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

[Git][cmucl/cmucl][issue-464-lisp-version-uses-branch-name] 32 commits: Update cmucl.pot for new docstrings
by Raymond Toy (＠rtoy) 26 Feb '26

26 Feb '26

Raymond Toy pushed to branch issue-464-lisp-version-uses-branch-name at cmucl / cmucl Commits: 336b9322 by Raymond Toy at 2026-01-15T09:13:30-08:00 Update cmucl.pot for new docstrings Forgot to update this when accurate complex division was committed. [skip-ci] - - - - - 1b688607 by Raymond Toy at 2026-01-18T15:38:33-08:00 Fix #463: Handle double-double-float and double-float comparisons - - - - - 67dc5c9d by Raymond Toy at 2026-01-18T15:38:34-08:00 Merge branch 'issue-463-double-double-float-comparison' into 'master' Fix #463: Handle double-double-float and double-float comparisons Closes #463 See merge request cmucl/cmucl!342 - - - - - 06df185b by Raymond Toy at 2026-01-19T13:33:37-08:00 Fix #459: More accurate complex division for double-double-float - - - - - 75324b6d by Raymond Toy at 2026-01-19T13:33:37-08:00 Merge branch 'issue-459-more-accurate-dd-complex-div' into 'master' Fix #459: More accurate complex division for double-double-float Closes #459 and #456 See merge request cmucl/cmucl!338 - - - - - 3f733bae by Raymond Toy at 2026-01-19T16:54:46-08:00 Fix critical typo in deftransform for / for complex floats We inadvertently left off the quote for the code that the deftransform is supposed to use. Without that the compiler produces an error when the deftransform would be applicable. This bug was introduced when the MR for #459 was landed. - - - - - 6d264493 by Raymond Toy at 2026-01-20T07:02:39-08:00 Fix #428: Add some constants for common values in irrat.lisp - - - - - ea927341 by Raymond Toy at 2026-01-20T07:02:40-08:00 Merge branch 'issue-428-add-constants-for-irrat' into 'master' Fix #428: Add some constants for common values in irrat.lisp Closes #428 See merge request cmucl/cmucl!344 - - - - - 7f708431 by Raymond Toy at 2026-01-27T08:45:32-08:00 Fix #466: Add C wrapper for the special functions - - - - - 318d0560 by Raymond Toy at 2026-01-27T08:45:32-08:00 Merge branch 'issue-466-c-wrapper-specfun' into 'master' Fix #466: Add C wrapper for the special functions Closes #466 See merge request cmucl/cmucl!345 - - - - - fdb86a06 by Raymond Toy at 2026-02-01T07:38:55-08:00 Fix #434: Add support for correctly rounded double-precision math functions - - - - - e3ec78e4 by Raymond Toy at 2026-02-01T07:38:55-08:00 Merge branch 'issue-425-correctly-rounded-math-functions' into 'master' Fix #434: Add support for correctly rounded double-precision math functions Closes #434, #426, and #425 See merge request cmucl/cmucl!312 - - - - - 9a4f3d7e by Raymond Toy at 2026-02-04T08:06:20-08:00 Minor cleanup of GNUMakefile First, CORE64_OBJS is no longer defined, so don't use it. The CORE64_OBJS that used to name the .o files for core-math are now computed as part of OBJS. This removal also meant that the "clean" target no longer removed the core-math object files. Fix this by changing the rule to remove $(OBJS) instead of *.o. - - - - - f5a798b8 by Raymond Toy at 2026-02-05T17:51:48-08:00 Fix #470: Fix unit test issues on Ubuntu CI - - - - - 5b6d4d73 by Raymond Toy at 2026-02-05T17:51:48-08:00 Merge branch 'issue-470-ubuntu-ci-failures' into 'master' Fix #470: Fix unit test issues on Ubuntu CI Closes #470 See merge request cmucl/cmucl!348 - - - - - 772641b9 by Raymond Toy at 2026-02-05T19:39:14-08:00 Fix #469: Reenable cr_pow - - - - - 6ac1b6b4 by Raymond Toy at 2026-02-05T19:39:14-08:00 Merge branch 'issue-469-enable-cr-pow' into 'master' Fix #469: Reenable cr_pow Closes #469 and #470 See merge request cmucl/cmucl!346 - - - - - 9dec6e71 by Raymond Toy at 2026-02-16T07:40:15-08:00 Fix #468: Make core-math signal the same errors as fdlibm - - - - - ec7e3a25 by Raymond Toy at 2026-02-16T07:40:15-08:00 Merge branch 'issue-468-core-math-signals' into 'master' Fix #468: Make core-math signal the same errors as fdlibm Closes #468, #426, and #425 See merge request cmucl/cmucl!347 - - - - - 6494ef48 by Raymond Toy at 2026-02-16T07:44:39-08:00 Fix #471: Add tests for kernel:%pow - - - - - 69923013 by Raymond Toy at 2026-02-16T07:44:39-08:00 Merge branch 'issue-471-test-cases-for-pow' into 'master' Fix #471: Add tests for kernel:%pow Closes #471 See merge request cmucl/cmucl!349 - - - - - 1c92a62c by Raymond Toy at 2026-02-17T10:47:23-08:00 Fix #472: Ansi-tests test.log not found - - - - - 53a087ca by Raymond Toy at 2026-02-17T10:47:23-08:00 Merge branch 'issue-472-ansi-tests-test-log-not-found' into 'master' Fix #472: Ansi-tests test.log not found Closes #472 See merge request cmucl/cmucl!350 - - - - - 9bf28346 by Raymond Toy at 2026-02-18T07:18:07-08:00 Fix #473: Signal underflow with core-math exp - - - - - b26718dd by Raymond Toy at 2026-02-18T07:18:07-08:00 Merge branch 'issue-473-make-cr-exp-signal-underflow' into 'master' Fix #473: Signal underflow with core-math exp Closes #473 See merge request cmucl/cmucl!351 - - - - - 3434a963 by Raymond Toy at 2026-02-18T10:53:11-08:00 Update list of fixed tickets [skip-ci] - - - - - d09876ca by Raymond Toy at 2026-02-24T16:05:24-08:00 Address #435: Add single-float core-math routines - - - - - c430d75d by Raymond Toy at 2026-02-24T16:05:24-08:00 Merge branch 'issue-435-add-core-math-code-only' into 'master' Address #435: Add single-float core-math routines See merge request cmucl/cmucl!354 - - - - - 1b1e639b by Raymond Toy at 2026-02-24T18:09:31-08:00 Forgot to add log1pf.c - - - - - e1f841fb by Raymond Toy at 2026-02-24T18:15:35-08:00 Merge branch 'issue-435-add-core-math-compile-code' into 'master' Forgot to add log1pf.c See merge request cmucl/cmucl!355 - - - - - 138673db by Raymond Toy at 2026-02-26T06:39:23-08:00 Merge branch 'master' into issue-464-lisp-version-uses-branch-name - - - - - 11066214 by Raymond Toy at 2026-02-26T06:41:22-08:00 Undo changes to tests/fdlibm.lisp. This branch shouldn't have changed anything from master. I guess I did a bad conflict resolution during the merge from master to update this branch. - - - - - 31 changed files: - .gitlab-ci.yml - src/general-info/release-22a.md - + src/lisp/core-math/src/binary32/acos/acosf.c - + src/lisp/core-math/src/binary32/acosh/acoshf.c - + src/lisp/core-math/src/binary32/asin/asinf.c - + src/lisp/core-math/src/binary32/asinh/asinhf.c - + src/lisp/core-math/src/binary32/atan/atanf.c - + src/lisp/core-math/src/binary32/atan2/atan2f.c - + src/lisp/core-math/src/binary32/atanh/atanhf.c - + src/lisp/core-math/src/binary32/cos/cosf.c - + src/lisp/core-math/src/binary32/cosh/coshf.c - + src/lisp/core-math/src/binary32/exp/expf.c - + src/lisp/core-math/src/binary32/exp2m1/Makefile - + src/lisp/core-math/src/binary32/exp2m1/check_special.c - + src/lisp/core-math/src/binary32/exp2m1/exp2m1f.c - + src/lisp/core-math/src/binary32/exp2m1/exp2m1f.wc - + src/lisp/core-math/src/binary32/exp2m1/exp2m1f_mpfr.c - + src/lisp/core-math/src/binary32/expm1/expm1f.c - + src/lisp/core-math/src/binary32/hypot/hypotf.c - + src/lisp/core-math/src/binary32/log/logf.c - + src/lisp/core-math/src/binary32/log10/log10f.c - + src/lisp/core-math/src/binary32/log1p/log1pf.c - + src/lisp/core-math/src/binary32/log2/log2f.c - + src/lisp/core-math/src/binary32/pow/powf.c - + src/lisp/core-math/src/binary32/sin/sinf.c - + src/lisp/core-math/src/binary32/sincos/sincosf.c - + src/lisp/core-math/src/binary32/sinh/sinhf.c - + src/lisp/core-math/src/binary32/tan/tanf.c - + src/lisp/core-math/src/binary32/tanh/tanhf.c - src/lisp/irrat.c - tests/fdlibm.lisp The diff was not included because it is too large. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a0e8bf87e0445b7bee7853… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/a0e8bf87e0445b7bee7853… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-476-disable-ci-scheduled-analyzer-link-checker] Comment out CI_SOURCE = "branch"
by Raymond Toy (＠rtoy) 26 Feb '26

