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.117 by root, Fri Dec 1 19:41:06 2006 UTC vs.
Revision 1.133 by root, Thu Jan 4 20:14:19 2007 UTC

4#include "perl.h" 4#include "perl.h"
5#include "XSUB.h" 5#include "XSUB.h"
6 6
7#include "patchlevel.h" 7#include "patchlevel.h"
8 8
9#if USE_VALGRIND
10# include <valgrind/valgrind.h>
11#endif
12
13/* the maximum number of idle cctx that will be pooled */
14#define MAX_IDLE_CCTX 8
15
16#define PERL_VERSION_ATLEAST(a,b,c) \
17 (PERL_REVISION > (a) \
18 || (PERL_REVISION == (a) \
19 && (PERL_VERSION > (b) \
20 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
21
22#if !PERL_VERSION_ATLEAST (5,6,0)
23# ifndef PL_ppaddr
24# define PL_ppaddr ppaddr
25# endif
26# ifndef call_sv
27# define call_sv perl_call_sv
28# endif
29# ifndef get_sv
30# define get_sv perl_get_sv
31# endif
32# ifndef get_cv
33# define get_cv perl_get_cv
34# endif
35# ifndef IS_PADGV
36# define IS_PADGV(v) 0
37# endif
38# ifndef IS_PADCONST
39# define IS_PADCONST(v) 0
40# endif
41#endif
42
43#include <stdio.h> 9#include <stdio.h>
44#include <errno.h> 10#include <errno.h>
45 11#include <assert.h>
46#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
47# undef STACKGUARD
48#endif
49
50#ifndef STACKGUARD
51# define STACKGUARD 0
52#endif
53 12
54#ifdef HAVE_MMAP 13#ifdef HAVE_MMAP
55# include <unistd.h> 14# include <unistd.h>
56# include <sys/mman.h> 15# include <sys/mman.h>
57# ifndef MAP_ANONYMOUS 16# ifndef MAP_ANONYMOUS
72#else 31#else
73# define PAGESIZE 0 32# define PAGESIZE 0
74# define BOOT_PAGESIZE (void)0 33# define BOOT_PAGESIZE (void)0
75#endif 34#endif
76 35
36#if USE_VALGRIND
37# include <valgrind/valgrind.h>
38#endif
39
40/* the maximum number of idle cctx that will be pooled */
41#define MAX_IDLE_CCTX 8
42
43#define PERL_VERSION_ATLEAST(a,b,c) \
44 (PERL_REVISION > (a) \
45 || (PERL_REVISION == (a) \
46 && (PERL_VERSION > (b) \
47 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
48
49#if !PERL_VERSION_ATLEAST (5,6,0)
50# ifndef PL_ppaddr
51# define PL_ppaddr ppaddr
52# endif
53# ifndef call_sv
54# define call_sv perl_call_sv
55# endif
56# ifndef get_sv
57# define get_sv perl_get_sv
58# endif
59# ifndef get_cv
60# define get_cv perl_get_cv
61# endif
62# ifndef IS_PADGV
63# define IS_PADGV(v) 0
64# endif
65# ifndef IS_PADCONST
66# define IS_PADCONST(v) 0
67# endif
68#endif
69
70/* 5.8.7 */
71#ifndef SvRV_set
72# define SvRV_set(s,v) SvRV(s) = (v)
73#endif
74
75#if !__i386 && !__x86_64 && !__powerpc && !__m68k && !__alpha && !__mips && !__sparc64
76# undef STACKGUARD
77#endif
78
79#ifndef STACKGUARD
80# define STACKGUARD 0
81#endif
82
83/* prefer perl internal functions over our own? */
84#ifndef PREFER_PERL_FUNCTIONS
85# define PREFER_PERL_FUNCTIONS 0
86#endif
87
77/* The next macro should declare a variable stacklevel that contains and approximation 88/* The next macro should declare a variable stacklevel that contains and approximation
78 * to the current C stack pointer. Its property is that it changes with each call 89 * to the current C stack pointer. Its property is that it changes with each call
79 * and should be unique. */ 90 * and should be unique. */
80#define dSTACKLEVEL int stacklevel 91#define dSTACKLEVEL int stacklevel
81#define STACKLEVEL ((void *)&stacklevel) 92#define STACKLEVEL ((void *)&stacklevel)
82 93
83#define IN_DESTRUCT (PL_main_cv == Nullcv) 94#define IN_DESTRUCT (PL_main_cv == Nullcv)
84 95
85#if __GNUC__ >= 3 96#if __GNUC__ >= 3
86# define attribute(x) __attribute__(x) 97# define attribute(x) __attribute__(x)
98# define BARRIER __asm__ __volatile__ ("" : : : "memory")
87#else 99#else
88# define attribute(x) 100# define attribute(x)
101# define BARRIER
89#endif 102#endif
90 103
91#define NOINLINE attribute ((noinline)) 104#define NOINLINE attribute ((noinline))
92 105
93#include "CoroAPI.h" 106#include "CoroAPI.h"
94
95#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */
96 107
97#ifdef USE_ITHREADS 108#ifdef USE_ITHREADS
98static perl_mutex coro_mutex; 109static perl_mutex coro_mutex;
99# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0) 110# define LOCK do { MUTEX_LOCK (&coro_mutex); } while (0)
100# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0) 111# define UNLOCK do { MUTEX_UNLOCK (&coro_mutex); } while (0)
101#else 112#else
102# define LOCK (void)0 113# define LOCK (void)0
103# define UNLOCK (void)0 114# define UNLOCK (void)0
104#endif 115#endif
105 116
117struct io_state
118{
119 int errorno;
120 I32 laststype;
121 int laststatval;
122 Stat_t statcache;
123};
124
106static struct CoroAPI coroapi; 125static struct CoroAPI coroapi;
107static AV *main_mainstack; /* used to differentiate between $main and others */ 126static AV *main_mainstack; /* used to differentiate between $main and others */
108static HV *coro_state_stash, *coro_stash; 127static HV *coro_state_stash, *coro_stash;
109static SV *coro_mortal; /* will be freed after next transfer */ 128static SV *coro_mortal; /* will be freed after next transfer */
110 129
118 /* the stack */ 137 /* the stack */
119 void *sptr; 138 void *sptr;
120 long ssize; /* positive == mmap, otherwise malloc */ 139 long ssize; /* positive == mmap, otherwise malloc */
121 140
122 /* cpu state */ 141 /* cpu state */
123 void *idle_sp; /* sp of top-level transfer/schedule/cede call */ 142 void *idle_sp; /* sp of top-level transfer/schedule/cede call */
143 JMPENV *idle_te; /* same as idle_sp, but for top_env, TODO: remove once stable */
124 JMPENV *top_env; 144 JMPENV *top_env;
125 coro_context cctx; 145 coro_context cctx;
126 146
127 int inuse; 147 int inuse;
128 148
130 int valgrind_id; 150 int valgrind_id;
131#endif 151#endif
132} coro_cctx; 152} coro_cctx;
133 153
134enum { 154enum {
135 CF_RUNNING = 0x0001, /* coroutine is running */ 155 CF_RUNNING = 0x0001, /* coroutine is running */
136 CF_READY = 0x0002, /* coroutine is ready */ 156 CF_READY = 0x0002, /* coroutine is ready */
137 CF_NEW = 0x0004, /* ahs never been switched to */ 157 CF_NEW = 0x0004, /* has never been switched to */
158 CF_DESTROYED = 0x0008, /* coroutine data has been freed */
138}; 159};
139 160
140/* this is a structure representing a perl-level coroutine */ 161/* this is a structure representing a perl-level coroutine */
141struct coro { 162struct coro {
142 /* the c coroutine allocated to this perl coroutine, if any */ 163 /* the c coroutine allocated to this perl coroutine, if any */
143 coro_cctx *cctx; 164 coro_cctx *cctx;
144 165
145 /* data associated with this coroutine (initial args) */ 166 /* data associated with this coroutine (initial args) */
146 AV *args; 167 AV *args;
147 int refcnt; 168 int refcnt;
148 int flags; 169 int save; /* CORO_SAVE flags */
170 int flags; /* CF_ flags */
149 171
150 /* optionally saved, might be zero */ 172 /* optionally saved, might be zero */
151 AV *defav; 173 AV *defav; /* @_ */
152 SV *defsv; 174 SV *defsv; /* $_ */
153 SV *errsv; 175 SV *errsv; /* $@ */
176 SV *irssv; /* $/ */
177 SV *irssv_sv; /* real $/ cache */
154 178
155#define VAR(name,type) type name; 179#define VAR(name,type) type name;
156# include "state.h" 180# include "state.h"
157#undef VAR 181#undef VAR
158 182
244 268
245 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0) 269 if (mg && AvFILLp ((av = (AV *)mg->mg_obj)) >= 0)
246 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--]; 270 CvPADLIST (cv) = (AV *)AvARRAY (av)[AvFILLp (av)--];
247 else 271 else
248 { 272 {
249#if 0 273#if PREFER_PERL_FUNCTIONS
250 /* this is probably cleaner, but also slower? */ 274 /* this is probably cleaner, but also slower? */
251 CV *cp = Perl_cv_clone (cv); 275 CV *cp = Perl_cv_clone (cv);
252 CvPADLIST (cv) = CvPADLIST (cp); 276 CvPADLIST (cv) = CvPADLIST (cp);
253 CvPADLIST (cp) = 0; 277 CvPADLIST (cp) = 0;
254 SvREFCNT_dec (cp); 278 SvREFCNT_dec (cp);
281} 305}
282 306
283#define SB do { 307#define SB do {
284#define SE } while (0) 308#define SE } while (0)
285 309
286#define LOAD(state) load_state ((state))
287#define SAVE(state,flags) save_state ((state),(flags))
288
289#define REPLACE_SV(sv,val) SB SvREFCNT_dec (sv); (sv) = (val); (val) = 0; SE 310#define REPLACE_SV(sv,val) SB SvREFCNT_dec (sv); (sv) = (val); (val) = 0; SE
290 311
291static void 312static void
292load_state (Coro__State c) 313load_perl (Coro__State c)
293{ 314{
294#define VAR(name,type) PL_ ## name = c->name; 315#define VAR(name,type) PL_ ## name = c->name;
295# include "state.h" 316# include "state.h"
296#undef VAR 317#undef VAR
297 318
298 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav); 319 if (c->defav) REPLACE_SV (GvAV (PL_defgv), c->defav);
299 if (c->defsv) REPLACE_SV (DEFSV , c->defsv); 320 if (c->defsv) REPLACE_SV (DEFSV , c->defsv);
300 if (c->errsv) REPLACE_SV (ERRSV , c->errsv); 321 if (c->errsv) REPLACE_SV (ERRSV , c->errsv);
322 if (c->irssv)
323 {
324 if (c->irssv == PL_rs || sv_eq (PL_rs, c->irssv))
325 SvREFCNT_dec (c->irssv);
326 else
327 {
328 REPLACE_SV (PL_rs, c->irssv);
329 if (!c->irssv_sv) c->irssv_sv = get_sv ("/", 0);
330 sv_setsv (c->irssv_sv, PL_rs);
331 }
332 }
301 333
302 { 334 {
303 dSP; 335 dSP;
304 CV *cv; 336 CV *cv;
305 337
314 PUTBACK; 346 PUTBACK;
315 } 347 }
316} 348}
317 349
318static void 350static void
319save_state (Coro__State c, int flags) 351save_perl (Coro__State c)
320{ 352{
321 { 353 {
322 dSP; 354 dSP;
323 I32 cxix = cxstack_ix; 355 I32 cxix = cxstack_ix;
324 PERL_CONTEXT *ccstk = cxstack; 356 PERL_CONTEXT *ccstk = cxstack;
327 /* 359 /*
328 * the worst thing you can imagine happens first - we have to save 360 * the worst thing you can imagine happens first - we have to save
329 * (and reinitialize) all cv's in the whole callchain :( 361 * (and reinitialize) all cv's in the whole callchain :(
330 */ 362 */
331 363
364 EXTEND (SP, 3 + 1);
332 PUSHs (Nullsv); 365 PUSHs (Nullsv);
333 /* this loop was inspired by pp_caller */ 366 /* this loop was inspired by pp_caller */
334 for (;;) 367 for (;;)
335 { 368 {
336 while (cxix >= 0) 369 while (cxix >= 0)
342 CV *cv = cx->blk_sub.cv; 375 CV *cv = cx->blk_sub.cv;
343 376
344 if (CvDEPTH (cv)) 377 if (CvDEPTH (cv))
345 { 378 {
346 EXTEND (SP, 3); 379 EXTEND (SP, 3);
347
348 PUSHs ((SV *)CvPADLIST (cv)); 380 PUSHs ((SV *)CvPADLIST (cv));
349 PUSHs (INT2PTR (SV *, CvDEPTH (cv))); 381 PUSHs (INT2PTR (SV *, CvDEPTH (cv)));
350 PUSHs ((SV *)cv); 382 PUSHs ((SV *)cv);
351 383
352 CvDEPTH (cv) = 0; 384 CvDEPTH (cv) = 0;
353 get_padlist (cv); 385 get_padlist (cv);
354 } 386 }
355 } 387 }
356#ifdef CXt_FORMAT
357 else if (CxTYPE (cx) == CXt_FORMAT)
358 {
359 /* I never used formats, so how should I know how these are implemented? */
360 /* my bold guess is as a simple, plain sub... */
361 croak ("CXt_FORMAT not yet handled. Don't switch coroutines from within formats");
362 }
363#endif
364 } 388 }
365 389
366 if (top_si->si_type == PERLSI_MAIN) 390 if (top_si->si_type == PERLSI_MAIN)
367 break; 391 break;
368 392
372 } 396 }
373 397
374 PUTBACK; 398 PUTBACK;
375 } 399 }
376 400
377 c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0; 401 c->defav = c->save & CORO_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0;
378 c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0; 402 c->defsv = c->save & CORO_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0;
379 c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0; 403 c->errsv = c->save & CORO_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0;
404 c->irssv = c->save & CORO_SAVE_IRSSV ? SvREFCNT_inc (PL_rs) : 0;
380 405
381#define VAR(name,type)c->name = PL_ ## name; 406#define VAR(name,type)c->name = PL_ ## name;
382# include "state.h" 407# include "state.h"
383#undef VAR 408#undef VAR
384} 409}
387 * allocate various perl stacks. This is an exact copy 412 * allocate various perl stacks. This is an exact copy
388 * of perl.c:init_stacks, except that it uses less memory 413 * of perl.c:init_stacks, except that it uses less memory
389 * on the (sometimes correct) assumption that coroutines do 414 * on the (sometimes correct) assumption that coroutines do
390 * not usually need a lot of stackspace. 415 * not usually need a lot of stackspace.
391 */ 416 */
417#if PREFER_PERL_FUNCTIONS
418# define coro_init_stacks init_stacks
419#else
392static void 420static void
393coro_init_stacks () 421coro_init_stacks ()
394{ 422{
395 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT)); 423 PL_curstackinfo = new_stackinfo(128, 1024/sizeof(PERL_CONTEXT));
396 PL_curstackinfo->si_type = PERLSI_MAIN; 424 PL_curstackinfo->si_type = PERLSI_MAIN;
426 New(54,PL_retstack,16,OP*); 454 New(54,PL_retstack,16,OP*);
427 PL_retstack_ix = 0; 455 PL_retstack_ix = 0;
428 PL_retstack_max = 16; 456 PL_retstack_max = 16;
429#endif 457#endif
430} 458}
459#endif
431 460
432/* 461/*
433 * destroy the stacks, the callchain etc... 462 * destroy the stacks, the callchain etc...
434 */ 463 */
435static void 464static void
436coro_destroy_stacks () 465coro_destroy_stacks ()
437{ 466{
438 if (!IN_DESTRUCT) 467 if (!IN_DESTRUCT)
439 { 468 {
440 /* is this ugly, I ask? */ 469 /* restore all saved variables and stuff */
441 LEAVE_SCOPE (0); 470 LEAVE_SCOPE (0);
471 assert (PL_tmps_floor == -1);
442 472
443 /* sure it is, but more important: is it correct?? :/ */ 473 /* free all temporaries */
444 FREETMPS; 474 FREETMPS;
475 assert (PL_tmps_ix == -1);
445 476
446 /*POPSTACK_TO (PL_mainstack);*//*D*//*use*/ 477 POPSTACK_TO (PL_mainstack);
447 } 478 }
448 479
449 while (PL_curstackinfo->si_next) 480 while (PL_curstackinfo->si_next)
450 PL_curstackinfo = PL_curstackinfo->si_next; 481 PL_curstackinfo = PL_curstackinfo->si_next;
451 482
452 while (PL_curstackinfo) 483 while (PL_curstackinfo)
453 { 484 {
454 PERL_SI *p = PL_curstackinfo->si_prev; 485 PERL_SI *p = PL_curstackinfo->si_prev;
455 486
456 { /*D*//*remove*/
457 dSP;
458 SWITCHSTACK (PL_curstack, PL_curstackinfo->si_stack);
459 PUTBACK; /* possibly superfluous */
460 }
461
462 if (!IN_DESTRUCT) 487 if (!IN_DESTRUCT)
463 {
464 dounwind (-1);/*D*//*remove*/
465 SvREFCNT_dec (PL_curstackinfo->si_stack); 488 SvREFCNT_dec (PL_curstackinfo->si_stack);
466 }
467 489
468 Safefree (PL_curstackinfo->si_cxstack); 490 Safefree (PL_curstackinfo->si_cxstack);
469 Safefree (PL_curstackinfo); 491 Safefree (PL_curstackinfo);
470 PL_curstackinfo = p; 492 PL_curstackinfo = p;
471 } 493 }
497 519
498 { 520 {
499 dSP; 521 dSP;
500 LOGOP myop; 522 LOGOP myop;
501 523
502 /* I have no idea why this is needed, but it is */
503 PUSHMARK (SP);
504
505 SvREFCNT_dec (GvAV (PL_defgv)); 524 SvREFCNT_dec (GvAV (PL_defgv));
506 GvAV (PL_defgv) = coro->args; coro->args = 0; 525 GvAV (PL_defgv) = coro->args; coro->args = 0;
507 526
508 Zero (&myop, 1, LOGOP); 527 Zero (&myop, 1, LOGOP);
509 myop.op_next = Nullop; 528 myop.op_next = Nullop;
510 myop.op_flags = OPf_WANT_VOID; 529 myop.op_flags = OPf_WANT_VOID;
511 530
512 PL_op = (OP *)&myop;
513
514 PUSHMARK (SP); 531 PUSHMARK (SP);
515 XPUSHs ((SV *)get_cv ("Coro::State::_coro_init", FALSE)); 532 XPUSHs ((SV *)get_cv ("Coro::State::_coro_init", FALSE));
516 PUTBACK; 533 PUTBACK;
534 PL_op = (OP *)&myop;
517 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX); 535 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
518 SPAGAIN; 536 SPAGAIN;
519 } 537 }
520 538
521 ENTER; /* necessary e.g. for dounwind */ 539 ENTER; /* necessary e.g. for dounwind */
529 SvREFCNT_dec (coro_mortal); 547 SvREFCNT_dec (coro_mortal);
530 coro_mortal = 0; 548 coro_mortal = 0;
531 } 549 }
532} 550}
533 551
552/* inject a fake call to Coro::State::_cctx_init into the execution */
534static void NOINLINE 553static void NOINLINE
535prepare_cctx (coro_cctx *cctx) 554prepare_cctx (coro_cctx *cctx)
536{ 555{
537 dSP; 556 dSP;
538 LOGOP myop; 557 LOGOP myop;
539 558
540 Zero (&myop, 1, LOGOP); 559 Zero (&myop, 1, LOGOP);
541 myop.op_next = PL_op; 560 myop.op_next = PL_op;
542 myop.op_flags = OPf_WANT_VOID; 561 myop.op_flags = OPf_WANT_VOID | OPf_STACKED;
543
544 sv_setiv (get_sv ("Coro::State::_cctx", FALSE), PTR2IV (cctx));
545 562
546 PUSHMARK (SP); 563 PUSHMARK (SP);
564 EXTEND (SP, 2);
565 PUSHs (sv_2mortal (newSViv (PTR2IV (cctx))));
547 XPUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE)); 566 PUSHs ((SV *)get_cv ("Coro::State::_cctx_init", FALSE));
548 PUTBACK; 567 PUTBACK;
568 PL_op = (OP *)&myop;
549 PL_restartop = PL_ppaddr[OP_ENTERSUB](aTHX); 569 PL_op = PL_ppaddr[OP_ENTERSUB](aTHX);
550 SPAGAIN; 570 SPAGAIN;
551} 571}
552 572
553static void 573static void
554coro_run (void *arg) 574coro_run (void *arg)
555{ 575{
556 /* coro_run is the alternative epilogue of transfer() */ 576 /* coro_run is the alternative tail of transfer(), so unlock here. */
557 UNLOCK; 577 UNLOCK;
558 578
559 /* 579 /*
560 * this is a _very_ stripped down perl interpreter ;) 580 * this is a _very_ stripped down perl interpreter ;)
561 */ 581 */
563 583
564 /* inject call to cctx_init */ 584 /* inject call to cctx_init */
565 prepare_cctx ((coro_cctx *)arg); 585 prepare_cctx ((coro_cctx *)arg);
566 586
567 /* somebody will hit me for both perl_run and PL_restartop */ 587 /* somebody will hit me for both perl_run and PL_restartop */
588 PL_restartop = PL_op;
568 perl_run (PL_curinterp); 589 perl_run (PL_curinterp);
569 590
570 fputs ("FATAL: C coroutine fell over the edge of the world, aborting. Did you call exit in a coroutine?\n", stderr); 591 fputs ("FATAL: C coroutine fell over the edge of the world, aborting. Did you call exit in a coroutine?\n", stderr);
571 abort (); 592 abort ();
572} 593}
576{ 597{
577 coro_cctx *cctx; 598 coro_cctx *cctx;
578 599
579 ++cctx_count; 600 ++cctx_count;
580 601
581 New (0, cctx, 1, coro_cctx); 602 Newz (0, cctx, 1, coro_cctx);
582 603
583#if HAVE_MMAP 604#if HAVE_MMAP
584 605
585 cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE; 606 cctx->ssize = ((STACKSIZE * sizeof (long) + PAGESIZE - 1) / PAGESIZE + STACKGUARD) * PAGESIZE;
586 /* mmap suppsedly does allocate-on-write for us */ 607 /* mmap supposedly does allocate-on-write for us */
587 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0); 608 cctx->sptr = mmap (0, cctx->ssize, PROT_EXEC|PROT_READ|PROT_WRITE, MAP_PRIVATE|MAP_ANONYMOUS, 0, 0);
588 609
589 if (cctx->sptr == (void *)-1) 610 if (cctx->sptr == (void *)-1)
590 { 611 {
591 perror ("FATAL: unable to mmap stack for coroutine"); 612 perror ("FATAL: unable to mmap stack for coroutine");
681 cctx_first = cctx; 702 cctx_first = cctx;
682} 703}
683 704
684/* never call directly, always through the coro_state_transfer global variable */ 705/* never call directly, always through the coro_state_transfer global variable */
685static void NOINLINE 706static void NOINLINE
686transfer (struct coro *prev, struct coro *next, int flags) 707transfer (struct coro *prev, struct coro *next)
687{ 708{
688 dSTACKLEVEL; 709 dSTACKLEVEL;
689 710
690 /* sometimes transfer is only called to set idle_sp */ 711 /* sometimes transfer is only called to set idle_sp */
691 if (flags == TRANSFER_SET_STACKLEVEL) 712 if (!next)
713 {
692 ((coro_cctx *)prev)->idle_sp = STACKLEVEL; 714 ((coro_cctx *)prev)->idle_sp = STACKLEVEL;
715 assert (((coro_cctx *)prev)->idle_te = PL_top_env); /* just for the side-effect when asserts are enabled */
716 }
693 else if (prev != next) 717 else if (prev != next)
694 { 718 {
695 coro_cctx *prev__cctx; 719 coro_cctx *prev__cctx;
696 720
697 if (prev->flags & CF_NEW) 721 if (prev->flags & CF_NEW)
708 croak ("Coro::State::transfer called with non-running prev Coro::State, but can only transfer from running states"); 732 croak ("Coro::State::transfer called with non-running prev Coro::State, but can only transfer from running states");
709 733
710 if (next->flags & CF_RUNNING) 734 if (next->flags & CF_RUNNING)
711 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states"); 735 croak ("Coro::State::transfer called with running next Coro::State, but can only transfer to inactive states");
712 736
737 if (next->flags & CF_DESTROYED)
738 croak ("Coro::State::transfer called with destroyed next Coro::State, but can only transfer to inactive states");
739
713 prev->flags &= ~CF_RUNNING; 740 prev->flags &= ~CF_RUNNING;
714 next->flags |= CF_RUNNING; 741 next->flags |= CF_RUNNING;
715 742
716 LOCK; 743 LOCK;
717 744
718 if (next->mainstack) 745 if (next->flags & CF_NEW)
719 { 746 {
720 /* coroutine already started */ 747 /* need to start coroutine */
721 SAVE (prev, flags); 748 next->flags &= ~CF_NEW;
722 LOAD (next); 749 /* first get rid of the old state */
750 save_perl (prev);
751 /* setup coroutine call */
752 setup_coro (next);
753 /* need a new stack */
754 assert (!next->cctx);
723 } 755 }
724 else 756 else
725 { 757 {
726 /* need to start coroutine */ 758 /* coroutine already started */
727 assert (next->flags & CF_NEW); 759 save_perl (prev);
728 next->flags &= ~CF_NEW; 760 load_perl (next);
729 /* first get rid of the old state */
730 SAVE (prev, -1);
731 /* setup coroutine call */
732 setup_coro (next);
733 /* need a new stack */
734 assert (!next->stack);
735 } 761 }
736 762
737 prev__cctx = prev->cctx; 763 prev__cctx = prev->cctx;
738 764
739 /* possibly "free" the cctx */ 765 /* possibly "free" the cctx */
740 if (prev__cctx->idle_sp == STACKLEVEL && 0) 766 if (prev__cctx->idle_sp == STACKLEVEL)
741 { 767 {
742 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */ 768 /* I assume that STACKLEVEL is a stronger indicator than PL_top_env changes */
743 assert (PL_top_env == prev__cctx->top_env); 769 assert (("ERROR: current top_env must equal previous top_env", PL_top_env == prev__cctx->idle_te));
744 770
745 prev->cctx = 0; 771 prev->cctx = 0;
746 772
747 cctx_put (prev__cctx); 773 cctx_put (prev__cctx);
748 prev__cctx->inuse = 0; 774 prev__cctx->inuse = 0;
761 PL_top_env = next->cctx->top_env; 787 PL_top_env = next->cctx->top_env;
762 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx); 788 coro_transfer (&prev__cctx->cctx, &next->cctx->cctx);
763 } 789 }
764 790
765 free_coro_mortal (); 791 free_coro_mortal ();
766
767 UNLOCK; 792 UNLOCK;
768 } 793 }
769} 794}
770 795
771struct transfer_args 796struct transfer_args
772{ 797{
773 struct coro *prev, *next; 798 struct coro *prev, *next;
774 int flags;
775}; 799};
776 800
777#define TRANSFER(ta) transfer ((ta).prev, (ta).next, (ta).flags) 801#define TRANSFER(ta) transfer ((ta).prev, (ta).next)
778 802
779static void 803static int
780coro_state_destroy (struct coro *coro) 804coro_state_destroy (struct coro *coro)
781{ 805{
782 if (coro->refcnt--) 806 if (coro->refcnt--)
783 return; 807 return 0;
808
809 if (coro->flags & CF_DESTROYED)
810 return 0;
811
812 coro->flags |= CF_DESTROYED;
784 813
785 if (coro->mainstack && coro->mainstack != main_mainstack) 814 if (coro->mainstack && coro->mainstack != main_mainstack)
786 { 815 {
816 assert (!(coro->flags & CF_RUNNING));
817
787 struct coro temp; 818 struct coro temp;
819 Zero (&temp, 1, struct coro);
820 temp.save = CORO_SAVE_ALL;
788 821
789 if (coro->flags & CF_RUNNING) 822 if (coro->flags & CF_RUNNING)
790 croak ("FATAL: tried to destroy currently running coroutine"); 823 croak ("FATAL: tried to destroy currently running coroutine");
791 824
792 SAVE ((&temp), TRANSFER_SAVE_ALL); 825 save_perl (&temp);
793 LOAD (coro); 826 load_perl (coro);
794 827
795 coro_destroy_stacks (); 828 coro_destroy_stacks ();
796 829
797 LOAD ((&temp)); /* this will get rid of defsv etc.. */ 830 load_perl (&temp); /* this will get rid of defsv etc.. */
798 831
799 coro->mainstack = 0; 832 coro->mainstack = 0;
800 } 833 }
801 834
802 cctx_destroy (coro->cctx); 835 cctx_destroy (coro->cctx);
803 SvREFCNT_dec (coro->args); 836 SvREFCNT_dec (coro->args);
804 Safefree (coro); 837
838 return 1;
805} 839}
806 840
807static int 841static int
808coro_state_clear (pTHX_ SV *sv, MAGIC *mg) 842coro_state_clear (pTHX_ SV *sv, MAGIC *mg)
809{ 843{
810 struct coro *coro = (struct coro *)mg->mg_ptr; 844 struct coro *coro = (struct coro *)mg->mg_ptr;
811 mg->mg_ptr = 0; 845 mg->mg_ptr = 0;
812 846
813 coro_state_destroy (coro); 847 coro_state_destroy (coro);
848
849 if (!coro->refcnt)
850 Safefree (coro);
814 851
815 return 0; 852 return 0;
816} 853}
817 854
818static int 855static int
857 assert (mg->mg_type == PERL_MAGIC_ext); 894 assert (mg->mg_type == PERL_MAGIC_ext);
858 return (struct coro *)mg->mg_ptr; 895 return (struct coro *)mg->mg_ptr;
859} 896}
860 897
861static void 898static void
862prepare_transfer (struct transfer_args *ta, SV *prev, SV *next, int flags) 899prepare_transfer (struct transfer_args *ta, SV *prev_sv, SV *next_sv)
863{ 900{
864 ta->prev = SvSTATE (prev); 901 ta->prev = SvSTATE (prev_sv);
865 ta->next = SvSTATE (next); 902 ta->next = SvSTATE (next_sv);
866 ta->flags = flags;
867} 903}
868 904
869static void 905static void
870api_transfer (SV *prev, SV *next, int flags) 906api_transfer (SV *prev_sv, SV *next_sv)
871{ 907{
872 struct transfer_args ta; 908 struct transfer_args ta;
873 909
874 prepare_transfer (&ta, prev, next, flags); 910 prepare_transfer (&ta, prev_sv, next_sv);
875 TRANSFER (ta); 911 TRANSFER (ta);
912}
913
914static int
915api_save (SV *coro_sv, int new_save)
916{
917 struct coro *coro = SvSTATE (coro_sv);
918 int old_save = coro->save;
919
920 if (new_save >= 0)
921 coro->save = new_save;
922
923 return old_save;
876} 924}
877 925
878/** Coro ********************************************************************/ 926/** Coro ********************************************************************/
879 927
880#define PRIO_MAX 3 928#define PRIO_MAX 3
926 coro = SvSTATE (coro_sv); 974 coro = SvSTATE (coro_sv);
927 975
928 if (coro->flags & CF_READY) 976 if (coro->flags & CF_READY)
929 return 0; 977 return 0;
930 978
931#if 0 /* this is actually harmless */
932 if (coro->flags & CF_RUNNING)
933 croak ("Coro::ready called on currently running coroutine");
934#endif
935
936 coro->flags |= CF_READY; 979 coro->flags |= CF_READY;
937 980
938 LOCK; 981 LOCK;
939 coro_enq (SvREFCNT_inc (coro_sv)); 982 coro_enq (SvREFCNT_inc (coro_sv));
940 UNLOCK; 983 UNLOCK;
943} 986}
944 987
945static int 988static int
946api_is_ready (SV *coro_sv) 989api_is_ready (SV *coro_sv)
947{ 990{
948 return !!SvSTATE (coro_sv)->flags & CF_READY; 991 return !!(SvSTATE (coro_sv)->flags & CF_READY);
949} 992}
950 993
951static void 994static void
952prepare_schedule (struct transfer_args *ta) 995prepare_schedule (struct transfer_args *ta)
953{ 996{
954 SV *prev, *next; 997 SV *prev_sv, *next_sv;
955 998
956 for (;;) 999 for (;;)
957 { 1000 {
958 LOCK; 1001 LOCK;
959 next = coro_deq (PRIO_MIN); 1002 next_sv = coro_deq (PRIO_MIN);
960 UNLOCK; 1003 UNLOCK;
961 1004
1005 /* nothing to schedule: call the idle handler */
962 if (next) 1006 if (!next_sv)
963 break;
964
965 { 1007 {
966 dSP; 1008 dSP;
967 1009
968 ENTER; 1010 ENTER;
969 SAVETMPS; 1011 SAVETMPS;
970 1012
971 PUSHMARK (SP); 1013 PUSHMARK (SP);
972 PUTBACK; 1014 PUTBACK;
973 call_sv (get_sv ("Coro::idle", FALSE), G_DISCARD); 1015 call_sv (get_sv ("Coro::idle", FALSE), G_DISCARD);
974 1016
975 FREETMPS; 1017 FREETMPS;
976 LEAVE; 1018 LEAVE;
1019 continue;
977 } 1020 }
978 }
979 1021
980 prev = SvRV (coro_current); 1022 ta->next = SvSTATE (next_sv);
981 SvRV_set (coro_current, next); 1023
1024 /* cannot transfer to destroyed coros, skip and look for next */
1025 if (ta->next->flags & CF_DESTROYED)
1026 {
1027 SvREFCNT_dec (next_sv);
1028 continue;
1029 }
1030
1031 break;
1032 }
982 1033
983 /* free this only after the transfer */ 1034 /* free this only after the transfer */
1035 prev_sv = SvRV (coro_current);
1036 SvRV_set (coro_current, next_sv);
1037 ta->prev = SvSTATE (prev_sv);
1038
1039 assert (ta->next->flags & CF_READY);
1040 ta->next->flags &= ~CF_READY;
1041
984 LOCK; 1042 LOCK;
985 free_coro_mortal (); 1043 free_coro_mortal ();
1044 coro_mortal = prev_sv;
986 UNLOCK; 1045 UNLOCK;
987 coro_mortal = prev;
988
989 assert (!SvROK(prev));//D
990 assert (!SvROK(next));//D
991
992 ta->prev = SvSTATE (prev);
993 ta->next = SvSTATE (next);
994 ta->flags = TRANSFER_SAVE_ALL;
995
996 assert (ta->flags & CF_READY);
997 ta->next->flags &= ~CF_READY;
998} 1046}
999 1047
1000static void 1048static void
1001prepare_cede (struct transfer_args *ta) 1049prepare_cede (struct transfer_args *ta)
1002{ 1050{
1003 api_ready (coro_current); 1051 api_ready (coro_current);
1004
1005 prepare_schedule (ta); 1052 prepare_schedule (ta);
1053}
1054
1055static int
1056prepare_cede_notself (struct transfer_args *ta)
1057{
1058 if (coro_nready)
1059 {
1060 SV *prev = SvRV (coro_current);
1061 prepare_schedule (ta);
1062 api_ready (prev);
1063 return 1;
1064 }
1065 else
1066 return 0;
1006} 1067}
1007 1068
1008static void 1069static void
1009api_schedule (void) 1070api_schedule (void)
1010{ 1071{
1012 1073
1013 prepare_schedule (&ta); 1074 prepare_schedule (&ta);
1014 TRANSFER (ta); 1075 TRANSFER (ta);
1015} 1076}
1016 1077
1017static void 1078static int
1018api_cede (void) 1079api_cede (void)
1019{ 1080{
1020 struct transfer_args ta; 1081 struct transfer_args ta;
1021 1082
1022 prepare_cede (&ta); 1083 prepare_cede (&ta);
1084
1085 if (ta.prev != ta.next)
1086 {
1023 TRANSFER (ta); 1087 TRANSFER (ta);
1088 return 1;
1089 }
1090 else
1091 return 0;
1092}
1093
1094static int
1095api_cede_notself (void)
1096{
1097 struct transfer_args ta;
1098
1099 if (prepare_cede_notself (&ta))
1100 {
1101 TRANSFER (ta);
1102 return 1;
1103 }
1104 else
1105 return 0;
1024} 1106}
1025 1107
1026MODULE = Coro::State PACKAGE = Coro::State 1108MODULE = Coro::State PACKAGE = Coro::State
1027 1109
1028PROTOTYPES: DISABLE 1110PROTOTYPES: DISABLE
1034#endif 1116#endif
1035 BOOT_PAGESIZE; 1117 BOOT_PAGESIZE;
1036 1118
1037 coro_state_stash = gv_stashpv ("Coro::State", TRUE); 1119 coro_state_stash = gv_stashpv ("Coro::State", TRUE);
1038 1120
1039 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV)); 1121 newCONSTSUB (coro_state_stash, "SAVE_DEFAV", newSViv (CORO_SAVE_DEFAV));
1040 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV)); 1122 newCONSTSUB (coro_state_stash, "SAVE_DEFSV", newSViv (CORO_SAVE_DEFSV));
1041 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV)); 1123 newCONSTSUB (coro_state_stash, "SAVE_ERRSV", newSViv (CORO_SAVE_ERRSV));
1124 newCONSTSUB (coro_state_stash, "SAVE_IRSSV", newSViv (CORO_SAVE_IRSSV));
1125 newCONSTSUB (coro_state_stash, "SAVE_ALL", newSViv (CORO_SAVE_ALL));
1042 1126
1043 main_mainstack = PL_mainstack; 1127 main_mainstack = PL_mainstack;
1044 1128
1045 coroapi.ver = CORO_API_VERSION; 1129 coroapi.ver = CORO_API_VERSION;
1046 coroapi.transfer = api_transfer; 1130 coroapi.transfer = api_transfer;
1056 HV *hv; 1140 HV *hv;
1057 int i; 1141 int i;
1058 1142
1059 Newz (0, coro, 1, struct coro); 1143 Newz (0, coro, 1, struct coro);
1060 coro->args = newAV (); 1144 coro->args = newAV ();
1145 coro->save = CORO_SAVE_ALL;
1061 coro->flags = CF_NEW; 1146 coro->flags = CF_NEW;
1062 1147
1063 hv = newHV (); 1148 hv = newHV ();
1064 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP; 1149 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro, 0)->mg_flags |= MGf_DUP;
1065 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 1150 RETVAL = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
1066 1151
1067 for (i = 1; i < items; i++) 1152 for (i = 1; i < items; i++)
1068 av_push (coro->args, newSVsv (ST (i))); 1153 av_push (coro->args, newSVsv (ST (i)));
1069} 1154}
1070 OUTPUT: 1155 OUTPUT:
1156 RETVAL
1157
1158int
1159save (SV *coro, int new_save = -1)
1160 CODE:
1161 RETVAL = api_save (coro, new_save);
1162 OUTPUT:
1071 RETVAL 1163 RETVAL
1072 1164
1073void 1165void
1074_set_stacklevel (...) 1166_set_stacklevel (...)
1075 ALIAS: 1167 ALIAS:
1076 Coro::State::transfer = 1 1168 Coro::State::transfer = 1
1077 Coro::schedule = 2 1169 Coro::schedule = 2
1078 Coro::cede = 3 1170 Coro::cede = 3
1079 Coro::Cont::yield = 4 1171 Coro::cede_notself = 4
1080 CODE: 1172 CODE:
1081{ 1173{
1082 struct transfer_args ta; 1174 struct transfer_args ta;
1083 1175
1084 switch (ix) 1176 switch (ix)
1085 { 1177 {
1086 case 0: 1178 case 0:
1087 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0))); 1179 ta.prev = (struct coro *)INT2PTR (coro_cctx *, SvIV (ST (0)));
1088 ta.next = 0; 1180 ta.next = 0;
1089 ta.flags = TRANSFER_SET_STACKLEVEL;
1090 break; 1181 break;
1091 1182
1092 case 1: 1183 case 1:
1093 if (items != 3) 1184 if (items != 2)
1094 croak ("Coro::State::transfer (prev,next,flags) expects three arguments, not %d", items); 1185 croak ("Coro::State::transfer (prev,next) expects two arguments, not %d", items);
1095 1186
1096 prepare_transfer (&ta, ST (0), ST (1), SvIV (ST (2))); 1187 prepare_transfer (&ta, ST (0), ST (1));
1097 break; 1188 break;
1098 1189
1099 case 2: 1190 case 2:
1100 prepare_schedule (&ta); 1191 prepare_schedule (&ta);
1101 break; 1192 break;
1103 case 3: 1194 case 3:
1104 prepare_cede (&ta); 1195 prepare_cede (&ta);
1105 break; 1196 break;
1106 1197
1107 case 4: 1198 case 4:
1108 { 1199 if (!prepare_cede_notself (&ta))
1109 SV *yieldstack; 1200 XSRETURN_EMPTY;
1110 SV *sv;
1111 AV *defav = GvAV (PL_defgv);
1112 1201
1113 yieldstack = *hv_fetch (
1114 (HV *)SvRV (coro_current),
1115 "yieldstack", sizeof ("yieldstack") - 1,
1116 0
1117 );
1118
1119 /* set up @_ -- ugly */
1120 av_clear (defav);
1121 av_fill (defav, items - 1);
1122 while (items--)
1123 av_store (defav, items, SvREFCNT_inc (ST(items)));
1124
1125 sv = av_pop ((AV *)SvRV (yieldstack));
1126 ta.prev = SvSTATE (*av_fetch ((AV *)SvRV (sv), 0, 0));
1127 ta.next = SvSTATE (*av_fetch ((AV *)SvRV (sv), 1, 0));
1128 ta.flags = 0;
1129 SvREFCNT_dec (sv);
1130 }
1131 break; 1202 break;
1132
1133 } 1203 }
1134 1204
1205 BARRIER;
1135 TRANSFER (ta); 1206 TRANSFER (ta);
1136} 1207}
1137 1208
1138void 1209bool
1139_clone_state_from (SV *dst, SV *src) 1210_destroy (SV *coro_sv)
1140 CODE: 1211 CODE:
1141{ 1212 RETVAL = coro_state_destroy (SvSTATE (coro_sv));
1142 struct coro *coro_src = SvSTATE (src); 1213 OUTPUT:
1143 1214 RETVAL
1144 sv_unmagic (SvRV (dst), PERL_MAGIC_ext);
1145
1146 ++coro_src->refcnt;
1147 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP;
1148}
1149 1215
1150void 1216void
1151_exit (code) 1217_exit (code)
1152 int code 1218 int code
1153 PROTOTYPE: $ 1219 PROTOTYPE: $
1190 coro_ready[i] = newAV (); 1256 coro_ready[i] = newAV ();
1191 1257
1192 { 1258 {
1193 SV *sv = perl_get_sv("Coro::API", 1); 1259 SV *sv = perl_get_sv("Coro::API", 1);
1194 1260
1195 coroapi.schedule = api_schedule; 1261 coroapi.schedule = api_schedule;
1262 coroapi.save = api_save;
1196 coroapi.cede = api_cede; 1263 coroapi.cede = api_cede;
1264 coroapi.cede_notself = api_cede_notself;
1197 coroapi.ready = api_ready; 1265 coroapi.ready = api_ready;
1198 coroapi.is_ready = api_is_ready; 1266 coroapi.is_ready = api_is_ready;
1199 coroapi.nready = &coro_nready; 1267 coroapi.nready = &coro_nready;
1200 coroapi.current = coro_current; 1268 coroapi.current = coro_current;
1201 1269
1202 GCoroAPI = &coroapi; 1270 GCoroAPI = &coroapi;
1203 sv_setiv (sv, (IV)&coroapi); 1271 sv_setiv (sv, (IV)&coroapi);
1204 SvREADONLY_on (sv); 1272 SvREADONLY_on (sv);
1205 } 1273 }
1206} 1274}
1275
1276void
1277_set_current (SV *current)
1278 PROTOTYPE: $
1279 CODE:
1280 SvREFCNT_dec (SvRV (coro_current));
1281 SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
1207 1282
1208int 1283int
1209prio (Coro::State coro, int newprio = 0) 1284prio (Coro::State coro, int newprio = 0)
1210 ALIAS: 1285 ALIAS:
1211 nice = 1 1286 nice = 1
1214 RETVAL = coro->prio; 1289 RETVAL = coro->prio;
1215 1290
1216 if (items > 1) 1291 if (items > 1)
1217 { 1292 {
1218 if (ix) 1293 if (ix)
1219 newprio += coro->prio; 1294 newprio = coro->prio - newprio;
1220 1295
1221 if (newprio < PRIO_MIN) newprio = PRIO_MIN; 1296 if (newprio < PRIO_MIN) newprio = PRIO_MIN;
1222 if (newprio > PRIO_MAX) newprio = PRIO_MAX; 1297 if (newprio > PRIO_MAX) newprio = PRIO_MAX;
1223 1298
1224 coro->prio = newprio; 1299 coro->prio = newprio;
1225 } 1300 }
1226} 1301}
1302 OUTPUT:
1303 RETVAL
1227 1304
1228SV * 1305SV *
1229ready (SV *self) 1306ready (SV *self)
1230 PROTOTYPE: $ 1307 PROTOTYPE: $
1231 CODE: 1308 CODE:
1247 CODE: 1324 CODE:
1248 RETVAL = coro_nready; 1325 RETVAL = coro_nready;
1249 OUTPUT: 1326 OUTPUT:
1250 RETVAL 1327 RETVAL
1251 1328
1252void
1253_set_current (SV *current)
1254 PROTOTYPE: $
1255 CODE:
1256 SvREFCNT_dec (SvRV (coro_current));
1257 SvRV_set (coro_current, SvREFCNT_inc (SvRV (current)));
1258
1259MODULE = Coro::State PACKAGE = Coro::AIO 1329MODULE = Coro::State PACKAGE = Coro::AIO
1260 1330
1261SV * 1331SV *
1262_get_state () 1332_get_state ()
1263 CODE: 1333 CODE:
1264{ 1334{
1265 struct { 1335 struct io_state *data;
1266 int errorno;
1267 int laststype;
1268 int laststatval;
1269 Stat_t statcache;
1270 } data;
1271 1336
1337 RETVAL = newSV (sizeof (struct io_state));
1338 data = (struct io_state *)SvPVX (RETVAL);
1339 SvCUR_set (RETVAL, sizeof (struct io_state));
1340 SvPOK_only (RETVAL);
1341
1272 data.errorno = errno; 1342 data->errorno = errno;
1273 data.laststype = PL_laststype; 1343 data->laststype = PL_laststype;
1274 data.laststatval = PL_laststatval; 1344 data->laststatval = PL_laststatval;
1275 data.statcache = PL_statcache; 1345 data->statcache = PL_statcache;
1276
1277 RETVAL = newSVpvn ((char *)&data, sizeof data);
1278} 1346}
1279 OUTPUT: 1347 OUTPUT:
1280 RETVAL 1348 RETVAL
1281 1349
1282void 1350void
1283_set_state (char *data_) 1351_set_state (char *data_)
1284 PROTOTYPE: $ 1352 PROTOTYPE: $
1285 CODE: 1353 CODE:
1286{ 1354{
1287 struct { 1355 struct io_state *data = (void *)data_;
1288 int errorno;
1289 int laststype;
1290 int laststatval;
1291 Stat_t statcache;
1292 } *data = (void *)data_;
1293 1356
1294 errno = data->errorno; 1357 errno = data->errorno;
1295 PL_laststype = data->laststype; 1358 PL_laststype = data->laststype;
1296 PL_laststatval = data->laststatval; 1359 PL_laststatval = data->laststatval;
1297 PL_statcache = data->statcache; 1360 PL_statcache = data->statcache;
1298} 1361}
1362

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines