ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Coro/Coro/State.xs
(Generate patch)

Comparing Coro/Coro/State.xs (file contents):
Revision 1.76 by root, Thu Oct 26 08:45:56 2006 UTC vs.
Revision 1.77 by root, Tue Oct 31 23:55:33 2006 UTC

… …
139}; 139};
140 140
141typedef struct coro *Coro__State; 141typedef struct coro *Coro__State;
142typedef struct coro *Coro__State_or_hashref; 142typedef struct coro *Coro__State_or_hashref;
143 143
144/* mostly copied from op.c:cv_clone2 */ 144static AV *
145STATIC AV * 145coro_clone_padlist (pTHX_ CV *cv)
146clone_padlist (pTHX_ AV *protopadlist)
147{ 146{
148 AV *av; 147 AV *padlist = CvPADLIST (cv);
149 I32 ix;
150 AV *protopad_name = (AV *) * av_fetch (protopadlist, 0, FALSE);
151 AV *protopad = (AV *) * av_fetch (protopadlist, 1, FALSE);
152 SV **pname = AvARRAY (protopad_name);
153 SV **ppad = AvARRAY (protopad);
154 I32 fname = AvFILLp (protopad_name);
155 I32 fpad = AvFILLp (protopad);
156 AV *newpadlist, *newpad_name, *newpad; 148 AV *newpadlist, *newpad;
157 SV **npad;
158
159 newpad_name = newAV ();
160 for (ix = fname; ix >= 0; ix--)
161 av_store (newpad_name, ix, SvREFCNT_inc (pname[ix]));
162
163 newpad = newAV ();
164 av_fill (newpad, AvFILLp (protopad));
165 npad = AvARRAY (newpad);
166 149
167 newpadlist = newAV (); 150 newpadlist = newAV ();
168 AvREAL_off (newpadlist); 151 AvREAL_off (newpadlist);
169 av_store (newpadlist, 0, (SV *) newpad_name); 152 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
153 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
154 --AvFILLp (padlist);
155
156 av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE)));
170 av_store (newpadlist, 1, (SV *) newpad); 157 av_store (newpadlist, 1, (SV *)newpad);
171
172 av = newAV (); /* will be @_ */
173 av_extend (av, 0);
174 av_store (newpad, 0, (SV *) av);
175 AvREIFY_on (av);
176
177 for (ix = fpad; ix > 0; ix--)
178 {
179 SV *namesv = (ix <= fname) ? pname[ix] : Nullsv;
180
181 if (namesv && namesv != &PL_sv_undef)
182 {
183 char *name = SvPVX (namesv); /* XXX */
184
185 if (SvFLAGS (namesv) & SVf_FAKE || *name == '&')
186 { /* lexical from outside? */
187 npad[ix] = SvREFCNT_inc (ppad[ix]);
188 }
189 else
190 { /* our own lexical */
191 SV *sv;
192 if (*name == '&')
193 sv = SvREFCNT_inc (ppad[ix]);
194 else if (*name == '@')
195 sv = (SV *) newAV ();
196 else if (*name == '%')
197 sv = (SV *) newHV ();
198 else
199 sv = NEWSV (0, 0);
200
201#ifdef SvPADBUSY
202 if (!SvPADBUSY (sv))
203#endif
204 SvPADMY_on (sv);
205
206 npad[ix] = sv;
207 }
208 }
209 else if (IS_PADGV (ppad[ix]) || IS_PADCONST (ppad[ix]))
210 {
211 npad[ix] = SvREFCNT_inc (ppad[ix]);
212 }
213 else
214 {
215 SV *sv = NEWSV (0, 0);
216 SvPADTMP_on (sv);
217 npad[ix] = sv;
218 }
219 }
220
221#if 0 /* return -ENOTUNDERSTOOD */
222 /* Now that vars are all in place, clone nested closures. */
223
224 for (ix = fpad; ix > 0; ix--) {
225 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
226 if (namesv
227 && namesv != &PL_sv_undef
228 && !(SvFLAGS(namesv) & SVf_FAKE)
229 && *SvPVX(namesv) == '&'
230 && CvCLONE(ppad[ix]))
231 {
232 CV *kid = cv_clone((CV*)ppad[ix]);
233 SvREFCNT_dec(ppad[ix]);
234 CvCLONE_on(kid);
235 SvPADMY_on(kid);
236 npad[ix] = (SV*)kid;
237 }
238 }
239#endif
240 158
241 return newpadlist; 159 return newpadlist;
242} 160}
243 161
244STATIC void 162static void
245free_padlist (pTHX_ AV *padlist) 163free_padlist (pTHX_ AV *padlist)
246{ 164{
247 /* may be during global destruction */ 165 /* may be during global destruction */
248 if (SvREFCNT (padlist)) 166 if (SvREFCNT (padlist))
249 { 167 {
… …
263 181
264 SvREFCNT_dec ((SV*)padlist); 182 SvREFCNT_dec ((SV*)padlist);
265 } 183 }
266} 184}
267 185
268STATIC int 186static int
269coro_cv_free (pTHX_ SV *sv, MAGIC *mg) 187coro_cv_free (pTHX_ SV *sv, MAGIC *mg)
270{ 188{
271 AV *padlist; 189 AV *padlist;
272 AV *av = (AV *)mg->mg_obj; 190 AV *av = (AV *)mg->mg_obj;
273 191
… …
283#define PERL_MAGIC_coro PERL_MAGIC_ext 201#define PERL_MAGIC_coro PERL_MAGIC_ext
284 202
285static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free}; 203static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free};
286 204
287/* the next two functions merely cache the padlists */ 205/* the next two functions merely cache the padlists */
288STATIC void 206static void
289get_padlist (pTHX_ CV *cv) 207get_padlist (pTHX_ CV *cv)
290{ 208{
291 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 209 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
292 210
293 if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0) 211 if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0)
294 CvPADLIST (cv) = (AV *)av_pop ((AV *)mg->mg_obj); 212 CvPADLIST (cv) = (AV *)av_pop ((AV *)mg->mg_obj);
295 else 213 else
214 {
215#if 0
216 /* this should work - but it doesn't :( */
217 CV *cp = Perl_cv_clone (aTHX_ cv);
218 CvPADLIST (cv) = CvPADLIST (cp);
219 CvPADLIST (cp) = 0;
220 SvREFCNT_dec (cp);
221#else
296 CvPADLIST (cv) = clone_padlist (aTHX_ CvPADLIST (cv)); 222 CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv);
223#endif
224 }
297} 225}
298 226
299STATIC void 227static void
300put_padlist (pTHX_ CV *cv) 228put_padlist (pTHX_ CV *cv)
301{ 229{
302 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 230 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
303 231
304 if (!mg) 232 if (!mg)
… …
421 } 349 }
422 350
423 PUSHs ((SV *)CvPADLIST(cv)); 351 PUSHs ((SV *)CvPADLIST(cv));
424 PUSHs ((SV *)cv); 352 PUSHs ((SV *)cv);
425 353
426 get_padlist (aTHX_ cv); /* this is a monster */ 354 get_padlist (aTHX_ cv);
427 } 355 }
428 } 356 }
429#ifdef CXt_FORMAT 357#ifdef CXt_FORMAT
430 else if (CxTYPE(cx) == CXt_FORMAT) 358 else if (CxTYPE(cx) == CXt_FORMAT)
431 { 359 {
… …
491 * allocate various perl stacks. This is an exact copy 419 * allocate various perl stacks. This is an exact copy
492 * of perl.c:init_stacks, except that it uses less memory 420 * of perl.c:init_stacks, except that it uses less memory
493 * on the (sometimes correct) assumption that coroutines do 421 * on the (sometimes correct) assumption that coroutines do
494 * not usually need a lot of stackspace. 422 * not usually need a lot of stackspace.
495 */ 423 */
496STATIC void 424static void
497coro_init_stacks (pTHX) 425coro_init_stacks (pTHX)
498{ 426{
499 LOCK; 427 LOCK;
500 428
501 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1); 429 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1);
… …
538} 466}
539 467
540/* 468/*
541 * destroy the stacks, the callchain etc... 469 * destroy the stacks, the callchain etc...
542 */ 470 */
543STATIC void 471static void
544destroy_stacks(pTHX) 472destroy_stacks(pTHX)
545{ 473{
546 if (!IN_DESTRUCT) 474 if (!IN_DESTRUCT)
547 { 475 {
548 /* is this ugly, I ask? */ 476 /* is this ugly, I ask? */
… …
716 CALLRUNOPS(aTHX); 644 CALLRUNOPS(aTHX);
717 645
718 abort (); 646 abort ();
719} 647}
720 648
721STATIC void 649static void
722transfer (pTHX_ struct coro *prev, struct coro *next, int flags) 650transfer (pTHX_ struct coro *prev, struct coro *next, int flags)
723{ 651{
724 dSTACKLEVEL; 652 dSTACKLEVEL;
725 653
726 if (prev != next) 654 if (prev != next)

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines