1 ;;;; miscellaneous VM definition noise for the Alpha
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from the CMU CL system, which was
7 ;;;; written at Carnegie Mellon University and released into the
8 ;;;; public domain. The software is in the public domain and is
9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
10 ;;;; files for more information.
14 ;;;; defining the registers
16 (eval-when (:compile-toplevel :load-toplevel :execute)
17 (defvar *register-names* (make-array 32 :initial-element nil)))
19 (macrolet ((defreg (name offset)
20 (let ((offset-sym (symbolicate name "-OFFSET")))
21 `(eval-when (:compile-toplevel :load-toplevel :execute)
22 (defconstant ,offset-sym ,offset)
23 (setf (svref *register-names* ,offset-sym)
24 ,(symbol-name name)))))
25 (defregset (name &rest regs)
26 `(eval-when (:compile-toplevel :load-toplevel :execute)
28 (list ,@(mapcar (lambda (name)
29 (symbolicate name "-OFFSET"))
31 ;; c.f. src/runtime/alpha-lispregs.h
68 ;; Assembler temp (at)
70 ;; Global pointer (gp)
77 (defregset non-descriptor-regs
78 nl0 nl1 nl2 nl3 nl4 nl5 nfp cfunc)
80 (defregset descriptor-regs
81 fdefn lexenv nargs ocfp lra a0 a1 a2 a3 a4 a5 l0 l1 l2)
83 (defregset *register-arg-offsets*
85 (defparameter register-arg-names '(a0 a1 a2 a3 a4 a5)))
87 (define-storage-base registers :finite :size 32)
88 (define-storage-base float-registers :finite :size 64)
89 (define-storage-base control-stack :unbounded :size 8)
90 (define-storage-base non-descriptor-stack :unbounded :size 0)
91 (define-storage-base constant :non-packed)
92 (define-storage-base immediate-constant :non-packed)
94 ;;; a handy macro so we don't have to keep changing all the numbers
95 ;;; whenever we insert a new storage class.
97 ;;; FIXME: This macro is not needed in the runtime target.
99 (defmacro define-storage-classes (&rest classes)
100 (do ((forms (list 'progn)
101 (let* ((class (car classes))
102 (sc-name (car class))
103 (constant-name (intern (concatenate 'simple-string
106 (list* `(define-storage-class ,sc-name ,index
108 `(defconstant ,constant-name ,index)
109 ;; (The CMU CL version of this macro did
110 ;; `(EXPORT ',CONSTANT-NAME)
111 ;; here, but in SBCL we try to have package
112 ;; structure described statically in one
113 ;; master source file, instead of building it
114 ;; dynamically by letting all the system code
115 ;; modify it as the system boots.)
118 (classes classes (cdr classes)))
122 ;;; see comment in ../x86/vm.lisp. The value of 7 was taken from
123 ;;; vm:catch-block-size in a cmucl that I happened to have around
124 ;;; and seems to be working so far -dan
125 (defconstant sb!vm::kludge-nondeterministic-catch-block-size 7)
127 (define-storage-classes
129 ;; Non-immediate contstants in the constant pool
132 ;; ZERO and NULL are in registers.
133 (zero immediate-constant)
134 (null immediate-constant)
135 (fp-single-zero immediate-constant)
136 (fp-double-zero immediate-constant)
138 ;; Anything else that can be an immediate.
139 (immediate immediate-constant)
144 ;; The control stack. (Scanned by GC)
145 (control-stack control-stack)
147 ;; The non-descriptor stacks.
148 (signed-stack non-descriptor-stack
149 :element-size 2 :alignment 2) ; (signed-byte 64)
150 (unsigned-stack non-descriptor-stack
151 :element-size 2 :alignment 2) ; (unsigned-byte 64)
152 (base-char-stack non-descriptor-stack) ; non-descriptor characters.
153 (sap-stack non-descriptor-stack
154 :element-size 2 :alignment 2) ; System area pointers.
155 (single-stack non-descriptor-stack) ; single-floats
156 (double-stack non-descriptor-stack
157 :element-size 2 :alignment 2) ; double floats.
158 (complex-single-stack non-descriptor-stack :element-size 2)
159 (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
162 ;; **** Things that can go in the integer registers.
164 ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing
165 ;; bad will happen if they are. (fixnums, characters, header values, etc).
168 :locations #.(append non-descriptor-regs descriptor-regs)
169 ; :locations #.non-descriptor-regs
170 :constant-scs (zero immediate)
172 :alternate-scs (control-stack))
174 ;; Pointer descriptor objects. Must be seen by GC.
175 (descriptor-reg registers
176 :locations #.descriptor-regs
177 :constant-scs (constant null immediate)
179 :alternate-scs (control-stack))
181 ;; Non-Descriptor characters
182 (base-char-reg registers
183 :locations #.non-descriptor-regs
184 :constant-scs (immediate)
186 :alternate-scs (base-char-stack))
188 ;; Non-Descriptor SAP's (arbitrary pointers into address space)
190 :locations #.non-descriptor-regs
191 :constant-scs (immediate)
193 :alternate-scs (sap-stack))
195 ;; Non-Descriptor (signed or unsigned) numbers.
196 (signed-reg registers
197 :locations #.non-descriptor-regs
198 :constant-scs (zero immediate)
200 :alternate-scs (signed-stack))
201 (unsigned-reg registers
202 :locations #.non-descriptor-regs
203 :constant-scs (zero immediate)
205 :alternate-scs (unsigned-stack))
207 ;; Random objects that must not be seen by GC. Used only as temporaries.
208 (non-descriptor-reg registers
209 :locations #.non-descriptor-regs)
211 ;; Pointers to the interior of objects. Used only as an temporary.
212 (interior-reg registers
213 :locations (#.lip-offset))
216 ;; **** Things that can go in the floating point registers.
218 ;; Non-Descriptor single-floats.
219 (single-reg float-registers
220 :locations #.(loop for i from 4 to 30 collect i)
221 :constant-scs (fp-single-zero)
223 :alternate-scs (single-stack))
225 ;; Non-Descriptor double-floats.
226 (double-reg float-registers
227 :locations #.(loop for i from 4 to 30 collect i)
228 :constant-scs (fp-double-zero)
230 :alternate-scs (double-stack))
232 (complex-single-reg float-registers
233 :locations #.(loop for i from 4 to 28 by 2 collect i)
237 :alternate-scs (complex-single-stack))
239 (complex-double-reg float-registers
240 :locations #.(loop for i from 4 to 28 by 2 collect i)
244 :alternate-scs (complex-double-stack))
246 ;; A catch or unwind block.
247 (catch-block control-stack
248 :element-size sb!vm::kludge-nondeterministic-catch-block-size))
250 ;;; Make some random tns for important registers.
251 (macrolet ((defregtn (name sc)
252 (let ((offset-sym (symbolicate name "-OFFSET"))
253 (tn-sym (symbolicate name "-TN")))
254 `(defparameter ,tn-sym
255 (make-random-tn :kind :normal
256 :sc (sc-or-lose ',sc)
257 :offset ,offset-sym)))))
259 ;; These, we access by foo-TN only
261 (defregtn zero any-reg)
262 (defregtn null descriptor-reg)
263 (defregtn code descriptor-reg)
264 (defregtn alloc any-reg)
265 (defregtn bsp any-reg)
266 (defregtn csp any-reg)
267 (defregtn cfp any-reg)
268 (defregtn nsp any-reg)
270 ;; These alias regular locations, so we have to make sure we don't bypass
271 ;; the register allocator when using them.
272 (defregtn nargs any-reg)
273 (defregtn ocfp any-reg)
274 (defregtn lip interior-reg))
276 ;; and some floating point values..
277 (defparameter fp-single-zero-tn
278 (make-random-tn :kind :normal
279 :sc (sc-or-lose 'single-reg)
281 (defparameter fp-double-zero-tn
282 (make-random-tn :kind :normal
283 :sc (sc-or-lose 'double-reg)
286 ;;; If value can be represented as an immediate constant, then return
287 ;;; the appropriate SC number, otherwise return NIL.
288 (!def-vm-support-routine immediate-constant-sc (value)
291 (sc-number-or-lose 'zero))
293 (sc-number-or-lose 'null ))
294 ((or fixnum system-area-pointer character)
295 (sc-number-or-lose 'immediate ))
297 (if (static-symbol-p value)
298 (sc-number-or-lose 'immediate )
302 (sc-number-or-lose 'fp-single-zero )
306 (sc-number-or-lose 'fp-double-zero )
309 ;;;; function call parameters
311 ;;; the SC numbers for register and stack arguments/return values
312 (defconstant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
313 (defconstant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
314 (defconstant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
316 (eval-when (:compile-toplevel :load-toplevel :execute)
318 ;;; offsets of special stack frame locations
319 (defconstant ocfp-save-offset 0)
320 (defconstant lra-save-offset 1)
321 (defconstant nfp-save-offset 2)
323 ;;; the number of arguments/return values passed in registers
324 (defconstant register-arg-count 6)
326 ;;; (Names to use for the argument registers would go here, but there
331 ;;; a list of TN's describing the register arguments
332 (defparameter *register-arg-tns*
334 (make-random-tn :kind :normal
335 :sc (sc-or-lose 'descriptor-reg)
337 *register-arg-offsets*))
339 ;;; This is used by the debugger.
340 (defconstant single-value-return-byte-offset 4)
342 ;;; This function is called by debug output routines that want a
343 ;;; pretty name for a TN's location. It returns a thing that can be
344 ;;; printed with PRINC.
345 (!def-vm-support-routine location-print-name (tn)
346 ; (declare (type tn tn))
347 (let ((sb (sb-name (sc-sb (tn-sc tn))))
348 (offset (tn-offset tn)))
350 (registers (or (svref *register-names* offset)
351 (format nil "R~D" offset)))
352 (float-registers (format nil "F~D" offset))
353 (control-stack (format nil "CS~D" offset))
354 (non-descriptor-stack (format nil "NS~D" offset))
355 (constant (format nil "Const~D" offset))
356 (immediate-constant "Immed"))))