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; static SCM write_program = SCM_BOOL_F;
SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0, 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 #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; objtable = SCM_BOOL_F;
else if (scm_is_true (objtable)) else if (scm_is_true (objtable))
SCM_VALIDATE_VECTOR (2, objtable); SCM_VALIDATE_VECTOR (2, objtable);
if (SCM_UNLIKELY (SCM_UNBNDP (free_vars))) if (SCM_UNLIKELY (SCM_UNBNDP (free_variables)))
free_vars = SCM_BOOL_F; free_variables = SCM_BOOL_F;
else if (free_vars != SCM_BOOL_F) else if (free_variables != SCM_BOOL_F)
SCM_VALIDATE_VECTOR (3, free_vars); 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 #undef FUNC_NAME
@ -59,8 +59,8 @@ program_mark (SCM obj)
{ {
if (scm_is_true (SCM_PROGRAM_OBJTABLE (obj))) if (scm_is_true (SCM_PROGRAM_OBJTABLE (obj)))
scm_gc_mark (SCM_PROGRAM_OBJTABLE (obj)); scm_gc_mark (SCM_PROGRAM_OBJTABLE (obj));
if (scm_is_true (SCM_PROGRAM_FREE_VARS (obj))) if (scm_is_true (SCM_PROGRAM_FREE_VARIABLES (obj)))
scm_gc_mark (SCM_PROGRAM_FREE_VARS (obj)); scm_gc_mark (SCM_PROGRAM_FREE_VARIABLES (obj));
return SCM_PROGRAM_OBJCODE (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))) */ 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), (SCM program),
"") "")
#define FUNC_NAME s_scm_program_free_vars #define FUNC_NAME s_scm_program_free_variables
{ {
SCM_VALIDATE_PROGRAM (1, program); SCM_VALIDATE_PROGRAM (1, program);
return SCM_PROGRAM_FREE_VARS (program); return SCM_PROGRAM_FREE_VARIABLES (program);
} }
#undef FUNC_NAME #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_P(x) (SCM_SMOB_PREDICATE (scm_tc16_program, x))
#define SCM_PROGRAM_OBJCODE(x) (SCM_SMOB_OBJECT (x)) #define SCM_PROGRAM_OBJCODE(x) (SCM_SMOB_OBJECT (x))
#define SCM_PROGRAM_OBJTABLE(x) (SCM_SMOB_OBJECT_2 (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_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_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) #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_p (SCM obj);
SCM_API SCM scm_program_base (SCM program); 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_name (SCM program);
SCM_API SCM scm_program_objects (SCM program); SCM_API SCM scm_program_objects (SCM program);
SCM_API SCM scm_program_module (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_program_objcode (SCM program);
SCM_API SCM scm_c_program_source (SCM program, size_t ip); 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_HOOKS 0 /* Various hooks */
#define VM_USE_CLOCK 0 /* Bogoclock */ #define VM_USE_CLOCK 0 /* Bogoclock */
#define VM_CHECK_OBJECT 1 /* Check object table */ #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 */ #define VM_PUSH_DEBUG_FRAMES 0 /* Push frames onto the evaluator debug stack */
#elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE) #elif (VM_ENGINE == SCM_VM_DEBUG_ENGINE)
#define VM_USE_HOOKS 1 #define VM_USE_HOOKS 1
#define VM_USE_CLOCK 1 #define VM_USE_CLOCK 1
#define VM_CHECK_OBJECT 1 #define VM_CHECK_OBJECT 1
#define VM_CHECK_CLOSURE 1 #define VM_CHECK_FREE_VARIABLES 1
#define VM_PUSH_DEBUG_FRAMES 1 #define VM_PUSH_DEBUG_FRAMES 1
#else #else
#error unknown debug engine VM_ENGINE #error unknown debug engine VM_ENGINE
@ -47,8 +47,8 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
/* Cache variables */ /* Cache variables */
struct scm_objcode *bp = NULL; /* program base pointer */ struct scm_objcode *bp = NULL; /* program base pointer */
SCM *closure = NULL; /* closure variables */ SCM *free_vars = NULL; /* free variables */
size_t closure_count = 0; /* length of CLOSURE */ size_t free_vars_count = 0; /* length of FREE_VARS */
SCM *objects = NULL; /* constant objects */ SCM *objects = NULL; /* constant objects */
size_t object_count = 0; /* length of OBJECTS */ size_t object_count = 0; /* length of OBJECTS */
SCM *stack_base = vp->stack_base; /* stack base address */ 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; goto vm_error;
#endif #endif
#if VM_CHECK_CLOSURE #if VM_CHECK_FREE_VARIABLES
vm_error_closure: vm_error_free_variable:
err_msg = scm_from_locale_string ("VM: Invalid closure variable access"); err_msg = scm_from_locale_string ("VM: Invalid free variable access");
finish_args = SCM_EOL; finish_args = SCM_EOL;
goto vm_error; goto vm_error;
#endif #endif
@ -254,7 +254,7 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
#undef VM_USE_HOOKS #undef VM_USE_HOOKS
#undef VM_USE_CLOCK #undef VM_USE_CLOCK
#undef VM_CHECK_OBJECT #undef VM_CHECK_OBJECT
#undef VM_CHECK_CLOSURE #undef VM_CHECK_FREE_VARIABLE
#undef VM_PUSH_DEBUG_FRAMES #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)) \ if (SCM_I_IS_VECTOR (c)) \
{ \ { \
closure = SCM_I_VECTOR_WELTS (c); \ free_vars = SCM_I_VECTOR_WELTS (c); \
closure_count = SCM_I_VECTOR_LENGTH (c); \ free_vars_count = SCM_I_VECTOR_LENGTH (c); \
} \ } \
else \ else \
{ \ { \
closure = NULL; \ free_vars = NULL; \
closure_count = 0; \ free_vars_count = 0; \
} \ } \
} \ } \
} }
@ -189,11 +189,11 @@
#define CHECK_OBJECT(_num) #define CHECK_OBJECT(_num)
#endif #endif
#if VM_CHECK_CLOSURE #if VM_CHECK_FREE_VARIABLES
#define CHECK_CLOSURE(_num) \ #define CHECK_FREE_VARIABLE(_num) \
do { if (SCM_UNLIKELY ((_num) >= closure_count)) goto vm_error_closure; } while (0) do { if (SCM_UNLIKELY ((_num) >= free_vars_count)) goto vm_error_free_variable; } while (0)
#else #else
#define CHECK_CLOSURE(_num) #define CHECK_FREE_VARIABLE(_num)
#endif #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_SET(v,o) SCM_VARIABLE_SET (v, o)
#define VARIABLE_BOUNDP(v) (VARIABLE_REF (v) != SCM_UNDEFINED) #define VARIABLE_BOUNDP(v) (VARIABLE_REF (v) != SCM_UNDEFINED)
#define CLOSURE_REF(i) closure[i] #define FREE_VARIABLE_REF(i) free_vars[i]
/* ref */ /* ref */
@ -1138,41 +1138,41 @@ VM_DEFINE_INSTRUCTION (59, local_boxed_set, "local-boxed-set", 1, 1, 0)
NEXT; 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 (); scm_t_uint8 idx = FETCH ();
CHECK_CLOSURE (idx); CHECK_FREE_VARIABLE (idx);
PUSH (CLOSURE_REF (idx)); PUSH (FREE_VARIABLE_REF (idx));
NEXT; 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 v;
scm_t_uint8 idx = FETCH (); scm_t_uint8 idx = FETCH ();
CHECK_CLOSURE (idx); CHECK_FREE_VARIABLE (idx);
v = CLOSURE_REF (idx); v = FREE_VARIABLE_REF (idx);
ASSERT_BOUND_VARIABLE (v); ASSERT_BOUND_VARIABLE (v);
PUSH (VARIABLE_REF (v)); PUSH (VARIABLE_REF (v));
NEXT; 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 v, val;
scm_t_uint8 idx = FETCH (); scm_t_uint8 idx = FETCH ();
POP (val); POP (val);
CHECK_CLOSURE (idx); CHECK_FREE_VARIABLE (idx);
v = CLOSURE_REF (idx); v = FREE_VARIABLE_REF (idx);
ASSERT_BOUND_VARIABLE (v); ASSERT_BOUND_VARIABLE (v);
VARIABLE_SET (v, val); VARIABLE_SET (v, val);
NEXT; 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; SCM vect;
POP (vect); POP (vect);

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

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

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

@ -503,7 +503,7 @@
(else (error "what" x loc)))) (else (error "what" x loc))))
free-locs) free-locs)
(emit-code #f (make-glil-call 'vector (length 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) (if (eq? context 'tail)
(emit-code #f (make-glil-call 'return 1))))))) (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-arity program-meta
program-objcode program? program-objects 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") (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 #f #f ref 0) (call return 1))
(lexical #t #f ref 0) (lexical #t #f ref 0)
(call vector 1) (call vector 1)
(call make-closure2 2) (call make-closure 2)
(call return 1)) (call return 1))
(call return 1)))) (call return 1))))