1.0.38.9: Integer callback result fixes.

  * Callback results should be typechecked based on their declared
type, but stored as if they were the full width of a machine register.

  * Fixed sb-alien::alien-callback-lisp-wrapper-lambda to make this
happen properly.

  * Updated corresponding tests (formerly callback.impure.lisp /
sign-extension and underflow-detection) to cover 16-bit cases, which
would have broken on all targets, not merely 64-bit targets.

  * As a minor side note, assistance in testing the changes in 1.0.38.8
was provided by one Andreas Selfjord Eriksen, but I forgot to note this
fact in the commit message.  Mea Culpa.

diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp
index b596d27..2113489 100644 (file)
--- a/src/code/target-alieneval.lisp
+++ b/src/code/target-alieneval.lisp
@@ -822,22 +822,31 @@ ENTER-ALIEN-CALLBACK pulls the corresponsing trampoline out and calls it.")
                             :local ,(alien-callback-accessor-form
                                      spec 'args-sap offset))
                  do (incf offset (alien-callback-argument-bytes spec env)))
-           ,(flet ((store (spec)
+           ,(flet ((store (spec real-type)
                           (if spec
                               `(setf (deref (sap-alien res-sap (* ,spec)))
-                                     (funcall function ,@arguments))
+                                     ,(if real-type
+                                          `(the ,real-type
+                                             (funcall function ,@arguments))
+                                          `(funcall function ,@arguments)))
                               `(funcall function ,@arguments))))
                   (cond ((alien-void-type-p result-type)
-                         (store nil))
+                         (store nil nil))
                         ((alien-integer-type-p result-type)
+                         ;; Integer types should be padded out to a full
+                         ;; register width, to comply with most ABI calling
+                         ;; conventions, but should be typechecked on the
+                         ;; declared type width, hence the following:
                          (if (alien-integer-type-signed result-type)
                              (store `(signed
-                                      ,(alien-type-word-aligned-bits result-type)))
+                                      ,(alien-type-word-aligned-bits result-type))
+                                    `(signed-byte ,(alien-type-bits result-type)))
                              (store
                               `(unsigned
-                                ,(alien-type-word-aligned-bits result-type)))))
+                                ,(alien-type-word-aligned-bits result-type))
+                              `(unsigned-byte ,(alien-type-bits result-type)))))
                         (t
-                         (store (unparse-alien-type result-type)))))))
+                         (store (unparse-alien-type result-type) nil))))))
        (values))))
 
 (defun invalid-alien-callback (&rest arguments)

diff --git a/tests/callback.impure.lisp b/tests/callback.impure.lisp
index 34bb23f..a06b13a 100644 (file)
--- a/tests/callback.impure.lisp
+++ b/tests/callback.impure.lisp
@@ -134,20 +134,29 @@
   (sb-alien::alien-lambda void ()
     (values)))
 
-;;; tests for a sign extension problem in callback argument handling on x86-64
+;;; tests for integer-width problems in callback result handling
 
-(defvar *add-two-ints* (sb-alien::alien-callback (function int int int) #'+))
+(defvar *add-two-ints*
+  (sb-alien::alien-callback (function int int int) #'+))
+(defvar *add-two-shorts*
+  (sb-alien::alien-callback (function short short short) #'+))
 
-(with-test (:name :sign-extension)
-  (assert (= (alien-funcall *add-two-ints* #x-80000000 1) -2147483647)))
+;;; The original test cases here were what are now (:int-result
+;;; :sign-extension) and (:int-result :underflow-detection), the latter
+;;; of which would fail on 64-bit platforms.  Upon further investigation,
+;;; it turned out that the same tests with a SHORT return type instead of
+;;; an INT return type would also fail on 32-bit platforms.
+
+(with-test (:name (:short-result :sign-extension))
+  (assert (= (alien-funcall *add-two-shorts* #x-8000 1) -32767)))
 
-;;; On x86 This'll signal a TYPE-ERROR "The value -2147483649 is not of type
-;;; (SIGNED-BYTE 32)". On x86-64 it'll wrap around to 2147483647, probably
-;;; due to the sign-extension done by the (INTEGER :NATURALIZE-GEN)
-;;; alien-type-method. I believe the former behaviour is the one we want.
-;;; -- JES, 2005-10-16
+(with-test (:name (:short-result :underflow-detection))
+  (assert (raises-error? (alien-funcall *add-two-shorts* #x-8000 -1))))
+
+(with-test (:name (:int-result :sign-extension))
+  (assert (= (alien-funcall *add-two-ints* #x-80000000 1) -2147483647)))
 
-(with-test (:name :underflow-detection :fails-on :x86-64)
+(with-test (:name (:int-result :underflow-detection))
   (assert (raises-error? (alien-funcall *add-two-ints* #x-80000000 -1))))
 
 ;;; tests for handling 64-bit arguments - this was causing problems on

diff --git a/version.lisp-expr b/version.lisp-expr
index a8abec0..c92916e 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.38.8"
+"1.0.38.9"