X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Fvm.lisp;h=5ee30a896aed051d3b00119bcca4133312f3efd0;hb=69ef68ba7393e3492c1b4a756d1140f71c2922bc;hp=fd64d6ec225a7fe1c17908c6e7682197ec2369cf;hpb=ec2616d216958a608581802c47496c0194478dc8;p=sbcl.git diff --git a/src/compiler/sparc/vm.lisp b/src/compiler/sparc/vm.lisp index fd64d6e..5ee30a8 100644 --- a/src/compiler/sparc/vm.lisp +++ b/src/compiler/sparc/vm.lisp @@ -10,7 +10,18 @@ ;;;; files for more information. (in-package "SB!VM") - + +;;;; Additional constants + +;;; NUMBER-STACK-DISPLACEMENT +;;; +;;; The number of bytes reserved above the number stack pointer. These +;;; slots are required by architecture for a place to spill register windows. +;;; +;;; FIXME: Where is this used? +(def!constant number-stack-displacement + (* 16 n-word-bytes)) + ;;;; Define the registers (eval-when (:compile-toplevel :load-toplevel :execute) @@ -19,7 +30,7 @@ (macrolet ((defreg (name offset) (let ((offset-sym (symbolicate name "-OFFSET"))) `(eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant ,offset-sym ,offset) + (def!constant ,offset-sym ,offset) (setf (svref *register-names* ,offset-sym) ,(symbol-name name))))) @@ -99,7 +110,7 @@ "-SC-NUMBER")))) (list* `(define-storage-class ,sc-name ,index ,@(cdr class)) - `(defconstant ,constant-name ,index) + `(def!constant ,constant-name ,index) ;; (The CMU CL version of this macro did ;; `(EXPORT ',CONSTANT-NAME) ;; here, but in SBCL we try to have package @@ -118,7 +129,7 @@ ;;; and seems to be working so far -dan ;;; ;;; arbitrarily taken for alpha, too. - Christophe -(defconstant sb!vm::kludge-nondeterministic-catch-block-size 7) +(def!constant kludge-nondeterministic-catch-block-size 7) (!define-storage-classes @@ -142,7 +153,7 @@ ;; The non-descriptor stacks. (signed-stack non-descriptor-stack) ; (signed-byte 32) (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32) - (base-char-stack non-descriptor-stack) ; non-descriptor characters. + (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 @@ -177,11 +188,11 @@ :alternate-scs (control-stack)) ;; Non-Descriptor characters - (base-char-reg registers + (character-reg registers :locations #.non-descriptor-regs :constant-scs (immediate) :save-p t - :alternate-scs (base-char-stack)) + :alternate-scs (character-stack)) ;; Non-Descriptor SAP's (arbitrary pointers into address space) (sap-reg registers @@ -270,12 +281,9 @@ ;; A catch or unwind block. - (catch-block control-stack :element-size sb!vm::kludge-nondeterministic-catch-block-size)) - - + (catch-block control-stack :element-size kludge-nondeterministic-catch-block-size)) -;;;; Make some random tns for important registers. - +;;;; Make some miscellaneous TNs for important registers. (macrolet ((defregtn (name sc) (let ((offset-sym (symbolicate name "-OFFSET")) (tn-sym (symbolicate name "-TN"))) @@ -294,10 +302,8 @@ (defregtn cfp any-reg) (defregtn ocfp any-reg) (defregtn nsp any-reg)) - - -;;; If value can be represented as an immediate constant, then return the +;;; 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) (typecase value @@ -305,39 +311,37 @@ (sc-number-or-lose 'zero)) (null (sc-number-or-lose 'null)) - ((or fixnum system-area-pointer character) + ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum) + system-area-pointer character) (sc-number-or-lose 'immediate)) (symbol (if (static-symbol-p value) (sc-number-or-lose 'immediate) nil)))) - ;;;; 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) ;; names to use for the argument registers. - ;; (defparameter register-arg-names '(a0 a1 a2 a3 a4 a5)) -); eval-when (:compile-toplevel :load-toplevel :execute) +) ; EVAL-WHEN -;;; a list of TN's describing the register arguments. +;;; a list of TN's describing the register arguments (defparameter *register-arg-tns* (mapcar (lambda (n) (make-random-tn :kind :normal @@ -346,8 +350,7 @@ *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 @@ -365,10 +368,3 @@ (constant (format nil "Const~D" offset)) (immediate-constant "Immed")))) - -;;; The loader uses this to convert alien names to the form they -;;; occure in the symbol table (for example, prepending an -;;; underscore). On the SPARC, we don't prepend an underscore. -(defun extern-alien-name (name) - (declare (type simple-base-string name)) - (concatenate 'string #+nil "_" name))