move module and meta inside programs' object tables

* libguile/programs.h (struct scm_program): Remove the module and meta
  fields.

* libguile/programs.c (scm_c_make_program): Add a new argument, `objs'.
  If it's a vector, we'll look for the module and the metadata in there,
  instead of having them in the scm_program structure.
  (scm_c_make_closure, program_mark, scm_program_meta)
  (scm_c_program_source, scm_program_module): Adapt to the new program
  representation.

* libguile/objcodes.c (scm_objcode_to_program): Pass #f as the object
  table when making the program.

* libguile/vm-engine.h (CACHE_PROGRAM):
* libguile/vm-engine.c (vm_run): Rework to use the simple vector API for
  getting the current object table. Call the helper,
  vm_make_boot_program, to make the boot program.

* libguile/vm-i-loader.c (load-program): Set the current module and the
  meta in the object vector, which we pass to scm_c_make_program.

* libguile/vm-i-system.c (toplevel-ref, toplevel-set): Adapt to the new
  program representation.

* module/language/glil/compile-objcode.scm (codegen): Clarify.

libguile/objcodes.c

@@ -240,7 +240,7 @@ SCM_DEFINE (scm_objcode_to_program, "objcode->program", 1, 1, 0,
 
   base = SCM_OBJCODE_BASE (objcode);
   size = SCM_OBJCODE_SIZE (objcode);
-  prog = scm_c_make_program (base + 10, size - 10, objcode);
+  prog = scm_c_make_program (base + 10, size - 10, SCM_BOOL_F, objcode);
   p = SCM_PROGRAM_DATA (prog);
   p->nlocs = base[8];
   p->nexts = base[9];

libguile/programs.c

@@ -57,7 +57,7 @@ static SCM zero_vector;
 static SCM write_program = SCM_BOOL_F;
 
 SCM
-scm_c_make_program (void *addr, size_t size, SCM holder)
+scm_c_make_program (void *addr, size_t size, SCM objs, SCM holder)
 #define FUNC_NAME "scm_c_make_program"
 {
   struct scm_program *p = scm_gc_malloc (sizeof (struct scm_program),
@@ -67,11 +67,9 @@ scm_c_make_program (void *addr, size_t size, SCM holder)
   p->nrest    = 0;
   p->nlocs    = 0;
   p->nexts    = 0;
-  p->meta     = SCM_BOOL_F;
+  p->objs     = objs;
-  p->objs     = zero_vector;
   p->external = SCM_EOL;
   p->holder   = holder;
-  p->module   = scm_current_module ();
 
   /* If nobody holds bytecode's address, then allocate a new memory */
   if (SCM_FALSEP (holder)) 
@@ -89,22 +87,22 @@ scm_c_make_program (void *addr, size_t size, SCM holder)
 SCM
 scm_c_make_closure (SCM program, SCM external)
 {
-  SCM prog = scm_c_make_program (0, 0, program);
+  struct scm_program *p = scm_gc_malloc (sizeof (struct scm_program),
-  if (!SCM_PROGRAM_P (program))
+                                         "program");
-    abort ();
+  *p = *SCM_PROGRAM_DATA (program);
-  *SCM_PROGRAM_DATA (prog) = *SCM_PROGRAM_DATA (program);
+  p->holder = program;
-  SCM_PROGRAM_DATA (prog)->external = external;
+  p->external = external;
-  return prog;
+  SCM_RETURN_NEWSMOB (scm_tc16_program, p);
 }
 
 static SCM
 program_mark (SCM obj)
 {
   struct scm_program *p = SCM_PROGRAM_DATA (obj);
-  scm_gc_mark (p->meta);
+  if (scm_is_true (p->objs))
     scm_gc_mark (p->objs);
+  if (!scm_is_null (p->external))
     scm_gc_mark (p->external);
-  scm_gc_mark (p->module);
   return p->holder;
 }
 
@@ -194,8 +192,10 @@ SCM_DEFINE (scm_program_meta, "program-meta", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_program_meta
 {
+  SCM objs;
   SCM_VALIDATE_PROGRAM (1, program);
-  return SCM_PROGRAM_DATA (program)->meta;
+  objs = SCM_PROGRAM_DATA (program)->objs;
+  return scm_is_true (objs) ? scm_c_vector_ref (objs, 1) : SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
@@ -204,9 +204,12 @@ scm_c_program_source (struct scm_program *p, size_t ip)
 {
   SCM meta, sources, source;
 
-  if (scm_is_false (p->meta))
+  if (scm_is_false (p->objs))
     return SCM_BOOL_F;
-  meta = scm_call_0 (p->meta);
+  meta = scm_c_vector_ref (p->objs, 1);
+  if (scm_is_false (meta))
+    return SCM_BOOL_F;
+  meta = scm_call_0 (meta);
   if (scm_is_false (meta))
     return SCM_BOOL_F;
   sources = scm_cadr (meta);
@@ -232,8 +235,10 @@ SCM_DEFINE (scm_program_module, "program-module", 1, 0, 0,
 	    "")
 #define FUNC_NAME s_scm_program_module
 {
+  SCM objs;
   SCM_VALIDATE_PROGRAM (1, program);
-  return SCM_PROGRAM_DATA (program)->module;
+  objs = SCM_PROGRAM_DATA (program)->objs;
+  return scm_is_true (objs) ? scm_c_vector_ref (objs, 0) : SCM_BOOL_F;
 }
 #undef FUNC_NAME
 

libguile/programs.h

@@ -57,8 +57,6 @@ struct scm_program {
   unsigned char nlocs;		/* the number of local variables */
   unsigned char nexts;		/* the number of external variables */
   scm_byte_t *base;		/* program base address */
-  SCM module;			/* resolve bindings with respect to this module */
-  SCM meta;			/* meta data */
   SCM objs;			/* constant objects */
   SCM external;			/* external environment */
   SCM holder;			/* the owner of bytecode */
@@ -70,7 +68,7 @@ extern scm_t_bits scm_tc16_program;
 #define SCM_PROGRAM_DATA(x)	((struct scm_program *) SCM_SMOB_DATA (x))
 #define SCM_VALIDATE_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, PROGRAM_P)
 
-extern SCM scm_c_make_program (void *addr, size_t size, SCM holder);
+extern SCM scm_c_make_program (void *addr, size_t size, SCM objs, SCM holder);
 extern SCM scm_c_make_closure (SCM program, SCM external);
 
 extern SCM scm_program_p (SCM obj);

libguile/vm-engine.c

@@ -58,8 +58,7 @@ vm_run (SCM vm, SCM program, SCM args)
   struct scm_program *bp = NULL;	/* program base pointer */
   SCM external = SCM_EOL;		/* external environment */
   SCM *objects = NULL;			/* constant objects */
-  scm_t_array_handle objects_handle;    /* handle of the OBJECTS array */
+  size_t object_count = 0;              /* length of OBJECTS */
-  size_t object_count;                  /* length of OBJECTS */
   SCM *stack_base = vp->stack_base;	/* stack base address */
   SCM *stack_limit = vp->stack_limit;	/* stack limit address */
 
@@ -105,9 +104,7 @@ vm_run (SCM vm, SCM program, SCM args)
     SCM prog = program;
 
     /* Boot program */
-    scm_byte_t bytes[6] = {scm_op_mv_call, 0, 0, 1, scm_op_make_int8_1, scm_op_halt};
+    program = vm_make_boot_program (scm_ilength (args));
-    bytes[1] = scm_ilength (args); /* FIXME: argument overflow */
-    program = scm_c_make_program (bytes, 6, SCM_BOOL_F);
 
     /* Initial frame */
     CACHE_REGISTER ();
@@ -152,8 +149,6 @@ vm_run (SCM vm, SCM program, SCM args)
   vm_error_wrong_num_args:
     /* nargs and program are valid */
     SYNC_ALL ();
-    if (objects)
-      scm_array_handle_release (&objects_handle);
     scm_wrong_num_args (program);
     /* shouldn't get here */
     goto vm_error;
@@ -222,8 +217,6 @@ vm_run (SCM vm, SCM program, SCM args)
 
   vm_error:
     SYNC_ALL ();
-    if (objects)
-      scm_array_handle_release (&objects_handle);
 
     scm_ithrow (sym_vm_error, SCM_LIST3 (sym_vm_run, err_msg, err_args), 1);
   }

libguile/vm-engine.h

@@ -163,17 +163,15 @@
    call `scm_vector_writable_elements ()' and the likes.  */
 #define CACHE_PROGRAM()							\
 {									\
-  ssize_t _vincr;							\
-									\
   if (bp != SCM_PROGRAM_DATA (program)) {                               \
     bp = SCM_PROGRAM_DATA (program);					\
-    /* Was: objects = SCM_VELTS (bp->objs); */				\
+    if (SCM_I_IS_VECTOR (bp->objs)) {                                   \
-									\
+      objects = SCM_I_VECTOR_WELTS (bp->objs);                          \
-    if (objects)                                                        \
+      object_count = SCM_I_VECTOR_LENGTH (bp->objs);                    \
-      scm_array_handle_release (&objects_handle);                       \
+    } else {                                                            \
-									\
+      objects = NULL;                                                   \
-    objects = scm_vector_writable_elements (bp->objs, &objects_handle,	\
+      object_count = 0;                                                 \
-                                            &object_count, &_vincr);	\
+    }                                                                   \
   }                                                                     \
 }
 

libguile/vm-i-loader.c

@@ -106,37 +106,33 @@ VM_DEFINE_LOADER (load_keyword, "load-keyword")
 VM_DEFINE_LOADER (load_program, "load-program")
 {
   size_t len;
-  SCM prog, x;
+  SCM prog, x, objs = SCM_BOOL_F, meta = SCM_BOOL_F;
   struct scm_program *p;
 
-  FETCH_LENGTH (len);
-  SYNC_REGISTER ();
-  prog = scm_c_make_program (ip, len, program);
-  p = SCM_PROGRAM_DATA (prog);
-  ip += len;
-
   POP (x);
 
   /* init meta data */
   if (SCM_PROGRAM_P (x))
     {
-      p->meta = x;
+      meta = x;
       POP (x);
     }
 
   /* init object table */
   if (scm_is_vector (x))
     {
-#if 0
+      objs = x;
-      if (scm_is_simple_vector (x))
+      scm_c_vector_set_x (objs, 0, scm_current_module ());
-	printf ("is_simple_vector!\n");
+      scm_c_vector_set_x (objs, 1, meta);
-      else
-	printf ("NOT is_simple_vector\n");
-#endif
-      p->objs = x;
       POP (x);
     }
 
+  FETCH_LENGTH (len);
+  SYNC_REGISTER ();
+  prog = scm_c_make_program (ip, len, objs, program);
+  p = SCM_PROGRAM_DATA (prog);
+  ip += len;
+
   /* init parameters */
   /* NOTE: format defined in system/vm/assemble.scm */
   if (SCM_I_INUMP (x))

libguile/vm-i-system.c

@@ -297,10 +297,11 @@ VM_DEFINE_INSTRUCTION (toplevel_ref, "toplevel-ref", 1, 0, 1)
       SYNC_REGISTER ();
       if (SCM_LIKELY (SCM_SYMBOLP (what))) 
         {
+          SCM mod;
           if (SCM_LIKELY (scm_module_system_booted_p
-                          && scm_is_true (bp->module)))
+                          && scm_is_true ((mod = scm_program_module (program)))))
             /* might longjmp */
-            what = scm_module_lookup (bp->module, what);
+            what = scm_module_lookup (mod, what);
           else
             what = scm_sym2var (what, SCM_BOOL_F, SCM_BOOL_F);
         }
@@ -379,10 +380,11 @@ VM_DEFINE_INSTRUCTION (toplevel_set, "toplevel-set", 1, 1, 0)
       SYNC_BEFORE_GC ();
       if (SCM_LIKELY (SCM_SYMBOLP (what))) 
         {
+          SCM mod;
           if (SCM_LIKELY (scm_module_system_booted_p
-                          && scm_is_true (bp->module)))
+                          && scm_is_true ((mod = scm_program_module (program)))))
             /* might longjmp */
-            what = scm_module_lookup (bp->module, what);
+            what = scm_module_lookup (mod, what);
           else
             what = scm_sym2var (what, SCM_BOOL_F, SCM_BOOL_F);
         }

libguile/vm.c

@@ -282,6 +282,16 @@ vm_fetch_length (scm_byte_t *ip, size_t *lenp)
   return ip;
 }
 
+static SCM
+vm_make_boot_program (long len)
+{
+  scm_byte_t bytes[6] = {scm_op_mv_call, 0, 0, 1, scm_op_make_int8_1, scm_op_halt};
+  if (SCM_UNLIKELY (len > 255 || len < 0))
+    abort ();
+  bytes[1] = (scm_byte_t)len;
+  return scm_c_make_program (bytes, 6, SCM_BOOL_F, SCM_BOOL_F);
+}
+
 
 /*
  * VM

module/language/glil/compile-objcode.scm

@@ -115,8 +115,9 @@
 	   (closed-bindings '())
 	   (source-alist '())
 	   (label-alist '())
-           ;; the pre-elements are prepended to the object vector
+           ;; the pre-elements are prepended to the object vector in
-           ;; in practice these are placeholders for module & meta.
+           ;; practice these are placeholders for module & meta,
+           ;; respectively.
            (object-pre-elements '(#f #f))
 	   (object-alist '()))
        (define (object-index obj)