Raymond Toy pushed to branch issue-276-xoroshiro128starstar at cmucl / cmucl

Commits: 33cf472e by Raymond Toy at 2024-03-08T15:31:41+00:00 Fix #278: Add more debugging prints for gencgc

- - - - - e16b28cc by Raymond Toy at 2024-03-08T15:31:47+00:00 Merge branch 'issue-278-more-gencgc-debug-prints' into 'master'

Fix #278: Add more debugging prints for gencgc

Closes #278

See merge request cmucl/cmucl!193 - - - - - 9fee7762 by Raymond Toy at 2024-03-08T15:52:35+00:00 Fix #277: return least-positive float for rationals close to it

- - - - - 8faafb32 by Raymond Toy at 2024-03-08T15:52:37+00:00 Merge branch 'issue-277-float-ratio-float-least-positive-float' into 'master'

Fix #277: return least-positive float for rationals close to it

Closes #277

See merge request cmucl/cmucl!191 - - - - - 0d6882c7 by Raymond Toy at 2024-03-10T20:12:37+00:00 Fix #274: 1d999999 hangs cmucl

- - - - - 34f33e19 by Raymond Toy at 2024-03-10T20:12:38+00:00 Merge branch 'issue-274-make-float-of-huge-numbers' into 'master'

Fix #274: 1d999999 hangs cmucl

Closes #274

See merge request cmucl/cmucl!189 - - - - - a2e2a586 by Raymond Toy at 2024-03-11T23:16:30+00:00 Merge branch 'master' into 'issue-276-xoroshiro128starstar'

# Conflicts: # src/general-info/release-21f.md - - - - -

6 changed files:

- src/code/float.lisp - src/code/reader.lisp - src/i18n/locale/cmucl.pot - src/lisp/gencgc.c - src/lisp/os.h - tests/float.lisp

Changes:

===================================== src/code/float.lisp ===================================== @@ -1137,7 +1137,8 @@ (floatit (ash bits -1)) #+nil (progn - (format t "1: f0, f1 = ~A ~A~%" f0 f1) + (format t "x = ~A~%" x) + (format t "1: f0, f1 = ~A~%" f0) (format t " scale = ~A~%" (1+ scale))) (scale-float f0 (1+ scale)))) @@ -1146,14 +1147,30 @@ (floatit bits) #+nil (progn - (format t "2: f0, f1 = ~A ~A~%" f0 f1) + (format t "2: f0, f1 = ~A~%" f0) (format t " scale = ~A~%" scale) - (format t "scale-float f0 = ~A~%" (scale-float f0 scale)) - (when f1 - (format t "scale-float f1 = ~A~%" - (scale-float f1 (- scale 53))))) - - (scale-float f0 scale)))))) + (format t "scale-float f0 = ~A~%" (scale-float f0 scale))) + (let ((min-exponent + ;; Compute the min (unbiased) exponent + (ecase format + (single-float + (- vm:single-float-normal-exponent-min + vm:single-float-bias + vm:single-float-digits)) + (double-float + (- vm:double-float-normal-exponent-min + vm:double-float-bias + vm:double-float-digits))))) + ;; F0 is always between 0.5 and 1. If + ;; SCALE is the min exponent, we have a + ;; denormal number just less than the + ;; least-positive float. We want to + ;; return the least-positive-float so + ;; multiply F0 by 2 (without adjusting + ;; SCALE) to get the nearest float. + (if (= scale min-exponent) + (scale-float (* 2 f0) scale) + (scale-float f0 scale)))))))) (floatit (bits) (let ((sign (if plusp 0 1))) (case format

===================================== src/code/reader.lisp ===================================== @@ -1785,7 +1785,7 @@ the end of the stream." ;; Is there an exponent letter? (cond ((eofp char) ;; If not, we've read the whole number. - (let ((num (make-float-aux number divisor + (let ((num (make-float-aux 0 number divisor *read-default-float-format* stream))) (return-from make-float (if negative-fraction (- num) num)))) @@ -1815,7 +1815,7 @@ the end of the stream." #+double-double (#\W 'kernel:double-double-float))) num) - (setq num (make-float-aux (* (expt 10 exponent) number) divisor + (setq num (make-float-aux exponent number divisor float-format stream))

(return-from make-float (if negative-fraction @@ -1823,10 +1823,55 @@ the end of the stream." num)))) (t (error _"Internal error in floating point reader.")))))

-(defun make-float-aux (number divisor float-format stream) +(defun make-float-aux (exponent number divisor float-format stream) + ;; Computes x = number*10^exponent/divisor. + ;; + ;; First check to see if x can possibly fit into a float of the + ;; given format. So compute log2(x) to get an approximate value of + ;; the base 2 exponent of x. If it's too large or too small, we can + ;; throw an error immediately. We don't need to be super accurate + ;; with the limits. The rest of the code will handle it correctly, + ;; even if we're too small or too large. + (unless (zerop number) + (flet ((fast-log2 (n) + ;; For an integer, the integer-length is close enough to + ;; the log2 of the number. + (integer-length n))) + ;; log2(x) = log(number*10^exponent/divisor) + ;; = exponent*log2(10) + log2(number)-log2(divisor) + (let ((log2-num (+ (* exponent #.(kernel::log2 10d0)) + (fast-log2 number) + (- (fast-log2 divisor))))) + (multiple-value-bind (log2-low log2-high) + (ecase float-format + ((short-float single-float) + ;; Single-float exponents range is -149 to 127, but we + ;; don't need to be super-accurate since we're + ;; multiplying the values by 2. + (values (* 2 (- vm:single-float-normal-exponent-min + vm:single-float-bias + vm:single-float-digits)) + (* 2 (- vm:single-float-normal-exponent-max + vm:single-float-bias)))) + ((double-float long-float + #+double-double kernel:double-double-float) + (values (* 2 (- vm:double-float-normal-exponent-min + vm:double-float-bias + vm:double-float-digits)) + (* 2 (- vm:double-float-normal-exponent-max + vm:double-float-bias))))) + ;; Double-float exponent range is -1074 to -1023 + (unless (< log2-low log2-num log2-high) + ;; The number is definitely too large or too small to fit. + ;; Signal an error. + (%reader-error stream _"Number not representable as a ~S: ~S" + float-format (read-buffer-to-string))))))) + + ;; Otherwise the number might fit, so we carefully compute the result (handler-case (with-float-traps-masked (:underflow) - (let* ((ratio (/ number divisor)) + (let* ((ratio (/ (* (expt 10 exponent) number) + divisor)) (result (coerce ratio float-format))) (when (and (zerop result) (not (zerop number))) ;; The number we've read is so small that it gets @@ -1850,7 +1895,7 @@ the end of the stream." result)) (error () (%reader-error stream _"Number not representable as a ~S: ~S" - float-format (/ number divisor))))) + float-format (read-buffer-to-string)))))

(defun make-ratio (stream)

===================================== src/i18n/locale/cmucl.pot ===================================== @@ -8728,11 +8728,11 @@ msgid "Internal error in floating point reader." msgstr ""

#: src/code/reader.lisp -msgid "Underflow" +msgid "Number not representable as a ~S: ~S" msgstr ""

#: src/code/reader.lisp -msgid "Number not representable as a ~S: ~S" +msgid "Underflow" msgstr ""

#: src/code/reader.lisp

===================================== src/lisp/gencgc.c ===================================== @@ -6756,10 +6756,9 @@ scavenge_newspace_generation_one_scan(int generation) { int i;

-#if 0 - fprintf(stderr, "Starting one full scan of newspace generation %d\n", - generation); -#endif + DPRINTF(gencgc_verbose, + (stderr, "Starting one full scan of newspace generation %d\n", + generation));

for (i = 0; i < last_free_page; i++) { if (PAGE_ALLOCATED(i) && !PAGE_UNBOXED(i) @@ -6864,10 +6863,10 @@ scavenge_newspace_generation_one_scan(int generation) i = last_page; } } -#if 0 - fprintf(stderr, "Finished one full scan of newspace generation %d\n", - generation); -#endif + + DPRINTF(gencgc_verbose, + (stderr, "Finished one full scan of newspace generation %d\n", + generation)); }

/* Scan all weak objects and reset weak object lists */ @@ -6896,9 +6895,8 @@ scavenge_newspace_generation(int generation) struct new_area (*previous_new_areas)[] = NULL; int previous_new_areas_index;

-#if 0 - fprintf(stderr, "Start scavenge_newspace_generation %d\n", generation); -#endif + DPRINTF(gencgc_verbose, + (stderr, "Start scavenge_newspace_generation %d\n", generation));

#define SC_NS_GEN_CK 0 #if SC_NS_GEN_CK @@ -7078,9 +7076,9 @@ scavenge_newspace_generation(int generation) "*** scav.new.gen. %d: write protected page %d written to? dont_move=%d\n", generation, i, PAGE_DONT_MOVE(i)); #endif -#if 0 - fprintf(stderr, "Finished scavenge_newspace_generation %d\n", generation); -#endif + + DPRINTF(gencgc_verbose, + (stderr, "Finished scavenge_newspace_generation %d\n", generation)); }

@@ -7839,20 +7837,26 @@ garbage_collect_generation(int generation, int raise) scavenge_control_stack(); #endif

+ DPRINTF(gencgc_verbose, + (stderr, "Scavenging interrupt handlers ...\n")); + scavenge_interrupt_handlers();

-#ifdef PRINTNOISE - printf("Scavenging the binding stack (%d bytes) ...\n", - ((lispobj *) get_binding_stack_pointer() - - binding_stack) * sizeof(lispobj)); -#endif + DPRINTF(gencgc_verbose, + (stderr, "Done scavenging interrupt handlers\n")); + + DPRINTF(gencgc_verbose, + (stderr, "Scavenging the binding stack (%d bytes) ...\n", + ((lispobj *) get_binding_stack_pointer() - + binding_stack) * sizeof(lispobj))); + /* Scavenge the binding stack. */ scavenge(binding_stack, (lispobj *) get_binding_stack_pointer() - binding_stack);

-#ifdef PRINTNOISE - printf("Done scavenging the binding stack.\n"); -#endif + DPRINTF(gencgc_verbose, + (stderr, "Done scavenging the binding stack.\n")); + /* * Scavenge the scavenge_hooks in case this refers to a hook added * in a prior generation GC. From here on the scavenger_hook will @@ -7860,30 +7864,44 @@ garbage_collect_generation(int generation, int raise) * doing here. */

-#ifdef PRINTNOISE - printf("Scavenging the scavenger hooks ...\n"); -#endif + DPRINTF(gencgc_verbose, + (stderr, "Scavenging the scavenger hooks ...\n")); + scavenge(&scavenger_hooks, 1); -#ifdef PRINTNOISE - printf("Done scavenging the scavenger hooks.\n"); -#endif + + DPRINTF(gencgc_verbose, + (stderr, "Done scavenging the scavenger hooks.\n"));

static_space_size = (lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER) - static_space; - if (gencgc_verbose > 1) - fprintf(stderr, "Scavenge static space: %ld bytes\n", - static_space_size * sizeof(lispobj)); + + DPRINTF(gencgc_verbose, + (stderr, "Scavenge static space: %ld bytes\n", + static_space_size * sizeof(lispobj))); + scavenge(static_space, static_space_size);

+ DPRINTF(gencgc_verbose, + (stderr, "Done scavenging static space\n")); + /* * All generations but the generation being GCed need to be * scavenged. The new_space generation needs special handling as * objects may be moved in - it is handle separately below. */ - for (i = 0; i < NUM_GENERATIONS; i++) - if (i != generation && i != new_space) + for (i = 0; i < NUM_GENERATIONS; i++) { + if (i != generation && i != new_space) { + DPRINTF(gencgc_verbose, + (stderr, "Scavenge generation %lu (gen = %d, new space = %d)\n", + i, generation, new_space)); + scavenge_generation(i);

+ DPRINTF(gencgc_verbose, + (stderr, "Done scavenging generation %lu\n", i)); + } + } + /* * Finally scavenge the new_space generation. Keep going until no * more objects are moved into the new generation.

===================================== src/lisp/os.h ===================================== @@ -8,7 +8,13 @@

#include "lisp.h"

-#define DPRINTF(t,a) { if (t) fprintf a; } +#if defined(__GNUC__) || defined(__clang__) +#define UNLIKELY(x) __builtin_expect(!!(x), 0) +#else +#define UNLIKELY(x) (x) +#endif + +#define DPRINTF(t,a) { if (UNLIKELY(t)) fprintf a; }

#ifdef DARWIN #include "Darwin-os.h"

===================================== tests/float.lisp ===================================== @@ -136,5 +136,79 @@ (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))) + ;; Need to make sure underflows are masked. + (kernel::with-float-traps-masked (:underflow) + ;; 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))) + ;; Need to make sure underflows are masked. + (kernel::with-float-traps-masked (:underflow) + ;; 247/100*10^-324 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))))) + +(define-test reader-error.small-single-floats + (:tag :issues) + ;; Test a number less than half of least-positive-single-float, + ;; something a bit smaller, hen then something really small that + ;; used to appear to hang cmucl because it was trying to compute the + ;; a rational with a huge number of digits. + (dolist (num '("1e-46" "1e-80" "1e-999999999")) + (assert-error 'reader-error (read-from-string num) + num))) + +(define-test reader-error.small-double-floats + (:tag :issues) + ;; Like reader-error.small-single-floats but for doubles + (dolist (num '("1d-324" "1d-600" "1d-999999999")) + (assert-error 'reader-error (read-from-string num) + num))) + +(define-test reader-error.big-single-floats + (:tag :issues) + ;; Signal error for a number just a bit larger than + ;; most-positive-single-float. And a really big single-float. + (assert-error 'reader-error (read-from-string "3.5e38")) + (assert-error 'reader-error (read-from-string "1e999999999"))) + +(define-test reader-error.big-double-floats + (:tag :issues) + ;; Signal error for a number just a bit larger than + ;; most-positive-double-float. And a really big single-float. + (assert-error 'reader-error (read-from-string "1.8d308")) + (assert-error 'reader-error (read-from-string "1d999999999")))

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