X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=src%2Fcompiler%2Fx86-64%2Fvm.lisp;h=78c2df39cdb1101dc8a1312a23708c4f2f8c45ac;hb=a157ed0be79751f85b8243c06102eea95af06aa3;hp=780322020243a37cac8ea906e53264804718c3ac;hpb=86636706a92cbf7eac49c0e9a8ba9d5b49a0cd3f;p=sbcl.git

diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp
index 7803220..78c2df3 100644
--- a/src/compiler/x86-64/vm.lisp
+++ b/src/compiler/x86-64/vm.lisp
@@ -217,6 +217,8 @@
 
   (fp-single-zero immediate-constant)
   (fp-double-zero immediate-constant)
+  (fp-complex-single-zero immediate-constant)
+  (fp-complex-double-zero immediate-constant)
 
   (immediate immediate-constant)
 
@@ -235,7 +237,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 +327,27 @@
 
   ;; non-descriptor SINGLE-FLOATs
   (single-reg float-registers
-              :locations #.(loop for i from 0 below 15 collect i)
+              :locations #.*float-regs*
               :constant-scs (fp-single-zero)
               :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)
+              :locations #.*float-regs*
               :constant-scs (fp-double-zero)
               :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)
                       :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)
                       :save-p t
                       :alternate-scs (complex-double-stack))
 
@@ -369,6 +369,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 +415,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)
@@ -440,15 +432,40 @@
     (double-float
      (if (eql value 0d0)
          (sc-number-or-lose 'fp-double-zero )
+         nil))
+    ((complex single-float)
+     (if (eql value (complex 0f0 0f0))
+         (sc-number-or-lose 'fp-complex-single-zero)
+         nil))
+    ((complex double-float)
+     (if (eql value (complex 0d0 0d0))
+         (sc-number-or-lose 'fp-complex-double-zero)
          nil))))
 
 
 ;;;; 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)
+;;; 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) ; ?