Raymond Toy pushed to branch issue-242-c-call-char-result-wrong at cmucl / cmucl

Commits: 3522814e by Raymond Toy at 2023-07-01T11:06:10-07:00 Make out unwanted bits for boolean result

- - - - -

1 changed file:

- src/code/alieneval.lisp

Changes:

===================================== src/code/alieneval.lisp ===================================== @@ -666,8 +666,8 @@ ,val))) (t alien))) (case (alien-integer-type-bits type) - (8 `(ldb (byte 8 0) ,alien)) - (16 `(ldb (byte 16 0) ,alien)) + (8 `(ldb (byte 8 0) (truly-the (unsigned-byte 32) ,alien))) + (16 `(ldb (byte 16 0) (truly-the (unsigned-byte 32) ,alien))) (t alien))))

;; signed numbers <= 32 bits need to be sign extended. @@ -715,8 +715,8 @@

(def-alien-type-class (boolean :include integer :include-args (signed)))

-(def-alien-type-translator boolean (&optional (bits vm:word-bits)) - (make-alien-boolean-type :bits bits :signed nil)) +(def-alien-type-translator boolean (&optional (bits 8)) + (make-alien-boolean-type :bits bits :signed t))

(def-alien-type-method (boolean :unparse) (type) `(boolean ,(alien-boolean-type-bits type))) @@ -726,8 +726,10 @@ `(member t nil))

(def-alien-type-method (boolean :naturalize-gen) (type alien) - (declare (ignore type)) - `(not (zerop ,alien))) + ;; Mask out any unwanted bits. Important if the C code returns + ;; values in %al, or %ax + `(not (zerop (ldb (byte ,(alien-boolean-type-bits type) 0) + ,alien))))

(def-alien-type-method (boolean :deport-gen) (type value) (declare (ignore type))

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3522814e013a7092890be8e9...