This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add SAVEFREECOPHH()
[perl5.git] / scope.h
diff --git a/scope.h b/scope.h
index e910388..7ebd52a 100644 (file)
--- a/scope.h
+++ b/scope.h
 #define SAVEt_COMPILE_WARNINGS 43
 #define SAVEt_STACK_CXPOS      44
 #define SAVEt_PARSER           45
+#define SAVEt_ADELETE          46
+#define SAVEt_I32_SMALL                47
+#define SAVEt_INT_SMALL                48
+#define SAVEt_GVSV             49
+#define SAVEt_FREECOPHH                50
 
 #define SAVEf_SETMAGIC         1
+#define SAVEf_KEEPOLDELEM      2
 
+#define SAVE_TIGHT_SHIFT       6
+#define SAVE_MASK              0x3F
+
+#define save_aelem(av,idx,sptr)        save_aelem_flags(av,idx,sptr,SAVEf_SETMAGIC)
 #define save_helem(hv,key,sptr)        save_helem_flags(hv,key,sptr,SAVEf_SETMAGIC)
 
 #ifndef SCOPE_SAVES_SIGNAL_MASK
@@ -69,6 +79,7 @@
 #define SSPUSHLONG(i) (PL_savestack[PL_savestack_ix++].any_long = (long)(i))
 #define SSPUSHBOOL(p) (PL_savestack[PL_savestack_ix++].any_bool = (p))
 #define SSPUSHIV(i) (PL_savestack[PL_savestack_ix++].any_iv = (IV)(i))
+#define SSPUSHUV(u) (PL_savestack[PL_savestack_ix++].any_uv = (UV)(u))
 #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))
@@ -76,6 +87,7 @@
 #define SSPOPLONG (PL_savestack[--PL_savestack_ix].any_long)
 #define SSPOPBOOL (PL_savestack[--PL_savestack_ix].any_bool)
 #define SSPOPIV (PL_savestack[--PL_savestack_ix].any_iv)
+#define SSPOPUV (PL_savestack[--PL_savestack_ix].any_uv)
 #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)
@@ -97,6 +109,20 @@ Opening bracket on a callback.  See C<LEAVE> and L<perlcall>.
 =for apidoc Ams||LEAVE
 Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 
+=over
+
+=item ENTER_with_name(name)
+
+Same as C<ENTER>, but when debugging is enabled it also associates the
+given literal string with the new scope.
+
+=item LEAVE_with_name(name)
+
+Same as C<LEAVE>, but when debugging is enabled it first checks that the
+scope has the given name. Name must be a literal string.
+
+=back
+
 =cut
 */
 
@@ -114,9 +140,28 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
        DEBUG_SCOPE("LEAVE")                                    \
        pop_scope();                                            \
     } STMT_END
+#define ENTER_with_name(name)                                          \
+    STMT_START {                                                       \
+       push_scope();                                                   \
+       if (PL_scopestack_name)                                         \
+           PL_scopestack_name[PL_scopestack_ix-1] = name;              \
+       DEBUG_SCOPE("ENTER \"" name "\"")                               \
+    } STMT_END
+#define LEAVE_with_name(name)                                          \
+    STMT_START {                                                       \
+       DEBUG_SCOPE("LEAVE \"" name "\"")                               \
+       if (PL_scopestack_name) {                                       \
+           assert(((char*)PL_scopestack_name[PL_scopestack_ix-1]       \
+                       == (char*)name)                                 \
+                   || strEQ(PL_scopestack_name[PL_scopestack_ix-1], name));        \
+       }                                                               \
+       pop_scope();                                                    \
+    } STMT_END
 #else
 #define ENTER push_scope()
 #define LEAVE pop_scope()
+#define ENTER_with_name(name) ENTER
+#define LEAVE_with_name(name) LEAVE
 #endif
 #define LEAVE_SCOPE(old) if (PL_savestack_ix > old) leave_scope(old)
 
@@ -126,7 +171,7 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 #define SAVEINT(i)     save_int((int*)&(i))
 #define SAVEIV(i)      save_iv((IV*)&(i))
 #define SAVELONG(l)    save_long((long*)&(l))
-#define SAVEBOOL(b)    save_bool((bool*)&(b))
+#define SAVEBOOL(b)    save_bool(&(b))
 #define SAVESPTR(s)    save_sptr((SV**)&(s))
 #define SAVEPPTR(s)    save_pptr((char**)&(s))
 #define SAVEVPTR(s)    save_vptr((void*)&(s))
@@ -140,8 +185,13 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 #define SAVEGENERICPV(s)       save_generic_pvref((char**)&(s))
 #define SAVESHAREDPV(s)                save_shared_pvref((char**)&(s))
 #define SAVESETSVFLAGS(sv,mask,val)    save_set_svflags(sv,mask,val)
+#define SAVEFREECOPHH(h)       save_pushptr((void *)(h), SAVEt_FREECOPHH)
 #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) \
          save_destructor((DESTRUCTORFUNC_NOCONTEXT_t)(f), (void*)(p))
 
