diff --git a/compiler/mips/vm.lisp b/compiler/mips/vm.lisp index be249598b63278d932f8a06fbc52062cb87b557a..6128caec57a041026fd17ae5d0870ad24f5b1a74 100644 --- a/compiler/mips/vm.lisp +++ b/compiler/mips/vm.lisp @@ -7,7 +7,7 @@ ;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU) ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/vm.lisp,v 1.5 1990/02/03 17:04:45 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/vm.lisp,v 1.6 1990/02/17 21:26:01 wlott Exp $ ;;; ;;; This file contains the VM definition for the MIPS R2000 and the new ;;; object format. @@ -26,89 +26,91 @@ (define-storage-base immediate-constant :non-packed) ;;; -;;; Objects that can be stored in any register (immediate objects) -(define-storage-class any-reg 0 registers - :locations (2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)) - -;;; -;;; Objects that must be seen by GC (pointer objects) -(define-storage-class descriptor-reg 1 registers - :locations (8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23)) - -;;; -;;; Objects that must not be seen by GC (unboxed objects) -(define-storage-class non-descriptor-reg 2 registers - :locations (2 3 4 5 6 7)) - -;;; -;;; Unboxed string-chars -(define-storage-class string-char-reg 3 registers - :locations (2 3 4 5 6 7)) - -;;; -;;; Unboxed SAP's (arbitrary pointers into address space) -(define-storage-class sap-reg 4 registers - :locations (2 3 4 5 6 7)) - -;;; -;;; Stack for descriptor objects (scanned by GC) -(define-storage-class control-stack 5 control-stack) - -;;; -;;; Stack for non-descriptor objects (not scanned by GC) -(define-storage-class number-stack 6 number-stack) - -;;; -;;; Unboxed string-char stack -(define-storage-class string-char-stack 7 number-stack) - -;;; -;;; Unboxed SAP stack -(define-storage-class sap-stack 8 number-stack) - -;;; -;;; Non-immediate contstants in the constant pool -(define-storage-class constant 9 constant) - - -;;; Immediate numeric constants. -;;; -;;; zero = (integer 0 0) -;;; -;;; negative-immediate = (integer #x-7FFF #-x0001) -;;; The funny lower bound guarantees that the negation of an immediate -;;; is still an immediate. -;;; -;;; immediate = (integer 0 #x7FFE) -;;; The funny upper bound guarantees that (1+ immediate) will fit in -;;; 16 bits. +;;; Handy macro so we don't have to keep changing all the numbers whenever +;;; we insert a new storage class. ;;; -;;; unsigned-immediate = (integer #x7FFF #xFFFE) -;;; The funny upper bound guarantees that (1+ immediate) will fit in -;;; 16 bits. -;;; -(define-storage-class zero 10 immediate-constant) -(define-storage-class negative-immediate 11 immediate-constant) -(define-storage-class immediate 12 immediate-constant) -(define-storage-class unsigned-immediate 13 immediate-constant) - -;;; -;;; Immediate null/nil. -(define-storage-class null 14 immediate-constant) - -;;; -;;; Immediate unboxed string-chars. -(define-storage-class immediate-string-char 15 immediate-constant) - -;;; -;;; Immediate unboxed SAP's. -(define-storage-class immediate-sap 16 immediate-constant) - -;;; Objects that are easier to create using immediate loads than to fetch -;;; from the constant pool, but which aren't directly usable as immediate -;;; operands. These are only recognized by move VOPs. -;;; -(define-storage-class random-immediate 17 immediate-constant) +(defmacro define-storage-classes (&rest classes) + `(progn + ,@(mapcar (let ((index -1)) + #'(lambda (class) + (incf index) + `(define-storage-class ,(car class) ,index ,@(cdr class)))) + classes))) + +(define-storage-classes + ;; Objects that can be stored in any register (immediate objects) + (any-reg registers + :locations (2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 28 31)) + + ;; Objects that must be seen by GC (pointer objects) + (descriptor-reg registers + :locations (8 9 10 11 12 13 14 15 16 17 18 19 28 31)) + + ;; Objects that must not be seen by GC (unboxed objects) + (non-descriptor-reg registers + :locations (2 3 4 5 6 7)) + + ;; Pointers to the interior of objects. + (interior-reg registers + :locations (1)) + + ;; Unboxed string-chars + (string-char-reg registers + :locations (2 3 4 5 6 7)) + + ;; Unboxed SAP's (arbitrary pointers into address space) + (sap-reg registers + :locations (2 3 4 5 6 7)) + + ;; Stack for descriptor objects (scanned by GC) + (control-stack control-stack) + + ;; Stack for non-descriptor objects (not scanned by GC) + (number-stack number-stack) + + ;; Unboxed string-char stack + (string-char-stack number-stack) + + ;; Unboxed SAP stack + (sap-stack number-stack) + + ;; Non-immediate contstants in the constant pool + (constant constant) + + ;; Immediate numeric constants. + ;; + ;; zero = (integer 0 0) + ;; + ;; negative-immediate = (integer #x-1FFF #-x0001) + ;; The funny lower bound guarantees that the negation of an immediate + ;; is still an immediate. + ;; + ;; immediate = (integer 0 #x1FFE) + ;; The funny upper bound guarantees that (1+ immediate) will fit in + ;; 16 bits. + ;; + ;; unsigned-immediate = (integer #x1FFF #x3FFE) + ;; The funny upper bound guarantees that (1+ immediate) will fit in + ;; 16 bits. + ;; + (zero immediate-constant) + (negative-immediate immediate-constant) + (immediate immediate-constant) + (unsigned-immediate immediate-constant) + + ;; Immediate null/nil. + (null immediate-constant) + + ;; Immediate unboxed string-chars. + (immediate-string-char immediate-constant) + + ;; Immediate unboxed SAP's. + (immediate-sap immediate-constant) + + ;; Objects that are easier to create using immediate loads than to fetch + ;; from the constant pool, but which aren't directly usable as immediate + ;; operands. These are only recognized by move VOPs. + (random-immediate immediate-constant)) ;;;; Interfaces for stack sizes. @@ -319,13 +321,14 @@ (eval-when (compile eval load) (defconstant zero-offset 0) - (defconstant lip-offset 1) - (defconstant bsp-offset 24) - (defconstant csp-offset 25) - (defconstant null-offset 28) + (defconstant null-offset 20) + (defconstant bsp-offset 21) + (defconstant cont-offset 22) + (defconstant csp-offset 23) + (defconstant flags-offset 24) + (defconstant alloc-offset 25) (defconstant nsp-offset 29) - (defconstant code-offset 30) - (defconstant cont-offset 31)) + (defconstant code-offset 30)) ;;; ;;; Wired Zero @@ -334,12 +337,12 @@ :sc (sc-or-lose 'any-reg) :offset zero-offset)) -;;; -;;; Lisp Interior Pointer -(defparameter lip-tn +;;; +;;; ``Wired'' NIL +(defparameter null-tn (make-random-tn :kind :normal :sc (sc-or-lose 'any-reg) - :offset lip-offset)) + :offset null-offset)) ;;; ;;; Binding stack pointer @@ -348,6 +351,13 @@ :sc (sc-or-lose 'any-reg) :offset bsp-offset)) +;;; +;;; Frame Pointer +(defparameter cont-tn + (make-random-tn :kind :normal + :sc (sc-or-lose 'any-reg) + :offset cont-offset)) + ;;; ;;; Control stack pointer (defparameter csp-tn @@ -356,13 +366,19 @@ :offset csp-offset)) ;;; -;;; ``Wired'' NIL -(defparameter null-tn +;;; FLAGS magic register +(defparameter flags-tn (make-random-tn :kind :normal :sc (sc-or-lose 'any-reg) - :offset null-offset)) + :offset flags-offset)) ;;; +;;; Allocation pointer +(defparameter alloc-tn + (make-random-tn :kind :normal + :sc (sc-or-lose 'any-reg) + :offset alloc-offset)) +;;; ;;; Number stack pointer (defparameter nsp-tn (make-random-tn :kind :normal @@ -376,13 +392,6 @@ :sc (sc-or-lose 'any-reg) :offset code-offset)) -;;; -;;; Frame Pointer -(defparameter cont-tn - (make-random-tn :kind :normal - :sc (sc-or-lose 'any-reg) - :offset cont-offset)) - ;;;; Side-Effect Classes @@ -404,11 +413,11 @@ (sc-number-or-lose 'zero)) (null (sc-number-or-lose 'null)) - ((integer #x-7FFF #x-0001) + ((integer #x-1FFF #x-0001) (sc-number-or-lose 'negative-immediate)) - ((integer 0 #x7FFE) + ((integer 0 #x1FFE) (sc-number-or-lose 'immediate)) - ((integer #x7FFF #xFFFE) + ((integer #x1FFF #x3FFE) (sc-number-or-lose 'unsigned-immediate)) ((or fixnum (member t)) (sc-number-or-lose 'random-immediate)) @@ -425,10 +434,6 @@ ;;;; Function Call Parameters -;;; -;;; ### This will need to change as the call VOP's are written. -;;; - ;;; The SC numbers for register and stack arguments/return values. ;;; (defconstant register-arg-scn (sc-number-or-lose 'descriptor-reg)) @@ -436,20 +441,14 @@ (eval-when (compile load eval) -;;; ;;; Offset of special registers used during calls -(defconstant lra-offset 23) -(defconstant lexenv-offset 13) -(defconstant argument-pointer-offset 22) -(defconstant argument-count-offset 7) -(defconstant old-cont-offset 14) -(defconstant call-name-offset 15) - ;;; -;;; Offsets of special stack frame locations -(defconstant old-cont-save-offset 0) -(defconstant lra-save-offset 1) -(defconstant lexenv-save-offset 2) +(defconstant nargs-offset 7) +(defconstant cname-offset 14) +(defconstant lexenv-offset 15) +(defconstant args-offset 16) +(defconstant oldcont-offset 17) +(defconstant lra-offset 18) ); Eval-When (Compile Load Eval) @@ -472,21 +471,25 @@ (eval-when (compile load eval) +;;; The number of arguments/return values passed in registers. +;;; +(defconstant register-arg-count 6) + ;;; The offsets within the register-arg SC that we pass values in, first ;;; value first. ;;; -(defconstant register-arg-offsets '(16 17 18 19 20 21)) +(defconstant register-arg-offsets '(8 9 10 11 12 13)) -;;; The number of arguments/return values passed in registers. -;;; -(defconstant register-arg-count 6) +;;; Names to use for the argument registers. +;;; +(defconstant register-arg-names '(a0 a1 a2 a3 a4 a5)) ); Eval-When (Compile Load Eval) ;;; A list of TN's describing the register arguments. ;;; -(defparameter register-argument-tns +(defparameter register-arg-tns (mapcar #'(lambda (n) (make-random-tn :kind :normal :sc (sc-or-lose 'descriptor-reg)