Raymond Toy pushed to branch issue-259-use-right-software-version at cmucl / cmucl

Commits: 917c4240 by Raymond Toy at 2023-08-30T17:38:23+00:00 Fix #258: Remove get-page-size from linux-os.lisp

- - - - - 77dee627 by Raymond Toy at 2023-08-30T17:38:40+00:00 Merge branch 'issue-258-remove-get-page-size-from-linux-os' into 'master'

Fix #258: Remove get-page-size from linux-os.lisp

Closes #258

See merge request cmucl/cmucl!172 - - - - - db531fef by Raymond Toy at 2023-08-30T17:59:50+00:00 Address #240: Add hashtable for set-exclusive-or

- - - - - 766c6aa5 by Raymond Toy at 2023-08-30T18:00:08+00:00 Merge branch 'issue-240-add-hashtable-set-exclusive-or' into 'master'

Address #240: Add hashtable for set-exclusive-or

See merge request cmucl/cmucl!169 - - - - - 961c96ad by Raymond Toy at 2023-08-30T11:12:42-07:00 Update release notes with fixed issues

- - - - - f473d365 by Raymond Toy at 2023-09-04T14:52:33-07:00 Merge branch 'master' into issue-259-use-right-software-version

- - - - - 8d5757b8 by Raymond Toy at 2023-09-04T15:23:06-07:00 Fix #259: Use correct package for *software-version*

It's not super clear what package `*software-version*` should be in, but there was some confusion. It's defined in the LISP package (in misc.lisp), but in linux-os.lisp, which sets it, all the code there is in the SYSTEM package.

So move `*software-version*` to the SYSTEM package, and update linux-os.lisp to use it.

It's also weird if `*software-type*` is different, so move it to the SYSTEM package too, and don't export it anymore, since it seems like an internal variable not meant to be exposed.

To make these changes, you MUST build with the bootstrap file boot-2023-08 from the 2023-08 snapshot. (Probably works if built from 21e, but untested.)

- - - - -

10 changed files:

- src/bootfiles/21e/boot-2023-08.lisp - src/code/exports.lisp - src/code/linux-os.lisp - src/code/list.lisp - src/code/misc.lisp - src/general-info/release-21f.md - src/i18n/locale/cmucl-linux-os.pot - src/i18n/locale/cmucl.pot - + tests/environ.lisp - tests/sets.lisp

Changes:

