This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Flag ops that are on the savestack
[perl5.git] / scope.h
diff --git a/scope.h b/scope.h
index 7bda4c8..f8df5b4 100644 (file)
--- a/scope.h
+++ b/scope.h
 #define SAVEt_BOOL             38
 #define SAVEt_SET_SVFLAGS      39
 #define SAVEt_SAVESWITCHSTACK  40
-#define SAVEt_COP_ARYBASE      41
 #define SAVEt_RE_STATE         42
 #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)
@@ -71,6 +78,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))
@@ -78,6 +86,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)
@@ -99,6 +108,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
 */
 
@@ -116,9 +139,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)
 
@@ -128,7 +170,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))
@@ -142,8 +184,11 @@ 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) \
@@ -156,7 +201,7 @@ 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()
@@ -172,8 +217,6 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
        PL_curstackinfo->si_stack = (t);                \
     } 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,
@@ -186,19 +229,18 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
         SSCHECK(3);                               \
         SSPUSHINT(cxstack[cxstack_ix].blk_oldsp); \
         SSPUSHINT(cxstack_ix);                    \
-        SSPUSHINT(SAVEt_STACK_CXPOS);             \
+        SSPUSHUV(SAVEt_STACK_CXPOS);              \
     } STMT_END
 
 #define SAVEPARSER(p) save_pushptr((p), SAVEt_PARSER)
 
 #ifdef USE_ITHREADS
-#  define SAVECOPSTASH(c)      SAVEPPTR(CopSTASHPV(c))
-#  define SAVECOPSTASH_FREE(c) SAVESHAREDPV(CopSTASHPV(c))
+#  define SAVECOPSTASH_FREE(c) SAVEIV((c)->cop_stashoff)
 #  define SAVECOPFILE(c)       SAVEPPTR(CopFILE(c))
 #  define SAVECOPFILE_FREE(c)  SAVESHAREDPV(CopFILE(c))
 #else
-#  define SAVECOPSTASH(c)      SAVESPTR(CopSTASH(c))
-#  define SAVECOPSTASH_FREE(c) SAVECOPSTASH(c) /* XXX not refcounted */
+#  /* XXX not refcounted */
+#  define SAVECOPSTASH_FREE(c) SAVESPTR(CopSTASH(c))
 #  define SAVECOPFILE(c)       SAVESPTR(CopFILEGV(c))
 #  define SAVECOPFILE_FREE(c)  SAVEGENERICSV(CopFILEGV(c))
 #endif
@@ -210,7 +252,7 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
  * pointer would get broken if the savestack is moved on reallocation.
  * SSNEWa() works like SSNEW(), but also aligns the data to the specified
  * number of bytes.  MEM_ALIGNBYTES is perhaps the most useful.  The
- * alignment will be preserved therough savestack reallocation *only* if
+ * alignment will be preserved through savestack reallocation *only* if
  * realloc returns data aligned to a size divisible by "align"!
  *
  * SSPTR() converts the index returned by SSNEW/SSNEWa() into a pointer.
@@ -227,7 +269,21 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
 
 #define save_freesv(op)                save_pushptr((void *)(op), SAVEt_FREESV)
 #define save_mortalizesv(op)   save_pushptr((void *)(op), SAVEt_MORTALIZESV)
-#define save_freeop(op)                save_pushptr((void *)(op), SAVEt_FREEOP)
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
+# define save_freeop(op)                    \
+    ({                                       \
+      OP * const _o = (OP *)(op);             \
+      _o->op_savefree = 1;                     \
+      save_pushptr((void *)(_o), SAVEt_FREEOP); \
+    })
+#else
+# define save_freeop(op)                       \
+    (                                           \
+      PL_Xpv = (XPV *)(op),                      \
+      ((OP *)PL_Xpv)->op_savefree = 1,            \
+      save_pushptr((void *)(PL_Xpv), SAVEt_FREEOP) \
+    )
+#endif
 #define save_freepv(pv)                save_pushptr((void *)(pv), SAVEt_FREEPV)
 #define save_op()              save_pushptr((void *)(PL_op), SAVEt_OP)
 
@@ -235,8 +291,8 @@ Closing bracket on a callback.  See C<ENTER> and L<perlcall>.
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */