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.)

package-data-list.lisp-expr

@@ -220,6 +220,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
 
                #!+x86 "SET-FPU-WORD-FOR-C"
                #!+x86 "SET-FPU-WORD-FOR-LISP"
+               "ALIGN-STACK-POINTER"
                "ALLOC-ALIEN-STACK-SPACE" "ALLOC-NUMBER-STACK-SPACE"
                "ALLOCATE-CODE-OBJECT" "ALLOCATE-FRAME"
                "ALLOCATE-DYNAMIC-CODE-OBJECT" "ALLOCATE-FULL-CALL-FRAME"
@@ -248,7 +249,8 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
                "COMPONENT-INFO" "COMPONENT-LIVE-TN" "COMPUTE-FUN"
                "COMPUTE-OLD-NFP" "COPY-MORE-ARG"
                "CURRENT-BINDING-POINTER" "CURRENT-NFP-TN"
-               "CURRENT-STACK-POINTER" "DEALLOC-ALIEN-STACK-SPACE"
+               "CURRENT-STACK-POINTER"
+               "DEALLOC-ALIEN-STACK-SPACE"
                "DEALLOC-NUMBER-STACK-SPACE"
                "DEBUG-CATCH-TAG"
                "DEF-IR1-TRANSLATOR"

src/compiler/aliencomp.lisp

@@ -348,14 +348,16 @@
     (/noshow (local-alien-info-force-to-memory-p info))
     (/noshow alien-type (unparse-alien-type alien-type) (alien-type-bits alien-type))
     (if (local-alien-info-force-to-memory-p info)
-      #!+(or x86 x86-64) `(truly-the system-area-pointer
-                         (%primitive alloc-alien-stack-space
-                                     ,(ceiling (alien-type-bits alien-type)
-                                               sb!vm:n-byte-bits)))
-      #!-(or x86 x86-64) `(truly-the system-area-pointer
-                         (%primitive alloc-number-stack-space
-                                     ,(ceiling (alien-type-bits alien-type)
-                                               sb!vm:n-byte-bits)))
+      #!+(or x86 x86-64)
+      `(truly-the system-area-pointer
+                  (%primitive alloc-alien-stack-space
+                              ,(ceiling (alien-type-bits alien-type)
+                                        sb!vm:n-byte-bits)))
+      #!-(or x86 x86-64)
+      `(truly-the system-area-pointer
+                  (%primitive alloc-number-stack-space
+                              ,(ceiling (alien-type-bits alien-type)
+                                        sb!vm:n-byte-bits)))
       (let* ((alien-rep-type-spec (compute-alien-rep-type alien-type))
              (alien-rep-type (specifier-type alien-rep-type-spec)))
         (cond ((csubtypep (specifier-type 'system-area-pointer)
@@ -700,11 +702,14 @@
                   (error "Something is broken.")))
         (lvar (node-lvar call))
         (args args)
-        #!+(or (and x86 darwin) win32) (stack-pointer (make-stack-pointer-tn)))
+        #!+x86
+        (stack-pointer (make-stack-pointer-tn)))
     (multiple-value-bind (nsp stack-frame-size arg-tns result-tns)
         (make-call-out-tns type)
-      #!+x86 (vop set-fpu-word-for-c call block)
-      #!+(or (and x86 darwin) win32) (vop current-stack-pointer call block stack-pointer)
+      #!+x86
+      (progn
+        (vop set-fpu-word-for-c call block)
+        (vop current-stack-pointer call block stack-pointer))
       (vop alloc-number-stack-space call block stack-frame-size nsp)
       (dolist (tn arg-tns)
         ;; On PPC, TN might be a list. This is used to indicate
@@ -722,22 +727,22 @@
           (unless (= (length move-arg-vops) 1)
             (error "no unique move-arg-vop for moves in SC ~S" (sc-name sc)))
           #!+(or x86 x86-64) (emit-move-arg-template call
-                                         block
-                                         (first move-arg-vops)
-                                         (lvar-tn call block arg)
-                                         nsp
-                                         first-tn)
+                                                     block
+                                                     (first move-arg-vops)
+                                                     (lvar-tn call block arg)
+                                                     nsp
+                                                     first-tn)
           #!-(or x86 x86-64) (progn
-                   (emit-move call
-                              block
-                              (lvar-tn call block arg)
-                              temp-tn)
-                   (emit-move-arg-template call
-                                           block
-                                           (first move-arg-vops)
-                                           temp-tn
-                                           nsp
-                                           first-tn))
+                               (emit-move call
+                                          block
+                                          (lvar-tn call block arg)
+                                          temp-tn)
+                               (emit-move-arg-template call
+                                                       block
+                                                       (first move-arg-vops)
+                                                       temp-tn
+                                                       nsp
+                                                       first-tn))
           #!+(and ppc darwin)
           (when (listp tn)
             ;; This means that we have a float arg that we need to
@@ -759,7 +764,10 @@
               ((lvar-tn call block function)
                (reference-tn-list arg-tns nil))
               ((reference-tn-list result-tns t))))
-      #!-(or (and darwin x86) win32) (vop dealloc-number-stack-space call block stack-frame-size)
-      #!+(or (and darwin x86) win32) (vop reset-stack-pointer call block stack-pointer)
-      #!+x86 (vop set-fpu-word-for-lisp call block)
+      #!-x86
+      (vop dealloc-number-stack-space call block stack-frame-size)
+      #!+x86
+      (progn
+        (vop reset-stack-pointer call block stack-pointer)
+        (vop set-fpu-word-for-lisp call block))
       (move-lvar-result call block result-tns lvar))))

src/compiler/x86/c-call.lisp

@@ -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,32 +231,23 @@
            (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))
 
            (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)

src/compiler/x86/call.lisp

@@ -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

src/compiler/x86/macros.lisp

@@ -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)))
 

src/compiler/x86/nlx.lisp

@@ -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))))
 

src/compiler/x86/show.lisp

@@ -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)))

src/compiler/x86/values.lisp

@@ -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)))
+    ))
 

src/runtime/x86-assem.S

@@ -122,16 +122,11 @@ GNAME(call_into_c):
 	fstp	%st(0)
 	fstp	%st(0)
 
-#ifdef LISP_FEATURE_WIN32
-	cld
-#endif
-
-#ifdef LISP_FEATURE_DARWIN
-        andl	$0xfffffff0,%esp        # align stack to 16-byte boundary before calling C
-#endif
-	call	*%eax		# normal callout using Lisp stack
-
-	movl	%eax,%ecx	# remember integer return value
+	cld                       # clear out DF: Darwin, Solaris and Win32 at
+	                          # least need this, and it should not hurt others
+
+	call	*%eax		  # normal callout using Lisp stack
+	movl	%eax,%ecx	  # remember integer return value
 
 /* Check for a return FP value. */
 	fxam

tests/foreign-stack-alignment.impure.lisp

@@ -35,7 +35,8 @@
   #+(and ppc linux) 8
   #+x86-64 16
   #+mips 8
-  #+x86 4
+  #+(and x86 (not darwin)) 4
+  #+(and x86 darwin) 16
   #-(or x86 x86-64 mips (and ppc (or darwin linux))) (error "Unknown platform"))
 
 ;;;; Build the offset-tool as regular excutable, and run it with

version.lisp-expr

@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.5.34"
+"1.0.5.35"