diff options
author | Keisuke Nishida <kxn30@po.cwru.edu> | 2001-04-22 02:13:48 +0000 |
---|---|---|
committer | Keisuke Nishida <kxn30@po.cwru.edu> | 2001-04-22 02:13:48 +0000 |
commit | ac99cb0cb153b1691b48115f098a0008b78f9702 (patch) | |
tree | 61097ad9a9ceff1f371dd927a02430bc81ea079b /src | |
parent | ac02b386c2e5743b6ea96486af6ba2cc6583c12a (diff) | |
download | guile-ac99cb0cb153b1691b48115f098a0008b78f9702.tar.gz |
*** empty log message ***
Diffstat (limited to 'src')
-rw-r--r-- | src/Makefile.am | 8 | ||||
-rw-r--r-- | src/frames.c | 184 | ||||
-rw-r--r-- | src/frames.h | 126 | ||||
-rw-r--r-- | src/objcodes.c | 6 | ||||
-rw-r--r-- | src/programs.c | 59 | ||||
-rw-r--r-- | src/programs.h | 13 | ||||
-rw-r--r-- | src/vm.c | 144 | ||||
-rw-r--r-- | src/vm.h | 71 | ||||
-rw-r--r-- | src/vm_engine.c | 8 | ||||
-rw-r--r-- | src/vm_engine.h | 2 | ||||
-rw-r--r-- | src/vm_loader.c | 43 | ||||
-rw-r--r-- | src/vm_system.c | 8 |
12 files changed, 411 insertions, 261 deletions
diff --git a/src/Makefile.am b/src/Makefile.am index dcdd6eee3..311b6e7a3 100644 --- a/src/Makefile.am +++ b/src/Makefile.am @@ -5,14 +5,14 @@ guile_vm_LDADD = libguilevm.la guile_vm_LDFLAGS = $(GUILE_LDFLAGS) lib_LTLIBRARIES = libguilevm.la -libguilevm_la_SOURCES = \ - envs.c instructions.c objcodes.c programs.c vm.c \ - envs.h instructions.h objcodes.h programs.h vm.h \ +libguilevm_la_SOURCES = \ + envs.c frames.c instructions.c objcodes.c programs.c vm.c \ + envs.h frames.h instructions.h objcodes.h programs.h vm.h \ vm_engine.h vm_expand.h libguilevm_la_LDFLAGS = -version-info 0:0:0 -export-dynamic EXTRA_DIST = vm_engine.c vm_system.c vm_scheme.c vm_loader.c BUILT_SOURCES = vm_system.i vm_scheme.i vm_loader.i \ - envs.x instructions.x objcodes.x programs.x vm.x + envs.x frames.x instructions.x objcodes.x programs.x vm.x INCLUDES = $(GUILE_CFLAGS) DISTCLEANFILES = $(BUILT_SOURCES) diff --git a/src/frames.c b/src/frames.c new file mode 100644 index 000000000..382342008 --- /dev/null +++ b/src/frames.c @@ -0,0 +1,184 @@ +/* Copyright (C) 2001 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + +#include <string.h> +#include "frames.h" + + +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); +} + +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; +} + +/* Scheme interface */ + +SCM_DEFINE (scm_frame_p, "frame?", 1, 0, 0, + (SCM obj), + "") +#define FUNC_NAME s_scm_frame_p +{ + return SCM_BOOL (SCM_HEAP_FRAME_P (obj)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_frame_program, "frame-program", 1, 0, 0, + (SCM frame), + "") +#define FUNC_NAME s_scm_frame_program +{ + SCM_VALIDATE_HEAP_FRAME (1, frame); + return SCM_STACK_FRAME_PROGRAM (SCM_HEAP_FRAME_DATA (frame)->fp); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_frame_local_variables, "frame-local-variables", 1, 0, 0, + (SCM frame), + "") +#define FUNC_NAME s_scm_frame_local_variables +{ + struct scm_heap_frame *p; + + 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; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_frame_return_address, "frame-return-address", 1, 0, 0, + (SCM frame), + "") +#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))); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0, + (SCM frame), + "") +#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; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_frame_external_link, "frame-external-link", 1, 0, 0, + (SCM frame), + "") +#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; +} +#undef FUNC_NAME + + +void +scm_init_frames (void) +{ + scm_tc16_heap_frame = scm_make_smob_type ("heap_frame", 0); + scm_set_smob_mark (scm_tc16_heap_frame, heap_frame_mark); + +#ifndef SCM_MAGIC_SNARFER +#include "frames.x" +#endif +} + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ diff --git a/src/frames.h b/src/frames.h new file mode 100644 index 000000000..ed28e56a8 --- /dev/null +++ b/src/frames.h @@ -0,0 +1,126 @@ +/* Copyright (C) 2001 Free Software Foundation, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA + * + * As a special exception, the Free Software Foundation gives permission + * for additional uses of the text contained in its release of GUILE. + * + * The exception is that, if you link the GUILE library with other files + * to produce an executable, this does not by itself cause the + * resulting executable to be covered by the GNU General Public License. + * Your use of that executable is in no way restricted on account of + * linking the GUILE library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the + * Free Software Foundation under the name GUILE. If you copy + * code from other Free Software Foundation releases into a copy of + * GUILE, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for GUILE, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. */ + +#ifndef _SCM_FRAMES_H_ +#define _SCM_FRAMES_H_ + +#include <libguile.h> +#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 + */ + +/* Stack frames are allocated on the VM stack as follows: + + | | <- fp + bp->nargs + bp->nlocs + 3 + +------------------+ = SCM_STACK_FRAME_UPPER_ADDRESS (fp) + | Return address | + | Dynamic link | + | External link | <- fp + bp->nargs + bp->nlocs + | Local varialbe 1 | = SCM_STACK_FRAME_DATA_ADDRESS (fp) + | Local variable 0 | <- fp + bp->nargs + | Argument 1 | + | Argument 0 | <- fp + | Program | <- fp - 1 + +------------------+ = SCM_STACK_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_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] + + +/* + * VM 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_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); + +#endif /* _SCM_FRAMES_H_ */ + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ diff --git a/src/objcodes.c b/src/objcodes.c index 0df3be0f3..cff27215b 100644 --- a/src/objcodes.c +++ b/src/objcodes.c @@ -194,14 +194,16 @@ SCM_DEFINE (scm_objcode_to_program, "objcode->program", 1, 0, 0, SCM prog; size_t size; char *base; + struct scm_program *p; SCM_VALIDATE_OBJCODE (1, objcode); base = SCM_OBJCODE_BASE (objcode); size = SCM_OBJCODE_SIZE (objcode); prog = scm_c_make_program (base + 10, size - 10, objcode); - SCM_PROGRAM_NLOCS (prog) = base[8]; - SCM_PROGRAM_NEXTS (prog) = base[9]; + p = SCM_PROGRAM_DATA (prog); + p->nlocs = base[8]; + p->nexts = base[9]; return prog; } #undef FUNC_NAME diff --git a/src/programs.c b/src/programs.c index 2bc4611fa..797cebeea 100644 --- a/src/programs.c +++ b/src/programs.c @@ -59,6 +59,7 @@ scm_c_make_program (void *addr, size_t size, SCM holder) p->nrest = 0; p->nlocs = 0; p->nexts = 0; + p->meta = SCM_BOOL_F; p->objs = zero_vector; p->external = SCM_EOL; p->holder = holder; @@ -78,7 +79,7 @@ scm_c_make_closure (SCM program, SCM external) { SCM prog = scm_c_make_program (0, 0, program); *SCM_PROGRAM_DATA (prog) = *SCM_PROGRAM_DATA (program); - SCM_PROGRAM_EXTERNAL (prog) = external; + SCM_PROGRAM_DATA (prog)->external = external; return prog; } @@ -86,6 +87,7 @@ 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; @@ -105,19 +107,6 @@ program_free (SCM obj) return size; } -static int -program_print (SCM obj, SCM port, scm_print_state *pstate) -{ - SCM name = scm_object_property (obj, scm_sym_name); - scm_puts ("#<program ", port); - if (SCM_FALSEP (name)) - scm_intprint ((long) SCM_PROGRAM_BASE (obj), 16, port); - else - scm_display (name, port); - scm_putc ('>', port); - return 1; -} - static SCM program_apply (SCM program, SCM args) { @@ -138,16 +127,41 @@ SCM_DEFINE (scm_program_p, "program?", 1, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_program_base, "program-base", 1, 0, 0, + (SCM program), + "") +#define FUNC_NAME s_scm_program_base +{ + SCM_VALIDATE_PROGRAM (1, program); + + return scm_long2num ((long) SCM_PROGRAM_DATA (program)->base); +} +#undef FUNC_NAME + SCM_DEFINE (scm_program_arity, "program-arity", 1, 0, 0, (SCM program), "") #define FUNC_NAME s_scm_program_arity { + struct scm_program *p; + + SCM_VALIDATE_PROGRAM (1, program); + + p = SCM_PROGRAM_DATA (program); + return SCM_LIST4 (SCM_MAKINUM (p->nargs), + SCM_MAKINUM (p->nrest), + SCM_MAKINUM (p->nlocs), + SCM_MAKINUM (p->nexts)); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_program_meta, "program-meta", 1, 0, 0, + (SCM program), + "") +#define FUNC_NAME s_scm_program_meta +{ SCM_VALIDATE_PROGRAM (1, program); - return SCM_LIST4 (SCM_MAKINUM (SCM_PROGRAM_NARGS (program)), - SCM_MAKINUM (SCM_PROGRAM_NREST (program)), - SCM_MAKINUM (SCM_PROGRAM_NLOCS (program)), - SCM_MAKINUM (SCM_PROGRAM_NEXTS (program))); + return SCM_PROGRAM_DATA (program)->meta; } #undef FUNC_NAME @@ -157,7 +171,7 @@ SCM_DEFINE (scm_program_objects, "program-objects", 1, 0, 0, #define FUNC_NAME s_scm_program_objects { SCM_VALIDATE_PROGRAM (1, program); - return SCM_PROGRAM_OBJS (program); + return SCM_PROGRAM_DATA (program)->objs; } #undef FUNC_NAME @@ -167,7 +181,7 @@ SCM_DEFINE (scm_program_external, "program-external", 1, 0, 0, #define FUNC_NAME s_scm_program_external { SCM_VALIDATE_PROGRAM (1, program); - return SCM_PROGRAM_EXTERNAL (program); + return SCM_PROGRAM_DATA (program)->external; } #undef FUNC_NAME @@ -177,8 +191,8 @@ SCM_DEFINE (scm_program_bytecode, "program-bytecode", 1, 0, 0, #define FUNC_NAME s_scm_program_bytecode { SCM_VALIDATE_PROGRAM (1, program); - return scm_makfromstr (SCM_PROGRAM_BASE (program), - SCM_PROGRAM_SIZE (program), 0); + return scm_makfromstr (SCM_PROGRAM_DATA (program)->base, + SCM_PROGRAM_DATA (program)->size, 0); } #undef FUNC_NAME @@ -191,7 +205,6 @@ scm_init_programs (void) scm_tc16_program = scm_make_smob_type ("program", 0); scm_set_smob_mark (scm_tc16_program, program_mark); scm_set_smob_free (scm_tc16_program, program_free); - scm_set_smob_print (scm_tc16_program, program_print); scm_set_smob_apply (scm_tc16_program, program_apply, 0, 0, 1); #ifndef SCM_MAGIC_SNARFER diff --git a/src/programs.h b/src/programs.h index bbea84105..ca0ab05c3 100644 --- a/src/programs.h +++ b/src/programs.h @@ -58,6 +58,7 @@ 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 data */ SCM objs; /* constant objects */ SCM external; /* external environment */ SCM holder; /* the owner of bytecode */ @@ -69,18 +70,6 @@ extern scm_bits_t scm_tc16_program; #define SCM_PROGRAM_DATA(x) ((struct scm_program *) SCM_SMOB_DATA (x)) #define SCM_VALIDATE_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, PROGRAM_P) -#define SCM_PROGRAM_SIZE(x) (SCM_PROGRAM_DATA (x)->size) -#define SCM_PROGRAM_NARGS(x) (SCM_PROGRAM_DATA (x)->nargs) -#define SCM_PROGRAM_NREST(x) (SCM_PROGRAM_DATA (x)->nrest) -#define SCM_PROGRAM_NLOCS(x) (SCM_PROGRAM_DATA (x)->nlocs) -#define SCM_PROGRAM_NEXTS(x) (SCM_PROGRAM_DATA (x)->nexts) -#define SCM_PROGRAM_BASE(x) (SCM_PROGRAM_DATA (x)->base) -#define SCM_PROGRAM_META(x) (SCM_PROGRAM_DATA (x)->meta) -#define SCM_PROGRAM_OBJS(x) (SCM_PROGRAM_DATA (x)->objs) -#define SCM_PROGRAM_LINKS(x) (SCM_PROGRAM_DATA (x)->links) -#define SCM_PROGRAM_EXTERNAL(x) (SCM_PROGRAM_DATA (x)->external) -#define SCM_PROGRAM_HOLDER(x) (SCM_PROGRAM_DATA (x)->holder) - extern SCM scm_c_make_program (void *addr, size_t size, SCM holder); extern SCM scm_c_make_closure (SCM program, SCM external); @@ -40,10 +40,11 @@ * If you do not wish that, delete this exception notice. */ #include <string.h> +#include "envs.h" +#include "frames.h" #include "instructions.h" -#include "programs.h" #include "objcodes.h" -#include "envs.h" +#include "programs.h" #include "vm.h" /* I sometimes use this for debugging. */ @@ -55,119 +56,6 @@ /* - * VM Heap frame - */ - -scm_bits_t scm_tc16_vm_heap_frame; - -static SCM -make_vm_heap_frame (SCM *fp) -{ - 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; - p->external_link = SCM_UNDEFINED; - SCM_RETURN_NEWSMOB (scm_tc16_vm_heap_frame, p); -} - -static SCM -vm_heap_frame_mark (SCM obj) -{ - struct scm_vm_heap_frame *p = SCM_VM_HEAP_FRAME_DATA (obj); - scm_gc_mark (p->program); - scm_gc_mark (p->variables); - scm_gc_mark (p->dynamic_link); - return p->external_link; -} - -/* Scheme interface */ - -SCM_DEFINE (scm_frame_p, "frame?", 1, 0, 0, - (SCM obj), - "") -#define FUNC_NAME s_scm_frame_p -{ - return SCM_BOOL (SCM_VM_HEAP_FRAME_P (obj)); -} -#undef FUNC_NAME - -SCM_DEFINE (scm_frame_program, "frame-program", 1, 0, 0, - (SCM frame), - "") -#define FUNC_NAME s_scm_frame_program -{ - SCM_VALIDATE_VM_HEAP_FRAME (1, frame); - return SCM_VM_FRAME_PROGRAM (SCM_VM_HEAP_FRAME_DATA (frame)->fp); -} -#undef FUNC_NAME - -SCM_DEFINE (scm_frame_variables, "frame-variables", 1, 0, 0, - (SCM frame), - "") -#define FUNC_NAME s_scm_frame_variables -{ - 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 - -SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0, - (SCM frame), - "") -#define FUNC_NAME s_scm_frame_dynamic_link -{ - 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 - -SCM_DEFINE (scm_frame_external_link, "frame-external-link", 1, 0, 0, - (SCM frame), - "") -#define FUNC_NAME s_scm_frame_external_link -{ - struct scm_vm_heap_frame *p; - - SCM_VALIDATE_VM_HEAP_FRAME (1, frame); - p = SCM_VM_HEAP_FRAME_DATA (frame); - - if (SCM_UNBNDP (p->external_link)) - p->external_link = SCM_VM_FRAME_EXTERNAL_LINK (p->fp); - - return p->external_link; -} -#undef FUNC_NAME - - -/* * VM Continuation */ @@ -303,6 +191,7 @@ make_vm (void) vp->time = 0; vp->clock = 0; vp->options = SCM_EOL; + vp->last_frame = SCM_BOOL_F; for (i = 0; i < SCM_VM_NUM_HOOKS; i++) vp->hooks[i] = SCM_BOOL_F; SCM_RETURN_NEWSMOB (scm_tc16_vm, vp); @@ -321,8 +210,8 @@ vm_mark (SCM obj) fp = vp->fp; while (fp) { - SCM *upper = SCM_VM_FRAME_UPPER_ADDRESS (fp); - SCM *lower = SCM_VM_FRAME_LOWER_ADDRESS (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)) @@ -337,6 +226,7 @@ vm_mark (SCM obj) /* Mark the options */ for (i = 0; i < SCM_VM_NUM_HOOKS; i++) scm_gc_mark (vp->hooks[i]); + scm_gc_mark (vp->last_frame); return vp->options; } @@ -553,7 +443,17 @@ SCM_DEFINE (scm_vm_current_frame, "vm-current-frame", 1, 0, 0, { SCM_VALIDATE_VM (1, vm); VM_CHECK_RUNNING (vm); - return make_vm_heap_frame (SCM_VM_DATA (vm)->fp); + return scm_c_make_heap_frame (SCM_VM_DATA (vm)->fp); +} +#undef FUNC_NAME + +SCM_DEFINE (scm_vm_last_frame, "vm-last-frame", 1, 0, 0, + (SCM vm), + "") +#define FUNC_NAME s_scm_vm_last_frame +{ + SCM_VALIDATE_VM (1, vm); + return SCM_VM_DATA (vm)->last_frame; } #undef FUNC_NAME @@ -593,7 +493,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_VM_FRAME_UPPER_ADDRESS (vp->fp); sp <= vp->sp; sp++) + for (sp = SCM_STACK_FRAME_UPPER_ADDRESS (vp->fp); sp <= vp->sp; sp++) ls = scm_cons (*sp, ls); return ls; } @@ -607,12 +507,10 @@ SCM_DEFINE (scm_vm_fetch_stack, "vm-fetch-stack", 1, 0, 0, void scm_init_vm (void) { + scm_init_frames (); scm_init_instructions (); - scm_init_programs (); scm_init_objcodes (); - - 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_init_programs (); scm_tc16_vm_cont = scm_make_smob_type ("vm-cont", 0); scm_set_smob_mark (scm_tc16_vm_cont, vm_cont_mark); @@ -44,76 +44,6 @@ #include <libguile.h> #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 frame - */ - -/* - | | <- fp + bp->nargs + bp->nlocs + 3 - +------------------+ = SCM_VM_FRAME_UPPER_ADDRESS (fp) - | Return address | - | Dynamic link | - | External link | <- fp + bp->nargs + bp->nlocs - | Local varialbe 1 | = SCM_VM_FRAME_DATA_ADDRESS (fp) - | Local variable 0 | <- fp + bp->nargs - | Argument 1 | - | Argument 0 | <- fp - | Program | <- fp - 1 - +------------------+ = SCM_VM_FRAME_LOWER_ADDRESS (fp) - | | -*/ - -#define SCM_VM_FRAME_DATA_ADDRESS(fp) \ - (fp + SCM_PROGRAM_NARGS (SCM_VM_FRAME_PROGRAM (fp)) \ - + SCM_PROGRAM_NLOCS (SCM_VM_FRAME_PROGRAM (fp))) -#define SCM_VM_FRAME_UPPER_ADDRESS(fp) \ - (SCM_VM_FRAME_DATA_ADDRESS (fp) + 3) -#define SCM_VM_FRAME_LOWER_ADDRESS(fp) (fp - 1) - -#define SCM_VM_FRAME_RETURN_ADDRESS(fp) SCM_VM_FRAME_DATA_ADDRESS (fp)[2] -#define SCM_VM_FRAME_DYNAMIC_LINK(fp) SCM_VM_FRAME_DATA_ADDRESS (fp)[1] -#define SCM_VM_FRAME_EXTERNAL_LINK(fp) SCM_VM_FRAME_DATA_ADDRESS (fp)[0] -#define SCM_VM_FRAME_VARIABLE(fp,i) fp[i] -#define SCM_VM_FRAME_PROGRAM(fp) fp[-1] - -/* - * VM Heap frame - */ - -struct scm_vm_heap_frame { - SCM *fp; - SCM program; - SCM variables; - SCM dynamic_link; - SCM external_link; -}; - -extern scm_bits_t scm_tc16_vm_heap_frame; - -#define SCM_VM_HEAP_FRAME_P(x) SCM_SMOB_PREDICATE (scm_tc16_vm_heap_frame, x) -#define SCM_VM_HEAP_FRAME_DATA(f) ((struct scm_vm_heap_frame *) SCM_SMOB_DATA (f)) -#define SCM_VALIDATE_VM_HEAP_FRAME(p,x) SCM_MAKE_VALIDATE (p, x, VM_HEAP_FRAME_P) - -#define SCM_VM_HEAP_FRAME_PROGRAM(f) SCM_VM_HEAP_FRAME_DATA (f)->program -#define SCM_VM_HEAP_FRAME_VARIABLES(f) SCM_VM_HEAP_FRAME_DATA (f)->variables -#define SCM_VM_HEAP_FRAME_DYNAMIC_LINK(f) SCM_VM_HEAP_FRAME_DATA (f)->dynamic_link -#define SCM_VM_HEAP_FRAME_EXTERNAL_LINK(f) SCM_VM_HEAP_FRAME_DATA (f)->external_link - -/* - * VM - */ #define SCM_VM_BOOT_HOOK 0 #define SCM_VM_HALT_HOOK 1 @@ -133,6 +63,7 @@ struct scm_vm { SCM *stack_limit; /* stack limit address */ 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 */ }; diff --git a/src/vm_engine.c b/src/vm_engine.c index 30b8a5873..7cc93acca 100644 --- a/src/vm_engine.c +++ b/src/vm_engine.c @@ -88,7 +88,7 @@ vm_run (SCM vm, SCM program, SCM args) /* Boot program */ scm_byte_t bytes[3] = {scm_op_call, 0, scm_op_halt}; - bytes[1] = scm_ilength (args); + bytes[1] = scm_ilength (args); /* FIXME: argument overflow */ program = scm_c_make_program (bytes, 3, SCM_BOOL_T); /* Initial frame */ @@ -167,10 +167,8 @@ vm_run (SCM vm, SCM program, SCM args) vm_error: SYNC_ALL (); - scm_ithrow (sym_vm_error, - SCM_LIST4 (sym_vm_run, err_msg, err_args, - scm_vm_current_frame (vm)), - 1); + vp->last_frame = scm_vm_current_frame (vm); + scm_ithrow (sym_vm_error, SCM_LIST3 (sym_vm_run, err_msg, err_args), 1); } abort (); /* never reached */ diff --git a/src/vm_engine.h b/src/vm_engine.h index 75d275f1c..fad35892c 100644 --- a/src/vm_engine.h +++ b/src/vm_engine.h @@ -286,7 +286,7 @@ do { \ } \ } -/* See vm.h for the layout of stack frames */ +/* See frames.h for the layout of stack frames */ #define NEW_FRAME() \ { \ diff --git a/src/vm_loader.c b/src/vm_loader.c index fe7e2b518..d221ecdd1 100644 --- a/src/vm_loader.c +++ b/src/vm_loader.c @@ -109,18 +109,27 @@ VM_DEFINE_LOADER (load_program, "load-program") { size_t len; SCM prog, x; + struct scm_program *p; FETCH_LENGTH (len); prog = scm_c_make_program (ip, len, program); + p = SCM_PROGRAM_DATA (prog); ip += len; + POP (x); + + /* init meta data */ + if (SCM_CONSP (x)) + { + p->meta = x; + POP (x); + } + /* init object table */ - x = *sp; if (SCM_VECTORP (x)) { - SCM_PROGRAM_OBJS (prog) = x; - DROP (); - x = *sp; + p->objs = x; + POP (x); } /* init parameters */ @@ -131,31 +140,31 @@ VM_DEFINE_LOADER (load_program, "load-program") if (-128 <= i && i <= 127) { /* 8-bit representation */ - SCM_PROGRAM_NARGS (prog) = (i >> 6) & 0x03; /* 7-6 bits */ - 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 */ + p->nargs = (i >> 6) & 0x03; /* 7-6 bits */ + p->nrest = (i >> 5) & 0x01; /* 5 bit */ + p->nlocs = (i >> 2) & 0x07; /* 4-2 bits */ + p->nexts = i & 0x03; /* 1-0 bits */ } else { /* 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-04 bits */ - SCM_PROGRAM_NEXTS (prog) = i & 0x0f; /* 03-00 bits */ + p->nargs = (i >> 12) & 0x07; /* 15-12 bits */ + p->nrest = (i >> 11) & 0x01; /* 11 bit */ + p->nlocs = (i >> 4) & 0x7f; /* 10-04 bits */ + p->nexts = i & 0x0f; /* 03-00 bits */ } } else { /* Other cases */ sp -= 4; - SCM_PROGRAM_NARGS (prog) = SCM_INUM (sp[1]); - SCM_PROGRAM_NREST (prog) = SCM_INUM (sp[2]); - SCM_PROGRAM_NLOCS (prog) = SCM_INUM (sp[3]); - SCM_PROGRAM_NEXTS (prog) = SCM_INUM (sp[4]); + p->nargs = SCM_INUM (sp[0]); + p->nrest = SCM_INUM (sp[1]); + p->nlocs = SCM_INUM (sp[2]); + p->nexts = SCM_INUM (sp[3]); } - *sp = prog; + PUSH (prog); NEXT; } diff --git a/src/vm_system.c b/src/vm_system.c index 12aa02f72..e6336b435 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_VM_FRAME_VARIABLE (fp, i) -#define LOCAL_SET(i,o) SCM_VM_FRAME_VARIABLE (fp, 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 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_VM_FRAME_PROGRAM (fp); + program = SCM_STACK_FRAME_PROGRAM (fp); CACHE_PROGRAM (); NEXT; } @@ -496,7 +496,7 @@ VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1) FREE_FRAME (); /* Restore the last program */ - program = SCM_VM_FRAME_PROGRAM (fp); + program = SCM_STACK_FRAME_PROGRAM (fp); CACHE_PROGRAM (); external = fp[bp->nargs + bp->nlocs]; PUSH (ret); |