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
authorFather Chrysostomos <sprout@cpan.org>
Sat, 23 Jun 2012 16:48:34 +0000 (09:48 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 29 Jun 2012 07:20:55 +0000 (00:20 -0700)
This is to allow future commits to free dangling ops after errors.

If an op is on the savestack, then it is going to be freed by scope.c,
and op_free must not be called on it by anyone else.

So we flag such ops new.

op.h
scope.h

diff --git a/op.h b/op.h
index 7be9bf5..7e20c70 100644 (file)
--- a/op.h
+++ b/op.h
@@ -28,8 +28,9 @@
  *                     the op may be safely op_free()d multiple times
  *     op_latefreed    an op_latefree op has been op_free()d
  *     op_attached     this op (sub)tree has been attached to a CV
+ *     op_savefree     on savestack via SAVEFREEOP
  *
- *     op_spare        three spare bits!
+ *     op_spare        two spare bits!
  *     op_flags        Flags common to all operations.  See OPf_* below.
  *     op_private      Flags peculiar to a particular operation (BUT,
  *                     by default, set to the number of children until
@@ -62,7 +63,8 @@ typedef PERL_BITFIELD16 Optype;
     PERL_BITFIELD16 op_latefree:1;     \
     PERL_BITFIELD16 op_latefreed:1;    \
     PERL_BITFIELD16 op_attached:1;     \
-    PERL_BITFIELD16 op_spare:3;                \
+    PERL_BITFIELD16 op_savefree:1;     \
+    PERL_BITFIELD16 op_spare:2;                \
     U8         op_flags;               \
     U8         op_private;
 #endif
diff --git a/scope.h b/scope.h
index 74ebed9..f8df5b4 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -269,7 +269,21 @@ scope has the given name. Name must be a literal string.
 
 #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)