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

[Git][cmucl/cmucl][issue-243-weak-pointer-to-static-array] 2 commits: Implement algorithm from Carl in the comments
by Raymond Toy (＠rtoy) 16 Feb '24

16 Feb '24

Raymond Toy pushed to branch issue-243-weak-pointer-to-static-array at cmucl / cmucl Commits: 25743350 by Raymond Toy at 2024-02-16T09:40:50-08:00 Implement algorithm from Carl in the comments A pretty straightforward implementation of the algorithm from @cshapiro without having to allocate an array. - - - - - 254f9b45 by Raymond Toy at 2024-02-16T09:48:21-08:00 Clarify and clean up some comments. - - - - - 1 changed file: - src/lisp/gencgc.c Changes: ===================================== src/lisp/gencgc.c ===================================== @@ -5397,94 +5397,107 @@ size_weak_pointer(lispobj * where) } -#if 0 static void -update_static_vector_list(lispobj value, lispobj* vectors_to_free, int* num_static_vectors) +scan_static_vectors(void) { + struct weak_pointer *wp; + struct weak_pointer *clearable_list = NULL; + + printf("Phase 1: build clearable list\n"); + /* - * We have a static array with the mark cleared which means it's - * not used. + * Find weak pointers to unmarked static arrays, using a linked + * list. We reuse the next slot ofthe weak pointer to chain these + * weak pointers together. * - * Only add it if we don't already have it. We don't want - * duplicates because we'll end up trying to free things multiple - * times. + * Invariant: clearable_list only has weak pointers to unmarked + * static vectors. */ - int m; - int found = 0; - - for (m = 0; m < *num_static_vectors; ++m) { - if (value == vectors_to_free[m]) { - printf("Found %p at %d\n", (lispobj *) value, m); - found = 1; - break; + wp = weak_pointers; + while (wp) { + lispobj value = wp->value; + struct weak_pointer *next = wp->next; + + if (Pointerp(value)) { + /* The value may be a static vector */ + lispobj *header = (lispobj *) PTR(value); + + if (maybe_static_array_p(*header) + && (HeaderValue(*header) == 1)) { + printf("Adding %p header = 0x%08lx, next = %p\n", + wp, *header, wp->next); + wp->next = clearable_list; + clearable_list = wp; + } else { + printf("Skipping %p header = 0x%08lx\n", wp, *header); + } } + wp = next; } - if (!found) { - printf("Adding %p at %d\n", (lispobj *) value, *num_static_vectors); - vectors_to_free[*num_static_vectors] = value; - ++*num_static_vectors; - } -} -#endif - -void -scan_weak_pointers(void) -{ - struct weak_pointer *wp; + printf("Phase 2\n"); + /* - * Array of weak pointers to unmarked static vectors that can be - * freed. + * clearable_list now points to all weak pointers to unmarked + * static vectors. Go through the list. If it's not marked, mark + * it. If it's marked, break the weak pointer. + * + * Invariant: clearable_list contains only weak pointers that have + * been broken or that point to a unique dead static vector. */ - struct weak_pointer **clearable_list; + for (wp = clearable_list; wp; wp = wp->next) { + lispobj *header = (lispobj *) PTR(wp->value); - /* Total number of weak pointers */ - int num_weak_pointers = 0; + printf("wp %p value 0x%08lx header 0x%08lx\n", + wp, wp->value, *header); + if (HeaderValue(*header) == 1) { + printf(" Mark vector\n"); + *header |= 0x80000000; + } else { + printf(" Break weak pointer %p\n", wp); + wp->value = NIL; + wp->broken = T; + } + } + + printf("Phase 3: Free static vectors\n"); - /* Number of static vectors that we can free */ - int num_static_vectors = 0; - int n; - /* - * Count the number of weak pointers so we can allocate enough - * space for clearable_list. + * Free up space. Go through clearable_list and for each weak + * pointer that has not been broken, we can free the space. Then + * break the weak pointer too, since the space has been freed. */ + for (wp = clearable_list; wp; wp = wp->next) { + if (wp->broken == NIL) { + lispobj *static_array = (lispobj *) PTR(wp->value); + printf("free wp %p: %p\n", wp, static_array); - if (debug_static_array_p) { - printf("Phase 0\n"); - } - - for (wp = weak_pointers; wp; wp = wp->next) { - num_weak_pointers++; - } + wp->value = NIL; + wp->broken = T; - if (debug_static_array_p) { - printf("weak pointer count = %d\n", num_weak_pointers); + free(static_array); + } } +} - /* Nothing to do if there are no weak pointers */ - if (num_weak_pointers == 0) { - return; - } - - /* - * Allocate enough space to hold all weak pointers in case they - * all point to static vectors. - */ - clearable_list = (struct weak_pointer **) malloc(num_weak_pointers * sizeof(struct weak_pointer *)); - gc_assert(clearable_list); +void +scan_weak_pointers(void) +{ + struct weak_pointer *wp; /* * Now process the weak pointers. */ - if (debug_static_array_p) { - printf("Phase 1\n"); - } + printf("scan_weak_pointers...\n"); + for (wp = weak_pointers; wp; wp = wp->next) { lispobj value = wp->value; lispobj *first_pointer = (lispobj *) PTR(value); + printf("scan_weak: wp = %p value %p header 0x%08lx\n", + wp, (lispobj*) value, *first_pointer); + wp->mark_bit = NIL; if (Pointerp(value)) { if (from_space_p(value)) { @@ -5494,111 +5507,12 @@ scan_weak_pointers(void) wp->value = NIL; wp->broken = T; } - } else { - /* The value may be a static vector */ - lispobj *header = (lispobj *) PTR(value); - - if (debug_static_array_p) { - printf("wp %p: value %p, header = 0x%08lx\n", - wp, (lispobj*) value, *header); - } - - if (maybe_static_array_p(*header)) { - /* - * A header value of 1 means we have a static - * vector with the in-use bit cleared, so we can - * add this weak pointer to the clearable list. - */ - if (HeaderValue(*header) == 1) { - if (debug_static_array_p) { - printf(" clearable_list[%d] = %p\n", num_static_vectors, wp); - } - - clearable_list[num_static_vectors] = wp; - ++num_static_vectors; - } - } - } - } - } - - /* - * At this point, clearable_list contains all the weak pointers to - * unmarked (unused) static vecotors. - * - * Traverse the clearable list. If the weak pointer points to an - * unmarked static vector, mark it. If it points to a marked - * static vector, then we know it shares a referent with another - * weak pointer. Break this weak pointer and remove it from the - * clearable list by setting it to NIL. - */ - if (debug_static_array_p) { - printf("Phase 2: %d pointers\n", num_static_vectors); - } - - for (n = 0; n < num_static_vectors; ++n) { - struct weak_pointer *wp = clearable_list[n]; - lispobj *header = (lispobj *) PTR(wp->value); - - if (debug_static_array_p) { - printf("%2d: wp = %p, header = 0x%08lx\n", n, wp, *header); - } - - if (HeaderValue(*header) == 1) { - /* - * If the header value is 1, we have an unmarked static - * vector. Mark it now. - */ - if (debug_static_array_p) { - printf(" Mark vector\n"); - } - - *header |= 0x80000000; - } else { - /* - * We have a marked static vector. Break this weak - * pointer and remove it from the list by setting it to - * NIL. - */ - if (debug_static_array_p) { - printf(" Break weak pointer %p\n", wp); - } - - wp->value = NIL; - wp->broken = T; - clearable_list[n] = NULL; - } - } - - /* - * At this point, the clearable list is either NIL or a weak - * pointer that references a unique dead static vector. - * - * Traverse the clearable list skipping over any NIL entries. For - * all other entries, free the static vector and break the weak - * pointer. - */ - - if (debug_static_array_p) { - printf("Phase 3: Free static vectors\n"); - } - - for (n = 0; n < num_static_vectors; ++n) { - struct weak_pointer *wp = clearable_list[n]; - if (wp != NULL) { - lispobj *static_array = (lispobj *) PTR(wp->value); - - if (debug_static_array_p) { - printf("%2d: free wp %p: %p\n", n, (void*) wp, static_array); } - - free(static_array); - wp->value = NIL; - wp->broken = T; } } + printf("scan_weak_pointers done\n"); - free(clearable_list); + scan_static_vectors(); } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/afa06641a1eee29ce3796b… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/afa06641a1eee29ce3796b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-243-weak-pointer-to-static-array] Add some comments
by Raymond Toy (＠rtoy) 15 Feb '24

