Optimize bigfloat memory usage by sharing headers

Bigfloats now share their header (CAR), like other expressions already do via
EQTEST and SIMPIND. New headers are created only when precision changes.

This reduces memory usage and slightly improves bigfloat computation speed.

Bigfloats could already share their CDR (mantissa and exponent) in certain cases.
For example, computing bfloat(1)^0 twice results in bigfloats with the same CDR
object (EQ). Thus, destructive modification of bigfloats was already problematic
before this change, countering concerns that this might introduce risks.

Richard Fateman commented that destructively modifying bigfloat headers is not
something he would have done in the original code, and that he doubts anyone
would have added such code.

Author: TomasRiker

share/numeric/decfp-core.lisp

@@ -268,6 +268,19 @@ is (sum+1/10^50=1.0L0) ;  should be true
 	  (scale-float mantissa e))))
     ))
 
+(defvar *decbfloat-header* nil
+  "Current header ('BIGFLOAT 'SIMP $FPPREC 'DECIMAL) for new decimal bigfloats")
+
+(defvar *decbfloat-header-prec* nil
+  "Precision of current bigfloat header")
+
+(defun decbcons (s)
+  (unless (eql $fpprec *decbfloat-header-prec*)
+    ;; Precision was changed, make a new header.
+    (setq *decbfloat-header* `(bigfloat simp ,$fpprec decimal)
+          *decbfloat-header-prec* $fpprec))
+  (cons *decbfloat-header* s))
+
 (defun decbcons (s)
   `((bigfloat simp ,$fpprec decimal) . ,(decimalfptrim s)))
 

src/float.lisp

@@ -712,8 +712,18 @@
 ;; always be a positive power of 2, this number will not always be in lowest
 ;; terms.
 
+(defvar *bfloat-header* nil
+  "Current header ('BIGFLOAT 'SIMP FPPREC) for new bigfloats")
+
+(defvar *bfloat-header-prec* nil
+  "Precision of current bigfloat header")
+
 (defun bcons (s)
-  `((bigfloat simp ,fpprec) . ,s))
+  (unless (eql fpprec *bfloat-header-prec*)
+    ;; Precision was changed, make a new header.
+    (setq *bfloat-header* `(bigfloat simp ,fpprec)
+          *bfloat-header-prec* fpprec))
+  (cons *bfloat-header* s))
 
 (defmfun ($bfloat :properties ((evfun t))) (x)
   (let (y)