(setf (result-state-num-results state) (1+ num-results))
(multiple-value-bind (ptype reg-sc)
(if (alien-integer-type-signed type)
- (values (if (= (sb!alien::alien-integer-type-bits type) 32)
- 'signed-byte-32
- 'signed-byte-64)
- 'signed-reg)
+ (values 'signed-byte-64 'signed-reg)
(values 'unsigned-byte-64 'unsigned-reg))
(my-make-wired-tn ptype reg-sc (result-reg-offset num-results)))))
+(define-alien-type-method (integer :naturalize-gen) (type alien)
+ (if (and (alien-integer-type-signed type)
+ (<= (alien-type-bits type) 32))
+ `(sign-extend ,alien)
+ alien))
+
(define-alien-type-method (system-area-pointer :result-tn) (type state)
(declare (ignore type))
(let ((num-results (result-state-num-results state)))
,@(new-args))))))
(sb!c::give-up-ir1-transform))))
+;;; The ABI specifies that signed short/int's are returned as 32-bit
+;;; values. Negative values need to be sign-extended to 64-bits (done
+;;; in a :NATURALIZE-GEN alien-type-method).
+(defknown sign-extend (fixnum) fixnum (foldable flushable movable))
-
+(define-vop (sign-extend)
+ (:translate sign-extend)
+ (:policy :fast-safe)
+ (:args (val :scs (any-reg)))
+ (:arg-types fixnum)
+ (:results (res :scs (any-reg)))
+ (:result-types fixnum)
+ (:generator 1
+ (inst movsxd res
+ (make-random-tn :kind :normal
+ :sc (sc-or-lose 'dword-reg)
+ :offset (tn-offset val)))))
+
+(defun sign-extend (x)
+ (if (logbitp 31 x)
+ (dpb x (byte 32 0) -1)
+ (ldb (byte 32 0) x)))
(define-vop (foreign-symbol-address)
(:translate foreign-symbol-address)
(:results (res :scs (sap-reg)))
(:result-types system-area-pointer)
(:generator 2
- (inst lea res (make-fixup (extern-alien-name foreign-symbol) :foreign))))
+ (inst lea res (make-fixup foreign-symbol :foreign))))
#!+linkage-table
(define-vop (foreign-symbol-dataref-address)
(:results (res :scs (sap-reg)))
(:result-types system-area-pointer)
(:generator 2
- (inst mov res (make-fixup (extern-alien-name foreign-symbol) :foreign-dataref))))
+ (inst mov res (make-fixup foreign-symbol :foreign-dataref))))
(define-vop (call-out)
(:args (function :scs (sap-reg))
(args :more t))
(:results (results :more t))
(:temporary (:sc unsigned-reg :offset rax-offset :to :result) rax)
- (:temporary (:sc unsigned-reg :offset rcx-offset
- :from :eval :to :result) rcx)
+ (:ignore results)
(:vop-var vop)
(:save-p t)
(:generator 0
(inst call function)
;; To give the debugger a clue. XX not really internal-error?
(note-this-location vop :internal-error)
- ;; Sign-extend s-b-32 return values.
- (dolist (res (if (listp results)
- results
- (list results)))
- (let ((tn (tn-ref-tn res)))
- (when (eq (sb!c::tn-primitive-type tn)
- (primitive-type-or-lose 'signed-byte-32))
- (inst movsxd tn (make-random-tn :kind :normal
- :sc (sc-or-lose 'dword-reg)
- :offset (tn-offset tn))))))
;; FLOAT15 needs to contain FP zero in Lispland
- (inst xor rcx rcx)
- (inst movd (make-random-tn :kind :normal
+ (let ((float15 (make-random-tn :kind :normal
:sc (sc-or-lose 'double-reg)
- :offset float15-offset)
- rcx)))
+ :offset float15-offset)))
+ (inst xorpd float15 float15))))
(define-vop (alloc-number-stack-space)
(:info amount)
(:generator 0
(aver (location= result rsp-tn))
(unless (zerop amount)
- (let ((delta (logandc2 (+ amount 3) 3)))
+ (let ((delta (logandc2 (+ amount 7) 7)))
(inst sub rsp-tn delta)))
+ ;; C stack must be 16 byte aligned
+ (inst and rsp-tn #xfffffff0)
(move result rsp-tn)))
(define-vop (dealloc-number-stack-space)
(:info amount)
(:generator 0
(unless (zerop amount)
- (let ((delta (logandc2 (+ amount 3) 3)))
+ (let ((delta (logandc2 (+ amount 7) 7)))
(inst add rsp-tn delta)))))
(define-vop (alloc-alien-stack-space)