4 ;;;; Define the registers
6 (eval-when (:compile-toplevel :load-toplevel :execute)
7 (defvar *register-names* (make-array 32 :initial-element nil)))
9 ;;; FIXME: These want to turn into macrolets.
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)))))
15 (defregset (name &rest regs)
16 `(eval-when (:compile-toplevel :load-toplevel :execute)
18 (list ,@(mapcar #'(lambda (name) (symbolicate name "-OFFSET")) regs))))))
22 ;; This gets trashed by the C call convention.
25 ;; These are the callee saves, so these registers are stay live over
43 ;; This is where the caller-saves registers start, but we don't
44 ;; really care because we need to clear the above after call-out to
45 ;; make sure no pointers into oldspace are kept around.
50 ;; These are the 4 C argument registers.
55 ;; The global Data Pointer. We just leave it alone, because we
58 ;; These two are use for C return values.
64 (defregset non-descriptor-regs
65 nl0 nl1 nl2 nl3 nl4 nl5 nfp cfunc)
67 (defregset descriptor-regs
68 fdefn lexenv nargs ocfp lra a0 a1 a2 a3 a4 a5 l0 l1 l2)
70 (defregset *register-arg-offsets*
74 (define-storage-base registers :finite :size 32)
75 (define-storage-base float-registers :finite :size 64)
76 (define-storage-base control-stack :unbounded :size 8)
77 (define-storage-base non-descriptor-stack :unbounded :size 0)
78 (define-storage-base constant :non-packed)
79 (define-storage-base immediate-constant :non-packed)
82 ;;; Handy macro so we don't have to keep changing all the numbers whenever
83 ;;; we insert a new storage class.
85 (defmacro !define-storage-classes (&rest classes)
86 (do ((forms (list 'progn)
87 (let* ((class (car classes))
89 (constant-name (intern (concatenate 'simple-string
92 (list* `(define-storage-class ,sc-name ,index
94 `(defconstant ,constant-name ,index)
95 `(export ',constant-name)
98 (classes classes (cdr classes)))
102 (def!constant sb!vm::kludge-nondeterministic-catch-block-size 7)
104 (!define-storage-classes
106 ;; Non-immediate contstants in the constant pool
109 ;; ZERO and NULL are in registers.
110 (zero immediate-constant)
111 (null immediate-constant)
112 (fp-single-zero immediate-constant)
113 (fp-double-zero immediate-constant)
115 ;; Anything else that can be an immediate.
116 (immediate immediate-constant)
121 ;; The control stack. (Scanned by GC)
122 (control-stack control-stack)
124 ;; The non-descriptor stacks.
125 (signed-stack non-descriptor-stack) ; (signed-byte 32)
126 (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32)
127 (base-char-stack non-descriptor-stack) ; non-descriptor characters.
128 (sap-stack non-descriptor-stack) ; System area pointers.
129 (single-stack non-descriptor-stack) ; single-floats
130 (double-stack non-descriptor-stack
131 :element-size 2 :alignment 2) ; double floats.
132 (complex-single-stack non-descriptor-stack :element-size 2)
133 (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
136 ;; **** Things that can go in the integer registers.
138 ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing
139 ;; bad will happen if they are. (fixnums, characters, header values, etc).
142 :locations #.(append non-descriptor-regs descriptor-regs)
143 :constant-scs (zero immediate)
145 :alternate-scs (control-stack))
147 ;; Pointer descriptor objects. Must be seen by GC.
148 (descriptor-reg registers
149 :locations #.descriptor-regs
150 :constant-scs (constant null immediate)
152 :alternate-scs (control-stack))
154 ;; Non-Descriptor characters
155 (base-char-reg registers
156 :locations #.non-descriptor-regs
157 :constant-scs (immediate)
159 :alternate-scs (base-char-stack))
161 ;; Non-Descriptor SAP's (arbitrary pointers into address space)
163 :locations #.non-descriptor-regs
164 :constant-scs (immediate)
166 :alternate-scs (sap-stack))
168 ;; Non-Descriptor (signed or unsigned) numbers.
169 (signed-reg registers
170 :locations #.non-descriptor-regs
171 :constant-scs (zero immediate)
173 :alternate-scs (signed-stack))
174 (unsigned-reg registers
175 :locations #.non-descriptor-regs
176 :constant-scs (zero immediate)
178 :alternate-scs (unsigned-stack))
180 ;; Random objects that must not be seen by GC. Used only as temporaries.
181 (non-descriptor-reg registers
182 :locations #.non-descriptor-regs)
184 ;; Pointers to the interior of objects. Used only as an temporary.
185 (interior-reg registers
186 :locations (#.lip-offset))
189 ;; **** Things that can go in the floating point registers.
191 ;; Non-Descriptor single-floats.
192 (single-reg float-registers
193 :locations #.(loop for i from 4 to 31 collect i)
194 :constant-scs (fp-single-zero)
196 :alternate-scs (single-stack))
198 ;; Non-Descriptor double-floats.
199 (double-reg float-registers
200 :locations #.(loop for i from 4 to 31 collect i)
201 :constant-scs (fp-double-zero)
203 :alternate-scs (double-stack))
205 (complex-single-reg float-registers
206 :locations #.(loop for i from 4 to 30 by 2 collect i)
210 :alternate-scs (complex-single-stack))
212 (complex-double-reg float-registers
213 :locations #.(loop for i from 4 to 30 by 2 collect i)
217 :alternate-scs (complex-double-stack))
219 ;; A catch or unwind block.
220 (catch-block control-stack :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 ;; These, we access by foo-TN only
235 (defregtn zero any-reg)
236 (defregtn null descriptor-reg)
237 (defregtn code descriptor-reg)
238 (defregtn alloc any-reg)
239 (defregtn bsp any-reg)
240 (defregtn csp any-reg)
241 (defregtn cfp any-reg)
242 (defregtn nsp any-reg)
244 ;; These alias regular locations, so we have to make sure we don't bypass
245 ;; the register allocator when using them.
246 (defregtn nargs any-reg)
247 (defregtn ocfp any-reg)
248 (defregtn lip interior-reg))
250 ;; And some floating point values.
251 (defparameter fp-single-zero-tn
252 (make-random-tn :kind :normal
253 :sc (sc-or-lose 'single-reg)
255 (defparameter fp-double-zero-tn
256 (make-random-tn :kind :normal
257 :sc (sc-or-lose 'double-reg)
261 ;;; If VALUE can be represented as an immediate constant, then return
262 ;;; the appropriate SC number, otherwise return NIL.
263 (!def-vm-support-routine immediate-constant-sc (value)
266 (sc-number-or-lose 'zero))
268 (sc-number-or-lose 'null))
269 ((or fixnum system-area-pointer character)
270 (sc-number-or-lose 'immediate))
272 (if (static-symbol-p value)
273 (sc-number-or-lose 'immediate)
277 (sc-number-or-lose 'fp-single-zero)
281 (sc-number-or-lose 'fp-double-zero)
285 ;;;; Function Call Parameters
287 ;;; The SC numbers for register and stack arguments/return values.
289 (defconstant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
290 (defconstant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
291 (defconstant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
293 (eval-when (:compile-toplevel :load-toplevel :execute)
295 ;;; Offsets of special stack frame locations
296 (defconstant ocfp-save-offset 0)
297 (defconstant lra-save-offset 1)
298 (defconstant nfp-save-offset 2)
300 ;;; The number of arguments/return values passed in registers.
302 (defconstant register-arg-count 6)
304 ;;; Names to use for the argument registers.
306 (defconstant-eqx register-arg-names '(a0 a1 a2 a3 a4 a5) #'equal)
311 ;;; A list of TN's describing the register arguments.
313 (defparameter register-arg-tns
314 (mapcar #'(lambda (n)
315 (make-random-tn :kind :normal
316 :sc (sc-or-lose 'descriptor-reg)
318 *register-arg-offsets*))
320 ;;; This is used by the debugger.
321 (defconstant single-value-return-byte-offset 4)
323 ;;; This function is called by debug output routines that want a pretty name
324 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
325 (!def-vm-support-routine location-print-name (tn)
326 (declare (type tn tn))
327 (let ((sb (sb-name (sc-sb (tn-sc tn))))
328 (offset (tn-offset tn)))
330 (registers (or (svref *register-names* offset)
331 (format nil "R~D" offset)))
332 (float-registers (format nil "F~D" offset))
333 (control-stack (format nil "CS~D" offset))
334 (non-descriptor-stack (format nil "NS~D" offset))
335 (constant (format nil "Const~D" offset))
336 (immediate-constant "Immed"))))
338 ;;; The loader uses this to convert alien names to the form they
339 ;;; occure in the symbol table (for example, prepending an
340 ;;; underscore). On the HPPA we just leave it alone.
341 (defun extern-alien-name (name)
342 (declare (type simple-base-string name))