1.0.15.36: fix bug 423

[sbcl.git] / src / compiler / x86 / c-call.lisp

diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp
index b23a605..ae98e18 100644 (file)
--- a/src/compiler/x86/c-call.lisp
+++ b/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,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
@@ -290,26 +279,20 @@
 (define-vop (alloc-number-stack-space)
   (:info amount)
   (:results (result :scs (sap-reg any-reg)))
+  (:result-types system-area-pointer)
   (:generator 0
     (aver (location= result esp-tn))
     (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)
   (:results (result :scs (sap-reg any-reg)))
+  (:result-types system-area-pointer)
   #!+sb-thread
   (:generator 0
     (aver (not (location= result esp-tn)))
@@ -347,27 +330,16 @@
         (inst add (make-ea-for-symbol-value *alien-stack*)
               delta)))))
 
-;;; these are not strictly part of the c-call convention, but are
-;;; needed for the WITH-PRESERVED-POINTERS macro used for "locking
-;;; down" lisp objects so that GC won't move them while foreign
-;;; functions go to work.
-
-(define-vop (push-word-on-c-stack)
-    (:translate push-word-on-c-stack)
-  (:args (val :scs (sap-reg)))
+;;; not strictly part of the c-call convention, but needed for the
+;;; WITH-PINNED-OBJECTS macro used for "locking down" lisp objects so
+;;; that GC won't move them while foreign functions go to work.
+(define-vop (touch-object)
+  (:translate touch-object)
+  (:args (object))
+  (:ignore object)
   (:policy :fast-safe)
-  (:arg-types system-area-pointer)
-  (:generator 2
-    (inst push val)))
-
-(define-vop (pop-words-from-c-stack)
-    (:translate pop-words-from-c-stack)
-  (:args)
-  (:arg-types (:constant (unsigned-byte 29)))
-  (:info number)
-  (:policy :fast-safe)
-  (:generator 2
-    (inst add esp-tn (fixnumize number))))
+  (:arg-types t)
+  (:generator 0))
 
 #-sb-xc-host
 (defun alien-callback-accessor-form (type sp offset)