linker: Linker object writer takes a single argument.

* module/system/vm/linker.scm (write-linker-object): Pass the
'linker-object-writer' a single argument.
(string-table-writer, add-elf-objects): Adjust writers accordingly.
(string-table-writer):
(add-elf-objects):
* module/system/vm/assembler.scm (link-data, link-text-object)
(link-frame-maps, link-dynamic-section)
(link-symtab, link-arities, link-docstrs)
(link-procprops, link-debug): Likewise.
* test-suite/tests/linker.test (link-elf-with-one-main-section):
Likewise.

3 files changed, 35 insertions, 46 deletions

diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 2ecfce78c..165976363 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -2113,8 +2113,8 @@ should be .data or .rodata), and return the resulting linker object.
                      (add-relocs obj pos relocs)
                      (cons (make-linker-symbol obj-label pos) symbols))))
               (make-object asm name byte-len
-                           (lambda (bv offset)
-                             (let loop ((i 0) (pos offset))
+                           (lambda (bv)
+                             (let loop ((i 0) (pos 0))
                                (when (< i (vlist-length data))
                                  (match (vlist-ref data i)
                                    ((obj . obj-label)
@@ -2231,12 +2231,11 @@ The offsets are expected to be expressed in words."
 needed."
   (let ((size (asm-pos asm)))
     (make-object asm '.rtl-text size
-                 (lambda (bv offset)
-                   (let ((buf (bytevector-slice bv offset size)))
-                     (bytevector-copy! (asm-buf asm) 0 buf 0 size)
-                     (unless (eq? (asm-endianness asm) (native-endianness))
-                       (byte-swap/4! buf))
-                     (patch-relocs! buf (asm-relocs asm) (asm-labels asm))))
+                 (lambda (buf)
+                   (bytevector-copy! (asm-buf asm) 0 buf 0 size)
+                   (unless (eq? (asm-endianness asm) (native-endianness))
+                     (byte-swap/4! buf))
+                   (patch-relocs! buf (asm-relocs asm) (asm-labels asm)))
                  (process-relocs (asm-relocs asm)
                                  (asm-labels asm))
                  (process-labels (asm-labels asm)))))
@@ -2292,9 +2291,7 @@ needed."
                      (write-bytes (1+ map-pos) (ash map -8)
                                   (1- byte-length)))))))))
 
