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

[Git][cmucl/cmucl][issue-277-float-ratio-float-least-positive-float] Update release info
by Raymond Toy (＠rtoy) 08 Feb '24

08 Feb '24

Raymond Toy pushed to branch issue-277-float-ratio-float-least-positive-float at cmucl / cmucl Commits: 2d297bad by Raymond Toy at 2024-02-08T07:49:53-08:00 Update release info - - - - - 1 changed file: - src/general-info/release-21f.md Changes: ===================================== src/general-info/release-21f.md ===================================== @@ -40,6 +40,8 @@ public domain. * ~~#258~~ Remove `get-page-size` from linux-os.lisp * ~~#269~~ Add function to get user's home directory * ~~#266~~ Support "~user" in namestrings + * ~~#277~~ `float-ratio-float` returns least postive float for + ratios closer to that than zero. * 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/2d297badcd7f1a7bfc10d74… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/2d297badcd7f1a7bfc10d74… 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] Remove debugging prints and tests
by Raymond Toy (＠rtoy) 08 Feb '24

08 Feb '24

Raymond Toy pushed to branch issue-277-float-ratio-float-least-positive-float at cmucl / cmucl Commits: 52bc51af by Raymond Toy at 2024-02-08T07:42:18-08:00 Remove debugging prints and tests Remove debugging prints from float-ratio-float and add some tests for rational numbers close to the least positive float. - - - - - 2 changed files: - src/code/float.lisp - tests/float.lisp Changes: ===================================== src/code/float.lisp ===================================== @@ -1135,8 +1135,9 @@ (assert (= len (the fixnum (1+ digits)))) (multiple-value-bind (f0) (floatit (ash bits -1)) - ;;#+nil + #+nil (progn + (format t "x = ~A~%" x) (format t "1: f0, f1 = ~A~%" f0) (format t " scale = ~A~%" (1+ scale))) ===================================== tests/float.lisp ===================================== @@ -136,5 +136,45 @@ (ext:with-float-traps-masked (:overflow) (* 100 most-negative-double-float))))) - - \ No newline at end of file +(define-test float-ratio.single + (:tag :issues) + ;; least-positive-single-float is 1.4012985e-45. Let's test with + ;; some rationals from 7/10*10^-45 to 1.41*10^-45 to make sure they + ;; return 0 or least-positive-single-float + (let ((expo (expt 10 -45))) + ;; 7/10*10^-45 is just under halfway between 0 and least-positive, + ;; so the answer is 0. + (assert-equal 0f0 (kernel::float-ratio-float (* 7/10 expo) 'single-float)) + + ;; These are all more than half way to + ;; least-positive-single-float, so they should return that. + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 8/10 expo) 'single-float)) + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 1 expo) 'single-float)) + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 14/10 expo) 'single-float)) + (assert-equal least-positive-single-float + (kernel::float-ratio-float (* 2 expo) 'single-float)))) + +(define-test float-ratio.double + (:tag :issues) + ;; least-positive-double-float is 4.9406564584124654d-324. Let's + ;; test with some rationals from about 2*10^-324 to 4.94*10^-324 to make + ;; sure they return 0 or least-positive-double-float + (let ((expo (expt 10 -324))) + ;; 247/100*10^-45 is just under halfway between 0 and least-positive, + ;; so the answer is 0. + (assert-equal 0d0 (kernel::float-ratio-float (* 247/100 expo) 'double-float)) + + ;; These are all more than half way to + ;; least-positive-double-float, so they should return that. + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 248/100 expo) 'double-float)) + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 4 expo) 'double-float)) + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 494/100 expo) 'double-float)) + (assert-equal least-positive-double-float + (kernel::float-ratio-float (* 988/100 expo) 'double-float)))) + View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/52bc51afbe1505136c02310… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/52bc51afbe1505136c02310… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-277-float-ratio-float-least-positive-float
by Raymond Toy (＠rtoy) 08 Feb '24

08 Feb '24

Raymond Toy pushed new branch issue-277-float-ratio-float-least-positive-float at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-277-float-ratio-flo… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-275-signal-underflow-in-float-reader] 2 commits: Update release notes.
by Raymond Toy (＠rtoy) 07 Feb '24

07 Feb '24

