From 395c461b58f0cd484c21913c1e075593c206b5c1 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Mon, 26 Jan 2009 01:54:47 +0000 Subject: [PATCH] 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. --- NEWS | 2 ++ src/compiler/x86-64/c-call.lisp | 37 ++++++++++++++++++-------------- src/compiler/x86/c-call.lisp | 45 +++++++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 4 files changed, 69 insertions(+), 17 deletions(-) diff --git a/NEWS b/NEWS index ff82ae2..85422c1 100644 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4