diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2018-03-20 20:35:40 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2018-03-20 20:35:40 -0700 |
| commit | ab4dfc9532b72256fc38543650093882868b036f (patch) | |
| tree | 763a769b3330399b36dffd92efd3b9423ace71d5 | |
| parent | faeef3185bf60d0cb73bed0a229ab21a71047085 (diff) | |
| download | txr-ab4dfc9532b72256fc38543650093882868b036f.tar.gz txr-ab4dfc9532b72256fc38543650093882868b036f.tar.bz2 txr-ab4dfc9532b72256fc38543650093882868b036f.zip | |
compiler: improve progn.
* share/txr/stdlib/compiler.tl (compiler comp-progn): If the
suggested output register is a variable, progn should not use
it for the discarded values of the leading forms, only for
the last form. Writes to the variable space of the display
are costly because in closures, the underlying vector of
a given level has to be passed to gc_mutated. We use a new
temp register for the discarded forms.
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 21 |
1 files changed, 15 insertions, 6 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index c63e1300..c65acb56 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -442,14 +442,23 @@ (defmeth compiler comp-progn (me oreg env args) (let* (ffuns fvars + (nargs (len args)) lastfrag + (oreg-discard (if (eq (car oreg) t) + oreg + me.(alloc-treg))) (code (build - (each ((form args)) - (let ((frag me.(compile oreg env form))) - (set lastfrag frag) - (set fvars (uni fvars frag.fvars)) - (set ffuns (uni ffuns frag.ffuns)) - (pend frag.code)))))) + (each ((form args) + (n (range 1))) + (let ((islast (eql n nargs))) + (let ((frag me.(compile (if islast oreg oreg-discard) + env form))) + (when islast + (set lastfrag frag)) + (set fvars (uni fvars frag.fvars)) + (set ffuns (uni ffuns frag.ffuns)) + (pend frag.code))))))) + me.(free-treg oreg-discard) (new (frag (if lastfrag lastfrag.oreg ^(t 0)) code fvars ffuns)))) (defmeth compiler comp-prog1 (me oreg env form) |