Coro/Coro/State.xs

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

struct coro {
  U8 dowarn;
  
  PERL_SI *curstackinfo;
  AV *curstack;
  AV *mainstack;
  SV **stack_sp;
  OP *op;
  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;
  COP *curcop;

  AV *defav;

  SV *proc;
};

typedef struct coro *Coro__State;
typedef struct coro *Coro__State_or_hashref;

#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->op = PL_op;                        \
  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->curcop = PL_curcop;                \
  c->defav = GvAV (PL_defgv);

#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_op = c->op;                        \
  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;    \
  PL_curcop = c->curcop;                \
  GvAV (PL_defgv) = c->defav;

/* 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::State            PACKAGE = Coro::State

PROTOTYPES: ENABLE

Coro::State
newprocess(proc)
        SV *    proc
        PROTOTYPE: &
        CODE:
        Coro__State 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::State_or_hashref  prev
        Coro::State_or_hashref  next
        CODE:

        if (prev != next)
          {
            PUTBACK;
            SAVE (prev);

            /*
             * this could be done in newprocess which would to
             * extremely elegant and fast (just PUTBACK/SAVE/LOAD/SPAGAIN)
             * code here, but lazy allocation of stacks has also
             * some virtues and the overhead of the if() is nil.
             */
            if (next->mainstack)
              {
                LOAD (next);
                next->mainstack = 0; /* unnecessary but much cleaner */
                SPAGAIN;
              }
            else
              {
                /*
                 * emulate part of the perl startup here.
                 */
                UNOP myop;

                init_stacks ();
                PL_op = (OP *)&myop;
                /*PL_curcop = 0;*/
                GvAV (PL_defgv) = newAV ();

                SPAGAIN;
                Zero(&myop, 1, UNOP);
                myop.op_next = Nullop;
                myop.op_flags = OPf_WANT_VOID;

                EXTEND (SP,1);
                PUSHs (next->proc);
                
                PUTBACK;
                /*
                 * the next line is slightly wrong, as PL_op->op_next
                 * is actually being executed so we skip the first op
                 * that doens't matter, though, since it is only
                 * pp_nextstate and we never return...
                 */
                PL_op = Perl_pp_entersub(aTHX);
                SPAGAIN;

                ENTER;
              }
          }

void
DESTROY(coro)
        Coro::State     coro
        CODE:

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

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

            S_nuke_stacks ();
            SvREFCNT_dec ((SV *)GvAV (PL_defgv));

            LOAD((&temp));
            SPAGAIN;
          }

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


