This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
op.h: Restrict scope of multiconcat symbols to core
[perl5.git] / op.h
diff --git a/op.h b/op.h
index 4a544d9..be19303 100644 (file)
--- a/op.h
+++ b/op.h
@@ -24,7 +24,7 @@
  *                      !op_slabbed.
  *     op_savefree     on savestack via SAVEFREEOP
  *     op_folded       Result/remainder of a constant fold operation.
- *     op_moresib      this op is is not the last sibling
+ *     op_moresib      this op is not the last sibling
  *     op_spare        One spare bit
  *     op_flags        Flags common to all operations.  See OPf_* below.
  *     op_private      Flags peculiar to a particular operation (BUT,
@@ -70,14 +70,14 @@ typedef PERL_BITFIELD16 Optype;
 #define OP_GIMME_REVERSE(flags)        ((flags) & G_WANT)
 
 /*
-=head1 "Gimme" Values
+=for apidoc_section $callback
 
 =for apidoc Amn|U32|GIMME_V
 The XSUB-writer's equivalent to Perl's C<wantarray>.  Returns C<G_VOID>,
 C<G_SCALAR> or C<G_ARRAY> for void, scalar or list context,
 respectively.  See L<perlcall> for a usage example.
 
-=for apidoc Amn|U32|GIMME
+=for apidoc AmnD|U32|GIMME
 A backward-compatible version of C<GIMME_V> which can only return
 C<G_SCALAR> or C<G_ARRAY>; in a void context, it returns C<G_SCALAR>.
 Deprecated.  Use C<GIMME_V> instead.
@@ -181,7 +181,7 @@ Deprecated.  Use C<GIMME_V> instead.
 
 
 /* things that can be elements of op_aux */
-typedef union  {
+typedef union {
     PADOFFSET pad_offset;
     SV        *sv;
     IV        iv;
@@ -372,6 +372,10 @@ struct pmop {
 #define PMf_IS_QR      (1U<<(PMf_BASE_SHIFT+15))
 #define PMf_USE_RE_EVAL        (1U<<(PMf_BASE_SHIFT+16)) /* use re'eval' in scope */
 
+/* Means that this is a subpattern being compiled while processing a \p{}
+ * wildcard.  This isn't called from op.c, but it is passed as a pm flag. */
+#define PMf_WILDCARD    (1U<<(PMf_BASE_SHIFT+17))
+
 /* See comments at the beginning of these defines about adding bits.  The
  * highest bit position should be used, so that if PMf_BASE_SHIFT gets
  * increased, the #error below will be triggered so that you will be reminded
@@ -392,7 +396,7 @@ struct pmop {
 #else
 #  define PmopSTASH(o)                                                 \
     (((o)->op_pmflags & PMf_ONCE) ? (o)->op_pmstashstartu.op_pmstash : NULL)
-#  if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
+#  if defined (DEBUGGING) && defined(PERL_USE_GCC_BRACE_GROUPS)
 #    define PmopSTASH_set(o,hv)                ({                              \
        assert((o)->op_pmflags & PMf_ONCE);                             \
        ((o)->op_pmstashstartu.op_pmstash = (hv));                      \
@@ -635,7 +639,7 @@ typedef struct {
 
 
 /*
-=head1 Optree Manipulation Functions
+=for apidoc_section $optree_manipulation
 
 =for apidoc Am|OP*|LINKLIST|OP *o
 Given the root of an optree, link the tree in execution order using the
@@ -699,8 +703,9 @@ struct opslot {
 struct opslab {
     OPSLAB *   opslab_next;            /* next slab */
     OPSLAB *   opslab_head;            /* first slab in chain */
-    OP *       opslab_freed;           /* chain of freed ops (head only)*/
+    OP **      opslab_freed;           /* array of sized chains of freed ops (head only)*/
     size_t     opslab_refcnt;          /* number of ops (head slab only) */
+    U16         opslab_freed_size;      /* allocated size of opslab_freed */
     U16                opslab_size;            /* size of slab in pointers,
                                            including header */
     U16         opslab_free_space;     /* space available in this slab
@@ -713,13 +718,18 @@ struct opslab {
 };
 
 # 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))
 
+/* the slab that owns this op */
+# define OpMySLAB(o) \
+    ((OPSLAB*)((char *)((I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset)-STRUCT_OFFSET(struct opslab, opslab_slots)))
 /* the first (head) opslab of the chain in which this op is allocated */
 # define OpSLAB(o) \
-    (((OPSLAB*)( (I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset))->opslab_head)
+    (OpMySLAB(o)->opslab_head)
+/* calculate the slot given the owner slab and an offset */
+#define OpSLOToff(slab, offset) \
+    ((OPSLOT*)(((I32 **)&(slab)->opslab_slots)+(offset)))
 
 # define OpslabREFCNT_dec(slab)      \
        (((slab)->opslab_refcnt == 1) \
@@ -741,7 +751,7 @@ struct block_hooks {
 };
 
 /*
-=head1 Compile-time scope hooks
+=for apidoc_section $scope
 
 =for apidoc mx|U32|BhkFLAGS|BHK *hk
 Return the BHK's flags.
@@ -806,7 +816,7 @@ preprocessing token; the type of C<arg> depends on C<which>.
     STMT_START { \
        if (PL_blockhooks) { \
            SSize_t i; \
-           for (i = av_tindex(PL_blockhooks); i >= 0; i--) { \
+           for (i = av_top_index(PL_blockhooks); i >= 0; i--) { \
                SV *sv = AvARRAY(PL_blockhooks)[i]; \
                BHK *hk; \
                \
@@ -827,7 +837,7 @@ preprocessing token; the type of C<arg> depends on C<which>.
 #define RV2CVOPCV_MARK_EARLY     0x00000001
 #define RV2CVOPCV_RETURN_NAME_GV 0x00000002
 #define RV2CVOPCV_RETURN_STUB    0x00000004
-#ifdef PERL_CORE /* behaviour of this flag is subject to change: */
+#if defined(PERL_CORE) || defined(PERL_EXT) /* behaviour of this flag is subject to change: */
 # define RV2CVOPCV_MAYBE_NAME_GV  0x00000008
 #endif
 #define RV2CVOPCV_FLAG_MASK      0x0000000f /* all of the above */
@@ -839,7 +849,7 @@ preprocessing token; the type of C<arg> depends on C<which>.
 #define OP_LVALUE_NO_CROAK 1
 
 /*
-=head1 Custom Operators
+=for apidoc_section $custom
 
 =for apidoc Am|U32|XopFLAGS|XOP *xop
 Return the XOP's flags.
@@ -849,7 +859,7 @@ Return a member of the XOP structure.  C<which> is a cpp token
 indicating which entry to return.  If the member is not set
 this will return a default value.  The return type depends
 on C<which>.  This macro evaluates its arguments more than
-once.  If you are using C<Perl_custom_op_xop> to retreive a
+once.  If you are using C<Perl_custom_op_xop> to retrieve a
 C<XOP *> from a C<OP *>, use the more efficient L</XopENTRYCUSTOM> instead.
 
 =for apidoc Am||XopENTRYCUSTOM|const OP *o|which
@@ -935,7 +945,7 @@ typedef enum {
     (Perl_custom_op_get_field(x, XOPe_xop_ptr).xop_ptr)
 
 /*
-=head1 Optree Manipulation Functions
+=for apidoc_section $optree_manipulation
 
 =for apidoc Am|const char *|OP_NAME|OP *o
 Return the name of the provided OP.  For core ops this looks up the name
@@ -1049,10 +1059,6 @@ C<sib> is non-null. For a higher-level interface, see C<L</op_sibling_splice>>.
 #define newATTRSUB(f, o, p, a, b) Perl_newATTRSUB_x(aTHX_  f, o, p, a, b, FALSE)
 #define newSUB(f, o, p, b)     newATTRSUB((f), (o), (p), NULL, (b))
 
-/*
-=head1 Hook manipulation
-*/
-
 #ifdef USE_ITHREADS
 #  define OP_CHECK_MUTEX_INIT          MUTEX_INIT(&PL_check_mutex)
 #  define OP_CHECK_MUTEX_LOCK          MUTEX_LOCK(&PL_check_mutex)
@@ -1066,6 +1072,8 @@ C<sib> is non-null. For a higher-level interface, see C<L</op_sibling_splice>>.
 #endif
 
 
+#if defined(PERL_CORE) || defined(PERL_EXT)
+
 /* Stuff for OP_MULTDEREF/pp_multideref. */
 
 /* actions */
@@ -1105,6 +1113,8 @@ C<sib> is non-null. For a higher-level interface, see C<L</op_sibling_splice>>.
 #define MDEREF_MASK         0x7F
 #define MDEREF_SHIFT           7
 
+#endif  /* end CORE/EXT only */
+
 #if defined(PERL_IN_DOOP_C) || defined(PERL_IN_PP_C)
 #   define FATAL_ABOVE_FF_MSG                                       \
       "Use of strings with code points over 0xFF as arguments to "  \
@@ -1125,7 +1135,7 @@ C<sib> is non-null. For a higher-level interface, see C<L</op_sibling_splice>>.
 
 /* stuff for OP_ARGCHECK */
 
-struct  op_argcheck_aux {
+struct op_argcheck_aux {
     UV   params;     /* number of positional parameters */
     UV   opt_params; /* number of optional positional parameters */
     char slurpy;     /* presence of slurpy: may be '\0', '@' or '%' */