[ViewVC] Diff of: cvs/Coro/Coro/State.xs

Comparing Coro/Coro/State.xs (file contents):
Revision 1.214 by root, Sat Oct 13 23:19:10 2007 UTC vs.
Revision 1.229 by root, Thu Apr 10 07:45:33 2008 UTC

 # ifndef IS_PADCONST
 #  define IS_PADCONST(v) 0
 # endif
 #endif
+/* 5.8.8 */
+#ifndef GV_NOTQUAL
+# define GV_NOTQUAL 0
+#endif
+#ifndef newSV
+# define newSV(l) NEWSV(0,l)
+#endif
+/* 5.11 */
+#ifndef CxHASARGS
+# define CxHASARGS(cx) (cx)->blk_sub.hasargs
+#endif
 /* 5.8.7 */
 #ifndef SvRV_set
 # define SvRV_set(s,v) SvRV(s) = (v)
-#endif
-/* 5.8.8 */
-#ifndef GV_NOTQUAL
-# define GV_NOTQUAL 0
-#endif
-#ifndef newSV
-# define newSV(l) NEWSV(0,l)
 #endif
 #if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
 # undef CORO_STACKGUARD
 #endif
 static size_t coro_stacksize = CORO_STACKSIZE;
 static struct CoroAPI coroapi;
 static AV *main_mainstack; /* used to differentiate between $main and others */
 static JMPENV *main_top_env;
 static HV *coro_state_stash, *coro_stash;
-static SV *coro_mortal; /* will be freed after next transfer */
+static volatile SV *coro_mortal; /* will be freed after next transfer */
 static GV *irsgv;    /* $/ */
 static GV *stdoutgv; /* *STDOUT */
 static SV *rv_diehook;
 static SV *rv_warnhook;
 /** lowlevel stuff **********************************************************/
 static SV *
 coro_get_sv (pTHX_ const char *name, int create)
 {
-#if PERL_VERSION_ATLEAST (5,9,0)
+#if PERL_VERSION_ATLEAST (5,10,0)
          /* silence stupid and wrong 5.10 warning that I am unable to switch off */
          get_sv (name, create);
 #endif
   return get_sv (name, create);
 }
 static AV *
 coro_get_av (pTHX_ const char *name, int create)
 {
-#if PERL_VERSION_ATLEAST (5,9,0)
+#if PERL_VERSION_ATLEAST (5,10,0)
          /* silence stupid and wrong 5.10 warning that I am unable to switch off */
          get_av (name, create);
 #endif
   return get_av (name, create);
 }
 static HV *
 coro_get_hv (pTHX_ const char *name, int create)
 {
-#if PERL_VERSION_ATLEAST (5,9,0)
+#if PERL_VERSION_ATLEAST (5,10,0)
          /* silence stupid and wrong 5.10 warning that I am unable to switch off */
          get_hv (name, create);
 #endif
   return get_hv (name, create);
 }
   AV *padlist = CvPADLIST (cv);
   AV *newpadlist, *newpad;
   newpadlist = newAV ();
   AvREAL_off (newpadlist);
-#if PERL_VERSION_ATLEAST (5,9,0)
+#if PERL_VERSION_ATLEAST (5,10,0)
   Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
 #else
   Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
 #endif
   newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
     New(54,PL_savestack,24,ANY);
     PL_savestack_ix = 0;
     PL_savestack_max = 24;
-#if !PERL_VERSION_ATLEAST (5,9,0)
+#if !PERL_VERSION_ATLEAST (5,10,0)
     New(54,PL_retstack,4,OP*);
     PL_retstack_ix = 0;
     PL_retstack_max = 4;
 #endif
 }
   Safefree (PL_tmps_stack);
   Safefree (PL_markstack);
   Safefree (PL_scopestack);
   Safefree (PL_savestack);
-#if !PERL_VERSION_ATLEAST (5,9,0)
+#if !PERL_VERSION_ATLEAST (5,10,0)
   Safefree (PL_retstack);
 #endif
 }
 static size_t
       rss += slot->tmps_max * sizeof (SV *);
       rss += (slot->markstack_max - slot->markstack_ptr) * sizeof (I32);
       rss += slot->scopestack_max * sizeof (I32);
       rss += slot->savestack_max * sizeof (ANY);
