Raymond Toy pushed to branch master at cmucl / cmucl
Commits:
83df8fec by Raymond Toy at 2024-04-19T12:01:18-07:00
Use snapshot-2024-04 to run the CI
Snapshots have been uploaded so use them for running the CI.
- - - - -
1abdcb32 by Raymond Toy at 2024-04-19T15:08:49-07:00
Remove // comment
According to [fc0bd2a6f0] this change was supposed to be removed but
never was. Let's do it now. This was also the only place where we
used C++ comment-style.
- - - - -
2 changed files:
- .gitlab-ci.yml
- src/lisp/gencgc.c
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -1,6 +1,6 @@
variables:
- download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2023/08"
- version: "xoroshiro-assembly-x86"
+ download_url: "https://common-lisp.net/project/cmucl/downloads/snapshots/2024/04"
+ version: "2024-04-x86"
bootstrap: ""
=====================================
src/lisp/gencgc.c
=====================================
@@ -4325,7 +4325,7 @@ u32_vector(lispobj obj, unsigned *length)
static inline void
free_hash_entry(struct hash_table *hash_table, int hash_index, int kv_index)
{
- unsigned length = UINT_MAX; // to compare to
+ unsigned length = UINT_MAX;
unsigned *index_vector = u32_vector(hash_table->index_vector, &length);
unsigned *next_vector = u32_vector(hash_table->next_vector, 0);
int free_p = 1;
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a33e75aed5ec46cd2ec116…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a33e75aed5ec46cd2ec116…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch master at cmucl / cmucl
Commits:
a33e75ae by Raymond Toy at 2024-04-19T07:36:31-07:00
Update with fixed tickets that we forgot to add earlier.
- - - - -
1 changed file:
- src/general-info/release-21f.md
Changes:
=====================================
src/general-info/release-21f.md
=====================================
@@ -30,14 +30,17 @@ public domain.
* ANSI compliance fixes:
* Bug fixes:
* Gitlab tickets:
+ *
* ~~#154~~ piglatin translation does not work anymore
- * ~~#171~~ Readably print `(make-pathname :name :unspecfic)`
+ * ~~#171~~ Readably print `(make-pathname :name :unspecfic)`
+ * ~~#180~~ Move `get-page-size` to C
* ~~#196~~ Fix issues with mapping and nconc accumulation (mapcan)
* ~~#216~~ `enough-namestring` with relative pathname fails
* ~~#234~~ Make :ASCII external format builtin
* ~~#240~~ Speed up set operations
* ~~#242~~ Fix bug in `alien-funcall` with `c-call:char` as result type
* ~~#244~~ Add `c-call:signed-char`
+ * ~~#245~~ Replace `egrep` with `grep -E` in `make-dist.sh`
* ~~#248~~ Print MOVS instruction with correct case
* ~~#249~~ Replace LEA instruction with simpler shorter instructions in arithmetic vops for x86
* ~~#253~~ Block-compile list-to-hashtable and callers
@@ -53,6 +56,7 @@ public domain.
* ~~#265~~ CI for mac os is broken
* ~~#266~~ Support "~user" in namestrings
* ~~#269~~ Add function to get user's home directory
+ * ~~#270~~ Simplify `os_file_author` interface
* ~~#271~~ Update ASDF to 3.3.7
* ~~#272~~ Move scavenge code for static vectors to its own function
* ~~#274~~ 1d99999999 hangs
@@ -67,7 +71,11 @@ public domain.
* ~~#290~~ Pprint `with-float-traps-masked` better
* ~~#291~~ Pprint `handler-case` neatly.
* ~~#293~~ Allow restarts for FP overflow in reader.
+ * ~~#294~~ Implement assembly routine for xoroshiro update function
+ * ~~#296~~ Disassembly of movd instruction broken
* ~~#297~~ Pprint `new-assem:assemble` with less indentation.
+ * ~~#298~~ Add `with-float-rounding-mode` macro
+ * ~~#299~~ Enable xoroshiro assembly routine
* 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/a33e75aed5ec46cd2ec116c…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/a33e75aed5ec46cd2ec116c…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-293-restart-on-reader-fp-overflow at cmucl / cmucl
Commits:
0cbb2264 by Raymond Toy at 2024-04-10T03:10:16+00:00
Fix #296: Fix disassembly of MOVD instruction
- - - - -
df78595e by Raymond Toy at 2024-04-10T03:10:20+00:00
Merge branch 'issue-296-fix-movd-disassembly' into 'master'
Fix #296: Fix disassembly of MOVD instruction
Closes #296 and #300
See merge request cmucl/cmucl!207
- - - - -
e88d7ffe by Raymond Toy at 2024-04-11T22:11:51+00:00
Fix #275: FP underflow in reader allows restart with 0
- - - - -
07c9c06b by Raymond Toy at 2024-04-11T22:11:55+00:00
Merge branch 'issue-275b-signal-float-underflow' into 'master'
Fix #275: FP underflow in reader allows restart with 0
Closes #275 and #287
See merge request cmucl/cmucl!197
- - - - -
c4cfca89 by Raymond Toy at 2024-04-11T16:01:24-07:00
Merge branch 'master' into issue-293-restart-on-reader-fp-overflow
- - - - -
2 changed files:
- src/compiler/x86/insts.lisp
- src/general-info/release-21f.md
Changes:
=====================================
src/compiler/x86/insts.lisp
=====================================
@@ -509,6 +509,14 @@
(print-byte-reg value stream dstate)
(print-mem-access value stream t dstate)))
+(defun print-word-reg/mem (value stream dstate)
+ (declare (type (or list reg) value)
+ (type stream stream)
+ (type disassem:disassem-state dstate))
+ (if (typep value 'reg)
+ (print-word-reg value stream dstate)
+ (print-mem-access value stream nil dstate)))
+
(defun print-label (value stream dstate)
(declare (ignore dstate))
(princ (if (and (numberp value) (minusp value))
@@ -716,7 +724,11 @@
(disassem:define-argument-type byte-reg/mem
:prefilter #'prefilter-reg/mem
:printer #'print-byte-reg/mem)
-
+(disassem:define-argument-type word-reg/mem
+ ;; Like reg/mem but if the reg/mem field is a register, it's a word
+ ;; register.
+ :prefilter #'prefilter-reg/mem
+ :printer #'print-word-reg/mem)
;;;
;;; added by jrd
;;;
@@ -3478,7 +3490,7 @@
;;; We do not support the MMX version of this instruction.
(define-instruction movd (segment dst src)
(:printer ext-xmm-reg/mem ((prefix #x66) (op #x6e)))
- (:printer ext-xmm-reg/mem ((prefix #x66) (op #x7e))
+ (:printer ext-xmm-reg/mem ((prefix #x66) (op #x7e) (reg/mem nil :type 'word-reg/mem))
'(:name :tab reg/mem ", " reg))
(:emitter
(cond ((xmm-register-p dst)
=====================================
src/general-info/release-21f.md
=====================================
@@ -56,6 +56,7 @@ public domain.
* ~~#271~~ Update ASDF to 3.3.7
* ~~#272~~ Move scavenge code for static vectors to its own function
* ~~#274~~ 1d99999999 hangs
+ * ~~#275~~ FP underflow in reader allows restarting with 0
* ~~#276~~ Implement xoroshiro128** generator for x86
* ~~#277~~ `float-ratio-float` returns 0 for numbers close to
least-positive-float
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/da48651df72c0685a095cc…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/da48651df72c0685a095cc…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch master at cmucl / cmucl
Commits:
e88d7ffe by Raymond Toy at 2024-04-11T22:11:51+00:00
Fix #275: FP underflow in reader allows restart with 0
- - - - -
07c9c06b by Raymond Toy at 2024-04-11T22:11:55+00:00
Merge branch 'issue-275b-signal-float-underflow' into 'master'
Fix #275: FP underflow in reader allows restart with 0
Closes #275 and #287
See merge request cmucl/cmucl!197
- - - - -
4 changed files:
- src/code/reader.lisp
- src/general-info/release-21f.md
- src/i18n/locale/cmucl.pot
- tests/float.lisp
Changes:
=====================================
src/code/reader.lisp
=====================================
@@ -1832,56 +1832,70 @@ the end of the stream."
;; 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 (/ (* (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
- ;; converted to 0.0, but is not actually zero. Signal an
- ;; error. See CLHS 2.3.1.1.
- (error _"Underflow"))
- result))
- (error ()
- (%reader-error stream _"Number not representable as a ~S: ~S"
- float-format (read-buffer-to-string)))))
+ (flet ((handle-extreme-numbers ()
+ (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)
+ ;; Double-float exponent range is -1074 to -1023
+ (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)))))
+ (when (<= log2-num log2-low)
+ ;; Number is definitely too small; signal an underflow.
+ (error 'floating-point-underflow))
+ (when (>= log2-num log2-high)
+ ;; Number is definitely too large; signal an error
+ (error "Overflow"))))))))
+
+ ;; Otherwise the number might fit, so we carefully compute the result.
+ (handler-case
+ (with-float-traps-masked (:underflow)
+ (handle-extreme-numbers)
+ (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
+ ;; converted to 0.0, but is not actually zero. Signal an
+ ;; error. See CLHS 2.3.1.1.
+ (error 'floating-point-underflow))
+ result))
+ (floating-point-underflow ()
+ ;; Resignal a reader error, but allow the user to continue with
+ ;; 0.
+ (let ((zero (coerce 0 float-format)))
+ (restart-case
+ (%reader-error stream _"Floating point underflow when reading ~S: ~S"
+ float-format (read-buffer-to-string))
+ (continue ()
+ :report (lambda (stream)
+ (format stream "Return ~A" zero))
+ zero))))
+ (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
=====================================
@@ -56,6 +56,7 @@ public domain.
* ~~#271~~ Update ASDF to 3.3.7
* ~~#272~~ Move scavenge code for static vectors to its own function
* ~~#274~~ 1d99999999 hangs
+ * ~~#275~~ FP underflow in reader allows restarting with 0
* ~~#276~~ Implement xoroshiro128** generator for x86
* ~~#277~~ `float-ratio-float` returns 0 for numbers close to
least-positive-float
=====================================
src/i18n/locale/cmucl.pot
=====================================
@@ -8750,11 +8750,11 @@ msgid "Internal error in floating point reader."
msgstr ""
#: src/code/reader.lisp
-msgid "Number not representable as a ~S: ~S"
+msgid "Floating point underflow when reading ~S: ~S"
msgstr ""
#: src/code/reader.lisp
-msgid "Underflow"
+msgid "Number not representable as a ~S: ~S"
msgstr ""
#: src/code/reader.lisp
=====================================
tests/float.lisp
=====================================
@@ -247,3 +247,44 @@
(assert-equal 0.9999999999999999d0
(rounding-test 3d0))))
+(define-test reader.underflow-enabled
+ (:tag :issues)
+ ;; Test with FP underflow enabled, we can still read denormals
+ ;; without problem. For this test we only care that we get a
+ ;; number, not the actual value.
+ (dolist (n (list least-positive-single-float
+ least-positive-normalized-single-float
+ (/ (+ least-positive-single-float
+ least-positive-normalized-single-float)
+ 2)
+ least-positive-double-float
+ least-positive-normalized-double-float
+ (/ (+ least-positive-double-float
+ least-positive-normalized-double-float)
+ 2)
+ ))
+ (assert-true (floatp
+ (ext:with-float-traps-enabled (:underflow)
+ (read-from-string (format nil "~A" n)))))))
+
+(define-test reader-restarts.underflow
+ (:tag :issues)
+ ;; Test that we get a restart when reading floating-point numbers
+ ;; that are too small to fit in a float. Invoke the restart to
+ ;; return 0. All the numbers must be less than half the
+ ;; leasst-positive float.
+ (dolist (item '(("1e-46" 0f0)
+ ("1e-999" 0f0)
+ ("1d-324" 0d0)
+ ("1d-999" 0d0)))
+ (destructuring-bind (string expected-value)
+ item
+ (assert-equal expected-value
+ (values (handler-bind
+ ((reader-error
+ (lambda (c)
+ (declare (ignore c))
+ (invoke-restart 'lisp::continue))))
+ (read-from-string string)))))))
+
+
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/df78595ef611a98eb5fe6c…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/df78595ef611a98eb5fe6c…
You're receiving this email because of your account on gitlab.common-lisp.net.