1 | #include "EXTERN.h" |
1 | #include "EXTERN.h" |
2 | #include "perl.h" |
2 | #include "perl.h" |
3 | #include "XSUB.h" |
3 | #include "XSUB.h" |
4 | |
4 | |
5 | typedef struct coro { |
5 | typedef struct coro { |
|
|
6 | U8 dowarn; |
|
|
7 | |
6 | PERL_SI *curstackinfo; |
8 | PERL_SI *curstackinfo; |
7 | AV *curstack; |
9 | AV *curstack; |
8 | AV *mainstack; |
10 | AV *mainstack; |
|
|
11 | SV **stack_sp; |
|
|
12 | SV **curpad; |
9 | SV **stack_base; |
13 | SV **stack_base; |
10 | SV **stack_sp; |
|
|
11 | SV **stack_max; |
14 | SV **stack_max; |
12 | SV **tmps_stack; |
15 | SV **tmps_stack; |
13 | I32 tmps_floor; |
16 | I32 tmps_floor; |
14 | I32 tmps_ix; |
17 | I32 tmps_ix; |
15 | I32 tmps_max; |
18 | I32 tmps_max; |
… | |
… | |
24 | I32 savestack_max; |
27 | I32 savestack_max; |
25 | OP **retstack; |
28 | OP **retstack; |
26 | I32 retstack_ix; |
29 | I32 retstack_ix; |
27 | I32 retstack_max; |
30 | I32 retstack_max; |
28 | |
31 | |
|
|
32 | SV *errsv; |
|
|
33 | SV *defsv; |
|
|
34 | |
29 | SV *proc; |
35 | SV *proc; |
30 | } *Coro; |
36 | } *Coro; |
31 | |
37 | |
32 | #define SAVE(c) \ |
38 | #define SAVE(c) \ |
|
|
39 | c->dowarn = PL_dowarn; \ |
33 | c->curstackinfo = PL_curstackinfo; \ |
40 | c->curstackinfo = PL_curstackinfo; \ |
34 | c->curstack = PL_curstack; \ |
41 | c->curstack = PL_curstack; \ |
35 | c->mainstack = PL_mainstack; \ |
42 | c->mainstack = PL_mainstack; \ |
|
|
43 | c->stack_sp = PL_stack_sp; \ |
|
|
44 | c->curpad = PL_curpad; \ |
36 | c->stack_base = PL_stack_base; \ |
45 | c->stack_base = PL_stack_base; \ |
37 | c->stack_sp = PL_stack_sp; \ |
|
|
38 | c->stack_max = PL_stack_max; \ |
46 | c->stack_max = PL_stack_max; \ |
39 | c->tmps_stack = PL_tmps_stack; \ |
47 | c->tmps_stack = PL_tmps_stack; \ |
40 | c->tmps_floor = PL_tmps_floor; \ |
48 | c->tmps_floor = PL_tmps_floor; \ |
41 | c->tmps_ix = PL_tmps_ix; \ |
49 | c->tmps_ix = PL_tmps_ix; \ |
42 | c->tmps_max = PL_tmps_max; \ |
50 | c->tmps_max = PL_tmps_max; \ |
43 | c->markstack = PL_markstack; \ |
51 | c->markstack = PL_markstack; \ |
44 | c->markstack_ptr = PL_markstack_ptr; \ |
52 | c->markstack_ptr = PL_markstack_ptr; \ |
45 | c->markstack_max = PL_markstack_max; \ |
53 | c->markstack_max = PL_markstack_max; \ |
46 | c->scopestack = PL_scopestack; \ |
54 | c->scopestack = PL_scopestack; \ |
47 | c->scopestack_ix = PL_scopestack_ix; \ |
55 | c->scopestack_ix = PL_scopestack_ix; \ |
48 | c->scopestack_max = PL_scopestack_max; \ |
56 | c->scopestack_max = PL_scopestack_max;\ |
49 | c->savestack = PL_savestack; \ |
57 | c->savestack = PL_savestack; \ |
50 | c->savestack_ix = PL_savestack_ix; \ |
58 | c->savestack_ix = PL_savestack_ix; \ |
51 | c->savestack_max = PL_savestack_max; \ |
59 | c->savestack_max = PL_savestack_max; \ |
52 | c->retstack = PL_retstack; \ |
60 | c->retstack = PL_retstack; \ |
53 | c->retstack_ix = PL_retstack_ix; \ |
61 | c->retstack_ix = PL_retstack_ix; \ |
54 | c->retstack_max = PL_retstack_max; |
62 | c->retstack_max = PL_retstack_max; \ |
|
|
63 | c->errsv = ERRSV; \ |
|
|
64 | c->defsv = DEFSV; |
55 | |
65 | |
56 | #define LOAD(c) \ |
66 | #define LOAD(c) \ |
|
|
67 | PL_dowarn = c->dowarn; \ |
57 | PL_curstackinfo = c->curstackinfo; \ |
68 | PL_curstackinfo = c->curstackinfo; \ |
58 | PL_curstack = c->curstack; \ |
69 | PL_curstack = c->curstack; \ |
59 | PL_mainstack = c->mainstack; \ |
70 | PL_mainstack = c->mainstack; \ |
|
|
71 | PL_stack_sp = c->stack_sp; \ |
|
|
72 | PL_curpad = c->curpad; \ |
60 | PL_stack_base = c->stack_base; \ |
73 | PL_stack_base = c->stack_base; \ |
61 | PL_stack_sp = c->stack_sp; \ |
|
|
62 | PL_stack_max = c->stack_max; \ |
74 | PL_stack_max = c->stack_max; \ |
63 | PL_tmps_stack = c->tmps_stack; \ |
75 | PL_tmps_stack = c->tmps_stack; \ |
64 | PL_tmps_floor = c->tmps_floor; \ |
76 | PL_tmps_floor = c->tmps_floor; \ |
65 | PL_tmps_ix = c->tmps_ix; \ |
77 | PL_tmps_ix = c->tmps_ix; \ |
66 | PL_tmps_max = c->tmps_max; \ |
78 | PL_tmps_max = c->tmps_max; \ |
67 | PL_markstack = c->markstack; \ |
79 | PL_markstack = c->markstack; \ |
68 | PL_markstack_ptr = c->markstack_ptr; \ |
80 | PL_markstack_ptr = c->markstack_ptr; \ |
69 | PL_markstack_max = c->markstack_max; \ |
81 | PL_markstack_max = c->markstack_max; \ |
70 | PL_scopestack = c->scopestack; \ |
82 | PL_scopestack = c->scopestack; \ |
71 | PL_scopestack_ix = c->scopestack_ix; \ |
83 | PL_scopestack_ix = c->scopestack_ix; \ |
72 | PL_scopestack_max = c->scopestack_max; \ |
84 | PL_scopestack_max = c->scopestack_max;\ |
73 | PL_savestack = c->savestack; \ |
85 | PL_savestack = c->savestack; \ |
74 | PL_savestack_ix = c->savestack_ix; \ |
86 | PL_savestack_ix = c->savestack_ix; \ |
75 | PL_savestack_max = c->savestack_max; \ |
87 | PL_savestack_max = c->savestack_max; \ |
76 | PL_retstack = c->retstack; \ |
88 | PL_retstack = c->retstack; \ |
77 | PL_retstack_ix = c->retstack_ix; \ |
89 | PL_retstack_ix = c->retstack_ix; \ |
78 | PL_retstack_max = c->retstack_max; |
90 | PL_retstack_max = c->retstack_max; \ |
|
|
91 | ERRSV = c->errsv; \ |
|
|
92 | DEFSV = c->defsv; |
79 | |
93 | |
80 | /* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */ |
94 | /* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */ |
81 | STATIC void |
95 | STATIC void |
82 | S_nuke_stacks(pTHX) |
96 | S_nuke_stacks(pTHX) |
83 | { |
97 | { |
… | |
… | |
116 | RETVAL = coro; |
130 | RETVAL = coro; |
117 | OUTPUT: |
131 | OUTPUT: |
118 | RETVAL |
132 | RETVAL |
119 | |
133 | |
120 | void |
134 | void |
121 | _transfer(old,new) |
135 | _transfer(prev,next) |
122 | Coro old |
136 | Coro prev |
123 | Coro new |
137 | Coro next |
124 | CODE: |
138 | CODE: |
125 | |
139 | |
126 | PUTBACK; |
140 | PUTBACK; |
127 | SAVE (old); |
141 | SAVE (prev); |
128 | |
142 | |
129 | if (new->mainstack) /* this is, in theory, unnecessary overhead */ |
143 | if (next->mainstack) /* this is, in theory, unnecessary overhead */ |
130 | { |
144 | { |
131 | LOAD (new); |
145 | LOAD (next); |
132 | SPAGAIN; |
146 | SPAGAIN; |
133 | } |
147 | } |
134 | else |
148 | else |
135 | { |
149 | { |
136 | init_stacks (); |
150 | init_stacks (); |
137 | |
151 | |
|
|
152 | ERRSV = newSVsv(&PL_sv_undef); |
|
|
153 | DEFSV = newSVsv(&PL_sv_undef); |
|
|
154 | |
138 | SPAGAIN; |
155 | SPAGAIN; |
139 | PUSHMARK(SP); |
156 | PUSHMARK(SP); |
140 | PUTBACK; |
157 | PUTBACK; |
141 | call_sv (new->proc, G_VOID | G_DISCARD | G_EVAL); |
158 | call_sv (next->proc, G_VOID | G_DISCARD | G_EVAL); |
142 | |
159 | |
143 | exit (0); |
160 | exit (0); |
144 | |
161 | |
145 | SPAGAIN; |
162 | /*SPAGAIN; |
146 | SAVE (new); |
163 | SAVE (next); |
147 | |
164 | |
148 | LOAD (old); |
165 | LOAD (prev); |
149 | SPAGAIN; |
166 | SPAGAIN;*/ |
150 | } |
167 | } |
151 | |
168 | |
152 | void |
169 | void |
153 | DESTROY(coro) |
170 | DESTROY(coro) |
154 | Coro coro |
171 | Coro coro |
… | |
… | |
159 | struct coro temp; |
176 | struct coro temp; |
160 | |
177 | |
161 | PUTBACK; |
178 | PUTBACK; |
162 | SAVE((&temp)); |
179 | SAVE((&temp)); |
163 | LOAD(coro); |
180 | LOAD(coro); |
|
|
181 | |
164 | S_nuke_stacks (); |
182 | S_nuke_stacks (); |
|
|
183 | SvREFCNT_dec (ERRSV); |
|
|
184 | SvREFCNT_dec (DEFSV); |
|
|
185 | |
165 | LOAD((&temp)); |
186 | LOAD((&temp)); |
166 | SPAGAIN; |
187 | SPAGAIN; |
167 | } |
188 | } |
168 | |
189 | |
169 | SvREFCNT_dec (coro->proc); |
190 | SvREFCNT_dec (coro->proc); |