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

[Git][cmucl/cmucl][issue-276-xoroshiro128starstar] 8 commits: Fix #271: Update ASDF to version 3.3.7
by Raymond Toy (＠rtoy) 14 Feb '24

14 Feb '24

Raymond Toy pushed to branch issue-276-xoroshiro128starstar at cmucl / cmucl Commits: c65d8078 by Raymond Toy at 2024-01-29T17:32:41+00:00 Fix #271: Update ASDF to version 3.3.7 - - - - - 7e4b96a1 by Raymond Toy at 2024-01-29T17:32:44+00:00 Merge branch 'issue-271-update-asdf-3.3.7' into 'master' Fix #271: Update ASDF to version 3.3.7 See merge request cmucl/cmucl!186 - - - - - 569067e1 by Raymond Toy at 2024-02-14T15:59:07+00:00 Fix #256: loop for var nil works - - - - - f570ce79 by Raymond Toy at 2024-02-14T15:59:10+00:00 Merge branch 'issue-256-loop-var-nil' into 'master' Fix #256: loop for var nil works Closes #256 See merge request cmucl/cmucl!185 - - - - - cda885f5 by Raymond Toy at 2024-02-14T16:22:26+00:00 Fix #272; Move scavenge code for static vectors to its own function - - - - - c8cafc4b by Raymond Toy at 2024-02-14T16:22:28+00:00 Merge branch 'issue-272-add-scav-static-vector-fcn' into 'master' Fix #272; Move scavenge code for static vectors to its own function Closes #272 See merge request cmucl/cmucl!187 - - - - - d6358eaf by Raymond Toy at 2024-02-14T11:44:38-08:00 Update with recent bug fixes Forgot to update this when each bug was fixed. - - - - - 633d18ed by Raymond Toy at 2024-02-14T11:46:36-08:00 Merge branch 'master' into issue-276-xoroshiro128starstar - - - - - 8 changed files: - src/code/loop.lisp - src/contrib/asdf/asdf.lisp - src/contrib/asdf/doc/asdf.html - src/contrib/asdf/doc/asdf.info - src/contrib/asdf/doc/asdf.pdf - src/general-info/release-21f.md - src/lisp/gencgc.c - + tests/loop.lisp Changes: ===================================== src/code/loop.lisp ===================================== @@ -1169,7 +1169,10 @@ collected result will be returned as the value of the LOOP." ;; these type symbols. (let ((type-spec (or (gethash z (loop-universe-type-symbols *loop-universe*)) (gethash (symbol-name z) (loop-universe-type-keywords *loop-universe*))))) - (when type-spec + ;; If Z is NIL, we have something like (loop for var nil ...). + ;; In that case, we need to pop the source to skip over the + ;; type, just as if we had (loop for var fixnum ...) + (when (or type-spec (null z)) (loop-pop-source) type-spec))) (t ===================================== src/contrib/asdf/asdf.lisp ===================================== @@ -1,5 +1,5 @@ ;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; Package: CL-USER ; buffer-read-only: t; -*- -;;; This is ASDF 3.3.6: Another System Definition Facility. +;;; This is ASDF 3.3.7: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel(a)common-lisp.net>. @@ -1848,7 +1848,7 @@ form suitable for testing with #+." (in-package :uiop/version) (with-upgradability () - (defparameter *uiop-version* "3.3.6") + (defparameter *uiop-version* "3.3.7") (defun unparse-version (version-list) "From a parsed version (a list of natural numbers), compute the version string" @@ -2144,18 +2144,56 @@ use getenvp to return NIL in such a case." (defsetf getenv (x) (val) "Set an environment variable." - (declare (ignorable x val)) - #+allegro `(setf (sys:getenv ,x) ,val) - #+clasp `(ext:setenv ,x ,val) - #+clisp `(system::setenv ,x ,val) - #+clozure `(ccl:setenv ,x ,val) - #+cmucl `(unix:unix-setenv ,x ,val 1) - #+(or ecl clasp) `(ext:setenv ,x ,val) - #+lispworks `(setf (lispworks:environment-variable ,x) ,val) - #+mkcl `(mkcl:setenv ,x ,val) - #+sbcl `(progn (require :sb-posix) (symbol-call :sb-posix :setenv ,x ,val 1)) - #-(or allegro clasp clisp clozure cmucl ecl lispworks mkcl sbcl) - '(not-implemented-error '(setf getenv))) + (declare (ignorable x val)) ; for the not-implemented cases. + (if (constantp val) + (if val + #+allegro `(setf (sys:getenv ,x) ,val) + #+clasp `(ext:setenv ,x ,val) + #+clisp `(system::setenv ,x ,val) + #+clozure `(ccl:setenv ,x ,val) + #+cmucl `(unix:unix-setenv ,x ,val 1) + #+ecl `(ext:setenv ,x ,val) + #+lispworks `(setf (lispworks:environment-variable ,x) ,val) + #+mkcl `(mkcl:setenv ,x ,val) + #+sbcl `(progn (require :sb-posix) (symbol-call :sb-posix :setenv ,x ,val 1)) + #-(or allegro clasp clisp clozure cmucl ecl lispworks mkcl sbcl) + '(not-implemented-error '(setf getenv)) + ;; VAL is NIL, unset the variable + #+allegro `(symbol-call :excl.osi :unsetenv ,x) + ;; #+clasp `(ext:setenv ,x ,val) ; UNSETENV is not supported. + #+clisp `(system::setenv ,x ,val) ; need fix -- no idea if this works. + #+clozure `(ccl:unsetenv ,x) + #+cmucl `(unix:unix-unsetenv ,x) + #+ecl `(ext:setenv ,x ,val) ; Looked at source, don't see UNSETENV + #+lispworks `(setf (lispworks:environment-variable ,x) ,val) ; according to their docs, this should unset the variable + #+mkcl `(mkcl:setenv ,x ,val) ; like other ECL-family implementations, don't see UNSETENV + #+sbcl `(progn (require :sb-posix) (symbol-call :sb-posix :unsetenv ,x)) + #-(or allegro clisp clozure cmucl ecl lispworks mkcl sbcl) + '(not-implemented-error 'unsetenv)) + `(if ,val + #+allegro (setf (sys:getenv ,x) ,val) + #+clasp (ext:setenv ,x ,val) + #+clisp (system::setenv ,x ,val) + #+clozure (ccl:setenv ,x ,val) + #+cmucl (unix:unix-setenv ,x ,val 1) + #+ecl (ext:setenv ,x ,val) + #+lispworks (setf (lispworks:environment-variable ,x) ,val) + #+mkcl (mkcl:setenv ,x ,val) + #+sbcl (progn (require :sb-posix) (symbol-call :sb-posix :setenv ,x ,val 1)) + #-(or allegro clasp clisp clozure cmucl ecl lispworks mkcl sbcl) + '(not-implemented-error '(setf getenv)) + ;; VAL is NIL, unset the variable + #+allegro (symbol-call :excl.osi :unsetenv ,x) + ;; #+clasp (ext:setenv ,x ,val) ; UNSETENV not supported + #+clisp (system::setenv ,x ,val) ; need fix -- no idea if this works. + #+clozure (ccl:unsetenv ,x) + #+cmucl (unix:unix-unsetenv ,x) + #+ecl (ext:setenv ,x ,val) ; Looked at source, don't see UNSETENV + #+lispworks (setf (lispworks:environment-variable ,x) ,val) ; according to their docs, this should unset the variable + #+mkcl (mkcl:setenv ,x ,val) ; like other ECL-family implementations, don't see UNSETENV + #+sbcl (progn (require :sb-posix) (symbol-call :sb-posix :unsetenv ,x)) + #-(or allegro clisp clozure cmucl ecl lispworks mkcl sbcl) + '(not-implemented-error 'unsetenv)))) (defun getenvp (x) "Predicate that is true if the named variable is present in the libc environment, @@ -2240,7 +2278,7 @@ then returning the non-empty string value of the variable" ;; Note if not using International ACL ;; see http://www.franz.com/support/documentation/8.1/doc/operators/excl/ics-targe… (excl:ics-target-case (:-ics "8")) - (and (member :smp *features*) "S")) + (and (member :smp *features*) "SBT")) #+armedbear (format nil "~a-fasl~a" s system::*fasl-version*) #+clisp (subseq s 0 (position #\space s)) ; strip build information (date, etc.) @@ -2282,7 +2320,8 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie (or (implementation-type) (lisp-implementation-type)) (lisp-version-string) (or (operating-system) (software-type)) - (or (architecture) (machine-type)))))) + (or (architecture) (machine-type)) + #+sbcl (if (featurep :sb-thread) "S" ""))))) ;;;; Other system information @@ -2426,8 +2465,6 @@ the number having BYTES octets (defaulting to 4)." (end-of-file (c) (declare (ignore c)) nil))))) - - ;;;; ------------------------------------------------------------------------- ;;;; Portability layer around Common Lisp pathnames ;; This layer allows for portable manipulation of pathname objects themselves, @@ -4554,7 +4591,7 @@ Upon success, the KEEP form is evaluated and the file is is deleted unless it ev ,@before))) ,@(when after (assert pathnamep) - `((,afterf (,pathname) ,@after)))) + `((,afterf (,pathname) (declare (ignorable ,pathname)) ,@after)))) #-gcl (declare (dynamic-extent ,@(when before `(#',beforef)) ,@(when after `(#',afterf)))) (call-with-temporary-file ,(when before `#',beforef) @@ -4673,7 +4710,7 @@ when the image is restarted, but before the entry point is called.") before the image dump hooks are called and before the image is dumped.") (defvar *image-dump-hook* nil - "Functions to call (in order) when before an image is dumped")) + "Functions to call (in order) before an image is dumped")) (eval-when (#-lispworks :compile-toplevel :load-toplevel :execute) (deftype fatal-condition () @@ -4984,9 +5021,17 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." #-(or clisp clozure (and cmucl executable) lispworks sbcl scl) (when executable (not-implemented-error 'dump-image "dumping an executable")) - #+allegro + #+allegro ;; revised with help from Franz (progn - (sys:resize-areas :global-gc t :pack-heap t :sift-old-areas t :tenure t) ; :new 5000000 + #+(and allegro-version>= (version>= 11)) + (sys:resize-areas + :old :no-change :old-code :no-change + :global-gc t + :tenure t) + #+(and allegro-version>= (version= 10 1)) + (sys:resize-areas :old 10000000 :global-gc t :pack-heap t :sift-old-areas t :tenure t) + #+(and allegro-version>= (not (version>= 10 1))) + (sys:resize-areas :global-gc t :pack-heap t :sift-old-areas t :tenure t) (excl:dumplisp :name filename :suppress-allegro-cl-banner t)) #+clisp (apply #'ext:saveinitmem filename @@ -5122,7 +5167,8 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." ;; Variables #:*compile-file-warnings-behaviour* #:*compile-file-failure-behaviour* #:*output-translation-function* - #:*optimization-settings* #:*previous-optimization-settings* + ;; the following dropped because unnecessary. + ;; #:*optimization-settings* #:*previous-optimization-settings* #:*base-build-directory* #:compile-condition #:compile-file-error #:compile-warned-error #:compile-failed-error #:compile-warned-warning #:compile-failed-warning @@ -5132,7 +5178,10 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." ;; Types #+sbcl #:sb-grovel-unknown-constant-condition ;; Functions & Macros - #:get-optimization-settings #:proclaim-optimization-settings #:with-optimization-settings + ;; the following three removed from UIOP because they have bugs, it's + ;; easier to remove tham than to fix them, and they could never have been + ;; used successfully in the wild. [2023/12/11:rpg] + ;; #:get-optimization-settings #:proclaim-optimization-settings #:with-optimization-settings #:call-with-muffled-compiler-conditions #:with-muffled-compiler-conditions #:call-with-muffled-loader-conditions #:with-muffled-loader-conditions #:reify-simple-sexp #:unreify-simple-sexp @@ -5167,6 +5216,7 @@ what more while the input-file is shortened if possible to ENOUGH-PATHNAME relat This can help you produce more deterministic output for FASLs.")) ;;; Optimization settings +#+ignore (with-upgradability () (defvar *optimization-settings* nil "Optimization settings to be used by PROCLAIM-OPTIMIZATION-SETTINGS") @@ -5224,7 +5274,7 @@ This can help you produce more deterministic output for FASLs.")) (proclaim `(optimize ,@,reset-settings))))) #-(or allegro clasp clisp) `(let ,(loop :for v :in +optimization-variables+ :collect `(,v ,v)) - ,@(when settings `((proclaim `(optimize ,@,settings)))) + ,@(when settings `((proclaim '(optimize ,@settings)))) ,@body))) @@ -5495,7 +5545,16 @@ Simple means made of symbols, numbers, characters, simple-strings, pathnames, co using READ within a WITH-SAFE-IO-SYNTAX, that represents the warnings currently deferred by WITH-COMPILATION-UNIT. One of three functions required for deferred-warnings support in ASDF." #+allegro - (list :functions-defined excl::.functions-defined. + (list :functions-defined + #+(and allegro-version>= (version>= 11)) + (let (functions-defined) + (maphash #'(lambda (k v) + (declare (ignore v)) + (push k functions-defined)) + excl::.functions-defined.) + functions-defined) + #+(and allegro-version>= (not (version>= 11))) + excl::.functions-defined. :functions-called excl::.functions-called.) #+clozure (mapcar 'reify-deferred-warning @@ -5539,10 +5598,18 @@ One of three functions required for deferred-warnings support in ASDF." #+allegro (destructuring-bind (&key functions-defined functions-called) reified-deferred-warnings - (setf excl::.functions-defined. + (setf #+(and allegro-version>= (not (version>= 11))) + excl::.functions-defined. + #+(and allegro-version>= (not (version>= 11))) (append functions-defined excl::.functions-defined.) excl::.functions-called. - (append functions-called excl::.functions-called.))) + (append functions-called excl::.functions-called.)) + #+(and allegro-version>= (version>= 11)) + ;; in ACL >= 11, instead of adding defined functions to a list, + ;; we insert them into a no-values hash-table. + (mapc #'(lambda (fn) + (excl:puthash-key fn excl::.functions-defined.)) + functions-defined)) #+clozure (let ((dw (or ccl::*outstanding-deferred-warnings* (setf ccl::*outstanding-deferred-warnings* (ccl::%defer-warnings t))))) @@ -5605,7 +5672,11 @@ One of three functions required for deferred-warnings support in ASDF." "Reset the set of deferred warnings to be handled at the end of the current WITH-COMPILATION-UNIT. One of three functions required for deferred-warnings support in ASDF." #+allegro - (setf excl::.functions-defined. nil + (setf excl::.functions-defined. + #+(and allegro-version>= (not (version>= 11))) + nil + #+(and allegro-version>= (version>= 11)) + (make-hash-table :test #'equal :values nil) excl::.functions-called. nil) #+clozure (if-let (dw ccl::*outstanding-deferred-warnings*) @@ -7809,7 +7880,8 @@ DEPRECATED." #:*post-upgrade-cleanup-hook* #:cleanup-upgraded-asdf ;; There will be no symbol left behind! #:with-asdf-deprecation - #:intern*) + #:intern* + #:asdf-install-warning) (:import-from :uiop/package #:intern* #:find-symbol*)) (in-package :asdf/upgrade) @@ -7894,7 +7966,7 @@ previously-loaded version of ASDF." ;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5. ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 - (asdf-version "3.3.6") + (asdf-version "3.3.7") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) @@ -7970,6 +8042,19 @@ previously-loaded version of ASDF." (call-functions (reverse *post-upgrade-cleanup-hook*))) t)))) + (define-condition asdf-install-warning (simple-condition warning) + ((format-control + :initarg :format-control) + (format-arguments + :initarg :format-arguments + :initform nil)) + (:documentation "Warning class for issues related to upgrading or loading ASDF.") + (:report (lambda (c s) + (format s "WARNING: ~?" + (slot-value c 'format-control) + (slot-value c 'format-arguments))))) + + (defun upgrade-asdf () "Try to upgrade of ASDF. If a different version was used, return T. We need do that before we operate on anything that may possibly depend on ASDF." @@ -12551,7 +12636,9 @@ into a single file")) #:package-inferred-system #:sysdef-package-inferred-system-search #:package-system ;; backward compatibility only. To be removed. #:register-system-packages - #:*defpackage-forms* #:*package-inferred-systems* #:package-inferred-system-missing-package-error)) + #:*defpackage-forms* #:*package-inferred-systems* + #:package-inferred-system-missing-package-error + #:package-inferred-system-unknown-defpackage-option-error)) (in-package :asdf/package-inferred-system) (with-upgradability () @@ -12602,15 +12689,34 @@ every such file")) trying to define package-inferred-system ~A from file ~A~>") (error-system c) (error-pathname c))))) - (defun package-dependencies (defpackage-form) + (define-condition package-inferred-system-unknown-defpackage-option-error (system-definition-error) + ((system :initarg :system :reader error-system) + (pathname :initarg :pathname :reader error-pathname) + (option :initarg :clause-head :reader error-option) + (arguments :initarg :clause-rest :reader error-arguments)) + (:report (lambda (c s) + (format s (compatfmt "~@<Don't know how to infer package dependencies ~ + for non-standard option ~S ~ + while trying to define package-inferred-system ~A ~ + from file ~A~>") + (cons (error-option c) + (error-arguments c)) + (error-system c) + (error-pathname c))))) + + (defun package-dependencies (defpackage-form &optional system pathname) "Return a list of packages depended on by the package defined in DEFPACKAGE-FORM. A package is depended upon if -the DEFPACKAGE-FORM uses it or imports a symbol from it." +the DEFPACKAGE-FORM uses it or imports a symbol from it. + +SYSTEM should be the name of the system being defined, and +PATHNAME should be the file which contains the DEFPACKAGE-FORM. +These will be used to report errors when encountering an unknown defpackage argument." (assert (defpackage-form-p defpackage-form)) (remove-duplicates (while-collecting (dep) (loop :for (option . arguments) :in (cddr defpackage-form) :do - (ecase option + (case option ((:use :mix :reexport :use-reexport :mix-reexport) (dolist (p arguments) (dep (string p)))) ((:import-from :shadowing-import-from) @@ -12619,7 +12725,37 @@ the DEFPACKAGE-FORM uses it or imports a symbol from it." ((:local-nicknames) (loop :for (nil actual-package-name) :in arguments :do (dep (string actual-package-name)))) - ((:nicknames :documentation :shadow :export :intern :unintern :recycle))))) + ((:nicknames :documentation :shadow :export :intern :unintern :recycle)) + + ;;; SBCL extensions to defpackage relating to package locks. + ;; See https://www.sbcl.org/manual/#Implementation-Packages . + #+(or sbcl ecl) ;; MKCL too? + ((:lock) + ;; A :LOCK clause introduces no dependencies. + nil) + #+sbcl + ((:implement) + ;; A :IMPLEMENT clause introduces dependencies on the listed packages, + ;; as it's not meaningful to :IMPLEMENT a package which hasn't yet been defined. + (dolist (p arguments) (dep (string p)))) + + #+lispworks + ((:add-use-defaults) nil) + + #+allegro + ((:implementation-packages :alternate-name :flat) nil) + + ;; When encountering an unknown OPTION, signal a continuable error. + ;; We cannot in general know whether the unknown clause should introduce any dependencies, + ;; so we cannot do anything other than signal an error here, + ;; but users may know that certain extensions do not introduce dependencies, + ;; and may wish to manually continue building. + (otherwise (cerror "Treat the unknown option as introducing no package dependencies" + 'package-inferred-system-unknown-defpackage-option-error + :system system + :pathname pathname + :option option + :arguments arguments))))) :from-end t :test 'equal)) (defun package-designator-name (package) @@ -13974,6 +14110,13 @@ system or its dependencies if it has already been loaded." (when (boundp 'excl:*warn-on-nested-reader-conditionals*) (setf excl:*warn-on-nested-reader-conditionals* uiop/common-lisp::*acl-warn-save*)) + #+(and allegro allegro-v10.1) ;; check for patch needed for upgradeability + (unless (assoc "ma040" (cdr (assoc :lisp sys:*patches*)) :test 'equal) + (warn 'asdf-install-warning + :format-control "On Allegro Common Lisp 10.1, patch pma040 is ~ +needed for correct ASDF upgrading. Please update your Allegro image ~ +using (SYS:UPDATE-ALLEGRO).")) + ;; Advertise the features we provide. (dolist (f '(:asdf :asdf2 :asdf3 :asdf3.1 :asdf3.2 :asdf3.3)) (pushnew f *features*)) ===================================== src/contrib/asdf/doc/asdf.html ===================================== The diff for this file was not included because it is too large. ===================================== src/contrib/asdf/doc/asdf.info ===================================== The diff for this file was not included because it is too large. ===================================== src/contrib/asdf/doc/asdf.pdf ===================================== Binary files a/src/contrib/asdf/doc/asdf.pdf and b/src/contrib/asdf/doc/asdf.pdf differ ===================================== src/general-info/release-21f.md ===================================== @@ -23,6 +23,7 @@ public domain. * Add support for Gray streams implementation of file-length via `ext:stream-file-length` generic function. * Changes: + * Update to ASDF 3.3.7 * The RNG has changed from an old version of xoroshiro128+ to xoroshiro128**. This means sequences of random numbers will be different from before. See ~~#276~~. @@ -41,8 +42,11 @@ public domain. * ~~#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 + * ~~#256~~ loop for var nil works * ~~#269~~ Add function to get user's home directory * ~~#266~~ Support "~user" in namestrings + * ~~#271~~ Update ASDF to 3.3.7 + * ~~#272~~ Move scavenge code for static vectors to its own function * ~~#276~~ Implement xoroshiro128** generator for x86 * Other changes: * Improvements to the PCL implementation of CLOS: ===================================== src/lisp/gencgc.c ===================================== @@ -2698,6 +2698,43 @@ maybe_static_array_p(lispobj header) return result; } +static int +scav_static_vector(lispobj object) +{ + lispobj *ptr = (lispobj *) PTR(object); + lispobj header = *ptr; + + if (debug_static_array_p) { + fprintf(stderr, "Not in Lisp spaces: object = %p, ptr = %p\n", + (void*)object, ptr); + fprintf(stderr, " Header value = 0x%lx\n", (unsigned long) header); + } + + if (maybe_static_array_p(header)) { + int static_p; + + if (debug_static_array_p) { + fprintf(stderr, "Possible static vector at %p. header = 0x%lx\n", + ptr, (unsigned long) header); + } + + static_p = (HeaderValue(header) & 1) == 1; + if (static_p) { + /* + * We have a static vector. Mark it as + * reachable by setting the MSB of the header. + */ + *ptr = header | 0x80000000; + if (debug_static_array_p) { + fprintf(stderr, "Scavenged static vector @%p, header = 0x%lx\n", + ptr, (unsigned long) header); + } + } + } + + return 1; +} + /* Scavenging */ @@ -2756,41 +2793,7 @@ scavenge(void *start_obj, long nwords) || other_space_p(object)) { words_scavenged = 1; } else { - lispobj *ptr = (lispobj *) PTR(object); - words_scavenged = 1; - if (debug_static_array_p) { - fprintf(stderr, "Not in Lisp spaces: object = %p, ptr = %p\n", - (void*)object, ptr); - } - - if (1) { - lispobj header = *ptr; - if (debug_static_array_p) { - fprintf(stderr, " Header value = 0x%lx\n", (unsigned long) header); - } - - if (maybe_static_array_p(header)) { - int static_p; - - if (debug_static_array_p) { - fprintf(stderr, "Possible static vector at %p. header = 0x%lx\n", - ptr, (unsigned long) header); - } - - static_p = (HeaderValue(header) & 1) == 1; - if (static_p) { - /* - * We have a static vector. Mark it as - * reachable by setting the MSB of the header. - */ - *ptr = header | 0x80000000; - if (debug_static_array_p) { - fprintf(stderr, "Scavenged static vector @%p, header = 0x%lx\n", - ptr, (unsigned long) header); - } - } - } - } + words_scavenged = scav_static_vector(object); } } else if ((object & 3) == 0) words_scavenged = 1; ===================================== tests/loop.lisp ===================================== @@ -0,0 +1,14 @@ +;;; Tests from gitlab issues + +(defpackage :loop-tests + (:use :cl :lisp-unit)) + +(in-package "LOOP-TESTS") + +(define-test loop-var-nil + (:tag :issues) + ;; Just verify that (loop for var nil ...) works. Previously it + ;; signaled an error. See Gitlab issue #256. + (assert-equal '(1 2) + (loop for var nil from 1 to 2 collect var))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ea36f802fc0111c62c7846… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/ea36f802fc0111c62c7846… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update with recent bug fixes
by Raymond Toy (＠rtoy) 14 Feb '24

14 Feb '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: d6358eaf by Raymond Toy at 2024-02-14T11:44:38-08:00 Update with recent bug fixes Forgot to update this when each bug was fixed. - - - - - 1 changed file: - src/general-info/release-21f.md Changes: ===================================== src/general-info/release-21f.md ===================================== @@ -39,8 +39,11 @@ public domain. * ~~#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 + * ~~#256~~ loop for var nil works * ~~#269~~ Add function to get user's home directory * ~~#266~~ Support "~user" in namestrings + * ~~#271~~ Update ASDF to 3.3.7 + * ~~#272~~ Move scavenge code for static vectors to its own function * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/d6358eaf8804e249b8cbaaa… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/d6358eaf8804e249b8cbaaa… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #272; Move scavenge code for static vectors to its own function
by Raymond Toy (＠rtoy) 14 Feb '24

14 Feb '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: cda885f5 by Raymond Toy at 2024-02-14T16:22:26+00:00 Fix #272; Move scavenge code for static vectors to its own function - - - - - c8cafc4b by Raymond Toy at 2024-02-14T16:22:28+00:00 Merge branch 'issue-272-add-scav-static-vector-fcn' into 'master' Fix #272; Move scavenge code for static vectors to its own function Closes #272 See merge request cmucl/cmucl!187 - - - - - 1 changed file: - src/lisp/gencgc.c Changes: ===================================== src/lisp/gencgc.c ===================================== @@ -2698,6 +2698,43 @@ maybe_static_array_p(lispobj header) return result; } +static int +scav_static_vector(lispobj object) +{ + lispobj *ptr = (lispobj *) PTR(object); + lispobj header = *ptr; + + if (debug_static_array_p) { + fprintf(stderr, "Not in Lisp spaces: object = %p, ptr = %p\n", + (void*)object, ptr); + fprintf(stderr, " Header value = 0x%lx\n", (unsigned long) header); + } + + if (maybe_static_array_p(header)) { + int static_p; + + if (debug_static_array_p) { + fprintf(stderr, "Possible static vector at %p. header = 0x%lx\n", + ptr, (unsigned long) header); + } + + static_p = (HeaderValue(header) & 1) == 1; + if (static_p) { + /* + * We have a static vector. Mark it as + * reachable by setting the MSB of the header. + */ + *ptr = header | 0x80000000; + if (debug_static_array_p) { + fprintf(stderr, "Scavenged static vector @%p, header = 0x%lx\n", + ptr, (unsigned long) header); + } + } + } + + return 1; +} + /* Scavenging */ @@ -2756,41 +2793,7 @@ scavenge(void *start_obj, long nwords) || other_space_p(object)) { words_scavenged = 1; } else { - lispobj *ptr = (lispobj *) PTR(object); - words_scavenged = 1; - if (debug_static_array_p) { - fprintf(stderr, "Not in Lisp spaces: object = %p, ptr = %p\n", - (void*)object, ptr); - } - - if (1) { - lispobj header = *ptr; - if (debug_static_array_p) { - fprintf(stderr, " Header value = 0x%lx\n", (unsigned long) header); - } - - if (maybe_static_array_p(header)) { - int static_p; - - if (debug_static_array_p) { - fprintf(stderr, "Possible static vector at %p. header = 0x%lx\n", - ptr, (unsigned long) header); - } - - static_p = (HeaderValue(header) & 1) == 1; - if (static_p) { - /* - * We have a static vector. Mark it as - * reachable by setting the MSB of the header. - */ - *ptr = header | 0x80000000; - if (debug_static_array_p) { - fprintf(stderr, "Scavenged static vector @%p, header = 0x%lx\n", - ptr, (unsigned long) header); - } - } - } - } + words_scavenged = scav_static_vector(object); } } else if ((object & 3) == 0) words_scavenged = 1; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/f570ce7951d58bdcb1bccb… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/f570ce7951d58bdcb1bccb… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #256: loop for var nil works
by Raymond Toy (＠rtoy) 14 Feb '24

