X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fvm.lisp;h=ce601981181090f9fc909f21eab9ae0ff7ad8648;hb=c4b30c86e3dd1d1cc70c572a6cfffe8b84e9c34a;hp=405ca67823233461b278c13d2d177e9a0cedbb89;hpb=2973941cf214a5ea274cd0381a651ce0e1a7fab2;p=sbcl.git

diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp
index 405ca67..ce60198 100644
--- a/src/compiler/x86-64/vm.lisp
+++ b/src/compiler/x86-64/vm.lisp
@@ -217,6 +217,13 @@
 
   (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)
 
   (immediate immediate-constant)
 
@@ -235,7 +242,7 @@
   (sap-stack stack)                     ; System area pointers.
   (single-stack stack)                  ; single-floats
   (double-stack stack)
-  (complex-single-stack stack :element-size 2)  ; complex-single-floats
+  (complex-single-stack stack)  ; complex-single-floats
   (complex-double-stack stack :element-size 2)  ; complex-double-floats
 
 
@@ -325,29 +332,27 @@
 
   ;; non-descriptor SINGLE-FLOATs
   (single-reg float-registers
-              :locations #.(loop for i from 0 below 15 collect i)
-              :constant-scs (fp-single-zero)
+              :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
-              :locations #.(loop for i from 0 below 15 collect i)
-              :constant-scs (fp-double-zero)
+              :locations #.*float-regs*
+              :constant-scs (fp-double-zero fp-double-immediate)
               :save-p t
               :alternate-scs (double-stack))
 
   (complex-single-reg float-registers
-                      :locations #.(loop for i from 0 to 14 by 2 collect i)
-                      :element-size 2
-                      :constant-scs ()
+                      :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
-                      :locations #.(loop for i from 0 to 14 by 2 collect i)
-                      :element-size 2
-                      :constant-scs ()
+                      :locations #.*float-regs*
+                      :constant-scs (fp-complex-double-zero fp-complex-double-immediate)
                       :save-p t
                       :alternate-scs (complex-double-stack))
 
@@ -369,6 +374,8 @@
 ;;; 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))
 ) ; EVAL-WHEN
 
 ;;;; miscellaneous TNs for the various registers
@@ -413,16 +420,6 @@
   (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))
-
 ;;; 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)
@@ -434,25 +431,42 @@
      (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
-     (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)))))
 
 
 ;;;; miscellaneous function call parameters
 
-;;; offsets of special stack frame locations
-(def!constant ocfp-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)
+;;; 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)))
+  (- (1- index)))
 
 (declaim (inline frame-byte-offset))
 (defun frame-byte-offset (index)