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.171 by root, Sat Sep 29 19:42:10 2007 UTC vs.
Revision 1.174 by root, Sun Sep 30 13:43:18 2007 UTC

… …
199 199
200#define VAR(name,type) type name; 200#define VAR(name,type) type name;
201# include "state.h" 201# include "state.h"
202#undef VAR 202#undef VAR
203 203
204 /* statistics */
205 int usecount; /* number of switches to this coro */
206
204 /* coro process data */ 207 /* coro process data */
205 int prio; 208 int prio;
206 209
207 /* linked list */ 210 /* linked list */
208 struct coro *next, *prev; 211 struct coro *next, *prev;
… …
307 HV *stash; 310 HV *stash;
308 MAGIC *mg; 311 MAGIC *mg;
309 312
310 if (SvROK (coro)) 313 if (SvROK (coro))
311 coro = SvRV (coro); 314 coro = SvRV (coro);
315
316 if (SvTYPE (coro) != SVt_PVHV)
317 croak ("Coro::State object required");
312 318
313 stash = SvSTASH (coro); 319 stash = SvSTASH (coro);
314 if (stash != coro_stash && stash != coro_state_stash) 320 if (stash != coro_stash && stash != coro_state_stash)
315 { 321 {
316 /* very slow, but rare, check */ 322 /* very slow, but rare, check */
… …
669 675
670 while ((PL_op = CALL_FPTR (PL_op->op_ppaddr) (aTHX))) 676 while ((PL_op = CALL_FPTR (PL_op->op_ppaddr) (aTHX)))
671 { 677 {
672 PERL_ASYNC_CHECK (); 678 PERL_ASYNC_CHECK ();
673 679
674 if (PL_op->op_type == OP_LEAVESUB && cctx->flags & CC_TRACE_SUB) 680 if (cctx->flags & CC_TRACE_ALL)
675 { 681 {
676 PERL_CONTEXT *cx = &cxstack[cxstack_ix]; 682 if (PL_op->op_type == OP_LEAVESUB && cctx->flags & CC_TRACE_SUB)
677 SV **bot, **top;
678 AV *av = newAV (); /* return values */
679 SV **cb;
680 runops_proc_t old_runops = PL_runops;
681 dSP;
682 ENTER;
683 SAVETMPS;
684 EXTEND (SP, 3);
685 PL_runops = RUNOPS_DEFAULT;
686
687 GV *gv = CvGV (cx->blk_sub.cv);
688 SV *fullname = sv_2mortal (newSV (0));
689 if (isGV (gv))
690 gv_efullname3 (fullname, gv, 0);
691
692 bot = PL_stack_base + cx->blk_oldsp + 1;
693 top = cx->blk_gimme == G_ARRAY ? SP + 1
694 : cx->blk_gimme == G_SCALAR ? bot + 1
695 : bot;
696
697 while (bot < top)
698 av_push (av, SvREFCNT_inc (*bot++));
699
700 PUSHMARK (SP);
701 PUSHs (&PL_sv_no);
702 PUSHs (fullname);
703 PUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
704 PUTBACK;
705 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
706 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
707 SPAGAIN;
708
709 FREETMPS;
710 LEAVE;
711 PL_runops = old_runops;
712 }
713
714 if (oldcop != PL_curcop)
715 {
716 oldcop = PL_curcop;
717
718 if (PL_curcop != &PL_compiling)
719 { 683 {
684 PERL_CONTEXT *cx = &cxstack[cxstack_ix];
685 SV **bot, **top;
686 AV *av = newAV (); /* return values */
720 SV **cb; 687 SV **cb;
721 runops_proc_t old_runops = PL_runops;
722 dSP; 688 dSP;
689
690 GV *gv = CvGV (cx->blk_sub.cv);
691 SV *fullname = sv_2mortal (newSV (0));
692 if (isGV (gv))
693 gv_efullname3 (fullname, gv, 0);
694
695 bot = PL_stack_base + cx->blk_oldsp + 1;
696 top = cx->blk_gimme == G_ARRAY ? SP + 1
697 : cx->blk_gimme == G_SCALAR ? bot + 1
698 : bot;
699
700 while (bot < top)
701 av_push (av, SvREFCNT_inc (*bot++));
702
703 PL_runops = RUNOPS_DEFAULT;
723 ENTER; 704 ENTER;
724 SAVETMPS; 705 SAVETMPS;
725 EXTEND (SP, 3); 706 EXTEND (SP, 3);
726 PL_runops = RUNOPS_DEFAULT; 707 PUSHMARK (SP);
708 PUSHs (&PL_sv_no);
709 PUSHs (fullname);
710 PUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
711 PUTBACK;
712 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
713 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
714 SPAGAIN;
715 FREETMPS;
716 LEAVE;
717 PL_runops = runops_trace;
718 }
727 719
728 if (oldcxix != cxstack_ix && cctx->flags & CC_TRACE_SUB) 720 if (oldcop != PL_curcop)
721 {
722 oldcop = PL_curcop;
723
724 if (PL_curcop != &PL_compiling)
729 { 725 {
730 PERL_CONTEXT *cx = &cxstack[cxstack_ix]; 726 SV **cb;
731 727
732 if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix) 728 if (oldcxix != cxstack_ix && cctx->flags & CC_TRACE_SUB)
733 { 729 {
730 PERL_CONTEXT *cx = &cxstack[cxstack_ix];
731
732 if (CxTYPE (cx) == CXt_SUB && oldcxix < cxstack_ix)
733 {
734 runops_proc_t old_runops = PL_runops;
735 dSP;
734 GV *gv = CvGV (cx->blk_sub.cv); 736 GV *gv = CvGV (cx->blk_sub.cv);
735 SV *fullname = sv_2mortal (newSV (0)); 737 SV *fullname = sv_2mortal (newSV (0));
738
736 if (isGV (gv)) 739 if (isGV (gv))
737 gv_efullname3 (fullname, gv, 0); 740 gv_efullname3 (fullname, gv, 0);
738 741
742 PL_runops = RUNOPS_DEFAULT;
743 ENTER;
744 SAVETMPS;
745 EXTEND (SP, 3);
746 PUSHMARK (SP);
747 PUSHs (&PL_sv_yes);
748 PUSHs (fullname);
749 PUSHs (cx->blk_sub.hasargs ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
750 PUTBACK;
751 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0);
752 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
753 SPAGAIN;
754 FREETMPS;
755 LEAVE;
756 PL_runops = runops_trace;
757 }
758
759 oldcxix = cxstack_ix;
760 }
761
762 if (cctx->flags & CC_TRACE_LINE)
763 {
764 dSP;
765
766 PL_runops = RUNOPS_DEFAULT;
767 ENTER;
768 SAVETMPS;
769 EXTEND (SP, 3);
770 PL_runops = RUNOPS_DEFAULT;
739 PUSHMARK (SP); 771 PUSHMARK (SP);
740 PUSHs (&PL_sv_yes); 772 PUSHs (sv_2mortal (newSVpv (OutCopFILE (oldcop), 0)));
741 PUSHs (fullname); 773 PUSHs (sv_2mortal (newSViv (CopLINE (oldcop))));
742 PUSHs (cx->blk_sub.hasargs ? sv_2mortal (newRV_inc ((SV *)cx->blk_sub.argarray)) : &PL_sv_undef);
743 PUTBACK; 774 PUTBACK;
744 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_sub_cb", sizeof ("_trace_sub_cb") - 1, 0); 775 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_line_cb", sizeof ("_trace_line_cb") - 1, 0);
745 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD); 776 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
746 SPAGAIN; 777 SPAGAIN;
778 FREETMPS;
779 LEAVE;
780 PL_runops = runops_trace;
747 } 781 }
748
749 oldcxix = cxstack_ix;
750 } 782 }
751
752 if (cctx->flags & CC_TRACE_LINE)
753 {
754 PUSHMARK (SP);
755 PUSHs (sv_2mortal (newSVpv (OutCopFILE (oldcop), 0)));
756 PUSHs (sv_2mortal (newSViv (CopLINE (oldcop))));
757 PUTBACK;
758 cb = hv_fetch ((HV *)SvRV (coro_current), "_trace_line_cb", sizeof ("_trace_line_cb") - 1, 0);
759 if (cb) call_sv (*cb, G_KEEPERR | G_EVAL | G_VOID | G_DISCARD);
760 SPAGAIN;
761 }
762
763 FREETMPS;
764 LEAVE;
765 PL_runops = old_runops;
766 } 783 }
767 } 784 }
768 } 785 }
769 786
770 TAINT_NOT; 787 TAINT_NOT;
… …
1014 prev->cctx = 0; 1031 prev->cctx = 0;
1015 1032
1016 cctx_put (prev__cctx); 1033 cctx_put (prev__cctx);
1017 } 1034 }
1018 1035
1036 ++next->usecount;
1037
1019 if (!next->cctx) 1038 if (!next->cctx)
1020 next->cctx = cctx_get (aTHX); 1039 next->cctx = cctx_get (aTHX);
1021 1040
1022 if (prev__cctx != next->cctx) 1041 if (prev__cctx != next->cctx)
1023 { 1042 {
… …
1335 } 1354 }
1336 else 1355 else
1337 return 0; 1356 return 0;
1338} 1357}
1339 1358
1359static void
1360api_trace (SV *coro_sv, int flags)
1361{
1362 dTHX;
1363 struct coro *coro = SvSTATE (coro_sv);
1364
1365 if (flags & CC_TRACE)
1366 {
1367 if (!coro->cctx)
1368 coro->cctx = cctx_new ();
1369 else if (!(coro->cctx->flags & CC_TRACE))
1370 croak ("cannot enable tracing on coroutine with custom stack");
1371
1372 coro->cctx->flags |= CC_NOREUSE | (flags & (CC_TRACE | CC_TRACE_ALL));
1373 }
1374 else if (coro->cctx && coro->cctx->flags & CC_TRACE)
1375 {
1376 coro->cctx->flags &= ~(CC_TRACE | CC_TRACE_ALL);
1377
1378 if (coro->flags & CF_RUNNING)
1379 PL_runops = RUNOPS_DEFAULT;
1380 else
1381 coro->runops = RUNOPS_DEFAULT;
1382 }
1383}
1384
1340MODULE = Coro::State PACKAGE = Coro::State 1385MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
1341 1386
1342PROTOTYPES: DISABLE 1387PROTOTYPES: DISABLE
1343 1388
1344BOOT: 1389BOOT:
1345{ 1390{
… …
1553 save_perl (aTHX_ coro); 1598 save_perl (aTHX_ coro);
1554 load_perl (aTHX_ &temp); 1599 load_perl (aTHX_ &temp);
1555 } 1600 }
1556 } 1601 }
1557} 1602}
1558 1603
1559SV * 1604SV *
1560is_ready (Coro::State coro) 1605is_ready (Coro::State coro)
1561 PROTOTYPE: $ 1606 PROTOTYPE: $
1562 ALIAS: 1607 ALIAS:
1563 is_ready = CF_READY 1608 is_ready = CF_READY
… …
1568 RETVAL = boolSV (coro->flags & ix); 1613 RETVAL = boolSV (coro->flags & ix);
1569 OUTPUT: 1614 OUTPUT:
1570 RETVAL 1615 RETVAL
1571 1616
1572void 1617void
1573trace (Coro::State coro, int flags = CC_TRACE | CC_TRACE_SUB) 1618api_trace (SV *coro, int flags = CC_TRACE | CC_TRACE_SUB)
1574 CODE:
1575 if (flags & CC_TRACE)
1576 {
1577 if (!coro->cctx)
1578 coro->cctx = cctx_new ();
1579 else if (!(coro->cctx->flags & CC_TRACE))
1580 croak ("cannot enable tracing on coroutine with custom stack");
1581
1582 coro->cctx->flags |= flags & (CC_TRACE | CC_TRACE_ALL);
1583 }
1584 else
1585 if (coro->cctx && coro->cctx->flags & CC_TRACE)
1586 {
1587 coro->cctx->flags &= ~(CC_TRACE | CC_TRACE_ALL);
1588 coro->cctx->flags |= CC_NOREUSE;
1589
1590 if (coro->flags & CF_RUNNING)
1591 PL_runops = RUNOPS_DEFAULT;
1592 else
1593 coro->runops = RUNOPS_DEFAULT;
1594 }
1595 1619
1596SV * 1620SV *
1597has_stack (Coro::State coro) 1621has_stack (Coro::State coro)
1598 PROTOTYPE: $ 1622 PROTOTYPE: $
1599 CODE: 1623 CODE:
… …
1610 RETVAL 1634 RETVAL
1611 1635
1612IV 1636IV
1613rss (Coro::State coro) 1637rss (Coro::State coro)
1614 PROTOTYPE: $ 1638 PROTOTYPE: $
1639 ALIAS:
1640 usecount = 1
1615 CODE: 1641 CODE:
1642 switch (ix)
1643 {
1616 RETVAL = coro_rss (aTHX_ coro); 1644 case 0: RETVAL = coro_rss (aTHX_ coro); break;
1645 case 1: RETVAL = coro->usecount; break;
1646 }
1617 OUTPUT: 1647 OUTPUT:
1618 RETVAL 1648 RETVAL
1619 1649
1620 1650
1621MODULE = Coro::State PACKAGE = Coro 1651MODULE = Coro::State PACKAGE = Coro
… …
1753 av_clear (GvAV (PL_defgv)); 1783 av_clear (GvAV (PL_defgv));
1754 hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1, 1784 hv_store ((HV *)SvRV (coro_current), "desc", sizeof ("desc") - 1,
1755 newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0); 1785 newSVpvn ("[async_pool idle]", sizeof ("[async_pool idle]") - 1), 0);
1756 coro->save = CORO_SAVE_DEF; 1786 coro->save = CORO_SAVE_DEF;
1757 coro->prio = 0; 1787 coro->prio = 0;
1788
1789 if (coro->cctx && (coro->cctx->flags & CC_TRACE))
1790 api_trace (coro_current, 0);
1791
1758 av_push (av_async_pool, newSVsv (coro_current)); 1792 av_push (av_async_pool, newSVsv (coro_current));
1759} 1793}
1760 1794
1761 1795
1762MODULE = Coro::State PACKAGE = Coro::AIO 1796MODULE = Coro::State PACKAGE = Coro::AIO

Diff Legend

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