From: Bob Rogers <[EMAIL PROTECTED]>
Date: Sat, 7 Oct 2006 18:52:29 -0400
. . .
Also, the "[oops; got 4 and X]" lines in the output seem to suggest
that Parrot may be getting confused about parameters. The "4" is really
the length of one of the coro structures, which must be getting passed
as the first arg. Also, it fails with "too many args" if you don't
accept at least two values from the coroutine_yield. I suspect Parrot
is reusing some old parameter information; I'll try to nail this down if
I get a chance.
This turns out to have been a bug in my implementation; extensive
debugging shows that all parameter to all continuations are going to the
right places. Shame on me for having suspected Parrot. ;-}
A corrected version is attached.
-- Bob
.include "interpinfo.pasm"
### Coroutine implementation.
## Coroutine slots:
##
## 0. Coroutine state: 1 is new or valid, 0 is dead.
## 1. Initial sub.
## 2. Continuation to which to return when yielding.
## 3. Continuation from which to resume.
.sub coroutine_create
.param pmc sub
.local pmc coro, state
coro = new .FixedPMCArray
coro = 4
state = new .Undef
state = 1
coro[0] = state
coro[1] = sub
.return (coro)
.end
## Invoke the coroutine.
.sub coroutine_resume
.param pmc coro
.param pmc args :slurpy
## Decide whether we're dead.
.local pmc state
state = coro[0]
unless state goto dead
## Decide where to go. If we've never been invoked before, we need to
## call the sub.
.local pmc entry
entry = coro[3]
unless null entry goto doit
entry = coro[1]
doit:
## Remember where to return when we yield.
.local pmc cc
cc = interpinfo .INTERPINFO_CURRENT_CONT
coro[2] = cc
## Call the entry with our args. Most of the time, it will yield (by
## calling our continuation for us) instead of returning directly.
.local pmc result
(result :slurpy) = entry(args :flat)
## If we returned normally, then the coroutine is dead.
state = 0
## Note that the value of coro[2] will normally have been changed
## magically behind our backs by a subsequent yield/resume, so we can't
## just return directly.
cc = coro[2]
.return cc(result :flat)
dead:
## Complain about zombie creation.
.local pmc error
error = new .Exception
error['_message'] = "Can't reanimate a dead coroutine.\n"
throw error
.end
## Return values to the calling thread.
.sub coroutine_yield
.param pmc coro
.param pmc args :slurpy
## Remember where to go when we are resumed.
.local pmc cc
cc = interpinfo .INTERPINFO_CURRENT_CONT
coro[3] = cc
## Return to the coro caller.
cc = coro[2]
.return cc(args :flat)
.end
### Recursive enumeration.
## build a complete N-ary tree of the specified depth, with the leaves being
## consecutive integer PMCs from start.
.sub make_nary_tree
.param int start
.param int end
.param int node_width
.param int depth
.local pmc result
if depth goto deeper
result = new .Undef
result = start
inc start
goto done
deeper:
result = new .ResizablePMCArray
dec depth
.local int i
i = 0
next:
if i >= node_width goto done
if start > end goto done
($P0, start) = make_nary_tree(start, end, node_width, depth)
push result, $P0
inc i
goto next
done:
.return (result, start)
.end
## non-coroutine traversal, for debugging.
.sub enumerate_tree
.param pmc tree_node
.param int depth :optional
.param int depth_p :opt_flag
if depth_p goto have_depth
depth = 0
have_depth:
inc depth
$I0 = isa tree_node, 'ResizablePMCArray'
if $I0 goto recur
print "[leaf "
print tree_node
print "]\n"
done:
.return ()
recur:
.local int size, i
i = 0
size = tree_node
again:
if i >= size goto done
print "[recur: depth "
print depth
print ' elt '
print i
print "]\n"
$P1 = tree_node[i]
enumerate_tree($P1, depth)
inc i
goto again
.end
## Recursive coroutine to enumerate tree elements, each of which is yielded in
## turn.
.sub coro_enumerate_tree
.param pmc coro
.param pmc tree_node
.param int depth :optional
.param int depth_p :opt_flag
if depth_p goto have_depth
depth = 0
have_depth:
inc depth
$I0 = isa tree_node, 'FixedPMCArray'
if $I0 goto recur
## print "[leaf "
## print tree_node
## print "]\n"
($P5 :optional, $I5 :opt_flag, $P6 :optional) = coroutine_yield(coro,
tree_node)
unless $I5 goto done
## [this is a bug; we shouldn't ever get *any* values from
## coroutine_resume. -- rgr, 7-Oct-06.]
print "[oops; got "
print $P5
unless $I6 goto no_p6
print ' and '
print $P6
no_p6:
print "]\n"
.return ()
recur:
.local int size, i
i = 0
size = tree_node
again:
if i >= size goto done
## print "[coro recur: depth "
## print depth
## print ' elt '
## print i
## print "]\n"
$P1 = tree_node[i]
coro_enumerate_tree(coro, $P1, depth)
inc i
goto again
done:
.return ()
.end
## Solution to the "same fringe" problem that uses coroutines to enumerate each
## of two passed trees of numbers. Prints 'equal' if the trees have the same
## fringe, else 'not equal.'
.sub same_fringe
.param pmc tree1
.param pmc tree2
.local pmc coro1, coro2
.const .Sub coro_sub = "coro_enumerate_tree"
coro1 = coroutine_create(coro_sub)
coro2 = coroutine_create(coro_sub)
($P0 :optional, $I0 :opt_flag) = coroutine_resume(coro1, coro1, tree1)
($P1 :optional, $I1 :opt_flag) = coroutine_resume(coro2, coro2, tree2)
loop:
if $I0 goto got_first
if $I1 goto not_equal
goto equal
got_first:
unless $I1 goto not_equal
## now have results from both.
print "[got "
print $P0
print ' and '
print $P1
print "]\n"
if $P0 != $P1 goto not_equal
## set up for the next iteration.
($P0 :optional, $I0 :opt_flag) = coroutine_resume(coro1)
($P1 :optional, $I1 :opt_flag) = coroutine_resume(coro2)
goto loop
not_equal:
print "not "
equal:
print "equal.\n"
.end
## Main program to solve a "same fringe" test case.
.sub solve_same_fringe :main
.local pmc binary, binary_4, ternary, ternary_2
## load_bytecode "Data/Dumper"
binary = make_nary_tree(1, 8, 2, 3)
ternary = make_nary_tree(1, 8, 3, 2)
binary_4 = make_nary_tree(1, 16, 2, 4)
## now make a "damaged" one that we can decide that it is different.
ternary_2 = make_nary_tree(1, 8, 3, 2)
$P0 = ternary_2[1]
$P0 = $P0[0]
ternary_2[1] = $P0
## enumerate_tree(ternary)
## enumerate_tree(binary)
same_fringe(binary, binary)
same_fringe(binary, binary_4)
same_fringe(binary, ternary)
same_fringe(binary, ternary_2)
.end
## Main program to test tree creation and enumeration.
.sub enumerate_recursively
## make a data structure for traversal.
.local pmc binary_3
binary_3 = make_nary_tree(1, 8, 2, 3)
## enable this to show that make_nary_tree works.
enumerate_tree(binary_3)
## list its contents via coroutine.
.const .Sub coro_sub = "coro_enumerate_tree"
.local pmc coro1
coro1 = coroutine_create(coro_sub)
($P0 :optional, $I0 :opt_flag) = coroutine_resume(coro1, coro1,
binary_3, 0)
loop:
unless $I0 goto done
if null $P0 goto oops
print $P0
print "\n"
($P0 :optional, $I0 :opt_flag) = coroutine_resume(coro1)
goto loop
oops:
## we should never get here; the coroutine returns either no values, or
## one value that must be an integer PMC.
print "oops.\n"
done:
.end
