mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

scm_call_N doesn't cons for calling programs

Browse source 
* libguile/eval.c (scm_call_0, scm_call_1, scm_call_2, scm_call_3)
  (scm_call_4): Special-case compiled procedures here, to avoid consing.

* libguile/vm.h:
* libguile/vm.c (scm_c_vm_run): Take a SCM after all.
  (scm_vm_apply, scm_load_compiled_with_vm): Adapt to vm_run change.
This commit is contained in:
Andy Wingo 2009-02-05 00:51:34 +01:00
parent af35fc20a6
commit 4abef68f61
3 changed files with 37 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

38
libguile/eval.c
View file

@ -52,6 +52,7 @@
#include "libguile/ports.h"
#include "libguile/print.h"
#include "libguile/procprop.h"
#include "libguile/programs.h"
#include "libguile/root.h"
#include "libguile/smob.h"
#include "libguile/srcprop.h"
@ -62,6 +63,7 @@
#include "libguile/validate.h"
#include "libguile/values.h"
#include "libguile/vectors.h"
#include "libguile/vm.h"
#include "libguile/eval.h"
#include "libguile/private-options.h"
@ -3050,32 +3052,56 @@ SCM_DEFINE (scm_evaluator_traps, "evaluator-traps-interface", 0, 1, 0,
SCM
scm_call_0 (SCM proc)
{
return scm_apply (proc, SCM_EOL, SCM_EOL);
if (SCM_PROGRAM_P (proc))
return scm_c_vm_run (scm_the_vm (), proc, NULL, 0);
else
return scm_apply (proc, SCM_EOL, SCM_EOL);
}
SCM
scm_call_1 (SCM proc, SCM arg1)
{
return scm_apply (proc, arg1, scm_listofnull);
if (SCM_PROGRAM_P (proc))
return scm_c_vm_run (scm_the_vm (), proc, &arg1, 1);
else
return scm_apply (proc, arg1, scm_listofnull);
}
SCM
scm_call_2 (SCM proc, SCM arg1, SCM arg2)
{
return scm_apply (proc, arg1, scm_cons (arg2, scm_listofnull));
if (SCM_PROGRAM_P (proc))
{
SCM args[] = { arg1, arg2 };
return scm_c_vm_run (scm_the_vm (), proc, args, 2);
}
else
return scm_apply (proc, arg1, scm_cons (arg2, scm_listofnull));
}
SCM
scm_call_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3)
{
return scm_apply (proc, arg1, scm_cons2 (arg2, arg3, scm_listofnull));
if (SCM_PROGRAM_P (proc))
{
SCM args[] = { arg1, arg2, arg3 };
return scm_c_vm_run (scm_the_vm (), proc, args, 3);
}
else
return scm_apply (proc, arg1, scm_cons2 (arg2, arg3, scm_listofnull));
}
SCM
scm_call_4 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4)
{
return scm_apply (proc, arg1, scm_cons2 (arg2, arg3,
scm_cons (arg4, scm_listofnull)));
if (SCM_PROGRAM_P (proc))
{
SCM args[] = { arg1, arg2, arg3, arg4 };
return scm_c_vm_run (scm_the_vm (), proc, args, 4);
}
else
return scm_apply (proc, arg1, scm_cons2 (arg2, arg3,
scm_cons (arg4, scm_listofnull)));
}
/* Simple procedure applies

7
libguile/vm.c
View file

@ -378,8 +378,9 @@ vm_free (SCM obj)
}
SCM
scm_c_vm_run (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs)
{
struct scm_vm *vp = SCM_VM_DATA (vm);
return vm_engines[vp->engine](vp, program, argv, nargs);
}
@ -404,7 +405,7 @@ scm_vm_apply (SCM vm, SCM program, SCM args)
args = SCM_CDR (args);
}
return scm_c_vm_run (SCM_VM_DATA (vm), program, argv, nargs);
return scm_c_vm_run (vm, program, argv, nargs);
}
#undef FUNC_NAME
@ -625,7 +626,7 @@ SCM scm_load_compiled_with_vm (SCM file)
SCM program = scm_make_program (scm_load_objcode (file),
SCM_BOOL_F, SCM_EOL);
return scm_c_vm_run (SCM_VM_DATA (scm_the_vm ()), program, NULL, 0);
return scm_c_vm_run (scm_the_vm (), program, NULL, 0);
}
void

2
libguile/vm.h
View file

@ -87,7 +87,7 @@ extern SCM scm_the_vm_fluid;
extern SCM scm_the_vm ();
extern SCM scm_make_vm (void);
extern SCM scm_vm_apply (SCM vm, SCM program, SCM args);
extern SCM scm_c_vm_run (struct scm_vm *vp, SCM program, SCM *argv, int nargs);
extern SCM scm_c_vm_run (SCM vm, SCM program, SCM *argv, int nargs);
extern SCM scm_vm_option_ref (SCM vm, SCM key);
extern SCM scm_vm_option_set_x (SCM vm, SCM key, SCM val);