[Guile-commits] 05/09: assembler: Separate effectful part of 'link-frame-maps'.

[Ludovic Courtès]

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

commit 0a5768addcc18a2175e87148beeb60870ee23a2d
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Jan 6 15:48:50 2023 +0100

    assembler: Separate effectful part of 'link-frame-maps'.
    
    * module/system/vm/assembler.scm (link-frame-maps)[make-frame-maps]:
    Define 'write!' and use it.
---
 module/system/vm/assembler.scm | 43 +++++++++++++++++++++++-------------------
 1 file changed, 24 insertions(+), 19 deletions(-)

diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 1b0bf5c45..872cc31c6 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -2262,25 +2262,30 @@ needed."
            (header-pos frame-maps-prefix-len)
            (map-pos (+ header-pos (* count frame-map-header-len)))
            (bv (make-bytevector (+ map-pos map-len) 0)))
-      (bytevector-u32-set! bv 4 map-pos endianness)
-      (let lp ((maps maps) (header-pos header-pos) (map-pos map-pos))
-        (match maps
-          (()
-           (make-object asm '.guile.frame-maps bv
-                        (list (make-linker-reloc 'abs32/1 0 0 '.rtl-text))
-                        '() #:type SHT_PROGBITS #:flags SHF_ALLOC))
-          (((pos proc-slot . map) . maps)
-           (bytevector-u32-set! bv header-pos pos endianness)
-           (bytevector-u32-set! bv (+ header-pos 4) map-pos endianness)
-           (let write-bytes ((map-pos map-pos)
-                             (map map)
-                             (byte-length (map-byte-length proc-slot)))
-             (if (zero? byte-length)
-                 (lp maps (+ header-pos frame-map-header-len) map-pos)
-                 (begin
-                   (bytevector-u8-set! bv map-pos (logand map #xff))
-                   (write-bytes (1+ map-pos) (ash map -8)
-                                (1- byte-length))))))))))
+      (define (write! bv)
+        (bytevector-u32-set! bv 4 map-pos endianness)
+        (let lp ((maps maps) (header-pos header-pos) (map-pos map-pos))
+          (match maps
+            (()
+             #t)
+            (((pos proc-slot . map) . maps)
+             (bytevector-u32-set! bv header-pos pos endianness)
+             (bytevector-u32-set! bv (+ header-pos 4) map-pos endianness)
+             (let write-bytes ((map-pos map-pos)
+                               (map map)
+                               (byte-length (map-byte-length proc-slot)))
+               (if (zero? byte-length)
+                   (lp maps (+ header-pos frame-map-header-len) map-pos)
+                   (begin
+                     (bytevector-u8-set! bv map-pos (logand map #xff))
+                     (write-bytes (1+ map-pos) (ash map -8)
+                                  (1- byte-length)))))))))
+
+      (write! bv)
+      (make-object asm '.guile.frame-maps
+                   bv
+                   (list (make-linker-reloc 'abs32/1 0 0 '.rtl-text))
+                   '() #:type SHT_PROGBITS #:flags SHF_ALLOC)))
   (match (asm-slot-maps asm)
     (() #f)
     (in