diff options
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 25 |
1 files changed, 25 insertions, 0 deletions
diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index f1e1401a..403263ce 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -161,6 +161,7 @@ (sys:setq me.(comp-setq oreg env form)) (cond me.(comp-cond oreg env form)) (if me.(comp-if oreg env form)) + (unwind-protect me.(comp-unwind-protect oreg env form)) (block me.(comp-block oreg env form)) (return-from me.(comp-return-from oreg env form)) (return me.(comp-return oreg env form)) @@ -348,6 +349,30 @@ ((op) me.(compile oreg env nil)) (form (compile-error form "excess argument forms")))) +(defmeth compiler comp-unwind-protect (me oreg env form) + (mac-param-bind form (op prot-form . cleanup-body) form + (let* ((pfrag me.(compile oreg env prot-form)) + (cfrag me.(comp-progn oreg env cleanup-body)) + (lclean (gensym "l")) + (lskip (gensym "l"))) + (cond + ((null pfrag.code) + (new (frag pfrag.oreg + cfrag.code + cfrag.fvars + cfrag.ffuns))) + ((null cfrag.code) pfrag) + (t (new (frag pfrag.oreg + ^((uwprot ,lclean) + ,*pfrag.code + (jmp ,lskip) + ,lclean + ,*cfrag.code + (end nil) + ,lskip) + (uni pfrag.fvars pfrag.fvars) + (uni cfrag.fvars cfrag.fvars)))))))) + (defmeth compiler comp-block (me oreg env form) (mac-param-bind form (op name . body) form (let* ((nreg (if name me.(get-dreg name) '(t 0))) |