diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2018-03-27 21:16:40 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2018-03-27 21:16:40 -0700 |
commit | 679295d6bae2576555ebab444e44994a1f2befbd (patch) | |
tree | 917d9956a8dc28e0f5f815e2517dd2845b646fbb | |
parent | ee5e854dad5c2e5cb25bd928cc633f13e660a31d (diff) | |
download | txr-679295d6bae2576555ebab444e44994a1f2befbd.tar.gz txr-679295d6bae2576555ebab444e44994a1f2befbd.tar.bz2 txr-679295d6bae2576555ebab444e44994a1f2befbd.zip |
compiler: diagnose exhaustion of dregs.
* share/txr/stdlib/compiler.tl (compiler get-dreg):
Restructure code. Don't increment dreg-cntr past 255.
-rw-r--r-- | share/txr/stdlib/compiler.tl | 10 |
1 files changed, 6 insertions, 4 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index fe75cd62..d77c4cd1 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -121,11 +121,13 @@ (:static callop (relate '(apply usr:apply call) '(apply apply call)))) (defmeth compiler get-dreg (me atom) - (iflet ((dreg [me.dreg atom])) - dreg - (let* ((dreg ^(d ,(pinc me.dreg-cntr)))) + (condlet + (((dreg [me.dreg atom])) dreg) + ((((< me.dreg-cntr 256))) + (let* ((dreg ^(d ,(pinc me.dreg-cntr)))) (set [me.data (cadr dreg)] atom) - (set [me.dreg atom] dreg)))) + (set [me.dreg atom] dreg))) + (t (compile-error me.last-form "code too complex: out of registers")))) (defmeth compiler get-fidx (me atom) (iflet ((fidx [me.fidx atom])) |