Smaller stack frames on x86oids

[sbcl.git] / src / compiler / x86-64 / vm.lisp

diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp
index 258ccb7..2538e49 100644 (file)
--- a/src/compiler/x86-64/vm.lisp
+++ b/src/compiler/x86-64/vm.lisp
@@ -19,30 +19,30 @@
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defvar *byte-register-names* (make-array 32 :initial-element nil))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defvar *byte-register-names* (make-array 32 :initial-element nil))

-  (defvar *word-register-names* (make-array 16 :initial-element nil))
-  (defvar *dword-register-names* (make-array 16 :initial-element nil))
+  (defvar *word-register-names* (make-array 32 :initial-element nil))
+  (defvar *dword-register-names* (make-array 32 :initial-element nil))

   (defvar *qword-register-names* (make-array 32 :initial-element nil))
   (defvar *float-register-names* (make-array 16 :initial-element nil)))
 
 (macrolet ((defreg (name offset size)
   (defvar *qword-register-names* (make-array 32 :initial-element nil))
   (defvar *float-register-names* (make-array 16 :initial-element nil)))
 
 (macrolet ((defreg (name offset size)

-            (let ((offset-sym (symbolicate name "-OFFSET"))
-                  (names-vector (symbolicate "*" size "-REGISTER-NAMES*")))
-              `(progn
-                 (eval-when (:compile-toplevel :load-toplevel :execute)
+             (let ((offset-sym (symbolicate name "-OFFSET"))
+                   (names-vector (symbolicate "*" size "-REGISTER-NAMES*")))
+               `(progn
+                  (eval-when (:compile-toplevel :load-toplevel :execute)

                     ;; EVAL-WHEN is necessary because stuff like #.EAX-OFFSET
                     ;; (in the same file) depends on compile-time evaluation
                     ;; of the DEFCONSTANT. -- AL 20010224
                     ;; EVAL-WHEN is necessary because stuff like #.EAX-OFFSET
                     ;; (in the same file) depends on compile-time evaluation
                     ;; of the DEFCONSTANT. -- AL 20010224

-                   (def!constant ,offset-sym ,offset))
-                 (setf (svref ,names-vector ,offset-sym)
-                       ,(symbol-name name)))))
-          ;; FIXME: It looks to me as though DEFREGSET should also
-          ;; define the related *FOO-REGISTER-NAMES* variable.
-          (defregset (name &rest regs)
-            `(eval-when (:compile-toplevel :load-toplevel :execute)
-               (defparameter ,name
-                 (list ,@(mapcar (lambda (name)
-                                   (symbolicate name "-OFFSET"))
-                                 regs))))))
+                    (def!constant ,offset-sym ,offset))
+                  (setf (svref ,names-vector ,offset-sym)
+                        ,(symbol-name name)))))
+           ;; FIXME: It looks to me as though DEFREGSET should also
+           ;; define the related *FOO-REGISTER-NAMES* variable.
+           (defregset (name &rest regs)
+             `(eval-when (:compile-toplevel :load-toplevel :execute)
+                (defparameter ,name
+                  (list ,@(mapcar (lambda (name)
+                                    (symbolicate name "-OFFSET"))
+                                  regs))))))

 
   ;; byte registers
   ;;
 
   ;; byte registers
   ;;

@@ -71,7 +71,7 @@
   (defreg r15b 30 :byte)
   (defregset *byte-regs*
       al cl dl bl sil dil r8b r9b r10b
   (defreg r15b 30 :byte)
   (defregset *byte-regs*
       al cl dl bl sil dil r8b r9b r10b

-      r11b #+nil r12b #+nil r13b r14b r15b)
+      #+nil r11b #+nil r12b r13b r14b r15b)

 
   ;; word registers
   (defreg ax 0 :word)
 
   ;; word registers
   (defreg ax 0 :word)

@@ -82,7 +82,16 @@
   (defreg bp 10 :word)
   (defreg si 12 :word)
   (defreg di 14 :word)
   (defreg bp 10 :word)
   (defreg si 12 :word)
   (defreg di 14 :word)

-  (defregset *word-regs* ax cx dx bx si di)
+  (defreg r8w  16 :word)
+  (defreg r9w  18 :word)
+  (defreg r10w 20 :word)
+  (defreg r11w 22 :word)
+  (defreg r12w 24 :word)
+  (defreg r13w 26 :word)
+  (defreg r14w 28 :word)
+  (defreg r15w 30 :word)
+  (defregset *word-regs* ax cx dx bx si di r8w r9w r10w
+             #+nil r11w #+nil r12w r13w r14w r15w)

 
   ;; double word registers
   (defreg eax 0 :dword)
 
   ;; double word registers
   (defreg eax 0 :dword)

@@ -93,7 +102,16 @@
   (defreg ebp 10 :dword)
   (defreg esi 12 :dword)
   (defreg edi 14 :dword)
   (defreg ebp 10 :dword)
   (defreg esi 12 :dword)
   (defreg edi 14 :dword)

-  (defregset *dword-regs* eax ecx edx ebx esi edi)
+  (defreg r8d  16 :dword)
+  (defreg r9d  18 :dword)
+  (defreg r10d 20 :dword)
+  (defreg r11d 22 :dword)
+  (defreg r12d 24 :dword)
+  (defreg r13d 26 :dword)
+  (defreg r14d 28 :dword)
+  (defreg r15d 30 :dword)
+  (defregset *dword-regs* eax ecx edx ebx esi edi r8d r9d r10d
+             #+nil r11d #+nil r12w r13d r14d r15d)

 
   ;; quadword registers
   (defreg rax 0 :qword)
 
   ;; quadword registers
   (defreg rax 0 :qword)

@@ -116,8 +134,13 @@
   ;; list of qword registers.  However
   ;; <jsnell> r13 is already used as temporary [#lisp irc 2005/01/30]
   ;; and we're now going to use r12 for the struct thread*
   ;; list of qword registers.  However
   ;; <jsnell> r13 is already used as temporary [#lisp irc 2005/01/30]
   ;; and we're now going to use r12 for the struct thread*

-  (defregset *qword-regs* rax rcx rdx rbx rsi rdi 
-            r8 r9 r10 r11      r14 r15)
+  ;;
+  ;; Except that now we use r11 instead of r13 as the temporary,
+  ;; since it's got a more compact encoding than r13, and experimentally
+  ;; the temporary gets used more than the other registers that are never
+  ;; wired. -- JES, 2005-11-02
+  (defregset *qword-regs* rax rcx rdx rbx rsi rdi
+             r8 r9 r10 #+nil r11 #+nil r12 r13  r14 r15)

 
   ;; floating point registers
   (defreg float0 0 :float)
 
   ;; floating point registers
   (defreg float0 0 :float)

@@ -137,7 +160,7 @@
   (defreg float14 14 :float)
   (defreg float15 15 :float)
   (defregset *float-regs* float0 float1 float2 float3 float4 float5 float6 float7
   (defreg float14 14 :float)
   (defreg float15 15 :float)
   (defregset *float-regs* float0 float1 float2 float3 float4 float5 float6 float7

-            float8 float9 float10 float11 float12 float13 float14 float15)
+             float8 float9 float10 float11 float12 float13 float14 float15)

 
   ;; registers used to pass arguments
   ;;
 
   ;; registers used to pass arguments
   ;;

@@ -147,7 +170,10 @@
   (eval-when (:compile-toplevel :load-toplevel :execute)
     (defparameter *register-arg-names* '(rdx rdi rsi)))
   (defregset    *register-arg-offsets* rdx rdi rsi)
   (eval-when (:compile-toplevel :load-toplevel :execute)
     (defparameter *register-arg-names* '(rdx rdi rsi)))
   (defregset    *register-arg-offsets* rdx rdi rsi)

-  (defregset    *c-call-register-arg-offsets* rdi rsi rdx rcx r8 r9))
+  #!-win32
+  (defregset    *c-call-register-arg-offsets* rdi rsi rdx rcx r8 r9)
+  #!+win32
+  (defregset    *c-call-register-arg-offsets* rcx rdx r8 r9))

 \f
 ;;;; SB definitions
 
 \f
 ;;;; SB definitions
 

@@ -161,7 +187,7 @@
 
 (define-storage-base float-registers :finite :size 16)
 
 
 (define-storage-base float-registers :finite :size 16)
 

-(define-storage-base stack :unbounded :size 8)
+(define-storage-base stack :unbounded :size 4 :size-increment 1)

 (define-storage-base constant :non-packed)
 (define-storage-base immediate-constant :non-packed)
 (define-storage-base noise :unbounded :size 2)
 (define-storage-base constant :non-packed)
 (define-storage-base immediate-constant :non-packed)
 (define-storage-base noise :unbounded :size 2)

@@ -175,12 +201,12 @@
   (collect ((forms))
     (let ((index 0))
       (dolist (class classes)
   (collect ((forms))
     (let ((index 0))
       (dolist (class classes)

-       (let* ((sc-name (car class))
-              (constant-name (symbolicate sc-name "-SC-NUMBER")))
-         (forms `(define-storage-class ,sc-name ,index
-                   ,@(cdr class)))
-         (forms `(def!constant ,constant-name ,index))
-         (incf index))))
+        (let* ((sc-name (car class))
+               (constant-name (symbolicate sc-name "-SC-NUMBER")))
+          (forms `(define-storage-class ,sc-name ,index
+                    ,@(cdr class)))
+          (forms `(def!constant ,constant-name ,index))
+          (incf index))))

     `(progn
        ,@(forms))))
 
     `(progn
        ,@(forms))))
 

@@ -203,7 +229,7 @@
 ;;; (What a KLUDGE! Anyone who wants to come in and clean up this mess
 ;;; has my gratitude.) (FIXME: Maybe this should be me..)
 (eval-when (:compile-toplevel :load-toplevel :execute)
 ;;; (What a KLUDGE! Anyone who wants to come in and clean up this mess
 ;;; has my gratitude.) (FIXME: Maybe this should be me..)
 (eval-when (:compile-toplevel :load-toplevel :execute)

-  (def!constant kludge-nondeterministic-catch-block-size 6))
+  (def!constant kludge-nondeterministic-catch-block-size 5))

 
 (!define-storage-classes
 
 
 (!define-storage-classes
 

@@ -212,27 +238,43 @@
 
   (fp-single-zero immediate-constant)
   (fp-double-zero immediate-constant)
 
   (fp-single-zero immediate-constant)
   (fp-double-zero immediate-constant)

+  (fp-complex-single-zero immediate-constant)
+  (fp-complex-double-zero immediate-constant)
+
+  (fp-single-immediate immediate-constant)
+  (fp-double-immediate immediate-constant)
+  (fp-complex-single-immediate immediate-constant)
+  (fp-complex-double-immediate immediate-constant)
+
+  #!+sb-simd-pack (int-sse-immediate immediate-constant)
+  #!+sb-simd-pack (double-sse-immediate immediate-constant)
+  #!+sb-simd-pack (single-sse-immediate immediate-constant)

 
   (immediate immediate-constant)
 
   ;;
   ;; the stacks
   ;;
 
   (immediate immediate-constant)
 
   ;;
   ;; the stacks
   ;;

-  
+

   ;; the control stack
   ;; the control stack

-  (control-stack stack)                        ; may be pointers, scanned by GC
+  (control-stack stack)                 ; may be pointers, scanned by GC

 
   ;; the non-descriptor stacks
   ;; XXX alpha backend has :element-size 2 :alignment 2 in these entries
 
   ;; the non-descriptor stacks
   ;; XXX alpha backend has :element-size 2 :alignment 2 in these entries

-  (signed-stack stack)                 ; (signed-byte 32)
-  (unsigned-stack stack)               ; (unsigned-byte 32)
-  (character-stack stack)              ; non-descriptor characters.
-  (sap-stack stack)                    ; System area pointers.
-  (single-stack stack)                 ; single-floats
+  (signed-stack stack)                  ; (signed-byte 64)
+  (unsigned-stack stack)                ; (unsigned-byte 64)
+  (character-stack stack)               ; non-descriptor characters.
+  (sap-stack stack)                     ; System area pointers.
+  (single-stack stack)                  ; single-floats

   (double-stack stack)
   (double-stack stack)

-  (complex-single-stack stack :element-size 2) ; complex-single-floats
-  (complex-double-stack stack :element-size 2) ; complex-double-floats
-
+  (complex-single-stack stack)  ; complex-single-floats
+  (complex-double-stack stack :element-size 2)  ; complex-double-floats
+  #!+sb-simd-pack
+  (int-sse-stack stack :element-size 2)
+  #!+sb-simd-pack
+  (double-sse-stack stack :element-size 2)
+  #!+sb-simd-pack
+  (single-sse-stack stack :element-size 2)

 
   ;;
   ;; magic SCs
 
   ;;
   ;; magic SCs

@@ -252,109 +294,133 @@
   ;; immediate descriptor objects. Don't have to be seen by GC, but nothing
   ;; bad will happen if they are. (fixnums, characters, header values, etc).
   (any-reg registers
   ;; immediate descriptor objects. Don't have to be seen by GC, but nothing
   ;; bad will happen if they are. (fixnums, characters, header values, etc).
   (any-reg registers

-          :locations #.*qword-regs*
-          :element-size 2 ; I think this is for the al/ah overlap thing
-          :constant-scs (immediate)
-          :save-p t
-          :alternate-scs (control-stack))
+           :locations #.*qword-regs*
+           :element-size 2 ; I think this is for the al/ah overlap thing
+           :constant-scs (immediate)
+           :save-p t
+           :alternate-scs (control-stack))

 
   ;; pointer descriptor objects -- must be seen by GC
   (descriptor-reg registers
 
   ;; pointer descriptor objects -- must be seen by GC
   (descriptor-reg registers

-                 :locations #.*qword-regs*
-                 :element-size 2
-;                :reserve-locations (#.eax-offset)
-                 :constant-scs (constant immediate)
-                 :save-p t
-                 :alternate-scs (control-stack))
+                  :locations #.*qword-regs*
+                  :element-size 2
+;                 :reserve-locations (#.eax-offset)
+                  :constant-scs (constant immediate)
+                  :save-p t
+                  :alternate-scs (control-stack))

 
   ;; non-descriptor characters
   (character-reg registers
 
   ;; non-descriptor characters
   (character-reg registers

-                :locations #!-sb-unicode #.*byte-regs*
-                           #!+sb-unicode #.*qword-regs*
-                #!-sb-unicode #!-sb-unicode
-                :reserve-locations (#.al-offset)
-                :constant-scs (immediate)
-                :save-p t
-                :alternate-scs (character-stack))
+                 :locations #!-sb-unicode #.*byte-regs*
+                            #!+sb-unicode #.*qword-regs*
+                 #!+sb-unicode #!+sb-unicode
+                 :element-size 2
+                 #!-sb-unicode #!-sb-unicode
+                 :reserve-locations (#.al-offset)
+                 :constant-scs (immediate)
+                 :save-p t
+                 :alternate-scs (character-stack))

 
   ;; non-descriptor SAPs (arbitrary pointers into address space)
   (sap-reg registers
 
   ;; non-descriptor SAPs (arbitrary pointers into address space)
   (sap-reg registers

-          :locations #.*qword-regs*
-          :element-size 2
-;         :reserve-locations (#.eax-offset)
-          :constant-scs (immediate)
-          :save-p t
-          :alternate-scs (sap-stack))
+           :locations #.*qword-regs*
+           :element-size 2
+;          :reserve-locations (#.eax-offset)
+           :constant-scs (immediate)
+           :save-p t
+           :alternate-scs (sap-stack))

 
   ;; non-descriptor (signed or unsigned) numbers
   (signed-reg registers
 
   ;; non-descriptor (signed or unsigned) numbers
   (signed-reg registers

-             :locations #.*qword-regs*
-             :element-size 2
-             :constant-scs (immediate)
-             :save-p t
-             :alternate-scs (signed-stack))
+              :locations #.*qword-regs*
+              :element-size 2
+              :constant-scs (immediate)
+              :save-p t
+              :alternate-scs (signed-stack))

   (unsigned-reg registers
   (unsigned-reg registers

-               :locations #.*qword-regs*
-               :element-size 2
-               :constant-scs (immediate)
-               :save-p t
-               :alternate-scs (unsigned-stack))
+                :locations #.*qword-regs*
+                :element-size 2
+                :constant-scs (immediate)
+                :save-p t
+                :alternate-scs (unsigned-stack))

 
   ;; miscellaneous objects that must not be seen by GC. Used only as
   ;; temporaries.
   (word-reg registers
 
   ;; miscellaneous objects that must not be seen by GC. Used only as
   ;; temporaries.
   (word-reg registers

-           :locations #.*word-regs*
-           :element-size 2
-           )
+            :locations #.*word-regs*
+            :element-size 2
+            )

   (dword-reg registers
   (dword-reg registers

-           :locations #.*dword-regs*
-           :element-size 2
-           )
+            :locations #.*dword-regs*
+            :element-size 2
+            )

   (byte-reg registers
   (byte-reg registers

-           :locations #.*byte-regs*
-           )
+            :locations #.*byte-regs*
+            )

 
   ;; that can go in the floating point registers
 
   ;; non-descriptor SINGLE-FLOATs
   (single-reg float-registers
 
   ;; that can go in the floating point registers
 
   ;; non-descriptor SINGLE-FLOATs
   (single-reg float-registers

-             :locations #.(loop for i from 0 below 15 collect i)
-             :constant-scs (fp-single-zero)
-             :save-p t
-             :alternate-scs (single-stack))
+              :locations #.*float-regs*
+              :constant-scs (fp-single-zero fp-single-immediate)
+              :save-p t
+              :alternate-scs (single-stack))

 
   ;; non-descriptor DOUBLE-FLOATs
   (double-reg float-registers
 
   ;; non-descriptor DOUBLE-FLOATs
   (double-reg float-registers

-             :locations #.(loop for i from 0 below 15 collect i)
-             :constant-scs (fp-double-zero)
-             :save-p t
-             :alternate-scs (double-stack))
+              :locations #.*float-regs*
+              :constant-scs (fp-double-zero fp-double-immediate)
+              :save-p t
+              :alternate-scs (double-stack))

 
   (complex-single-reg float-registers
 
   (complex-single-reg float-registers

-                     :locations #.(loop for i from 0 to 14 by 2 collect i)
-                     :element-size 2
-                     :constant-scs ()
-                     :save-p t
-                     :alternate-scs (complex-single-stack))
+                      :locations #.*float-regs*
+                      :constant-scs (fp-complex-single-zero fp-complex-single-immediate)
+                      :save-p t
+                      :alternate-scs (complex-single-stack))

 
   (complex-double-reg float-registers
 
   (complex-double-reg float-registers

-                     :locations #.(loop for i from 0 to 14 by 2 collect i)
-                     :element-size 2
-                     :constant-scs ()
-                     :save-p t
-                     :alternate-scs (complex-double-stack))
+                      :locations #.*float-regs*
+                      :constant-scs (fp-complex-double-zero fp-complex-double-immediate)
+                      :save-p t
+                      :alternate-scs (complex-double-stack))
+
+  ;; temporary only
+  #!+sb-simd-pack
+  (sse-reg float-registers
+           :locations #.*float-regs*)
+  ;; regular values
+  #!+sb-simd-pack
+  (int-sse-reg float-registers
+               :locations #.*float-regs*
+               :constant-scs (int-sse-immediate)
+               :save-p t
+               :alternate-scs (int-sse-stack))
+  #!+sb-simd-pack
+  (double-sse-reg float-registers
+                  :locations #.*float-regs*
+                  :constant-scs (double-sse-immediate)
+                  :save-p t
+                  :alternate-scs (double-sse-stack))
+  #!+sb-simd-pack
+  (single-sse-reg float-registers
+                  :locations #.*float-regs*
+                  :constant-scs (single-sse-immediate)
+                  :save-p t
+                  :alternate-scs (single-sse-stack))

 
   ;; a catch or unwind block
   (catch-block stack :element-size kludge-nondeterministic-catch-block-size))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
 
   ;; a catch or unwind block
   (catch-block stack :element-size kludge-nondeterministic-catch-block-size))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)

-(defparameter *byte-sc-names* 
+(defparameter *byte-sc-names*

   '(#!-sb-unicode character-reg byte-reg #!-sb-unicode character-stack))
 (defparameter *word-sc-names* '(word-reg))
 (defparameter *dword-sc-names* '(dword-reg))
   '(#!-sb-unicode character-reg byte-reg #!-sb-unicode character-stack))
 (defparameter *word-sc-names* '(word-reg))
 (defparameter *dword-sc-names* '(dword-reg))

-(defparameter *qword-sc-names* 
+(defparameter *qword-sc-names*

   '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack
   '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack

-    signed-stack unsigned-stack sap-stack single-stack 
+    signed-stack unsigned-stack sap-stack single-stack

     #!+sb-unicode character-reg #!+sb-unicode character-stack constant))
 ;;; added by jrd. I guess the right thing to do is to treat floats
 ;;; as a separate size...
     #!+sb-unicode character-reg #!+sb-unicode character-stack constant))
 ;;; added by jrd. I guess the right thing to do is to treat floats
 ;;; as a separate size...

@@ -362,81 +428,132 @@
 ;;; These are used to (at least) determine operand size.
 (defparameter *float-sc-names* '(single-reg))
 (defparameter *double-sc-names* '(double-reg double-stack))
 ;;; These are used to (at least) determine operand size.
 (defparameter *float-sc-names* '(single-reg))
 (defparameter *double-sc-names* '(double-reg double-stack))

+(defparameter *complex-sc-names* '(complex-single-reg complex-single-stack
+                                   complex-double-reg complex-double-stack))
+#!+sb-simd-pack
+(defparameter *oword-sc-names* '(sse-reg int-sse-reg single-sse-reg double-sse-reg
+                                 sse-stack int-sse-stack single-sse-stack double-sse-stack))

 ) ; EVAL-WHEN
 \f
 ;;;; miscellaneous TNs for the various registers
 
 (macrolet ((def-misc-reg-tns (sc-name &rest reg-names)
 ) ; EVAL-WHEN
 \f
 ;;;; miscellaneous TNs for the various registers
 
 (macrolet ((def-misc-reg-tns (sc-name &rest reg-names)

-            (collect ((forms))
-                     (dolist (reg-name reg-names)
-                       (let ((tn-name (symbolicate reg-name "-TN"))
-                             (offset-name (symbolicate reg-name "-OFFSET")))
-                         ;; FIXME: It'd be good to have the special
-                         ;; variables here be named with the *FOO*
-                         ;; convention.
-                         (forms `(defparameter ,tn-name
-                                   (make-random-tn :kind :normal
-                                                   :sc (sc-or-lose ',sc-name)
-                                                   :offset
-                                                   ,offset-name)))))
-                     `(progn ,@(forms)))))
+             (collect ((forms))
+                      (dolist (reg-name reg-names)
+                        (let ((tn-name (symbolicate reg-name "-TN"))
+                              (offset-name (symbolicate reg-name "-OFFSET")))
+                          ;; FIXME: It'd be good to have the special
+                          ;; variables here be named with the *FOO*
+                          ;; convention.
+                          (forms `(defparameter ,tn-name
+                                    (make-random-tn :kind :normal
+                                                    :sc (sc-or-lose ',sc-name)
+                                                    :offset
+                                                    ,offset-name)))))
+                      `(progn ,@(forms)))))

 
   (def-misc-reg-tns unsigned-reg rax rbx rcx rdx rbp rsp rdi rsi
 
   (def-misc-reg-tns unsigned-reg rax rbx rcx rdx rbp rsp rdi rsi

-                   r8 r9 r10 r11  r12 r13 r14 r15)
-  (def-misc-reg-tns dword-reg eax ebx ecx edx ebp esp edi esi)
-  (def-misc-reg-tns word-reg ax bx cx dx bp sp di si)
+                    r8 r9 r10 r11 r12 r13 r14 r15)
+  (def-misc-reg-tns dword-reg eax ebx ecx edx ebp esp edi esi
+                    r8d r9d r10d r11d r12d r13d r14d r15d)
+  (def-misc-reg-tns word-reg ax bx cx dx bp sp di si
+                    r8w r9w r10w r11w r12w r13w r14w r15w)

   (def-misc-reg-tns byte-reg al cl dl bl sil dil r8b r9b r10b
   (def-misc-reg-tns byte-reg al cl dl bl sil dil r8b r9b r10b

-                   r11b r14b r15b)
-  (def-misc-reg-tns single-reg 
+                    r11b r12b r13b r14b r15b)
+  (def-misc-reg-tns single-reg

       float0 float1 float2 float3 float4 float5 float6 float7
       float8 float9 float10 float11 float12 float13 float14 float15))
 
       float0 float1 float2 float3 float4 float5 float6 float7
       float8 float9 float10 float11 float12 float13 float14 float15))
 

+(defun reg-in-size (tn size)
+  (make-random-tn :kind :normal
+                  :sc (sc-or-lose
+                       (ecase size
+                         (:byte 'byte-reg)
+                         (:word 'word-reg)
+                         (:dword 'dword-reg)
+                         (:qword 'unsigned-reg)))
+                  :offset (tn-offset tn)))
+
+;; A register that's never used by the code generator, and can therefore
+;; be used as an assembly temporary in cases where a VOP :TEMPORARY can't
+;; be used.
+(defparameter temp-reg-tn r11-tn)
+

 ;;; TNs for registers used to pass arguments
 (defparameter *register-arg-tns*
   (mapcar (lambda (register-arg-name)
 ;;; TNs for registers used to pass arguments
 (defparameter *register-arg-tns*
   (mapcar (lambda (register-arg-name)

-           (symbol-value (symbolicate register-arg-name "-TN")))
-         *register-arg-names*))
+            (symbol-value (symbolicate register-arg-name "-TN")))
+          *register-arg-names*))

 
 (defparameter thread-base-tn
   (make-random-tn :kind :normal :sc (sc-or-lose 'unsigned-reg )
 
 (defparameter thread-base-tn
   (make-random-tn :kind :normal :sc (sc-or-lose 'unsigned-reg )

-                 :offset r12-offset))
-
-(defparameter fp-single-zero-tn
-  (make-random-tn :kind :normal
-                 :sc (sc-or-lose 'single-reg)
-                 :offset 15))
-
-(defparameter fp-double-zero-tn
-  (make-random-tn :kind :normal
-                 :sc (sc-or-lose 'double-reg)
-                 :offset 15))
+                  :offset r12-offset))

 
 ;;; If value can be represented as an immediate constant, then return
 ;;; the appropriate SC number, otherwise return NIL.
 
 ;;; If value can be represented as an immediate constant, then return
 ;;; the appropriate SC number, otherwise return NIL.

-(!def-vm-support-routine immediate-constant-sc (value)
+(defun immediate-constant-sc (value)

   (typecase value
     ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)
   (typecase value
     ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum)

-        #-sb-xc-host system-area-pointer character)
+         character)

      (sc-number-or-lose 'immediate))
     (symbol
      (when (static-symbol-p value)
        (sc-number-or-lose 'immediate)))
     (single-float
      (sc-number-or-lose 'immediate))
     (symbol
      (when (static-symbol-p value)
        (sc-number-or-lose 'immediate)))
     (single-float

-     (if (eql value 0f0)
-        (sc-number-or-lose 'fp-single-zero )
-        nil))
+       (sc-number-or-lose
+        (if (eql value 0f0) 'fp-single-zero 'fp-single-immediate)))

     (double-float
     (double-float

-     (if (eql value 0d0)
-        (sc-number-or-lose 'fp-double-zero )
-        nil))))
-
+       (sc-number-or-lose
+        (if (eql value 0d0) 'fp-double-zero 'fp-double-immediate)))
+    ((complex single-float)
+       (sc-number-or-lose
+        (if (eql value #c(0f0 0f0))
+            'fp-complex-single-zero
+            'fp-complex-single-immediate)))
+    ((complex double-float)
+       (sc-number-or-lose
+        (if (eql value #c(0d0 0d0))
+            'fp-complex-double-zero
+            'fp-complex-double-immediate)))
+    #!+sb-simd-pack
+    (#+sb-xc-host nil
+     #-sb-xc-host (simd-pack double-float)
+        (sc-number-or-lose 'double-sse-immediate))
+    #!+sb-simd-pack
+    (#+sb-xc-host nil
+     #-sb-xc-host (simd-pack single-float)
+     (sc-number-or-lose 'single-sse-immediate))
+    #!+sb-simd-pack
+    (#+sb-xc-host nil
+     #-sb-xc-host simd-pack
+     (sc-number-or-lose 'int-sse-immediate))))
+
+(defun boxed-immediate-sc-p (sc)
+  (eql sc (sc-number-or-lose 'immediate)))

 \f
 ;;;; miscellaneous function call parameters
 
 \f
 ;;;; miscellaneous function call parameters
 

-;;; offsets of special stack frame locations
-(def!constant ocfp-save-offset 0)
-(def!constant return-pc-save-offset 1)
+;;; Offsets of special stack frame locations relative to RBP.
+;;;
+;;; Consider the standard prologue PUSH RBP; MOV RBP, RSP: the return
+;;; address is at RBP+8, the old control stack frame pointer is at
+;;; RBP, the magic 3rd slot is at RBP-8. Then come the locals from
+;;; RBP-16 on.
+(def!constant return-pc-save-offset 0)
+(def!constant ocfp-save-offset 1)

 (def!constant code-save-offset 2)
 (def!constant code-save-offset 2)

+;;; Let SP be the stack pointer before CALLing, and FP is the frame
+;;; pointer after the standard prologue. SP +
+;;; FRAME-WORD-OFFSET(SP->FP-OFFSET + I) = FP + FRAME-WORD-OFFSET(I).
+(def!constant sp->fp-offset 2)
+
+(declaim (inline frame-word-offset))
+(defun frame-word-offset (index)
+  (- (1- index)))
+
+(declaim (inline frame-byte-offset))
+(defun frame-byte-offset (index)
+  (* (frame-word-offset index) n-word-bytes))

 
 (def!constant lra-save-offset return-pc-save-offset) ; ?
 
 
 (def!constant lra-save-offset return-pc-save-offset) ; ?
 

@@ -445,27 +562,27 @@
 \f
 ;;; This function is called by debug output routines that want a pretty name
 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
 \f
 ;;; This function is called by debug output routines that want a pretty name
 ;;; for a TN's location. It returns a thing that can be printed with PRINC.

-(!def-vm-support-routine location-print-name (tn)
+(defun location-print-name (tn)

   (declare (type tn tn))
   (let* ((sc (tn-sc tn))
   (declare (type tn tn))
   (let* ((sc (tn-sc tn))

-        (sb (sb-name (sc-sb sc)))
-        (offset (tn-offset tn)))
+         (sb (sb-name (sc-sb sc)))
+         (offset (tn-offset tn)))

     (ecase sb
       (registers
        (let* ((sc-name (sc-name sc))
     (ecase sb
       (registers
        (let* ((sc-name (sc-name sc))

-             (name-vec (cond ((member sc-name *byte-sc-names*)
-                              *byte-register-names*)
-                             ((member sc-name *word-sc-names*)
-                              *word-register-names*)
-                             ((member sc-name *dword-sc-names*)
-                              *dword-register-names*)
-                             ((member sc-name *qword-sc-names*)
-                              *qword-register-names*))))
-        (or (and name-vec
-                 (< -1 offset (length name-vec))
-                 (svref name-vec offset))
-            ;; FIXME: Shouldn't this be an ERROR?
-            (format nil "<unknown reg: off=~W, sc=~A>" offset sc-name))))
+              (name-vec (cond ((member sc-name *byte-sc-names*)
+                               *byte-register-names*)
+                              ((member sc-name *word-sc-names*)
+                               *word-register-names*)
+                              ((member sc-name *dword-sc-names*)
+                               *dword-register-names*)
+                              ((member sc-name *qword-sc-names*)
+                               *qword-register-names*))))
+         (or (and name-vec
+                  (< -1 offset (length name-vec))
+                  (svref name-vec offset))
+             ;; FIXME: Shouldn't this be an ERROR?
+             (format nil "<unknown reg: off=~W, sc=~A>" offset sc-name))))

       (float-registers (format nil "FLOAT~D" offset))
       (stack (format nil "S~D" offset))
       (constant (format nil "Const~D" offset))
       (float-registers (format nil "FLOAT~D" offset))
       (stack (format nil "S~D" offset))
       (constant (format nil "Const~D" offset))

@@ -475,13 +592,44 @@
 
 (defun dwords-for-quad (value)
   (let* ((lo (logand value (1- (ash 1 32))))
 
 (defun dwords-for-quad (value)
   (let* ((lo (logand value (1- (ash 1 32))))

-        (hi (ash value -32)))
+         (hi (ash value -32)))

     (values lo hi)))
 
 (defun words-for-dword (value)
   (let* ((lo (logand value (1- (ash 1 16))))
     (values lo hi)))
 
 (defun words-for-dword (value)
   (let* ((lo (logand value (1- (ash 1 16))))

-        (hi (ash value -16)))
+         (hi (ash value -16)))

     (values lo hi)))
 
 (def!constant cfp-offset rbp-offset) ; pfw - needed by stuff in /code
 
     (values lo hi)))
 
 (def!constant cfp-offset rbp-offset) ; pfw - needed by stuff in /code
 

+(defun combination-implementation-style (node)
+  (declare (type sb!c::combination node))
+  (flet ((valid-funtype (args result)
+           (sb!c::valid-fun-use node
+                                (sb!c::specifier-type
+                                 `(function ,args ,result)))))
+    (case (sb!c::combination-fun-source-name node)
+      (logtest
+       (cond
+         ((or (valid-funtype '(fixnum fixnum) '*)
+              ;; todo: nothing prevents this from testing an unsigned word against
+              ;; a signed word, except for the mess of VOPs it would demand
+              (valid-funtype '((signed-byte 64) (signed-byte 64)) '*)
+              (valid-funtype '((unsigned-byte 64) (unsigned-byte 64)) '*))
+          (values :maybe nil))
+         (t
+          (values :default nil))))
+      (logbitp
+       (cond
+         ((or (and (valid-funtype '#.`((integer 0 ,(- 63 n-fixnum-tag-bits))
+                                       fixnum) '*)
+                   (sb!c::constant-lvar-p
+                    (first (sb!c::basic-combination-args node))))
+              (valid-funtype '((integer 0 63) (signed-byte 64)) '*)
+              (valid-funtype '((integer 0 63) (unsigned-byte 64)) '*))
+          (values :transform '(lambda (index integer)
+                               (%logbitp integer index))))
+         (t
+          (values :default nil))))
+      (t
+       (values :default nil)))))