Coro/Coro.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

typedef struct coro {
  U8 dowarn;
  
  PERL_SI *curstackinfo;
  AV *curstack;
  AV *mainstack;
  SV **stack_sp;
  SV **curpad;
  SV **stack_base;
  SV **stack_max;
  SV **tmps_stack;
  I32 tmps_floor;
  I32 tmps_ix;
  I32 tmps_max;
  I32 *markstack;
  I32 *markstack_ptr;
  I32 *markstack_max;
  I32 *scopestack;
  I32 scopestack_ix;
  I32 scopestack_max;
  ANY *savestack;
  I32 savestack_ix;
  I32 savestack_max;
  OP **retstack;
  I32 retstack_ix;
  I32 retstack_max;

  SV *errsv;
  SV *defsv;

  SV *proc;
} *Coro;

#define SAVE(c) \
  c->dowarn = PL_dowarn;                \
  c->curstackinfo = PL_curstackinfo;    \
  c->curstack = PL_curstack;            \
  c->mainstack = PL_mainstack;          \
  c->stack_sp = PL_stack_sp;            \
  c->curpad = PL_curpad;                \
  c->stack_base = PL_stack_base;        \
  c->stack_max = PL_stack_max;          \
  c->tmps_stack = PL_tmps_stack;        \
  c->tmps_floor = PL_tmps_floor;        \
  c->tmps_ix = PL_tmps_ix;              \
  c->tmps_max = PL_tmps_max;            \
  c->markstack = PL_markstack;          \
  c->markstack_ptr = PL_markstack_ptr;  \
  c->markstack_max = PL_markstack_max;  \
  c->scopestack = PL_scopestack;        \
  c->scopestack_ix = PL_scopestack_ix;  \
  c->scopestack_max = PL_scopestack_max;\
  c->savestack = PL_savestack;          \
  c->savestack_ix = PL_savestack_ix;    \
  c->savestack_max = PL_savestack_max;  \
  c->retstack = PL_retstack;            \
  c->retstack_ix = PL_retstack_ix;      \
  c->retstack_max = PL_retstack_max;    \
  c->errsv = ERRSV;                     \
  c->defsv = DEFSV;

#define LOAD(c) \
  PL_dowarn = c->dowarn;                \
  PL_curstackinfo = c->curstackinfo;    \
  PL_curstack = c->curstack;            \
  PL_mainstack = c->mainstack;          \
  PL_stack_sp = c->stack_sp;            \
  PL_curpad = c->curpad;                \
  PL_stack_base = c->stack_base;        \
  PL_stack_max = c->stack_max;          \
  PL_tmps_stack = c->tmps_stack;        \
  PL_tmps_floor = c->tmps_floor;        \
  PL_tmps_ix = c->tmps_ix;              \
  PL_tmps_max = c->tmps_max;            \
  PL_markstack = c->markstack;          \
  PL_markstack_ptr = c->markstack_ptr;  \
  PL_markstack_max = c->markstack_max;  \
  PL_scopestack = c->scopestack;        \
  PL_scopestack_ix = c->scopestack_ix;  \
  PL_scopestack_max = c->scopestack_max;\
  PL_savestack = c->savestack;          \
  PL_savestack_ix = c->savestack_ix;    \
  PL_savestack_max = c->savestack_max;  \
  PL_retstack = c->retstack;            \
  PL_retstack_ix = c->retstack_ix;      \
  PL_retstack_max = c->retstack_max;    \
  ERRSV = c->errsv;                     \
  DEFSV = c->defsv;

/* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */
STATIC void
S_nuke_stacks(pTHX)
{
    while (PL_curstackinfo->si_next)
        PL_curstackinfo = PL_curstackinfo->si_next;
    while (PL_curstackinfo) {
        PERL_SI *p = PL_curstackinfo->si_prev;
        /* curstackinfo->si_stack got nuked by sv_free_arenas() */
        Safefree(PL_curstackinfo->si_cxstack);
        Safefree(PL_curstackinfo);
        PL_curstackinfo = p;
    }
    Safefree(PL_tmps_stack);
    Safefree(PL_markstack);
    Safefree(PL_scopestack);
    Safefree(PL_savestack);
    Safefree(PL_retstack);
}

MODULE = Coro           PACKAGE = Coro

PROTOTYPES: ENABLE

