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,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, 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 */ /* @@ -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 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;