X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmips%2Fvm.lisp;h=cf909766255f71adc512ff56150b5b678327b1bc;hb=74cf7a4d01664fbf72a662ba093ad67ca243b524;hp=cc2d8443dad3ab2d012a1d9f55b1edc07a23643e;hpb=481348f2f96f364374f669786f9fc61348decabc;p=sbcl.git diff --git a/src/compiler/mips/vm.lisp b/src/compiler/mips/vm.lisp index cc2d844..cf90976 100644 --- a/src/compiler/mips/vm.lisp +++ b/src/compiler/mips/vm.lisp @@ -70,10 +70,10 @@ (defreg lip 31) ; Lisp interior pointer (defregset non-descriptor-regs - nl0 nl1 nl2 nl3 nl4 cfunc nargs) + nl0 nl1 nl2 nl3 nl4 cfunc nargs nfp) (defregset descriptor-regs - a0 a1 a2 a3 a4 a5 fdefn lexenv nfp ocfp lra l0 l1) + a0 a1 a2 a3 a4 a5 fdefn lexenv ocfp lra l0 l1) (defregset *register-arg-offsets* a0 a1 a2 a3 a4 a5) @@ -107,15 +107,14 @@ "-SC-NUMBER")))) (list* `(define-storage-class ,sc-name ,index ,@(cdr class)) - `(defconstant ,constant-name ,index) - `(export ',constant-name) + `(def!constant ,constant-name ,index) forms))) (index 0 (1+ index)) (classes classes (cdr classes))) ((null classes) (nreverse forms)))) -(def!constant kludge-nondeterministic-catch-block-size 7) +(def!constant kludge-nondeterministic-catch-block-size 6) (!define-storage-classes @@ -132,20 +131,10 @@ ;; The control stack. (Scanned by GC) (control-stack control-stack) - ;; The non-descriptor stacks. - (signed-stack non-descriptor-stack) ; (signed-byte 32) - (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32) - (character-stack non-descriptor-stack) ; non-descriptor characters. - (sap-stack non-descriptor-stack) ; System area pointers. - (single-stack non-descriptor-stack) ; single-floats - (double-stack non-descriptor-stack :element-size 2) ; double floats. - ;; complex-single-floats - (complex-single-stack non-descriptor-stack :element-size 2) - ;; complex-double-floats. - (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2) - - - ;; **** Things that can go in the integer registers. + ;; We put ANY-REG and DESCRIPTOR-REG early so that their SC-NUMBER + ;; is small and therefore the error trap information is smaller. + ;; Moving them up here from their previous place down below saves + ;; ~250K in core file size. --njf, 2006-01-27 ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing ;; bad will happen if they are. (fixnums, characters, header values, etc). @@ -166,6 +155,22 @@ :save-p t :alternate-scs (control-stack)) + ;; The non-descriptor stacks. + (signed-stack non-descriptor-stack) ; (signed-byte 32) + (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32) + (character-stack non-descriptor-stack) ; non-descriptor characters. + (sap-stack non-descriptor-stack) ; System area pointers. + (single-stack non-descriptor-stack) ; single-floats + (double-stack non-descriptor-stack + :element-size 2 :alignment 2) ; double floats. + ;; complex-single-floats + (complex-single-stack non-descriptor-stack :element-size 2) + ;; complex-double-floats. + (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2) + + + ;; **** Things that can go in the integer registers. + ;; Non-Descriptor characters (character-reg registers :locations #.non-descriptor-regs @@ -290,7 +295,7 @@ ;;; If VALUE can be represented as an immediate constant, then return the ;;; appropriate SC number, otherwise return NIL. -(!def-vm-support-routine immediate-constant-sc (value) +(defun immediate-constant-sc (value) (typecase value ((integer 0 0) (sc-number-or-lose 'zero)) @@ -301,32 +306,36 @@ (sc-number-or-lose 'immediate) nil)) ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum) - system-area-pointer character) + character) (sc-number-or-lose 'immediate)) (system-area-pointer (sc-number-or-lose 'immediate)) (character (sc-number-or-lose 'immediate)))) +(defun boxed-immediate-sc-p (sc) + (or (eql sc (sc-number-or-lose 'zero)) + (eql sc (sc-number-or-lose 'null)) + (eql sc (sc-number-or-lose 'immediate)))) ;;;; Function Call Parameters ;;; The SC numbers for register and stack arguments/return values. ;;; -(defconstant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg)) -(defconstant immediate-arg-scn (meta-sc-number-or-lose 'any-reg)) -(defconstant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack)) +(def!constant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg)) +(def!constant immediate-arg-scn (meta-sc-number-or-lose 'any-reg)) +(def!constant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack)) (eval-when (:compile-toplevel :load-toplevel :execute) ;;; Offsets of special stack frame locations -(defconstant ocfp-save-offset 0) -(defconstant lra-save-offset 1) -(defconstant nfp-save-offset 2) +(def!constant ocfp-save-offset 0) +(def!constant lra-save-offset 1) +(def!constant nfp-save-offset 2) ;;; The number of arguments/return values passed in registers. ;;; -(defconstant register-arg-count 6) +(def!constant register-arg-count 6) ;;; The offsets within the register-arg SC that we pass values in, first ;;; value first. @@ -349,11 +358,11 @@ *register-arg-offsets*)) ;;; This is used by the debugger. -(defconstant single-value-return-byte-offset 8) +(def!constant single-value-return-byte-offset 8) ;;; This function is called by debug output routines that want a pretty name ;;; for a TN's location. It returns a thing that can be printed with PRINC. -(!def-vm-support-routine location-print-name (tn) +(defun location-print-name (tn) (declare (type tn tn)) (let ((sb (sb-name (sc-sb (tn-sc tn)))) (offset (tn-offset tn))) @@ -366,4 +375,10 @@ (constant (format nil "Const~D" offset)) (immediate-constant "Immed")))) +(defun combination-implementation-style (node) + (declare (type sb!c::combination node) (ignore node)) + (values :default nil)) +(defun primitive-type-indirect-cell-type (ptype) + (declare (ignore ptype)) + nil)