X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/51a6867122da1f41a98aafc24aa8495668a1736d..f37b842aabb9fad0fb5fe0a4803f30c6ead59c74:/op.h diff --git a/op.h b/op.h index 2109891..2bfaa0d 100644 --- a/op.h +++ b/op.h @@ -19,23 +19,16 @@ * 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 * the operation is privatized by a check routine, * which may or may not check number of children). */ +#include "op_reg_common.h" #define OPCODE U16 @@ -53,15 +46,14 @@ typedef PERL_BITFIELD16 Optype; #define BASEOP \ OP* op_next; \ OP* op_sibling; \ - OP* (CPERLscope(*op_ppaddr))(pTHX); \ + OP* (*op_ppaddr)(pTHX); \ MADPROP_IN_BASEOP \ 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 @@ -85,7 +77,7 @@ typedef PERL_BITFIELD16 Optype; =for apidoc Amn|U32|GIMME_V The XSUB-writer's equivalent to Perl's C. Returns C, C or C for void, scalar or list context, -respectively. +respectively. See L for a usage example. =for apidoc Amn|U32|GIMME A backward-compatible version of C which can only return @@ -122,7 +114,6 @@ Deprecated. Use C 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 OP_ENTERITER, loop var is per-thread */ /* On pushre, rx is used as part of split, e.g. split " " */ /* On regcomp, "use re 'eval'" was in scope */ /* On OP_READLINE, was <$filehandle> */ @@ -130,17 +121,24 @@ Deprecated. Use C instead. defined()*/ /* On OP_DBSTATE, indicates breakpoint * (runtime property) */ - /* On OP_AELEMFAST, indiciates pad var */ /* On OP_REQUIRE, was seen as CORE::require */ - /* On OP_ENTERWHEN, there's no condition */ - /* On OP_BREAK, an implicit break */ + /* On OP_(ENTER|LEAVE)WHEN, there's + no condition */ /* On OP_SMARTMATCH, an implicit smartmatch */ /* On OP_ANONHASH and OP_ANONLIST, create a reference to the new anon hash or array */ - /* On OP_ENTER, store caller context */ /* On OP_HELEM and OP_HSLICE, localization will be followed by assignment, so do not wipe the target if it is special (e.g. a glob or a magic SV) */ + /* On OP_MATCH, OP_SUBST & OP_TRANS, the + operand of a logical or conditional + that was optimised away, so it should + not be bound via =~ */ + /* On OP_CONST, from a constant CV */ + /* On OP_GLOB, two meanings: + - Before ck_glob, called as CORE::glob + - After ck_glob, use Perl glob function + */ /* old names; don't use in new code, but don't break them, either */ #define OPf_LIST OPf_WANT_LIST @@ -153,12 +151,19 @@ Deprecated. Use C instead. : G_SCALAR) \ : dowantarray()) -/* NOTE: OP_NEXTSTATE and OP_DBSTATE (i.e. COPs) carry lower - * bits of PL_hints in op_private */ +/* Lower bits of op_private often carry the number of arguments, as + * set by newBINOP, newUNOP and ck_fun */ + +/* NOTE: OP_NEXTSTATE and OP_DBSTATE (i.e. COPs) carry NATIVE_HINTS + * in op_private */ /* Private for lvalues */ #define OPpLVAL_INTRO 128 /* Lvalue must be localized or lvalue sub */ +/* Private for OPs with TARGLEX */ + /* (lower bits may carry MAXARG) */ +#define OPpTARGET_MY 16 /* Target is PADMY. */ + /* Private for OP_LEAVE, OP_LEAVESUB, OP_LEAVESUBLV and OP_LEAVEWRITE */ #define OPpREFCOUNTED 64 /* op_targ carries a refcount */ @@ -169,7 +174,7 @@ Deprecated. Use C instead. #define OPpASSIGN_BACKWARDS 64 /* Left & right switched. */ #define OPpASSIGN_CV_TO_GV 128 /* Possible optimisation for constants. */ -/* Private for OP_MATCH and OP_SUBST{,CONST} */ +/* Private for OP_MATCH and OP_SUBST{,CONT} */ #define OPpRUNTIME 64 /* Pattern coming in on the stack */ /* Private for OP_TRANS */ @@ -191,22 +196,40 @@ Deprecated. Use C instead. #define OPpDEREF_AV 32 /* Want ref to AV. */ #define OPpDEREF_HV 64 /* Want ref to HV. */ #define OPpDEREF_SV (32|64) /* Want ref to SV. */ + /* OP_ENTERSUB only */ #define OPpENTERSUB_DB 16 /* Debug subroutine. */ -#define OPpENTERSUB_HASTARG 32 /* Called from OP tree. */ -#define OPpENTERSUB_NOMOD 64 /* Immune to mod() for :attrlist. */ - /* OP_ENTERSUB and OP_RV2CV only */ +#define OPpENTERSUB_HASTARG 4 /* Called from OP tree. */ +#define OPpENTERSUB_INARGS 1 /* Lval used as arg to a sub. */ +/* used by OPpDEREF (32|64) */ +/* used by HINT_STRICT_SUBS 2 */ + /* Mask for OP_ENTERSUB flags, the absence of which must be propagated + in dynamic context */ +#define OPpENTERSUB_LVAL_MASK (OPpLVAL_INTRO|OPpENTERSUB_INARGS) + + /* OP_RV2CV only */ #define OPpENTERSUB_AMPER 8 /* Used & form to call. */ #define OPpENTERSUB_NOPAREN 128 /* bare sub call (without parens) */ -#define OPpENTERSUB_INARGS 4 /* Lval used as arg to a sub. */ +#define OPpMAY_RETURN_CONSTANT 1 /* If a constant sub, return the constant */ + /* OP_GV only */ #define OPpEARLY_CV 32 /* foo() called before sub foo was parsed */ /* OP_?ELEM only */ #define OPpLVAL_DEFER 16 /* Defer creation of array/hash elem */ - /* OP_RV2?V, OP_GVSV, OP_ENTERITER only */ + /* OP_RV2[SAH]V, OP_GVSV, OP_ENTERITER only */ #define OPpOUR_INTRO 16 /* Variable was in an our() */ - /* OP_RV2[AGH]V, OP_PAD[AH]V, OP_[AH]ELEM */ + /* 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 */ + /* OP_PADSV only */ #define OPpPAD_STATE 16 /* is a "state" pad */ /* for OP_RV2?V, lower bits carry hints (currently only HINT_STRICT_REFS) */ @@ -215,13 +238,7 @@ Deprecated. Use C instead. #define OPpDONT_INIT_GV 4 /* Call gv_fetchpv with GV_NOINIT */ /* (Therefore will return whatever is currently in the symbol table, not guaranteed to be a PVGV) */ - - /* OP_RV2CV only */ -#define OPpMAY_RETURN_CONSTANT 1 /* If a constant sub, return the constant */ - -/* Private for OPs with TARGLEX */ - /* (lower bits may carry MAXARG) */ -#define OPpTARGET_MY 16 /* Target is PADMY. */ +#define OPpALLOW_FAKE 16 /* OK to return fake glob */ /* Private for OP_ENTERITER and OP_ITER */ #define OPpITER_REVERSED 4 /* for (reverse ...) */ @@ -230,11 +247,10 @@ Deprecated. Use C instead. /* Private for OP_CONST */ #define OPpCONST_NOVER 2 /* no 6; */ #define OPpCONST_SHORTCIRCUIT 4 /* eg the constant 5 in (5 || foo) */ -#define OPpCONST_STRICT 8 /* bearword subject to strict 'subs' */ +#define OPpCONST_STRICT 8 /* bareword subject to strict 'subs' */ #define OPpCONST_ENTERED 16 /* Has been entered as symbol. */ -#define OPpCONST_ARYBASE 32 /* Was a $[ translated to constant. */ #define OPpCONST_BARE 64 /* Was a bare word (filehandle?). */ -#define OPpCONST_WARNING 128 /* Was a $^W translated to constant. */ +#define OPpCONST_FOLDED 128 /* Result of constant folding */ /* Private for OP_FLIP/FLOP */ #define OPpFLIP_LINENUM 64 /* Range arg potentially a line num. */ @@ -273,14 +289,33 @@ Deprecated. Use C instead. /* Private for OP_FTXXX */ #define OPpFT_ACCESS 2 /* use filetest 'access' */ -#define OPpFT_STACKED 4 /* stacked filetest, as in "-f -x $f" */ +#define OPpFT_STACKED 4 /* stacked filetest, as "-f" in "-f -x $f" */ +#define OPpFT_STACKING 8 /* stacking filetest, as "-x" in "-f -x $f" */ +#define OPpFT_AFTER_t 16 /* previous op was -t */ /* Private for OP_(MAP|GREP)(WHILE|START) */ #define OPpGREP_LEX 2 /* iterate over lexical $_ */ /* Private for OP_ENTEREVAL */ #define OPpEVAL_HAS_HH 2 /* Does it have a copy of %^H */ +#define OPpEVAL_UNICODE 4 +#define OPpEVAL_BYTES 8 +#define OPpEVAL_COPHH 16 /* Construct %^H from cop hints */ +/* Private for OP_CALLER, OP_WANTARRAY and OP_RUNCV */ +#define OPpOFFBYONE 128 /* Treat caller(1) as caller(2) */ + +/* Private for OP_COREARGS */ +/* These must not conflict with OPpDONT_INIT_GV or OPpALLOW_FAKE. + See pp.c:S_rv2gv. */ +#define OPpCOREARGS_DEREF1 1 /* Arg 1 is a handle constructor */ +#define OPpCOREARGS_DEREF2 2 /* Arg 2 is a handle constructor */ +#define OPpCOREARGS_SCALARMOD 64 /* \$ rather than \[$@%*] */ +#define OPpCOREARGS_PUSHMARK 128 /* Call pp_pushmark */ + +/* Private for OP_(LAST|REDO|NEXT|GOTO|DUMP) */ +#define OPpPV_IS_UTF8 128 /* label is in UTF8 */ + struct op { BASEOP }; @@ -329,11 +364,15 @@ struct pmop { union { OP * op_pmreplstart; /* Only used in OP_SUBST */ #ifdef USE_ITHREADS - char * op_pmstashpv; /* Only used in OP_MATCH, with PMf_ONCE set */ + struct { + char * op_pmstashpv; /* Only used in OP_MATCH, with PMf_ONCE set */ + U32 op_pmstashflags; /* currently only SVf_UTF8 or 0 */ + } op_pmstashthr; #else HV * op_pmstash; #endif } op_pmstashstartu; + OP * op_code_list; /* list of (?{}) code blocks */ }; #ifdef USE_ITHREADS @@ -357,56 +396,82 @@ struct pmop { #define PM_SETRE(o,r) ((o)->op_pmregexp = (r)) #endif +/* Leave some space, so future bit allocations can go either in the shared or + * unshared area without affecting binary compatibility */ +#define PMf_BASE_SHIFT (_RXf_PMf_SHIFT_NEXT+6) -#define PMf_RETAINT 0x00000040 /* taint $1 etc. if target tainted */ -#define PMf_ONCE 0x00000080 /* match successfully only once per - reset, with related flag RXf_USED - in re->extflags holding state. - This is used only for ?? matches, - and only on OP_MATCH and OP_QR */ +/* 'use re "taint"' in scope: taint $1 etc. if target tainted */ +#define PMf_RETAINT (1<<(PMf_BASE_SHIFT+0)) -#define PMf_UNUSED 0x00000100 /* free for use */ -#define PMf_MAYBE_CONST 0x00000200 /* replacement contains variables */ +/* match successfully only once per reset, with related flag RXf_USED in + * re->extflags holding state. This is used only for ?? matches, and only on + * OP_MATCH and OP_QR */ +#define PMf_ONCE (1<<(PMf_BASE_SHIFT+1)) -#define PMf_USED 0x00000400 /* PMf_ONCE has matched successfully. - Not used under threading. */ +/* replacement contains variables */ +#define PMf_MAYBE_CONST (1<<(PMf_BASE_SHIFT+2)) -#define PMf_CONST 0x00000800 /* subst replacement is constant */ -#define PMf_KEEP 0x00001000 /* keep 1st runtime pattern forever */ -#define PMf_GLOBAL 0x00002000 /* pattern had a g modifier */ -#define PMf_CONTINUE 0x00004000 /* don't reset pos() if //g fails */ -#define PMf_EVAL 0x00008000 /* evaluating replacement as expr */ +/* PMf_ONCE has matched successfully. Not used under threading. */ +#define PMf_USED (1<<(PMf_BASE_SHIFT+3)) -/* The following flags have exact equivalents in regcomp.h with the prefix RXf_ - * which are stored in the regexp->extflags member. If you change them here, - * you have to change them there, and vice versa. - */ -#define PMf_MULTILINE 0x00000001 /* assume multiple lines */ -#define PMf_SINGLELINE 0x00000002 /* assume single line */ -#define PMf_FOLD 0x00000004 /* case insensitivity */ -#define PMf_EXTENDED 0x00000008 /* chuck embedded whitespace */ -#define PMf_KEEPCOPY 0x00000010 /* copy the string when matching */ -#define PMf_LOCALE 0x00000020 /* use locale for character types */ +/* subst replacement is constant */ +#define PMf_CONST (1<<(PMf_BASE_SHIFT+4)) -/* mask of bits that need to be transfered to re->extflags */ -#define PMf_COMPILETIME (PMf_MULTILINE|PMf_SINGLELINE|PMf_LOCALE|PMf_FOLD|PMf_EXTENDED|PMf_KEEPCOPY) +/* keep 1st runtime pattern forever */ +#define PMf_KEEP (1<<(PMf_BASE_SHIFT+5)) + +#define PMf_GLOBAL (1<<(PMf_BASE_SHIFT+6)) /* pattern had a g modifier */ + +/* don't reset pos() if //g fails */ +#define PMf_CONTINUE (1<<(PMf_BASE_SHIFT+7)) + +/* evaluating replacement as expr */ +#define PMf_EVAL (1<<(PMf_BASE_SHIFT+8)) + +/* Return substituted string instead of modifying it. */ +#define PMf_NONDESTRUCT (1<<(PMf_BASE_SHIFT+9)) + +/* the pattern has a CV attached (currently only under qr/...(?{}).../) */ +#define PMf_HAS_CV (1<<(PMf_BASE_SHIFT+10)) + +/* op_code_list is private; don't free it etc. It may well point to + * code within another sub, with different pad etc */ +#define PMf_CODELIST_PRIVATE (1<<(PMf_BASE_SHIFT+11)) + +/* the PMOP is a QR (we should be able to detect that from the op type, + * 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+13 > 31 +# error Too many PMf_ bits used. See above and regnodes.h for any spare in middle +#endif #ifdef USE_ITHREADS # define PmopSTASHPV(o) \ - (((o)->op_pmflags & PMf_ONCE) ? (o)->op_pmstashstartu.op_pmstashpv : NULL) + (((o)->op_pmflags & PMf_ONCE) ? (o)->op_pmstashstartu.op_pmstashthr.op_pmstashpv : NULL) # if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) # define PmopSTASHPV_set(o,pv) ({ \ assert((o)->op_pmflags & PMf_ONCE); \ - ((o)->op_pmstashstartu.op_pmstashpv = savesharedpv(pv)); \ + ((o)->op_pmstashstartu.op_pmstashthr.op_pmstashpv = savesharedpv(pv)); \ }) # else # define PmopSTASHPV_set(o,pv) \ - ((o)->op_pmstashstartu.op_pmstashpv = savesharedpv(pv)) + ((o)->op_pmstashstartu.op_pmstashthr.op_pmstashpv = savesharedpv(pv)) # endif -# define PmopSTASH(o) (PmopSTASHPV(o) \ - ? gv_stashpv((o)->op_pmstashstartu.op_pmstashpv,GV_ADD) : NULL) -# define PmopSTASH_set(o,hv) PmopSTASHPV_set(o, ((hv) ? HvNAME_get(hv) : NULL)) +# define PmopSTASH_flags(o) ((o)->op_pmstashstartu.op_pmstashthr.op_pmstashflags) +# define PmopSTASH_flags_set(o,flags) ((o)->op_pmstashstartu.op_pmstashthr.op_pmstashflags = flags) +# define PmopSTASH(o) (PmopSTASHPV(o) \ + ? gv_stashpv((o)->op_pmstashstartu.op_pmstashthr.op_pmstashpv, \ + GV_ADD | PmopSTASH_flags(o)) : NULL) +# define PmopSTASH_set(o,hv) (PmopSTASHPV_set(o, (hv) ? HvNAME_get(hv) : NULL), \ + PmopSTASH_flags_set(o, \ + ((hv) && HvNAME_HEK(hv) && \ + HvNAMEUTF8(hv)) \ + ? SVf_UTF8 \ + : 0)) # define PmopSTASH_free(o) PerlMemShared_free(PmopSTASHPV(o)) #else @@ -525,19 +590,18 @@ struct loop { # define Nullop ((OP*)NULL) #endif -/* Lowest byte-and-a-bit of PL_opargs */ +/* Lowest byte of PL_opargs */ #define OA_MARK 1 #define OA_FOLDCONST 2 #define OA_RETSCALAR 4 #define OA_TARGET 8 -#define OA_RETINTEGER 16 +#define OA_TARGLEX 16 #define OA_OTHERINT 32 #define OA_DANGEROUS 64 #define OA_DEFGV 128 -#define OA_TARGLEX 256 /* The next 4 bits encode op class information */ -#define OCSHIFT 9 +#define OCSHIFT 8 #define OA_CLASS_MASK (15 << OCSHIFT) @@ -556,7 +620,7 @@ struct loop { #define OA_FILESTATOP (12 << OCSHIFT) #define OA_LOOPEXOP (13 << OCSHIFT) -#define OASHIFT 13 +#define OASHIFT 12 /* Remaining nybbles of PL_opargs */ #define OA_SCALAR 1 @@ -612,10 +676,25 @@ struct loop { #define ref(o, type) doref(o, type, TRUE) #endif +/* +=head1 Optree Manipulation Functions + +=for apidoc Am|OP*|LINKLIST|OP *o +Given the root of an optree, link the tree in execution order using the +C pointers and return the first op executed. If this has +already been done, it will not be redone, and C<< o->op_next >> will be +returned. If C<< o->op_next >> is not already set, I should be at +least an C. + +=cut +*/ + +#define LINKLIST(o) ((o)->op_next ? (o)->op_next : op_linklist((OP*)o)) + /* no longer used anywhere in core */ #ifndef PERL_CORE #define cv_ckproto(cv, gv, p) \ - cv_ckproto_len((cv), (gv), (p), (p) ? strlen(p) : 0) + cv_ckproto_len_flags((cv), (gv), (p), (p) ? strlen(p) : 0, 0) #endif #ifdef PERL_CORE @@ -626,21 +705,263 @@ struct loop { #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 { + U32 bhk_flags; + void (*bhk_start) (pTHX_ int full); + void (*bhk_pre_end) (pTHX_ OP **seq); + void (*bhk_post_end) (pTHX_ OP **seq); + void (*bhk_eval) (pTHX_ OP *const saveop); +}; + +/* +=head1 Compile-time scope hooks + +=for apidoc mx|U32|BhkFLAGS|BHK *hk +Return the BHK's flags. + +=for apidoc mx|void *|BhkENTRY|BHK *hk|which +Return an entry from the BHK structure. I is a preprocessor token +indicating which entry to return. If the appropriate flag is not set +this will return NULL. The type of the return value depends on which +entry you ask for. + +=for apidoc Amx|void|BhkENTRY_set|BHK *hk|which|void *ptr +Set an entry in the BHK structure, and set the flags to indicate it is +valid. I is a preprocessing token indicating which entry to set. +The type of I depends on the entry. + +=for apidoc Amx|void|BhkDISABLE|BHK *hk|which +Temporarily disable an entry in this BHK structure, by clearing the +appropriate flag. I is a preprocessor token indicating which +entry to disable. + +=for apidoc Amx|void|BhkENABLE|BHK *hk|which +Re-enable an entry in this BHK structure, by setting the appropriate +flag. I is a preprocessor token indicating which entry to enable. +This will assert (under -DDEBUGGING) if the entry doesn't contain a valid +pointer. + +=for apidoc mx|void|CALL_BLOCK_HOOKS|which|arg +Call all the registered block hooks for type I. I is a +preprocessing token; the type of I depends on I. + +=cut +*/ + +#define BhkFLAGS(hk) ((hk)->bhk_flags) + +#define BHKf_bhk_start 0x01 +#define BHKf_bhk_pre_end 0x02 +#define BHKf_bhk_post_end 0x04 +#define BHKf_bhk_eval 0x08 + +#define BhkENTRY(hk, which) \ + ((BhkFLAGS(hk) & BHKf_ ## which) ? ((hk)->which) : NULL) + +#define BhkENABLE(hk, which) \ + STMT_START { \ + BhkFLAGS(hk) |= BHKf_ ## which; \ + assert(BhkENTRY(hk, which)); \ + } STMT_END + +#define BhkDISABLE(hk, which) \ + STMT_START { \ + BhkFLAGS(hk) &= ~(BHKf_ ## which); \ + } STMT_END + +#define BhkENTRY_set(hk, which, ptr) \ + STMT_START { \ + (hk)->which = ptr; \ + BhkENABLE(hk, which); \ + } STMT_END + +#define CALL_BLOCK_HOOKS(which, arg) \ + STMT_START { \ + if (PL_blockhooks) { \ + I32 i; \ + for (i = av_len(PL_blockhooks); i >= 0; i--) { \ + SV *sv = AvARRAY(PL_blockhooks)[i]; \ + BHK *hk; \ + \ + assert(SvIOK(sv)); \ + if (SvUOK(sv)) \ + hk = INT2PTR(BHK *, SvUVX(sv)); \ + else \ + hk = INT2PTR(BHK *, SvIVX(sv)); \ + \ + if (BhkENTRY(hk, which)) \ + BhkENTRY(hk, which)(aTHX_ arg); \ + } \ + } \ + } STMT_END + +/* flags for rv2cv_op_cv */ + +#define RV2CVOPCV_MARK_EARLY 0x00000001 +#define RV2CVOPCV_RETURN_NAME_GV 0x00000002 + +#define op_lvalue(op,t) Perl_op_lvalue_flags(aTHX_ op,t,0) + +/* flags for op_lvalue_flags */ + +#define OP_LVALUE_NO_CROAK 1 + +/* +=head1 Custom Operators + +=for apidoc Am|U32|XopFLAGS|XOP *xop +Return the XOP's flags. + +=for apidoc Am||XopENTRY|XOP *xop|which +Return a member of the XOP structure. I 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 I. + +=for apidoc Am|void|XopENTRY_set|XOP *xop|which|value +Set a member of the XOP structure. I is a cpp token indicating +which entry to set. See L for details about +the available members and how they are used. + +=for apidoc Am|void|XopDISABLE|XOP *xop|which +Temporarily disable a member of the XOP, by clearing the appropriate flag. + +=for apidoc Am|void|XopENABLE|XOP *xop|which +Reenable a member of the XOP which has been disabled. + +=cut +*/ + +struct custom_op { + U32 xop_flags; + const char *xop_name; + const char *xop_desc; + U32 xop_class; + void (*xop_peep)(pTHX_ OP *o, OP *oldop); +}; + +#define XopFLAGS(xop) ((xop)->xop_flags) + +#define XOPf_xop_name 0x01 +#define XOPf_xop_desc 0x02 +#define XOPf_xop_class 0x04 +#define XOPf_xop_peep 0x08 + +#define XOPd_xop_name PL_op_name[OP_CUSTOM] +#define XOPd_xop_desc PL_op_desc[OP_CUSTOM] +#define XOPd_xop_class OA_BASEOP +#define XOPd_xop_peep ((Perl_cpeep_t)0) + +#define XopENTRY_set(xop, which, to) \ + STMT_START { \ + (xop)->which = (to); \ + (xop)->xop_flags |= XOPf_ ## which; \ + } STMT_END + +#define XopENTRY(xop, which) \ + ((XopFLAGS(xop) & XOPf_ ## which) ? (xop)->which : XOPd_ ## which) + +#define XopDISABLE(xop, which) ((xop)->xop_flags &= ~XOPf_ ## which) +#define XopENABLE(xop, which) \ + STMT_START { \ + (xop)->xop_flags |= XOPf_ ## which; \ + assert(XopENTRY(xop, which)); \ + } STMT_END + +/* +=head1 Optree Manipulation Functions + +=for apidoc Am|const char *|OP_NAME|OP *o +Return the name of the provided OP. For core ops this looks up the name +from the op_type; for custom ops from the op_ppaddr. + +=for apidoc Am|const char *|OP_DESC|OP *o +Return a short description of the provided OP. + +=for apidoc Am|U32|OP_CLASS|OP *o +Return the class of the provided OP: that is, which of the *OP +structures it uses. For core ops this currently gets the information out +of PL_opargs, which does not always accurately reflect the type used. +For custom ops the type is returned from the registration, and it is up +to the registree to ensure it is accurate. The value returned will be +one of the OA_* constants from op.h. + +=cut +*/ + +#define OP_NAME(o) ((o)->op_type == OP_CUSTOM \ + ? XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_name) \ + : PL_op_name[(o)->op_type]) +#define OP_DESC(o) ((o)->op_type == OP_CUSTOM \ + ? XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_desc) \ + : PL_op_desc[(o)->op_type]) +#define OP_CLASS(o) ((o)->op_type == OP_CUSTOM \ + ? XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_class) \ + : (PL_opargs[(o)->op_type] & OA_CLASS_MASK)) + +#define newSUB(f, o, p, b) Perl_newATTRSUB(aTHX_ (f), (o), (p), NULL, (b)) + #ifdef PERL_MAD # define MAD_NULL 1 # define MAD_PV 2 @@ -739,11 +1060,27 @@ struct token { */ /* +=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) +# define OP_CHECK_MUTEX_UNLOCK MUTEX_UNLOCK(&PL_check_mutex) +# define OP_CHECK_MUTEX_TERM MUTEX_DESTROY(&PL_check_mutex) +#else +# define OP_CHECK_MUTEX_INIT NOOP +# define OP_CHECK_MUTEX_LOCK NOOP +# define OP_CHECK_MUTEX_UNLOCK NOOP +# define OP_CHECK_MUTEX_TERM NOOP +#endif + +/* * 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: */