June 2023 - cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl] Pushed new branch resolve-mr-for-issue-154-piglatin-translation-doesnt-work-anymore
by Jon Boone (＠jboone) 17 Jun '23

17 Jun '23

Jon Boone pushed new branch resolve-mr-for-issue-154-piglatin-translation-doesnt-work-anymore at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/resolve-mr-for-issue-154-… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-154-piglatin-translation-doesnt-work-anymore] testing removal of conditional
by Jon Boone (＠jboone) 17 Jun '23

17 Jun '23

Jon Boone pushed to branch issue-154-piglatin-translation-doesnt-work-anymore at cmucl / cmucl Commits: 28c7d555 by Jon Boone at 2023-06-17T14:14:17-04:00 testing removal of conditional - - - - - 1 changed file: - bin/build.sh Changes: ===================================== bin/build.sh ===================================== @@ -130,13 +130,14 @@ buildit () time $BUILDWORLD $TARGET $OLDLISP $BOOT || { echo "Failed: $BUILDWORLD"; exit 1; } if [ "$REBUILD_LISP" = "yes" ]; then $TOOLDIR/rebuild-lisp.sh $TARGET - else + fi + # else # Set the LANG to C. For whatever reason, if I (rtoy) don't # do this on my openSuSE system, any messages from gcc are # basically garbled. This should be harmless on other # systems. - LANG=C $MAKE -C $TARGET/lisp $MAKE_TARGET || { echo "Failed: $MAKE -C $TARGET/lisp"; exit 1; } - fi + # LANG=C $MAKE -C $TARGET/lisp $MAKE_TARGET || { echo "Failed: $MAKE -C $TARGET/lisp"; exit 1; } + # fi if [ "$BUILD_WORLD2" = "yes" ]; then View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/28c7d55558a33943f2b0c68… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/28c7d55558a33943f2b0c68… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-242-c-call-char-result-wrong] Fix silly typo introduced in last commit
by Raymond Toy (＠rtoy) 16 Jun '23

16 Jun '23

