summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-12-01 22:20:03 +0100
committerAndy Wingo <wingo@pobox.com>2009-12-01 22:20:03 +0100
commit67e2d80a6a97b51aefea701cf10112102b09b392 (patch)
treeac3dfda730ddb8ffb6dabbde888dc838a8723d95
parentcc8d1f5fcd97de920111d407d2c9e88d6aedbc6d (diff)
downloadguile-67e2d80a6a97b51aefea701cf10112102b09b392.tar.gz
apply goes to the vm, not the interpreter
* libguile/eval.c (eval): Call scm_vm_apply instead of apply. (apply): Deleted, no longer referenced. Heh. (scm_apply): Call scm_vm_apply. * libguile/init.c (scm_i_init_guile): Bootstrap the VM before the evaluator. * libguile/vm.c (scm_vm_apply): Actually it's not necessary that the procedure is a program; so that's cool, relax the check.
-rw-r--r--libguile/eval.c157
-rw-r--r--libguile/init.c3
-rw-r--r--libguile/vm.c2
3 files changed, 6 insertions, 156 deletions
diff --git a/libguile/eval.c b/libguile/eval.c
index 664d66217..1f3c36b62 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -141,8 +141,6 @@ scm_badargsp (SCM formals, SCM args)
return !scm_is_null (args) ? 1 : 0;
}
-static SCM apply (SCM proc, SCM args);
-
/* the environment:
(VAL ... . MOD)
If MOD is #f, it means the environment was captured before modules were
@@ -236,7 +234,7 @@ eval (SCM x, SCM env)
goto loop;
}
else
- return apply (proc, args);
+ return scm_vm_apply (scm_the_vm (), proc, args);
case SCM_M_CALL:
/* Evaluate the procedure to be applied. */
@@ -278,7 +276,7 @@ eval (SCM x, SCM env)
SCM rest = SCM_EOL;
for (; scm_is_pair (mx); mx = CDR (mx))
rest = scm_cons (eval (CAR (mx), env), rest);
- return apply (proc, scm_reverse (rest));
+ return scm_vm_apply (scm_the_vm (), proc, scm_reverse (rest));
}
case SCM_M_CONT:
@@ -303,7 +301,7 @@ eval (SCM x, SCM env)
producer = eval (CAR (mx), env);
proc = eval (CDR (mx), env); /* proc is the consumer. */
- v = apply (producer, SCM_EOL);
+ v = scm_vm_apply (scm_the_vm (), producer, SCM_EOL);
if (SCM_VALUESP (v))
args = scm_struct_ref (v, SCM_INUM0);
else
@@ -392,153 +390,6 @@ eval (SCM x, SCM env)
}
}
-static SCM
-apply (SCM proc, SCM args)
-{
- SCM arg1, arg2, arg3, rest;
- unsigned int nargs;
-
- SCM_ASRTGO (SCM_NIMP (proc), badproc);
-
- /* Args contains a list of all args. */
- {
- int ilen = scm_ilength (args);
- if (ilen < 0)
- scm_wrong_num_args (proc);
- nargs = ilen;
- }
-
- /* Parse args. */
- switch (nargs)
- {
- case 0:
- arg1 = SCM_UNDEFINED; arg2 = SCM_UNDEFINED;
- arg3 = SCM_UNDEFINED; rest = SCM_EOL;
- break;
- case 1:
- arg1 = CAR (args); arg2 = SCM_UNDEFINED;
- arg3 = SCM_UNDEFINED; rest = SCM_EOL;
- break;
- case 2:
- arg1 = CAR (args); arg2 = CADR (args);
- arg3 = SCM_UNDEFINED; rest = SCM_EOL;
- break;
- default:
- arg1 = CAR (args); arg2 = CADR (args);
- arg3 = CADDR (args); rest = CDDDR (args);
- break;
- }
-
- tail:
- switch (SCM_TYP7 (proc))
- {
- case scm_tcs_closures:
- {
- int nreq = SCM_CLOSURE_NUM_REQUIRED_ARGS (proc);
- SCM env = SCM_ENV (proc);
- if (SCM_CLOSURE_HAS_REST_ARGS (proc))
- {
- if (SCM_UNLIKELY (scm_ilength (args) < nreq))
- scm_wrong_num_args (proc);
- for (; nreq; nreq--, args = CDR (args))
- env = scm_cons (CAR (args), env);
- env = scm_cons (args, env);
- }
- else
- {
- for (; scm_is_pair (args); args = CDR (args), nreq--)
- env = scm_cons (CAR (args), env);
- if (SCM_UNLIKELY (nreq != 0))
- scm_wrong_num_args (proc);
- }
- return eval (SCM_CLOSURE_BODY (proc), env);
- }
- case scm_tc7_subr_2o:
- if (nargs > 2 || nargs < 1) scm_wrong_num_args (proc);
- return SCM_SUBRF (proc) (arg1, arg2);
- case scm_tc7_subr_2:
- if (nargs != 2) scm_wrong_num_args (proc);
- return SCM_SUBRF (proc) (arg1, arg2);
- case scm_tc7_subr_0:
- if (nargs != 0) scm_wrong_num_args (proc);
- return SCM_SUBRF (proc) ();
- case scm_tc7_subr_1:
- if (nargs != 1) scm_wrong_num_args (proc);
- return SCM_SUBRF (proc) (arg1);
- case scm_tc7_subr_1o:
- if (nargs > 1) scm_wrong_num_args (proc);
- return SCM_SUBRF (proc) (arg1);
- case scm_tc7_dsubr:
- if (nargs != 1) scm_wrong_num_args (proc);
- if (SCM_I_INUMP (arg1))
- return scm_from_double (SCM_DSUBRF (proc) ((double) SCM_I_INUM (arg1)));
- else if (SCM_REALP (arg1))
- return scm_from_double (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1)));
- else if (SCM_BIGP (arg1))
- return scm_from_double (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1)));
- else if (SCM_FRACTIONP (arg1))
- return scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1)));
- SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
- SCM_ARG1, scm_i_symbol_chars (SCM_SUBR_NAME (proc)));
- case scm_tc7_cxr:
- if (nargs != 1) scm_wrong_num_args (proc);
- return scm_i_chase_pairs (arg1, (scm_t_bits) SCM_SUBRF (proc));
- case scm_tc7_subr_3:
- if (nargs != 3) scm_wrong_num_args (proc);
- return SCM_SUBRF (proc) (arg1, arg2, arg3);
- case scm_tc7_lsubr:
- return SCM_SUBRF (proc) (args);
- case scm_tc7_lsubr_2:
- if (nargs < 2) scm_wrong_num_args (proc);
- return SCM_SUBRF (proc) (arg1, arg2, scm_cddr (args));
- case scm_tc7_asubr:
- if (nargs < 2)
- return SCM_SUBRF (proc) (arg1, SCM_UNDEFINED);
- for (args = CDR (args); nargs > 1; args = CDR (args), nargs--)
- arg1 = SCM_SUBRF (proc) (arg1, CAR (args));
- return arg1;
- case scm_tc7_program:
- return scm_vm_apply (scm_the_vm (), proc, args);
- case scm_tc7_rpsubr:
- if (nargs == 0)
- return SCM_BOOL_T;
- for (args = CDR (args); nargs > 1;
- arg1 = CAR (args), args = CDR (args), nargs--)
- if (scm_is_false (SCM_SUBRF (proc) (arg1, CAR (args))))
- return SCM_BOOL_F;
- return SCM_BOOL_T;
- case scm_tc7_smob:
- if (!SCM_SMOB_APPLICABLE_P (proc))
- goto badproc;
- switch (nargs)
- {
- case 0:
- return SCM_SMOB_APPLY_0 (proc);
- case 1:
- return SCM_SMOB_APPLY_1 (proc, arg1);
- case 2:
- return SCM_SMOB_APPLY_2 (proc, arg1, arg2);
- default:
- return SCM_SMOB_APPLY_3 (proc, arg1, arg2, scm_cddr (args));
- }
- case scm_tc7_gsubr:
- return scm_i_gsubr_apply_list (proc, args);
- case scm_tc7_pws:
- return apply (SCM_PROCEDURE (proc), args);
- case scm_tcs_struct:
- if (SCM_STRUCT_APPLICABLE_P (proc))
- {
- proc = SCM_STRUCT_PROCEDURE (proc);
- goto tail;
- }
- else
- goto badproc;
- default:
- badproc:
- scm_wrong_type_arg ("apply", SCM_ARG1, proc);
- }
-}
-
SCM
scm_closure_apply (SCM proc, SCM args)
{
@@ -1070,7 +921,7 @@ scm_apply (SCM proc, SCM arg1, SCM args)
else
args = scm_cons_star (arg1, args);
- return apply (proc, args);
+ return scm_vm_apply (scm_the_vm (), proc, args);
}
diff --git a/libguile/init.c b/libguile/init.c
index 85b277b32..a7434b33d 100644
--- a/libguile/init.c
+++ b/libguile/init.c
@@ -551,6 +551,7 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_weaks ();
scm_init_guardians ();
scm_init_vports ();
+ scm_bootstrap_vm ();
scm_init_memoize ();
scm_init_eval ();
scm_init_evalext ();
@@ -588,8 +589,6 @@ scm_i_init_guile (SCM_STACKITEM *base)
scm_init_rw ();
scm_init_extensions ();
- scm_bootstrap_vm ();
-
atexit (cleanup_for_exit);
scm_load_startup_files ();
}
diff --git a/libguile/vm.c b/libguile/vm.c
index f9e4abe47..247bb7d09 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -514,7 +514,7 @@ scm_vm_apply (SCM vm, SCM program, SCM args)
int i, nargs;
SCM_VALIDATE_VM (1, vm);
- SCM_VALIDATE_PROGRAM (2, program);
+ SCM_VALIDATE_PROC (2, program);
nargs = scm_ilength (args);
if (SCM_UNLIKELY (nargs < 0))