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.107 by root, Mon Nov 27 02:15:51 2006 UTC vs.
Revision 1.110 by root, Tue Nov 28 23:08:07 2006 UTC

… …
138 /* optionally saved, might be zero */ 138 /* optionally saved, might be zero */
139 AV *defav; 139 AV *defav;
140 SV *defsv; 140 SV *defsv;
141 SV *errsv; 141 SV *errsv;
142 142
143 /* saved global state not related to stacks */ 143#define VAR(name,type) type name;
144 U8 dowarn; 144# include "state.h"
145 I32 in_eval; 145#undef VAR
146
147 /* the stacks and related info (callchain etc..) */
148 PERL_SI *curstackinfo;
149 AV *curstack;
150 AV *mainstack;
151 SV **stack_sp;
152 OP *op;
153 SV **curpad;
154 AV *comppad;
155 CV *compcv;
156 SV **stack_base;
157 SV **stack_max;
158 SV **tmps_stack;
159 I32 tmps_floor;
160 I32 tmps_ix;
161 I32 tmps_max;
162 I32 *markstack;
163 I32 *markstack_ptr;
164 I32 *markstack_max;
165 I32 *scopestack;
166 I32 scopestack_ix;
167 I32 scopestack_max;
168 ANY *savestack;
169 I32 savestack_ix;
170 I32 savestack_max;
171 OP **retstack;
172 I32 retstack_ix;
173 I32 retstack_max;
174 PMOP *curpm;
175 COP *curcop;
176 146
177 /* coro process data */ 147 /* coro process data */
178 int prio; 148 int prio;
179}; 149};
180 150
… …
244 214
245#define PERL_MAGIC_coro PERL_MAGIC_ext 215#define PERL_MAGIC_coro PERL_MAGIC_ext
246 216
247static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free}; 217static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free};
248 218
219#define CORO_MAGIC(cv) \
220 SvMAGIC (cv) \
221 ? SvMAGIC (cv)->mg_type == PERL_MAGIC_coro \
222 ? SvMAGIC (cv) \
223 : mg_find ((SV *)cv, PERL_MAGIC_coro) \
224 : 0
225
249/* the next two functions merely cache the padlists */ 226/* the next two functions merely cache the padlists */
250static void 227static void
251get_padlist (CV *cv) 228get_padlist (CV *cv)
252{ 229{
253 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 230 MAGIC *mg = CORO_MAGIC (cv);
231 AV *av;
254 232
255 if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0) 233 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
256 CvPADLIST (cv) = (AV *)av_pop ((AV *)mg->mg_obj); 234 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
257 else 235 else
258 { 236 {
259#if 0 237#if 0
260 /* this is probably cleaner, but also slower? */ 238 /* this is probably cleaner, but also slower? */
261 CV *cp = Perl_cv_clone (cv); 239 CV *cp = Perl_cv_clone (cv);
… …
269} 247}
270 248
271static void 249static void
272put_padlist (CV *cv) 250put_padlist (CV *cv)
273{ 251{
274 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 252 MAGIC *mg = CORO_MAGIC (cv);
253 AV *av;
275 254
276 if (!mg) 255 if (!mg)
277 { 256 {
278 sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0); 257 sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0);
279 mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 258 mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
280 mg->mg_virtual = &vtbl_coro; 259 mg->mg_virtual = &vtbl_coro;
281 mg->mg_obj = (SV *)newAV (); 260 mg->mg_obj = (SV *)newAV ();
282 } 261 }
283 262
284 av_push ((AV *)mg->mg_obj, (SV *)CvPADLIST (cv)); 263 av = (AV *)mg->mg_obj;
264
265 if (AvFILLp (av) >= AvMAX (av))
266 av_extend (av, AvMAX (av) + 1);
267
268 AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
285} 269}
286 270
287#define SB do { 271#define SB do {
288#define SE } while (0) 272#define SE } while (0)
289 273
… …
293#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); (val) = 0; SE 277#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); (val) = 0; SE
294 278
295static void 279static void
296load_state(Coro__State c) 280load_state(Coro__State c)
297{ 281{
298 PL_dowarn = c->dowarn; 282#define VAR(name,type) PL_ ## name = c->name;
299 PL_in_eval = c->in_eval; 283# include "state.h"
300 284#undef VAR
301 PL_curstackinfo = c->curstackinfo;
302 PL_curstack = c->curstack;
303 PL_mainstack = c->mainstack;
304 PL_stack_sp = c->stack_sp;
305 PL_op = c->op;
306 PL_curpad = c->curpad;
307 PL_comppad = c->comppad;
308 PL_compcv = c->compcv;
309 PL_stack_base = c->stack_base;
310 PL_stack_max = c->stack_max;
311 PL_tmps_stack = c->tmps_stack;
312 PL_tmps_floor = c->tmps_floor;
313 PL_tmps_ix = c->tmps_ix;
314 PL_tmps_max = c->tmps_max;
315 PL_markstack = c->markstack;
316 PL_markstack_ptr = c->markstack_ptr;
317 PL_markstack_max = c->markstack_max;
318 PL_scopestack = c->scopestack;
319 PL_scopestack_ix = c->scopestack_ix;
320 PL_scopestack_max = c->scopestack_max;
321 PL_savestack = c->savestack;
322 PL_savestack_ix = c->savestack_ix;
323 PL_savestack_max = c->savestack_max;
324#if !PERL_VERSION_ATLEAST (5,9,0)
325 PL_retstack = c->retstack;
326 PL_retstack_ix = c->retstack_ix;
327 PL_retstack_max = c->retstack_max;
328#endif
329 PL_curpm = c->curpm;
330 PL_curcop = c->curcop;
331 285
332 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav); 286 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
333 if (c->defsv) REPLACE_SV (DEFSV , c->defsv); 287 if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
334 if (c->errsv) REPLACE_SV (ERRSV , c->errsv); 288 if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
335 289
… …
338 CV *cv; 292 CV *cv;
339 293
340 /* now do the ugly restore mess */ 294 /* now do the ugly restore mess */
341 while ((cv = (CV *)POPs)) 295 while ((cv = (CV *)POPs))
342 { 296 {
343 AV *padlist = (AV *)POPs;
344
345 if (padlist)
346 {
347 put_padlist (cv); /* mark this padlist as available */ 297 put_padlist (cv); /* mark this padlist as available */
348 CvPADLIST(cv) = padlist; 298 CvDEPTH (cv) = PTR2IV (POPs);
349 } 299 CvPADLIST (cv) = (AV *)POPs;
350
351 ++CvDEPTH(cv);
352 } 300 }
353 301
354 PUTBACK; 302 PUTBACK;
355 } 303 }
356} 304}
… …
378 PERL_CONTEXT *cx = &ccstk[cxix--]; 326 PERL_CONTEXT *cx = &ccstk[cxix--];
379 327
380 if (CxTYPE(cx) == CXt_SUB) 328 if (CxTYPE(cx) == CXt_SUB)
381 { 329 {
382 CV *cv = cx->blk_sub.cv; 330 CV *cv = cx->blk_sub.cv;
331
383 if (CvDEPTH(cv)) 332 if (CvDEPTH (cv))
384 { 333 {
385 EXTEND (SP, CvDEPTH(cv)*2); 334 EXTEND (SP, 3);
386
387 while (--CvDEPTH(cv))
388 {
389 /* this tells the restore code to increment CvDEPTH */
390 PUSHs (Nullsv);
391 PUSHs ((SV *)cv);
392 }
393 335
394 PUSHs ((SV *)CvPADLIST(cv)); 336 PUSHs ((SV *)CvPADLIST(cv));
337 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
395 PUSHs ((SV *)cv); 338 PUSHs ((SV *)cv);
396 339
340 CvDEPTH (cv) = 0;
397 get_padlist (cv); 341 get_padlist (cv);
398 } 342 }
399 } 343 }
400#ifdef CXt_FORMAT 344#ifdef CXt_FORMAT
401 else if (CxTYPE(cx) == CXt_FORMAT) 345 else if (CxTYPE(cx) == CXt_FORMAT)
… …
420 364
421 c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0; 365 c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
422 c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0; 366 c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
423 c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0; 367 c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
424 368
425 c->dowarn = PL_dowarn; 369#define VAR(name,type)c->name = PL_ ## name;
426 c->in_eval = PL_in_eval; 370# include "state.h"
427 371#undef VAR
428 c->curstackinfo = PL_curstackinfo;
429 c->curstack = PL_curstack;
430 c->mainstack = PL_mainstack;
431 c->stack_sp = PL_stack_sp;
432 c->op = PL_op;
433 c->curpad = PL_curpad;
434 c->comppad = PL_comppad;
435 c->compcv = PL_compcv;
436 c->stack_base = PL_stack_base;
437 c->stack_max = PL_stack_max;
438 c->tmps_stack = PL_tmps_stack;
439 c->tmps_floor = PL_tmps_floor;
440 c->tmps_ix = PL_tmps_ix;
441 c->tmps_max = PL_tmps_max;
442 c->markstack = PL_markstack;
443 c->markstack_ptr = PL_markstack_ptr;
444 c->markstack_max = PL_markstack_max;
445 c->scopestack = PL_scopestack;
446 c->scopestack_ix = PL_scopestack_ix;
447 c->scopestack_max = PL_scopestack_max;
448 c->savestack = PL_savestack;
449 c->savestack_ix = PL_savestack_ix;
450 c->savestack_max = PL_savestack_max;
451#if !PERL_VERSION_ATLEAST (5,9,0)
452 c->retstack = PL_retstack;
453 c->retstack_ix = PL_retstack_ix;
454 c->retstack_max = PL_retstack_max;
455#endif
456 c->curpm = PL_curpm;
457 c->curcop = PL_curcop;
458} 372}
459 373
460/* 374/*
461 * allocate various perl stacks. This is an exact copy 375 * allocate various perl stacks. This is an exact copy
462 * of perl.c:init_stacks, except that it uses less memory 376 * of perl.c:init_stacks, except that it uses less memory
… …
780 prev__cctx = prev->cctx; 694 prev__cctx = prev->cctx;
781 695
782 /* possibly "free" the cctx */ 696 /* possibly "free" the cctx */
783 if (prev__cctx->idle_sp == STACKLEVEL) 697 if (prev__cctx->idle_sp == STACKLEVEL)
784 { 698 {
699 assert (PL_top_env == prev__cctx->top_env);//D
785 cctx_put (prev__cctx); 700 cctx_put (prev__cctx);
786 prev->cctx = 0; 701 prev->cctx = 0;
787 } 702 }
788 703
789 if (!next->cctx) 704 if (!next->cctx)

Diff Legend

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