(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))))))
;; c.f. src/runtime/sparc-lispregs.h
;; Globals. These are difficult to extract from a sigcontext.
- (defreg zero 0) ; %g0
- (defreg alloc 1) ; %g1
- (defreg null 2) ; %g2
- (defreg csp 3) ; %g3
- (defreg cfp 4) ; %g4
- (defreg bsp 5) ; %g5
+ (defreg zero 0) ; %g0
+ (defreg alloc 1) ; %g1
+ (defreg null 2) ; %g2
+ (defreg csp 3) ; %g3
+ (defreg cfp 4) ; %g4
+ (defreg bsp 5) ; %g5
;; %g6 and %g7 are supposed to be reserved for the system.
;; Outs. These get clobbered when we call into C.
- (defreg nl0 8) ; %o0
- (defreg nl1 9) ; %o1
- (defreg nl2 10) ; %o2
- (defreg nl3 11) ; %o3
- (defreg nl4 12) ; %o4
- (defreg nl5 13) ; %o5
- (defreg nsp 14) ; %o6
- (defreg nargs 15) ; %o7
+ (defreg nl0 8) ; %o0
+ (defreg nl1 9) ; %o1
+ (defreg nl2 10) ; %o2
+ (defreg nl3 11) ; %o3
+ (defreg nl4 12) ; %o4
+ (defreg nl5 13) ; %o5
+ (defreg nsp 14) ; %o6
+ (defreg nargs 15) ; %o7
;; Locals. These are preserved when we call into C.
- (defreg a0 16) ; %l0
- (defreg a1 17) ; %l1
- (defreg a2 18) ; %l2
- (defreg a3 19) ; %l3
- (defreg a4 20) ; %l4
- (defreg a5 21) ; %l5
- (defreg ocfp 22) ; %l6
- (defreg lra 23) ; %l7
+ (defreg a0 16) ; %l0
+ (defreg a1 17) ; %l1
+ (defreg a2 18) ; %l2
+ (defreg a3 19) ; %l3
+ (defreg a4 20) ; %l4
+ (defreg a5 21) ; %l5
+ (defreg ocfp 22) ; %l6
+ (defreg lra 23) ; %l7
;; Ins. These are preserved just like locals.
- (defreg cname 24) ; %i0
- (defreg lexenv 25) ; %i1
- (defreg l0 26) ; %i2
- (defreg nfp 27) ; %i3
- (defreg cfunc 28) ; %i4
- (defreg code 29) ; %i5
+ (defreg cname 24) ; %i0
+ (defreg lexenv 25) ; %i1
+ (defreg l0 26) ; %i2
+ (defreg nfp 27) ; %i3
+ (defreg cfunc 28) ; %i4
+ (defreg code 29) ; %i5
;; we can't touch reg 30 if we ever want to return
- (defreg lip 31) ; %i7
+ (defreg lip 31) ; %i7
(defregset non-descriptor-regs
nl0 nl1 nl2 nl3 nl4 nl5 cfunc nargs nfp)
-
+
(defregset descriptor-regs
a0 a1 a2 a3 a4 a5 ocfp lra cname lexenv l0)
;;; 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))
- `(def!constant ,constant-name ,index)
+ (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))
+ `(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
;; master source file, instead of building it
;; dynamically by letting all the system code
;; modify it as the system boots.)
- forms)))
+ forms)))
(index 0 (1+ index))
(classes classes (cdr classes)))
((null classes)
;;; and seems to be working so far -dan
;;;
;;; arbitrarily taken for alpha, too. - Christophe
-(def!constant kludge-nondeterministic-catch-block-size 7)
+(def!constant kludge-nondeterministic-catch-block-size 6)
(!define-storage-classes
;; The control stack. (Scanned by GC)
(control-stack control-stack)
+ ;; 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).
+ (any-reg
+ registers
+ :locations #.(append non-descriptor-regs descriptor-regs)
+ :constant-scs (zero immediate)
+ :save-p t
+ :alternate-scs (control-stack))
+
+ ;; Pointer descriptor objects. Must be seen by GC.
+ (descriptor-reg registers
+ :locations #.descriptor-regs
+ :constant-scs (constant null immediate)
+ :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)
(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.
+ :element-size 2 :alignment 2) ; double floats.
#!+long-float
(long-stack non-descriptor-stack :element-size 4 :alignment 4) ; long floats.
;; complex-single-floats
;; **** Things that can go in the integer registers.
- ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing
- ;; bad will happen if they are. (fixnums, characters, header values, etc).
- (any-reg
- registers
- :locations #.(append non-descriptor-regs descriptor-regs)
- :constant-scs (zero immediate)
- :save-p t
- :alternate-scs (control-stack))
-
- ;; Pointer descriptor objects. Must be seen by GC.
- (descriptor-reg registers
- :locations #.descriptor-regs
- :constant-scs (constant null immediate)
- :save-p t
- :alternate-scs (control-stack))
-
;; Non-Descriptor characters
(character-reg registers
:locations #.non-descriptor-regs
;; Non-Descriptor double-floats.
(double-reg float-registers
:locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
- by 2 collect i)
+ by 2 collect i)
:element-size 2 :alignment 2
:reserve-locations (28 30)
:constant-scs ()
#!+long-float
(long-reg float-registers
:locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
- by 4 collect i)
+ by 4 collect i)
:element-size 4 :alignment 4
:reserve-locations (28)
:constant-scs ()
(complex-double-reg float-registers
:locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
- by 4 collect i)
+ by 4 collect i)
:element-size 4 :alignment 4
:reserve-locations (28)
:constant-scs ()
#!+long-float
(complex-long-reg float-registers
:locations #.(loop for i from 0 to #!-sparc-64 31 #!+sparc-64 63
- by 8 collect i)
+ by 8 collect i)
:element-size 8 :alignment 8
:constant-scs ()
:save-p t
\f
;;;; Make some miscellaneous TNs for important 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 null descriptor-reg)
(defregtn code descriptor-reg)
(defregtn alloc any-reg)
-
+
(defregtn nargs any-reg)
(defregtn bsp any-reg)
(defregtn csp any-reg)
(null
(sc-number-or-lose 'null))
((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
- system-area-pointer character)
+ character)
(sc-number-or-lose 'immediate))
(symbol
(if (static-symbol-p value)
- (sc-number-or-lose 'immediate)
- nil))))
+ (sc-number-or-lose 'immediate)
+ nil))))
\f
;;;; function call parameters
;;; a list of TN's describing the register arguments
(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.
(def!constant single-value-return-byte-offset 8)
(!def-vm-support-routine location-print-name (tn)
(declare (type tn tn)) ; FIXME: commented out on alpha
(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))
projects / sbcl.git / blobdiff