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

Comparing Coro/Coro/State.xs (file contents):
Revision 1.413 by root, Fri Jun 17 18:55:08 2011 UTC vs.
Revision 1.419 by root, Mon Feb 20 08:13:25 2012 UTC

 #endif
 /* the maximum number of idle cctx that will be pooled */
 static int cctx_max_idle = 4;
+#if defined(DEBUGGING) && PERL_VERSION_ATLEAST(5,12,0)
+# define HAS_SCOPESTACK_NAME 1
+#endif
 #if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
 # undef CORO_STACKGUARD
 #endif
 #ifndef CORO_STACKGUARD
 # if CORO_PTHREAD
 static void *coro_thx;
 # endif
 #endif
-/* used in state.h */
-#define VAR(name,type) VARx(name, PL_ ## name, type)
 #ifdef __linux
 # include <time.h> /* for timespec */
 # include <syscall.h> /* for SYS_* */
 # ifdef SYS_clock_gettime
 #  define coro_clock_gettime(id, ts) syscall (SYS_clock_gettime, (id), (ts))
   void *sptr;
   size_t ssize;
   /* cpu state */
   void *idle_sp;   /* sp of top-level transfer/schedule/cede call */
+#ifndef NDEBUG
-  JMPENV *idle_te; /* same as idle_sp, but for top_env, TODO: remove once stable */
+  JMPENV *idle_te; /* same as idle_sp, but for top_env */
+#endif
   JMPENV *top_env;
   coro_context cctx;
   U32 gen;
 #if CORO_USE_VALGRIND
 };
 /* the structure where most of the perl state is stored, overlaid on the cxstack */
 typedef struct
 {
-#define VARx(name,expr,type) type name;
+  #define VARx(name,expr,type) type name;
-# include "state.h"
+  #include "state.h"
-#undef VARx
 } perl_slots;
 /* how many context stack entries do we need for perl_slots */
 #define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))
   AvARRAY (av)[++AvFILLp (av)] = (SV *)CvPADLIST (cv);
 }
 /** load & save, init *******************************************************/
+ecb_inline void
+swap_sv (SV *a, SV *b)
+{
+  const U32 keep = SVs_PADSTALE | SVs_PADTMP | SVs_PADMY; /* keep these flags */
+  SV tmp;
+  /* swap sv_any */
+  SvANY (&tmp) = SvANY (a); SvANY (a) = SvANY (b); SvANY (b) = SvANY (&tmp);
+  /* swap sv_flags */
+  SvFLAGS (&tmp) = SvFLAGS (a);
+  SvFLAGS (a)    = (SvFLAGS (a) & keep) | (SvFLAGS (b   ) & ~keep);
+  SvFLAGS (b)    = (SvFLAGS (b) & keep) | (SvFLAGS (&tmp) & ~keep);
+#if PERL_VERSION_ATLEAST (5,10,0)
+  /* perl 5.10 and later complicates this _quite_ a bit, but it also
+   * is much faster, so no quarrels here. alternatively, we could
+   * sv_upgrade to avoid this.
+   */
+  {
+    /* swap sv_u */
+    tmp.sv_u = a->sv_u; a->sv_u = b->sv_u; b->sv_u = tmp.sv_u;
+    /* if SvANY points to the head, we need to adjust the pointers,
+     * as the pointer for a still points to b, and maybe vice versa.
+     */
+    #define svany_in_head(type) \
+       (((1 << SVt_NULL) | (1 << SVt_BIND) | (1 << SVt_IV) | (1 << SVt_RV)) & (1 << (type)))
+    if (svany_in_head (SvTYPE (a)))
+      SvANY (a) = (void *)((PTRV)SvANY (a) - (PTRV)b + (PTRV)a);
+    if (svany_in_head (SvTYPE (b)))
+      SvANY (b) = (void *)((PTRV)SvANY (b) - (PTRV)a + (PTRV)b);
+  }
+#endif
+}
 /* swap sv heads, at least logically */
 static void
 swap_svs (pTHX_ Coro__State c)
 {
   int i;
-  for (i = 0; i <= AvFILLp (c->swap_sv); )
+  for (i = 0; i <= AvFILLp (c->swap_sv); i += 2)
-    {
+    swap_sv (AvARRAY (c->swap_sv)[i], AvARRAY (c->swap_sv)[i + 1]);
-      SV *a = AvARRAY (c->swap_sv)[i++];
-      SV *b = AvARRAY (c->swap_sv)[i++];
-      const U32 keep = SVs_PADSTALE | SVs_PADTMP | SVs_PADMY; /* keep these flags */
-      SV tmp;
-      /* swap sv_any */
-      SvANY (&tmp) = SvANY (a); SvANY (a) = SvANY (b); SvANY (b) = SvANY (&tmp);
-      /* swap sv_flags */
-      SvFLAGS (&tmp) = SvFLAGS (a);
-      SvFLAGS (a)    = (SvFLAGS (a) & keep) | (SvFLAGS (b   ) & ~keep);
-      SvFLAGS (b)    = (SvFLAGS (b) & keep) | (SvFLAGS (&tmp) & ~keep);
-#if PERL_VERSION_ATLEAST (5,10,0)
-      /* perl 5.10 complicates this _quite_ a bit, but it also is
-       * much faster, so no quarrels here. alternatively, we could
-       * sv_upgrade to avoid this.
-       */
-      {
-        /* swap sv_u */
-        tmp.sv_u = a->sv_u; a->sv_u = b->sv_u; b->sv_u = tmp.sv_u;
-        /* if SvANY points to the head, we need to adjust the pointers,
-         * as the pointer for a still points to b, and maybe vice versa.
-         */
-        #define svany_in_head(type) \
-           (((1 << SVt_NULL) | (1 << SVt_BIND) | (1 << SVt_IV) | (1 << SVt_RV)) & (1 << (type)))
-        if (svany_in_head (SvTYPE (a)))
-          SvANY (a) = (void *)((PTRV)SvANY (a) - (PTRV)b + (PTRV)a);
-        if (svany_in_head (SvTYPE (b)))
-          SvANY (b) = (void *)((PTRV)SvANY (b) - (PTRV)a + (PTRV)b);
-      }
-#endif
-    }
 }
 #define SWAP_SVS(coro)				\
   if (ecb_expect_false ((coro)->swap_sv))	\
     swap_svs (aTHX_ (coro))
 #if CORO_JIT
   load_perl_slots (slot);
 #else
   #define VARx(name,expr,type) expr = slot->name;
-  # include "state.h"
+  #include "state.h"
-  #undef VARx
 #endif
   {
     dSP;
 #if CORO_JIT
     save_perl_slots (slot);
 #else
     #define VARx(name,expr,type) slot->name = expr;
-    # include "state.h"
+    #include "state.h"
-    #undef VARx
 #endif
   }
 }
 /*
 #endif
     New(54,PL_scopestack,8,I32);
     PL_scopestack_ix = 0;
     PL_scopestack_max = 8;
+#if HAS_SCOPESTACK_NAME
+    New(54,PL_scopestack_name,8,const char*);
+#endif
     New(54,PL_savestack,24,ANY);
     PL_savestack_ix = 0;
     PL_savestack_max = 24;
   }
   Safefree (PL_tmps_stack);
   Safefree (PL_markstack);
   Safefree (PL_scopestack);
+#if HAS_SCOPESTACK_NAME
+  Safefree (PL_scopestack_name);
+#endif
   Safefree (PL_savestack);
 #if !PERL_VERSION_ATLEAST (5,10,0)
   Safefree (PL_retstack);
 #endif
 }
       if (strEQ (s, "__DIE__" )) svp = &PL_diehook;
       if (strEQ (s, "__WARN__")) svp = &PL_warnhook;
       if (svp)
         {
-          sv_setsv (sv, *svp ? *svp : &PL_sv_undef);
+          SV *ssv;
+          if (!*svp)
+            ssv = &PL_sv_undef;
+          else if (SvTYPE (*svp) == SVt_PVCV) /* perlio directly stores a CV in warnhook. ugh. */
+            ssv = sv_2mortal (newRV_inc (*svp));
+          else
+            ssv = *svp;
+          sv_setsv (sv, ssv);
           return 0;
         }
     }
   return orig_sigelem_get ? orig_sigelem_get (aTHX_ sv, mg) : 0;
 transfer_tail (pTHX)
 {
   free_coro_mortal (aTHX);
 }
+/* try to exit the same way perl's main function would do */
+/* we do not bother resetting the environment or other things *7
+/* that are not, uhm, essential */
+/* this obviously also doesn't work when perl is embedded */
+static void ecb_noinline ecb_cold
+perlish_exit (void)
+{
+  int exitstatus = perl_destruct (PL_curinterp);
+  perl_free (PL_curinterp);
+  exit (exitstatus);
+}
 /*
  * this is a _very_ stripped down perl interpreter ;)
  */
 static void
 cctx_run (void *arg)
      */
     /*
      * 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
+     * reason for perl_run to return. We try to mimic whatever perl is normally
-     * bootstrap-time "top" top_env, as we cannot restore the "main"
+     * doing in that case. YMMV.
-     * 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;
+    perlish_exit ();
-    JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
   }
 }
 static coro_cctx *
 cctx_new (void)
   int count;
   eval_pv ("require 'Coro/jit-" CORO_JIT_TYPE ".pl'", 1);
   PUSHMARK (SP);
-#define VARx(name,expr,type) pushav_4uv (aTHX_ (UV)&(expr), sizeof (expr), offsetof (perl_slots, name), sizeof (type));
+  #define VARx(name,expr,type) pushav_4uv (aTHX_ (UV)&(expr), sizeof (expr), offsetof (perl_slots, name), sizeof (type));
-# include "state.h"
+  #include "state.h"
-#undef VARx
   count = call_pv ("Coro::State::_jit", G_ARRAY);
   SPAGAIN;
   save = POPs; save_ptr = SvPVbyte (save, save_len);
   load = POPs; load_ptr = SvPVbyte (load, load_len);

Diff Legend

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

Comparing Coro/Coro/State.xs (file contents): Revision 1.413 by root, Fri Jun 17 18:55:08 2011 UTC vs. Revision 1.419 by root, Mon Feb 20 08:13:25 2012 UTC

Diff Legend

Comparing Coro/Coro/State.xs (file contents):
Revision 1.413 by root, Fri Jun 17 18:55:08 2011 UTC vs.
Revision 1.419 by root, Mon Feb 20 08:13:25 2012 UTC