X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fc-call.lisp;h=0672d532e4213805777b5d4a2ac3b238a4091381;hb=079ef9dad558ca07cb8178ef428bf738112174fa;hp=f56fd5292191f0aa7069815462aa67c9bd26b5ec;hpb=b7eed59f1877263e1af5ad80299e641e8276f77d;p=sbcl.git diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp index f56fd52..0672d53 100644 --- a/src/compiler/x86/c-call.lisp +++ b/src/compiler/x86/c-call.lisp @@ -126,8 +126,8 @@ (deftransform %alien-funcall ((function type &rest args) * * :node node) - (aver (sb!c::constant-continuation-p type)) - (let* ((type (sb!c::continuation-value type)) + (aver (sb!c::constant-lvar-p type)) + (let* ((type (sb!c::lvar-value type)) (env (sb!c::node-lexenv node)) (arg-types (alien-fun-type-arg-types type)) (result-type (alien-fun-type-result-type type))) @@ -181,20 +181,29 @@ ,@(new-args)))))) (sb!c::give-up-ir1-transform)))) - - - (define-vop (foreign-symbol-address) (:translate foreign-symbol-address) (:policy :fast-safe) (:args) - (:arg-types (:constant simple-base-string)) + (:arg-types (:constant simple-string)) (:info foreign-symbol) (:results (res :scs (sap-reg))) (:result-types system-area-pointer) (:generator 2 (inst lea res (make-fixup (extern-alien-name foreign-symbol) :foreign)))) +#!+linkage-table +(define-vop (foreign-symbol-dataref-address) + (:translate foreign-symbol-dataref-address) + (:policy :fast-safe) + (:args) + (:arg-types (:constant simple-string)) + (:info foreign-symbol) + (:results (res :scs (sap-reg))) + (:result-types system-area-pointer) + (:generator 2 + (inst mov res (make-fixup (extern-alien-name foreign-symbol) :foreign-dataref)))) + (define-vop (call-out) (:args (function :scs (sap-reg)) (args :more t)) @@ -237,8 +246,16 @@ (define-vop (alloc-number-stack-space) (:info amount) (:results (result :scs (sap-reg any-reg))) + (: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))) @@ -246,10 +263,18 @@ (define-vop (dealloc-number-stack-space) (:info amount) + (:node-var node) (:generator 0 (unless (zerop amount) (let ((delta (logandc2 (+ amount 3) 3))) - (inst add esp-tn delta))))) + (inst add esp-tn delta))) + (when (policy node (= sb!c::float-accuracy 3)) + (inst fnstcw (make-ea :word :base esp-tn)) + (inst wait) + (inst and (make-ea :word :base esp-tn) #xfeff) + (inst fldcw (make-ea :word :base esp-tn)) + (inst wait) + (inst add esp-tn 4)))) (define-vop (alloc-alien-stack-space) (:info amount)