intern arbitrary constants

(Best-ability ChangeLog annotation added by Christopher Allan 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.

1 files changed, 17 insertions, 6 deletions

diff --git a/libguile/loader.c b/libguile/loader.c
index 743c8b0cd..1534ff897 100644
--- a/libguile/loader.c
+++ b/libguile/loader.c
@@ -344,7 +344,7 @@ process_dynamic_segment (char *base, Elf_Phdr *dyn_phdr,
 #define ABORT(msg) do { err_msg = msg; errno = 0; goto cleanup; } while (0)
 
 static SCM
-load_thunk_from_memory (char *data, size_t len, int is_read_only)
+load_thunk_from_memory (char *data, size_t len, int is_read_only, SCM constants)
 #define FUNC_NAME "load-thunk-from-memory"
 {
   Elf_Ehdr *header;
@@ -466,7 +466,12 @@ load_thunk_from_memory (char *data, size_t len, int is_read_only)
     }
 
   if (scm_is_true (init))
-    scm_call_0 (init);
+    {
+      if (scm_is_true (constants))
+        scm_call_1 (init, constants);
+      else
+        scm_call_0 (init);
+    }
 
   register_elf (data, len, frame_maps);
 
@@ -569,19 +574,25 @@ SCM_DEFINE (scm_load_thunk_from_file, "load-thunk-from-file", 1, 0, 0,
 
   (void) close (fd);
 
-  return load_thunk_from_memory (data, end, is_read_only);
+  return load_thunk_from_memory (data, end, is_read_only, SCM_BOOL_F);
 }
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_load_thunk_from_memory, "load-thunk-from-memory", 1, 0, 0,
-	    (SCM bv),
+	    (SCM obj),
 	    "")
 #define FUNC_NAME s_scm_load_thunk_from_memory
 {
   char *data;
   size_t len;
+  SCM bv, constants;
 
-  SCM_VALIDATE_BYTEVECTOR (1, bv);
+  SCM_VALIDATE_CONS (1, obj);
+  bv = scm_car (obj);
+  constants = scm_cdr (obj);
+  SCM_ASSERT (scm_is_bytevector (bv)
+              && (scm_is_vector (constants) || scm_is_false (constants)),
+              obj, 1, FUNC_NAME);
 
   data = (char *) SCM_BYTEVECTOR_CONTENTS (bv);
   len = SCM_BYTEVECTOR_LENGTH (bv);
@@ -591,7 +602,7 @@ SCM_DEFINE (scm_load_thunk_from_memory, "load-thunk-from-memory", 1, 0, 0,
 
   data = copy_and_align_elf_data (data, len);
 
-  return load_thunk_from_memory (data, len, 0);
+  return load_thunk_from_memory (data, len, 0, constants);
 }
 #undef FUNC_NAME