26 Feb '26

Raymond Toy pushed to branch issue-476-disable-ci-scheduled-analyzer-link-checker at cmucl / cmucl Commits: b5ccdd67 by Raymond Toy at 2026-02-25T17:14:57-08:00 Comment out CI_SOURCE = "branch" This only appears in the linux:install job. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -136,7 +136,7 @@ linux:install: #- if: $CI_PIPELINE_SOURCE == "schedule" - if: $CI_PIPELINE_SOURCE == "push" - if: $CI_PIPELINE_SOURCE == "merge_request_event" - - if: $CI_PIPELINE_SOURCE == "branch" + #- if: $CI_PIPELINE_SOURCE == "branch" - if: $CI_PIPELINE_SOURCE == "web" linux:build: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b5ccdd6740ed0afbfb3aef4… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b5ccdd6740ed0afbfb3aef4… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-476-disable-ci-scheduled-analyzer-link-checker] Comment out more CI_PIPELINE_SOURCE="schedule"
by Raymond Toy (＠rtoy) 26 Feb '26

26 Feb '26

Raymond Toy pushed to branch issue-476-disable-ci-scheduled-analyzer-link-checker at cmucl / cmucl Commits: 056a37f7 by Raymond Toy at 2026-02-25T17:12:38-08:00 Comment out more CI_PIPELINE_SOURCE="schedule" - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -133,7 +133,7 @@ linux:install: # schedule because this is a prerequisite of the analyzer build. A # regular push or merge request does the normal stuff. rules: - - if: $CI_PIPELINE_SOURCE == "schedule" + #- if: $CI_PIPELINE_SOURCE == "schedule" - if: $CI_PIPELINE_SOURCE == "push" - if: $CI_PIPELINE_SOURCE == "merge_request_event" - if: $CI_PIPELINE_SOURCE == "branch" @@ -154,7 +154,7 @@ linux:build: # schedule because this is a prerequisite of the analyzer build. A # regular push or merge request does the normal stuff. rules: - - if: $CI_PIPELINE_SOURCE == "schedule" + #- if: $CI_PIPELINE_SOURCE == "schedule" - if: $CI_PIPELINE_SOURCE == "push" - if: $CI_PIPELINE_SOURCE == "merge_request_event" - if: $CI_PIPELINE_SOURCE == "web" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/056a37f7b7c835cd5a03a40… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/056a37f7b7c835cd5a03a40… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-476-disable-ci-scheduled-analyzer-link-checker] Fix typo.
by Raymond Toy (＠rtoy) 26 Feb '26

26 Feb '26

Raymond Toy pushed to branch issue-476-disable-ci-scheduled-analyzer-link-checker at cmucl / cmucl Commits: e56e7d17 by Raymond Toy at 2026-02-25T16:05:19-08:00 Fix typo. Needed to comment out one more thing in the link-checker stage - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -383,7 +383,7 @@ markdown-link-check: # pipeline as having failed. rules: #- if: $CI_PIPELINE_SOURCE == "schedule" - allow_failure: true + # allow_failure: true - if: $CI_PIPELINE_SOURCE == "merge_request_event" when: manual allow_failure: true View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/e56e7d17eeee76c2f2d62aa… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/e56e7d17eeee76c2f2d62aa… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-476-disable-ci-scheduled-analyzer-link-checker
by Raymond Toy (＠rtoy) 26 Feb '26

26 Feb '26

Raymond Toy pushed new branch issue-476-disable-ci-scheduled-analyzer-link-checker at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-476-disable-ci-sche… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-435-add-core-math-lisp-support] 3 commits: Update sincos for single-float
by Raymond Toy (＠rtoy) 25 Feb '26

25 Feb '26

Raymond Toy pushed to branch issue-435-add-core-math-lisp-support at cmucl / cmucl Commits: e8cec854 by Raymond Toy at 2026-02-25T15:25:23-08:00 Update sincos for single-float Define %%sincosf for the single version to match %%sincos. Update %sincos to accept both single and double float values. Modify cis to %use %%sincos and %%sincosf instead of using %sincos to bypass the %type dispatch that %sincos does anyway. - - - - - 32530cd0 by Raymond Toy at 2026-02-25T15:27:55-08:00 Update deftransforms to call the single-float special functions. - - - - - e8f54c41 by Raymond Toy at 2026-02-25T15:49:14-08:00 Tell compiler about %%sincos and friends and update cis deftransforms Add defknown for %%sincos and %%sincosf, removing the defknown for %sincos. Update the deftransforms for cis to use %%sincos and %%sincosf. - - - - - 2 changed files: - src/code/irrat.lisp - src/compiler/float-tran.lisp Changes: ===================================== src/code/irrat.lisp ===================================== @@ -225,21 +225,34 @@ (y0 double-float :out) (y1 double-float :out)) -(declaim (inline %%sincos)) +(declaim (inline %%sincos %%sincosf)) (alien:def-alien-routine ("lisp_sincos" %%sincos) c-call:void (x double-float) (s double-float :out) (c double-float :out)) +(alien:def-alien-routine ("lisp_sincosf" %%sincosf) + c-call:void + (x single-float) + (s single-float :out) + (c single-float :out)) + (declaim (inline %sincos)) (export '%sincos) (defun %sincos (x) - (declare (double-float x)) - (multiple-value-bind (ign s c) - (%%sincos x) - (declare (ignore ign)) - (values s c))) + (declare (float x)) + (etypecase x + (single-float + (multiple-value-bind (ign s c) + (%%sincosf x) + (declare (ignore ign)) + (values s c))) + (double-float + (multiple-value-bind (ign s c) + (%%sincos x) + (declare (ignore ign)) + (values s c))))) ;;;; Power functions. @@ -1005,17 +1018,17 @@ (if (complexp theta) (error (intl:gettext "Argument to CIS is complex: ~S") theta) (number-dispatch ((theta real)) - ((rational) - (let ((arg (coerce theta 'double-float))) - (multiple-value-bind (s c) - (%sincos arg) - (complex (coerce c 'single-float) - (coerce s 'single-float))))) - (((foreach single-float double-float)) - (multiple-value-bind (s c) - (%sincos (coerce theta 'double-float)) - (complex (coerce c '(dispatch-type theta)) - (coerce s '(dispatch-type theta))))) + (((foreach rational single-float)) + (let ((arg (coerce theta 'single-float))) + (multiple-value-bind (ign s c) + (%%sincosf arg) + (declare (ignore ign)) + (complex c s)))) + ((double-float) + (multiple-value-bind (ign s c) + (%%sincos theta) + (declare (ignore ign)) + (complex c s))) #+double-double ((double-double-float) (multiple-value-bind (s c) ===================================== src/compiler/float-tran.lisp ===================================== @@ -683,25 +683,44 @@ (asinh %asinh *) (acosh %acosh float) (atanh %atanh float))) + (destructuring-bind (name prim rtype) + stuff + (let ((primf (intern (string (symbolicate prim "F")) + "KERNEL"))) + (deftransform name ((x) '(single-float) rtype :eval-name t) + #-core-math + `(coerce (,prim (coerce x 'double-float)) 'single-float) + #+core-math + `(,primf x)) + (deftransform name ((x) '(double-float) rtype :eval-name t :when :both) + `(,prim x))))) + +#-core-math +(dolist (stuff '((sqrt %sqrt float))) (destructuring-bind (name prim rtype) stuff (deftransform name ((x) '(single-float) rtype :eval-name t) `(coerce (,prim (coerce x 'double-float)) 'single-float)) (deftransform name ((x) '(double-float) rtype :eval-name t :when :both) - `(,prim x)))) + `(,prim x)))) -(defknown (%sincos) - (double-float) (values double-float double-float) +(defknown (kernel::%%sincos) + (double-float) (values null double-float double-float) + (movable foldable flushable)) + +(defknown (kernel::%%sincosf) + (single-float) (values null single-float single-float) (movable foldable flushable)) (deftransform cis ((x) (single-float) * :when :both) - `(multiple-value-bind (s c) - (%sincos (coerce x 'double-float)) - (complex (coerce c 'single-float) - (coerce s 'single-float)))) + `(multiple-value-bind (ign s c) + (kernel::%%sincosf x) + (declare (ignore ign)) + (complex c s))) (deftransform cis ((x) (double-float) * :when :both) - `(multiple-value-bind (s c) - (%sincos x) + `(multiple-value-bind (ign s c) + (kernel::%%sincos x) + (declare (ignore ign)) (complex c s))) ;;; The argument range is limited on the x86 FP trig. functions. A View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9f7c82924e28f8274b3b3c… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9f7c82924e28f8274b3b3c… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch issue-435-add-core-math-lisp-support
by Raymond Toy (＠rtoy) 25 Feb '26

25 Feb '26

Raymond Toy pushed new branch issue-435-add-core-math-lisp-support at cmucl / cmucl -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/tree/issue-435-add-core-math-l… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #474: Add functions to print and parse C-style hex floats
by Raymond Toy (＠rtoy) 25 Feb '26

25 Feb '26

Raymond Toy pushed to branch master at cmucl / cmucl Commits: beb2c36e by Raymond Toy at 2026-02-25T08:24:17-08:00 Fix #474: Add functions to print and parse C-style hex floats - - - - - 1030fd9b by Raymond Toy at 2026-02-25T08:24:17-08:00 Merge branch 'issue-474-print-parse-hex-floats' into 'master' Fix #474: Add functions to print and parse C-style hex floats Closes #474 See merge request cmucl/cmucl!353 - - - - - 9 changed files: - bin/run-ansi-tests.sh - src/code/exports.lisp - + src/code/ext-code.lisp - src/general-info/release-22a.md - src/i18n/locale/cmucl.pot - src/tools/worldcom.lisp - src/tools/worldload.lisp - + tests/extensions.lisp - tests/float.lisp Changes: ===================================== bin/run-ansi-tests.sh ===================================== @@ -36,7 +36,7 @@ shift $((OPTIND - 1)) # Use branch cmucl-expected-failures in general since this branch # generally has the list of expected failures. This is the branch to # use on cmucl master in general. -BRANCH=cmucl-expected-failures-etypecase.15 +BRANCH=cmucl-expected-failures set -x if [ -d ../ansi-test ]; then ===================================== src/code/exports.lisp ===================================== @@ -1368,7 +1368,13 @@ (:export "PACKAGE-LOCAL-NICKNAMES" "ADD-PACKAGE-LOCAL-NICKNAME" "REMOVE-PACKAGE-LOCAL-NICKNAME" - "PACKAGE-LOCALLY-NICKNAMED-BY-LIST")) + "PACKAGE-LOCALLY-NICKNAMED-BY-LIST") + ;; Printing and parsing of C-style hex floats + (:export "FLOAT-TO-HEX-STRING" + "WRITE-HEX-FLOAT" + "FORMAT-HEX-FLOAT" + "HEX-PARSE-ERROR" + "PARSE-HEX-FLOAT")) (defpackage "STREAM" (:import-from "SYSTEM" "LISP-STREAM") ===================================== src/code/ext-code.lisp ===================================== @@ -0,0 +1,184 @@ +;;; -*- Log: code.log; Package: Extensions -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of the CMU Common Lisp project at +;;; Carnegie Mellon University, and has been placed in the public domain. +;;; +(ext:file-comment + "$Header: src/code/extensions.lisp $") +;;; +;;; +;;; ********************************************************************** +;;; +;;; Spice Lisp extensions to the language. +;;; +;;; These extensions are compiled natively instead of byte-compiled +;;; like the code in code/extensions.lisp. +;;; +;;; ********************************************************************** +(in-package "EXTENSIONS") + +(intl:textdomain "cmucl") + + +;;;; C-style hex float printer and parser + +;;; FLOAT-TO-HEX-STRING -- Public +;;; +;;; Return a string representing a single and double-floats in C-style +;;; hex format. +(defun float-to-hex-string (val &optional at-p) + "Prints a single or double float in bit-perfect C-style hex. + If AT-P is true, prepends '+' for non-negative finite values." + (cond ((ext:float-nan-p val) + "0x0.0p+nan") + ((ext:float-infinity-p val) + (if (plusp val) + (if at-p + "+0x1.0p+inf" "0x1.0p+inf") + "-0x1.0p+inf")) + (t + (multiple-value-bind (sign exp-bits mantissa bias precision suffix) + (typecase val + (single-float + (let ((bits (ldb (byte 32 0) (kernel:single-float-bits val)))) + (values (ldb (byte 1 31) bits) + (ldb (byte 8 23) bits) + (ash (ldb (byte 23 0) bits) 1) ; Align 23 to 6 hex digits + 127 6 "f"))) + (double-float + (multiple-value-bind (hi lo) (kernel:double-float-bits val) + (values (ldb (byte 1 31) hi) + (ldb (byte 11 20) hi) + (logior (ash (ldb (byte 20 0) hi) 32) (ldb (byte 32 0) lo)) + 1023 13 ""))) + (t (error "Unsupported float type: ~S" (type-of val)))) + + (let ((sign-str (cond ((= sign 1) "-") + (at-p "+") + (t "")))) + (if (and (zerop exp-bits) (zerop mantissa)) + (format nil "~A0x0.0p+0~A" sign-str suffix) + (format nil "~A0x~A.~V,'0Xp~A~A" + sign-str + (if (zerop exp-bits) "0" "1") + precision + mantissa + (if (zerop exp-bits) (1+ (- bias)) (- exp-bits bias)) + suffix))))))) + +;;; WRITE-HEX-FLOAT -- Public +;;; +;;; Writes a float number in C-style hex format to the given stream. +(defun write-hex-float (float &optional (stream *standard-output*)) + "Convert FLOAT to C-style hex string and write it to STREAM. + Infinities are printed as \"-inf\" and \"inf\". NaN is printed as + \"nan\"." + (declare (float float)) + (write-string (float-to-hex-string float) + stream)) + +;;; FORMAT-HEX-FLOAT -- Public +;;; +;;; Function that can be used in a FORMAT ~/ +(defun format-hex-float (stream arg colon-p at-sign-p &optional width) + "Formatter for ~/ext:format-hex-float/. + Uses AT-SIGN-P (@) to force the sign. COLON-P (:) is currently ignored." + (declare (ignore width colon-p)) + (write-string (float-to-hex-string arg at-sign-p) + stream)) + +(define-condition hex-parse-error (parse-error) + ((text :initarg :text :reader hex-parse-error-text) + (message :initarg :message :reader hex-parse-error-message)) + (:report (lambda (c s) + (format s "Hex float parse error in ~S: ~A" + (hex-parse-error-text c) (hex-parse-error-message c))))) + +;;; PARSE-HEX-FLOAT-FROM-STREAM -- Public +;;; +;;; Parse a C-style float hex string from a stream. Invalid formats +;;; signal an error. A single-float or double-float may be returned. +(defun parse-hex-float-from-stream (stream) + "Reads a C-style hex float number from STREAM. A single-float or + double-float number is returned. A HEX-PARSE-ERROR is signaled for + an invalid format." + (let* ((sign 1.0d0) + (char (peek-char t stream))) ; Skip whitespace + + ;; 1. Handle Sign + (when (member char '(#\+ #\-)) + (when (char= (read-char stream) #\-) (setf sign -1.0d0)) + (setf char (peek-char nil stream))) + + ;; 2. Verify '0x' Prefix + (unless (and (char-equal (read-char stream) #\0) + (char-equal (read-char stream) #\x)) + (error 'hex-parse-error :text "Stream" :message "Missing '0x' prefix")) + + ;; 3. Read Significand + (let ((val 0.0d0) + (digits-read 0)) + ;; Integer part loop + (loop for c = (peek-char nil stream nil nil) + for digit = (and c (digit-char-p c 16)) + while digit + do (read-char stream) + (setf val (+ (* val 16.0d0) digit)) + (incf digits-read)) + + ;; Fractional part loop + (when (eql (peek-char nil stream nil nil) #\.) + (read-char stream) ; Consume #\. + (loop with weight = (/ 1.0d0 16.0d0) + for c = (peek-char nil stream nil nil) + for digit = (and c (digit-char-p c 16)) + while digit + do (read-char stream) + (setf val (+ val (* digit weight))) + (setf weight (/ weight 16.0d0)) + (incf digits-read))) + + (unless (plusp digits-read) + (error 'hex-parse-error :text "Stream" :message "No hex digits in significand")) + + ;; 4. Handle Exponent 'p' + (let ((p-char (read-char stream nil))) + (unless (and p-char (char-equal p-char #\p)) + (error 'hex-parse-error :text "Stream" :message "Missing exponent 'p'")) + + ;; Size 6 handles sign + 3-4 digits + buffer + (let ((exp-str (make-array 6 :element-type 'character + :fill-pointer 0 + :adjustable t))) + (loop for c = (peek-char nil stream nil nil) + while (and c (find c "+-0123456789")) + do (vector-push-extend (read-char stream) exp-str)) + + (when (zerop (length exp-str)) + (error 'hex-parse-error :text "Stream" :message "Invalid or missing exponent")) + + (let* ((raw-exp (parse-integer exp-str)) + (suffix (peek-char nil stream nil #\Space)) + (is-single (char-equal suffix #\f)) + ;; Final Construction + (result (* sign (scale-float val raw-exp)))) + + (when is-single (read-char stream)) ; Consume 'f' + + (if is-single + (float result 1.0f0) + result))))))) + +;;; PARSE-HEX-FLOAT -- Public +;;; +;;; Parse a C-style hex float number from either a string or a stream. +(defun parse-hex-float (obj) + "Parse a C-style hex float number from OBJ which is either a string or a stream." + (declare (type (or string stream) obj)) + (etypecase obj + (string + (with-input-from-string (s obj) + (parse-hex-float-from-stream s))) + (stream + (parse-hex-float-from-stream obj)))) ===================================== src/general-info/release-22a.md ===================================== @@ -57,6 +57,7 @@ public domain. * #460: Unit tests were not being recognized as failing on CI. * #463: `double-double-float` is missing comparison operations between `double-double-float` and `double-float` + * #474: Add functions to print and parse C-style hex floats. * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -6060,6 +6060,38 @@ msgid "" " afterward." msgstr "" +#: src/code/ext-code.lisp +msgid "" +"Prints a single or double float in bit-perfect C-style hex.\n" +" If AT-P is true, prepends '+' for non-negative finite values." +msgstr "" + +#: src/code/ext-code.lisp +msgid "" +"Convert FLOAT to C-style hex string and write it to STREAM.\n" +" Infinities are printed as \"-inf\" and \"inf\". NaN is printed as\n" +" \"nan\"." +msgstr "" + +#: src/code/ext-code.lisp +msgid "" +"Formatter for ~/ext:format-hex-float/. \n" +" Uses AT-SIGN-P (@) to force the sign. COLON-P (:) is currently ignored." +msgstr "" + +#: src/code/ext-code.lisp +msgid "" +"Reads a C-style hex float number from STREAM. A single-float or\n" +" double-float number is returned. A HEX-PARSE-ERROR is signaled for\n" +" an invalid format." +msgstr "" + +#: src/code/ext-code.lisp +msgid "" +"Parse a C-style hex float number from OBJ which is either a string or a " +"stream." +msgstr "" + #: src/code/commandline.lisp msgid "A list of all the command line arguments after --" msgstr "" ===================================== src/tools/worldcom.lisp ===================================== @@ -221,6 +221,7 @@ (comf "target:code/misc") (comf "target:code/misc-doc") (comf "target:code/extensions" :byte-compile t) +(comf "target:code/ext-code") (comf "target:code/commandline") (comf "target:code/env-access") ===================================== src/tools/worldload.lisp ===================================== @@ -44,6 +44,7 @@ (maybe-byte-load "target:code/extensions") +(maybe-byte-load "target:code/ext-code") (maybe-byte-load "target:code/defmacro") (maybe-byte-load "target:code/sysmacs") ===================================== tests/extensions.lisp ===================================== @@ -0,0 +1,89 @@ +;; Test extensions +(defpackage :extensions-tests + (:use :cl :lisp-unit)) + +(in-package "EXTENSIONS-TESTS") + +(defun get-double-bits (val) + (multiple-value-bind (hi lo) (kernel:double-float-bits val) + (logior (ash (ldb (byte 32 0) hi) 32) (ldb (byte 32 0) lo)))) + +(defun get-single-bits (val) + (ldb (byte 32 0) (kernel:single-float-bits val))) + +(define-test test-hex-syntax + (:tag :validation) + (assert-error 'ext:hex-parse-error (ext:parse-hex-float "inf")) + (assert-error 'ext:hex-parse-error (ext:parse-hex-float "0x.p+0")) + (assert-error 'ext:hex-parse-error (ext:parse-hex-float "0x1.0p"))) + +(define-test test-cliff-boundaries + (:tag :precision) + ;; Double Precision (-1022 Cliff) + + (assert-equal #x0010000000000000 + (get-double-bits (ext:parse-hex-float "0x1.0000000000000p-1022"))) + (assert-equal #x000fffffffffffff + (get-double-bits (ext:parse-hex-float "0x0.fffffffffffffp-1022"))) + (assert-equal #x001f0195cb356b8f + (get-double-bits (ext:parse-hex-float "0x1.f0195cb356b8fp-1022"))) + + ;; Single Precision (-126 Cliff) + + (assert-equal #x00800000 + (get-single-bits (ext:parse-hex-float "0x1.000000p-126f"))) + (assert-equal #x00400000 + (get-single-bits (ext:parse-hex-float "0x0.800000p-126f"))) + (assert-equal #x7f7fffff + (get-single-bits (ext:parse-hex-float "0x1.fffffep+127f")))) + +(define-test test-negative-zero + (:tag :edge-cases) + (assert-equal #x8000000000000000 + (get-double-bits (ext:parse-hex-float "-0x0.0p+0"))) + (assert-equal #x80000000 + (get-single-bits (ext:parse-hex-float "-0x0.0p+0f"))) + (assert-true (typep (ext:parse-hex-float "-0x0.0p+0f") + 'single-float))) + +(define-test test-subnormal-boundaries + (:tag :edge) + ;; Test smallest single-float subnormal + (let* ((val (kernel:make-single-float 1)) + (str (ext:float-to-hex-string val)) + (parsed (ext:parse-hex-float str))) + (assert-equal (get-single-bits val) (get-single-bits parsed) + val str parsed)) + ;; Test smallest double-float subnormal + (let* ((val (kernel:make-double-float 0 1)) + (str (ext:float-to-hex-string val)) + (parsed (ext:parse-hex-float str))) + (assert-equal (get-double-bits val) (get-double-bits parsed) + val str parsed))) + +(define-test test-double-roundtrip + (:tag :stress) + (loop repeat 10000 do + (let* ((hi-bits (random #x100000000)) + (hi (if (logbitp 31 hi-bits) (- hi-bits #x100000000) hi-bits)) + (lo (random #x100000000)) + (val (kernel:make-double-float hi lo))) + (unless (or (ext:float-nan-p val) (ext:float-infinity-p val)) + (let* ((str (ext:float-to-hex-string val)) + (parsed (ext:parse-hex-float str))) + (assert-equal (get-double-bits val) + (get-double-bits parsed) + val str parsed)))))) + +(define-test test-single-roundtrip + (:tag :stress) + (loop repeat 10000 do + (let* ((bits-raw (random #x100000000)) + (bits (if (logbitp 31 bits-raw) (- bits-raw #x100000000) bits-raw)) + (val (kernel:make-single-float bits))) + (unless (or (ext:float-nan-p val) (ext:float-infinity-p val)) + (let* ((str (concatenate 'string (ext:float-to-hex-string val) "f")) + (parsed (ext:parse-hex-float str))) + (assert-equal (get-single-bits val) + (get-single-bits parsed) + val str parsed)))))) ===================================== tests/float.lisp ===================================== @@ -346,20 +346,7 @@ ;; Rudimentary code to read C %a formatted numbers that look like ;; "-0x1.c4dba4ba1ee79p-620". We assume STRING is exactly in this ;; format. No error-checking is done. -(defun parse-hex-float (string) - (let* ((sign (if (char= (aref string 0) #\-) - -1 - 1)) - (dot-posn (position #\. string)) - (p-posn (position #\p string)) - (lead (parse-integer string :start (1- dot-posn) :end dot-posn)) - (frac (parse-integer string :start (1+ dot-posn) :end p-posn :radix 16)) - (exp (parse-integer string :start (1+ p-posn)))) - (* sign - (scale-float (float (+ (ash lead 52) - frac) - 1d0) - (- exp 52))))) + ;; Relative error in terms of bits of accuracy. This is the ;; definition used by Baudin and Smith. A result of 53 means the two @@ -507,50 +494,50 @@ ;; 13 ;; Iteration 1. Without this, we would instead return ;; - ;; (complex (parse-hex-float "0x1.ba8df8075bceep+155") - ;; (parse-hex-float "-0x1.a4ad6329485f0p-895")) + ;; (complex (ext:parse-hex-float "0x1.ba8df8075bceep+155") + ;; (ext:parse-hex-float "-0x1.a4ad6329485f0p-895")) ;; ;; whose imaginary part is quite a bit off. (frob cdiv.mcgehearty-iteration.1 - (complex (parse-hex-float "0x1.73a3dac1d2f1fp+509") - (parse-hex-float "-0x1.c4dba4ba1ee79p-620")) - (complex (parse-hex-float "0x1.adf526c249cf0p+353") - (parse-hex-float "0x1.98b3fbc1677bbp-697")) - (complex (parse-hex-float "0x1.BA8DF8075BCEEp+155") - (parse-hex-float "-0x1.A4AD628DA5B74p-895")) + (complex (ext:parse-hex-float "0x1.73a3dac1d2f1fp+509") + (ext:parse-hex-float "-0x1.c4dba4ba1ee79p-620")) + (complex (ext:parse-hex-float "0x1.adf526c249cf0p+353") + (ext:parse-hex-float "0x1.98b3fbc1677bbp-697")) + (complex (ext:parse-hex-float "0x1.BA8DF8075BCEEp+155") + (ext:parse-hex-float "-0x1.A4AD628DA5B74p-895")) 53 106) ;; 14 ;; Iteration 2. (frob cdiv.mcgehearty-iteration.2 - (complex (parse-hex-float "-0x0.000000008e4f8p-1022") - (parse-hex-float "0x0.0000060366ba7p-1022")) - (complex (parse-hex-float "-0x1.605b467369526p-245") - (parse-hex-float "0x1.417bd33105808p-256")) - (complex (parse-hex-float "0x1.cde593daa4ffep-810") - (parse-hex-float "-0x1.179b9a63df6d3p-799")) + (complex (ext:parse-hex-float "-0x0.000000008e4f8p-1022") + (ext:parse-hex-float "0x0.0000060366ba7p-1022")) + (complex (ext:parse-hex-float "-0x1.605b467369526p-245") + (ext:parse-hex-float "0x1.417bd33105808p-256")) + (complex (ext:parse-hex-float "0x1.cde593daa4ffep-810") + (ext:parse-hex-float "-0x1.179b9a63df6d3p-799")) 52 106) ;; 15 ;; Iteration 3 (frob cdiv.mcgehearty-iteration.3 - (complex (parse-hex-float "0x1.cb27eece7c585p-355 ") - (parse-hex-float "0x0.000000223b8a8p-1022")) - (complex (parse-hex-float "-0x1.74e7ed2b9189fp-22") - (parse-hex-float "0x1.3d80439e9a119p-731")) - (complex (parse-hex-float "-0x1.3b35ed806ae5ap-333") - (parse-hex-float "-0x0.05e01bcbfd9f6p-1022")) + (complex (ext:parse-hex-float "0x1.cb27eece7c585p-355 ") + (ext:parse-hex-float "0x0.000000223b8a8p-1022")) + (complex (ext:parse-hex-float "-0x1.74e7ed2b9189fp-22") + (ext:parse-hex-float "0x1.3d80439e9a119p-731")) + (complex (ext:parse-hex-float "-0x1.3b35ed806ae5ap-333") + (ext:parse-hex-float "-0x0.05e01bcbfd9f6p-1022")) 53 106) ;; 16 ;; Iteration 4 (frob cdiv.mcgehearty-iteration.4 - (complex (parse-hex-float "-0x1.f5c75c69829f0p-530") - (parse-hex-float "-0x1.e73b1fde6b909p+316")) - (complex (parse-hex-float "-0x1.ff96c3957742bp+1023") - (parse-hex-float "0x1.5bd78c9335899p+1021")) - (complex (parse-hex-float "-0x1.423c6ce00c73bp-710") - (parse-hex-float "0x1.d9edcf45bcb0ep-708")) + (complex (ext:parse-hex-float "-0x1.f5c75c69829f0p-530") + (ext:parse-hex-float "-0x1.e73b1fde6b909p+316")) + (complex (ext:parse-hex-float "-0x1.ff96c3957742bp+1023") + (ext:parse-hex-float "0x1.5bd78c9335899p+1021")) + (complex (ext:parse-hex-float "-0x1.423c6ce00c73bp-710") + (ext:parse-hex-float "0x1.d9edcf45bcb0ep-708")) 52 106)) @@ -592,26 +579,6 @@ (assert-equal -2w300 (* -2w300 1w0))) - - -;; Rudimentary code to read C %a formatted numbers that look like -;; "-0x1.c4dba4ba1ee79p-620". We assume STRING is exactly in this -;; format. No error-checking is done. -(defun parse-hex-float (string) - (let* ((sign (if (char= (aref string 0) #\-) - -1 - 1)) - (dot-posn (position #\. string)) - (p-posn (position #\p string)) - (lead (parse-integer string :start (1- dot-posn) :end dot-posn)) - (frac (parse-integer string :start (1+ dot-posn) :end p-posn :radix 16)) - (exp (parse-integer string :start (1+ p-posn)))) - (* sign - (scale-float (float (+ (ash lead 52) - frac) - 1d0) - (- exp 52))))) - ;; Relative error in terms of bits of accuracy. This is the ;; definition used by Baudin and Smith. A result of 53 means the two ;; numbers have identical bits. For complex numbers, we use the min @@ -725,47 +692,47 @@ ;; 13 ;; Iteration 1. Without this, we would instead return ;; - ;; (complex (parse-hex-float "0x1.ba8df8075bceep+155") - ;; (parse-hex-float "-0x1.a4ad6329485f0p-895")) + ;; (complex (ext:parse-hex-float "0x1.ba8df8075bceep+155") + ;; (ext:parse-hex-float "-0x1.a4ad6329485f0p-895")) ;; ;; whose imaginary part is quite a bit off. (frob cdiv.mcgehearty-iteration.1 - (complex (parse-hex-float "0x1.73a3dac1d2f1fp+509") - (parse-hex-float "-0x1.c4dba4ba1ee79p-620")) - (complex (parse-hex-float "0x1.adf526c249cf0p+353") - (parse-hex-float "0x1.98b3fbc1677bbp-697")) - (complex (parse-hex-float "0x1.BA8DF8075BCEEp+155") - (parse-hex-float "-0x1.A4AD628DA5B74p-895")) + (complex (ext:parse-hex-float "0x1.73a3dac1d2f1fp+509") + (ext:parse-hex-float "-0x1.c4dba4ba1ee79p-620")) + (complex (ext:parse-hex-float "0x1.adf526c249cf0p+353") + (ext:parse-hex-float "0x1.98b3fbc1677bbp-697")) + (complex (ext:parse-hex-float "0x1.BA8DF8075BCEEp+155") + (ext:parse-hex-float "-0x1.A4AD628DA5B74p-895")) 53) ;; 14 ;; Iteration 2. (frob cdiv.mcgehearty-iteration.2 - (complex (parse-hex-float "-0x0.000000008e4f8p-1022") - (parse-hex-float "0x0.0000060366ba7p-1022")) - (complex (parse-hex-float "-0x1.605b467369526p-245") - (parse-hex-float "0x1.417bd33105808p-256")) - (complex (parse-hex-float "0x1.cde593daa4ffep-810") - (parse-hex-float "-0x1.179b9a63df6d3p-799")) + (complex (ext:parse-hex-float "-0x0.000000008e4f8p-1022") + (ext:parse-hex-float "0x0.0000060366ba7p-1022")) + (complex (ext:parse-hex-float "-0x1.605b467369526p-245") + (ext:parse-hex-float "0x1.417bd33105808p-256")) + (complex (ext:parse-hex-float "0x1.cde593daa4ffep-810") + (ext:parse-hex-float "-0x1.179b9a63df6d3p-799")) 52) ;; 15 ;; Iteration 3 (frob cdiv.mcgehearty-iteration.3 - (complex (parse-hex-float "0x1.cb27eece7c585p-355 ") - (parse-hex-float "0x0.000000223b8a8p-1022")) - (complex (parse-hex-float "-0x1.74e7ed2b9189fp-22") - (parse-hex-float "0x1.3d80439e9a119p-731")) - (complex (parse-hex-float "-0x1.3b35ed806ae5ap-333") - (parse-hex-float "-0x0.05e01bcbfd9f6p-1022")) + (complex (ext:parse-hex-float "0x1.cb27eece7c585p-355 ") + (ext:parse-hex-float "0x0.000000223b8a8p-1022")) + (complex (ext:parse-hex-float "-0x1.74e7ed2b9189fp-22") + (ext:parse-hex-float "0x1.3d80439e9a119p-731")) + (complex (ext:parse-hex-float "-0x1.3b35ed806ae5ap-333") + (ext:parse-hex-float "-0x0.05e01bcbfd9f6p-1022")) 53) ;; 16 ;; Iteration 4 (frob cdiv.mcgehearty-iteration.4 - (complex (parse-hex-float "-0x1.f5c75c69829f0p-530") - (parse-hex-float "-0x1.e73b1fde6b909p+316")) - (complex (parse-hex-float "-0x1.ff96c3957742bp+1023") - (parse-hex-float "0x1.5bd78c9335899p+1021")) - (complex (parse-hex-float "-0x1.423c6ce00c73bp-710") - (parse-hex-float "0x1.d9edcf45bcb0ep-708")) + (complex (ext:parse-hex-float "-0x1.f5c75c69829f0p-530") + (ext:parse-hex-float "-0x1.e73b1fde6b909p+316")) + (complex (ext:parse-hex-float "-0x1.ff96c3957742bp+1023") + (ext:parse-hex-float "0x1.5bd78c9335899p+1021")) + (complex (ext:parse-hex-float "-0x1.423c6ce00c73bp-710") + (ext:parse-hex-float "0x1.d9edcf45bcb0ep-708")) 52)) (define-test complex-division.misc View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/e1f841fbe5641e473bca8a… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/e1f841fbe5641e473bca8a… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-474-print-parse-hex-floats] Address review comments for inf and nan outputs
by Raymond Toy (＠rtoy) 25 Feb '26

