summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorKeisuke Nishida <kxn30@po.cwru.edu>2001-04-22 02:13:48 +0000
committerKeisuke Nishida <kxn30@po.cwru.edu>2001-04-22 02:13:48 +0000
commitac99cb0cb153b1691b48115f098a0008b78f9702 (patch)
tree61097ad9a9ceff1f371dd927a02430bc81ea079b /src
parentac02b386c2e5743b6ea96486af6ba2cc6583c12a (diff)
downloadguile-ac99cb0cb153b1691b48115f098a0008b78f9702.tar.gz
*** empty log message ***
Diffstat (limited to 'src')
-rw-r--r--src/Makefile.am8
-rw-r--r--src/frames.c184
-rw-r--r--src/frames.h126
-rw-r--r--src/objcodes.c6
-rw-r--r--src/programs.c59
-rw-r--r--src/programs.h13
-rw-r--r--src/vm.c144
-rw-r--r--src/vm.h71
-rw-r--r--src/vm_engine.c8
-rw-r--r--src/vm_engine.h2
-rw-r--r--src/vm_loader.c43
-rw-r--r--src/vm_system.c8
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);
diff --git a/src/vm.c b/src/vm.c
index ae2b7f120..dc8c3376a 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -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);
diff --git a/src/vm.h b/src/vm.h
index 5faac62fe..5059961ee 100644
--- a/src/vm.h
+++ b/src/vm.h
@@ -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);