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.244 by root, Sun Sep 21 18:29:39 2008 UTC vs.
Revision 1.248 by root, Mon Sep 29 12:40:50 2008 UTC

… …
4#define PERL_EXT 4#define PERL_EXT
5 5
6#include "EXTERN.h" 6#include "EXTERN.h"
7#include "perl.h" 7#include "perl.h"
8#include "XSUB.h" 8#include "XSUB.h"
9#include "perliol.h"
9 10
10#include "patchlevel.h" 11#include "patchlevel.h"
11 12
12#include <stdio.h> 13#include <stdio.h>
13#include <errno.h> 14#include <errno.h>
… …
153 I32 laststype; 154 I32 laststype;
154 int laststatval; 155 int laststatval;
155 Stat_t statcache; 156 Stat_t statcache;
156}; 157};
157 158
159static double (*nvtime)(); /* so why doesn't it take void? */
160
158static size_t coro_stacksize = CORO_STACKSIZE; 161static size_t coro_stacksize = CORO_STACKSIZE;
159static struct CoroAPI coroapi; 162static struct CoroAPI coroapi;
160static AV *main_mainstack; /* used to differentiate between $main and others */ 163static AV *main_mainstack; /* used to differentiate between $main and others */
161static JMPENV *main_top_env; 164static JMPENV *main_top_env;
162static HV *coro_state_stash, *coro_stash; 165static HV *coro_state_stash, *coro_stash;
… …
361 364
362 /* casting is fun. */ 365 /* casting is fun. */
363 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av))) 366 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))
364 free_padlist (aTHX_ padlist); 367 free_padlist (aTHX_ padlist);
365 368
366 SvREFCNT_dec (av); 369 SvREFCNT_dec (av); /* sv_magicext increased the refcount */
367 370
368 return 0; 371 return 0;
369} 372}
370 373
371#define CORO_MAGIC_type_cv PERL_MAGIC_ext 374#define CORO_MAGIC_type_cv PERL_MAGIC_ext
… …
666 #undef VAR 669 #undef VAR
667 } 670 }
668 else 671 else
669 slot = coro->slot; 672 slot = coro->slot;
670 673
674 if (slot)
675 {
671 rss += sizeof (slot->curstackinfo); 676 rss += sizeof (slot->curstackinfo);
672 rss += (slot->curstackinfo->si_cxmax + 1) * sizeof (PERL_CONTEXT); 677 rss += (slot->curstackinfo->si_cxmax + 1) * sizeof (PERL_CONTEXT);
673 rss += sizeof (SV) + sizeof (struct xpvav) + (1 + AvMAX (slot->curstack)) * sizeof (SV *); 678 rss += sizeof (SV) + sizeof (struct xpvav) + (1 + AvMAX (slot->curstack)) * sizeof (SV *);
674 rss += slot->tmps_max * sizeof (SV *); 679 rss += slot->tmps_max * sizeof (SV *);
675 rss += (slot->markstack_max - slot->markstack_ptr) * sizeof (I32); 680 rss += (slot->markstack_max - slot->markstack_ptr) * sizeof (I32);
676 rss += slot->scopestack_max * sizeof (I32); 681 rss += slot->scopestack_max * sizeof (I32);
677 rss += slot->savestack_max * sizeof (ANY); 682 rss += slot->savestack_max * sizeof (ANY);
678 683
679#if !PERL_VERSION_ATLEAST (5,10,0) 684#if !PERL_VERSION_ATLEAST (5,10,0)
680 rss += slot->retstack_max * sizeof (OP *); 685 rss += slot->retstack_max * sizeof (OP *);
681#endif 686#endif
687 }
682 } 688 }
683 689
684 return rss; 690 return rss;
685} 691}
686 692
… …
1642static MGVTBL coro_gensub_vtbl = { 1648static MGVTBL coro_gensub_vtbl = {
1643 0, 0, 0, 0, 1649 0, 0, 0, 0,
1644 coro_gensub_free 1650 coro_gensub_free
1645}; 1651};
1646 1652
1653/*****************************************************************************/
1654/* PerlIO::cede */
1655
1656typedef struct
1657{
1658 PerlIOBuf base;
1659 NV next, every;
1660} PerlIOCede;
1661
1662static IV
1663PerlIOCede_pushed (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
1664{
1665 PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
1666
1667 self->every = SvCUR (arg) ? SvNV (arg) : 0.01;
1668 self->next = nvtime () + self->every;
1669
1670 return PerlIOBuf_pushed (aTHX_ f, mode, Nullsv, tab);
1671}
1672
1673static SV *
1674PerlIOCede_getarg (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
1675{
1676 PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
1677
1678 return newSVnv (self->every);
1679}
1680
1681static IV
1682PerlIOCede_flush (pTHX_ PerlIO *f)
1683{
1684 PerlIOCede *self = PerlIOSelf (f, PerlIOCede);
1685 double now = nvtime ();
1686
1687 if (now >= self->next)
1688 {
1689 api_cede ();
1690 self->next = now + self->every;
1691 }
1692
1693 return PerlIOBuf_flush (aTHX_ f);
1694}
1695
1696static PerlIO_funcs PerlIO_cede =
1697{
1698 sizeof(PerlIO_funcs),
1699 "cede",
1700 sizeof(PerlIOCede),
1701 PERLIO_K_DESTRUCT | PERLIO_K_RAW,
1702 PerlIOCede_pushed,
1703 PerlIOBuf_popped,
1704 PerlIOBuf_open,
1705 PerlIOBase_binmode,
1706 PerlIOCede_getarg,
1707 PerlIOBase_fileno,
1708 PerlIOBuf_dup,
1709 PerlIOBuf_read,
1710 PerlIOBuf_unread,
1711 PerlIOBuf_write,
1712 PerlIOBuf_seek,
1713 PerlIOBuf_tell,
1714 PerlIOBuf_close,
1715 PerlIOCede_flush,
1716 PerlIOBuf_fill,
1717 PerlIOBase_eof,
1718 PerlIOBase_error,
1719 PerlIOBase_clearerr,
1720 PerlIOBase_setlinebuf,
1721 PerlIOBuf_get_base,
1722 PerlIOBuf_bufsiz,
1723 PerlIOBuf_get_ptr,
1724 PerlIOBuf_get_cnt,
1725 PerlIOBuf_set_ptrcnt,
1726};
1727
1728
1647MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_ 1729MODULE = Coro::State PACKAGE = Coro::State PREFIX = api_
1648 1730
1649PROTOTYPES: DISABLE 1731PROTOTYPES: DISABLE
1650 1732
1651BOOT: 1733BOOT:
… …
1680 main_top_env = main_top_env->je_prev; 1762 main_top_env = main_top_env->je_prev;
1681 1763
1682 coroapi.ver = CORO_API_VERSION; 1764 coroapi.ver = CORO_API_VERSION;
1683 coroapi.rev = CORO_API_REVISION; 1765 coroapi.rev = CORO_API_REVISION;
1684 coroapi.transfer = api_transfer; 1766 coroapi.transfer = api_transfer;
1767
1768 {
1769 SV **svp = hv_fetch (PL_modglobal, "Time::NVtime", 12, 0);
1770
1771 if (!svp) croak ("Time::HiRes is required");
1772 if (!SvIOK (*svp)) croak ("Time::NVtime isn't a function pointer");
1773
1774 nvtime = INT2PTR (double (*)(), SvIV (*svp));
1775 }
1685 1776
1686 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL)); 1777 assert (("PRIO_NORMAL must be 0", !PRIO_NORMAL));
1687} 1778}
1688 1779
1689SV * 1780SV *
… …
1817call (Coro::State coro, SV *coderef) 1908call (Coro::State coro, SV *coderef)
1818 ALIAS: 1909 ALIAS:
1819 eval = 1 1910 eval = 1
1820 CODE: 1911 CODE:
1821{ 1912{
1822 if (coro->mainstack) 1913 if (coro->mainstack && ((coro->flags & CF_RUNNING) || coro->slot))
1823 { 1914 {
1824 struct coro temp; 1915 struct coro temp;
1825 1916
1826 if (!(coro->flags & CF_RUNNING)) 1917 if (!(coro->flags & CF_RUNNING))
1827 { 1918 {
… …
2216 } 2307 }
2217 2308
2218 --incede; 2309 --incede;
2219} 2310}
2220 2311
2312
2313MODULE = Coro::State PACKAGE = PerlIO::cede
2314
2315BOOT:
2316 PerlIO_define_layer (aTHX_ &PerlIO_cede);

Diff Legend

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