Coro/Coro.xs

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

typedef struct coro {
  PERL_SI *curstackinfo;
  AV *curstack;
  AV *mainstack;
  SV **stack_base;
  SV **stack_sp;
  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->curstackinfo = PL_curstackinfo;    \
  c->curstack = PL_curstack;            \
  c->mainstack = PL_mainstack;          \
  c->stack_base = PL_stack_base;        \
  c->stack_sp = PL_stack_sp;            \
  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_curstackinfo = c->curstackinfo;    \
  PL_curstack = c->curstack;            \
  PL_mainstack = c->mainstack;          \
  PL_stack_base = c->stack_base;        \
  PL_stack_sp = c->stack_sp;            \
  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(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 ();

            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 ();
            LOAD((&temp));
            SPAGAIN;
          }

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


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