From ac21241540700a7a1f101d2cdf0c6f2906fba34e Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Tue, 10 Jul 2018 06:56:21 -0700 Subject: compiler: bugfix: mishandled empty test * share/txr/stdlib/compiler.tl (compiler comp-for): Fix exception thrown when compiling (for init test step ...) when test is nil. Firstly, we must distinguish a (nil) test from (), because the latter means (t). Hence the need for the test-p Boolean. The list of frags must not contain a nil, which isn't a frag. The instruction template must not only omit generating the conditional jump when the test is absent, but also omit generating the test code (insertion of tfrag.code) in that case, because tfrag is nil. --- share/txr/stdlib/compiler.tl | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 04a92bf5..56db42b2 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -1061,23 +1061,26 @@ apply-list-arg))))) (defmeth compiler comp-for (me oreg env form) - (mac-param-bind form (op inits (: test . rets) incs . body) form + (mac-param-bind form (op inits (: (test nil test-p) . rets) incs . body) form (let* ((treg me.(alloc-treg)) (ifrag me.(comp-progn treg env inits)) - (tfrag (if test me.(compile oreg env test))) + (tfrag (if test-p me.(compile oreg env test))) (rfrag me.(comp-progn oreg env rets)) (nfrag me.(comp-progn treg env incs)) (bfrag me.(comp-progn treg env body)) (lback (gensym "l")) (lskip (gensym "l")) - (frags (list ifrag tfrag rfrag nfrag bfrag))) + (frags (build + (add ifrag) + (if test-p (add tfrag)) + (add rfrag nfrag bfrag)))) me.(free-treg treg) (new (frag rfrag.oreg ^(,*ifrag.code ,lback - ,*tfrag.code - ,*(if test - ^((if ,tfrag.oreg ,lskip))) + ,*(if test-p + ^(,*tfrag.code + (if ,tfrag.oreg ,lskip))) ,*bfrag.code ,*nfrag.code (jmp ,lback) -- cgit v1.2.3