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

[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

[Git][cmucl/cmucl] Pushed new branch issue-242-c-call-char-result-wrong
by Raymond Toy (＠rtoy) 15 Jun '23

15 Jun '23

Raymond Toy pushed new branch issue-242-c-call-char-result-wrong at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-242-c-call-char-res… 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] Refactoring of list to hashtable to its own function
by Raymond Toy (＠rtoy) 14 Jun '23

14 Jun '23

Raymond Toy pushed to branch issue-240-set-diff-with-hash-table at cmucl / cmucl Commits: 5e47bcfc by Raymond Toy at 2023-06-14T09:08:48-07:00 Refactoring of list to hashtable to its own function Move the code for converting a list to a hash table to its own function. Also support using a key function. Update set-difference to use this new function. - - - - - 1 changed file: - src/code/list.lisp Changes: ===================================== src/code/list.lisp ===================================== @@ -745,6 +745,41 @@ (cons item list))) +;; Convert a list to a hashtable. Given 2 lists, find the shorter of +;; the two lists and add the shorter list to a hashtable. +(defun list-to-hashtable (list1 list2 &key test test-not key) + ;; Don't currently support test-not when converting a list to a hashtable + (unless test-not + (let ((hash-test (let ((test-fn (if (and (symbolp test) + (fboundp test)) + (fdefinition test) + test))) + (cond ((eql test-fn #'eq) 'eq) + ((eql test-fn #'eql) 'eql) + ((eql test-fn #'equal) 'equal) + ((eql test-fn #'equalp) 'equalp))))) + (unless hash-test + (return-from list-to-hashtable (values nil nil))) + (multiple-value-bind (len shorter-list) + (do ((length 0 (1+ length)) + (l1 list1 (cdr l1)) + (l2 list2 (cdr l2))) + ((cond ((null l1) + (return (values length list1))) + ((null l2) + (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)))))))) + ;;; UNION -- Public. ;;; ;;; This function assumes list2 is the result, adding to it from list1 as @@ -812,53 +847,37 @@ (setq list1 (Cdr list1)))) res)) -(defun set-difference (list1 list2 &key key - (test #'eql testp) (test-not nil notp)) +(defun set-difference (list1 list2 &key key (test #'eql testp) (test-not nil notp)) "Returns the elements of list1 which are not in list2." (declare (inline member)) (if (and testp notp) (error "Test and test-not both supplied.")) - (flet ((default-impl (list1 list2) - (if (null list2) + (multiple-value-bind (hashtable shorter-list) + (list-to-hashtable list1 list2 :key key :test test :test-not test-not) + (cond ((null hashtable) + ;; Default implementation because we didn't create the hash + ;; table. + (if (null list2) list1 (let ((res nil)) (dolist (elt list1) (if (not (with-set-keys (member (apply-key key elt) list2))) (push elt res))) - res)))) - (cond ((and testp (null key) - (member test (list #'eq #'eql #'equal #'equalp))) - (multiple-value-bind (len shorter-list) - (do ((length 0 (1+ length)) - (l1 list1 (cdr l1)) - (l2 list2 (cdr l2))) - ((cond ((null l1) - (return (values length list1))) - ((null l2) - (return (values length list2)))))) - (when (< len 20) - (return-from set-difference (default-impl list1 list2))) - (flet ((build-hash (len list) - (let ((hashtable (make-hash-table :test test :size len))) - (dolist (item list) - (setf (gethash item hashtable) t)) - hashtable))) - (cond ((eq shorter-list list2) - (let ((hashtable (build-hash len list2)) - diff) - (dolist (item list1) - (unless (gethash item hashtable) - (push item diff))) - diff)) - ((eq shorter-list list1) - (let ((hashtable (build-hash len list1))) - (dolist (item list2) - (when (gethash item hashtable) - (remhash item hashtable))) - (loop for item being the hash-keys of hashtable - collect item))))))) - (t - (default-impl list1 list2))))) + res))) + ((eq shorter-list list2) + ;; list2 was placed in hash table. + (let (diff) + (dolist (item list1) + (unless (gethash (apply-key key item) hashtable) + (push item diff))) + diff)) + ((eq shorter-list list1) + ;; list1 was placed in the hash table. + (dolist (item list2) + (when (gethash (apply-key key item) hashtable) + (remhash item hashtable))) + (loop for item being the hash-values of hashtable + collect item))))) (defun nset-difference (list1 list2 &key key View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/5e47bcfc5129d5d7b47b110… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/5e47bcfc5129d5d7b47b110… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-240-set-diff-with-hash-table
by Raymond Toy (＠rtoy) 13 Jun '23

13 Jun '23

Raymond Toy pushed new branch issue-240-set-diff-with-hash-table at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-240-set-diff-with-h… 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] make the additional command part of a single command line invocation
by Jon Boone (＠jboone) 08 Jun '23

08 Jun '23

Jon Boone pushed to branch issue-154-piglatin-translation-doesnt-work-anymore at cmucl / cmucl Commits: 11ec47e8 by Jon Boone at 2023-06-07T22:33:48-04:00 make the additional command part of a single command line invocation - - - - - 1 changed file: - src/lisp/GNUmakefile Changes: ===================================== src/lisp/GNUmakefile ===================================== @@ -106,7 +106,7 @@ LOCALE_DIRS = $(patsubst %, i18n/locale/%/LC_MESSAGES, $(LOCALES)) # FreeBSD, it moves the line to after the Language-Team line. This # makes things messy. Hence, sort and diff. translations: - echo "making translations" + echo "making translations"; \ for pot in ../../src/i18n/locale/*.pot; do \ for po in $(LOCALE_DIRS); do \ d=`dirname $$pot`; \ View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/11ec47e882e6c08e12a47a7… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/11ec47e882e6c08e12a47a7… 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] adds translations diagnostic ouput to GNUmakefile
by Jon Boone (＠jboone) 08 Jun '23

08 Jun '23

Jon Boone pushed to branch issue-154-piglatin-translation-doesnt-work-anymore at cmucl / cmucl Commits: cb69ee79 by Jon Boone at 2023-06-07T22:21:17-04:00 adds translations diagnostic ouput to GNUmakefile - - - - - 1 changed file: - src/lisp/GNUmakefile Changes: ===================================== src/lisp/GNUmakefile ===================================== @@ -106,6 +106,7 @@ LOCALE_DIRS = $(patsubst %, i18n/locale/%/LC_MESSAGES, $(LOCALES)) # FreeBSD, it moves the line to after the Language-Team line. This # makes things messy. Hence, sort and diff. translations: + echo "making translations" for pot in ../../src/i18n/locale/*.pot; do \ for po in $(LOCALE_DIRS); do \ d=`dirname $$pot`; \ View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/cb69ee793b7eb1c1e0842b5… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/cb69ee793b7eb1c1e0842b5… 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] adding diagnostic message about POT
by Jon Boone (＠jboone) 08 Jun '23

08 Jun '23

Jon Boone pushed to branch issue-154-piglatin-translation-doesnt-work-anymore at cmucl / cmucl Commits: c24b478b by Jon Boone at 2023-06-07T21:14:45-04:00 adding diagnostic message about POT - - - - - 1 changed file: - bin/build.sh Changes: ===================================== bin/build.sh ===================================== @@ -246,6 +246,7 @@ if [ "${BUILD_POT}" = "yes" ]; then fi BUILD=3 +echo "MAKE_TARGET = ${MAKE_TARGET}" buildit # Asdf and friends are part of the base install, so we need to build View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c24b478baec3bde7afc58e6… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c24b478baec3bde7afc58e6… 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] revert to using clang, but leave the option to not use it
by Jon Boone (＠jboone) 08 Jun '23

08 Jun '23

Jon Boone pushed to branch issue-154-piglatin-translation-doesnt-work-anymore at cmucl / cmucl Commits: c2a36a08 by Jon Boone at 2023-06-07T21:08:55-04:00 revert to using clang, but leave the option to not use it - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -46,8 +46,8 @@ linux:build: #- bin/cross-build-world.sh -crl -B boot-2020-04-1 xtarget xcross src/tools/cross-scripts/cross-x86-x86.lisp snapshot/bin/lisp # Regular build using the cross-compiled result or snapshot - ls -laR snapshot/lib/cmucl/lib/locale - # - bin/build.sh $bootstrap -R -C "x86_linux_clang" -o snapshot/bin/lisp - - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp + - bin/build.sh $bootstrap -R -C "x86_linux_clang" -o snapshot/bin/lisp + # - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp - ls -laR linux-4/i18n/locale - bin/make-dist.sh -I dist linux-4 - ls -laR dist/lib/cmucl/lib/locale View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c2a36a0827e245984341dea… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c2a36a0827e245984341dea… 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] trying to build on linux w/out clang
by Jon Boone (＠jboone) 07 Jun '23

07 Jun '23

Jon Boone pushed to branch issue-154-piglatin-translation-doesnt-work-anymore at cmucl / cmucl Commits: 48f51460 by Jon Boone at 2023-06-07T17:26:08-04:00 trying to build on linux w/out clang - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -46,7 +46,8 @@ linux:build: #- bin/cross-build-world.sh -crl -B boot-2020-04-1 xtarget xcross src/tools/cross-scripts/cross-x86-x86.lisp snapshot/bin/lisp # Regular build using the cross-compiled result or snapshot - ls -laR snapshot/lib/cmucl/lib/locale - - bin/build.sh $bootstrap -R -C "x86_linux_clang" -o snapshot/bin/lisp + # - bin/build.sh $bootstrap -R -C "x86_linux_clang" -o snapshot/bin/lisp + - bin/build.sh $bootstrap -R -C "x86_linux" -o snapshot/bin/lisp - ls -laR linux-4/i18n/locale - bin/make-dist.sh -I dist linux-4 - ls -laR dist/lib/cmucl/lib/locale View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/48f51460d25f08e14736827… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/48f51460d25f08e14736827… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0