diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2018-03-23 06:56:12 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2018-03-23 06:56:12 -0700 |
| commit | 89257e70fba9b57de6c80f00280decf49b73cd76 (patch) | |
| tree | b5895ddf80d67e409207c4cc65d08d360e32ff9f | |
| parent | 690038a3c75463681c2acc49689f0472b1698e89 (diff) | |
| download | txr-89257e70fba9b57de6c80f00280decf49b73cd76.tar.gz txr-89257e70fba9b57de6c80f00280decf49b73cd76.tar.bz2 txr-89257e70fba9b57de6c80f00280decf49b73cd76.zip | |
compiler: last cond case: don't jmp to end.
* share/txr/stdlib/compiler.tl (compiler comp-cond): Don't
generate the jmp instruction at the end of the last case.
Why do I bother; a simple peephole optimizer will eliminate
these. I want a little better code, now! That's why.
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 16 |
1 files changed, 11 insertions, 5 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index 2446c23a..f6eb91ac 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -224,20 +224,24 @@ (defmeth compiler comp-cond (me oreg env form) (let* ((lout (gensym "l")) - (frags (collect-each ((cl (rest form))) + (ncases (len (rest form))) + (frags (collect-each ((cl (rest form)) + (i (range 1))) (mac-param-bind form (test . forms) cl (cond ((and (eq test t) (null forms)) (let ((dreg me.(get-dreg t))) (new (frag oreg ^(,*(maybe-mov oreg dreg) - (jmp ,lout)))))) + ,*(if (neql i ncases) + ^((jmp ,lout)))))))) ((eq test t) (let ((ffrag me.(comp-progn oreg env forms))) (new (frag oreg ^(,*ffrag.code ,*(maybe-mov oreg ffrag.oreg) - (jmp ,lout)) + ,*(if (neql i ncases) + ^((jmp ,lout)))) ffrag.fvars ffrag.ffuns)))) ((null forms) @@ -248,7 +252,8 @@ ,*(if (neq (car tfrag.oreg) 'd) ^((if ,tfrag.oreg ,lskip))) ,*(maybe-mov oreg tfrag.oreg) - (jmp ,lout) + ,*(if (neql i ncases) + ^((jmp ,lout))) ,lskip) tfrag.fvars tfrag.ffuns)))) @@ -261,7 +266,8 @@ ^((if ,tfrag.oreg ,lskip))) ,*ffrag.code ,*(maybe-mov oreg ffrag.oreg) - (jmp ,lout) + ,*(if (neql i ncases) + ^((jmp ,lout))) ,lskip) (uni tfrag.fvars ffrag.fvars) (uni tfrag.ffuns ffrag.ffuns)))))))))) |