X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fc-call.lisp;h=e44100311e6193b81a8edb2187770519d4767d8d;hb=a0c5831b3a74118cf41a848300200a1acdb48dcf;hp=a85abb125856b6b84e2ac666a0b8dea0701f3e5b;hpb=0d871fd7a98fc4af92a8b942a1154761466ad8c9;p=sbcl.git

diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp
index a85abb1..e441003 100644
--- a/src/compiler/x86/c-call.lisp
+++ b/src/compiler/x86/c-call.lisp
@@ -228,6 +228,8 @@
            (dotimes (i 8)
              (inst fstp fr0-tn))
 
+           #!+win32 (inst cld)
+
            (inst call function)
            ;; To give the debugger a clue. XX not really internal-error?
            (note-this-location vop :internal-error)
@@ -243,31 +245,24 @@
                (inst fldz)) ; insure no regs are empty
            ))))
 
-(define-vop (alloc-number-stack-space)
-  (:info amount)
-  (:results (result :scs (sap-reg any-reg)))
+;;; While SBCL uses the FPU in 53-bit mode, most C libraries assume that
+;;; the FPU is in 64-bit mode. So we change the FPU mode to 64-bit with
+;;; the SET-FPU-WORD-FOR-C VOP before calling out to C and set it back
+;;; to 53-bit mode after coming back using the SET-FPU-WORD-FOR-LISP VOP.
+(define-vop (set-fpu-word-for-c)
   (:node-var node)
   (:generator 0
-    (aver (location= result esp-tn))
     (when (policy node (= sb!c::float-accuracy 3))
       (inst sub esp-tn 4)
       (inst fnstcw (make-ea :word :base esp-tn))
       (inst wait)
       (inst or (make-ea :word :base esp-tn) #x300)
       (inst fldcw (make-ea :word :base esp-tn))
-      (inst wait))
-    (unless (zerop amount)
-      (let ((delta (logandc2 (+ amount 3) 3)))
-        (inst sub esp-tn delta)))
-    (move result esp-tn)))
+      (inst wait))))
 
-(define-vop (dealloc-number-stack-space)
-  (:info amount)
+(define-vop (set-fpu-word-for-lisp)
   (:node-var node)
   (:generator 0
-    (unless (zerop amount)
-      (let ((delta (logandc2 (+ amount 3) 3)))
-        (inst add esp-tn delta)))
     (when (policy node (= sb!c::float-accuracy 3))
       (inst fnstcw (make-ea :word :base esp-tn))
       (inst wait)
@@ -276,6 +271,25 @@
       (inst wait)
       (inst add esp-tn 4))))
 
+(define-vop (alloc-number-stack-space)
+  (:info amount)
+  (:results (result :scs (sap-reg any-reg)))
+  (: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)
+    (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)
@@ -292,7 +306,7 @@
                                 (ash symbol-tls-index-slot word-shift)
                                 (- other-pointer-lowtag))))
         (inst fs-segment-prefix)
-        (inst sub (make-ea :dword :scale 1 :index temp) delta)))
+        (inst sub (make-ea :dword :base temp) delta)))
     (load-tl-symbol-value result *alien-stack*))
   #!-sb-thread
   (:generator 0
@@ -316,12 +330,12 @@
       (let ((delta (logandc2 (+ amount 3) 3)))
         (inst mov temp
               (make-ea :dword
-                           :disp (+ nil-value
-                                    (static-symbol-offset '*alien-stack*)
+                       :disp (+ nil-value
+                                (static-symbol-offset '*alien-stack*)
                                 (ash symbol-tls-index-slot word-shift)
                                 (- other-pointer-lowtag))))
         (inst fs-segment-prefix)
-        (inst add (make-ea :dword :scale 1 :index temp) delta))))
+        (inst add (make-ea :dword :base temp) delta))))
   #!-sb-thread
   (:generator 0
     (unless (zerop amount)
@@ -380,7 +394,16 @@ pointer to the arguments."
               (inst add  eax 16)                    ; arguments
               (inst push eax)                       ; arg1
               (inst push (ash index 2))             ; arg0
-              (inst push (get-lisp-obj-address #'enter-alien-callback)) ; function
+
+              ;; Indirect the access to ENTER-ALIEN-CALLBACK through
+              ;; the symbol-value slot of SB-ALIEN::*ENTER-ALIEN-CALLBACK*
+              ;; to ensure it'll work even if the GC moves ENTER-ALIEN-CALLBACK.
+              ;; Skip any SB-THREAD TLS magic, since we don't expecte anyone
+              ;; to rebind the variable. -- JES, 2006-01-01
+              (inst mov eax (+ nil-value (static-symbol-offset
+                                          'sb!alien::*enter-alien-callback*)))
+              (loadw eax eax symbol-value-slot other-pointer-lowtag)
+              (inst push eax) ; function
               (inst mov  eax (foreign-symbol-address "funcall3"))
               (inst call eax)
               ;; now put the result into the right register