mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-18 18:40:22 +02:00
Code Activity

*** empty log message ***

Browse source
This commit is contained in:
Keisuke Nishida 2001-04-07 09:39:38 +00:00
parent 4bfb26f58f
commit 3616e9e963
17 changed files with 248 additions and 205 deletions
Download patch file Download diff file Expand all files Collapse all files

117
src/vm.c
View file

@ -54,39 +54,30 @@
/*
* VM Debug frame
* VM Heap frame
*/
scm_bits_t scm_tc16_vm_debug_frame;
scm_bits_t scm_tc16_vm_heap_frame;
static SCM
make_vm_debug_frame (SCM *fp)
make_vm_heap_frame (SCM *fp)
{
int i, size;
struct scm_vm_debug_frame *p;
if (!fp)
return SCM_BOOL_F;
p = scm_must_malloc (sizeof (struct scm_vm_debug_frame), "make_vm_debug_frame");
p->program = SCM_VM_FRAME_PROGRAM (fp);
p->dynamic_link = make_vm_debug_frame (SCM_VM_FRAME_ADDRESS
(SCM_VM_FRAME_DYNAMIC_LINK (fp)));
size = SCM_PROGRAM_NARGS (p->program) + SCM_PROGRAM_NLOCS (p->program);
p->variables = scm_make_vector (SCM_MAKINUM (size), SCM_BOOL_F);
for (i = 0; i < size; i++)
SCM_VELTS (p->variables)[i] = SCM_VM_FRAME_VARIABLE (fp, i);
SCM_RETURN_NEWSMOB (scm_tc16_vm_debug_frame, p);
struct scm_vm_heap_frame *p =
scm_must_malloc (sizeof (struct scm_vm_heap_frame), "make_vm_heap_frame");
p->fp = fp;
p->program = SCM_UNDEFINED;
p->variables = SCM_UNDEFINED;
p->dynamic_link = SCM_UNDEFINED;
SCM_RETURN_NEWSMOB (scm_tc16_vm_heap_frame, p);
}
static SCM
vm_debug_frame_mark (SCM obj)
vm_heap_frame_mark (SCM obj)
{
scm_gc_mark (SCM_VM_DEBUG_FRAME_PROGRAM (obj));
scm_gc_mark (SCM_VM_DEBUG_FRAME_VARIABLES (obj));
return SCM_VM_DEBUG_FRAME_DYNAMIC_LINK (obj);
struct scm_vm_heap_frame *p = SCM_VM_HEAP_FRAME_DATA (obj);
scm_gc_mark (p->program);
scm_gc_mark (p->variables);
return p->dynamic_link;
}
/* Scheme interface */
@ -96,7 +87,7 @@ SCM_DEFINE (scm_frame_p, "frame?", 1, 0, 0,
"")
#define FUNC_NAME s_scm_frame_p
{
return SCM_BOOL (SCM_VM_DEBUG_FRAME_P (obj));
return SCM_BOOL (SCM_VM_HEAP_FRAME_P (obj));
}
#undef FUNC_NAME
@ -105,8 +96,8 @@ SCM_DEFINE (scm_frame_program, "frame-program", 1, 0, 0,
"")
#define FUNC_NAME s_scm_frame_program
{
SCM_VALIDATE_VM_DEBUG_FRAME (1, frame);
return SCM_VM_DEBUG_FRAME_PROGRAM (frame);
SCM_VALIDATE_VM_HEAP_FRAME (1, frame);
return SCM_VM_FRAME_PROGRAM (SCM_VM_HEAP_FRAME_DATA (frame)->fp);
}
#undef FUNC_NAME
@ -115,8 +106,20 @@ SCM_DEFINE (scm_frame_variables, "frame-variables", 1, 0, 0,
"")
#define FUNC_NAME s_scm_frame_variables
{
SCM_VALIDATE_VM_DEBUG_FRAME (1, frame);
return SCM_VM_DEBUG_FRAME_VARIABLES (frame);
struct scm_vm_heap_frame *p;
SCM_VALIDATE_VM_HEAP_FRAME (1, frame);
p = SCM_VM_HEAP_FRAME_DATA (frame);
if (SCM_UNBNDP (p->variables))
{
SCM prog = scm_frame_program (frame);
int i, size = SCM_PROGRAM_NARGS (prog) + SCM_PROGRAM_NLOCS (prog);
p->variables = scm_make_vector (SCM_MAKINUM (size), SCM_BOOL_F);
for (i = 0; i < size; i++)
SCM_VELTS (p->variables)[i] = SCM_VM_FRAME_VARIABLE (p->fp, i);
}
return p->variables;
}
#undef FUNC_NAME
@ -125,8 +128,21 @@ SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0,
"")
#define FUNC_NAME s_scm_frame_dynamic_link
{
SCM_VALIDATE_VM_DEBUG_FRAME (1, frame);
return SCM_VM_DEBUG_FRAME_DYNAMIC_LINK (frame);
struct scm_vm_heap_frame *p;
SCM_VALIDATE_VM_HEAP_FRAME (1, frame);
p = SCM_VM_HEAP_FRAME_DATA (frame);
if (SCM_UNBNDP (p->dynamic_link))
{
SCM *fp = SCM_VM_STACK_ADDRESS (SCM_VM_FRAME_DYNAMIC_LINK (p->fp));
if (fp)
p->dynamic_link = make_vm_heap_frame (fp);
else
p->dynamic_link = SCM_BOOL_F;
}
return p->dynamic_link;
}
#undef FUNC_NAME
@ -260,10 +276,10 @@ make_vm (void)
struct scm_vm *vp = SCM_MUST_MALLOC (sizeof (struct scm_vm));
vp->stack_size = VM_DEFAULT_STACK_SIZE;
vp->stack_base = SCM_MUST_MALLOC (vp->stack_size * sizeof (SCM));
vp->stack_limit = vp->stack_base + vp->stack_size;
vp->ip = NULL;
vp->sp = vp->stack_limit;
vp->fp = NULL;
vp->stack_limit = vp->stack_base + vp->stack_size - 3;
vp->ip = NULL;
vp->sp = vp->stack_base - 1;
vp->fp = NULL;
vp->time = 0;
vp->clock = 0;
vp->options = SCM_EOL;
@ -288,16 +304,14 @@ vm_mark (SCM obj)
SCM *upper = SCM_VM_FRAME_UPPER_ADDRESS (fp);
SCM *lower = SCM_VM_FRAME_LOWER_ADDRESS (fp);
/* Mark intermediate data */
for (; sp < lower; sp++)
for (; sp >= upper; sp--)
if (SCM_NIMP (*sp))
scm_gc_mark (*sp);
/* Mark frame data */
scm_gc_mark (SCM_VM_FRAME_PROGRAM (fp));
/* Mark frame variables */
for (sp = fp; sp < upper; sp++)
fp = SCM_VM_STACK_ADDRESS (*sp); /* dynamic link */
/* Mark frame variables + program */
for (sp -= 2; sp >= lower; sp--)
if (SCM_NIMP (*sp))
scm_gc_mark (*sp);
fp = SCM_VM_FRAME_ADDRESS (SCM_VM_FRAME_DYNAMIC_LINK (fp));
}
/* Mark the options */
@ -519,7 +533,7 @@ SCM_DEFINE (scm_vm_current_frame, "vm-current-frame", 1, 0, 0,
{
SCM_VALIDATE_VM (1, vm);
VM_CHECK_RUNNING (vm);
return make_vm_debug_frame (SCM_VM_DATA (vm)->fp);
return make_vm_heap_frame (SCM_VM_DATA (vm)->fp);
}
#undef FUNC_NAME
@ -551,18 +565,17 @@ SCM_DEFINE (scm_vm_fetch_stack, "vm-fetch-stack", 1, 0, 0,
"")
#define FUNC_NAME s_scm_vm_fetch_stack
{
SCM *p;
SCM list = SCM_EOL;
SCM *sp;
SCM ls = SCM_EOL;
struct scm_vm *vp;
SCM_VALIDATE_VM (1, vm);
VM_CHECK_RUNNING (vm);
if (SCM_VM_DATA (vm)->fp)
for (p = SCM_VM_FRAME_LOWER_ADDRESS (SCM_VM_DATA (vm)->fp) - 1;
p >= SCM_VM_DATA (vm)->sp;
p--)
list = scm_cons (*p, list);
return list;
vp = SCM_VM_DATA (vm);
for (sp = SCM_VM_FRAME_UPPER_ADDRESS (vp->fp); sp <= vp->sp; sp++)
ls = scm_cons (*sp, ls);
return ls;
}
#undef FUNC_NAME
@ -606,8 +619,8 @@ scm_init_vm (void)
scm_init_instructions ();
scm_init_programs ();
scm_tc16_vm_debug_frame = scm_make_smob_type ("vm_frame", 0);
scm_set_smob_mark (scm_tc16_vm_debug_frame, vm_debug_frame_mark);
scm_tc16_vm_heap_frame = scm_make_smob_type ("vm_frame", 0);
scm_set_smob_mark (scm_tc16_vm_heap_frame, vm_heap_frame_mark);
scm_tc16_vm_cont = scm_make_smob_type ("vm-cont", 0);
scm_set_smob_mark (scm_tc16_vm_cont, vm_cont_mark);