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.3 by root, Tue Jul 17 00:24:15 2001 UTC vs.
Revision 1.4 by root, Tue Jul 17 02:21:56 2001 UTC

… …
157 157
158 SvREFCNT_dec((SV*)padlist); 158 SvREFCNT_dec((SV*)padlist);
159 } 159 }
160} 160}
161 161
162STATIC AV * 162/* the next tow functions merely cache the padlists */
163unuse_padlist (AV *padlist) 163STATIC void
164get_padlist (CV *cv)
164{ 165{
165 free_padlist (padlist); 166 SV **he = hv_fetch (padlist_cache, (void *)&cv, sizeof (CV *), 0);
167
168 if (he && AvFILLp ((AV *)*he) >= 0)
169 CvPADLIST (cv) = (AV *)av_pop ((AV *)*he);
170 else
171 CvPADLIST (cv) = clone_padlist (CvPADLIST (cv));
172}
173
174STATIC void
175put_padlist (CV *cv)
176{
177 SV **he = hv_fetch (padlist_cache, (void *)&cv, sizeof (CV *), 1);
178
179 if (SvTYPE (*he) != SVt_PVAV)
180 {
181 SvREFCNT_dec (*he);
182 *he = (SV *)newAV ();
183 }
184
185 av_push ((AV *)*he, (SV *)CvPADLIST (cv));
166} 186}
167 187
168static void 188static void
169SAVE(pTHX_ Coro__State c) 189SAVE(pTHX_ Coro__State c)
170{ 190{
… …
183 /* this loop was inspired by pp_caller */ 203 /* this loop was inspired by pp_caller */
184 for (;;) 204 for (;;)
185 { 205 {
186 while (cxix >= 0) 206 while (cxix >= 0)
187 { 207 {
188 PERL_CONTEXT *cx = &ccstk[--cxix]; 208 PERL_CONTEXT *cx = &ccstk[cxix--];
189 209
190 if (CxTYPE(cx) == CXt_SUB) 210 if (CxTYPE(cx) == CXt_SUB)
191 { 211 {
192 CV *cv = cx->blk_sub.cv; 212 CV *cv = cx->blk_sub.cv;
193 if (CvDEPTH(cv)) 213 if (CvDEPTH(cv))
… …
198 EXTEND (SP, 3); 218 EXTEND (SP, 3);
199 PUSHs ((SV *)CvDEPTH(cv)); 219 PUSHs ((SV *)CvDEPTH(cv));
200 PUSHs ((SV *)CvPADLIST(cv)); 220 PUSHs ((SV *)CvPADLIST(cv));
201 PUSHs ((SV *)cv); 221 PUSHs ((SV *)cv);
202 222
203 CvPADLIST(cv) = clone_padlist (CvPADLIST(cv)); 223 get_padlist (cv);
204 224
205 CvDEPTH(cv) = 0; 225 CvDEPTH(cv) = 0;
206#ifdef USE_THREADS 226#ifdef USE_THREADS
207 CvOWNER(cv) = 0; 227 CvOWNER(cv) = 0;
208 error must unlock this cv etc.. etc... 228 error must unlock this cv etc.. etc...
… …
297 /* now do the ugly restore mess */ 317 /* now do the ugly restore mess */
298 while ((cv = (CV *)POPs)) 318 while ((cv = (CV *)POPs))
299 { 319 {
300 AV *padlist = (AV *)POPs; 320 AV *padlist = (AV *)POPs;
301 321
302 unuse_padlist (CvPADLIST(cv)); 322 put_padlist (cv);
303 CvPADLIST(cv) = padlist; 323 CvPADLIST(cv) = padlist;
304 CvDEPTH(cv) = (I32)POPs; 324 CvDEPTH(cv) = (I32)POPs;
305 325
306#ifdef USE_THREADS 326#ifdef USE_THREADS
307 CvOWNER(cv) = (struct perl_thread *)POPs; 327 CvOWNER(cv) = (struct perl_thread *)POPs;
… …
313 } 333 }
314} 334}
315 335
316/* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */ 336/* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */
317STATIC void 337STATIC void
318S_nuke_stacks(pTHX) 338destroy_stacks(pTHX)
319{ 339{
340 dSP;
341
342 /* die does this while calling POPSTACK, but I just don't see why. */
343 dounwind(-1);
344
345 /* is this ugly, I ask? */
346 while (PL_scopestack_ix)
347 LEAVE;
348
320 while (PL_curstackinfo->si_next) 349 while (PL_curstackinfo->si_next)
321 PL_curstackinfo = PL_curstackinfo->si_next; 350 PL_curstackinfo = PL_curstackinfo->si_next;
351
322 while (PL_curstackinfo) { 352 while (PL_curstackinfo)
353 {
323 PERL_SI *p = PL_curstackinfo->si_prev; 354 PERL_SI *p = PL_curstackinfo->si_prev;
324 /* curstackinfo->si_stack got nuked by sv_free_arenas() */ 355
356 SvREFCNT_dec(PL_curstackinfo->si_stack);
325 Safefree(PL_curstackinfo->si_cxstack); 357 Safefree(PL_curstackinfo->si_cxstack);
326 Safefree(PL_curstackinfo); 358 Safefree(PL_curstackinfo);
327 PL_curstackinfo = p; 359 PL_curstackinfo = p;
328 } 360 }
361
362 if (PL_scopestack_ix != 0)
363 Perl_warner(aTHX_ WARN_INTERNAL,
364 "Unbalanced scopes: %ld more ENTERs than LEAVEs\n",
365 (long)PL_scopestack_ix);
366 if (PL_savestack_ix != 0)
367 Perl_warner(aTHX_ WARN_INTERNAL,
368 "Unbalanced saves: %ld more saves than restores\n",
369 (long)PL_savestack_ix);
370 if (PL_tmps_floor != -1)
371 Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced tmps: %ld more allocs than frees\n",
372 (long)PL_tmps_floor + 1);
373 /*
374 */
329 Safefree(PL_tmps_stack); 375 Safefree(PL_tmps_stack);
330 Safefree(PL_markstack); 376 Safefree(PL_markstack);
331 Safefree(PL_scopestack); 377 Safefree(PL_scopestack);
332 Safefree(PL_savestack); 378 Safefree(PL_savestack);
333 Safefree(PL_retstack); 379 Safefree(PL_retstack);
334} 380}
335 381
336#define SUB_INIT "Coro::State::_newcoro" 382#define SUB_INIT "Coro::State::_newcoro"
337 383
338MODULE = Coro::State PACKAGE = Coro::State 384MODULE = Coro::State PACKAGE = Coro::State
… …
390 /* 436 /*
391 * emulate part of the perl startup here. 437 * emulate part of the perl startup here.
392 */ 438 */
393 UNOP myop; 439 UNOP myop;
394 440
395 init_stacks (); 441 init_stacks (); /* from perl.c */
396 PL_op = (OP *)&myop; 442 PL_op = (OP *)&myop;
397 /*PL_curcop = 0;*/ 443 /*PL_curcop = 0;*/
398 GvAV (PL_defgv) = (SV *)SvREFCNT_inc (next->args); 444 GvAV (PL_defgv) = (SV *)SvREFCNT_inc (next->args);
399 445
400 SPAGAIN; 446 SPAGAIN;
… …
429 475
430 PUTBACK; 476 PUTBACK;
431 SAVE(aTHX_ (&temp)); 477 SAVE(aTHX_ (&temp));
432 LOAD(aTHX_ coro); 478 LOAD(aTHX_ coro);
433 479
434 S_nuke_stacks (); 480 destroy_stacks ();
435 SvREFCNT_dec ((SV *)GvAV (PL_defgv)); 481 SvREFCNT_dec ((SV *)GvAV (PL_defgv));
436 482
437 LOAD((&temp)); 483 LOAD((&temp));
438 SPAGAIN; 484 SPAGAIN;
439 } 485 }

Diff Legend

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