*** empty log message ***

src/programs.c

@@ -59,7 +59,6 @@ scm_c_make_program (void *addr, size_t size, SCM holder)
   p->nrest    = 0;
   p->nlocs    = 0;
   p->nexts    = 0;
-  p->meta     = SCM_EOL;
   p->objs     = zero_vector;
   p->external = SCM_EOL;
   p->holder   = holder;
@@ -77,17 +76,9 @@ scm_c_make_program (void *addr, size_t size, SCM holder)
 SCM
 scm_c_make_closure (SCM program, SCM external)
 {
-  struct scm_program *p;
+  SCM prog = scm_c_make_program (0, 0, program);
-  struct scm_program *q = SCM_PROGRAM_DATA (program);
+  *SCM_PROGRAM_DATA (prog) = *SCM_PROGRAM_DATA (program);
-  SCM prog = scm_c_make_program (q->base, q->size, program);
+  SCM_PROGRAM_EXTERNAL (prog) = external;
-  p = SCM_PROGRAM_DATA (prog);
-  p->nargs    = q->nargs;
-  p->nrest    = q->nrest;
-  p->nlocs    = q->nlocs;
-  p->nexts    = q->nexts;
-  p->meta     = q->meta;
-  p->objs     = q->objs;
-  p->external = external;
   return prog;
 }
 
