--- Coro/Coro/State.xs 2001/11/27 01:41:41 1.40 +++ Coro/Coro/State.xs 2004/02/14 12:39:41 1.53 @@ -2,6 +2,29 @@ #include "perl.h" #include "XSUB.h" +#include "patchlevel.h" + +#if PATCHLEVEL < 6 +# ifndef PL_ppaddr +# define PL_ppaddr ppaddr +# endif +# ifndef call_sv +# define call_sv perl_call_sv +# endif +# ifndef get_sv +# define get_sv perl_get_sv +# endif +# ifndef get_cv +# define get_cv perl_get_cv +# endif +# ifndef IS_PADGV +# define IS_PADGV(v) 0 +# endif +# ifndef IS_PADCONST +# define IS_PADCONST(v) 0 +# endif +#endif + #include "libcoro/coro.c" #include @@ -18,8 +41,6 @@ # endif #endif -#define MAY_FLUSH /* increases codesize and is rarely used */ - #define SUB_INIT "Coro::State::initialize" #define UCORO_STATE "_coro_state" @@ -49,6 +70,9 @@ } coro_stack; struct coro { + /* the top-level JMPENV for each coroutine, needed to catch dies. */ + JMPENV start_env; + /* the optional C context */ coro_stack *stack; void *cursp; @@ -70,6 +94,7 @@ SV **stack_sp; OP *op; SV **curpad; + AV *comppad; SV **stack_base; SV **stack_max; SV **tmps_stack; @@ -89,7 +114,6 @@ I32 retstack_ix; I32 retstack_max; COP *curcop; - PMOP *curpm; JMPENV *top_env; /* data associated with this coroutine (initial args) */ @@ -160,7 +184,9 @@ sv = (SV *) newHV (); else sv = NEWSV (0, 0); +#ifdef SvPADBUSY if (!SvPADBUSY (sv)) +#endif SvPADMY_on (sv); npad[ix] = sv; } @@ -200,35 +226,53 @@ return newpadlist; } -#ifdef MAY_FLUSH STATIC void free_padlist (AV *padlist) { /* may be during global destruction */ - if (SvREFCNT(padlist)) + if (SvREFCNT (padlist)) { - I32 i = AvFILLp(padlist); + I32 i = AvFILLp (padlist); while (i >= 0) { - SV **svp = av_fetch(padlist, i--, FALSE); - SV *sv = svp ? *svp : Nullsv; - if (sv) - SvREFCNT_dec(sv); + SV **svp = av_fetch (padlist, i--, FALSE); + if (svp) + { + SV *sv; + while (&PL_sv_undef != (sv = av_pop ((AV *)*svp))) + SvREFCNT_dec (sv); + + SvREFCNT_dec (*svp); + } } - SvREFCNT_dec((SV*)padlist); - } + SvREFCNT_dec ((SV*)padlist); + } } -#endif + +STATIC int +coro_cv_free (SV *sv, MAGIC *mg) +{ + AV *padlist; + AV *av = (AV *)mg->mg_obj; + + /* casting is fun. */ + while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av))) + free_padlist (padlist); +} + +#define PERL_MAGIC_coro PERL_MAGIC_ext + +static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free}; /* the next two functions merely cache the padlists */ STATIC void get_padlist (CV *cv) { - SV **he = hv_fetch (padlist_cache, (void *)&cv, sizeof (CV *), 0); + MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); - if (he && AvFILLp ((AV *)*he) >= 0) - CvPADLIST (cv) = (AV *)av_pop ((AV *)*he); + if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0) + CvPADLIST (cv) = (AV *)av_pop ((AV *)mg->mg_obj); else CvPADLIST (cv) = clone_padlist (CvPADLIST (cv)); } @@ -236,42 +280,18 @@ STATIC void put_padlist (CV *cv) { - SV **he = hv_fetch (padlist_cache, (void *)&cv, sizeof (CV *), 1); - - if (SvTYPE (*he) != SVt_PVAV) - { - SvREFCNT_dec (*he); - *he = (SV *)newAV (); - } - - av_push ((AV *)*he, (SV *)CvPADLIST (cv)); -} - -#ifdef MAY_FLUSH -STATIC void -flush_padlist_cache () -{ - HV *hv = padlist_cache; - padlist_cache = newHV (); + MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); - if (hv_iterinit (hv)) + if (!mg) { - HE *he; - AV *padlist; - - while (!!(he = hv_iternext (hv))) - { - AV *av = (AV *)HeVAL(he); - - /* casting is fun. */ - while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av))) - free_padlist (padlist); - } + sv_magic ((SV *)cv, 0, PERL_MAGIC_coro, 0, 0); + mg = mg_find ((SV *)cv, PERL_MAGIC_coro); + mg->mg_virtual = &vtbl_coro; + mg->mg_obj = (SV *)newAV (); } - SvREFCNT_dec (hv); + av_push ((AV *)mg->mg_obj, (SV *)CvPADLIST (cv)); } -#endif #define SB do { #define SE } while (0) @@ -279,7 +299,7 @@ #define LOAD(state) load_state(aTHX_ (state)); #define SAVE(state,flags) save_state(aTHX_ (state),(flags)); -#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); SE +#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); (val) = 0; SE static void load_state(pTHX_ Coro__State c) @@ -293,6 +313,7 @@ PL_stack_sp = c->stack_sp; PL_op = c->op; PL_curpad = c->curpad; + PL_comppad = c->comppad; PL_stack_base = c->stack_base; PL_stack_max = c->stack_max; PL_tmps_stack = c->tmps_stack; @@ -390,12 +411,14 @@ get_padlist (cv); /* this is a monster */ } } +#ifdef CXt_FORMAT else if (CxTYPE(cx) == CXt_FORMAT) { /* I never used formats, so how should I know how these are implemented? */ /* my bold guess is as a simple, plain sub... */ croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats"); } +#endif } if (top_si->si_type == PERLSI_MAIN) @@ -422,6 +445,7 @@ c->stack_sp = PL_stack_sp; c->op = PL_op; c->curpad = PL_curpad; + c->comppad = PL_comppad; c->stack_base = PL_stack_base; c->stack_max = PL_stack_max; c->tmps_stack = PL_tmps_stack; @@ -447,8 +471,8 @@ /* * allocate various perl stacks. This is an exact copy * of perl.c:init_stacks, except that it uses less memory - * on the assumption that coroutines do not usually need - * a lot of stackspace. + * on the (sometimes correct) assumption that coroutines do + * not usually need a lot of stackspace. */ STATIC void coro_init_stacks (pTHX) @@ -471,7 +495,9 @@ PL_markstack_ptr = PL_markstack; PL_markstack_max = PL_markstack + 16; +#ifdef SET_MARK_OFFSET SET_MARK_OFFSET; +#endif New(54,PL_scopestack,16,I32); PL_scopestack_ix = 0; @@ -488,7 +514,6 @@ /* * destroy the stacks, the callchain etc... - * still there is a memleak of 128 bytes... */ STATIC void destroy_stacks(pTHX) @@ -496,12 +521,10 @@ if (!IN_DESTRUCT) { /* is this ugly, I ask? */ - while (PL_scopestack_ix) - LEAVE; + LEAVE_SCOPE (0); /* sure it is, but more important: is it correct?? :/ */ - while (PL_tmps_ix > PL_tmps_floor) /* should only ever be one iteration */ - FREETMPS; + FREETMPS; } while (PL_curstackinfo->si_next) @@ -548,14 +571,14 @@ if (alloc) { #if HAVE_MMAP - stack->ssize = 128 * 1024 * sizeof (long); /* mmap should do allocate-on-write for us */ + stack->ssize = 16384 * sizeof (long); /* mmap should do allocate-on-write for us */ stack->sptr = mmap (0, stack->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); if (stack->sptr == (void *)-1) #endif { /*FIXME*//*D*//* reasonable stack size! */ - stack->ssize = -4096 * sizeof (long); - New (0, stack->sptr, 4096, long); + stack->ssize = - (8192 * sizeof (long)); + New (0, stack->sptr, 8192, long); } } else @@ -579,9 +602,9 @@ if (stack->ssize > 0 && stack->sptr) munmap (stack->sptr, stack->ssize); else -#else - Safefree (stack->sptr); #endif + Safefree (stack->sptr); + Safefree (stack); } else if (ctx->gencnt == stack->gencnt) @@ -597,14 +620,13 @@ */ dSP; Coro__State ctx = (Coro__State)arg; - SV *sub_init = (SV*)get_cv(SUB_INIT, FALSE); + SV *sub_init = (SV *)get_cv (SUB_INIT, FALSE); coro_init_stacks (aTHX); - PL_curpm = 0; /* segfault on first access */ /*PL_curcop = 0;*/ /*PL_in_eval = PL_in_eval;*/ /* inherit */ SvREFCNT_dec (GvAV (PL_defgv)); - GvAV (PL_defgv) = ctx->args; + GvAV (PL_defgv) = ctx->args; ctx->args = 0; SPAGAIN; @@ -641,7 +663,7 @@ * ah yes, and I don't care anyways ;) */ PUTBACK; - PL_op = pp_entersub(); + PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); SPAGAIN; ENTER; /* necessary e.g. for dounwind */ @@ -657,11 +679,7 @@ Coro__State ctx = (Coro__State)arg; JMPENV coro_start_env; - /* same as JMPENV_BOOTSTRAP */ - Zero(&coro_start_env, 1, JMPENV); - coro_start_env.je_ret = -1; - coro_start_env.je_mustcatch = TRUE; - PL_top_env = &coro_start_env; + PL_top_env = &ctx->start_env; ctx->cursp = 0; PL_op = PL_op->op_next; @@ -729,6 +747,8 @@ if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK) { + PL_top_env = &next->start_env; + setup_coro (next); prev->stack->refcnt++; @@ -738,6 +758,7 @@ } else { + assert (!next->stack); allocate_stack (next, 1); coro_create (&(next->stack->cctx), setup_coro, (void *)next, @@ -752,7 +773,7 @@ /* * xnext is now either prev or next, depending on wether - * we switched the c stack or not. that's why i use a global + * we switched the c stack or not. that's why I use a global * variable, that should become thread-specific at one point. */ xnext->cursp = stacklevel; @@ -904,7 +925,6 @@ newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV)); newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV)); newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV)); - newCONSTSUB (coro_state_stash, "SAVE_CURPM", newSViv (TRANSFER_SAVE_CURPM)); newCONSTSUB (coro_state_stash, "SAVE_CCTXT", newSViv (TRANSFER_SAVE_CCTXT)); if (!padlist_cache) @@ -926,12 +946,18 @@ if (!SvROK (args) || SvTYPE (SvRV (args)) != SVt_PVAV) croak ("Coro::State::_newprocess expects an arrayref"); - New (0, coro, 1, struct coro); + Newz (0, coro, 1, struct coro); coro->args = (AV *)SvREFCNT_inc (SvRV (args)); coro->mainstack = 0; /* actual work is done inside transfer */ coro->stack = 0; + /* same as JMPENV_BOOTSTRAP */ + /* we might be able to recycle start_env, but safe is safe */ + //Zero(&coro->start_env, 1, JMPENV); + coro->start_env.je_ret = -1; + coro->start_env.je_mustcatch = TRUE; + RETVAL = coro; OUTPUT: RETVAL @@ -972,28 +998,15 @@ } deallocate_stack (coro); - + SvREFCNT_dec (coro->args); Safefree (coro); void -flush() - CODE: -#ifdef MAY_FLUSH - flush_padlist_cache (); -#endif - -void _exit(code) int code PROTOTYPE: $ CODE: -#if defined(__GLIBC__) || _POSIX_C_SOURCE _exit (code); -#else - signal (SIGTERM, SIG_DFL); - raise (SIGTERM); - exit (code); -#endif MODULE = Coro::State PACKAGE = Coro::Cont @@ -1009,7 +1022,7 @@ struct coro *prev, *next; if (!returnstk) - returnstk = SvRV (get_sv ("Coro::Cont::return", FALSE)); + returnstk = SvRV ((SV *)get_sv ("Coro::Cont::return", FALSE)); /* set up @_ -- ugly */ av_clear (defav); @@ -1062,6 +1075,8 @@ } } +#if !PERL_MICRO + void ready(self) SV * self @@ -1069,6 +1084,8 @@ CODE: api_ready (self); +#endif + int nready(...) PROTOTYPE: