gentoo auto-resync : 19:10:2024 - 04:04:35

5 files changed, 544 insertions, 0 deletions

diff --git a/dev-scheme/Manifest.gz b/dev-scheme/Manifest.gz
index ebf96f5e8cfe..f8baff47279f 100644
--- a/dev-scheme/Manifest.gz
+++ b/dev-scheme/Manifest.gz
diff --git a/dev-scheme/guile/Manifest b/dev-scheme/guile/Manifest
index ddd4bae4f466..974d685487d6 100644
--- a/dev-scheme/guile/Manifest
+++ b/dev-scheme/guile/Manifest
@@ -11,6 +11,8 @@ AUX guile-1.8.8-tinfo.patch 450 BLAKE2B 0dcf1728e30034f1e612d666b07cdbf2147dbbe8
 AUX guile-2.2.3-gentoo-sandbox.patch 361 BLAKE2B 997d4cec108f302f34b42c59c78d420c858f964b8587bed523d95fadedbf9981dd9c196934299413db9c23e940a4b88e798e4fff65cdea1507968494338313ba SHA512 450f44cbd2b3f0c7c02963c35e58e8d0e4a7192239993215b69713d8a1109692ab1e153efe685c27681069477a56e7bc52b34ebd8717a2c8695be8c6b8abe673
 AUX guile-2.2.7-fix-buggy-gnulib.patch 2813 BLAKE2B 9905f91b37fc8262ed508f8dd9507e9bb38704847f84ba0fc0b214f52b2359182d56b9a766ed31102d1d5c9d6ad852f6a3ca5976f032e77d536c2374448b242e SHA512 eea1f62f2e8ce3d476bba79d0d400c13d32e3ccd138db5f512788dfe08ddca234cfc83e8c2df7cf0252e958271e78d74cbb9632b3fc97f7f6fd1bacb6f1f5e54
 AUX guile-2.2.7-stack-up.patch 568 BLAKE2B 11f19c9e657b9b23c033e0edac9d06fcaa2f56f69230d526fc42eed6050022395599855015539c32ed83b6e3f5c8a94744ff6ef50b3c9284818d0d8f725f18b6 SHA512 f312e4e5d8d3781efb6fe65f4ec94431d8b19a7ac3e3e9e461748c60643088237e570314e74b5253418a01b129586465ed43107463d8de182e362393f75073bd
+AUX guile-3.0-fix-32bit-BE.patch 587 BLAKE2B 27e372f0bfdc9dc40c96d2cb7248f01dd5f769d8fdbb7558314814a903e04668ecab43de4198d6ee7f7a15345909e4a4bb20d38152e13174b01f024fddd760d9 SHA512 fa884aad07a00e3c224cc94f5cca1459690ea8085e30d68913de22fc8b4f094e389e2edaf8e432ec0a10d82e57e291503288868cf36064abd94b6004847066f1
+AUX guile-3.0.10-backport-issue72913.patch 17953 BLAKE2B 4fbdbc8ab51d39acadac5b181df43687f9913e60a1431ea8affbd66b1af1d8d55d39d9477086ca520ae455d9a03ec4a073e94b6dabf9cfdb7ced56f9d4ab7879 SHA512 3eac97a35fd6a86fab90c36730935d317e051e11cb20509521ad7e9e74713c7d844b5d23920491d0318ec4d84570cc036847c25a0d3404522b11fc6339af3799
 DIST guile-1.8.8.tar.gz 3956654 BLAKE2B 4820d635ac2c57526c0c03f3e0e6e4ac4276533ea8db15e6d1b759c33edec094a1a4bdc3e09ccae61f1b271d63565063746feea242a90c18cd575775444a42ef SHA512 ede6feb90cd419d8763feb8c5169275490a653919573c4dfced025b74cf591072b3a10ffb9a3f6ee3fe7b0a0956ffcf434e0859b421455c8349cea56bf427db0
 DIST guile-2.2.7.tar.xz 10881984 BLAKE2B e2b1fe7cb010371beaaf32f8f173397c90fd291ed7d5835b9d976f37fd133254841b4179bd1e1cd02e604c7befcab6c25f85d20ba0850f96978f7c32ca1fe6d8 SHA512 6f60b3489e26f5ff32b55c89316cdcdbf3ec1f4344726006e445f24098c922c50becdc748f1b66d2b271dc002e409ee6210bf85da779cee1f68c9111b3b5c543
 DIST guile-3.0.10.tar.xz 5802280 BLAKE2B 2b41f1afb282eb4672f5aca5b044f47a12509745f5580fc4a621e7555c8b884f92dc76bc78fbdf8a64d59cf1de65b230ce03b0a34bbcb77307a7c9453a277ac6 SHA512 8b58e6c70cd48af85a0b346fcdf488fd5ac8d8678181c9c469895bf6ddab909c415e471776fdcda3c234e00fae80bdd4518c17ff16cf8107a36d2990a4face1d
