cmucl-cvs

cmucl-cvs@common-lisp.net

2904 discussions

[Git][cmucl/cmucl][master] Update release notes with closed issues
by Raymond Toy (＠rtoy) 23 Jul '23

23 Jul '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: a85ad7cf by Raymond Toy at 2023-07-23T12:18:48-07:00 Update release notes with closed issues Should have been updated when the issue was closed, but we forgot. Update now. - - - - - 1 changed file: - src/general-info/release-21f.md Changes: ===================================== src/general-info/release-21f.md ===================================== @@ -23,6 +23,8 @@ public domain. * Bug fixes: * Gitlab tickets: * ~~#154~~ piglatin translation does not work anymore + * ~~#171~~ Readably print `(make-pathname :name :unspecfic)` + * ~~#242~~ Fix bug in `alien-funcall` with `c-call:char` as result type * ~~#248~~ Print MOVS instruction with correct case * Other changes: * Improvements to the PCL implementation of CLOS: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a85ad7cff820a069ab52775… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a85ad7cff820a069ab52775… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-245-replace-egrep-with-grep
by Raymond Toy (＠rtoy) 23 Jul '23

23 Jul '23

Raymond Toy pushed new branch issue-245-replace-egrep-with-grep at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-245-replace-egrep-w… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-244-c-call-signed-char
by Raymond Toy (＠rtoy) 23 Jul '23

23 Jul '23

Raymond Toy pushed new branch issue-244-c-call-signed-char at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-244-c-call-signed-c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Remove extraneous debugging print
by Raymond Toy (＠rtoy) 22 Jul '23

22 Jul '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 8c6e050a by Raymond Toy at 2023-07-21T18:06:08-07:00 Remove extraneous debugging print Introduced in commit [0a35575aa0] for debugging and we forgot to remove it. - - - - - 1 changed file: - src/compiler/x86/c-call.lisp Changes: ===================================== src/compiler/x86/c-call.lisp ===================================== @@ -153,7 +153,6 @@ 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) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8c6e050a7cf90929c4e74e3… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/8c6e050a7cf90929c4e74e3… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #248: Disassemble MOVS inst nicely
by Raymond Toy (＠rtoy) 22 Jul '23

22 Jul '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: d37a3150 by Raymond Toy at 2023-07-22T00:19:38+00:00 Fix #248: Disassemble MOVS inst nicely - - - - - 95dfdcf3 by Raymond Toy at 2023-07-22T00:19:39+00:00 Merge branch 'issue-248-disassemble-movs-nicely' into 'master' Fix #248: Disassemble MOVS inst nicely Closes #248 See merge request cmucl/cmucl!156 - - - - - 2 changed files: - src/compiler/x86/insts.lisp - src/general-info/release-21f.md Changes: ===================================== src/compiler/x86/insts.lisp ===================================== @@ -744,7 +744,12 @@ ;; set by a prefix instruction (or (disassem:dstate-get-prop dstate 'word-width) *default-operand-size*))) - (princ (schar (symbol-name word-width) 0) stream))))) + ;; Make sure the print case is honored when + ;; printing out the width. + (princ (ecase word-width + (:word 'w) + (:dword 'd)) + stream))))) ;;;; Disassembler instruction formats. ===================================== src/general-info/release-21f.md ===================================== @@ -23,6 +23,7 @@ public domain. * Bug fixes: * Gitlab tickets: * ~~#154~~ piglatin translation does not work anymore + * ~~#248~~ Print MOVS instruction with correct case * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4bce99fc161c8f1bc3698e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4bce99fc161c8f1bc3698e… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #171: Readably print pathnames with :unspecific
by Raymond Toy (＠rtoy) 21 Jul '23

