1.0.24.48: Do explicit sign-extension of small signed alien return values

        * gcc 4.3 has a different interpretation of the ABI, and
          zero-extends signed chars, shorts and (on x86-64) ints.

diff --git a/NEWS b/NEWS
index ff82ae2..85422c1 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -30,6 +30,8 @@ changes in sbcl-1.0.25 relative to 1.0.24:
     unquoted symbol. Regression from 1.0.22.8. (reported by Ariel Badichi)
   * bug fix: named ENUMs in multiply-referenced alien record types no longer
     cause an implied type redefinition.  Regression from 1.0.21.29.
+  * bug fix: sign-extension of small signed return values now works with C
+    code compiled with gcc 4.3 or newer. (reported by Liam Healy)
   * improvements to the Windows port:
     ** SB-BSD-SOCKETS now works from saved cores as well. (reported by Stephen
        Westfold, thanks to Rudi Schlatte)

diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp
index c9d4861..3e20c42 100644 (file)
--- a/src/compiler/x86-64/c-call.lisp
+++ b/src/compiler/x86-64/c-call.lisp
@@ -74,8 +74,6 @@
     (0 eax-offset)
     (1 edx-offset)))
 
-;; XXX The return handling probably doesn't conform to the ABI
-
 (define-alien-type-method (integer :result-tn) (type state)
   (let ((num-results (result-state-num-results state)))
     (setf (result-state-num-results state) (1+ num-results))
@@ -88,7 +86,7 @@
 (define-alien-type-method (integer :naturalize-gen) (type alien)
   (if (and (alien-integer-type-signed type)
            (<= (alien-type-bits type) 32))
-      `(sign-extend ,alien)
+      `(sign-extend ,alien ,(alien-type-bits type))
       alien))
 
 (define-alien-type-method (system-area-pointer :result-tn) (type state)
@@ -191,34 +189,41 @@
                                     ,@(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 ((signed-byte 32)) fixnum
-          (foldable flushable movable))
+;;; 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
+    (foldable flushable movable))
 
 (define-vop (sign-extend)
   (:translate sign-extend)
   (:policy :fast-safe)
   (:args (val :scs (signed-reg)))
-  (:arg-types fixnum)
+  (:arg-types fixnum (:constant fixnum))
+  (:info size)
   (:results (res :scs (signed-reg)))
   (:result-types fixnum)
   (:generator 1
    (inst movsxd res
          (make-random-tn :kind :normal
-                         :sc (sc-or-lose 'dword-reg)
+                         :sc (sc-or-lose (ecase size
+                                           (8 'byte-reg)
+                                           (16 'word-reg)
+                                           (32 'dword-reg)))
                          :offset (tn-offset val)))))
 
 #-sb-xc-host
-(defun sign-extend (x)
-  (declare (type (signed-byte 32) x))
-  (sign-extend x))
+(defun sign-extend (x size)
+  (declare (type fixnum x))
+  (ecase size
+    (8 (sign-extend x size))
+    (16 (sign-extend x size))
+    (32 (sign-extend x size))))
 
 #+sb-xc-host
-(defun sign-extend (x)
-  (if (logbitp 31 x)
-      (dpb x (byte 32 0) -1)
+(defun sign-extend (x size)
+  (if (logbitp (1- size) x)
+      (dpb x (byte size 0) -1)
       x))
 
 (define-vop (foreign-symbol-sap)

diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp
index 7f9277a..b202a24 100644 (file)
--- a/src/compiler/x86/c-call.lisp
+++ b/src/compiler/x86/c-call.lisp
@@ -78,6 +78,12 @@
             (values 'unsigned-byte-32 '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) 16))
+      `(sign-extend ,alien ,(alien-type-bits type))
+      alien))
+
 (define-alien-type-method (system-area-pointer :result-tn) (type state)
   (declare (ignore type))
   (let ((num-results (result-state-num-results state)))
@@ -181,6 +187,45 @@
                                     ,@(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.
+(defknown sign-extend ((signed-byte 16) 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 fixnum (: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 fixnum 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)
   (:policy :fast-safe)

diff --git a/version.lisp-expr b/version.lisp-expr
index 5d0da1f..c0af3f9 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.24.47"
+"1.0.24.48"