X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a5ae69f0baa6e5bcbc8ca09d9e0c16b89ca0fdae..44a07e3eb40e7f824e3f24bfa890532fa8ded63c:/op.h

diff --git a/op.h b/op.h
index 7be9bf5..210521e 100644
--- a/op.h
+++ b/op.h
@@ -19,17 +19,11 @@
  *	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_static	tell op_free() to skip PerlMemShared_free(), when
+ *                      !op_slabbed.
+ *	op_savefree	on savestack via SAVEFREEOP
+ *	op_spare	Three 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,9 +53,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_slabbed:1;	\
+    PERL_BITFIELD16 op_savefree:1;	\
+    PERL_BITFIELD16 op_static:1;	\
     PERL_BITFIELD16 op_spare:3;		\
     U8		op_flags;		\
     U8		op_private;
@@ -72,11 +66,9 @@ typedef PERL_BITFIELD16 Optype;
    then all the other bit-fields before/after it should change their
    types too to let VC pack them into the same 4 byte integer.*/
 
+/* for efficiency, requires OPf_WANT_VOID == G_VOID etc */
 #define OP_GIMME(op,dfl) \
-	(((op)->op_flags & OPf_WANT) == OPf_WANT_VOID   ? G_VOID   : \
-	 ((op)->op_flags & OPf_WANT) == OPf_WANT_SCALAR ? G_SCALAR : \
-	 ((op)->op_flags & OPf_WANT) == OPf_WANT_LIST   ? G_ARRAY   : \
-	 dfl)
+	(((op)->op_flags & OPf_WANT) ? ((op)->op_flags & OPf_WANT) : dfl)
 
 #define OP_GIMME_REVERSE(flags)	((flags) & G_WANT)
 
@@ -123,7 +115,7 @@ Deprecated.  Use C<GIMME_V> instead.
 				/*  On OP_ENTERSUB || OP_NULL, saw a "do". */
 				/*  On OP_EXISTS, treat av as av, not avhv.  */
 				/*  On OP_(ENTER|LEAVE)EVAL, don't clear $@ */
-				/*  On pushre, rx is used as part of split, e.g. split " " */
+				/*  On OP_SPLIT, special split " " */
 				/*  On regcomp, "use re 'eval'" was in scope */
 				/*  On OP_READLINE, was <$filehandle> */
 				/*  On RV2[ACGHS]V, don't create GV--in
@@ -148,6 +140,7 @@ Deprecated.  Use C<GIMME_V> instead.
 				    - Before ck_glob, called as CORE::glob
 				    - After ck_glob, use Perl glob function
 			         */
+                                /*  On OP_PADRANGE, push @_ */
 
 /* old names; don't use in new code, but don't break them, either */
 #define OPf_LIST	OPf_WANT_LIST
@@ -230,6 +223,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 */
@@ -238,6 +236,11 @@ Deprecated.  Use C<GIMME_V> instead.
 #define OPpPAD_STATE		16	/* is a "state" pad */
   /* for OP_RV2?V, lower bits carry hints (currently only HINT_STRICT_REFS) */
 
+  /* OP_PADRANGE only */
+  /* bit 7 is OPpLVAL_INTRO */
+#define OPpPADRANGE_COUNTMASK	127	/* bits 6..0 hold target range, */
+#define OPpPADRANGE_COUNTSHIFT	7	/* 7 bits in total */
+
   /* OP_RV2GV only */
 #define OPpDONT_INIT_GV		4	/* Call gv_fetchpv with GV_NOINIT */
 /* (Therefore will return whatever is currently in the symbol table, not
@@ -254,6 +257,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. */
@@ -411,9 +415,6 @@ struct pmop {
  * OP_MATCH and OP_QR */
 #define PMf_ONCE	(1<<(PMf_BASE_SHIFT+1))
 
-/* replacement contains variables */
-#define PMf_MAYBE_CONST (1<<(PMf_BASE_SHIFT+2))
-
 /* PMf_ONCE has matched successfully.  Not used under threading. */
 #define PMf_USED        (1<<(PMf_BASE_SHIFT+3))
 
@@ -708,19 +709,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 {