X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Fvm.lisp;h=5bf1cca425f8047ea6f144b915e4a5241afeb5fa;hb=8a8a8922802460741d6f8f6c11d71b1f414cf3a7;hp=6c954051bab3d5868ed53f752d9ec980a21edd1d;hpb=68fd2d2dd6f265669a8957accd8a33e62786a97e;p=sbcl.git diff --git a/src/compiler/sparc/vm.lisp b/src/compiler/sparc/vm.lisp index 6c95405..5bf1cca 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))))) @@ -29,7 +40,7 @@ (list ,@(mapcar (lambda (name) (symbolicate name "-OFFSET")) regs)))))) - ;; "c.f. src/runtime/sparc-lispregs.h + ;; c.f. src/runtime/sparc-lispregs.h ;; Globals. These are difficult to extract from a sigcontext. (defreg zero 0) ; %g0 @@ -79,7 +90,7 @@ (defregset *register-arg-offsets* a0 a1 a2 a3 a4 a5)) -;;;; SB and SC definition: +;;;; SB and SC definition (define-storage-base registers :finite :size 32) (define-storage-base float-registers :finite :size 64) @@ -88,11 +99,9 @@ (define-storage-base constant :non-packed) (define-storage-base immediate-constant :non-packed) -;;; Handy macro so we don't have to keep changing all the numbers whenever -;;; we insert a new storage class. -;;; -;;; FIXME: This macro is not needed in the runtime target. -(defmacro define-storage-classes (&rest classes) +;;; 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)) @@ -101,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 @@ -120,11 +129,11 @@ ;;; 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 +(!define-storage-classes - ;; Non-immediate contstants in the constant pool + ;; non-immediate constants in the constant pool (constant constant) ;; ZERO and NULL are in registers. @@ -134,8 +143,9 @@ ;; Anything else that can be an immediate. (immediate immediate-constant) - - ;; **** The stacks. + ;; + ;; the stacks + ;; ;; The control stack. (Scanned by GC) (control-stack control-stack) @@ -271,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"))) @@ -295,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 @@ -312,33 +317,30 @@ (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 @@ -347,8 +349,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