File Coverage

lib/Future/AsyncAwait.xs
Criterion Covered Total %
statement 787 1004 78.3
branch 372 598 62.2
condition n/a
subroutine n/a
pod n/a
total 1159 1602 72.3


line stmt bran cond sub pod time code
1             /* You may distribute under the terms of either the GNU General Public License
2             * or the Artistic License (the same terms as Perl itself)
3             *
4             * (C) Paul Evans, 2016-2025 -- leonerd@leonerd.org.uk
5             */
6             #define PERL_NO_GET_CONTEXT
7              
8             #include "EXTERN.h"
9             #include "perl.h"
10             #include "XSUB.h"
11              
12             #include "AsyncAwait.h"
13              
14             #ifdef HAVE_DMD_HELPER
15             # define WANT_DMD_API_044
16             # include "DMD_helper.h"
17             #endif
18              
19             #include "XSParseKeyword.h"
20             #include "XSParseSublike.h"
21              
22             #include "perl-backcompat.c.inc"
23             #include "PL_savetype_name.c.inc"
24              
25             #if !HAVE_PERL_VERSION(5, 24, 0)
26             /* On perls before 5.24 we have to do some extra work to save the itervar
27             * from being thrown away */
28             # define HAVE_ITERVAR
29             #endif
30              
31             #if HAVE_PERL_VERSION(5, 24, 0)
32             /* For unknown reasons, doing this on perls 5.20 or 5.22 massively breaks
33             * everything.
34             * https://rt.cpan.org/Ticket/Display.html?id=129202#txn-1843918
35             */
36             # define HAVE_FUTURE_CHAIN_CANCEL
37             #endif
38              
39             #if HAVE_PERL_VERSION(5, 26, 0)
40             # define HAVE_OP_ARGCHECK
41             #endif
42              
43             #if HAVE_PERL_VERSION(5, 43, 3)
44             # define HAVE_OP_MULTIPARAM
45             #endif
46              
47             #if HAVE_PERL_VERSION(5, 33, 7)
48             /* perl 5.33.7 added CXp_TRY and the CxTRY macro for true try/catch semantics */
49             # define HAVE_CX_TRY
50             #endif
51              
52             #ifdef SAVEt_CLEARPADRANGE
53             # include "save_clearpadrange.c.inc"
54             #endif
55              
56             #if !HAVE_PERL_VERSION(5, 24, 0)
57             # include "cx_pushblock.c.inc"
58             # include "cx_pusheval.c.inc"
59             #endif
60              
61             #include "perl-additions.c.inc"
62             #include "newOP_CUSTOM.c.inc"
63             #include "cv_copy_flags.c.inc"
64              
65             /* Currently no version of perl makes this visible, so we always want it. Maybe
66             * one day in the future we can make it version-dependent
67             */
68              
69             static void panic(char *fmt, ...);
70              
71             #ifndef NOT_REACHED
72             # define NOT_REACHED STMT_START { panic("Unreachable\n"); } STMT_END
73             #endif
74             #include "docatch.c.inc"
75              
76             typedef struct SuspendedFrame SuspendedFrame;
77             struct SuspendedFrame {
78             SuspendedFrame *next;
79             U8 type;
80             U8 gimme;
81              
82             U32 stacklen;
83             SV **stack;
84              
85             U32 marklen;
86             I32 *marks;
87              
88             COP *oldcop;
89              
90             /* items from the save stack */
91             U32 savedlen;
92             struct Saved {
93             U8 type;
94             union {
95             struct {
96             PADOFFSET padix;
97             U32 count;
98             } clearpad; /* for SAVEt_CLEARSV and SAVEt_CLEARPADRANGE */
99             struct {
100             void (*func)(pTHX_ void *data);
101             void *data;
102             } dx; /* for SAVEt_DESTRUCTOR_X */
103             GV *gv; /* for SAVEt_SV + cur.sv, saved.sv */
104             int *iptr; /* for SAVEt_INT... */
105             STRLEN *lenptr; /* for SAVEt_STRLEN + cur.len, saved.len */
106             PADOFFSET padix; /* for SAVEt_PADSV_AND_MORTALIZE, SAVEt_SPTR */
107             SV *sv; /* for SAVEt_ITEM */
108             struct {
109             SV *sv;
110             U32 mask, set;
111             } svflags; /* for SAVEt_SET_SVFLAGS */
112             } u;
113              
114             union {
115             SV *sv; /* for SAVEt_SV, SAVEt_FREESV, SAVEt_ITEM */
116             void *ptr; /* for SAVEt_COMPPAD, */
117             int i; /* for SAVEt_INT... */
118             STRLEN len; /* for SAVEt_STRLEN */
119             } cur, /* the current value that *thing that we should restore to */
120             saved; /* the saved value we should push to the savestack on restore */
121             } *saved;
122              
123             union {
124             struct {
125             OP *retop;
126             } eval;
127             struct block_loop loop;
128             } el;
129              
130             /* for debugging purposes */
131             SV *loop_list_first_item;
132              
133             #ifdef HAVE_ITERVAR
134             SV *itervar;
135             #endif
136             U32 scopes;
137              
138             U32 mortallen;
139             SV **mortals;
140             };
141              
142             typedef struct {
143             SV *awaiting_future; /* the Future that 'await' is currently waiting for */
144             SV *returning_future; /* the Future that its contining CV will eventually return */
145             COP *curcop; /* value of PL_curcop at suspend time */
146             SuspendedFrame *frames;
147              
148             U32 padlen;
149             SV **padslots;
150              
151             PMOP *curpm; /* value of PL_curpm at suspend time */
152             AV *defav; /* value of GvAV(PL_defgv) at suspend time */
153              
154             HV *modhookdata;
155             } SuspendedState;
156              
157             #ifdef DEBUG
158             # define TRACEPRINT S_traceprint
159             static void S_traceprint(char *fmt, ...)
160             {
161             /* TODO: make conditional */
162             va_list args;
163             va_start(args, fmt);
164             vfprintf(stderr, fmt, args);
165             va_end(args);
166             }
167             #else
168             # define TRACEPRINT(...)
169             #endif
170              
171 0           static void vpanic(char *fmt, va_list args)
172             {
173 0           fprintf(stderr, "Future::AsyncAwait panic: ");
174 0           vfprintf(stderr, fmt, args);
175 0           raise(SIGABRT);
176 0           }
177              
178 0           static void panic(char *fmt, ...)
179             {
180             va_list args;
181 0           va_start(args, fmt);
182 0           vpanic(fmt, args);
183 0           }
184              
185             /*
186             * Hook mechanism
187             */
188              
189             struct HookRegistration
190             {
191             const struct AsyncAwaitHookFuncs *funcs;
192             void *data;
193             };
194              
195             struct HookRegistrations
196             {
197             struct HookRegistration *arr;
198             size_t count, size;
199             };
200              
201 305           static struct HookRegistrations *S_registrations(pTHX_ bool add)
202             {
203 305           SV *regsv = *hv_fetchs(PL_modglobal, "Future::AsyncAwait/registrations", GV_ADD);
204 305 100         if(!SvOK(regsv)) {
205 271 100         if(!add)
206             return NULL;
207              
208             struct HookRegistrations *registrations;
209 2           Newx(registrations, 1, struct HookRegistrations);
210              
211 2           registrations->count = 0;
212 2           registrations->size = 4;
213 2           Newx(registrations->arr, registrations->size, struct HookRegistration);
214              
215 2           sv_setuv(regsv, PTR2UV(registrations));
216             }
217              
218 36           return INT2PTR(struct HookRegistrations *, SvUV(regsv));
219             }
220             #define registrations(add) S_registrations(aTHX_ add)
221              
222 2           static void register_faa_hook(pTHX_ const struct AsyncAwaitHookFuncs *hookfuncs, void *hookdata)
223             {
224             /* Currently no flags are recognised; complain if the caller requested any */
225 2 50         if(hookfuncs->flags)
226 0           croak("Unrecognised hookfuncs->flags value %08x", hookfuncs->flags);
227              
228 2           struct HookRegistrations *regs = registrations(TRUE);
229              
230 2 50         if(regs->count == regs->size) {
231 0           regs->size *= 2;
232 0 0         Renew(regs->arr, regs->size, struct HookRegistration);
233             }
234              
235 2           regs->arr[regs->count].funcs = hookfuncs;
236 2           regs->arr[regs->count].data = hookdata;
237 2           regs->count++;
238 2           }
239              
240             #define RUN_HOOKS_FWD(func, ...) \
241             { \
242             int _hooki = 0; \
243             while(_hooki < regs->count) { \
244             struct HookRegistration *reg = regs->arr + _hooki; \
245             if(reg->funcs->func) \
246             (*reg->funcs->func)(aTHX_ __VA_ARGS__, reg->data); \
247             _hooki++; \
248             } \
249             }
250              
251             #define RUN_HOOKS_REV(func, ...) \
252             { \
253             int _hooki = regs->count; \
254             while(_hooki > 0) { \
255             _hooki--; \
256             struct HookRegistration *reg = regs->arr + _hooki; \
257             if(reg->funcs->func) \
258             (*reg->funcs->func)(aTHX_ __VA_ARGS__, reg->data); \
259             } \
260             }
261              
262             /*
263             * Magic that we attach to suspended CVs, that contains state required to restore
264             * them
265             */
266              
267             static int suspendedstate_free(pTHX_ SV *sv, MAGIC *mg);
268              
269             static MGVTBL vtbl_suspendedstate = {
270             NULL, /* get */
271             NULL, /* set */
272             NULL, /* len */
273             NULL, /* clear */
274             suspendedstate_free,
275             };
276              
277             #ifdef HAVE_DMD_HELPER
278             static int dumpmagic_suspendedstate(pTHX_ DMDContext *ctx, const SV *sv, MAGIC *mg)
279             {
280             SuspendedState *state = (SuspendedState *)mg->mg_ptr;
281             int ret = 0;
282              
283             ret += DMD_ANNOTATE_SV(sv, state->awaiting_future, "the awaiting Future");
284             ret += DMD_ANNOTATE_SV(sv, state->returning_future, "the returning Future");
285              
286             SuspendedFrame *frame;
287             for(frame = state->frames; frame; frame = frame->next) {
288             int i;
289              
290             for(i = 0; i < frame->stacklen; i++)
291             ret += DMD_ANNOTATE_SV(sv, frame->stack[i], "a suspended stack temporary");
292              
293             for(i = 0; i < frame->mortallen; i++)
294             ret += DMD_ANNOTATE_SV(sv, frame->mortals[i], "a suspended mortal");
295              
296             #ifdef HAVE_ITERVAR
297             if(frame->itervar)
298             ret += DMD_ANNOTATE_SV(sv, frame->itervar, "a suspended loop iteration variable");
299             #endif
300              
301             switch(frame->type) {
302             case CXt_BLOCK:
303             case CXt_LOOP_PLAIN:
304             break;
305              
306             case CXt_LOOP_LAZYSV:
307             ret += DMD_ANNOTATE_SV(sv, frame->el.loop.state_u.lazysv.cur, "a suspended foreach LAZYSV loop iterator value");
308             ret += DMD_ANNOTATE_SV(sv, frame->el.loop.state_u.lazysv.end, "a suspended foreach LAZYSV loop stop value");
309             goto cxt_loop_common;
310              
311             #if HAVE_PERL_VERSION(5, 24, 0)
312             case CXt_LOOP_ARY:
313             #else
314             case CXt_LOOP_FOR:
315             #endif
316             if(frame->el.loop.state_u.ary.ary)
317             ret += DMD_ANNOTATE_SV(sv, (SV *)frame->el.loop.state_u.ary.ary, "a suspended foreach ARY loop value array");
318             goto cxt_loop_common;
319              
320             case CXt_LOOP_LAZYIV:
321             #if HAVE_PERL_VERSION(5, 24, 0)
322             case CXt_LOOP_LIST:
323             #endif
324             cxt_loop_common:
325             #if !defined(HAVE_ITERVAR)
326             ret += DMD_ANNOTATE_SV(sv, frame->el.loop.itersave, "a suspended loop saved iteration variable");
327             #endif
328             break;
329             }
330              
331             for(i = 0; i < frame->savedlen; i++) {
332             struct Saved *saved = &frame->saved[i];
333             switch(saved->type) {
334             #ifdef SAVEt_CLEARPADRANGE
335             case SAVEt_CLEARPADRANGE:
336             #endif
337             case SAVEt_CLEARSV:
338             case SAVEt_INT_SMALL:
339             case SAVEt_DESTRUCTOR_X:
340             #ifdef SAVEt_STRLEN
341             case SAVEt_STRLEN:
342             #endif
343             case SAVEt_SET_SVFLAGS:
344             /* Nothing interesting */
345             break;
346              
347             case SAVEt_FREEPV:
348             /* This is interesting but a plain char* pointer so there's nothing
349             * we can do with it in Devel::MAT */
350             break;
351              
352             case SAVEt_COMPPAD:
353             ret += DMD_ANNOTATE_SV(sv, saved->cur.ptr, "a suspended SAVEt_COMPPAD");
354             break;
355              
356             case SAVEt_FREESV:
357             ret += DMD_ANNOTATE_SV(sv, saved->saved.sv, "a suspended SAVEt_FREESV");
358             break;
359              
360             case SAVEt_SV:
361             ret += DMD_ANNOTATE_SV(sv, (SV *)saved->u.gv, "a suspended SAVEt_SV target GV");
362             ret += DMD_ANNOTATE_SV(sv, saved->cur.sv, "a suspended SAVEt_SV current value");
363             ret += DMD_ANNOTATE_SV(sv, saved->saved.sv, "a suspended SAVEt_SV saved value");
364             break;
365              
366             case SAVEt_SPTR:
367             ret += DMD_ANNOTATE_SV(sv, saved->cur.sv, "a suspended SAVEt_SPTR current value");
368             ret += DMD_ANNOTATE_SV(sv, saved->saved.sv, "a suspended SAVEt_SPTR saved value");
369             break;
370              
371             case SAVEt_PADSV_AND_MORTALIZE:
372             ret += DMD_ANNOTATE_SV(sv, saved->cur.sv, "a suspended SAVEt_PADSV_AND_MORTALIZE current value");
373             ret += DMD_ANNOTATE_SV(sv, saved->saved.sv, "a suspended SAVEt_PADSV_AND_MORTALIZE saved value");
374             break;
375             }
376             }
377             }
378              
379             if(state->padlen && state->padslots) {
380             int i;
381             for(i = 0; i < state->padlen - 1; i++)
382             if(state->padslots[i])
383             ret += DMD_ANNOTATE_SV(sv, state->padslots[i], "a suspended pad slot");
384             }
385              
386             if(state->defav)
387             ret += DMD_ANNOTATE_SV(sv, (SV *)state->defav, "the subroutine arguments AV");
388              
389             if(state->modhookdata)
390             ret += DMD_ANNOTATE_SV(sv, (SV *)state->modhookdata, "the module hook data HV");
391              
392             return ret;
393             }
394             #endif
395              
396             #define suspendedstate_get(cv) MY_suspendedstate_get(aTHX_ cv)
397 431           static SuspendedState *MY_suspendedstate_get(pTHX_ CV *cv)
398             {
399             MAGIC *mg;
400 431 100         if((mg = mg_findext((SV *)cv, PERL_MAGIC_ext, &vtbl_suspendedstate)))
401 278           return (SuspendedState *)mg->mg_ptr;
402              
403             return NULL;
404             }
405              
406             #define suspendedstate_new(cv) MY_suspendedstate_new(aTHX_ cv)
407 107           static SuspendedState *MY_suspendedstate_new(pTHX_ CV *cv)
408             {
409             SuspendedState *ret;
410 107           Newx(ret, 1, SuspendedState);
411              
412 107           ret->awaiting_future = NULL;
413 107           ret->returning_future = NULL;
414 107           ret->frames = NULL;
415 107           ret->padslots = NULL;
416 107           ret->modhookdata = NULL;
417 107           ret->defav = NULL;
418              
419 107           sv_magicext((SV *)cv, NULL, PERL_MAGIC_ext, &vtbl_suspendedstate, (char *)ret, 0);
420              
421 107           return ret;
422             }
423              
424 106           static int suspendedstate_free(pTHX_ SV *sv, MAGIC *mg)
425             {
426 106           SuspendedState *state = (SuspendedState *)mg->mg_ptr;
427              
428 106 100         if(state->awaiting_future) {
429 11           SvREFCNT_dec(state->awaiting_future);
430 11           state->awaiting_future = NULL;
431             }
432              
433 106 100         if(state->returning_future) {
434 11           SvREFCNT_dec(state->returning_future);
435 11           state->returning_future = NULL;
436             }
437              
438 106 100         if(state->frames) {
439             SuspendedFrame *frame, *next = state->frames;
440 23 100         while((frame = next)) {
441 12           next = frame->next;
442              
443 12 100         if(frame->stacklen) {
444             /* The stack isn't refcounted, so we should not SvREFCNT_dec() these
445             * items
446             */
447 3           Safefree(frame->stack);
448             }
449              
450 12 100         if(frame->marklen) {
451 3           Safefree(frame->marks);
452             }
453              
454 12 100         if(frame->saved) {
455             int idx;
456 17 100         for(idx = 0; idx < frame->savedlen; idx++) {
457 13           struct Saved *saved = &frame->saved[idx];
458 13           switch(saved->type) {
459             /* Saved types for which we've no cleanup needed */
460             #ifdef SAVEt_CLEARPADRANGE
461             case SAVEt_CLEARPADRANGE:
462             #endif
463             case SAVEt_CLEARSV:
464             case SAVEt_COMPPAD:
465             case SAVEt_INT_SMALL:
466             case SAVEt_DESTRUCTOR_X:
467             #ifdef SAVEt_STRLEN
468             case SAVEt_STRLEN:
469             #endif
470             case SAVEt_SET_SVFLAGS:
471             break;
472              
473 0           case SAVEt_FREEPV:
474 0           Safefree(saved->cur.ptr);
475 0           break;
476              
477 2           case SAVEt_FREESV:
478 2           SvREFCNT_dec(saved->saved.sv);
479 2           break;
480              
481 1           case SAVEt_SV:
482 1           SvREFCNT_dec(saved->u.gv);
483 1           SvREFCNT_dec(saved->saved.sv);
484 1           SvREFCNT_dec(saved->cur.sv);
485 1           break;
486              
487 0           case SAVEt_PADSV_AND_MORTALIZE:
488 0           SvREFCNT_dec(saved->saved.sv);
489 0           SvREFCNT_dec(saved->cur.sv);
490 0           break;
491              
492 2           case SAVEt_SPTR:
493 2           SvREFCNT_dec(saved->saved.sv);
494             /* saved->cur.sv does not account for an extra refcount */
495 2           break;
496              
497 0           default:
498             {
499 0           char *name = PL_savetype_name[saved->type];
500 0 0         if(name)
501 0           fprintf(stderr, "TODO: free saved slot type SAVEt_%s=%d\n", name, saved->type);
502             else
503 0           fprintf(stderr, "TODO: free saved slot type UNKNOWN=%d\n", saved->type);
504             break;
505             }
506             }
507             }
508              
509 4           Safefree(frame->saved);
510             }
511              
512 12           switch(frame->type) {
513             case CXt_BLOCK:
514             case CXt_LOOP_PLAIN:
515             break;
516              
517 0           case CXt_LOOP_LAZYSV:
518 0           SvREFCNT_dec(frame->el.loop.state_u.lazysv.cur);
519 0           SvREFCNT_dec(frame->el.loop.state_u.lazysv.end);
520 0           goto cxt_loop_common;
521              
522             #if HAVE_PERL_VERSION(5, 24, 0)
523 0           case CXt_LOOP_ARY:
524             #else
525             case CXt_LOOP_FOR:
526             #endif
527 0 0         if(frame->el.loop.state_u.ary.ary)
528 0           SvREFCNT_dec(frame->el.loop.state_u.ary.ary);
529 0           goto cxt_loop_common;
530              
531             case CXt_LOOP_LAZYIV:
532             #if HAVE_PERL_VERSION(5, 24, 0)
533             case CXt_LOOP_LIST:
534             #endif
535 1           cxt_loop_common:
536             #if !defined(HAVE_ITERVAR)
537 1           SvREFCNT_dec(frame->el.loop.itersave);
538             #endif
539 1           break;
540             }
541              
542             #ifdef HAVE_ITERVAR
543             if(frame->itervar) {
544             SvREFCNT_dec(frame->itervar);
545             frame->itervar = NULL;
546             }
547             #endif
548              
549 12 100         if(frame->mortals) {
550             int i;
551 4 100         for(i = 0; i < frame->mortallen; i++)
552 2           sv_2mortal(frame->mortals[i]);
553              
554 2           Safefree(frame->mortals);
555             }
556              
557 12           Safefree(frame);
558             }
559             }
560              
561 106 100         if(state->padslots) {
562             int i;
563 57 100         for(i = 0; i < state->padlen - 1; i++) {
564 46 100         if(state->padslots[i])
565 16           SvREFCNT_dec(state->padslots[i]);
566             }
567              
568 11           Safefree(state->padslots);
569 11           state->padslots = NULL;
570 11           state->padlen = 0;
571             }
572              
573 106 100         if(state->defav) {
574 11           SvREFCNT_dec(state->defav);
575 11           state->defav = NULL;
576             }
577              
578 106 100         if(state->modhookdata) {
579 13           struct HookRegistrations *regs = registrations(FALSE);
580             /* New hooks first */
581 13 100         if(regs)
582 20 50         RUN_HOOKS_REV(free, (CV *)sv, state->modhookdata);
    100          
583              
584             /* Legacy hooks after */
585 13           SV **hookp = hv_fetchs(PL_modglobal, "Future::AsyncAwait/suspendhook", FALSE);
586 13 50         if(hookp && SvOK(*hookp) && SvUV(*hookp)) {
    0          
    0          
587 0           warn("Invoking legacy Future::AsyncAwait suspendhook for FREE phase");
588 0           SuspendHookFunc *hook = INT2PTR(SuspendHookFunc *, SvUV(*hookp));
589 0           (*hook)(aTHX_ FAA_PHASE_FREE, (CV *)sv, state->modhookdata);
590             }
591              
592 13           SvREFCNT_dec(state->modhookdata);
593             }
594              
595 106           Safefree(state);
596              
597 106           return 1;
598             }
599              
600             #define suspend_frame(frame, cx) MY_suspend_frame(aTHX_ frame, cx)
601 190           static void MY_suspend_frame(pTHX_ SuspendedFrame *frame, PERL_CONTEXT *cx)
602             {
603 190           frame->stacklen = (I32)(PL_stack_sp - PL_stack_base) - cx->blk_oldsp;
604 190 100         if(frame->stacklen) {
605 30           SV **bp = PL_stack_base + cx->blk_oldsp + 1;
606             I32 i;
607             /* Steal SVs right off the stack */
608 30           Newx(frame->stack, frame->stacklen, SV *);
609 108 100         for(i = 0; i < frame->stacklen; i++) {
610 78           frame->stack[i] = bp[i];
611 78           bp[i] = NULL;
612             }
613 30           PL_stack_sp = PL_stack_base + cx->blk_oldsp;
614             }
615              
616 190           frame->marklen = (I32)(PL_markstack_ptr - PL_markstack) - cx->blk_oldmarksp;
617 190 100         if(frame->marklen) {
618 19           I32 *markbase = PL_markstack + cx->blk_oldmarksp + 1;
619             I32 i;
620 19           Newx(frame->marks, frame->marklen, I32);
621 40 100         for(i = 0; i < frame->marklen; i++) {
622             /* Translate mark value relative to base */
623 21           I32 relmark = markbase[i] - cx->blk_oldsp;
624 21           frame->marks[i] = relmark;
625             }
626 19           PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp;
627             }
628              
629 190           frame->oldcop = cx->blk_oldcop;
630              
631 190           I32 old_saveix = OLDSAVEIX(cx);
632             /* This is an over-estimate but it doesn't matter. We just waste a bit of RAM
633             * temporarily
634             */
635 190           I32 savedlen = PL_savestack_ix - old_saveix;
636 190 100         if(savedlen)
637 56           Newx(frame->saved, savedlen, struct Saved);
638             else
639 134           frame->saved = NULL;
640 190           frame->savedlen = 0; /* we increment it as we fill it */
641              
642             I32 oldtmpsfloor = -2;
643             #if HAVE_PERL_VERSION(5, 24, 0)
644             /* Perl 5.24 onwards has a PERL_CONTEXT slot for the old value of
645             * PL_tmpsfloor. Older perls do not, and keep it in the save stack instead.
646             * We'll keep an eye out for its saved value
647             */
648 190           oldtmpsfloor = cx->blk_old_tmpsfloor;
649             #endif
650              
651 284 100         while(PL_savestack_ix > old_saveix) {
652             /* Useful references
653             * scope.h
654             * scope.c: Perl_leave_scope()
655             */
656              
657 94           UV uv = PL_savestack[PL_savestack_ix-1].any_uv;
658 94           U8 type = (U8)uv & SAVE_MASK;
659              
660 94           struct Saved *saved = &frame->saved[frame->savedlen];
661              
662 94           switch(type) {
663             #ifdef SAVEt_CLEARPADRANGE
664 15           case SAVEt_CLEARPADRANGE: {
665 15           UV padix = uv >> (OPpPADRANGE_COUNTSHIFT + SAVE_TIGHT_SHIFT);
666 15           I32 count = (uv >> SAVE_TIGHT_SHIFT) & OPpPADRANGE_COUNTMASK;
667 15           PL_savestack_ix--;
668              
669 15 100         saved->type = count == 1 ? SAVEt_CLEARSV : SAVEt_CLEARPADRANGE;
670 15           saved->u.clearpad.padix = padix;
671 15           saved->u.clearpad.count = count;
672              
673 15           break;
674             }
675             #endif
676              
677 45           case SAVEt_CLEARSV: {
678 45           UV padix = (uv >> SAVE_TIGHT_SHIFT);
679 45           PL_savestack_ix--;
680              
681 45           saved->type = SAVEt_CLEARSV;
682 45           saved->u.clearpad.padix = padix;
683              
684 45           break;
685             }
686              
687 0           case SAVEt_COMPPAD: {
688             /* This occurs as a side-effect of Perl_pad_new on 5.22 */
689 0           PL_savestack_ix -= 2;
690 0           void *pad = PL_savestack[PL_savestack_ix].any_ptr;
691              
692 0           saved->type = SAVEt_COMPPAD;
693 0           saved->saved.ptr = pad;
694 0           saved->cur.ptr = PL_comppad;
695              
696 0           PL_comppad = pad;
697 0 0         PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL;
698              
699 0           break;
700             }
701              
702 0           case SAVEt_FREEPV: {
703 0           PL_savestack_ix -= 2;
704 0           char *pv = PL_savestack[PL_savestack_ix].any_ptr;
705              
706 0           saved->type = SAVEt_FREEPV;
707 0           saved->saved.ptr = pv;
708              
709 0           break;
710             }
711              
712 8           case SAVEt_FREESV: {
713 8           PL_savestack_ix -= 2;
714 8           void *sv = PL_savestack[PL_savestack_ix].any_ptr;
715              
716 8           saved->type = SAVEt_FREESV;
717 8           saved->saved.sv = sv;
718              
719 8           break;
720             }
721              
722 0           case SAVEt_INT_SMALL: {
723 0           PL_savestack_ix -= 2;
724 0           int val = ((int)uv >> SAVE_TIGHT_SHIFT);
725 0           int *var = PL_savestack[PL_savestack_ix].any_ptr;
726              
727             /* In general we don't want to support this; but specifically on perls
728             * older than 5.20, this might be PL_tmps_floor
729             */
730 0 0         if(var == (int *)&PL_tmps_floor) {
731             /* Don't bother to save the old tmpsfloor as we'll SAVETMPS again
732             * later if we need to
733             */
734             oldtmpsfloor = val;
735 0           goto nosave;
736             }
737              
738 0           panic("TODO: Unsure how to handle a savestack entry of SAVEt_INT_SMALL with var != &PL_tmps_floor\n");
739 0           break;
740             }
741              
742 10           case SAVEt_DESTRUCTOR_X: {
743             /* This is only known to be used by Syntax::Keyword::Try to implement
744             * finally blocks. It may be found elsewhere for which this code is
745             * unsafe, but detecting such cases is generally impossible. Good luck.
746             */
747 10           PL_savestack_ix -= 3;
748 10           void (*func)(pTHX_ void *) = PL_savestack[PL_savestack_ix].any_dxptr;
749 10           void *data = PL_savestack[PL_savestack_ix+1].any_ptr;
750              
751 10           saved->type = SAVEt_DESTRUCTOR_X;
752 10           saved->u.dx.func = func;
753 10           saved->u.dx.data = data;
754              
755 10           break;
756             }
757              
758 0           case SAVEt_ITEM: {
759 0           PL_savestack_ix -= 3;
760 0           SV *var = PL_savestack[PL_savestack_ix].any_ptr;
761 0           SV *val = PL_savestack[PL_savestack_ix+1].any_ptr;
762              
763 0           saved->type = SAVEt_ITEM;
764 0           saved->u.sv = var;
765 0           saved->cur.sv = newSVsv(var);
766 0           saved->saved.sv = val;
767              
768             /* restore it for now */
769 0           sv_setsv(var, val);
770              
771 0           break;
772             }
773              
774 8           case SAVEt_SPTR: {
775 8           PL_savestack_ix -= 3;
776 8           SV *val = PL_savestack[PL_savestack_ix].any_ptr;
777 8           SV **var = PL_savestack[PL_savestack_ix+1].any_ptr;
778              
779             /* In general we don't support this; but specifically we will accept
780             * it if we can convert var into a PAD index. This is to support
781             * SAVESPTR(PAD_SVl(padix)), as may be used by Object::Pad or others
782             */
783 8 50         if(var < PL_curpad || var > PL_curpad + AvFILL(PL_comppad))
    50          
    50          
784 0           panic("TODO: Unsure how to handle a savestack entry of SAVEt_SPTR with var not the current pad\n");
785              
786 8           PADOFFSET padix = var - PL_curpad;
787              
788 8           saved->type = SAVEt_SPTR;
789 8           saved->u.padix = padix;
790 8           saved->cur.sv = PL_curpad[padix]; /* steal ownership */
791 8 50         saved->saved.sv = val; /* steal ownership */
792              
793             /* restore it for now */
794 8           PL_curpad[padix] = SvREFCNT_inc(val);
795              
796 8           break;
797             }
798              
799             #ifdef SAVEt_STRLEN
800 0           case SAVEt_STRLEN: {
801 0           PL_savestack_ix -= 3;
802 0           STRLEN val = PL_savestack[PL_savestack_ix].any_iv;
803 0           STRLEN *var = PL_savestack[PL_savestack_ix+1].any_ptr;
804              
805             /* In general we don't want to support this; but specifically on perls
806             * older than 5.24, this might be PL_tmps_floor
807             */
808 0 0         if(var == (STRLEN *)&PL_tmps_floor) {
809             /* Don't bother to save the old tmpsfloor as we'll SAVETMPS again
810             * later if we need to
811             */
812 0           oldtmpsfloor = val;
813 0           goto nosave;
814             }
815              
816 0           panic("TODO: Unsure how to handle a savestack entry of SAVEt_STRLEN with var != &PL_tmps_floor\n");
817 0           break;
818             }
819             #endif
820              
821 8           case SAVEt_SV: {
822 8           PL_savestack_ix -= 3;
823             /* despite being called SAVEt_SV, the first field actually points at
824             * the GV containing the local'ised SV
825             */
826 8           GV *gv = PL_savestack[PL_savestack_ix ].any_ptr;
827 8           SV *val = PL_savestack[PL_savestack_ix+1].any_ptr;
828              
829             /* In general we don't want to support local $VAR. However, a special
830             * case of local $@ is allowable
831             * See also https://rt.cpan.org/Ticket/Display.html?id=122793
832             */
833 8 50         if(gv != PL_errgv) {
834 0           const char *name = GvNAME(gv);
835 0 0         const char *stashname = HvNAME(GvSTASH(gv));
    0          
    0          
    0          
    0          
836              
837 0 0         if(name && stashname)
838 0           panic("TODO: Unsure how to handle a savestack entry of SAVEt_SV with gv != PL_errgv ($%s::%s)\n",
839             stashname, name);
840             else
841 0           panic("TODO: Unsure how to handle a savestack entry of SAVEt_SV with gv != PL_errgv\n");
842             }
843              
844 8           saved->type = SAVEt_SV;
845 8           saved->u.gv = gv;
846 8           saved->cur.sv = GvSV(gv); /* steal ownership */
847 8           saved->saved.sv = val; /* steal ownership */
848              
849             /* restore it for now */
850 8           GvSV(gv) = val;
851              
852 8           break;
853             }
854              
855 0           case SAVEt_PADSV_AND_MORTALIZE: {
856 0           PL_savestack_ix -= 4;
857 0           SV *val = PL_savestack[PL_savestack_ix ].any_ptr;
858 0           AV *padav = PL_savestack[PL_savestack_ix+1].any_ptr;
859 0           PADOFFSET padix = PL_savestack[PL_savestack_ix+2].any_uv;
860              
861 0 0         if(padav != PL_comppad)
862 0           panic("TODO: Unsure how to handle a savestack entry of SAVEt_PADSV_AND_MORTALIZE with padav != PL_comppad\n");
863              
864 0 0         SvREFCNT_inc(PL_curpad[padix]); /* un-mortalize */
865              
866 0           saved->type = SAVEt_PADSV_AND_MORTALIZE;
867 0           saved->u.padix = padix;
868 0           saved->cur.sv = PL_curpad[padix]; /* steal ownership */
869 0           saved->saved.sv = val; /* steal ownership */
870              
871 0 0         AvARRAY(padav)[padix] = SvREFCNT_inc(val);
872              
873 0           break;
874             }
875              
876 0           case SAVEt_SET_SVFLAGS: {
877 0           PL_savestack_ix -= 4;
878 0           SV *sv = PL_savestack[PL_savestack_ix ].any_ptr;
879 0           U32 mask = (U32)PL_savestack[PL_savestack_ix+1].any_i32;
880 0           U32 set = (U32)PL_savestack[PL_savestack_ix+2].any_i32;
881              
882 0           saved->type = SAVEt_SET_SVFLAGS;
883 0           saved->u.svflags.sv = sv;
884 0           saved->u.svflags.mask = mask;
885 0           saved->u.svflags.set = set;
886              
887 0           break;
888             }
889              
890 0           default:
891             {
892 0           char *name = PL_savetype_name[type];
893 0 0         if(name)
894 0           panic("TODO: Unsure how to handle savestack entry of SAVEt_%s=%d\n", name, type);
895             else
896 0           panic("TODO: Unsure how to handle savestack entry of UNKNOWN=%d\n", type);
897             }
898             }
899              
900 94           frame->savedlen++;
901              
902             nosave:
903             ;
904             }
905              
906 190 50         if(OLDSAVEIX(cx) != PL_savestack_ix)
907 0           panic("TODO: handle OLDSAVEIX\n");
908              
909 190           frame->scopes = (PL_scopestack_ix - cx->blk_oldscopesp) + 1;
910 190 100         if(frame->scopes) {
911             /* We'll mutate PL_scopestack_ix but it doesn't matter as dounwind() will
912             * put it right at the end. Do this unconditionally to avoid divergent
913             * behaviour between -DDEBUGGING builds and non.
914             */
915 138           PL_scopestack_ix -= frame->scopes;
916             }
917              
918             /* ref:
919             * https://perl5.git.perl.org/perl.git/blob/HEAD:/cop.h
920             */
921 190           U8 type = CxTYPE(cx);
922 190           switch(type) {
923 7           case CXt_BLOCK:
924 7           frame->type = CXt_BLOCK;
925 7           frame->gimme = cx->blk_gimme;
926             /* nothing else special */
927 7           break;
928              
929 9           case CXt_LOOP_PLAIN:
930 9           frame->type = type;
931 9           frame->el.loop = cx->blk_loop;
932 9           frame->gimme = cx->blk_gimme;
933 9           break;
934              
935             #if HAVE_PERL_VERSION(5, 24, 0)
936 31           case CXt_LOOP_ARY:
937             case CXt_LOOP_LIST:
938             #else
939             case CXt_LOOP_FOR:
940             #endif
941             case CXt_LOOP_LAZYSV:
942             case CXt_LOOP_LAZYIV:
943 31 50         if(!CxPADLOOP(cx))
944             /* non-lexical foreach will effectively work like 'local' and we
945             * can't really support local
946             */
947 0           croak("Cannot suspend a foreach loop on non-lexical iterator");
948              
949 31           frame->type = type;
950 31           frame->el.loop = cx->blk_loop;
951 31           frame->gimme = cx->blk_gimme;
952              
953             #ifdef HAVE_ITERVAR
954             # ifdef USE_ITHREADS
955             if(cx->blk_loop.itervar_u.svp != (SV **)PL_comppad)
956             panic("TODO: Unsure how to handle a foreach loop with itervar != PL_comppad\n");
957             # else
958             if(cx->blk_loop.itervar_u.svp != &PAD_SVl(cx->blk_loop.my_op->op_targ))
959             panic("TODO: Unsure how to handle a foreach loop with itervar != PAD_SVl(op_targ))\n");
960             # endif
961              
962             frame->itervar = SvREFCNT_inc(*CxITERVAR(cx));
963             #else
964 31 50         if(CxITERVAR(cx) != &PAD_SVl(cx->blk_loop.my_op->op_targ))
    0          
    50          
965 0           panic("TODO: Unsure how to handle a foreach loop with itervar != PAD_SVl(op_targ))\n");
966 31 50         SvREFCNT_inc(cx->blk_loop.itersave);
967             #endif
968              
969 31           switch(type) {
970 3           case CXt_LOOP_LAZYSV:
971             /* these two fields are refcounted, so we need to save them from
972             * dounwind() throwing them away
973             */
974 3 50         SvREFCNT_inc(frame->el.loop.state_u.lazysv.cur);
975 3 50         SvREFCNT_inc(frame->el.loop.state_u.lazysv.end);
976             break;
977              
978             #if HAVE_PERL_VERSION(5, 24, 0)
979 6           case CXt_LOOP_ARY:
980             #else
981             case CXt_LOOP_FOR:
982             /* The ix field stores an absolute stack height as offset from
983             * PL_stack_base directly. When we get resumed the stack will
984             * probably not be the same absolute height at this point, so we'll
985             * have to store them relative to something fixed.
986             */
987             if(!cx->blk_loop.state_u.ary.ary) {
988             I32 height = PL_stack_sp - PL_stack_base;
989             frame->el.loop.state_u.ary.ix = height - frame->el.loop.state_u.ary.ix;
990             }
991             #endif
992             /* this field is also refcounted, so we need to save it too */
993 6 50         if(frame->el.loop.state_u.ary.ary)
994             SvREFCNT_inc(frame->el.loop.state_u.ary.ary);
995             break;
996              
997             #if HAVE_PERL_VERSION(5, 24, 0)
998 19           case CXt_LOOP_LIST: {
999             /* The various fields in the context structure store absolute stack
1000             * heights as offsets from PL_stack_base directly. When we get
1001             * resumed the stack will probably not be the same absolute height
1002             * at this point, so we'll have to store them relative to something
1003             * fixed.
1004             * We'll adjust them to be upside-down, counting -backwards- from
1005             * the current stack height.
1006             */
1007 19           I32 height = PL_stack_sp - PL_stack_base;
1008              
1009 19 50         if(cx->blk_oldsp != height)
1010 0           panic("ARGH suspending CXt_LOOP_LIST frame with blk_oldsp != stack height\n");
1011              
1012             /* First item is at [1] oddly, not [0] */
1013 19           frame->loop_list_first_item = PL_stack_base[cx->blk_loop.state_u.stack.basesp+1];
1014              
1015 19           frame->el.loop.state_u.stack.basesp = height - frame->el.loop.state_u.stack.basesp;
1016 19           frame->el.loop.state_u.stack.ix = height - frame->el.loop.state_u.stack.ix;
1017 19           break;
1018             }
1019             #endif
1020             }
1021              
1022             break;
1023              
1024 143           case CXt_EVAL: {
1025 143 50         if(!(cx->cx_type & CXp_TRYBLOCK))
1026 0           panic("TODO: handle CXt_EVAL without CXp_TRYBLOCK\n");
1027 143 50         if(cx->blk_eval.old_namesv)
1028 0           panic("TODO: handle cx->blk_eval.old_namesv\n");
1029 143 50         if(cx->blk_eval.cv)
1030 0           panic("TODO: handle cx->blk_eval.cv\n");
1031 143 50         if(cx->blk_eval.cur_top_env != PL_top_env)
1032 0           panic("TODO: handle cx->blk_eval.cur_top_env\n");
1033              
1034             /*
1035             * It seems we don't need to care about blk_eval.old_eval_root or
1036             * blk_eval.cur_text, and if we ignore these then it works fine via
1037             * string eval().
1038             * https://rt.cpan.org/Ticket/Display.html?id=126036
1039             */
1040              
1041 143           frame->type = CXt_EVAL;
1042 143           frame->gimme = cx->blk_gimme;
1043              
1044             #ifdef HAVE_CX_TRY
1045 143 100         if(CxTRY(cx))
1046 3           frame->type |= CXp_TRY;
1047             #endif
1048              
1049 143           frame->el.eval.retop = cx->blk_eval.retop;
1050              
1051 143           break;
1052             }
1053              
1054 0           default:
1055 0           panic("TODO: unsure how to handle a context frame of type %d\n", CxTYPE(cx));
1056             }
1057              
1058 190           frame->mortallen = 0;
1059 190           frame->mortals = NULL;
1060 190 50         if(oldtmpsfloor == -2) {
1061             /* Don't worry about it; the next level down will save us */
1062             }
1063             else {
1064             /* Save the mortals! */
1065 190           SV **tmpsbase = PL_tmps_stack + PL_tmps_floor + 1;
1066             I32 i;
1067              
1068 190           frame->mortallen = (I32)(PL_tmps_ix - PL_tmps_floor);
1069 190 100         if(frame->mortallen) {
1070 26           Newx(frame->mortals, frame->mortallen, SV *);
1071 60 100         for(i = 0; i < frame->mortallen; i++) {
1072 34           frame->mortals[i] = tmpsbase[i];
1073 34           tmpsbase[i] = NULL;
1074             }
1075             }
1076              
1077 190           PL_tmps_ix = PL_tmps_floor;
1078 190           PL_tmps_floor = oldtmpsfloor;
1079             }
1080 190           }
1081              
1082             #define suspendedstate_suspend(state, cv) MY_suspendedstate_suspend(aTHX_ state, cv)
1083 138           static void MY_suspendedstate_suspend(pTHX_ SuspendedState *state, CV *cv)
1084             {
1085             I32 cxix;
1086             PADOFFSET padnames_max, pad_max, i;
1087             PADLIST *plist;
1088             PADNAME **padnames;
1089             PAD *pad;
1090             SV **padsvs;
1091              
1092 138           state->frames = NULL;
1093              
1094 328 50         for(cxix = cxstack_ix; cxix; cxix--) {
1095 328           PERL_CONTEXT *cx = &cxstack[cxix];
1096 328 100         if(CxTYPE(cx) == CXt_SUB)
1097             break;
1098              
1099             SuspendedFrame *frame;
1100              
1101 190           Newx(frame, 1, SuspendedFrame);
1102 190           frame->next = state->frames;
1103 190           state->frames = frame;
1104             #ifdef HAVE_ITERVAR
1105             frame->itervar = NULL;
1106             #endif
1107              
1108 190           suspend_frame(frame, cx);
1109             }
1110              
1111             /* Now steal the lexical SVs from the PAD */
1112 138           plist = CvPADLIST(cv);
1113              
1114 138           padnames = PadnamelistARRAY(PadlistNAMES(plist));
1115 138           padnames_max = PadnamelistMAX(PadlistNAMES(plist));
1116              
1117 138           pad = PadlistARRAY(plist)[CvDEPTH(cv)];
1118 138           pad_max = PadMAX(pad);
1119 138           padsvs = PadARRAY(pad);
1120              
1121 138           state->padlen = PadMAX(pad) + 1;
1122 138           Newx(state->padslots, state->padlen - 1, SV *);
1123              
1124             /* slot 0 is always the @_ AV */
1125 619 100         for(i = 1; i <= pad_max; i++) {
1126 481 50         PADNAME *pname = (i <= padnames_max) ? padnames[i] : NULL;
1127              
1128 481 100         if(!padname_is_normal_lexical(pname)) {
1129 351           state->padslots[i-1] = NULL;
1130 351           continue;
1131             }
1132              
1133 130 50         if(PadnameIsSTATE(pname)) {
1134 0 0         state->padslots[i-1] = SvREFCNT_inc(padsvs[i]);
1135             }
1136             else {
1137             /* Don't fiddle refcount */
1138 130           state->padslots[i-1] = padsvs[i];
1139 130           switch(PadnamePV(pname)[0]) {
1140 20           case '@':
1141 20           padsvs[i] = MUTABLE_SV(newAV());
1142 20           break;
1143 5           case '%':
1144 5           padsvs[i] = MUTABLE_SV(newHV());
1145 5           break;
1146 105           case '$':
1147 105           padsvs[i] = newSV(0);
1148 105           break;
1149 0           default:
1150 0           panic("TODO: unsure how to steal and switch pad slot with pname %s\n",
1151             PadnamePV(pname));
1152             }
1153 130           SvPADMY_on(padsvs[i]);
1154             }
1155             }
1156              
1157 138 100         if(PL_curpm)
1158 2           state->curpm = PL_curpm;
1159             else
1160 136           state->curpm = NULL;
1161              
1162             #if !HAVE_PERL_VERSION(5, 24, 0)
1163             /* perls before v5.24 will crash if we try to do this at all */
1164             if(0)
1165             #elif HAVE_PERL_VERSION(5, 36, 0)
1166             /* perls 5.36 onwards have CvSIGNATURE; we don't need to bother doing this
1167             * inside signatured subs */
1168 138 50         if(!CvSIGNATURE(cv))
1169             #endif
1170             /* on perl versions between those, just do it unconditionally */
1171             {
1172 138           state->defav = GvAV(PL_defgv); /* steal */
1173              
1174 138           AV *av = GvAV(PL_defgv) = newAV();
1175 138           AvREAL_off(av);
1176              
1177 138 50         if(PAD_SVl(0) == (SV *)state->defav) {
1178             /* Steal that one too */
1179 138           SvREFCNT_dec(PAD_SVl(0));
1180 138           PAD_SVl(0) = SvREFCNT_inc(av);
1181             }
1182             }
1183              
1184 138           dounwind(cxix);
1185 138           }
1186              
1187             #define resume_frame(frame, cx) MY_resume_frame(aTHX_ frame)
1188 178           static void MY_resume_frame(pTHX_ SuspendedFrame *frame)
1189             {
1190             I32 i;
1191              
1192             PERL_CONTEXT *cx;
1193             I32 was_scopestack_ix = PL_scopestack_ix;
1194              
1195 178           switch(frame->type) {
1196 7           case CXt_BLOCK:
1197             #if !HAVE_PERL_VERSION(5, 24, 0)
1198             ENTER_with_name("block");
1199             SAVETMPS;
1200             #endif
1201 7           cx = cx_pushblock(CXt_BLOCK, frame->gimme, PL_stack_sp, PL_savestack_ix);
1202             /* nothing else special */
1203 7           break;
1204              
1205 9           case CXt_LOOP_PLAIN:
1206             #if !HAVE_PERL_VERSION(5, 24, 0)
1207             ENTER_with_name("loop1");
1208             SAVETMPS;
1209             ENTER_with_name("loop2");
1210             #endif
1211 9           cx = cx_pushblock(frame->type, frame->gimme, PL_stack_sp, PL_savestack_ix);
1212             /* don't call cx_pushloop_plain() because it will get this wrong */
1213 9           cx->blk_loop = frame->el.loop;
1214 9           break;
1215              
1216             #if HAVE_PERL_VERSION(5, 24, 0)
1217 30           case CXt_LOOP_ARY:
1218             case CXt_LOOP_LIST:
1219             #else
1220             case CXt_LOOP_FOR:
1221             #endif
1222             case CXt_LOOP_LAZYSV:
1223             case CXt_LOOP_LAZYIV:
1224             #if !HAVE_PERL_VERSION(5, 24, 0)
1225             ENTER_with_name("loop1");
1226             SAVETMPS;
1227             ENTER_with_name("loop2");
1228             #endif
1229 30           cx = cx_pushblock(frame->type, frame->gimme, PL_stack_sp, PL_savestack_ix);
1230             /* don't call cx_pushloop_plain() because it will get this wrong */
1231 30           cx->blk_loop = frame->el.loop;
1232             #if HAVE_PERL_VERSION(5, 24, 0)
1233 30           cx->cx_type |= CXp_FOR_PAD;
1234             #endif
1235              
1236             #ifdef HAVE_ITERVAR
1237             # ifdef USE_ITHREADS
1238             cx->blk_loop.itervar_u.svp = (SV **)PL_comppad;
1239             # else
1240             cx->blk_loop.itervar_u.svp = &PAD_SVl(cx->blk_loop.my_op->op_targ);
1241             # endif
1242             SvREFCNT_dec(*CxITERVAR(cx));
1243             *CxITERVAR(cx) = frame->itervar;
1244             frame->itervar = NULL;
1245             #else
1246 30           cx->blk_loop.itervar_u.svp = &PAD_SVl(cx->blk_loop.my_op->op_targ);
1247             #endif
1248 30           break;
1249              
1250 129           case CXt_EVAL:
1251 129 50         if(CATCH_GET)
1252 0           panic("Too late to docatch()\n");
1253              
1254             #if !HAVE_PERL_VERSION(5, 24, 0)
1255             ENTER_with_name("eval_scope");
1256             SAVETMPS;
1257             #endif
1258 129           cx = cx_pushblock(CXt_EVAL|CXp_TRYBLOCK, frame->gimme,
1259             PL_stack_sp, PL_savestack_ix);
1260 129           cx_pusheval(cx, frame->el.eval.retop, NULL);
1261 129           PL_in_eval = EVAL_INEVAL;
1262 129 50         CLEAR_ERRSV();
    50          
    50          
1263             break;
1264              
1265             #ifdef HAVE_CX_TRY
1266 3           case CXt_EVAL|CXp_TRY:
1267 3 50         if(CATCH_GET)
1268 0           panic("Too late to docatch()\n");
1269              
1270 3           cx = cx_pushblock(CXt_EVAL|CXp_EVALBLOCK|CXp_TRY, frame->gimme,
1271             PL_stack_sp, PL_savestack_ix);
1272 3           cx_pushtry(cx, frame->el.eval.retop);
1273 3           PL_in_eval = EVAL_INEVAL;
1274 3 50         CLEAR_ERRSV();
    50          
    50          
1275             break;
1276             #endif
1277              
1278 0           default:
1279 0           panic("TODO: Unsure how to restore a %d frame\n", frame->type);
1280             }
1281              
1282 178 100         if(frame->stacklen) {
1283 27           dSP;
1284 27 50         EXTEND(SP, frame->stacklen);
1285              
1286 100 100         for(i = 0; i < frame->stacklen; i++) {
1287 73           PUSHs(frame->stack[i]);
1288             }
1289              
1290 27           Safefree(frame->stack);
1291 27           PUTBACK;
1292             }
1293              
1294 178 100         if(frame->marklen) {
1295 34 100         for(i = 0; i < frame->marklen; i++) {
1296 18           I32 absmark = frame->marks[i] + cx->blk_oldsp;
1297 18 50         PUSHMARK(PL_stack_base + absmark);
1298             }
1299              
1300 16           Safefree(frame->marks);
1301             }
1302              
1303 178           cx->blk_oldcop = frame->oldcop;
1304              
1305 259 100         for(i = frame->savedlen - 1; i >= 0; i--) {
1306 81           struct Saved *saved = &frame->saved[i];
1307              
1308 81           switch(saved->type) {
1309 48           case SAVEt_CLEARSV:
1310 48           save_clearsv(PL_curpad + saved->u.clearpad.padix);
1311 48           break;
1312              
1313             #ifdef SAVEt_CLEARPADRANGE
1314 4           case SAVEt_CLEARPADRANGE:
1315 4           save_clearpadrange(saved->u.clearpad.padix, saved->u.clearpad.count);
1316 4           break;
1317             #endif
1318              
1319 10           case SAVEt_DESTRUCTOR_X:
1320 10           save_pushptrptr(saved->u.dx.func, saved->u.dx.data, saved->type);
1321 10           break;
1322              
1323 0           case SAVEt_COMPPAD:
1324 0           PL_comppad = saved->saved.ptr;
1325 0           save_pushptr(PL_comppad, saved->type);
1326              
1327 0           PL_comppad = saved->cur.ptr;
1328 0 0         PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL;
1329 0           break;
1330              
1331 0           case SAVEt_FREEPV:
1332 0           save_freepv(saved->saved.ptr);
1333 0           break;
1334              
1335 6           case SAVEt_FREESV:
1336 6           save_freesv(saved->saved.sv);
1337 6           break;
1338              
1339 0           case SAVEt_INT:
1340 0           *(saved->u.iptr) = saved->saved.i;
1341 0           save_int(saved->u.iptr);
1342              
1343 0           *(saved->u.iptr) = saved->cur.i;
1344 0           break;
1345              
1346 7           case SAVEt_SV:
1347 14 50         save_pushptrptr(saved->u.gv, SvREFCNT_inc(saved->saved.sv), SAVEt_SV);
1348              
1349 7           SvREFCNT_dec(GvSV(saved->u.gv));
1350 7           GvSV(saved->u.gv) = saved->cur.sv;
1351 7           break;
1352              
1353 0           case SAVEt_ITEM:
1354 0           save_pushptrptr(saved->u.sv, saved->saved.sv, SAVEt_ITEM);
1355              
1356 0           sv_setsv(saved->u.sv, saved->cur.sv);
1357 0           SvREFCNT_dec(saved->cur.sv);
1358 0           break;
1359              
1360 6           case SAVEt_SPTR:
1361 6           PL_curpad[saved->u.padix] = saved->saved.sv;
1362 6           SAVESPTR(PL_curpad[saved->u.padix]);
1363              
1364 6           SvREFCNT_dec(PL_curpad[saved->u.padix]);
1365 6           PL_curpad[saved->u.padix] = saved->cur.sv;
1366 6           break;
1367              
1368             #ifdef SAVEt_STRLEN
1369 0           case SAVEt_STRLEN:
1370 0           *(saved->u.lenptr) = saved->saved.len;
1371 0           Perl_save_strlen(aTHX_ saved->u.lenptr);
1372              
1373 0           *(saved->u.lenptr) = saved->cur.len;
1374 0           break;
1375             #endif
1376              
1377 0           case SAVEt_PADSV_AND_MORTALIZE:
1378 0           PL_curpad[saved->u.padix] = saved->saved.sv;
1379 0           save_padsv_and_mortalize(saved->u.padix);
1380              
1381 0           SvREFCNT_dec(PL_curpad[saved->u.padix]);
1382 0           PL_curpad[saved->u.padix] = saved->cur.sv;
1383 0           break;
1384              
1385             case SAVEt_SET_SVFLAGS:
1386             /*
1387             save_set_svflags(saved->u.svflags.sv,
1388             saved->u.svflags.mask, saved->u.svflags.set);
1389             */
1390             break;
1391              
1392 0           default:
1393 0           panic("TODO: Unsure how to restore a %d savestack entry\n", saved->type);
1394             }
1395             }
1396              
1397 178 100         if(frame->saved)
1398 52           Safefree(frame->saved);
1399              
1400             if(frame->scopes) {
1401             #ifdef DEBUG
1402             if(PL_scopestack_ix - was_scopestack_ix < frame->scopes) {
1403             fprintf(stderr, "TODO ARG still more scopes to ENTER\n");
1404             }
1405             #endif
1406             }
1407              
1408 178 100         if(frame->mortallen) {
1409 56 100         for(i = 0; i < frame->mortallen; i++) {
1410 32           sv_2mortal(frame->mortals[i]);
1411             }
1412              
1413 24           Safefree(frame->mortals);
1414 24           frame->mortals = NULL;
1415             }
1416              
1417 178 100         switch(frame->type) {
1418             #if !HAVE_PERL_VERSION(5, 24, 0)
1419             case CXt_LOOP_FOR:
1420             if(!cx->blk_loop.state_u.ary.ary) {
1421             I32 height = PL_stack_sp - PL_stack_base - frame->stacklen;
1422             cx->blk_loop.state_u.ary.ix = height - cx->blk_loop.state_u.ary.ix;
1423             }
1424             break;
1425             #endif
1426              
1427             #if HAVE_PERL_VERSION(5, 24, 0)
1428 18           case CXt_LOOP_LIST: {
1429 18           I32 height = PL_stack_sp - PL_stack_base - frame->stacklen;
1430              
1431 18           cx->blk_loop.state_u.stack.basesp = height - cx->blk_loop.state_u.stack.basesp;
1432 18           cx->blk_loop.state_u.stack.ix = height - cx->blk_loop.state_u.stack.ix;
1433              
1434             /* For consistency; check that the first SV in the list is in the right
1435             * place. If so we presume the others are
1436             */
1437 18 50         if(PL_stack_base[cx->blk_loop.state_u.stack.basesp+1] == frame->loop_list_first_item)
1438             break;
1439              
1440             /* First item is at [1] oddly, not [0] */
1441             #ifdef debug_sv_summary
1442             fprintf(stderr, "F:AA: consistency check resume LOOP_LIST with first=%p:",
1443             frame->loop_list_first_item);
1444             debug_sv_summary(frame->loop_list_first_item);
1445             fprintf(stderr, " stackitem=%p:", PL_stack_base[frame->el.loop.state_u.stack.basesp + 1]);
1446             debug_sv_summary(PL_stack_base[frame->el.loop.state_u.stack.basesp]);
1447             fprintf(stderr, "\n");
1448             #endif
1449 0           panic("ARGH CXt_LOOP_LIST consistency check failed\n");
1450 0           break;
1451             }
1452             #endif
1453             }
1454 178           }
1455              
1456             #define suspendedstate_resume(state, cv) MY_suspendedstate_resume(aTHX_ state, cv)
1457 127           static void MY_suspendedstate_resume(pTHX_ SuspendedState *state, CV *cv)
1458             {
1459             I32 i;
1460              
1461 127 50         if(state->padlen) {
1462 127           PAD *pad = PadlistARRAY(CvPADLIST(cv))[CvDEPTH(cv)];
1463             PADOFFSET i;
1464              
1465             /* slot 0 is always the @_ AV */
1466 562 100         for(i = 1; i < state->padlen; i++) {
1467 435 100         if(!state->padslots[i-1])
1468 324           continue;
1469              
1470 111           SvREFCNT_dec(PadARRAY(pad)[i]);
1471 111           PadARRAY(pad)[i] = state->padslots[i-1];
1472             }
1473              
1474 127           Safefree(state->padslots);
1475 127           state->padslots = NULL;
1476 127           state->padlen = 0;
1477             }
1478              
1479             SuspendedFrame *frame, *next;
1480 305 100         for(frame = state->frames; frame; frame = next) {
1481 178           next = frame->next;
1482              
1483 178           resume_frame(frame, cx);
1484              
1485 178           Safefree(frame);
1486             }
1487 127           state->frames = NULL;
1488              
1489 127 100         if(state->curpm)
1490 2           PL_curpm = state->curpm;
1491              
1492 127 50         if(state->defav) {
1493 127           SvREFCNT_dec(GvAV(PL_defgv));
1494 127           SvREFCNT_dec(PAD_SVl(0));
1495              
1496 127           GvAV(PL_defgv) = state->defav;
1497 127 50         PAD_SVl(0) = SvREFCNT_inc((SV *)state->defav);
1498 127           state->defav = NULL;
1499             }
1500 127           }
1501              
1502             #define suspendedstate_cancel(state) MY_suspendedstate_cancel(aTHX_ state)
1503 7           static void MY_suspendedstate_cancel(pTHX_ SuspendedState *state)
1504             {
1505             SuspendedFrame *frame;
1506 13 100         for(frame = state->frames; frame; frame = frame->next) {
1507             I32 i;
1508              
1509 9 100         for(i = frame->savedlen - 1; i >= 0; i--) {
1510 3           struct Saved *saved = &frame->saved[i];
1511              
1512 3 50         switch(saved->type) {
1513 0           case SAVEt_DESTRUCTOR_X:
1514             /* We have to run destructors to ensure that defer {} and try/finally
1515             * work correctly
1516             * https://rt.cpan.org/Ticket/Display.html?id=135351
1517             */
1518 0           (*saved->u.dx.func)(aTHX_ saved->u.dx.data);
1519 0           break;
1520             }
1521             }
1522             }
1523 7           }
1524              
1525             /*
1526             * Pre-creation assistance
1527             */
1528              
1529             enum {
1530             PRECREATE_CANCEL,
1531             PRECREATE_MODHOOKDATA,
1532             };
1533              
1534             #define get_precreate_padix() S_get_precreate_padix(aTHX)
1535 234           PADOFFSET S_get_precreate_padix(pTHX)
1536             {
1537 234           return SvUV(SvRV(*hv_fetchs(GvHV(PL_hintgv), "Future::AsyncAwait/*precreate_padix", 0)));
1538             }
1539              
1540             #define get_or_create_precreate_padix() S_get_or_create_precreate_padix(aTHX)
1541 4           PADOFFSET S_get_or_create_precreate_padix(pTHX)
1542             {
1543             SV *sv;
1544 4           PADOFFSET padix = SvUV(sv = SvRV(*hv_fetchs(GvHV(PL_hintgv), "Future::AsyncAwait/*precreate_padix", 0)));
1545 4 50         if(!padix) {
1546 4           padix = pad_add_name_pvs("@(Future::AsyncAwait/precancel)", 0, NULL, NULL);
1547 4           sv_setuv(sv, padix);
1548              
1549 4           PADOFFSET p2 = pad_add_name_pvs("%(Future::AsyncAwait/premodhookdata)", 0, NULL, NULL);
1550             assert(p2 == padix + PRECREATE_MODHOOKDATA);
1551             }
1552              
1553 4           return padix;
1554             }
1555              
1556             /*
1557             * Some Future class helper functions
1558             */
1559              
1560             #define future_classname() MY_future_classname(aTHX)
1561 27           static SV *MY_future_classname(pTHX)
1562             {
1563             /* cop_hints_fetch_* return a mortal copy so this is fine */
1564 27           SV *class = cop_hints_fetch_pvs(PL_curcop, "Future::AsyncAwait/future", 0);
1565 27 100         if(class == &PL_sv_placeholder)
1566 26           class = sv_2mortal(newSVpvn("Future", 6));
1567              
1568 27           return class;
1569             }
1570              
1571             #define future_done_from_stack(f, mark) MY_future_done_from_stack(aTHX_ f, mark)
1572 108           static SV *MY_future_done_from_stack(pTHX_ SV *f, SV **mark)
1573             {
1574 108           dSP;
1575             SV **svp;
1576              
1577 108 50         EXTEND(SP, 1);
1578              
1579 108           ENTER_with_name("future_done_from_stack");
1580 108           SAVETMPS;
1581              
1582 108 50         PUSHMARK(mark);
1583 108           SV **bottom = mark + 1;
1584             const char *method;
1585              
1586             /* splice the class name 'Future' in to the start of the stack */
1587              
1588 233 100         for (svp = SP; svp >= bottom; svp--) {
1589 125           *(svp+1) = *svp;
1590             }
1591              
1592 108 100         if(f) {
1593             assert(SvROK(f));
1594 84           *bottom = f;
1595             method = "AWAIT_DONE";
1596             }
1597             else {
1598 24           *bottom = future_classname();
1599             method = "AWAIT_NEW_DONE";
1600             }
1601 108           SP++;
1602 108           PUTBACK;
1603              
1604 108           call_method(method, G_SCALAR);
1605              
1606 108           SPAGAIN;
1607              
1608 108 50         SV *ret = SvREFCNT_inc(POPs);
1609              
1610 108 50         FREETMPS;
1611 108           LEAVE_with_name("future_done_from_stack");
1612              
1613 108           return ret;
1614             }
1615              
1616             #define future_fail(f, failure) MY_future_fail(aTHX_ f, failure)
1617 13           static SV *MY_future_fail(pTHX_ SV *f, SV *failure)
1618             {
1619 13           dSP;
1620              
1621 13           ENTER_with_name("future_fail");
1622 13           SAVETMPS;
1623              
1624             const char *method;
1625              
1626 13 50         PUSHMARK(SP);
1627 13 100         if(f) {
1628             assert(SvROK(f));
1629 10           PUSHs(f);
1630             method = "AWAIT_FAIL";
1631             }
1632             else {
1633 3           PUSHs(future_classname());
1634             method = "AWAIT_NEW_FAIL";
1635             }
1636 13           mPUSHs(newSVsv(failure));
1637 13           PUTBACK;
1638              
1639 13           call_method(method, G_SCALAR);
1640              
1641 13           SPAGAIN;
1642              
1643 13 50         SV *ret = SvREFCNT_inc(POPs);
1644              
1645 13 50         FREETMPS;
1646 13           LEAVE_with_name("future_fail");
1647              
1648 13           return ret;
1649             }
1650              
1651             #define future_new_from_proto(proto) MY_future_new_from_proto(aTHX_ proto)
1652 107           static SV *MY_future_new_from_proto(pTHX_ SV *proto)
1653             {
1654             assert(SvROK(proto));
1655              
1656 107           dSP;
1657              
1658 107           ENTER_with_name("future_new_from_proto");
1659 107           SAVETMPS;
1660              
1661 107 50         PUSHMARK(SP);
1662 107           PUSHs(proto);
1663 107           PUTBACK;
1664              
1665 107           call_method("AWAIT_CLONE", G_SCALAR);
1666              
1667 107           SPAGAIN;
1668              
1669 107 50         SV *f = SvREFCNT_inc(POPs);
1670              
1671 107 50         FREETMPS;
1672 107           LEAVE_with_name("future_new_from_proto");
1673              
1674 107 50         if(!SvROK(f))
1675 0           croak("Expected Future->new to yield a new reference");
1676              
1677             assert(SvREFCNT(f) == 1);
1678             assert(SvREFCNT(SvRV(f)) == 1);
1679 107           return f;
1680             }
1681              
1682             #define future_is_ready(f) MY_future_check(aTHX_ f, "AWAIT_IS_READY")
1683             #define future_is_cancelled(f) MY_future_check(aTHX_ f, "AWAIT_IS_CANCELLED")
1684 438           static bool MY_future_check(pTHX_ SV *f, const char *method)
1685             {
1686 438           dSP;
1687              
1688 438 50         if(!f || !SvOK(f))
    50          
1689 0           panic("ARGH future_check() on undefined value\n");
1690 438 50         if(!SvROK(f))
1691 0           panic("ARGH future_check() on non-reference\n");
1692              
1693 438           ENTER_with_name("future_check");
1694 438           SAVETMPS;
1695              
1696 438 50         PUSHMARK(SP);
1697 438 50         EXTEND(SP, 1);
1698 438           PUSHs(f);
1699 438           PUTBACK;
1700              
1701 438           call_method(method, G_SCALAR);
1702              
1703 438           SPAGAIN;
1704              
1705 438           bool ret = SvTRUEx(POPs);
1706              
1707 438           PUTBACK;
1708 438 50         FREETMPS;
1709 438           LEAVE_with_name("future_check");
1710              
1711 438           return ret;
1712             }
1713              
1714             #define future_get_to_stack(f, gimme) MY_future_get_to_stack(aTHX_ f, gimme)
1715 136           static void MY_future_get_to_stack(pTHX_ SV *f, I32 gimme)
1716             {
1717 136           dSP;
1718              
1719 136           ENTER_with_name("future_get_to_stack");
1720              
1721 136 50         PUSHMARK(SP);
1722 136 50         EXTEND(SP, 1);
1723 136           PUSHs(f);
1724 136           PUTBACK;
1725              
1726 136           call_method("AWAIT_GET", gimme);
1727              
1728 127           LEAVE_with_name("future_get_to_stack");
1729 127           }
1730              
1731             #define future_on_ready(f, code) MY_future_on_ready(aTHX_ f, code)
1732 138           static void MY_future_on_ready(pTHX_ SV *f, CV *code)
1733             {
1734 138           dSP;
1735              
1736 138           ENTER_with_name("future_on_ready");
1737 138           SAVETMPS;
1738              
1739 138 50         PUSHMARK(SP);
1740 138 50         EXTEND(SP, 2);
1741 138           PUSHs(f);
1742 138           mPUSHs(newRV_inc((SV *)code));
1743 138           PUTBACK;
1744              
1745 138           call_method("AWAIT_ON_READY", G_VOID);
1746              
1747 138 50         FREETMPS;
1748 138           LEAVE_with_name("future_on_ready");
1749 138           }
1750              
1751             #define future_on_cancel(f, code) MY_future_on_cancel(aTHX_ f, code)
1752 4           static void MY_future_on_cancel(pTHX_ SV *f, SV *code)
1753             {
1754 4           dSP;
1755              
1756 4           ENTER_with_name("future_on_cancel");
1757 4           SAVETMPS;
1758              
1759 4 50         PUSHMARK(SP);
1760 4 50         EXTEND(SP, 2);
1761 4           PUSHs(f);
1762 4           mPUSHs(code);
1763 4           PUTBACK;
1764              
1765 4           call_method("AWAIT_ON_CANCEL", G_VOID);
1766              
1767 4 50         FREETMPS;
1768 4           LEAVE_with_name("future_on_cancel");
1769 4           }
1770              
1771             #define future_chain_on_cancel(f1, f2) MY_future_chain_on_cancel(aTHX_ f1, f2)
1772 138           static void MY_future_chain_on_cancel(pTHX_ SV *f1, SV *f2)
1773             {
1774 138           dSP;
1775              
1776 138           ENTER_with_name("future_chain_on_cancel");
1777 138           SAVETMPS;
1778              
1779 138 50         PUSHMARK(SP);
1780 138 50         EXTEND(SP, 2);
1781 138           PUSHs(f1);
1782 138           PUSHs(f2);
1783 138           PUTBACK;
1784              
1785 138           call_method("AWAIT_CHAIN_CANCEL", G_VOID);
1786              
1787 138 50         FREETMPS;
1788 138           LEAVE_with_name("future_chain_on_cancel");
1789 138           }
1790              
1791             #define future_await_toplevel(f) MY_future_await_toplevel(aTHX_ f)
1792 9           static void MY_future_await_toplevel(pTHX_ SV *f)
1793             {
1794 9           dSP;
1795              
1796 9           ENTER_with_name("future_await_toplevel");
1797              
1798 9 50         PUSHMARK(SP);
1799 9 50         EXTEND(SP, 1);
1800 9           PUSHs(f);
1801 9           PUTBACK;
1802              
1803 9           call_method("AWAIT_WAIT", GIMME_V);
1804              
1805 8           LEAVE_with_name("future_await_toplevel");
1806 8           }
1807              
1808             /*
1809             * API functions
1810             */
1811              
1812 0           static HV *get_modhookdata(pTHX_ CV *cv, U32 flags, PADOFFSET precreate_padix)
1813             {
1814 0           SuspendedState *state = suspendedstate_get(cv);
1815              
1816 0 0         if(!state) {
1817 0 0         if(!precreate_padix)
1818             return NULL;
1819              
1820 0 0         if(!(flags & FAA_MODHOOK_CREATE))
1821             return NULL;
1822              
1823 0           return (HV *)PAD_SVl(precreate_padix + PRECREATE_MODHOOKDATA);
1824             }
1825              
1826 0 0         if((flags & FAA_MODHOOK_CREATE) && !state->modhookdata)
    0          
1827 0           state->modhookdata = newHV();
1828              
1829 0           return state->modhookdata;
1830             }
1831              
1832             /*
1833             * Custom ops
1834             */
1835              
1836             static XOP xop_enterasync;
1837 4           static OP *pp_enterasync(pTHX)
1838             {
1839 4           PADOFFSET precreate_padix = PL_op->op_targ;
1840              
1841 4 50         if(precreate_padix) {
1842 4           save_clearsv(&PAD_SVl(precreate_padix + PRECREATE_CANCEL));
1843 4           save_clearsv(&PAD_SVl(precreate_padix + PRECREATE_MODHOOKDATA));
1844             }
1845              
1846 4           return PL_op->op_next;
1847             }
1848              
1849             static XOP xop_leaveasync;
1850 123           static OP *pp_leaveasync(pTHX)
1851             {
1852 123           dSP;
1853 123           dMARK;
1854              
1855             SV *f = NULL;
1856             SV *ret = NULL;
1857              
1858 123           SuspendedState *state = suspendedstate_get(find_runcv(0));
1859 123 100         if(state && state->returning_future) {
    50          
1860             f = state->returning_future;
1861 96           state->returning_future = NULL;
1862             }
1863              
1864 96 100         if(f && !SvROK(f)) {
1865             /* async sub was abandoned. We just have to tidy up a bit and finish */
1866              
1867 2 50         if(SvTRUE(ERRSV)) {
    100          
1868             /* This error will otherwise go unreported; best we can do is warn() it */
1869 1           CV *curcv = find_runcv(0);
1870 1           GV *gv = CvGV(curcv);
1871 1 50         if(!CvANON(curcv))
1872 1 50         warn("Abandoned async sub %s::%s failed: %" SVf,
    50          
    50          
    50          
    0          
    50          
1873             HvNAME(GvSTASH(gv)), GvNAME(gv), SVfARG(ERRSV));
1874             else
1875 0 0         warn("Abandoned async sub CODE(0x%p) in package %s failed: %" SVf,
    0          
    0          
    0          
    0          
    0          
1876             curcv, HvNAME(GvSTASH(gv)), SVfARG(ERRSV));
1877             }
1878              
1879 2           goto abort;
1880             }
1881              
1882 121 50         if(SvTRUE(ERRSV)) {
    100          
1883 13 50         ret = future_fail(f, ERRSV);
1884             }
1885             else {
1886 108           ret = future_done_from_stack(f, mark);
1887             }
1888              
1889 121           SPAGAIN;
1890              
1891 123           abort: ; /* statement to keep C compilers happy */
1892 123           PERL_CONTEXT *cx = CX_CUR();
1893              
1894 123           SV **oldsp = PL_stack_base + cx->blk_oldsp;
1895              
1896             /* Pop extraneous stack items */
1897 244 100         while(SP > oldsp)
1898 121           POPs;
1899              
1900 123 100         if(ret) {
1901 121 50         EXTEND(SP, 1);
1902 121           mPUSHs(ret);
1903 121           PUTBACK;
1904             }
1905              
1906 123 100         if(f)
1907 96           SvREFCNT_dec(f);
1908              
1909 123           return PL_op->op_next;
1910             }
1911              
1912             static XOP xop_await;
1913 304           static OP *pp_await(pTHX)
1914             {
1915             /* We arrive here in either of two cases:
1916             * 1) Normal code flow has executed an 'await F' expression
1917             * 2) A previous await operation is resuming
1918             * Distinguish which by inspecting the state (if any) of the suspended context
1919             * magic on the containing CV
1920             */
1921 304           dSP;
1922             SV *f;
1923              
1924 304           CV *curcv = find_runcv(0);
1925             CV *origcv = curcv;
1926             bool defer_mortal_curcv = FALSE;
1927              
1928 304           PADOFFSET precreate_padix = PL_op->op_targ;
1929             /* Must fetch precancel AV now, before any pad fiddling or cv copy */
1930 304 100         AV *precancel = precreate_padix ? (AV *)PAD_SVl(precreate_padix + PRECREATE_CANCEL) : NULL;
1931              
1932 304           SuspendedState *state = suspendedstate_get(curcv);
1933              
1934 304 100         if(state && state->awaiting_future && CATCH_GET) {
    100          
    100          
1935             /* If we don't do this we get all the mess that is
1936             * https://rt.cpan.org/Ticket/Display.html?id=126037
1937             */
1938 14           return docatch(pp_await);
1939             }
1940              
1941 290           struct HookRegistrations *regs = registrations(FALSE);
1942              
1943 290 100         if(state && state->curcop)
    100          
1944 133           PL_curcop = state->curcop;
1945              
1946             TRACEPRINT("ENTER await curcv=%p [%s:%d]\n", curcv, CopFILE(PL_curcop), CopLINE(PL_curcop));
1947             if(state)
1948             TRACEPRINT(" (state=%p/{awaiting_future=%p, returning_future=%p})\n",
1949             state, state->awaiting_future, state->returning_future);
1950             else
1951             TRACEPRINT(" (no state)\n");
1952              
1953             if(state) {
1954 167 100         if(!SvROK(state->returning_future) || future_is_cancelled(state->returning_future)) {
    100          
1955 7 100         if(!SvROK(state->returning_future)) {
1956 3           GV *gv = CvGV(curcv);
1957 3 100         if(!CvANON(curcv))
1958 2 50         warn("Suspended async sub %s::%s lost its returning future", HvNAME(GvSTASH(gv)), GvNAME(gv));
    50          
    50          
    0          
    50          
1959             else
1960 1 50         warn("Suspended async sub CODE(0x%p) in package %s lost its returning future", curcv, HvNAME(GvSTASH(gv)));
    50          
    50          
    0          
    50          
1961             }
1962              
1963             TRACEPRINT(" CANCELLED\n");
1964              
1965 7           suspendedstate_cancel(state);
1966              
1967 7 50         PUSHMARK(SP);
1968 7           PUTBACK;
1969 7           return PL_ppaddr[OP_RETURN](aTHX);
1970             }
1971             }
1972              
1973 160 100         if(state && state->awaiting_future) {
1974             I32 orig_height;
1975              
1976             TRACEPRINT(" RESUME\n");
1977              
1978             f = state->awaiting_future;
1979 127           sv_2mortal(state->awaiting_future);
1980 127           state->awaiting_future = NULL;
1981              
1982             /* Before we restore the stack we first need to POP the caller's
1983             * arguments, as we don't care about those
1984             */
1985 127           orig_height = CX_CUR()->blk_oldsp;
1986 254 100         while(sp > PL_stack_base + orig_height)
1987 127           POPs;
1988 127           PUTBACK;
1989              
1990             /* We also need to clean up the markstack and insert a new mark at the
1991             * beginning
1992             */
1993 127           orig_height = CX_CUR()->blk_oldmarksp;
1994 127 50         while(PL_markstack_ptr > PL_markstack + orig_height)
1995             POPMARK;
1996 127 50         PUSHMARK(SP);
1997              
1998             /* Legacy ones first */
1999             {
2000 127           SV **hookp = hv_fetchs(PL_modglobal, "Future::AsyncAwait/suspendhook", FALSE);
2001 127 50         if(hookp && SvOK(*hookp) && SvUV(*hookp)) {
    0          
    0          
2002 0           warn("Invoking legacy Future::AsyncAwait suspendhook for PRERESUME phase");
2003 0           SuspendHookFunc *hook = INT2PTR(SuspendHookFunc *, SvUV(*hookp));
2004 0 0         if(!state->modhookdata)
2005 0           state->modhookdata = newHV();
2006              
2007 0           (*hook)(aTHX_ FAA_PHASE_PRERESUME, curcv, state->modhookdata);
2008             }
2009             }
2010              
2011             /* New ones after */
2012 127 100         if(regs)
2013 24 50         RUN_HOOKS_REV(pre_resume, curcv, state->modhookdata);
    100          
2014              
2015 127           suspendedstate_resume(state, curcv);
2016              
2017 127 100         if(regs)
2018 24 50         RUN_HOOKS_FWD(post_resume, curcv, state->modhookdata);
    100          
2019              
2020             #ifdef DEBUG_SHOW_STACKS
2021             debug_showstack("Stack after resume");
2022             #endif
2023             }
2024             else {
2025 156           f = POPs;
2026 156           PUTBACK;
2027             }
2028              
2029 283 50         if(!sv_isobject(f))
2030 0           croak("Expected a blessed object reference to await");
2031              
2032 283 100         if(PL_op->op_flags & OPf_SPECIAL) {
2033 9           future_await_toplevel(f);
2034 8           return PL_op->op_next;
2035             }
2036              
2037 274 100         if(future_is_ready(f)) {
2038             assert(CvDEPTH(curcv) > 0);
2039             TRACEPRINT(" READY\n");
2040 136 100         if(state)
2041 129           state->curcop = NULL;
2042             /* This might throw */
2043 136           future_get_to_stack(f, GIMME_V);
2044             TRACEPRINT("LEAVE await curcv=%p [%s:%d]\n", curcv, CopFILE(PL_curcop), CopLINE(PL_curcop));
2045 127           return PL_op->op_next;
2046             }
2047              
2048             #ifdef DEBUG_SHOW_STACKS
2049             debug_showstack("Stack before suspend");
2050             #endif
2051              
2052 138 100         if(!state) {
2053             /* Clone the CV and then attach suspendedstate magic to it */
2054              
2055             /* No point copying a normal lexical slot because the suspend logic is
2056             * about to capture all the pad slots from the running CV (orig) and
2057             * they'll be restored into this new one later by resume.
2058             */
2059             CV *runcv = curcv;
2060 107           curcv = cv_copy_flags(runcv, CV_COPY_NULL_LEXICALS);
2061 107           state = suspendedstate_new(curcv);
2062              
2063 107 100         HV *premodhookdata = precreate_padix ? (HV *)PAD_SVl(precreate_padix + PRECREATE_MODHOOKDATA) : NULL;
2064 3 50         if(premodhookdata) {
2065 3           state->modhookdata = premodhookdata;
2066 3           PAD_SVl(precreate_padix + PRECREATE_MODHOOKDATA) = NULL; /* steal it */
2067             }
2068              
2069 107 100         if(regs) {
2070 10 50         if(!state->modhookdata)
2071 10           state->modhookdata = newHV();
2072 20 50         RUN_HOOKS_FWD(post_cv_copy, runcv, curcv, state->modhookdata);
    100          
2073             }
2074              
2075             TRACEPRINT(" SUSPEND cloned CV->%p\n", curcv);
2076             defer_mortal_curcv = TRUE;
2077             }
2078             else {
2079             TRACEPRINT(" SUSPEND reuse CV\n");
2080             }
2081              
2082 138           state->curcop = PL_curcop;
2083              
2084 138 100         if(regs)
2085 24 50         RUN_HOOKS_REV(pre_suspend, curcv, state->modhookdata);
    100          
2086              
2087 138           suspendedstate_suspend(state, origcv);
2088              
2089             /* New ones first */
2090 138 100         if(regs)
2091 24 50         RUN_HOOKS_FWD(post_suspend, curcv, state->modhookdata);
    100          
2092              
2093             /* Legacy ones after */
2094             {
2095 138           SV **hookp = hv_fetchs(PL_modglobal, "Future::AsyncAwait/suspendhook", FALSE);
2096 138 50         if(hookp && SvOK(*hookp) && SvUV(*hookp)) {
    0          
    0          
2097 0           warn("Invoking legacy Future::AsyncAwait suspendhook for POSTSUSPEND phase");
2098 0           SuspendHookFunc *hook = INT2PTR(SuspendHookFunc *, SvUV(*hookp));
2099 0 0         if(!state->modhookdata)
2100 0           state->modhookdata = newHV();
2101              
2102 0           (*hook)(aTHX_ FAA_PHASE_POSTSUSPEND, curcv, state->modhookdata);
2103             }
2104             }
2105              
2106 138           CvSTART(curcv) = PL_op; /* resume from here */
2107 138           future_on_ready(f, curcv);
2108              
2109             /* If the Future implementation's ->AWAIT_ON_READY failed to capture this CV
2110             * then we'll segfault later after SvREFCNT_dec() on it. We can at least
2111             * detect that here
2112             */
2113 138 50         if(SvREFCNT(curcv) < 2) {
2114 0           croak("AWAIT_ON_READY failed to capture the CV");
2115             }
2116              
2117 138           state->awaiting_future = newSVsv(f);
2118 138           sv_rvweaken(state->awaiting_future);
2119              
2120 138 100         if(!state->returning_future) {
2121 107           state->returning_future = future_new_from_proto(f);
2122              
2123 107 100         if(precancel) {
2124             I32 i;
2125 6 100         for(i = 0; i < av_count(precancel); i++)
2126 3           future_on_cancel(state->returning_future, AvARRAY(precancel)[i]);
2127 3           AvFILLp(precancel) = -1;
2128             }
2129             #ifndef HAVE_FUTURE_CHAIN_CANCEL
2130             /* We can't chain the cancellation but we do need a different way to
2131             * invoke the defer and finally blocks
2132             */
2133             future_on_cancel(state->returning_future, newRV_inc((SV *)curcv));
2134             #endif
2135             }
2136              
2137 138 100         if(defer_mortal_curcv)
2138 107           SvREFCNT_dec((SV *)curcv);
2139              
2140 138 50         PUSHMARK(SP);
2141 138           mPUSHs(newSVsv(state->returning_future));
2142 138           PUTBACK;
2143              
2144 138 100         if(!SvWEAKREF(state->returning_future))
2145 107           sv_rvweaken(state->returning_future);
2146 138 50         if(!SvROK(state->returning_future))
2147 0           panic("ARGH we lost state->returning_future for curcv=%p\n", curcv);
2148              
2149             #ifdef HAVE_FUTURE_CHAIN_CANCEL
2150 138           future_chain_on_cancel(state->returning_future, state->awaiting_future);
2151              
2152 138 50         if(!SvROK(state->returning_future))
2153 0           panic("ARGH we lost state->returning_future for curcv=%p\n", curcv);
2154             #endif
2155              
2156 138 50         if(!SvROK(state->awaiting_future))
2157 0           panic("ARGH we lost state->awaiting_future for curcv=%p\n", curcv);
2158              
2159             TRACEPRINT("LEAVE await curcv=%p [%s:%d]\n", curcv, CopFILE(PL_curcop), CopLINE(PL_curcop));
2160              
2161 138           return PL_ppaddr[OP_RETURN](aTHX);
2162             }
2163              
2164             static XOP xop_pushcancel;
2165 4           static OP *pp_pushcancel(pTHX)
2166             {
2167 4           SuspendedState *state = suspendedstate_get(find_runcv(0));
2168              
2169 4           CV *on_cancel = cv_clone((CV *)cSVOP->op_sv);
2170              
2171 4 100         if(state && state->returning_future) {
    50          
2172 1           future_on_cancel(state->returning_future, newRV_noinc((SV *)on_cancel));
2173             }
2174             else {
2175 3           PADOFFSET precreate_padix = PL_op->op_targ;
2176 3           AV *precancel = (AV *)PAD_SVl(precreate_padix + PRECREATE_CANCEL);
2177 3           av_push(precancel, newRV_noinc((SV *)on_cancel));
2178             }
2179              
2180 4           return PL_op->op_next;
2181             }
2182              
2183             enum {
2184             NO_FORBID,
2185             FORBID_FOREACH_NONLEXICAL,
2186             FORBID_MAP,
2187             FORBID_GREP,
2188             };
2189              
2190             static void check_optree(pTHX_ OP *op, int forbid, COP **last_cop);
2191 2274           static void check_optree(pTHX_ OP *op, int forbid, COP **last_cop)
2192             {
2193             OP *op_first;
2194             OP *kid = NULL;
2195              
2196 2274 100         if(OP_CLASS(op) == OA_COP)
    100          
2197 360           *last_cop = (COP *)op;
2198              
2199 2274           switch(op->op_type) {
2200 20           case OP_LEAVELOOP:
2201 20 100         if((op_first = cUNOPx(op)->op_first)->op_type != OP_ENTERITER)
2202             break;
2203              
2204             /* This is a foreach loop of some kind. If it's not using a lexical
2205             * iterator variable, disallow await inside the body.
2206             * Check the first child, then apply forbid to the remainder of the body
2207             */
2208 15           check_optree(aTHX_ op_first, forbid, last_cop);
2209 15 50         kid = OpSIBLING(op_first);
2210              
2211 15 100         if(!op_first->op_targ)
2212             forbid = FORBID_FOREACH_NONLEXICAL;
2213             break;
2214              
2215 3           case OP_MAPSTART:
2216             case OP_GREPSTART:
2217             /* children are: PUSHMARK, BODY, ITEMS... */
2218 3 50         if((op_first = cUNOPx(op)->op_first)->op_type != OP_PUSHMARK)
2219             break;
2220              
2221 3 50         kid = OpSIBLING(op_first);
2222 3           check_optree(aTHX_ kid,
2223 3 100         op->op_type == OP_MAPSTART ? FORBID_MAP : FORBID_GREP, last_cop);
2224              
2225 1 50         kid = OpSIBLING(kid);
2226             break;
2227              
2228 130           case OP_CUSTOM:
2229 130 100         if(op->op_ppaddr != &pp_await)
2230             break;
2231 112 100         if(!forbid)
2232             /* await is allowed here */
2233             break;
2234              
2235             char *reason;
2236 3           switch(forbid) {
2237 1           case FORBID_FOREACH_NONLEXICAL:
2238             reason = "foreach on non-lexical iterator variable";
2239 1           break;
2240 1           case FORBID_MAP:
2241             reason = "map";
2242 1           break;
2243 1           case FORBID_GREP:
2244             reason = "grep";
2245 1           break;
2246             }
2247              
2248 3 50         croak("await is not allowed inside %s at %s line %d.\n",
2249             reason, CopFILE(*last_cop), CopLINE(*last_cop));
2250             break;
2251             }
2252              
2253 2269 100         if(op->op_flags & OPf_KIDS) {
2254 961 100         if(!kid)
2255 945           kid = cUNOPx(op)->op_first;
2256 5193 100         for(; kid; kid = OpSIBLING(kid))
    100          
2257 2131           check_optree(aTHX_ kid, forbid, last_cop);
2258             }
2259 2254           }
2260              
2261             /*
2262             * Keyword plugins
2263             */
2264              
2265 132           static void parse_post_blockstart(pTHX_ struct XSParseSublikeContext *ctx, void *hookdata)
2266             {
2267             /* Save the identity of the currently-compiling sub so that
2268             * await_keyword_plugin() can check
2269             */
2270 132           hv_stores(GvHV(PL_hintgv), "Future::AsyncAwait/PL_compcv", newSVuv(PTR2UV(PL_compcv)));
2271              
2272 132           hv_stores(GvHV(PL_hintgv), "Future::AsyncAwait/*precreate_padix", newRV_noinc(newSVuv(0)));
2273 132           }
2274              
2275 127           static void parse_pre_blockend(pTHX_ struct XSParseSublikeContext *ctx, void *hookdata)
2276             {
2277             /* body might be NULL if an error happened, or if this was a bodyless
2278             * prototype or required method declaration
2279             */
2280 127 100         if(!ctx->body)
2281 2           return;
2282              
2283 125           COP *last_cop = PL_curcop;
2284 125           check_optree(aTHX_ ctx->body, NO_FORBID, &last_cop);
2285              
2286             #ifdef HAVE_OP_ARGCHECK // or HAVE_OP_MULTIPARAM
2287             /* If the sub body is using signatures, we want to pull the OP_ARGCHECK
2288             * outside the try block. This has two advantages:
2289             * 1. arity checks appear synchronous from the perspective of the caller;
2290             * immediate exceptions rather than failed Futures
2291             * 2. it makes Syntax::Keyword::MultiSub able to handle `async multi sub`
2292             */
2293             OP *argcheckop = NULL;
2294 122 100         if(ctx->body->op_type == OP_LINESEQ) {
2295             OP *lineseq = ctx->body;
2296 117           OP *o = cLISTOPx(lineseq)->op_first;
2297             /* OP_ARGCHECK is often found inside a second inner nested OP_LINESEQ that
2298             * was op_null'ed out
2299             */
2300 117 100         if(o->op_type == OP_NULL && o->op_flags & OPf_KIDS &&
    50          
2301 5 50         cUNOPo->op_first->op_type == OP_LINESEQ) {
2302             lineseq = cUNOPo->op_first;
2303 5           o = cLISTOPx(lineseq)->op_first;
2304             }
2305 117 100         if(o->op_type == OP_NEXTSTATE &&
2306 114 50         (OpSIBLING(o)->op_type == OP_ARGCHECK
    100          
2307             # ifdef HAVE_OP_MULTIPARAM
2308             || OpSIBLING(o)->op_type == OP_MULTIPARAM
2309             # endif
2310             )) {
2311             /* Splice out the NEXTSTATE+ARGCHECK ops */
2312             argcheckop = o; /* technically actually the NEXTSTATE before it */
2313              
2314 7 50         o = OpSIBLING(OpSIBLING(o));
2315 7 50         OpMORESIB_set(OpSIBLING(argcheckop), NULL);
2316              
2317 7           cLISTOPx(lineseq)->op_first = o;
2318             }
2319             }
2320             #endif
2321              
2322             /* turn block into
2323             * NEXTSTATE; PUSHMARK; eval { BLOCK }; LEAVEASYNC
2324             */
2325              
2326 122           OP *body = newSTATEOP(0, NULL, NULL);
2327              
2328 122           PADOFFSET precreate_padix = get_precreate_padix();
2329 122 100         if(precreate_padix) {
2330             OP *enterasync;
2331 4           body = op_append_elem(OP_LINESEQ, body,
2332             enterasync = newOP_CUSTOM(&pp_enterasync, 0));
2333              
2334 4           enterasync->op_targ = precreate_padix;
2335             }
2336              
2337 122           body = op_append_elem(OP_LINESEQ, body, newOP(OP_PUSHMARK, 0));
2338              
2339             OP *try;
2340 122           body = op_append_elem(OP_LINESEQ, body, try = newUNOP(OP_ENTERTRY, 0, ctx->body));
2341 122           op_contextualize(try, G_ARRAY);
2342              
2343 122           body = op_append_elem(OP_LINESEQ, body, newOP_CUSTOM(&pp_leaveasync, OPf_WANT_SCALAR));
2344              
2345             #ifdef HAVE_OP_ARGCHECK
2346 122 100         if(argcheckop) {
2347             assert(body->op_type == OP_LINESEQ);
2348             /* Splice the argcheckop back into the start of the lineseq */
2349             OP *o = argcheckop;
2350 14 50         while(OpSIBLING(o))
    100          
2351             o = OpSIBLING(o);
2352              
2353 7           OpMORESIB_set(o, cLISTOPx(body)->op_first);
2354 7           cLISTOPx(body)->op_first = argcheckop;
2355             }
2356             #endif
2357              
2358 122           ctx->body = body;
2359             }
2360              
2361 124           static void parse_post_newcv(pTHX_ struct XSParseSublikeContext *ctx, void *hookdata)
2362             {
2363 124 100         if(ctx->cv && CvLVALUE(ctx->cv))
    100          
2364 1           warn("Pointless use of :lvalue on async sub");
2365 124           }
2366              
2367             static struct XSParseSublikeHooks hooks_async = {
2368             .ver = XSPARSESUBLIKE_ABI_VERSION,
2369             .permit_hintkey = "Future::AsyncAwait/async",
2370             .flags = XS_PARSE_SUBLIKE_FLAG_PREFIX|XS_PARSE_SUBLIKE_FLAG_BODY_OPTIONAL|XS_PARSE_SUBLIKE_FLAG_ALLOW_PKGNAME,
2371              
2372             .post_blockstart = parse_post_blockstart,
2373             .pre_blockend = parse_pre_blockend,
2374             .post_newcv = parse_post_newcv,
2375             };
2376              
2377 125           static void check_await(pTHX_ void *hookdata)
2378             {
2379 125           SV **asynccvp = hv_fetchs(GvHV(PL_hintgv), "Future::AsyncAwait/PL_compcv", 0);
2380 125 100         if(asynccvp && SvUV(*asynccvp) == PTR2UV(PL_compcv))
    100          
2381             ; /* await inside regular `async sub` */
2382 12 100         else if(PL_compcv == PL_main_cv)
2383             ; /* toplevel await */
2384             else
2385 5 100         croak(CvEVAL(PL_compcv) ?
    50          
2386             "await is not allowed inside string eval" :
2387             "Cannot 'await' outside of an 'async sub'");
2388 122           }
2389              
2390 121           static int build_await(pTHX_ OP **out, XSParseKeywordPiece *arg0, void *hookdata)
2391             {
2392 121           OP *expr = arg0->op;
2393              
2394 121 100         if(PL_compcv == PL_main_cv)
2395 9           *out = newUNOP_CUSTOM(&pp_await, OPf_SPECIAL, expr);
2396             else {
2397 112           *out = newUNOP_CUSTOM(&pp_await, 0, expr);
2398              
2399 112           (*out)->op_targ = get_precreate_padix();
2400             }
2401              
2402 121           return KEYWORD_PLUGIN_EXPR;
2403             }
2404              
2405             static struct XSParseKeywordHooks hooks_await = {
2406             .permit_hintkey = "Future::AsyncAwait/async",
2407             .check = &check_await,
2408             .piece1 = XPK_TERMEXPR_SCALARCTX,
2409             .build1 = &build_await,
2410             };
2411              
2412 4           static void check_cancel(pTHX_ void *hookdata)
2413             {
2414 4           SV **asynccvp = hv_fetchs(GvHV(PL_hintgv), "Future::AsyncAwait/PL_compcv", 0);
2415 4 50         if(!asynccvp || SvUV(*asynccvp) != PTR2UV(PL_compcv))
    50          
2416 0 0         croak(CvEVAL(PL_compcv) ?
    0          
2417             "CANCEL is not allowed inside string eval" :
2418             "Cannot 'CANCEL' outside of an 'async sub'");
2419              
2420             #ifdef WARN_EXPERIMENTAL
2421 4 50         if(!hv_fetchs(GvHV(PL_hintgv), "Future::AsyncAwait/experimental(cancel)", 0)) {
2422 0           Perl_ck_warner(aTHX_ packWARN(WARN_EXPERIMENTAL),
2423             "CANCEL block syntax is experimental and may be changed or removed without notice");
2424             }
2425             #endif
2426 4           }
2427              
2428 4           static int build_cancel(pTHX_ OP **out, XSParseKeywordPiece *arg0, void *hookdata)
2429             {
2430 4           CV *on_cancel = arg0->cv;
2431             OP *pushcancel;
2432              
2433 4           *out = op_prepend_elem(OP_LINESEQ,
2434             (pushcancel = newSVOP_CUSTOM(&pp_pushcancel, 0, (SV *)on_cancel)), NULL);
2435              
2436 4           pushcancel->op_targ = get_or_create_precreate_padix();
2437              
2438 4           return KEYWORD_PLUGIN_STMT;
2439             }
2440              
2441             static struct XSParseKeywordHooks hooks_cancel = {
2442             .permit_hintkey = "Future::AsyncAwait/async",
2443             .check = &check_cancel,
2444             .piece1 = XPK_ANONSUB,
2445             .build1 = &build_cancel,
2446             };
2447              
2448             /*
2449             * Back-compat support
2450             */
2451              
2452             struct AsyncAwaitHookFuncs_v1
2453             {
2454             U32 flags;
2455             void (*post_cv_copy)(pTHX_ CV *runcv, CV *cv, HV *modhookdata, void *hookdata);
2456             /* no pre_suspend */
2457             void (*post_suspend)(pTHX_ CV *cv, HV *modhookdata, void *hookdata);
2458             void (*pre_resume) (pTHX_ CV *cv, HV *modhookdata, void *hookdata);
2459             /* no post_resume */
2460             void (*free) (pTHX_ CV *cv, HV *modhookdata, void *hookdata);
2461             };
2462              
2463 0           static void register_faa_hook_v1(pTHX_ const struct AsyncAwaitHookFuncs_v1 *hookfuncs_v1, void *hookdata)
2464             {
2465             /* No flags are recognised; complain if the caller requested any */
2466 0 0         if(hookfuncs_v1->flags)
2467 0           croak("Unrecognised hookfuncs->flags value %08x", hookfuncs_v1->flags);
2468              
2469             struct AsyncAwaitHookFuncs *hookfuncs;
2470 0           Newx(hookfuncs, 1, struct AsyncAwaitHookFuncs);
2471              
2472 0           hookfuncs->flags = 0;
2473 0           hookfuncs->post_cv_copy = hookfuncs_v1->post_cv_copy;
2474 0           hookfuncs->pre_suspend = NULL;
2475 0           hookfuncs->post_suspend = hookfuncs_v1->post_suspend;
2476 0           hookfuncs->pre_resume = hookfuncs_v1->pre_resume;
2477 0           hookfuncs->post_resume = NULL;
2478 0           hookfuncs->free = hookfuncs_v1->free;
2479              
2480 0           register_faa_hook(aTHX_ hookfuncs, hookdata);
2481 0           }
2482              
2483             MODULE = Future::AsyncAwait PACKAGE = Future::AsyncAwait
2484              
2485             int
2486             __cxstack_ix()
2487             CODE:
2488 20 50         RETVAL = cxstack_ix;
2489             OUTPUT:
2490             RETVAL
2491              
2492             BOOT:
2493 48           XopENTRY_set(&xop_enterasync, xop_name, "enterasync");
2494 48           XopENTRY_set(&xop_enterasync, xop_desc, "enterasync()");
2495 48           XopENTRY_set(&xop_enterasync, xop_class, OA_BASEOP);
2496 48           Perl_custom_op_register(aTHX_ &pp_enterasync, &xop_enterasync);
2497              
2498 48           XopENTRY_set(&xop_leaveasync, xop_name, "leaveasync");
2499 48           XopENTRY_set(&xop_leaveasync, xop_desc, "leaveasync()");
2500 48           XopENTRY_set(&xop_leaveasync, xop_class, OA_UNOP);
2501 48           Perl_custom_op_register(aTHX_ &pp_leaveasync, &xop_leaveasync);
2502              
2503 48           XopENTRY_set(&xop_await, xop_name, "await");
2504 48           XopENTRY_set(&xop_await, xop_desc, "await()");
2505 48           XopENTRY_set(&xop_await, xop_class, OA_UNOP);
2506 48           Perl_custom_op_register(aTHX_ &pp_await, &xop_await);
2507              
2508 48           XopENTRY_set(&xop_pushcancel, xop_name, "pushcancel");
2509 48           XopENTRY_set(&xop_pushcancel, xop_desc, "pushcancel()");
2510 48           XopENTRY_set(&xop_pushcancel, xop_class, OA_SVOP);
2511 48           Perl_custom_op_register(aTHX_ &pp_pushcancel, &xop_pushcancel);
2512              
2513 48           boot_xs_parse_keyword(0.13);
2514 48           boot_xs_parse_sublike(0.31);
2515              
2516 48           register_xs_parse_sublike("async", &hooks_async, NULL);
2517              
2518 48           register_xs_parse_keyword("await", &hooks_await, NULL);
2519 48           register_xs_parse_keyword("CANCEL", &hooks_cancel, NULL);
2520             #ifdef HAVE_DMD_HELPER
2521             DMD_SET_MAGIC_HELPER(&vtbl_suspendedstate, dumpmagic_suspendedstate);
2522             #endif
2523              
2524 48           sv_setiv(*hv_fetchs(PL_modglobal, "Future::AsyncAwait/ABIVERSION_MIN", 1), 1);
2525 48           sv_setiv(*hv_fetchs(PL_modglobal, "Future::AsyncAwait/ABIVERSION_MAX", 1), FUTURE_ASYNCAWAIT_ABI_VERSION);
2526              
2527 48           sv_setiv(*hv_fetchs(PL_modglobal, "Future::AsyncAwait/register()@2", 1),
2528             PTR2UV(®ister_faa_hook));
2529 48           sv_setiv(*hv_fetchs(PL_modglobal, "Future::AsyncAwait/register()@1", 1),
2530             PTR2UV(®ister_faa_hook_v1));
2531 48           sv_setiv(*hv_fetchs(PL_modglobal, "Future::AsyncAwait/get_modhookdata()@1", 1),
2532             PTR2UV(&get_modhookdata));
2533 48           sv_setiv(*hv_fetchs(PL_modglobal, "Future::AsyncAwait/make_precreate_padix()@1", 1),
2534             PTR2UV(&S_get_or_create_precreate_padix));
2535              
2536             {
2537             AV *run_on_loaded = NULL;
2538             SV **svp;
2539 48 50         if(svp = hv_fetchs(PL_modglobal, "Future::AsyncAwait/on_loaded", FALSE)) {
2540 0 0         run_on_loaded = (AV *)SvREFCNT_inc(*svp);
2541 0           hv_deletes(PL_modglobal, "Future::AsyncAwait/on_loaded", 0);
2542             }
2543              
2544 48           hv_stores(PL_modglobal, "Future::AsyncAwait/loaded", &PL_sv_yes);
2545              
2546 48 50         if(run_on_loaded) {
2547 0           svp = AvARRAY(run_on_loaded);
2548              
2549             int i;
2550 0 0         for(i = 0; i < AvFILL(run_on_loaded); i += 2) {
    0          
2551 0           void (*func)(pTHX_ void *data) = INT2PTR(void *, SvUV(svp[i ]));
2552 0           void *data = INT2PTR(void *, SvUV(svp[i+1]));
2553              
2554 0           (*func)(aTHX_ data);
2555             }
2556              
2557 0           SvREFCNT_dec(run_on_loaded);
2558             }
2559             }