--- Coro/Coro/State.xs 2004/08/10 01:56:30 1.61 +++ Coro/Coro/State.xs 2006/11/24 00:31:21 1.84 @@ -1,12 +1,14 @@ #define PERL_NO_GET_CONTEXT +#include "libcoro/coro.c" + #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "patchlevel.h" -#if PATCHLEVEL < 6 +#if PERL_VERSION < 6 # ifndef PL_ppaddr # define PL_ppaddr ppaddr # endif @@ -27,9 +29,15 @@ # endif #endif -#include "libcoro/coro.c" +#include + +#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64 +# undef STACKGUARD +#endif -#include +#ifndef STACKGUARD +# define STACKGUARD 0 +#endif #ifdef HAVE_MMAP # include @@ -41,6 +49,14 @@ # undef HAVE_MMAP # endif # endif +# include +# ifndef PAGESIZE +# define PAGESIZE pagesize +# define BOOT_PAGESIZE pagesize = sysconf (_SC_PAGESIZE) +static long pagesize; +# else +# define BOOT_PAGESIZE +# endif #endif #define SUB_INIT "Coro::State::initialize" @@ -59,11 +75,11 @@ #ifdef USE_ITHREADS static perl_mutex coro_mutex; -# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0) +# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0) # define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0) #else -# define LOCK 0 -# define UNLOCK 0 +# define LOCK (void)0 +# define UNLOCK (void)0 #endif static struct CoroAPI coroapi; @@ -86,9 +102,6 @@ } 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; @@ -111,6 +124,7 @@ OP *op; SV **curpad; AV *comppad; + CV *compcv; SV **stack_base; SV **stack_max; SV **tmps_stack; @@ -129,6 +143,7 @@ OP **retstack; I32 retstack_ix; I32 retstack_max; + PMOP *curpm; COP *curcop; JMPENV *top_env; @@ -139,107 +154,29 @@ typedef struct coro *Coro__State; typedef struct coro *Coro__State_or_hashref; -/* mostly copied from op.c:cv_clone2 */ -STATIC AV * -clone_padlist (pTHX_ AV *protopadlist) -{ - AV *av; - I32 ix; - AV *protopad_name = (AV *) * av_fetch (protopadlist, 0, FALSE); - AV *protopad = (AV *) * av_fetch (protopadlist, 1, FALSE); - SV **pname = AvARRAY (protopad_name); - SV **ppad = AvARRAY (protopad); - I32 fname = AvFILLp (protopad_name); - I32 fpad = AvFILLp (protopad); - AV *newpadlist, *newpad_name, *newpad; - SV **npad; - - newpad_name = newAV (); - for (ix = fname; ix >= 0; ix--) - av_store (newpad_name, ix, SvREFCNT_inc (pname[ix])); - - newpad = newAV (); - av_fill (newpad, AvFILLp (protopad)); - npad = AvARRAY (newpad); +static AV * +coro_clone_padlist (pTHX_ CV *cv) +{ + AV *padlist = CvPADLIST (cv); + AV *newpadlist, *newpad; newpadlist = newAV (); AvREAL_off (newpadlist); - av_store (newpadlist, 0, (SV *) newpad_name); - av_store (newpadlist, 1, (SV *) newpad); - - av = newAV (); /* will be @_ */ - av_extend (av, 0); - av_store (newpad, 0, (SV *) av); - AvFLAGS (av) = AVf_REIFY; - - for (ix = fpad; ix > 0; ix--) - { - SV *namesv = (ix <= fname) ? pname[ix] : Nullsv; - - if (namesv && namesv != &PL_sv_undef) - { - char *name = SvPVX (namesv); /* XXX */ - - if (SvFLAGS (namesv) & SVf_FAKE || *name == '&') - { /* lexical from outside? */ - npad[ix] = SvREFCNT_inc (ppad[ix]); - } - else - { /* our own lexical */ - SV *sv; - if (*name == '&') - sv = SvREFCNT_inc (ppad[ix]); - else if (*name == '@') - sv = (SV *) newAV (); - else if (*name == '%') - sv = (SV *) newHV (); - else - sv = NEWSV (0, 0); - -#ifdef SvPADBUSY - if (!SvPADBUSY (sv)) +#if PERL_VERSION < 9 + Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); +#else + Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1); #endif - SvPADMY_on (sv); + newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; + --AvFILLp (padlist); - npad[ix] = sv; - } - } - else if (IS_PADGV (ppad[ix]) || IS_PADCONST (ppad[ix])) - { - npad[ix] = SvREFCNT_inc (ppad[ix]); - } - else - { - SV *sv = NEWSV (0, 0); - SvPADTMP_on (sv); - npad[ix] = sv; - } - } - -#if 0 /* return -ENOTUNDERSTOOD */ - /* Now that vars are all in place, clone nested closures. */ - - for (ix = fpad; ix > 0; ix--) { - SV* namesv = (ix <= fname) ? pname[ix] : Nullsv; - if (namesv - && namesv != &PL_sv_undef - && !(SvFLAGS(namesv) & SVf_FAKE) - && *SvPVX(namesv) == '&' - && CvCLONE(ppad[ix])) - { - CV *kid = cv_clone((CV*)ppad[ix]); - SvREFCNT_dec(ppad[ix]); - CvCLONE_on(kid); - SvPADMY_on(kid); - npad[ix] = (SV*)kid; - } - } -#endif + av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE))); + av_store (newpadlist, 1, (SV *)newpad); return newpadlist; } -STATIC void +static void free_padlist (pTHX_ AV *padlist) { /* may be during global destruction */ @@ -263,7 +200,7 @@ } } -STATIC int +static int coro_cv_free (pTHX_ SV *sv, MAGIC *mg) { AV *padlist; @@ -274,6 +211,8 @@ free_padlist (aTHX_ padlist); SvREFCNT_dec (av); + + return 0; } #define PERL_MAGIC_coro PERL_MAGIC_ext @@ -281,7 +220,7 @@ static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free}; /* the next two functions merely cache the padlists */ -STATIC void +static void get_padlist (pTHX_ CV *cv) { MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); @@ -289,10 +228,20 @@ if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0) CvPADLIST (cv) = (AV *)av_pop ((AV *)mg->mg_obj); else - CvPADLIST (cv) = clone_padlist (aTHX_ CvPADLIST (cv)); + { +#if 0 + /* this should work - but it doesn't :( */ + CV *cp = Perl_cv_clone (aTHX_ cv); + CvPADLIST (cv) = CvPADLIST (cp); + CvPADLIST (cp) = 0; + SvREFCNT_dec (cp); +#else + CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv); +#endif + } } -STATIC void +static void put_padlist (pTHX_ CV *cv) { MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); @@ -329,6 +278,7 @@ PL_op = c->op; PL_curpad = c->curpad; PL_comppad = c->comppad; + PL_compcv = c->compcv; PL_stack_base = c->stack_base; PL_stack_max = c->stack_max; PL_tmps_stack = c->tmps_stack; @@ -344,9 +294,12 @@ PL_savestack = c->savestack; PL_savestack_ix = c->savestack_ix; PL_savestack_max = c->savestack_max; +#if PERL_VERSION < 9 PL_retstack = c->retstack; PL_retstack_ix = c->retstack_ix; PL_retstack_max = c->retstack_max; +#endif + PL_curpm = c->curpm; PL_curcop = c->curcop; PL_top_env = c->top_env; @@ -415,7 +368,7 @@ PUSHs ((SV *)CvPADLIST(cv)); PUSHs ((SV *)cv); - get_padlist (aTHX_ cv); /* this is a monster */ + get_padlist (aTHX_ cv); } } #ifdef CXt_FORMAT @@ -453,6 +406,7 @@ c->op = PL_op; c->curpad = PL_curpad; c->comppad = PL_comppad; + c->compcv = PL_compcv; c->stack_base = PL_stack_base; c->stack_max = PL_stack_max; c->tmps_stack = PL_tmps_stack; @@ -468,9 +422,12 @@ c->savestack = PL_savestack; c->savestack_ix = PL_savestack_ix; c->savestack_max = PL_savestack_max; +#if PERL_VERSION < 9 c->retstack = PL_retstack; c->retstack_ix = PL_retstack_ix; c->retstack_max = PL_retstack_max; +#endif + c->curpm = PL_curpm; c->curcop = PL_curcop; c->top_env = PL_top_env; } @@ -481,7 +438,7 @@ * on the (sometimes correct) assumption that coroutines do * not usually need a lot of stackspace. */ -STATIC void +static void coro_init_stacks (pTHX) { LOCK; @@ -516,9 +473,11 @@ PL_savestack_ix = 0; PL_savestack_max = 96; +#if PERL_VERSION < 9 New(54,PL_retstack,8,OP*); PL_retstack_ix = 0; PL_retstack_max = 8; +#endif UNLOCK; } @@ -526,7 +485,7 @@ /* * destroy the stacks, the callchain etc... */ -STATIC void +static void destroy_stacks(pTHX) { if (!IN_DESTRUCT) @@ -568,7 +527,9 @@ Safefree (PL_markstack); Safefree (PL_scopestack); Safefree (PL_savestack); +#if PERL_VERSION < 9 Safefree (PL_retstack); +#endif } static void @@ -585,14 +546,19 @@ if (alloc) { #if HAVE_MMAP - stack->ssize = 16384 * sizeof (long); /* mmap should do allocate-on-write for us */ + stack->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; /* 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) + if (stack->sptr != (void *)-1) + { +# if STACKGUARD + mprotect (stack->sptr, STACKGUARD * PAGESIZE, PROT_NONE); +# endif + } + else #endif { - /*FIXME*//*D*//* reasonable stack size! */ - stack->ssize = - (8192 * sizeof (long)); - New (0, stack->sptr, 8192, long); + stack->ssize = - (STACKSIZE * (long)sizeof (long)); + New (0, stack->sptr, STACKSIZE, long); } } else @@ -662,12 +628,12 @@ { UNOP myop; - PL_op = (OP *)&myop; - Zero(&myop, 1, UNOP); myop.op_next = Nullop; myop.op_flags = OPf_WANT_VOID; + PL_op = (OP *)&myop; + PUSHMARK(SP); XPUSHs (sub_init); /* @@ -693,9 +659,8 @@ */ dTHX; Coro__State ctx = (Coro__State)arg; - JMPENV coro_start_env; - PL_top_env = &ctx->start_env; + PL_top_env = &PL_start_env; ctx->cursp = 0; PL_op = PL_op->op_next; @@ -704,13 +669,15 @@ abort (); } -STATIC void -transfer (pTHX_ struct coro *prev, struct coro *next, int flags) +/* never call directly, always through the coro_state_transfer global variable */ +static void +transfer_impl (pTHX_ struct coro *prev, struct coro *next, int flags) { dSTACKLEVEL; if (prev != next) { + /* has this coro been created yet? */ if (next->mainstack) { LOCK; @@ -759,15 +726,17 @@ SAVE (prev, -1); /* first get rid of the old state */ UNLOCK; + /* create the coroutine for the first time */ if (flags & TRANSFER_SAVE_CCTXT) { if (!prev->stack) allocate_stack (prev, 0); + /* the new coroutine starts with start_env again */ + PL_top_env = &PL_start_env; + if (prev->stack->sptr && flags & TRANSFER_LAZY_STACK) { - PL_top_env = &next->start_env; - setup_coro (next); next->cursp = stacklevel; @@ -805,6 +774,8 @@ UNLOCK; } +void (*coro_state_transfer)(pTHX_ struct coro *prev, struct coro *next, int flags) = transfer_impl; + #define SV_CORO(sv,func) \ do { \ if (SvROK (sv)) \ @@ -826,15 +797,15 @@ \ } while(0) -#define SvSTATE(sv) (struct coro *)SvIV (sv) +#define SvSTATE(sv) INT2PTR (struct coro *, SvIVX (sv)) static void -api_transfer(pTHX_ SV *prev, SV *next, int flags) +api_transfer (pTHX_ SV *prev, SV *next, int flags) { SV_CORO (prev, "Coro::transfer"); SV_CORO (next, "Coro::transfer"); - transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); + coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); } /** Coro ********************************************************************/ @@ -848,28 +819,27 @@ /* for Coro.pm */ static GV *coro_current, *coro_idle; -static AV *coro_ready[PRIO_MAX-PRIO_MIN+1]; +static AV *coro_ready [PRIO_MAX-PRIO_MIN+1]; static int coro_nready; static void coro_enq (pTHX_ SV *sv) { - if (SvTYPE (sv) == SVt_PVHV) - { - SV **xprio = hv_fetch ((HV *)sv, "prio", 4, 0); - int prio = xprio ? SvIV (*xprio) : PRIO_NORMAL; + SV **xprio; + int prio; - prio = prio > PRIO_MAX ? PRIO_MAX - : prio < PRIO_MIN ? PRIO_MIN - : prio; + if (SvTYPE (sv) != SVt_PVHV) + croak ("Coro::ready tried to enqueue something that is not a coroutine"); - av_push (coro_ready [prio - PRIO_MIN], sv); - coro_nready++; + xprio = hv_fetch ((HV *)sv, "prio", 4, 0); + prio = xprio ? SvIV (*xprio) : PRIO_NORMAL; - return; - } + prio = prio > PRIO_MAX ? PRIO_MAX + : prio < PRIO_MIN ? PRIO_MIN + : prio; - croak ("Coro::ready tried to enqueue something that is not a coroutine"); + av_push (coro_ready [prio - PRIO_MIN], sv); + coro_nready++; } static SV * @@ -882,10 +852,10 @@ min_prio = 0; for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; ) - if (av_len (coro_ready[prio]) >= 0) + if (AvFILLp (coro_ready [prio]) >= 0) { coro_nready--; - return av_shift (coro_ready[prio]); + return av_shift (coro_ready [prio]); } return 0; @@ -929,8 +899,8 @@ UNLOCK; - transfer (aTHX_ SvSTATE (prev), SvSTATE (next), - TRANSFER_SAVE_ALL | TRANSFER_LAZY_STACK); + coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), + TRANSFER_SAVE_ALL | TRANSFER_LAZY_STACK); } static void @@ -954,6 +924,7 @@ #ifdef USE_ITHREADS MUTEX_INIT (&coro_mutex); #endif + BOOT_PAGESIZE; ucoro_state_sv = newSVpv (UCORO_STATE, sizeof(UCORO_STATE) - 1); PERL_HASH(ucoro_state_hash, UCORO_STATE, sizeof(UCORO_STATE) - 1); @@ -986,12 +957,6 @@ /*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 @@ -1006,7 +971,7 @@ PUTBACK; SV_CORO (next, "Coro::transfer"); SV_CORO (prev, "Coro::transfer"); - transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); + coro_state_transfer (aTHX_ SvSTATE (prev), SvSTATE (next), flags); SPAGAIN; void @@ -1044,19 +1009,20 @@ MODULE = Coro::State PACKAGE = Coro::Cont -# this is slightly dirty (should expose a c-level api) - void yield(...) PROTOTYPE: @ CODE: - static SV *returnstk; + SV *yieldstack; SV *sv; AV *defav = GvAV (PL_defgv); struct coro *prev, *next; - if (!returnstk) - returnstk = SvRV ((SV *)get_sv ("Coro::Cont::return", FALSE)); + yieldstack = *hv_fetch ( + (HV *)SvRV (GvSV (coro_current)), + "yieldstack", sizeof ("yieldstack") - 1, + 0 + ); /* set up @_ -- ugly */ av_clear (defav); @@ -1064,18 +1030,15 @@ while (items--) av_store (defav, items, SvREFCNT_inc (ST(items))); - SvGETMAGIC (returnstk); /* isn't documentation wrong for mg_get? */ - sv = av_pop ((AV *)SvRV (returnstk)); - prev = (struct coro *)SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0))); - next = (struct coro *)SvIV ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0))); + sv = av_pop ((AV *)SvRV (yieldstack)); + prev = SvSTATE ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 0, 0))); + next = SvSTATE ((SV*)SvRV (*av_fetch ((AV *)SvRV (sv), 1, 0))); SvREFCNT_dec (sv); - transfer (aTHX_ prev, next, 0); + coro_state_transfer (aTHX_ prev, next, 0); MODULE = Coro::State PACKAGE = Coro -# this is slightly dirty (should expose a c-level api) - BOOT: { int i; @@ -1104,8 +1067,8 @@ coroapi.current = coro_current; GCoroAPI = &coroapi; - sv_setiv(sv, (IV)&coroapi); - SvREADONLY_on(sv); + sv_setiv (sv, (IV)&coroapi); + SvREADONLY_on (sv); } } @@ -1140,3 +1103,42 @@ CODE: api_cede (); +# and these are hacks +SV * +_aio_get_state () + CODE: +{ + struct { + int errorno; + int laststype; + int laststatval; + Stat_t statcache; + } data; + + data.errorno = errno; + data.laststype = PL_laststype; + data.laststatval = PL_laststatval; + data.statcache = PL_statcache; + + RETVAL = newSVpvn ((char *)&data, sizeof data); +} + OUTPUT: + RETVAL + +void +_aio_set_state (char *data_) + PROTOTYPE: $ + CODE: +{ + struct { + int errorno; + int laststype; + int laststatval; + Stat_t statcache; + } *data = (void *)data_; + + errno = data->errorno; + PL_laststype = data->laststype; + PL_laststatval = data->laststatval; + PL_statcache = data->statcache; +}