14 Feb '24

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 569067e1 by Raymond Toy at 2024-02-14T15:59:07+00:00 Fix #256: loop for var nil works - - - - - f570ce79 by Raymond Toy at 2024-02-14T15:59:10+00:00 Merge branch 'issue-256-loop-var-nil' into 'master' Fix #256: loop for var nil works Closes #256 See merge request cmucl/cmucl!185 - - - - - 2 changed files: - src/code/loop.lisp - + tests/loop.lisp Changes: ===================================== src/code/loop.lisp ===================================== @@ -1169,7 +1169,10 @@ collected result will be returned as the value of the LOOP." ;; these type symbols. (let ((type-spec (or (gethash z (loop-universe-type-symbols *loop-universe*)) (gethash (symbol-name z) (loop-universe-type-keywords *loop-universe*))))) - (when type-spec + ;; If Z is NIL, we have something like (loop for var nil ...). + ;; In that case, we need to pop the source to skip over the + ;; type, just as if we had (loop for var fixnum ...) + (when (or type-spec (null z)) (loop-pop-source) type-spec))) (t ===================================== tests/loop.lisp ===================================== @@ -0,0 +1,14 @@ +;;; Tests from gitlab issues + +(defpackage :loop-tests + (:use :cl :lisp-unit)) + +(in-package "LOOP-TESTS") + +(define-test loop-var-nil + (:tag :issues) + ;; Just verify that (loop for var nil ...) works. Previously it + ;; signaled an error. See Gitlab issue #256. + (assert-equal '(1 2) + (loop for var nil from 1 to 2 collect var))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/7e4b96a10457b415b931ad… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/7e4b96a10457b415b931ad… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-272-add-scav-static-vector-fcn] Address review comment
by Raymond Toy (＠rtoy) 14 Feb '24

