X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmips%2Fvm.lisp;h=9030f90567104a413581c765b19b85372e0eec0c;hb=fe962ba01d267b92f638c8f0d19be41054219f04;hp=b20d78bbee35697d53ce97820816527b18fcb4e5;hpb=bc9235363fc93155dbdbba04755b4fa89fc00ea8;p=sbcl.git diff --git a/src/compiler/mips/vm.lisp b/src/compiler/mips/vm.lisp index b20d78b..9030f90 100644 --- a/src/compiler/mips/vm.lisp +++ b/src/compiler/mips/vm.lisp @@ -18,15 +18,15 @@ (defvar *register-names* (make-array 32 :initial-element nil))) (macrolet ((defreg (name offset) - (let ((offset-sym (symbolicate name "-OFFSET"))) - `(eval-when (:compile-toplevel :load-toplevel :execute) - (def!constant ,offset-sym ,offset) - (setf (svref *register-names* ,offset-sym) ,(symbol-name name))))) - - (defregset (name &rest regs) - `(eval-when (:compile-toplevel :load-toplevel :execute) - (defparameter ,name - (list ,@(mapcar #'(lambda (name) (symbolicate name "-OFFSET")) regs)))))) + (let ((offset-sym (symbolicate name "-OFFSET"))) + `(eval-when (:compile-toplevel :load-toplevel :execute) + (def!constant ,offset-sym ,offset) + (setf (svref *register-names* ,offset-sym) ,(symbol-name name))))) + + (defregset (name &rest regs) + `(eval-when (:compile-toplevel :load-toplevel :execute) + (defparameter ,name + (list ,@(mapcar #'(lambda (name) (symbolicate name "-OFFSET")) regs)))))) ;; Wired zero register. (defreg zero 0) ; NULL ;; Reserved for assembler use. @@ -61,7 +61,8 @@ (defreg l1 24) ; tagged temporary 1 (defreg alloc 25) ; ALLOC pointer ;; 26 and 27 are used by the system kernel. - ;; 28 is the global pointer of our C runtime. + ;; 28 is the global pointer of our C runtime, and used for + ;; jump/branch relaxation in Lisp. (defreg nsp 29) ; number (native) stack pointer ;; C frame pointer, or additional saved register. (defreg code 30) ; current function object @@ -96,19 +97,19 @@ ;;; ;;; Handy macro so we don't have to keep changing all the numbers whenever ;;; we insert a new storage class. -;;; +;;; (defmacro !define-storage-classes (&rest classes) (do ((forms (list 'progn) - (let* ((class (car classes)) - (sc-name (car class)) - (constant-name (intern (concatenate 'simple-string - (string sc-name) - "-SC-NUMBER")))) - (list* `(define-storage-class ,sc-name ,index - ,@(cdr class)) - `(defconstant ,constant-name ,index) - `(export ',constant-name) - forms))) + (let* ((class (car classes)) + (sc-name (car class)) + (constant-name (intern (concatenate 'simple-string + (string sc-name) + "-SC-NUMBER")))) + (list* `(define-storage-class ,sc-name ,index + ,@(cdr class)) + `(defconstant ,constant-name ,index) + `(export ',constant-name) + forms))) (index 0 (1+ index)) (classes classes (cdr classes))) ((null classes) @@ -131,20 +132,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). @@ -152,7 +143,7 @@ registers :locations #.(append non-descriptor-regs descriptor-regs) :reserve-locations #.(append reserve-non-descriptor-regs - reserve-descriptor-regs) + reserve-descriptor-regs) :constant-scs (constant zero immediate) :save-p t :alternate-scs (control-stack)) @@ -165,6 +156,21 @@ :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) ; 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 @@ -261,12 +267,12 @@ ;;;; Random TNs for interesting registers (macrolet ((defregtn (name sc) - (let ((offset-sym (symbolicate name "-OFFSET")) - (tn-sym (symbolicate name "-TN"))) - `(defparameter ,tn-sym - (make-random-tn :kind :normal - :sc (sc-or-lose ',sc) - :offset ,offset-sym))))) + (let ((offset-sym (symbolicate name "-OFFSET")) + (tn-sym (symbolicate name "-TN"))) + `(defparameter ,tn-sym + (make-random-tn :kind :normal + :sc (sc-or-lose ',sc) + :offset ,offset-sym))))) (defregtn zero any-reg) (defregtn nargs any-reg) @@ -297,10 +303,10 @@ (sc-number-or-lose 'null)) (symbol (if (static-symbol-p value) - (sc-number-or-lose 'immediate) - nil)) + (sc-number-or-lose 'immediate) + nil)) ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum) - system-area-pointer character) + system-area-pointer character) (sc-number-or-lose 'immediate)) (system-area-pointer (sc-number-or-lose 'immediate)) @@ -332,7 +338,7 @@ ;;; ;;; Names to use for the argument registers. -;;; +;;; (defconstant-eqx register-arg-names '(a0 a1 a2 a3 a4 a5) #'equal) ) ; EVAL-WHEN @@ -340,12 +346,12 @@ ;;; A list of TN's describing the register arguments. ;;; -(defparameter register-arg-tns +(defparameter *register-arg-tns* (mapcar #'(lambda (n) - (make-random-tn :kind :normal - :sc (sc-or-lose 'descriptor-reg) - :offset n)) - *register-arg-offsets*)) + (make-random-tn :kind :normal + :sc (sc-or-lose 'descriptor-reg) + :offset n)) + *register-arg-offsets*)) ;;; This is used by the debugger. (defconstant single-value-return-byte-offset 8) @@ -355,14 +361,16 @@ (!def-vm-support-routine location-print-name (tn) (declare (type tn tn)) (let ((sb (sb-name (sc-sb (tn-sc tn)))) - (offset (tn-offset tn))) + (offset (tn-offset tn))) (ecase sb (registers (or (svref *register-names* offset) - (format nil "R~D" offset))) + (format nil "R~D" offset))) (float-registers (format nil "F~D" offset)) (control-stack (format nil "CS~D" offset)) (non-descriptor-stack (format nil "NS~D" offset)) (constant (format nil "Const~D" offset)) (immediate-constant "Immed")))) - +(!def-vm-support-routine combination-implementation-style (node) + (declare (type sb!c::combination node) (ignore node)) + (values :default nil))