[PATCH] WIP add save stack caller tracing #14968
Labels
Comments
From @bulk88Created by @bulk88See attached patch. This patch was created since #8641 took too much time The only thing I see remaining thing to do is write a perldelta which I Perl Info |
From @bulk88Inline PatchFrom 986e13f80b1d30f23b0e6e37702dee025e908faf Mon Sep 17 00:00:00 2001
From: Daniel Dragan <bulk88@hotmail.com>
Date: Sun, 4 Oct 2015 18:06:21 -0400
Subject: [PATCH] WIP add save stack caller tracing
this patch is missing a perldelta, the next revision of it will include one
bulk88 has repeatedly encoutered save stack bugs regarding psuedofork.
Debugging them is very difficult since the save stack is used everywhere
and if a panic/segv/crash happens in Perl_leave_scope or Perl_ss_dup it
is difficult to figure out where the SS entry was created.
DEBUG_LEAKING_SCALARS helps if its refcnted, but many things on the SS
aren't SV heads.
So create an API for recording callers for save stack to fix the problem.
The macro indirection in embed.fnc and scope.h either goto the normal
no SS debugging C funcs, or they redirect to file/line recording variants.
To make sure there are no accidents during compiling, such as XS/CPAN has
the SS_DEBUG define, core doesn't, or some core compilands have it but
others dont, change the symbols names if the C func prototype changes.
Some of the SS funcs have a dual purpose, they are used in public API
macros that need to capture file and line (1 up), but they are also used
in other public SS funcs which get their own callers (2 up). Recording a
scope.c func as the caller on the SS is useless, so create all caps macros
for save_pushptrptr and similar, that explictly specify the file and line
to capture. The older all lower case macros/funcs implictly capture file
and line so there is less code changes in the rest of core.
Convert save_pushptri32ptr from public API to static. It shouldn't be
public API since it takes SAVEt_ constants and those are not documented.
It also is not used outside of scope.c. Benefit is 1 less global symbols
and possible CC inline/optimization by it not being public. Also drop
save_pushptrptr from public API since it takes SAVEt_ constants, leave it
exported so SAVESWITCHSTACK (which isn't public) works if some XS code is
crazy enough to use that.
---
embed.fnc | 145 +++++++++++++++++++++++---
embed.h | 118 +++++++++++++++-------
makedef.pl | 39 +++++++
mathoms.c | 8 +-
mg.c | 16 +++-
perl.c | 4 +-
pp_hot.c | 1 +
proto.h | 336 +++++++++++++++++++++++++++++++++++++++++++-----------------
regcomp.c | 10 ++-
regexec.c | 10 ++-
scope.c | 281 +++++++++++++++++++++++++++++++++++++++-----------
scope.h | 171 ++++++++++++++++++++++++++++++-
sv.c | 23 ++++-
13 files changed, 937 insertions(+), 225 deletions(-)
diff --git a/embed.fnc b/embed.fnc
index d9b43d1..35994f5 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1256,9 +1256,114 @@ Apda |char* |savesvpv |NN SV* sv
Ap |void |savestack_grow
Ap |void |savestack_grow_cnt |I32 need
Amp |void |save_aelem |NN AV* av|SSize_t idx|NN SV **sptr
+Ap |I32 |save_alloc |I32 size|I32 pad
+Apmb |void |save_freesv |NULLOK SV* sv
+: Used in SAVEFREOP(), used in op.c, pp_ctl.c
+Apmb |void |save_freeop |NULLOK OP* o
+Apmb |void |save_freepv |NULLOK char* pv
+
+
+Amp |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr
+
+Ap |void |save_iv |NN IV *ivp
+Ap |void |save_list |NN SV** sarg|I32 maxsarg
+Ap |void |save_long |NN long* longp
+Apmb |void |save_mortalizesv|NN SV* sv
+Ap |void |save_nogv |NN GV* gv
+: Used in SAVEFREOP(), used in gv.c, op.c, perl.c, pp_ctl.c, pp_sort.c
+Apmb |void |save_op
+#ifdef SS_DEBUG
+Amp |void |save_aelem_flags|NN AV* av|SSize_t idx|NN SV **sptr \
+ |const U32 flags
+pX |void |save_aelem_flags_d|NN AV* av|SSize_t idx|NN SV **sptr \
+ |const U32 flags |NN const char * const file \
+ |const I32 line
+Amp |void |save_aptr |NN AV** aptr
+pX |void |save_aptr_d |NN AV** aptr \
+ |NN const char * const file|const I32 line
+Amp |AV* |save_ary |NN GV* gv
+pX |AV* |save_ary_d |NN GV* gv \
+ |NN const char * const file|const I32 line
+Amp |void |save_bool |NN bool* boolp
+pX |void |save_bool_d |NN bool* boolp \
+ |NN const char * const file|const I32 line
+Amp |void |save_clearsv |NN SV** svp
+pX |void |save_clearsv_d |NN SV** svp \
+ |NN const char * const file|const I32 line
+Amp |void |save_delete |NN HV *hv|NN char *key|I32 klen
+pX |void |save_delete_d |NN HV *hv|NN char *key|I32 klen \
+ |NN const char * const file|const I32 line
+Amp |void |save_hdelete |NN HV *hv|NN SV *keysv
+pX |void |save_hdelete_d |NN HV *hv|NN SV *keysv \
+ |NN const char * const file|const I32 line
+Amp |void |save_adelete |NN AV *av|SSize_t key
+pX |void |save_adelete_d |NN AV *av|SSize_t key \
+ |NN const char * const file|const I32 line
+Amp |void |save_destructor|DESTRUCTORFUNC_NOCONTEXT_t f|NN void* p
+pX |void |save_destructor_d|DESTRUCTORFUNC_NOCONTEXT_t f|NN void* p \
+ |NN const char * const file|const I32 line
+Amp |void |save_destructor_x|DESTRUCTORFUNC_t f|NULLOK void* p
+pX |void |save_destructor_x_d|DESTRUCTORFUNC_t f|NULLOK void* p \
+ |NN const char * const file|const I32 line
+Amp |void |save_generic_svref|NN SV** sptr
+pX |void |save_generic_svref_d|NN SV** sptr \
+ |NN const char * const file|const I32 line
+Amp |void |save_generic_pvref|NN char** str
+pX |void |save_generic_pvref_d|NN char** str \
+ |NN const char * const file|const I32 line
+Amp |void |save_shared_pvref|NN char** str
+pX |void |save_shared_pvref_d|NN char** str \
+ |NN const char * const file|const I32 line
+Amp |void |save_gp |NN GV* gv|I32 empty
+pX |void |save_gp_d |NN GV* gv|I32 empty \
+ |NN const char * const file|const I32 line
+Amp |HV* |save_hash |NN GV* gv
+pX |HV* |save_hash_d |NN GV* gv|NN const char * const file|const I32 line
+Amp |void |save_hints
+pX |void |save_hints_d|NN const char * const file|const I32 line
+Amp |void |save_helem_flags|NN HV *hv|NN SV *key|NN SV **sptr|const U32 flags
+pX |void |save_helem_flags_d|NN HV *hv|NN SV *key|NN SV **sptr|const U32 flags \
+ |NN const char * const file|const I32 line
+Amp |void |save_hptr |NN HV** hptr
+pX |void |save_hptr_d |NN HV** hptr|NN const char * const file|const I32 line
+Amp |void |save_I16 |NN I16* intp
+pX |void |save_I16_d |NN I16* intp|NN const char * const file|const I32 line
+Amp |void |save_I32 |NN I32* intp
+pX |void |save_I32_d |NN I32* intp|NN const char * const file|const I32 line
+Amp |void |save_I8 |NN I8* bytep
+pX |void |save_I8_d |NN I8* bytep|NN const char * const file|const I32 line
+Amp |void |save_int |NN int* intp
+pX |void |save_int_d |NN int* intp|NN const char * const file|const I32 line
+Amp |void |save_item |NN SV* item
+pX |void |save_item_d |NN SV* item|NN const char * const file|const I32 line
+Amp |SV* |save_scalar |NN GV* gv
+pX |SV* |save_scalar_d |NN GV* gv|NN const char * const file|const I32 line
+Amp |void |save_pptr |NN char** pptr
+pX |void |save_pptr_d |NN char** pptr \
+ |NN const char * const file|const I32 line
+Amp |void |save_vptr |NN void *ptr
+pX |void |save_vptr_d |NN void *ptr \
+ |NN const char * const file|const I32 line
+Amp |void |save_re_context
+pX |void |save_re_context_d|NN const char * const file|const I32 line
+Amp |void |save_padsv_and_mortalize|PADOFFSET off
+pX |void |save_padsv_and_mortalize_d|PADOFFSET off \
+ |NN const char * const file|const I32 line
+Amp |void |save_sptr |NN SV** sptr
+pX |void |save_sptr_d |NN SV** sptr|NN const char * const file|const I32 line
+mp |void |save_strlen |NN STRLEN* ptr
+pX |void |save_strlen_d |NN STRLEN* ptr|NN const char * const file|const I32 line
+Amp |SV* |save_svref |NN SV** sptr
+pX |SV* |save_svref_d |NN SV** sptr|NN const char * const file|const I32 line
+Amp |void |save_pushptr |NULLOK void *const ptr|const int type
+pX |void |save_pushptr_d |NULLOK void *const ptr|const int type \
+ |NN const char * const file|const I32 line
+Amp |void |save_set_svflags|NN SV *sv|U32 mask|U32 val
+pX |void |save_set_svflags_d|NN SV *sv|U32 mask|U32 val \
+ |NN const char * const file|const I32 line
+#else
Ap |void |save_aelem_flags|NN AV* av|SSize_t idx|NN SV **sptr \
|const U32 flags
-Ap |I32 |save_alloc |I32 size|I32 pad
Ap |void |save_aptr |NN AV** aptr
Ap |AV* |save_ary |NN GV* gv
Ap |void |save_bool |NN bool* boolp
@@ -1268,17 +1373,12 @@ Ap |void |save_hdelete |NN HV *hv|NN SV *keysv
Ap |void |save_adelete |NN AV *av|SSize_t key
Ap |void |save_destructor|DESTRUCTORFUNC_NOCONTEXT_t f|NN void* p
Ap |void |save_destructor_x|DESTRUCTORFUNC_t f|NULLOK void* p
-Apmb |void |save_freesv |NULLOK SV* sv
-: Used in SAVEFREOP(), used in op.c, pp_ctl.c
-Apmb |void |save_freeop |NULLOK OP* o
-Apmb |void |save_freepv |NULLOK char* pv
Ap |void |save_generic_svref|NN SV** sptr
Ap |void |save_generic_pvref|NN char** str
Ap |void |save_shared_pvref|NN char** str
Ap |void |save_gp |NN GV* gv|I32 empty
Ap |HV* |save_hash |NN GV* gv
Ap |void |save_hints
-Amp |void |save_helem |NN HV *hv|NN SV *key|NN SV **sptr
Ap |void |save_helem_flags|NN HV *hv|NN SV *key|NN SV **sptr|const U32 flags
Ap |void |save_hptr |NN HV** hptr
Ap |void |save_I16 |NN I16* intp
@@ -1286,13 +1386,6 @@ Ap |void |save_I32 |NN I32* intp
Ap |void |save_I8 |NN I8* bytep
Ap |void |save_int |NN int* intp
Ap |void |save_item |NN SV* item
-Ap |void |save_iv |NN IV *ivp
-Ap |void |save_list |NN SV** sarg|I32 maxsarg
-Ap |void |save_long |NN long* longp
-Apmb |void |save_mortalizesv|NN SV* sv
-Ap |void |save_nogv |NN GV* gv
-: Used in SAVEFREOP(), used in gv.c, op.c, perl.c, pp_ctl.c, pp_sort.c
-Apmb |void |save_op
Ap |SV* |save_scalar |NN GV* gv
Ap |void |save_pptr |NN char** pptr
Ap |void |save_vptr |NN void *ptr
@@ -1302,13 +1395,34 @@ Ap |void |save_sptr |NN SV** sptr
Xp |void |save_strlen |NN STRLEN* ptr
Ap |SV* |save_svref |NN SV** sptr
Ap |void |save_pushptr |NULLOK void *const ptr|const int type
-Ap |void |save_pushi32ptr|const I32 i|NULLOK void *const ptr|const int type
+Ap |void |save_set_svflags|NN SV *sv|U32 mask|U32 val
+#endif
: Used by SAVESWITCHSTACK() in pp.c
-Ap |void |save_pushptrptr|NULLOK void *const ptr1 \
+#ifdef SS_DEBUG
+m |void |save_pushptrptr|NULLOK void *const ptr1 \
+ |NULLOK void *const ptr2|const int type
+pX |void |save_pushptrptr_d |NULLOK void *const ptr1 \
+ |NULLOK void *const ptr2|const int type \
+ |NN const char * const file|const I32 line
+#else
+pX |void |save_pushptrptr|NULLOK void *const ptr1 \
|NULLOK void *const ptr2|const int type
+#endif
#if defined(PERL_IN_SCOPE_C)
+# ifdef SS_DEBUG
+m |void |save_pushptri32ptr|NULLOK void *const ptr1|const I32 i \
+ |NULLOK void *const ptr2|const int type
+s |void |save_pushptri32ptr_d|NULLOK void *const ptr1|const I32 i \
+ |NULLOK void *const ptr2|const int type \
+ |NN const char * const file|const I32 line
+m |void |save_pushi32ptr|const I32 i|NULLOK void *const ptr|const int type
+s |void |save_pushi32ptr_d|const I32 i|NULLOK void *const ptr|const int type \
+ |NN const char * const file|const I32 line
+# else
s |void |save_pushptri32ptr|NULLOK void *const ptr1|const I32 i \
|NULLOK void *const ptr2|const int type
+s |void |save_pushi32ptr|const I32 i|NULLOK void *const ptr|const int type
+# endif
#endif
: Used in perly.y
p |OP* |sawparens |NULLOK OP* o
@@ -2662,7 +2776,6 @@ p |void |free_tied_hv_pool
: Used in mg.c
pR |int |get_debug_opts |NN const char **s|bool givehelp
#endif
-Ap |void |save_set_svflags|NN SV *sv|U32 mask|U32 val
#ifdef DEBUGGING
Apod |void |hv_assert |NN HV *hv
#endif
diff --git a/embed.h b/embed.h
index 3f6515f..27912ba 100644
--- a/embed.h
+++ b/embed.h
@@ -511,45 +511,11 @@
#define safesysfree Perl_safesysfree
#define safesysmalloc Perl_safesysmalloc
#define safesysrealloc Perl_safesysrealloc
-#define save_I16(a) Perl_save_I16(aTHX_ a)
-#define save_I32(a) Perl_save_I32(aTHX_ a)
-#define save_I8(a) Perl_save_I8(aTHX_ a)
-#define save_adelete(a,b) Perl_save_adelete(aTHX_ a,b)
-#define save_aelem_flags(a,b,c,d) Perl_save_aelem_flags(aTHX_ a,b,c,d)
#define save_alloc(a,b) Perl_save_alloc(aTHX_ a,b)
-#define save_aptr(a) Perl_save_aptr(aTHX_ a)
-#define save_ary(a) Perl_save_ary(aTHX_ a)
-#define save_bool(a) Perl_save_bool(aTHX_ a)
-#define save_clearsv(a) Perl_save_clearsv(aTHX_ a)
-#define save_delete(a,b,c) Perl_save_delete(aTHX_ a,b,c)
-#define save_destructor(a,b) Perl_save_destructor(aTHX_ a,b)
-#define save_destructor_x(a,b) Perl_save_destructor_x(aTHX_ a,b)
-#define save_generic_pvref(a) Perl_save_generic_pvref(aTHX_ a)
-#define save_generic_svref(a) Perl_save_generic_svref(aTHX_ a)
-#define save_gp(a,b) Perl_save_gp(aTHX_ a,b)
-#define save_hash(a) Perl_save_hash(aTHX_ a)
-#define save_hdelete(a,b) Perl_save_hdelete(aTHX_ a,b)
-#define save_helem_flags(a,b,c,d) Perl_save_helem_flags(aTHX_ a,b,c,d)
-#define save_hints() Perl_save_hints(aTHX)
-#define save_hptr(a) Perl_save_hptr(aTHX_ a)
-#define save_int(a) Perl_save_int(aTHX_ a)
-#define save_item(a) Perl_save_item(aTHX_ a)
#define save_iv(a) Perl_save_iv(aTHX_ a)
#define save_list(a,b) Perl_save_list(aTHX_ a,b)
#define save_long(a) Perl_save_long(aTHX_ a)
#define save_nogv(a) Perl_save_nogv(aTHX_ a)
-#define save_padsv_and_mortalize(a) Perl_save_padsv_and_mortalize(aTHX_ a)
-#define save_pptr(a) Perl_save_pptr(aTHX_ a)
-#define save_pushi32ptr(a,b,c) Perl_save_pushi32ptr(aTHX_ a,b,c)
-#define save_pushptr(a,b) Perl_save_pushptr(aTHX_ a,b)
-#define save_pushptrptr(a,b,c) Perl_save_pushptrptr(aTHX_ a,b,c)
-#define save_re_context() Perl_save_re_context(aTHX)
-#define save_scalar(a) Perl_save_scalar(aTHX_ a)
-#define save_set_svflags(a,b,c) Perl_save_set_svflags(aTHX_ a,b,c)
-#define save_shared_pvref(a) Perl_save_shared_pvref(aTHX_ a)
-#define save_sptr(a) Perl_save_sptr(aTHX_ a)
-#define save_svref(a) Perl_save_svref(aTHX_ a)
-#define save_vptr(a) Perl_save_vptr(aTHX_ a)
#define savepv(a) Perl_savepv(aTHX_ a)
#define savepvn(a,b) Perl_savepvn(aTHX_ a,b)
#define savesharedpv(a) Perl_savesharedpv(aTHX_ a)
@@ -759,6 +725,40 @@
#if !(defined(NO_MATHOMS))
#define sv_nounlocking(a) Perl_sv_nounlocking(aTHX_ a)
#endif
+#if !(defined(SS_DEBUG))
+#define save_I16(a) Perl_save_I16(aTHX_ a)
+#define save_I32(a) Perl_save_I32(aTHX_ a)
+#define save_I8(a) Perl_save_I8(aTHX_ a)
+#define save_adelete(a,b) Perl_save_adelete(aTHX_ a,b)
+#define save_aelem_flags(a,b,c,d) Perl_save_aelem_flags(aTHX_ a,b,c,d)
+#define save_aptr(a) Perl_save_aptr(aTHX_ a)
+#define save_ary(a) Perl_save_ary(aTHX_ a)
+#define save_bool(a) Perl_save_bool(aTHX_ a)
+#define save_clearsv(a) Perl_save_clearsv(aTHX_ a)
+#define save_delete(a,b,c) Perl_save_delete(aTHX_ a,b,c)
+#define save_destructor(a,b) Perl_save_destructor(aTHX_ a,b)
+#define save_destructor_x(a,b) Perl_save_destructor_x(aTHX_ a,b)
+#define save_generic_pvref(a) Perl_save_generic_pvref(aTHX_ a)
+#define save_generic_svref(a) Perl_save_generic_svref(aTHX_ a)
+#define save_gp(a,b) Perl_save_gp(aTHX_ a,b)
+#define save_hash(a) Perl_save_hash(aTHX_ a)
+#define save_hdelete(a,b) Perl_save_hdelete(aTHX_ a,b)
+#define save_helem_flags(a,b,c,d) Perl_save_helem_flags(aTHX_ a,b,c,d)
+#define save_hints() Perl_save_hints(aTHX)
+#define save_hptr(a) Perl_save_hptr(aTHX_ a)
+#define save_int(a) Perl_save_int(aTHX_ a)
+#define save_item(a) Perl_save_item(aTHX_ a)
+#define save_padsv_and_mortalize(a) Perl_save_padsv_and_mortalize(aTHX_ a)
+#define save_pptr(a) Perl_save_pptr(aTHX_ a)
+#define save_pushptr(a,b) Perl_save_pushptr(aTHX_ a,b)
+#define save_re_context() Perl_save_re_context(aTHX)
+#define save_scalar(a) Perl_save_scalar(aTHX_ a)
+#define save_set_svflags(a,b,c) Perl_save_set_svflags(aTHX_ a,b,c)
+#define save_shared_pvref(a) Perl_save_shared_pvref(aTHX_ a)
+#define save_sptr(a) Perl_save_sptr(aTHX_ a)
+#define save_svref(a) Perl_save_svref(aTHX_ a)
+#define save_vptr(a) Perl_save_vptr(aTHX_ a)
+#endif
#if !defined(HAS_BZERO) && !defined(HAS_MEMSET)
#define my_bzero Perl_my_bzero
#endif
@@ -1307,7 +1307,6 @@
#define rsignal_restore(a,b) Perl_rsignal_restore(aTHX_ a,b)
#define rsignal_save(a,b,c) Perl_rsignal_save(aTHX_ a,b,c)
#define rxres_save(a,b) Perl_rxres_save(aTHX_ a,b)
-#define save_strlen(a) Perl_save_strlen(aTHX_ a)
#define sawparens(a) Perl_sawparens(aTHX_ a)
#define scalar(a) Perl_scalar(aTHX_ a)
#define scalarvoid(a) Perl_scalarvoid(aTHX_ a)
@@ -1352,6 +1351,14 @@
# if !(defined(PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION))
#define do_exec(a) Perl_do_exec(aTHX_ a)
# endif
+# if !(defined(SS_DEBUG))
+#define save_pushptrptr(a,b,c) Perl_save_pushptrptr(aTHX_ a,b,c)
+#define save_strlen(a) Perl_save_strlen(aTHX_ a)
+# if defined(PERL_IN_SCOPE_C)
+#define save_pushi32ptr(a,b,c) S_save_pushi32ptr(aTHX_ a,b,c)
+#define save_pushptri32ptr(a,b,c,d) S_save_pushptri32ptr(aTHX_ a,b,c,d)
+# endif
+# endif
# if !(defined(_MSC_VER))
#define magic_regdatum_set(a,b) Perl_magic_regdatum_set(aTHX_ a,b)
# endif
@@ -1668,8 +1675,11 @@
#define space_join_names_mortal(a) S_space_join_names_mortal(aTHX_ a)
# endif
# if defined(PERL_IN_SCOPE_C)
-#define save_pushptri32ptr(a,b,c,d) S_save_pushptri32ptr(aTHX_ a,b,c,d)
#define save_scalar_at(a,b) S_save_scalar_at(aTHX_ a,b)
+# if defined(SS_DEBUG)
+#define save_pushi32ptr_d(a,b,c,d,e) S_save_pushi32ptr_d(aTHX_ a,b,c,d,e)
+#define save_pushptri32ptr_d(a,b,c,d,e,f) S_save_pushptri32ptr_d(aTHX_ a,b,c,d,e,f)
+# endif
# endif
# if defined(PERL_IN_SV_C)
#define F0convert S_F0convert
@@ -1774,6 +1784,42 @@
# if defined(PERL_USES_PL_PIDSTATUS) && defined(PERL_IN_UTIL_C)
#define pidgone(a,b) S_pidgone(aTHX_ a,b)
# endif
+# if defined(SS_DEBUG)
+#define save_I16_d(a,b,c) Perl_save_I16_d(aTHX_ a,b,c)
+#define save_I32_d(a,b,c) Perl_save_I32_d(aTHX_ a,b,c)
+#define save_I8_d(a,b,c) Perl_save_I8_d(aTHX_ a,b,c)
+#define save_adelete_d(a,b,c,d) Perl_save_adelete_d(aTHX_ a,b,c,d)
+#define save_aelem_flags_d(a,b,c,d,e,f) Perl_save_aelem_flags_d(aTHX_ a,b,c,d,e,f)
+#define save_aptr_d(a,b,c) Perl_save_aptr_d(aTHX_ a,b,c)
+#define save_ary_d(a,b,c) Perl_save_ary_d(aTHX_ a,b,c)
+#define save_bool_d(a,b,c) Perl_save_bool_d(aTHX_ a,b,c)
+#define save_clearsv_d(a,b,c) Perl_save_clearsv_d(aTHX_ a,b,c)
+#define save_delete_d(a,b,c,d,e) Perl_save_delete_d(aTHX_ a,b,c,d,e)
+#define save_destructor_d(a,b,c,d) Perl_save_destructor_d(aTHX_ a,b,c,d)
+#define save_destructor_x_d(a,b,c,d) Perl_save_destructor_x_d(aTHX_ a,b,c,d)
+#define save_generic_pvref_d(a,b,c) Perl_save_generic_pvref_d(aTHX_ a,b,c)
+#define save_generic_svref_d(a,b,c) Perl_save_generic_svref_d(aTHX_ a,b,c)
+#define save_gp_d(a,b,c,d) Perl_save_gp_d(aTHX_ a,b,c,d)
+#define save_hash_d(a,b,c) Perl_save_hash_d(aTHX_ a,b,c)
+#define save_hdelete_d(a,b,c,d) Perl_save_hdelete_d(aTHX_ a,b,c,d)
+#define save_helem_flags_d(a,b,c,d,e,f) Perl_save_helem_flags_d(aTHX_ a,b,c,d,e,f)
+#define save_hints_d(a,b) Perl_save_hints_d(aTHX_ a,b)
+#define save_hptr_d(a,b,c) Perl_save_hptr_d(aTHX_ a,b,c)
+#define save_int_d(a,b,c) Perl_save_int_d(aTHX_ a,b,c)
+#define save_item_d(a,b,c) Perl_save_item_d(aTHX_ a,b,c)
+#define save_padsv_and_mortalize_d(a,b,c) Perl_save_padsv_and_mortalize_d(aTHX_ a,b,c)
+#define save_pptr_d(a,b,c) Perl_save_pptr_d(aTHX_ a,b,c)
+#define save_pushptr_d(a,b,c,d) Perl_save_pushptr_d(aTHX_ a,b,c,d)
+#define save_pushptrptr_d(a,b,c,d,e) Perl_save_pushptrptr_d(aTHX_ a,b,c,d,e)
+#define save_re_context_d(a,b) Perl_save_re_context_d(aTHX_ a,b)
+#define save_scalar_d(a,b,c) Perl_save_scalar_d(aTHX_ a,b,c)
+#define save_set_svflags_d(a,b,c,d,e) Perl_save_set_svflags_d(aTHX_ a,b,c,d,e)
+#define save_shared_pvref_d(a,b,c) Perl_save_shared_pvref_d(aTHX_ a,b,c)
+#define save_sptr_d(a,b,c) Perl_save_sptr_d(aTHX_ a,b,c)
+#define save_strlen_d(a,b,c) Perl_save_strlen_d(aTHX_ a,b,c)
+#define save_svref_d(a,b,c) Perl_save_svref_d(aTHX_ a,b,c)
+#define save_vptr_d(a,b,c) Perl_save_vptr_d(aTHX_ a,b,c)
+# endif
# if defined(USE_C_BACKTRACE)
#define get_c_backtrace(a,b) Perl_get_c_backtrace(aTHX_ a,b)
# endif
diff --git a/makedef.pl b/makedef.pl
index d1adad0..24bd99a 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -570,6 +570,45 @@ if ($define{'PERL_GLOBAL_STRUCT'}) {
++$skip{PL_op_exec_cnt}
unless $define{PERL_TRACE_OPS};
+if($define{SS_DEBUG}) {
+ ++$skip{$_} foreach qw(
+ Perl_save_I16
+ Perl_save_I32
+ Perl_save_I8
+ Perl_save_adelete
+ Perl_save_aelem_flags
+ Perl_save_aptr
+ Perl_save_ary
+ Perl_save_bool
+ Perl_save_clearsv
+ Perl_save_delete
+ Perl_save_destructor
+ Perl_save_destructor_x
+ Perl_save_generic_pvref
+ Perl_save_generic_svref
+ Perl_save_gp
+ Perl_save_hash
+ Perl_save_hdelete
+ Perl_save_helem_flags
+ Perl_save_hints
+ Perl_save_hptr
+ Perl_save_int
+ Perl_save_item
+ Perl_save_padsv_and_mortalize
+ Perl_save_pptr
+ Perl_save_pushptr
+ Perl_save_pushptrptr
+ Perl_save_re_context
+ Perl_save_scalar
+ Perl_save_set_svflags
+ Perl_save_shared_pvref
+ Perl_save_sptr
+ Perl_save_strlen
+ Perl_save_svref
+ Perl_save_vptr
+ );
+}
+
# functions from *.sym files
my @syms = qw(globvar.sym);
diff --git a/mathoms.c b/mathoms.c
index 3187782..f32917f 100644
--- a/mathoms.c
+++ b/mathoms.c
@@ -782,7 +782,7 @@ Perl_save_long(pTHX_ long int *longp)
SSCHECK(3);
SSPUSHLONG(*longp);
SSPUSHPTR(longp);
- SSPUSHUV(SAVEt_LONG);
+ SSPUSHTYPE(SAVEt_LONG);
}
void
@@ -793,7 +793,7 @@ Perl_save_iv(pTHX_ IV *ivp)
SSCHECK(3);
SSPUSHIV(*ivp);
SSPUSHPTR(ivp);
- SSPUSHUV(SAVEt_IV);
+ SSPUSHTYPE(SAVEt_IV);
}
void
@@ -803,7 +803,7 @@ Perl_save_nogv(pTHX_ GV *gv)
SSCHECK(2);
SSPUSHPTR(gv);
- SSPUSHUV(SAVEt_NSTAB);
+ SSPUSHTYPE(SAVEt_NSTAB);
}
void
@@ -821,7 +821,7 @@ Perl_save_list(pTHX_ SV **sarg, I32 maxsarg)
SSCHECK(3);
SSPUSHPTR(sarg[i]); /* remember the pointer */
SSPUSHPTR(sv); /* remember the value */
- SSPUSHUV(SAVEt_ITEM);
+ SSPUSHTYPE(SAVEt_ITEM);
}
}
diff --git a/mg.c b/mg.c
index 8ebb6a3..8b6238e 100644
--- a/mg.c
+++ b/mg.c
@@ -3411,12 +3411,22 @@ S_restore_magic(pTHX_ const void *p)
* may leave alloc gunk on the savestack, and some code
* (e.g. sighandler) doesn't expect that...
*/
+ /* This code is unwinding the save stack outside of
+ LEAVE/Perl_leave_scope, with no abstraction and
+ a fragile implementation.
+ */
if (PL_savestack_ix == mgs->mgs_ss_ix)
{
- UV popval = SSPOPUV;
+#ifdef SS_DEBUG
+ const char * file;
+ I32 line;
+#endif
+ UV popval;
+ SSPOPTYPE(file, line, popval);
assert(popval == SAVEt_DESTRUCTOR_X);
- PL_savestack_ix -= 2;
- popval = SSPOPUV;
+ PL_savestack_ix -= 2; /* free body of SAVEt_DESTRUCTOR_X entry */
+
+ SSPOPTYPE(file, line, popval);
assert((popval & SAVE_MASK) == SAVEt_ALLOC);
PL_savestack_ix -= popval >> SAVE_TIGHT_SHIFT;
}
diff --git a/perl.c b/perl.c
index 1d2ec91..fa1c603 100644
--- a/perl.c
+++ b/perl.c
@@ -4091,9 +4091,9 @@ Perl_init_stacks(pTHX)
PL_scopestack_ix = 0;
PL_scopestack_max = REASONABLE(32);
- Newx(PL_savestack,REASONABLE_but_at_least(128,SS_MAXPUSH),ANY);
+ Newx(PL_savestack,REASONABLE_but_at_least(128,SS_MAXPUSH+SS_DBGPUSH),ANY);
PL_savestack_ix = 0;
- PL_savestack_max = REASONABLE_but_at_least(128,SS_MAXPUSH);
+ PL_savestack_max = REASONABLE_but_at_least(128,SS_MAXPUSH+SS_DBGPUSH);
}
#undef REASONABLE
diff --git a/pp_hot.c b/pp_hot.c
index bed0a27..de3f972 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -379,6 +379,7 @@ PP(pp_padrange)
assert((payload >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT)) == base);
{
dSS_ADD;
+ dSS_FILELINE;
SS_ADD_UV(payload);
SS_ADD_END(1);
}
diff --git a/proto.h b/proto.h
index 6d49f47..9c28a21 100644
--- a/proto.h
+++ b/proto.h
@@ -2643,74 +2643,12 @@ PERL_CALLCONV Malloc_t Perl_safesysrealloc(Malloc_t where, MEM_SIZE nbytes)
__attribute__malloc__
__attribute__warn_unused_result__;
-PERL_CALLCONV void Perl_save_I16(pTHX_ I16* intp);
-#define PERL_ARGS_ASSERT_SAVE_I16 \
- assert(intp)
-PERL_CALLCONV void Perl_save_I32(pTHX_ I32* intp);
-#define PERL_ARGS_ASSERT_SAVE_I32 \
- assert(intp)
-PERL_CALLCONV void Perl_save_I8(pTHX_ I8* bytep);
-#define PERL_ARGS_ASSERT_SAVE_I8 \
- assert(bytep)
-PERL_CALLCONV void Perl_save_adelete(pTHX_ AV *av, SSize_t key);
-#define PERL_ARGS_ASSERT_SAVE_ADELETE \
- assert(av)
/* PERL_CALLCONV void Perl_save_aelem(pTHX_ AV* av, SSize_t idx, SV **sptr); */
-PERL_CALLCONV void Perl_save_aelem_flags(pTHX_ AV* av, SSize_t idx, SV **sptr, const U32 flags);
-#define PERL_ARGS_ASSERT_SAVE_AELEM_FLAGS \
- assert(av); assert(sptr)
PERL_CALLCONV I32 Perl_save_alloc(pTHX_ I32 size, I32 pad);
-PERL_CALLCONV void Perl_save_aptr(pTHX_ AV** aptr);
-#define PERL_ARGS_ASSERT_SAVE_APTR \
- assert(aptr)
-PERL_CALLCONV AV* Perl_save_ary(pTHX_ GV* gv);
-#define PERL_ARGS_ASSERT_SAVE_ARY \
- assert(gv)
-PERL_CALLCONV void Perl_save_bool(pTHX_ bool* boolp);
-#define PERL_ARGS_ASSERT_SAVE_BOOL \
- assert(boolp)
-PERL_CALLCONV void Perl_save_clearsv(pTHX_ SV** svp);
-#define PERL_ARGS_ASSERT_SAVE_CLEARSV \
- assert(svp)
-PERL_CALLCONV void Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen);
-#define PERL_ARGS_ASSERT_SAVE_DELETE \
- assert(hv); assert(key)
-PERL_CALLCONV void Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p);
-#define PERL_ARGS_ASSERT_SAVE_DESTRUCTOR \
- assert(p)
-PERL_CALLCONV void Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p);
/* PERL_CALLCONV void Perl_save_freeop(pTHX_ OP* o); */
/* PERL_CALLCONV void Perl_save_freepv(pTHX_ char* pv); */
/* PERL_CALLCONV void Perl_save_freesv(pTHX_ SV* sv); */
-PERL_CALLCONV void Perl_save_generic_pvref(pTHX_ char** str);
-#define PERL_ARGS_ASSERT_SAVE_GENERIC_PVREF \
- assert(str)
-PERL_CALLCONV void Perl_save_generic_svref(pTHX_ SV** sptr);
-#define PERL_ARGS_ASSERT_SAVE_GENERIC_SVREF \
- assert(sptr)
-PERL_CALLCONV void Perl_save_gp(pTHX_ GV* gv, I32 empty);
-#define PERL_ARGS_ASSERT_SAVE_GP \
- assert(gv)
-PERL_CALLCONV HV* Perl_save_hash(pTHX_ GV* gv);
-#define PERL_ARGS_ASSERT_SAVE_HASH \
- assert(gv)
-PERL_CALLCONV void Perl_save_hdelete(pTHX_ HV *hv, SV *keysv);
-#define PERL_ARGS_ASSERT_SAVE_HDELETE \
- assert(hv); assert(keysv)
/* PERL_CALLCONV void Perl_save_helem(pTHX_ HV *hv, SV *key, SV **sptr); */
-PERL_CALLCONV void Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags);
-#define PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS \
- assert(hv); assert(key); assert(sptr)
-PERL_CALLCONV void Perl_save_hints(pTHX);
-PERL_CALLCONV void Perl_save_hptr(pTHX_ HV** hptr);
-#define PERL_ARGS_ASSERT_SAVE_HPTR \
- assert(hptr)
-PERL_CALLCONV void Perl_save_int(pTHX_ int* intp);
-#define PERL_ARGS_ASSERT_SAVE_INT \
- assert(intp)
-PERL_CALLCONV void Perl_save_item(pTHX_ SV* item);
-#define PERL_ARGS_ASSERT_SAVE_ITEM \
- assert(item)
PERL_CALLCONV void Perl_save_iv(pTHX_ IV *ivp);
#define PERL_ARGS_ASSERT_SAVE_IV \
assert(ivp)
@@ -2727,35 +2665,6 @@ PERL_CALLCONV void Perl_save_nogv(pTHX_ GV* gv);
#define PERL_ARGS_ASSERT_SAVE_NOGV \
assert(gv)
/* PERL_CALLCONV void Perl_save_op(pTHX); */
-PERL_CALLCONV void Perl_save_padsv_and_mortalize(pTHX_ PADOFFSET off);
-PERL_CALLCONV void Perl_save_pptr(pTHX_ char** pptr);
-#define PERL_ARGS_ASSERT_SAVE_PPTR \
- assert(pptr)
-PERL_CALLCONV void Perl_save_pushi32ptr(pTHX_ const I32 i, void *const ptr, const int type);
-PERL_CALLCONV void Perl_save_pushptr(pTHX_ void *const ptr, const int type);
-PERL_CALLCONV void Perl_save_pushptrptr(pTHX_ void *const ptr1, void *const ptr2, const int type);
-PERL_CALLCONV void Perl_save_re_context(pTHX);
-PERL_CALLCONV SV* Perl_save_scalar(pTHX_ GV* gv);
-#define PERL_ARGS_ASSERT_SAVE_SCALAR \
- assert(gv)
-PERL_CALLCONV void Perl_save_set_svflags(pTHX_ SV *sv, U32 mask, U32 val);
-#define PERL_ARGS_ASSERT_SAVE_SET_SVFLAGS \
- assert(sv)
-PERL_CALLCONV void Perl_save_shared_pvref(pTHX_ char** str);
-#define PERL_ARGS_ASSERT_SAVE_SHARED_PVREF \
- assert(str)
-PERL_CALLCONV void Perl_save_sptr(pTHX_ SV** sptr);
-#define PERL_ARGS_ASSERT_SAVE_SPTR \
- assert(sptr)
-PERL_CALLCONV void Perl_save_strlen(pTHX_ STRLEN* ptr);
-#define PERL_ARGS_ASSERT_SAVE_STRLEN \
- assert(ptr)
-PERL_CALLCONV SV* Perl_save_svref(pTHX_ SV** sptr);
-#define PERL_ARGS_ASSERT_SAVE_SVREF \
- assert(sptr)
-PERL_CALLCONV void Perl_save_vptr(pTHX_ void *ptr);
-#define PERL_ARGS_ASSERT_SAVE_VPTR \
- assert(ptr)
PERL_CALLCONV char* Perl_savepv(pTHX_ const char* pv)
__attribute__malloc__
__attribute__warn_unused_result__;
@@ -3599,6 +3508,102 @@ PERL_CALLCONV void* Perl_my_cxt_init(pTHX_ int *index, size_t size);
assert(index)
# endif
#endif
+#if !(defined(SS_DEBUG))
+PERL_CALLCONV void Perl_save_I16(pTHX_ I16* intp);
+#define PERL_ARGS_ASSERT_SAVE_I16 \
+ assert(intp)
+PERL_CALLCONV void Perl_save_I32(pTHX_ I32* intp);
+#define PERL_ARGS_ASSERT_SAVE_I32 \
+ assert(intp)
+PERL_CALLCONV void Perl_save_I8(pTHX_ I8* bytep);
+#define PERL_ARGS_ASSERT_SAVE_I8 \
+ assert(bytep)
+PERL_CALLCONV void Perl_save_adelete(pTHX_ AV *av, SSize_t key);
+#define PERL_ARGS_ASSERT_SAVE_ADELETE \
+ assert(av)
+PERL_CALLCONV void Perl_save_aelem_flags(pTHX_ AV* av, SSize_t idx, SV **sptr, const U32 flags);
+#define PERL_ARGS_ASSERT_SAVE_AELEM_FLAGS \
+ assert(av); assert(sptr)
+PERL_CALLCONV void Perl_save_aptr(pTHX_ AV** aptr);
+#define PERL_ARGS_ASSERT_SAVE_APTR \
+ assert(aptr)
+PERL_CALLCONV AV* Perl_save_ary(pTHX_ GV* gv);
+#define PERL_ARGS_ASSERT_SAVE_ARY \
+ assert(gv)
+PERL_CALLCONV void Perl_save_bool(pTHX_ bool* boolp);
+#define PERL_ARGS_ASSERT_SAVE_BOOL \
+ assert(boolp)
+PERL_CALLCONV void Perl_save_clearsv(pTHX_ SV** svp);
+#define PERL_ARGS_ASSERT_SAVE_CLEARSV \
+ assert(svp)
+PERL_CALLCONV void Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen);
+#define PERL_ARGS_ASSERT_SAVE_DELETE \
+ assert(hv); assert(key)
+PERL_CALLCONV void Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p);
+#define PERL_ARGS_ASSERT_SAVE_DESTRUCTOR \
+ assert(p)
+PERL_CALLCONV void Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p);
+PERL_CALLCONV void Perl_save_generic_pvref(pTHX_ char** str);
+#define PERL_ARGS_ASSERT_SAVE_GENERIC_PVREF \
+ assert(str)
+PERL_CALLCONV void Perl_save_generic_svref(pTHX_ SV** sptr);
+#define PERL_ARGS_ASSERT_SAVE_GENERIC_SVREF \
+ assert(sptr)
+PERL_CALLCONV void Perl_save_gp(pTHX_ GV* gv, I32 empty);
+#define PERL_ARGS_ASSERT_SAVE_GP \
+ assert(gv)
+PERL_CALLCONV HV* Perl_save_hash(pTHX_ GV* gv);
+#define PERL_ARGS_ASSERT_SAVE_HASH \
+ assert(gv)
+PERL_CALLCONV void Perl_save_hdelete(pTHX_ HV *hv, SV *keysv);
+#define PERL_ARGS_ASSERT_SAVE_HDELETE \
+ assert(hv); assert(keysv)
+PERL_CALLCONV void Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags);
+#define PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS \
+ assert(hv); assert(key); assert(sptr)
+PERL_CALLCONV void Perl_save_hints(pTHX);
+PERL_CALLCONV void Perl_save_hptr(pTHX_ HV** hptr);
+#define PERL_ARGS_ASSERT_SAVE_HPTR \
+ assert(hptr)
+PERL_CALLCONV void Perl_save_int(pTHX_ int* intp);
+#define PERL_ARGS_ASSERT_SAVE_INT \
+ assert(intp)
+PERL_CALLCONV void Perl_save_item(pTHX_ SV* item);
+#define PERL_ARGS_ASSERT_SAVE_ITEM \
+ assert(item)
+PERL_CALLCONV void Perl_save_padsv_and_mortalize(pTHX_ PADOFFSET off);
+PERL_CALLCONV void Perl_save_pptr(pTHX_ char** pptr);
+#define PERL_ARGS_ASSERT_SAVE_PPTR \
+ assert(pptr)
+PERL_CALLCONV void Perl_save_pushptr(pTHX_ void *const ptr, const int type);
+PERL_CALLCONV void Perl_save_pushptrptr(pTHX_ void *const ptr1, void *const ptr2, const int type);
+PERL_CALLCONV void Perl_save_re_context(pTHX);
+PERL_CALLCONV SV* Perl_save_scalar(pTHX_ GV* gv);
+#define PERL_ARGS_ASSERT_SAVE_SCALAR \
+ assert(gv)
+PERL_CALLCONV void Perl_save_set_svflags(pTHX_ SV *sv, U32 mask, U32 val);
+#define PERL_ARGS_ASSERT_SAVE_SET_SVFLAGS \
+ assert(sv)
+PERL_CALLCONV void Perl_save_shared_pvref(pTHX_ char** str);
+#define PERL_ARGS_ASSERT_SAVE_SHARED_PVREF \
+ assert(str)
+PERL_CALLCONV void Perl_save_sptr(pTHX_ SV** sptr);
+#define PERL_ARGS_ASSERT_SAVE_SPTR \
+ assert(sptr)
+PERL_CALLCONV void Perl_save_strlen(pTHX_ STRLEN* ptr);
+#define PERL_ARGS_ASSERT_SAVE_STRLEN \
+ assert(ptr)
+PERL_CALLCONV SV* Perl_save_svref(pTHX_ SV** sptr);
+#define PERL_ARGS_ASSERT_SAVE_SVREF \
+ assert(sptr)
+PERL_CALLCONV void Perl_save_vptr(pTHX_ void *ptr);
+#define PERL_ARGS_ASSERT_SAVE_VPTR \
+ assert(ptr)
+# if defined(PERL_IN_SCOPE_C)
+STATIC void S_save_pushi32ptr(pTHX_ const I32 i, void *const ptr, const int type);
+STATIC void S_save_pushptri32ptr(pTHX_ void *const ptr1, const I32 i, void *const ptr2, const int type);
+# endif
+#endif
#if !(defined(WIN32))
/* PERL_CALLCONV char* my_setlocale(pTHX_ int category, const char* locale)
__attribute__pure__; */
@@ -5065,10 +5070,19 @@ STATIC void S_to_utf8_substr(pTHX_ regexp * prog);
assert(prog)
#endif
#if defined(PERL_IN_SCOPE_C)
-STATIC void S_save_pushptri32ptr(pTHX_ void *const ptr1, const I32 i, void *const ptr2, const int type);
STATIC SV* S_save_scalar_at(pTHX_ SV **sptr, const U32 flags);
#define PERL_ARGS_ASSERT_SAVE_SCALAR_AT \
assert(sptr)
+# if defined(SS_DEBUG)
+/* PERL_CALLCONV void save_pushi32ptr(pTHX_ const I32 i, void *const ptr, const int type); */
+STATIC void S_save_pushi32ptr_d(pTHX_ const I32 i, void *const ptr, const int type, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_PUSHI32PTR_D \
+ assert(file)
+/* PERL_CALLCONV void save_pushptri32ptr(pTHX_ void *const ptr1, const I32 i, void *const ptr2, const int type); */
+STATIC void S_save_pushptri32ptr_d(pTHX_ void *const ptr1, const I32 i, void *const ptr2, const int type, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_PUSHPTRI32PTR_D \
+ assert(file)
+# endif
#endif
#if defined(PERL_IN_SV_C)
STATIC char * S_F0convert(NV nv, char *const endbuf, STRLEN *const len);
@@ -5375,6 +5389,144 @@ PERL_CALLCONV OP* Perl_op_parent(OP *o);
#if defined(PERL_USES_PL_PIDSTATUS) && defined(PERL_IN_UTIL_C)
STATIC void S_pidgone(pTHX_ Pid_t pid, int status);
#endif
+#if defined(SS_DEBUG)
+/* PERL_CALLCONV void Perl_save_I16(pTHX_ I16* intp); */
+PERL_CALLCONV void Perl_save_I16_d(pTHX_ I16* intp, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_I16_D \
+ assert(intp); assert(file)
+/* PERL_CALLCONV void Perl_save_I32(pTHX_ I32* intp); */
+PERL_CALLCONV void Perl_save_I32_d(pTHX_ I32* intp, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_I32_D \
+ assert(intp); assert(file)
+/* PERL_CALLCONV void Perl_save_I8(pTHX_ I8* bytep); */
+PERL_CALLCONV void Perl_save_I8_d(pTHX_ I8* bytep, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_I8_D \
+ assert(bytep); assert(file)
+/* PERL_CALLCONV void Perl_save_adelete(pTHX_ AV *av, SSize_t key); */
+PERL_CALLCONV void Perl_save_adelete_d(pTHX_ AV *av, SSize_t key, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_ADELETE_D \
+ assert(av); assert(file)
+/* PERL_CALLCONV void Perl_save_aelem_flags(pTHX_ AV* av, SSize_t idx, SV **sptr, const U32 flags); */
+PERL_CALLCONV void Perl_save_aelem_flags_d(pTHX_ AV* av, SSize_t idx, SV **sptr, const U32 flags, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_AELEM_FLAGS_D \
+ assert(av); assert(sptr); assert(file)
+/* PERL_CALLCONV void Perl_save_aptr(pTHX_ AV** aptr); */
+PERL_CALLCONV void Perl_save_aptr_d(pTHX_ AV** aptr, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_APTR_D \
+ assert(aptr); assert(file)
+/* PERL_CALLCONV AV* Perl_save_ary(pTHX_ GV* gv); */
+PERL_CALLCONV AV* Perl_save_ary_d(pTHX_ GV* gv, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_ARY_D \
+ assert(gv); assert(file)
+/* PERL_CALLCONV void Perl_save_bool(pTHX_ bool* boolp); */
+PERL_CALLCONV void Perl_save_bool_d(pTHX_ bool* boolp, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_BOOL_D \
+ assert(boolp); assert(file)
+/* PERL_CALLCONV void Perl_save_clearsv(pTHX_ SV** svp); */
+PERL_CALLCONV void Perl_save_clearsv_d(pTHX_ SV** svp, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_CLEARSV_D \
+ assert(svp); assert(file)
+/* PERL_CALLCONV void Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen); */
+PERL_CALLCONV void Perl_save_delete_d(pTHX_ HV *hv, char *key, I32 klen, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_DELETE_D \
+ assert(hv); assert(key); assert(file)
+/* PERL_CALLCONV void Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p); */
+PERL_CALLCONV void Perl_save_destructor_d(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_DESTRUCTOR_D \
+ assert(p); assert(file)
+/* PERL_CALLCONV void Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p); */
+PERL_CALLCONV void Perl_save_destructor_x_d(pTHX_ DESTRUCTORFUNC_t f, void* p, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_DESTRUCTOR_X_D \
+ assert(file)
+/* PERL_CALLCONV void Perl_save_generic_pvref(pTHX_ char** str); */
+PERL_CALLCONV void Perl_save_generic_pvref_d(pTHX_ char** str, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_GENERIC_PVREF_D \
+ assert(str); assert(file)
+/* PERL_CALLCONV void Perl_save_generic_svref(pTHX_ SV** sptr); */
+PERL_CALLCONV void Perl_save_generic_svref_d(pTHX_ SV** sptr, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_GENERIC_SVREF_D \
+ assert(sptr); assert(file)
+/* PERL_CALLCONV void Perl_save_gp(pTHX_ GV* gv, I32 empty); */
+PERL_CALLCONV void Perl_save_gp_d(pTHX_ GV* gv, I32 empty, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_GP_D \
+ assert(gv); assert(file)
+/* PERL_CALLCONV HV* Perl_save_hash(pTHX_ GV* gv); */
+PERL_CALLCONV HV* Perl_save_hash_d(pTHX_ GV* gv, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_HASH_D \
+ assert(gv); assert(file)
+/* PERL_CALLCONV void Perl_save_hdelete(pTHX_ HV *hv, SV *keysv); */
+PERL_CALLCONV void Perl_save_hdelete_d(pTHX_ HV *hv, SV *keysv, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_HDELETE_D \
+ assert(hv); assert(keysv); assert(file)
+/* PERL_CALLCONV void Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags); */
+PERL_CALLCONV void Perl_save_helem_flags_d(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS_D \
+ assert(hv); assert(key); assert(sptr); assert(file)
+/* PERL_CALLCONV void Perl_save_hints(pTHX); */
+PERL_CALLCONV void Perl_save_hints_d(pTHX_ const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_HINTS_D \
+ assert(file)
+/* PERL_CALLCONV void Perl_save_hptr(pTHX_ HV** hptr); */
+PERL_CALLCONV void Perl_save_hptr_d(pTHX_ HV** hptr, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_HPTR_D \
+ assert(hptr); assert(file)
+/* PERL_CALLCONV void Perl_save_int(pTHX_ int* intp); */
+PERL_CALLCONV void Perl_save_int_d(pTHX_ int* intp, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_INT_D \
+ assert(intp); assert(file)
+/* PERL_CALLCONV void Perl_save_item(pTHX_ SV* item); */
+PERL_CALLCONV void Perl_save_item_d(pTHX_ SV* item, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_ITEM_D \
+ assert(item); assert(file)
+/* PERL_CALLCONV void Perl_save_padsv_and_mortalize(pTHX_ PADOFFSET off); */
+PERL_CALLCONV void Perl_save_padsv_and_mortalize_d(pTHX_ PADOFFSET off, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_PADSV_AND_MORTALIZE_D \
+ assert(file)
+/* PERL_CALLCONV void Perl_save_pptr(pTHX_ char** pptr); */
+PERL_CALLCONV void Perl_save_pptr_d(pTHX_ char** pptr, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_PPTR_D \
+ assert(pptr); assert(file)
+/* PERL_CALLCONV void Perl_save_pushptr(pTHX_ void *const ptr, const int type); */
+PERL_CALLCONV void Perl_save_pushptr_d(pTHX_ void *const ptr, const int type, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_PUSHPTR_D \
+ assert(file)
+/* PERL_CALLCONV void save_pushptrptr(pTHX_ void *const ptr1, void *const ptr2, const int type); */
+PERL_CALLCONV void Perl_save_pushptrptr_d(pTHX_ void *const ptr1, void *const ptr2, const int type, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_PUSHPTRPTR_D \
+ assert(file)
+/* PERL_CALLCONV void Perl_save_re_context(pTHX); */
+PERL_CALLCONV void Perl_save_re_context_d(pTHX_ const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_RE_CONTEXT_D \
+ assert(file)
+/* PERL_CALLCONV SV* Perl_save_scalar(pTHX_ GV* gv); */
+PERL_CALLCONV SV* Perl_save_scalar_d(pTHX_ GV* gv, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_SCALAR_D \
+ assert(gv); assert(file)
+/* PERL_CALLCONV void Perl_save_set_svflags(pTHX_ SV *sv, U32 mask, U32 val); */
+PERL_CALLCONV void Perl_save_set_svflags_d(pTHX_ SV *sv, U32 mask, U32 val, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_SET_SVFLAGS_D \
+ assert(sv); assert(file)
+/* PERL_CALLCONV void Perl_save_shared_pvref(pTHX_ char** str); */
+PERL_CALLCONV void Perl_save_shared_pvref_d(pTHX_ char** str, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_SHARED_PVREF_D \
+ assert(str); assert(file)
+/* PERL_CALLCONV void Perl_save_sptr(pTHX_ SV** sptr); */
+PERL_CALLCONV void Perl_save_sptr_d(pTHX_ SV** sptr, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_SPTR_D \
+ assert(sptr); assert(file)
+/* PERL_CALLCONV void Perl_save_strlen(pTHX_ STRLEN* ptr); */
+PERL_CALLCONV void Perl_save_strlen_d(pTHX_ STRLEN* ptr, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_STRLEN_D \
+ assert(ptr); assert(file)
+/* PERL_CALLCONV SV* Perl_save_svref(pTHX_ SV** sptr); */
+PERL_CALLCONV SV* Perl_save_svref_d(pTHX_ SV** sptr, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_SVREF_D \
+ assert(sptr); assert(file)
+/* PERL_CALLCONV void Perl_save_vptr(pTHX_ void *ptr); */
+PERL_CALLCONV void Perl_save_vptr_d(pTHX_ void *ptr, const char * const file, const I32 line);
+#define PERL_ARGS_ASSERT_SAVE_VPTR_D \
+ assert(ptr); assert(file)
+#endif
#if defined(UNLINK_ALL_VERSIONS)
PERL_CALLCONV I32 Perl_unlnk(pTHX_ const char* f);
#define PERL_ARGS_ASSERT_UNLNK \
diff --git a/regcomp.c b/regcomp.c
index 4f4bb44..d3d5fb3 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -17901,11 +17901,15 @@ S_re_croak2(pTHX_ bool utf8, const char* pat1,const char* pat2,...)
#ifndef PERL_IN_XSUB_RE
void
-Perl_save_re_context(pTHX)
+SS_DBG_FN(Perl_save_re_context)(pTHX_ pSS_DBGFL)
{
I32 nparens = -1;
I32 i;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_RE_CONTEXT_D;
+#endif
+
/* Save $1..$n (#18107: UTF-8 s/(\w+)/uc($1)/e); AMS 20021106. */
if (PL_curpm) {
@@ -17932,7 +17936,11 @@ Perl_save_re_context(pTHX)
if (gvp) {
GV * const gv = *gvp;
if (SvTYPE(gv) == SVt_PVGV && GvSV(gv))
+#ifdef SS_DEBUG
+ save_scalar_d(gv, file, line);
+#else
save_scalar(gv);
+#endif
}
}
}
diff --git a/regexec.c b/regexec.c
index e92e7a3..d6dd316 100644
--- a/regexec.c
+++ b/regexec.c
@@ -265,7 +265,7 @@ static regmatch_state * S_push_slab(pTHX);
#define REGCP_PAREN_ELEMS 3
#define REGCP_OTHER_ELEMS 3
-#define REGCP_FRAME_ELEMS 1
+#define REGCP_FRAME_ELEMS SSTYPESIZE
/* REGCP_FRAME_ELEMS are not part of the REGCP_OTHER_ELEMS and
* are needed for the regexp context stack bookkeeping. */
@@ -321,7 +321,7 @@ S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen)
SSPUSHINT(maxopenparen);
SSPUSHINT(rex->lastparen);
SSPUSHINT(rex->lastcloseparen);
- SSPUSHUV(SAVEt_REGCONTEXT | elems_shifted); /* Magic cookie. */
+ SSPUSHTYPE(SAVEt_REGCONTEXT | elems_shifted); /* Magic cookie. */
return retval;
}
@@ -354,12 +354,16 @@ S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p)
{
UV i;
U32 paren;
+#ifdef SS_DEBUG
+ const char * file;
+ I32 line;
+#endif
GET_RE_DEBUG_FLAGS_DECL;
PERL_ARGS_ASSERT_REGCPPOP;
/* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
- i = SSPOPUV;
+ SSPOPTYPE(file, line, i);
assert((i & SAVE_MASK) == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
i >>= SAVE_TIGHT_SHIFT; /* Parentheses elements to pop. */
rex->lastcloseparen = SSPOPINT;
diff --git a/scope.c b/scope.c
index 9768c30..952db4f 100644
--- a/scope.c
+++ b/scope.c
@@ -204,9 +204,15 @@ S_save_scalar_at(pTHX_ SV **sptr, const U32 flags)
}
void
-Perl_save_pushptrptr(pTHX_ void *const ptr1, void *const ptr2, const int type)
+SS_DBG_FN(Perl_save_pushptrptr)(pTHX_ void *const ptr1,
+ void *const ptr2, const int type _pSS_DBGFL)
{
dSS_ADD;
+
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_PUSHPTRPTR_D;
+#endif
+
SS_ADD_PTR(ptr1);
SS_ADD_PTR(ptr2);
SS_ADD_UV(type);
@@ -214,61 +220,82 @@ Perl_save_pushptrptr(pTHX_ void *const ptr1, void *const ptr2, const int type)
}
SV *
-Perl_save_scalar(pTHX_ GV *gv)
+SS_DBG_FN(Perl_save_scalar)(pTHX_ GV *gv _pSS_DBGFL)
{
SV ** const sptr = &GvSVn(gv);
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_SCALAR_D;
+#else
PERL_ARGS_ASSERT_SAVE_SCALAR;
+#endif
if (UNLIKELY(SvGMAGICAL(*sptr))) {
PL_localizing = 1;
(void)mg_get(*sptr);
PL_localizing = 0;
}
- save_pushptrptr(SvREFCNT_inc_simple(gv), SvREFCNT_inc(*sptr), SAVEt_SV);
+ SS_PUSHPTRPTR(SvREFCNT_inc_simple(gv), SvREFCNT_inc(*sptr), SAVEt_SV,
+ file, line);
return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
}
/* Like save_sptr(), but also SvREFCNT_dec()s the new value. Can be used to
* restore a global SV to its prior contents, freeing new value. */
void
-Perl_save_generic_svref(pTHX_ SV **sptr)
+SS_DBG_FN(Perl_save_generic_svref)(pTHX_ SV **sptr _pSS_DBGFL)
{
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_GENERIC_SVREF_D;
+#else
PERL_ARGS_ASSERT_SAVE_GENERIC_SVREF;
+#endif
- save_pushptrptr(sptr, SvREFCNT_inc(*sptr), SAVEt_GENERIC_SVREF);
+ SS_PUSHPTRPTR(sptr, SvREFCNT_inc(*sptr), SAVEt_GENERIC_SVREF, file, line);
}
/* Like save_pptr(), but also Safefree()s the new value if it is different
* from the old one. Can be used to restore a global char* to its prior
* contents, freeing new value. */
void
-Perl_save_generic_pvref(pTHX_ char **str)
+SS_DBG_FN(Perl_save_generic_pvref)(pTHX_ char **str _pSS_DBGFL)
{
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_GENERIC_PVREF_D;
+#else
PERL_ARGS_ASSERT_SAVE_GENERIC_PVREF;
+#endif
- save_pushptrptr(*str, str, SAVEt_GENERIC_PVREF);
+ SS_PUSHPTRPTR(*str, str, SAVEt_GENERIC_PVREF, file, line);
}
/* Like save_generic_pvref(), but uses PerlMemShared_free() rather than Safefree().
* Can be used to restore a shared global char* to its prior
* contents, freeing new value. */
void
-Perl_save_shared_pvref(pTHX_ char **str)
+SS_DBG_FN(Perl_save_shared_pvref)(pTHX_ char **str _pSS_DBGFL)
{
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_SHARED_PVREF_D;
+#else
PERL_ARGS_ASSERT_SAVE_SHARED_PVREF;
+#endif
- save_pushptrptr(str, *str, SAVEt_SHARED_PVREF);
+ SS_PUSHPTRPTR(str, *str, SAVEt_SHARED_PVREF, file, line);
}
/* set the SvFLAGS specified by mask to the values in val */
void
-Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val)
+SS_DBG_FN(Perl_save_set_svflags)(pTHX_ SV* sv, U32 mask, U32 val _pSS_DBGFL)
{
dSS_ADD;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_SET_SVFLAGS_D;
+#else
PERL_ARGS_ASSERT_SAVE_SET_SVFLAGS;
+#endif
SS_ADD_PTR(sv);
SS_ADD_INT(mask);
@@ -278,11 +305,15 @@ Perl_save_set_svflags(pTHX_ SV* sv, U32 mask, U32 val)
}
void
-Perl_save_gp(pTHX_ GV *gv, I32 empty)
+SS_DBG_FN(Perl_save_gp)(pTHX_ GV *gv, I32 empty _pSS_DBGFL)
{
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_GP_D;
+#else
PERL_ARGS_ASSERT_SAVE_GP;
+#endif
- save_pushptrptr(SvREFCNT_inc(gv), GvGP(gv), SAVEt_GP);
+ SS_PUSHPTRPTR(SvREFCNT_inc(gv), GvGP(gv), SAVEt_GP, file, line);
if (empty) {
GP *gp = Perl_newGP(aTHX_ gv);
@@ -310,16 +341,20 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty)
}
AV *
-Perl_save_ary(pTHX_ GV *gv)
+SS_DBG_FN(Perl_save_ary)(pTHX_ GV *gv _pSS_DBGFL)
{
AV * const oav = GvAVn(gv);
AV *av;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_ARY_D;
+#else
PERL_ARGS_ASSERT_SAVE_ARY;
+#endif
if (UNLIKELY(!AvREAL(oav) && AvREIFY(oav)))
av_reify(oav);
- save_pushptrptr(SvREFCNT_inc_simple_NN(gv), oav, SAVEt_AV);
+ SS_PUSHPTRPTR(SvREFCNT_inc_simple_NN(gv), oav, SAVEt_AV, file, line);
GvAV(gv) = NULL;
av = GvAVn(gv);
@@ -329,14 +364,18 @@ Perl_save_ary(pTHX_ GV *gv)
}
HV *
-Perl_save_hash(pTHX_ GV *gv)
+SS_DBG_FN(Perl_save_hash)(pTHX_ GV *gv _pSS_DBGFL)
{
HV *ohv, *hv;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_HASH_D;
+#else
PERL_ARGS_ASSERT_SAVE_HASH;
+#endif
- save_pushptrptr(
- SvREFCNT_inc_simple_NN(gv), (ohv = GvHVn(gv)), SAVEt_HV
+ SS_PUSHPTRPTR(
+ SvREFCNT_inc_simple_NN(gv), (ohv = GvHVn(gv)), SAVEt_HV, file, line
);
GvHV(gv) = NULL;
@@ -347,23 +386,31 @@ Perl_save_hash(pTHX_ GV *gv)
}
void
-Perl_save_item(pTHX_ SV *item)
+SS_DBG_FN(Perl_save_item)(pTHX_ SV *item _pSS_DBGFL)
{
SV * const sv = newSVsv(item);
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_ITEM_D;
+#else
PERL_ARGS_ASSERT_SAVE_ITEM;
+#endif
- save_pushptrptr(item, /* remember the pointer */
+ SS_PUSHPTRPTR(item, /* remember the pointer */
sv, /* remember the value */
- SAVEt_ITEM);
+ SAVEt_ITEM, file, line);
}
void
-Perl_save_bool(pTHX_ bool *boolp)
+SS_DBG_FN(Perl_save_bool)(pTHX_ bool *boolp _pSS_DBGFL)
{
dSS_ADD;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_BOOL_D;
+#else
PERL_ARGS_ASSERT_SAVE_BOOL;
+#endif
SS_ADD_PTR(boolp);
SS_ADD_UV(SAVEt_BOOL | (*boolp << 8));
@@ -371,10 +418,14 @@ Perl_save_bool(pTHX_ bool *boolp)
}
void
-Perl_save_pushi32ptr(pTHX_ const I32 i, void *const ptr, const int type)
+SS_DBG_FN(S_save_pushi32ptr)(pTHX_ const I32 i, void *const ptr, const int type _pSS_DBGFL)
{
dSS_ADD;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_PUSHI32PTR_D;
+#endif
+
SS_ADD_INT(i);
SS_ADD_PTR(ptr);
SS_ADD_UV(type);
@@ -382,14 +433,18 @@ Perl_save_pushi32ptr(pTHX_ const I32 i, void *const ptr, const int type)
}
void
-Perl_save_int(pTHX_ int *intp)
+SS_DBG_FN(Perl_save_int)(pTHX_ int *intp _pSS_DBGFL)
{
const int i = *intp;
UV type = ((UV)((UV)i << SAVE_TIGHT_SHIFT) | SAVEt_INT_SMALL);
int size = 2;
dSS_ADD;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_INT_D;
+#else
PERL_ARGS_ASSERT_SAVE_INT;
+#endif
if (UNLIKELY((int)(type >> SAVE_TIGHT_SHIFT) != i)) {
SS_ADD_INT(i);
@@ -402,11 +457,15 @@ Perl_save_int(pTHX_ int *intp)
}
void
-Perl_save_I8(pTHX_ I8 *bytep)
+SS_DBG_FN(Perl_save_I8)(pTHX_ I8 *bytep _pSS_DBGFL)
{
dSS_ADD;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_I8_D;
+#else
PERL_ARGS_ASSERT_SAVE_I8;
+#endif
SS_ADD_PTR(bytep);
SS_ADD_UV(SAVEt_I8 | ((UV)*bytep << 8));
@@ -414,11 +473,15 @@ Perl_save_I8(pTHX_ I8 *bytep)
}
void
-Perl_save_I16(pTHX_ I16 *intp)
+SS_DBG_FN(Perl_save_I16)(pTHX_ I16 *intp _pSS_DBGFL)
{
dSS_ADD;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_I16_D;
+#else
PERL_ARGS_ASSERT_SAVE_I16;
+#endif
SS_ADD_PTR(intp);
SS_ADD_UV(SAVEt_I16 | ((UV)*intp << 8));
@@ -426,14 +489,18 @@ Perl_save_I16(pTHX_ I16 *intp)
}
void
-Perl_save_I32(pTHX_ I32 *intp)
+SS_DBG_FN(Perl_save_I32)(pTHX_ I32 *intp _pSS_DBGFL)
{
const I32 i = *intp;
UV type = ((I32)((U32)i << SAVE_TIGHT_SHIFT) | SAVEt_I32_SMALL);
int size = 2;
dSS_ADD;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_I32_D;
+#else
PERL_ARGS_ASSERT_SAVE_I32;
+#endif
if (UNLIKELY((I32)(type >> SAVE_TIGHT_SHIFT) != i)) {
SS_ADD_INT(i);
@@ -446,11 +513,15 @@ Perl_save_I32(pTHX_ I32 *intp)
}
void
-Perl_save_strlen(pTHX_ STRLEN *ptr)
+SS_DBG_FN(Perl_save_strlen)(pTHX_ STRLEN *ptr _pSS_DBGFL)
{
dSS_ADD;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_STRLEN_D;
+#else
PERL_ARGS_ASSERT_SAVE_STRLEN;
+#endif
SS_ADD_IV(*ptr);
SS_ADD_PTR(ptr);
@@ -462,34 +533,50 @@ Perl_save_strlen(pTHX_ STRLEN *ptr)
* force word-alignment and we'll miss the pointer.
*/
void
-Perl_save_pptr(pTHX_ char **pptr)
+SS_DBG_FN(Perl_save_pptr)(pTHX_ char **pptr _pSS_DBGFL)
{
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_PPTR_D;
+#else
PERL_ARGS_ASSERT_SAVE_PPTR;
+#endif
- save_pushptrptr(*pptr, pptr, SAVEt_PPTR);
+ SS_PUSHPTRPTR(*pptr, pptr, SAVEt_PPTR, file, line);
}
void
-Perl_save_vptr(pTHX_ void *ptr)
+SS_DBG_FN(Perl_save_vptr)(pTHX_ void *ptr _pSS_DBGFL)
{
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_VPTR_D;
+#else
PERL_ARGS_ASSERT_SAVE_VPTR;
+#endif
- save_pushptrptr(*(char**)ptr, ptr, SAVEt_VPTR);
+ SS_PUSHPTRPTR(*(char**)ptr, ptr, SAVEt_VPTR, file, line);
}
void
-Perl_save_sptr(pTHX_ SV **sptr)
+SS_DBG_FN(Perl_save_sptr)(pTHX_ SV **sptr _pSS_DBGFL)
{
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_SPTR_D;
+#else
PERL_ARGS_ASSERT_SAVE_SPTR;
+#endif
- save_pushptrptr(*sptr, sptr, SAVEt_SPTR);
+ SS_PUSHPTRPTR(*sptr, sptr, SAVEt_SPTR, file, line);
}
void
-Perl_save_padsv_and_mortalize(pTHX_ PADOFFSET off)
+SS_DBG_FN(Perl_save_padsv_and_mortalize)(pTHX_ PADOFFSET off _pSS_DBGFL)
{
dSS_ADD;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_PADSV_AND_MORTALIZE_D;
+#endif
+
ASSERT_CURPAD_ACTIVE("save_padsv");
SS_ADD_PTR(SvREFCNT_inc_simple_NN(PL_curpad[off]));
SS_ADD_PTR(PL_comppad);
@@ -499,37 +586,54 @@ Perl_save_padsv_and_mortalize(pTHX_ PADOFFSET off)
}
void
-Perl_save_hptr(pTHX_ HV **hptr)
+SS_DBG_FN(Perl_save_hptr)(pTHX_ HV **hptr _pSS_DBGFL)
{
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_HPTR_D;
+#else
PERL_ARGS_ASSERT_SAVE_HPTR;
+#endif
- save_pushptrptr(*hptr, hptr, SAVEt_HPTR);
+ SS_PUSHPTRPTR(*hptr, hptr, SAVEt_HPTR, file, line);
}
void
-Perl_save_aptr(pTHX_ AV **aptr)
+SS_DBG_FN(Perl_save_aptr)(pTHX_ AV **aptr _pSS_DBGFL)
{
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_APTR_D;
+#else
PERL_ARGS_ASSERT_SAVE_APTR;
+#endif
- save_pushptrptr(*aptr, aptr, SAVEt_APTR);
+ SS_PUSHPTRPTR(*aptr, aptr, SAVEt_APTR, file, line);
}
void
-Perl_save_pushptr(pTHX_ void *const ptr, const int type)
+SS_DBG_FN(Perl_save_pushptr)(pTHX_ void *const ptr, const int type _pSS_DBGFL)
{
dSS_ADD;
+
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_PUSHPTR_D;
+#endif
+
SS_ADD_PTR(ptr);
SS_ADD_UV(type);
SS_ADD_END(2);
}
void
-Perl_save_clearsv(pTHX_ SV **svp)
+SS_DBG_FN(Perl_save_clearsv)(pTHX_ SV **svp _pSS_DBGFL)
{
const UV offset = svp - PL_curpad;
const UV offset_shifted = offset << SAVE_TIGHT_SHIFT;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_CLEARSV_D;
+#else
PERL_ARGS_ASSERT_SAVE_CLEARSV;
+#endif
ASSERT_CURPAD_ACTIVE("save_clearsv");
SvPADSTALE_off(*svp); /* mark lexical as active */
@@ -546,34 +650,46 @@ Perl_save_clearsv(pTHX_ SV **svp)
}
void
-Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
+SS_DBG_FN(Perl_save_delete)(pTHX_ HV *hv, char *key, I32 klen _pSS_DBGFL)
{
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_DELETE_D;
+#else
PERL_ARGS_ASSERT_SAVE_DELETE;
+#endif
- save_pushptri32ptr(key, klen, SvREFCNT_inc_simple(hv), SAVEt_DELETE);
+ SS_PUSHPTRI32PTR(key, klen, SvREFCNT_inc_simple(hv), SAVEt_DELETE, file, line);
}
void
-Perl_save_hdelete(pTHX_ HV *hv, SV *keysv)
+SS_DBG_FN(Perl_save_hdelete)(pTHX_ HV *hv, SV *keysv _pSS_DBGFL)
{
STRLEN len;
I32 klen;
const char *key;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_HDELETE_D;
+#else
PERL_ARGS_ASSERT_SAVE_HDELETE;
+#endif
key = SvPV_const(keysv, len);
klen = SvUTF8(keysv) ? -(I32)len : (I32)len;
SvREFCNT_inc_simple_void_NN(hv);
- save_pushptri32ptr(savepvn(key, len), klen, hv, SAVEt_DELETE);
+ SS_PUSHPTRI32PTR(savepvn(key, len), klen, hv, SAVEt_DELETE, file, line);
}
void
-Perl_save_adelete(pTHX_ AV *av, SSize_t key)
+SS_DBG_FN(Perl_save_adelete)(pTHX_ AV *av, SSize_t key _pSS_DBGFL)
{
dSS_ADD;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_ADELETE_D;
+#else
PERL_ARGS_ASSERT_SAVE_ADELETE;
+#endif
SvREFCNT_inc_void(av);
SS_ADD_UV(key);
@@ -583,10 +699,14 @@ Perl_save_adelete(pTHX_ AV *av, SSize_t key)
}
void
-Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
+SS_DBG_FN(Perl_save_destructor)(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p _pSS_DBGFL)
{
dSS_ADD;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_DESTRUCTOR_D;
+#else
PERL_ARGS_ASSERT_SAVE_DESTRUCTOR;
+#endif
SS_ADD_DPTR(f);
SS_ADD_PTR(p);
@@ -595,10 +715,14 @@ Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
}
void
-Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p)
+SS_DBG_FN(Perl_save_destructor_x)(pTHX_ DESTRUCTORFUNC_t f, void* p _pSS_DBGFL)
{
dSS_ADD;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_DESTRUCTOR_X_D;
+#endif
+
SS_ADD_DXPTR(f);
SS_ADD_PTR(p);
SS_ADD_UV(SAVEt_DESTRUCTOR_X);
@@ -606,24 +730,34 @@ Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p)
}
void
-Perl_save_hints(pTHX)
+SS_DBG_FN(Perl_save_hints)(pTHX_ pSS_DBGFL)
{
COPHH *save_cophh = cophh_copy(CopHINTHASH_get(&PL_compiling));
+
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_HINTS_D;
+#endif
+
if (PL_hints & HINT_LOCALIZE_HH) {
HV *oldhh = GvHV(PL_hintgv);
- save_pushptri32ptr(oldhh, PL_hints, save_cophh, SAVEt_HINTS);
+ SS_PUSHPTRI32PTR(oldhh, PL_hints, save_cophh, SAVEt_HINTS, file, line);
GvHV(PL_hintgv) = NULL; /* in case copying dies */
GvHV(PL_hintgv) = hv_copy_hints_hv(oldhh);
} else {
- save_pushi32ptr(PL_hints, save_cophh, SAVEt_HINTS);
+ SS_PUSHI32PTR(PL_hints, save_cophh, SAVEt_HINTS, file, line);
}
}
static void
-S_save_pushptri32ptr(pTHX_ void *const ptr1, const I32 i, void *const ptr2,
- const int type)
+SS_DBG_FN(S_save_pushptri32ptr)(pTHX_ void *const ptr1, const I32 i,
+ void *const ptr2, const int type _pSS_DBGFL)
{
dSS_ADD;
+
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_PUSHPTRI32PTR_D;
+#endif
+
SS_ADD_PTR(ptr1);
SS_ADD_INT(i);
SS_ADD_PTR(ptr2);
@@ -632,13 +766,17 @@ S_save_pushptri32ptr(pTHX_ void *const ptr1, const I32 i, void *const ptr2,
}
void
-Perl_save_aelem_flags(pTHX_ AV *av, SSize_t idx, SV **sptr,
- const U32 flags)
+SS_DBG_FN(Perl_save_aelem_flags)(pTHX_ AV *av, SSize_t idx, SV **sptr,
+ const U32 flags _pSS_DBGFL)
{
dSS_ADD;
SV *sv;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_AELEM_FLAGS_D;
+#else
PERL_ARGS_ASSERT_SAVE_AELEM_FLAGS;
+#endif
SvGETMAGIC(*sptr);
SS_ADD_PTR(SvREFCNT_inc_simple(av));
@@ -663,11 +801,15 @@ Perl_save_aelem_flags(pTHX_ AV *av, SSize_t idx, SV **sptr,
}
void
-Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags)
+SS_DBG_FN(Perl_save_helem_flags)(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags _pSS_DBGFL)
{
SV *sv;
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS_D;
+#else
PERL_ARGS_ASSERT_SAVE_HELEM_FLAGS;
+#endif
SvGETMAGIC(*sptr);
{
@@ -691,12 +833,16 @@ Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags)
}
SV*
-Perl_save_svref(pTHX_ SV **sptr)
+SS_DBG_FN(Perl_save_svref)(pTHX_ SV **sptr _pSS_DBGFL)
{
+#ifdef SS_DEBUG
+ PERL_ARGS_ASSERT_SAVE_SVREF_D;
+#else
PERL_ARGS_ASSERT_SAVE_SVREF;
+#endif
SvGETMAGIC(*sptr);
- save_pushptrptr(sptr, SvREFCNT_inc(*sptr), SAVEt_SVREF);
+ SS_PUSHPTRPTR(sptr, SvREFCNT_inc(*sptr), SAVEt_SVREF, file, line);
return save_scalar_at(sptr, SAVEf_SETMAGIC); /* XXX - FIXME - see #60360 */
}
@@ -713,10 +859,10 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad)
"panic: save_alloc elems %"UVuf" out of range (%"IVdf"-%"IVdf")",
elems, (IV)size, (IV)pad);
- SSGROW(elems + 1);
+ SSGROW(elems + SSTYPESIZE);
PL_savestack_ix += elems;
- SSPUSHUV(SAVEt_ALLOC | elems_shifted);
+ SSPUSHTYPE(SAVEt_ALLOC | elems_shifted);
return start;
}
@@ -769,6 +915,12 @@ Perl_leave_scope(pTHX_ I32 base)
while (PL_savestack_ix > base) {
UV uv;
U8 type;
+#ifdef SS_DEBUG
+ ANY * any_file;
+ const char * file;
+ ANY * any_line;
+ I32 line;
+#endif
SV *refsv;
SV **svp;
@@ -777,7 +929,16 @@ Perl_leave_scope(pTHX_ I32 base)
{
I32 ix = PL_savestack_ix - 1;
- ANY *p = &PL_savestack[ix];
+ ANY *p;
+#ifdef SS_DEBUG
+ any_file = &PL_savestack[ix--];
+ any_line = &PL_savestack[ix--];
+ file = any_file->any_ptr;
+ line = any_line->any_i32;
+ /* make sure its a valid addr and probably a path */
+ assert(isPRINT(*file));
+#endif
+ p = &PL_savestack[ix];
uv = p->any_uv;
type = (U8)uv & SAVE_MASK;
if (type > SAVEt_ARG0_MAX) {
diff --git a/scope.h b/scope.h
index 822c8ba..bcc95c4 100644
--- a/scope.h
+++ b/scope.h
@@ -8,6 +8,48 @@
*
*/
+/* SS_DEBUG is a define specified as -DSS_DEBUG to the CC.
+ SS_DEBUG records the C callers of each save stack entry.
+ There are 2 ways to read the file and line of a SS entry.
+ The first is compiling perl with -O0 and putting C breakpoints in
+ Perl_leave_scope or Perl_ss_dup, and examine C auto vars "file" and "line".
+ The second way is to use the memory watch tool. The perl save stack consists
+ of IV sized slices, so set your debugger to show the hex dump as 32 or
+ 64 bit hex numbers (IV size), then examine memory block pointed to by
+ PL_savestack or my_perl->Isavestack, then look for the FILE pointers, then
+ examine memory at the candidiate FILE pointers, if it is the name of a C file
+ you found where it was created. If the candidate pointer isn't valid, or the
+ memblock doesn't look like a file path (contains unprintables or high bit on)
+ keep searching higher or lower addrs until you find a file path. Don't search
+ addresses below PL_stavestack since that is before the start of the SS array.
+
+ A save stack will look like
+
+ ***LOW ADDR***
+ DATA or PTR -body #4 and more, extremely rare > 3 body entries, see SAVEt_ALLOC)
+ DATA or PTR -body #3 optional, pointer or mask or counter
+ DATA or PTR -body #2 optional, usually a pointer
+ DATA or PTR -body #1 if alone then a ptr, if #2 exists, flags/mask/counter for #2
+ -it is very rare this ent doesn't exist, see SAVEt_CLEARSV
+ TYPE -very important, all SS entries must have one, no exceptions,
+ -this is a U32 or U64 number, but the flag will be inside the
+ -mask of 0x3f (6 bits), the meaning of the rest
+ -of the (32-6 bits) is SAVEt_ specific, the vast majority of them
+ -leave it as all 0s, so a type will be like 0000001D.
+ -TYPE will never a pointer, it shouldn't look like a pointer
+ -looking at all 8 quads except by coincidence. There will be alot
+ -of high 0 hex digits in the number.
+ LINE -only exists on SS_DEBUG build. lines look like 0000XXXX in your
+ -memory dump, The largest perl source code file comes in at
+ -0x5000 lines, most core .c files are under 4096 so the line
+ -numbers more like 00000XXX insted of 0000XXXX
+ FILE -only exists on SS_DEBUG build. These are C string litteral
+ -pointers. These pointers will almost always be from bin perl or
+ -libperl and can be visually identified by XXXX0000 being inside
+ -perl's .rodata section.
+ ***HIGH ADDR***
+ */
+
/* *** these are ordered by number of of auto-popped args */
/* zero args */
@@ -100,8 +142,19 @@
* macros */
#define SS_MAXPUSH 4
-#define SSCHECK(need) if (UNLIKELY(PL_savestack_ix + (I32)(need) + SS_MAXPUSH > PL_savestack_max)) savestack_grow()
-#define SSGROW(need) if (UNLIKELY(PL_savestack_ix + (I32)(need) + SS_MAXPUSH > PL_savestack_max)) savestack_grow_cnt(need + SS_MAXPUSH)
+/* extra entries for file/line recording */
+#ifdef SS_DEBUG
+# define SS_DBGPUSH 2
+#else
+# define SS_DBGPUSH 0
+#endif
+
+#define SSCHECK(need) \
+ if (UNLIKELY(PL_savestack_ix + (I32)(need) + SS_MAXPUSH + SS_DBGPUSH \
+ > PL_savestack_max)) savestack_grow()
+#define SSGROW(need) \
+ if (UNLIKELY(PL_savestack_ix + (I32)(need) + SS_MAXPUSH + SS_DBGPUSH \
+ > PL_savestack_max)) savestack_grow_cnt(need + SS_MAXPUSH + SS_DBGPUSH)
#define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i))
#define SSPUSHLONG(i) (PL_savestack[PL_savestack_ix++].any_long = (long)(i))
#define SSPUSHBOOL(p) (PL_savestack[PL_savestack_ix++].any_bool = (p))
@@ -110,6 +163,17 @@
#define SSPUSHPTR(p) (PL_savestack[PL_savestack_ix++].any_ptr = (void*)(p))
#define SSPUSHDPTR(p) (PL_savestack[PL_savestack_ix++].any_dptr = (p))
#define SSPUSHDXPTR(p) (PL_savestack[PL_savestack_ix++].any_dxptr = (p))
+/* TODO add file line tracking for old SS API */
+#ifdef SS_DEBUG
+# define SSPUSHTYPE(t) (PL_savestack[PL_savestack_ix++].any_uv = (UV)(t)), \
+ (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(-1)), \
+ (PL_savestack[PL_savestack_ix++].any_ptr = \
+ (void*)("file tracking not implemented yet on old SS API, FIXME"))
+# define SSTYPESIZE 3
+#else
+# define SSPUSHTYPE(t) SSPUSHUV(t)
+# define SSTYPESIZE 1
+#endif
/* SS_ADD*: newer, faster versions of the above. Don't mix the two sets of
* macros. These are fast because they save reduce accesses to the PL_
@@ -127,7 +191,27 @@
I32 ix = PL_savestack_ix; \
ANY *ssp = &PL_savestack[ix]
-#define SS_ADD_END(need) \
+#ifdef SS_DEBUG
+# define SS_ADD_END(need) \
+ assert((need) <= SS_MAXPUSH); \
+ SS_ADD_INT(line); \
+ SS_ADD_PTR(file); \
+ ix += (need) + SS_DBGPUSH; \
+ PL_savestack_ix = ix; \
+ assert(ix <= PL_savestack_max); \
+ if (UNLIKELY((ix + SS_MAXPUSH + SS_DBGPUSH) > PL_savestack_max)) savestack_grow(); \
+ assert(PL_savestack_ix + SS_MAXPUSH + SS_DBGPUSH <= PL_savestack_max);
+
+# define dSS_FILELINE \
+ const char * const file = __FILE__; \
+ const I32 line = __LINE__
+# define _pSS_DBGFL ,const char * const file, const I32 line
+# define pSS_DBGFL const char * const file, const I32 line
+# define SS_DBG_FN(a) a##_d
+
+#else
+#error bad
+# define SS_ADD_END(need) \
assert((need) <= SS_MAXPUSH); \
ix += (need); \
PL_savestack_ix = ix; \
@@ -135,6 +219,12 @@
if (UNLIKELY((ix + SS_MAXPUSH) > PL_savestack_max)) savestack_grow(); \
assert(PL_savestack_ix + SS_MAXPUSH <= PL_savestack_max);
+# define dSS_FILELINE dNOOP
+# define _pSS_DBGFL
+# define pSS_DBGFL
+# define SS_DBG_FN(a) a
+#endif
+
#define SS_ADD_INT(i) ((ssp++)->any_i32 = (I32)(i))
#define SS_ADD_LONG(i) ((ssp++)->any_long = (long)(i))
#define SS_ADD_BOOL(p) ((ssp++)->any_bool = (p))
@@ -152,6 +242,14 @@
#define SSPOPPTR (PL_savestack[--PL_savestack_ix].any_ptr)
#define SSPOPDPTR (PL_savestack[--PL_savestack_ix].any_dptr)
#define SSPOPDXPTR (PL_savestack[--PL_savestack_ix].any_dxptr)
+#ifdef SS_DEBUG
+# define SSPOPTYPE(file, line, type) (void)( \
+ ((file) = SSPOPPTR), \
+ ((line) = SSPOPINT), \
+ ((type) = SSPOPUV))
+#else
+# define SSPOPTYPE(file, line, type) (void)((type) = SSPOPUV)
+#endif
/*
@@ -188,7 +286,7 @@ scope has the given name. Name must be a literal string.
=cut
*/
-#define SAVETMPS Perl_save_strlen(aTHX_ (STRLEN *)&PL_tmps_floor), \
+#define SAVETMPS save_strlen((STRLEN *)&PL_tmps_floor), \
PL_tmps_floor = PL_tmps_ix
#define FREETMPS if (PL_tmps_ix > PL_tmps_floor) free_tmps()
@@ -264,9 +362,74 @@ scope has the given name. Name must be a literal string.
#define SAVEDESTRUCTOR_X(f,p) \
save_destructor_x((DESTRUCTORFUNC_t)(f), (void*)(p))
+#ifdef SS_DEBUG
+# define save_destructor_x(f, p) \
+ Perl_save_destructor_x_d(aTHX_ f, p, __FILE__, __LINE__)
+# define save_aelem_flags(av, idx, sptr, flags) \
+ Perl_save_aelem_flags_d(aTHX_ av, idx, sptr, flags, __FILE__, __LINE__)
+# define save_aptr(aptr) Perl_save_aptr_d(aTHX_ aptr, __FILE__, __LINE__)
+# define save_ary(gv) Perl_save_ary_d(aTHX_ gv, __FILE__, __LINE__)
+# define save_bool(boolp) Perl_save_bool_d(aTHX_ boolp, __FILE__, __LINE__)
+# define save_clearsv(svp) Perl_save_clearsv_d(aTHX_ svp, __FILE__, __LINE__)
+# define save_delete(hv, key, klen) \
+ Perl_save_delete_d(aTHX_ hv, key, klen, __FILE__, __LINE__)
+# define save_hdelete(hv, keysv) \
+ Perl_save_hdelete_d(aTHX_ hv, keysv, __FILE__, __LINE__)
+# define save_adelete(av, key) \
+ Perl_save_adelete_d(aTHX_ av, key, __FILE__, __LINE__)
+# define save_destructor(f, p) \
+ Perl_save_destructor_d(aTHX_ f, p, __FILE__, __LINE__)
+# define save_generic_svref(sptr) \
+ Perl_save_generic_svref_d(aTHX_ sptr, __FILE__, __LINE__)
+# define save_generic_pvref(str) \
+ Perl_save_generic_pvref_d(aTHX_ str, __FILE__, __LINE__)
+# define save_shared_pvref(str) \
+ Perl_save_shared_pvref_d(aTHX_ str, __FILE__, __LINE__)
+# define save_gp(gv, empty) Perl_save_gp_d(aTHX_ gv, empty, __FILE__, __LINE__)
+# define save_hash(gv) Perl_save_hash_d(aTHX_ gv, __FILE__, __LINE__)
+# define save_hints() Perl_save_hints_d(aTHX_ __FILE__, __LINE__)
+# define save_helem_flags(hv, key, sptr, flags) \
+ Perl_save_helem_flags_d(aTHX_ hv, key, sptr, flags, __FILE__, __LINE__)
+# define save_hptr(hptr) Perl_save_hptr_d(aTHX_ hptr, __FILE__, __LINE__)
+# define save_I16(intp) Perl_save_I16_d(aTHX_ intp, __FILE__, __LINE__)
+# define save_I32(intp) Perl_save_I32_d(aTHX_ intp, __FILE__, __LINE__)
+# define save_I8(bytep) Perl_save_I8_d(aTHX_ bytep, __FILE__, __LINE__)
+# define save_int(intp) Perl_save_int_d(aTHX_ intp, __FILE__, __LINE__)
+# define save_item(item) Perl_save_item_d(aTHX_ item, __FILE__, __LINE__)
+# define save_scalar(gv) Perl_save_scalar_d(aTHX_ gv, __FILE__, __LINE__)
+# define save_pptr(pptr) Perl_save_pptr_d(aTHX_ pptr, __FILE__, __LINE__)
+# define save_vptr(ptr) Perl_save_vptr_d(aTHX_ ptr, __FILE__, __LINE__)
+# define save_re_context() Perl_save_re_context_d(aTHX_ __FILE__, __LINE__)
+# define save_padsv_and_mortalize(off) Perl_save_padsv_and_mortalize_d(aTHX_ off, __FILE__, __LINE__)
+# define save_sptr(sptr) Perl_save_sptr_d(aTHX_ sptr, __FILE__, __LINE__)
+# define save_strlen(ptr) Perl_save_strlen_d(aTHX_ ptr, __FILE__, __LINE__)
+# define save_svref(sptr) Perl_save_svref_d(aTHX_ sptr, __FILE__, __LINE__)
+# define save_pushptr(ptr, type) Perl_save_pushptr_d(aTHX_ ptr, type, __FILE__, __LINE__)
+# define save_set_svflags(sv, mask, val) \
+ Perl_save_set_svflags_d(aTHX_ sv, mask, val, __FILE__, __LINE__)
+# define save_pushptrptr(p1, p2, type) \
+ Perl_save_pushptrptr_d(aTHX_ p1, p2, type, __FILE__, __LINE__)
+# define SS_PUSHPTRPTR(p1, p2, type, f, l) \
+ Perl_save_pushptrptr_d(aTHX_ p1, p2, type, f, l)
+# if defined(PERL_IN_SCOPE_C)
+# define SS_PUSHPTRI32PTR(ptr1, i, ptr2, type, f, l) \
+ S_save_pushptri32ptr_d(aTHX_ ptr1, i, ptr2, type, f, l)
+# define SS_PUSHI32PTR(i,ptr,type, f, l) \
+ save_pushi32ptr_d(i,ptr,type, f, l)
+# endif
+#else
+# define SS_PUSHPTRPTR(p1, p2, type, f, l) \
+ save_pushptrptr(p1, p2, type)
+# if defined(PERL_IN_SCOPE_C)
+# define SS_PUSHPTRI32PTR(ptr1, i, ptr2, type, f, l) \
+ save_pushptri32ptr(ptr1, i, ptr2, type)
+# endif
+#endif
+
#define SAVESTACK_POS() \
STMT_START { \
dSS_ADD; \
+ dSS_FILELINE; \
SS_ADD_INT(PL_stack_sp - PL_stack_base); \
SS_ADD_UV(SAVEt_STACK_POS); \
SS_ADD_END(2); \
diff --git a/sv.c b/sv.c
index dc2ba8b..e08545d 100644
--- a/sv.c
+++ b/sv.c
@@ -4067,7 +4067,8 @@ Perl_gv_setref(pTHX_ SV *const dstr, SV *const sstr)
/* There is no save_pushptrptrptr. Creating it for this
one call site would be overkill. So inline the ss add
routines here. */
- dSS_ADD;
+ dSS_ADD;
+ dSS_FILELINE;
SS_ADD_PTR(dstr);
SS_ADD_PTR(location);
SS_ADD_PTR(SvREFCNT_inc(*location));
@@ -14072,9 +14073,23 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param)
Newxz(nss, max, ANY);
while (ix > 0) {
- const UV uv = POPUV(ss,ix);
- const U8 type = (U8)uv & SAVE_MASK;
-
+#ifdef SS_DEBUG
+ const char * file;
+ I32 line;
+#endif
+ UV uv;
+ U8 type;
+
+#ifdef SS_DEBUG
+ file = POPPTR(ss,ix);
+ TOPPTR(nss,ix) = (char*)file;
+ line = POPINT(ss,ix);
+ TOPINT(nss,ix) = line;
+ /* make sure its a valid addr and probably a path */
+ assert(isPRINT(*file));
+#endif
+ uv = POPUV(ss,ix);
+ type = (U8)uv & SAVE_MASK;
TOPUV(nss,ix) = uv;
switch (type) {
case SAVEt_CLEARSV:
--
1.7.9.msysgit.0
|
From @iabynOn Mon, Oct 05, 2015 at 11:51:43AM -0700, bulk88 wrote:
Um, this seems a bit invasive. Would it be possible instead, to 1. If you're just interested in finding when a particular SS frame of On debugging builds, have a var, PL_savestack_serial say, which is 2. If you need to do more general introspection (e.g. a full stack dump On debugging builds, have a fake save type, SAVEt_DEBUGINFO say, along with #ifdef DEBUGGING Perl_save_debuginfo(pTHX_ char *file, int line) #else Then just update the SAVEFOO macros to be, e.g. #define SAVEI8(i) save_I8((I8*)&(i)); SAVEDEBUGINFO -- |
|
The RT System itself - Status changed from 'new' to 'open' |
From @bulk88On Tue Oct 06 03:22:43 2015, davem wrote:
Flaws
There is no clear separation between SS_ADD/SSPUSH your own kind of type sandwich, SAVE***** macros and save_***** functions. perlapi lists save_***** funcs. http://perldoc.perl.org/perlguts.html#Localizing-changes lists the SAVE*****. cpangrep shows SAVE****** being the standard on CPAN, but core has a bunch of with save_****** usage. Since core uses save_****** calls in a bunch of places, the save_***** calls must be hooked, not the all caps macros. With your proposal, there are many ways SS frames can slip through the cracks and not get their context recorded since having a context SS frame is completely optional instead of absolutely required or very quick failure. If bad CPAN code makes their own SS sandwich with SSPUSH*, it won't record the context. With my design, failing to correctly code for SS_DEBUG (have the file and line entries next to the type entry) will quickly cause a SEGV in SS_DEBUG perl in Perl_leave_scope since the file and line slots are missing. Plus random memory corruption might wipe or replace the file char *, and make the printable char test assert fail, failing sooner. If the context frame is blindly skipped like SAVEt_ALLOC in Perl_leave_scope, it might have been corrupted but it isn't known. Also having SSPUSHTYPE instead of SSPUSHUV for the type slot makes the reading the source code easier. There will be further revisions to the code since it fails on most build permutations, and I have them already on another machine. The concept of each SAVEt_* gets a file and line slot will remain. The invasiveness of patch is limited to scope.c/scope.h/embed.fnc/makedef.pl. No source code changes in the other files unless they directly pop or push SS slots and refuse to use the abstraction in scope.c for whatever reason. -- |
|
@bulk88 could you please submit this case as a PR if you would like to discuss it further? |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Migrated from rt.perl.org#126273 (status was 'open')
Searchable as RT126273$
The text was updated successfully, but these errors were encountered: