From c8f12ee44d226924b89cdd764b65a5f6a4030b81 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sat, 29 May 2021 06:29:59 -0700
Subject: compiler: mov into t0 bug in compiling catch form

* share/txr/stdlib/compiler.tl (compiler comp-catch): The
tfrag's output register may be (t 0) in which case the
maybe-mov in the cfrag code generates a mov into (t 0) which
is not allowed. Instead of tfrag.oreg we create an abstrction
coreg which could be either toreg or oreg and consistently use
it.
---
 share/txr/stdlib/compiler.tl | 14 ++++++++------
 1 file changed, 8 insertions(+), 6 deletions(-)

diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl
index e3d43658..c30ebbd6 100644
--- a/share/txr/stdlib/compiler.tl
+++ b/share/txr/stdlib/compiler.tl
@@ -877,6 +877,7 @@
              (eavb (cdar nenv.(extend-var ex-args-var)))
              (tfrag me.(compile oreg nenv try-expr))
              (dfrag me.(compile oreg nenv desc-expr))
+             (coreg (if (equal tfrag.oreg '(t 0)) oreg tfrag.oreg))
              (lhand (gensym "l"))
              (lhend (gensym "l"))
              (treg me.(alloc-treg))
@@ -886,34 +887,35 @@
                        (mac-param-bind form (sym params . body) cl
                          (let* ((cl-src ^(apply (lambda ,params ,*body)
                                                 ,ex-sym-var ,ex-args-var))
-                                (cfrag me.(compile oreg nenv (expand cl-src)))
+                                (cfrag me.(compile coreg nenv (expand cl-src)))
                                 (lskip (gensym "l")))
-                           (new (frag oreg
+                           (new (frag coreg
                                       ^((gcall ,treg
                                                ,me.(get-sidx 'exception-subtype-p)
                                                ,esvb.loc
                                                ,me.(get-dreg sym))
                                         (if ,treg ,lskip)
                                         ,*cfrag.code
-                                        ,*me.(maybe-mov tfrag.oreg cfrag.oreg)
+                                        ,*me.(maybe-mov coreg cfrag.oreg)
                                         ,*(unless (eql i nclauses)
                                             ^((jmp ,lhend)))
                                         ,lskip)
                                       cfrag.fvars
                                       cfrag.ffuns)))))))
         me.(free-treg treg)
-        (new (frag tfrag.oreg
+        (new (frag coreg
                    ^((frame ,nenv.lev ,nenv.v-cntr)
                      ,*dfrag.code
                      (catch ,esvb.loc ,eavb.loc
                             ,me.(get-dreg symbols) ,dfrag.oreg ,lhand)
                      ,*tfrag.code
+                     ,*me.(maybe-mov coreg tfrag.oreg)
                      (jmp ,lhend)
                      ,lhand
                      ,*(mappend .code cfrags)
                      ,lhend
-                     (end ,tfrag.oreg)
-                     (end ,tfrag.oreg))
+                     (end ,coreg)
+                     (end ,coreg))
                    (uni tfrag.fvars [reduce-left uni cfrags nil .fvars])
                    (uni tfrag.ffuns [reduce-left uni cfrags nil .ffuns])))))))
 
-- 
cgit v1.2.3