14 Feb '24

Raymond Toy pushed to branch issue-272-add-scav-static-vector-fcn at cmucl / cmucl Commits: def94dc5 by Raymond Toy at 2024-02-14T07:05:38-08:00 Address review comment Merge body of two identical successive if conditions into one. - - - - - 1 changed file: - src/lisp/gencgc.c Changes: ===================================== src/lisp/gencgc.c ===================================== @@ -2707,9 +2707,6 @@ scav_static_vector(lispobj object) if (debug_static_array_p) { fprintf(stderr, "Not in Lisp spaces: object = %p, ptr = %p\n", (void*)object, ptr); - } - - if (debug_static_array_p) { fprintf(stderr, " Header value = 0x%lx\n", (unsigned long) header); } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/def94dc566c562312e667c5… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/def94dc566c562312e667c5… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-272-add-scav-static-vector-fcn] Apply 1 suggestion(s) to 1 file(s)
by Raymond Toy (＠rtoy) 14 Feb '24

14 Feb '24

Raymond Toy pushed to branch issue-272-add-scav-static-vector-fcn at cmucl / cmucl Commits: 406f2a4b by Carl Shapiro at 2024-02-14T15:02:53+00:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 1 changed file: - src/lisp/gencgc.c Changes: ===================================== src/lisp/gencgc.c ===================================== @@ -2698,7 +2698,7 @@ maybe_static_array_p(lispobj header) return result; } -int +static int scav_static_vector(lispobj object) { lispobj *ptr = (lispobj *) PTR(object); View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/406f2a4b4d83c339bb7ce5b… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/406f2a4b4d83c339bb7ce5b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-256-loop-var-nil] Refill comment to 80 columns as requested.
by Raymond Toy (＠rtoy) 14 Feb '24

