This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=92afe25d5c162c29d971c2c36bd04a5b9d0b29c5 The branch, wip-rtl-halloween has been updated via 92afe25d5c162c29d971c2c36bd04a5b9d0b29c5 (commit) via be6e40a1df4cc97d1bf3d4567e980b92454d5180 (commit) via 91fc226e24bea970b5d6814fdceebd3c97c54a28 (commit) via 1d15832ffc1e46be2d5549c744681cf88776698e (commit) via 03f16599e37d91fdc7564e4baed9a489b2901dec (commit) from 14b9aa95e61e2d593bd96ab0a7675ed72d55503c (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit 92afe25d5c162c29d971c2c36bd04a5b9d0b29c5 Author: Andy Wingo <[email protected]> Date: Sun Nov 3 12:28:47 2013 +0100 Correctness fix for vector constructor inlining. * module/language/tree-il/compile-cps.scm (convert): Don't inline the vector constructor if any arg could capture the current continuation. commit be6e40a1df4cc97d1bf3d4567e980b92454d5180 Author: Andy Wingo <[email protected]> Date: Sun Nov 3 12:16:49 2013 +0100 Eval evaluates initializers before creating environment ribs. * module/ice-9/eval.scm (let-env-evaluator, primitive-eval): Evaluate initializers of let expressions before creating the environment rib. This prevents call/cc-related shenanigans. commit 91fc226e24bea970b5d6814fdceebd3c97c54a28 Author: Andy Wingo <[email protected]> Date: Sun Nov 3 12:15:09 2013 +0100 "length" is an interesting primitive * module/language/tree-il/primitives.scm (*effect-free-primitives*): (*interesting-primitive-names*): Add "length", so that we can constant-fold it. commit 1d15832ffc1e46be2d5549c744681cf88776698e Author: Andy Wingo <[email protected]> Date: Fri Nov 1 19:43:45 2013 +0100 Revert "Compile-time debugging" This reverts commit 6a37b7faaf150e9fb7945ef79969cb7671d17367. commit 03f16599e37d91fdc7564e4baed9a489b2901dec Author: Andy Wingo <[email protected]> Date: Fri Nov 1 19:28:36 2013 +0100 Fix call/cc with the RTL VM * libguile/vm.c (vm_return_to_continuation): The RTL VM saves the registers for the caller of call/cc, but the caller will expect values in the normal MV return location: above the frame. Make it so, number four! ----------------------------------------------------------------------- Summary of changes: libguile/vm.c | 38 ++++++++++++------------ module/ice-9/eval.scm | 50 ++++++++++++++++++++++++++---- module/language/cps/compile-rtl.scm | 6 +--- module/language/cps/contification.scm | 6 +-- module/language/tree-il/compile-cps.scm | 19 +++++++++-- module/language/tree-il/primitives.scm | 4 ++- 6 files changed, 83 insertions(+), 40 deletions(-) diff --git a/libguile/vm.c b/libguile/vm.c index c9ce3a3..bf1a269 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -150,7 +150,7 @@ vm_return_to_continuation (SCM vm, SCM cont, size_t n, SCM *argv) scm_misc_error (NULL, "Too few values returned to continuation", SCM_EOL); - if (vp->stack_size < cp->stack_size + n + 1) + if (vp->stack_size < cp->stack_size + n + 4) scm_misc_error ("vm-engine", "not enough space to reinstate continuation", scm_list_2 (vm, cont)); @@ -167,24 +167,24 @@ vm_return_to_continuation (SCM vm, SCM cont, size_t n, SCM *argv) vp->fp = cp->fp; memcpy (vp->stack_base, cp->stack_base, cp->stack_size * sizeof (SCM)); - if (n == 1 || !cp->mvra) - { - vp->ip = cp->ra; - vp->sp++; - *vp->sp = argv_copy[0]; - } - else - { - size_t i; - for (i = 0; i < n; i++) - { - vp->sp++; - *vp->sp = argv_copy[i]; - } - vp->sp++; - *vp->sp = scm_from_size_t (n); - vp->ip = cp->mvra; - } + { + size_t i; + + /* Push on an empty frame, as the continuation expects. */ + for (i = 0; i < 4; i++) + { + vp->sp++; + *vp->sp = SCM_BOOL_F; + } + + /* Push the return values. */ + for (i = 0; i < n; i++) + { + vp->sp++; + *vp->sp = argv_copy[i]; + } + vp->ip = cp->mvra; + } } SCM diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm index e34c087..51cdb65 100644 --- a/module/ice-9/eval.scm +++ b/module/ice-9/eval.scm @@ -79,6 +79,48 @@ (vector-set! e (1+ width) val) (lp (vector-ref e 0) (1- d))))))) + ;; For evaluating the initializers in a "let" expression. We have to + ;; evaluate the initializers before creating the environment rib, to + ;; prevent continuation-related shenanigans; see + ;; http://wingolog.org/archives/2013/11/02/scheme-quiz-time for a + ;; deeper discussion. + ;; + ;; This macro will inline evaluation of the first N initializers. + ;; That number N is indicated by the number of template arguments + ;; passed to the macro. It's a bit nasty but it's flexible and + ;; optimizes well. + (define-syntax let-env-evaluator + (syntax-rules () + ((eval-and-make-env eval env (template ...)) + (let () + (define-syntax eval-and-make-env + (syntax-rules () + ((eval-and-make-env inits width (template ...) k) + (let lp ((n (length '(template ...))) (vals '())) + (if (eqv? n width) + (let ((env (make-env n #f env))) + (let lp ((n (1- n)) (vals vals)) + (if (null? vals) + (k env) + (begin + (env-set! env 0 n (car vals)) + (lp (1- n) (cdr vals)))))) + (lp (1+ n) + (cons (eval (vector-ref inits n) env) vals))))) + ((eval-and-make-env inits width (var (... ...)) k) + (let ((n (length '(var (... ...))))) + (if (eqv? n width) + (k (make-env n #f env)) + (let* ((x (eval (vector-ref inits n) env)) + (k (lambda (env) + (env-set! env 0 n x) + (k env)))) + (eval-and-make-env inits width (x var (... ...)) k))))))) + (lambda (inits) + (let ((width (vector-length inits)) + (k (lambda (env) env))) + (eval-and-make-env inits width () k))))))) + ;; Fast case for procedures with fixed arities. (define-syntax make-fixed-closure (lambda (x) @@ -456,13 +498,7 @@ x) (('let (inits . body)) - (let* ((width (vector-length inits)) - (new-env (make-env width #f env))) - (let lp ((i 0)) - (when (< i width) - (env-set! new-env 0 i (eval (vector-ref inits i) env)) - (lp (1+ i)))) - (eval body new-env))) + (eval body ((let-env-evaluator eval env (_ _ _ _)) inits))) (('lambda (body meta nreq . tail)) (let ((proc diff --git a/module/language/cps/compile-rtl.scm b/module/language/cps/compile-rtl.scm index 7ed0c11..a842804 100644 --- a/module/language/cps/compile-rtl.scm +++ b/module/language/cps/compile-rtl.scm @@ -49,9 +49,7 @@ (define (optimize exp opts) (define (run-pass exp pass kw default) (if (kw-arg-ref opts kw default) - (begin - (pk 'OPTIMIZING kw) - (pass exp)) + (pass exp) exp)) ;; Calls to source-to-source optimization passes go here. @@ -504,13 +502,11 @@ (_ (values)))) (define (compile-rtl exp env opts) - (pk 'COMPILING) (let* ((exp (fix-arities exp)) (exp (optimize exp opts)) (exp (convert-closures exp)) (exp (reify-primitives exp)) (asm (make-assembler))) - (pk 'CODEGEN) (visit-funs (lambda (fun) (compile-fun fun asm)) exp) diff --git a/module/language/cps/contification.scm b/module/language/cps/contification.scm index aa162e0..da73206 100644 --- a/module/language/cps/contification.scm +++ b/module/language/cps/contification.scm @@ -348,7 +348,5 @@ (if (null? call-substs) fun ;; Iterate to fixed point. - (begin - (pk 'CONTIFIED (length call-substs)) - (contify - (apply-contification fun call-substs cont-substs fun-elisions cont-splices))))))) + (contify + (apply-contification fun call-substs cont-substs fun-elisions cont-splices)))))) diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm index 9d19062..67f1ec1 100644 --- a/module/language/tree-il/compile-cps.scm +++ b/module/language/tree-il/compile-cps.scm @@ -337,13 +337,24 @@ (convert (make-conditional src exp (make-const #f #t) (make-const #f #f)) k subst)) - ((eq? name 'vector) + ((and (eq? name 'vector) + (and-map (match-lambda + ((or ($ <const>) + ($ <void>) + ($ <lambda>) + ($ <lexical-ref>)) #t) + (_ #f)) + args)) ;; Some macros generate calls to "vector" with like 300 ;; arguments. Since we eventually compile to make-vector and ;; vector-set!, it reduces live variable pressure to allocate the - ;; vector first, then set values as they are produced. Normally - ;; we would do this transformation in the compiler, but it's - ;; quite tricky there and quite easy here, so hold your nose + ;; vector first, then set values as they are produced, if we can + ;; prove that no value can capture the continuation. (More on + ;; that caveat here: + ;; http://wingolog.org/archives/2013/11/02/scheme-quiz-time). + ;; + ;; Normally we would do this transformation in the compiler, but + ;; it's quite tricky there and quite easy here, so hold your nose ;; while we drop some smelly code. (convert (let ((len (length args))) (let-gensyms (v) diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm index 46bc4eb..5e4f388 100644 --- a/module/language/tree-il/primitives.scm +++ b/module/language/tree-il/primitives.scm @@ -73,6 +73,8 @@ caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr + length + make-vector vector-length vector-ref vector-set! variable? variable-ref variable-set! variable-bound? @@ -165,7 +167,7 @@ char<? char<=? char>=? char>? integer->char char->integer number->string string->number struct-vtable - string-length vector-length + length string-length vector-length ;; These all should get expanded out by expand-primitives. caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr hooks/post-receive -- GNU Guile
