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.49 by pcg, Sun Nov 23 03:34:13 2003 UTC vs.
Revision 1.54 by pcg, Sat Mar 13 06:45:04 2004 UTC

… …
38# else 38# else
39# undef HAVE_MMAP 39# undef HAVE_MMAP
40# endif 40# endif
41# endif 41# endif
42#endif 42#endif
43
44#define MAY_FLUSH /* increases codesize and is rarely used */
45 43
46#define SUB_INIT "Coro::State::initialize" 44#define SUB_INIT "Coro::State::initialize"
47#define UCORO_STATE "_coro_state" 45#define UCORO_STATE "_coro_state"
48 46
49/* The next macro should declare a variable stacklevel that contains and approximation 47/* The next macro should declare a variable stacklevel that contains and approximation
… …
226#endif 224#endif
227 225
228 return newpadlist; 226 return newpadlist;
229} 227}
230 228
231#ifdef MAY_FLUSH
232STATIC void 229STATIC void
233free_padlist (AV *padlist) 230free_padlist (AV *padlist)
234{ 231{
235 /* may be during global destruction */ 232 /* may be during global destruction */
236 if (SvREFCNT(padlist)) 233 if (SvREFCNT (padlist))
237 { 234 {
238 I32 i = AvFILLp(padlist); 235 I32 i = AvFILLp (padlist);
239 while (i >= 0) 236 while (i >= 0)
240 { 237 {
241 SV **svp = av_fetch(padlist, i--, FALSE); 238 SV **svp = av_fetch (padlist, i--, FALSE);
242 SV *sv = svp ? *svp : Nullsv;
243 if (sv) 239 if (svp)
240 {
241 SV *sv;
242 while (&PL_sv_undef != (sv = av_pop ((AV *)*svp)))
244 SvREFCNT_dec(sv); 243 SvREFCNT_dec (sv);
244
245 SvREFCNT_dec (*svp);
246 }
245 } 247 }
246 248
247 SvREFCNT_dec((SV*)padlist); 249 SvREFCNT_dec ((SV*)padlist);
248 } 250 }
249} 251}
250#endif 252
253STATIC int
254coro_cv_free (pTHX_ SV *sv, MAGIC *mg)
255{
256 AV *padlist;
257 AV *av = (AV *)mg->mg_obj;
258
259 /* casting is fun. */
260 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))
261 free_padlist (padlist);
262}
263
264#define PERL_MAGIC_coro PERL_MAGIC_ext
265
266static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free};
251 267
252/* the next two functions merely cache the padlists */ 268/* the next two functions merely cache the padlists */
253STATIC void 269STATIC void
254get_padlist (CV *cv) 270get_padlist (CV *cv)
255{ 271{
256 SV **he = hv_fetch (padlist_cache, (void *)&cv, sizeof (CV *), 0); 272 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
257 273
258 if (he && AvFILLp ((AV *)*he) >= 0) 274 if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0)
259 CvPADLIST (cv) = (AV *)av_pop ((AV *)*he); 275 CvPADLIST (cv) = (AV *)av_pop ((AV *)mg->mg_obj);
260 else 276 else
261 CvPADLIST (cv) = clone_padlist (CvPADLIST (cv)); 277 CvPADLIST (cv) = clone_padlist (CvPADLIST (cv));
262} 278}
263 279
264STATIC void 280STATIC void
265put_padlist (CV *cv) 281put_padlist (CV *cv)
266{ 282{
267 SV **he = hv_fetch (padlist_cache, (void *)&cv, sizeof (CV *), 1); 283 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
268 284
269 if (SvTYPE (*he) != SVt_PVAV) 285 if (!mg)
270 { 286 {
271 SvREFCNT_dec (*he); 287 sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0);
288 mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
289 mg->mg_virtual = &vtbl_coro;
272 *he = (SV *)newAV (); 290 mg->mg_obj = (SV *)newAV ();
273 } 291 }
274 292
275 av_push ((AV *)*he, (SV *)CvPADLIST (cv)); 293 av_push ((AV *)mg->mg_obj, (SV *)CvPADLIST (cv));
276} 294}
277
278#ifdef MAY_FLUSH
279STATIC void
280flush_padlist_cache ()
281{
282 HV *hv = padlist_cache;
283 padlist_cache = newHV ();
284
285 if (hv_iterinit (hv))
286 {
287 HE *he;
288 AV *padlist;
289
290 while (!!(he = hv_iternext (hv)))
291 {
292 AV *av = (AV *)HeVAL(he);
293
294 /* casting is fun. */
295 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))
296 free_padlist (padlist);
297 }
298 }
299
300 SvREFCNT_dec (hv);
301}
302#endif
303 295
304#define SB do { 296#define SB do {
305#define SE } while (0) 297#define SE } while (0)
306 298
307#define LOAD(state) load_state(aTHX_ (state)); 299#define LOAD(state) load_state(aTHX_ (state));
… …
477} 469}
478 470
479/* 471/*
480 * allocate various perl stacks. This is an exact copy 472 * allocate various perl stacks. This is an exact copy
481 * of perl.c:init_stacks, except that it uses less memory 473 * of perl.c:init_stacks, except that it uses less memory
482 * on the assumption that coroutines do not usually need 474 * on the (sometimes correct) assumption that coroutines do
483 * a lot of stackspace. 475 * not usually need a lot of stackspace.
484 */ 476 */
485STATIC void 477STATIC void
486coro_init_stacks (pTHX) 478coro_init_stacks (pTHX)
487{ 479{
488 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1); 480 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1);
… …
527destroy_stacks(pTHX) 519destroy_stacks(pTHX)
528{ 520{
529 if (!IN_DESTRUCT) 521 if (!IN_DESTRUCT)
530 { 522 {
531 /* is this ugly, I ask? */ 523 /* is this ugly, I ask? */
532 while (PL_scopestack_ix) 524 LEAVE_SCOPE (0);
533 LEAVE;
534 525
535 /* sure it is, but more important: is it correct?? :/ */ 526 /* sure it is, but more important: is it correct?? :/ */
536 while (PL_tmps_ix > PL_tmps_floor) /* should only ever be one iteration */
537 FREETMPS; 527 FREETMPS;
538 } 528 }
539 529
540 while (PL_curstackinfo->si_next) 530 while (PL_curstackinfo->si_next)
541 PL_curstackinfo = PL_curstackinfo->si_next; 531 PL_curstackinfo = PL_curstackinfo->si_next;
542 532
… …
579 stack->usecnt = 1; 569 stack->usecnt = 1;
580 stack->gencnt = ctx->gencnt = 0; 570 stack->gencnt = ctx->gencnt = 0;
581 if (alloc) 571 if (alloc)
582 { 572 {
583#if HAVE_MMAP 573#if HAVE_MMAP
584 stack->ssize = 128 * 1024 * sizeof (long); /* mmap should do allocate-on-write for us */ 574 stack->ssize = 16384 * sizeof (long); /* mmap should do allocate-on-write for us */
585 stack->sptr = mmap (0, stack->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); 575 stack->sptr = mmap (0, stack->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
586 if (stack->sptr == (void *)-1) 576 if (stack->sptr == (void *)-1)
587#endif 577#endif
588 { 578 {
589 /*FIXME*//*D*//* reasonable stack size! */ 579 /*FIXME*//*D*//* reasonable stack size! */
590 stack->ssize = -4096 * sizeof (long); 580 stack->ssize = - (8192 * sizeof (long));
591 New (0, stack->sptr, 4096, long); 581 New (0, stack->sptr, 8192, long);
592 } 582 }
593 } 583 }
594 else 584 else
595 stack->sptr = 0; 585 stack->sptr = 0;
596 586
… …
628 /* 618 /*
629 * emulate part of the perl startup here. 619 * emulate part of the perl startup here.
630 */ 620 */
631 dSP; 621 dSP;
632 Coro__State ctx = (Coro__State)arg; 622 Coro__State ctx = (Coro__State)arg;
633 SV *sub_init = (SV*)get_cv(SUB_INIT, FALSE); 623 SV *sub_init = (SV *)get_cv (SUB_INIT, FALSE);
634 624
635 coro_init_stacks (aTHX); 625 coro_init_stacks (aTHX);
636 /*PL_curcop = 0;*/ 626 /*PL_curcop = 0;*/
637 /*PL_in_eval = PL_in_eval;*/ /* inherit */ 627 /*PL_in_eval = PL_in_eval;*/ /* inherit */
638 SvREFCNT_dec (GvAV (PL_defgv)); 628 SvREFCNT_dec (GvAV (PL_defgv));
… …
1010 deallocate_stack (coro); 1000 deallocate_stack (coro);
1011 SvREFCNT_dec (coro->args); 1001 SvREFCNT_dec (coro->args);
1012 Safefree (coro); 1002 Safefree (coro);
1013 1003
1014void 1004void
1015flush()
1016 CODE:
1017#ifdef MAY_FLUSH
1018 flush_padlist_cache ();
1019#endif
1020
1021void
1022_exit(code) 1005_exit(code)
1023 int code 1006 int code
1024 PROTOTYPE: $ 1007 PROTOTYPE: $
1025 CODE: 1008 CODE:
1026#if defined(__GLIBC__) || _POSIX_C_SOURCE
1027 _exit (code); 1009 _exit (code);
1028#else
1029 signal (SIGTERM, SIG_DFL);
1030 raise (SIGTERM);
1031 exit (code);
1032#endif
1033 1010
1034MODULE = Coro::State PACKAGE = Coro::Cont 1011MODULE = Coro::State PACKAGE = Coro::Cont
1035 1012
1036# this is slightly dirty (should expose a c-level api) 1013# this is slightly dirty (should expose a c-level api)
1037 1014
… …
1096 sv_setiv(sv, (IV)&coroapi); 1073 sv_setiv(sv, (IV)&coroapi);
1097 SvREADONLY_on(sv); 1074 SvREADONLY_on(sv);
1098 } 1075 }
1099} 1076}
1100 1077
1078#if !PERL_MICRO
1079
1101void 1080void
1102ready(self) 1081ready(self)
1103 SV * self 1082 SV * self
1104 PROTOTYPE: $ 1083 PROTOTYPE: $
1105 CODE: 1084 CODE:
1106 api_ready (self); 1085 api_ready (self);
1086
1087#endif
1107 1088
1108int 1089int
1109nready(...) 1090nready(...)
1110 PROTOTYPE: 1091 PROTOTYPE:
1111 CODE: 1092 CODE:

Diff Legend

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