diff options
author | Andy Wingo <wingo@pobox.com> | 2024-09-25 17:24:51 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2024-09-25 17:24:51 +0200 |
commit | e45b70dcded37eb77e71ec30445b12040b6bb1b7 (patch) | |
tree | 861c5cde1e658fd943d61fe7917dc1ac1249dbbf | |
parent | 0dab58fc2a6ac6a8354439749d598f8c24f57ddd (diff) | |
download | guile-e45b70dcded37eb77e71ec30445b12040b6bb1b7.tar.gz |
Fix boxing of non-fixnum negative u64 values
* module/language/cps/specialize-numbers.scm (u64->fixnum/truncate): New
helper.
(specialize-operations): Fix specialized boxing of u64 values to
truncate possibly-negative values, to avoid confusing CSE. Fixes
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=71891.
-rw-r--r-- | module/language/cps/specialize-numbers.scm | 21 |
1 files changed, 20 insertions, 1 deletions
diff --git a/module/language/cps/specialize-numbers.scm b/module/language/cps/specialize-numbers.scm index f70c28e08..b46919a40 100644 --- a/module/language/cps/specialize-numbers.scm +++ b/module/language/cps/specialize-numbers.scm @@ -115,6 +115,13 @@ (letk ks64 ($kargs ('s64) (s64) ,tag-body)) (build-term ($continue ks64 src ($primcall 'u64->s64 #f (u64)))))) +(define (u64->fixnum/truncate cps k src u64 bits) + (with-cps cps + (letv truncated) + (let$ tag-body (u64->fixnum k src truncated)) + (letk ku64 ($kargs ('truncated) (truncated) ,tag-body)) + (build-term + ($continue ku64 src ($primcall 'ulogand/immediate bits (u64)))))) (define-simple-primcall scm->u64) (define-simple-primcall scm->u64/truncate) (define-simple-primcall u64->scm) @@ -473,7 +480,19 @@ BITS indicating the significant bits needed for a variable. BITS may be (define (box-s64 result) (if (fixnum-result? result) tag-fixnum s64->scm)) (define (box-u64 result) - (if (fixnum-result? result) u64->fixnum u64->scm)) + (call-with-values + (lambda () + (lookup-post-type types label result 0)) + (lambda (type min max) + (cond + ((and (type<=? type &exact-integer) + (<= 0 min max (target-most-positive-fixnum))) + u64->fixnum) + ((only-fixnum-bits-used? result) + (lambda (cps k src u64) + (u64->fixnum/truncate cps k src u64 (intmap-ref sigbits result)))) + (else + u64->scm))))) (define (box-f64 result) f64->scm) |