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

[Git][cmucl/cmucl][issue-243-weak-pointer-to-static-array] Fix typo bug and remove comment
by Raymond Toy (＠rtoy) 18 Feb '24

18 Feb '24

Raymond Toy pushed to branch issue-243-weak-pointer-to-static-array at cmucl / cmucl Commits: 9cb44e30 by Raymond Toy at 2024-02-17T19:59:54-08:00 Fix typo bug and remove comment In merging the if statements we should have used `&&` instead of `&`. - - - - - 1 changed file: - src/lisp/gencgc.c Changes: ===================================== src/lisp/gencgc.c ===================================== @@ -5570,16 +5570,12 @@ scan_weak_pointers(void) { struct weak_pointer *wp; - /* - * Now process the weak pointers. - */ - for (wp = weak_pointers; wp; wp = wp->next) { lispobj value = wp->value; lispobj *first_pointer = (lispobj *) PTR(value); wp->mark_bit = NIL; - if (Pointerp(value) & from_space_p(value)) { + if (Pointerp(value) && from_space_p(value)) { if (first_pointer[0] == 0x01) wp->value = first_pointer[1]; else { View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/9cb44e305299b41e951c584… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/9cb44e305299b41e951c584… 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] Minor tweak to minimize diff from master
by Raymond Toy (＠rtoy) 18 Feb '24

18 Feb '24

Raymond Toy pushed to branch issue-243-weak-pointer-to-static-array at cmucl / cmucl Commits: f45625b4 by Raymond Toy at 2024-02-17T19:54:26-08:00 Minor tweak to minimize diff from master Combine two if statements like it was on master to minimize the diff between this version and master because it's a needless change. - - - - - 1 changed file: - src/lisp/gencgc.c Changes: ===================================== src/lisp/gencgc.c ===================================== @@ -5579,14 +5579,12 @@ scan_weak_pointers(void) lispobj *first_pointer = (lispobj *) PTR(value); wp->mark_bit = NIL; - if (Pointerp(value)) { - if (from_space_p(value)) { - if (first_pointer[0] == 0x01) - wp->value = first_pointer[1]; - else { - wp->value = NIL; - wp->broken = T; - } + if (Pointerp(value) & from_space_p(value)) { + if (first_pointer[0] == 0x01) + wp->value = first_pointer[1]; + else { + wp->value = NIL; + wp->broken = T; } } } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/f45625b4992eada575b56dd… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/f45625b4992eada575b56dd… 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] Remove unneeded clear-static-vector-mark
by Raymond Toy (＠rtoy) 17 Feb '24

17 Feb '24

Raymond Toy pushed to branch issue-243-weak-pointer-to-static-array at cmucl / cmucl Commits: 4ccd8d2a by Raymond Toy at 2024-02-17T12:58:07-08:00 Remove unneeded clear-static-vector-mark Remove `clear-static-vector-mark` because GC does that for us now in `scan_static_vectors`. Fix up some comments in `finalize-static-vectors`, and be a bit more careful in only removing an item from `lisp::*static-vectors*` only if the weak pointer was broken. Minor tweak to a debugging print. Update cmucl.pot. - - - - - 3 changed files: - src/code/array.lisp - src/i18n/locale/cmucl.pot - src/lisp/gencgc.c Changes: ===================================== src/code/array.lisp ===================================== @@ -374,40 +374,20 @@ sys:system-area-pointer)) (sys:int-sap addr))))) -(defun clear-static-vector-mark () - ;; Run down the list of weak pointers to static vectors. For each - ;; vector, clear the mark. - (dolist (wp *static-vectors*) - (let ((vector (weak-pointer-value wp))) - ;; The value should never be NIL here? - (when vector - (let* ((sap (sys:vector-sap vector)) - (header (sys:sap-ref-32 sap (* -2 vm:word-bytes)))) - (when *debug-static-array-p* - (format t (intl:gettext "static vector ~A. header = ~X~%") - vector header)) - (setf (sys:sap-ref-32 sap (* -2 vm:word-bytes)) - (logand header #x7fffffff))))))) - (defun finalize-static-vectors () - ;; Run down the list of weak-pointers to static vectors. Look at - ;; the static vector and see if vector is marked. If so, clear the - ;; mark, and do nothing. If the mark is not set, then the vector is - ;; free, so free it, and remove this weak-pointer from the list. - ;; The mark bit the MSB of the header word. Look at scavenge in - ;; gencgc.c. + ;; Run down the list of weak-pointers to static vectors and remove + ;; any weak pointers that have been broken. (when *static-vectors* (when *debug-static-array-p* (let ((*print-array* nil)) (format t (intl:gettext "Finalizing static vectors ~S~%") *static-vectors*))) - ;; Remove any weak pointers that whose value is NIL. The + ;; Remove any weak pointers that have been broken. The ;; corresponding static array has been freed by GC. (setf *static-vectors* - (delete-if-not #'weak-pointer-value *static-vectors*)))) + (delete-if-not #'(lambda (wp) + (nth-value 1 (weak-pointer-value wp))) + *static-vectors*)))) -;; Clear the mark bit of all of static vectors before GC -#+nil -(pushnew 'clear-static-vector-mark *before-gc-hooks*) ;; Clean up any unreferenced static vectors after GC has run. (pushnew 'finalize-static-vectors *after-gc-hooks*) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -2379,10 +2379,6 @@ msgstr "" msgid "~&Freeing foreign vector at #x~X~%" msgstr "" -#: src/code/array.lisp -msgid "static vector ~A. header = ~X~%" -msgstr "" - #: src/code/array.lisp msgid "Finalizing static vectors ~S~%" msgstr "" ===================================== src/lisp/gencgc.c ===================================== @@ -5532,7 +5532,7 @@ scan_static_vectors(void) if ((*header & STATIC_VECTOR_MARK_BIT) == 0) { lispobj *static_array = (lispobj *) PTR(wp->value); if (debug_static_array_p) { - printf(" Free wp\n"); + printf(" Free static vector\n"); } wp->value = NIL; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/4ccd8d2a9bbd8d4965722c7… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/4ccd8d2a9bbd8d4965722c7… 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] Turn off debug_static_array_p
by Raymond Toy (＠rtoy) 17 Feb '24

17 Feb '24

Raymond Toy pushed to branch issue-243-weak-pointer-to-static-array at cmucl / cmucl Commits: 18bdcf0a by Raymond Toy at 2024-02-17T09:32:53-08:00 Turn off debug_static_array_p - - - - - 1 changed file: - src/lisp/gencgc.c Changes: ===================================== src/lisp/gencgc.c ===================================== @@ -260,7 +260,7 @@ unsigned counters_verbose = 0; * If true, then some debugging information is printed when scavenging * static (malloc'ed) arrays. */ -boolean debug_static_array_p = 1; +boolean debug_static_array_p = 0; /* * To enable the use of page protection to help avoid the scavenging View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/18bdcf0a5f76cf17d6005b3… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/18bdcf0a5f76cf17d6005b3… 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] 3 commits: Don't add to the *before-gc-hooks* to clear static vector marks.
by Raymond Toy (＠rtoy) 17 Feb '24

17 Feb '24

Raymond Toy pushed to branch issue-243-weak-pointer-to-static-array at cmucl / cmucl Commits: 5472c92c by Raymond Toy at 2024-02-16T16:05:27-08:00 Don't add to the *before-gc-hooks* to clear static vector marks. - - - - - 060bbae4 by Raymond Toy at 2024-02-17T08:43:19-08:00 Clean up implementation Add `#defines` for the various bits needed to handle processing of static arrays. When scavenging weak pointers to static arrays, clear out the visited bit, just to be safe. Clean up debugging prints. Add phase 4 to go through all the remaining static vectors and unmark them so we don't have to do that in Lisp. - - - - - 255af7a5 by Raymond Toy at 2024-02-17T09:03:01-08:00 Clean up prints some more - - - - - 2 changed files: - src/code/array.lisp - src/lisp/gencgc.c Changes: ===================================== src/code/array.lisp ===================================== @@ -406,6 +406,7 @@ (delete-if-not #'weak-pointer-value *static-vectors*)))) ;; Clear the mark bit of all of static vectors before GC +#+nil (pushnew 'clear-static-vector-mark *before-gc-hooks*) ;; Clean up any unreferenced static vectors after GC has run. (pushnew 'finalize-static-vectors *after-gc-hooks*) ===================================== src/lisp/gencgc.c ===================================== @@ -32,6 +32,25 @@ */ #define EQ_BASED_HASH_VALUE 0x80000000 +/* + * If the header value for a vector has this bit set, then it is a + * static vector. + */ +#define STATIC_VECTOR_HEADER_BIT 0x1 + +/* + * Mark bit for static vectors. If set in the header, the static + * vector is in use. + */ +#define STATIC_VECTOR_MARK_BIT 0x80000000 + +/* + * Visited bit for static vectors. When scanning weak pointers for + * static vectors, this bit indicates that we've visited this static + * vector already. + */ +#define STATIC_VECTOR_VISITED_BIT 0x08000000 + #define gc_abort() lose("GC invariant lost! File \"%s\", line %d\n", \ __FILE__, __LINE__) @@ -241,7 +260,7 @@ unsigned counters_verbose = 0; * If true, then some debugging information is printed when scavenging * static (malloc'ed) arrays. */ -boolean debug_static_array_p = 0; +boolean debug_static_array_p = 1; /* * To enable the use of page protection to help avoid the scavenging @@ -2718,13 +2737,14 @@ scav_static_vector(lispobj object) ptr, (unsigned long) header); } - static_p = (HeaderValue(header) & 1) == 1; + static_p = (HeaderValue(header) & STATIC_VECTOR_HEADER_BIT) == 1; if (static_p) { /* - * We have a static vector. Mark it as - * reachable by setting the MSB of the header. + * We have a static vector. Mark it as reachable by + * setting the MSB of the header. And clear out any + * possible visited bit. */ - *ptr = header | 0x80000000; + *ptr = (header | STATIC_VECTOR_MARK_BIT) & ~STATIC_VECTOR_VISITED_BIT; if (debug_static_array_p) { fprintf(stderr, "Scavenged static vector @%p, header = 0x%lx\n", ptr, (unsigned long) header); @@ -5402,10 +5422,9 @@ scan_static_vectors(void) { struct weak_pointer *wp; struct weak_pointer *static_vector_list = NULL; - const int scan_mark_flag = 0x8000; if (debug_static_array_p) { - printf("Phase 1: find static vectors\n"); + printf("Phase 1: Find static vectors\n"); } /* @@ -5428,15 +5447,16 @@ scan_static_vectors(void) if (maybe_static_array_p(*header)) { if (debug_static_array_p) { - printf("Adding %p header = 0x%08lx, next = %p\n", - wp, *header, wp->next); + printf(" Add: wp %p value %p header 0x%08lx, next = %p\n", + wp, (lispobj *) wp->value, *header, wp->next); } wp->next = static_vector_list; static_vector_list = wp; } else { if (debug_static_array_p) { - printf("Skipping %p header = 0x%08lx\n", wp, *header); + printf(" Skip: wp %p value %p header 0x%08lx\n", + wp, (lispobj *) wp->value, *header); } } } @@ -5444,7 +5464,7 @@ scan_static_vectors(void) } if (debug_static_array_p) { - printf("Phase 2\n"); + printf("Phase 2: Visit unused static vectors\n"); } /* @@ -5458,25 +5478,26 @@ scan_static_vectors(void) lispobj *header = (lispobj *) PTR(wp->value); if (debug_static_array_p) { - printf("wp %p value 0x%08lx header 0x%08lx\n", - wp, wp->value, *header); + printf(" wp %p value %p header 0x%08lx\n", + wp, (lispobj *) wp->value, *header); } /* * If the static vector is unused (mark bit clear) and if we - * haven't seen this vector before, set the scan flag. + * haven't seen this vector before, set the visited flag. If + * we have visited this vector before, break the weak pointer. */ - if ((*header & 0x80000000) == 0) { + if ((*header & STATIC_VECTOR_MARK_BIT) == 0) { /* Unused static vector */ - if ((*header & scan_mark_flag) == 0) { + if ((*header & STATIC_VECTOR_VISITED_BIT) == 0) { if (debug_static_array_p) { - printf(" Mark vector\n"); + printf(" Mark vector\n"); } - *header |= scan_mark_flag; + *header |= STATIC_VECTOR_VISITED_BIT; } else { if (debug_static_array_p) { - printf(" Break weak pointer %p\n", wp); + printf(" Break weak pointer %p\n", wp); } wp->value = NIL; @@ -5499,16 +5520,19 @@ scan_static_vectors(void) for (wp = static_vector_list; wp; wp = wp->next) { lispobj *header = (lispobj *) PTR(wp->value); - printf("wp = %p, header = 0x%08lx\n", wp, *header); + if (debug_static_array_p) { + printf(" wp %p value %p header 0x%08lx\n", + wp, (lispobj*) wp->value, *header); + } /* * Only free the arrays where the mark bit is clear. */ if (wp->broken == NIL) { - if ((*header & 0x80000000) == 0) { + if ((*header & STATIC_VECTOR_MARK_BIT) == 0) { lispobj *static_array = (lispobj *) PTR(wp->value); if (debug_static_array_p) { - printf("free wp %p: %p\n", wp, static_array); + printf(" Free wp\n"); } wp->value = NIL; @@ -5518,6 +5542,27 @@ scan_static_vectors(void) } } } + + if (debug_static_array_p) { + printf("Phase 4: unmark static vectors\n"); + } + + for (wp = static_vector_list; wp; wp = wp->next) { + lispobj *header = (lispobj *) PTR(wp->value); + + if (debug_static_array_p) { + printf(" wp %p value %p broken %d header 0x%08lx\n", + wp, (lispobj*) wp->value, wp->broken == T, *header); + } + + if ((*header & STATIC_VECTOR_MARK_BIT) != 0) { + if (debug_static_array_p) { + printf(" Clearing mark bit\n"); + } + + *header &= ~STATIC_VECTOR_MARK_BIT; + } + } } void View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/959be526befaead7b46d43… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/959be526befaead7b46d43… 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] Create list of all static vectors, not just the unmarked ones
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: 959be526 by Raymond Toy at 2024-02-16T13:08:57-08:00 Create list of all static vectors, not just the unmarked ones Instead of creating a list of unmarked static vectors, create a list of all static vectors. Then we can process the unmarked vectors and free them carefully. Although we haven't implemented it yet, this allows us to make one final pass to unmark the marked static vectors so that when GC happens again, we can mark them as being in use. - - - - - 1 changed file: - src/lisp/gencgc.c Changes: ===================================== src/lisp/gencgc.c ===================================== @@ -5401,19 +5401,20 @@ static void scan_static_vectors(void) { struct weak_pointer *wp; - struct weak_pointer *clearable_list = NULL; + struct weak_pointer *static_vector_list = NULL; + const int scan_mark_flag = 0x8000; if (debug_static_array_p) { - printf("Phase 1: build clearable list\n"); + printf("Phase 1: find static vectors\n"); } /* - * 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. + * Find weak pointers to static arrays, using a linked list. We + * reuse the next slot of the weak pointer to chain these weak + * pointers together. * - * Invariant: clearable_list only has weak pointers to unmarked - * static vectors. + * Invariant: static_vector_list only has weak pointers to static + * vectors. */ wp = weak_pointers; while (wp) { @@ -5424,16 +5425,15 @@ scan_static_vectors(void) /* The value may be a static vector */ lispobj *header = (lispobj *) PTR(value); - if (maybe_static_array_p(*header) - && (HeaderValue(*header) == 1)) { + if (maybe_static_array_p(*header)) { if (debug_static_array_p) { printf("Adding %p header = 0x%08lx, next = %p\n", wp, *header, wp->next); } - wp->next = clearable_list; - clearable_list = wp; + wp->next = static_vector_list; + static_vector_list = wp; } else { if (debug_static_array_p) { printf("Skipping %p header = 0x%08lx\n", wp, *header); @@ -5448,14 +5448,13 @@ scan_static_vectors(void) } /* - * 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. + * static_vector_list now points to all weak pointers to static + * vectors. For unmarked (unused) static vectors, set another bit + * in the header to say we've visited it. If we've already + * visited the static vector, break the weak pointer. * - * Invariant: clearable_list contains only weak pointers that have - * been broken or that point to a unique dead static vector. */ - for (wp = clearable_list; wp; wp = wp->next) { + for (wp = static_vector_list; wp; wp = wp->next) { lispobj *header = (lispobj *) PTR(wp->value); if (debug_static_array_p) { @@ -5463,42 +5462,60 @@ scan_static_vectors(void) wp, wp->value, *header); } - if (HeaderValue(*header) == 1) { - if (debug_static_array_p) { - printf(" Mark vector\n"); - } + /* + * If the static vector is unused (mark bit clear) and if we + * haven't seen this vector before, set the scan flag. + */ + if ((*header & 0x80000000) == 0) { + /* Unused static vector */ + if ((*header & scan_mark_flag) == 0) { + if (debug_static_array_p) { + printf(" Mark vector\n"); + } - *header |= 0x80000000; - } else { - if (debug_static_array_p) { - printf(" Break weak pointer %p\n", wp); - } + *header |= scan_mark_flag; + } else { + if (debug_static_array_p) { + printf(" Break weak pointer %p\n", wp); + } - wp->value = NIL; - wp->broken = T; + wp->value = NIL; + wp->broken = T; + } } } + if (debug_static_array_p) { printf("Phase 3: Free static vectors\n"); } /* - * 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. + * Free up space. Go through static_vector_list and for each weak + * pointer that hasn't been broken and is an unused static array, + * free the static vector. Also break the weak pointer too, since + * the space has been freed. */ - for (wp = clearable_list; wp; wp = wp->next) { + for (wp = static_vector_list; wp; wp = wp->next) { + lispobj *header = (lispobj *) PTR(wp->value); + + printf("wp = %p, header = 0x%08lx\n", wp, *header); + + /* + * Only free the arrays where the mark bit is clear. + */ if (wp->broken == NIL) { - lispobj *static_array = (lispobj *) PTR(wp->value); - if (debug_static_array_p) { - printf("free wp %p: %p\n", wp, static_array); - } + if ((*header & 0x80000000) == 0) { + lispobj *static_array = (lispobj *) PTR(wp->value); + if (debug_static_array_p) { + printf("free wp %p: %p\n", wp, static_array); + } - wp->value = NIL; - wp->broken = T; + wp->value = NIL; + wp->broken = T; - free(static_array); + free(static_array); + } } } } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/959be526befaead7b46d43b… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/959be526befaead7b46d43b… 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] Clean up prints
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: c587dab3 by Raymond Toy at 2024-02-16T10:30:56-08:00 Clean up prints Only print debugging stuff if `debug_static_array_p` is true. Remove prints from `scan_weak_pointers`. - - - - - 1 changed file: - src/lisp/gencgc.c Changes: ===================================== src/lisp/gencgc.c ===================================== @@ -5403,7 +5403,9 @@ scan_static_vectors(void) struct weak_pointer *wp; struct weak_pointer *clearable_list = NULL; - printf("Phase 1: build clearable list\n"); + if (debug_static_array_p) { + printf("Phase 1: build clearable list\n"); + } /* * Find weak pointers to unmarked static arrays, using a linked @@ -5424,18 +5426,26 @@ scan_static_vectors(void) if (maybe_static_array_p(*header) && (HeaderValue(*header) == 1)) { - printf("Adding %p header = 0x%08lx, next = %p\n", - wp, *header, wp->next); + + if (debug_static_array_p) { + 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); + if (debug_static_array_p) { + printf("Skipping %p header = 0x%08lx\n", wp, *header); + } } } wp = next; } - printf("Phase 2\n"); + if (debug_static_array_p) { + printf("Phase 2\n"); + } /* * clearable_list now points to all weak pointers to unmarked @@ -5448,19 +5458,30 @@ scan_static_vectors(void) for (wp = clearable_list; wp; wp = wp->next) { lispobj *header = (lispobj *) PTR(wp->value); - printf("wp %p value 0x%08lx header 0x%08lx\n", - wp, wp->value, *header); + if (debug_static_array_p) { + printf("wp %p value 0x%08lx header 0x%08lx\n", + wp, wp->value, *header); + } + if (HeaderValue(*header) == 1) { - printf(" Mark vector\n"); + if (debug_static_array_p) { + printf(" Mark vector\n"); + } + *header |= 0x80000000; } else { - printf(" Break weak pointer %p\n", wp); + if (debug_static_array_p) { + printf(" Break weak pointer %p\n", wp); + } + wp->value = NIL; wp->broken = T; } } - printf("Phase 3: Free static vectors\n"); + if (debug_static_array_p) { + printf("Phase 3: Free static vectors\n"); + } /* * Free up space. Go through clearable_list and for each weak @@ -5470,7 +5491,9 @@ scan_static_vectors(void) 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("free wp %p: %p\n", wp, static_array); + } wp->value = NIL; wp->broken = T; @@ -5489,15 +5512,10 @@ scan_weak_pointers(void) * Now process the weak pointers. */ - 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)) { @@ -5510,7 +5528,6 @@ scan_weak_pointers(void) } } } - printf("scan_weak_pointers done\n"); scan_static_vectors(); } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c587dab3901ca26fbc6494b… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/c587dab3901ca26fbc6494b… 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] 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