14 Feb '24

Raymond Toy pushed to branch issue-256-loop-var-nil at cmucl / cmucl Commits: 701c8a64 by Raymond Toy at 2024-02-14T06:59:39-08:00 Refill comment to 80 columns as requested. - - - - - 1 changed file: - src/code/loop.lisp Changes: ===================================== src/code/loop.lisp ===================================== @@ -1169,10 +1169,9 @@ collected result will be returned as the value of the LOOP." ;; these type symbols. (let ((type-spec (or (gethash z (loop-universe-type-symbols *loop-universe*)) (gethash (symbol-name z) (loop-universe-type-keywords *loop-universe*))))) - ;; If Z is NIL, we have something like (loop for var - ;; nil ...). In that case, we need to pop the - ;; source to skip over the type, just as if we had - ;; (loop for var fixnum ...) + ;; If Z is NIL, we have something like (loop for var nil ...). + ;; In that case, we need to pop the source to skip over the + ;; type, just as if we had (loop for var fixnum ...) (when (or type-spec (null z)) (loop-pop-source) type-spec))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/701c8a646faf2d6d0e76807… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/701c8a646faf2d6d0e76807… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-256-loop-var-nil] Apply 1 suggestion(s) to 1 file(s)
by Raymond Toy (＠rtoy) 14 Feb '24