@@ -95,7 +86,6 @@ static SCM
 program_mark (SCM obj)
 {
   struct scm_program *p = SCM_PROGRAM_DATA (obj);
-  scm_gc_mark (p->meta);
   scm_gc_mark (p->objs);
   scm_gc_mark (p->external);
   return p->holder;

src/programs.h

@@ -58,7 +58,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 meta;			/* meta information */
   SCM objs;			/* constant objects */
   SCM external;			/* external environment */
   SCM holder;			/* the owner of bytecode */

src/vm_engine.c

@@ -123,41 +123,48 @@ vm_run (SCM vm, SCM program, SCM args)
   /* Errors */
   {
   vm_error_unbound:
-    err_msg  = scm_makfrom0str ("Unbound variable: ~A");
+    err_msg  = scm_makfrom0str ("VM: Unbound variable: ~A");
     goto vm_error;
 
   vm_error_wrong_type_arg:
-    err_msg  = scm_makfrom0str ("Wrong type argument");
+    err_msg  = scm_makfrom0str ("VM: Wrong type argument");
     err_args = SCM_EOL;
     goto vm_error;
 
   vm_error_wrong_num_args:
-    err_msg  = scm_makfrom0str ("Wrong number of arguments");
+    err_msg  = scm_makfrom0str ("VM: Wrong number of arguments");
     err_args = SCM_EOL;
     goto vm_error;
 
   vm_error_wrong_type_apply:
-    err_msg  = scm_makfrom0str ("Wrong type to apply: ~S");
+    err_msg  = scm_makfrom0str ("VM: Wrong type to apply: ~S");
     err_args = SCM_LIST1 (program);
     goto vm_error;
 
-#if VM_CHECK_IP
-  vm_error_invalid_address:
-    err_msg  = scm_makfrom0str ("Invalid program address");
-    err_args = SCM_EOL;
-    goto vm_error;
-#endif
-
   vm_error_stack_overflow:
-    err_msg  = scm_makfrom0str ("Stack overflow");
+    err_msg  = scm_makfrom0str ("VM: Stack overflow");
     err_args = SCM_EOL;
     goto vm_error;
 
   vm_error_stack_underflow:
-    err_msg  = scm_makfrom0str ("Stack underflow");
+    err_msg  = scm_makfrom0str ("VM: Stack underflow");
     err_args = SCM_EOL;
     goto vm_error;
 
+#if VM_CHECK_IP
+  vm_error_invalid_address:
+    err_msg  = scm_makfrom0str ("VM: Invalid program address");
+    err_args = SCM_EOL;
+    goto vm_error;
+#endif
+
+#if VM_CHECK_EXTERNAL
+  vm_error_external:
+    err_msg  = scm_makfrom0str ("VM: Invalid external access");
+    err_args = SCM_EOL;
+    goto vm_error;
+#endif
+
   vm_error:
     SYNC_ALL ();
     scm_ithrow (sym_vm_error,

src/vm_engine.h

@@ -47,6 +47,7 @@
 
 #define VM_USE_HOOKS		1	/* Various hooks */
 #define VM_USE_CLOCK		1	/* Bogoclock */
+#define VM_CHECK_EXTERNAL	1	/* Check external link */
 
 
 /*
@@ -145,6 +146,19 @@
   SYNC_REGISTER ();				\
 }
 
+
+/*
+ * Error check
+ */
+
+#undef CHECK_EXTERNAL
+#if VM_CHECK_EXTERNAL
+#define CHECK_EXTERNAL(e) \
+  do { if (!SCM_CONSP (e)) goto vm_error_external; } while (0)
+#else
+#define CHECK_EXTERNAL(e)
+#endif
+
 
 /*
  * Hooks
@@ -154,23 +168,23 @@
 #if VM_USE_HOOKS
 #define RUN_HOOK(h)				\
 {						\
-  if (!SCM_FALSEP (h))				\
+  if (!SCM_FALSEP (vp->hooks[h]))		\
     {						\
       SYNC_BEFORE_GC ();			\
-      scm_c_run_hook (h, hook_args);		\
+      scm_c_run_hook (vp->hooks[h], hook_args);	\
     }						\
 }
 #else
 #define RUN_HOOK(h)
 #endif
 
-#define BOOT_HOOK()	RUN_HOOK (vp->hooks[SCM_VM_BOOT_HOOK])
+#define BOOT_HOOK()	RUN_HOOK (SCM_VM_BOOT_HOOK)
-#define HALT_HOOK()	RUN_HOOK (vp->hooks[SCM_VM_HALT_HOOK])
+#define HALT_HOOK()	RUN_HOOK (SCM_VM_HALT_HOOK)
-#define NEXT_HOOK()	RUN_HOOK (vp->hooks[SCM_VM_NEXT_HOOK])
+#define NEXT_HOOK()	RUN_HOOK (SCM_VM_NEXT_HOOK)
-#define ENTER_HOOK()	RUN_HOOK (vp->hooks[SCM_VM_ENTER_HOOK])
+#define ENTER_HOOK()	RUN_HOOK (SCM_VM_ENTER_HOOK)
-#define APPLY_HOOK()	RUN_HOOK (vp->hooks[SCM_VM_APPLY_HOOK])
+#define APPLY_HOOK()	RUN_HOOK (SCM_VM_APPLY_HOOK)
-#define EXIT_HOOK()	RUN_HOOK (vp->hooks[SCM_VM_EXIT_HOOK])
+#define EXIT_HOOK()	RUN_HOOK (SCM_VM_EXIT_HOOK)
-#define RETURN_HOOK()	RUN_HOOK (vp->hooks[SCM_VM_RETURN_HOOK])
+#define RETURN_HOOK()	RUN_HOOK (SCM_VM_RETURN_HOOK)
 
 
 /*
@@ -253,18 +267,7 @@ do {						\
 
 
 /*
- * Function support
+ * Stack frame
- */
-
-#define ARGS1(a1)	SCM a1 = sp[0];
-#define ARGS2(a1,a2)	SCM a1 = sp[-1], a2 = sp[0]; sp--;
-#define ARGS3(a1,a2,a3)	SCM a1 = sp[-2], a2 = sp[-1], a3 = sp[0]; sp -= 2;
-
-#define RETURN(x)	do { *sp = x; NEXT; } while (0)
-
-
-/*
- * Frame allocation
  */
 
 #define INIT_ARGS()				\
@@ -307,6 +310,8 @@ do {						\
   external = bp->external;			\
   for (i = 0; i < bp->nexts; i++)		\
     CONS (external, SCM_UNDEFINED, external);	\
+						\
+  /* Set frame data */				\
   p[0] = external;				\
   p[1] = dl;					\
   p[2] = ra;					\
@@ -320,6 +325,17 @@ do {						\
   fp = SCM_VM_STACK_ADDRESS (p[1]);		\
 }
 
+
+/*
+ * Function support
+ */
+
+#define ARGS1(a1)	SCM a1 = sp[0];
+#define ARGS2(a1,a2)	SCM a1 = sp[-1], a2 = sp[0]; sp--;
+#define ARGS3(a1,a2,a3)	SCM a1 = sp[-2], a2 = sp[-1], a3 = sp[0]; sp -= 2;
+
+#define RETURN(x)	do { *sp = x; NEXT; } while (0)
+
 /*
   Local Variables:
   c-file-style: "gnu"

src/vm_loader.c

@@ -141,8 +141,8 @@ VM_DEFINE_LOADER (load_program, "load-program")
 	  /* 16-bit representation */
 	  SCM_PROGRAM_NARGS (prog) = (i >> 12) & 0x07;	/* 15-12 bits */
 	  SCM_PROGRAM_NREST (prog) = (i >> 11) & 0x01;	/*    11 bit  */
-	  SCM_PROGRAM_NLOCS (prog) = (i >> 4)  & 0x7f;	/* 10-4 bits */
+	  SCM_PROGRAM_NLOCS (prog) = (i >> 4)  & 0x7f;	/* 10-04 bits */
-	  SCM_PROGRAM_NEXTS (prog) = i & 0x0f;		/* 3-0 bits */
+	  SCM_PROGRAM_NEXTS (prog) = i & 0x0f;		/* 03-00 bits */
 	}
     }
   else

src/vm_system.c

@@ -248,7 +248,11 @@ VM_DEFINE_INSTRUCTION (external_set, "external-set", 1, 1, 0)
   unsigned int i;
   SCM e = external;
   for (i = FETCH (); i; i--)
+    {
+      CHECK_EXTERNAL(e);
       e = SCM_CDR (e);
+    }
+  CHECK_EXTERNAL(e);
   SCM_SETCAR (e, *sp);
   DROP ();
   NEXT;