cmucl-cvs

cmucl-cvs@common-lisp.net

2904 discussions

[Git][cmucl/cmucl][issue-234-make-ascii-format-builtin] Clean up impl of %find-external-format
by Raymond Toy (＠rtoy) 07 Jul '23

07 Jul '23

Raymond Toy pushed to branch issue-234-make-ascii-format-builtin at cmucl / cmucl Commits: 8ff9f737 by Raymond Toy at 2023-07-06T16:38:53-07:00 Clean up impl of %find-external-format Simplify code in `%find-external-format` to use the same code for all the built-in formats. Add new constant `+builtin-externalf-formats+` to list all the external formats that are built into lisp. - - - - - 1 changed file: - src/code/extfmts.lisp Changes: ===================================== src/code/extfmts.lisp ===================================== @@ -461,18 +461,18 @@ (format t "~&~A~%" (intl:gettext (or (ef-documentation ef) ""))))))))) +(defconstant +builtin-external-formats+ '(:utf-8 :iso8859-1 :ascii) + "List of external formats that are builtin so that they don't need to + be loaded on first use.") + (defun %find-external-format (name) ;; avoid loading files, etc., early in the boot sequence - (when (or (eq name :iso8859-1) - (and (eq name :default) (eq *default-external-format* :iso8859-1))) - (return-from %find-external-format - (gethash :iso8859-1 *external-formats*))) - (when (eq name :utf-8) - (return-from %find-external-format - (gethash :utf-8 *external-formats*))) - (when (eq name :ascii) + (when (and (eq name :default) + (eq *default-external-format* :iso8859-1)) + (setf name :iso8859-1)) + (when (member name +builtin-external-formats+ :test 'eq) (return-from %find-external-format - (gethash :ascii *external-formats*))) + (gethash name *external-formats*))) (when (zerop (hash-table-count *external-format-aliases*)) (setf (gethash :latin1 *external-format-aliases*) :iso8859-1) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8ff9f73774da81f757cde04… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8ff9f73774da81f757cde04… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-234-make-ascii-format-builtin] 7 commits: Fix #154 - add 'en_US.UTF-8@piglatin' as locale-alias for 'en@piglatin'
by Raymond Toy (＠rtoy) 05 Jul '23

05 Jul '23

Raymond Toy pushed to branch issue-234-make-ascii-format-builtin at cmucl / cmucl Commits: b1592289 by Jon Boone at 2023-06-19T00:07:56+00:00 Fix #154 - add 'en_US.UTF-8@piglatin' as locale-alias for 'en@piglatin' - - - - - 361c463b by Jon Boone at 2023-06-19T00:08:11+00:00 Merge branch 'issue-154-piglatin-translation-doesnt-work-anymore' into 'master' Fix #154 - add 'en_US.UTF-8@piglatin' as locale-alias for 'en@piglatin' Closes #154 and #216 See merge request cmucl/cmucl!151 - - - - - d8502e05 by Raymond Toy at 2023-06-19T07:19:00-07:00 Add release notes for 21f Just pulled in the template and added that #154 has been fixed. - - - - - 1fcdbdb2 by Raymond Toy at 2023-06-19T14:17:30-07:00 Fix typo in docstring for EQUAL - - - - - 4e433b83 by Raymond Toy at 2023-07-05T06:40:08-07:00 Set LANG in build.sh For some reason, on my Mac system, LANG isn't set and sometimes git messages are in Korean. So for consistency, set LANG in build.sh to a known value that should work everywhere. - - - - - 1e08c263 by Raymond Toy at 2023-07-05T09:38:46-07:00 Merge branch 'master' into issue-234-make-ascii-format-builtin - - - - - fec52ff6 by Raymond Toy at 2023-07-05T09:59:48-07:00 Fix typo when the format is :ascii We were incorrectly looking up :utf-8 when given :ascii. - - - - - 8 changed files: - .gitlab-ci.yml - bin/build.sh - src/code/extfmts.lisp - src/code/intl.lisp - src/code/pred.lisp - + src/general-info/release-21f.md - src/i18n/locale/cmucl.pot - tests/issues.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -46,6 +46,7 @@ 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 - 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/make-dist.sh -I dist linux-4 linux:test: ===================================== bin/build.sh ===================================== @@ -110,6 +110,8 @@ case `uname -s` in esac ;; esac +export LANG=en_US.UTF-8 + buildit () { if echo $INTERACTIVE_BUILD | grep $BUILD > /dev/null; then @@ -130,13 +132,11 @@ buildit () time $BUILDWORLD $TARGET $OLDLISP $BOOT || { echo "Failed: $BUILDWORLD"; exit 1; } if [ "$REBUILD_LISP" = "yes" ]; then $TOOLDIR/rebuild-lisp.sh $TARGET - 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 + fi + + # 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; } if [ "$BUILD_WORLD2" = "yes" ]; then ===================================== src/code/extfmts.lisp ===================================== @@ -472,7 +472,7 @@ (gethash :utf-8 *external-formats*))) (when (eq name :ascii) (return-from %find-external-format - (gethash :utf-8 *external-formats*))) + (gethash :ascii *external-formats*))) (when (zerop (hash-table-count *external-format-aliases*)) (setf (gethash :latin1 *external-format-aliases*) :iso8859-1) ===================================== src/code/intl.lisp ===================================== @@ -51,6 +51,7 @@ Use (INTL:TEXTDOMAIN \"whatever\") in each source file to set this.") (defvar *loaded-domains* (make-hash-table :test 'equal)) (defvar *locale-aliases* (make-hash-table :test 'equal)) +(setf (gethash "en_US.UTF-8@piglatin" *locale-aliases*) "en@piglatin") (defstruct domain-entry (domain "" :type simple-base-string) ===================================== src/code/pred.lisp ===================================== @@ -387,8 +387,8 @@ (defun equal (x y) "Returns T if X and Y are EQL or if they are structured components whose elements are EQUAL. Strings and bit-vectors are EQUAL if they - are the same length and have indentical components. Other arrays must be - EQ to be EQUAL." + are the same length and have identical components. Other arrays + must be EQ to be EQUAL." (cond ((eql x y) t) ((consp x) (and (consp y) ===================================== src/general-info/release-21f.md ===================================== @@ -0,0 +1,40 @@ +# Work in progress + +The CMUCL project is pleased to announce the release of CMUCL 21f. +This is a major release which contains numerous enhancements and bug +fixes from the <previous> release. + +CMUCL is a free, high performance implementation of the Common Lisp +programming language which runs on most major Unix platforms. It +mainly conforms to the ANSI Common Lisp standard. CMUCL provides a +sophisticated native code compiler; a powerful foreign function +interface; an implementation of CLOS, the Common Lisp Object System, +which includes multi-methods and a meta-object protocol; a +source-level debugger and code profiler; and an Emacs-like editor +implemented in Common Lisp. CMUCL is maintained by a team of +volunteers collaborating over the Internet, and is mostly in the +public domain. + +## New in this release: + * Known issues: + * Feature enhancements: + * Changes: + * ANSI compliance fixes: + * Bug fixes: + * Gitlab tickets: + * ~~#154~~ piglatin translation does not work anymore + * Other changes: + * Improvements to the PCL implementation of CLOS: + * Changes to building procedure: + +This release is not binary compatible with code compiled using CMUCL +21e; you will need to recompile FASL files. + +See http://www.cmucl.org or +https://gitlab.common-lisp.net/cmucl/cmucl for more information, +See +https://gitlab.common-lisp.net/cmucl/cmucl/wikis/GettingCmucl +for obtaining CMUCL, including sources and binaries.. + + +We hope you enjoy using this release of CMUCL! ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -9083,7 +9083,8 @@ msgstr "" #: src/code/extfmts.lisp msgid "" "The default external format to use if no other external format is\n" -" specified" +" specified. This is unaffected by any locale settings or by\n" +" SET-SYSTEM-EXTERNAL-FORMAT." msgstr "" #: src/code/extfmts.lisp ===================================== tests/issues.lisp ===================================== @@ -830,7 +830,18 @@ (assert-true (stream::find-external-format :euckr)) (assert-true (stream::find-external-format :cp949)))) - +(define-test issue.154 + (:tag :issues) + (let ((old-locale intl::*locale*) + (locale "en_US.UTF-8@piglatin") + (piglatin-text "Ethay izesay ofway away eamstray inway-ufferbay.")) + (unwind-protect + (progn + (assert-equal locale (intl:setlocale "en_US.UTF-8@piglatin")) + (print (intl::find-domain "cmucl" intl::*locale*)) + (assert-equal piglatin-text (intl:dgettext "cmucl" "The size of a stream in-buffer.")) + ) + (intl:setlocale old-locale)))) (define-test issue.158 (:tag :issues) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1b030d611bab51f190b877… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1b030d611bab51f190b877… 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] 6 commits: Fix #154 - add 'en_US.UTF-8@piglatin' as locale-alias for 'en@piglatin'
by Raymond Toy (＠rtoy) 05 Jul '23

05 Jul '23

Raymond Toy pushed to branch issue-242-c-call-char-result-wrong at cmucl / cmucl Commits: b1592289 by Jon Boone at 2023-06-19T00:07:56+00:00 Fix #154 - add 'en_US.UTF-8@piglatin' as locale-alias for 'en@piglatin' - - - - - 361c463b by Jon Boone at 2023-06-19T00:08:11+00:00 Merge branch 'issue-154-piglatin-translation-doesnt-work-anymore' into 'master' Fix #154 - add 'en_US.UTF-8@piglatin' as locale-alias for 'en@piglatin' Closes #154 and #216 See merge request cmucl/cmucl!151 - - - - - d8502e05 by Raymond Toy at 2023-06-19T07:19:00-07:00 Add release notes for 21f Just pulled in the template and added that #154 has been fixed. - - - - - 1fcdbdb2 by Raymond Toy at 2023-06-19T14:17:30-07:00 Fix typo in docstring for EQUAL - - - - - 4e433b83 by Raymond Toy at 2023-07-05T06:40:08-07:00 Set LANG in build.sh For some reason, on my Mac system, LANG isn't set and sometimes git messages are in Korean. So for consistency, set LANG in build.sh to a known value that should work everywhere. - - - - - fc986b6a by Raymond Toy at 2023-07-05T08:59:54-07:00 Merge branch 'master' into issue-242-c-call-char-result-wrong - - - - - 7 changed files: - .gitlab-ci.yml - bin/build.sh - src/code/intl.lisp - src/code/pred.lisp - + src/general-info/release-21f.md - src/i18n/locale/cmucl.pot - tests/issues.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -46,6 +46,7 @@ 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 - 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/make-dist.sh -I dist linux-4 linux:test: ===================================== bin/build.sh ===================================== @@ -110,6 +110,8 @@ case `uname -s` in esac ;; esac +export LANG=en_US.UTF-8 + buildit () { if echo $INTERACTIVE_BUILD | grep $BUILD > /dev/null; then @@ -130,13 +132,11 @@ buildit () time $BUILDWORLD $TARGET $OLDLISP $BOOT || { echo "Failed: $BUILDWORLD"; exit 1; } if [ "$REBUILD_LISP" = "yes" ]; then $TOOLDIR/rebuild-lisp.sh $TARGET - 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 + fi + + # 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; } if [ "$BUILD_WORLD2" = "yes" ]; then ===================================== src/code/intl.lisp ===================================== @@ -51,6 +51,7 @@ Use (INTL:TEXTDOMAIN \"whatever\") in each source file to set this.") (defvar *loaded-domains* (make-hash-table :test 'equal)) (defvar *locale-aliases* (make-hash-table :test 'equal)) +(setf (gethash "en_US.UTF-8@piglatin" *locale-aliases*) "en@piglatin") (defstruct domain-entry (domain "" :type simple-base-string) ===================================== src/code/pred.lisp ===================================== @@ -387,8 +387,8 @@ (defun equal (x y) "Returns T if X and Y are EQL or if they are structured components whose elements are EQUAL. Strings and bit-vectors are EQUAL if they - are the same length and have indentical components. Other arrays must be - EQ to be EQUAL." + are the same length and have identical components. Other arrays + must be EQ to be EQUAL." (cond ((eql x y) t) ((consp x) (and (consp y) ===================================== src/general-info/release-21f.md ===================================== @@ -0,0 +1,40 @@ +# Work in progress + +The CMUCL project is pleased to announce the release of CMUCL 21f. +This is a major release which contains numerous enhancements and bug +fixes from the <previous> release. + +CMUCL is a free, high performance implementation of the Common Lisp +programming language which runs on most major Unix platforms. It +mainly conforms to the ANSI Common Lisp standard. CMUCL provides a +sophisticated native code compiler; a powerful foreign function +interface; an implementation of CLOS, the Common Lisp Object System, +which includes multi-methods and a meta-object protocol; a +source-level debugger and code profiler; and an Emacs-like editor +implemented in Common Lisp. CMUCL is maintained by a team of +volunteers collaborating over the Internet, and is mostly in the +public domain. + +## New in this release: + * Known issues: + * Feature enhancements: + * Changes: + * ANSI compliance fixes: + * Bug fixes: + * Gitlab tickets: + * ~~#154~~ piglatin translation does not work anymore + * Other changes: + * Improvements to the PCL implementation of CLOS: + * Changes to building procedure: + +This release is not binary compatible with code compiled using CMUCL +21e; you will need to recompile FASL files. + +See http://www.cmucl.org or +https://gitlab.common-lisp.net/cmucl/cmucl for more information, +See +https://gitlab.common-lisp.net/cmucl/cmucl/wikis/GettingCmucl +for obtaining CMUCL, including sources and binaries.. + + +We hope you enjoy using this release of CMUCL! ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -9083,7 +9083,8 @@ msgstr "" #: src/code/extfmts.lisp msgid "" "The default external format to use if no other external format is\n" -" specified" +" specified. This is unaffected by any locale settings or by\n" +" SET-SYSTEM-EXTERNAL-FORMAT." msgstr "" #: src/code/extfmts.lisp ===================================== tests/issues.lisp ===================================== @@ -830,7 +830,18 @@ (assert-true (stream::find-external-format :euckr)) (assert-true (stream::find-external-format :cp949)))) - +(define-test issue.154 + (:tag :issues) + (let ((old-locale intl::*locale*) + (locale "en_US.UTF-8@piglatin") + (piglatin-text "Ethay izesay ofway away eamstray inway-ufferbay.")) + (unwind-protect + (progn + (assert-equal locale (intl:setlocale "en_US.UTF-8@piglatin")) + (print (intl::find-domain "cmucl" intl::*locale*)) + (assert-equal piglatin-text (intl:dgettext "cmucl" "The size of a stream in-buffer.")) + ) + (intl:setlocale old-locale)))) (define-test issue.158 (:tag :issues) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/db121350dec799687bc2d5… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/db121350dec799687bc2d5… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Set LANG in build.sh
by Raymond Toy (＠rtoy) 05 Jul '23

05 Jul '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 4e433b83 by Raymond Toy at 2023-07-05T06:40:08-07:00 Set LANG in build.sh For some reason, on my Mac system, LANG isn't set and sometimes git messages are in Korean. So for consistency, set LANG in build.sh to a known value that should work everywhere. - - - - - 1 changed file: - bin/build.sh Changes: ===================================== bin/build.sh ===================================== @@ -110,6 +110,8 @@ case `uname -s` in esac ;; esac +export LANG=en_US.UTF-8 + buildit () { if echo $INTERACTIVE_BUILD | grep $BUILD > /dev/null; then View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/4e433b83b0829b262b39820… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/4e433b83b0829b262b39820… 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] Modify %alien-funcall deftransform to change the integer return type
by Raymond Toy (＠rtoy) 04 Jul '23

04 Jul '23

Raymond Toy pushed to branch issue-242-c-call-char-result-wrong at cmucl / cmucl Commits: db121350 by Raymond Toy at 2023-07-03T20:58:20-07:00 Modify %alien-funcall deftransform to change the integer return type When the return type is an integer and the number of bits in the integer is less than 32, rewrite the return type to be a 32-bit integer (signed or unsigned according to the original type). This fixes the issue with calling a function that returns an alien:boolean, even if we declare it to return an (alien:boolean 8). Masking still happens. But this doesn't work for unsigned char or unsigned short; masking has been elided. But examination of what gcc does shows that we always zero extend the result to eax. So masking isn't really needed in this case. Clang does the same thing. - - - - - 1 changed file: - src/compiler/x86/c-call.lisp Changes: ===================================== src/compiler/x86/c-call.lisp ===================================== @@ -141,59 +141,78 @@ (alien-function-type-result-type type) (make-result-state)))))) -(deftransform %alien-funcall ((function type &rest args)) - (assert (c::constant-continuation-p type)) +(defun %alien-funcall-aux (function type &rest args) + (declare (ignorable function type args)) (let* ((type (c::continuation-value type)) (arg-types (alien-function-type-arg-types type)) (result-type (alien-function-type-result-type type))) (assert (= (length arg-types) (length args))) - (if (or (some #'(lambda (type) - (and (alien-integer-type-p type) - (> (alien::alien-integer-type-bits type) 32))) - arg-types) - (and (alien-integer-type-p result-type) - (> (alien::alien-integer-type-bits result-type) 32))) - (collect ((new-args) (lambda-vars) (new-arg-types)) - (dolist (type arg-types) - (let ((arg (gensym))) - (lambda-vars arg) - (cond ((and (alien-integer-type-p type) - (> (alien::alien-integer-type-bits type) 32)) - (new-args `(logand ,arg #xffffffff)) - (new-args `(ash ,arg -32)) - (new-arg-types (parse-alien-type '(unsigned 32))) - (if (alien-integer-type-signed type) - (new-arg-types (parse-alien-type '(signed 32))) - (new-arg-types (parse-alien-type '(unsigned 32))))) - (t - (new-args arg) - (new-arg-types type))))) - (cond ((and (alien-integer-type-p result-type) - (> (alien::alien-integer-type-bits result-type) 32)) - (let ((new-result-type - (let ((alien::*values-type-okay* t)) - (parse-alien-type - (if (alien-integer-type-signed result-type) - '(values (unsigned 32) (signed 32)) - '(values (unsigned 32) (unsigned 32))))))) - `(lambda (function type ,@(lambda-vars)) - (declare (ignore type)) - (multiple-value-bind (low high) - (%alien-funcall function - ',(make-alien-function-type - :arg-types (new-arg-types) - :result-type new-result-type) - ,@(new-args)) - (logior low (ash high 32)))))) + (unless (or (some #'(lambda (type) + (and (alien-integer-type-p type) + (> (alien::alien-integer-type-bits type) 32))) + arg-types) + (and (alien-integer-type-p result-type) + (/= (alien::alien-integer-type-bits result-type) 32))) + (format t "give up~%") + (c::give-up)) + (collect ((new-args) (lambda-vars) (new-arg-types)) + (dolist (type arg-types) + (let ((arg (gensym))) + (lambda-vars arg) + (cond ((and (alien-integer-type-p type) + (> (alien::alien-integer-type-bits type) 32)) + (new-args `(logand ,arg #xffffffff)) + (new-args `(ash ,arg -32)) + (new-arg-types (parse-alien-type '(unsigned 32))) + (if (alien-integer-type-signed type) + (new-arg-types (parse-alien-type '(signed 32))) + (new-arg-types (parse-alien-type '(unsigned 32))))) (t - `(lambda (function type ,@(lambda-vars)) - (declare (ignore type)) - (%alien-funcall function - ',(make-alien-function-type - :arg-types (new-arg-types) - :result-type result-type) - ,@(new-args)))))) - (c::give-up)))) + (new-args arg) + (new-arg-types type))))) + (cond ((and (alien-integer-type-p result-type) + (< (alien::alien-integer-type-bits result-type) 32)) + (let ((new-result-type + (parse-alien-type + (if (alien-integer-type-signed result-type) + '(signed 32) + '(unsigned 32))))) + `(lambda (function type ,@(lambda-vars)) + (declare (ignore type)) + (%alien-funcall function + ',(make-alien-function-type + :arg-types (new-arg-types) + :result-type new-result-type) + ,@(new-args))))) + ((and (alien-integer-type-p result-type) + (> (alien::alien-integer-type-bits result-type) 32)) + (let ((new-result-type + (let ((alien::*values-type-okay* t)) + (parse-alien-type + (if (alien-integer-type-signed result-type) + '(values (unsigned 32) (signed 32)) + '(values (unsigned 32) (unsigned 32))))))) + `(lambda (function type ,@(lambda-vars)) + (declare (ignore type)) + (multiple-value-bind (low high) + (%alien-funcall function + ',(make-alien-function-type + :arg-types (new-arg-types) + :result-type new-result-type) + ,@(new-args)) + (logior low (ash high 32)))))) + (t + `(lambda (function type ,@(lambda-vars)) + (declare (ignore type)) + (%alien-funcall function + ',(make-alien-function-type + :arg-types (new-arg-types) + :result-type result-type) + ,@(new-args)))))))) + +(deftransform %alien-funcall ((function type &rest args)) + (assert (c::constant-continuation-p type)) + (apply #'%alien-funcall-aux function type args)) (define-vop (foreign-symbol-code-address) (:translate #+linkage-table foreign-symbol-code-address View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/db121350dec799687bc2d51… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/db121350dec799687bc2d51… 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] Make out unwanted bits for boolean result
by Raymond Toy (＠rtoy) 01 Jul '23

01 Jul '23

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/3522814e013a7092890be8e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/3522814e013a7092890be8e… 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] Rename unsigned_to_bool to int_to_bool
by Raymond Toy (＠rtoy) 01 Jul '23

01 Jul '23

Raymond Toy pushed to branch issue-242-c-call-char-result-wrong at cmucl / cmucl Commits: 40f30050 by Raymond Toy at 2023-07-01T07:25:32-07:00 Rename unsigned_to_bool to int_to_bool Forgot one place. - - - - - 1 changed file: - tests/issues.lisp Changes: ===================================== tests/issues.lisp ===================================== @@ -1074,7 +1074,7 @@ (flet ((fun (n) (setf test-arg n) (alien:alien-funcall - (alien:extern-alien "unsigned_to_bool" + (alien:extern-alien "int_to_bool" (function c-call:char)))) (expected (n) (if (zerop n) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/40f300500cfe1ee912a37fd… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/40f300500cfe1ee912a37fd… 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] Rename unsigned_to_bool to int_to_bool
by Raymond Toy (＠rtoy) 01 Jul '23

01 Jul '23

Raymond Toy pushed to branch issue-242-c-call-char-result-wrong at cmucl / cmucl Commits: b921dc29 by Raymond Toy at 2023-07-01T07:19:31-07:00 Rename unsigned_to_bool to int_to_bool Since the global `test_arg` is an `int`, rename `unsigned_to_bool` to `int_to_bool` since we're converting an `int` to a `bool` instead of an `unsigned`. This makes the name of the function consistent with what is being converted. Doesn't affect the current test because we only test with small non-negative integers. - - - - - 2 changed files: - tests/issues.lisp - tests/test-return.c Changes: ===================================== tests/issues.lisp ===================================== @@ -1088,7 +1088,7 @@ (flet ((fun (n) (setf test-arg n) (alien:alien-funcall - (alien:extern-alien "unsigned_to_bool" + (alien:extern-alien "int_to_bool" (function alien:boolean)))) (expected (n) (not (zerop n)))) ===================================== tests/test-return.c ===================================== @@ -38,7 +38,7 @@ int_to_unsigned_int() return (unsigned int) test_arg; } -_Bool unsigned_to_bool() +_Bool int_to_bool() { return (_Bool) test_arg; } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b921dc292adcd038a13a8c8… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b921dc292adcd038a13a8c8… 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 arg from test function and set the value directly.
by Raymond Toy (＠rtoy) 01 Jul '23

01 Jul '23

Raymond Toy pushed to branch issue-242-c-call-char-result-wrong at cmucl / cmucl Commits: 1f87ddfc by Raymond Toy at 2023-06-30T21:33:50-07:00 Remove arg from test function and set the value directly. As suggested by @cshapiro, define a global var that we can set and which is used by the functions to compute the return value. This reduces any possible issues with round-tripping a value through the FFI. Update the tests appropriately to define the alien variable and set it before calling the test function. - - - - - 2 changed files: - tests/issues.lisp - tests/test-return.c Changes: ===================================== tests/issues.lisp ===================================== @@ -991,13 +991,15 @@ ;; load-foreign apparently returns NIL if it succeeds. (assert-true (eql nil (ext:load-foreign (merge-pathnames "test-return.o" *test-path*))))) +(alien:def-alien-variable "test_arg" c-call:int) + (define-test issue.242.test-alien-return-signed-char (:tag :issues) (flet ((fun (n) + (setf test-arg n) (alien:alien-funcall (alien:extern-alien "int_to_signed_char" - (function c-call:char c-call:int)) - n)) + (function c-call:char)))) (sign-extend (n) (let ((n (ldb (byte 8 0) n))) (if (> n #x7f) @@ -1009,10 +1011,10 @@ (define-test issue.242.test-alien-return-signed-short (:tag :issues) (flet ((fun (n) + (setf test-arg n) (alien:alien-funcall (alien:extern-alien "int_to_short" - (function c-call:short c-call:int)) - n)) + (function c-call:short)))) (sign-extend (n) (let ((n (ldb (byte 16 0) n))) (if (> n #x7fff) @@ -1024,20 +1026,20 @@ (define-test issue.242.test-alien-return-signed-int (:tag :issues) (flet ((fun (n) + (setf test-arg n) (alien:alien-funcall (alien:extern-alien "int_to_int" - (function c-call:int c-call:int)) - n))) + (function c-call:int))))) (dolist (x '(1023 -1023 #x7fffffff #x-80000000)) (assert-equal x (fun x) x)))) (define-test issue.242.test-alien-return-unsigned-char (:tag :issues) (flet ((fun (n) + (setf test-arg n) (alien:alien-funcall (alien:extern-alien "int_to_unsigned_char" - (function c-call:unsigned-char c-call:int)) - n)) + (function c-call:unsigned-char)))) (expected (n) (ldb (byte 8 0) n))) (dolist (x '(99 -99 1023 -1023)) @@ -1046,10 +1048,10 @@ (define-test issue.242.test-alien-return-unsigned-short (:tag :issues) (flet ((fun (n) + (setf test-arg n) (alien:alien-funcall (alien:extern-alien "int_to_unsigned_short" - (function c-call:unsigned-short c-call:int)) - n)) + (function c-call:unsigned-short)))) (expected (n) (ldb (byte 16 0) n))) (dolist (x '(1023 -1023 100000 -100000)) @@ -1058,10 +1060,10 @@ (define-test issue.242.test-alien-return-unsigned-int (:tag :issues) (flet ((fun (n) + (setf test-arg n) (alien:alien-funcall (alien:extern-alien "int_to_unsigned_int" - (function c-call:unsigned-int c-call:int)) - n)) + (function c-call:unsigned-int)))) (expected (n) (ldb (byte 32 0) n))) (dolist (x '(1023 -1023 #x7fffffff #x-80000000)) @@ -1070,10 +1072,10 @@ (define-test issue.242.test-alien-return-bool (:tag :issues) (flet ((fun (n) + (setf test-arg n) (alien:alien-funcall (alien:extern-alien "unsigned_to_bool" - (function c-call:char c-call:unsigned-int)) - n)) + (function c-call:char)))) (expected (n) (if (zerop n) 0 @@ -1084,10 +1086,10 @@ (define-test issue.242.test-alien-return-bool.2 (:tag :issues) (flet ((fun (n) + (setf test-arg n) (alien:alien-funcall (alien:extern-alien "unsigned_to_bool" - (function alien:boolean c-call:unsigned-int)) - n)) + (function alien:boolean)))) (expected (n) (not (zerop n)))) (dolist (x '(0 1 1000)) ===================================== tests/test-return.c ===================================== @@ -1,43 +1,45 @@ #include <stdbool.h> +int test_arg; + signed char -int_to_signed_char(int x) +int_to_signed_char() { - return (signed char) x; + return (signed char) test_arg; } short -int_to_short(int x) +int_to_short() { - return (short) x; + return (short) test_arg; } int -int_to_int(int x) +int_to_int() { - return (int) x; + return (int) test_arg; } unsigned char -int_to_unsigned_char(int x) +int_to_unsigned_char() { - return (unsigned char) x; + return (unsigned char) test_arg; } unsigned short -int_to_unsigned_short(int x) +int_to_unsigned_short() { - return (unsigned short) x; + return (unsigned short) test_arg; } unsigned int -int_to_unsigned_int(int x) +int_to_unsigned_int() { - return (unsigned int) x; + return (unsigned int) test_arg; } -_Bool unsigned_to_bool(unsigned u) +_Bool unsigned_to_bool() { - return (_Bool) u; + return (_Bool) test_arg; } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1f87ddfc5760085d3426604… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/1f87ddfc5760085d3426604… 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] Change `signed short` to `short`
by Raymond Toy (＠rtoy) 30 Jun '23

30 Jun '23

Raymond Toy pushed to branch issue-242-c-call-char-result-wrong at cmucl / cmucl Commits: 88d71368 by Raymond Toy at 2023-06-30T14:17:04-07:00 Change `signed short` to `short` `short` is always signed. - - - - - 1 changed file: - tests/test-return.c Changes: ===================================== tests/test-return.c ===================================== @@ -6,10 +6,10 @@ int_to_signed_char(int x) return (signed char) x; } -signed short +short int_to_short(int x) { - return (signed short) x; + return (short) x; } int View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/88d71368da29315d7b6a457… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/88d71368da29315d7b6a457… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs