summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorCharles Zhang <charleszhang99@yahoo.com>2024-04-23 00:53:00 +0200
committerCharles Zhang <charleszhang99@yahoo.com>2024-04-23 21:18:51 +0200
commit6401acf1897b7f37badc7c0f2a5d767c61764ae1 (patch)
tree6c0469c775c7c3837296eb6875d0d506e4510579 /src
parent35e793f74f9d9ae8dbd7677525e7c7d58933c2de (diff)
Simplify printing and reading of cross-floats.
With the new portable implementation of xfloats, the journal files created are much smaller than in the past, and read in full less often. Therefore, it doesn't make as much sense to compress the constructors, so define the print-object methods more simply (which saves time on printing).
Diffstat (limited to 'src')
-rw-r--r--src/code/cross-early.lisp17
-rw-r--r--src/code/cross-float.lisp42
2 files changed, 22 insertions, 37 deletions
diff --git a/src/code/cross-early.lisp b/src/code/cross-early.lisp
index 068566ee2..9886991ad 100644
--- a/src/code/cross-early.lisp
+++ b/src/code/cross-early.lisp
@@ -43,6 +43,10 @@
(format 'single-float)
(bits (error "unspecified %BITS") :type (signed-byte 32)))
(:constructor %make-single-flonum (bits))))
+
+(defmethod print-object ((obj single-float) stream)
+ (format stream "#.(MAKE-SINGLE-FLOAT #x~x)" (single-float-bits obj)))
+
(defun %single-bits-from (sign exponent mantissa)
(declare (type bit sign)
(type (unsigned-byte 8) exponent)
@@ -59,6 +63,12 @@
(format 'double-float)
(bits (error "unspecifier %BITS") :type (signed-byte 64)))
(:constructor %make-double-flonum (bits))))
+
+(defmethod print-object ((obj double-float) stream)
+ (format stream "#.(MAKE-DOUBLE-FLOAT #x~x #x~x)"
+ (double-float-high-bits obj)
+ (double-float-low-bits obj)))
+
(defun %double-bits-from (sign exponent mantissa)
(declare (type bit sign)
(type (unsigned-byte 11) exponent)
@@ -152,6 +162,13 @@
(real nil :type real :read-only t)
(imag nil :type real :read-only t))
+(defmethod print-object ((obj complexnum) stream)
+ (write-string "#.(COMPLEX " stream)
+ (prin1 (complexnum-real obj) stream)
+ (write-char #\Space stream)
+ (prin1 (complexnum-imag obj) stream)
+ (write-char #\) stream))
+
(defun complex-single-float-p (x)
(and (complexp x) (single-float-p (complexnum-real x))))
(defun complex-double-float-p (x)
diff --git a/src/code/cross-float.lisp b/src/code/cross-float.lisp
index 4e9dac6f2..83f9d5512 100644
--- a/src/code/cross-float.lisp
+++ b/src/code/cross-float.lisp
@@ -14,35 +14,6 @@
(in-package "SB-IMPL")
(eval-when (:compile-toplevel :load-toplevel :execute)
-;;; This choice exists because cold-init reads from "output/sxhash-calls.lisp-expr"
-;;; using the ordinary definition of "#." which has to call the function at the car
-;;; of a list; but warm.lisp uses a purpose-made #. reader that handles only 2
-;;; symbols, reducing the size of xfloat-math.lisp-expr by abbreviating the float
-;;; constructors to single-character symbols.
-(defvar *proxy-sfloat-ctor* "MAKE-SINGLE-FLOAT")
-(defvar *proxy-dfloat-ctor* "MAKE-DOUBLE-FLOAT")
-(labels
- ((stringify (bits) (if (= bits 0) 0 (format nil "#x~x" bits)))
- (output-part (x stream)
- (typecase x
- (single-float
- (format stream "(~A ~A)" *proxy-sfloat-ctor* (stringify (single-float-bits x))))
- (double-float
- (format stream "(~A ~A ~A)" *proxy-dfloat-ctor*
- (stringify (double-float-high-bits x))
- (stringify (double-float-low-bits x))))
- (rational
- (prin1 x stream)))))
- (defmethod print-object ((self float) stream)
- (write-string "#." stream)
- (output-part self stream))
-
- (defmethod print-object ((self complexnum) stream)
- (write-string "#.(COMPLEX " stream)
- (output-part (complexnum-real self) stream)
- (write-char #\Space stream)
- (output-part (complexnum-imag self) stream)
- (write-char #\) stream)))
;;; To ensure that target numbers compare by EQL correctly under the host's
;;; definition of EQL (so that we don't have to intercept it and all else
@@ -100,11 +71,10 @@
;; Ensure that we're reading the correct variant of the file
;; in case there is more than one set of floating-point formats.
(assert (eq (read stream) :default))
- (let ((pkg (make-package "SB-FLOAT-MATH-GENIE" :use '("CL")))
+ (let ((pkg (make-package "SB-FLOAT-GENIE" :use '("CL")))
(line 0))
- (loop for (alias . actual) in '(("S" . sb-kernel:make-single-float)
- ("D" . sb-kernel:make-double-float))
- do (setf (fdefinition (intern alias pkg)) (fdefinition actual)))
+ (import 'make-single-float pkg)
+ (import 'make-double-float pkg)
(unwind-protect
(dolist (expr (let ((*package* pkg)) (read stream)))
(incf line)
@@ -865,10 +835,8 @@
;; Record each <fun,args> combination to STREAM
;; Though all symbols we print, such as SINGLE-FLOAT, are accessible
;; in any of the SB- packages, ABCL would buggily output package prefixes
- ;; if ~S is used here. The intent is to use only SBCL as host to compute
- ;; the table, since we assume that everybody's math routines suck.
- ;; But anyway, this does seem to work in most other lisps.
- (let ((*print-pretty* nil) (*proxy-sfloat-ctor* "S") (*proxy-dfloat-ctor* "D"))
+ ;; if ~S is used here.
+ (let ((*print-pretty* nil))
(maphash (lambda (key result)
(destructuring-bind (fun . args) key
(format stream "(~A ~A~{ ~A~})~%"