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.
14 ;;; the size of an INTEGER representation of a SYSTEM-AREA-POINTER, i.e.
15 ;;; size of a native memory address
16 (deftype sap-int-type () '(unsigned-byte 32))
17 ;;; FIXME: This should just named be SAP-INT, not SAP-INT-TYPE. And
18 ;;; grep for SAPINT in the code and replace it with SAP-INT as
23 (macrolet ((defreg (name offset size)
24 (let ((offset-sym (symbolicate name "-OFFSET"))
25 (names-vector (symbolicate "*" size "-REGISTER-NAMES*")))
27 (eval-when (:compile-toplevel :execute :load-toplevel)
28 (defconstant ,offset-sym ,offset))
29 (setf (svref ,names-vector ,offset-sym)
30 ,(symbol-name name)))))
31 ;; FIXME: It looks to me as though DEFREGSET should also define the
32 ;; *FOO-REGISTER-NAMES* variable.
33 (defregset (name &rest regs)
34 `(eval-when (:compile-toplevel :execute :load-toplevel)
36 (list ,@(mapcar (lambda (name)
37 (symbolicate name "-OFFSET"))
42 ;; Note: the encoding here is different then that used by the chip. We
43 ;; use this encoding so that the compiler thinks that AX (and EAX) overlap
44 ;; AL and AH instead of AL and CL.
45 (eval-when (:compile-toplevel :load-toplevel :execute)
46 (defvar *byte-register-names* (make-array 8 :initial-element nil)))
55 (defregset byte-regs al ah cl ch dl dh bl bh)
58 (eval-when (:compile-toplevel :load-toplevel :execute)
59 (defvar *word-register-names* (make-array 16 :initial-element nil)))
68 (defregset word-regs ax cx dx bx si di)
70 ;; double word registers
71 (eval-when (:compile-toplevel :load-toplevel :execute)
72 (defvar *dword-register-names* (make-array 16 :initial-element nil)))
78 (defreg ebp 10 :dword)
79 (defreg esi 12 :dword)
80 (defreg edi 14 :dword)
81 (defregset dword-regs eax ecx edx ebx esi edi)
83 ;; floating point registers
84 (eval-when (:compile-toplevel :load-toplevel :execute)
85 (defvar *float-register-names* (make-array 8 :initial-element nil)))
94 (defregset float-regs fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7)
96 ;; registers used to pass arguments
98 ;; the number of arguments/return values passed in registers
99 (defconstant register-arg-count 3)
100 ;; names and offsets for registers used to pass arguments
101 (defconstant register-arg-names '(edx edi esi))
102 (defregset register-arg-offsets edx edi esi))
106 ;;; Despite the fact that there are only 8 different registers, we consider
107 ;;; them 16 in order to describe the overlap of byte registers. The only
108 ;;; thing we need to represent is what registers overlap. Therefore, we
109 ;;; consider bytes to take one unit, and words or dwords to take two. We
110 ;;; don't need to tell the difference between words and dwords, because
111 ;;; you can't put two words in a dword register.
112 (define-storage-base registers :finite :size 16)
114 ;;; jrd changed this from size 1 to size 8. It doesn't seem to make much
115 ;;; sense to use the 387's idea of a stack; 8 separate registers is easier
118 ;;; (define-storage-base float-registers :finite :size 1)
120 (define-storage-base float-registers :finite :size 8)
122 (define-storage-base stack :unbounded :size 8)
123 (define-storage-base constant :non-packed)
124 (define-storage-base immediate-constant :non-packed)
125 (define-storage-base noise :unbounded :size 2)
129 ;;; a handy macro so we don't have to keep changing all the numbers whenever
130 ;;; we insert a new storage class
132 ;;; FIXME: This macro is not needed in the runtime target.
133 (defmacro define-storage-classes (&rest classes)
136 (dolist (class classes)
137 (let* ((sc-name (car class))
138 (constant-name (symbolicate sc-name "-SC-NUMBER")))
139 (forms `(define-storage-class ,sc-name ,index
141 (forms `(defconstant ,constant-name ,index))
142 (forms `(let ((sb!int::*rogue-export* "DEFINE-STORAGE-CLASSES"))
143 (export ',constant-name)))
148 ;;; The DEFINE-STORAGE-CLASS call for CATCH-BLOCK refers to the size of
149 ;;; CATCH-BLOCK. The size of CATCH-BLOCK isn't calculated until later in
150 ;;; the build process, and the calculation is entangled with code which has
151 ;;; lots of predependencies, including dependencies on the prior call of
152 ;;; DEFINE-STORAGE-CLASS. The proper way to unscramble this would be to
153 ;;; untangle the code, so that the code which calculates the size of
154 ;;; CATCH-BLOCK can be separated from the other lots-of-dependencies code, so
155 ;;; that the code which calculates the size of CATCH-BLOCK can be executed
156 ;;; early, so that this value is known properly at this point in compilation.
157 ;;; However, that would be a lot of editing of code that I (WHN 19990131) can't
158 ;;; test until the project is complete. So instead, I set the correct value by
159 ;;; hand here (a sort of nondeterministic guess of the right answer:-) and add
160 ;;; an assertion later, after the value is calculated, that the original guess
163 ;;; (What a KLUDGE! Anyone who wants to come in and clean up this mess has my
164 ;;; gratitude.) (FIXME: Maybe this should be me..)
165 (defconstant sb!vm::kludge-nondeterministic-catch-block-size 6)
167 (define-storage-classes
169 ;; non-immediate contstants in the constant pool
172 ;; some FP constants can be generated in the i387 silicon
173 (fp-constant immediate-constant)
175 (immediate immediate-constant)
182 (control-stack stack) ; may be pointers, scanned by GC
184 ;; the non-descriptor stacks
185 (signed-stack stack) ; (signed-byte 32)
186 (unsigned-stack stack) ; (unsigned-byte 32)
187 (base-char-stack stack) ; non-descriptor characters.
188 (sap-stack stack) ; System area pointers.
189 (single-stack stack) ; single-floats
190 (double-stack stack :element-size 2) ; double-floats.
192 (long-stack stack :element-size 3) ; long-floats.
193 (complex-single-stack stack :element-size 2) ; complex-single-floats
194 (complex-double-stack stack :element-size 4) ; complex-double-floats
196 (complex-long-stack stack :element-size 6) ; complex-long-floats
205 ;; things that can go in the integer registers
208 ;; On the X86, we don't have to distinguish between descriptor and
209 ;; non-descriptor registers, because of the conservative GC.
210 ;; Therefore, we use different scs only to distinguish between
211 ;; descriptor and non-descriptor values and to specify size.
213 ;; immediate descriptor objects. Don't have to be seen by GC, but nothing
214 ;; bad will happen if they are. (fixnums, characters, header values, etc).
216 :locations #.dword-regs
218 ; :reserve-locations (#.eax-offset)
219 :constant-scs (immediate)
221 :alternate-scs (control-stack))
223 ;; pointer descriptor objects -- must be seen by GC
224 (descriptor-reg registers
225 :locations #.dword-regs
227 ; :reserve-locations (#.eax-offset)
228 :constant-scs (constant immediate)
230 :alternate-scs (control-stack))
232 ;; non-descriptor characters
233 (base-char-reg registers
234 :locations #.byte-regs
235 :reserve-locations (#.ah-offset #.al-offset)
236 :constant-scs (immediate)
238 :alternate-scs (base-char-stack))
240 ;; non-descriptor SAPs (arbitrary pointers into address space)
242 :locations #.dword-regs
244 ; :reserve-locations (#.eax-offset)
245 :constant-scs (immediate)
247 :alternate-scs (sap-stack))
249 ;; non-descriptor (signed or unsigned) numbers
250 (signed-reg registers
251 :locations #.dword-regs
253 ; :reserve-locations (#.eax-offset)
254 :constant-scs (immediate)
256 :alternate-scs (signed-stack))
257 (unsigned-reg registers
258 :locations #.dword-regs
260 ; :reserve-locations (#.eax-offset)
261 :constant-scs (immediate)
263 :alternate-scs (unsigned-stack))
265 ;; miscellaneous objects that must not be seen by GC. Used only as
268 :locations #.word-regs
270 ; :reserve-locations (#.ax-offset)
273 :locations #.byte-regs
274 ; :reserve-locations (#.al-offset #.ah-offset)
277 ;; that can go in the floating point registers
279 ;; non-descriptor SINGLE-FLOATs
280 (single-reg float-registers
281 :locations (0 1 2 3 4 5 6 7)
282 :constant-scs (fp-constant)
284 :alternate-scs (single-stack))
286 ;; non-descriptor DOUBLE-FLOATs
287 (double-reg float-registers
288 :locations (0 1 2 3 4 5 6 7)
289 :constant-scs (fp-constant)
291 :alternate-scs (double-stack))
293 ;; non-descriptor LONG-FLOATs
295 (long-reg float-registers
296 :locations (0 1 2 3 4 5 6 7)
297 :constant-scs (fp-constant)
299 :alternate-scs (long-stack))
301 (complex-single-reg float-registers
306 :alternate-scs (complex-single-stack))
308 (complex-double-reg float-registers
313 :alternate-scs (complex-double-stack))
316 (complex-long-reg float-registers
321 :alternate-scs (complex-long-stack))
323 ;; a catch or unwind block
325 :element-size sb!vm::kludge-nondeterministic-catch-block-size))
327 (eval-when (:compile-toplevel :load-toplevel :execute)
329 (defconstant byte-sc-names '(base-char-reg byte-reg base-char-stack))
330 (defconstant word-sc-names '(word-reg))
331 (defconstant dword-sc-names
332 '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack
333 signed-stack unsigned-stack sap-stack single-stack constant))
335 ;;; added by jrd. I guess the right thing to do is to treat floats
336 ;;; as a separate size...
338 ;;; These are used to (at least) determine operand size.
339 (defconstant float-sc-names '(single-reg))
340 (defconstant double-sc-names '(double-reg double-stack))
344 ;;;; miscellaneous TNs for the various registers
346 (macrolet ((def-misc-reg-tns (sc-name &rest reg-names)
348 (dolist (reg-name reg-names)
349 (let ((tn-name (symbolicate reg-name "-TN"))
350 (offset-name (symbolicate reg-name "-OFFSET")))
351 ;; FIXME: Couldn't shouldn't this be DEFCONSTANT
352 ;; instead of DEFPARAMETER?
353 (forms `(defparameter ,tn-name
354 (make-random-tn :kind :normal
355 :sc (sc-or-lose ',sc-name)
358 `(progn ,@(forms)))))
360 (def-misc-reg-tns unsigned-reg eax ebx ecx edx ebp esp edi esi)
361 (def-misc-reg-tns word-reg ax bx cx dx bp sp di si)
362 (def-misc-reg-tns byte-reg al ah bl bh cl ch dl dh)
363 (def-misc-reg-tns single-reg fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7))
365 ;;; TNs for registers used to pass arguments
366 (defparameter *register-arg-tns*
367 (mapcar (lambda (register-arg-name)
368 (symbol-value (symbolicate register-arg-name "-TN")))
371 ;;; FIXME: doesn't seem to be used in SBCL
374 (defparameter fp-constant-tn
375 (make-random-tn :kind :normal
376 :sc (sc-or-lose 'fp-constant)
377 :offset 31)) ; Offset doesn't get used.
380 ;;; IMMEDIATE-CONSTANT-SC
382 ;;; If value can be represented as an immediate constant, then return the
383 ;;; appropriate SC number, otherwise return NIL.
384 (def-vm-support-routine immediate-constant-sc (value)
386 ((or fixnum #-sb-xc-host system-area-pointer character)
387 (sc-number-or-lose 'immediate))
389 (when (static-symbol-p value)
390 (sc-number-or-lose 'immediate)))
392 (when (or (eql value 0f0) (eql value 1f0))
393 (sc-number-or-lose 'fp-constant)))
395 (when (or (eql value 0d0) (eql value 1d0))
396 (sc-number-or-lose 'fp-constant)))
399 (when (or (eql value 0l0) (eql value 1l0)
401 (eql value (log 10l0 2l0))
402 (eql value (log 2.718281828459045235360287471352662L0 2l0))
403 (eql value (log 2l0 10l0))
404 (eql value (log 2l0 2.718281828459045235360287471352662L0)))
405 (sc-number-or-lose 'fp-constant)))))
407 ;;;; miscellaneous function call parameters
409 ;;; offsets of special stack frame locations
410 (defconstant ocfp-save-offset 0)
411 (defconstant return-pc-save-offset 1)
412 (defconstant code-save-offset 2)
414 ;;; FIXME: This is a bad comment (changed since when?) and there are others
415 ;;; like it in this file. It'd be nice to clarify them. Failing that deleting
416 ;;; them or flagging them with KLUDGE might be better than nothing.
418 ;;; names of these things seem to have changed. these aliases by jrd
419 (defconstant lra-save-offset return-pc-save-offset)
421 (defconstant cfp-offset ebp-offset) ; pfw - needed by stuff in /code
422 ; related to signal context stuff
424 ;;; SINGLE-VALUE-RETURN-BYTE-OFFSET
426 ;;; This is used by the debugger.
427 (defconstant single-value-return-byte-offset 2)
429 ;;; This function is called by debug output routines that want a pretty name
430 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
431 (def-vm-support-routine location-print-name (tn)
432 (declare (type tn tn))
433 (let* ((sc (tn-sc tn))
434 (sb (sb-name (sc-sb sc)))
435 (offset (tn-offset tn)))
438 (let* ((sc-name (sc-name sc))
439 (name-vec (cond ((member sc-name byte-sc-names)
440 *byte-register-names*)
441 ((member sc-name word-sc-names)
442 *word-register-names*)
443 ((member sc-name dword-sc-names)
444 *dword-register-names*))))
446 (< -1 offset (length name-vec))
447 (svref name-vec offset))
448 ;; FIXME: Shouldn't this be an ERROR?
449 (format nil "<unknown reg: off=~D, sc=~A>" offset sc-name))))
450 (float-registers (format nil "FR~D" offset))
451 (stack (format nil "S~D" offset))
452 (constant (format nil "Const~D" offset))
453 (immediate-constant "Immed")
454 (noise (symbol-name (sc-name sc))))))
455 ;;; FIXME: Could this, and everything that uses it, be made #!+SB-SHOW?
457 ;;; The loader uses this to convert alien names to the form they need in
458 ;;; the symbol table (for example, prepending an underscore).
459 (defun extern-alien-name (name)
460 (declare (type simple-string name))