14 Feb '24

Raymond Toy pushed to branch issue-256-loop-var-nil at cmucl / cmucl Commits: 7d9e1761 by Carl Shapiro at 2024-02-14T14:45:19+00:00 Apply 1 suggestion(s) to 1 file(s) - - - - - 1 changed file: - src/code/loop.lisp Changes: ===================================== src/code/loop.lisp ===================================== @@ -1163,7 +1163,7 @@ collected result will be returned as the value of the LOOP." ;; a common lisp type specifier or pattern (matching the variable) thereof. (loop-pop-source) (loop-pop-source)) - + ((symbolp z) ;;This is the (sort of) "old" syntax, even though we didn't used to support all of ;; these type symbols. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7d9e176129b529e294bfe86… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7d9e176129b529e294bfe86… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-276-xoroshiro128starstar] Clean up indentation
by Raymond Toy (＠rtoy) 14 Feb '24

14 Feb '24

Raymond Toy pushed to branch issue-276-xoroshiro128starstar at cmucl / cmucl Commits: ea36f802 by Raymond Toy at 2024-02-14T06:39:29-08:00 Clean up indentation - - - - - 2 changed files: - src/code/rand-xoroshiro.lisp - src/compiler/x86/arith.lisp Changes: ===================================== src/code/rand-xoroshiro.lisp ===================================== @@ -535,7 +535,7 @@ x0))) (setf (aref state 0) (convert s0-1 s0-0)) (setf (aref state 1) (convert s1-1 s1-0))) - rng-state)) + rng-state)) #+x86 (defun random-state-jump (&optional (rng-state *random-state*)) ===================================== src/compiler/x86/arith.lisp ===================================== @@ -1720,10 +1720,10 @@ ;; s0 = state[0] (inst movsd s0 (make-ea :dword :base state - :disp (- (+ (* vm:vector-data-offset - vm:word-bytes) - (* 8 0)) - vm:other-pointer-type))) + :disp (- (+ (* vm:vector-data-offset + vm:word-bytes) + (* 8 0)) + vm:other-pointer-type))) ;; t0 = s0 * 5 = s0 << 2 + s0 (inst movapd t0 s0) ; t0 = s0 (inst psllq t0 2) ; t0 = t0 << 2 = 4*t0 @@ -1750,10 +1750,10 @@ ;; s1 = state[1] (inst movsd s1 (make-ea :dword :base state - :disp (- (+ (* vm:vector-data-offset - vm:word-bytes) - (* 8 1)) - vm:other-pointer-type))) + :disp (- (+ (* vm:vector-data-offset + vm:word-bytes) + (* 8 1)) + vm:other-pointer-type))) (inst xorpd s1 s0) ; s1 = s1 ^ s0 ;; s0 can now be reused as a temp. @@ -1773,10 +1773,10 @@ ;; Save s0 to state[0] (inst movsd (make-ea :dword :base state - :disp (- (+ (* vm:vector-data-offset - vm:word-bytes) - (* 8 0)) - vm:other-pointer-type)) + :disp (- (+ (* vm:vector-data-offset + vm:word-bytes) + (* 8 0)) + vm:other-pointer-type)) s0) ;; s1 = rotl(s1, 37) @@ -1787,9 +1787,9 @@ ;; Save s1 to state[1] (inst movsd (make-ea :dword :base state - :disp (- (+ (* vm:vector-data-offset - vm:word-bytes) - (* 8 1)) - vm:other-pointer-type)) + :disp (- (+ (* vm:vector-data-offset + vm:word-bytes) + (* 8 1)) + vm:other-pointer-type)) s1))) ) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ea36f802fc0111c62c7846c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ea36f802fc0111c62c7846c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-276-xoroshiro128starstar] 2 commits: Remove old implementation of xoroshiro-next
by Raymond Toy (＠rtoy) 14 Feb '24

