X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fc-call.lisp;h=023c99b8c80c2db71a0f94224e2ba6b6369485b5;hb=ab6672fd5c392b8678681bdda138c4dc9e4de31a;hp=b23a605d0bf8be21044c899d4063ddb8a7e3b5b6;hpb=a83d979b12102a512f8b040fa2f9329db5ecf28e;p=sbcl.git diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp index b23a605..023c99b 100644 --- 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 @@ -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) @@ -347,27 +328,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))) - (: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) +;;; 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) - (:generator 2 - (inst add esp-tn (fixnumize number)))) + (:arg-types t) + (:generator 0)) #-sb-xc-host (defun alien-callback-accessor-form (type sp offset)