1 ;;;; miscellaneous VM definition noise for the x86
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.
16 ;;;; Define the registers
18 (eval-when (:compile-toplevel :load-toplevel :execute)
19 (defvar *register-names* (make-array 32 :initial-element nil)))
21 (macrolet ((defreg (name offset)
22 (let ((offset-sym (symbolicate name "-OFFSET")))
23 `(eval-when (:compile-toplevel :load-toplevel :execute)
24 (defconstant ,offset-sym ,offset)
25 (setf (svref *register-names* ,offset-sym) ,(symbol-name name)))))
26 (defregset (name &rest regs)
27 `(eval-when (:compile-toplevel :load-toplevel :execute)
29 (list ,@(mapcar #'(lambda (name)
30 (symbolicate name "-OFFSET"))
32 ;; c.f. src/runtime/alpha-lispregs.h
69 ;; Assembler temp (at)
71 ;; Global pointer (gp)
78 (defregset non-descriptor-regs
79 nl0 nl1 nl2 nl3 nl4 nl5 nfp cfunc)
81 (defregset descriptor-regs
82 fdefn lexenv nargs ocfp lra a0 a1 a2 a3 a4 a5 l0 l1 l2)
84 (defregset *register-arg-offsets*
86 (defparameter register-arg-names '(a0 a1 a2 a3 a4 a5)))
88 (define-storage-base registers :finite :size 32)
89 (define-storage-base float-registers :finite :size 64)
90 (define-storage-base control-stack :unbounded :size 8)
91 (define-storage-base non-descriptor-stack :unbounded :size 0)
92 (define-storage-base constant :non-packed)
93 (define-storage-base immediate-constant :non-packed)
96 ;;; Handy macro so we don't have to keep changing all the numbers whenever
97 ;;; we insert a new storage class.
98 ;;; FIXME: This macro is not needed in the runtime target.
100 (defmacro define-storage-classes (&rest classes)
101 (do ((forms (list 'progn)
102 (let* ((class (car classes))
103 (sc-name (car class))
104 (constant-name (intern (concatenate 'simple-string
107 (list* `(define-storage-class ,sc-name ,index
109 `(defconstant ,constant-name ,index)
110 `(export ',constant-name)
113 (classes classes (cdr classes)))
117 ;;; see comment in ../x86/vm.lisp. The value of 7 was taken from
118 ;;; vm:catch-block-size in a cmucl that I happened to have around
119 ;;; and seems to be working so far -dan
120 (defconstant sb!vm::kludge-nondeterministic-catch-block-size 7)
123 (define-storage-classes
125 ;; Non-immediate contstants in the constant pool
128 ;; ZERO and NULL are in registers.
129 (zero immediate-constant)
130 (null immediate-constant)
131 (fp-single-zero immediate-constant)
132 (fp-double-zero immediate-constant)
134 ;; Anything else that can be an immediate.
135 (immediate immediate-constant)
140 ;; The control stack. (Scanned by GC)
141 (control-stack control-stack)
143 ;; The non-descriptor stacks.
144 (signed-stack non-descriptor-stack
145 :element-size 2 :alignment 2) ; (signed-byte 64)
146 (unsigned-stack non-descriptor-stack
147 :element-size 2 :alignment 2) ; (unsigned-byte 64)
148 (base-char-stack non-descriptor-stack) ; non-descriptor characters.
149 (sap-stack non-descriptor-stack
150 :element-size 2 :alignment 2) ; System area pointers.
151 (single-stack non-descriptor-stack) ; single-floats
152 (double-stack non-descriptor-stack
153 :element-size 2 :alignment 2) ; double floats.
154 (complex-single-stack non-descriptor-stack :element-size 2)
155 (complex-double-stack non-descriptor-stack :element-size 4 :alignment 2)
158 ;; **** Things that can go in the integer registers.
160 ;; Immediate descriptor objects. Don't have to be seen by GC, but nothing
161 ;; bad will happen if they are. (fixnums, characters, header values, etc).
164 :locations #.(append non-descriptor-regs descriptor-regs)
165 ; :locations #.non-descriptor-regs
166 :constant-scs (zero immediate)
168 :alternate-scs (control-stack))
170 ;; Pointer descriptor objects. Must be seen by GC.
171 (descriptor-reg registers
172 :locations #.descriptor-regs
173 :constant-scs (constant null immediate)
175 :alternate-scs (control-stack))
177 ;; Non-Descriptor characters
178 (base-char-reg registers
179 :locations #.non-descriptor-regs
180 :constant-scs (immediate)
182 :alternate-scs (base-char-stack))
184 ;; Non-Descriptor SAP's (arbitrary pointers into address space)
186 :locations #.non-descriptor-regs
187 :constant-scs (immediate)
189 :alternate-scs (sap-stack))
191 ;; Non-Descriptor (signed or unsigned) numbers.
192 (signed-reg registers
193 :locations #.non-descriptor-regs
194 :constant-scs (zero immediate)
196 :alternate-scs (signed-stack))
197 (unsigned-reg registers
198 :locations #.non-descriptor-regs
199 :constant-scs (zero immediate)
201 :alternate-scs (unsigned-stack))
203 ;; Random objects that must not be seen by GC. Used only as temporaries.
204 (non-descriptor-reg registers
205 :locations #.non-descriptor-regs)
207 ;; Pointers to the interior of objects. Used only as an temporary.
208 (interior-reg registers
209 :locations (#.lip-offset))
212 ;; **** Things that can go in the floating point registers.
214 ;; Non-Descriptor single-floats.
215 (single-reg float-registers
216 :locations #.(loop for i from 4 to 30 collect i)
217 :constant-scs (fp-single-zero)
219 :alternate-scs (single-stack))
221 ;; Non-Descriptor double-floats.
222 (double-reg float-registers
223 :locations #.(loop for i from 4 to 30 collect i)
224 :constant-scs (fp-double-zero)
226 :alternate-scs (double-stack))
228 (complex-single-reg float-registers
229 :locations #.(loop for i from 4 to 28 by 2 collect i)
233 :alternate-scs (complex-single-stack))
235 (complex-double-reg float-registers
236 :locations #.(loop for i from 4 to 28 by 2 collect i)
240 :alternate-scs (complex-double-stack))
242 ;; A catch or unwind block.
243 (catch-block control-stack
244 :element-size sb!vm::kludge-nondeterministic-catch-block-size))
247 ;;;; 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)
285 ;;; Immediate-Constant-SC -- Interface
287 ;;; If value can be represented as an immediate constant, then return the
288 ;;; appropriate SC number, otherwise return NIL.
290 (!def-vm-support-routine immediate-constant-sc (value)
293 (sc-number-or-lose 'zero))
295 (sc-number-or-lose 'null ))
296 ((or fixnum system-area-pointer character)
297 (sc-number-or-lose 'immediate ))
299 (if (static-symbol-p value)
300 (sc-number-or-lose 'immediate )
304 (sc-number-or-lose 'fp-single-zero )
308 (sc-number-or-lose 'fp-double-zero )
311 ;;;; Function Call Parameters
313 ;;; The SC numbers for register and stack arguments/return values.
315 (defconstant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg))
316 (defconstant immediate-arg-scn (meta-sc-number-or-lose 'any-reg))
317 (defconstant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack))
319 (eval-when (:compile-toplevel :load-toplevel :execute)
321 ;;; Offsets of special stack frame locations
322 (defconstant ocfp-save-offset 0)
323 (defconstant lra-save-offset 1)
324 (defconstant nfp-save-offset 2)
326 ;;; The number of arguments/return values passed in registers.
328 (defconstant register-arg-count 6)
330 ;;; Names to use for the argument registers.
334 ); Eval-When (Compile Load Eval)
337 ;;; A list of TN's describing the register arguments.
339 (defparameter *register-arg-tns*
340 (mapcar #'(lambda (n)
341 (make-random-tn :kind :normal
342 :sc (sc-or-lose 'descriptor-reg)
344 *register-arg-offsets*))
346 ;;; SINGLE-VALUE-RETURN-BYTE-OFFSET
348 ;;; This is used by the debugger.
350 (export 'single-value-return-byte-offset)
351 (defconstant single-value-return-byte-offset 4)
354 ;;; LOCATION-PRINT-NAME -- Interface
356 ;;; This function is called by debug output routines that want a pretty name
357 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
359 (!def-vm-support-routine location-print-name (tn)
360 ; (declare (type tn tn))
361 (let ((sb (sb-name (sc-sb (tn-sc tn))))
362 (offset (tn-offset tn)))
364 (registers (or (svref *register-names* offset)
365 (format nil "R~D" offset)))
366 (float-registers (format nil "F~D" offset))
367 (control-stack (format nil "CS~D" offset))
368 (non-descriptor-stack (format nil "NS~D" offset))
369 (constant (format nil "Const~D" offset))
370 (immediate-constant "Immed"))))