21 Jul '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: bdd7294f by Raymond Toy at 2023-07-21T19:15:10+00:00 Fix #171: Readably print pathnames with :unspecific - - - - - 4bce99fc by Raymond Toy at 2023-07-21T19:15:11+00:00 Merge branch 'issue-171-readable-unspecific-pathnames' into 'master' Fix #171: Readably print pathnames with :unspecific Closes #171 See merge request cmucl/cmucl!134 - - - - - 2 changed files: - src/code/pathname.lisp - tests/pathname.lisp Changes: ===================================== src/code/pathname.lisp ===================================== @@ -121,58 +121,73 @@ (defun %print-pathname (pathname stream depth) (declare (ignore depth)) (let* ((host (%pathname-host pathname)) + (device (%pathname-device pathname)) + (directory (%pathname-directory pathname)) + (name (%pathname-name pathname)) + (type (%pathname-type pathname)) + (version (%pathname-version pathname)) + (unspecific-p (or (eq device :unspecific) + (eq name :unspecific) + (eq type :unspecific) + (eq version :unspecific))) (namestring (if host (handler-case (namestring pathname) (error nil)) nil))) - (cond (namestring + ;; A pathname with :UNSPECIFIC components has a namestring that + ;; ignores :UNSPECIFIC (and NIL). Thus the namestring exists, but + ;; we want to use our special syntax to print the pathname + ;; readably when :UNSPECIFIC occurs. + (cond ((and namestring (not unspecific-p)) (if (or *print-escape* *print-readably*) (format stream "#P~S" namestring) (format stream "~A" namestring))) (t - (let ((device (%pathname-device pathname)) - (directory (%pathname-directory pathname)) - (name (%pathname-name pathname)) - (type (%pathname-type pathname)) - (version (%pathname-version pathname))) - (cond ((every #'(lambda (d) - (or (stringp d) - (symbolp d))) - (cdr directory)) - ;; A CMUCL extension. If we have an unprintable - ;; pathname, convert it to a form that would be - ;; suitable as args to MAKE-PATHNAME to recreate - ;; the pathname. - ;; - ;; We don't handle search-lists because we don't - ;; currently have a readable syntax for - ;; search-lists. - (collect ((result)) - (unless (eq host *unix-host*) - (result :host) - (result (if host - (pathname-host pathname) - nil))) - (when device - (result :device) - (result device)) - (when directory - (result :directory) - (result directory)) - (when name - (result :name) - (result name)) - (when type - (result :type) - (result type)) - (when version - (result :version) - (result version)) - (format stream "#P~S" (result)))) - (*print-readably* - (error 'print-not-readable :object pathname)) - (t - (funcall (formatter "#<Unprintable pathname,~:_ Host=~S,~:_ Device=~S,~:_ ~ + (cond ((and + ;; We only use the extension if the pathname does + ;; not contain a pattern object which doesn't print + ;; readably. Search-lists, which are part of the + ;; directory component, are excluded too. + (not (typep name 'pattern)) + (not (typep type 'pattern)) + (every #'(lambda (d) + (or (stringp d) + (symbolp d))) + (cdr directory))) + ;; A CMUCL extension. If we have an unprintable + ;; pathname, convert it to a form that would be + ;; suitable as args to MAKE-PATHNAME to recreate + ;; the pathname. + ;; + ;; We don't handle search-lists because we don't + ;; currently have a readable syntax for + ;; search-lists. + (collect ((result)) + (unless (eq host *unix-host*) + (result :host) + (result (if host + (pathname-host pathname) + nil))) + (when device + (result :device) + (result device)) + (when directory + (result :directory) + (result directory)) + (when name + (result :name) + (result name)) + (when type + (result :type) + (result type)) + (when version + (result :version) + (result version)) + (format stream "#P~S" (result)))) + (*print-readably* + (error 'print-not-readable :object pathname)) + (t + (funcall (formatter "#<Unprintable pathname,~:_ Host=~S,~:_ Device=~S,~:_ ~ Directory=~S,~:_ Name=~S,~:_ Type=~S,~:_ Version=~S>") stream (%pathname-host pathname) ===================================== tests/pathname.lisp ===================================== @@ -83,3 +83,31 @@ and type = (pathname-type f) do (assert-true (and (null name) (null type)) f)))) + + + +;; Test that pathnames with :unspecific components are printed using +;; our extension to make :unspecific explicit. +(define-test issue.171.unspecific + (:tag :issues) + (flet ((output (path) + (with-output-to-string (s) + (write path :stream s)))) + (dolist (test + (list + (list (make-pathname :name "foo" :type :unspecific) + "#P(:NAME \"foo\" :TYPE :UNSPECIFIC)" + "foo") + (list (make-pathname :name :unspecific :type "foo") + "#P(:NAME :UNSPECIFIC :TYPE \"foo\")" + ".foo") + (list (make-pathname :name "foo" :type "txt" :version :unspecific) + "#P(:NAME \"foo\" :TYPE \"txt\" :VERSION :UNSPECIFIC)" + "foo.txt") + (list (make-pathname :device :unspecific) + "#P(:DEVICE :UNSPECIFIC)" + ""))) + (destructuring-bind (pathname printed-value namestring) + test + (assert-equal printed-value (output pathname)) + (assert-equal namestring (namestring pathname)))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5d4b0622357a2b6ac96dad… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/5d4b0622357a2b6ac96dad… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-171-readable-unspecific-pathnames] Undo some indentation to keep diff smaller
by Raymond Toy (＠rtoy) 21 Jul '23

21 Jul '23

Raymond Toy pushed to branch issue-171-readable-unspecific-pathnames at cmucl / cmucl Commits: 059a00b2 by Raymond Toy at 2023-07-21T11:58:36-07:00 Undo some indentation to keep diff smaller We'll leave the indentation unchanged, even though it is wrong; it's not relevant to this change. - - - - - 1 changed file: - src/code/pathname.lisp Changes: ===================================== src/code/pathname.lisp ===================================== @@ -189,13 +189,13 @@ (t (funcall (formatter "#<Unprintable pathname,~:_ Host=~S,~:_ Device=~S,~:_ ~ Directory=~S,~:_ Name=~S,~:_ Type=~S,~:_ Version=~S>") - stream - (%pathname-host pathname) - (%pathname-device pathname) - (%pathname-directory pathname) - (%pathname-name pathname) - (%pathname-type pathname) - (%pathname-version pathname))))))))) + stream + (%pathname-host pathname) + (%pathname-device pathname) + (%pathname-directory pathname) + (%pathname-name pathname) + (%pathname-type pathname) + (%pathname-version pathname))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/059a00b27bf9ce836b6fee3… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/059a00b27bf9ce836b6fee3… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #242: Mask out unwanted bits for integer results
by Raymond Toy (＠rtoy) 17 Jul '23

