mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

*** empty log message ***

Browse source
This commit is contained in:
Keisuke Nishida 2001-04-20 18:35:59 +00:00
parent 2a63758b46
commit ac02b386c2
6 changed files with 71 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

16
src/programs.c
View file

@ -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;

1
src/programs.h
View file

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

33
src/vm_engine.c
View file

@ -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,

62
src/vm_engine.h
View file

@ -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"

8
src/vm_loader.c
View file

@ -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

6
src/vm_system.c
View file

@ -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;