ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro/State.xs
(Generate patch)

Comparing Coro/Coro/State.xs (file contents):
Revision 1.2 by root, Sun Jul 15 02:35:52 2001 UTC vs.
Revision 1.3 by root, Tue Jul 17 00:24:15 2001 UTC

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#if 0
6# define CHK(x) (void *)0
7#else
8# define CHK(x) if (!(x)) croak("FATAL, CHK: " #x)
9#endif
10
5struct coro { 11struct coro {
6 U8 dowarn; 12 U8 dowarn;
13 AV *defav;
7 14
8 PERL_SI *curstackinfo; 15 PERL_SI *curstackinfo;
9 AV *curstack; 16 AV *curstack;
10 AV *mainstack; 17 AV *mainstack;
11 SV **stack_sp; 18 SV **stack_sp;
… …
29 OP **retstack; 36 OP **retstack;
30 I32 retstack_ix; 37 I32 retstack_ix;
31 I32 retstack_max; 38 I32 retstack_max;
32 COP *curcop; 39 COP *curcop;
33 40
34 AV *defav; 41 AV *args;
35
36 SV *proc;
37}; 42};
38 43
39typedef struct coro *Coro__State; 44typedef struct coro *Coro__State;
40typedef struct coro *Coro__State_or_hashref; 45typedef struct coro *Coro__State_or_hashref;
41 46
42#define SAVE(c) \ 47static HV *padlist_cache;
48
49/* mostly copied from op.c:cv_clone2 */
50STATIC AV *
51clone_padlist (AV *protopadlist)
52{
53 AV *av;
54 I32 ix;
55 AV *protopad_name = (AV *) * av_fetch (protopadlist, 0, FALSE);
56 AV *protopad = (AV *) * av_fetch (protopadlist, 1, FALSE);
57 SV **pname = AvARRAY (protopad_name);
58 SV **ppad = AvARRAY (protopad);
59 I32 fname = AvFILLp (protopad_name);
60 I32 fpad = AvFILLp (protopad);
61 AV *newpadlist, *newpad_name, *newpad;
62 SV **npad;
63
64 newpad_name = newAV ();
65 for (ix = fname; ix >= 0; ix--)
66 av_store (newpad_name, ix, SvREFCNT_inc (pname[ix]));
67
68 newpad = newAV ();
69 av_fill (newpad, AvFILLp (protopad));
70 npad = AvARRAY (newpad);
71
72 newpadlist = newAV ();
73 AvREAL_off (newpadlist);
74 av_store (newpadlist, 0, (SV *) newpad_name);
75 av_store (newpadlist, 1, (SV *) newpad);
76
77 av = newAV (); /* will be @_ */
78 av_extend (av, 0);
79 av_store (newpad, 0, (SV *) av);
80 AvFLAGS (av) = AVf_REIFY;
81
82 for (ix = fpad; ix > 0; ix--)
83 {
84 SV *namesv = (ix <= fname) ? pname[ix] : Nullsv;
85 if (namesv && namesv != &PL_sv_undef)
86 {
87 char *name = SvPVX (namesv); /* XXX */
88 if (SvFLAGS (namesv) & SVf_FAKE || *name == '&')
89 { /* lexical from outside? */
90 npad[ix] = SvREFCNT_inc (ppad[ix]);
91 }
92 else
93 { /* our own lexical */
94 SV *sv;
95 if (*name == '&')
96 sv = SvREFCNT_inc (ppad[ix]);
97 else if (*name == '@')
98 sv = (SV *) newAV ();
99 else if (*name == '%')
100 sv = (SV *) newHV ();
101 else
102 sv = NEWSV (0, 0);
103 if (!SvPADBUSY (sv))
104 SvPADMY_on (sv);
105 npad[ix] = sv;
106 }
107 }
108 else if (IS_PADGV (ppad[ix]) || IS_PADCONST (ppad[ix]))
109 {
110 npad[ix] = SvREFCNT_inc (ppad[ix]);
111 }
112 else
113 {
114 SV *sv = NEWSV (0, 0);
115 SvPADTMP_on (sv);
116 npad[ix] = sv;
117 }
118 }
119
120#if 0 /* NONOTUNDERSTOOD */
121 /* Now that vars are all in place, clone nested closures. */
122
123 for (ix = fpad; ix > 0; ix--) {
124 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
125 if (namesv
126 && namesv != &PL_sv_undef
127 && !(SvFLAGS(namesv) & SVf_FAKE)
128 && *SvPVX(namesv) == '&'
129 && CvCLONE(ppad[ix]))
130 {
131 CV *kid = cv_clone((CV*)ppad[ix]);
132 SvREFCNT_dec(ppad[ix]);
133 CvCLONE_on(kid);
134 SvPADMY_on(kid);
135 npad[ix] = (SV*)kid;
136 }
137 }
138#endif
139
140 return newpadlist;
141}
142
143STATIC AV *
144free_padlist (AV *padlist)
145{
146 /* may be during global destruction */
147 if (SvREFCNT(padlist))
148 {
149 I32 i = AvFILLp(padlist);
150 while (i >= 0)
151 {
152 SV **svp = av_fetch(padlist, i--, FALSE);
153 SV *sv = svp ? *svp : Nullsv;
154 if (sv)
155 SvREFCNT_dec(sv);
156 }
157
158 SvREFCNT_dec((SV*)padlist);
159 }
160}
161
162STATIC AV *
163unuse_padlist (AV *padlist)
164{
165 free_padlist (padlist);
166}
167
168static void
169SAVE(pTHX_ Coro__State c)
170{
171 {
172 dSP;
173 I32 cxix = cxstack_ix;
174 PERL_SI *top_si = PL_curstackinfo;
175 PERL_CONTEXT *ccstk = cxstack;
176
177 /*
178 * the worst thing you can imagine happens first - we have to save
179 * (and reinitialize) all cv's in the whole callchain :(
180 */
181
182 PUSHs (Nullsv);
183 /* this loop was inspired by pp_caller */
184 for (;;)
185 {
186 while (cxix >= 0)
187 {
188 PERL_CONTEXT *cx = &ccstk[--cxix];
189
190 if (CxTYPE(cx) == CXt_SUB)
191 {
192 CV *cv = cx->blk_sub.cv;
193 if (CvDEPTH(cv))
194 {
195#ifdef USE_THREADS
196 XPUSHs ((SV *)CvOWNER(cv));
197#endif
198 EXTEND (SP, 3);
199 PUSHs ((SV *)CvDEPTH(cv));
200 PUSHs ((SV *)CvPADLIST(cv));
201 PUSHs ((SV *)cv);
202
203 CvPADLIST(cv) = clone_padlist (CvPADLIST(cv));
204
205 CvDEPTH(cv) = 0;
206#ifdef USE_THREADS
207 CvOWNER(cv) = 0;
208 error must unlock this cv etc.. etc...
209 if you are here wondering about this error message then
210 the reason is that it will not work as advertised yet
211#endif
212 }
213 }
214 else if (CxTYPE(cx) == CXt_FORMAT)
215 {
216 /* I never used formats, so how should I know how these are implemented? */
217 /* my bold guess is as a simple, plain sub... */
218 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
219 }
220 }
221
222 if (top_si->si_type == PERLSI_MAIN)
223 break;
224
225 top_si = top_si->si_prev;
226 ccstk = top_si->si_cxstack;
227 cxix = top_si->si_cxix;
228 }
229
230 PUTBACK;
231 }
232
43 c->dowarn = PL_dowarn; \ 233 c->dowarn = PL_dowarn;
44 c->curstackinfo = PL_curstackinfo; \
45 c->curstack = PL_curstack; \
46 c->mainstack = PL_mainstack; \
47 c->stack_sp = PL_stack_sp; \
48 c->op = PL_op; \
49 c->curpad = PL_curpad; \
50 c->stack_base = PL_stack_base; \
51 c->stack_max = PL_stack_max; \
52 c->tmps_stack = PL_tmps_stack; \
53 c->tmps_floor = PL_tmps_floor; \
54 c->tmps_ix = PL_tmps_ix; \
55 c->tmps_max = PL_tmps_max; \
56 c->markstack = PL_markstack; \
57 c->markstack_ptr = PL_markstack_ptr; \
58 c->markstack_max = PL_markstack_max; \
59 c->scopestack = PL_scopestack; \
60 c->scopestack_ix = PL_scopestack_ix; \
61 c->scopestack_max = PL_scopestack_max;\
62 c->savestack = PL_savestack; \
63 c->savestack_ix = PL_savestack_ix; \
64 c->savestack_max = PL_savestack_max; \
65 c->retstack = PL_retstack; \
66 c->retstack_ix = PL_retstack_ix; \
67 c->retstack_max = PL_retstack_max; \
68 c->curcop = PL_curcop; \
69 c->defav = GvAV (PL_defgv); 234 c->defav = GvAV (PL_defgv);
235 c->curstackinfo = PL_curstackinfo;
236 c->curstack = PL_curstack;
237 c->mainstack = PL_mainstack;
238 c->stack_sp = PL_stack_sp;
239 c->op = PL_op;
240 c->curpad = PL_curpad;
241 c->stack_base = PL_stack_base;
242 c->stack_max = PL_stack_max;
243 c->tmps_stack = PL_tmps_stack;
244 c->tmps_floor = PL_tmps_floor;
245 c->tmps_ix = PL_tmps_ix;
246 c->tmps_max = PL_tmps_max;
247 c->markstack = PL_markstack;
248 c->markstack_ptr = PL_markstack_ptr;
249 c->markstack_max = PL_markstack_max;
250 c->scopestack = PL_scopestack;
251 c->scopestack_ix = PL_scopestack_ix;
252 c->scopestack_max = PL_scopestack_max;
253 c->savestack = PL_savestack;
254 c->savestack_ix = PL_savestack_ix;
255 c->savestack_max = PL_savestack_max;
256 c->retstack = PL_retstack;
257 c->retstack_ix = PL_retstack_ix;
258 c->retstack_max = PL_retstack_max;
259 c->curcop = PL_curcop;
260}
70 261
71#define LOAD(c) \ 262static void
263LOAD(pTHX_ Coro__State c)
264{
72 PL_dowarn = c->dowarn; \ 265 PL_dowarn = c->dowarn;
73 PL_curstackinfo = c->curstackinfo; \
74 PL_curstack = c->curstack; \
75 PL_mainstack = c->mainstack; \
76 PL_stack_sp = c->stack_sp; \
77 PL_op = c->op; \
78 PL_curpad = c->curpad; \
79 PL_stack_base = c->stack_base; \
80 PL_stack_max = c->stack_max; \
81 PL_tmps_stack = c->tmps_stack; \
82 PL_tmps_floor = c->tmps_floor; \
83 PL_tmps_ix = c->tmps_ix; \
84 PL_tmps_max = c->tmps_max; \
85 PL_markstack = c->markstack; \
86 PL_markstack_ptr = c->markstack_ptr; \
87 PL_markstack_max = c->markstack_max; \
88 PL_scopestack = c->scopestack; \
89 PL_scopestack_ix = c->scopestack_ix; \
90 PL_scopestack_max = c->scopestack_max;\
91 PL_savestack = c->savestack; \
92 PL_savestack_ix = c->savestack_ix; \
93 PL_savestack_max = c->savestack_max; \
94 PL_retstack = c->retstack; \
95 PL_retstack_ix = c->retstack_ix; \
96 PL_retstack_max = c->retstack_max; \
97 PL_curcop = c->curcop; \
98 GvAV (PL_defgv) = c->defav; 266 GvAV (PL_defgv) = c->defav;
267 PL_curstackinfo = c->curstackinfo;
268 PL_curstack = c->curstack;
269 PL_mainstack = c->mainstack;
270 PL_stack_sp = c->stack_sp;
271 PL_op = c->op;
272 PL_curpad = c->curpad;
273 PL_stack_base = c->stack_base;
274 PL_stack_max = c->stack_max;
275 PL_tmps_stack = c->tmps_stack;
276 PL_tmps_floor = c->tmps_floor;
277 PL_tmps_ix = c->tmps_ix;
278 PL_tmps_max = c->tmps_max;
279 PL_markstack = c->markstack;
280 PL_markstack_ptr = c->markstack_ptr;
281 PL_markstack_max = c->markstack_max;
282 PL_scopestack = c->scopestack;
283 PL_scopestack_ix = c->scopestack_ix;
284 PL_scopestack_max = c->scopestack_max;
285 PL_savestack = c->savestack;
286 PL_savestack_ix = c->savestack_ix;
287 PL_savestack_max = c->savestack_max;
288 PL_retstack = c->retstack;
289 PL_retstack_ix = c->retstack_ix;
290 PL_retstack_max = c->retstack_max;
291 PL_curcop = c->curcop;
292
293 {
294 dSP;
295 CV *cv;
296
297 /* now do the ugly restore mess */
298 while ((cv = (CV *)POPs))
299 {
300 AV *padlist = (AV *)POPs;
301
302 unuse_padlist (CvPADLIST(cv));
303 CvPADLIST(cv) = padlist;
304 CvDEPTH(cv) = (I32)POPs;
305
306#ifdef USE_THREADS
307 CvOWNER(cv) = (struct perl_thread *)POPs;
308 error does not work either
309#endif
310 }
311
312 PUTBACK;
313 }
314}
99 315
100/* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */ 316/* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */
101STATIC void 317STATIC void
102S_nuke_stacks(pTHX) 318S_nuke_stacks(pTHX)
103{ 319{
104 while (PL_curstackinfo->si_next) 320 while (PL_curstackinfo->si_next)
105 PL_curstackinfo = PL_curstackinfo->si_next; 321 PL_curstackinfo = PL_curstackinfo->si_next;
106 while (PL_curstackinfo) { 322 while (PL_curstackinfo) {
107 PERL_SI *p = PL_curstackinfo->si_prev; 323 PERL_SI *p = PL_curstackinfo->si_prev;
108 /* curstackinfo->si_stack got nuked by sv_free_arenas() */ 324 /* curstackinfo->si_stack got nuked by sv_free_arenas() */
109 Safefree(PL_curstackinfo->si_cxstack); 325 Safefree(PL_curstackinfo->si_cxstack);
110 Safefree(PL_curstackinfo); 326 Safefree(PL_curstackinfo);
111 PL_curstackinfo = p; 327 PL_curstackinfo = p;
112 } 328 }
113 Safefree(PL_tmps_stack); 329 Safefree(PL_tmps_stack);
114 Safefree(PL_markstack); 330 Safefree(PL_markstack);
115 Safefree(PL_scopestack); 331 Safefree(PL_scopestack);
116 Safefree(PL_savestack); 332 Safefree(PL_savestack);
117 Safefree(PL_retstack); 333 Safefree(PL_retstack);
118} 334}
119 335
336#define SUB_INIT "Coro::State::_newcoro"
337
120MODULE = Coro::State PACKAGE = Coro::State 338MODULE = Coro::State PACKAGE = Coro::State
121 339
122PROTOTYPES: ENABLE 340PROTOTYPES: ENABLE
123 341
342BOOT:
343 if (!padlist_cache)
344 padlist_cache = newHV ();
345
124Coro::State 346Coro::State
125newprocess(proc) 347_newprocess(args)
126 SV * proc 348 SV * args
127 PROTOTYPE: & 349 PROTOTYPE: $
128 CODE: 350 CODE:
129 Coro__State coro; 351 Coro__State coro;
352
353 if (!SvROK (args) || SvTYPE (SvRV (args)) != SVt_PVAV)
354 croak ("Coro::State::newprocess expects an arrayref");
130 355
131 New (0, coro, 1, struct coro); 356 New (0, coro, 1, struct coro);
132 357
133 coro->mainstack = 0; /* actual work is done inside transfer */ 358 coro->mainstack = 0; /* actual work is done inside transfer */
134 coro->proc = SvREFCNT_inc (proc); 359 coro->args = (AV *)SvREFCNT_inc (SvRV (args));
135 360
136 RETVAL = coro; 361 RETVAL = coro;
137 OUTPUT: 362 OUTPUT:
138 RETVAL 363 RETVAL
139 364
140void 365void
141transfer(prev,next) 366transfer(prev,next)
142 Coro::State_or_hashref prev 367 Coro::State_or_hashref prev
143 Coro::State_or_hashref next 368 Coro::State_or_hashref next
144 CODE: 369 CODE:
145 370
146 if (prev != next) 371 if (prev != next)
147 { 372 {
148 PUTBACK; 373 PUTBACK;
149 SAVE (prev); 374 SAVE (aTHX_ prev);
150 375
151 /* 376 /*
152 * this could be done in newprocess which would to 377 * this could be done in newprocess which would lead to
153 * extremely elegant and fast (just PUTBACK/SAVE/LOAD/SPAGAIN) 378 * extremely elegant and fast (just PUTBACK/SAVE/LOAD/SPAGAIN)
154 * code here, but lazy allocation of stacks has also 379 * code here, but lazy allocation of stacks has also
155 * some virtues and the overhead of the if() is nil. 380 * some virtues and the overhead of the if() is nil.
156 */ 381 */
157 if (next->mainstack) 382 if (next->mainstack)
158 { 383 {
159 LOAD (next); 384 LOAD (aTHX_ next);
160 next->mainstack = 0; /* unnecessary but much cleaner */ 385 next->mainstack = 0; /* unnecessary but much cleaner */
161 SPAGAIN; 386 SPAGAIN;
162 } 387 }
163 else 388 else
164 { 389 {
… …
168 UNOP myop; 393 UNOP myop;
169 394
170 init_stacks (); 395 init_stacks ();
171 PL_op = (OP *)&myop; 396 PL_op = (OP *)&myop;
172 /*PL_curcop = 0;*/ 397 /*PL_curcop = 0;*/
173 GvAV (PL_defgv) = newAV (); 398 GvAV (PL_defgv) = (SV *)SvREFCNT_inc (next->args);
174 399
175 SPAGAIN; 400 SPAGAIN;
176 Zero(&myop, 1, UNOP); 401 Zero(&myop, 1, UNOP);
177 myop.op_next = Nullop; 402 myop.op_next = Nullop;
178 myop.op_flags = OPf_WANT_VOID; 403 myop.op_flags = OPf_WANT_VOID;
179 404
180 EXTEND (SP,1); 405 PUSHMARK(SP);
181 PUSHs (next->proc); 406 XPUSHs ((SV*)get_cv(SUB_INIT, TRUE));
182
183 PUTBACK; 407 PUTBACK;
184 /* 408 /*
185 * the next line is slightly wrong, as PL_op->op_next 409 * the next line is slightly wrong, as PL_op->op_next
186 * is actually being executed so we skip the first op 410 * is actually being executed so we skip the first op.
187 * that doens't matter, though, since it is only 411 * that doesn't matter, though, since it is only
188 * pp_nextstate and we never return... 412 * pp_nextstate and we never return...
189 */ 413 */
190 PL_op = Perl_pp_entersub(aTHX); 414 PL_op = Perl_pp_entersub(aTHX);
191 SPAGAIN; 415 SPAGAIN;
192 416
… …
194 } 418 }
195 } 419 }
196 420
197void 421void
198DESTROY(coro) 422DESTROY(coro)
199 Coro::State coro 423 Coro::State coro
200 CODE: 424 CODE:
201 425
202 if (coro->mainstack) 426 if (coro->mainstack)
203 { 427 {
204 struct coro temp; 428 struct coro temp;
205 429
206 PUTBACK; 430 PUTBACK;
207 SAVE((&temp)); 431 SAVE(aTHX_ (&temp));
208 LOAD(coro); 432 LOAD(aTHX_ coro);
209 433
210 S_nuke_stacks (); 434 S_nuke_stacks ();
211 SvREFCNT_dec ((SV *)GvAV (PL_defgv)); 435 SvREFCNT_dec ((SV *)GvAV (PL_defgv));
212 436
213 LOAD((&temp)); 437 LOAD((&temp));
214 SPAGAIN; 438 SPAGAIN;
215 } 439 }
216 440
217 SvREFCNT_dec (coro->proc); 441 SvREFCNT_dec (coro->args);
218 Safefree (coro); 442 Safefree (coro);
219 443
220 444

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines