From d724a264199e78928fd19ddd3168cb4ab4e3ff6d Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Tue, 13 Dec 2022 11:04:40 +0000 Subject: [PATCH] add switch_argstack(), push/pop_stackinfo() fns These new inline functions are supposed to be near-identical replacements for these macros: PUSHSTACKi(type) push_stackinfo(type) POPSTACK() pop_stackinfo() SWITCHSTACK(from,to) switch_argstack(to) // assumes (from == PL_curstack) except that they don't require dSP to be in scope (they operate on PL_stack_sp rather than sp) and their names more clearly specify what sort of stack they manipulate. The macros are now thin wrappers around the functions. I've kept most of their uses in core for now as they are still used in places with dSP present. --- cop.h | 50 ++++++++++--------------------------- embed.fnc | 3 +++ embed.h | 3 +++ inline.h | 74 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ pp.h | 13 +++++----- pp_sort.c | 7 +----- proto.h | 13 ++++++++++ 7 files changed, 114 insertions(+), 49 deletions(-) diff --git a/cop.h b/cop.h index 01fb7dc361..1a704e1f09 100644 --- a/cop.h +++ b/cop.h @@ -1294,49 +1294,25 @@ typedef struct stackinfo PERL_SI; # define PUSHSTACK_INIT_HWM(si) NOOP #endif +/* for backcompat; use push_stackinfo() instead */ + #define PUSHSTACKi(type) \ - STMT_START { \ - PERL_SI *next = PL_curstackinfo->si_next; \ - DEBUG_l({ \ - int i = 0; PERL_SI *p = PL_curstackinfo; \ - while (p) { i++; p = p->si_prev; } \ - Perl_deb(aTHX_ "push STACKINFO %d in %s at %s:%d\n", \ - i, SAFE_FUNCTION__, __FILE__, __LINE__);}) \ - if (!next) { \ - next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); \ - next->si_prev = PL_curstackinfo; \ - PL_curstackinfo->si_next = next; \ - } \ - next->si_type = type; \ - next->si_cxix = -1; \ - next->si_cxsubix = -1; \ - PUSHSTACK_INIT_HWM(next); \ - AvFILLp(next->si_stack) = 0; \ - SWITCHSTACK(PL_curstack,next->si_stack); \ - PL_curstackinfo = next; \ - SET_MARK_OFFSET; \ + STMT_START { \ + PL_stack_sp = sp; \ + push_stackinfo(type); \ + sp = PL_stack_sp ; \ } STMT_END #define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN) -/* POPSTACK works with PL_stack_sp, so it may need to be bracketed by + +/* for backcompat; use pop_stackinfo() instead. + * + * POPSTACK works with PL_stack_sp, so it may need to be bracketed by * PUTBACK/SPAGAIN to flush/refresh any local SP that may be active */ -#define POPSTACK \ - STMT_START { \ - dSP; \ - PERL_SI * const prev = PL_curstackinfo->si_prev; \ - DEBUG_l({ \ - int i = -1; PERL_SI *p = PL_curstackinfo; \ - while (p) { i++; p = p->si_prev; } \ - Perl_deb(aTHX_ "pop STACKINFO %d in %s at %s:%d\n", \ - i, SAFE_FUNCTION__, __FILE__, __LINE__);}) \ - if (!prev) { \ - Perl_croak_popstack(); \ - } \ - SWITCHSTACK(PL_curstack,prev->si_stack); \ - /* don't free prev here, free them all at the END{} */ \ - PL_curstackinfo = prev; \ - } STMT_END + +#define POPSTACK pop_stackinfo() + #define POPSTACK_TO(s) \ STMT_START { \ diff --git a/embed.fnc b/embed.fnc index 19be67319b..6869070cd2 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2523,6 +2523,7 @@ p |OP * |pmruntime |NN OP *o \ |I32 floor Xiop |I32 |POPMARK Cdp |void |pop_scope +Cipx |void |pop_stackinfo : Used in perl.c and toke.c Fop |void |populate_isa |NN const char *name \ @@ -2556,6 +2557,7 @@ Adp |void |ptr_table_store|NN PTR_TBL_t * const tbl \ |NULLOK const void * const oldsv \ |NN void * const newsv Cdp |void |push_scope +Cipx |void |push_stackinfo |I32 type Adp |char * |pv_display |NN SV *dsv \ |NN const char *pv \ |STRLEN cur \ @@ -3456,6 +3458,7 @@ Adp |void |sv_vsetpvfn |NN SV * const sv \ |NULLOK SV ** const svargs \ |const Size_t sv_count \ |NULLOK bool * const maybe_tainted +Cipx |void |switch_argstack|NN AV *to Adp |void |switch_to_global_locale Adp |bool |sync_locale CTop |void |sys_init |NN int *argc \ diff --git a/embed.h b/embed.h index 112a0b13a8..6f39da7b17 100644 --- a/embed.h +++ b/embed.h @@ -496,6 +496,7 @@ # define perly_sighandler Perl_perly_sighandler # define pmop_dump(a) Perl_pmop_dump(aTHX_ a) # define pop_scope() Perl_pop_scope(aTHX) +# define pop_stackinfo() Perl_pop_stackinfo(aTHX) # define pregcomp(a,b) Perl_pregcomp(aTHX_ a,b) # define pregexec(a,b,c,d,e,f,g) Perl_pregexec(aTHX_ a,b,c,d,e,f,g) # define pregfree(a) Perl_pregfree(aTHX_ a) @@ -507,6 +508,7 @@ # define ptr_table_split(a) Perl_ptr_table_split(aTHX_ a) # define ptr_table_store(a,b,c) Perl_ptr_table_store(aTHX_ a,b,c) # define push_scope() Perl_push_scope(aTHX) +# define push_stackinfo(a) Perl_push_stackinfo(aTHX_ a) # define pv_display(a,b,c,d,e) Perl_pv_display(aTHX_ a,b,c,d,e) # define pv_escape(a,b,c,d,e,f) Perl_pv_escape(aTHX_ a,b,c,d,e,f) # define pv_pretty(a,b,c,d,e,f,g) Perl_pv_pretty(aTHX_ a,b,c,d,e,f,g) @@ -748,6 +750,7 @@ # define sv_vsetpvf(a,b,c) Perl_sv_vsetpvf(aTHX_ a,b,c) # define sv_vsetpvf_mg(a,b,c) Perl_sv_vsetpvf_mg(aTHX_ a,b,c) # define sv_vsetpvfn(a,b,c,d,e,f,g) Perl_sv_vsetpvfn(aTHX_ a,b,c,d,e,f,g) +# define switch_argstack(a) Perl_switch_argstack(aTHX_ a) # define switch_to_global_locale() Perl_switch_to_global_locale(aTHX) # define sync_locale() Perl_sync_locale(aTHX) # define taint_env() Perl_taint_env(aTHX) diff --git a/inline.h b/inline.h index 2d0dbbe71e..89b3354607 100644 --- a/inline.h +++ b/inline.h @@ -3525,6 +3525,80 @@ Perl_clear_defarray_simple(pTHX_ AV *av) Perl_av_remove_offset(aTHX_ av); } +/* switch to a different argument stack */ + +PERL_STATIC_INLINE void +Perl_switch_argstack(pTHX_ AV *to) +{ + PERL_ARGS_ASSERT_SWITCH_ARGSTACK; + + AvFILLp(PL_curstack) = PL_stack_sp - PL_stack_base; + PL_stack_base = AvARRAY(to); + PL_stack_max = PL_stack_base + AvMAX(to); + PL_stack_sp = PL_stack_base + AvFILLp(to); + PL_curstack = to; +} + + +/* Push, and switch to a new stackinfo, allocating one if none are spare, + * to get a fresh set of stacks. + * Update all the interpreter variables like PL_curstackinfo, + * PL_stack_sp, etc. */ + +PERL_STATIC_INLINE void +Perl_push_stackinfo(pTHX_ I32 type) +{ + PERL_ARGS_ASSERT_PUSH_STACKINFO; + + PERL_SI *next = PL_curstackinfo->si_next; + DEBUG_l({ + int i = 0; PERL_SI *p = PL_curstackinfo; + while (p) { i++; p = p->si_prev; } + Perl_deb(aTHX_ "push STACKINFO %d in %s at %s:%d\n", + i, SAFE_FUNCTION__, __FILE__, __LINE__); + }) + + if (!next) { + next = new_stackinfo(32, 2048/sizeof(PERL_CONTEXT) - 1); + next->si_prev = PL_curstackinfo; + PL_curstackinfo->si_next = next; + } + next->si_type = type; + next->si_cxix = -1; + next->si_cxsubix = -1; + PUSHSTACK_INIT_HWM(next); + AvFILLp(next->si_stack) = 0; + switch_argstack(next->si_stack); + PL_curstackinfo = next; + SET_MARK_OFFSET; +} + + +/* Pop, then switch to the previous stackinfo and set of stacks. + * Update all the interpreter variables like PL_curstackinfo, + * PL_stack_sp, etc. */ + +PERL_STATIC_INLINE void +Perl_pop_stackinfo(pTHX) +{ + PERL_ARGS_ASSERT_POP_STACKINFO; + + PERL_SI * const prev = PL_curstackinfo->si_prev; + DEBUG_l({ + int i = -1; PERL_SI *p = PL_curstackinfo; + while (p) { i++; p = p->si_prev; } + Perl_deb(aTHX_ "pop STACKINFO %d in %s at %s:%d\n", + i, SAFE_FUNCTION__, __FILE__, __LINE__);}) + if (!prev) { + Perl_croak_popstack(); + } + + switch_argstack(prev->si_stack); + /* don't free prev here, free them all at the END{} */ + PL_curstackinfo = prev; +} + + /* =for apidoc newPADxVOP diff --git a/pp.h b/pp.h index 4d1a955ff2..94edee1b0d 100644 --- a/pp.h +++ b/pp.h @@ -625,13 +625,14 @@ Does not use C. See also C>, C> and C>. #define MAXARG (PL_op->op_private & OPpARG4_MASK) +/* for backcompat - use switch_argstack() instead */ + #define SWITCHSTACK(f,t) \ - STMT_START { \ - AvFILLp(f) = sp - PL_stack_base; \ - PL_stack_base = AvARRAY(t); \ - PL_stack_max = PL_stack_base + AvMAX(t); \ - sp = PL_stack_sp = PL_stack_base + AvFILLp(t); \ - PL_curstack = t; \ + STMT_START { \ + PL_curstack = f; \ + PL_stack_sp = sp; \ + switch_argstack(t); \ + sp = PL_stack_sp; \ } STMT_END #define EXTEND_MORTAL(n) \ diff --git a/pp_sort.c b/pp_sort.c index b93c71ff76..42040c34e2 100644 --- a/pp_sort.c +++ b/pp_sort.c @@ -917,12 +917,7 @@ PP(pp_sort) SAVEOP(); CATCH_SET(TRUE); - { - - dSP; /* XXX PUSHSTACKi assumes sp is gettable/settable */ - PUSHSTACKi(PERLSI_SORT); - PUTBACK; - } + push_stackinfo(PERLSI_SORT); if (!hasargs && !is_xsub) { /* standard perl sub with values passed as $a and $b */ diff --git a/proto.h b/proto.h index 33de096f70..69af1ca2c6 100644 --- a/proto.h +++ b/proto.h @@ -9746,6 +9746,14 @@ Perl_newSV_type_mortal(pTHX_ const svtype type) __attribute__always_inline__; # define PERL_ARGS_ASSERT_NEWSV_TYPE_MORTAL +PERL_STATIC_INLINE void +Perl_pop_stackinfo(pTHX); +# define PERL_ARGS_ASSERT_POP_STACKINFO + +PERL_STATIC_INLINE void +Perl_push_stackinfo(pTHX_ I32 type); +# define PERL_ARGS_ASSERT_PUSH_STACKINFO + PERL_STATIC_INLINE void Perl_rpp_extend(pTHX_ SSize_t n); # define PERL_ARGS_ASSERT_RPP_EXTEND @@ -9870,6 +9878,11 @@ Perl_sv_setpv_freshbuf(pTHX_ SV * const sv); # define PERL_ARGS_ASSERT_SV_SETPV_FRESHBUF \ assert(sv) +PERL_STATIC_INLINE void +Perl_switch_argstack(pTHX_ AV *to); +# define PERL_ARGS_ASSERT_SWITCH_ARGSTACK \ + assert(to) + PERL_STATIC_INLINE IV Perl_utf8_distance(pTHX_ const U8 *a, const U8 *b) __attribute__warn_unused_result__;