-#if !PERL_VERSION_ATLEAST (5,9,0)
+#if !PERL_VERSION_ATLEAST (5,10,0)
       rss += slot->retstack_max * sizeof (OP *);
 #endif
     }
   return rss;
 }
 /** coroutine stack handling ************************************************/
 static int (*orig_sigelem_get) (pTHX_ SV *sv, MAGIC *mg);
+static int (*orig_sigelem_set) (pTHX_ SV *sv, MAGIC *mg);
 /*
  * This overrides the default magic get method of %SIG elements.
  * The original one doesn't provide for reading back of PL_diehook/PL_warnhook
  * and instead of tryign to save and restore the hash elements, we just provide
     {
       if (strEQ (s, "__DIE__" ) && PL_diehook ) return sv_setsv (sv, PL_diehook ), 0;
       if (strEQ (s, "__WARN__") && PL_warnhook) return sv_setsv (sv, PL_warnhook), 0;
     }
-  return orig_sigelem_get (aTHX_ sv, mg);
+  return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;
+}
+static int
+coro_sigelem_set (pTHX_ SV *sv, MAGIC *mg)
+{
+  const char *s = MgPV_nolen_const (mg);
+  if (*s == '_')
+    {
+      SV **svp = 0;
+      if (strEQ (s, "__DIE__" )) svp = &PL_diehook;
+      if (strEQ (s, "__WARN__")) svp = &PL_warnhook;
+      if (svp)
+        {
+          SV *old = *svp;
+          *svp = newSVsv (sv);
+          SvREFCNT_dec (old);
+          return;
+        }
+    }
+  return orig_sigelem_set ? orig_sigelem_set (aTHX_ sv, mg) : 0;
 }
 static void
 coro_setup (pTHX_ struct coro *coro)
 {
   PL_curpm      = 0;
   PL_curpad     = 0;
   PL_localizing = 0;
   PL_dirty      = 0;
   PL_restartop  = 0;
+#if PERL_VERSION_ATLEAST (5,10,0)
+  PL_parser     = 0;
+#endif
   /* recreate the die/warn hooks */
-  PL_diehook = 0;
+  PL_diehook  = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );
-  hv_store (hv_sig, "__DIE__", sizeof ("__DIE__") - 1, newSV (0), 0);
+  PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), rv_warnhook);
-  PL_diehook = SvREFCNT_inc (rv_diehook);
-  PL_warnhook = 0;
-  hv_store (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, newSV (0), 0);
-  PL_warnhook = SvREFCNT_inc (rv_warnhook);
   GvSV (PL_defgv)    = newSV (0);
   GvAV (PL_defgv)    = coro->args; coro->args = 0;
   GvSV (PL_errgv)    = newSV (0);
   GvSV (irsgv)       = newSVpvn ("\n", 1); sv_magic (GvSV (irsgv), (SV *)irsgv, PERL_MAGIC_sv, "/", 0);
                           SAVETMPS;
                           EXTEND (SP, 3);
                           PUSHMARK (SP);
                           PUSHs (&PL_sv_yes);
                           PUSHs (fullname);