25 Feb '26

Raymond Toy pushed to branch issue-474-print-parse-hex-floats at cmucl / cmucl Commits: ffe5ccd2 by Raymond Toy at 2026-02-25T07:52:09-08:00 Address review comments for inf and nan outputs Instead of printing "inf" and "nan", print "0x1.0p+inf" and "0x0.0p+nan" instead, as suggested. - - - - - 1 changed file: - src/code/ext-code.lisp Changes: ===================================== src/code/ext-code.lisp ===================================== @@ -30,9 +30,13 @@ (defun float-to-hex-string (val &optional at-p) "Prints a single or double float in bit-perfect C-style hex. If AT-P is true, prepends '+' for non-negative finite values." - (cond ((ext:float-nan-p val) "nan") + (cond ((ext:float-nan-p val) + "0x0.0p+nan") ((ext:float-infinity-p val) - (if (plusp val) (if at-p "+inf" "inf") "-inf")) + (if (plusp val) + (if at-p + "+0x1.0p+inf" "0x1.0p+inf") + "-0x1.0p+inf")) (t (multiple-value-bind (sign exp-bits mantissa bias precision suffix) (typecase val View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ffe5ccd2e2e5a36d5a97eb4… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/ffe5ccd2e2e5a36d5a97eb4… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-435-add-core-math-compile-code] Undo changes to lisp_cosh and lisp_expm1
by Raymond Toy (＠rtoy) 25 Feb '26

25 Feb '26

Raymond Toy pushed to branch issue-435-add-core-math-compile-code at cmucl / cmucl Commits: 993d1907 by Raymond Toy at 2026-02-24T18:42:57-08:00 Undo changes to lisp_cosh and lisp_expm1 Accidentally let some stuff in. - - - - - 1 changed file: - src/lisp/irrat.c Changes: ===================================== src/lisp/irrat.c ===================================== @@ -163,8 +163,6 @@ double lisp_cosh(double x) { #ifdef FEATURE_CORE_MATH - MAYBE_SIGNAL_OVERFLOW(fabs(x)) - return cr_cosh(x); #else return __ieee754_cosh(x); @@ -308,10 +306,6 @@ double lisp_expm1(double x) { #ifdef FEATURE_CORE_MATH - if (isinf(x) == 1) { - return fdlibm_setexception(x, FDLIBM_OVERFLOW); - } - return cr_expm1(x); #else return fdlibm_expm1(x); View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/993d19072a51e7a2186a25a… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/993d19072a51e7a2186a25a… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0