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) ,(symbol-name name)))))
24 (defregset (name &rest regs)
25 `(eval-when (:compile-toplevel :load-toplevel :execute)
27 (list ,@(mapcar #'(lambda (name)
28 (symbolicate name "-OFFSET"))
30 ;; c.f. src/runtime/alpha-lispregs.h
67 ;; Assembler temp (at)
69 ;; Global pointer (gp)
76 (defregset non-descriptor-regs
77 nl0 nl1 nl2 nl3 nl4 nl5 nfp cfunc)
79 (defregset descriptor-regs
80 fdefn lexenv nargs ocfp lra a0 a1 a2 a3 a4 a5 l0 l1 l2)
82 (defregset *register-arg-offsets*
84 (defparameter register-arg-names '(a0 a1 a2 a3 a4 a5)))
86 (define-storage-base registers :finite :size 32)
87 (define-storage-base float-registers :finite :size 64)
88 (define-storage-base control-stack :unbounded :size 8)
89 (define-storage-base non-descriptor-stack :unbounded :size 0)
90 (define-storage-base constant :non-packed)
91 (define-storage-base immediate-constant :non-packed)
93 ;;; a handy macro so we don't have to keep changing all the numbers
94 ;;; whenever we insert a new storage class.
96 ;;; FIXME: This macro is not needed in the runtime target.
98 (defmacro define-storage-classes (&rest classes)
99 (do ((forms (list 'progn)
100 (let* ((class (car classes))
101 (sc-name (car class))
102 (constant-name (intern (concatenate 'simple-string
105 (list* `(define-storage-class ,sc-name ,index
107 `(defconstant ,constant-name ,index)
108 ;; (The CMU CL version of this macro did
109 ;; `(EXPORT ',CONSTANT-NAME)
110 ;; here, but in SBCL we try to have package
111 ;; structure described statically in one
112 ;; master source file, instead of building it
113 ;; dynamically by letting all the system code
114 ;; modify it as the system boots.)
117 (classes classes (cdr classes)))
121 ;;; see comment in ../x86/vm.lisp. The value of 7 was taken from
122 ;;; vm:catch-block-size in a cmucl that I happened to have around
123 ;;; and seems to be working so far -dan
124 (defconstant sb!vm::kludge-nondeterministic-catch-block-size 7)
126 (define-storage-classes
128 ;; Non-immediate contstants in the constant pool
131 ;; ZERO and NULL are in registers.
132 (zero immediate-constant)
133 (null immediate-constant)
134 (fp-single-zero immediate-constant)
135 (fp-double-zero immediate-constant)
137 ;; Anything else that can be an immediate.
138 (immediate immediate-constant)
143 ;; The control stack. (Scanned by GC)
144 (control-stack control-stack)
146 ;; The non-descriptor stacks.
147 (signed-stack non-descriptor-stack
148 :element-size 2 :alignment 2) ; (signed-byte 64)
149 (unsigned-stack non-descriptor-stack
150 :element-size 2 :alignment 2) ; (unsigned-byte 64)
151 (base-char-stack non-descriptor-stack) ; non-descriptor characters.
152 (sap-stack non-descriptor-stack
153 :element-size 2 :alignment 2) ; System area pointers.
154 (single-stack non-descriptor-stack) ; single-floats
155 (double-stack non-descriptor-stack
156 :element-size 2 :alignment 2) ; double floats.
157 (complex-single-stack non-descriptor-stack :element-size 2)
158 (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
161 ;; **** Things that can go in the integer registers.
163 ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing
164 ;; bad will happen if they are. (fixnums, characters, header values, etc).
167 :locations #.(append non-descriptor-regs descriptor-regs)
168 ; :locations #.non-descriptor-regs
169 :constant-scs (zero immediate)
171 :alternate-scs (control-stack))
173 ;; Pointer descriptor objects. Must be seen by GC.
174 (descriptor-reg registers
175 :locations #.descriptor-regs
176 :constant-scs (constant null immediate)
178 :alternate-scs (control-stack))
180 ;; Non-Descriptor characters
181 (base-char-reg registers
182 :locations #.non-descriptor-regs
183 :constant-scs (immediate)
185 :alternate-scs (base-char-stack))
187 ;; Non-Descriptor SAP's (arbitrary pointers into address space)
189 :locations #.non-descriptor-regs
190 :constant-scs (immediate)
192 :alternate-scs (sap-stack))
194 ;; Non-Descriptor (signed or unsigned) numbers.
195 (signed-reg registers
196 :locations #.non-descriptor-regs
197 :constant-scs (zero immediate)
199 :alternate-scs (signed-stack))
200 (unsigned-reg registers
201 :locations #.non-descriptor-regs
202 :constant-scs (zero immediate)
204 :alternate-scs (unsigned-stack))
206 ;; Random objects that must not be seen by GC. Used only as temporaries.
207 (non-descriptor-reg registers
208 :locations #.non-descriptor-regs)
210 ;; Pointers to the interior of objects. Used only as an temporary.
211 (interior-reg registers
212 :locations (#.lip-offset))
215 ;; **** Things that can go in the floating point registers.
217 ;; Non-Descriptor single-floats.
218 (single-reg float-registers
219 :locations #.(loop for i from 4 to 30 collect i)
220 :constant-scs (fp-single-zero)
222 :alternate-scs (single-stack))
224 ;; Non-Descriptor double-floats.
225 (double-reg float-registers
226 :locations #.(loop for i from 4 to 30 collect i)
227 :constant-scs (fp-double-zero)
229 :alternate-scs (double-stack))
231 (complex-single-reg float-registers
232 :locations #.(loop for i from 4 to 28 by 2 collect i)
236 :alternate-scs (complex-single-stack))
238 (complex-double-reg float-registers
239 :locations #.(loop for i from 4 to 28 by 2 collect i)
243 :alternate-scs (complex-double-stack))
245 ;; A catch or unwind block.
246 (catch-block control-stack
247 :element-size sb!vm::kludge-nondeterministic-catch-block-size))
249 ;;; Make some random tns for important registers.
250 (macrolet ((defregtn (name sc)
251 (let ((offset-sym (symbolicate name "-OFFSET"))
252 (tn-sym (symbolicate name "-TN")))
253 `(defparameter ,tn-sym
254 (make-random-tn :kind :normal
255 :sc (sc-or-lose ',sc)
256 :offset ,offset-sym)))))
258 ;; These, we access by foo-TN only
260 (defregtn zero any-reg)
261 (defregtn null descriptor-reg)
262 (defregtn code descriptor-reg)
263 (defregtn alloc any-reg)
264 (defregtn bsp any-reg)
265 (defregtn csp any-reg)
266 (defregtn cfp any-reg)
267 (defregtn nsp any-reg)
269 ;; These alias regular locations, so we have to make sure we don't bypass
270 ;; the register allocator when using them.
271 (defregtn nargs any-reg)
272 (defregtn ocfp any-reg)
273 (defregtn lip interior-reg))
275 ;; and some floating point values..
276 (defparameter fp-single-zero-tn
277 (make-random-tn :kind :normal
278 :sc (sc-or-lose 'single-reg)
280 (defparameter fp-double-zero-tn
281 (make-random-tn :kind :normal
282 :sc (sc-or-lose 'double-reg)
285 ;;; If value can be represented as an immediate constant, then return
286 ;;; the appropriate SC number, otherwise return NIL.
287 (!def-vm-support-routine immediate-constant-sc (value)
290 (sc-number-or-lose 'zero))
292 (sc-number-or-lose 'null ))
293 ((or fixnum system-area-pointer character)
294 (sc-number-or-lose 'immediate ))
296 (if (static-symbol-p value)
297 (sc-number-or-lose 'immediate )
301 (sc-number-or-lose 'fp-single-zero )
305 (sc-number-or-lose 'fp-double-zero )
308 ;;;; function call parameters
310 ;;; the SC numbers for register and stack arguments/return values
311 (defconstant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
312 (defconstant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
313 (defconstant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
315 (eval-when (:compile-toplevel :load-toplevel :execute)
317 ;;; offsets of special stack frame locations
318 (defconstant ocfp-save-offset 0)
319 (defconstant lra-save-offset 1)
320 (defconstant nfp-save-offset 2)
322 ;;; the number of arguments/return values passed in registers
323 (defconstant register-arg-count 6)
325 ;;; (Names to use for the argument registers would go here, but there
330 ;;; a list of TN's describing the register arguments
331 (defparameter *register-arg-tns*
332 (mapcar #'(lambda (n)
333 (make-random-tn :kind :normal
334 :sc (sc-or-lose 'descriptor-reg)
336 *register-arg-offsets*))
338 ;;; This is used by the debugger.
339 (defconstant single-value-return-byte-offset 4)
341 ;;; This function is called by debug output routines that want a
342 ;;; pretty name for a TN's location. It returns a thing that can be
343 ;;; printed with PRINC.
344 (!def-vm-support-routine location-print-name (tn)
345 ; (declare (type tn tn))
346 (let ((sb (sb-name (sc-sb (tn-sc tn))))
347 (offset (tn-offset tn)))
349 (registers (or (svref *register-names* offset)
350 (format nil "R~D" offset)))
351 (float-registers (format nil "F~D" offset))
352 (control-stack (format nil "CS~D" offset))
353 (non-descriptor-stack (format nil "NS~D" offset))
354 (constant (format nil "Const~D" offset))
355 (immediate-constant "Immed"))))