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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.323 by root, Sat Nov 22 06:03:10 2008 UTC vs.
Revision 1.330 by root, Wed Nov 26 09:29:06 2008 UTC

 static HV *coro_state_stash, *coro_stash;
 static volatile SV *coro_mortal; /* will be freed/thrown after next transfer */
 static AV *av_destroy; /* destruction queue */
 static SV *sv_manager; /* the manager coro */
+static SV *sv_idle; /* $Coro::idle */
 static GV *irsgv;    /* $/ */
 static GV *stdoutgv; /* *STDOUT */
 static SV *rv_diehook;
 static SV *rv_warnhook;
 {
   SV *defsv;
   AV *defav;
   SV *errsv;
   SV *irsgv;
+  HV *hinthv;
 #define VAR(name,type) type name;
 # include "state.h"
 #undef VAR
 } perl_slots;
   if (SvREFCNT (padlist))
     {
       I32 i = AvFILLp (padlist);
       while (i >= 0)
         {
-          SV **svp = av_fetch (padlist, i--, FALSE);
+          SV **svp = AvARRAY (padlist)[i--];
           if (svp)
             {
-              SV *sv;
+              AvREAL_on (*svp);
-              while (&PL_sv_undef != (sv = av_pop ((AV *)*svp)))
-                SvREFCNT_dec (sv);
+              av_undef (*svp);
               SvREFCNT_dec (*svp);
             }
         }
       SvREFCNT_dec ((SV*)padlist);
     mg = sv_magicext ((SV *)cv, (SV *)newAV (), CORO_MAGIC_type_cv, &coro_cv_vtbl, 0, 0);
   av = (AV *)mg->mg_obj;
   if (expect_false (AvFILLp (av) >= AvMAX (av)))
-    av_extend (av, AvMAX (av) + 1);
+    av_extend (av, AvFILLp (av) + 1);
   AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
 }
 /** load & save, init *******************************************************/
   perl_slots *slot = c->slot;
   c->slot = 0;
   PL_mainstack = c->mainstack;
-  GvSV (PL_defgv) = slot->defsv;
+  GvSV (PL_defgv)  = slot->defsv;
-  GvAV (PL_defgv) = slot->defav;
+  GvAV (PL_defgv)  = slot->defav;
-  GvSV (PL_errgv) = slot->errsv;
+  GvSV (PL_errgv)  = slot->errsv;
-  GvSV (irsgv)    = slot->irsgv;
+  GvSV (irsgv)     = slot->irsgv;
+  GvHV (PL_hintgv) = slot->hinthv;
   #define VAR(name,type) PL_ ## name = slot->name;
   # include "state.h"
   #undef VAR
   c->mainstack = PL_mainstack;
   {
     perl_slots *slot = c->slot = (perl_slots *)(cxstack + cxstack_ix + 1);
-    slot->defav = GvAV (PL_defgv);
+    slot->defav  = GvAV (PL_defgv);
-    slot->defsv = DEFSV;
+    slot->defsv  = DEFSV;
-    slot->errsv = ERRSV;
+    slot->errsv  = ERRSV;
-    slot->irsgv = GvSV (irsgv);
+    slot->irsgv  = GvSV (irsgv);
+    slot->hinthv = GvHV (PL_hintgv);
     #define VAR(name,type) slot->name = PL_ ## name;
     # include "state.h"
     #undef VAR
   }
   PL_runops     = RUNOPS_DEFAULT;
   PL_curcop     = &PL_compiling;
   PL_in_eval    = EVAL_NULL;
   PL_comppad    = 0;
+  PL_comppad_name       = 0;
+  PL_comppad_name_fill  = 0;
+  PL_comppad_name_floor = 0;
   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
+  PL_hints      = 0;
   /* recreate the die/warn hooks */
   PL_diehook  = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__DIE__" , sizeof ("__DIE__" ) - 1, 1), rv_diehook );
   PL_warnhook = 0; SvSetMagicSV (*hv_fetch (hv_sig, "__WARN__", sizeof ("__WARN__") - 1, 1), 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);
+  GvHV (PL_hintgv)   = 0;
   PL_rs              = newSVsv (GvSV (irsgv));
   PL_defoutgv        = (GV *)SvREFCNT_inc_NN (stdoutgv);
   {
     dSP;
   SvREFCNT_dec (GvAV (PL_defgv));
   SvREFCNT_dec (GvSV (PL_errgv));
   SvREFCNT_dec (PL_defoutgv);
   SvREFCNT_dec (PL_rs);
   SvREFCNT_dec (GvSV (irsgv));
+  SvREFCNT_dec (GvHV (PL_hintgv));
   SvREFCNT_dec (PL_diehook);
   SvREFCNT_dec (PL_warnhook);
   SvREFCNT_dec (coro->saved_deffh);
     /*
      * If perl-run returns we assume exit() was being called or the coro
      * fell off the end, which seems to be the only valid (non-bug)
      * reason for perl_run to return. We try to exit by jumping to the
      * bootstrap-time "top" top_env, as we cannot restore the "main"
-     * coroutine as Coro has no such concept
+     * coroutine as Coro has no such concept.
+     * This actually isn't valid with the pthread backend, but OSes requiring
+     * that backend are too broken to do it in a standards-compliant way.
      */
     PL_top_env = main_top_env;
     JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
   }
 }
   /* TODO: throwing up here is considered harmful */
   if (expect_true (prev != next))
     {
       if (expect_false (!(prev->flags & (CF_RUNNING | CF_NEW))))
-        croak ("Coro::State::transfer called with non-running/new prev Coro::State, but can only transfer from running or new states,");
+        croak ("Coro::State::transfer called with a suspended prev Coro::State, but can only transfer from running or new states,");
       if (expect_false (next->flags & CF_RUNNING))
         croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states,");
       if (expect_false (next->flags & CF_DESTROYED))
           coro_setup (aTHX_ next);
         }
       else
         load_perl (aTHX_ next);
+      assert (!prev->cctx);//D temporary
       /* possibly untie and reuse the cctx */
       if (expect_true (
             cctx_current->idle_sp == STACKLEVEL
             && !(cctx_current->flags & CC_TRACE)
             && !force_cctx
          ))
         {
           /* I assume that stacklevel is a stronger indicator than PL_top_env changes */
           assert (("FATAL: current top_env must equal previous top_env in Coro (please report)", PL_top_env == cctx_current->idle_te));
-          /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get */
+          /* if the cctx is about to be destroyed we need to make sure we won't see it in cctx_get. */
-          /* without this the next cctx_get might destroy the prev__cctx while still in use */
+          /* without this the next cctx_get might destroy the running cctx while still in use */
           if (expect_false (CCTX_EXPIRED (cctx_current)))
-            if (!next->cctx)
+            if (expect_true (!next->cctx))
               next->cctx = cctx_get (aTHX);
           cctx_put (cctx_current);
-          assert (!prev->cctx);//D temporary
         }
       else
         prev->cctx = cctx_current;
       ++next->usecount;
 {
   struct coro *coro;
   SV *sv_hook;
   void (*xs_hook)(void);
-  if (SvROK (coro_sv))
-    coro_sv = SvRV (coro_sv);
   coro = SvSTATE (coro_sv);
   if (coro->flags & CF_READY)
     return 0;
             }
         }
       else
         {
           /* nothing to schedule: call the idle handler */
+          if (SvROK (sv_idle)
+              && SvOBJECT (SvRV (sv_idle)))
+            {
+              ++coro_nready; /* hack so that api_ready doesn't invoke ready hook */
+              api_ready (aTHX_ SvRV (sv_idle));
+              --coro_nready;
+            }
+          else
+            {
-          dSP;
+              dSP;
-          ENTER;
+              ENTER;
-          SAVETMPS;
+              SAVETMPS;
-          PUSHMARK (SP);
+              PUSHMARK (SP);
-          PUTBACK;
+              PUTBACK;
-          call_sv (get_sv ("Coro::idle", FALSE), G_VOID | G_DISCARD);
+              call_sv (sv_idle, G_VOID | G_DISCARD);
-          FREETMPS;
+              FREETMPS;
-          LEAVE;
+              LEAVE;
+            }
         }
     }
 }
 INLINE void
 static void
 api_trace (pTHX_ SV *coro_sv, int flags)
 {
   struct coro *coro = SvSTATE (coro_sv);
+  if (coro->flags & CF_RUNNING)
+    croak ("cannot enable tracing on a running coroutine, caught");
   if (flags & CC_TRACE)
     {
       if (!coro->cctx)
         coro->cctx = cctx_new_run ();
       else if (!(coro->cctx->flags & CC_TRACE))
-        croak ("cannot enable tracing on coroutine with custom stack,");
+        croak ("cannot enable tracing on coroutine with custom stack, caught");
       coro->cctx->flags |= CC_NOREUSE | (flags & (CC_TRACE | CC_TRACE_ALL));
     }
   else if (coro->cctx && coro->cctx->flags & CC_TRACE)
     {
   SV **ary;
   /* unfortunately, building manually saves memory */
   Newx (ary, 2, SV *);
   AvALLOC (av) = ary;
+#if PERL_VERSION_ATLEAST (5,10,0)
-  /*AvARRAY (av) = ary;*/
+  AvARRAY (av) = ary;
+#else
-  SvPVX ((SV *)av) = (char *)ary; /* 5.8.8 needs this syntax instead of AvARRAY = ary */
+  /* 5.8.8 needs this syntax instead of AvARRAY = ary, yet */
+  /* -DDEBUGGING flags this as a bug, despite it perfectly working */
+  SvPVX ((SV *)av) = (char *)ary;
+#endif
   AvMAX   (av) = 1;
   AvFILLp (av) = 0;
   ary [0] = newSViv (count);
   return newRV_noinc ((SV *)av);
         cv_coro_terminate  =      get_cv (      "Coro::terminate" , GV_ADD);
         coro_current       = coro_get_sv (aTHX_ "Coro::current"   , FALSE); SvREADONLY_on (coro_current);
         av_async_pool      = coro_get_av (aTHX_ "Coro::async_pool", TRUE);
         av_destroy         = coro_get_av (aTHX_ "Coro::destroy"   , TRUE);
         sv_manager         = coro_get_sv (aTHX_ "Coro::manager"   , TRUE);
+        sv_idle            = coro_get_sv (aTHX_ "Coro::idle"      , TRUE);
         sv_async_pool_idle = newSVpv ("[async pool idle]", 0); SvREADONLY_on (sv_async_pool_idle);
         sv_Coro            = newSVpv ("Coro", 0); SvREADONLY_on (sv_Coro);
         cv_pool_handler    = get_cv ("Coro::pool_handler", GV_ADD); SvREADONLY_on (cv_pool_handler);
         cv_coro_state_new  = get_cv ("Coro::State::new", 0); SvREADONLY_on (cv_coro_state_new);

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.323 by root, Sat Nov 22 06:03:10 2008 UTC vs. Revision 1.330 by root, Wed Nov 26 09:29:06 2008 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.323 by root, Sat Nov 22 06:03:10 2008 UTC vs.
Revision 1.330 by root, Wed Nov 26 09:29:06 2008 UTC