linker string tables are stateful objects

* module/system/vm/linker.scm (make-string-table): Rework to be a
  stateful object instead of a function object.  Works better in this
  case.  Adapt users.
  (string-table-intern!): Rename from string-table-intern, and just
  return the index of the string.
  (link-string-table!): Rename from link-string-table, and set a flag to
  prevent interning strings after linking, as that's not going to work
  well.

* module/language/objcode/elf.scm (bytecode->elf): Adapt.

module/language/objcode/elf.scm

@@ -36,11 +36,7 @@
 (define (bytecode->elf bv)
   (let ((string-table (make-string-table)))
     (define (intern-string! string)
-      (call-with-values
+      (string-table-intern! string-table string))
-          (lambda () (string-table-intern string-table string))
-        (lambda (table idx)
-          (set! string-table table)
-          idx)))
     (define (make-object index name bv relocs . kwargs)
       (let ((name-idx (intern-string! (symbol->string name))))
         (make-linker-object (apply make-elf-section
@@ -79,7 +75,7 @@
                        #:type SHT_DYNAMIC #:flags SHF_ALLOC))))
     (define (make-string-table index)
       (intern-string! ".shstrtab")
-      (make-object index '.shstrtab (link-string-table string-table) '()
+      (make-object index '.shstrtab (link-string-table! string-table) '()
                    #:type SHT_STRTAB #:flags 0))
     (let* ((word-size (target-word-size))
            (endianness (target-endianness))

module/system/vm/linker.scm

@@ -85,8 +85,8 @@
             (linker-object-symbols* . linker-object-symbols)
 
             make-string-table
-            string-table-intern
+            string-table-intern!
-            link-string-table
+            link-string-table!
 
             link-elf))
 
@@ -156,40 +156,52 @@
   "Return the linker symbols defined by the user for this this section."
   (cdr (linker-object-symbols object)))
 
+(define-record-type <string-table>
+  (%make-string-table strings linked?)
+  string-table?
+  (strings string-table-strings set-string-table-strings!)
+  (linked? string-table-linked? set-string-table-linked?!))
+
 (define (make-string-table)
-  "Return a functional string table with one entry: the empty string."
+  "Return a string table with one entry: the empty string."
-  '(("" 0 #vu8())))
+  (%make-string-table '(("" 0 #vu8())) #f))
 
-(define (string-table-length table)
+(define (string-table-length strings)
-  "Return the number of bytes needed for the string table @var{table}."
+  "Return the number of bytes needed for the @var{strings}."
-  (let ((last (car table)))
+  (match strings
-    ;; The + 1 is for the trailing NUL byte.
+    (((str pos bytes) . _)
-    (+ (cadr last) (bytevector-length (caddr last)) 1)))
+     ;; The + 1 is for the trailing NUL byte.
+     (+ pos (bytevector-length bytes) 1))))
 
-(define (string-table-intern table str)
+(define (string-table-intern! table str)
-  "Add @var{str} to the string table @var{table}.  Yields two values:  a
+  "Ensure that @var{str} is present in the string table @var{table}.
-possibly newly allocated string table, and the byte index of the string
+Returns the byte index of the string in that table."
-in that table."
+  (match table
-  (cond
+    (($ <string-table> strings linked?)
-   ((assoc str table)
+     (match (assoc str strings)
-    => (lambda (ent)
+       ((_ pos _) pos)
-         (values table (cadr ent))))
+       (#f
-   (else
+        (let ((next (string-table-length strings)))
-    (let* ((next (string-table-length table)))
+          (when linked?
-      (values (cons (list str next (string->utf8 str))
+            (error "string table already linked, can't intern" table str))
-                    table)
+          (set-string-table-strings! table
-              next)))))
+                                     (cons (list str next (string->utf8 str))
+                                           strings))
+          next))))))
 
-(define (link-string-table table)
+(define (link-string-table! table)
   "Link the functional string table @var{table} into a sequence of
 bytes, suitable for use as the contents of an ELF string table section."
-  (let ((out (make-bytevector (string-table-length table) 0)))
+  (match table
-    (for-each
+    (($ <string-table> strings #f)
-     (lambda (ent)
+     (let ((out (make-bytevector (string-table-length strings) 0)))
-       (let ((bytes (caddr ent)))
+       (for-each
-         (bytevector-copy! bytes 0 out (cadr ent) (bytevector-length bytes))))
+        (match-lambda
-     table)
+         ((_ pos bytes)
-    out))
+          (bytevector-copy! bytes 0 out pos (bytevector-length bytes))))
+        strings)
+       (set-string-table-linked?! table #t)
+       out))))
 
 (define (segment-kind section)
   "Return the type of segment needed to store @var{section}, as a pair.