17 Jul '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 0a35575a by Raymond Toy at 2023-07-17T15:07:47+00:00 Fix #242: Mask out unwanted bits for integer results - - - - - 5d4b0622 by Raymond Toy at 2023-07-17T15:07:49+00:00 Merge branch 'issue-242-c-call-char-result-wrong' into 'master' Fix #242: Mask out unwanted bits for integer results Closes #242 See merge request cmucl/cmucl!154 - - - - - 5 changed files: - bin/run-tests.sh - src/code/alieneval.lisp - src/compiler/x86/c-call.lisp - tests/issues.lisp - + tests/test-return.c Changes: ===================================== bin/run-tests.sh ===================================== @@ -47,6 +47,11 @@ function cleanup { trap cleanup EXIT +# 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 # 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 ===================================== @@ -170,6 +170,9 @@ (alien-rep nil :type (or null function)) (extract-gen nil :type (or null function)) (deposit-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? @@ -646,8 +649,26 @@ #-amd64 (def-alien-type-method (integer :naturalize-gen) (type alien) - (declare (ignore type)) - alien) + ;; Mask out any unwanted bits. Important if the C code returns + ;; values in %al, or %ax + (if (alien-integer-type-signed type) + (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) (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. ;; I really should use the movsxd instruction, but I don't @@ -694,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))) @@ -705,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)) ===================================== 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 ===================================== tests/issues.lisp ===================================== @@ -997,3 +997,111 @@ ;; 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*))))) + +(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)))) + (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) x)))) + +(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)))) + (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) x)))) + +(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))))) + (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)))) + (expected (n) + (ldb (byte 8 0) n))) + (dolist (x '(99 -99 1023 -1023)) + (assert-equal (expected x) (fun x) x)))) + +(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)))) + (expected (n) + (ldb (byte 16 0) n))) + (dolist (x '(1023 -1023 100000 -100000)) + (assert-equal (expected x) (fun x) x)))) + +(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)))) + (expected (n) + (ldb (byte 32 0) n))) + (dolist (x '(1023 -1023 #x7fffffff #x-80000000)) + (assert-equal (expected x) (fun x) x)))) + +(define-test issue.242.test-alien-return-bool + (:tag :issues) + (flet ((fun (n) + (setf test-arg n) + (alien:alien-funcall + (alien:extern-alien "int_to_bool" + (function c-call:char)))) + (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) + (setf test-arg n) + (alien:alien-funcall + (alien:extern-alien "int_to_bool" + (function alien:boolean)))) + (expected (n) + (not (zerop n)))) + (dolist (x '(0 1 1000)) + (assert-equal (expected x) (fun x) x)))) ===================================== tests/test-return.c ===================================== @@ -0,0 +1,45 @@ +#include <stdbool.h> + +int test_arg; + +signed char +int_to_signed_char() +{ + return (signed char) test_arg; +} + +short +int_to_short() +{ + return (short) test_arg; +} + +int +int_to_int() +{ + return (int) test_arg; +} + +unsigned char +int_to_unsigned_char() +{ + return (unsigned char) test_arg; +} + +unsigned short +int_to_unsigned_short() +{ + return (unsigned short) test_arg; +} + +unsigned int +int_to_unsigned_int() +{ + return (unsigned int) test_arg; +} + +_Bool int_to_bool() +{ + return (_Bool) test_arg; +} + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/635d07cac7d7aa3ebe04ff… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/635d07cac7d7aa3ebe04ff… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #234: Make :ascii external format builtin.
by Raymond Toy (＠rtoy) 17 Jul '23

