diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2018-03-26 06:34:44 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2018-03-26 06:34:44 -0700 |
| commit | 5c604c752e878066c7312eba6dd72d550ceb451f (patch) | |
| tree | b2aad7078de576c32534b9d28e1f76954f398229 /share | |
| parent | 5897492b4cb4c906efe21246facf6f46fbcc8ff9 (diff) | |
| download | txr-5c604c752e878066c7312eba6dd72d550ceb451f.tar.gz txr-5c604c752e878066c7312eba6dd72d550ceb451f.tar.bz2 txr-5c604c752e878066c7312eba6dd72d550ceb451f.zip | |
compiler/vm: implement sys:abscond-from special form.
* share/txr/stdlib/asm.tl (abscsr): New instruction.
(op-abscsr): New opcode class, derived from op-retsr.
* share/txr/stdlib/compiler.tl: Handle sys:abscond-from via
comp-return-from method.
(compiler comp-return-from): Handle sys:abscond-from by
switching to abscsr opcode instead of ret pseudo-op.
* vm.c (vm_abscsr): New static function.
(vm_execute): Dispatch ABSCSR opcode.
* vmop.h: Regenerated.
Diffstat (limited to 'share')
| -rw-r--r-- | share/txr/stdlib/asm.tl | 2 | ||||
| -rw-r--r-- | share/txr/stdlib/compiler.tl | 5 |
2 files changed, 5 insertions, 2 deletions
diff --git a/share/txr/stdlib/asm.tl b/share/txr/stdlib/asm.tl index b6e8dff5..88c801e2 100644 --- a/share/txr/stdlib/asm.tl +++ b/share/txr/stdlib/asm.tl @@ -569,6 +569,8 @@ (t 'retrr))])) real.(asm asm syntax))))) +(defopcode-derived op-abscsr abscsr auto op-retsr) + (defopcode op-catch catch auto (:method asm (me asm syntax) me.(chk-arg-count 4 syntax) diff --git a/share/txr/stdlib/compiler.tl b/share/txr/stdlib/compiler.tl index f1ccccd4..ad78295c 100644 --- a/share/txr/stdlib/compiler.tl +++ b/share/txr/stdlib/compiler.tl @@ -176,7 +176,7 @@ (if me.(comp-if oreg env form)) (unwind-protect me.(comp-unwind-protect oreg env form)) ((block block*) me.(comp-block oreg env form)) - (return-from me.(comp-return-from oreg env form)) + ((return-from sys:abscond-from) me.(comp-return-from oreg env form)) (return me.(comp-return oreg env form)) ((let let*) me.(comp-let oreg env form)) ((sys:fbind sys:lbind) me.(comp-fbind oreg env form)) @@ -447,10 +447,11 @@ (let* ((nreg (if (null name) nil me.(get-dreg name))) + (opcode (if (eq op 'return-from) 'ret 'abscsr)) (vfrag me.(compile oreg env value))) (new (frag oreg ^(,*vfrag.code - (ret ,nreg ,vfrag.oreg)) + (,opcode ,nreg ,vfrag.oreg)) vfrag.fvars vfrag.ffuns))))) |