Introduce save_hdelete() and SAVEHDELETE()

save_hdelete() is just like save_delete() except that it takes an SV instead of  char buffer.

diff --git a/embed.fnc b/embed.fnc
index bfc9425..f1db823 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -890,6 +890,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_hdelete   |NN HV *hv|NN SV *keysv
 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

diff --git a/embed.h b/embed.h
index b602464..dd7f269 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_hdelete           Perl_save_hdelete
 #define save_adelete           Perl_save_adelete
 #define save_destructor                Perl_save_destructor
 #define save_destructor_x      Perl_save_destructor_x
@@ -3118,6 +3119,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_hdelete(a,b)      Perl_save_hdelete(aTHX_ a,b)
 #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)

diff --git a/global.sym b/global.sym
index 73bf5be..de14a7b 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_hdelete
 Perl_save_adelete
 Perl_save_destructor
 Perl_save_destructor_x

diff --git a/proto.h b/proto.h
index 77464c5..61805f6 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2783,6 +2783,12 @@ 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_hdelete(pTHX_ HV *hv, SV *keysv)
+                       __attribute__nonnull__(pTHX_1)
+                       __attribute__nonnull__(pTHX_2);
+#define PERL_ARGS_ASSERT_SAVE_HDELETE  \
+       assert(hv); assert(keysv)
+
 PERL_CALLCONV void     Perl_save_adelete(pTHX_ AV *av, I32 key)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_SAVE_ADELETE  \

diff --git a/scope.c b/scope.c
index 5aaf5de..50798e4 100644 (file)
--- a/scope.c
+++ b/scope.c
@@ -514,6 +514,21 @@ Perl_save_delete(pTHX_ HV *hv, char *key, I32 klen)
 }
 
 void
+Perl_save_hdelete(pTHX_ HV *hv, SV *keysv)
+{
+    STRLEN len;
+    I32 klen;
+    const char *key;
+
+    PERL_ARGS_ASSERT_SAVE_HDELETE;
+
+    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);
+}
+
+void
 Perl_save_adelete(pTHX_ AV *av, I32 key)
 {
     dVAR;

diff --git a/scope.h b/scope.h
index 77a389d..7517798 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -145,6 +145,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 SAVEHDELETE(h,s) \
+         save_hdelete(MUTABLE_HV(h), (s))
 #define SAVEADELETE(a,k) \
          save_adelete(MUTABLE_AV(a), (I32)(k))
 #define SAVEDESTRUCTOR(f,p) \