17 Jul '23

Raymond Toy pushed to branch master at cmucl / cmucl Commits: da69492b by Raymond Toy at 2023-07-17T15:07:01+00:00 Fix #234: Make :ascii external format builtin. - - - - - 635d07ca by Raymond Toy at 2023-07-17T15:07:04+00:00 Merge branch 'issue-234-make-ascii-format-builtin' into 'master' Fix #234: Make :ascii external format builtin. Closes #234 See merge request cmucl/cmucl!155 - - - - - 2 changed files: - src/code/extfmts.lisp - src/code/fd-stream-comp.lisp Changes: ===================================== src/code/extfmts.lisp ===================================== @@ -461,15 +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) + (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 :utf-8 *external-formats*))) + (gethash name *external-formats*))) (when (zerop (hash-table-count *external-format-aliases*)) (setf (gethash :latin1 *external-format-aliases*) :iso8859-1) @@ -1188,6 +1191,8 @@ character and illegal outputs are replaced by a question mark.") ,(subst (ef-name ef) ef (function-lambda-expression (aref (ef-cache ef) slot)))))) +;;; Builtin external formats. + ;; A safe UTF-8 external format. Any illegal UTF-8 sequences on input ;; are replaced with the Unicode REPLACEMENT CHARACTER (U+FFFD), or ;; signals an error as appropriate. @@ -1303,3 +1308,29 @@ replacement character.") ((< ,code #x10000) (utf8 ,code 2)) ((< ,code #x110000) (utf8 ,code 3)) (t (error "How did this happen? Codepoint U+~X is illegal" ,code)))))) + +(define-external-format :ascii (:size 1 :documentation +"US ASCII 7-bit encoding. Illegal input sequences are replaced with +the Unicode replacment character. Illegal output characters are +replaced with a question mark.") + () + (octets-to-code (state input unput error c) + `(let ((,c ,input)) + (values (if (< ,c #x80) + ,c + (if ,error + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Invalid octet #x~4,'0X for ASCII" ,c 1)) + +replacement-character-code+)) + 1))) + (code-to-octets (code state output error) + `(,output (if (> ,code #x7F) + (if ,error + (locally + ;; No warnings about fdefinition + (declare (optimize (ext:inhibit-warnings 3))) + (funcall ,error "Cannot output codepoint #x~X to ASCII stream" ,code)) + #x3F) + ,code)))) ===================================== src/code/fd-stream-comp.lisp ===================================== @@ -28,6 +28,7 @@ (stream::precompile-ef-slot :iso8859-1 #.stream::+ef-de+) (stream::precompile-ef-slot :iso8859-1 #.stream::+ef-osc+) +;; :utf-8 is builtin. Important since it's the default now. (stream::precompile-ef-slot :utf-8 #.stream::+ef-cin+) (stream::precompile-ef-slot :utf-8 #.stream::+ef-cout+) (stream::precompile-ef-slot :utf-8 #.stream::+ef-sout+) @@ -36,3 +37,13 @@ (stream::precompile-ef-slot :utf-8 #.stream::+ef-en+) (stream::precompile-ef-slot :utf-8 #.stream::+ef-de+) (stream::precompile-ef-slot :utf-8 #.stream::+ef-osc+) + +;; :ascii is builtin. +(stream::precompile-ef-slot :ascii #.stream::+ef-cin+) +(stream::precompile-ef-slot :ascii #.stream::+ef-cout+) +(stream::precompile-ef-slot :ascii #.stream::+ef-sout+) +(stream::precompile-ef-slot :ascii #.stream::+ef-os+) +(stream::precompile-ef-slot :ascii #.stream::+ef-so+) +(stream::precompile-ef-slot :ascii #.stream::+ef-en+) +(stream::precompile-ef-slot :ascii #.stream::+ef-de+) +(stream::precompile-ef-slot :ascii #.stream::+ef-osc+) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4e433b83b0829b262b3982… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4e433b83b0829b262b3982… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-171-readable-unspecific-pathnames] 62 commits: Fix #176: short-site-name and long-site-name return NIL
by Raymond Toy (＠rtoy) 07 Jul '23

