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.417 by root, Sun Feb 19 11:14:45 2012 UTC vs.
Revision 1.423 by root, Mon Oct 8 23:13:36 2012 UTC

… …
12#include "perl.h" 12#include "perl.h"
13#include "XSUB.h" 13#include "XSUB.h"
14#include "perliol.h" 14#include "perliol.h"
15 15
16#include "schmorp.h" 16#include "schmorp.h"
17
18#define ECB_NO_THREADS 1
17#include "ecb.h" 19#include "ecb.h"
18 20
19#include <stddef.h> 21#include <stddef.h>
20#include <stdio.h> 22#include <stdio.h>
21#include <errno.h> 23#include <errno.h>
… …
101# if CORO_PTHREAD 103# if CORO_PTHREAD
102static void *coro_thx; 104static void *coro_thx;
103# endif 105# endif
104#endif 106#endif
105 107
106/* used in state.h */
107#define VAR(name,type) VARx(name, PL_ ## name, type)
108
109#ifdef __linux 108#ifdef __linux
110# include <time.h> /* for timespec */ 109# include <time.h> /* for timespec */
111# include <syscall.h> /* for SYS_* */ 110# include <syscall.h> /* for SYS_* */
112# ifdef SYS_clock_gettime 111# ifdef SYS_clock_gettime
113# define coro_clock_gettime(id, ts) syscall (SYS_clock_gettime, (id), (ts)) 112# define coro_clock_gettime(id, ts) syscall (SYS_clock_gettime, (id), (ts))
… …
213}; 212};
214 213
215/* the structure where most of the perl state is stored, overlaid on the cxstack */ 214/* the structure where most of the perl state is stored, overlaid on the cxstack */
216typedef struct 215typedef struct
217{ 216{
218#define VARx(name,expr,type) type name; 217 #define VARx(name,expr,type) type name;
219# include "state.h" 218 #include "state.h"
220#undef VARx
221} perl_slots; 219} perl_slots;
222 220
223/* how many context stack entries do we need for perl_slots */ 221/* how many context stack entries do we need for perl_slots */
224#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT)) 222#define SLOT_COUNT ((sizeof (perl_slots) + sizeof (PERL_CONTEXT) - 1) / sizeof (PERL_CONTEXT))
225 223
… …
710 708
711#if CORO_JIT 709#if CORO_JIT
712 load_perl_slots (slot); 710 load_perl_slots (slot);
713#else 711#else
714 #define VARx(name,expr,type) expr = slot->name; 712 #define VARx(name,expr,type) expr = slot->name;
715 # include "state.h" 713 #include "state.h"
716 #undef VARx
717#endif 714#endif
718 715
719 { 716 {
720 dSP; 717 dSP;
721 718
… …
843 840
844#if CORO_JIT 841#if CORO_JIT
845 save_perl_slots (slot); 842 save_perl_slots (slot);
846#else 843#else
847 #define VARx(name,expr,type) slot->name = expr; 844 #define VARx(name,expr,type) slot->name = expr;
848 # include "state.h" 845 #include "state.h"
849 #undef VARx
850#endif 846#endif
851 } 847 }
852} 848}
853 849
854/* 850/*
… …
1410 1406
1411 slf_frame.prepare = slf_prepare_set_stacklevel; 1407 slf_frame.prepare = slf_prepare_set_stacklevel;
1412 slf_frame.check = slf_check_set_stacklevel; 1408 slf_frame.check = slf_check_set_stacklevel;
1413} 1409}
1414 1410
1411/* the tail of transfer: execute stuff we can only do after a transfer */
1412ecb_inline void
1413transfer_tail (pTHX)
1414{
1415 free_coro_mortal (aTHX);
1416}
1417
1415/* try to exit the same way perl's main function would do */ 1418/* try to exit the same way perl's main function would do */
1416/* we do not bother resetting the environment or other things *7 1419/* we do not bother resetting the environment or other things *7
1417/* that are not, uhm, essential */ 1420/* that are not, uhm, essential */
1418/* this obviously also doesn't work when perl is embedded */ 1421/* this obviously also doesn't work when perl is embedded */
1419static void ecb_noinline ecb_cold 1422static void ecb_noinline ecb_cold
1420perlish_exit (void) 1423perlish_exit (pTHX)
1421{ 1424{
1422 int exitstatus = perl_destruct (PL_curinterp); 1425 int exitstatus = perl_destruct (PL_curinterp);
1423 perl_free (PL_curinterp); 1426 perl_free (PL_curinterp);
1424 exit (exitstatus); 1427 exit (exitstatus);
1425}
1426
1427/* the tail of transfer: execute stuff we can only do after a transfer */
1428ecb_inline void
1429transfer_tail (pTHX)
1430{
1431 free_coro_mortal (aTHX);
1432} 1428}
1433 1429
1434/* 1430/*
1435 * this is a _very_ stripped down perl interpreter ;) 1431 * this is a _very_ stripped down perl interpreter ;)
1436 */ 1432 */
… …
1468 * If perl-run returns we assume exit() was being called or the coro 1464 * If perl-run returns we assume exit() was being called or the coro
1469 * fell off the end, which seems to be the only valid (non-bug) 1465 * fell off the end, which seems to be the only valid (non-bug)
1470 * reason for perl_run to return. We try to mimic whatever perl is normally 1466 * reason for perl_run to return. We try to mimic whatever perl is normally
1471 * doing in that case. YMMV. 1467 * doing in that case. YMMV.
1472 */ 1468 */
1473 perlish_exit (); 1469 perlish_exit (aTHX);
1474 } 1470 }
1475} 1471}
1476 1472
1477static coro_cctx * 1473static coro_cctx *
1478cctx_new (void) 1474cctx_new (void)
… …
1510 size_t stack_size; 1506 size_t stack_size;
1511 1507
1512#if HAVE_MMAP 1508#if HAVE_MMAP
1513 cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE; 1509 cctx->ssize = ((cctx_stacksize * sizeof (long) + PAGESIZE - 1) / PAGESIZE + CORO_STACKGUARD) * PAGESIZE;
1514 /* mmap supposedly does allocate-on-write for us */ 1510 /* mmap supposedly does allocate-on-write for us */
1515 cctx->sptr = mmap (0, cctx->ssize, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_ANONYMOUS, 0, 0); 1511 cctx->sptr = mmap (0, cctx->ssize, PROT_READ | PROT_WRITE | PROT_EXEC, MAP_ANONYMOUS, -1, 0);
1516 1512
1517 if (cctx->sptr != (void *)-1) 1513 if (cctx->sptr != (void *)-1)
1518 { 1514 {
1519 #if CORO_STACKGUARD 1515 #if CORO_STACKGUARD
1520 mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE); 1516 mprotect (cctx->sptr, CORO_STACKGUARD * PAGESIZE, PROT_NONE);
… …
3401 int count; 3397 int count;
3402 3398
3403 eval_pv ("require 'Coro/jit-" CORO_JIT_TYPE ".pl'", 1); 3399 eval_pv ("require 'Coro/jit-" CORO_JIT_TYPE ".pl'", 1);
3404 3400
3405 PUSHMARK (SP); 3401 PUSHMARK (SP);
3406#define VARx(name,expr,type) pushav_4uv (aTHX_ (UV)&(expr), sizeof (expr), offsetof (perl_slots, name), sizeof (type)); 3402 #define VARx(name,expr,type) pushav_4uv (aTHX_ (UV)&(expr), sizeof (expr), offsetof (perl_slots, name), sizeof (type));
3407# include "state.h" 3403 #include "state.h"
3408#undef VARx
3409 count = call_pv ("Coro::State::_jit", G_ARRAY); 3404 count = call_pv ("Coro::State::_jit", G_ARRAY);
3410 SPAGAIN; 3405 SPAGAIN;
3411 3406
3412 save = POPs; save_ptr = SvPVbyte (save, save_len); 3407 save = POPs; save_ptr = SvPVbyte (save, save_len);
3413 load = POPs; load_ptr = SvPVbyte (load, load_len); 3408 load = POPs; load_ptr = SvPVbyte (load, load_len);
… …
3670 RETVAL = boolSV (coro->flags & ix); 3665 RETVAL = boolSV (coro->flags & ix);
3671 OUTPUT: 3666 OUTPUT:
3672 RETVAL 3667 RETVAL
3673 3668
3674void 3669void
3675throw (Coro::State self, SV *exception = &PL_sv_undef) 3670throw (SV *self, SV *exception = &PL_sv_undef)
3676 PROTOTYPE: $;$ 3671 PROTOTYPE: $;$
3677 CODE: 3672 CODE:
3678{ 3673{
3674 struct coro *coro = SvSTATE (self);
3679 struct coro *current = SvSTATE_current; 3675 struct coro *current = SvSTATE_current;
3680 SV **exceptionp = self == current ? &CORO_THROW : &self->except; 3676 SV **exceptionp = coro == current ? &CORO_THROW : &coro->except;
3681 SvREFCNT_dec (*exceptionp); 3677 SvREFCNT_dec (*exceptionp);
3682 SvGETMAGIC (exception); 3678 SvGETMAGIC (exception);
3683 *exceptionp = SvOK (exception) ? newSVsv (exception) : 0; 3679 *exceptionp = SvOK (exception) ? newSVsv (exception) : 0;
3680
3681 api_ready (aTHX_ self);
3684} 3682}
3685 3683
3686void 3684void
3687api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB) 3685api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)
3688 PROTOTYPE: $;$ 3686 PROTOTYPE: $;$

Diff Legend

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