Reduce stack usage by unwind-block.
[sbcl.git] / src / compiler / x86-64 / vm.lisp
blobd39a418a854a45b6cc2dffdf327d418be599644a
1 ;;;; miscellaneous VM definition noise for the x86-64
3 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; more information.
5 ;;;;
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.
12 (in-package "SB!VM")
14 ;;;; register specs
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*")))
26 `(progn
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)
38 (defparameter ,name
39 (list ,@(mapcar (lambda (name)
40 (symbolicate name "-OFFSET"))
41 regs))))))
43 ;; byte registers
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
53 ;; to reflect this.
54 (defreg al 0 :byte)
55 (defreg cl 2 :byte)
56 (defreg dl 4 :byte)
57 (defreg bl 6 :byte)
58 (defreg sil 12 :byte)
59 (defreg dil 14 :byte)
60 (defreg r8b 16 :byte)
61 (defreg r9b 18 :byte)
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)
72 ;; word registers
73 (defreg ax 0 :word)
74 (defreg cx 2 :word)
75 (defreg dx 4 :word)
76 (defreg bx 6 :word)
77 (defreg sp 8 :word)
78 (defreg bp 10 :word)
79 (defreg si 12 :word)
80 (defreg di 14 :word)
81 (defreg r8w 16 :word)
82 (defreg r9w 18 :word)
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
93 (defreg eax 0 :dword)
94 (defreg ecx 2 :dword)
95 (defreg edx 4 :dword)
96 (defreg ebx 6 :dword)
97 (defreg esp 8 :dword)
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)
169 #!-win32
170 (defregset *c-call-register-arg-offsets* rdi rsi rdx rcx r8 r9)
171 #!+win32
172 (defregset *c-call-register-arg-offsets* rcx rdx r8 r9))
174 ;;;; SB definitions
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 (define-storage-base stack :unbounded :size 3 :size-increment 1)
187 (define-storage-base constant :non-packed)
188 (define-storage-base immediate-constant :non-packed)
189 (define-storage-base noise :unbounded :size 2)
191 ;;;; SC definitions
193 ;;; a handy macro so we don't have to keep changing all the numbers whenever
194 ;;; we insert a new storage class
196 (defmacro !define-storage-classes (&rest classes)
197 (collect ((forms))
198 (let ((index 0))
199 (dolist (class classes)
200 (let* ((sc-name (car class))
201 (constant-name (symbolicate sc-name "-SC-NUMBER")))
202 (forms `(define-storage-class ,sc-name ,index
203 ,@(cdr class)))
204 (forms `(defconstant ,constant-name ,index))
205 (incf index))))
206 `(progn
207 ,@(forms))))
209 (!define-storage-classes
211 ;; non-immediate constants in the constant pool
212 (constant constant)
214 (fp-single-zero immediate-constant)
215 (fp-double-zero immediate-constant)
216 (fp-complex-single-zero immediate-constant)
217 (fp-complex-double-zero immediate-constant)
219 (fp-single-immediate immediate-constant)
220 (fp-double-immediate immediate-constant)
221 (fp-complex-single-immediate immediate-constant)
222 (fp-complex-double-immediate immediate-constant)
224 #!+sb-simd-pack (int-sse-immediate immediate-constant)
225 #!+sb-simd-pack (double-sse-immediate immediate-constant)
226 #!+sb-simd-pack (single-sse-immediate immediate-constant)
228 (immediate immediate-constant)
231 ;; the stacks
234 ;; the control stack
235 (control-stack stack) ; may be pointers, scanned by GC
237 ;; the non-descriptor stacks
238 ;; XXX alpha backend has :element-size 2 :alignment 2 in these entries
239 (signed-stack stack) ; (signed-byte 64)
240 (unsigned-stack stack) ; (unsigned-byte 64)
241 (character-stack stack) ; non-descriptor characters.
242 (sap-stack stack) ; System area pointers.
243 (single-stack stack) ; single-floats
244 (double-stack stack)
245 (complex-single-stack stack) ; complex-single-floats
246 (complex-double-stack stack :element-size 2) ; complex-double-floats
247 #!+sb-simd-pack
248 (int-sse-stack stack :element-size 2)
249 #!+sb-simd-pack
250 (double-sse-stack stack :element-size 2)
251 #!+sb-simd-pack
252 (single-sse-stack stack :element-size 2)
255 ;; magic SCs
258 (ignore-me noise)
261 ;; things that can go in the integer registers
264 ;; On the X86, we don't have to distinguish between descriptor and
265 ;; non-descriptor registers, because of the conservative GC.
266 ;; Therefore, we use different scs only to distinguish between
267 ;; descriptor and non-descriptor values and to specify size.
269 ;; immediate descriptor objects. Don't have to be seen by GC, but nothing
270 ;; bad will happen if they are. (fixnums, characters, header values, etc).
271 (any-reg registers
272 :locations #.*qword-regs*
273 :element-size 2 ; I think this is for the al/ah overlap thing
274 :constant-scs (immediate)
275 :save-p t
276 :alternate-scs (control-stack))
278 ;; pointer descriptor objects -- must be seen by GC
279 (descriptor-reg registers
280 :locations #.*qword-regs*
281 :element-size 2
282 ; :reserve-locations (#.eax-offset)
283 :constant-scs (constant immediate)
284 :save-p t
285 :alternate-scs (control-stack))
287 ;; non-descriptor characters
288 (character-reg registers
289 :locations #!-sb-unicode #.*byte-regs*
290 #!+sb-unicode #.*qword-regs*
291 #!+sb-unicode #!+sb-unicode
292 :element-size 2
293 #!-sb-unicode #!-sb-unicode
294 :reserve-locations (#.al-offset)
295 :constant-scs (immediate)
296 :save-p t
297 :alternate-scs (character-stack))
299 ;; non-descriptor SAPs (arbitrary pointers into address space)
300 (sap-reg registers
301 :locations #.*qword-regs*
302 :element-size 2
303 ; :reserve-locations (#.eax-offset)
304 :constant-scs (immediate)
305 :save-p t
306 :alternate-scs (sap-stack))
308 ;; non-descriptor (signed or unsigned) numbers
309 (signed-reg registers
310 :locations #.*qword-regs*
311 :element-size 2
312 :constant-scs (immediate)
313 :save-p t
314 :alternate-scs (signed-stack))
315 (unsigned-reg registers
316 :locations #.*qword-regs*
317 :element-size 2
318 :constant-scs (immediate)
319 :save-p t
320 :alternate-scs (unsigned-stack))
322 ;; miscellaneous objects that must not be seen by GC. Used only as
323 ;; temporaries.
324 (word-reg registers
325 :locations #.*word-regs*
326 :element-size 2
328 (dword-reg registers
329 :locations #.*dword-regs*
330 :element-size 2
332 (byte-reg registers
333 :locations #.*byte-regs*
336 ;; that can go in the floating point registers
338 ;; non-descriptor SINGLE-FLOATs
339 (single-reg float-registers
340 :locations #.*float-regs*
341 :constant-scs (fp-single-zero fp-single-immediate)
342 :save-p t
343 :alternate-scs (single-stack))
345 ;; non-descriptor DOUBLE-FLOATs
346 (double-reg float-registers
347 :locations #.*float-regs*
348 :constant-scs (fp-double-zero fp-double-immediate)
349 :save-p t
350 :alternate-scs (double-stack))
352 (complex-single-reg float-registers
353 :locations #.*float-regs*
354 :constant-scs (fp-complex-single-zero fp-complex-single-immediate)
355 :save-p t
356 :alternate-scs (complex-single-stack))
358 (complex-double-reg float-registers
359 :locations #.*float-regs*
360 :constant-scs (fp-complex-double-zero fp-complex-double-immediate)
361 :save-p t
362 :alternate-scs (complex-double-stack))
364 ;; temporary only
365 #!+sb-simd-pack
366 (sse-reg float-registers
367 :locations #.*float-regs*)
368 ;; regular values
369 #!+sb-simd-pack
370 (int-sse-reg float-registers
371 :locations #.*float-regs*
372 :constant-scs (int-sse-immediate)
373 :save-p t
374 :alternate-scs (int-sse-stack))
375 #!+sb-simd-pack
376 (double-sse-reg float-registers
377 :locations #.*float-regs*
378 :constant-scs (double-sse-immediate)
379 :save-p t
380 :alternate-scs (double-sse-stack))
381 #!+sb-simd-pack
382 (single-sse-reg float-registers
383 :locations #.*float-regs*
384 :constant-scs (single-sse-immediate)
385 :save-p t
386 :alternate-scs (single-sse-stack))
388 (catch-block stack :element-size catch-block-size)
389 (unwind-block stack :element-size unwind-block-size))
391 (eval-when (:compile-toplevel :load-toplevel :execute)
392 (defparameter *byte-sc-names*
393 '(#!-sb-unicode character-reg byte-reg #!-sb-unicode character-stack))
394 (defparameter *word-sc-names* '(word-reg))
395 (defparameter *dword-sc-names* '(dword-reg))
396 (defparameter *qword-sc-names*
397 '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack
398 signed-stack unsigned-stack sap-stack single-stack
399 #!+sb-unicode character-reg #!+sb-unicode character-stack constant))
400 ;;; added by jrd. I guess the right thing to do is to treat floats
401 ;;; as a separate size...
403 ;;; These are used to (at least) determine operand size.
404 (defparameter *float-sc-names* '(single-reg))
405 (defparameter *double-sc-names* '(double-reg double-stack))
406 (defparameter *complex-sc-names* '(complex-single-reg complex-single-stack
407 complex-double-reg complex-double-stack))
408 #!+sb-simd-pack
409 (defparameter *oword-sc-names* '(sse-reg int-sse-reg single-sse-reg double-sse-reg
410 sse-stack int-sse-stack single-sse-stack double-sse-stack))
411 ) ; EVAL-WHEN
413 ;;;; miscellaneous TNs for the various registers
415 (macrolet ((def-misc-reg-tns (sc-name &rest reg-names)
416 (collect ((forms))
417 (dolist (reg-name reg-names)
418 (let ((tn-name (symbolicate reg-name "-TN"))
419 (offset-name (symbolicate reg-name "-OFFSET")))
420 ;; FIXME: It'd be good to have the special
421 ;; variables here be named with the *FOO*
422 ;; convention.
423 (forms `(defparameter ,tn-name
424 (make-random-tn :kind :normal
425 :sc (sc-or-lose ',sc-name)
426 :offset
427 ,offset-name)))))
428 `(progn ,@(forms)))))
430 (def-misc-reg-tns unsigned-reg rax rbx rcx rdx rbp rsp rdi rsi
431 r8 r9 r10 r11 r12 r13 r14 r15)
432 (def-misc-reg-tns dword-reg eax ebx ecx edx ebp esp edi esi
433 r8d r9d r10d r11d r12d r13d r14d r15d)
434 (def-misc-reg-tns word-reg ax bx cx dx bp sp di si
435 r8w r9w r10w r11w r12w r13w r14w r15w)
436 (def-misc-reg-tns byte-reg al cl dl bl sil dil r8b r9b r10b
437 r11b r12b r13b r14b r15b)
438 (def-misc-reg-tns single-reg
439 float0 float1 float2 float3 float4 float5 float6 float7
440 float8 float9 float10 float11 float12 float13 float14 float15))
442 (defun reg-in-size (tn size)
443 (make-random-tn :kind :normal
444 :sc (sc-or-lose
445 (ecase size
446 (:byte 'byte-reg)
447 (:word 'word-reg)
448 (:dword 'dword-reg)
449 (:qword 'unsigned-reg)))
450 :offset (tn-offset tn)))
452 ;; A register that's never used by the code generator, and can therefore
453 ;; be used as an assembly temporary in cases where a VOP :TEMPORARY can't
454 ;; be used.
455 (defparameter temp-reg-tn r11-tn)
457 ;;; TNs for registers used to pass arguments
458 (defparameter *register-arg-tns*
459 (mapcar (lambda (register-arg-name)
460 (symbol-value (symbolicate register-arg-name "-TN")))
461 *register-arg-names*))
463 (defparameter thread-base-tn
464 (make-random-tn :kind :normal :sc (sc-or-lose 'unsigned-reg )
465 :offset r12-offset))
467 ;;; If value can be represented as an immediate constant, then return
468 ;;; the appropriate SC number, otherwise return NIL.
469 (defun immediate-constant-sc (value)
470 (typecase value
471 ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
472 character)
473 (sc-number-or-lose 'immediate))
474 (symbol
475 (when (static-symbol-p value)
476 (sc-number-or-lose 'immediate)))
477 (single-float
478 (sc-number-or-lose
479 (if (eql value 0f0) 'fp-single-zero 'fp-single-immediate)))
480 (double-float
481 (sc-number-or-lose
482 (if (eql value 0d0) 'fp-double-zero 'fp-double-immediate)))
483 ((complex single-float)
484 (sc-number-or-lose
485 (if (eql value #c(0f0 0f0))
486 'fp-complex-single-zero
487 'fp-complex-single-immediate)))
488 ((complex double-float)
489 (sc-number-or-lose
490 (if (eql value #c(0d0 0d0))
491 'fp-complex-double-zero
492 'fp-complex-double-immediate)))
493 #!+(and sb-simd-pack (not (host-feature sb-xc-host)))
494 ((simd-pack double-float) (sc-number-or-lose 'double-sse-immediate))
495 #!+(and sb-simd-pack (not (host-feature sb-xc-host)))
496 ((simd-pack single-float) (sc-number-or-lose 'single-sse-immediate))
497 #!+(and sb-simd-pack (not (host-feature sb-xc-host)))
498 (simd-pack (sc-number-or-lose 'int-sse-immediate))))
500 (defun boxed-immediate-sc-p (sc)
501 (eql sc (sc-number-or-lose 'immediate)))
503 (defun encode-value-if-immediate (tn &optional (tag t))
504 (if (sc-is tn immediate)
505 (let ((val (tn-value tn)))
506 (etypecase val
507 (integer (if tag
508 (fixnumize val)
509 val))
510 (symbol (+ nil-value (static-symbol-offset val)))
511 (character (if tag
512 (logior (ash (char-code val) n-widetag-bits)
513 character-widetag)
514 (char-code val)))))
515 tn))
517 ;;;; miscellaneous function call parameters
519 ;;; Offsets of special stack frame locations relative to RBP.
521 ;;; Consider the standard prologue PUSH RBP; MOV RBP, RSP: the return
522 ;;; address is at RBP+8, the old control stack frame pointer is at
523 ;;; RBP, the magic 3rd slot is at RBP-8. Then come the locals from
524 ;;; RBP-16 on.
525 (defconstant return-pc-save-offset 0)
526 (defconstant ocfp-save-offset 1)
527 (defconstant code-save-offset 2)
528 ;;; Let SP be the stack pointer before CALLing, and FP is the frame
529 ;;; pointer after the standard prologue. SP +
530 ;;; FRAME-WORD-OFFSET(SP->FP-OFFSET + I) = FP + FRAME-WORD-OFFSET(I).
531 (defconstant sp->fp-offset 2)
533 (declaim (inline frame-word-offset))
534 (defun frame-word-offset (index)
535 (- (1- index)))
537 (declaim (inline frame-byte-offset))
538 (defun frame-byte-offset (index)
539 (* (frame-word-offset index) n-word-bytes))
541 (defconstant lra-save-offset return-pc-save-offset) ; ?
543 ;;; This is used by the debugger.
544 (defconstant single-value-return-byte-offset 3)
546 ;;; This function is called by debug output routines that want a pretty name
547 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
548 (defun location-print-name (tn)
549 (declare (type tn tn))
550 (let* ((sc (tn-sc tn))
551 (sb (sb-name (sc-sb sc)))
552 (offset (tn-offset tn)))
553 (ecase sb
554 (registers
555 (let* ((sc-name (sc-name sc))
556 (name-vec (cond ((member sc-name *byte-sc-names*)
557 *byte-register-names*)
558 ((member sc-name *word-sc-names*)
559 *word-register-names*)
560 ((member sc-name *dword-sc-names*)
561 *dword-register-names*)
562 ((member sc-name *qword-sc-names*)
563 *qword-register-names*))))
564 (or (and name-vec
565 (< -1 offset (length name-vec))
566 (svref name-vec offset))
567 ;; FIXME: Shouldn't this be an ERROR?
568 (format nil "<unknown reg: off=~W, sc=~A>" offset sc-name))))
569 (float-registers (format nil "FLOAT~D" offset))
570 (stack (format nil "S~D" offset))
571 (constant (format nil "Const~D" offset))
572 (immediate-constant "Immed")
573 (noise (symbol-name (sc-name sc))))))
574 ;;; FIXME: Could this, and everything that uses it, be made #!+SB-SHOW?
576 (defun dwords-for-quad (value)
577 (let* ((lo (logand value (1- (ash 1 32))))
578 (hi (ash value -32)))
579 (values lo hi)))
581 (defun words-for-dword (value)
582 (let* ((lo (logand value (1- (ash 1 16))))
583 (hi (ash value -16)))
584 (values lo hi)))
586 (defconstant cfp-offset rbp-offset) ; pfw - needed by stuff in /code
588 (defun combination-implementation-style (node)
589 (declare (type sb!c::combination node))
590 (flet ((valid-funtype (args result)
591 (sb!c::valid-fun-use node
592 (sb!c::specifier-type
593 `(function ,args ,result)))))
594 (case (sb!c::combination-fun-source-name node)
595 (logtest
596 (cond
597 ((or (valid-funtype '(fixnum fixnum) '*)
598 ;; todo: nothing prevents this from testing an unsigned word against
599 ;; a signed word, except for the mess of VOPs it would demand
600 (valid-funtype '((signed-byte 64) (signed-byte 64)) '*)
601 (valid-funtype '((unsigned-byte 64) (unsigned-byte 64)) '*))
602 (values :maybe nil))
604 (values :default nil))))
605 (logbitp
606 (cond
607 ((or (and (valid-funtype '#.`((integer 0 ,(- 63 n-fixnum-tag-bits))
608 fixnum) '*)
609 (sb!c::constant-lvar-p
610 (first (sb!c::basic-combination-args node))))
611 (valid-funtype '((integer 0 63) (signed-byte 64)) '*)
612 (valid-funtype '((integer 0 63) (unsigned-byte 64)) '*))
613 (values :transform '(lambda (index integer)
614 (%logbitp integer index))))
616 (values :default nil))))
618 (values :default nil)))))