Raymond Toy pushed to branch issue-275-signal-underflow-in-float-reader at cmucl / cmucl Commits: 2034be96 by Raymond Toy at 2024-02-07T10:55:02-08:00 Update release notes. - - - - - 3b6a71be by Raymond Toy at 2024-02-07T11:03:49-08:00 Clean up impl Remove old code dealing with small numbers and refactor the code to a nicer form. - - - - - 2 changed files: - src/code/reader.lisp - src/general-info/release-21f.md Changes: ===================================== src/code/reader.lisp ===================================== @@ -1824,50 +1824,27 @@ the end of the stream." (t (error _"Internal error in floating point reader."))))) (defun make-float-aux (number divisor float-format stream) - (let ((ratio (/ number divisor)) - result) - (handler-case - (progn - (setf result (coerce ratio float-format)) - #+nil - (when (and (zerop result) (not (zerop number))) - ;; The number we've read is so small that it gets - ;; converted to 0.0, but is not actually zero. In this - ;; case, we want to round such small numbers to - ;; least-positive-foo-float. If it's still too small, we - ;; want to signal an error saying that we can't really - ;; convert it because the exponent is too small. - ;; See CLHS 2.3.1.1. - (let ((float-limit (ecase float-format - ((short-float single-float) - least-positive-single-float) - (double-float - least-positive-double-float) - #+double-double - (double-double-float - ext:least-positive-double-double-float)))) - (if (>= (* 2 ratio) float-limit) - (setf result float-limit) - (error _"Underflow")))) - result) - (floating-point-underflow (c) - (describe c) - ;; Got an underflow. Resignal it with the same - ;; operation/operands, but allowing a restart to set the value - ;; to 0. - (restart-case - (error 'floating-point-underflow - :operation (arithmetic-error-operation c) - :operands (arithmetic-error-operands c)) - (return-zero () - :report (lambda (stream) - (format stream _"Return ~A for ~A" - (coerce 0 float-format) - (read-buffer-to-string))) - (setf result (coerce 0 float-format))))) - (error () - (%reader-error stream _"Number not representable as a ~S: ~S" - float-format (read-buffer-to-string)))))) + (handler-case + (let ((ratio (/ number divisor))) + (coerce ratio float-format)) + (floating-point-underflow (c) + (describe c) + ;; Got an underflow. Resignal it with the same + ;; operation/operands, but allowing a restart to set the value + ;; to 0. + (restart-case + (error 'floating-point-underflow + :operation (arithmetic-error-operation c) + :operands (arithmetic-error-operands c)) + (return-zero () + :report (lambda (stream) + (format stream _"Return ~A for ~A" + (coerce 0 float-format) + (read-buffer-to-string))) + (setf result (coerce 0 float-format))))) + (error () + (%reader-error stream _"Number not representable as a ~S: ~S" + float-format (read-buffer-to-string)))))) (defun make-ratio (stream) ===================================== src/general-info/release-21f.md ===================================== @@ -40,6 +40,8 @@ public domain. * ~~#258~~ Remove `get-page-size` from linux-os.lisp * ~~#269~~ Add function to get user's home directory * ~~#266~~ Support "~user" in namestrings + * ~~#275~~ Handle floating point underflow in float reader + allowing user to flush the value to 0. * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/70586e47c6002ceef43fc0… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/70586e47c6002ceef43fc0… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-275-signal-underflow-in-float-reader
by Raymond Toy (＠rtoy) 07 Feb '24

07 Feb '24

Raymond Toy pushed new branch issue-275-signal-underflow-in-float-reader at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-275-signal-underflo… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-274-make-float-of-huge-numbers
by Raymond Toy (＠rtoy) 06 Feb '24

06 Feb '24

Raymond Toy pushed new branch issue-274-make-float-of-huge-numbers at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-274-make-float-of-h… 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 old version of finalize-static-vectors
by Raymond Toy (＠rtoy) 02 Feb '24

02 Feb '24