07 Jul '23

Raymond Toy pushed to branch issue-171-readable-unspecific-pathnames at cmucl / cmucl Commits: 5958fd8d by Raymond Toy at 2023-03-23T13:45:44+00:00 Fix #176: short-site-name and long-site-name return NIL - - - - - b758b5aa by Raymond Toy at 2023-03-23T13:45:46+00:00 Merge branch 'issue-176-site-name-is-nil' into 'master' Fix #176: short-site-name and long-site-name return NIL Closes #176 See merge request cmucl/cmucl!130 - - - - - 927c2ae9 by Raymond Toy at 2023-03-23T13:46:03+00:00 Address #120: Move misc doc stuff to misc-doc.lisp - - - - - c26f8ede by Raymond Toy at 2023-03-23T13:46:05+00:00 Merge branch 'issue-120-move-misc-first' into 'master' Address #120: Move misc doc stuff to misc-doc.lisp Closes #120 See merge request cmucl/cmucl!133 - - - - - 5dc0d7bf by Raymond Toy at 2023-03-24T14:31:40+00:00 Address #158: Filename encoding for Darwin - - - - - 3578e015 by Raymond Toy at 2023-03-24T14:31:42+00:00 Merge branch 'issue-158-darwin-pathnames-utf8' into 'master' Address #158: Filename encoding for Darwin Closes #166 and #159 See merge request cmucl/cmucl!113 - - - - - ce823be4 by Raymond Toy at 2023-03-24T08:17:30-07:00 Update release notes with recently closed issues We left out a few issues that probably aren't relevant to users like #175 and #170. We also added #158 which isn't closed, but explains we support utf-8 on Darwin. - - - - - b9b145ab by Raymond Toy at 2023-03-24T08:23:42-07:00 Add period at the end of each bug item - - - - - 72cdab53 by Raymond Toy at 2023-03-29T11:33:08-07:00 Fix warning about lack of prototype in os_get_locale_codeset. Clang produces a warning for `char * os_get_locale_codeset()` because we don't give a prototype for the arg of `os_get_locale_codeset`. So just make it `void`. - - - - - bbfff3c0 by Raymond Toy at 2023-04-10T15:11:59+00:00 Fix #170: Move get-system-info to C - - - - - 5196072a by Raymond Toy at 2023-04-10T15:12:01+00:00 Merge branch 'issue-179-get-system-info-in-c' into 'master' Fix #170: Move get-system-info to C Closes #170 See merge request cmucl/cmucl!137 - - - - - b2aee0f7 by Raymond Toy at 2023-04-17T08:14:29-07:00 Update cmucl.pot with latest source Some docstrings have changed, so update cmucl.pot - - - - - fbb742ae by Raymond Toy at 2023-04-19T14:14:39+00:00 Fix #120: software-version in C - - - - - 501ca837 by Raymond Toy at 2023-04-19T14:14:40+00:00 Merge branch 'issue-120-software-type-in-c' into 'master' Fix #120: software-version in C Closes #120, #130, #146, #136, #142, #134, and #132 See merge request cmucl/cmucl!93 - - - - - 2556df76 by Raymond Toy at 2023-04-19T07:38:34-07:00 Update pot files Forgot to update these in the merges, so let's do them all now. - - - - - 38daa5e2 by Raymond Toy at 2023-04-19T15:13:28+00:00 Add missing colon after "Version" - - - - - de972bb3 by Raymond Toy at 2023-04-19T15:32:14+00:00 Merge branch 'rtoy-master-patch-80206' into 'master' Add missing colon after "Version" See merge request cmucl/cmucl!140 - - - - - f52fcecb by Raymond Toy at 2023-04-21T13:35:02+00:00 Fix #180: Move get-page-size to C - - - - - 412d6523 by Raymond Toy at 2023-04-21T13:35:02+00:00 Merge branch 'issue-180-get-page-size-in-c' into 'master' Fix #180: Move get-page-size to C Closes #180 See merge request cmucl/cmucl!136 - - - - - 31825793 by Raymond Toy at 2023-04-25T20:49:36+00:00 Fix #189: Move get-system-info from unix.lisp to os.lisp - - - - - 90a5e569 by Raymond Toy at 2023-04-25T20:49:36+00:00 Merge branch 'issue-189-move-get-system-info' into 'master' Fix #189: Move get-system-info from unix.lisp to os.lisp Closes #189 See merge request cmucl/cmucl!141 - - - - - c2a99381 by Raymond Toy at 2023-04-26T21:38:42+00:00 Fix #131: Move unix-uname to contrib/unix - - - - - acb29d8f by Raymond Toy at 2023-04-26T21:38:42+00:00 Merge branch 'issue-131-move-unix-uname' into 'master' Fix #131: Move unix-uname to contrib/unix Closes #131 See merge request cmucl/cmucl!142 - - - - - 677c3ccf by Raymond Toy at 2023-04-27T22:55:29+00:00 Fix #185: Use shorter instructions on x86 - - - - - 8826d962 by Raymond Toy at 2023-04-27T22:55:39+00:00 Merge branch 'issue-185-x86-shorter-insts' into 'master' Fix #185: Use shorter instructions on x86 Closes #185 See merge request cmucl/cmucl!138 - - - - - 784a143b by Raymond Toy at 2023-04-29T03:54:43+00:00 Fix #192: Print radix marker in disassemblies; adjust note column - - - - - ce57a9f2 by Raymond Toy at 2023-04-29T03:55:21+00:00 Merge branch 'issue-192-disassemble-prints-radix-marker' into 'master' Fix #192: Print radix marker in disassemblies; adjust note column Closes #192 See merge request cmucl/cmucl!143 - - - - - 48aa21e0 by Raymond Toy at 2023-04-28T20:59:32-07:00 Update release notes for issue #192 - - - - - 3154df47 by Raymond Toy at 2023-04-30T13:54:45+00:00 Fix #193: Treat NIL and :UNSPECIFIC as equivalent in pathnames - - - - - 9eec4ee5 by Raymond Toy at 2023-04-30T13:55:56+00:00 Merge branch 'issue-193-nil-unspecific-equivalent' into 'master' Fix #193: Treat NIL and :UNSPECIFIC as equivalent in pathnames Closes #193 See merge request cmucl/cmucl!144 - - - - - a0c4c593 by Raymond Toy at 2023-04-30T07:17:53-07:00 Update pot file - - - - - 95f592f0 by Raymond Toy at 2023-04-30T07:18:08-07:00 Update release notes for #193 - - - - - 65bf9fa5 by Raymond Toy at 2023-04-30T07:59:16-07:00 Update pot files for Darwin - - - - - 89bdabd4 by Raymond Toy at 2023-04-30T15:08:48-07:00 More pot file updates on linux. - - - - - fa4edacb by Raymond Toy at 2023-05-01T13:09:03-07:00 Update CI to use latest snapshot (2023-04) - - - - - 6162e5b4 by Jon Boone at 2023-05-09T17:38:36+00:00 Fix #143 - Adds argument checking for lisp-streams and Gray sttreams for LISTEN - - - - - e472bd4f by Jon Boone at 2023-05-09T17:38:47+00:00 Merge branch 'issue-143-ansi-compliance-failure-listen-extra-argument' into 'master' Fix #143 - Adds argument checking for lisp-streams and Gray sttreams for LISTEN Closes #143 See merge request cmucl/cmucl!145 - - - - - a4c000f9 by Raymond Toy at 2023-05-10T11:48:33-07:00 Update cmucl.pot Issue #143 updated a docstring so the pot file needs updating. - - - - - ee480fbf by Raymond Toy at 2023-05-10T11:49:20-07:00 Update release notes Issue #143 has been fixed. - - - - - 7774063f by Raymond Toy at 2023-05-12T16:28:16-07:00 Update pot files for Darwin - - - - - d53c9575 by Raymond Toy at 2023-05-12T16:43:51-07:00 Update cmucl.pot and cmucl-unix.pot for Linux See also #223. - - - - - d533ca2c by Raymond Toy at 2023-05-13T07:02:39-07:00 Update file version to 21e Add the required bootstrap file and update CI to use it. - - - - - 28167cf6 by Raymond Toy at 2023-05-13T07:05:04-07:00 Update all translations - - - - - e82bebb7 by Raymond Toy at 2023-05-13T17:29:42-07:00 Update release notes for 21e. Basically just remove the WIP section title. - - - - - 84ec62e3 by Raymond Toy at 2023-05-16T23:47:44+00:00 Address #195: Use relocatable stacks by default - - - - - 78acc885 by Raymond Toy at 2023-05-16T23:47:53+00:00 Merge branch 'issue-195-relocatable-stacks-by-default' into 'master' Address #195: Use relocatable stacks by default See merge request cmucl/cmucl!146 - - - - - 95429eb4 by Raymond Toy at 2023-05-16T16:55:54-07:00 Fix a couple of compiler warnings for functions with no args The warning is: > warning: a function declaration without a prototype is deprecated in > all versions of C [-Wstrict-prototypes] So update the two places this occurs and add `void`. - - - - - a67cb2e8 by Raymond Toy at 2023-05-20T23:43:21+00:00 Update Version to default to hint at version 21e, the latest release. - - - - - ac7d904b by Raymond Toy at 2023-05-22T16:16:29-07:00 Update docstring for *default-external-format* Add a note that `*default-external-format*` is not affected by any locale settings nor by `set-system-external-format`. `set-system-external-format` already has a note that it does not affect `*default-external-format*`. - - - - - b871db2b by Raymond Toy at 2023-05-24T17:15:28+00:00 Fix #228: Update ansi-tests from upstream - - - - - 6683933b by Raymond Toy at 2023-05-24T17:15:31+00:00 Merge branch 'issue-228-update-ansi-tests' into 'master' Fix #228: Update ansi-tests from upstream Closes #228 See merge request cmucl/cmucl!150 - - - - - dcb8124f by Raymond Toy at 2023-05-29T06:42:23-07:00 Add a simple template for release notes Supply a template for release notes that has the various parts to be filled in. This probably needs some tweaking. I'm no longer clear on the differences between "Changes", "ANSI compliance fixes", "Bug fixes", and "Gitlab tickets". - - - - - 648c1127 by Raymond Toy at 2023-05-31T03:55:52+00:00 Fix #216: enough-namestring with relative pathname fails - - - - - 660ab4c5 by Raymond Toy at 2023-05-31T03:56:07+00:00 Merge branch 'issue-216-enough-namestring-relative-dir' into 'master' Fix #216: enough-namestring with relative pathname fails Closes #216 See merge request cmucl/cmucl!152 - - - - - a2fa2dae by Raymond Toy at 2023-06-02T15:22:40-07:00 Remove unicode replacement character There's a Unicode replacement character (U+FFFD) in src/code/unicode.lisp. I tried to see if I can figure out what character was actually here, but I couldn't find the original. There's no point in having it here since it provides no information other than at some point it got replaced. Might as well remove it. - - - - - 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. - - - - - 7731faf6 by Raymond Toy at 2023-07-07T06:54:54-07:00 Merge branch 'master' into issue-171-readable-unspecific-pathnames - - - - - ea79f524 by Raymond Toy at 2023-07-07T07:27:59-07:00 Add tests for printing :unspecific in pathnames Test that :unspecific components in pathnames are printed out using our extended syntax. Also verify that the namestring is printed as if nil were used instead of :unspecific. - - - - - 30 changed files: - .gitlab-ci.yml - .gitlab/issue_templates/Bug.md - bin/build.sh - + src/bootfiles/21d/boot-21e.lisp - src/code/bsd-os.lisp - src/code/exports.lisp - src/code/extfmts.lisp - src/code/filesys.lisp - src/code/hpux-os.lisp - src/code/intl.lisp - src/code/irix-os.lisp - src/code/linux-os.lisp - + src/code/misc-doc.lisp - src/code/misc.lisp - + src/code/os.lisp - src/code/osf1-os.lisp - src/code/pathname.lisp - src/code/pred.lisp - src/code/save.lisp - src/code/sparc-svr4-vm.lisp - src/code/stream.lisp - src/code/string.lisp - src/code/sunos-os.lisp - src/code/unicode.lisp - src/code/unix.lisp - src/code/x86-vm.lisp - src/compiler/byte-comp.lisp - src/compiler/disassem.lisp - src/compiler/x86/insts.lisp - src/contrib/unix/unix-glibc2.lisp The diff was not included because it is too large. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ab252b87549f9b8aa79337… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ab252b87549f9b8aa79337… 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