summaryrefslogtreecommitdiffstats
path: root/stdlib
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2022-09-15 00:32:00 -0700
committerKaz Kylheku <kaz@kylheku.com>2022-09-15 00:32:00 -0700
commitfc5f70b9175ab037cd53038ef46cddfce0b58163 (patch)
tree77c707cd8b883c22a96492b478a761cbda1d975d /stdlib
parent186a9866d9625dd67a725870a37afb64d934f51a (diff)
downloadtxr-fc5f70b9175ab037cd53038ef46cddfce0b58163.tar.gz
txr-fc5f70b9175ab037cd53038ef46cddfce0b58163.tar.bz2
txr-fc5f70b9175ab037cd53038ef46cddfce0b58163.zip
compiler: unbundle v-reg allocation from env extension
* stdlib/compiler.tl (env get-loc): New method for allocating v-reg, split out of extend-var and extend-var*. Now there is a check for the v-cntr overflow. (env (extend-var, extend-var*)): Taken an optional loc parameter, so the caller can optionally allocate a v-reg location using get-loc, and then specify that location when creating a variable. If the argument is omitted, use get-loc.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/compiler.tl16
1 files changed, 10 insertions, 6 deletions
diff --git a/stdlib/compiler.tl b/stdlib/compiler.tl
index 8bb9f1d3..527228e9 100644
--- a/stdlib/compiler.tl
+++ b/stdlib/compiler.tl
@@ -106,17 +106,21 @@
(((up me.up)) up.(lookup-block sym mark-used))
(t nil)))
- (:method extend-var (me sym)
+ (:method get-loc (me)
+ (when (>= me.v-cntr %lev-size%)
+ (compile-error me.last-form
+ "code too complex: too many lexicals in one frame"))
+ ^(v ,(ppred me.lev) ,(pinc me.v-cntr)))
+
+ (:method extend-var (me sym : (loc me.(get-loc)))
(when (assoc sym me.vb)
(compile-error me.co.last-form "duplicate variable: ~s" sym))
- (let* ((loc ^(v ,(ppred me.lev) ,(pinc me.v-cntr)))
- (bn (new vbinding sym sym loc loc env me)))
+ (let ((bn (new vbinding sym sym loc loc env me)))
(set me.vb (acons sym bn me.vb))
bn))
- (:method extend-var* (me sym)
- (let* ((loc ^(v ,(ppred me.lev) ,(pinc me.v-cntr)))
- (bn (new vbinding sym sym loc loc env me)))
+ (:method extend-var* (me sym : (loc me.(get-loc)))
+ (let ((bn (new vbinding sym sym loc loc env me)))
(set me.vb (acons sym bn me.vb))
bn))