| … | |
… | |
| 133 | #else |
133 | #else |
| 134 | # define dSTACKLEVEL volatile void *stacklevel |
134 | # define dSTACKLEVEL volatile void *stacklevel |
| 135 | # define STACKLEVEL ((void *)&stacklevel) |
135 | # define STACKLEVEL ((void *)&stacklevel) |
| 136 | #endif |
136 | #endif |
| 137 | |
137 | |
| 138 | #define IN_DESTRUCT (PL_main_cv == Nullcv) |
138 | #define IN_DESTRUCT PL_dirty |
| 139 | |
139 | |
| 140 | #if __GNUC__ >= 3 |
140 | #if __GNUC__ >= 3 |
| 141 | # define attribute(x) __attribute__(x) |
141 | # define attribute(x) __attribute__(x) |
| 142 | # define expect(expr,value) __builtin_expect ((expr),(value)) |
142 | # define expect(expr,value) __builtin_expect ((expr),(value)) |
| 143 | # define INLINE static inline |
143 | # define INLINE static inline |
| … | |
… | |
| 381 | |
381 | |
| 382 | static void |
382 | static void |
| 383 | free_padlist (pTHX_ AV *padlist) |
383 | free_padlist (pTHX_ AV *padlist) |
| 384 | { |
384 | { |
| 385 | /* may be during global destruction */ |
385 | /* may be during global destruction */ |
| 386 | if (SvREFCNT (padlist)) |
386 | if (!IN_DESTRUCT) |
| 387 | { |
387 | { |
| 388 | I32 i = AvFILLp (padlist); |
388 | I32 i = AvFILLp (padlist); |
|
|
389 | |
| 389 | while (i >= 0) |
390 | while (i >= 0) |
| 390 | { |
391 | { |
| 391 | SV **svp = av_fetch (padlist, i--, FALSE); |
392 | /* we try to be extra-careful here */ |
| 392 | if (svp) |
393 | AV *av = (AV *)AvARRAY (padlist)[i--]; |
| 393 | { |
394 | |
| 394 | SV *sv; |
395 | I32 i = AvFILLp (av); |
| 395 | while (&PL_sv_undef != (sv = av_pop ((AV *)*svp))) |
396 | |
|
|
397 | while (i >= 0) |
|
|
398 | SvREFCNT_dec (AvARRAY (av)[i--]); |
|
|
399 | |
|
|
400 | AvFILLp (av) = -1; |
| 396 | SvREFCNT_dec (sv); |
401 | SvREFCNT_dec (av); |
| 397 | |
|
|
| 398 | SvREFCNT_dec (*svp); |
|
|
| 399 | } |
|
|
| 400 | } |
402 | } |
| 401 | |
403 | |
|
|
404 | AvFILLp (padlist) = -1; |
| 402 | SvREFCNT_dec ((SV*)padlist); |
405 | SvREFCNT_dec ((SV*)padlist); |
| 403 | } |
406 | } |
| 404 | } |
407 | } |
| 405 | |
408 | |
| 406 | static int |
409 | static int |
| … | |
… | |
| 503 | mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0); |
506 | mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0); |
| 504 | |
507 | |
| 505 | av = (AV *)mg->mg_obj; |
508 | av = (AV *)mg->mg_obj; |
| 506 | |
509 | |
| 507 | if (expect_false (AvFILLp (av) >= AvMAX (av))) |
510 | if (expect_false (AvFILLp (av) >= AvMAX (av))) |
| 508 | av_extend (av, AvMAX (av) + 1); |
511 | av_extend (av, AvFILLp (av) + 1); |
| 509 | |
512 | |
| 510 | AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv); |
513 | AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv); |
| 511 | } |
514 | } |
| 512 | |
515 | |
| 513 | /** load & save, init *******************************************************/ |
516 | /** load & save, init *******************************************************/ |
| … | |
… | |
| 1178 | /* |
1181 | /* |
| 1179 | * If perl-run returns we assume exit() was being called or the coro |
1182 | * If perl-run returns we assume exit() was being called or the coro |
| 1180 | * fell off the end, which seems to be the only valid (non-bug) |
1183 | * fell off the end, which seems to be the only valid (non-bug) |
| 1181 | * reason for perl_run to return. We try to exit by jumping to the |
1184 | * reason for perl_run to return. We try to exit by jumping to the |
| 1182 | * bootstrap-time "top" top_env, as we cannot restore the "main" |
1185 | * bootstrap-time "top" top_env, as we cannot restore the "main" |
| 1183 | * coroutine as Coro has no such concept |
1186 | * coroutine as Coro has no such concept. |
|
|
1187 | * This actually isn't valid with the pthread backend, but OSes requiring |
|
|
1188 | * that backend are too broken to do it in a standards-compliant way. |
| 1184 | */ |
1189 | */ |
| 1185 | PL_top_env = main_top_env; |
1190 | PL_top_env = main_top_env; |
| 1186 | JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */ |
1191 | JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */ |
| 1187 | } |
1192 | } |
| 1188 | } |
1193 | } |
| … | |
… | |
| 2368 | SV **ary; |
2373 | SV **ary; |
| 2369 | |
2374 | |
| 2370 | /* unfortunately, building manually saves memory */ |
2375 | /* unfortunately, building manually saves memory */ |
| 2371 | Newx (ary, 2, SV *); |
2376 | Newx (ary, 2, SV *); |
| 2372 | AvALLOC (av) = ary; |
2377 | AvALLOC (av) = ary; |
|
|
2378 | #if PERL_VERSION_ATLEAST (5,10,0) |
| 2373 | /*AvARRAY (av) = ary;*/ |
2379 | AvARRAY (av) = ary; |
|
|
2380 | #else |
| 2374 | SvPVX ((SV *)av) = (char *)ary; /* 5.8.8 needs this syntax instead of AvARRAY = ary */ |
2381 | /* 5.8.8 needs this syntax instead of AvARRAY = ary, yet */ |
|
|
2382 | /* -DDEBUGGING flags this as a bug, despite it perfectly working */ |
|
|
2383 | SvPVX ((SV *)av) = (char *)ary; |
|
|
2384 | #endif |
| 2375 | AvMAX (av) = 1; |
2385 | AvMAX (av) = 1; |
| 2376 | AvFILLp (av) = 0; |
2386 | AvFILLp (av) = 0; |
| 2377 | ary [0] = newSViv (count); |
2387 | ary [0] = newSViv (count); |
| 2378 | |
2388 | |
| 2379 | return newRV_noinc ((SV *)av); |
2389 | return newRV_noinc ((SV *)av); |