14 Feb '24

Raymond Toy pushed to branch issue-276-xoroshiro128starstar at cmucl / cmucl Commits: 31b7ffd9 by Raymond Toy at 2024-02-13T19:57:48-08:00 Remove old implementation of xoroshiro-next This was for xoroshiro128+, and we're using xoroshiro128** now. - - - - - f452e5d2 by Raymond Toy at 2024-02-13T19:58:26-08:00 Update release notes Make an explicit note that we've changed the RNG generator. - - - - - 2 changed files: - src/compiler/x86/arith.lisp - src/general-info/release-21f.md Changes: ===================================== src/compiler/x86/arith.lisp ===================================== @@ -1678,79 +1678,6 @@ (in-package "VM") -#|| -#+random-xoroshiro -(progn -(defknown xoroshiro-next ((simple-array double-float (2))) - (values (unsigned-byte 32) (unsigned-byte 32)) - (movable)) - -(define-vop (xoroshiro-next) - (:policy :fast-safe) - (:translate xoroshiro-next) - (:args (state :scs (descriptor-reg) :to (:result 3))) - (:arg-types simple-array-double-float) - (:results (r1 :scs (unsigned-reg)) - (r0 :scs (unsigned-reg))) - (:result-types unsigned-num unsigned-num) - (:temporary (:sc double-reg) s0) - (:temporary (:sc double-reg) s1) - (:temporary (:sc double-reg) t0) - (:generator 10 - ;; s0 = state[0] - (inst movsd s0 (make-ea :dword :base state - :disp (- (+ (* vm:vector-data-offset - vm:word-bytes) - (* 8 0)) - vm:other-pointer-type))) - ;; s1 = state[1] - (inst movsd s1 (make-ea :dword :base state - :disp (- (+ (* vm:vector-data-offset - vm:word-bytes) - (* 8 1)) - vm:other-pointer-type))) - ;; Compute result = s0 + s1 - (inst movapd t0 s0) - (inst paddq t0 s1) - ;; Save the 64-bit result as two 32-bit results - (inst movd r0 t0) - (inst psrlq t0 32) - (inst movd r1 t0) - - ;; s1 = s1 ^ s0 - (inst xorpd s1 s0) - - ;; s0 = rotl(s0,55) = s0 << 55 | s0 >> 9 - (inst movapd t0 s0) - (inst psllq s0 55) ; s0 = s0 << 55 - (inst psrlq t0 9) ; t0 = s0 >> 9 - (inst orpd s0 t0) ; s0 = rotl(s0, 55) - - (inst movapd t0 s1) - (inst xorpd s0 s1) ; s0 = s0 ^ s1 - (inst psllq t0 14) ; t0 = s1 << 14 - (inst xorpd s0 t0) ; s0 = s0 ^ t0 - (inst movsd (make-ea :dword :base state - :disp (- (+ (* vm:vector-data-offset - vm:word-bytes) - (* 8 0)) - vm:other-pointer-type)) - s0) - - ;; s1 = rotl(s1, 36) = s1 << 36 | s1 >> 28, using t0 as temp - (inst movapd t0 s1) - (inst psllq s1 36) - (inst psrlq t0 28) - (inst orpd s1 t0) - - (inst movsd (make-ea :dword :base state - :disp (- (+ (* vm:vector-data-offset - vm:word-bytes) - (* 8 1)) - vm:other-pointer-type)) - s1))) -) -||# #+random-xoroshiro (progn (defknown xoroshiro-next ((simple-array double-float (2))) @@ -1790,6 +1717,8 @@ ;; ;; return result; ;; } + + ;; s0 = state[0] (inst movsd s0 (make-ea :dword :base state :disp (- (+ (* vm:vector-data-offset vm:word-bytes) @@ -1819,6 +1748,7 @@ (inst psrlq t0 32) (inst movd r1 t0) + ;; s1 = state[1] (inst movsd s1 (make-ea :dword :base state :disp (- (+ (* vm:vector-data-offset vm:word-bytes) ===================================== src/general-info/release-21f.md ===================================== @@ -23,6 +23,9 @@ public domain. * Add support for Gray streams implementation of file-length via `ext:stream-file-length` generic function. * Changes: + * The RNG has changed from an old version of xoroshiro128+ to + xoroshiro128**. This means sequences of random numbers will be + different from before. See ~~#276~~. * ANSI compliance fixes: * Bug fixes: * Gitlab tickets: @@ -40,6 +43,7 @@ public domain. * ~~#258~~ Remove `get-page-size` from linux-os.lisp * ~~#269~~ Add function to get user's home directory * ~~#266~~ Support "~user" in namestrings + * ~~#276~~ Implement xoroshiro128** generator for x86 * 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/1b1c57ad6e23556f6cf9ba… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1b1c57ad6e23556f6cf9ba… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0