… | |
… | |
10 | |
10 | |
11 | #define MAY_FLUSH /* increases codesize */ |
11 | #define MAY_FLUSH /* increases codesize */ |
12 | |
12 | |
13 | #define SUB_INIT "Coro::State::initialize" |
13 | #define SUB_INIT "Coro::State::initialize" |
14 | |
14 | |
15 | #define SAVE_DEFAV 0x00000001 |
15 | #define TRANSFER_SAVE_DEFAV 0x00000001 |
16 | #define SAVE_DEFSV 0x00000002 |
16 | #define TRANSFER_SAVE_DEFSV 0x00000002 |
17 | #define SAVE_ERRSV 0x00000004 |
17 | #define TRANSFER_SAVE_ERRSV 0x00000004 |
18 | |
18 | |
19 | #define SAVE_ALL -1 |
19 | #define TRANSFER_SAVE_ALL -1 |
20 | |
20 | |
21 | struct coro { |
21 | struct coro { |
22 | /* optionally saved, might be zero */ |
22 | /* optionally saved, might be zero */ |
23 | AV *defav; |
23 | AV *defav; |
24 | SV *defsv; |
24 | SV *defsv; |
… | |
… | |
59 | }; |
59 | }; |
60 | |
60 | |
61 | typedef struct coro *Coro__State; |
61 | typedef struct coro *Coro__State; |
62 | typedef struct coro *Coro__State_or_hashref; |
62 | typedef struct coro *Coro__State_or_hashref; |
63 | |
63 | |
|
|
64 | static AV *main_mainstack; /* used to differentiate between $main and others */ |
|
|
65 | |
64 | static HV *padlist_cache; |
66 | static HV *padlist_cache; |
65 | |
67 | |
66 | /* mostly copied from op.c:cv_clone2 */ |
68 | /* mostly copied from op.c:cv_clone2 */ |
67 | STATIC AV * |
69 | STATIC AV * |
68 | clone_padlist (AV *protopadlist) |
70 | clone_padlist (AV *protopadlist) |
… | |
… | |
363 | } |
365 | } |
364 | |
366 | |
365 | PUTBACK; |
367 | PUTBACK; |
366 | } |
368 | } |
367 | |
369 | |
368 | c->defav = flags & SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0; |
370 | c->defav = flags & TRANSFER_SAVE_DEFAV ? (AV *)SvREFCNT_inc (GvAV (PL_defgv)) : 0; |
369 | c->defsv = flags & SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0; |
371 | c->defsv = flags & TRANSFER_SAVE_DEFSV ? SvREFCNT_inc (DEFSV) : 0; |
370 | c->errsv = flags & SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0; |
372 | c->errsv = flags & TRANSFER_SAVE_ERRSV ? SvREFCNT_inc (ERRSV) : 0; |
371 | |
373 | |
372 | /* I have not the slightest idea of why av_reify is necessary */ |
374 | /* I have not the slightest idea of why av_reify is necessary */ |
373 | /* but if it's missing the defav contents magically get replaced sometimes */ |
375 | /* but if it's missing the defav contents magically get replaced sometimes */ |
374 | if (c->defav) |
376 | if (c->defav) |
375 | av_reify (c->defav); |
377 | av_reify (c->defav); |
… | |
… | |
516 | |
518 | |
517 | BOOT: |
519 | BOOT: |
518 | { /* {} necessary for stoopid perl-5.6.x */ |
520 | { /* {} necessary for stoopid perl-5.6.x */ |
519 | HV * stash = gv_stashpvn("Coro::State", 10, TRUE); |
521 | HV * stash = gv_stashpvn("Coro::State", 10, TRUE); |
520 | |
522 | |
521 | newCONSTSUB (stash, "SAVE_DEFAV", newSViv (SAVE_DEFAV)); |
523 | newCONSTSUB (stash, "SAVE_DEFAV", newSViv (TRANSFER_SAVE_DEFAV)); |
522 | newCONSTSUB (stash, "SAVE_DEFSV", newSViv (SAVE_DEFSV)); |
524 | newCONSTSUB (stash, "SAVE_DEFSV", newSViv (TRANSFER_SAVE_DEFSV)); |
523 | newCONSTSUB (stash, "SAVE_ERRSV", newSViv (SAVE_ERRSV)); |
525 | newCONSTSUB (stash, "SAVE_ERRSV", newSViv (TRANSFER_SAVE_ERRSV)); |
524 | |
526 | |
525 | if (!padlist_cache) |
527 | if (!padlist_cache) |
526 | padlist_cache = newHV (); |
528 | padlist_cache = newHV (); |
|
|
529 | |
|
|
530 | main_mainstack = PL_mainstack; |
527 | } |
531 | } |
528 | |
532 | |
529 | Coro::State |
533 | Coro::State |
530 | _newprocess(args) |
534 | _newprocess(args) |
531 | SV * args |
535 | SV * args |
… | |
… | |
544 | RETVAL = coro; |
548 | RETVAL = coro; |
545 | OUTPUT: |
549 | OUTPUT: |
546 | RETVAL |
550 | RETVAL |
547 | |
551 | |
548 | void |
552 | void |
549 | transfer(prev, next, flags = SAVE_ALL) |
553 | transfer(prev, next, flags = TRANSFER_SAVE_ALL) |
550 | Coro::State_or_hashref prev |
554 | Coro::State_or_hashref prev |
551 | Coro::State_or_hashref next |
555 | Coro::State_or_hashref next |
552 | int flags |
556 | int flags |
553 | PROTOTYPE: @ |
557 | PROTOTYPE: @ |
554 | CODE: |
558 | CODE: |
… | |
… | |
558 | void |
562 | void |
559 | DESTROY(coro) |
563 | DESTROY(coro) |
560 | Coro::State coro |
564 | Coro::State coro |
561 | CODE: |
565 | CODE: |
562 | |
566 | |
563 | if (coro->mainstack) |
567 | if (coro->mainstack && coro->mainstack != main_mainstack) |
564 | { |
568 | { |
565 | struct coro temp; |
569 | struct coro temp; |
566 | |
570 | |
567 | SAVE(aTHX_ (&temp), SAVE_ALL); |
571 | SAVE(aTHX_ (&temp), TRANSFER_SAVE_ALL); |
568 | LOAD(aTHX_ coro); |
572 | LOAD(aTHX_ coro); |
569 | |
573 | |
570 | destroy_stacks (); |
574 | destroy_stacks (); |
571 | |
575 | |
572 | LOAD((&temp)); /* this will get rid of defsv etc.. */ |
576 | LOAD((&temp)); /* this will get rid of defsv etc.. */ |
573 | } |
577 | } |
574 | |
578 | |
575 | Safefree (coro); |
579 | Safefree (coro); |
|
|
580 | |
|
|
581 | /* |
|
|
582 | * there is one problematic case left (remember _recurse?) |
|
|
583 | * consider the case when we |
|
|
584 | * |
|
|
585 | * 1. start a coroutine |
|
|
586 | * 2. inside it descend into some xs functions |
|
|
587 | * 3. xs function calls a callback |
|
|
588 | * 4. callback switches to $main |
|
|
589 | * 5. $main ends - we will end inside the xs function |
|
|
590 | * 6. xs function returns and perl executes - what? |
|
|
591 | * |
|
|
592 | * to avoid this case we recurse in this function |
|
|
593 | * and simply call my_exit(0), skipping other xs functions |
|
|
594 | */ |
|
|
595 | |
|
|
596 | #if 0 |
|
|
597 | void |
|
|
598 | _recurse() |
|
|
599 | CODE: |
|
|
600 | LEAVE; |
|
|
601 | PL_stack_sp = PL_stack_base + ax - 1; |
|
|
602 | PL_op = PL_op->op_next; |
|
|
603 | CALLRUNOPS(aTHX); |
|
|
604 | printf ("my_exit\n"); |
|
|
605 | my_exit (0); |
|
|
606 | |
|
|
607 | #endif |
576 | |
608 | |
577 | void |
609 | void |
578 | flush() |
610 | flush() |
579 | CODE: |
611 | CODE: |
580 | #ifdef MAY_FLUSH |
612 | #ifdef MAY_FLUSH |