diff options
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 16 |
1 files changed, 12 insertions, 4 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 990395cb..baf5985f 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -165,6 +165,7 @@ (dreg-cntr 0) (sidx-cntr 0) (nlev 2) + (loop-nest 0) (tregs nil) (discards nil) (dreg (hash :eql-based)) @@ -918,11 +919,14 @@ (if (>= me.(unalloc-reg-count) (len env.vb)) (let ((trhash (hash)) (vbhash (hash)) - (vlev (ppred env.lev))) + (vlev (ppred env.lev)) + (tregs nil)) (each ((cell env.vb)) (tree-bind (sym . vbind) cell - (set [trhash vbind.loc] me.(alloc-new-treg)) - (set [vbhash vbind.loc] vbind))) + (let ((treg me.(alloc-new-treg))) + (set [trhash vbind.loc] treg) + (set [vbhash vbind.loc] vbind) + (push treg tregs)))) (let ((ncode (append-each ((insns (conses code))) (match-case insns (((frame @lev @size) . @rest) @@ -944,7 +948,9 @@ (let ((vb [vbhash loc])) (set vb.loc treg) me.(free-treg treg))) - ncode)) + (if (plusp me.loop-nest) + (append (mapcar (ret ^(mov ,@1 (t 0))) (nreverse tregs)) ncode) + ncode))) code)) (defmeth compiler comp-let (me oreg env form) @@ -1451,10 +1457,12 @@ (let* ((treg me.(alloc-treg)) (ifrag me.(comp-progn treg env inits)) (*load-time* nil) + (dummy (inc me.loop-nest)) (tfrag (if test-p me.(compile treg env test))) (rfrag me.(comp-progn oreg env rets)) (nfrag me.(comp-progn treg env incs)) (bfrag me.(comp-progn treg env body)) + (dummy (dec me.loop-nest)) (lback (gensym "l")) (lskip (gensym "l")) (frags (build |