@@ -24,6 +26,7 @@ EBUILD guile-2.2.7-r102.ebuild 3258 BLAKE2B 9a9369724870cebce227610e9ae14b40e79a
 EBUILD guile-2.2.7-r2.ebuild 2300 BLAKE2B 5b8582730cab705ed219468469550ac73657008f6980752d5813955dbffb0955fbc74ad69da106b1e5d052cc553e3bce4a51a6c21bb9e65616b3b1ad895c54db SHA512 4109d875e65aa81601632f19b76e5bd83a6a34381cc28bb72a2217f3b47a1e81a752e4547ecbea0e4644b1323266067dae9703e0fde59b0a89fcb0133eeecfe2
 EBUILD guile-3.0.10-r100.ebuild 2481 BLAKE2B 4991446f833ef45ee944638af26500b5eb317c0e438c3e143590a7000906647da580e9ef91787d866c0476efece8e5e298e4ac47d0a08c3161c9c437aa8367a7 SHA512 fec6a49cbf2f22f8c80fe1e353114148ae2701bf98505d6266080125a678feb87b6884367ff467aca7103bfdda7db99f34948861d29fe31888676b0075954004
 EBUILD guile-3.0.10-r101.ebuild 3006 BLAKE2B fbfe8bb49fcd81933f6a610d014c838dcf186407afadb244a2046353bceac19021963db5d2658e73c5cefff5a6a6e1433fa388569d5781f9c4a5a41be13a86a7 SHA512 35a3d059f3a231e53fde545333bee56fb22d7ac261f2ca9f483e1dcd416ed6f95bac04beafca9a1cc2df01205b24c3f7e05554745fc2c23a247a3b62f0eea45b
+EBUILD guile-3.0.10-r102.ebuild 3259 BLAKE2B 4797fe23c7a6ed6be2e0516f3289afb68dc2aec7241118bf1bd94c0956806a1e6a9bf933a6caa6d667e091254a67c4e9a56fd1fee22d34e280f495557b1fee09 SHA512 d9e2378b4ac15a0e048c7b4427e92f8177a24bc362abdbfe8b2cc97c0b4b3f286d1ebb6ab43766a575bd5373fa6bd9e08be4f0fc09933d37d464b71e41d77034
 EBUILD guile-3.0.10.ebuild 2153 BLAKE2B 03c876db0a07d574bb0576129c366db97bff78eb3bd98e94d4e889c347109f61680eac1a4627847ba7954cae4acd5be96755a272b8f6463d6ad3f35477d8eeb6 SHA512 2dc8ca60d39c8839b4ebc5a7af7a92fe17423e8b2897415adc5089afc6646c5240f5cae2626907bb9ef8eae8c407c825560c429142c288db83f1ad45a24e5e8c
 EBUILD guile-3.0.9.ebuild 2151 BLAKE2B a2d3a1626657a2824201837ab46f86e280cb719bd5a14fc7afb2f1c8a09ed10d7d3039973d9d1788c1475cdd64bfd1ebef8fa55d1461ba9ac249033f789082c7 SHA512 5d41585f1dcc2560aa9af56b2023acbc232f6c3d8e757a6dcc44c4821c1e8bf20b72ad65975543a79271184e9c86d8331e9770963ff293208f7a63fcd3951392
 MISC metadata.xml 1423 BLAKE2B 1e1d2bc292338c5cab820a087f22fd4bd9517b85a6a1d52175cc666f329a2ce1f9cfcea6da01a02328395e15b0dbcb91e755fa8dde6709d1bbc47a0b34bb1e22 SHA512 013db66fb8ed106d739faad36c5b2014917526791839ea1e9bb9d4f588de666eb9a662dd5550be7f781a3346314d885742586ce9382d6745b3f7a9c1e9c37cc7