-                          PUSHs (cx->blk_sub.hasargs ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
+                          PUSHs (CxHASARGS (cx)  ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
                           PUTBACK;
                           cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
                           if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
                           SPAGAIN;
                           FREETMPS;
         croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
       if (expect_false (next->flags & CF_DESTROYED))
         croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");
-      if (
-#if PERL_VERSION_ATLEAST (5,9,0)
+#if !PERL_VERSION_ATLEAST (5,10,0)
-          expect_false (PL_parser)
-#else
-          expect_false (PL_lex_state != LEX_NOTPARSING)
+      if (expect_false (PL_lex_state != LEX_NOTPARSING)
-#endif
-         )
-        croak ("Coro::State::transfer called while parsing, but this is not supported");
+        croak ("Coro::State::transfer called while parsing, but this is not supported in your perl version");
+#endif
     }
 }
 /* always use the TRANSFER macro */
 static void NOINLINE
-transfer (pTHX_ struct coro *prev, struct coro *next)
+transfer (pTHX_ struct coro *prev, struct coro *next, int force_cctx)
 {
   dSTACKLEVEL;
+  static volatile int has_throw;
   /* sometimes transfer is only called to set idle_sp */
   if (expect_false (!next))
     {
       ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
         load_perl (aTHX_ next);
       prev__cctx = prev->cctx;
       /* possibly "free" the cctx */
-      if (expect_true (prev__cctx->idle_sp == STACKLEVEL && !(prev__cctx->flags & CC_TRACE)))
+      if (expect_true (
+            prev__cctx->idle_sp == STACKLEVEL
+            && !(prev__cctx->flags & CC_TRACE)
+            && !force_cctx
+         ))
         {
           /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
           assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te));
           prev->cctx = 0;
       ++next->usecount;
       if (expect_true (!next->cctx))
         next->cctx = cctx_get (aTHX);
+      has_throw = !!next->throw;
       if (expect_false (prev__cctx != next->cctx))
         {
           prev__cctx->top_env = PL_top_env;
           PL_top_env = next->cctx->top_env;
         }
       free_coro_mortal (aTHX);
       UNLOCK;
-      if (expect_false (prev->throw || next->throw))
+      if (expect_false (has_throw))
         {
           struct coro *coro = SvSTATE (coro_current);
           if (coro->throw)
             {
 struct transfer_args
 {
   struct coro *prev, *next;
 };
-#define TRANSFER(ta) transfer (aTHX_ (ta).prev, (ta).next)
+#define TRANSFER(ta, force_cctx) transfer (aTHX_ (ta).prev, (ta).next, (force_cctx))
 #define TRANSFER_CHECK(ta) transfer_check (aTHX_ (ta).prev, (ta).next)
 /** high level stuff ********************************************************/
 static int
 {
   dTHX;
   struct transfer_args ta;
   prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
-  TRANSFER (ta);
+  TRANSFER (ta, 1);
 }
 /** Coro ********************************************************************/
 static void
 {
   av_push (coro_ready [SvSTATE (coro_sv)->prio - PRIO_MIN], coro_sv);
 }
 static SV *
-coro_deq (pTHX_ int min_prio)
+coro_deq (pTHX)
 {
-  int prio = PRIO_MAX - PRIO_MIN;
+  int prio;
-  min_prio -= PRIO_MIN;
-  if (min_prio < 0)
-    min_prio = 0;
-  for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= min_prio; )
+  for (prio = PRIO_MAX - PRIO_MIN + 1; --prio >= 0; )
     if (AvFILLp (coro_ready [prio]) >= 0)
       return av_shift (coro_ready [prio]);
   return 0;
 }
   SV *prev_sv, *next_sv;
   for (;;)
     {
       LOCK;
-      next_sv = coro_deq (aTHX_ PRIO_MIN);
+      next_sv = coro_deq (aTHX);
       /* nothing to schedule: call the idle handler */
       if (expect_false (!next_sv))
         {
           dSP;
           SAVETMPS;
           PUSHMARK (SP);
           PUTBACK;
           call_sv (get_sv ("Coro::idle", FALSE), G_DISCARD);
+          SPAGAIN;
           FREETMPS;
           LEAVE;
           continue;
         }
 {
   dTHX;
   struct transfer_args ta;
   prepare_schedule (aTHX_ &ta);
-  TRANSFER (ta);
+  TRANSFER (ta, 1);
 }
 static int
 api_cede (void)
 {
   prepare_cede (aTHX_ &ta);
   if (expect_true (ta.prev != ta.next))
     {
-      TRANSFER (ta);
+      TRANSFER (ta, 1);
       return 1;
     }
   else
     return 0;
 }
   dTHX;
   struct transfer_args ta;
   if (prepare_cede_notself (aTHX_ &ta))
     {
-      TRANSFER (ta);
+      TRANSFER (ta, 1);
       return 1;
     }
   else
     return 0;
 }
         irsgv    = gv_fetchpv ("/"     , GV_ADD|GV_NOTQUAL, SVt_PV);
         stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);
         orig_sigelem_get = PL_vtbl_sigelem.svt_get;
         PL_vtbl_sigelem.svt_get = coro_sigelem_get;
+        orig_sigelem_set = PL_vtbl_sigelem.svt_set;
+        PL_vtbl_sigelem.svt_set = coro_sigelem_set;
         hv_sig      = coro_get_hv (aTHX_ "SIG", TRUE);
         rv_diehook  = newRV_inc ((SV *)gv_fetchpv ("Coro::State::diehook" , 0, SVt_PVCV));
         rv_warnhook = newRV_inc ((SV *)gv_fetchpv ("Coro::State::warnhook", 0, SVt_PVCV));
         Coro::cede_notself    = 4
         CODE:
 {
 	struct transfer_args ta;
+        PUTBACK;
         switch (ix)
           {
             case 0:
               ta.prev  = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0)));
               ta.next  = 0;
               if (!prepare_cede_notself (aTHX_ &ta))
                 XSRETURN_EMPTY;
               break;
           }
