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... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3522814e013a7092890be8e9... You're receiving this email because of your account on gitlab.common-lisp.net.