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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.300 by root, Wed Nov 19 02:07:48 2008 UTC vs.
Revision 1.305 by root, Wed Nov 19 10:44:41 2008 UTC

 #ifdef WIN32
 # undef setjmp
 # undef longjmp
 # undef _exit
-# define setjmp _setjmp // deep magic, don't ask
+# define setjmp _setjmp /* deep magic */
 #else
 # include <inttypes.h> /* most portable stdint.h */
 #endif
 #ifdef HAVE_MMAP
   int usecount; /* number of transfers to this coro */
   /* coro process data */
   int prio;
   SV *except; /* exception to be thrown */
+  SV *rouse_cb;
   /* async_pool */
   SV *saved_deffh;
   /* linked list */
   else
    {
 #if CORO_PREFER_PERL_FUNCTIONS
      /* this is probably cleaner? but also slower! */
      /* in practise, it seems to be less stable */
-     CV *cp = Perl_cv_clone (cv);
+     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);
  * of perl.c:init_stacks, except that it uses less memory
  * on the (sometimes correct) assumption that coroutines do
  * not usually need a lot of stackspace.
  */
 #if CORO_PREFER_PERL_FUNCTIONS
-# define coro_init_stacks init_stacks
+# define coro_init_stacks(thx) init_stacks ()
 #else
 static void
 coro_init_stacks (pTHX)
 {
     PL_curstackinfo = new_stackinfo(32, 8);
   SvREFCNT_dec (GvSV (irsgv));
   SvREFCNT_dec (PL_diehook);
   SvREFCNT_dec (PL_warnhook);
+  SvREFCNT_dec (CORO_THROW);
   SvREFCNT_dec (coro->saved_deffh);
-  SvREFCNT_dec (CORO_THROW);
+  SvREFCNT_dec (coro->rouse_cb);
   coro_destruct_stacks (aTHX);
 }
 INLINE void
   prepare_transfer (aTHX_ &ta, prev_sv, next_sv);
   TRANSFER (ta, 1);
 }
+/*****************************************************************************/
+/* gensub: simple closure generation utility */
+#define GENSUB_ARG CvXSUBANY (cv).any_ptr
+/* create a closure from XS, returns a code reference */
+/* the arg can be accessed via GENSUB_ARG from the callback */
+/* the callback must use dXSARGS/XSRETURN */
+static SV *
+gensub (pTHX_ void (*xsub)(pTHX_ CV *), void *arg)
+{
+  CV *cv = (CV *)newSV (0);
+  sv_upgrade ((SV *)cv, SVt_PVCV);
+  CvANON_on (cv);
+  CvISXSUB_on (cv);
+  CvXSUB (cv) = xsub;
+  GENSUB_ARG = arg;
+  return newRV_noinc ((SV *)cv);
+}
 /** Coro ********************************************************************/
 INLINE void
 coro_enq (pTHX_ struct coro *coro)
 {
       if (coro->flags & CF_RUNNING)
         PL_runops = RUNOPS_DEFAULT;
       else
         coro->slot->runops = RUNOPS_DEFAULT;
     }
