Add save_adelete()/SAVEADELETE() to save on the stack an array element delete

diff --git a/embed.fnc b/embed.fnc
index c76ca9d..1a0e5d3 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -889,6 +889,7 @@ Ap  |AV*    |save_ary       |NN GV* gv
 Ap     |void   |save_bool      |NN bool* boolp
 Ap     |void   |save_clearsv   |NN SV** svp
 Ap     |void   |save_delete    |NN HV *hv|NN char *key|I32 klen
+Ap     |void   |save_adelete   |NN AV *av|I32 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

diff --git a/embed.h b/embed.h
index 6fa667a..b1f9741 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -780,6 +780,7 @@
 #define save_bool              Perl_save_bool
 #define save_clearsv           Perl_save_clearsv
 #define save_delete            Perl_save_delete
+#define save_adelete           Perl_save_adelete
 #define save_destructor                Perl_save_destructor
 #define save_destructor_x      Perl_save_destructor_x
 #define save_generic_svref     Perl_save_generic_svref
@@ -3123,6 +3124,7 @@
 #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_adelete(a,b)      Perl_save_adelete(aTHX_ a,b)
 #define save_destructor(a,b)   Perl_save_destructor(aTHX_ a,b)
 #define save_destructor_x(a,b) Perl_save_destructor_x(aTHX_ a,b)
 #ifdef PERL_CORE

diff --git a/global.sym b/global.sym
index 5ec7ba3..0b21dcd 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -440,6 +440,7 @@ Perl_save_ary
 Perl_save_bool
 Perl_save_clearsv
 Perl_save_delete
+Perl_save_adelete
 Perl_save_destructor
 Perl_save_destructor_x
 Perl_save_freesv

diff --git a/proto.h b/proto.h
index 1313b31..ffbc9fb 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2781,6 +2781,11 @@ 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_adelete(pTHX_ AV *av, I32 key)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_SAVE_ADELETE  \
+       assert(av)
+
 PERL_CALLCONV void     Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
                        __attribute__nonnull__(pTHX_2);
 #define PERL_ARGS_ASSERT_SAVE_DESTRUCTOR       \

diff --git a/scope.c b/scope.c
index cad14de..20e027f 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -509,6 +509,17 @@ Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
 }
 
 void
+Perl_save_adelete(pTHX_ AV *av, I32 key)
+{
+    dVAR;
+
+    PERL_ARGS_ASSERT_SAVE_ADELETE;
+
+    SvREFCNT_inc_void(av);
+    save_pushi32ptr(key, av, SAVEt_ADELETE);
+}
+
+void
 Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p)
 {
     dVAR;
@@ -864,6 +875,13 @@ Perl_leave_scope(pTHX_ I32 base)
            SvREFCNT_dec(hv);
            Safefree(ptr);
            break;
+       case SAVEt_ADELETE:
+           ptr = SSPOPPTR;
+           av = MUTABLE_AV(ptr);
+           i = SSPOPINT;
+           (void)av_delete(av, i, G_DISCARD);
+           SvREFCNT_dec(av);
+           break;
        case SAVEt_DESTRUCTOR_X:
            ptr = SSPOPPTR;
            (*SSPOPDXPTR)(aTHX_ ptr);

diff --git a/scope.h b/scope.h
index 70b7165..97e0d7a 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -54,6 +54,7 @@
 #define SAVEt_COMPILE_WARNINGS 43
 #define SAVEt_STACK_CXPOS      44
 #define SAVEt_PARSER           45
+#define SAVEt_ADELETE          46
 
 #define SAVEf_SETMAGIC         1
 
@@ -142,6 +143,8 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 #define SAVESETSVFLAGS(sv,mask,val)    save_set_svflags(sv,mask,val)
 #define SAVEDELETE(h,k,l) \
          save_delete(MUTABLE_HV(h), (char*)(k), (I32)(l))
+#define SAVEADELETE(a,k) \
+         save_adelete(MUTABLE_AV(a), (I32)(k))
 #define SAVEDESTRUCTOR(f,p) \
          save_destructor((DESTRUCTORFUNC_NOCONTEXT_t)(f), (void*)(p))