mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

rename "closure-ref" to "free-ref"; s/vars/variables/ in some names

Browse source 
* libguile/programs.h:
* libguile/programs.c: (SCM_PROGRAM_FREE_VARIABLES): Rename from
  SCM_PROGRAM_FREE_VARS. Callers changed.
* libguile/programs.c (scm_make_program): Rename arg to
  "free_variables".
  (scm_program_free_variables): Rename from program-free-vars.

* libguile/vm-engine.h:
* libguile/vm-engine.c (VM_CHECK_FREE_VARIABLES): Rename from
  VM_CHECK_CLOSURE.
  (vm_engine, CACHE_PROGRAM): Rename closure and closure_count to free_vars and
  free_vars_vount.

* libguile/vm-i-system.c (FREE_VARIABLE_REF): Rename from CLOSURE_REF.
  (free-ref, free-boxed-ref, free-boxed-set): Rename from closure-ref,
  closure-boxed-ref, closure-boxed-set.
  (make-closure): Renamed from make-closure2.

* module/language/glil/compile-assembly.scm (glil->assembly): Hack to
  never write out the the old "make-closure" instruction. Will fix
  better later. Change to emit free-ref etc instead of closure-ref.

* module/language/tree-il/compile-glil.scm (flatten): Emit make-closure
  instead of make-closure2, now that the old make-closure is gone.

* module/system/vm/program.scm (system): Rename program-free-vars to
  program-free-variables.

* test-suite/tests/tree-il.test ("lambda"): Update for make-closure.
This commit is contained in:
Andy Wingo 2009-07-23 14:36:22 +02:00
parent 20d47c3915
commit 57ab0671d7
9 changed files with 49 additions and 49 deletions
Download patch file Download diff file Expand all files Collapse all files

22
libguile/programs.c
View file

