diff options
Diffstat (limited to 'stdlib/compiler.tl')
| -rw-r--r-- | stdlib/compiler.tl | 10 |
1 files changed, 9 insertions, 1 deletions
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl index 0ad03aea..f3c27153 100644 --- a/stdlib/compiler.tl +++ b/stdlib/compiler.tl @@ -253,7 +253,8 @@ (with-gensyms (saved-tregs saved-treg-cntr) ^(let* ((,saved-tregs (qref ,me tregs)) (,saved-treg-cntr (qref ,me treg-cntr)) - (*tail-pos* nil)) + (*tail-pos* nil) + (*esc-blocks* nil)) (unwind-protect (progn (set (qref ,me tregs) nil @@ -341,6 +342,8 @@ (defvar *tail-fun*) +(defvar *esc-blocks*) + ;; 0 - no optimization ;; 1 - constant folding, algebraics. ;; 2 - block elimination, frame elimination, self tail calls @@ -804,6 +807,7 @@ (defmeth compiler comp-unwind-protect (me oreg env form) (mac-param-bind form (t prot-form . cleanup-body) form (let* ((*tail-pos* nil) + (*esc-blocks* nil) (treg me.(alloc-treg)) (pfrag me.(compile oreg env prot-form)) (cfrag me.(comp-progn treg env cleanup-body)) @@ -836,6 +840,7 @@ (treg (if star me.(maybe-alloc-treg oreg))) (nfrag (if star (ntp me.(compile treg env name)))) (nreg (if star nfrag.oreg me.(get-dreg name))) + (*esc-blocks* (cons name *esc-blocks*)) (bfrag me.(comp-progn oreg (or nenv env) body)) (lskip (gensym "l"))) (when treg @@ -901,6 +906,7 @@ me.(compile oreg env try-expr) (with-gensyms (ex-sym-var ex-args-var) (let* ((*tail-pos* nil) + (*esc-blocks* nil) (nenv (new env up env co me)) (esvb nenv.(extend-var ex-sym-var)) (eavb nenv.(extend-var ex-args-var)) @@ -1129,6 +1135,7 @@ (tfn *tail-fun*) (tpos nil) (tco *compile-opts*.opt-tail-calls) + (*esc-blocks* nil) (pars (new (fun-param-parser par-syntax form))) (need-frame (or (plusp pars.nfix) pars.rest)) (nenv (if need-frame (new env up env co me) env)) @@ -1770,6 +1777,7 @@ (defmeth compiler comp-prof (me oreg env form) (mac-param-bind form (t . forms) form (let ((*tail-pos* nil) + (*esc-blocks* nil) (bfrag me.(comp-progn oreg env forms))) (new (frag oreg ^((prof ,oreg) |