ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro/State.xs
(Generate patch)

Comparing Coro/Coro/State.xs (file contents):
Revision 1.255 by root, Sat Nov 8 04:52:01 2008 UTC vs.
Revision 1.258 by root, Sun Nov 9 23:08:49 2008 UTC

… …
142#define NOINLINE attribute ((noinline)) 142#define NOINLINE attribute ((noinline))
143 143
144#include "CoroAPI.h" 144#include "CoroAPI.h"
145 145
146#ifdef USE_ITHREADS 146#ifdef USE_ITHREADS
147
147static perl_mutex coro_lock; 148static perl_mutex coro_lock;
148# define LOCK do { MUTEX_LOCK (&coro_lock); } while (0) 149# define LOCK do { MUTEX_LOCK (&coro_lock); } while (0)
149# define UNLOCK do { MUTEX_UNLOCK (&coro_lock); } while (0) 150# define UNLOCK do { MUTEX_UNLOCK (&coro_lock); } while (0)
151# if CORO_PTHREAD
152static void *coro_thx;
153# endif
154
150#else 155#else
156
151# define LOCK (void)0 157# define LOCK (void)0
152# define UNLOCK (void)0 158# define UNLOCK (void)0
159
153#endif 160#endif
161
162# undef LOCK
163# define LOCK (void)0
164# undef UNLOCK
165# define UNLOCK (void)0
154 166
155/* helper storage struct for Coro::AIO */ 167/* helper storage struct for Coro::AIO */
156struct io_state 168struct io_state
157{ 169{
158 AV *res; 170 AV *res;
… …
280#define PRIO_MIN -4 292#define PRIO_MIN -4
281 293
282/* for Coro.pm */ 294/* for Coro.pm */
283static SV *coro_current; 295static SV *coro_current;
284static SV *coro_readyhook; 296static SV *coro_readyhook;
285static AV *coro_ready [PRIO_MAX-PRIO_MIN+1]; 297static AV *coro_ready [PRIO_MAX - PRIO_MIN + 1];
286static int coro_nready; 298static int coro_nready;
287static struct coro *coro_first; 299static struct coro *coro_first;
288 300
289/** lowlevel stuff **********************************************************/ 301/** lowlevel stuff **********************************************************/
290 302
… …
1048 * this is a _very_ stripped down perl interpreter ;) 1060 * this is a _very_ stripped down perl interpreter ;)
1049 */ 1061 */
1050static void 1062static void
1051cctx_run (void *arg) 1063cctx_run (void *arg)
1052{ 1064{
1065#ifdef USE_ITHREADS
1066# if CORO_PTHREAD
1067 PERL_SET_CONTEXT (coro_thx);
1068# endif
1069#endif
1070 {
1053 dTHX; 1071 dTHX;
1054 1072
1055 /* cctx_run is the alternative tail of transfer(), so unlock here. */ 1073 /* cctx_run is the alternative tail of transfer(), so unlock here. */
1056 UNLOCK; 1074 UNLOCK;
1057 1075
1058 /* we now skip the entersub that lead to transfer() */ 1076 /* we now skip the entersub that lead to transfer() */
1059 PL_op = PL_op->op_next; 1077 PL_op = PL_op->op_next;
1060 1078
1061 /* inject a fake subroutine call to cctx_init */ 1079 /* inject a fake subroutine call to cctx_init */
1062 cctx_prepare (aTHX_ (coro_cctx *)arg); 1080 cctx_prepare (aTHX_ (coro_cctx *)arg);
1063 1081
1064 /* somebody or something will hit me for both perl_run and PL_restartop */ 1082 /* somebody or something will hit me for both perl_run and PL_restartop */
1065 PL_restartop = PL_op; 1083 PL_restartop = PL_op;
1066 perl_run (PL_curinterp); 1084 perl_run (PL_curinterp);
1067 1085
1068 /* 1086 /*
1069 * If perl-run returns we assume exit() was being called or the coro 1087 * If perl-run returns we assume exit() was being called or the coro
1070 * fell off the end, which seems to be the only valid (non-bug) 1088 * fell off the end, which seems to be the only valid (non-bug)
1071 * reason for perl_run to return. We try to exit by jumping to the 1089 * reason for perl_run to return. We try to exit by jumping to the
1072 * bootstrap-time "top" top_env, as we cannot restore the "main" 1090 * bootstrap-time "top" top_env, as we cannot restore the "main"
1073 * coroutine as Coro has no such concept 1091 * coroutine as Coro has no such concept
1074 */ 1092 */
1075 PL_top_env = main_top_env; 1093 PL_top_env = main_top_env;
1076 JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */ 1094 JMPENV_JUMP (2); /* I do not feel well about the hardcoded 2 at all */
1095 }
1077} 1096}
1078 1097
1079static coro_cctx * 1098static coro_cctx *
1080cctx_new () 1099cctx_new ()
1081{ 1100{
1082 coro_cctx *cctx; 1101 coro_cctx *cctx;
1102
1103 ++cctx_count;
1104 New (0, cctx, 1, coro_cctx);
1105
1106 cctx->gen = cctx_gen;
1107 cctx->flags = 0;
1108
1109 return cctx;
1110}
1111
1112/* create a new cctx only suitable as source */
1113static coro_cctx *
1114cctx_new_empty ()
1115{
1116 coro_cctx *cctx = cctx_new ();
1117
1118 cctx->sptr = 0;
1119 cctx->idle_sp = 0; /* should never be a valid address */
1120 coro_create (&cctx->cctx, 0, 0, 0, 0);
1121
1122 return cctx;
1123}
1124
1125/* create a new cctx suitable as destination/running a perl interpreter */
1126static coro_cctx *
1127cctx_new_run ()
1128{
1129 coro_cctx *cctx = cctx_new ();
1083 void *stack_start; 1130 void *stack_start;
1084 size_t stack_size; 1131 size_t stack_size;
1085
1086 ++cctx_count;
1087 Newz (0, cctx, 1, coro_cctx);
1088
1089 cctx->gen = cctx_gen;
1090 1132
1091#if HAVE_MMAP 1133#if HAVE_MMAP
1092 cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE; 1134 cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
1093 /* mmap supposedly does allocate-on-write for us */ 1135 /* mmap supposedly does allocate-on-write for us */
1094 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); 1136 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
… …
1167 return cctx; 1209 return cctx;
1168 1210
1169 cctx_destroy (cctx); 1211 cctx_destroy (cctx);
1170 } 1212 }
1171 1213
1172 return cctx_new (); 1214 return cctx_new_run ();
1173} 1215}
1174 1216
1175static void 1217static void
1176cctx_put (coro_cctx *cctx) 1218cctx_put (coro_cctx *cctx)
1177{ 1219{
… …
1233 coro_cctx *prev__cctx; 1275 coro_cctx *prev__cctx;
1234 1276
1235 if (expect_false (prev->flags & CF_NEW)) 1277 if (expect_false (prev->flags & CF_NEW))
1236 { 1278 {
1237 /* create a new empty/source context */ 1279 /* create a new empty/source context */
1238 ++cctx_count; 1280 prev->cctx = cctx_new_empty ();
1239 New (0, prev->cctx, 1, coro_cctx);
1240 prev->cctx->sptr = 0;
1241 coro_create (&prev->cctx->cctx, 0, 0, 0, 0);
1242
1243 prev->flags &= ~CF_NEW; 1281 prev->flags &= ~CF_NEW;
1244 prev->flags |= CF_RUNNING; 1282 prev->flags |= CF_RUNNING;
1245 } 1283 }
1246 1284
1247 prev->flags &= ~CF_RUNNING; 1285 prev->flags &= ~CF_RUNNING;
… …
1635 struct coro *coro = SvSTATE (coro_sv); 1673 struct coro *coro = SvSTATE (coro_sv);
1636 1674
1637 if (flags & CC_TRACE) 1675 if (flags & CC_TRACE)
1638 { 1676 {
1639 if (!coro->cctx) 1677 if (!coro->cctx)
1640 coro->cctx = cctx_new (); 1678 coro->cctx = cctx_new_run ();
1641 else if (!(coro->cctx->flags & CC_TRACE)) 1679 else if (!(coro->cctx->flags & CC_TRACE))
1642 croak ("cannot enable tracing on coroutine with custom stack"); 1680 croak ("cannot enable tracing on coroutine with custom stack");
1643 1681
1644 coro->cctx->flags |= CC_NOREUSE | (flags & (CC_TRACE | CC_TRACE_ALL)); 1682 coro->cctx->flags |= CC_NOREUSE | (flags & (CC_TRACE | CC_TRACE_ALL));
1645 } 1683 }
… …
1754 1792
1755BOOT: 1793BOOT:
1756{ 1794{
1757#ifdef USE_ITHREADS 1795#ifdef USE_ITHREADS
1758 MUTEX_INIT (&coro_lock); 1796 MUTEX_INIT (&coro_lock);
1797# if CORO_PTHREAD
1798 coro_thx = PERL_GET_CONTEXT;
1799# endif
1759#endif 1800#endif
1760 BOOT_PAGESIZE; 1801 BOOT_PAGESIZE;
1761 1802
1762 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV); 1803 irsgv = gv_fetchpv ("/" , GV_ADD|GV_NOTQUAL, SVt_PV);
1763 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO); 1804 stdoutgv = gv_fetchpv ("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO);

Diff Legend

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