-      (make-object asm '.guile.frame-maps size
-                   (lambda (bv offset)
-                     (write! (bytevector-slice bv offset)))
+      (make-object asm '.guile.frame-maps size write!
                    (list (make-linker-reloc 'abs32/1 0 0 '.rtl-text))
                    '() #:type SHT_PROGBITS #:flags SHF_ALLOC)))
   (match (asm-slot-maps asm)
@@ -2374,9 +2371,7 @@ procedure with label @var{rw-init}.  @var{rw-init} may be false.  If
         (set-uword! (- words 2) DT_NULL)
         (set-uword! (- words 1) 0))
 
-      (make-object asm '.dynamic size
-                   (lambda (bv offset)
-                     (write! (bytevector-slice bv offset)))
+      (make-object asm '.dynamic size write!
                    relocs '()
                    #:type SHT_DYNAMIC #:flags SHF_ALLOC)))
   (case (asm-word-size asm)
@@ -2406,9 +2401,9 @@ procedure with label @var{rw-init}.  @var{rw-init} may be false.  If
       (map (lambda (meta n)
              (intern-string! (meta-name meta)))
            meta (iota n)))
-    (define (write-symbols! bv offset)
+    (define (write-symbols! bv)
       (for-each (lambda (name meta n)
-                  (write-elf-symbol bv (+ offset (* n size))
+                  (write-elf-symbol bv (* n size)
                                     endianness word-size
                                     (make-elf-symbol
                                      #:name name
@@ -2658,14 +2653,11 @@ procedure with label @var{rw-init}.  @var{rw-init} may be false.  If
                                   #:type SHT_STRTAB #:flags 0)))
         (values (make-object asm '.guile.arities
                              (+ header-size (bytevector-length name-bv))
-                             (lambda (bv offset)
+                             (lambda (bv)
                                ;; FIXME: Avoid extra allocation + copy.
-                               (bytevector-copy! headers 0
-                                                 bv offset
+                               (bytevector-copy! headers 0 bv 0
                                                  header-size)
-                               (bytevector-copy! name-bv 0
-                                                 bv
-                                                 (+ offset header-size)
+                               (bytevector-copy! name-bv 0 bv header-size
                                                  (bytevector-length name-bv)))
                              relocs '()
                              #:type SHT_PROGBITS #:flags 0
@@ -2703,7 +2695,7 @@ procedure with label @var{rw-init}.  @var{rw-init} may be false.  If
                             ((pc . str)
                              (cons pc (string-table-intern! strtab str))))
                           (find-docstrings))))
-    (define (write-docstrings! bv offset)
+    (define (write-docstrings! bv)
       (fold (lambda (pair pos)
               (match pair
                 ((pc . string-pos)
@@ -2712,7 +2704,7 @@ procedure with label @var{rw-init}.  @var{rw-init} may be false.  If
                                       string-pos
                                       endianness)
                  (+ pos docstr-size))))
-            offset
+            0
             docstrings))
 
     (let ((strtab (make-object asm '.guile.docstrs.strtab
@@ -2772,8 +2764,8 @@ procedure with label @var{rw-init}.  @var{rw-init} may be false.  If
   (let* ((endianness (asm-endianness asm))
          (procprops (find-procprops))
          (size (* (length procprops) procprops-size)))
-    (define (write-procprops! bv offset)
-      (let lp ((procprops procprops) (pos offset))
+    (define (write-procprops! bv)
+      (let lp ((procprops procprops) (pos 0))
         (match procprops
           (()
            #t)
@@ -3114,8 +3106,8 @@ procedure with label @var{rw-init}.  @var{rw-init} may be false.  If
              (put-uleb128 die-port 0))))))
 
     (define (copy-writer source)
-      (lambda (bv offset)
-        (bytevector-copy! source 0 bv offset
+      (lambda (bv)
+        (bytevector-copy! source 0 bv 0
                           (bytevector-length source))))
 
     ;; Compilation unit header.
@@ -3151,7 +3143,7 @@ procedure with label @var{rw-init}.  @var{rw-init} may be false.  If
                          '() '()
                          #:type SHT_PROGBITS #:flags 0)
             (make-object asm '.debug_loc
-                         0 (lambda (bv offset) #t)
+                         0 (lambda (bv) #t)
                          '() '()
                          #:type SHT_PROGBITS #:flags 0)
             (let ((bv (get-line-bv)))
diff --git a/module/system/vm/linker.scm b/module/system/vm/linker.scm
index 56e19c285..6858850ef 100644
--- a/module/system/vm/linker.scm
+++ b/module/system/vm/linker.scm
@@ -205,12 +205,12 @@ Returns the byte index of the string in that table."
   "Return a <linker-object> \"writer\" procedure that links the string
 table @var{table} into a sequence of bytes, suitable for use as the
 contents of an ELF string table section."
-  (lambda (bv offset)
+  (lambda (bv)
     (match table
       (($ <string-table> strings #f)
        (for-each (match-lambda
                    ((_ pos bytes)
-                    (bytevector-copy! bytes 0 bv (+ pos offset)
+                    (bytevector-copy! bytes 0 bv pos
                                       (bytevector-length bytes))))
                  strings)
        (set-string-table-linked?! table #t)))))
@@ -478,7 +478,7 @@ locations, as given in @var{symtab}."
         (begin
           (unless (= len (linker-object-size o))
             (error "unexpected length" section o))
-          ((linker-object-writer o) bv offset)
+          ((linker-object-writer o) (bytevector-slice bv offset len))
           (for-each (lambda (reloc)
                       (process-reloc reloc bv offset symtab endianness))
                     relocs)))))
@@ -524,7 +524,7 @@ list of objects, augmented with objects for the special ELF sections."
     (make-linker-object ""
                         (make-elf-section #:index 0 #:type SHT_NULL
                                           #:flags 0 #:addralign 0)
-                        0 (lambda (bv offset) #t) '() '()))
+                        0 (lambda (bv) #t) '() '()))
 
   ;; The ELF header and the segment table.
   ;;
@@ -545,8 +545,8 @@ list of objects, augmented with objects for the special ELF sections."
                           (make-elf-section #:index index #:type SHT_PROGBITS
                                             #:flags SHF_ALLOC #:size size)
                           size
-                          (lambda (bv offset)
-                            (write-elf-header (bytevector-slice bv offset) header))
+                          (lambda (bv)
+                            (write-elf-header bv header))
                           (list shoff-reloc)
                           '())))
 
@@ -580,10 +580,9 @@ list of objects, augmented with objects for the special ELF sections."
                             section-label)
                           relocs))))))
 
-      (define (write-object-elf-header! bv offset object)
+      (define (write-object-elf-header! bv object)
         (let ((section (linker-object-section object)))
-          (let ((offset (+ offset
-                           (* shentsize (elf-section-index section)))))
+          (let ((offset (* shentsize (elf-section-index section))))
             (write-elf-section-header bv offset endianness word-size section))))
 
       (let ((relocs (fold-values
@@ -596,10 +595,9 @@ list of objects, augmented with objects for the special ELF sections."
                      objects
                      (compute-reloc shoff-label section-table '()))))
         (%make-linker-object #f section-table size
-                             (lambda (bv offset)
+                             (lambda (bv)
                                (for-each (lambda (object)
                                            (write-object-elf-header! bv
-                                                                     offset
                                                                      object))
                                          objects))
                              relocs
@@ -630,17 +628,16 @@ list of objects, augmented with objects for the special ELF sections."
     (define write-header!
       (linker-object-writer header))
 
-    (define (write-header+segments! bv offset)
+    (define (write-header+segments! bv)
       (for-each (lambda (segment)
-                  (let ((offset (+ offset
-                                   phoff
+                  (let ((offset (+ phoff
                                    (* (elf-segment-index segment) phentsize))))
                     (write-elf-program-header bv offset
                                               endianness
                                               word-size
                                               segment)))
                 segments)
-      (write-header! bv offset))
+      (write-header! bv))
 
     (set-linker-object-writer! header write-header+segments!)
     (values add-header-segment! objects)))
diff --git a/test-suite/tests/linker.test b/test-suite/tests/linker.test
index ea54618b4..2dc70963d 100644
--- a/test-suite/tests/linker.test
+++ b/test-suite/tests/linker.test
@@ -46,8 +46,8 @@
            (endianness (target-endianness))
            (sec (make-object 1 name
                              (bytevector-length bytes)
-                             (lambda (bv offset)
-                               (bytevector-copy! bytes 0 bv offset
+                             (lambda (bv)
+                               (bytevector-copy! bytes 0 bv 0
                                                  (bytevector-length
                                                   bytes)))
                              '()))