+ (* (arg-state-stack-frame-size arg-state) n-word-bytes)
+ (arg-tns)
+ (invoke-alien-type-method :result-tn
+ (alien-fun-type-result-type type)
+ (make-result-state))))))
+
+
+(deftransform %alien-funcall ((function type &rest args) * * :node node)
+ (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)))
+ (aver (= (length arg-types) (length args)))
+ (if (or (some #'(lambda (type)
+ (and (alien-integer-type-p type)
+ (> (sb!alien::alien-integer-type-bits type) 32)))
+ arg-types)
+ (and (alien-integer-type-p result-type)
+ (> (sb!alien::alien-integer-type-bits result-type) 32)))
+ (collect ((new-args) (lambda-vars) (new-arg-types))
+ (dolist (type arg-types)
+ (let ((arg (gensym)))
+ (lambda-vars arg)
+ (cond ((and (alien-integer-type-p type)
+ (> (sb!alien::alien-integer-type-bits type) 32))
+ (new-args `(logand ,arg #xffffffff))
+ (new-args `(ash ,arg -32))
+ (new-arg-types (parse-alien-type '(unsigned 32) env))
+ (if (alien-integer-type-signed type)
+ (new-arg-types (parse-alien-type '(signed 32) env))
+ (new-arg-types (parse-alien-type '(unsigned 32) env))))
+ (t
+ (new-args arg)
+ (new-arg-types type)))))
+ (cond ((and (alien-integer-type-p result-type)
+ (> (sb!alien::alien-integer-type-bits result-type) 32))
+ (let ((new-result-type
+ (let ((sb!alien::*values-type-okay* t))
+ (parse-alien-type
+ (if (alien-integer-type-signed result-type)
+ '(values (unsigned 32) (signed 32))
+ '(values (unsigned 32) (unsigned 32)))
+ env))))
+ `(lambda (function type ,@(lambda-vars))
+ (declare (ignore type))
+ (multiple-value-bind (low high)
+ (%alien-funcall function
+ ',(make-alien-fun-type
+ :arg-types (new-arg-types)
+ :result-type new-result-type)
+ ,@(new-args))
+ (logior low (ash high 32))))))
+ (t
+ `(lambda (function type ,@(lambda-vars))
+ (declare (ignore type))
+ (%alien-funcall function
+ ',(make-alien-fun-type
+ :arg-types (new-arg-types)
+ :result-type result-type)
+ ,@(new-args))))))
+ (sb!c::give-up-ir1-transform))))
+
+;;; The ABI is vague about how signed sub-word integer return values
+;;; are handled, but since gcc versions >=4.3 no longer do sign
+;;; extension in the callee, we need to do it in the caller. FIXME:
+;;; If the value to be extended is known to already be of the target
+;;; type at compile time, we can (and should) elide the extension.
+(defknown sign-extend ((signed-byte 32) t) fixnum
+ (foldable flushable movable))
+
+(define-vop (sign-extend)
+ (:translate sign-extend)
+ (:policy :fast-safe)
+ ;; Need to wire this to EAX since in x86 some dword registers don't
+ ;; have a matching word or byte register.
+ (:args (val :scs (signed-reg) :target eax))
+ (:temporary (:sc signed-reg :offset eax-offset :from :eval :to :result) eax)
+ (:arg-types signed-num (:constant fixnum))
+ (:info size)
+ (:results (res :scs (signed-reg)))
+ (:result-types fixnum)
+ (:ignore eax)
+ (:generator 1
+ (inst movsx res
+ (make-random-tn :kind :normal
+ :sc (sc-or-lose (ecase size
+ (8 'byte-reg)
+ (16 'word-reg)))
+ :offset (tn-offset val)))))
+
+#-sb-xc-host
+(defun sign-extend (x size)
+ (declare (type (signed-byte 32) x))
+ (ecase size
+ (8 (sign-extend x size))
+ (16 (sign-extend x size))))
+
+#+sb-xc-host
+(defun sign-extend (x size)
+ (if (logbitp (1- size) x)
+ (dpb x (byte size 0) -1)
+ x))
+
+(define-vop (foreign-symbol-sap)
+ (:translate foreign-symbol-sap)