Raymond Toy pushed to branch issue-242-c-call-char-result-wrong at cmucl / cmucl Commits: f5ad7b01 by Raymond Toy at 2023-06-16T07:20:26-07:00 Fix silly typo introduced in last commit - - - - - 1 changed file: - src/code/alieneval.lisp Changes: ===================================== src/code/alieneval.lisp ===================================== @@ -173,7 +173,7 @@ ;; ;; Method that accepts the alien type and the alien value. The ;; method converts the alien value into an appropriate lisp value. - (naturalize-gen nil :type (or null function) + (naturalize-gen nil :type (or null function)) (deport-gen nil :type (or null function)) ;; Cast? (arg-tn nil :type (or null function)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/f5ad7b01e50ec09ee333ecf… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/f5ad7b01e50ec09ee333ecf… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-242-c-call-char-result-wrong] Add original C test from the bug report.
by Raymond Toy (＠rtoy) 16 Jun '23

16 Jun '23

Raymond Toy pushed to branch issue-242-c-call-char-result-wrong at cmucl / cmucl Commits: e8c35cb7 by Raymond Toy at 2023-06-16T07:07:11-07:00 Add original C test from the bug report. Add tests for this as well from the original bug report and an additional test that uses alien:boolean as the return type. - - - - - 2 changed files: - tests/issues.lisp - tests/test-return.c Changes: ===================================== tests/issues.lisp ===================================== @@ -1004,7 +1004,7 @@ (- n #x100) n)))) (dolist (x '(99 -99 1023 -1023)) - (assert-equal (sign-extend x) (fun x))))) + (assert-equal (sign-extend x) (fun x) x)))) (define-test issue.242.test-alien-return-signed-short (:tag :issues) @@ -1019,7 +1019,7 @@ (- n #x10000) n)))) (dolist (x '(1023 -1023 100000 -100000)) - (assert-equal (sign-extend x) (fun x))))) + (assert-equal (sign-extend x) (fun x) x)))) (define-test issue.242.test-alien-return-signed-int (:tag :issues) @@ -1029,7 +1029,7 @@ (function c-call:int c-call:int)) n))) (dolist (x '(1023 -1023 #x7fffffff #x-80000000)) - (assert-equal x (fun x))))) + (assert-equal x (fun x) x)))) (define-test issue.242.test-alien-return-unsigned-char (:tag :issues) @@ -1041,7 +1041,7 @@ (expected (n) (ldb (byte 8 0) n))) (dolist (x '(99 -99 1023 -1023)) - (assert-equal (expected x) (fun x))))) + (assert-equal (expected x) (fun x) x)))) (define-test issue.242.test-alien-return-unsigned-short (:tag :issues) @@ -1053,7 +1053,7 @@ (expected (n) (ldb (byte 16 0) n))) (dolist (x '(1023 -1023 100000 -100000)) - (assert-equal (expected x) (fun x))))) + (assert-equal (expected x) (fun x) x)))) (define-test issue.242.test-alien-return-unsigned-int (:tag :issues) @@ -1065,4 +1065,30 @@ (expected (n) (ldb (byte 32 0) n))) (dolist (x '(1023 -1023 #x7fffffff #x-80000000)) - (assert-equal (expected x) (fun x))))) + (assert-equal (expected x) (fun x) x)))) + +(define-test issue.242.test-alien-return-bool + (:tag :issues) + (flet ((fun (n) + (alien:alien-funcall + (alien:extern-alien "unsigned_to_bool" + (function c-call:char c-call:unsigned-int)) + n)) + (expected (n) + (if (zerop n) + 0 + 1))) + (dolist (x '(0 1 1000)) + (assert-equal (expected x) (fun x) x)))) + +(define-test issue.242.test-alien-return-bool.2 + (:tag :issues) + (flet ((fun (n) + (alien:alien-funcall + (alien:extern-alien "unsigned_to_bool" + (function alien:boolean c-call:unsigned-int)) + n)) + (expected (n) + (not (zerop n)))) + (dolist (x '(0 1 1000)) + (assert-equal (expected x) (fun x) x)))) ===================================== tests/test-return.c ===================================== @@ -1,3 +1,5 @@ +#include <stdbool.h> + signed char int_to_signed_char(int x) { @@ -19,18 +21,23 @@ int_to_int(int x) unsigned char int_to_unsigned_char(int x) { - return (signed char) x; + return (unsigned char) x; } unsigned short int_to_unsigned_short(int x) { - return (signed short) x; + return (unsigned short) x; } unsigned int int_to_unsigned_int(int x) { - return (int) x; + return (unsigned int) x; +} + +_Bool unsigned_to_bool(unsigned u) +{ + return (_Bool) u; } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/e8c35cb738dbac4d469d70c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/e8c35cb738dbac4d469d70c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-242-c-call-char-result-wrong] Remove unused function testing alien funcalls
by Raymond Toy (＠rtoy) 16 Jun '23

16 Jun '23

Raymond Toy pushed to branch issue-242-c-call-char-result-wrong at cmucl / cmucl Commits: a7a7029b by Raymond Toy at 2023-06-16T06:41:00-07:00 Remove unused function testing alien funcalls In restructuring the tests, I forgot to remove a function for testing alien funcalls. Remove it now. - - - - - 1 changed file: - tests/issues.lisp Changes: ===================================== tests/issues.lisp ===================================== @@ -991,12 +991,6 @@ ;; load-foreign apparently returns NIL if it succeeds. (assert-true (eql nil (ext:load-foreign (merge-pathnames "test-return.o" *test-path*))))) -(defun return-unsigned-int (x) - ((alien:alien-funcall - (alien:extern-alien "int_to_unsigned_int" - (function c-call:unsigned-int c-call:unsigned-int)) - n))) - (define-test issue.242.test-alien-return-signed-char (:tag :issues) (flet ((fun (n) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a7a7029baf371e6c0f6f623… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a7a7029baf371e6c0f6f623… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-242-c-call-char-result-wrong] Remove debugging stuff and add comment
by Raymond Toy (＠rtoy) 16 Jun '23

16 Jun '23

Raymond Toy pushed to branch issue-242-c-call-char-result-wrong at cmucl / cmucl Commits: 3107832c by Raymond Toy at 2023-06-16T06:38:26-07:00 Remove debugging stuff and add comment - - - - - 1 changed file: - bin/run-tests.sh Changes: ===================================== bin/run-tests.sh ===================================== @@ -47,8 +47,9 @@ function cleanup { trap cleanup EXIT -echo $PWD -ls tests/*.c +# Compile up the C file that is used for testing alien funcalls to +# functions that return integer types of different lengths. We use +# gcc since clang isn't always available. (cd tests; gcc -m32 -O3 -c test-return.c) if [ $# -eq 0 ]; then View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3107832c9f11f35abc93903… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3107832c9f11f35abc93903… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-242-c-call-char-result-wrong] 2 commits: Add tests for unsigned return types
by Raymond Toy (＠rtoy) 16 Jun '23

16 Jun '23

Raymond Toy pushed to branch issue-242-c-call-char-result-wrong at cmucl / cmucl Commits: d7f0d936 by Raymond Toy at 2023-06-16T06:29:46-07:00 Add tests for unsigned return types - - - - - 10a18a52 by Raymond Toy at 2023-06-16T06:35:11-07:00 Add comment on what :naturalize-gen method does Since I can never remember, add a comment for what the `:naturalize-gen` alien method is for. - - - - - 2 changed files: - src/code/alieneval.lisp - tests/issues.lisp Changes: ===================================== src/code/alieneval.lisp ===================================== @@ -170,7 +170,10 @@ (alien-rep nil :type (or null function)) (extract-gen nil :type (or null function)) (deposit-gen nil :type (or null function)) - (naturalize-gen nil :type (or null function)) + ;; + ;; Method that accepts the alien type and the alien value. The + ;; method converts the alien value into an appropriate lisp value. + (naturalize-gen nil :type (or null function) (deport-gen nil :type (or null function)) ;; Cast? (arg-tn nil :type (or null function)) ===================================== tests/issues.lisp ===================================== @@ -1036,3 +1036,39 @@ n))) (dolist (x '(1023 -1023 #x7fffffff #x-80000000)) (assert-equal x (fun x))))) + +(define-test issue.242.test-alien-return-unsigned-char + (:tag :issues) + (flet ((fun (n) + (alien:alien-funcall + (alien:extern-alien "int_to_unsigned_char" + (function c-call:unsigned-char c-call:int)) + n)) + (expected (n) + (ldb (byte 8 0) n))) + (dolist (x '(99 -99 1023 -1023)) + (assert-equal (expected x) (fun x))))) + +(define-test issue.242.test-alien-return-unsigned-short + (:tag :issues) + (flet ((fun (n) + (alien:alien-funcall + (alien:extern-alien "int_to_unsigned_short" + (function c-call:unsigned-short c-call:int)) + n)) + (expected (n) + (ldb (byte 16 0) n))) + (dolist (x '(1023 -1023 100000 -100000)) + (assert-equal (expected x) (fun x))))) + +(define-test issue.242.test-alien-return-unsigned-int + (:tag :issues) + (flet ((fun (n) + (alien:alien-funcall + (alien:extern-alien "int_to_unsigned_int" + (function c-call:unsigned-int c-call:int)) + n)) + (expected (n) + (ldb (byte 32 0) n))) + (dolist (x '(1023 -1023 #x7fffffff #x-80000000)) + (assert-equal (expected x) (fun x))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2cc3c60e2692a1709fcf48… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/2cc3c60e2692a1709fcf48… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-242-c-call-char-result-wrong] 2 commits: Fix bug in sign-extension.
by Raymond Toy (＠rtoy) 16 Jun '23

16 Jun '23

Raymond Toy pushed to branch issue-242-c-call-char-result-wrong at cmucl / cmucl Commits: de5d0be0 by Raymond Toy at 2023-06-15T20:54:26-07:00 Fix bug in sign-extension. Stupidly forgot to handle the case where the value is positive. We accidentally returned nil. - - - - - 2cc3c60e by Raymond Toy at 2023-06-15T20:58:27-07:00 Add tests for different foreign integer return types Add a C file, test-return.c, that has functions that return different length integer types. Compile it in run-tests.sh so that the tests can load it. Add tests that we get the right values from the functions. Only the signed integer types are tested right now. We need to add the unsigned tests. - - - - - 4 changed files: - bin/run-tests.sh - src/code/alieneval.lisp - tests/issues.lisp - + tests/test-return.c Changes: ===================================== bin/run-tests.sh ===================================== @@ -47,6 +47,10 @@ function cleanup { trap cleanup EXIT +echo $PWD +ls tests/*.c +(cd tests; gcc -m32 -O3 -c test-return.c) + if [ $# -eq 0 ]; then # No args so run all the tests $LISP -noinit -load tests/run-tests.lisp -eval '(cmucl-test-runner:run-all-tests)' ===================================== src/code/alieneval.lisp ===================================== @@ -649,16 +649,19 @@ ;; Mask out any unwanted bits. Important if the C code returns ;; values in %al, or %ax (if (alien-integer-type-signed type) - (case (alien-integer-type-bits type) - ;; First, get just the low part of the alien and then - ;; sign-extend it appropriately. - (8 `(let ((val (ldb (byte 8 0) ,alien))) - (if (> val #x7f) - (- val #x100)))) - (16 `(let ((val (ldb (byte 16 0) ,alien))) - (if (> val #x7fff) - (- val #x10000)))) - (t alien)) + (let ((val (gensym "VAL-"))) + (case (alien-integer-type-bits type) + ;; First, get just the low part of the alien and then + ;; sign-extend it appropriately. + (8 `(let ((,val (ldb (byte 8 0) ,alien))) + (if (> ,val #x7f) + (- ,val #x100) + ,val))) + (16 `(let ((,val (ldb (byte 16 0) ,alien))) + (if (> ,val #x7fff) + (- ,val #x10000) + ,val))) + (t alien))) (case (alien-integer-type-bits type) (8 `(ldb (byte 8 0) ,alien)) (16 `(ldb (byte 16 0) ,alien)) ===================================== tests/issues.lisp ===================================== @@ -986,3 +986,53 @@ ;; This is the condition from the CLHS entry for enough-namestring (assert-equal (merge-pathnames enough defaults) (merge-pathnames (parse-namestring pathname nil defaults) defaults)))))) + +(define-test issue.242-load-foreign + ;; load-foreign apparently returns NIL if it succeeds. + (assert-true (eql nil (ext:load-foreign (merge-pathnames "test-return.o" *test-path*))))) + +(defun return-unsigned-int (x) + ((alien:alien-funcall + (alien:extern-alien "int_to_unsigned_int" + (function c-call:unsigned-int c-call:unsigned-int)) + n))) + +(define-test issue.242.test-alien-return-signed-char + (:tag :issues) + (flet ((fun (n) + (alien:alien-funcall + (alien:extern-alien "int_to_signed_char" + (function c-call:char c-call:int)) + n)) + (sign-extend (n) + (let ((n (ldb (byte 8 0) n))) + (if (> n #x7f) + (- n #x100) + n)))) + (dolist (x '(99 -99 1023 -1023)) + (assert-equal (sign-extend x) (fun x))))) + +(define-test issue.242.test-alien-return-signed-short + (:tag :issues) + (flet ((fun (n) + (alien:alien-funcall + (alien:extern-alien "int_to_short" + (function c-call:short c-call:int)) + n)) + (sign-extend (n) + (let ((n (ldb (byte 16 0) n))) + (if (> n #x7fff) + (- n #x10000) + n)))) + (dolist (x '(1023 -1023 100000 -100000)) + (assert-equal (sign-extend x) (fun x))))) + +(define-test issue.242.test-alien-return-signed-int + (:tag :issues) + (flet ((fun (n) + (alien:alien-funcall + (alien:extern-alien "int_to_int" + (function c-call:int c-call:int)) + n))) + (dolist (x '(1023 -1023 #x7fffffff #x-80000000)) + (assert-equal x (fun x))))) ===================================== tests/test-return.c ===================================== @@ -0,0 +1,36 @@ +signed char +int_to_signed_char(int x) +{ + return (signed char) x; +} + +signed short +int_to_short(int x) +{ + return (signed short) x; +} + +int +int_to_int(int x) +{ + return (int) x; +} + +unsigned char +int_to_unsigned_char(int x) +{ + return (signed char) x; +} + +unsigned short +int_to_unsigned_short(int x) +{ + return (signed short) x; +} + +unsigned int +int_to_unsigned_int(int x) +{ + return (int) x; +} + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/d5391d9a0e25c687937e86… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/d5391d9a0e25c687937e86… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-242-c-call-char-result-wrong] Handle the signed integer case for alien integers
by Raymond Toy (＠rtoy) 15 Jun '23

15 Jun '23

Raymond Toy pushed to branch issue-242-c-call-char-result-wrong at cmucl / cmucl Commits: d5391d9a by Raymond Toy at 2023-06-15T15:53:13-07:00 Handle the signed integer case for alien integers Mask out integer bits that we don't care about, and then sign-extend the result, as needed. - - - - - 1 changed file: - src/code/alieneval.lisp Changes: ===================================== src/code/alieneval.lisp ===================================== @@ -648,10 +648,21 @@ (def-alien-type-method (integer :naturalize-gen) (type alien) ;; Mask out any unwanted bits. Important if the C code returns ;; values in %al, or %ax - (case (alien-integer-type-bits type) - (8 `(ldb (byte 8 0) ,alien)) - (16 `(ldb (byte 16 0) ,alien)) - (t alien))) + (if (alien-integer-type-signed type) + (case (alien-integer-type-bits type) + ;; First, get just the low part of the alien and then + ;; sign-extend it appropriately. + (8 `(let ((val (ldb (byte 8 0) ,alien))) + (if (> val #x7f) + (- val #x100)))) + (16 `(let ((val (ldb (byte 16 0) ,alien))) + (if (> val #x7fff) + (- val #x10000)))) + (t alien)) + (case (alien-integer-type-bits type) + (8 `(ldb (byte 8 0) ,alien)) + (16 `(ldb (byte 16 0) ,alien)) + (t alien)))) ;; signed numbers <= 32 bits need to be sign extended. ;; I really should use the movsxd instruction, but I don't View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/d5391d9a0e25c687937e86f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/d5391d9a0e25c687937e86f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-240-set-diff-with-hash-table] 2 commits: Make hashtable support multiset for list1
by Raymond Toy (＠rtoy) 15 Jun '23

15 Jun '23

Raymond Toy pushed to branch issue-240-set-diff-with-hash-table at cmucl / cmucl Commits: 42fd6d23 by Raymond Toy at 2023-06-15T15:23:03-07:00 Make hashtable support multiset for list1 It's important that for list1 the hashtable support multisets since list1 can be. This is needed so duplicates in list1 show up in the output. This variant was from @cshapiro. - - - - - 85c8c1df by Raymond Toy at 2023-06-15T15:26:43-07:00 Reverse the output Reverse the output for the case when list1 is longer so that the order of the items matches the order of the input. - - - - - 1 changed file: - src/code/list.lisp Changes: ===================================== src/code/list.lisp ===================================== @@ -770,15 +770,16 @@ (return (values length list2)))))) (when (< len 15) (return-from list-to-hashtable (values nil nil))) - (flet ((build-hash (len list) - (let ((hashtable (make-hash-table :test test :size len))) - (dolist (item list) - (setf (gethash (apply-key key item) hashtable) item)) - hashtable))) - (cond ((eq shorter-list list2) - (values (build-hash len list2) list2)) - ((eq shorter-list list1) - (values (build-hash len list1) list1)))))))) + (cond ((eq shorter-list list2) + (let ((hashtable (make-hash-table :test test :size len))) + (dolist (item list2) + (setf (gethash (apply-key key item) hashtable) item)) + (values hashtable list2))) + ((eq shorter-list list1) + (let ((hashtable (make-hash-table :test test :size len))) + (dolist (item list1) + (push item (gethash (apply-key key item) hashtable))) + (values hashtable list1)))))))) ;;; UNION -- Public. ;;; @@ -870,14 +871,17 @@ (dolist (item list1) (unless (gethash (apply-key key item) hashtable) (push item diff))) - diff)) + (nreverse diff))) ((eq shorter-list list1) ;; list1 was placed in the hash table. (dolist (item list2) - (when (gethash (apply-key key item) hashtable) + (unless (eq hashtable (gethash (apply-key key item) hashtable hashtable)) (remhash item hashtable))) - (loop for item being the hash-values of hashtable - collect item))))) + (let ((result '())) + (maphash #'(lambda (key value) + (declare (ignore key)) + (setq result (nconc result value))) + hashtable)))))) (defun nset-difference (list1 list2 &key key View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5e47bcfc5129d5d7b47b11… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5e47bcfc5129d5d7b47b11… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0