(invoke-alien-type-method :result-tn type state))
values)))
-(!def-vm-support-routine make-call-out-tns (type)
+(defun make-call-out-tns (type)
(let ((arg-state (make-arg-state)))
(collect ((arg-tns))
(dolist (arg-type (alien-fun-type-arg-types type))
(:generator 2
(inst mov res (make-fixup foreign-symbol :foreign-dataref))))
+(defun force-x87-to-mem (tn fp-temp)
+ (aver (location= tn fr0-tn))
+ (sc-case tn
+ (single-reg
+ (let ((ea (ea-for-sf-stack fp-temp)))
+ (inst fstp ea)
+ (inst fld ea)))
+ (double-reg
+ (let ((ea (ea-for-df-stack fp-temp)))
+ (inst fstpd ea)
+ (inst fldd ea)))
+ #!+long-float
+ (long-reg ; nothing to do!
+ )))
+
(define-vop (call-out)
(:args (function :scs (sap-reg))
(args :more t))
:from :eval :to :result) ecx)
(:temporary (:sc unsigned-reg :offset edx-offset
:from :eval :to :result) edx)
+ (:temporary (:sc double-stack) fp-temp)
#!+sb-safepoint (:temporary (:sc unsigned-reg :offset esi-offset) esi)
#!+sb-safepoint (:temporary (:sc unsigned-reg :offset edi-offset) edi)
#!-sb-safepoint (:node-var node)
;; sufficiently motivated maintainer.
#!-sb-safepoint (policy node (> space speed)))
(move eax function)
- (inst call (make-fixup "call_into_c" :foreign)))
+ (inst call (make-fixup "call_into_c" :foreign))
+ (when (and results
+ (location= (tn-ref-tn results) fr0-tn))
+ (force-x87-to-mem (tn-ref-tn results) fp-temp)))
(t
;; Setup the NPX for C; all the FP registers need to be
;; empty; pop them all.
(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
- ))))
+ (cond ((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
+ (force-x87-to-mem (tn-ref-tn results) fp-temp))
+ (t ; ensure no regs are empty
+ (inst fldz)))))))
;;; 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
`(deref (sap-alien (sap+ ,sp ,offset) (* ,type))))
#-sb-xc-host
-(defun alien-callback-assembler-wrapper (index return-type arg-types)
+(defun alien-callback-assembler-wrapper
+ (index return-type arg-types &optional (stack-offset 0))
"Cons up a piece of code which calls call-callback with INDEX and a
pointer to the arguments."
(declare (ignore arg-types))
(error "unrecognized alien type: ~A" return-type)))
(inst mov esp ebp) ; discard frame
(inst pop ebp) ; restore frame pointer
- (inst ret))
+ (inst ret stack-offset))
(finalize-segment segment)
;; Now that the segment is done, convert it to a static
;; vector we can point foreign code to.