[Sbcl-commits] CVS: sbcl/src/compiler/x86 c-call.lisp, 1.37, 1.38 call.lisp, 1.37, 1.38 macros.lisp, 1.45, 1.46 nlx.lisp, 1.21, 1.22 show.lisp, 1.6, 1.7 values.lisp, 1.10, 1.11

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler/x86
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv28343/src/compiler/x86

Modified Files:
	c-call.lisp call.lisp macros.lisp nlx.lisp show.lisp 
	values.lisp 
Log Message:
1.0.5.35: stack alignment on x86/Darwin, once more

 * Stack alignment cannot be changed after arguments have been pushed
   on stack: ALLOCATE-NUMBER-STACK-SPACE is the place to do this, and
   nowhere else.

 * Use the RESET-STACK-POINTER logic on all x86 platforms for
   simplicity.

 * Factor out the alignment logic to ALIGN-STACK-POINTER.

 * Clear DF unconditionally when calling out, which means that Solaris
   doesn't need to switch it back and forth. (Darwin, Solaris, and Win32
   all need DF cleared for call-out.)


Index: c-call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/c-call.lisp,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -d -r1.37 -r1.38
--- c-call.lisp	13 Apr 2007 20:40:12 -0000	1.37
+++ c-call.lisp	6 May 2007 17:56:28 -0000	1.38
@@ -214,8 +214,6 @@
                    :from :eval :to :result) ecx)
   (:temporary (:sc unsigned-reg :offset edx-offset
                    :from :eval :to :result) edx)
-  #!+darwin
-  (:temporary (:sc unsigned-reg :offset esi-offset) prev-esp)
   (:node-var node)
   (:vop-var vop)
   (:save-p t)
@@ -233,23 +231,14 @@
            (dotimes (i 8)
              (inst fstp fr0-tn))
 
-           #!+win32
+           ;; Clear out DF: Darwin, Windows, and Solaris at least require
+           ;; this, and it should not hurt others either.
            (inst cld)
 
-           #!+darwin
-           ;; Align stack for C.
-           (progn
-             (move prev-esp esp-tn)
-             (inst and esp-tn -16))
-
            (inst call function)
-           ;; To give the debugger a clue. XX not really internal-error?
+           ;; To give the debugger a clue. FIXME: not really internal-error?
            (note-this-location vop :internal-error)
 
-           #!+darwin
-           ;; Restore
-           (move esp-tn prev-esp)
-
            ;; Restore the NPX for lisp; ensure no regs are empty
            (dotimes (i 7)
              (inst fldz))
@@ -257,8 +246,8 @@
            (if (and results
                     (location= (tn-ref-tn results) fr0-tn))
                ;; The return result is in fr0.
-               (inst fxch fr7-tn) ; move the result back to fr0
-               (inst fldz)) ; insure no regs are empty
+               (inst fxch fr7-tn)       ; move the result back to fr0
+               (inst fldz))             ; insure no regs are empty
            ))))
 
 ;;; While SBCL uses the FPU in 53-bit mode, most C libraries assume that
@@ -295,17 +284,9 @@
     (unless (zerop amount)
       (let ((delta (logandc2 (+ amount 3) 3)))
         (inst sub esp-tn delta)))
-    ;; C stack should probably be 16 byte aligned on Darwin
-    #!+darwin (inst and esp-tn -16)
+    (align-stack-pointer esp-tn)
     (move result esp-tn)))
 
-(define-vop (dealloc-number-stack-space)
-  (:info amount)
-  (:generator 0
-    (unless (zerop amount)
-      (let ((delta (logandc2 (+ amount 3) 3)))
-        (inst add esp-tn delta)))))
-
 (define-vop (alloc-alien-stack-space)
   (:info amount)
   #!+sb-thread (:temporary (:sc unsigned-reg) temp)

Index: call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/call.lisp,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -d -r1.37 -r1.38
--- call.lisp	12 Apr 2007 02:28:52 -0000	1.37
+++ call.lisp	6 May 2007 17:56:28 -0000	1.38
@@ -312,8 +312,6 @@
       (inst mov eax-tn nil-value)
       (inst std)
       (inst mov ecx-tn (- nvals register-arg-count))
-      ;; solaris requires DF being zero.
-      #!+sunos (inst cld)
       ;; Jump into the default loop.
       (inst jmp default-stack-vals)
 
@@ -348,8 +346,6 @@
       (inst std)
       (inst rep)
       (inst movs :dword)
-      ;; solaris requires DF being zero.
-      #!+sunos (inst cld)
       ;; Restore ESI.
       (loadw esi-tn ebx-tn (frame-word-offset 2))
       ;; Now we have to default the remaining args. Find out how many.
@@ -365,8 +361,6 @@
       (emit-label default-stack-vals)
       (inst rep)
       (inst stos eax-tn)
-      ;; solaris requires DF being zero.
-      #!+sunos (inst cld)
       ;; Restore EDI, and reset the stack.
       (emit-label restore-edi)
       (loadw edi-tn ebx-tn (frame-word-offset 1))
@@ -1383,9 +1377,7 @@
        (inst jmp :nz loop)
        ;; NIL out the last cons.
        (storew nil-value dst 1 list-pointer-lowtag))
-      (emit-label done)
-      ;; solaris requires DF being zero.
-      #!+sunos (inst cld))))
+      (emit-label done))))
 
 ;;; Return the location and size of the &MORE arg glob created by
 ;;; COPY-MORE-ARG. SUPPLIED is the total number of arguments supplied

Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/macros.lisp,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -d -r1.45 -r1.46
--- macros.lisp	29 Apr 2007 17:17:27 -0000	1.45
+++ macros.lisp	6 May 2007 17:56:28 -0000	1.46
@@ -46,6 +46,12 @@
     `(unless (location= ,n-dst ,n-src)
        (inst mov ,n-dst ,n-src))))
 
+(defmacro align-stack-pointer (tn)
+  #!-darwin (declare (ignore tn))
+  #!+darwin
+  ;; 16 byte alignment.
+  `(inst and ,tn #xfffffff0))
+
 (defmacro make-ea-for-object-slot (ptr slot lowtag &optional (size :dword))
   `(make-ea ,size :base ,ptr :disp (- (* ,slot n-word-bytes) ,lowtag)))
 

Index: nlx.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/nlx.lisp,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- nlx.lisp	7 Apr 2007 20:00:25 -0000	1.21
+++ nlx.lisp	6 May 2007 17:56:28 -0000	1.22
@@ -239,8 +239,6 @@
     (inst movs :dword)
 
     DONE
-    ;; solaris requires DF being zero.
-    #!+sunos (inst cld)
     ;; Reset the CSP at last moved arg.
     (inst lea esp-tn (make-ea :dword :base edi :disp n-word-bytes))))
 

Index: show.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/show.lisp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- show.lisp	6 Mar 2006 10:02:03 -0000	1.6
+++ show.lisp	6 May 2007 17:56:28 -0000	1.7
@@ -22,20 +22,26 @@
                :from :eval
                :to (:result 0))
               eax)
-  #!+darwin (:temporary (:sc unsigned-reg
-                            :offset esi-offset)
-                       prev-stack-pointer)
+  #!+darwin
+  (:temporary (:sc unsigned-reg
+                   :offset esi-offset)
+              prev-stack-pointer)
   (:results (result :scs (descriptor-reg)))
   (:save-p t)
   (:generator 100
-    ;; the stack should be 16-byte aligned on Darwin
-    #!-darwin (inst push object)
-    #!+darwin (progn (inst mov prev-stack-pointer esp-tn)
-                     (inst sub esp-tn n-word-bytes)
-                     (inst and esp-tn -16)
-                     (storew object esp-tn))
+    #!-darwin
+    (inst push object)
+    #!+darwin
+    (progn
+      ;; the stack should be 16-byte aligned on Darwin
+      (inst mov prev-stack-pointer esp-tn)
+      (inst sub esp-tn n-word-bytes)
+      (align-stack-pointer esp-tn)
+      (storew object esp-tn))
     (inst lea eax (make-fixup "debug_print" :foreign))
     (inst call (make-fixup "call_into_c" :foreign))
-    #!-darwin (inst add esp-tn n-word-bytes)
-    #!+darwin (inst mov esp-tn prev-stack-pointer)
+    #!-darwin
+    (inst add esp-tn n-word-bytes)
+    #!+darwin
+    (inst mov esp-tn prev-stack-pointer)
     (move result eax)))

Index: values.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/values.lisp,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- values.lisp	13 Nov 2006 06:10:16 -0000	1.10
+++ values.lisp	6 May 2007 17:56:28 -0000	1.11
@@ -39,8 +39,6 @@
     (inst cmp esp-tn esi)
     (inst jmp :be loop)
     DONE
-    ;; solaris requires DF being zero.
-    #!+sunos (inst cld)
     (inst lea esp-tn (make-ea :dword :base edi :disp n-word-bytes))
     (inst sub edi esi)
     (loop for moved = moved-ptrs then (tn-ref-across moved)
@@ -151,6 +149,5 @@
     (inst jmp :nz LOOP)
 
     DONE
-    ;; solaris requires DF being zero.
-    #!+sunos (inst cld)))
+    ))