intern arbitrary constants

(Best-ability ChangeLog annotation added by Christine Lemmer-Webber.)

* libguile/loader.c (load_thunk_from_memory): Refactor, adding
  "constants" argument and passing to "init" if appropriate.
  (load_thunk_from_file): Call "load-thunk-from-memory" with
  "constants" set to #f.
  (scm_load_thunk_from_memory): Instead of a bytevector, accept
  a cons of "(bytevector . constants)", where constants is either
  a vector or #f.  Pass this into "load_thunk_from_memory".
* module/language/bytecode/spec.scm: Adapt printer.
* module/language/cps/compile-bytecode.scm (compile-bytecode):
  New variable.
* module/system/repl/command.scm (disassemble):
  Adapt to expect pair which includes bytevector as its car.
* module/system/vm/assembler.scm <asm>: Add "to-file?" slot.
  (fresh-block): New variable.
  (make-assembler): Adapt to expect "to-file?" keyword argument.
  (intern-constant): Support "asm-to-file?" in checks.
  (emit-init-constants, link-data): Likewise.
  (link-assembly): Update logic for handling "(bytevector . constants)"
  pair, as well as the expectations of its invocation by compile-bytecode.

module/system/vm/assembler.scm

@@ -502,7 +502,8 @@ N-byte unit."
             constants inits
             shstrtab next-section-number
             meta sources
-            slot-maps)
+            slot-maps
+            to-file?)
   asm?
 
   ;; We write bytecode into a bytevector, growing the bytevector as
@@ -583,10 +584,16 @@ N-byte unit."
   ;; relative to the beginning of the text section.  SLOT-MAP is a
   ;; bitfield describing the stack at call sites, as an integer.
   ;;
-  (slot-maps asm-slot-maps set-asm-slot-maps!))
+  (slot-maps asm-slot-maps set-asm-slot-maps!)
+
+  (to-file? asm-to-file?))
+
+(define-inline (fresh-block)
+  (make-u32vector *block-size*))
 
 (define* (make-assembler #:key (word-size (target-word-size))
-                         (endianness (target-endianness)))
+                         (endianness (target-endianness))
+                         (to-file? #t))
   "Create an assembler for a given target @var{word-size} and
 @var{endianness}, falling back to appropriate values for the configured
 target."
@@ -595,7 +602,7 @@ target."
             word-size endianness
             vlist-null vlist-null
             (make-string-table) 1
-            '() '() '()))
+            '() '() '() to-file?))
 
 (define (intern-section-name! asm string)
   "Add a string to the section name table (shstrtab)."
@@ -1349,7 +1356,10 @@ table, its existing label is used directly."
      ((array? obj)
       (patch! 1 (shared-array-root obj)))
      (else
-      (error "don't know how to intern" obj))))
+      (if (asm-to-file? asm)
+          (error "don't know how to intern" obj)
+          `((vector-ref/immediate 1 0 ,(vlist-length (asm-constants asm)))
+            (static-set! 1 ,label 0))))))
   (cond
    ((immediate-bits asm obj) #f)
    ((vhash-assoc obj (asm-constants asm)) => cdr)
@@ -1805,6 +1815,10 @@ a procedure to do that and return its label.  Otherwise return
     (and (not (vlist-null? inits))
          (let ((label (gensym "init-constants")))
            (emit-begin-program asm label '())
+           (if (asm-to-file? asm)
+               '((emit-assert-nargs-ee/locals asm 1 1))
+               '((emit-assert-nargs-ee/locals asm 2 0)
+                 (mov 0 1)))
            (emit-assert-nargs-ee/locals asm 1 1)
            (let lp ((n (1- (vlist-length inits))))
              (match (vlist-ref inits n)
@@ -2082,7 +2096,9 @@ should be .data or .rodata), and return the resulting linker object.
               (lp (+ pos (* 3 word-size)) (cdr bounds) (cdr incs))))))
 
        (else
-        (error "unrecognized object" obj))))
+        (if (asm-to-file? asm)
+            (error "unrecognized object" obj)
+            (write-constant-reference buf pos obj)))))
 
     (define (add-relocs obj pos relocs)
       (match obj
@@ -3098,4 +3114,7 @@ procedure with label @var{rw-init}.  @var{rw-init} may be false.  If
 The result is a bytevector, by default linked so that read-only and
 writable data are on separate pages.  Pass @code{#:page-aligned? #f} to
 disable this behavior."
-  (link-elf (link-objects asm) #:page-aligned? page-aligned?))
+  (define (asm-constant-vector asm)
+    (list->vector (reverse (map car (vlist->list (asm-constants asm))))))
+  (let ((bv (link-elf (link-objects asm) #:page-aligned? page-aligned?)))
+    (cons bv (if (asm-to-file? asm) #f (asm-constant-vector asm)))))