summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-01-17 16:42:53 +0100
committerAndy Wingo <wingo@pobox.com>2009-01-17 16:42:53 +0100
commit2fda0242214e1b650b8fd3eb084e1c930a8399a5 (patch)
treecb0e118575713554b98b11e4d15c91a0605f6941
parenta72317988fa29377928d30c7e52b5acf63b6943a (diff)
downloadguile-2fda0242214e1b650b8fd3eb084e1c930a8399a5.tar.gz
move module and meta inside programs' object tables
* libguile/programs.h (struct scm_program): Remove the module and meta fields. * libguile/programs.c (scm_c_make_program): Add a new argument, `objs'. If it's a vector, we'll look for the module and the metadata in there, instead of having them in the scm_program structure. (scm_c_make_closure, program_mark, scm_program_meta) (scm_c_program_source, scm_program_module): Adapt to the new program representation. * libguile/objcodes.c (scm_objcode_to_program): Pass #f as the object table when making the program. * libguile/vm-engine.h (CACHE_PROGRAM): * libguile/vm-engine.c (vm_run): Rework to use the simple vector API for getting the current object table. Call the helper, vm_make_boot_program, to make the boot program. * libguile/vm-i-loader.c (load-program): Set the current module and the meta in the object vector, which we pass to scm_c_make_program. * libguile/vm-i-system.c (toplevel-ref, toplevel-set): Adapt to the new program representation. * module/language/glil/compile-objcode.scm (codegen): Clarify.
-rw-r--r--libguile/objcodes.c2
-rw-r--r--libguile/programs.c41
-rw-r--r--libguile/programs.h4
-rw-r--r--libguile/vm-engine.c11
-rw-r--r--libguile/vm-engine.h16
-rw-r--r--libguile/vm-i-loader.c26
-rw-r--r--libguile/vm-i-system.c10
-rw-r--r--libguile/vm.c10
-rw-r--r--module/language/glil/compile-objcode.scm5
9 files changed, 64 insertions, 61 deletions
diff --git a/libguile/objcodes.c b/libguile/objcodes.c
index 6f5ded53c..10782d443 100644
--- a/libguile/objcodes.c
+++ b/libguile/objcodes.c
@@ -240,7 +240,7 @@ SCM_DEFINE (scm_objcode_to_program, "objcode->program", 1, 1, 0,
base = SCM_OBJCODE_BASE (objcode);
size = SCM_OBJCODE_SIZE (objcode);
- prog = scm_c_make_program (base + 10, size - 10, objcode);
+ prog = scm_c_make_program (base + 10, size - 10, SCM_BOOL_F, objcode);
p = SCM_PROGRAM_DATA (prog);
p->nlocs = base[8];
p->nexts = base[9];
diff --git a/libguile/programs.c b/libguile/programs.c
index 235422ac8..f5b5d42ba 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -57,7 +57,7 @@ static SCM zero_vector;
static SCM write_program = SCM_BOOL_F;
SCM
-scm_c_make_program (void *addr, size_t size, SCM holder)
+scm_c_make_program (void *addr, size_t size, SCM objs, SCM holder)
#define FUNC_NAME "scm_c_make_program"
{
struct scm_program *p = scm_gc_malloc (sizeof (struct scm_program),
@@ -67,11 +67,9 @@ 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->objs = objs;
p->external = SCM_EOL;
p->holder = holder;
- p->module = scm_current_module ();
/* If nobody holds bytecode's address, then allocate a new memory */
if (SCM_FALSEP (holder))
@@ -89,22 +87,22 @@ scm_c_make_program (void *addr, size_t size, SCM holder)
SCM
scm_c_make_closure (SCM program, SCM external)
{
- SCM prog = scm_c_make_program (0, 0, program);
- if (!SCM_PROGRAM_P (program))
- abort ();
- *SCM_PROGRAM_DATA (prog) = *SCM_PROGRAM_DATA (program);
- SCM_PROGRAM_DATA (prog)->external = external;
- return prog;
+ struct scm_program *p = scm_gc_malloc (sizeof (struct scm_program),
+ "program");
+ *p = *SCM_PROGRAM_DATA (program);
+ p->holder = program;
+ p->external = external;
+ SCM_RETURN_NEWSMOB (scm_tc16_program, p);
}
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);
- scm_gc_mark (p->module);
+ if (scm_is_true (p->objs))
+ scm_gc_mark (p->objs);
+ if (!scm_is_null (p->external))
+ scm_gc_mark (p->external);
return p->holder;
}
@@ -194,8 +192,10 @@ SCM_DEFINE (scm_program_meta, "program-meta", 1, 0, 0,
"")
#define FUNC_NAME s_scm_program_meta
{
+ SCM objs;
SCM_VALIDATE_PROGRAM (1, program);
- return SCM_PROGRAM_DATA (program)->meta;
+ objs = SCM_PROGRAM_DATA (program)->objs;
+ return scm_is_true (objs) ? scm_c_vector_ref (objs, 1) : SCM_BOOL_F;
}
#undef FUNC_NAME
@@ -204,9 +204,12 @@ scm_c_program_source (struct scm_program *p, size_t ip)
{
SCM meta, sources, source;
- if (scm_is_false (p->meta))
+ if (scm_is_false (p->objs))
+ return SCM_BOOL_F;
+ meta = scm_c_vector_ref (p->objs, 1);
+ if (scm_is_false (meta))
return SCM_BOOL_F;
- meta = scm_call_0 (p->meta);
+ meta = scm_call_0 (meta);
if (scm_is_false (meta))
return SCM_BOOL_F;
sources = scm_cadr (meta);
@@ -232,8 +235,10 @@ SCM_DEFINE (scm_program_module, "program-module", 1, 0, 0,
"")
#define FUNC_NAME s_scm_program_module
{
+ SCM objs;
SCM_VALIDATE_PROGRAM (1, program);
- return SCM_PROGRAM_DATA (program)->module;
+ objs = SCM_PROGRAM_DATA (program)->objs;
+ return scm_is_true (objs) ? scm_c_vector_ref (objs, 0) : SCM_BOOL_F;
}
#undef FUNC_NAME
diff --git a/libguile/programs.h b/libguile/programs.h
index e57f6d08a..4b5447fb8 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -57,8 +57,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 module; /* resolve bindings with respect to this module */
- SCM meta; /* meta data */
SCM objs; /* constant objects */
SCM external; /* external environment */
SCM holder; /* the owner of bytecode */
@@ -70,7 +68,7 @@ extern scm_t_bits 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)
-extern SCM scm_c_make_program (void *addr, size_t size, SCM holder);
+extern SCM scm_c_make_program (void *addr, size_t size, SCM objs, SCM holder);
extern SCM scm_c_make_closure (SCM program, SCM external);
extern SCM scm_program_p (SCM obj);
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index fcafd5151..2f058c5b8 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -58,8 +58,7 @@ vm_run (SCM vm, SCM program, SCM args)
struct scm_program *bp = NULL; /* program base pointer */
SCM external = SCM_EOL; /* external environment */
SCM *objects = NULL; /* constant objects */
- scm_t_array_handle objects_handle; /* handle of the OBJECTS array */
- size_t object_count; /* length of OBJECTS */
+ size_t object_count = 0; /* length of OBJECTS */
SCM *stack_base = vp->stack_base; /* stack base address */
SCM *stack_limit = vp->stack_limit; /* stack limit address */
@@ -105,9 +104,7 @@ vm_run (SCM vm, SCM program, SCM args)
SCM prog = program;
/* Boot program */
- scm_byte_t bytes[6] = {scm_op_mv_call, 0, 0, 1, scm_op_make_int8_1, scm_op_halt};
- bytes[1] = scm_ilength (args); /* FIXME: argument overflow */
- program = scm_c_make_program (bytes, 6, SCM_BOOL_F);
+ program = vm_make_boot_program (scm_ilength (args));
/* Initial frame */
CACHE_REGISTER ();
@@ -152,8 +149,6 @@ vm_run (SCM vm, SCM program, SCM args)
vm_error_wrong_num_args:
/* nargs and program are valid */
SYNC_ALL ();
- if (objects)
- scm_array_handle_release (&objects_handle);
scm_wrong_num_args (program);
/* shouldn't get here */
goto vm_error;
@@ -222,8 +217,6 @@ vm_run (SCM vm, SCM program, SCM args)
vm_error:
SYNC_ALL ();
- if (objects)
- scm_array_handle_release (&objects_handle);
scm_ithrow (sym_vm_error, SCM_LIST3 (sym_vm_run, err_msg, err_args), 1);
}
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index d0ceaf492..eef9ee6d4 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -163,17 +163,15 @@
call `scm_vector_writable_elements ()' and the likes. */
#define CACHE_PROGRAM() \
{ \
- ssize_t _vincr; \
- \
if (bp != SCM_PROGRAM_DATA (program)) { \
bp = SCM_PROGRAM_DATA (program); \
- /* Was: objects = SCM_VELTS (bp->objs); */ \
- \
- if (objects) \
- scm_array_handle_release (&objects_handle); \
- \
- objects = scm_vector_writable_elements (bp->objs, &objects_handle, \
- &object_count, &_vincr); \
+ if (SCM_I_IS_VECTOR (bp->objs)) { \
+ objects = SCM_I_VECTOR_WELTS (bp->objs); \
+ object_count = SCM_I_VECTOR_LENGTH (bp->objs); \
+ } else { \
+ objects = NULL; \
+ object_count = 0; \
+ } \
} \
}
diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c
index 71f53abf5..45aced1de 100644
--- a/libguile/vm-i-loader.c
+++ b/libguile/vm-i-loader.c
@@ -106,37 +106,33 @@ VM_DEFINE_LOADER (load_keyword, "load-keyword")
VM_DEFINE_LOADER (load_program, "load-program")
{
size_t len;
- SCM prog, x;
+ SCM prog, x, objs = SCM_BOOL_F, meta = SCM_BOOL_F;
struct scm_program *p;
- FETCH_LENGTH (len);
- SYNC_REGISTER ();
- prog = scm_c_make_program (ip, len, program);
- p = SCM_PROGRAM_DATA (prog);
- ip += len;
-
POP (x);
/* init meta data */
if (SCM_PROGRAM_P (x))
{
- p->meta = x;
+ meta = x;
POP (x);
}
/* init object table */
if (scm_is_vector (x))
{
-#if 0
- if (scm_is_simple_vector (x))
- printf ("is_simple_vector!\n");
- else
- printf ("NOT is_simple_vector\n");
-#endif
- p->objs = x;
+ objs = x;
+ scm_c_vector_set_x (objs, 0, scm_current_module ());
+ scm_c_vector_set_x (objs, 1, meta);
POP (x);
}
+ FETCH_LENGTH (len);
+ SYNC_REGISTER ();
+ prog = scm_c_make_program (ip, len, objs, program);
+ p = SCM_PROGRAM_DATA (prog);
+ ip += len;
+
/* init parameters */
/* NOTE: format defined in system/vm/assemble.scm */
if (SCM_I_INUMP (x))
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 60182c75a..6e98235de 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -297,10 +297,11 @@ VM_DEFINE_INSTRUCTION (toplevel_ref, "toplevel-ref", 1, 0, 1)
SYNC_REGISTER ();
if (SCM_LIKELY (SCM_SYMBOLP (what)))
{
+ SCM mod;
if (SCM_LIKELY (scm_module_system_booted_p
- && scm_is_true (bp->module)))
+ && scm_is_true ((mod = scm_program_module (program)))))
/* might longjmp */
- what = scm_module_lookup (bp->module, what);
+ what = scm_module_lookup (mod, what);
else
what = scm_sym2var (what, SCM_BOOL_F, SCM_BOOL_F);
}
@@ -379,10 +380,11 @@ VM_DEFINE_INSTRUCTION (toplevel_set, "toplevel-set", 1, 1, 0)
SYNC_BEFORE_GC ();
if (SCM_LIKELY (SCM_SYMBOLP (what)))
{
+ SCM mod;
if (SCM_LIKELY (scm_module_system_booted_p
- && scm_is_true (bp->module)))
+ && scm_is_true ((mod = scm_program_module (program)))))
/* might longjmp */
- what = scm_module_lookup (bp->module, what);
+ what = scm_module_lookup (mod, what);
else
what = scm_sym2var (what, SCM_BOOL_F, SCM_BOOL_F);
}
diff --git a/libguile/vm.c b/libguile/vm.c
index 429c0903b..6f1481e23 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -282,6 +282,16 @@ vm_fetch_length (scm_byte_t *ip, size_t *lenp)
return ip;
}
+static SCM
+vm_make_boot_program (long len)
+{
+ scm_byte_t bytes[6] = {scm_op_mv_call, 0, 0, 1, scm_op_make_int8_1, scm_op_halt};
+ if (SCM_UNLIKELY (len > 255 || len < 0))
+ abort ();
+ bytes[1] = (scm_byte_t)len;
+ return scm_c_make_program (bytes, 6, SCM_BOOL_F, SCM_BOOL_F);
+}
+
/*
* VM
diff --git a/module/language/glil/compile-objcode.scm b/module/language/glil/compile-objcode.scm
index 2788665f8..8cef763d3 100644
--- a/module/language/glil/compile-objcode.scm
+++ b/module/language/glil/compile-objcode.scm
@@ -115,8 +115,9 @@
(closed-bindings '())
(source-alist '())
(label-alist '())
- ;; the pre-elements are prepended to the object vector
- ;; in practice these are placeholders for module & meta.
+ ;; the pre-elements are prepended to the object vector in
+ ;; practice these are placeholders for module & meta,
+ ;; respectively.
(object-pre-elements '(#f #f))
(object-alist '()))
(define (object-index obj)