Raymond Toy pushed to branch issue-243-weak-pointer-to-static-array at cmucl / cmucl Commits: b6faa24e by Raymond Toy at 2024-02-02T09:34:25-08:00 Remove old version of finalize-static-vectors - - - - - 1 changed file: - src/code/array.lisp Changes: ===================================== src/code/array.lisp ===================================== @@ -389,47 +389,6 @@ (setf (sys:sap-ref-32 sap (* -2 vm:word-bytes)) (logand header #x7fffffff))))))) -#+nil -(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. - (when *static-vectors* - (when *debug-static-array-p* - (let ((*print-array* nil)) - (format t (intl:gettext "Finalizing static vectors ~S~%") *static-vectors*))) - (setf *static-vectors* - (delete-if - #'(lambda (wp) - (let ((vector (weak-pointer-value wp))) - (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)) - (cond ((logbitp 31 header) - ;; Clear mark - (setf (sys:sap-ref-32 sap (* -2 vm:word-bytes)) - (logand header #x7fffffff)) - (when *debug-static-array-p* - (let ((*print-array* nil)) - (format t (intl:gettext " static vector ~A in use~%") vector))) - nil) - (t - ;; Mark was clear so free the vector - (when *debug-static-array-p* - (let ((*print-array* nil)) - (format t (intl:gettext " Free static vector ~A~%") vector))) - (sys:without-interrupts - (setf (weak-pointer-value wp) nil) - (free-static-vector vector)) - t)))))) - *static-vectors*)))) - (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 View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b6faa24ed282c902b9f9253… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b6faa24ed282c902b9f9253… 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 function to add to free list
by Raymond Toy (＠rtoy) 02 Feb '24

02 Feb '24

Raymond Toy pushed to branch issue-243-weak-pointer-to-static-array at cmucl / cmucl Commits: 91dba6ce by Raymond Toy at 2024-02-02T09:31:03-08:00 Add function to add to free list Make the `scan_weak_pointers` a bit smaller by moving the code for inserting a value to the free list into its own function. Update some comments and fix a printf. The printf was printing the address of the header instead of the value, which is what we wanted to so we can see that we do have a static array and whether it was marked as live or not. - - - - - 1 changed file: - src/lisp/gencgc.c Changes: ===================================== src/lisp/gencgc.c ===================================== @@ -5393,13 +5393,42 @@ size_weak_pointer(lispobj * where) return WEAK_POINTER_NWORDS; } + +static void +update_static_vector_list(lispobj value, lispobj* vectors_to_free, int* num_static_vectors) +{ + /* + * We have a static array with the mark cleared which means it's + * not used. + * + * 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. + */ + 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; + } + } + if (!found) { + printf("Adding %p at %d\n", (lispobj *) value, *num_static_vectors); + vectors_to_free[*num_static_vectors] = value; + ++*num_static_vectors; + } +} + void scan_weak_pointers(void) { struct weak_pointer *wp; lispobj* vectors_to_free = NULL; - int max_vectors = 0; - int k = 0; + int num_weak_pointers = 0; + int num_static_vectors = 0; int n; /* @@ -5408,20 +5437,21 @@ scan_weak_pointers(void) */ for (wp = weak_pointers; wp; wp = wp->next) { - max_vectors++; + num_weak_pointers++; } - printf("weak pointer count = %d\n", max_vectors); + printf("weak pointer count = %d\n", num_weak_pointers); /* Nothing to do if there are no weak pointers */ - if (max_vectors == 0) { + if (num_weak_pointers == 0) { return; } /* - * Allocate max space + * Allocate enough space to hold all weak pointers in case they + * all point to static vectors. */ - vectors_to_free = (lispobj*) malloc(max_vectors * sizeof(lispobj)); + vectors_to_free = (lispobj*) malloc(num_weak_pointers * sizeof(lispobj)); gc_assert(vectors_to_free); printf("vectors_to_free = %p\n", vectors_to_free); @@ -5446,32 +5476,17 @@ scan_weak_pointers(void) /* The value may be a static vector */ lispobj *header = (lispobj *) PTR(value); - printf("value %p, header = %p\n", (lispobj*) value, header); + printf("value %p, header = %0lx\n", (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. + */ if (HeaderValue(*header) == 1) { - /* - * We have a static array with the mark - * cleared which means it's not used. - * - * Only add it if we don't already have it. - */ - int m; - int found = 0; + update_static_vector_list(value, vectors_to_free, &num_static_vectors); - for (m = 0; m < k; ++m) { - if (value == vectors_to_free[m]) { - printf("Found %p at %d\n", (lispobj *) value, m); - found = 1; - break; - } - } - if (!found) { - printf("Adding %p at %d\n", (lispobj *) value, k); - vectors_to_free[k] = value; - ++k; - } - /* * Now we can break the weak pointer to the static vector. */ @@ -5486,9 +5501,9 @@ scan_weak_pointers(void) /* * Free up any unreferenced static vectors now */ - printf("%d static vectors to be freed\n", k); + printf("%d static vectors to be freed\n", num_static_vectors); - for (n = 0; n < k; ++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); View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/91dba6ce5470fc79172aef7… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/91dba6ce5470fc79172aef7… 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 code and prints a bit
by Raymond Toy (＠rtoy) 02 Feb '24

02 Feb '24

Raymond Toy pushed to branch issue-243-weak-pointer-to-static-array at cmucl / cmucl Commits: a1da802f by Raymond Toy at 2024-02-01T17:13:41-08:00 Clean up code and prints a bit If there are no weak pointers, exit right away. Add a few more prints and remove a misleading print. - - - - - 1 changed file: - src/lisp/gencgc.c Changes: ===================================== src/lisp/gencgc.c ===================================== @@ -5411,17 +5411,23 @@ scan_weak_pointers(void) max_vectors++; } + printf("weak pointer count = %d\n", max_vectors); + + /* Nothing to do if there are no weak pointers */ + if (max_vectors == 0) { + return; + } + /* * Allocate max space */ vectors_to_free = (lispobj*) malloc(max_vectors * sizeof(lispobj)); gc_assert(vectors_to_free); - printf("weak pointer count = %d\n", max_vectors); printf("vectors_to_free = %p\n", vectors_to_free); /* - * Now process the weak pointers + * Now process the weak pointers. */ for (wp = weak_pointers; wp; wp = wp->next) { lispobj value = wp->value; @@ -5440,16 +5446,14 @@ scan_weak_pointers(void) /* The value may be a static vector */ lispobj *header = (lispobj *) PTR(value); + printf("value %p, header = %p\n", (lispobj*) value, header); + if (maybe_static_array_p(*header)) { if (HeaderValue(*header) == 1) { /* * We have a static array with the mark * cleared which means it's not used. - */ - printf(" vectors_to_free[%d] = %p %08lx\n", - k, (lispobj *) value, *header); - - /* + * * Only add it if we don't already have it. */ int m; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a1da802f25ba8a5c68e3879… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a1da802f25ba8a5c68e3879… 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] Fix some logic errors.
by Raymond Toy (＠rtoy) 02 Feb '24

02 Feb '24

Raymond Toy pushed to branch issue-243-weak-pointer-to-static-array at cmucl / cmucl Commits: 79ea44b8 by Raymond Toy at 2024-02-01T16:47:51-08:00 Fix some logic errors. When checking the header value, we want a header value of exactly 1, which means that we have a static vector and that the mark is clear. This means the static vector is not referenced by anything. We were also breaking the weak pointer in the wrong place. We only want to break the weak pointer when the static vector can be freed. Otherwise, leave the weak pointer alone. - - - - - 1 changed file: - src/lisp/gencgc.c Changes: ===================================== src/lisp/gencgc.c ===================================== @@ -5441,8 +5441,14 @@ scan_weak_pointers(void) lispobj *header = (lispobj *) PTR(value); if (maybe_static_array_p(*header)) { - if ((HeaderValue(*header) & 1) == 1) { - printf(" vectors_to_free[%d] = %p\n", k, (lispobj *) value); + if (HeaderValue(*header) == 1) { + /* + * We have a static array with the mark + * cleared which means it's not used. + */ + printf(" vectors_to_free[%d] = %p %08lx\n", + k, (lispobj *) value, *header); + /* * Only add it if we don't already have it. */ @@ -5461,12 +5467,13 @@ scan_weak_pointers(void) vectors_to_free[k] = value; ++k; } + + /* + * Now we can break the weak pointer to the static vector. + */ + wp->value = NIL; + wp->broken = T; } - /* - * Now we can break the weak pointer to the static vector. - */ - wp->value = NIL; - wp->broken = T; } } } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/79ea44b89034e0086e3ba11… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/79ea44b89034e0086e3ba11… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0