This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
lexsub.t: Add test name, test override from another pkg
[perl5.git] / op.h
diff --git a/op.h b/op.h
index b7e8614..2bfaa0d 100644 (file)
--- a/op.h
+++ b/op.h
  *     op_type         The type of the operation.
  *     op_opt          Whether or not the op has been optimised by the
  *                     peephole optimiser.
- *
- *                     See the comments in S_clear_yystack() for more
- *                     details on the following three flags:
- *
- *     op_latefree     tell op_free() to clear this op (and free any kids)
- *                     but not yet deallocate the struct. This means that
- *                     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_spare        three spare bits!
+ *     op_slabbed      allocated via opslab
+ *     op_savefree     on savestack via SAVEFREEOP
+ *     op_spare        Four 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
@@ -59,10 +51,9 @@ typedef PERL_BITFIELD16 Optype;
     PADOFFSET  op_targ;                \
     PERL_BITFIELD16 op_type:9;         \
     PERL_BITFIELD16 op_opt:1;          \
-    PERL_BITFIELD16 op_latefree:1;     \
-    PERL_BITFIELD16 op_latefreed:1;    \
-    PERL_BITFIELD16 op_attached:1;     \
-    PERL_BITFIELD16 op_spare:3;                \
+    PERL_BITFIELD16 op_slabbed:1;      \
+    PERL_BITFIELD16 op_savefree:1;     \
+    PERL_BITFIELD16 op_spare:4;                \
     U8         op_flags;               \
     U8         op_private;
 #endif
@@ -230,6 +221,11 @@ Deprecated.  Use C<GIMME_V> instead.
   /* OP_RV2[AGH]V, OP_PAD[AH]V, OP_[AH]ELEM, OP_[AH]SLICE OP_AV2ARYLEN,
      OP_R?KEYS, OP_SUBSTR, OP_POS, OP_VEC */
 #define OPpMAYBE_LVSUB         8       /* We might be an lvalue to return */
+  /* OP_RV2HV and OP_PADHV */
+#define OPpTRUEBOOL            32      /* %hash in (%hash || $foo) in
+                                          void context */
+#define OPpMAYBE_TRUEBOOL      64      /* %hash in (%hash || $foo) where
+                                          cx is not known till run time */
 
   /* OP_SUBSTR only */
 #define OPpSUBSTR_REPL_FIRST   16      /* 1st arg is replacement string */
@@ -254,6 +250,7 @@ Deprecated.  Use C<GIMME_V> instead.
 #define        OPpCONST_STRICT         8       /* bareword subject to strict 'subs' */
 #define OPpCONST_ENTERED       16      /* Has been entered as symbol. */
 #define OPpCONST_BARE          64      /* Was a bare word (filehandle?). */
+#define OPpCONST_FOLDED                128     /* Result of constant folding */
 
 /* Private for OP_FLIP/FLOP */
 #define OPpFLIP_LINENUM                64      /* Range arg potentially a line num. */
@@ -445,8 +442,9 @@ struct pmop {
  * but the regex compilation API passes just the pm flags, not the op
  * itself */
 #define PMf_IS_QR      (1<<(PMf_BASE_SHIFT+12))
+#define PMf_USE_RE_EVAL        (1<<(PMf_BASE_SHIFT+13)) /* use re'eval' in scope */
 
-#if PMf_BASE_SHIFT+12 > 31
+#if PMf_BASE_SHIFT+13 > 31
 #   error Too many PMf_ bits used.  See above and regnodes.h for any spare in middle
 #endif
 
@@ -707,19 +705,66 @@ least an C<UNOP>.
 #include "reentr.h"
 #endif
 
-#if defined(PL_OP_SLAB_ALLOC)
 #define NewOp(m,var,c,type)    \
        (var = (type *) Perl_Slab_Alloc(aTHX_ c*sizeof(type)))
 #define NewOpSz(m,var,size)    \
        (var = (OP *) Perl_Slab_Alloc(aTHX_ size))
 #define FreeOp(p) Perl_Slab_Free(aTHX_ p)
-#else
-#define NewOp(m, var, c, type) \
-       (var = (MEM_WRAP_CHECK_(c,type) \
-        (type*)PerlMemShared_calloc(c, sizeof(type))))
-#define NewOpSz(m, var, size)  \
-       (var = (OP*)PerlMemShared_calloc(1, size))
-#define FreeOp(p) PerlMemShared_free(p)
+
+/*
+ * The per-CV op slabs consist of a header (the opslab struct) and a bunch
+ * of space for allocating op slots, each of which consists of two pointers
+ * followed by an op.  The first pointer points to the next op slot.  The
+ * second points to the slab.  At the end of the slab is a null pointer,
+ * so that slot->opslot_next - slot can be used to determine the size
+ * of the op.
+ *
+ * Each CV can have multiple slabs; opslab_next points to the next slab, to
+ * form a chain.  All bookkeeping is done on the first slab, which is where
+ * all the op slots point.
+ *
+ * Freed ops are marked as freed and attached to the freed chain
+ * via op_next pointers.
+ *
+ * When there is more than one slab, the second slab in the slab chain is
+ * assumed to be the one with free space available.  It is used when allo-
+ * cating an op if there are no freed ops available or big enough.
+ */
+
+#ifdef PERL_CORE
+struct opslot {
+    /* keep opslot_next first */
+    OPSLOT *   opslot_next;            /* next slot */
+    OPSLAB *   opslot_slab;            /* owner */
+    OP         opslot_op;              /* the op itself */
+};
+
+struct opslab {
+    OPSLOT *   opslab_first;           /* first op in this slab */
+    OPSLAB *   opslab_next;            /* next slab */
+    OP *       opslab_freed;           /* chain of freed ops */
+    size_t     opslab_refcnt;          /* number of ops */
+# ifdef PERL_DEBUG_READONLY_OPS
+    U16                opslab_size;            /* size of slab in pointers */
+    bool       opslab_readonly;
+# endif
+    OPSLOT     opslab_slots;           /* slots begin here */
+};
+
+# define OPSLOT_HEADER         STRUCT_OFFSET(OPSLOT, opslot_op)
+# define OPSLOT_HEADER_P       (OPSLOT_HEADER/sizeof(I32 *))
+# define OpSLOT(o)             (assert_(o->op_slabbed) \
+                                (OPSLOT *)(((char *)o)-OPSLOT_HEADER))
+# define OpSLAB(o)             OpSLOT(o)->opslot_slab
+# define OpslabREFCNT_dec(slab)      \
+       (((slab)->opslab_refcnt == 1) \
+        ? opslab_free_nopad(slab)     \
+        : (void)--(slab)->opslab_refcnt)
+  /* Variant that does not null out the pads */
+# define OpslabREFCNT_dec_padok(slab) \
+       (((slab)->opslab_refcnt == 1)  \
+        ? opslab_free(slab)            \
+        : (void)--(slab)->opslab_refcnt)
 #endif
 
 struct block_hooks {