File Coverage

lib/Future/AsyncAwait.xs
Criterion Covered Total %
statement 674 910 74.0
branch 393 812 48.4
condition n/a
subroutine n/a
pod n/a
total 1067 1722 61.9


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