guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 04/09: assembler: Separate effectful part of 'link-procp


From: Ludovic Courtès
Subject: [Guile-commits] 04/09: assembler: Separate effectful part of 'link-procprops'.
Date: Sat, 7 Jan 2023 16:54:53 -0500 (EST)

civodul pushed a commit to branch wip-linker-assembler-memory-consumption
in repository guile.

commit f6fb95db8010a4000006ced86370a628d4215171
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Jan 6 15:31:15 2023 +0100

    assembler: Separate effectful part of 'link-procprops'.
    
    * module/system/vm/assembler.scm (link-procprops): Define
    'write-procprops!' and use it.
---
 module/system/vm/assembler.scm | 40 ++++++++++++++++++++++++++--------------
 1 file changed, 26 insertions(+), 14 deletions(-)

diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 87f9cc2e9..1b0bf5c45 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -2744,20 +2744,32 @@ procedure with label @var{rw-init}.  @var{rw-init} may 
be false.  If
   (let* ((endianness (asm-endianness asm))
          (procprops (find-procprops))
          (bv (make-bytevector (* (length procprops) procprops-size) 0)))
-    (let lp ((procprops procprops) (pos 0) (relocs '()))
-      (match procprops
-        (()
-         (make-object asm '.guile.procprops
-                      bv
-                      relocs '()
-                      #:type SHT_PROGBITS #:flags 0))
-        (((pc . props) . procprops)
-         (bytevector-u32-set! bv pos pc endianness)
-         (lp procprops
-             (+ pos procprops-size)
-             (cons (make-linker-reloc 'abs32/1 (+ pos 4) 0
-                                      (intern-constant asm props))
-                   relocs)))))))
+    (define (write-procprops! bv offset)
+      (let lp ((procprops procprops) (pos offset))
+        (match procprops
+          (()
+           #t)
+          (((pc . props) . procprops)
+           (bytevector-u32-set! bv pos pc endianness)
+           (lp procprops (+ pos procprops-size))))))
+
+    (define relocs
+      (let lp ((procprops procprops) (pos 0) (relocs '()))
+        (match procprops
+          (()
+           relocs)
+          (((pc . props) . procprops)
+           (lp procprops
+               (+ pos procprops-size)
+               (cons (make-linker-reloc 'abs32/1 (+ pos 4) 0
+                                        (intern-constant asm props))
+                     relocs))))))
+
+    (write-procprops! bv 0)
+    (make-object asm '.guile.procprops
+                 bv
+                 relocs '()
+                 #:type SHT_PROGBITS #:flags 0)))
 
 ;;;
 ;;; The DWARF .debug_info, .debug_abbrev, .debug_str, and .debug_loc



reply via email to

[Prev in Thread] Current Thread [Next in Thread]