Coro
_newprocess(proc)
        SV *    proc
        PROTOTYPE: &
        CODE:
        Coro coro;
        
        New (0, coro, 1, struct coro);

        coro->mainstack = 0; /* actual work is done inside _transfer */
        coro->proc = SvREFCNT_inc (proc);

        RETVAL = coro;
        OUTPUT:
        RETVAL

void
_transfer(old,new)
        Coro    old
        Coro    new
        CODE:

        PUTBACK;
        SAVE (old);

        if (new->mainstack) /* this is, in theory, unnecessary overhead */
          {
            LOAD (new);
            SPAGAIN;
          }
        else
          {
            init_stacks ();

            ERRSV = newSVsv(&PL_sv_undef);
            DEFSV = newSVsv(&PL_sv_undef);

            SPAGAIN;
            PUSHMARK(SP);
            PUTBACK;
            call_sv (new->proc, G_VOID | G_DISCARD | G_EVAL);

            exit (0);

            /*SPAGAIN;
            SAVE (new);

            LOAD (old);
            SPAGAIN;*/
          }

void
DESTROY(coro)
        Coro    coro
        CODE:

        if (coro->mainstack)
          {
            struct coro temp;

            PUTBACK;
            SAVE((&temp));
            LOAD(coro);

            S_nuke_stacks ();
            SvREFCNT_dec (ERRSV);
            SvREFCNT_dec (DEFSV);

            LOAD((&temp));
            SPAGAIN;
          }

        SvREFCNT_dec (coro->proc);
        Safefree (coro);


