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.99 by root, Sun Nov 26 23:53:20 2006 UTC vs.
Revision 1.100 by root, Mon Nov 27 00:07:49 2006 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 PERL_VERSION < 6 9#define PERL_VERSION_ATLEAST(a,b,c) \
10 (PERL_REVISION > (a) \
11 || (PERL_REVISION == (a) \
12 && (PERL_VERSION > (b) \
13 || (PERL_VERSION == (b) && PERLSUBVERSION >= (c)))))
14
15#if !PERL_VERSION_ATLEAST (5,6,0)
10# ifndef PL_ppaddr 16# ifndef PL_ppaddr
11# define PL_ppaddr ppaddr 17# define PL_ppaddr ppaddr
12# endif 18# endif
13# ifndef call_sv 19# ifndef call_sv
14# define call_sv perl_call_sv 20# define call_sv perl_call_sv
… …
63 * and should be unique. */ 69 * and should be unique. */
64#define dSTACKLEVEL int stacklevel 70#define dSTACKLEVEL int stacklevel
65#define STACKLEVEL ((void *)&stacklevel) 71#define STACKLEVEL ((void *)&stacklevel)
66 72
67#define IN_DESTRUCT (PL_main_cv == Nullcv) 73#define IN_DESTRUCT (PL_main_cv == Nullcv)
74
75#if __GNUC__ >= 3
76# define attribute(x) __attribute__(x)
77#else
78# define attribute(x)
79#endif
80
81#define NOINLINE attribute ((noinline))
68 82
69#include "CoroAPI.h" 83#include "CoroAPI.h"
70 84
71#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */ 85#define TRANSFER_SET_STACKLEVEL 0x8bfbfbfb /* magic cookie */
72 86
… …
159 AV *padlist = CvPADLIST (cv); 173 AV *padlist = CvPADLIST (cv);
160 AV *newpadlist, *newpad; 174 AV *newpadlist, *newpad;
161 175
162 newpadlist = newAV (); 176 newpadlist = newAV ();
163 AvREAL_off (newpadlist); 177 AvREAL_off (newpadlist);
164#if PERL_VERSION < 9 178#if PERL_VERSION_ATLEAST (5,9,0)
179 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
180#else
165 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1); 181 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1, 1);
166#else
167 Perl_pad_push (aTHX_ padlist, AvFILLp (padlist) + 1);
168#endif 182#endif
169 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)]; 183 newpad = (AV *)AvARRAY (padlist)[AvFILLp (padlist)];
170 --AvFILLp (padlist); 184 --AvFILLp (padlist);
171 185
172 av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE))); 186 av_store (newpadlist, 0, SvREFCNT_inc (*av_fetch (padlist, 0, FALSE)));
… …
291 PL_scopestack_ix = c->scopestack_ix; 305 PL_scopestack_ix = c->scopestack_ix;
292 PL_scopestack_max = c->scopestack_max; 306 PL_scopestack_max = c->scopestack_max;
293 PL_savestack = c->savestack; 307 PL_savestack = c->savestack;
294 PL_savestack_ix = c->savestack_ix; 308 PL_savestack_ix = c->savestack_ix;
295 PL_savestack_max = c->savestack_max; 309 PL_savestack_max = c->savestack_max;
296#if PERL_VERSION < 9 310#if !PERL_VERSION_ATLEAST (5,9,0)
297 PL_retstack = c->retstack; 311 PL_retstack = c->retstack;
298 PL_retstack_ix = c->retstack_ix; 312 PL_retstack_ix = c->retstack_ix;
299 PL_retstack_max = c->retstack_max; 313 PL_retstack_max = c->retstack_max;
300#endif 314#endif
301 PL_curpm = c->curpm; 315 PL_curpm = c->curpm;
… …
418 c->scopestack_ix = PL_scopestack_ix; 432 c->scopestack_ix = PL_scopestack_ix;
419 c->scopestack_max = PL_scopestack_max; 433 c->scopestack_max = PL_scopestack_max;
420 c->savestack = PL_savestack; 434 c->savestack = PL_savestack;
421 c->savestack_ix = PL_savestack_ix; 435 c->savestack_ix = PL_savestack_ix;
422 c->savestack_max = PL_savestack_max; 436 c->savestack_max = PL_savestack_max;
423#if PERL_VERSION < 9 437#if !PERL_VERSION_ATLEAST (5,9,0)
424 c->retstack = PL_retstack; 438 c->retstack = PL_retstack;
425 c->retstack_ix = PL_retstack_ix; 439 c->retstack_ix = PL_retstack_ix;
426 c->retstack_max = PL_retstack_max; 440 c->retstack_max = PL_retstack_max;
427#endif 441#endif
428 c->curpm = PL_curpm; 442 c->curpm = PL_curpm;
… …
466 480
467 New(54,PL_savestack,96,ANY); 481 New(54,PL_savestack,96,ANY);
468 PL_savestack_ix = 0; 482 PL_savestack_ix = 0;
469 PL_savestack_max = 96; 483 PL_savestack_max = 96;
470 484
471#if PERL_VERSION < 9 485#if !PERL_VERSION_ATLEAST (5,9,0)
472 New(54,PL_retstack,8,OP*); 486 New(54,PL_retstack,8,OP*);
473 PL_retstack_ix = 0; 487 PL_retstack_ix = 0;
474 PL_retstack_max = 8; 488 PL_retstack_max = 8;
475#endif 489#endif
476} 490}
… …
518 532
519 Safefree (PL_tmps_stack); 533 Safefree (PL_tmps_stack);
520 Safefree (PL_markstack); 534 Safefree (PL_markstack);
521 Safefree (PL_scopestack); 535 Safefree (PL_scopestack);
522 Safefree (PL_savestack); 536 Safefree (PL_savestack);
523#if PERL_VERSION < 9 537#if !PERL_VERSION_ATLEAST (5,9,0)
524 Safefree (PL_retstack); 538 Safefree (PL_retstack);
525#endif 539#endif
526} 540}
527 541
528static void 542static void
… …
567 SvREFCNT_dec (coro_mortal); 581 SvREFCNT_dec (coro_mortal);
568 coro_mortal = 0; 582 coro_mortal = 0;
569 } 583 }
570} 584}
571 585
572static void 586static void NOINLINE
573prepare_cctx (coro_stack *cctx) 587prepare_cctx (coro_stack *cctx)
574{ 588{
575 dSP; 589 dSP;
576 UNOP myop; 590 UNOP myop;
577 591
… …
689 stack->next = stack_first; 703 stack->next = stack_first;
690 stack_first = stack; 704 stack_first = stack;
691} 705}
692 706
693/* never call directly, always through the coro_state_transfer global variable */ 707/* never call directly, always through the coro_state_transfer global variable */
694static void 708static void NOINLINE
695transfer_impl (struct coro *prev, struct coro *next, int flags) 709transfer (struct coro *prev, struct coro *next, int flags)
696{ 710{
697 dSTACKLEVEL; 711 dSTACKLEVEL;
698 712
699 /* sometimes transfer is only called to set idle_sp */ 713 /* sometimes transfer is only called to set idle_sp */
700 if (flags == TRANSFER_SET_STACKLEVEL) 714 if (flags == TRANSFER_SET_STACKLEVEL)
… …
749 763
750 UNLOCK; 764 UNLOCK;
751 } 765 }
752} 766}
753 767
754/* use this function pointer to call the above function */
755/* this is done to increase chances of the compiler not inlining the call */
756/* not static to make it even harder for the compiler (and theoretically impossible in most cases */
757void (*coro_state_transfer)(struct coro *prev, struct coro *next, int flags) = transfer_impl;
758
759struct transfer_args 768struct transfer_args
760{ 769{
761 struct coro *prev, *next; 770 struct coro *prev, *next;
762 int flags; 771 int flags;
763}; 772};
764 773
765#define TRANSFER(ta) coro_state_transfer ((ta).prev, (ta).next, (ta).flags) 774#define TRANSFER(ta) transfer ((ta).prev, (ta).next, (ta).flags)
766 775
767static void 776static void
768coro_state_destroy (struct coro *coro) 777coro_state_destroy (struct coro *coro)
769{ 778{
770 if (coro->refcnt--) 779 if (coro->refcnt--)
… …
808 ++coro->refcnt; 817 ++coro->refcnt;
809 818
810 return 0; 819 return 0;
811} 820}
812 821
813static MGVTBL coro_state_vtbl = { 0, 0, 0, 0, coro_state_clear, 0, coro_state_dup, 0 }; 822static MGVTBL coro_state_vtbl = {
823 0, 0, 0, 0,
824 coro_state_clear,
825 0,
826#ifdef MGf_DUP
827 coro_state_dup,
828#endif
829};
814 830
815static struct coro * 831static struct coro *
816SvSTATE (SV *coro) 832SvSTATE (SV *coro)
817{ 833{
818 HV *stash; 834 HV *stash;
… …
1112 ++coro_src->refcnt; 1128 ++coro_src->refcnt;
1113 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP; 1129 sv_magicext (SvRV (dst), 0, PERL_MAGIC_ext, &coro_state_vtbl, (char *)coro_src, 0)->mg_flags |= MGf_DUP;
1114} 1130}
1115 1131
1116void 1132void
1117_nonlocal_goto (IV nextop)
1118 CODE:
1119 /* uuh, somebody will kill me again for this */
1120 PL_op->op_next = INT2PTR (OP *, nextop);
1121
1122void
1123_exit (code) 1133_exit (code)
1124 int code 1134 int code
1125 PROTOTYPE: $ 1135 PROTOTYPE: $
1126 CODE: 1136 CODE:
1127 _exit (code); 1137 _exit (code);

Diff Legend

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