+}
+/*****************************************************************************/
+/* rouse callback */
+#define CORO_MAGIC_type_rouse PERL_MAGIC_ext
+static void
+coro_rouse_callback (pTHX_ CV *cv)
+{
+  dXSARGS;
+  SV *data = (SV *)GENSUB_ARG;
+  if (SvTYPE (SvRV (data)) != SVt_PVAV)
+    {
+      /* first call, set args */
+      int i;
+      AV *av = newAV ();
+      SV *coro = SvRV (data);
+      SvRV_set (data, (SV *)av);
+      api_ready (aTHX_ coro);
+      SvREFCNT_dec (coro);
+      /* better take a full copy of the arguments */
+      while (items--)
+        av_store (av, items, newSVsv (ST (items)));
+    }
+  XSRETURN_EMPTY;
+}
+static int
+slf_check_rouse_wait (pTHX_ struct CoroSLF *frame)
+{
+  SV *data = (SV *)frame->data;
+  if (CORO_THROW)
+    return 0;
+  if (SvTYPE (SvRV (data)) != SVt_PVAV)
+    return 1;
+  /* now push all results on the stack */
+  {
+    dSP;
+    AV *av = (AV *)SvRV (data);
+    int i;
+    EXTEND (SP, AvFILLp (av) + 1);
+    for (i = 0; i <= AvFILLp (av); ++i)
+      PUSHs (sv_2mortal (AvARRAY (av)[i]));
+    /* we have stolen the elements, so ste length to zero and free */
+    AvFILLp (av) = -1;
+    av_undef (av);
+    PUTBACK;
+  }
+  return 0;
+}
+static void
+slf_init_rouse_wait (pTHX_ struct CoroSLF *frame, CV *cv, SV **arg, int items)
+{
+  SV *cb;
+  if (items)
+    cb = arg [0];
+  else
+    {
+      struct coro *coro = SvSTATE_current;
+      if (!coro->rouse_cb)
+        croak ("Coro::rouse_wait called without rouse callback, and no default rouse callback found either,");
+      cb = sv_2mortal (coro->rouse_cb);
+      coro->rouse_cb = 0;
+    }
+  if (!SvROK (cb)
+      || SvTYPE (SvRV (cb)) != SVt_PVCV
+      || CvXSUB ((CV *)SvRV (cb)) != coro_rouse_callback)
+    croak ("Coro::rouse_wait called with illegal callback argument,");
+  {
+    CV *cv = (CV *)SvRV (cb); /* for GENSUB_ARG */
+    SV *data = (SV *)GENSUB_ARG;
+    frame->data    = (void *)data;
+    frame->prepare = SvTYPE (SvRV (data)) == SVt_PVAV ? prepare_nop : prepare_schedule;
+    frame->check   = slf_check_rouse_wait;
+  }
+}
+static SV *
+coro_new_rouse_cb (pTHX)
+{
+  HV *hv = (HV *)SvRV (coro_current);
+  struct coro *coro = SvSTATE_hv (hv);
+  SV *data = newRV_inc ((SV *)hv);
+  SV *cb = gensub (aTHX_ coro_rouse_callback, (void *)data);
+  sv_magicext (SvRV (cb), data, CORO_MAGIC_type_rouse, 0, 0, 0);
+  SvREFCNT_dec (data); /* magicext increases the refcount */
+  SvREFCNT_dec (coro->rouse_cb);
+  coro->rouse_cb = SvREFCNT_inc_NN (cb);
+  return cb;
 }
 /*****************************************************************************/
 /* schedule-like-function opcode (SLF) */
   SV **ary;
   /* unfortunately, building manually saves memory */
   Newx (ary, 2, SV *);
   AvALLOC (av) = ary;
-  AvARRAY (av) = ary;
+  /*AvARRAY (av) = ary;*/
+  SvPVX ((SV *)av) = (char *)ary; /* 5.8.8 needs this syntax instead of AvARRAY = ary */
   AvMAX   (av) = 1;
   AvFILLp (av) = 0;
   ary [0] = newSViv (count);
   return newRV_noinc ((SV *)av);
       AvARRAY (av)[0] = AvARRAY (av)[1];
       AvARRAY (av)[1] = cb;
       cb = av_shift (av);
-      api_ready (cb);
+      api_ready (aTHX_ cb);
       sv_setiv (cb, 0); /* signal waiter */
       SvREFCNT_dec (cb);
       --count;
     }
       frame->data    = (void *)sv_2mortal (SvREFCNT_inc_NN (waiter)); /* owned by process */
       frame->prepare = prepare_schedule;
       frame->check   = slf_check_signal_wait;
     }
-}
-/*****************************************************************************/
-/* gensub: simple closure generation utility */
-#define GENSUB_ARG CvXSUBANY (cv).any_ptr
-/* create a closure from XS, returns a code reference */
-/* the arg can be accessed via GENSUB_ARG from the callback */
-/* the callback must use dXSARGS/XSRETURN */
-static SV *
-gensub (pTHX_ void (*xsub)(pTHX_ CV *), void *arg)
-{
-  CV *cv = (CV *)newSV (0);
-  sv_upgrade ((SV *)cv, SVt_PVCV);
-  CvANON_on (cv);
-  CvISXSUB_on (cv);
-  CvXSUB (cv) = xsub;
-  GENSUB_ARG = arg;
-  return newRV_noinc ((SV *)cv);
 }
 /*****************************************************************************/
 /* Coro::AIO */
           api_trace (aTHX_ coro_current, 0);
         av_push (av_async_pool, newSVsv (coro_current));
 }
+SV *
+rouse_cb ()
+        PROTOTYPE:
+	CODE:
+        RETVAL = coro_new_rouse_cb (aTHX);
+	OUTPUT:
+        RETVAL
+void
+rouse_wait (SV *cb = 0)
+        PROTOTYPE: ;$
+	PPCODE:
+        CORO_EXECUTE_SLF_XS (slf_init_rouse_wait);
 MODULE = Coro::State                PACKAGE = PerlIO::cede
 BOOT:
 	PerlIO_define_layer (aTHX_ &PerlIO_cede);
         CODE:
 {
 	AV *av = (AV *)SvRV (self);
         if (AvFILLp (av))
-          coro_signal_wake (av, 1);
+          coro_signal_wake (aTHX_ av, 1);
         else
           SvIVX (AvARRAY (av)[0]) = 1; /* remember the signal */
 }
 IV

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.300 by root, Wed Nov 19 02:07:48 2008 UTC vs. Revision 1.305 by root, Wed Nov 19 10:44:41 2008 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.300 by root, Wed Nov 19 02:07:48 2008 UTC vs.
Revision 1.305 by root, Wed Nov 19 10:44:41 2008 UTC