Revision:	1.3
Committed:	Tue Jul 10 01:43:21 2001 UTC (22 years, 11 months ago) by root
Branch:	MAIN
Changes since 1.2:	+28 -7 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#include "EXTERN.h"
2			#include "perl.h"
3			#include "XSUB.h"
4
5			typedef struct coro {
6	root	1.3	U8 dowarn;
7
8	root	1.1	PERL_SI *curstackinfo;
9			AV *curstack;
10			AV *mainstack;
11	root	1.3	SV **stack_sp;
12			SV **curpad;
13	root	1.1	SV **stack_base;
14			SV **stack_max;
15			SV **tmps_stack;
16			I32 tmps_floor;
17			I32 tmps_ix;
18			I32 tmps_max;
19			I32 *markstack;
20			I32 *markstack_ptr;
21			I32 *markstack_max;
22			I32 *scopestack;
23			I32 scopestack_ix;
24			I32 scopestack_max;
25			ANY *savestack;
26			I32 savestack_ix;
27			I32 savestack_max;
28			OP **retstack;
29			I32 retstack_ix;
30			I32 retstack_max;
31
32	root	1.3	SV *errsv;
33			SV *defsv;
34
35	root	1.1	SV *proc;
36			} *Coro;
37
38			#define SAVE(c) \
39	root	1.3	c->dowarn = PL_dowarn; \
40	root	1.1	c->curstackinfo = PL_curstackinfo; \
41			c->curstack = PL_curstack; \
42			c->mainstack = PL_mainstack; \
43	root	1.3	c->stack_sp = PL_stack_sp; \
44			c->curpad = PL_curpad; \
45	root	1.1	c->stack_base = PL_stack_base; \
46			c->stack_max = PL_stack_max; \
47			c->tmps_stack = PL_tmps_stack; \
48			c->tmps_floor = PL_tmps_floor; \
49			c->tmps_ix = PL_tmps_ix; \
50			c->tmps_max = PL_tmps_max; \
51			c->markstack = PL_markstack; \
52			c->markstack_ptr = PL_markstack_ptr; \
53			c->markstack_max = PL_markstack_max; \
54			c->scopestack = PL_scopestack; \
55			c->scopestack_ix = PL_scopestack_ix; \
56	root	1.3	c->scopestack_max = PL_scopestack_max;\
57	root	1.1	c->savestack = PL_savestack; \
58			c->savestack_ix = PL_savestack_ix; \
59			c->savestack_max = PL_savestack_max; \
60			c->retstack = PL_retstack; \
61			c->retstack_ix = PL_retstack_ix; \
62	root	1.3	c->retstack_max = PL_retstack_max; \
63			c->errsv = ERRSV; \
64			c->defsv = DEFSV;
65	root	1.1
66			#define LOAD(c) \
67	root	1.3	PL_dowarn = c->dowarn; \
68	root	1.1	PL_curstackinfo = c->curstackinfo; \
69			PL_curstack = c->curstack; \
70			PL_mainstack = c->mainstack; \
71	root	1.3	PL_stack_sp = c->stack_sp; \
72			PL_curpad = c->curpad; \
73	root	1.1	PL_stack_base = c->stack_base; \
74			PL_stack_max = c->stack_max; \
75			PL_tmps_stack = c->tmps_stack; \
76			PL_tmps_floor = c->tmps_floor; \
77			PL_tmps_ix = c->tmps_ix; \
78			PL_tmps_max = c->tmps_max; \
79			PL_markstack = c->markstack; \
80			PL_markstack_ptr = c->markstack_ptr; \
81			PL_markstack_max = c->markstack_max; \
82			PL_scopestack = c->scopestack; \
83			PL_scopestack_ix = c->scopestack_ix; \
84	root	1.3	PL_scopestack_max = c->scopestack_max;\
85	root	1.1	PL_savestack = c->savestack; \
86			PL_savestack_ix = c->savestack_ix; \
87			PL_savestack_max = c->savestack_max; \
88			PL_retstack = c->retstack; \
89			PL_retstack_ix = c->retstack_ix; \
90	root	1.3	PL_retstack_max = c->retstack_max; \
91			ERRSV = c->errsv; \
92			DEFSV = c->defsv;
93	root	1.1
94			/* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */
95			STATIC void
96			S_nuke_stacks(pTHX)
97			{
98			while (PL_curstackinfo->si_next)
99			PL_curstackinfo = PL_curstackinfo->si_next;
100			while (PL_curstackinfo) {
101			PERL_SI *p = PL_curstackinfo->si_prev;
102			/* curstackinfo->si_stack got nuked by sv_free_arenas() */
103			Safefree(PL_curstackinfo->si_cxstack);
104			Safefree(PL_curstackinfo);
105			PL_curstackinfo = p;
106			}
107			Safefree(PL_tmps_stack);
108			Safefree(PL_markstack);
109			Safefree(PL_scopestack);
110			Safefree(PL_savestack);
111			Safefree(PL_retstack);
112			}
113
114			MODULE = Coro PACKAGE = Coro
115
116			PROTOTYPES: ENABLE
117
118			Coro
119			_newprocess(proc)
120			SV * proc
121			PROTOTYPE: &
122			CODE:
123			Coro coro;
124
125			New (0, coro, 1, struct coro);
126
127			coro->mainstack = 0; /* actual work is done inside _transfer */
128			coro->proc = SvREFCNT_inc (proc);
129
130			RETVAL = coro;
131			OUTPUT:
132			RETVAL
133
134			void
135			_transfer(old,new)
136			Coro old
137			Coro new
138			CODE:
139
140			PUTBACK;
141			SAVE (old);
142
143			if (new->mainstack) /* this is, in theory, unnecessary overhead */
144			{
145			LOAD (new);
146			SPAGAIN;
147			}
148			else
149			{
150			init_stacks ();
151
152	root	1.3	ERRSV = newSVsv(&PL_sv_undef);
153			DEFSV = newSVsv(&PL_sv_undef);
154
155	root	1.1	SPAGAIN;
156			PUSHMARK(SP);
157			PUTBACK;
158			call_sv (new->proc, G_VOID \| G_DISCARD \| G_EVAL);
159
160			exit (0);
161
162	root	1.2	/*SPAGAIN;
163	root	1.1	SAVE (new);
164
165			LOAD (old);
166	root	1.2	SPAGAIN;*/
167	root	1.1	}
168
169			void
170			DESTROY(coro)
171			Coro coro
172			CODE:
173
174			if (coro->mainstack)
175			{
176			struct coro temp;
177
178			PUTBACK;
179			SAVE((&temp));
180			LOAD(coro);
181	root	1.3
182	root	1.1	S_nuke_stacks ();
183	root	1.3	SvREFCNT_dec (ERRSV);
184			SvREFCNT_dec (DEFSV);
185
186	root	1.1	LOAD((&temp));
187			SPAGAIN;
188			}
189
190			SvREFCNT_dec (coro->proc);
191			Safefree (coro);
192
193