From c56c21aeb00a4bcce8887cabbc1a2ff1fc55f15c Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 29 Sep 2024 09:19:50 -0600 Subject: [PATCH] adjust `|` parsing for very large precision requests Avoiding running out of memory for a very large precision request when the number with adjusted precision should take about as much memory as the number without an adjustment. --- mats/5_3.ms | 20 +++++++++++++++++++- s/strnum.ss | 25 +++++++++++++++++++++---- 2 files changed, 40 insertions(+), 5 deletions(-) diff --git a/mats/5_3.ms b/mats/5_3.ms index 068e57681..cd70980f8 100644 --- a/mats/5_3.ms +++ b/mats/5_3.ms @@ -140,15 +140,33 @@ (< -.039 -.038413 -.038) ; non-empty mantissa widths (eqv? #e0.1|1 1/8) + (eqv? 0.1|1 0.125) (eqv? 77|1 64.0) (eqv? 12|0 0.0) + (eqv? #e12|0 0) (eqv? 9|3 8.0) (eqv? -10|3 -10.0) (eqv? #e99999999999999983222784|54 99999999999999983222784) (eqv? #e99999999999999983222784|53 99999999999999991611392) (eqv? #e99999999999999983222783|54 99999999999999983222784) (eqv? #e99999999999999983222783|53 99999999999999974834176) -) + (eqv? 1000 (integer-length (numerator #e1.2345678901234567891012345|1000))) + (eqv? 1000 (integer-length (denominator #e1.2345678901234567891012345|1000))) + (eqv? 10000 (integer-length (numerator #e1.2345678901234567891012345|10000))) + (eqv? 10000 (integer-length (denominator #e1.2345678901234567891012345|10000))) +; don't run out of memory unnecessarily + (eqv? #e1234567|100000000000000000 1234567) + (eqv? #i1.234567|100000000000000000 1.234567) + (eqv? 1.234567|100000000000000000 1.234567) + (eqv? 1.234567e300|100000000000000000 1.234567e300) + (eqv? 0.1|100000000000000000 0.1|100) + (eqv? 0.3|100000000000000000 0.3|53) + (not (eqv? 0.3|52 0.3|53)) ; confirm boundary + (eqv? 0.3e300|100000000000000000 0.3e300|50) + (not (eqv? 0.3e300|50 0.3e300|49)) + (eqv? #e0.3e300|1000000000000000 #e0.3e300) + (eqv? #e0.3e300|696 #e0.3e300) + (not (eqv? #e0.3e300|695 #e0.3e300))) (mat string->number ; error cases diff --git a/s/strnum.ss b/s/strnum.ss index 680030fec..1c7a13a32 100644 --- a/s/strnum.ss +++ b/s/strnum.ss @@ -204,13 +204,30 @@ an exception. (define noround (lambda (x) x)) (define rounder - (lambda (p) + (lambda (p ex) (if (zero? p) (lambda (n) 0) (lambda (n) (let ([a (numerator n)] [b (denominator n)]) - (let ([d (- (bitwise-length a) (bitwise-length b))]) + (let* ([a-bits (bitwise-length a)] + [b-bits (bitwise-length b)] + [d (- a-bits b-bits)] + ;; If `p` is large, we might run out of memory by + ;; shifting by it directly, but in some cases, the right + ;; result should fit into memory no matter how big `p` is. + [p (cond + [(not (eq? ex 'e)) + ;; end result will have at most 53 bits, anyway, so + ;; bound p; we don't need a tight bound, and adding 2 + ;; extra bits over `double` precision to make sure + ;; rounding will be right + (min p (+ (max a-bits b-bits) 53 2))] + [(= b (bitwise-arithmetic-shift-left 1 (- b-bits 1))) + ;; no need for extra precision if the + ;; denominator is a power of 2 + (min p (+ a-bits b-bits))] + [else p])]) (let*-values ([(a b) (if (positive? d) @@ -476,9 +493,9 @@ an exception. [(digit 10) (mwidth1 r ex ms d x)]) (mknum-state mwidth1 (r ex ms mw x) ; saw digit after vertical bar - (finish-number ms ex x1 (x (rounder mw))) + (finish-number ms ex x1 (x (rounder mw ex))) [(digit 10) (mwidth1 r ex ms (+ (* 10 mw) d) x)] - [else (complex0 r ex ms (x (rounder mw)))]) + [else (complex0 r ex ms (x (rounder mw ex)))]) (mknum-state complex0 (r ex ms x) ; saw end of real part before end of string (assert #f) ; should arrive here only from else clauses, thus not at the end of the string