summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2018-03-27 21:16:40 -0700
committerKaz Kylheku <kaz@kylheku.com>2018-03-27 21:16:40 -0700
commit679295d6bae2576555ebab444e44994a1f2befbd (patch)
tree917d9956a8dc28e0f5f815e2517dd2845b646fbb
parentee5e854dad5c2e5cb25bd928cc633f13e660a31d (diff)
downloadtxr-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.tl10
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]))