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

[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

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

06 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