diff options
author | Ludovic Courtès <ludo@gnu.org> | 2009-02-16 00:24:00 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2009-03-02 00:20:43 +0100 |
commit | e20d7001c3f7150400169fecb0bf0eefdf122fe2 (patch) | |
tree | c87cda61cb2fd5574aa8aceccd199d48736437c0 /libguile/eval.i.c | |
parent | b786a5bbf825f61e04ccd9a54f93cb1e40ac67d9 (diff) | |
download | guile-e20d7001c3f7150400169fecb0bf0eefdf122fe2.tar.gz |
Remove "compiled closures" ("cclos") in favor of a simpler mechanism.
The idea is to introduce `gsubrs' whose arity is encoded in their type
(more precisely in the sizeof (void *) - 8 MSBs). This removes the
indirection introduced by cclos and simplifies the code.
* libguile/__scm.h (CCLO): Remove.
* libguile/debug.c (scm_procedure_source, scm_procedure_environment):
Remove references to `scm_tc7_cclo'.
* libguile/eval.c (scm_trampoline_0, scm_trampoline_1,
scm_trampoline_2): Replace `scm_tc7_cclo' with `scm_tc7_gsubr'.
* libguile/eval.i.c (CEVAL): Likewise. No longer make PROC the first
argument. Directly invoke `scm_gsubr_apply ()' instead of jump to the
`evap(N+1)' label or call to `SCM_APPLY ()'.
* libguile/evalext.c (scm_self_evaluating_p): Remove reference to
`scm_tc7_cclo'.
* libguile/gc-card.c (scm_i_sweep_card, scm_i_tag_name): Likewise.
* libguile/gc-mark.c (scm_gc_mark_dependencies): Likewise.
* libguile/goops.c (scm_class_of): Likewise.
* libguile/print.c (iprin1): Likewise.
* libguile/gsubr.c (create_gsubr): Use `unsigned int's for REQ, OPT and
RST. Use `scm_tc7_gsubr' instead of `scm_makcclo ()' in the default
case.
(scm_gsubr_apply): Remove calls to `SCM_GSUBR_PROC ()'.
(scm_f_gsubr_apply): Remove.
* libguile/gsubr.h (SCM_GSUBR_TYPE): New definition.
(SCM_GSUBR_MAX): Changed to 33.
(SCM_SET_GSUBR_TYPE, SCM_GSUBR_PROC, SCM_SET_GSUBR_PROC,
scm_f_gsubr_apply): Remove.
* libguile/procprop.c (scm_i_procedure_arity): Remove reference to
`scm_tc7_cclo'; add proper handling of `scm_tc7_gsubr'.
* libguile/procs.c (scm_makcclo, scm_make_cclo): Remove.
(scm_procedure_p): Remove reference to `scm_tc7_cclo'.
(scm_thunk_p): Likewise, plus add proper `scm_tc7_gsubr' handling.
* libguile/procs.h (SCM_CCLO_LENGTH, SCM_MAKE_CCLO_TAG,
SCM_SET_CCLO_LENGTH, SCM_CCLO_BASE, SCM_SET_CCLO_BASE, SCM_CCLO_REF,
SCM_CCLO_SET, SCM_CCLO_SUBR, SCM_SET_CCLO_SUBR, scm_makcclo,
scm_make_cclo): Remove.
* libguile/stacks.c (read_frames): Remove reference to `scm_f_gsubr_apply'.
* libguile/tags.h (scm_tc7_cclo): Remove.
(scm_tc7_gsubr): New.
(scm_tcs_subrs): Add `scm_tc7_gsubr'.
Diffstat (limited to 'libguile/eval.i.c')
-rw-r--r-- | libguile/eval.i.c | 46 |
1 files changed, 16 insertions, 30 deletions
diff --git a/libguile/eval.i.c b/libguile/eval.i.c index 83878ff41..65e274435 100644 --- a/libguile/eval.i.c +++ b/libguile/eval.i.c @@ -1,7 +1,7 @@ /* * eval.i.c - actual evaluator code for GUILE * - * Copyright (C) 2002, 03, 04, 05, 06, 07 Free Software Foundation, Inc. + * Copyright (C) 2002, 03, 04, 05, 06, 07, 09 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 @@ -1124,14 +1124,12 @@ dispatch: if (!SCM_SMOB_APPLICABLE_P (proc)) goto badfun; RETURN (SCM_SMOB_APPLY_0 (proc)); - case scm_tc7_cclo: - arg1 = proc; - proc = SCM_CCLO_SUBR (proc); + case scm_tc7_gsubr: #ifdef DEVAL debug.info->a.proc = proc; - debug.info->a.args = scm_list_1 (arg1); + debug.info->a.args = SCM_EOL; #endif - goto evap1; + RETURN (scm_gsubr_apply (scm_list_1 (proc))); case scm_tc7_pws: proc = SCM_PROCEDURE (proc); #ifdef DEVAL @@ -1245,15 +1243,12 @@ dispatch: if (!SCM_SMOB_APPLICABLE_P (proc)) goto badfun; RETURN (SCM_SMOB_APPLY_1 (proc, arg1)); - case scm_tc7_cclo: - arg2 = arg1; - arg1 = proc; - proc = SCM_CCLO_SUBR (proc); + case scm_tc7_gsubr: #ifdef DEVAL debug.info->a.args = scm_cons (arg1, debug.info->a.args); debug.info->a.proc = proc; #endif - goto evap2; + RETURN (scm_gsubr_apply (scm_list_2 (proc, arg1))); case scm_tc7_pws: proc = SCM_PROCEDURE (proc); #ifdef DEVAL @@ -1351,19 +1346,14 @@ dispatch: goto badfun; RETURN (SCM_SMOB_APPLY_2 (proc, arg1, arg2)); cclon: - case scm_tc7_cclo: + case scm_tc7_gsubr: #ifdef DEVAL - RETURN (SCM_APPLY (SCM_CCLO_SUBR (proc), - scm_cons (proc, debug.info->a.args), - SCM_EOL)); + RETURN (scm_gsubr_apply (scm_cons (proc, debug.info->a.args))); #else - RETURN (SCM_APPLY (SCM_CCLO_SUBR (proc), - scm_cons2 (proc, arg1, - scm_cons (arg2, - scm_ceval_args (x, - env, - proc))), - SCM_EOL)); + RETURN (scm_gsubr_apply + (scm_cons (proc, + scm_cons2 (arg1, arg2, + scm_ceval_args (x, env, proc))))); #endif case scm_tcs_struct: if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC) @@ -1492,7 +1482,7 @@ dispatch: goto badfun; RETURN (SCM_SMOB_APPLY_3 (proc, arg1, arg2, SCM_CDDR (debug.info->a.args))); - case scm_tc7_cclo: + case scm_tc7_gsubr: goto cclon; case scm_tc7_pws: proc = SCM_PROCEDURE (proc); @@ -1555,7 +1545,7 @@ dispatch: goto badfun; RETURN (SCM_SMOB_APPLY_3 (proc, arg1, arg2, scm_ceval_args (x, env, proc))); - case scm_tc7_cclo: + case scm_tc7_gsubr: goto cclon; case scm_tc7_pws: proc = SCM_PROCEDURE (proc); @@ -1867,19 +1857,15 @@ tail: RETURN (SCM_SMOB_APPLY_2 (proc, arg1, SCM_CAR (args))); else RETURN (SCM_SMOB_APPLY_3 (proc, arg1, SCM_CAR (args), SCM_CDR (args))); - case scm_tc7_cclo: + case scm_tc7_gsubr: #ifdef DEVAL args = (SCM_UNBNDP(arg1) ? SCM_EOL : debug.vect[0].a.args); - arg1 = proc; - proc = SCM_CCLO_SUBR (proc); debug.vect[0].a.proc = proc; debug.vect[0].a.args = scm_cons (arg1, args); #else args = (SCM_UNBNDP(arg1) ? SCM_EOL : scm_cons (arg1, args)); - arg1 = proc; - proc = SCM_CCLO_SUBR (proc); #endif - goto tail; + RETURN (scm_gsubr_apply (scm_cons (proc, args))); case scm_tc7_pws: proc = SCM_PROCEDURE (proc); #ifdef DEVAL |