* libguile/frames.c (scm_frame_external_link): Removed.
* libguile/frames.h: No need to have the "external link" in the stack
frame -- update macros to take the new situation into account.
* libguile/objcodes.h (struct scm_objcode): Rename the nexts field to
"unused". In the future we can use it for nlocs, I think.
(SCM_OBJCODE_NEXTS): removed.
* libguile/programs.h:
* libguile/programs.c (scm_make_program): Expect the third argument to
be a vector of free variables, not a list of free variables.
SCM_BOOL_F indicates no free variables, not SCM_EOL.
(program_mark): Adapt.
(scm_program_arity): No more nexts.
(scm_program_free_vars): Replaces scm_program_externals.
* libguile/vm-engine.c (VM_CHECK_EXTERNAL)
(vm_engine): No need for the "external" var.
* libguile/vm-engine.h (CACHE_PROGRAM): Update for SCM_PROGRAM_FREE_VARS
instead of SCM_PROGRAM_EXTERNALS.
(NEW_FRAME): Update for new frame size, and no need to cons up
externals. Yay :)
* libguile/vm-i-loader.c (load-program): Update for scm_make_program.
* libguile/vm-i-system.c (external-ref, external-set): No more.
(make-closure): No more.
(goto/args): No need to re-cons externals here. Update for new stack
frame size.
(mv-call, return, return/values): Update for new frame size. No need
to reinstate externals on return.
* libguile/vm.c (really_make_boot_program, scm_load_compiled_with_vm):
Update for scm_make_program.
* module/language/objcode/spec.scm (objcode-env-externals): Treat '() as
#f, for the externals. Need to clean this up later...
* module/system/vm/program.scm (arity:nexts): Remove. Rename
program-external to program-free-vars.
-/* Copyright (C) 2001 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
}
#undef FUNC_NAME
-SCM_DEFINE (scm_vm_frame_external_link, "vm-frame-external-link", 1, 0, 0,
- (SCM frame),
- "")
-#define FUNC_NAME s_scm_vm_frame_external_link
-{
- SCM_VALIDATE_VM_FRAME (1, frame);
- return SCM_FRAME_EXTERNAL_LINK (SCM_VM_FRAME_FP (frame));
-}
-#undef FUNC_NAME
-
SCM_DEFINE (scm_vm_frame_stack, "vm-frame-stack", 1, 0, 0,
(SCM frame),
"")
-/* Copyright (C) 2001 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
/* VM Frame Layout
---------------
- | | <- fp + bp->nargs + bp->nlocs + 4
+ | | <- fp + bp->nargs + bp->nlocs + 3
+------------------+ = SCM_FRAME_UPPER_ADDRESS (fp)
| Return address |
| MV return address|
- | Dynamic link |
- | External link | <- fp + bp->nargs + bp->nlocs
+ | Dynamic link | <- fp + bp->nargs + bp->blocs
| Local variable 1 | = SCM_FRAME_DATA_ADDRESS (fp)
| Local variable 0 | <- fp + bp->nargs
| Argument 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_UPPER_ADDRESS(fp) (SCM_FRAME_DATA_ADDRESS (fp) + 3)
#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_FRAME_RETURN_ADDRESS(fp) \
- (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[3]))
-#define SCM_FRAME_MV_RETURN_ADDRESS(fp) \
(SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[2]))
+#define SCM_FRAME_MV_RETURN_ADDRESS(fp) \
+ (SCM_FRAME_BYTE_CAST (SCM_FRAME_DATA_ADDRESS (fp)[1]))
#define SCM_FRAME_DYNAMIC_LINK(fp) \
- (SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[1]))
+ (SCM_FRAME_STACK_CAST (SCM_FRAME_DATA_ADDRESS (fp)[0]))
#define SCM_FRAME_SET_DYNAMIC_LINK(fp, dl) \
((SCM_FRAME_DATA_ADDRESS (fp)[1])) = (SCM)(dl);
-#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]
SCM_API SCM scm_vm_frame_return_address (SCM frame);
SCM_API SCM scm_vm_frame_mv_return_address (SCM frame);
SCM_API SCM scm_vm_frame_dynamic_link (SCM frame);
-SCM_API SCM scm_vm_frame_external_link (SCM frame);
SCM_API SCM scm_vm_frame_stack (SCM frame);
SCM_API SCM scm_c_vm_frame_prev (SCM frame);
scm_t_uint8 nargs;
scm_t_uint8 nrest;
scm_t_uint8 nlocs;
- scm_t_uint8 nexts;
+ scm_t_uint8 unused;
scm_t_uint32 len; /* the maximum index of base[] */
scm_t_uint32 metalen; /* well, i lie. this many bytes at the end of
base[] for metadata */
#define SCM_OBJCODE_NARGS(x) (SCM_OBJCODE_DATA (x)->nargs)
#define SCM_OBJCODE_NREST(x) (SCM_OBJCODE_DATA (x)->nrest)
#define SCM_OBJCODE_NLOCS(x) (SCM_OBJCODE_DATA (x)->nlocs)
-#define SCM_OBJCODE_NEXTS(x) (SCM_OBJCODE_DATA (x)->nexts)
#define SCM_OBJCODE_BASE(x) (SCM_OBJCODE_DATA (x)->base)
#define SCM_OBJCODE_IS_MMAP(x) (SCM_SMOB_FLAGS (x) & SCM_F_OBJCODE_IS_MMAP)
-/* Copyright (C) 2001 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
static SCM write_program = SCM_BOOL_F;
SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0,
- (SCM objcode, SCM objtable, SCM external),
+ (SCM objcode, SCM objtable, SCM free_vars),
"")
#define FUNC_NAME s_scm_make_program
{
objtable = SCM_BOOL_F;
else if (scm_is_true (objtable))
SCM_VALIDATE_VECTOR (2, objtable);
- if (SCM_UNLIKELY (SCM_UNBNDP (external)))
- external = SCM_EOL;
- else
- /* FIXME: currently this test is quite expensive (can be 2-3% of total
- execution time in programs that make many closures). We could remove it,
- yes, but we'd get much better gains if we used some other method, like
- just capturing the variables that we need instead of all heap-allocated
- variables. Dunno. Keeping the check for now, as it's a user-callable
- function, and inlining the op in the vm's make-closure operation. */
- SCM_VALIDATE_LIST (3, external);
-
- SCM_RETURN_NEWSMOB3 (scm_tc16_program, objcode, objtable, external);
+ if (SCM_UNLIKELY (SCM_UNBNDP (free_vars)))
+ free_vars = SCM_BOOL_F;
+ else if (free_vars != SCM_BOOL_F)
+ SCM_VALIDATE_VECTOR (3, free_vars);
+
+ SCM_RETURN_NEWSMOB3 (scm_tc16_program, objcode, objtable, free_vars);
}
#undef FUNC_NAME
{
if (scm_is_true (SCM_PROGRAM_OBJTABLE (obj)))
scm_gc_mark (SCM_PROGRAM_OBJTABLE (obj));
- if (!scm_is_null (SCM_PROGRAM_EXTERNALS (obj)))
- scm_gc_mark (SCM_PROGRAM_EXTERNALS (obj));
+ if (scm_is_true (SCM_PROGRAM_FREE_VARS (obj)))
+ scm_gc_mark (SCM_PROGRAM_FREE_VARS (obj));
return SCM_PROGRAM_OBJCODE (obj);
}
SCM_VALIDATE_PROGRAM (1, program);
p = SCM_PROGRAM_DATA (program);
- return scm_list_4 (SCM_I_MAKINUM (p->nargs),
+ return scm_list_3 (SCM_I_MAKINUM (p->nargs),
SCM_I_MAKINUM (p->nrest),
- SCM_I_MAKINUM (p->nlocs),
- SCM_I_MAKINUM (p->nexts));
+ SCM_I_MAKINUM (p->nlocs));
}
#undef FUNC_NAME
metaobj = scm_objcode_meta (SCM_PROGRAM_OBJCODE (program));
if (scm_is_true (metaobj))
- return scm_make_program (metaobj, SCM_BOOL_F, SCM_EOL);
+ return scm_make_program (metaobj, SCM_BOOL_F, SCM_BOOL_F);
else
return SCM_BOOL_F;
}
return source; /* (addr . (filename . (line . column))) */
}
-SCM_DEFINE (scm_program_external, "program-external", 1, 0, 0,
+SCM_DEFINE (scm_program_free_vars, "program-free-vars", 1, 0, 0,
(SCM program),
"")
-#define FUNC_NAME s_scm_program_external
-{
- SCM_VALIDATE_PROGRAM (1, program);
- return SCM_PROGRAM_EXTERNALS (program);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_program_external_set_x, "program-external-set!", 2, 0, 0,
- (SCM program, SCM external),
- "Modify the list of closure variables of @var{program} (for "
- "debugging purposes).")
-#define FUNC_NAME s_scm_program_external_set_x
+#define FUNC_NAME s_scm_program_free_vars
{
SCM_VALIDATE_PROGRAM (1, program);
- SCM_VALIDATE_LIST (2, external);
- SCM_PROGRAM_EXTERNALS (program) = external;
- return SCM_UNSPECIFIED;
+ return SCM_PROGRAM_FREE_VARS (program);
}
#undef FUNC_NAME
-/* Copyright (C) 2001 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
#define SCM_PROGRAM_P(x) (SCM_SMOB_PREDICATE (scm_tc16_program, x))
#define SCM_PROGRAM_OBJCODE(x) (SCM_SMOB_OBJECT (x))
#define SCM_PROGRAM_OBJTABLE(x) (SCM_SMOB_OBJECT_2 (x))
-#define SCM_PROGRAM_EXTERNALS(x) (SCM_SMOB_OBJECT_3 (x))
+#define SCM_PROGRAM_FREE_VARS(x) (SCM_SMOB_OBJECT_3 (x))
#define SCM_PROGRAM_DATA(x) (SCM_OBJCODE_DATA (SCM_PROGRAM_OBJCODE (x)))
#define SCM_VALIDATE_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, PROGRAM_P)
#define SCM_PROGRAM_IS_BOOT(x) (SCM_SMOB_FLAGS (x) & SCM_F_PROGRAM_IS_BOOT)
-SCM_API SCM scm_make_program (SCM objcode, SCM objtable, SCM externals);
+SCM_API SCM scm_make_program (SCM objcode, SCM objtable, SCM free_vars);
SCM_API SCM scm_program_p (SCM obj);
SCM_API SCM scm_program_base (SCM program);
SCM_API SCM scm_program_name (SCM program);
SCM_API SCM scm_program_objects (SCM program);
SCM_API SCM scm_program_module (SCM program);
-SCM_API SCM scm_program_external (SCM program);
-SCM_API SCM scm_program_external_set_x (SCM program, SCM external);
+SCM_API SCM scm_program_free_vars (SCM program);
SCM_API SCM scm_program_objcode (SCM program);
SCM_API SCM scm_c_program_source (SCM program, size_t ip);
#if (VM_ENGINE == SCM_VM_REGULAR_ENGINE)
#define VM_USE_HOOKS 0 /* Various hooks */
#define VM_USE_CLOCK 0 /* Bogoclock */
-#define VM_CHECK_EXTERNAL 1 /* Check external link */
#define VM_CHECK_OBJECT 1 /* Check object table */
#define VM_CHECK_CLOSURE 1 /* Check closure vars */
#define VM_PUSH_DEBUG_FRAMES 0 /* Push frames onto the evaluator debug stack */
#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
#define VM_USE_HOOKS 1
#define VM_USE_CLOCK 1
-#define VM_CHECK_EXTERNAL 1
#define VM_CHECK_OBJECT 1
#define VM_CHECK_CLOSURE 1
#define VM_PUSH_DEBUG_FRAMES 1
/* Cache variables */
struct scm_objcode *bp = NULL; /* program base pointer */
- SCM external = SCM_EOL; /* external environment REMOVEME */
SCM *closure = NULL; /* closure variables */
size_t closure_count = 0; /* length of CLOSURE */
SCM *objects = NULL; /* constant objects */
goto vm_error;
#endif
-#if VM_CHECK_EXTERNAL
- vm_error_external:
- err_msg = scm_from_locale_string ("VM: Invalid external access");
- finish_args = SCM_EOL;
- goto vm_error;
-#endif
-
#if VM_CHECK_OBJECT
vm_error_object:
err_msg = scm_from_locale_string ("VM: Invalid object table access");
#undef VM_USE_HOOKS
#undef VM_USE_CLOCK
-#undef VM_CHECK_EXTERNAL
#undef VM_CHECK_OBJECT
+#undef VM_CHECK_CLOSURE
#undef VM_PUSH_DEBUG_FRAMES
/*
#define ASSERT_BOUND(x)
#endif
-/* Get a local copy of the program's "object table" (i.e. the vector of
- external bindings that are referenced by the program), initialized by
- `load-program'. */
-/* XXX: We could instead use the "simple vector macros", thus not having to
- call `scm_vector_writable_elements ()' and the likes. */
+/* Cache the object table and free variables. */
#define CACHE_PROGRAM() \
{ \
if (bp != SCM_PROGRAM_DATA (program)) { \
} \
} \
{ \
- SCM c = SCM_PROGRAM_EXTERNALS (program); \
+ SCM c = SCM_PROGRAM_FREE_VARS (program); \
if (SCM_I_IS_VECTOR (c)) \
{ \
closure = SCM_I_VECTOR_WELTS (c); \
* Error check
*/
-#undef CHECK_EXTERNAL
-#if VM_CHECK_EXTERNAL
-#define CHECK_EXTERNAL(e) \
- do { if (SCM_UNLIKELY (!SCM_CONSP (e))) goto vm_error_external; } while (0)
-#else
-#define CHECK_EXTERNAL(e)
-#endif
-
/* Accesses to a program's object table. */
#if VM_CHECK_OBJECT
#define CHECK_OBJECT(_num) \
/* New registers */ \
fp = sp - bp->nargs + 1; \
data = SCM_FRAME_DATA_ADDRESS (fp); \
- sp = data + 3; \
+ sp = data + 2; \
CHECK_OVERFLOW (); \
stack_base = sp; \
ip = bp->base; \
data[-i] = SCM_UNDEFINED; \
\
/* Set frame data */ \
- data[3] = (SCM)ra; \
- data[2] = 0x0; \
- data[1] = (SCM)dl; \
- \
- /* Postpone initializing external vars, \
- because if the CONS causes a GC, we \
- want the stack marker to see the data \
- array formatted as expected. */ \
- data[0] = SCM_UNDEFINED; \
- external = SCM_PROGRAM_EXTERNALS (fp[-1]); \
- for (i = 0; i < bp->nexts; i++) \
- CONS (external, SCM_UNDEFINED, external); \
- data[0] = external; \
+ data[2] = (SCM)ra; \
+ data[1] = 0x0; \
+ data[0] = (SCM)dl; \
}
-#define CACHE_EXTERNAL() external = fp[bp->nargs + bp->nlocs]
-
/*
Local Variables:
c-file-style: "gnu"
objcode = scm_c_make_objcode_slice (SCM_PROGRAM_OBJCODE (fp[-1]), ip);
len = sizeof (struct scm_objcode) + SCM_OBJCODE_TOTAL_LEN (objcode);
- PUSH (scm_make_program (objcode, objs, SCM_EOL));
+ PUSH (scm_make_program (objcode, objs, SCM_BOOL_F));
ip += len;
NEXT;
}
-VM_DEFINE_INSTRUCTION (26, external_ref, "external-ref", 1, 0, 1)
-{
- unsigned int i;
- SCM e = external;
- for (i = FETCH (); i; i--)
- {
- CHECK_EXTERNAL(e);
- e = SCM_CDR (e);
- }
- CHECK_EXTERNAL(e);
- PUSH (SCM_CAR (e));
- ASSERT_BOUND (*sp);
- NEXT;
-}
-
VM_DEFINE_INSTRUCTION (27, variable_ref, "variable-ref", 0, 0, 1)
{
SCM x = *sp;
NEXT;
}
-VM_DEFINE_INSTRUCTION (31, external_set, "external-set", 1, 1, 0)
-{
- unsigned int i;
- SCM e = external;
- for (i = FETCH (); i; i--)
- {
- CHECK_EXTERNAL(e);
- e = SCM_CDR (e);
- }
- CHECK_EXTERNAL(e);
- SCM_SETCAR (e, *sp);
- DROP ();
- NEXT;
-}
-
VM_DEFINE_INSTRUCTION (32, variable_set, "variable-set", 0, 1, 0)
{
VARIABLE_SET (sp[0], sp[-1]);
* Subprogram call
*/
-VM_DEFINE_INSTRUCTION (42, make_closure, "make-closure", 0, 1, 1)
-{
- SYNC_BEFORE_GC ();
- SCM_NEWSMOB3 (*sp, scm_tc16_program, SCM_PROGRAM_OBJCODE (*sp),
- SCM_PROGRAM_OBJTABLE (*sp), external);
- NEXT;
-}
-
VM_DEFINE_INSTRUCTION (43, call, "call", 1, -1, 1)
{
SCM x;
sp -= 2;
NULLSTACK (bp->nargs + 1);
- /* Freshen the externals */
- external = SCM_PROGRAM_EXTERNALS (x);
- for (i = 0; i < bp->nexts; i++)
- CONS (external, SCM_UNDEFINED, external);
- SCM_FRAME_DATA_ADDRESS (fp)[0] = external;
-
/* Init locals to valid SCM values */
for (i = 0; i < bp->nlocs; i++)
LOCAL_SET (i + bp->nargs, SCM_UNDEFINED);
sure we have space for the locals now */
data = SCM_FRAME_DATA_ADDRESS (fp);
ip = bp->base;
- stack_base = data + 3;
+ stack_base = data + 2;
sp = stack_base;
CHECK_OVERFLOW ();
data[-i] = SCM_UNDEFINED;
/* Set frame data */
- data[3] = (SCM)ra;
- data[2] = (SCM)mvra;
- data[1] = (SCM)dl;
-
- /* Postpone initializing external vars, because if the CONS causes a GC,
- we want the stack marker to see the data array formatted as expected. */
- data[0] = SCM_UNDEFINED;
- external = SCM_PROGRAM_EXTERNALS (fp[-1]);
- for (i = 0; i < bp->nexts; i++)
- CONS (external, SCM_UNDEFINED, external);
- data[0] = external;
+ data[2] = (SCM)ra;
+ data[1] = (SCM)mvra;
+ data[0] = (SCM)dl;
ENTER_HOOK ();
APPLY_HOOK ();
CACHE_PROGRAM ();
INIT_ARGS ();
NEW_FRAME ();
- SCM_FRAME_DATA_ADDRESS (fp)[2] = (SCM)(SCM_FRAME_RETURN_ADDRESS (fp) + offset);
+ SCM_FRAME_DATA_ADDRESS (fp)[1] = (SCM)(SCM_FRAME_RETURN_ADDRESS (fp) + offset);
ENTER_HOOK ();
APPLY_HOOK ();
NEXT;
POP (ret);
ASSERT (sp == stack_base);
- ASSERT (stack_base == data + 3);
+ ASSERT (stack_base == data + 2);
/* Restore registers */
sp = SCM_FRAME_LOWER_ADDRESS (fp);
- ip = SCM_FRAME_BYTE_CAST (data[3]);
- fp = SCM_FRAME_STACK_CAST (data[1]);
+ ip = SCM_FRAME_BYTE_CAST (data[2]);
+ fp = SCM_FRAME_STACK_CAST (data[0]);
{
#ifdef VM_ENABLE_STACK_NULLING
int nullcount = stack_base - sp;
/* Restore the last program */
program = SCM_FRAME_PROGRAM (fp);
CACHE_PROGRAM ();
- CACHE_EXTERNAL ();
CHECK_IP ();
NEXT;
}
RETURN_HOOK ();
data = SCM_FRAME_DATA_ADDRESS (fp);
- ASSERT (stack_base == data + 3);
+ ASSERT (stack_base == data + 2);
- /* data[2] is the mv return address */
- if (nvalues != 1 && data[2])
+ /* data[1] is the mv return address */
+ if (nvalues != 1 && data[1])
{
int i;
/* Restore registers */
sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
- ip = SCM_FRAME_BYTE_CAST (data[2]); /* multiple value ra */
- fp = SCM_FRAME_STACK_CAST (data[1]);
+ ip = SCM_FRAME_BYTE_CAST (data[1]); /* multiple value ra */
+ fp = SCM_FRAME_STACK_CAST (data[0]);
/* Push return values, and the number of values */
for (i = 0; i < nvalues; i++)
continuation.) */
/* Restore registers */
sp = SCM_FRAME_LOWER_ADDRESS (fp) - 1;
- ip = SCM_FRAME_BYTE_CAST (data[3]); /* single value ra */
- fp = SCM_FRAME_STACK_CAST (data[1]);
+ ip = SCM_FRAME_BYTE_CAST (data[2]); /* single value ra */
+ fp = SCM_FRAME_STACK_CAST (data[0]);
/* Push first value */
*++sp = stack_base[1];
/* Restore the last program */
program = SCM_FRAME_PROGRAM (fp);
CACHE_PROGRAM ();
- CACHE_EXTERNAL ();
CHECK_IP ();
NEXT;
}
-/* Copyright (C) 2001 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
u8vec = make_u8vector (bytes.bytes, sizeof (bytes.bytes));
ret = scm_make_program (scm_bytecode_to_objcode (u8vec),
- SCM_BOOL_F, SCM_EOL);
+ SCM_BOOL_F, SCM_BOOL_F);
SCM_SET_SMOB_FLAGS (ret, SCM_F_PROGRAM_IS_BOOT);
return ret;
SCM scm_load_compiled_with_vm (SCM file)
{
SCM program = scm_make_program (scm_load_objcode (file),
- SCM_BOOL_F, SCM_EOL);
+ SCM_BOOL_F, SCM_BOOL_F);
return scm_c_vm_run (scm_the_vm (), program, NULL, 0);
}
;;; Guile Lowlevel Intermediate Language
-;; Copyright (C) 2001 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
(if env (car env) (current-module)))
(define (objcode-env-externals env)
- (if env (cdr env) '()))
+ (and env (vector? (cdr env)) (cdr env)))
(define (objcode->value x e opts)
(let ((thunk (make-program x #f (objcode-env-externals e))))
;;; Guile VM program functions
-;;; Copyright (C) 2001 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2009 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
program-properties program-property program-documentation
program-name program-arguments
- program-arity program-external-set! program-meta
+ program-arity program-meta
program-objcode program? program-objects
- program-module program-base program-external))
+ program-module program-base program-free-vars))
(load-extension "libguile" "scm_init_programs")
(define arity:nargs car)
(define arity:nrest cadr)
(define arity:nlocs caddr)
-(define arity:nexts cadddr)
(define (make-binding name extp index start end)
(list name extp index start end))
HCoop / bpt / guile.git / commitdiff