mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 00:30:21 +02:00
Code Activity

move module and meta inside programs' object tables

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2009-01-17 16:42:53 +01:00
parent a72317988f
commit 2fda024221
9 changed files with 64 additions and 61 deletions
Download patch file Download diff file Expand all files Collapse all files

2
libguile/objcodes.c
View file

@ -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];

37
libguile/programs.c
View file

@ -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);
if (scm_is_true (p->objs))
scm_gc_mark (p->objs);
if (!scm_is_null (p->external))
scm_gc_mark (p->external);
scm_gc_mark (p->module);
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_call_0 (p->meta);
meta = scm_c_vector_ref (p->objs, 1);
if (scm_is_false (meta))
return SCM_BOOL_F;
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

4
libguile/programs.h
View file

@ -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);

11
libguile/vm-engine.c
View file

@ -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);
}

16
libguile/vm-engine.h
View file

@ -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; \
} \
} \
}

26
libguile/vm-i-loader.c
View file

@ -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))

10
libguile/vm-i-system.c
View file

@ -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);
}

10
libguile/vm.c
View file

@ -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

5
module/language/glil/compile-objcode.scm
View file

@ -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)