diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/frames.c | 110 | ||||
-rw-r--r-- | src/frames.h | 68 | ||||
-rw-r--r-- | src/vm.c | 95 | ||||
-rw-r--r-- | src/vm.h | 5 | ||||
-rw-r--r-- | src/vm_engine.c | 2 | ||||
-rw-r--r-- | src/vm_engine.h | 26 | ||||
-rw-r--r-- | src/vm_system.c | 12 |
7 files changed, 173 insertions, 145 deletions
diff --git a/src/frames.c b/src/frames.c index 382342008..d5525b76f 100644 --- a/src/frames.c +++ b/src/frames.c @@ -48,24 +48,40 @@ scm_bits_t scm_tc16_heap_frame; SCM scm_c_make_heap_frame (SCM *fp) { - struct scm_heap_frame *p = - scm_must_malloc (sizeof (struct scm_heap_frame), "make_heap_frame"); - p->fp = fp; - p->program = SCM_UNDEFINED; - p->variables = SCM_UNDEFINED; - p->dynamic_link = SCM_UNDEFINED; - p->external_link = SCM_UNDEFINED; - SCM_RETURN_NEWSMOB (scm_tc16_heap_frame, p); + SCM frame; + SCM *lower = SCM_FRAME_LOWER_ADDRESS (fp); + SCM *upper = SCM_FRAME_UPPER_ADDRESS (fp); + size_t size = sizeof (SCM) * (upper - lower + 1); + SCM *p = scm_must_malloc (size, "scm_c_make_heap_frame"); + SCM_NEWSMOB (frame, scm_tc16_heap_frame, p); + p[0] = frame; /* self link */ + memcpy (p + 1, lower, size - sizeof (SCM)); + return frame; } static SCM heap_frame_mark (SCM obj) { - struct scm_heap_frame *p = SCM_HEAP_FRAME_DATA (obj); - scm_gc_mark (p->program); - scm_gc_mark (p->variables); - scm_gc_mark (p->dynamic_link); - return p->external_link; + SCM *sp; + SCM *fp = SCM_HEAP_FRAME_POINTER (obj); + SCM *limit = &SCM_FRAME_HEAP_LINK (fp); + + for (sp = SCM_FRAME_LOWER_ADDRESS (fp); sp <= limit; sp++) + if (SCM_NIMP (*sp)) + scm_gc_mark (*sp); + + return SCM_BOOL_F; +} + +static scm_sizet +heap_frame_free (SCM obj) +{ + SCM *fp = SCM_HEAP_FRAME_POINTER (obj); + SCM *lower = SCM_FRAME_LOWER_ADDRESS (fp); + SCM *upper = SCM_FRAME_UPPER_ADDRESS (fp); + size_t size = sizeof (SCM) * (upper - lower + 1); + scm_must_free (SCM_HEAP_FRAME_DATA (obj)); + return size; } /* Scheme interface */ @@ -85,30 +101,31 @@ SCM_DEFINE (scm_frame_program, "frame-program", 1, 0, 0, #define FUNC_NAME s_scm_frame_program { SCM_VALIDATE_HEAP_FRAME (1, frame); - return SCM_STACK_FRAME_PROGRAM (SCM_HEAP_FRAME_DATA (frame)->fp); + return SCM_FRAME_PROGRAM (SCM_HEAP_FRAME_POINTER (frame)); } #undef FUNC_NAME -SCM_DEFINE (scm_frame_local_variables, "frame-local-variables", 1, 0, 0, - (SCM frame), +SCM_DEFINE (scm_frame_local_ref, "frame-local-ref", 2, 0, 0, + (SCM frame, SCM index), "") -#define FUNC_NAME s_scm_frame_local_variables +#define FUNC_NAME s_scm_frame_local_ref { - struct scm_heap_frame *p; + SCM_VALIDATE_HEAP_FRAME (1, frame); + SCM_VALIDATE_INUM (2, index); /* FIXME: Check the range! */ + return SCM_FRAME_VARIABLE (SCM_HEAP_FRAME_POINTER (frame), + SCM_INUM (index)); +} +#undef FUNC_NAME +SCM_DEFINE (scm_frame_local_set_x, "frame-local-set!", 3, 0, 0, + (SCM frame, SCM index, SCM val), + "") +#define FUNC_NAME s_scm_frame_local_set_x +{ SCM_VALIDATE_HEAP_FRAME (1, frame); - p = SCM_HEAP_FRAME_DATA (frame); - - if (SCM_UNBNDP (p->variables)) - { - SCM prog = scm_frame_program (frame); - struct scm_program *pp = SCM_PROGRAM_DATA (prog); - int i, size = pp->nargs + pp->nlocs; - p->variables = scm_make_vector (SCM_MAKINUM (size), SCM_BOOL_F); - for (i = 0; i < size; i++) - SCM_VELTS (p->variables)[i] = SCM_STACK_FRAME_VARIABLE (p->fp, i); - } - return p->variables; + SCM_VALIDATE_INUM (2, index); /* FIXME: Check the range! */ + SCM_FRAME_VARIABLE (SCM_HEAP_FRAME_POINTER (frame), SCM_INUM (index)) = val; + return SCM_UNSPECIFIED; } #undef FUNC_NAME @@ -118,10 +135,8 @@ SCM_DEFINE (scm_frame_return_address, "frame-return-address", 1, 0, 0, #define FUNC_NAME s_scm_frame_return_address { SCM_VALIDATE_HEAP_FRAME (1, frame); - - return scm_long2num ((long) SCM_VM_BYTE_ADDRESS - (SCM_STACK_FRAME_RETURN_ADDRESS - (SCM_HEAP_FRAME_DATA (frame)->fp))); + return scm_ulong2num ((unsigned long) (SCM_FRAME_RETURN_ADDRESS + (SCM_HEAP_FRAME_POINTER (frame)))); } #undef FUNC_NAME @@ -130,21 +145,8 @@ SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0, "") #define FUNC_NAME s_scm_frame_dynamic_link { - struct scm_heap_frame *p; - SCM_VALIDATE_HEAP_FRAME (1, frame); - p = SCM_HEAP_FRAME_DATA (frame); - - if (SCM_UNBNDP (p->dynamic_link)) - { - SCM *fp = SCM_VM_STACK_ADDRESS (SCM_STACK_FRAME_DYNAMIC_LINK (p->fp)); - if (fp) - p->dynamic_link = scm_c_make_heap_frame (fp); - else - p->dynamic_link = SCM_BOOL_F; - } - - return p->dynamic_link; + return SCM_FRAME_HEAP_LINK (SCM_HEAP_FRAME_POINTER (frame)); } #undef FUNC_NAME @@ -153,15 +155,8 @@ SCM_DEFINE (scm_frame_external_link, "frame-external-link", 1, 0, 0, "") #define FUNC_NAME s_scm_frame_external_link { - struct scm_heap_frame *p; - SCM_VALIDATE_HEAP_FRAME (1, frame); - p = SCM_HEAP_FRAME_DATA (frame); - - if (SCM_UNBNDP (p->external_link)) - p->external_link = SCM_STACK_FRAME_EXTERNAL_LINK (p->fp); - - return p->external_link; + return SCM_FRAME_EXTERNAL_LINK (SCM_HEAP_FRAME_POINTER (frame)); } #undef FUNC_NAME @@ -169,8 +164,9 @@ SCM_DEFINE (scm_frame_external_link, "frame-external-link", 1, 0, 0, void scm_init_frames (void) { - scm_tc16_heap_frame = scm_make_smob_type ("heap_frame", 0); + scm_tc16_heap_frame = scm_make_smob_type ("frame", 0); scm_set_smob_mark (scm_tc16_heap_frame, heap_frame_mark); + scm_set_smob_free (scm_tc16_heap_frame, heap_frame_free); #ifndef SCM_MAGIC_SNARFER #include "frames.x" diff --git a/src/frames.h b/src/frames.h index ed28e56a8..823930bc0 100644 --- a/src/frames.h +++ b/src/frames.h @@ -46,74 +46,56 @@ #include "config.h" #include "programs.h" -/* - * VM Address - */ - -#define SCM_VM_MAKE_STACK_ADDRESS(ptr) SCM_PACK (ptr) -#define SCM_VM_STACK_ADDRESS(addr) ((SCM *) SCM_UNPACK (addr)) - -#define SCM_VM_MAKE_BYTE_ADDRESS(ptr) SCM_PACK (ptr) -#define SCM_VM_BYTE_ADDRESS(addr) ((scm_byte_t *) SCM_UNPACK (addr)) - /* - * VM Stack frames + * VM frames */ -/* Stack frames are allocated on the VM stack as follows: - - | | <- fp + bp->nargs + bp->nlocs + 3 - +------------------+ = SCM_STACK_FRAME_UPPER_ADDRESS (fp) +/* + | | <- fp + bp->nargs + bp->nlocs + 4 + +------------------+ = SCM_FRAME_UPPER_ADDRESS (fp) | Return address | | Dynamic link | + | Heap link | | External link | <- fp + bp->nargs + bp->nlocs - | Local varialbe 1 | = SCM_STACK_FRAME_DATA_ADDRESS (fp) + | Local varialbe 1 | = SCM_FRAME_DATA_ADDRESS (fp) | Local variable 0 | <- fp + bp->nargs | Argument 1 | | Argument 0 | <- fp | Program | <- fp - 1 - +------------------+ = SCM_STACK_FRAME_LOWER_ADDRESS (fp) + +------------------+ = SCM_FRAME_LOWER_ADDRESS (fp) | | */ -#define SCM_STACK_FRAME_DATA_ADDRESS(fp) \ - (fp + SCM_PROGRAM_DATA (SCM_STACK_FRAME_PROGRAM (fp))->nargs \ - + SCM_PROGRAM_DATA (SCM_STACK_FRAME_PROGRAM (fp))->nlocs) -#define SCM_STACK_FRAME_UPPER_ADDRESS(fp) \ - (SCM_STACK_FRAME_DATA_ADDRESS (fp) + 3) -#define SCM_STACK_FRAME_LOWER_ADDRESS(fp) (fp - 1) +#define SCM_FRAME_DATA_ADDRESS(fp) \ + (fp + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nargs \ + + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nlocs) +#define SCM_FRAME_UPPER_ADDRESS(fp) (SCM_FRAME_DATA_ADDRESS (fp) + 4) +#define SCM_FRAME_LOWER_ADDRESS(fp) (fp - 1) + +#define SCM_FRAME_BYTE_CAST(x) ((scm_byte_t *) SCM_UNPACK (x)) +#define SCM_FRAME_STACK_CAST(x) ((SCM *) SCM_UNPACK (x)) -#define SCM_STACK_FRAME_RETURN_ADDRESS(fp) SCM_STACK_FRAME_DATA_ADDRESS (fp)[2] -#define SCM_STACK_FRAME_DYNAMIC_LINK(fp) SCM_STACK_FRAME_DATA_ADDRESS (fp)[1] -#define SCM_STACK_FRAME_EXTERNAL_LINK(fp) SCM_STACK_FRAME_DATA_ADDRESS (fp)[0] -#define SCM_STACK_FRAME_VARIABLE(fp,i) fp[i] -#define SCM_STACK_FRAME_PROGRAM(fp) fp[-1] +#define SCM_FRAME_RETURN_ADDRESS(fp) SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[3]) +#define SCM_FRAME_DYNAMIC_LINK(fp) SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[2]) +#define SCM_FRAME_HEAP_LINK(fp) SCM_FRAME_DATA_ADDRESS (fp)[1] +#define SCM_FRAME_EXTERNAL_LINK(fp) SCM_FRAME_DATA_ADDRESS (fp)[0] +#define SCM_FRAME_VARIABLE(fp,i) fp[i] +#define SCM_FRAME_PROGRAM(fp) fp[-1] /* - * VM Heap frames + * Heap frames */ -struct scm_heap_frame { - SCM *fp; - SCM program; - SCM variables; - SCM dynamic_link; - SCM external_link; -}; - extern scm_bits_t scm_tc16_heap_frame; #define SCM_HEAP_FRAME_P(x) SCM_SMOB_PREDICATE (scm_tc16_heap_frame, x) -#define SCM_HEAP_FRAME_DATA(f) ((struct scm_heap_frame *) SCM_SMOB_DATA (f)) +#define SCM_HEAP_FRAME_DATA(f) ((SCM *) SCM_SMOB_DATA (f)) +#define SCM_HEAP_FRAME_SELF(f) (SCM_HEAP_FRAME_DATA (f)[0]) +#define SCM_HEAP_FRAME_POINTER(f) (SCM_HEAP_FRAME_DATA (f) + 2) #define SCM_VALIDATE_HEAP_FRAME(p,x) SCM_MAKE_VALIDATE (p, x, HEAP_FRAME_P) -#define SCM_HEAP_FRAME_PROGRAM(f) SCM_HEAP_FRAME_DATA (f)->program -#define SCM_HEAP_FRAME_VARIABLES(f) SCM_HEAP_FRAME_DATA (f)->variables -#define SCM_HEAP_FRAME_DYNAMIC_LINK(f) SCM_HEAP_FRAME_DATA (f)->dynamic_link -#define SCM_HEAP_FRAME_EXTERNAL_LINK(f) SCM_HEAP_FRAME_DATA (f)->external_link - extern SCM scm_c_make_heap_frame (SCM *fp); extern void scm_init_frames (void); @@ -148,6 +148,63 @@ vm_fetch_length (scm_byte_t *ip, size_t *lenp) return ip; } +static SCM +vm_heapify_frames_1 (struct scm_vm *vp, SCM *fp, SCM *limit, SCM **basep) +{ + SCM *base, frame; + SCM *dl = SCM_FRAME_DYNAMIC_LINK (fp); + SCM *sp = SCM_FRAME_UPPER_ADDRESS (fp); + + if (!dl) + { + /* The top frame */ + base = vp->stack_base; + frame = scm_c_make_heap_frame (fp); + fp = SCM_HEAP_FRAME_POINTER (frame); + SCM_FRAME_HEAP_LINK (fp) = SCM_BOOL_T; + } + else + { + /* Other frames */ + SCM link = SCM_FRAME_HEAP_LINK (dl); + if (!SCM_FALSEP (link)) + { + link = SCM_FRAME_LOWER_ADDRESS (dl)[-1]; /* self link */ + base = SCM_FRAME_LOWER_ADDRESS (fp); + } + else + { + link = vm_heapify_frames_1 (vp, dl, SCM_FRAME_LOWER_ADDRESS (fp), + &base); + } + frame = scm_c_make_heap_frame (fp); + fp = SCM_HEAP_FRAME_POINTER (frame); + SCM_FRAME_HEAP_LINK (fp) = link; + SCM_FRAME_DYNAMIC_LINK (fp) = SCM_HEAP_FRAME_POINTER (link); + } + + /* Move stack data */ + for (; sp < limit; base++, sp++) + *base = *sp; + *basep = base; + + return frame; +} + +static SCM +vm_heapify_frames (SCM vm) +{ + struct scm_vm *vp = SCM_VM_DATA (vm); + if (SCM_FALSEP (SCM_FRAME_HEAP_LINK (vp->fp))) + { + SCM *base; + vp->this_frame = vm_heapify_frames_1 (vp, vp->fp, vp->sp + 1, &base); + vp->fp = SCM_HEAP_FRAME_POINTER (vp->this_frame); + vp->sp = base - 1; + } + return vp->this_frame; +} + /* * VM @@ -191,6 +248,7 @@ make_vm (void) vp->time = 0; vp->clock = 0; vp->options = SCM_EOL; + vp->this_frame = SCM_BOOL_F; vp->last_frame = SCM_BOOL_F; for (i = 0; i < SCM_VM_NUM_HOOKS; i++) vp->hooks[i] = SCM_BOOL_F; @@ -202,30 +260,16 @@ static SCM vm_mark (SCM obj) { int i; - SCM *sp, *fp; struct scm_vm *vp = SCM_VM_DATA (obj); - /* Mark the stack */ - sp = vp->sp; - fp = vp->fp; - while (fp) - { - SCM *upper = SCM_STACK_FRAME_UPPER_ADDRESS (fp); - SCM *lower = SCM_STACK_FRAME_LOWER_ADDRESS (fp); - /* Mark intermediate data */ - for (; sp >= upper; sp--) - if (SCM_NIMP (*sp)) - scm_gc_mark (*sp); - fp = SCM_VM_STACK_ADDRESS (sp[-1]); /* dynamic link */ - /* Mark external link, frame variables, and program */ - for (sp -= 2; sp >= lower; sp--) - if (SCM_NIMP (*sp)) - scm_gc_mark (*sp); - } + /* mark the stack conservatively */ + scm_mark_locations ((SCM_STACKITEM *) vp->stack_base, + sizeof (SCM) * (vp->sp - vp->stack_base + 1)); - /* Mark the options */ + /* mark other objects */ for (i = 0; i < SCM_VM_NUM_HOOKS; i++) scm_gc_mark (vp->hooks[i]); + scm_gc_mark (vp->this_frame); scm_gc_mark (vp->last_frame); return vp->options; } @@ -425,8 +469,8 @@ SCM_DEFINE (scm_vm_stats, "vm-stats", 1, 0, 0, SCM_VALIDATE_VM (1, vm); stats = scm_c_make_vector (2, SCM_MAKINUM (0)); - SCM_VELTS (stats)[0] = scm_long2num (SCM_VM_DATA (vm)->time); - SCM_VELTS (stats)[1] = scm_long2num (SCM_VM_DATA (vm)->clock); + SCM_VELTS (stats)[0] = scm_ulong2num (SCM_VM_DATA (vm)->time); + SCM_VELTS (stats)[1] = scm_ulong2num (SCM_VM_DATA (vm)->clock); return stats; } @@ -436,14 +480,13 @@ SCM_DEFINE (scm_vm_stats, "vm-stats", 1, 0, 0, if (!SCM_VM_DATA (vm)->ip) \ SCM_MISC_ERROR ("Not running", SCM_LIST1 (vm)) -SCM_DEFINE (scm_vm_current_frame, "vm-current-frame", 1, 0, 0, +SCM_DEFINE (scm_vm_this_frame, "vm-this-frame", 1, 0, 0, (SCM vm), "") -#define FUNC_NAME s_scm_vm_current_frame +#define FUNC_NAME s_scm_vm_this_frame { SCM_VALIDATE_VM (1, vm); - VM_CHECK_RUNNING (vm); - return scm_c_make_heap_frame (SCM_VM_DATA (vm)->fp); + return SCM_VM_DATA (vm)->this_frame; } #undef FUNC_NAME @@ -493,7 +536,7 @@ SCM_DEFINE (scm_vm_fetch_stack, "vm-fetch-stack", 1, 0, 0, VM_CHECK_RUNNING (vm); vp = SCM_VM_DATA (vm); - for (sp = SCM_STACK_FRAME_UPPER_ADDRESS (vp->fp); sp <= vp->sp; sp++) + for (sp = vp->stack_base; sp <= vp->sp; sp++) ls = scm_cons (*sp, ls); return ls; } @@ -61,9 +61,10 @@ struct scm_vm { size_t stack_size; /* stack size */ SCM *stack_base; /* stack base address */ SCM *stack_limit; /* stack limit address */ + SCM this_frame; /* currrent frame */ + SCM last_frame; /* last frame */ SCM hooks[SCM_VM_NUM_HOOKS]; /* hooks */ SCM options; /* options */ - SCM last_frame; /* last frame */ unsigned long time; /* time spent */ unsigned long clock; /* bogos clock */ }; @@ -78,8 +79,6 @@ extern SCM scm_vm_apply (SCM vm, SCM program, SCM args); extern SCM scm_vm_option_ref (SCM vm, SCM key); extern SCM scm_vm_option_set_x (SCM vm, SCM key, SCM val); -extern SCM scm_vm_current_frame (SCM vm); - extern void scm_init_vm (void); #endif /* _SCM_VM_H_ */ diff --git a/src/vm_engine.c b/src/vm_engine.c index 7cc93acca..d0fdb7296 100644 --- a/src/vm_engine.c +++ b/src/vm_engine.c @@ -167,7 +167,7 @@ vm_run (SCM vm, SCM program, SCM args) vm_error: SYNC_ALL (); - vp->last_frame = scm_vm_current_frame (vm); + vp->last_frame = vm_heapify_frames (vm); scm_ithrow (sym_vm_error, SCM_LIST3 (sym_vm_run, err_msg, err_args), 1); } diff --git a/src/vm_engine.h b/src/vm_engine.h index fad35892c..767ac37a1 100644 --- a/src/vm_engine.h +++ b/src/vm_engine.h @@ -170,8 +170,10 @@ { \ if (!SCM_FALSEP (vp->hooks[h])) \ { \ - SYNC_BEFORE_GC (); \ + SYNC_REGISTER (); \ + vm_heapify_frames (vm); \ scm_c_run_hook (vp->hooks[h], hook_args); \ + CACHE_REGISTER (); \ } \ } #else @@ -291,15 +293,15 @@ do { \ #define NEW_FRAME() \ { \ int i; \ - SCM ra = SCM_VM_MAKE_BYTE_ADDRESS (ip); \ - SCM dl = SCM_VM_MAKE_STACK_ADDRESS (fp); \ + SCM ra = SCM_PACK (ip); \ + SCM dl = SCM_PACK (fp); \ SCM *p = sp + 1; \ SCM *q = p + bp->nlocs; \ \ /* New pointers */ \ ip = bp->base; \ fp = p - bp->nargs; \ - sp = q + 2; \ + sp = q + 3; \ CHECK_OVERFLOW (); \ \ /* Init local variables */ \ @@ -312,19 +314,25 @@ do { \ CONS (external, SCM_UNDEFINED, external); \ \ /* Set frame data */ \ + p[3] = ra; \ + p[2] = dl; \ + p[1] = SCM_BOOL_F; \ p[0] = external; \ - p[1] = dl; \ - p[2] = ra; \ } #define FREE_FRAME() \ { \ SCM *p = fp + bp->nargs + bp->nlocs; \ - sp = fp - 2; \ - ip = SCM_VM_BYTE_ADDRESS (p[2]); \ - fp = SCM_VM_STACK_ADDRESS (p[1]); \ + if (!SCM_FALSEP (p[1])) \ + vp->this_frame = p[1]; \ + else \ + sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1; \ + fp = SCM_FRAME_STACK_CAST (p[2]); \ + ip = SCM_FRAME_BYTE_CAST (p[3]); \ } +#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs] + /* * Function support diff --git a/src/vm_system.c b/src/vm_system.c index e6336b435..a94d451a9 100644 --- a/src/vm_system.c +++ b/src/vm_system.c @@ -187,8 +187,8 @@ VM_DEFINE_INSTRUCTION (list_break, "list-break", 0, 0, 0) #define OBJECT_REF(i) objects[i] #define OBJECT_SET(i,o) objects[i] = o -#define LOCAL_REF(i) SCM_STACK_FRAME_VARIABLE (fp, i) -#define LOCAL_SET(i,o) SCM_STACK_FRAME_VARIABLE (fp, i) = o +#define LOCAL_REF(i) SCM_FRAME_VARIABLE (fp, i) +#define LOCAL_SET(i,o) SCM_FRAME_VARIABLE (fp, i) = o #define VARIABLE_REF(v) SCM_CDR (v) #define VARIABLE_SET(v,o) SCM_SETCDR (v, o) @@ -379,7 +379,7 @@ VM_DEFINE_INSTRUCTION (call, "call", 1, -1, 1) EXIT_HOOK (); reinstate_vm_cont (vp, x); CACHE_REGISTER (); - program = SCM_STACK_FRAME_PROGRAM (fp); + program = SCM_FRAME_PROGRAM (fp); CACHE_PROGRAM (); NEXT; } @@ -490,15 +490,15 @@ VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1) { SCM ret; vm_return: - ret = *sp; + POP (ret); EXIT_HOOK (); RETURN_HOOK (); FREE_FRAME (); /* Restore the last program */ - program = SCM_STACK_FRAME_PROGRAM (fp); + program = SCM_FRAME_PROGRAM (fp); CACHE_PROGRAM (); - external = fp[bp->nargs + bp->nlocs]; + CACHE_EXTERNAL (); PUSH (ret); NEXT; } |