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.96 by root, Sun Nov 26 18:25:11 2006 UTC vs.
Revision 1.98 by root, Sun Nov 26 21:25:53 2006 UTC

1#define PERL_NO_GET_CONTEXT
2
3#include "libcoro/coro.c" 1#include "libcoro/coro.c"
4 2
5#include "EXTERN.h" 3#include "EXTERN.h"
6#include "perl.h" 4#include "perl.h"
7#include "XSUB.h" 5#include "XSUB.h"
… …
154 152
155typedef struct coro *Coro__State; 153typedef struct coro *Coro__State;
156typedef struct coro *Coro__State_or_hashref; 154typedef struct coro *Coro__State_or_hashref;
157 155
158static AV * 156static AV *
159coro_clone_padlist (pTHX_ CV *cv) 157coro_clone_padlist (CV *cv)
160{ 158{
161 AV *padlist = CvPADLIST (cv); 159 AV *padlist = CvPADLIST (cv);
162 AV *newpadlist, *newpad; 160 AV *newpadlist, *newpad;
163 161
164 newpadlist = newAV (); 162 newpadlist = newAV ();
… …
176 174
177 return newpadlist; 175 return newpadlist;
178} 176}
179 177
180static void 178static void
181free_padlist (pTHX_ AV *padlist) 179free_padlist (AV *padlist)
182{ 180{
183 /* may be during global destruction */ 181 /* may be during global destruction */
184 if (SvREFCNT (padlist)) 182 if (SvREFCNT (padlist))
185 { 183 {
186 I32 i = AvFILLp (padlist); 184 I32 i = AvFILLp (padlist);
… …
207 AV *padlist; 205 AV *padlist;
208 AV *av = (AV *)mg->mg_obj; 206 AV *av = (AV *)mg->mg_obj;
209 207
210 /* casting is fun. */ 208 /* casting is fun. */
211 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av))) 209 while (&PL_sv_undef != (SV *)(padlist = (AV *)av_pop (av)))
212 free_padlist (aTHX_ padlist); 210 free_padlist (padlist);
213 211
214 SvREFCNT_dec (av); 212 SvREFCNT_dec (av);
215 213
216 return 0; 214 return 0;
217} 215}
… …
220 218
221static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free}; 219static MGVTBL vtbl_coro = {0, 0, 0, 0, coro_cv_free};
222 220
223/* the next two functions merely cache the padlists */ 221/* the next two functions merely cache the padlists */
224static void 222static void
225get_padlist (pTHX_ CV *cv) 223get_padlist (CV *cv)
226{ 224{
227 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 225 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
228 226
229 if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0) 227 if (mg && AvFILLp ((AV *)mg->mg_obj) >= 0)
230 CvPADLIST (cv) = (AV *)av_pop ((AV *)mg->mg_obj); 228 CvPADLIST (cv) = (AV *)av_pop ((AV *)mg->mg_obj);
231 else 229 else
232 { 230 {
233#if 0 231#if 0
234 /* this is probably cleaner, but also slower? */ 232 /* this is probably cleaner, but also slower? */
235 CV *cp = Perl_cv_clone (aTHX_ cv); 233 CV *cp = Perl_cv_clone (cv);
236 CvPADLIST (cv) = CvPADLIST (cp); 234 CvPADLIST (cv) = CvPADLIST (cp);
237 CvPADLIST (cp) = 0; 235 CvPADLIST (cp) = 0;
238 SvREFCNT_dec (cp); 236 SvREFCNT_dec (cp);
239#else 237#else
240 CvPADLIST (cv) = coro_clone_padlist (aTHX_ cv); 238 CvPADLIST (cv) = coro_clone_padlist (cv);
241#endif 239#endif
242 } 240 }
243} 241}
244 242
245static void 243static void
246put_padlist (pTHX_ CV *cv) 244put_padlist (CV *cv)
247{ 245{
248 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro); 246 MAGIC *mg = mg_find ((SV *)cv, PERL_MAGIC_coro);
249 247
250 if (!mg) 248 if (!mg)
251 { 249 {
… …
259} 257}
260 258
261#define SB do { 259#define SB do {
262#define SE } while (0) 260#define SE } while (0)
263 261
264#define LOAD(state) load_state(aTHX_ (state)); 262#define LOAD(state) load_state((state));
265#define SAVE(state,flags) save_state(aTHX_ (state),(flags)); 263#define SAVE(state,flags) save_state((state),(flags));
266 264
267#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); (val) = 0; SE 265#define REPLACE_SV(sv,val) SB SvREFCNT_dec(sv); (sv) = (val); (val) = 0; SE
268 266
269static void 267static void
270load_state(pTHX_ Coro__State c) 268load_state(Coro__State c)
271{ 269{
272 PL_dowarn = c->dowarn; 270 PL_dowarn = c->dowarn;
273 PL_in_eval = c->in_eval; 271 PL_in_eval = c->in_eval;
274 272
275 PL_curstackinfo = c->curstackinfo; 273 PL_curstackinfo = c->curstackinfo;
… …
316 { 314 {
317 AV *padlist = (AV *)POPs; 315 AV *padlist = (AV *)POPs;
318 316
319 if (padlist) 317 if (padlist)
320 { 318 {
321 put_padlist (aTHX_ cv); /* mark this padlist as available */ 319 put_padlist (cv); /* mark this padlist as available */
322 CvPADLIST(cv) = padlist; 320 CvPADLIST(cv) = padlist;
323 } 321 }
324 322
325 ++CvDEPTH(cv); 323 ++CvDEPTH(cv);
326 } 324 }
… …
328 PUTBACK; 326 PUTBACK;
329 } 327 }
330} 328}
331 329
332static void 330static void
333save_state(pTHX_ Coro__State c, int flags) 331save_state(Coro__State c, int flags)
334{ 332{
335 { 333 {
336 dSP; 334 dSP;
337 I32 cxix = cxstack_ix; 335 I32 cxix = cxstack_ix;
338 PERL_CONTEXT *ccstk = cxstack; 336 PERL_CONTEXT *ccstk = cxstack;
… …
366 } 364 }
367 365
368 PUSHs ((SV *)CvPADLIST(cv)); 366 PUSHs ((SV *)CvPADLIST(cv));
369 PUSHs ((SV *)cv); 367 PUSHs ((SV *)cv);
370 368
371 get_padlist (aTHX_ cv); 369 get_padlist (cv);
372 } 370 }
373 } 371 }
374#ifdef CXt_FORMAT 372#ifdef CXt_FORMAT
375 else if (CxTYPE(cx) == CXt_FORMAT) 373 else if (CxTYPE(cx) == CXt_FORMAT)
376 { 374 {
… …
436 * of perl.c:init_stacks, except that it uses less memory 434 * of perl.c:init_stacks, except that it uses less memory
437 * on the (sometimes correct) assumption that coroutines do 435 * on the (sometimes correct) assumption that coroutines do
438 * not usually need a lot of stackspace. 436 * not usually need a lot of stackspace.
439 */ 437 */
440static void 438static void
441coro_init_stacks (pTHX) 439coro_init_stacks ()
442{ 440{
443 LOCK; 441 LOCK;
444 442
445 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1); 443 PL_curstackinfo = new_stackinfo(96, 1024/sizeof(PERL_CONTEXT) - 1);
446 PL_curstackinfo->si_type = PERLSI_MAIN; 444 PL_curstackinfo->si_type = PERLSI_MAIN;
… …
483 481
484/* 482/*
485 * destroy the stacks, the callchain etc... 483 * destroy the stacks, the callchain etc...
486 */ 484 */
487static void 485static void
488destroy_stacks(pTHX) 486destroy_stacks()
489{ 487{
490 if (!IN_DESTRUCT) 488 if (!IN_DESTRUCT)
491 { 489 {
492 /* is this ugly, I ask? */ 490 /* is this ugly, I ask? */
493 LEAVE_SCOPE (0); 491 LEAVE_SCOPE (0);
… …
540 dTHX; 538 dTHX;
541 dSP; 539 dSP;
542 UNOP myop; 540 UNOP myop;
543 SV *sub_init = (SV *)get_cv ("Coro::State::coro_init", FALSE); 541 SV *sub_init = (SV *)get_cv ("Coro::State::coro_init", FALSE);
544 542
545 coro_init_stacks (aTHX); 543 coro_init_stacks ();
546 /*PL_curcop = 0;*/ 544 /*PL_curcop = 0;*/
547 /*PL_in_eval = PL_in_eval;*/ /* inherit */ 545 /*PL_in_eval = PL_in_eval;*/ /* inherit */
548 SvREFCNT_dec (GvAV (PL_defgv)); 546 SvREFCNT_dec (GvAV (PL_defgv));
549 GvAV (PL_defgv) = coro->args; coro->args = 0; 547 GvAV (PL_defgv) = coro->args; coro->args = 0;
550 548
… …
593 591
594 /* continue at cctx_init, without entersub */ 592 /* continue at cctx_init, without entersub */
595 PL_restartop = CvSTART (get_cv ("Coro::State::cctx_init", FALSE)); 593 PL_restartop = CvSTART (get_cv ("Coro::State::cctx_init", FALSE));
596 594
597 /* somebody will hit me for both perl_run and PL_restartop */ 595 /* somebody will hit me for both perl_run and PL_restartop */
598 ret = perl_run (aTHX_ PERL_GET_CONTEXT); 596 ret = perl_run (PERL_GET_CONTEXT);
599 printf ("ret %d\n", ret);//D 597 printf ("ret %d\n", ret);//D
600 598
601 fputs ("FATAL: C coroutine fell over the edge of the world, aborting.\n", stderr); 599 fputs ("FATAL: C coroutine fell over the edge of the world, aborting.\n", stderr);
602 abort (); 600 abort ();
603} 601}
… …
686 stack_first = stack; 684 stack_first = stack;
687} 685}
688 686
689/* never call directly, always through the coro_state_transfer global variable */ 687/* never call directly, always through the coro_state_transfer global variable */
690static void 688static void
691transfer_impl (pTHX_ struct coro *prev, struct coro *next, int flags) 689transfer_impl (struct coro *prev, struct coro *next, int flags)
692{ 690{
693 dSTACKLEVEL; 691 dSTACKLEVEL;
694 692
695 /* sometimes transfer is only called to set idle_sp */ 693 /* sometimes transfer is only called to set idle_sp */
696 if (flags == TRANSFER_SET_STACKLEVEL) 694 if (flags == TRANSFER_SET_STACKLEVEL)
… …
748} 746}
749 747
750/* use this function pointer to call the above function */ 748/* use this function pointer to call the above function */
751/* this is done to increase chances of the compiler not inlining the call */ 749/* this is done to increase chances of the compiler not inlining the call */
752/* not static to make it even harder for the compiler (and theoretically impossible in most cases */ 750/* not static to make it even harder for the compiler (and theoretically impossible in most cases */
753void (*coro_state_transfer)(pTHX_ struct coro *prev, struct coro *next, int flags) = transfer_impl; 751void (*coro_state_transfer)(struct coro *prev, struct coro *next, int flags) = transfer_impl;
754 752
755struct transfer_args 753struct transfer_args
756{ 754{
757 struct coro *prev, *next; 755 struct coro *prev, *next;
758 int flags; 756 int flags;
… …
768 766
769 if (coro->mainstack && coro->mainstack != main_mainstack) 767 if (coro->mainstack && coro->mainstack != main_mainstack)
770 { 768 {
771 struct coro temp; 769 struct coro temp;
772 770
773 SAVE (aTHX_ (&temp), TRANSFER_SAVE_ALL); 771 SAVE ((&temp), TRANSFER_SAVE_ALL);
774 LOAD (aTHX_ coro); 772 LOAD (coro);
775 773
776 destroy_stacks (aTHX); 774 destroy_stacks ();
777 775
778 LOAD ((&temp)); /* this will get rid of defsv etc.. */ 776 LOAD ((&temp)); /* this will get rid of defsv etc.. */
779 777
780 coro->mainstack = 0; 778 coro->mainstack = 0;
781 } 779 }
… …
784 SvREFCNT_dec (coro->args); 782 SvREFCNT_dec (coro->args);
785 Safefree (coro); 783 Safefree (coro);
786} 784}
787 785
788static int 786static int
789coro_state_clear (SV *sv, MAGIC *mg) 787coro_state_clear (pTHX_ SV *sv, MAGIC *mg)
790{ 788{
791 struct coro *coro = (struct coro *)mg->mg_ptr; 789 struct coro *coro = (struct coro *)mg->mg_ptr;
792 mg->mg_ptr = 0; 790 mg->mg_ptr = 0;
793 791
794 coro_state_destroy (coro); 792 coro_state_destroy (coro);
795 793
796 return 0; 794 return 0;
797} 795}
798 796
799static int 797static int
800coro_state_dup (MAGIC *mg, CLONE_PARAMS *params) 798coro_state_dup (pTHX_ MAGIC *mg, CLONE_PARAMS *params)
801{ 799{
802 struct coro *coro = (struct coro *)mg->mg_ptr; 800 struct coro *coro = (struct coro *)mg->mg_ptr;
803 801
804 ++coro->refcnt; 802 ++coro->refcnt;
805 803
… …
829 assert (mg->mg_type == PERL_MAGIC_ext); 827 assert (mg->mg_type == PERL_MAGIC_ext);
830 return (struct coro *)mg->mg_ptr; 828 return (struct coro *)mg->mg_ptr;
831} 829}
832 830
833static void 831static void
834prepare_transfer (pTHX_ struct transfer_args *ta, SV *prev, SV *next, int flags) 832prepare_transfer (struct transfer_args *ta, SV *prev, SV *next, int flags)
835{ 833{
836 ta->prev = SvSTATE (prev); 834 ta->prev = SvSTATE (prev);
837 ta->next = SvSTATE (next); 835 ta->next = SvSTATE (next);
838 ta->flags = flags; 836 ta->flags = flags;
839} 837}
… …
842api_transfer (SV *prev, SV *next, int flags) 840api_transfer (SV *prev, SV *next, int flags)
843{ 841{
844 dTHX; 842 dTHX;
845 struct transfer_args ta; 843 struct transfer_args ta;
846 844
847 prepare_transfer (aTHX_ &ta, prev, next, flags); 845 prepare_transfer (&ta, prev, next, flags);
848 TRANSFER (ta); 846 TRANSFER (ta);
849} 847}
850 848
851/** Coro ********************************************************************/ 849/** Coro ********************************************************************/
852 850
… …
861static GV *coro_current, *coro_idle; 859static GV *coro_current, *coro_idle;
862static AV *coro_ready [PRIO_MAX-PRIO_MIN+1]; 860static AV *coro_ready [PRIO_MAX-PRIO_MIN+1];
863static int coro_nready; 861static int coro_nready;
864 862
865static void 863static void
866coro_enq (pTHX_ SV *sv) 864coro_enq (SV *sv)
867{ 865{
868 int prio; 866 int prio;
869 867
870 if (SvTYPE (sv) != SVt_PVHV) 868 if (SvTYPE (sv) != SVt_PVHV)
871 croak ("Coro::ready tried to enqueue something that is not a coroutine"); 869 croak ("Coro::ready tried to enqueue something that is not a coroutine");
… …
875 av_push (coro_ready [prio - PRIO_MIN], sv); 873 av_push (coro_ready [prio - PRIO_MIN], sv);
876 coro_nready++; 874 coro_nready++;
877} 875}
878 876
879static SV * 877static SV *
880coro_deq (pTHX_ int min_prio) 878coro_deq (int min_prio)
881{ 879{
882 int prio = PRIO_MAX - PRIO_MIN; 880 int prio = PRIO_MAX - PRIO_MIN;
883 881
884 min_prio -= PRIO_MIN; 882 min_prio -= PRIO_MIN;
885 if (min_prio < 0) 883 if (min_prio < 0)
… …
902 900
903 if (SvROK (coro)) 901 if (SvROK (coro))
904 coro = SvRV (coro); 902 coro = SvRV (coro);
905 903
906 LOCK; 904 LOCK;
907 coro_enq (aTHX_ SvREFCNT_inc (coro)); 905 coro_enq (SvREFCNT_inc (coro));
908 UNLOCK; 906 UNLOCK;
909} 907}
910 908
911static void 909static void
912prepare_schedule (aTHX_ struct transfer_args *ta) 910prepare_schedule (struct transfer_args *ta)
913{ 911{
914 SV *current, *prev, *next; 912 SV *current, *prev, *next;
915 913
916 LOCK; 914 LOCK;
917 915
… …
919 917
920 for (;;) 918 for (;;)
921 { 919 {
922 LOCK; 920 LOCK;
923 921
924 next = coro_deq (aTHX_ PRIO_MIN); 922 next = coro_deq (PRIO_MIN);
925 923
926 if (next) 924 if (next)
927 break; 925 break;
928 926
929 UNLOCK; 927 UNLOCK;
… …
956 954
957 UNLOCK; 955 UNLOCK;
958} 956}
959 957
960static void 958static void
961prepare_cede (aTHX_ struct transfer_args *ta) 959prepare_cede (struct transfer_args *ta)
962{ 960{
963 LOCK; 961 LOCK;
964 coro_enq (aTHX_ SvREFCNT_inc (SvRV (GvSV (coro_current)))); 962 coro_enq (SvREFCNT_inc (SvRV (GvSV (coro_current))));
965 UNLOCK; 963 UNLOCK;
966 964
967 prepare_schedule (ta); 965 prepare_schedule (ta);
968} 966}
969 967

Diff Legend

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