X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fc-call.lisp;h=7eec4723a4838d0ed621ff8c3e5e9f552c570bd2;hb=08917ec0d00a781a1089922a5419b7f136cdf08f;hp=b202a240b3c2e41db977a554092ab89626a099f4;hpb=395c461b58f0cd484c21913c1e075593c206b5c1;p=sbcl.git diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp index b202a24..7eec472 100644 --- a/src/compiler/x86/c-call.lisp +++ b/src/compiler/x86/c-call.lisp @@ -79,9 +79,10 @@ (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) 16)) - `(sign-extend ,alien ,(alien-type-bits type)) + (if (<= (alien-type-bits type) 16) + (if (alien-integer-type-signed type) + `(sign-extend ,alien ,(alien-type-bits type)) + `(logand ,alien ,(1- (ash 1 (alien-type-bits type))))) alien)) (define-alien-type-method (system-area-pointer :result-tn) (type state) @@ -189,8 +190,10 @@ ;;; 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. -(defknown sign-extend ((signed-byte 16) t) fixnum +;;; 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) @@ -200,7 +203,7 @@ ;; 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 fixnum (:constant fixnum)) + (:arg-types signed-num (:constant fixnum)) (:info size) (:results (res :scs (signed-reg))) (:result-types fixnum) @@ -215,7 +218,7 @@ #-sb-xc-host (defun sign-extend (x size) - (declare (type fixnum x)) + (declare (type (signed-byte 32) x)) (ecase size (8 (sign-extend x size)) (16 (sign-extend x size))))