compiler: bug: eliminate-frame not initializing tregs.

In eliminate-frame, our stategy of replacing vregs with tregs
assumes that the newly minted tregs are initialized to nil.
This is true if the block is executed only once, but not true
if it's in the middle of a loop, where the previous
iteration's treg values can be present. This results in
miscompilation of code like

  (when-match (@x @(all @x)) '(1 (1 2)) x)

which wrongly returns 1 instead of nil starting at
optimization level 2.

* share/txr/stdlib/compiler.tl (struct compiler): New slot,
loop-nest, indicating the loop nesting level.
(compiler eliminate-frame): add instructions to the start of
the block of code to null out all the tregs that we allocated
for replacing vregs. We do this only when compiling the
repeated parts of a loop, as indicated by a positive value
of loop-nest.
(comp-for): Increment loop-nest before compiling the repeated
parts of the loop; decrement it afterward.

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