5 ;;;; Define the registers
7 (eval-when (:compile-toplevel :load-toplevel :execute)
8 (defvar *register-names* (make-array 32 :initial-element nil)))
10 (macrolet ((defreg (name offset)
11 (let ((offset-sym (symbolicate name "-OFFSET")))
12 `(eval-when (:compile-toplevel :load-toplevel :execute)
13 (def!constant ,offset-sym ,offset)
14 (setf (svref *register-names* ,offset-sym) ,(symbol-name name)))))
16 (defregset (name &rest regs)
17 `(eval-when (:compile-toplevel :load-toplevel :execute)
19 (list ,@(mapcar #'(lambda (name)
20 (symbolicate name "-OFFSET")) regs))))))
24 (defreg rtoc 2) ; May be "NULL" someday.
32 (defreg fdefn 10) ; was nl7
55 (defregset non-descriptor-regs
56 nl0 nl1 nl2 nl3 nl4 nl5 nl6 #+nil nl7 cfunc nargs nfp)
58 (defregset descriptor-regs
59 fdefn a0 a1 a2 a3 ocfp lra cname lexenv l0 l1 l2 )
62 (defregset *register-arg-offsets* a0 a1 a2 a3)
63 (defparameter register-arg-names '(a0 a1 a2 a3)))
67 ;;;; SB and SC definition:
69 (define-storage-base registers :finite :size 32)
70 (define-storage-base float-registers :finite :size 32)
71 (define-storage-base control-stack :unbounded :size 8)
72 (define-storage-base non-descriptor-stack :unbounded :size 0)
73 (define-storage-base constant :non-packed)
74 (define-storage-base immediate-constant :non-packed)
77 ;;; Handy macro so we don't have to keep changing all the numbers whenever
78 ;;; we insert a new storage class.
80 (defmacro define-storage-classes (&rest classes)
81 (do ((forms (list 'progn)
82 (let* ((class (car classes))
84 (constant-name (intern (concatenate 'simple-string
87 (list* `(define-storage-class ,sc-name ,index
89 `(def!constant ,constant-name ,index)
92 (classes classes (cdr classes)))
96 ;; XXX this is most likely wrong. Check with Eric Marsden next time you
98 (def!constant sb!vm::kludge-nondeterministic-catch-block-size 7)
100 (define-storage-classes
102 ;; Non-immediate contstants in the constant pool
105 ;; ZERO and NULL are in registers.
106 (zero immediate-constant)
107 (null immediate-constant)
109 ;; Anything else that can be an immediate.
110 (immediate immediate-constant)
115 ;; The control stack. (Scanned by GC)
116 (control-stack control-stack)
118 ;; The non-descriptor stacks.
119 (signed-stack non-descriptor-stack) ; (signed-byte 32)
120 (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
121 (base-char-stack non-descriptor-stack) ; non-descriptor characters.
122 (sap-stack non-descriptor-stack) ; System area pointers.
123 (single-stack non-descriptor-stack) ; single-floats
124 (double-stack non-descriptor-stack
125 :element-size 2 :alignment 2) ; double floats.
126 (complex-single-stack non-descriptor-stack :element-size 2)
127 (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
130 ;; **** Things that can go in the integer registers.
132 ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing
133 ;; bad will happen if they are. (fixnums, characters, header values, etc).
136 :locations #.(append non-descriptor-regs descriptor-regs)
137 :constant-scs (zero immediate)
139 :alternate-scs (control-stack))
141 ;; Pointer descriptor objects. Must be seen by GC.
142 (descriptor-reg registers
143 :locations #.descriptor-regs
144 :constant-scs (constant null immediate)
146 :alternate-scs (control-stack))
148 ;; Non-Descriptor characters
149 (base-char-reg registers
150 :locations #.non-descriptor-regs
151 :constant-scs (immediate)
153 :alternate-scs (base-char-stack))
155 ;; Non-Descriptor SAP's (arbitrary pointers into address space)
157 :locations #.non-descriptor-regs
158 :constant-scs (immediate)
160 :alternate-scs (sap-stack))
162 ;; Non-Descriptor (signed or unsigned) numbers.
163 (signed-reg registers
164 :locations #.non-descriptor-regs
165 :constant-scs (zero immediate)
167 :alternate-scs (signed-stack))
168 (unsigned-reg registers
169 :locations #.non-descriptor-regs
170 :constant-scs (zero immediate)
172 :alternate-scs (unsigned-stack))
174 ;; Random objects that must not be seen by GC. Used only as temporaries.
175 (non-descriptor-reg registers
176 :locations #.non-descriptor-regs)
178 ;; Pointers to the interior of objects. Used only as a temporary.
179 (interior-reg registers
180 :locations (#.lip-offset))
183 ;; **** Things that can go in the floating point registers.
185 ;; Non-Descriptor single-floats.
186 (single-reg float-registers
187 :locations #.(loop for i from 0 to 31 collect i)
188 ;; ### Note: We really should have every location listed, but then we
189 ;; would have to make load-tns work with element-sizes other than 1.
192 :alternate-scs (single-stack))
194 ;; Non-Descriptor double-floats.
195 (double-reg float-registers
196 :locations #.(loop for i from 0 to 31 collect i)
197 ;; ### Note: load-tns don't work with an element-size other than 1.
198 ;; :element-size 2 :alignment 2
201 :alternate-scs (double-stack))
203 (complex-single-reg float-registers
204 :locations #.(loop for i from 0 to 30 by 2 collect i)
208 :alternate-scs (complex-single-stack))
210 (complex-double-reg float-registers
211 :locations #.(loop for i from 0 to 30 by 2 collect i)
215 :alternate-scs (complex-double-stack))
217 ;; A catch or unwind block.
218 (catch-block control-stack
219 :element-size sb!vm::kludge-nondeterministic-catch-block-size))
223 ;;;; Make some random tns for important registers.
225 (macrolet ((defregtn (name sc)
226 (let ((offset-sym (symbolicate name "-OFFSET"))
227 (tn-sym (symbolicate name "-TN")))
228 `(defparameter ,tn-sym
229 (make-random-tn :kind :normal
230 :sc (sc-or-lose ',sc)
231 :offset ,offset-sym)))))
233 (defregtn zero any-reg)
234 (defregtn lip interior-reg)
235 (defregtn null descriptor-reg)
236 (defregtn code descriptor-reg)
237 (defregtn alloc any-reg)
239 (defregtn nargs any-reg)
240 (defregtn bsp any-reg)
241 (defregtn csp any-reg)
242 (defregtn cfp any-reg)
243 (defregtn ocfp any-reg)
244 (defregtn nsp any-reg))
248 ;;; Immediate-Constant-SC -- Interface
250 ;;; If value can be represented as an immediate constant, then return the
251 ;;; appropriate SC number, otherwise return NIL.
253 (!def-vm-support-routine immediate-constant-sc (value)
256 (sc-number-or-lose 'zero))
258 (sc-number-or-lose 'null))
259 ((or fixnum system-area-pointer character)
260 (sc-number-or-lose 'immediate))
262 (if (static-symbol-p value)
263 (sc-number-or-lose 'immediate)
267 ;;;; Function Call Parameters
269 ;;; The SC numbers for register and stack arguments/return values.
271 (def!constant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
272 (def!constant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
273 (def!constant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
275 (eval-when (:compile-toplevel :load-toplevel :execute)
277 ;;; Offsets of special stack frame locations
278 (def!constant ocfp-save-offset 0)
279 (def!constant lra-save-offset 1)
280 (def!constant nfp-save-offset 2)
282 ;;; The number of arguments/return values passed in registers.
284 (def!constant register-arg-count 4)
286 ;;; Names to use for the argument registers.
290 ); Eval-When (:compile-toplevel :load-toplevel :execute)
293 ;;; A list of TN's describing the register arguments.
295 (defparameter *register-arg-tns*
296 (mapcar #'(lambda (n)
297 (make-random-tn :kind :normal
298 :sc (sc-or-lose 'descriptor-reg)
300 *register-arg-offsets*))
302 (export 'single-value-return-byte-offset)
304 ;;; SINGLE-VALUE-RETURN-BYTE-OFFSET
306 ;;; This is used by the debugger.
308 (def!constant single-value-return-byte-offset 8)
311 ;;; LOCATION-PRINT-NAME -- Interface
313 ;;; This function is called by debug output routines that want a pretty name
314 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
316 (!def-vm-support-routine location-print-name (tn)
317 (declare (type tn tn))
318 (let ((sb (sb-name (sc-sb (tn-sc tn))))
319 (offset (tn-offset tn)))
321 (registers (or (svref *register-names* offset)
322 (format nil "R~D" offset)))
323 (float-registers (format nil "F~D" offset))
324 (control-stack (format nil "CS~D" offset))
325 (non-descriptor-stack (format nil "NS~D" offset))
326 (constant (format nil "Const~D" offset))
327 (immediate-constant "Immed"))))
329 ;;; The loader uses this to convert alien names to the form they
330 ;;; occur in the symbol table. This is ELF, so do nothing
332 (defun extern-alien-name (name)
333 (declare (type simple-base-string name))