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.
16 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
17 (defvar *byte-register-names
* (make-array 32 :initial-element nil
))
18 (defvar *word-register-names
* (make-array 32 :initial-element nil
))
19 (defvar *dword-register-names
* (make-array 32 :initial-element nil
))
20 (defvar *qword-register-names
* (make-array 32 :initial-element nil
))
21 (defvar *float-register-names
* (make-array 16 :initial-element nil
)))
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
:load-toplevel
:execute
)
28 ;; EVAL-WHEN is necessary because stuff like #.EAX-OFFSET
29 ;; (in the same file) depends on compile-time evaluation
30 ;; of the DEFCONSTANT. -- AL 20010224
31 (defconstant ,offset-sym
,offset
))
32 (setf (svref ,names-vector
,offset-sym
)
33 ,(symbol-name name
)))))
34 ;; FIXME: It looks to me as though DEFREGSET should also
35 ;; define the related *FOO-REGISTER-NAMES* variable.
36 (defregset (name &rest regs
)
37 `(eval-when (:compile-toplevel
:load-toplevel
:execute
)
39 (list ,@(mapcar (lambda (name)
40 (symbolicate name
"-OFFSET"))
45 ;; Note: the encoding here is different than that used by the chip.
46 ;; We use this encoding so that the compiler thinks that AX (and
47 ;; EAX) overlap AL and AH instead of AL and CL.
49 ;; High-byte are registers disabled on AMD64, since they can't be
50 ;; encoded for an op that has a REX-prefix and we don't want to
51 ;; add special cases into the code generation. The overlap doesn't
52 ;; therefore exist anymore, but the numbering hasn't been changed
62 (defreg r10b
20 :byte
)
63 (defreg r11b
22 :byte
)
64 (defreg r12b
24 :byte
)
65 (defreg r13b
26 :byte
)
66 (defreg r14b
28 :byte
)
67 (defreg r15b
30 :byte
)
68 (defregset *byte-regs
*
69 al cl dl bl sil dil r8b r9b r10b
70 #+nil r11b
#+nil r12b r13b r14b r15b
)
83 (defreg r10w
20 :word
)
84 (defreg r11w
22 :word
)
85 (defreg r12w
24 :word
)
86 (defreg r13w
26 :word
)
87 (defreg r14w
28 :word
)
88 (defreg r15w
30 :word
)
89 (defregset *word-regs
* ax cx dx bx si di r8w r9w r10w
90 #+nil r11w
#+nil r12w r13w r14w r15w
)
92 ;; double word registers
98 (defreg ebp
10 :dword
)
99 (defreg esi
12 :dword
)
100 (defreg edi
14 :dword
)
101 (defreg r8d
16 :dword
)
102 (defreg r9d
18 :dword
)
103 (defreg r10d
20 :dword
)
104 (defreg r11d
22 :dword
)
105 (defreg r12d
24 :dword
)
106 (defreg r13d
26 :dword
)
107 (defreg r14d
28 :dword
)
108 (defreg r15d
30 :dword
)
109 (defregset *dword-regs
* eax ecx edx ebx esi edi r8d r9d r10d
110 #+nil r11d
#+nil r12w r13d r14d r15d
)
112 ;; quadword registers
113 (defreg rax
0 :qword
)
114 (defreg rcx
2 :qword
)
115 (defreg rdx
4 :qword
)
116 (defreg rbx
6 :qword
)
117 (defreg rsp
8 :qword
)
118 (defreg rbp
10 :qword
)
119 (defreg rsi
12 :qword
)
120 (defreg rdi
14 :qword
)
121 (defreg r8
16 :qword
)
122 (defreg r9
18 :qword
)
123 (defreg r10
20 :qword
)
124 (defreg r11
22 :qword
)
125 (defreg r12
24 :qword
)
126 (defreg r13
26 :qword
)
127 (defreg r14
28 :qword
)
128 (defreg r15
30 :qword
)
129 ;; for no good reason at the time, r12 and r13 were missed from the
130 ;; list of qword registers. However
131 ;; <jsnell> r13 is already used as temporary [#lisp irc 2005/01/30]
132 ;; and we're now going to use r12 for the struct thread*
134 ;; Except that now we use r11 instead of r13 as the temporary,
135 ;; since it's got a more compact encoding than r13, and experimentally
136 ;; the temporary gets used more than the other registers that are never
137 ;; wired. -- JES, 2005-11-02
138 (defregset *qword-regs
* rax rcx rdx rbx rsi rdi
139 r8 r9 r10
#+nil r11
#+nil r12 r13 r14 r15
)
141 ;; floating point registers
142 (defreg float0
0 :float
)
143 (defreg float1
1 :float
)
144 (defreg float2
2 :float
)
145 (defreg float3
3 :float
)
146 (defreg float4
4 :float
)
147 (defreg float5
5 :float
)
148 (defreg float6
6 :float
)
149 (defreg float7
7 :float
)
150 (defreg float8
8 :float
)
151 (defreg float9
9 :float
)
152 (defreg float10
10 :float
)
153 (defreg float11
11 :float
)
154 (defreg float12
12 :float
)
155 (defreg float13
13 :float
)
156 (defreg float14
14 :float
)
157 (defreg float15
15 :float
)
158 (defregset *float-regs
* float0 float1 float2 float3 float4 float5 float6 float7
159 float8 float9 float10 float11 float12 float13 float14 float15
)
161 ;; registers used to pass arguments
163 ;; the number of arguments/return values passed in registers
164 (defconstant register-arg-count
3)
165 ;; names and offsets for registers used to pass arguments
166 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
167 (defparameter *register-arg-names
* '(rdx rdi rsi
)))
168 (defregset *register-arg-offsets
* rdx rdi rsi
)
170 (defregset *c-call-register-arg-offsets
* rdi rsi rdx rcx r8 r9
)
172 (defregset *c-call-register-arg-offsets
* rcx rdx r8 r9
))
176 ;;; There are 16 registers really, but we consider them 32 in order to
177 ;;; describe the overlap of byte registers. The only thing we need to
178 ;;; represent is what registers overlap. Therefore, we consider bytes
179 ;;; to take one unit, and [dq]?words to take two. We don't need to
180 ;;; tell the difference between [dq]?words, because you can't put two
181 ;;; words in a dword register.
182 (define-storage-base registers
:finite
:size
32)
184 (define-storage-base float-registers
:finite
:size
16)
186 ;;; Start from 2, for the old RBP (aka OCFP) and return address
187 (define-storage-base stack
:unbounded
:size
2 :size-increment
1)
188 (define-storage-base constant
:non-packed
)
189 (define-storage-base immediate-constant
:non-packed
)
190 (define-storage-base noise
:unbounded
:size
2)
194 (!define-storage-classes
196 ;; non-immediate constants in the constant pool
199 (fp-single-zero immediate-constant
)
200 (fp-double-zero immediate-constant
)
201 (fp-complex-single-zero immediate-constant
)
202 (fp-complex-double-zero immediate-constant
)
204 (fp-single-immediate immediate-constant
)
205 (fp-double-immediate immediate-constant
)
206 (fp-complex-single-immediate immediate-constant
)
207 (fp-complex-double-immediate immediate-constant
)
209 #!+sb-simd-pack
(int-sse-immediate immediate-constant
)
210 #!+sb-simd-pack
(double-sse-immediate immediate-constant
)
211 #!+sb-simd-pack
(single-sse-immediate immediate-constant
)
213 (immediate immediate-constant
)
220 (control-stack stack
) ; may be pointers, scanned by GC
222 ;; the non-descriptor stacks
223 ;; XXX alpha backend has :element-size 2 :alignment 2 in these entries
224 (signed-stack stack
) ; (signed-byte 64)
225 (unsigned-stack stack
) ; (unsigned-byte 64)
226 (character-stack stack
) ; non-descriptor characters.
227 (sap-stack stack
) ; System area pointers.
228 (single-stack stack
) ; single-floats
230 (complex-single-stack stack
) ; complex-single-floats
231 (complex-double-stack stack
:element-size
2) ; complex-double-floats
233 (int-sse-stack stack
:element-size
2)
235 (double-sse-stack stack
:element-size
2)
237 (single-sse-stack stack
:element-size
2)
246 ;; things that can go in the integer registers
249 ;; On the X86, we don't have to distinguish between descriptor and
250 ;; non-descriptor registers, because of the conservative GC.
251 ;; Therefore, we use different scs only to distinguish between
252 ;; descriptor and non-descriptor values and to specify size.
254 ;; immediate descriptor objects. Don't have to be seen by GC, but nothing
255 ;; bad will happen if they are. (fixnums, characters, header values, etc).
257 :locations
#.
*qword-regs
*
258 :element-size
2 ; I think this is for the al/ah overlap thing
259 :constant-scs
(immediate)
261 :alternate-scs
(control-stack))
263 ;; pointer descriptor objects -- must be seen by GC
264 (descriptor-reg registers
265 :locations
#.
*qword-regs
*
267 ; :reserve-locations (#.eax-offset)
268 :constant-scs
(constant immediate
)
270 :alternate-scs
(control-stack))
272 ;; non-descriptor characters
273 (character-reg registers
274 :locations
#!-sb-unicode
#.
*byte-regs
*
275 #!+sb-unicode
#.
*qword-regs
*
276 #!+sb-unicode
#!+sb-unicode
278 #!-sb-unicode
#!-sb-unicode
279 :reserve-locations
(#.al-offset
)
280 :constant-scs
(immediate)
282 :alternate-scs
(character-stack))
284 ;; non-descriptor SAPs (arbitrary pointers into address space)
286 :locations
#.
*qword-regs
*
288 ; :reserve-locations (#.eax-offset)
289 :constant-scs
(immediate)
291 :alternate-scs
(sap-stack))
293 ;; non-descriptor (signed or unsigned) numbers
294 (signed-reg registers
295 :locations
#.
*qword-regs
*
297 :constant-scs
(immediate)
299 :alternate-scs
(signed-stack))
300 (unsigned-reg registers
301 :locations
#.
*qword-regs
*
303 :constant-scs
(immediate)
305 :alternate-scs
(unsigned-stack))
307 ;; miscellaneous objects that must not be seen by GC. Used only as
310 :locations
#.
*word-regs
*
314 :locations
#.
*dword-regs
*
318 :locations
#.
*byte-regs
*
321 ;; that can go in the floating point registers
323 ;; non-descriptor SINGLE-FLOATs
324 (single-reg float-registers
325 :locations
#.
*float-regs
*
326 :constant-scs
(fp-single-zero fp-single-immediate
)
328 :alternate-scs
(single-stack))
330 ;; non-descriptor DOUBLE-FLOATs
331 (double-reg float-registers
332 :locations
#.
*float-regs
*
333 :constant-scs
(fp-double-zero fp-double-immediate
)
335 :alternate-scs
(double-stack))
337 (complex-single-reg float-registers
338 :locations
#.
*float-regs
*
339 :constant-scs
(fp-complex-single-zero fp-complex-single-immediate
)
341 :alternate-scs
(complex-single-stack))
343 (complex-double-reg float-registers
344 :locations
#.
*float-regs
*
345 :constant-scs
(fp-complex-double-zero fp-complex-double-immediate
)
347 :alternate-scs
(complex-double-stack))
351 (sse-reg float-registers
352 :locations
#.
*float-regs
*)
355 (int-sse-reg float-registers
356 :locations
#.
*float-regs
*
357 :constant-scs
(int-sse-immediate)
359 :alternate-scs
(int-sse-stack))
361 (double-sse-reg float-registers
362 :locations
#.
*float-regs
*
363 :constant-scs
(double-sse-immediate)
365 :alternate-scs
(double-sse-stack))
367 (single-sse-reg float-registers
368 :locations
#.
*float-regs
*
369 :constant-scs
(single-sse-immediate)
371 :alternate-scs
(single-sse-stack))
373 (catch-block stack
:element-size catch-block-size
)
374 (unwind-block stack
:element-size unwind-block-size
))
376 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
377 (defparameter *byte-sc-names
*
378 '(#!-sb-unicode character-reg byte-reg
#!-sb-unicode character-stack
))
379 (defparameter *word-sc-names
* '(word-reg))
380 (defparameter *dword-sc-names
* '(dword-reg))
381 (defparameter *qword-sc-names
*
382 '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack
383 signed-stack unsigned-stack sap-stack single-stack
384 #!+sb-unicode character-reg
#!+sb-unicode character-stack constant
))
385 ;;; added by jrd. I guess the right thing to do is to treat floats
386 ;;; as a separate size...
388 ;;; These are used to (at least) determine operand size.
389 (defparameter *float-sc-names
* '(single-reg))
390 (defparameter *double-sc-names
* '(double-reg double-stack
))
391 (defparameter *complex-sc-names
* '(complex-single-reg complex-single-stack
392 complex-double-reg complex-double-stack
))
394 (defparameter *oword-sc-names
* '(sse-reg int-sse-reg single-sse-reg double-sse-reg
395 sse-stack int-sse-stack single-sse-stack double-sse-stack
))
398 ;;;; miscellaneous TNs for the various registers
400 (macrolet ((def-misc-reg-tns (sc-name &rest reg-names
)
402 (dolist (reg-name reg-names
)
403 (let ((tn-name (symbolicate reg-name
"-TN"))
404 (offset-name (symbolicate reg-name
"-OFFSET")))
405 ;; FIXME: It'd be good to have the special
406 ;; variables here be named with the *FOO*
408 (forms `(defparameter ,tn-name
409 (make-random-tn :kind
:normal
410 :sc
(sc-or-lose ',sc-name
)
413 `(progn ,@(forms)))))
415 (def-misc-reg-tns unsigned-reg rax rbx rcx rdx rbp rsp rdi rsi
416 r8 r9 r10 r11 r12 r13 r14 r15
)
417 (def-misc-reg-tns dword-reg eax ebx ecx edx ebp esp edi esi
418 r8d r9d r10d r11d r12d r13d r14d r15d
)
419 (def-misc-reg-tns word-reg ax bx cx dx bp sp di si
420 r8w r9w r10w r11w r12w r13w r14w r15w
)
421 (def-misc-reg-tns byte-reg al cl dl bl sil dil r8b r9b r10b
422 r11b r12b r13b r14b r15b
)
423 (def-misc-reg-tns single-reg
424 float0 float1 float2 float3 float4 float5 float6 float7
425 float8 float9 float10 float11 float12 float13 float14 float15
))
427 (defun reg-in-size (tn size
)
428 (make-random-tn :kind
:normal
434 (:qword
'unsigned-reg
)))
435 :offset
(tn-offset tn
)))
437 ;; A register that's never used by the code generator, and can therefore
438 ;; be used as an assembly temporary in cases where a VOP :TEMPORARY can't
440 (defparameter temp-reg-tn r11-tn
)
442 ;;; TNs for registers used to pass arguments
443 (defparameter *register-arg-tns
*
444 (mapcar (lambda (register-arg-name)
445 (symbol-value (symbolicate register-arg-name
"-TN")))
446 *register-arg-names
*))
448 (defparameter thread-base-tn
449 (make-random-tn :kind
:normal
:sc
(sc-or-lose 'unsigned-reg
)
452 ;;; If value can be represented as an immediate constant, then return
453 ;;; the appropriate SC number, otherwise return NIL.
454 (defun immediate-constant-sc (value)
455 (declare (notinline sb
!c
::core-object-p
) ; forward ref
456 (special sb
!c
::*compile-object
*))
458 ((or (integer #.sb
!xc
:most-negative-fixnum
#.sb
!xc
:most-positive-fixnum
)
460 (sc-number-or-lose 'immediate
))
462 ;; If #!+immobile-symbols, then ALL symbols are static in placement
463 ;; and in the sub-2GB space, therefore immediate constants.
464 ;; Otherwise, if #!+immobile-space, and either compilation is to memory
465 ;; and the symbol is in immobile-space, or if in the cross-compiler which
466 ;; dumps all symbols as immobile if possible, then it's immediate.
467 (when (or #!+(or immobile-symbols
(and immobile-space
(host-feature sb-xc-host
))) t
468 #!+(and immobile-space
(not (host-feature sb-xc-host
)))
469 (and (sb!c
::core-object-p sb
!c
::*compile-object
*)
470 (typep (get-lisp-obj-address value
) '(signed-byte 32)))
471 (static-symbol-p value
))
472 (sc-number-or-lose 'immediate
)))
475 (if (eql value
0f0
) 'fp-single-zero
'fp-single-immediate
)))
478 (if (eql value
0d0
) 'fp-double-zero
'fp-double-immediate
)))
479 ((complex single-float
)
481 (if (eql value
#c
(0f0 0f0
))
482 'fp-complex-single-zero
483 'fp-complex-single-immediate
)))
484 ((complex double-float
)
486 (if (eql value
#c
(0d0 0d0
))
487 'fp-complex-double-zero
488 'fp-complex-double-immediate
)))
489 #!+(and sb-simd-pack
(not (host-feature sb-xc-host
)))
490 ((simd-pack double-float
) (sc-number-or-lose 'double-sse-immediate
))
491 #!+(and sb-simd-pack
(not (host-feature sb-xc-host
)))
492 ((simd-pack single-float
) (sc-number-or-lose 'single-sse-immediate
))
493 #!+(and sb-simd-pack
(not (host-feature sb-xc-host
)))
494 (simd-pack (sc-number-or-lose 'int-sse-immediate
))))
496 (defun boxed-immediate-sc-p (sc)
497 (eql sc
(sc-number-or-lose 'immediate
)))
499 (defun encode-value-if-immediate (tn &optional
(tag t
))
500 (if (sc-is tn immediate
)
501 (let ((val (tn-value tn
)))
503 (integer (if tag
(fixnumize val
) val
))
504 (symbol (if (static-symbol-p val
)
505 (+ nil-value
(static-symbol-offset val
))
506 (make-fixup val
:immobile-object
)))
508 (logior (ash (char-code val
) n-widetag-bits
)
513 ;;;; miscellaneous function call parameters
515 ;;; Offsets of special stack frame locations relative to RBP.
517 ;;; Consider the standard prologue PUSH RBP; MOV RBP, RSP: the return
518 ;;; address is at RBP+8, the old control stack frame pointer is at
519 ;;; RBP, the magic 3rd slot is at RBP-8. Then come the locals from
521 (defconstant return-pc-save-offset
0)
522 (defconstant ocfp-save-offset
1)
523 ;;; Let SP be the stack pointer before CALLing, and FP is the frame
524 ;;; pointer after the standard prologue. SP +
525 ;;; FRAME-WORD-OFFSET(SP->FP-OFFSET + I) = FP + FRAME-WORD-OFFSET(I).
526 (defconstant sp-
>fp-offset
2)
528 (declaim (inline frame-word-offset
))
529 (defun frame-word-offset (index)
532 (declaim (inline frame-byte-offset
))
533 (defun frame-byte-offset (index)
534 (* (frame-word-offset index
) n-word-bytes
))
536 (defconstant lra-save-offset return-pc-save-offset
) ; ?
538 ;;; This is used by the debugger.
539 (defconstant single-value-return-byte-offset
3)
541 ;;; This function is called by debug output routines that want a pretty name
542 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
543 (defun location-print-name (tn)
544 (declare (type tn tn
))
545 (let* ((sc (tn-sc tn
))
546 (sb (sb-name (sc-sb sc
)))
547 (offset (tn-offset tn
)))
550 (let* ((sc-name (sc-name sc
))
551 (name-vec (cond ((member sc-name
*byte-sc-names
*)
552 *byte-register-names
*)
553 ((member sc-name
*word-sc-names
*)
554 *word-register-names
*)
555 ((member sc-name
*dword-sc-names
*)
556 *dword-register-names
*)
557 ((member sc-name
*qword-sc-names
*)
558 *qword-register-names
*))))
560 (< -
1 offset
(length name-vec
))
561 (svref name-vec offset
))
562 ;; FIXME: Shouldn't this be an ERROR?
563 (format nil
"<unknown reg: off=~W, sc=~A>" offset sc-name
))))
564 (float-registers (format nil
"FLOAT~D" offset
))
565 (stack (format nil
"S~D" offset
))
566 (constant (format nil
"Const~D" offset
))
567 (immediate-constant "Immed")
568 (noise (symbol-name (sc-name sc
))))))
569 ;;; FIXME: Could this, and everything that uses it, be made #!+SB-SHOW?
571 (defun dwords-for-quad (value)
572 (let* ((lo (logand value
(1- (ash 1 32))))
573 (hi (ash value -
32)))
576 (defun words-for-dword (value)
577 (let* ((lo (logand value
(1- (ash 1 16))))
578 (hi (ash value -
16)))
581 (defconstant cfp-offset rbp-offset
) ; pfw - needed by stuff in /code
583 (defun combination-implementation-style (node)
584 (declare (type sb
!c
::combination node
))
585 (flet ((valid-funtype (args result
)
586 (sb!c
::valid-fun-use node
587 (sb!c
::specifier-type
588 `(function ,args
,result
)))))
589 (case (sb!c
::combination-fun-source-name node
)
592 ((or (valid-funtype '(fixnum fixnum
) '*)
593 ;; todo: nothing prevents this from testing an unsigned word against
594 ;; a signed word, except for the mess of VOPs it would demand
595 (valid-funtype '((signed-byte 64) (signed-byte 64)) '*)
596 (valid-funtype '((unsigned-byte 64) (unsigned-byte 64)) '*))
599 (values :default nil
))))
602 ((or (and (valid-funtype '#.
`((integer 0 ,(- 63 n-fixnum-tag-bits
))
604 (sb!c
::constant-lvar-p
605 (first (sb!c
::basic-combination-args node
))))
606 (valid-funtype '((integer 0 63) (signed-byte 64)) '*)
607 (valid-funtype '((integer 0 63) (unsigned-byte 64)) '*))
608 (values :transform
'(lambda (index integer
)
609 (%logbitp integer index
))))
611 (values :default nil
))))
613 (values :default nil
)))))