15 Feb '24

Raymond Toy pushed to branch issue-243-weak-pointer-to-static-array at cmucl / cmucl Commits: afa06641 by Raymond Toy at 2024-02-15T08:52:10-08:00 Add some comments - - - - - 1 changed file: - src/lisp/gencgc.c Changes: ===================================== src/lisp/gencgc.c ===================================== @@ -5431,8 +5431,17 @@ void scan_weak_pointers(void) { struct weak_pointer *wp; + + /* + * Array of weak pointers to unmarked static vectors that can be + * freed. + */ struct weak_pointer **clearable_list; + + /* Total number of weak pointers */ int num_weak_pointers = 0; + + /* Number of static vectors that we can free */ int num_static_vectors = 0; int n; @@ -5514,6 +5523,9 @@ scan_weak_pointers(void) } /* + * At this point, clearable_list contains all the weak pointers to + * unmarked (unused) static vecotors. + * * Traverse the clearable list. If the weak pointer points to an * unmarked static vector, mark it. If it points to a marked * static vector, then we know it shares a referent with another @@ -5559,8 +5571,12 @@ scan_weak_pointers(void) } /* - * Traverse the clearable list and free the static vector, - * skipping over any NIL values. + * At this point, the clearable list is either NIL or a weak + * pointer that references a unique dead static vector. + * + * Traverse the clearable list skipping over any NIL entries. For + * all other entries, free the static vector and break the weak + * pointer. */ if (debug_static_array_p) { View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/afa06641a1eee29ce3796b3… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/afa06641a1eee29ce3796b3… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-243-weak-pointer-to-static-array] 11 commits: Fix #271: Update ASDF to version 3.3.7
by Raymond Toy (＠rtoy) 15 Feb '24

