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 (def!constant ,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 (defmacro !define-storage-classes (&rest classes)
98 (do ((forms (list 'progn)
99 (let* ((class (car classes))
100 (sc-name (car class))
101 (constant-name (intern (concatenate 'simple-string
104 (list* `(define-storage-class ,sc-name ,index
106 `(def!constant ,constant-name ,index)
107 ;; (The CMU CL version of this macro did
108 ;; `(EXPORT ',CONSTANT-NAME)
109 ;; here, but in SBCL we try to have package
110 ;; structure described statically in one
111 ;; master source file, instead of building it
112 ;; dynamically by letting all the system code
113 ;; modify it as the system boots.)
116 (classes classes (cdr classes)))
120 ;;; see comment in ../x86/vm.lisp. The value of 7 was taken from
121 ;;; vm:catch-block-size in a cmucl that I happened to have around
122 ;;; and seems to be working so far -dan
123 (def!constant sb!vm::kludge-nondeterministic-catch-block-size 7)
125 (!define-storage-classes
127 ;; non-immediate constants in the constant pool
130 ;; ZERO and NULL are in registers.
131 (zero immediate-constant)
132 (null immediate-constant)
133 (fp-single-zero immediate-constant)
134 (fp-double-zero immediate-constant)
136 ;; Anything else that can be an immediate.
137 (immediate immediate-constant)
142 ;; The control stack. (Scanned by GC)
143 (control-stack control-stack)
145 ;; The non-descriptor stacks.
146 (signed-stack non-descriptor-stack
147 :element-size 2 :alignment 2) ; (signed-byte 64)
148 (unsigned-stack non-descriptor-stack
149 :element-size 2 :alignment 2) ; (unsigned-byte 64)
150 (base-char-stack non-descriptor-stack) ; non-descriptor characters.
151 (sap-stack non-descriptor-stack
152 :element-size 2 :alignment 2) ; System area pointers.
153 (single-stack non-descriptor-stack) ; single-floats
154 (double-stack non-descriptor-stack
155 :element-size 2 :alignment 2) ; double floats.
156 (complex-single-stack non-descriptor-stack :element-size 2)
157 (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
160 ;; **** Things that can go in the integer registers.
162 ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing
163 ;; bad will happen if they are. (fixnums, characters, header values, etc).
166 :locations #.(append non-descriptor-regs descriptor-regs)
167 ; :locations #.non-descriptor-regs
168 :constant-scs (zero immediate)
170 :alternate-scs (control-stack))
172 ;; Pointer descriptor objects. Must be seen by GC.
173 (descriptor-reg registers
174 :locations #.descriptor-regs
175 :constant-scs (constant null immediate)
177 :alternate-scs (control-stack))
179 ;; Non-Descriptor characters
180 (base-char-reg registers
181 :locations #.non-descriptor-regs
182 :constant-scs (immediate)
184 :alternate-scs (base-char-stack))
186 ;; Non-Descriptor SAP's (arbitrary pointers into address space)
188 :locations #.non-descriptor-regs
189 :constant-scs (immediate)
191 :alternate-scs (sap-stack))
193 ;; Non-Descriptor (signed or unsigned) numbers.
194 (signed-reg registers
195 :locations #.non-descriptor-regs
196 :constant-scs (zero immediate)
198 :alternate-scs (signed-stack))
199 (unsigned-reg registers
200 :locations #.non-descriptor-regs
201 :constant-scs (zero immediate)
203 :alternate-scs (unsigned-stack))
205 ;; Random objects that must not be seen by GC. Used only as temporaries.
206 (non-descriptor-reg registers
207 :locations #.non-descriptor-regs)
209 ;; Pointers to the interior of objects. Used only as an temporary.
210 (interior-reg registers
211 :locations (#.lip-offset))
214 ;; **** Things that can go in the floating point registers.
216 ;; Non-Descriptor single-floats.
217 (single-reg float-registers
218 :locations #.(loop for i from 4 to 30 collect i)
219 :constant-scs (fp-single-zero)
221 :alternate-scs (single-stack))
223 ;; Non-Descriptor double-floats.
224 (double-reg float-registers
225 :locations #.(loop for i from 4 to 30 collect i)
226 :constant-scs (fp-double-zero)
228 :alternate-scs (double-stack))
230 (complex-single-reg float-registers
231 :locations #.(loop for i from 4 to 28 by 2 collect i)
235 :alternate-scs (complex-single-stack))
237 (complex-double-reg float-registers
238 :locations #.(loop for i from 4 to 28 by 2 collect i)
242 :alternate-scs (complex-double-stack))
244 ;; A catch or unwind block.
245 (catch-block control-stack
246 :element-size sb!vm::kludge-nondeterministic-catch-block-size))
248 ;;; Make some random tns for important registers.
249 (macrolet ((defregtn (name sc)
250 (let ((offset-sym (symbolicate name "-OFFSET"))
251 (tn-sym (symbolicate name "-TN")))
252 `(defparameter ,tn-sym
253 (make-random-tn :kind :normal
254 :sc (sc-or-lose ',sc)
255 :offset ,offset-sym)))))
257 ;; These, we access by foo-TN only
259 (defregtn zero any-reg)
260 (defregtn null descriptor-reg)
261 (defregtn code descriptor-reg)
262 (defregtn alloc any-reg)
263 (defregtn bsp any-reg)
264 (defregtn csp any-reg)
265 (defregtn cfp any-reg)
266 (defregtn nsp any-reg)
268 ;; These alias regular locations, so we have to make sure we don't bypass
269 ;; the register allocator when using them.
270 (defregtn nargs any-reg)
271 (defregtn ocfp any-reg)
272 (defregtn lip interior-reg))
274 ;; and some floating point values..
275 (defparameter fp-single-zero-tn
276 (make-random-tn :kind :normal
277 :sc (sc-or-lose 'single-reg)
279 (defparameter fp-double-zero-tn
280 (make-random-tn :kind :normal
281 :sc (sc-or-lose 'double-reg)
284 ;;; If value can be represented as an immediate constant, then return
285 ;;; the appropriate SC number, otherwise return NIL.
286 (!def-vm-support-routine immediate-constant-sc (value)
289 (sc-number-or-lose 'zero))
291 (sc-number-or-lose 'null ))
292 ((or fixnum system-area-pointer character)
293 (sc-number-or-lose 'immediate ))
295 (if (static-symbol-p value)
296 (sc-number-or-lose 'immediate )
300 (sc-number-or-lose 'fp-single-zero )
304 (sc-number-or-lose 'fp-double-zero )
307 ;;;; function call parameters
309 ;;; the SC numbers for register and stack arguments/return values
310 (def!constant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
311 (def!constant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
312 (def!constant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
314 (eval-when (:compile-toplevel :load-toplevel :execute)
316 ;;; offsets of special stack frame locations
317 (def!constant ocfp-save-offset 0)
318 (def!constant lra-save-offset 1)
319 (def!constant nfp-save-offset 2)
321 ;;; the number of arguments/return values passed in registers
322 (def!constant register-arg-count 6)
324 ;;; (Names to use for the argument registers would go here, but there
329 ;;; a list of TN's describing the register arguments
330 (defparameter *register-arg-tns*
332 (make-random-tn :kind :normal
333 :sc (sc-or-lose 'descriptor-reg)
335 *register-arg-offsets*))
337 ;;; This is used by the debugger.
338 (def!constant single-value-return-byte-offset 4)
340 ;;; This function is called by debug output routines that want a
341 ;;; pretty name for a TN's location. It returns a thing that can be
342 ;;; printed with PRINC.
343 (!def-vm-support-routine location-print-name (tn)
344 ; (declare (type tn tn))
345 (let ((sb (sb-name (sc-sb (tn-sc tn))))
346 (offset (tn-offset tn)))
348 (registers (or (svref *register-names* offset)
349 (format nil "R~D" offset)))
350 (float-registers (format nil "F~D" offset))
351 (control-stack (format nil "CS~D" offset))
352 (non-descriptor-stack (format nil "NS~D" offset))
353 (constant (format nil "Const~D" offset))
354 (immediate-constant "Immed"))))
356 ;;; The loader uses this to convert alien names to the form they
357 ;;; occure in the symbol table (for example, prepending an
359 (defun extern-alien-name (name)
360 (declare (type simple-base-string name))
361 ;; On the Alpha we don't do anything.