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

[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

[Git][cmucl/cmucl][issue-435-add-core-math-compile-code] 2 commits: Merge branch 'issue-435-add-core-math-compile-code' into 'master'
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: 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 - - - - - f2f15905 by Raymond Toy at 2026-02-24T18:35:58-08:00 Address #435: Compile single-float core-math routines Update config files and Makefiles to include the single-float core-math routines. Add interfaces to the routines in irrat.c. This verifies that we have included everything and it compiles. The lisp interface hasn't been updated, so none of these get called. - - - - - 3 changed files: - src/lisp/Config.x86_common - src/lisp/GNUmakefile - src/lisp/irrat.c Changes: ===================================== src/lisp/Config.x86_common ===================================== @@ -65,6 +65,34 @@ CORE64_SRCS=\ $(CORE_MATH_64)/log1p/log1p.c \ $(CORE_MATH_64)/expm1/expm1.c \ $(CORE_MATH_64)/sincos/sincos.c + +CORE_MATH_32=core-math/src/binary32 +CORE32_SRCS=\ + $(CORE_MATH_32)/sin/sinf.c \ + $(CORE_MATH_32)/cos/cosf.c \ + $(CORE_MATH_32)/tan/tanf.c \ + $(CORE_MATH_32)/atan2/atan2f.c \ + $(CORE_MATH_32)/asin/asinf.c \ + $(CORE_MATH_32)/acos/acosf.c \ + $(CORE_MATH_32)/atan/atanf.c \ + $(CORE_MATH_32)/sinh/sinhf.c \ + $(CORE_MATH_32)/cosh/coshf.c \ + $(CORE_MATH_32)/tanh/tanhf.c \ + $(CORE_MATH_32)/asinh/asinhf.c \ + $(CORE_MATH_32)/acosh/acoshf.c \ + $(CORE_MATH_32)/atanh/atanhf.c \ + $(CORE_MATH_32)/exp/expf.c \ + $(CORE_MATH_32)/log/logf.c \ + $(CORE_MATH_32)/log10/log10f.c \ + $(CORE_MATH_32)/log2/log2f.c \ + $(CORE_MATH_32)/pow/powf.c \ + $(CORE_MATH_32)/hypot/hypotf.c \ + $(CORE_MATH_32)/log1p/log1pf.c \ + $(CORE_MATH_32)/expm1/expm1f.c \ + $(CORE_MATH_32)/sincos/sincosf.c + +CORE_MATH_SRCS = $(CORE64_SRCS) $(CORE32_SRCS) + endif ifeq ($(filter 2% 3%, $(shell $(CC) -dumpversion)),) ===================================== src/lisp/GNUmakefile ===================================== @@ -36,7 +36,7 @@ SRCS = lisp.c coreparse.c alloc.c monitor.c print.c interr.c \ dynbind.c breakpoint.c regnames.c backtrace.c save.c purify.c \ runprog.c time.c case-mapping.c exec-init.c \ irrat.c \ - ${CORE64_SRCS} \ + ${CORE_MATH_SRCS} \ ${FDLIBM} ${ARCH_SRC} ${ASSEM_SRC} ${OS_SRC} ${GC_SRC} ===================================== src/lisp/irrat.c ===================================== @@ -32,6 +32,28 @@ extern double cr_hypot(double, double); extern double cr_log1p(double); extern double cr_expm1(double); extern void cr_sincos(double, double *, double *); + +extern float cr_sinf(float); +extern float cr_cosf(float); +extern float cr_tanf(float); +extern float cr_atanf(float); +extern float cr_atan2f(float, float); +extern float cr_asinf(float); +extern float cr_acosf(float); +extern float cr_sinhf(float); +extern float cr_coshf(float); +extern float cr_tanhf(float); +extern float cr_asinhf(float); +extern float cr_acoshf(float); +extern float cr_atanhf(float); +extern float cr_expf(float); +extern float cr_logf(float); +extern float cr_log10f(float); +extern float cr_powf(float, float); +extern float cr_hypotf(float, float); +extern float cr_log1pf(float); +extern float cr_expm1f(float); +extern void cr_sincosf(float, float *, float *); #endif @@ -141,6 +163,8 @@ double lisp_cosh(double x) { #ifdef FEATURE_CORE_MATH + MAYBE_SIGNAL_OVERFLOW(fabs(x)) + return cr_cosh(x); #else return __ieee754_cosh(x); @@ -284,6 +308,10 @@ 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); @@ -297,7 +325,7 @@ lisp_scalbn(double x, int n) } void -lisp_sincos (double x, double *s, double *c) +lisp_sincos(double x, double *s, double *c) { #ifdef FEATURE_CORE_MATH cr_sincos(x, s, c); @@ -307,3 +335,236 @@ lisp_sincos (double x, double *s, double *c) cmucl_sincos(x, s, c); #endif } + +/* + * The single-float versions of the special functions. When core-math + * is set, we use the single-float core-math functions. Otherwise, we + * use the double-float versions from fdlibm, with appropriate + * coercions. + */ +float +lisp_sinf(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_sinf(x); +#else + return (float) fdlibm_sin((double) x); +#endif +} + +float +lisp_cosf(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_cosf(x); +#else + return (float) fdlibm_cos((double) x); +#endif +} + +float +lisp_tanf(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_tanf(x); +#else + return (float) fdlibm_tan((double) x); +#endif +} + +float +lisp_atanf(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_atanf(x); +#else + return (float) fdlibm_atan((double) x); +#endif +} + +float +lisp_atan2f(float y, float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_atan2f(y, x); +#else + return (float) __ieee754_atan2((double) y, (double) x); +#endif +} + +float +lisp_asinf(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_asinf(x); +#else + return (float) __ieee754_asin((double) x); +#endif +} + +float +lisp_acosf(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_acosf(x); +#else + return (float) __ieee754_acos((double) x); +#endif +} + +float +lisp_sinhf(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_sinhf(x); +#else + return (float) __ieee754_sinh((double) x); +#endif +} + +float +lisp_coshf(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_coshf(x); +#else + return (float) __ieee754_cosh((double) x); +#endif +} + +float +lisp_tanhf(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_tanhf(x); +#else + return (float) fdlibm_tanh((double) x); +#endif +} + +float +lisp_asinhf(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_asinhf(x); +#else + return (float) fdlibm_asinh((double) x); +#endif +} + +float +lisp_acoshf(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_acoshf(x); +#else + return (float) __ieee754_acosh((double) x); +#endif +} + +float +lisp_atanhf(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_atanhf(x); +#else + return (float) __ieee754_atanh((double) x); +#endif +} + +float +lisp_expf(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_expf(x); +#else + return (float) __ieee754_exp((double) x); +#endif +} + +float +lisp_logf(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_logf(x); +#else + return (float) __ieee754_log((double) x); +#endif +} + +float +lisp_log10f(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_log10f(x); +#else + return (float) __ieee754_log10((double) x); +#endif +} + +float +lisp_powf(float x, float y) +{ +#ifdef FEATURE_CORE_MATH + /* + * cr_pow when compiled with older versions of gcc or clang can + * cause failures in the ansi-tests [#469]. Ubuntu 25.10 and Fedora 41 + * (gcc only) are known to have compilers that work well enough + * that the ansi-tests pass. + */ + return cr_powf(x, y); +#else + /* + * cr_pow seems causes ansi-tests to fail in test WRITE.1 among + * others. Somewhere an invalid operation is occurring. Thus + * just use fdlibm for now until we can figure out what's causing + * the failure. + */ + return (float) __ieee754_pow((double) x, (double) y); +#endif +} + +float +lisp_hypotf(float x, float y) +{ +#ifdef FEATURE_CORE_MATH + return cr_hypotf(x, y); +#else + return (float) __ieee754_hypot((double) x, (double) y); +#endif +} + +float +lisp_log1pf(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_log1pf(x); +#else + return (float) fdlibm_log1p((double) x); +#endif +} + +float +lisp_expm1f(float x) +{ +#ifdef FEATURE_CORE_MATH + return cr_expm1f(x); +#else + return (float) fdlibm_expm1((double) x); +#endif +} + +void +lisp_sincosf(float x, float *s, float *c) +{ +#ifdef FEATURE_CORE_MATH + cr_sincosf(x, s, c); +#else + extern void cmucl_sincos(double, double*, double*); + double ds, dc; + + cmucl_sincos((double) x, &ds, &dc); + *s = (float) ds; + *c = (float) dc; +#endif +} View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1b1e639bf08e9e6c9b4555… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/1b1e639bf08e9e6c9b4555… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Forgot to add log1pf.c
by Raymond Toy (＠rtoy) 25 Feb '26

25 Feb '26

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 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 - - - - - 1 changed file: - + src/lisp/core-math/src/binary32/log1p/log1pf.c Changes: ===================================== src/lisp/core-math/src/binary32/log1p/log1pf.c ===================================== @@ -0,0 +1,141 @@ +/* Correctly-rounded biased argument natural logarithm function for binary32 value. + +Copyright (c) 2023-2025 Alexei Sibidanov. + +This file is part of the CORE-MATH project +(https://core-math.gitlabpages.inria.fr/). + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. +*/ + +#include <stdint.h> +#include <errno.h> + +// Warning: clang also defines __GNUC__ +#if defined(__GNUC__) && !defined(__clang__) +#pragma GCC diagnostic ignored "-Wunknown-pragmas" +#endif + +#pragma STDC FENV_ACCESS ON + +typedef union {float f; uint32_t u;} b32u32_u; +typedef union {double f; uint64_t u;} b64u64_u; + +static __attribute__((noinline)) float as_special(float x){ + b32u32_u t = {.f = x}; + if(t.u==0xbf800000u){// +0.0 +#ifdef CORE_MATH_SUPPORT_ERRNO + errno = ERANGE; +#endif + return -1.0f/0.0f; // to raise FE_DIVBYZERO + } + if(t.u == 0x7f800000u) return x; // +inf + uint32_t ax = t.u<<1; + if(ax > 0xff000000u) return x + x; // nan +#ifdef CORE_MATH_SUPPORT_ERRNO + errno = EDOM; +#endif + return 0.0f/0.0f; // to raise FE_INVALID +} + +float cr_log1pf(float x) { + static const double x0[] = { + 0x1.f81f82p-1, 0x1.e9131acp-1, 0x1.dae6077p-1, 0x1.cd85689p-1, 0x1.c0e0704p-1, 0x1.b4e81b5p-1, + 0x1.a98ef6p-1, 0x1.9ec8e95p-1, 0x1.948b0fdp-1, 0x1.8acb90fp-1, 0x1.8181818p-1, 0x1.78a4c81p-1, + 0x1.702e05cp-1, 0x1.6816817p-1, 0x1.605816p-1, 0x1.58ed231p-1, 0x1.51d07ebp-1, 0x1.4afd6ap-1, + 0x1.446f865p-1, 0x1.3e22cbdp-1, 0x1.3813814p-1, 0x1.323e34ap-1, 0x1.2c9fb4ep-1, 0x1.27350b9p-1, + 0x1.21fb781p-1, 0x1.1cf06aep-1, 0x1.1811812p-1, 0x1.135c811p-1, 0x1.0ecf56cp-1, 0x1.0a6810ap-1, + 0x1.0624dd3p-1, 0x1.0204081p-1}; + static const double lixb[] = { + 0x1.fc0a8909b4218p-7, 0x1.77458f51aac89p-5, 0x1.341d793afb997p-4, 0x1.a926d3a5ebd2ap-4, + 0x1.0d77e7a8a823dp-3, 0x1.44d2b6c557102p-3, 0x1.7ab89040accecp-3, 0x1.af3c94ecab3d6p-3, + 0x1.e27076d54e6c9p-3, 0x1.0a324e3888ad5p-2, 0x1.22941fc0c7357p-2, 0x1.3a64c56ae3fdbp-2, + 0x1.51aad874af21fp-2, 0x1.686c81d300eap-2, 0x1.7eaf83c7fa9b5p-2, 0x1.947941aa610ecp-2, + 0x1.a9cec9a3f023bp-2, 0x1.beb4d9ea4156ep-2, 0x1.d32fe7f35e5c7p-2, 0x1.e7442617b817ap-2, + 0x1.faf588dd5ed1p-2, 0x1.0723e5c635c39p-1, 0x1.109f39d53c99p-1, 0x1.19ee6b38a4668p-1, + 0x1.23130d7f93c3bp-1, 0x1.2c0e9ec9b0b85p-1, 0x1.34e289cb35eccp-1, 0x1.3d9026ad3d3f3p-1, + 0x1.4618bc1eadbbbp-1, 0x1.4e7d8127dd8a9p-1, 0x1.56bf9d5967092p-1, 0x1.5ee02a926936ep-1}; + static const double lix[] = { + 0x1.fc0a890fc03e4p-7, 0x1.77458f532dcfcp-5, 0x1.341d793bbd1d1p-4, 0x1.a926d3a6ad563p-4, + 0x1.0d77e7a908e59p-3, 0x1.44d2b6c5b7d1ep-3, 0x1.7ab890410d909p-3, 0x1.af3c94ed0bff3p-3, + 0x1.e27076d5af2e6p-3, 0x1.0a324e38b90e3p-2, 0x1.22941fc0f7966p-2, 0x1.3a64c56b145eap-2, + 0x1.51aad874df82dp-2, 0x1.686c81d3314afp-2, 0x1.7eaf83c82afc3p-2, 0x1.947941aa916fbp-2, + 0x1.a9cec9a42084ap-2, 0x1.beb4d9ea71b7cp-2, 0x1.d32fe7f38ebd5p-2, 0x1.e7442617e8788p-2, + 0x1.faf588dd8f31fp-2, 0x1.0723e5c64df4p-1, 0x1.109f39d554c97p-1, 0x1.19ee6b38bc96fp-1, + 0x1.23130d7fabf43p-1, 0x1.2c0e9ec9c8e8cp-1, 0x1.34e289cb4e1d3p-1, 0x1.3d9026ad556fbp-1, + 0x1.4618bc1ec5ec2p-1, 0x1.4e7d8127f5bb1p-1, 0x1.56bf9d597f399p-1, 0x1.5ee02a9281675p-1}; + static const double b[] = + {0x1p+0, -0x1p-1, 0x1.5555555556f6bp-2, -0x1.00000000029b9p-2, + 0x1.9999988d176e4p-3, -0x1.55555418889a7p-3, 0x1.24adeca50e2bcp-3, -0x1.001ba33bf57cfp-3}; + + double z = x; + b32u32_u t = {.f = x}; + uint32_t ux = t.u, ax = ux&(~0u>>1); + if(__builtin_expect(ax<0x3c880000u, 1)){ // |x| < 0x1.1p-6 + if(__builtin_expect(ax<0x33000000u, 0)){ // |x| < 0x1p-25 + if(!ax) return x; + float res = __builtin_fmaf(x,-x,x); +#ifdef CORE_MATH_SUPPORT_ERRNO + /* log1p(x) underflows exactly when |res| < 2^-126 + and for x=-0x1.fffffcp-127 and rounding downwards */ + if (__builtin_fabsf (res) < 0x1p-126f || + (x == -0x1.fffffcp-127f && res == -0x1p-126f)) + errno = ERANGE; // underflow +#endif + return res; + } + double z2 = z*z, z4 = z2*z2; + double f = z2*((b[1] + z*b[2]) + z2*(b[3] + z*b[4]) + z4*((b[5] + z*b[6]) + z2*b[7])); + b64u64_u r = {.f = z + f}; + if(__builtin_expect((r.u&0xfffffffll) == 0, 0)) r.f += 0x1p14*(f + (z - r.f)); + return r.f; + } else { + if(__builtin_expect(ux>=0xbf800000u||ax>=0x7f800000u, 0)) return as_special(x); + b64u64_u tp = {.f = z + 1}; + int e = tp.u>>52; + uint64_t m52 = tp.u&(~(uint64_t)0>>12); + unsigned j = (tp.u >> (52-5))&31; + e -= 0x3ff; + b64u64_u xd = {.u = m52 | ((uint64_t)0x3ff<<52)}; + z = xd.f*x0[j] - 1; + static const double c[] = + {-0x1.3902c33434e7fp-43, 0x1.ffffffe1cbed5p-1, -0x1.ffffff7d1b014p-2, 0x1.5564e0ed3613ap-2, -0x1.0012232a00d4ap-2}; + const double ln2 = 0x1.62e42fefa39efp-1; + double z2 = z*z, r = (ln2*e + lixb[j]) + z*((c[1] + z*c[2]) + z2*(c[3] + z*c[4])); + float ub = r, lb = r + 2.2e-11; + if(__builtin_expect(ub != lb, 0)){ + double z4 = z2*z2, f = z*((b[0] + z*b[1]) + z2*(b[2] + z*b[3]) + z4*((b[4] + z*b[5]) + z2*(b[6] + z*b[7]))); + const double ln2l = 0x1.7f7d1cf79abcap-20, ln2h = 0x1.62e4p-1; + double Lh = ln2h * e, Ll = ln2l * e, rl = f + Ll + lix[j]; + b64u64_u tr = {.f = rl + Lh}; + if(__builtin_expect((tr.u&0xfffffffll) == 0 , 0)){ + if(x==-0x1.247ab0p-6) return -0x1.271f0ep-6f - 0x1p-31f; + if(x==-0x1.3a415ep-5) return -0x1.407112p-5f + 0x1p-30f; + if(x== 0x1.fb035ap-2) return 0x1.9bddc2p-2f + 0x1p-27f; + tr.f += 64*(rl + (Lh - tr.f)); + } else if(rl+(Lh-tr.f)==0.0){ + if(x== 0x1.b7fd86p-4) return 0x1.a1ece2p-4f + 0x1p-29f; + if(x==-0x1.3a415ep-5) return -0x1.407112p-5f + 0x1p-30f; + if(x== 0x1.43c7e2p-6) return 0x1.409f80p-6f + 0x1p-31f; + } + ub = tr.f; + } + return ub; + } +} View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/c430d75d10ac4715177157… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/c430d75d10ac4715177157… 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-compile-code
by Raymond Toy (＠rtoy) 25 Feb '26

25 Feb '26

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

1 0

[Git][cmucl/cmucl][master] 2 commits: Address #435: Add single-float core-math routines
by Raymond Toy (＠rtoy) 25 Feb '26

25 Feb '26

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 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 - - - - - 26 changed files: - + 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/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 The diff was not included because it is too large. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/3434a96310bce31753072e… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/3434a96310bce31753072e… 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-code-only
by Raymond Toy (＠rtoy) 25 Feb '26

25 Feb '26

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

1 0