+        SPAGAIN;
         BARRIER;
         PUTBACK;
-        TRANSFER (ta);
+        TRANSFER (ta, 0);
         SPAGAIN; /* might be the sp of a different coroutine now */
         /* be extra careful not to ever do anything after TRANSFER */
 }
 bool
           {
             struct coro temp;
             if (!(coro->flags & CF_RUNNING))
               {
+                PUTBACK;
                 save_perl (aTHX_ &temp);
                 load_perl (aTHX_ coro);
               }
             {
             if (!(coro->flags & CF_RUNNING))
               {
                 save_perl (aTHX_ coro);
                 load_perl (aTHX_ &temp);
+                SPAGAIN;
               }
           }
 }
 SV *
             case 1: RETVAL = coro->usecount;        break;
           }
 	OUTPUT:
         RETVAL
+void
+force_cctx ()
+	CODE:
+        struct coro *coro = SvSTATE (coro_current);
+        coro->cctx->idle_sp = 0;
 MODULE = Coro::State                PACKAGE = Coro
 BOOT:
 {
 	PROTOTYPE: $;$
         CODE:
         SvREFCNT_dec (self->throw);
         self->throw = SvOK (throw) ? newSVsv (throw) : 0;
+void
+swap_defsv (Coro::State self)
+	PROTOTYPE: $
+        ALIAS:
+        swap_defav = 1
+        CODE:
+	if (!self->slot)
+          croak ("cannot swap state with coroutine that has no saved state");
+        else
+          {
+            SV **src = ix ? (SV **)&GvAV (PL_defgv) : &GvSV (PL_defgv);
+            SV **dst = ix ? (SV **)&self->slot->defav : (SV **)&self->slot->defsv;
+            SV *tmp = *src; *src = *dst; *dst = tmp;
+          }
 # for async_pool speedup
 void
 _pool_1 (SV *cb)
 	CODE:
 {
         SV *invoke = hv_delete (hv, "_invoke", sizeof ("_invoke") - 1, 0);
         AV *invoke_av;
 	int i, len;
         if (!invoke)
+          {
+            SvREFCNT_dec (PL_diehook); PL_diehook = 0;
-          croak ("\3async_pool terminate\2\n");
+            croak ("\3async_pool terminate\2\n");
+          }
         SvREFCNT_dec (coro->saved_deffh);
         coro->saved_deffh = SvREFCNT_inc ((SV *)PL_defoutgv);
         hv_store (hv, "desc", sizeof ("desc") - 1,
         SvREFCNT_dec ((SV *)PL_defoutgv); PL_defoutgv = (GV *)coro->saved_deffh;
         coro->saved_deffh = 0;
   	if (coro_rss (aTHX_ coro) > SvIV (sv_pool_rss)
             || av_len (av_async_pool) + 1 >= SvIV (sv_pool_size))
+          {
+            SvREFCNT_dec (PL_diehook); PL_diehook = 0;
-          croak ("\3async_pool terminate\2\n");
+            croak ("\3async_pool terminate\2\n");
+          }
         av_clear (GvAV (PL_defgv));
         hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1,
                   newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0);

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.214 by root, Sat Oct 13 23:19:10 2007 UTC vs. Revision 1.229 by root, Thu Apr 10 07:45:33 2008 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.214 by root, Sat Oct 13 23:19:10 2007 UTC vs.
Revision 1.229 by root, Thu Apr 10 07:45:33 2008 UTC