===================================== src/bootfiles/21e/boot-2023-08.lisp ===================================== @@ -2,4 +2,5 @@ ;; ;; Build with -B boot-2023-08 from the 21e release. (ext:without-package-locks - (unintern 'lisp::*software-version* "LISP")) + (unintern 'lisp::*software-version* "LISP") + (unexport 'system::*software-type* "SYSTEM"))

===================================== src/code/exports.lisp ===================================== @@ -2057,8 +2057,6 @@ "%SP-REVERSE-FIND-CHARACTER-WITH-ATTRIBUTE" "%STANDARD-CHAR-P" "*BEEP-FUNCTION*" "*LONG-SITE-NAME*" "*SHORT-SITE-NAME*" - "*SOFTWARE-TYPE*" - "*SOFTWARE-VERSION*" "*STDERR*" "*STDIN*" "*STDOUT*" "*TASK-DATA*" "*TASK-NOTIFY*" "*TASK-SELF*" "*TTY*" "*TYPESCRIPTPORT*" "*XWINDOW-TABLE*"

===================================== src/code/linux-os.lisp ===================================== @@ -32,16 +32,3 @@ ;;; (defun os-init () (setf *software-version* nil)) - - -;;; GET-PAGE-SIZE -- Interface -;;; -;;; Return the system page size. -;;; -(defun get-page-size () - (multiple-value-bind (val err) - (unix:unix-getpagesize) - (unless val - (error (intl:gettext "Getpagesize failed: ~A") (unix:get-unix-error-msg err))) - val)) -

===================================== src/code/list.lisp ===================================== @@ -928,7 +928,7 @@

(defun set-exclusive-or (list1 list2 &key key (test #'eql testp) (test-not nil notp)) - "Return new list of elements appearing exactly once in LIST1 and LIST2." + "Return new list of elements appearing exactly one of LIST1 and LIST2." (declare (inline member)) (let ((result nil) (key (when key (coerce key 'function))) @@ -936,19 +936,38 @@ (test-not (if test-not (coerce test-not 'function) #'eql))) (declare (type (or function null) key) (type function test test-not)) - (dolist (elt list1) - (unless (with-set-keys (member (apply-key key elt) list2)) - (setq result (cons elt result)))) - (let ((test (if testp - (lambda (x y) (funcall test y x)) - test)) - (test-not (if notp - (lambda (x y) (funcall test-not y x)) - test-not))) - (dolist (elt list2) - (unless (with-set-keys (member (apply-key key elt) list1)) - (setq result (cons elt result))))) - result)) + ;; Find the elements in list1 that do not appear in list2 and add + ;; them to the result. + (macrolet + ((compute-membership (item-list test-form) + `(dolist (elt ,item-list) + (unless ,test-form + (setq result (cons elt result)))))) + (let ((hashtable (list-to-hashtable list2 key test test-not))) + (cond + (hashtable + (compute-membership list1 + (nth-value 1 (gethash (apply-key key elt) hashtable)))) + (t + (compute-membership list1 + (with-set-keys (member (apply-key key elt) list2)))))) + ;; Now find the elements in list2 that do not appear in list1 and + ;; them to the result. + (let ((hashtable (list-to-hashtable list1 key test test-not))) + (cond + (hashtable + (compute-membership list2 + (nth-value 1 (gethash (apply-key key elt) hashtable)))) + (t + (let ((test (if testp + (lambda (x y) (funcall test y x)) + test)) + (test-not (if notp + (lambda (x y) (funcall test-not y x)) + test-not))) + (compute-membership list2 + (with-set-keys (member (apply-key key elt) list1))))))) + result)))

;;; The outer loop examines list1 while the inner loop examines list2. If an

===================================== src/code/misc.lisp ===================================== @@ -23,7 +23,12 @@ short-site-name long-site-name dribble compiler-macro))

(in-package "SYSTEM") -(export '(*software-type* *short-site-name* *long-site-name*)) +(export '(*short-site-name* *long-site-name*)) +(defvar *software-type* "Unix" + _N"The value of SOFTWARE-TYPE. Set in FOO-os.lisp.") + +(defvar *software-version* nil + _N"Version string for supporting software")

(in-package "EXT") (export 'featurep) @@ -80,20 +85,14 @@ "Returns a string giving the name of the local machine." (unix:unix-gethostname))

-(defvar *software-type* "Unix" - _N"The value of SOFTWARE-TYPE. Set in FOO-os.lisp.") - (defun software-type () "Returns a string describing the supporting software." - *software-type*) - -(defvar *software-version* nil - _N"Version string for supporting software") + system::*software-type*)

(defun software-version () _N"Returns a string describing version of the supporting software." - (unless *software-version* - (setf *software-version* + (unless system::*software-version* + (setf system::*software-version* (let (version result) (unwind-protect (progn @@ -105,7 +104,7 @@ (if (zerop (length result)) "Unknown" result))) - *software-version*)) + system::*software-version*))

(defvar *short-site-name* nil "The value of SHORT-SITE-NAME. Set in library:site-init.lisp.")

===================================== src/general-info/release-21f.md ===================================== @@ -1,3 +1,5 @@ +# CMUCL 21f + # Work in progress

The CMUCL project is pleased to announce the release of CMUCL 21f. @@ -24,9 +26,16 @@ public domain. * 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 + * ~~#196~~ Fix issues with mapping and nconc accumulation (mapcan) + * ~~#216~~ `enough-namestring` with relative pathname fails + * ~~#234~~ Make :ASCII external format builtin + * ~~#240~~ Speed up set operations + * ~~#242~~ Fix bug in `alien-funcall` with `c-call:char` as result type * ~~#244~~ Add `c-call:signed-char` * ~~#248~~ Print MOVS instruction with correct case + * ~~#249~~ Replace LEA instruction with simpler shorter instructions in arithmetic vops for x86 + * ~~#253~~ Block-compile list-to-hashtable and callers + * ~~#258~~ Remove `get-page-size` from linux-os.lisp * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure:

===================================== src/i18n/locale/cmucl-linux-os.pot ===================================== @@ -15,10 +15,6 @@ msgstr "" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n"

-#: src/code/linux-os.lisp -msgid "Getpagesize failed: ~A" -msgstr "" - #: src/code/signal.lisp msgid "Stack fault on coprocessor" msgstr ""

===================================== src/i18n/locale/cmucl.pot ===================================== @@ -3236,7 +3236,7 @@ msgid "Destructively returns the elements of list1 which are not in list2." msgstr ""

#: src/code/list.lisp -msgid "Return new list of elements appearing exactly once in LIST1 and LIST2." +msgid "Return new list of elements appearing exactly one of LIST1 and LIST2." msgstr ""

#: src/code/list.lisp @@ -5619,6 +5619,14 @@ msgid "" " NIL if no such character exists." msgstr ""

+#: src/code/misc.lisp +msgid "The value of SOFTWARE-TYPE. Set in FOO-os.lisp." +msgstr "" + +#: src/code/misc.lisp +msgid "Version string for supporting software" +msgstr "" + #: src/code/misc.lisp msgid "" "If X is an atom, see if it is present in *FEATURES*. Also\n" @@ -5645,18 +5653,10 @@ msgstr "" msgid "Returns a string giving the name of the local machine." msgstr ""

-#: src/code/misc.lisp -msgid "The value of SOFTWARE-TYPE. Set in FOO-os.lisp." -msgstr "" - #: src/code/misc.lisp msgid "Returns a string describing the supporting software." msgstr ""

-#: src/code/misc.lisp -msgid "Version string for supporting software" -msgstr "" - #: src/code/misc.lisp msgid "Returns a string describing version of the supporting software." msgstr ""

===================================== tests/environ.lisp ===================================== @@ -0,0 +1,23 @@ +;; Tests for environment dictionary + +(defpackage :environ-tests + (:use :cl :lisp-unit)) + +(in-package "ENVIRON-TESTS") + +(define-test software-type + (:tag :issues) + (let ((type (software-type))) + ;; Can't really test anything, so just verify we get a non-empty + ;; string. + (assert-true (typep type 'string)) + (assert-true (plusp (length type))))) + +(define-test software-version + (:tag :issues) + (let ((version (software-version))) + ;; Can't really test anything, so just verify we get a non-empty + ;; string. + (assert-true (typep version 'string)) + (assert-true (plusp (length version))))) +

===================================== tests/sets.lisp ===================================== @@ -279,3 +279,26 @@ '(3 4) :test 'eql :test-not 'equal))) + +(define-test set-exclusive-or.1 + (:tag :issues) + (flet + ((test (min-length) + ;; From CLHS + (let ((lisp::*min-list-length-for-hashtable* min-length)) + (assert-equal '("b" "A" "b" "a") + (set-exclusive-or '(1 "a" "b") + '(1 "A" "b"))) + (assert-equal '("A" "a") + (set-exclusive-or '(1 "a" "b") + '(1 "A" "b") + :test #'equal)) + (assert-equal nil + (set-exclusive-or '(1 "a" "b") + '(1 "A" "b") + :test #'equalp))))) + ;; Test the list impl by making the min length large. Then test + ;; the hashtable impl with a very short min length + (test 100) + (test 2))) +

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/dd384b8200627dd67aedfcc...