diff --git a/dev-scheme/guile/files/guile-3.0-fix-32bit-BE.patch b/dev-scheme/guile/files/guile-3.0-fix-32bit-BE.patch
new file mode 100644
index 000000000000..6417f639b5df
--- /dev/null
+++ b/dev-scheme/guile/files/guile-3.0-fix-32bit-BE.patch
@@ -0,0 +1,21 @@
+https://bugs.gentoo.org/940650#c4
+https://bugs.debian.org/cgi-bin/bugreport.cgi?att=1;bug=977223;filename=guile-3.0-fix-32bit-BE.patch;msg=66
+
+diff --git a/stage0/Makefile.am b/stage0/Makefile.am
+index 12029fb45..b00611df0 100644
+--- a/stage0/Makefile.am
++++ b/stage0/Makefile.am
+@@ -22,7 +22,12 @@
+ 
+ 
+ GUILE_WARNINGS = -W0
+-GUILE_OPTIMIZATIONS = -O1
++$(ifeq($SCM_PREBUILT_BINARIES,"32-bit-little-endian") \
++	GUILE_OPTIMIZATIONS = -O1 -Oresolve-primitives -Ocps \
++else \
++	GUILE_OPTIMIZATIONS = -O1 \
++endif)
++
+ GUILE_BOOTSTRAP_STAGE = stage0
+ 
+ include $(top_srcdir)/am/bootstrap.am
diff --git a/dev-scheme/guile/files/guile-3.0.10-backport-issue72913.patch b/dev-scheme/guile/files/guile-3.0.10-backport-issue72913.patch
new file mode 100644
index 000000000000..0a4d84cfea31
--- /dev/null
+++ b/dev-scheme/guile/files/guile-3.0.10-backport-issue72913.patch
@@ -0,0 +1,394 @@
+https://bugs.gentoo.org/940650#c12
+https://issues.guix.gnu.org/72913
+https://git.savannah.gnu.org/cgit/guile.git/commit/?id=aff9ac968840e9c86719fb613bd2ed3c39b9905c
+
+From 605440d8021061a4ef8c18370783ef39f62c59b2 Mon Sep 17 00:00:00 2001
+From: Andy Wingo <wingo@pobox.com>
+Date: Wed, 25 Sep 2024 17:23:06 +0200
+Subject: [PATCH 1/4] Fix fixpoint needed-bits computation in
+ specialize-numbers
+
+* module/language/cps/specialize-numbers.scm (next-power-of-two): Use
+integer-length.  No change.
+(compute-significant-bits): Fix the fixpoint computation, which was
+failing to complete in some cases with loops.
+---
+ module/language/cps/specialize-numbers.scm | 27 ++++++++--------------
+ 1 file changed, 10 insertions(+), 17 deletions(-)
+
+diff --git a/module/language/cps/specialize-numbers.scm b/module/language/cps/specialize-numbers.scm
+index 4ec88871c..12963cd71 100644
+--- a/module/language/cps/specialize-numbers.scm
++++ b/module/language/cps/specialize-numbers.scm
+@@ -265,10 +265,7 @@
+   (sigbits-intersect a (sigbits-intersect b c)))
+ 
+ (define (next-power-of-two n)
+-  (let lp ((out 1))
+-    (if (< n out)
+-        out
+-        (lp (ash out 1)))))
++  (ash 1 (integer-length n)))
+ 
+ (define (range->sigbits min max)
+   (cond
+@@ -310,18 +307,16 @@
+ BITS indicating the significant bits needed for a variable.  BITS may be
+ #f to indicate all bits, or a non-negative integer indicating a bitmask."
+   (let ((preds (invert-graph (compute-successors cps kfun))))
+-    (let lp ((worklist (intmap-keys preds)) (visited empty-intset)
+-             (out empty-intmap))
++    (let lp ((worklist (intmap-keys preds)) (out empty-intmap))
+       (match (intset-prev worklist)
+         (#f out)
+         (label
+-         (let ((worklist (intset-remove worklist label))
+-               (visited* (intset-add visited label)))
++         (let ((worklist (intset-remove worklist label)))
+            (define (continue out*)
+-             (if (and (eq? out out*) (eq? visited visited*))
+-                 (lp worklist visited out)
++             (if (eq? out out*)
++                 (lp worklist out)
+                  (lp (intset-union worklist (intmap-ref preds label))
+-                     visited* out*)))
++                     out*)))
+            (define (add-def out var)
+              (intmap-add out var 0 sigbits-union))
+            (define (add-defs out vars)
+@@ -352,12 +347,10 @@ BITS indicating the significant bits needed for a variable.  BITS may be
+                       (($ $values args)
+                        (match (intmap-ref cps k)
+                          (($ $kargs _ vars)
+-                          (if (intset-ref visited k)
+-                              (fold (lambda (arg var out)
+-                                      (intmap-add out arg (intmap-ref out var)
+-                                                  sigbits-union))
+-                                    out args vars)
+-                              out))
++                          (fold (lambda (arg var out)
++                                  (intmap-add out arg (intmap-ref out var (lambda (_) 0))
++                                              sigbits-union))
++                                out args vars))
+                          (($ $ktail)
+                           (add-unknown-uses out args))))
+                       (($ $call proc args)
+-- 
+2.47.0
+
+
+From 6953fcb8d9b7d9d36bf36e83e80e24153d37e2a4 Mon Sep 17 00:00:00 2001
+From: Andy Wingo <wingo@pobox.com>
+Date: Wed, 25 Sep 2024 17:24:51 +0200
+Subject: [PATCH 2/4] 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 12963cd71..e9761f0cb 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.47.0
+
+
+From b0559dbe88eb54e2bba4a82dd1f7e7c5b6de2f55 Mon Sep 17 00:00:00 2001
+From: Andy Wingo <wingo@pobox.com>
+Date: Mon, 23 Sep 2024 15:57:23 +0200
+Subject: [PATCH 3/4] Narrow parameter of logand/immediate if no bits used
+
+* module/language/cps/specialize-numbers.scm (specialize-operations):
+Narrow ulogand/immediate param according to used bits.
+---
+ module/language/cps/specialize-numbers.scm | 8 +++++---
+ 1 file changed, 5 insertions(+), 3 deletions(-)
+
+diff --git a/module/language/cps/specialize-numbers.scm b/module/language/cps/specialize-numbers.scm
+index e9761f0cb..262dee484 100644
+--- a/module/language/cps/specialize-numbers.scm
++++ b/module/language/cps/specialize-numbers.scm
+@@ -1,6 +1,6 @@
+ ;;; Continuation-passing style (CPS) intermediate language (IL)
+ 
+-;; Copyright (C) 2015-2021, 2023 Free Software Foundation, Inc.
++;; Copyright (C) 2015-2021,2023-2024 Free Software Foundation, Inc.
+ 
+ ;;;; This library is free software; you can redistribute it and/or
+ ;;;; modify it under the terms of the GNU Lesser General Public
+@@ -573,9 +573,11 @@ BITS indicating the significant bits needed for a variable.  BITS may be
+               (specialize-unop cps k src op param a
+                                (unbox-u64 a) (box-u64 result))))
+ 
+-           (('logand/immediate (? u64-result? ) param (? u64-operand? a))
++           (('logand/immediate (? u64-result?) param (? u64-operand? a))
+             (specialize-unop cps k src 'ulogand/immediate
+-                             (logand param (1- (ash 1 64)))
++                             (logand param
++                                     (or (intmap-ref sigbits result) -1)
++                                     (1- (ash 1 64)))
+                              a
+                              (unbox-u64 a) (box-u64 result)))
+ 
+-- 
+2.47.0
+
+
+From 51db308ec2107f9fb32a06004e7a0a3da6418ff6 Mon Sep 17 00:00:00 2001
+From: Andy Wingo <wingo@pobox.com>
+Date: Thu, 26 Sep 2024 11:14:52 +0200
+Subject: [PATCH 4/4] Run sigbits fixpoint based on use/def graph, not cfg
+
+* module/language/cps/specialize-numbers.scm (sigbits-ref): New helper.
+(invert-graph*): New helper.
+(compute-significant-bits): When visiting a term changes computed
+needed-bits for one of its definitions, we need to revisit the variables
+that contributed to its result (the uses), because they might need more
+bits as well.  Previously we were doing this by enqueueing predecessors
+to the term, which worked if the uses were defined in predecessors, or
+if all defining terms were already in the worklist, which is the case
+without loops.  But with loops, when revisiting a term, you could see
+that it causes sigbits to change, enqueue its predecessors, but then the
+predecessors don't change anything and the fixpoint stops before
+reaching the definitions of the variables we need.  So instead we
+compute the use-def graph and enqueue defs directly.
+---
+ module/language/cps/specialize-numbers.scm | 120 ++++++++++-----------
+ 1 file changed, 54 insertions(+), 66 deletions(-)
+
+diff --git a/module/language/cps/specialize-numbers.scm b/module/language/cps/specialize-numbers.scm
+index 262dee484..ac63c8194 100644
+--- a/module/language/cps/specialize-numbers.scm
++++ b/module/language/cps/specialize-numbers.scm
+@@ -286,6 +286,9 @@
+       (and (type<=? type (logior &exact-integer &u64 &s64))
+            (range->sigbits min max)))))
+ 
++(define (sigbits-ref sigbits var)
++  (intmap-ref sigbits var (lambda (_) 0)))
++
+ (define significant-bits-handlers (make-hash-table))
+ (define-syntax-rule (define-significant-bits-handler
+                       ((primop label types out def ...) param arg ...)
+@@ -297,24 +300,42 @@
+ (define-significant-bits-handler ((logand label types out res) param a b)
+   (let ((sigbits (sigbits-intersect3 (inferred-sigbits types label a)
+                                      (inferred-sigbits types label b)
+-                                     (intmap-ref out res (lambda (_) 0)))))
++                                     (sigbits-ref out res))))
+     (intmap-add (intmap-add out a sigbits sigbits-union)
+                 b sigbits sigbits-union)))
+ (define-significant-bits-handler ((logand/immediate label types out res) param a)
+   (let ((sigbits (sigbits-intersect3 (inferred-sigbits types label a)
+                                      param
+-                                     (intmap-ref out res (lambda (_) 0)))))
++                                     (sigbits-ref out res))))
+     (intmap-add out a sigbits sigbits-union)))
+ 
+ (define (significant-bits-handler primop)
+   (hashq-ref significant-bits-handlers primop))
+ 
++(define (invert-graph* defs)
++  "Given a graph LABEL->VAR..., return a graph VAR->LABEL....  Like the one
++in (language cps graphs), but different because it doesn't assume that
++the domain will be the same before and after."
++  (persistent-intmap
++   (intmap-fold (lambda (label vars out)
++                  (intset-fold
++                   (lambda (var out)
++                     (intmap-add! out var (intset label) intset-union))
++                   vars
++                   out))
++                defs
++                empty-intmap)))
++
+ (define (compute-significant-bits cps types kfun)
+   "Given the locally inferred types @var{types}, compute a map of VAR ->
+ BITS indicating the significant bits needed for a variable.  BITS may be
+ #f to indicate all bits, or a non-negative integer indicating a bitmask."
+-  (let ((preds (invert-graph (compute-successors cps kfun))))
+-    (let lp ((worklist (intmap-keys preds)) (out empty-intmap))
++  (let ((cps (intmap-select cps (compute-function-body cps kfun))))
++    ;; Label -> Var...
++    (define-values (defs uses) (compute-defs-and-uses cps))
++    ;; Var -> Label...
++    (define defs-by-var (invert-graph* defs))
++    (let lp ((worklist (intmap-keys cps)) (out empty-intmap))
+       (match (intset-prev worklist)
+         (#f out)
+         (label
+@@ -322,69 +343,36 @@ BITS indicating the significant bits needed for a variable.  BITS may be
+            (define (continue out*)
+              (if (eq? out out*)
+                  (lp worklist out)
+-                 (lp (intset-union worklist (intmap-ref preds label))
++                 (lp (intset-fold
++                      (lambda (use worklist)
++                        (intset-union worklist (intmap-ref defs-by-var use)))
++                      (intmap-ref uses label)
++                      worklist)
+                      out*)))
+-           (define (add-def out var)
+-             (intmap-add out var 0 sigbits-union))
+-           (define (add-defs out vars)
+-             (match vars
+-               (() out)
+-               ((var . vars) (add-defs (add-def out var) vars))))
+-           (define (add-unknown-use out var)
++           (define (add-unknown-use var out)
+              (intmap-add out var (inferred-sigbits types label var)
+                          sigbits-union))
+-           (define (add-unknown-uses out vars)
+-             (match vars
+-               (() out)
+-               ((var . vars)
+-                (add-unknown-uses (add-unknown-use out var) vars))))
++           (define (default)
++             (intset-fold add-unknown-use (intmap-ref uses label) out))
+            (continue
+             (match (intmap-ref cps label)
+-              (($ $kfun src meta self)
+-               (if self (add-def out self) out))
+-              (($ $kargs names vars term)
+-               (let ((out (add-defs out vars)))
+-                 (match term
+-                   (($ $continue k src exp)
+-                    (match exp
+-                      ((or ($ $const) ($ $prim) ($ $fun) ($ $const-fun)
+-                           ($ $code) ($ $rec))
+-                       ;; No uses, so no info added to sigbits.
+-                       out)
+-                      (($ $values args)
+-                       (match (intmap-ref cps k)
+-                         (($ $kargs _ vars)
+-                          (fold (lambda (arg var out)
+-                                  (intmap-add out arg (intmap-ref out var (lambda (_) 0))
+-                                              sigbits-union))
+-                                out args vars))
+-                         (($ $ktail)
+-                          (add-unknown-uses out args))))
+-                      (($ $call proc args)
+-                       (add-unknown-use (add-unknown-uses out args) proc))
+-                      (($ $callk label proc args)
+-                       (let ((out (add-unknown-uses out args)))
+-                         (if proc
+-                             (add-unknown-use out proc)
+-                             out)))
+-                      (($ $calli args callee)
+-                       (add-unknown-uses (add-unknown-use out callee) args))
+-                      (($ $primcall name param args)
+-                       (let ((h (significant-bits-handler name)))
+-                         (if h
+-                             (match (intmap-ref cps k)
+-                               (($ $kargs _ defs)
+-                                (h label types out param args defs)))
+-                             (add-unknown-uses out args))))))
+-                   (($ $branch kf kt src op param args)
+-                    (add-unknown-uses out args))
+-                   (($ $switch kf kt src arg)
+-                    (add-unknown-use out arg))
+-                   (($ $prompt k kh src escape? tag)
+-                    (add-unknown-use out tag))
+-                   (($ $throw src op param args)
+-                    (add-unknown-uses out args)))))
+-              (_ out)))))))))
++              (($ $kargs _ _ ($ $continue k _ ($ $primcall op param args)))
++               (match (significant-bits-handler op)
++                 (#f (default))
++                 (h
++                  (match (intmap-ref cps k)
++                    (($ $kargs _ defs)
++                     (h label types out param args defs))))))
++              (($ $kargs _ _ ($ $continue k _ ($ $values args)))
++               (match (intmap-ref cps k)
++                 (($ $kargs _ vars)
++                  (fold (lambda (arg var out)
++                          (intmap-add out arg (sigbits-ref out var)
++                                      sigbits-union))
++                        out args vars))
++                 (($ $ktail)
++                  (default))))
++              (_ (default))))))))))
+ 
+ (define (specialize-operations cps)
+   (define (u6-parameter? param)
+@@ -416,7 +404,7 @@ BITS indicating the significant bits needed for a variable.  BITS may be
+     (define (all-u64-bits-set? var)
+       (operand-in-range? var &exact-integer (1- (ash 1 64)) (1- (ash 1 64))))
+     (define (only-fixnum-bits-used? var)
+-      (let ((bits (intmap-ref sigbits var)))
++      (let ((bits (sigbits-ref sigbits var)))
+         (and bits (= bits (logand bits (target-most-positive-fixnum))))))
+     (define (fixnum-result? result)
+       (or (only-fixnum-bits-used? result)
+@@ -429,7 +417,7 @@ BITS indicating the significant bits needed for a variable.  BITS may be
+                        min max
+                        (target-most-positive-fixnum)))))))
+     (define (only-u64-bits-used? var)
+-      (let ((bits (intmap-ref sigbits var)))
++      (let ((bits (sigbits-ref sigbits var)))
+         (and bits (= bits (logand bits (1- (ash 1 64)))))))
+     (define (u64-result? result)
+       (or (only-u64-bits-used? result)
+@@ -490,7 +478,7 @@ BITS indicating the significant bits needed for a variable.  BITS may be
+             u64->fixnum)
+            ((only-fixnum-bits-used? result)
+             (lambda (cps k src u64)
+-              (u64->fixnum/truncate cps k src u64 (intmap-ref sigbits result))))
++              (u64->fixnum/truncate cps k src u64 (sigbits-ref sigbits result))))
+            (else
+             u64->scm)))))
+     (define (box-f64 result)
+@@ -576,7 +564,7 @@ BITS indicating the significant bits needed for a variable.  BITS may be
+            (('logand/immediate (? u64-result?) param (? u64-operand? a))
+             (specialize-unop cps k src 'ulogand/immediate
+                              (logand param
+-                                     (or (intmap-ref sigbits result) -1)
++                                     (or (sigbits-ref sigbits a) -1)
+                                      (1- (ash 1 64)))
+                              a
+                              (unbox-u64 a) (box-u64 result)))
+-- 
+2.47.0
+
diff --git a/dev-scheme/guile/guile-3.0.10-r102.ebuild b/dev-scheme/guile/guile-3.0.10-r102.ebuild
new file mode 100644
index 000000000000..1b276a4f9906
--- /dev/null
+++ b/dev-scheme/guile/guile-3.0.10-r102.ebuild
@@ -0,0 +1,126 @@
+# Copyright 1999-2024 Gentoo Authors
+# Distributed under the terms of the GNU General Public License v2
+
+EAPI=8
+
+inherit autotools
+
+DESCRIPTION="GNU Ubiquitous Intelligent Language for Extensions"
+HOMEPAGE="https://www.gnu.org/software/guile/"
+SRC_URI="mirror://gnu/guile/${P}.tar.xz"
+
+LICENSE="LGPL-3+"
+SLOT="$(ver_cut 1-2)"  # See (guile)Parallel Installations.
+KEYWORDS="~alpha ~amd64 ~arm ~arm64 ~hppa ~loong ~m68k ~mips ~ppc ~ppc64 ~riscv ~s390 ~sparc ~x86 ~amd64-linux ~x86-linux ~arm64-macos ~ppc-macos ~x64-macos"
+
+IUSE="debug debug-malloc +deprecated +jit +networking +nls +regex +threads" # upstream recommended +networking +nls
+REQUIRED_USE="regex" # workaround for bug #596322
+RESTRICT="strip"
+
+RDEPEND="
+	>=dev-libs/boehm-gc-7.0[threads?]
+	dev-libs/gmp:=
+	dev-libs/libffi:=
+	dev-libs/libatomic_ops
+	dev-libs/libunistring:=
+	sys-libs/ncurses:=
+	sys-libs/readline:=
+	virtual/libcrypt:=
+	!dev-scheme/guile:12
+"
+DEPEND="${RDEPEND}"
+BDEPEND="
+	virtual/pkgconfig
+	dev-build/libtool
+	sys-devel/gettext
+"
+
+# guile generates ELF files without use of C or machine code
+# It's false positive. bug #677600
+QA_PREBUILT='*[.]go'
+
+DOCS=( ABOUT-NLS AUTHORS ChangeLog GUILE-VERSION HACKING NEWS README THANKS )
+
+PATCHES=(
+	"${FILESDIR}"/${PN}-2.2.3-gentoo-sandbox.patch
+	"${FILESDIR}/${PN}-3.0-fix-32bit-BE.patch"
+	"${FILESDIR}/${PN}-3.0.10-backport-issue72913.patch"
+)
+
+# Where to install data files.
+GUILE_DATA="${EPREFIX}/usr/share/guile-data/${SLOT}"
+GUILE_PCDIR="${EPREFIX}/usr/share/guile-data/${SLOT}/pkgconfig"
+GUILE_INFODIR="${GUILE_DATA}"/info
+
+src_prepare() {
+	default
+
+	# Needed for fix-32bit-BE.patch
+	eautoreconf
+}
+
+src_configure() {
+	# See bug #676468 (may be able to drop this if we adapt fix-32bit-BE.patch)?
+	mv prebuilt/32-bit-big-endian{,.broken} || die
+
+	local -a myconf=(
+		--program-suffix="-${SLOT}"
+		--infodir="${GUILE_INFODIR}"
+		--with-pkgconfigdir="${GUILE_PCDIR}"
+
+		--disable-error-on-warning
+		--disable-rpath
+		--disable-lto
+		--enable-posix
+		--without-libgmp-prefix
+		--without-libiconv-prefix
+		--without-libintl-prefix
+		--without-libreadline-prefix
+		--without-libunistring-prefix
+		$(use_enable debug guile-debug)
+		$(use_enable debug-malloc)
+		$(use_enable deprecated)
+		$(use_enable jit)
+		$(use_enable networking)
+		$(use_enable nls)
+		$(use_enable regex)
+		$(use_with threads)
+	)
+
+	econf "${myconf[@]}"
+}
+
+# Akin to (and taken from) toolchain-autoconfs eclass
+guile_slot_info() {
+	rm -f dir || die
+
+	pushd "${D}/${GUILE_INFODIR}" >/dev/null || die
+	for f in *.info*; do
+		# Install convenience aliases for versioned Guile pages.
+		ln -s "$f" "${f/./-${SLOT}.}" || die
+	done
+	popd >/dev/null || die
+
+	docompress "${GUILE_INFODIR}"
+}
+
+src_install() {
+	default
+
+	# From Novell https://bugzilla.novell.com/show_bug.cgi?id=874028#c0
+	dodir /usr/share/gdb/auto-load/$(get_libdir)
+	mv "${ED}"/usr/$(get_libdir)/libguile-*-gdb.scm "${ED}"/usr/share/gdb/auto-load/$(get_libdir) || die
+
+	mv "${ED}"/usr/share/aclocal/guile{,-"${SLOT}"}.m4 || die
+	find "${ED}" -name '*.la' -delete || die
+
+	guile_slot_info
+
+	local major="$(ver_cut 1 "${SLOT}")"
+	local minor="$(ver_cut 2 "${SLOT}")"
+	local idx="$((99999-(major*1000+minor)))"
+	newenvd - "50guile${idx}" <<-EOF
+	PKG_CONFIG_PATH="${GUILE_PCDIR}"
+	INFOPATH="${GUILE_INFODIR}"
+	EOF
+}