15 Feb '24

Raymond Toy pushed to branch issue-243-weak-pointer-to-static-array 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. - - - - - daeccf04 by Raymond Toy at 2024-02-14T14:36:46-08:00 Merge branch 'master' into issue-243-weak-pointer-to-static-array - - - - - 44743f61 by Raymond Toy at 2024-02-14T15:59:45-08:00 Implement algorithm suggested by Carl First cut at implementing the algorithm. More work needed. - - - - - 9fe13723 by Raymond Toy at 2024-02-15T07:09:37-08:00 Forgot to break the weak pointers to static vector being freed When we free the static vector, we need to break the weak pointer to the now free space. (Duh!) Update some prints to make it a little clearer what's happening. - - - - - 7f34622e by Raymond Toy at 2024-02-15T07:25:18-08:00 Print debug stuff only if debug_static_array_p is set. - - - - - 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 * ANSI compliance fixes: * Bug fixes: * Gitlab tickets: @@ -38,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: ===================================== 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; @@ -5394,6 +5397,7 @@ size_weak_pointer(lispobj * where) } +#if 0 static void update_static_vector_list(lispobj value, lispobj* vectors_to_free, int* num_static_vectors) { @@ -5421,26 +5425,33 @@ update_static_vector_list(lispobj value, lispobj* vectors_to_free, int* num_stat ++*num_static_vectors; } } +#endif void scan_weak_pointers(void) { struct weak_pointer *wp; - lispobj* vectors_to_free = NULL; + struct weak_pointer **clearable_list; int num_weak_pointers = 0; int num_static_vectors = 0; int n; /* * Count the number of weak pointers so we can allocate enough - * space for vectors_to_free. + * space for clearable_list. */ + + if (debug_static_array_p) { + printf("Phase 0\n"); + } for (wp = weak_pointers; wp; wp = wp->next) { num_weak_pointers++; } - printf("weak pointer count = %d\n", num_weak_pointers); + if (debug_static_array_p) { + printf("weak pointer count = %d\n", num_weak_pointers); + } /* Nothing to do if there are no weak pointers */ if (num_weak_pointers == 0) { @@ -5451,14 +5462,16 @@ scan_weak_pointers(void) * Allocate enough space to hold all weak pointers in case they * all point to static vectors. */ - vectors_to_free = (lispobj*) malloc(num_weak_pointers * sizeof(lispobj)); - gc_assert(vectors_to_free); - - printf("vectors_to_free = %p\n", vectors_to_free); + clearable_list = (struct weak_pointer **) malloc(num_weak_pointers * sizeof(struct weak_pointer *)); + gc_assert(clearable_list); /* * Now process the weak pointers. */ + if (debug_static_array_p) { + printf("Phase 1\n"); + } + for (wp = weak_pointers; wp; wp = wp->next) { lispobj value = wp->value; lispobj *first_pointer = (lispobj *) PTR(value); @@ -5476,22 +5489,24 @@ scan_weak_pointers(void) /* The value may be a static vector */ lispobj *header = (lispobj *) PTR(value); - printf("value %p, header = %0lx\n", (lispobj*) value, *header); + if (debug_static_array_p) { + printf("wp %p: value %p, header = 0x%08lx\n", + wp, (lispobj*) value, *header); + } if (maybe_static_array_p(*header)) { /* * A header value of 1 means we have a static * vector with the in-use bit cleared, so we can - * collect the vector. + * add this weak pointer to the clearable list. */ if (HeaderValue(*header) == 1) { - update_static_vector_list(value, vectors_to_free, &num_static_vectors); - - /* - * Now we can break the weak pointer to the static vector. - */ - wp->value = NIL; - wp->broken = T; + if (debug_static_array_p) { + printf(" clearable_list[%d] = %p\n", num_static_vectors, wp); + } + + clearable_list[num_static_vectors] = wp; + ++num_static_vectors; } } } @@ -5499,17 +5514,75 @@ scan_weak_pointers(void) } /* - * Free up any unreferenced static vectors now + * Traverse the clearable list. If the weak pointer points to an + * unmarked static vector, mark it. If it points to a marked + * static vector, then we know it shares a referent with another + * weak pointer. Break this weak pointer and remove it from the + * clearable list by setting it to NIL. + */ + if (debug_static_array_p) { + printf("Phase 2: %d pointers\n", num_static_vectors); + } + + for (n = 0; n < num_static_vectors; ++n) { + struct weak_pointer *wp = clearable_list[n]; + lispobj *header = (lispobj *) PTR(wp->value); + + if (debug_static_array_p) { + printf("%2d: wp = %p, header = 0x%08lx\n", n, wp, *header); + } + + if (HeaderValue(*header) == 1) { + /* + * If the header value is 1, we have an unmarked static + * vector. Mark it now. + */ + if (debug_static_array_p) { + printf(" Mark vector\n"); + } + + *header |= 0x80000000; + } else { + /* + * We have a marked static vector. Break this weak + * pointer and remove it from the list by setting it to + * NIL. + */ + if (debug_static_array_p) { + printf(" Break weak pointer %p\n", wp); + } + + wp->value = NIL; + wp->broken = T; + clearable_list[n] = NULL; + } + } + + /* + * Traverse the clearable list and free the static vector, + * skipping over any NIL values. */ - printf("%d static vectors to be freed\n", num_static_vectors); + + if (debug_static_array_p) { + printf("Phase 3: Free static vectors\n"); + } for (n = 0; n < num_static_vectors; ++n) { - lispobj *header = (lispobj *) PTR(vectors_to_free[n]); - printf("free %p: %p\n", (void*) vectors_to_free[n], header); - free(header); + struct weak_pointer *wp = clearable_list[n]; + if (wp != NULL) { + lispobj *static_array = (lispobj *) PTR(wp->value); + + if (debug_static_array_p) { + printf("%2d: free wp %p: %p\n", n, (void*) wp, static_array); + } + + free(static_array); + wp->value = NIL; + wp->broken = T; + } } - free(vectors_to_free); + free(clearable_list); } ===================================== 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/b6faa24ed282c902b9f925… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/b6faa24ed282c902b9f925… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-277-float-ratio-float-least-positive-float] 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-277-float-ratio-float-least-positive-float 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. - - - - - f7cd2a92 by Raymond Toy at 2024-02-14T14:32:44-08:00 Merge branch 'master' into issue-277-float-ratio-float-least-positive-float - - - - - 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 * ANSI compliance fixes: * Bug fixes: * Gitlab tickets: @@ -38,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 * ~~#277~~ `float-ratio-float` returns least postive float for ratios closer to that than zero. * Other 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; ===================================== 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/6aec95c6d40e6e83bfcb1b… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/6aec95c6d40e6e83bfcb1b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[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