cvsroot/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 *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;

#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;

/* 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(prev,next)
        Coro    prev
        Coro    next
        CODE:

        PUTBACK;
        SAVE (prev);

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

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

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

            exit (0);

            /*SPAGAIN;
            SAVE (next);

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