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;

  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;

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

/* 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:

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

            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 ();

            LOAD((&temp));
            SPAGAIN;
          }

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


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