b3b5d81c2a
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=71891 says the issue was fixed in aff9ac968840e9c86719fb613bd2ed3c39b9905c, but to avoid conflicts (which I don't know how to resolve, not knowing scheme), also pull in 5e6288c9304b60f1875a44808ee3858e3d6efc83 0dab58fc2a6ac6a8354439749d598f8c24f57ddd and e45b70dcded37eb77e71ec30445b12040b6bb1b7.
57 lines
2.2 KiB
Diff
57 lines
2.2 KiB
Diff
From e45b70dcded37eb77e71ec30445b12040b6bb1b7 Mon Sep 17 00:00:00 2001
|
|
From: Andy Wingo <wingo@pobox.com>
|
|
Date: Wed, 25 Sep 2024 17:24:51 +0200
|
|
Subject: [PATCH] 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.
|
|
---
|
|
module/language/cps/specialize-numbers.scm | 21 ++++++++++++++++++++-
|
|
1 file changed, 20 insertions(+), 1 deletion(-)
|
|
|
|
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)
|
|
|
|
--
|
|
2.34.1
|
|
|