1 ;;;; miscellaneous VM definition noise for the x86-64
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
() '(unsigned-byte 64))
20 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
21 (defvar *byte-register-names
* (make-array 32 :initial-element nil
))
22 (defvar *word-register-names
* (make-array 16 :initial-element nil
))
23 (defvar *dword-register-names
* (make-array 16 :initial-element nil
))
24 (defvar *qword-register-names
* (make-array 32 :initial-element nil
))
25 (defvar *float-register-names
* (make-array 16 :initial-element nil
)))
27 (macrolet ((defreg (name offset size
)
28 (let ((offset-sym (symbolicate name
"-OFFSET"))
29 (names-vector (symbolicate "*" size
"-REGISTER-NAMES*")))
31 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
32 ;; EVAL-WHEN is necessary because stuff like #.EAX-OFFSET
33 ;; (in the same file) depends on compile-time evaluation
34 ;; of the DEFCONSTANT. -- AL 20010224
35 (def!constant
,offset-sym
,offset
))
36 (setf (svref ,names-vector
,offset-sym
)
37 ,(symbol-name name
)))))
38 ;; FIXME: It looks to me as though DEFREGSET should also
39 ;; define the related *FOO-REGISTER-NAMES* variable.
40 (defregset (name &rest regs
)
41 `(eval-when (:compile-toplevel
:load-toplevel
:execute
)
43 (list ,@(mapcar (lambda (name)
44 (symbolicate name
"-OFFSET"))
49 ;; Note: the encoding here is different than that used by the chip.
50 ;; We use this encoding so that the compiler thinks that AX (and
51 ;; EAX) overlap AL and AH instead of AL and CL.
53 ;; High-byte are registers disabled on AMD64, since they can't be
54 ;; encoded for an op that has a REX-prefix and we don't want to
55 ;; add special cases into the code generation. The overlap doesn't
56 ;; therefore exist anymore, but the numbering hasn't been changed
66 (defreg r10b
20 :byte
)
67 (defreg r11b
22 :byte
)
68 (defreg r12b
24 :byte
)
69 (defreg r13b
26 :byte
)
70 (defreg r14b
28 :byte
)
71 (defreg r15b
30 :byte
)
72 (defregset *byte-regs
*
73 al cl dl bl sil dil r8b r9b r10b
74 r11b
#+nil r12b
#+nil r13b r14b r15b
)
85 (defregset *word-regs
* ax cx dx bx si di
)
87 ;; double word registers
93 (defreg ebp
10 :dword
)
94 (defreg esi
12 :dword
)
95 (defreg edi
14 :dword
)
96 (defregset *dword-regs
* eax ecx edx ebx esi edi
)
100 (defreg rcx
2 :qword
)
101 (defreg rdx
4 :qword
)
102 (defreg rbx
6 :qword
)
103 (defreg rsp
8 :qword
)
104 (defreg rbp
10 :qword
)
105 (defreg rsi
12 :qword
)
106 (defreg rdi
14 :qword
)
107 (defreg r8
16 :qword
)
108 (defreg r9
18 :qword
)
109 (defreg r10
20 :qword
)
110 (defreg r11
22 :qword
)
111 (defreg r12
24 :qword
)
112 (defreg r13
26 :qword
)
113 (defreg r14
28 :qword
)
114 (defreg r15
30 :qword
)
115 ;; for no good reason at the time, r12 and r13 were missed from the
116 ;; list of qword registers. However
117 ;; <jsnell> r13 is already used as temporary [#lisp irc 2005/01/30]
118 ;; and we're now going to use r12 for the struct thread*
119 (defregset *qword-regs
* rax rcx rdx rbx rsi rdi
120 r8 r9 r10 r11 r14 r15
)
122 ;; floating point registers
123 (defreg float0
0 :float
)
124 (defreg float1
1 :float
)
125 (defreg float2
2 :float
)
126 (defreg float3
3 :float
)
127 (defreg float4
4 :float
)
128 (defreg float5
5 :float
)
129 (defreg float6
6 :float
)
130 (defreg float7
7 :float
)
131 (defreg float8
8 :float
)
132 (defreg float9
9 :float
)
133 (defreg float10
10 :float
)
134 (defreg float11
11 :float
)
135 (defreg float12
12 :float
)
136 (defreg float13
13 :float
)
137 (defreg float14
14 :float
)
138 (defreg float15
15 :float
)
139 (defregset *float-regs
* float0 float1 float2 float3 float4 float5 float6 float7
140 float8 float9 float10 float11 float12 float13 float14 float15
)
142 ;; registers used to pass arguments
144 ;; the number of arguments/return values passed in registers
145 (def!constant register-arg-count
3)
146 ;; names and offsets for registers used to pass arguments
147 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
148 (defparameter *register-arg-names
* '(rdx rdi rsi
)))
149 (defregset *register-arg-offsets
* rdx rdi rsi
)
150 (defregset *c-call-register-arg-offsets
* rdi rsi rdx rcx r8 r9
))
154 ;;; There are 16 registers really, but we consider them 32 in order to
155 ;;; describe the overlap of byte registers. The only thing we need to
156 ;;; represent is what registers overlap. Therefore, we consider bytes
157 ;;; to take one unit, and [dq]?words to take two. We don't need to
158 ;;; tell the difference between [dq]?words, because you can't put two
159 ;;; words in a dword register.
160 (define-storage-base registers
:finite
:size
32)
162 (define-storage-base float-registers
:finite
:size
16)
164 (define-storage-base stack
:unbounded
:size
8)
165 (define-storage-base constant
:non-packed
)
166 (define-storage-base immediate-constant
:non-packed
)
167 (define-storage-base noise
:unbounded
:size
2)
171 ;;; a handy macro so we don't have to keep changing all the numbers whenever
172 ;;; we insert a new storage class
174 (defmacro !define-storage-classes
(&rest classes
)
177 (dolist (class classes
)
178 (let* ((sc-name (car class
))
179 (constant-name (symbolicate sc-name
"-SC-NUMBER")))
180 (forms `(define-storage-class ,sc-name
,index
182 (forms `(def!constant
,constant-name
,index
))
187 ;;; The DEFINE-STORAGE-CLASS call for CATCH-BLOCK refers to the size
188 ;;; of CATCH-BLOCK. The size of CATCH-BLOCK isn't calculated until
189 ;;; later in the build process, and the calculation is entangled with
190 ;;; code which has lots of predependencies, including dependencies on
191 ;;; the prior call of DEFINE-STORAGE-CLASS. The proper way to
192 ;;; unscramble this would be to untangle the code, so that the code
193 ;;; which calculates the size of CATCH-BLOCK can be separated from the
194 ;;; other lots-of-dependencies code, so that the code which calculates
195 ;;; the size of CATCH-BLOCK can be executed early, so that this value
196 ;;; is known properly at this point in compilation. However, that
197 ;;; would be a lot of editing of code that I (WHN 19990131) can't test
198 ;;; until the project is complete. So instead, I set the correct value
199 ;;; by hand here (a sort of nondeterministic guess of the right
200 ;;; answer:-) and add an assertion later, after the value is
201 ;;; calculated, that the original guess was correct.
203 ;;; (What a KLUDGE! Anyone who wants to come in and clean up this mess
204 ;;; has my gratitude.) (FIXME: Maybe this should be me..)
205 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
206 (def!constant kludge-nondeterministic-catch-block-size
6))
208 (!define-storage-classes
210 ;; non-immediate constants in the constant pool
213 (fp-single-zero immediate-constant
)
214 (fp-double-zero immediate-constant
)
216 (immediate immediate-constant
)
223 (control-stack stack
) ; may be pointers, scanned by GC
225 ;; the non-descriptor stacks
226 ;; XXX alpha backend has :element-size 2 :alignment 2 in these entries
227 (signed-stack stack
) ; (signed-byte 32)
228 (unsigned-stack stack
) ; (unsigned-byte 32)
229 (character-stack stack
) ; non-descriptor characters.
230 (sap-stack stack
) ; System area pointers.
231 (single-stack stack
) ; single-floats
233 (complex-single-stack stack
:element-size
2) ; complex-single-floats
234 (complex-double-stack stack
:element-size
2) ; complex-double-floats
244 ;; things that can go in the integer registers
247 ;; On the X86, we don't have to distinguish between descriptor and
248 ;; non-descriptor registers, because of the conservative GC.
249 ;; Therefore, we use different scs only to distinguish between
250 ;; descriptor and non-descriptor values and to specify size.
252 ;; immediate descriptor objects. Don't have to be seen by GC, but nothing
253 ;; bad will happen if they are. (fixnums, characters, header values, etc).
255 :locations
#.
*qword-regs
*
256 :element-size
2 ; I think this is for the al/ah overlap thing
257 :constant-scs
(immediate)
259 :alternate-scs
(control-stack))
261 ;; pointer descriptor objects -- must be seen by GC
262 (descriptor-reg registers
263 :locations
#.
*qword-regs
*
265 ; :reserve-locations (#.eax-offset)
266 :constant-scs
(constant immediate
)
268 :alternate-scs
(control-stack))
270 ;; non-descriptor characters
271 (character-reg registers
272 :locations
#!-sb-unicode
#.
*byte-regs
*
273 #!+sb-unicode
#.
*qword-regs
*
274 #!-sb-unicode
#!-sb-unicode
275 :reserve-locations
(#.al-offset
)
276 :constant-scs
(immediate)
278 :alternate-scs
(character-stack))
280 ;; non-descriptor SAPs (arbitrary pointers into address space)
282 :locations
#.
*qword-regs
*
284 ; :reserve-locations (#.eax-offset)
285 :constant-scs
(immediate)
287 :alternate-scs
(sap-stack))
289 ;; non-descriptor (signed or unsigned) numbers
290 (signed-reg registers
291 :locations
#.
*qword-regs
*
293 :constant-scs
(immediate)
295 :alternate-scs
(signed-stack))
296 (unsigned-reg registers
297 :locations
#.
*qword-regs
*
299 :constant-scs
(immediate)
301 :alternate-scs
(unsigned-stack))
303 ;; miscellaneous objects that must not be seen by GC. Used only as
306 :locations
#.
*word-regs
*
310 :locations
#.
*dword-regs
*
314 :locations
#.
*byte-regs
*
317 ;; that can go in the floating point registers
319 ;; non-descriptor SINGLE-FLOATs
320 (single-reg float-registers
321 :locations
#.
(loop for i from
0 below
15 collect i
)
322 :constant-scs
(fp-single-zero)
324 :alternate-scs
(single-stack))
326 ;; non-descriptor DOUBLE-FLOATs
327 (double-reg float-registers
328 :locations
#.
(loop for i from
0 below
15 collect i
)
329 :constant-scs
(fp-double-zero)
331 :alternate-scs
(double-stack))
333 (complex-single-reg float-registers
334 :locations
#.
(loop for i from
0 to
14 by
2 collect i
)
338 :alternate-scs
(complex-single-stack))
340 (complex-double-reg float-registers
341 :locations
#.
(loop for i from
0 to
14 by
2 collect i
)
345 :alternate-scs
(complex-double-stack))
347 ;; a catch or unwind block
348 (catch-block stack
:element-size kludge-nondeterministic-catch-block-size
))
350 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
351 (defparameter *byte-sc-names
*
352 '(#!-sb-unicode character-reg byte-reg
#!-sb-unicode character-stack
))
353 (defparameter *word-sc-names
* '(word-reg))
354 (defparameter *dword-sc-names
* '(dword-reg))
355 (defparameter *qword-sc-names
*
356 '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack
357 signed-stack unsigned-stack sap-stack single-stack
358 #!+sb-unicode character-reg
#!+sb-unicode character-stack constant
))
359 ;;; added by jrd. I guess the right thing to do is to treat floats
360 ;;; as a separate size...
362 ;;; These are used to (at least) determine operand size.
363 (defparameter *float-sc-names
* '(single-reg))
364 (defparameter *double-sc-names
* '(double-reg double-stack
))
367 ;;;; miscellaneous TNs for the various registers
369 (macrolet ((def-misc-reg-tns (sc-name &rest reg-names
)
371 (dolist (reg-name reg-names
)
372 (let ((tn-name (symbolicate reg-name
"-TN"))
373 (offset-name (symbolicate reg-name
"-OFFSET")))
374 ;; FIXME: It'd be good to have the special
375 ;; variables here be named with the *FOO*
377 (forms `(defparameter ,tn-name
378 (make-random-tn :kind
:normal
379 :sc
(sc-or-lose ',sc-name
)
382 `(progn ,@(forms)))))
384 (def-misc-reg-tns unsigned-reg rax rbx rcx rdx rbp rsp rdi rsi
385 r8 r9 r10 r11 r12 r13 r14 r15
)
386 (def-misc-reg-tns dword-reg eax ebx ecx edx ebp esp edi esi
)
387 (def-misc-reg-tns word-reg ax bx cx dx bp sp di si
)
388 (def-misc-reg-tns byte-reg al cl dl bl sil dil r8b r9b r10b
390 (def-misc-reg-tns single-reg
391 float0 float1 float2 float3 float4 float5 float6 float7
392 float8 float9 float10 float11 float12 float13 float14 float15
))
394 ;;; TNs for registers used to pass arguments
395 (defparameter *register-arg-tns
*
396 (mapcar (lambda (register-arg-name)
397 (symbol-value (symbolicate register-arg-name
"-TN")))
398 *register-arg-names
*))
400 (defparameter thread-base-tn
401 (make-random-tn :kind
:normal
:sc
(sc-or-lose 'unsigned-reg
)
404 (defparameter fp-single-zero-tn
405 (make-random-tn :kind
:normal
406 :sc
(sc-or-lose 'single-reg
)
409 (defparameter fp-double-zero-tn
410 (make-random-tn :kind
:normal
411 :sc
(sc-or-lose 'double-reg
)
414 ;;; If value can be represented as an immediate constant, then return
415 ;;; the appropriate SC number, otherwise return NIL.
416 (!def-vm-support-routine immediate-constant-sc
(value)
418 ((or (integer #.sb
!xc
:most-negative-fixnum
#.sb
!xc
:most-positive-fixnum
)
419 #-sb-xc-host system-area-pointer character
)
420 (sc-number-or-lose 'immediate
))
422 (when (static-symbol-p value
)
423 (sc-number-or-lose 'immediate
)))
426 (sc-number-or-lose 'fp-single-zero
)
430 (sc-number-or-lose 'fp-double-zero
)
434 ;;;; miscellaneous function call parameters
436 ;;; offsets of special stack frame locations
437 (def!constant ocfp-save-offset
0)
438 (def!constant return-pc-save-offset
1)
439 (def!constant code-save-offset
2)
441 (def!constant lra-save-offset return-pc-save-offset
) ; ?
443 ;;; This is used by the debugger.
444 (def!constant single-value-return-byte-offset
3)
446 ;;; This function is called by debug output routines that want a pretty name
447 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
448 (!def-vm-support-routine location-print-name
(tn)
449 (declare (type tn tn
))
450 (let* ((sc (tn-sc tn
))
451 (sb (sb-name (sc-sb sc
)))
452 (offset (tn-offset tn
)))
455 (let* ((sc-name (sc-name sc
))
456 (name-vec (cond ((member sc-name
*byte-sc-names
*)
457 *byte-register-names
*)
458 ((member sc-name
*word-sc-names
*)
459 *word-register-names
*)
460 ((member sc-name
*dword-sc-names
*)
461 *dword-register-names
*)
462 ((member sc-name
*qword-sc-names
*)
463 *qword-register-names
*))))
465 (< -
1 offset
(length name-vec
))
466 (svref name-vec offset
))
467 ;; FIXME: Shouldn't this be an ERROR?
468 (format nil
"<unknown reg: off=~W, sc=~A>" offset sc-name
))))
469 (float-registers (format nil
"FLOAT~D" offset
))
470 (stack (format nil
"S~D" offset
))
471 (constant (format nil
"Const~D" offset
))
472 (immediate-constant "Immed")
473 (noise (symbol-name (sc-name sc
))))))
474 ;;; FIXME: Could this, and everything that uses it, be made #!+SB-SHOW?
476 (defun dwords-for-quad (value)
477 (let* ((lo (logand value
(1- (ash 1 32))))
478 (hi (ash value -
32)))
481 (defun words-for-dword (value)
482 (let* ((lo (logand value
(1- (ash 1 16))))
483 (hi (ash value -
16)))
486 (def!constant cfp-offset rbp-offset
) ; pfw - needed by stuff in /code