diff options
| -rw-r--r-- | mu.arc | 24 | ||||
| -rw-r--r-- | mu.arc.t | 44 |
2 files changed, 58 insertions, 10 deletions
diff --git a/mu.arc b/mu.arc index ac7040e3..4a5429aa 100644 --- a/mu.arc +++ b/mu.arc @@ -739,36 +739,36 @@ break (do (assert (is oarg nil) "break: can't take oarg in @instr") - (assert (is arg nil) "break: can't take arg in @instr") - (yield `(jump (,(close-offset pc locs) offset)))) + (yield `(jump (,(close-offset pc locs (and arg arg.0.0)) offset)))) break-if (do (assert (is oarg nil) "break-if: can't take oarg in @instr") - (yield `(jump-if ,arg.0 (,(close-offset pc locs) offset)))) + (yield `(jump-if ,arg.0 (,(close-offset pc locs (and cdr.arg arg.1.0)) offset)))) break-unless (do (assert (is oarg nil) "break-unless: can't take oarg in @instr") - (yield `(jump-unless ,arg.0 (,(close-offset pc locs) offset)))) + (yield `(jump-unless ,arg.0 (,(close-offset pc locs (and cdr.arg arg.1.0)) offset)))) loop (do (assert (is oarg nil) "loop: can't take oarg in @instr") - (assert (is arg nil) "loop: can't take arg in @instr") - (yield `(jump (,(- stack.0 1 pc) offset)))) + (yield `(jump (,(open-offset pc stack (and arg arg.0.0)) offset)))) loop-if (do (trace "cvt0" "loop-if: " instr " => " (- stack.0 1)) (assert (is oarg nil) "loop-if: can't take oarg in @instr") - (yield `(jump-if ,arg.0 (,(- stack.0 1 pc) offset)))) + (yield `(jump-if ,arg.0 (,(open-offset pc stack (and cdr.arg arg.1.0)) offset)))) loop-unless (do (trace "cvt0" "loop-if: " instr " => " (- stack.0 1)) (assert (is oarg nil) "loop-unless: can't take oarg in @instr") - (yield `(jump-unless ,arg.0 (,(- stack.0 1 pc) offset)))) + (yield `(jump-unless ,arg.0 (,(open-offset pc stack (and cdr.arg arg.1.0)) offset)))) ;else (yield instr)))) (++ pc)))))))) -(def close-offset (pc locs) +(def close-offset (pc locs nblocks) + (or= nblocks 1) +;? (tr nblocks) (point return ;? (tr "close " pc " " locs) (let stacksize 0 @@ -781,10 +781,14 @@ (if (is 'open state) (++ stacksize) (-- stacksize)) ; last time ;? (tr "process2 " stacksize loc) - (when (is -1 stacksize) + (when (is stacksize (* -1 nblocks)) ;? (tr "close now " loc) (return (- loc pc 1)))))))) +(def open-offset (pc stack nblocks) + (or= nblocks 1) + (- (stack (- nblocks 1)) 1 pc)) + ;; convert jump targets to offsets (def convert-labels (instrs) diff --git a/mu.arc.t b/mu.arc.t index 4ca5a316..98e67933 100644 --- a/mu.arc.t +++ b/mu.arc.t @@ -1432,6 +1432,30 @@ ;? (quit) (reset) +(new-trace "break-multiple") +(= traces* (queue)) +;? (= dump-trace* (obj whitelist '("-"))) +(if (~iso (convert-braces + '(((1 integer) <- copy (0 literal)) + { begin + { begin + (break (2 blocks)) + } + ((2 integer) <- copy (0 literal)) + ((3 integer) <- copy (0 literal)) + ((4 integer) <- copy (0 literal)) + ((5 integer) <- copy (0 literal)) + })) + '(((1 integer) <- copy (0 literal)) + (jump (4 offset)) + ((2 integer) <- copy (0 literal)) + ((3 integer) <- copy (0 literal)) + ((4 integer) <- copy (0 literal)) + ((5 integer) <- copy (0 literal)))) + (prn "F - 'break' can take an extra arg with number of nested blocks to exit")) +;? (quit) + +(reset) (new-trace "loop") ;? (set dump-trace*) (add-code @@ -1501,6 +1525,26 @@ (if (~iso memory* (obj 1 4 2 4 3 nil 4 34)) (prn "F - 'loop-if' might never trigger")) +(reset) +(new-trace "loop-multiple") +(= traces* (queue)) +;? (= dump-trace* (obj whitelist '("-"))) +(if (~iso (convert-braces + '(((1 integer) <- copy (0 literal)) + { begin + ((2 integer) <- copy (0 literal)) + ((3 integer) <- copy (0 literal)) + { begin + (loop (2 blocks)) + } + })) + '(((1 integer) <- copy (0 literal)) + ((2 integer) <- copy (0 literal)) + ((3 integer) <- copy (0 literal)) + (jump (-3 offset)))) + (prn "F - 'loop' can take an extra arg with number of nested blocks to exit")) +;? (quit) + ;; Variables ; ; A big convenience high-level languages provide is the ability to name memory |