summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/programs.c16
-rw-r--r--src/programs.h1
-rw-r--r--src/vm_engine.c31
-rw-r--r--src/vm_engine.h62
-rw-r--r--src/vm_loader.c8
-rw-r--r--src/vm_system.c6
6 files changed, 70 insertions, 54 deletions
diff --git a/src/programs.c b/src/programs.c
index d6d7ab8e2..2bc4611fa 100644
--- a/src/programs.c
+++ b/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;
- struct scm_program *q = SCM_PROGRAM_DATA (program);
- SCM prog = scm_c_make_program (q->base, q->size, program);
- 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;
+ SCM prog = scm_c_make_program (0, 0, program);
+ *SCM_PROGRAM_DATA (prog) = *SCM_PROGRAM_DATA (program);
+ SCM_PROGRAM_EXTERNAL (prog) = 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;
diff --git a/src/programs.h b/src/programs.h
index f5fa3be03..bbea84105 100644
--- a/src/programs.h
+++ b/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 */
diff --git a/src/vm_engine.c b/src/vm_engine.c
index dc02f8fdf..30b8a5873 100644
--- a/src/vm_engine.c
+++ b/src/vm_engine.c
@@ -123,40 +123,47 @@ 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");
+ vm_error_stack_overflow:
+ err_msg = scm_makfrom0str ("VM: Stack overflow");
err_args = SCM_EOL;
goto vm_error;
-#endif
- vm_error_stack_overflow:
- err_msg = scm_makfrom0str ("Stack overflow");
+ vm_error_stack_underflow:
+ err_msg = scm_makfrom0str ("VM: Stack underflow");
err_args = SCM_EOL;
goto vm_error;
- vm_error_stack_underflow:
- err_msg = scm_makfrom0str ("Stack underflow");
+#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 ();
diff --git a/src/vm_engine.h b/src/vm_engine.h
index 313c5dca6..75d275f1c 100644
--- a/src/vm_engine.h
+++ b/src/vm_engine.h
@@ -45,8 +45,9 @@
* Options
*/
-#define VM_USE_HOOKS 1 /* Various hooks */
-#define VM_USE_CLOCK 1 /* Bogoclock */
+#define VM_USE_HOOKS 1 /* Various hooks */
+#define VM_USE_CLOCK 1 /* Bogoclock */
+#define VM_CHECK_EXTERNAL 1 /* Check external link */
/*
@@ -147,6 +148,19 @@
/*
+ * 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 HALT_HOOK() RUN_HOOK (vp->hooks[SCM_VM_HALT_HOOK])
-#define NEXT_HOOK() RUN_HOOK (vp->hooks[SCM_VM_NEXT_HOOK])
-#define ENTER_HOOK() RUN_HOOK (vp->hooks[SCM_VM_ENTER_HOOK])
-#define APPLY_HOOK() RUN_HOOK (vp->hooks[SCM_VM_APPLY_HOOK])
-#define EXIT_HOOK() RUN_HOOK (vp->hooks[SCM_VM_EXIT_HOOK])
-#define RETURN_HOOK() RUN_HOOK (vp->hooks[SCM_VM_RETURN_HOOK])
+#define BOOT_HOOK() RUN_HOOK (SCM_VM_BOOT_HOOK)
+#define HALT_HOOK() RUN_HOOK (SCM_VM_HALT_HOOK)
+#define NEXT_HOOK() RUN_HOOK (SCM_VM_NEXT_HOOK)
+#define ENTER_HOOK() RUN_HOOK (SCM_VM_ENTER_HOOK)
+#define APPLY_HOOK() RUN_HOOK (SCM_VM_APPLY_HOOK)
+#define EXIT_HOOK() RUN_HOOK (SCM_VM_EXIT_HOOK)
+#define RETURN_HOOK() RUN_HOOK (SCM_VM_RETURN_HOOK)
/*
@@ -253,18 +267,7 @@ do { \
/*
- * 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)
-
-
-/*
- * Frame allocation
+ * Stack frame
*/
#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"
diff --git a/src/vm_loader.c b/src/vm_loader.c
index 899e9928f..fe7e2b518 100644
--- a/src/vm_loader.c
+++ b/src/vm_loader.c
@@ -132,7 +132,7 @@ VM_DEFINE_LOADER (load_program, "load-program")
{
/* 8-bit representation */
SCM_PROGRAM_NARGS (prog) = (i >> 6) & 0x03; /* 7-6 bits */
- SCM_PROGRAM_NREST (prog) = (i >> 5) & 0x01; /* 5 bit */
+ SCM_PROGRAM_NREST (prog) = (i >> 5) & 0x01; /* 5 bit */
SCM_PROGRAM_NLOCS (prog) = (i >> 2) & 0x07; /* 4-2 bits */
SCM_PROGRAM_NEXTS (prog) = i & 0x03; /* 1-0 bits */
}
@@ -140,9 +140,9 @@ 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_NEXTS (prog) = i & 0x0f; /* 3-0 bits */
+ SCM_PROGRAM_NREST (prog) = (i >> 11) & 0x01; /* 11 bit */
+ SCM_PROGRAM_NLOCS (prog) = (i >> 4) & 0x7f; /* 10-04 bits */
+ SCM_PROGRAM_NEXTS (prog) = i & 0x0f; /* 03-00 bits */
}
}
else
diff --git a/src/vm_system.c b/src/vm_system.c
index a8b887ea1..12aa02f72 100644
--- a/src/vm_system.c
+++ b/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--)
- e = SCM_CDR (e);
+ {
+ CHECK_EXTERNAL(e);
+ e = SCM_CDR (e);
+ }
+ CHECK_EXTERNAL(e);
SCM_SETCAR (e, *sp);
DROP ();
NEXT;