X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fc-call.lisp;h=d90427f6324d4bc3be6b4fc2d6db416831dc2075;hb=c4b30c86e3dd1d1cc70c572a6cfffe8b84e9c34a;hp=3e20c42f8b630eea0b567aa42643e136263b84a6;hpb=395c461b58f0cd484c21913c1e075593c206b5c1;p=sbcl.git

diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp
index 3e20c42..d90427f 100644
--- a/src/compiler/x86-64/c-call.lisp
+++ b/src/compiler/x86-64/c-call.lisp
@@ -84,9 +84,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) 32))
-      `(sign-extend ,alien ,(alien-type-bits type))
+  (if (<= (alien-type-bits type) 32)
+      (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)
@@ -191,15 +192,17 @@
 
 ;;; 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 32) 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 64) t) fixnum
     (foldable flushable movable))
 
 (define-vop (sign-extend)
   (:translate sign-extend)
   (:policy :fast-safe)
   (:args (val :scs (signed-reg)))
-  (:arg-types fixnum (:constant fixnum))
+  (:arg-types signed-num (:constant fixnum))
   (:info size)
   (:results (res :scs (signed-reg)))
   (:result-types fixnum)
@@ -214,7 +217,7 @@
 
 #-sb-xc-host
 (defun sign-extend (x size)
-  (declare (type fixnum x))
+  (declare (type (signed-byte 64) x))
   (ecase size
     (8 (sign-extend x size))
     (16 (sign-extend x size))