5
Code - Perl 6 Routine class
9
This file sets up the Perl 6 C<Routine> class, the base class for all
10
wrappable executable objects.
14
.include 'interpinfo.pasm'
16
.namespace ['Routine']
18
.sub 'onload' :anon :load :init
20
p6meta = get_hll_global ['Perl6Object'], '$!P6META'
21
p6meta.'new_class'('Routine', 'parent'=>'Block')
36
# Did we already wrap?
37
.local pmc cand_list, cur_sub
38
cur_sub = getattribute self, ['Sub'], 'proxy'
39
cand_list = getprop '@!candidates', cur_sub
40
unless null cand_list goto have_cand_list
42
# If not, need to create a new candidate list with the current sub,
43
# and install the wrap helper that will start dispatching at the
44
# start of the candidate list.
45
.local pmc p6i, p6i_copy
46
cand_list = root_new ['parrot';'ResizablePMCArray']
47
unshift cand_list, cur_sub
48
p6i = root_new ['parrot';'P6Invocation'], cand_list
49
.lex '__CANDIDATE_LIST__', p6i
50
.const 'Sub' $P0 = '!wrap_start_helper'
52
setattribute self, ['Sub'], 'proxy', $P0
53
setprop $P0, '@!candidates', cand_list
55
# XXX Aww, fick. Some hrovno happens in what follows that puts
56
# some merde value into the p6i register - even though we never
57
# do anything to explicitly change the hora. So, we make a copy,
58
# in another register, and then copy it back over at the end.
59
# Something is srsly buggered up somewhere.
62
# We need to clone the wrapper, then tweak it to have an outer of
63
# !wrap_clholder_helper, which we use to hold the candidate list,
64
# and set the helper's outer to the block's original outer to maintain
65
# the static chain. This is so we have a lexical slot for the
66
# candidate list to go in; beats giving every single block one.
68
.local pmc orig_wrapper, tmp, tmp2
69
orig_wrapper = wrapper
70
wrapper = clone orig_wrapper
71
.fixup_cloned_sub(orig_wrapper, wrapper)
72
.const 'Sub' $P1 = '!wrap_clholder_helper'
74
setprop $P1, '$!wrapper_block', wrapper
75
$P2 = wrapper.'get_outer'()
77
wrapper.'set_outer'($P1)
79
# Unshift this candidate onto the list; generate a wrap handle also, stick
80
# it on the candidate and return it.
84
$P2 = getprop '$!handle', $P2
85
if null $P2 goto no_handle
90
setprop $P1, '$!handle', handle
91
unshift cand_list, $P1
93
if null p6i_copy goto done
98
.sub '!wrap_start_helper' :anon :outer('wrap')
99
.param pmc pos_args :slurpy
100
.param pmc named_args :slurpy :named
101
$P0 = find_lex '__CANDIDATE_LIST__'
103
.tailcall $P1(pos_args :flat, named_args :flat :named)
105
.sub '!wrap_clholder_helper' :anon
106
.param pmc pos_args :slurpy
107
.param pmc named_args :slurpy :named
109
# Slot for candidate list.
110
.lex '__CANDIDATE_LIST__', $P0
112
# Set up return handler, so next[with|same] work.
113
$P2 = root_new ['parrot';'ExceptionHandler']
114
set_addr $P2, ret_handler
115
$P2."handle_types"(58)
118
# Get the inner block and call it.
119
$P1 = interpinfo .INTERPINFO_CURRENT_SUB
120
$P1 = getprop '$!wrapper_block', $P1
122
($P3) = $P1(pos_args :flat, named_args :flat :named)
126
.local pmc exception, result
127
.get_results (exception)
128
result = getattribute exception, "payload"
137
.sub 'unwrap' :method
140
# Check it's wrapped.
141
.local pmc cand_list, cur_sub
142
cur_sub = getattribute self, ['Sub'], 'proxy'
143
cand_list = getprop '@!candidates', cur_sub
144
if null cand_list goto error
146
# Look by handle for what to remove and remove it.
147
$I0 = elements cand_list
150
if $I1 >= $I0 goto error
152
$P0 = getprop '$!handle', $P0
153
if null $P0 goto error
154
if handle == $P0 goto remove
158
delete cand_list[$I1]
160
# If it's not the last wrapper we're done, otherwise we'll remove the
161
# wrapper completely and restore the sub.
162
$I0 = elements cand_list
163
if $I0 == 1 goto final
167
$P0 = shift cand_list
168
setattribute self, ['Sub'], 'proxy', $P0
172
'die'('Could not unwrap; unrecognized wrap handle')
183
# vim: expandtab shiftwidth=4 ft=pir:
added
removed
src/classes/Routine.pir
