diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-05-29 06:29:59 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-05-29 06:29:59 -0700 |
| commit | c8f12ee44d226924b89cdd764b65a5f6a4030b81 (patch) | |
| tree | 642238a77c2feb1466c6c6ba10bb386523ce3d7a | |
| parent | 0bc1df959700cc60ad6f9f289bcb905dc294ceb1 (diff) | |
| download | txr-c8f12ee44d226924b89cdd764b65a5f6a4030b81.tar.gz txr-c8f12ee44d226924b89cdd764b65a5f6a4030b81.tar.bz2 txr-c8f12ee44d226924b89cdd764b65a5f6a4030b81.zip | |
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.
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 14 |
1 files 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]))))))) |