mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

primitive-eval passes first N args on stack directly, not via apply

Browse source 
* libguile/memoize.c (MAKMEMO_CALL): Memoize in the number of arguments
  at the call site.
  (memoize, scm_m_cond, memoize_named_let, unmemoize):
* libguile/eval.c (eval): Adapt to changes in call memoization.

* module/ice-9/eval.scm (primitive-eval): For calls, pass the first N
  arguments directly on the stack, and only the rest as a consed
  argument list to apply. Currently N is 4.
This commit is contained in:
Andy Wingo 2009-12-13 17:05:10 +01:00
parent 4abb824cdb
commit 9331f91cc4
3 changed files with 55 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

5
libguile/eval.c
View file

@ -254,8 +254,8 @@ eval (SCM x, SCM env)
case SCM_M_CALL:
/* Evaluate the procedure to be applied. */
proc = eval (CAR (mx), env);
mx = CDR (mx);
/* int nargs = CADR (mx); */
mx = CDDR (mx);
if (BOOT_CLOSURE_P (proc))
{
@ -289,6 +289,7 @@ eval (SCM x, SCM env)
else
{
SCM rest = SCM_EOL;
/* FIXME: use alloca */
for (; scm_is_pair (mx); mx = CDR (mx))
rest = scm_cons (eval (CAR (mx), env), rest);
return scm_vm_apply (scm_the_vm (), proc, scm_reverse (rest));

16
libguile/memoize.c
View file

@ -207,8 +207,8 @@ scm_t_bits scm_tc16_memoized;
MAKMEMO (SCM_M_CONT, proc)
#define MAKMEMO_CALL_WITH_VALUES(prod, cons) \
MAKMEMO (SCM_M_CALL_WITH_VALUES, scm_cons (prod, cons))
#define MAKMEMO_CALL(proc, args) \
MAKMEMO (SCM_M_CALL, scm_cons (proc, args))
#define MAKMEMO_CALL(proc, nargs, args) \
MAKMEMO (SCM_M_CALL, scm_cons (proc, scm_cons (SCM_I_MAKINUM (nargs), args)))
#define MAKMEMO_LEX_REF(n) \
MAKMEMO (SCM_M_LEXICAL_REF, SCM_I_MAKINUM (n))
#define MAKMEMO_LEX_SET(n, val) \
@ -345,11 +345,15 @@ memoize (SCM exp, SCM env)
return trans (exp, env);
else
{
SCM proc;
SCM args = SCM_EOL;
for (; scm_is_pair (exp); exp = CDR (exp))
int nargs = 0;
proc = memoize (CAR (exp), env);
for (exp = CDR (exp); scm_is_pair (exp); exp = CDR (exp), nargs++)
args = scm_cons (memoize (CAR (exp), env), args);
if (scm_is_null (exp))
return MAKMEMO (SCM_M_CALL, scm_reverse_x (args, SCM_UNDEFINED));
return MAKMEMO_CALL (proc, nargs,
scm_reverse_x (args, SCM_UNDEFINED));
else
syntax_error ("expected a proper list", exp, SCM_UNDEFINED);
}
@ -566,6 +570,7 @@ scm_m_cond (SCM expr, SCM env)
i = MAKMEMO_IF (MAKMEMO_LEX_REF (0),
MAKMEMO_CALL (memoize (CADDR (clause),
scm_cons (tmp, new_env)),
1,
scm_list_1 (MAKMEMO_LEX_REF (0))),
MAKMEMO_QUOTE (SCM_UNSPECIFIED));
SCM_SETCDR (loc,
@ -793,6 +798,7 @@ memoize_named_let (const SCM expr, SCM env)
memoize_sequence (CDDDR (expr),
memoize_env_extend (env, rvariables)))),
MAKMEMO_CALL (MAKMEMO_LEX_REF (0),
nreq,
memoize_exprs (inits, env)))));
}
@ -1054,7 +1060,7 @@ unmemoize (const SCM expr)
case SCM_M_BEGIN:
return scm_cons (scm_sym_begin, unmemoize_exprs (args));
case SCM_M_CALL:
return unmemoize_exprs (args);
return scm_cons (unmemoize (CAR (args)), unmemoize_exprs (CDDR (args)));
case SCM_M_CONT:
return scm_list_2 (scm_sym_atcall_cc, unmemoize (args));
case SCM_M_CALL_WITH_VALUES:

50
module/ice-9/eval.scm
View file

@ -55,10 +55,9 @@
(and (current-module) the-root-module)
env)))))
(define *max-static-argument-count* 8)
(define-syntax make-closure
(lambda (x)
(define *max-static-argument-count* 8)
(define (make-formals n)
(map (lambda (i)
(datum->syntax
@ -107,6 +106,43 @@
(1- nreq)
(cdr args)))))))))))))
(define-syntax call
(lambda (x)
(define *max-static-call-count* 4)
(syntax-case x ()
((_ eval proc nargs args env) (identifier? #'env)
#`(case nargs
#,@(map (lambda (nargs)
#`((#,nargs)
(proc
#,@(map
(lambda (n)
(let lp ((n n) (args #'args))
(if (zero? n)
#`(eval (car #,args) env)
(lp (1- n) #`(cdr #,args)))))
(iota nargs)))))
(iota *max-static-call-count*))
(else
(apply proc
#,@(map
(lambda (n)
(let lp ((n n) (args #'args))
(if (zero? n)
#`(eval (car #,args) env)
(lp (1- n) #`(cdr #,args)))))
(iota *max-static-call-count*))
(let lp ((exps #,(let lp ((n *max-static-call-count*)
(args #'args))
(if (zero? n)
args
(lp (1- n) #`(cdr #,args)))))
(args '()))
(if (null? exps)
(reverse args)
(lp (cdr exps)
(cons (eval (car exps) env) args)))))))))))
;; This macro could be more straightforward if the compiler had better
;; copy propagation. As it is we do some copy propagation by hand.
(define-syntax mx-bind
@ -189,14 +225,10 @@
(('apply (f args))
(apply (eval f env) (eval args env)))
(('call (f . args))
(('call (f nargs . args))
(let ((proc (eval f env)))
(let eval-args ((in args) (out '()))
(if (null? in)
(apply proc (reverse out))
(eval-args (cdr in)
(cons (eval (car in) env) out))))))
(call eval proc nargs args env)))
(('call/cc proc)
(call/cc (eval proc env)))