@ -36,7 +36,7 @@ scm_t_bits scm_tc16_program;
static SCM write_program = SCM_BOOL_F;
SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0,
(SCM objcode, SCM objtable, SCM free_vars),
(SCM objcode, SCM objtable, SCM free_variables),
"")
#define FUNC_NAME s_scm_make_program
{
@ -45,12 +45,12 @@ SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0,
objtable = SCM_BOOL_F;
else if (scm_is_true (objtable))
SCM_VALIDATE_VECTOR (2, objtable);
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);
if (SCM_UNLIKELY (SCM_UNBNDP (free_variables)))
free_variables = SCM_BOOL_F;
else if (free_variables != SCM_BOOL_F)
SCM_VALIDATE_VECTOR (3, free_variables);
SCM_RETURN_NEWSMOB3 (scm_tc16_program, objcode, objtable, free_vars);
SCM_RETURN_NEWSMOB3 (scm_tc16_program, objcode, objtable, free_variables);
}
#undef FUNC_NAME
@ -59,8 +59,8 @@ program_mark (SCM obj)
{
if (scm_is_true (SCM_PROGRAM_OBJTABLE (obj)))
scm_gc_mark (SCM_PROGRAM_OBJTABLE (obj));
if (scm_is_true (SCM_PROGRAM_FREE_VARS (obj)))
scm_gc_mark (SCM_PROGRAM_FREE_VARS (obj));
if (scm_is_true (SCM_PROGRAM_FREE_VARIABLES (obj)))
scm_gc_mark (SCM_PROGRAM_FREE_VARIABLES (obj));
return SCM_PROGRAM_OBJCODE (obj);
}
@ -293,13 +293,13 @@ scm_c_program_source (SCM program, size_t ip)
return source; /* (addr . (filename . (line . column))) */
}
SCM_DEFINE (scm_program_free_vars, "program-free-vars", 1, 0, 0,
SCM_DEFINE (scm_program_free_variables, "program-free-variables", 1, 0, 0,
(SCM program),
"")
#define FUNC_NAME s_scm_program_free_vars
#define FUNC_NAME s_scm_program_free_variables
{
SCM_VALIDATE_PROGRAM (1, program);
return SCM_PROGRAM_FREE_VARS (program);
return SCM_PROGRAM_FREE_VARIABLES (program);
}
#undef FUNC_NAME

6
libguile/programs.h
View file

@ -35,12 +35,12 @@ SCM_API scm_t_bits scm_tc16_program;
#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_FREE_VARS(x) (SCM_SMOB_OBJECT_3 (x))
#define SCM_PROGRAM_FREE_VARIABLES(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 free_vars);
SCM_API SCM scm_make_program (SCM objcode, SCM objtable, SCM free_variables);
SCM_API SCM scm_program_p (SCM obj);
SCM_API SCM scm_program_base (SCM program);
@ -53,7 +53,7 @@ SCM_API SCM scm_program_properties (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_free_vars (SCM program);
SCM_API SCM scm_program_free_variables (SCM program);
SCM_API SCM scm_program_objcode (SCM program);
SCM_API SCM scm_c_program_source (SCM program, size_t ip);

16
libguile/vm-engine.c
View file

@ -22,13 +22,13 @@
#define VM_USE_HOOKS 0 /* Various hooks */
#define VM_USE_CLOCK 0 /* Bogoclock */
#define VM_CHECK_OBJECT 1 /* Check object table */
#define VM_CHECK_CLOSURE 1 /* Check closure vars */
#define VM_CHECK_FREE_VARIABLES 1 /* Check free variable access */
#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_OBJECT 1
#define VM_CHECK_CLOSURE 1
#define VM_CHECK_FREE_VARIABLES 1
#define VM_PUSH_DEBUG_FRAMES 1
#else
#error unknown debug engine VM_ENGINE
@ -47,8 +47,8 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
/* Cache variables */
struct scm_objcode *bp = NULL; /* program base pointer */
SCM *closure = NULL; /* closure variables */
size_t closure_count = 0; /* length of CLOSURE */
SCM *free_vars = NULL; /* free variables */
size_t free_vars_count = 0; /* length of FREE_VARS */
SCM *objects = NULL; /* constant objects */
size_t object_count = 0; /* length of OBJECTS */
SCM *stack_base = vp->stack_base; /* stack base address */
@ -234,9 +234,9 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
goto vm_error;
#endif
#if VM_CHECK_CLOSURE
vm_error_closure:
err_msg = scm_from_locale_string ("VM: Invalid closure variable access");
#if VM_CHECK_FREE_VARIABLES
vm_error_free_variable:
err_msg = scm_from_locale_string ("VM: Invalid free variable access");
finish_args = SCM_EOL;
goto vm_error;
#endif
@ -254,7 +254,7 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
#undef VM_USE_HOOKS
#undef VM_USE_CLOCK
#undef VM_CHECK_OBJECT
#undef VM_CHECK_CLOSURE
#undef VM_CHECK_FREE_VARIABLE
#undef VM_PUSH_DEBUG_FRAMES
/*

18
libguile/vm-engine.h
View file

@ -152,16 +152,16 @@
} \
} \
{ \
SCM c = SCM_PROGRAM_FREE_VARS (program); \
SCM c = SCM_PROGRAM_FREE_VARIABLES (program); \
if (SCM_I_IS_VECTOR (c)) \
{ \
closure = SCM_I_VECTOR_WELTS (c); \
closure_count = SCM_I_VECTOR_LENGTH (c); \
free_vars = SCM_I_VECTOR_WELTS (c); \
free_vars_count = SCM_I_VECTOR_LENGTH (c); \
} \
else \
{ \
closure = NULL; \
closure_count = 0; \
free_vars = NULL; \
free_vars_count = 0; \
} \
} \
}
@ -189,11 +189,11 @@
#define CHECK_OBJECT(_num)
#endif
#if VM_CHECK_CLOSURE
#define CHECK_CLOSURE(_num) \
do { if (SCM_UNLIKELY ((_num) >= closure_count)) goto vm_error_closure; } while (0)
#if VM_CHECK_FREE_VARIABLES
#define CHECK_FREE_VARIABLE(_num) \
do { if (SCM_UNLIKELY ((_num) >= free_vars_count)) goto vm_error_free_variable; } while (0)
#else
#define CHECK_CLOSURE(_num)
#define CHECK_FREE_VARIABLE(_num)
#endif

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

@ -248,7 +248,7 @@ VM_DEFINE_INSTRUCTION (22, list_break, "list-break", 0, 0, 0)
#define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
#define VARIABLE_BOUNDP(v) (VARIABLE_REF (v) != SCM_UNDEFINED)
#define CLOSURE_REF(i) closure[i]
#define FREE_VARIABLE_REF(i) free_vars[i]
/* ref */
@ -1138,41 +1138,41 @@ VM_DEFINE_INSTRUCTION (59, local_boxed_set, "local-boxed-set", 1, 1, 0)
NEXT;
}
VM_DEFINE_INSTRUCTION (60, closure_ref, "closure-ref", 1, 0, 1)
VM_DEFINE_INSTRUCTION (60, free_ref, "free-ref", 1, 0, 1)
{
scm_t_uint8 idx = FETCH ();
CHECK_CLOSURE (idx);
PUSH (CLOSURE_REF (idx));
CHECK_FREE_VARIABLE (idx);
PUSH (FREE_VARIABLE_REF (idx));
NEXT;
}
/* no closure-set -- if a var is assigned, it should be in a box */
/* no free-set -- if a var is assigned, it should be in a box */
VM_DEFINE_INSTRUCTION (61, closure_boxed_ref, "closure-boxed-ref", 1, 0, 1)
VM_DEFINE_INSTRUCTION (61, free_boxed_ref, "free-boxed-ref", 1, 0, 1)
{
SCM v;
scm_t_uint8 idx = FETCH ();
CHECK_CLOSURE (idx);
v = CLOSURE_REF (idx);
CHECK_FREE_VARIABLE (idx);
v = FREE_VARIABLE_REF (idx);
ASSERT_BOUND_VARIABLE (v);
PUSH (VARIABLE_REF (v));
NEXT;
}
VM_DEFINE_INSTRUCTION (62, closure_boxed_set, "closure-boxed-set", 1, 1, 0)
VM_DEFINE_INSTRUCTION (62, free_boxed_set, "free-boxed-set", 1, 1, 0)
{
SCM v, val;
scm_t_uint8 idx = FETCH ();
POP (val);
CHECK_CLOSURE (idx);
v = CLOSURE_REF (idx);
CHECK_FREE_VARIABLE (idx);
v = FREE_VARIABLE_REF (idx);
ASSERT_BOUND_VARIABLE (v);
VARIABLE_SET (v, val);
NEXT;
}
VM_DEFINE_INSTRUCTION (63, make_closure2, "make-closure2", 0, 2, 1)
VM_DEFINE_INSTRUCTION (63, make_closure, "make-closure", 0, 2, 1)
{
SCM vect;
POP (vect);

6
module/language/glil/compile-assembly.scm
View file

@ -178,7 +178,7 @@
(emit-code (align-program prog addr)))
(else
(let ((table (dump-object (make-object-table objects) addr))
(closure (if (> closure-level 0) '((make-closure)) '())))
(closure '()))
(cond
(object-alist
;; if we are being compiled from something with an object
@ -267,8 +267,8 @@
((empty-box) 'empty-box)
(else (error "what" op)))
(case op
((ref) (if boxed? 'closure-boxed-ref 'closure-ref))
((set) (if boxed? 'closure-boxed-set (error "what." glil)))
((ref) (if boxed? 'free-boxed-ref 'free-ref))
((set) (if boxed? 'free-boxed-set (error "what." glil)))
(else (error "what" op))))
,index))))

2
module/language/tree-il/compile-glil.scm
View file

@ -503,7 +503,7 @@
(else (error "what" x loc))))
free-locs)
(emit-code #f (make-glil-call 'vector (length free-locs)))
(emit-code #f (make-glil-call 'make-closure2 2))))
(emit-code #f (make-glil-call 'make-closure 2))))
(if (eq? context 'tail)
(emit-code #f (make-glil-call 'return 1)))))))

2
module/system/vm/program.scm
View file

@ -33,7 +33,7 @@
program-arity program-meta
program-objcode program? program-objects
program-module program-base program-free-vars))
program-module program-base program-free-variables))
(load-extension "libguile" "scm_init_programs")

2
test-suite/tests/tree-il.test
View file

@ -376,7 +376,7 @@
(lexical #f #f ref 0) (call return 1))
(lexical #t #f ref 0)
(call vector 1)
(call make-closure2 2)
(call make-closure 2)
(call return 1))
(call return 1))))