diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2022-09-15 00:32:00 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2022-09-15 00:32:00 -0700 |
commit | fc5f70b9175ab037cd53038ef46cddfce0b58163 (patch) | |
tree | 77c707cd8b883c22a96492b478a761cbda1d975d /stdlib | |
parent | 186a9866d9625dd67a725870a37afb64d934f51a (diff) | |
download | txr-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.tl | 16 |
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)) |