@@ -152,79 +202,40 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
     STMT_START {                               \
        SSCHECK(2);                             \
        SSPUSHINT(PL_stack_sp - PL_stack_base); \
-       SSPUSHINT(SAVEt_STACK_POS);             \
+       SSPUSHUV(SAVEt_STACK_POS);              \
     } STMT_END
 
 #define SAVEOP()       save_op()
 
-#define SAVEHINTS() \
-    STMT_START {                                       \
-       SSCHECK(4);                                     \
-       if (PL_hints & HINT_LOCALIZE_HH) {              \
-           SSPUSHPTR(GvHV(PL_hintgv));                 \
-           GvHV(PL_hintgv) = Perl_hv_copy_hints_hv(aTHX_ GvHV(PL_hintgv)); \
-       }                                               \
-       if (PL_compiling.cop_hints_hash) {              \
-           HINTS_REFCNT_LOCK;                          \
-           PL_compiling.cop_hints_hash->refcounted_he_refcnt++;        \
-           HINTS_REFCNT_UNLOCK;                        \
-       }                                               \
-       SSPUSHPTR(PL_compiling.cop_hints_hash);         \
-       SSPUSHINT(PL_hints);                            \
-       SSPUSHINT(SAVEt_HINTS);                         \
-    } STMT_END
+#define SAVEHINTS()    save_hints()
 
-#define SAVECOMPPAD() \
-    STMT_START {                                               \
-       SSCHECK(2);                                             \
-       SSPUSHPTR(MUTABLE_SV(PL_comppad));                      \
-       SSPUSHINT(SAVEt_COMPPAD);                               \
-    } STMT_END
+#define SAVECOMPPAD() save_pushptr(MUTABLE_SV(PL_comppad), SAVEt_COMPPAD)
 
 #define SAVESWITCHSTACK(f,t) \
     STMT_START {                                       \
-       SSCHECK(3);                                     \
-       SSPUSHPTR(MUTABLE_SV(f));                       \
-       SSPUSHPTR(MUTABLE_SV(t));                       \
-       SSPUSHINT(SAVEt_SAVESWITCHSTACK);               \
+       save_pushptrptr(MUTABLE_SV(f), MUTABLE_SV(t), SAVEt_SAVESWITCHSTACK); \
        SWITCHSTACK((f),(t));                           \
        PL_curstackinfo->si_stack = (t);                \
     } STMT_END
 
-#define SAVECOPARYBASE(c) \
-    STMT_START {                                       \
-       SSCHECK(3);                                     \
-       SSPUSHINT(CopARYBASE_get(c));                   \
-       SSPUSHPTR(c);                                   \
-       SSPUSHINT(SAVEt_COP_ARYBASE);                   \
-    } STMT_END
+#define SAVECOPARYBASE(c) save_pushi32ptr(CopARYBASE_get(c), c, SAVEt_COP_ARYBASE);
 
 /* Need to do the cop warnings like this, rather than a "SAVEFREESHAREDPV",
    because realloc() means that the value can actually change. Possibly
    could have done savefreesharedpvREF, but this way actually seems cleaner,
    as it simplifies the code that does the saves, and reduces the load on the
    save stack.  */
-#define SAVECOMPILEWARNINGS() \
-    STMT_START {                                       \
-       SSCHECK(2);                                     \
-       SSPUSHPTR(PL_compiling.cop_warnings);           \
-       SSPUSHINT(SAVEt_COMPILE_WARNINGS);              \
-    } STMT_END
+#define SAVECOMPILEWARNINGS() save_pushptr(PL_compiling.cop_warnings, SAVEt_COMPILE_WARNINGS)
 
 #define SAVESTACK_CXPOS() \
     STMT_START {                                  \
         SSCHECK(3);                               \
         SSPUSHINT(cxstack[cxstack_ix].blk_oldsp); \
         SSPUSHINT(cxstack_ix);                    \
-        SSPUSHINT(SAVEt_STACK_CXPOS);             \
+        SSPUSHUV(SAVEt_STACK_CXPOS);              \
     } STMT_END
 
-#define SAVEPARSER(p) \
-    STMT_START {                                  \
-        SSCHECK(2);                               \
-        SSPUSHPTR(p);                            \
-        SSPUSHINT(SAVEt_PARSER);                 \
-    } STMT_END
+#define SAVEPARSER(p) save_pushptr((p), SAVEt_PARSER)
 
 #ifdef USE_ITHREADS
 #  define SAVECOPSTASH(c)      SAVEPPTR(CopSTASHPV(c))
@@ -254,7 +265,7 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 #define SSNEW(size)             Perl_save_alloc(aTHX_ (size), 0)
 #define SSNEWt(n,t)             SSNEW((n)*sizeof(t))
 #define SSNEWa(size,align)     Perl_save_alloc(aTHX_ (size), \
-    (align - ((int)((caddr_t)&PL_savestack[PL_savestack_ix]) % align)) % align)
+    (I32)(align - ((size_t)((caddr_t)&PL_savestack[PL_savestack_ix]) % align)) % align)
 #define SSNEWat(n,t,align)     SSNEWa((n)*sizeof(t), align)
 
 #define SSPTR(off,type)         ((type)  ((char*)PL_savestack + off))