Revision:	1.2
Committed:	Sun Jul 15 02:35:52 2001 UTC (22 years, 10 months ago) by root
Branch:	MAIN
Changes since 1.1:	+51 -42 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			struct coro {
6			U8 dowarn;
7
8			PERL_SI *curstackinfo;
9			AV *curstack;
10			AV *mainstack;
11			SV **stack_sp;
12			OP *op;
13			SV **curpad;
14			SV **stack_base;
15			SV **stack_max;
16			SV **tmps_stack;
17			I32 tmps_floor;
18			I32 tmps_ix;
19			I32 tmps_max;
20			I32 *markstack;
21			I32 *markstack_ptr;
22			I32 *markstack_max;
23			I32 *scopestack;
24			I32 scopestack_ix;
25			I32 scopestack_max;
26			ANY *savestack;
27			I32 savestack_ix;
28			I32 savestack_max;
29			OP **retstack;
30			I32 retstack_ix;
31			I32 retstack_max;
32			COP *curcop;
33
34	root	1.2	AV *defav;
35
36	root	1.1	SV *proc;
37			};
38
39			typedef struct coro *Coro__State;
40			typedef struct coro *Coro__State_or_hashref;
41
42			#define SAVE(c) \
43			c->dowarn = PL_dowarn; \
44			c->curstackinfo = PL_curstackinfo; \
45			c->curstack = PL_curstack; \
46			c->mainstack = PL_mainstack; \
47			c->stack_sp = PL_stack_sp; \
48			c->op = PL_op; \
49			c->curpad = PL_curpad; \
50			c->stack_base = PL_stack_base; \
51			c->stack_max = PL_stack_max; \
52			c->tmps_stack = PL_tmps_stack; \
53			c->tmps_floor = PL_tmps_floor; \
54			c->tmps_ix = PL_tmps_ix; \
55			c->tmps_max = PL_tmps_max; \
56			c->markstack = PL_markstack; \
57			c->markstack_ptr = PL_markstack_ptr; \
58			c->markstack_max = PL_markstack_max; \
59			c->scopestack = PL_scopestack; \
60			c->scopestack_ix = PL_scopestack_ix; \
61			c->scopestack_max = PL_scopestack_max;\
62			c->savestack = PL_savestack; \
63			c->savestack_ix = PL_savestack_ix; \
64			c->savestack_max = PL_savestack_max; \
65			c->retstack = PL_retstack; \
66			c->retstack_ix = PL_retstack_ix; \
67			c->retstack_max = PL_retstack_max; \
68	root	1.2	c->curcop = PL_curcop; \
69			c->defav = GvAV (PL_defgv);
70	root	1.1
71			#define LOAD(c) \
72			PL_dowarn = c->dowarn; \
73			PL_curstackinfo = c->curstackinfo; \
74			PL_curstack = c->curstack; \
75			PL_mainstack = c->mainstack; \
76			PL_stack_sp = c->stack_sp; \
77			PL_op = c->op; \
78			PL_curpad = c->curpad; \
79			PL_stack_base = c->stack_base; \
80			PL_stack_max = c->stack_max; \
81			PL_tmps_stack = c->tmps_stack; \
82			PL_tmps_floor = c->tmps_floor; \
83			PL_tmps_ix = c->tmps_ix; \
84			PL_tmps_max = c->tmps_max; \
85			PL_markstack = c->markstack; \
86			PL_markstack_ptr = c->markstack_ptr; \
87			PL_markstack_max = c->markstack_max; \
88			PL_scopestack = c->scopestack; \
89			PL_scopestack_ix = c->scopestack_ix; \
90			PL_scopestack_max = c->scopestack_max;\
91			PL_savestack = c->savestack; \
92			PL_savestack_ix = c->savestack_ix; \
93			PL_savestack_max = c->savestack_max; \
94			PL_retstack = c->retstack; \
95			PL_retstack_ix = c->retstack_ix; \
96			PL_retstack_max = c->retstack_max; \
97	root	1.2	PL_curcop = c->curcop; \
98			GvAV (PL_defgv) = c->defav;
99	root	1.1
100			/* this is an EXACT copy of S_nuke_stacks in perl.c, which is unfortunately static */
101			STATIC void
102			S_nuke_stacks(pTHX)
103			{
104			while (PL_curstackinfo->si_next)
105			PL_curstackinfo = PL_curstackinfo->si_next;
106			while (PL_curstackinfo) {
107			PERL_SI *p = PL_curstackinfo->si_prev;
108			/* curstackinfo->si_stack got nuked by sv_free_arenas() */
109			Safefree(PL_curstackinfo->si_cxstack);
110			Safefree(PL_curstackinfo);
111			PL_curstackinfo = p;
112			}
113			Safefree(PL_tmps_stack);
114			Safefree(PL_markstack);
115			Safefree(PL_scopestack);
116			Safefree(PL_savestack);
117			Safefree(PL_retstack);
118			}
119
120			MODULE = Coro::State PACKAGE = Coro::State
121
122			PROTOTYPES: ENABLE
123
124			Coro::State
125			newprocess(proc)
126			SV * proc
127			PROTOTYPE: &
128			CODE:
129			Coro__State coro;
130
131			New (0, coro, 1, struct coro);
132
133			coro->mainstack = 0; /* actual work is done inside transfer */
134			coro->proc = SvREFCNT_inc (proc);
135
136			RETVAL = coro;
137			OUTPUT:
138			RETVAL
139
140			void
141			transfer(prev,next)
142			Coro::State_or_hashref prev
143			Coro::State_or_hashref next
144			CODE:
145
146	root	1.2	if (prev != next)
147	root	1.1	{
148	root	1.2	PUTBACK;
149			SAVE (prev);
150	root	1.1
151			/*
152	root	1.2	* this could be done in newprocess which would to
153			* extremely elegant and fast (just PUTBACK/SAVE/LOAD/SPAGAIN)
154			* code here, but lazy allocation of stacks has also
155			* some virtues and the overhead of the if() is nil.
156	root	1.1	*/
157	root	1.2	if (next->mainstack)
158			{
159			LOAD (next);
160			next->mainstack = 0; /* unnecessary but much cleaner */
161			SPAGAIN;
162			}
163			else
164			{
165			/*
166			* emulate part of the perl startup here.
167			*/
168			UNOP myop;
169
170			init_stacks ();
171			PL_op = (OP *)&myop;
172			/PL_curcop = 0;/
173			GvAV (PL_defgv) = newAV ();
174
175			SPAGAIN;
176			Zero(&myop, 1, UNOP);
177			myop.op_next = Nullop;
178			myop.op_flags = OPf_WANT_VOID;
179
180			EXTEND (SP,1);
181			PUSHs (next->proc);
182
183			PUTBACK;
184			/*
185			* the next line is slightly wrong, as PL_op->op_next
186			* is actually being executed so we skip the first op
187			* that doens't matter, though, since it is only
188			* pp_nextstate and we never return...
189			*/
190			PL_op = Perl_pp_entersub(aTHX);
191			SPAGAIN;
192	root	1.1
193	root	1.2	ENTER;
194			}
195	root	1.1	}
196
197			void
198			DESTROY(coro)
199			Coro::State coro
200			CODE:
201
202			if (coro->mainstack)
203			{
204			struct coro temp;
205
206			PUTBACK;
207			SAVE((&temp));
208			LOAD(coro);
209
210			S_nuke_stacks ();
211	root	1.2	SvREFCNT_dec ((SV *)GvAV (PL_defgv));
212	root	1.1
213			LOAD((&temp));
214			SPAGAIN;
215			}
216
217			SvREFCNT_dec (coro->proc);
218			Safefree (coro);
219
220