X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/5255171e6cd0accee6f76ea2980e32b3b5b8e171..7b060fdbaf8c0d22e561dd8d9e4b1b147997e707:/op.h diff --git a/op.h b/op.h index 3ddce78..139375d 100644 --- a/op.h +++ b/op.h @@ -20,8 +20,12 @@ * op_opt Whether or not the op has been optimised by the * peephole optimiser. * 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 Four spare bits! + * op_folded Result/remainder of a constant fold operation. + * op_lastsib this op is is 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, * by default, set to the number of children until @@ -32,12 +36,6 @@ #define OPCODE U16 -#ifdef PERL_MAD -# define MADPROP_IN_BASEOP MADPROP* op_madprop; -#else -# define MADPROP_IN_BASEOP -#endif - typedef PERL_BITFIELD16 Optype; #ifdef BASEOP_DEFINITION @@ -47,13 +45,15 @@ typedef PERL_BITFIELD16 Optype; OP* op_next; \ OP* op_sibling; \ OP* (*op_ppaddr)(pTHX); \ - MADPROP_IN_BASEOP \ PADOFFSET op_targ; \ PERL_BITFIELD16 op_type:9; \ PERL_BITFIELD16 op_opt:1; \ PERL_BITFIELD16 op_slabbed:1; \ PERL_BITFIELD16 op_savefree:1; \ - PERL_BITFIELD16 op_spare:4; \ + PERL_BITFIELD16 op_static:1; \ + PERL_BITFIELD16 op_folded:1; \ + PERL_BITFIELD16 op_lastsib:1; \ + PERL_BITFIELD16 op_spare:1; \ U8 op_flags; \ U8 op_private; #endif @@ -63,11 +63,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) @@ -77,7 +75,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. See L for a usage example. +respectively. See L for a usage example. =for apidoc Amn|U32|GIMME A backward-compatible version of C which can only return @@ -114,9 +112,8 @@ 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_SPLIT, special split " " */ + /* 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> */ /* On RV2[ACGHS]V, don't create GV--in defined()*/ /* On OP_DBSTATE, indicates breakpoint @@ -139,6 +136,8 @@ Deprecated. Use C instead. - Before ck_glob, called as CORE::glob - After ck_glob, use Perl glob function */ + /* On OP_PADRANGE, push @_ */ + /* On OP_DUMP, has no label */ /* old names; don't use in new code, but don't break them, either */ #define OPf_LIST OPf_WANT_LIST @@ -151,170 +150,23 @@ Deprecated. Use C instead. : G_SCALAR) \ : dowantarray()) -/* 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 */ +/* NOTE: OPp* flags are now auto-generated and defined in opcode.h, + * from data in regen/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. */ +#define OPpTRANS_ALL (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL|OPpTRANS_SQUASH|OPpTRANS_COMPLEMENT|OPpTRANS_GROWS|OPpTRANS_DELETE) -/* Private for OP_LEAVE, OP_LEAVESUB, OP_LEAVESUBLV and OP_LEAVEWRITE */ -#define OPpREFCOUNTED 64 /* op_targ carries a refcount */ -/* Private for OP_AASSIGN */ -#define OPpASSIGN_COMMON 64 /* Left & right have syms in common. */ -/* Private for OP_SASSIGN */ -#define OPpASSIGN_BACKWARDS 64 /* Left & right switched. */ -#define OPpASSIGN_CV_TO_GV 128 /* Possible optimisation for constants. */ +/* Mask for OP_ENTERSUB flags, the absence of which must be propagated + in dynamic context */ +#define OPpENTERSUB_LVAL_MASK (OPpLVAL_INTRO|OPpENTERSUB_INARGS) -/* Private for OP_MATCH and OP_SUBST{,CONT} */ -#define OPpRUNTIME 64 /* Pattern coming in on the stack */ +/* VMS-specific hints in COPs */ +#define OPpHINT_M_VMSISH_MASK (OPpHINT_M_VMSISH_STATUS|OPpHINT_M_VMSISH_TIME) -/* Private for OP_TRANS */ -#define OPpTRANS_FROM_UTF 1 -#define OPpTRANS_TO_UTF 2 -#define OPpTRANS_IDENTICAL 4 /* right side is same as left */ -#define OPpTRANS_SQUASH 8 - /* 16 is used for OPpTARGET_MY */ -#define OPpTRANS_COMPLEMENT 32 -#define OPpTRANS_GROWS 64 -#define OPpTRANS_DELETE 128 -#define OPpTRANS_ALL (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF|OPpTRANS_IDENTICAL|OPpTRANS_SQUASH|OPpTRANS_COMPLEMENT|OPpTRANS_GROWS|OPpTRANS_DELETE) -/* Private for OP_REPEAT */ -#define OPpREPEAT_DOLIST 64 /* List replication. */ - -/* Private for OP_RV2GV, OP_RV2SV, OP_AELEM, OP_HELEM, OP_PADSV */ -#define OPpDEREF (32|64) /* autovivify: Want ref to something: */ -#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 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 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[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_[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) */ - - /* 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 - guaranteed to be a PVGV) */ -#define OPpALLOW_FAKE 16 /* OK to return fake glob */ - -/* Private for OP_ENTERITER and OP_ITER */ -#define OPpITER_REVERSED 4 /* for (reverse ...) */ -#define OPpITER_DEF 8 /* for $_ or for my $_ */ - -/* 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 /* 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. */ - -/* Private for OP_LIST */ -#define OPpLIST_GUESSED 64 /* Guessed that pushmark was needed. */ - -/* Private for OP_DELETE */ -#define OPpSLICE 64 /* Operating on a list of keys */ -/* Also OPpLVAL_INTRO (128) */ - -/* Private for OP_EXISTS */ -#define OPpEXISTS_SUB 64 /* Checking for &sub, not {} or []. */ - -/* Private for OP_SORT */ -#define OPpSORT_NUMERIC 1 /* Optimized away { $a <=> $b } */ -#define OPpSORT_INTEGER 2 /* Ditto while under "use integer" */ -#define OPpSORT_REVERSE 4 /* Reversed sort */ -#define OPpSORT_INPLACE 8 /* sort in-place; eg @a = sort @a */ -#define OPpSORT_DESCEND 16 /* Descending sort */ -#define OPpSORT_QSORT 32 /* Use quicksort (not mergesort) */ -#define OPpSORT_STABLE 64 /* Use a stable algorithm */ - -/* Private for OP_REVERSE */ -#define OPpREVERSE_INPLACE 8 /* reverse in-place (@a = reverse @a) */ - -/* Private for OP_OPEN and OP_BACKTICK */ -#define OPpOPEN_IN_RAW 16 /* binmode(F,":raw") on input fh */ -#define OPpOPEN_IN_CRLF 32 /* binmode(F,":crlf") on input fh */ -#define OPpOPEN_OUT_RAW 64 /* binmode(F,":raw") on output fh */ -#define OPpOPEN_OUT_CRLF 128 /* binmode(F,":crlf") on output fh */ - -/* Private for OP_EXIT, HUSH also for OP_DIE */ -#define OPpHUSH_VMSISH 64 /* hush DCL exit msg vmsish mode*/ -#define OPpEXIT_VMSISH 128 /* exit(0) vs. exit(1) vmsish mode*/ - -/* Private for OP_FTXXX */ -#define OPpFT_ACCESS 2 /* use filetest 'access' */ -#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 @@ -348,7 +200,7 @@ struct pmop { OP * op_first; OP * op_last; #ifdef USE_ITHREADS - IV op_pmoffset; + PADOFFSET op_pmoffset; #else REGEXP * op_pmregexp; /* compiled expression */ #endif @@ -364,10 +216,7 @@ struct pmop { union { OP * op_pmreplstart; /* Only used in OP_SUBST */ #ifdef USE_ITHREADS - struct { - char * op_pmstashpv; /* Only used in OP_MATCH, with PMf_ONCE set */ - U32 op_pmstashflags; /* currently only SVf_UTF8 or 0 */ - } op_pmstashthr; + PADOFFSET op_pmstashoff; /* Only used in OP_MATCH, with PMf_ONCE set */ #else HV * op_pmstash; #endif @@ -408,10 +257,7 @@ 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. */ +/* PMf_ONCE, i.e. ?pat?, has matched successfully. Not used under threading. */ #define PMf_USED (1<<(PMf_BASE_SHIFT+3)) /* subst replacement is constant */ @@ -450,30 +296,13 @@ struct pmop { #ifdef USE_ITHREADS -# define PmopSTASHPV(o) \ - (((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_pmstashthr.op_pmstashpv = savesharedpv(pv)); \ - }) -# else -# define PmopSTASHPV_set(o,pv) \ - ((o)->op_pmstashstartu.op_pmstashthr.op_pmstashpv = savesharedpv(pv)) -# endif -# 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)) - +# define PmopSTASH(o) ((o)->op_pmflags & PMf_ONCE \ + ? PL_stashpad[(o)->op_pmstashstartu.op_pmstashoff] \ + : NULL) +# define PmopSTASH_set(o,hv) \ + (assert_((o)->op_pmflags & PMf_ONCE) \ + (o)->op_pmstashstartu.op_pmstashoff = \ + (hv) ? alloccopstash(hv) : 0) #else # define PmopSTASH(o) \ (((o)->op_pmflags & PMf_ONCE) ? (o)->op_pmstashstartu.op_pmstash : NULL) @@ -485,13 +314,10 @@ struct pmop { # else # define PmopSTASH_set(o,hv) ((o)->op_pmstashstartu.op_pmstash = (hv)) # endif -# define PmopSTASHPV(o) (PmopSTASH(o) ? HvNAME_get(PmopSTASH(o)) : NULL) - /* op_pmstashstartu.op_pmstash is not refcounted */ -# define PmopSTASHPV_set(o,pv) PmopSTASH_set((o), gv_stashpv(pv,GV_ADD)) -/* Note that if this becomes non-empty, then S_forget_pmop in op.c will need - changing */ -# define PmopSTASH_free(o) #endif +#define PmopSTASHPV(o) (PmopSTASH(o) ? HvNAME_get(PmopSTASH(o)) : NULL) + /* op_pmstashstartu.op_pmstash is not refcounted */ +#define PmopSTASHPV_set(o,pv) PmopSTASH_set((o), gv_stashpv(pv,GV_ADD)) struct svop { BASEOP @@ -564,17 +390,21 @@ struct loop { #ifdef USE_ITHREADS # define cGVOPx_gv(o) ((GV*)PAD_SVl(cPADOPx(o)->op_padix)) -# define IS_PADGV(v) (v && SvTYPE(v) == SVt_PVGV && isGV_with_GP(v) \ - && GvIN_PAD(v)) -# define IS_PADCONST(v) (v && SvREADONLY(v)) +# ifndef PERL_CORE +# define IS_PADGV(v) (v && isGV(v)) +# define IS_PADCONST(v) \ + (v && (SvREADONLY(v) || (SvIsCOW(v) && !SvLEN(v)))) +# endif # define cSVOPx_sv(v) (cSVOPx(v)->op_sv \ ? cSVOPx(v)->op_sv : PAD_SVl((v)->op_targ)) # define cSVOPx_svp(v) (cSVOPx(v)->op_sv \ ? &cSVOPx(v)->op_sv : &PAD_SVl((v)->op_targ)) #else # define cGVOPx_gv(o) ((GV*)cSVOPx(o)->op_sv) -# define IS_PADGV(v) FALSE -# define IS_PADCONST(v) FALSE +# ifndef PERL_CORE +# define IS_PADGV(v) FALSE +# define IS_PADCONST(v) FALSE +# endif # define cSVOPx_sv(v) (cSVOPx(v)->op_sv) # define cSVOPx_svp(v) (&cSVOPx(v)->op_sv) #endif @@ -600,7 +430,7 @@ struct loop { #define OA_DANGEROUS 64 #define OA_DEFGV 128 -/* The next 4 bits encode op class information */ +/* The next 4 bits (8..11) encode op class information */ #define OCSHIFT 8 #define OA_CLASS_MASK (15 << OCSHIFT) @@ -620,9 +450,10 @@ struct loop { #define OA_FILESTATOP (12 << OCSHIFT) #define OA_LOOPEXOP (13 << OCSHIFT) +/* Each remaining nybble of PL_opargs (i.e. bits 12..15, 16..19 etc) + * encode the type for each arg */ #define OASHIFT 12 -/* Remaining nybbles of PL_opargs */ #define OA_SCALAR 1 #define OA_LIST 2 #define OA_AVREF 3 @@ -670,9 +501,12 @@ struct loop { /* flags used by Perl_load_module() */ #define PERL_LOADMOD_DENY 0x1 /* no Module */ #define PERL_LOADMOD_NOIMPORT 0x2 /* use Module () */ -#define PERL_LOADMOD_IMPORT_OPS 0x4 /* use Module (...) */ +#define PERL_LOADMOD_IMPORT_OPS 0x4 /* import arguments + are passed as a sin- + gle op tree, not a + list of SVs */ -#if defined(PERL_IN_PERLY_C) || defined(PERL_IN_OP_C) +#if defined(PERL_IN_PERLY_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_TOKE_C) #define ref(o, type) doref(o, type, TRUE) #endif @@ -681,9 +515,9 @@ struct loop { =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 +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 +returned. If C<< o->op_next >> is not already set, I should be at least an C. =cut @@ -782,29 +616,29 @@ struct block_hooks { 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 +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. +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 +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. +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 +Call all the registered block hooks for type I. I is a preprocessing token; the type of I depends on I. =cut @@ -840,8 +674,8 @@ preprocessing token; the type of I depends on I. #define CALL_BLOCK_HOOKS(which, arg) \ STMT_START { \ if (PL_blockhooks) { \ - I32 i; \ - for (i = av_len(PL_blockhooks); i >= 0; i--) { \ + SSize_t i; \ + for (i = av_tindex(PL_blockhooks); i >= 0; i--) { \ SV *sv = AvARRAY(PL_blockhooks)[i]; \ BHK *hk; \ \ @@ -861,6 +695,11 @@ preprocessing token; the type of I depends on I. #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: */ +# define RV2CVOPCV_MAYBE_NAME_GV 0x00000008 +#endif +#define RV2CVOPCV_FLAG_MASK 0x0000000f /* all of the above */ #define op_lvalue(op,t) Perl_op_lvalue_flags(aTHX_ op,t,0) @@ -875,14 +714,23 @@ preprocessing token; the type of I depends on I. 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. +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. This macro evaluates its arguments more than +once. If you are using C to retreive a +C from a C, use the more efficient L instead. + +=for apidoc Am||XopENTRYCUSTOM|const OP *o|which +Exactly like C but more +efficient. The I parameter is identical to L. =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. +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. This macro evaluates its argument +more than once. =for apidoc Am|void|XopDISABLE|XOP *xop|which Temporarily disable a member of the XOP, by clearing the appropriate flag. @@ -901,6 +749,17 @@ struct custom_op { void (*xop_peep)(pTHX_ OP *o, OP *oldop); }; +/* return value of Perl_custom_op_get_field, similar to void * then casting but + the U32 doesn't need truncation on 64 bit platforms in the caller, also + for easier macro writing */ +typedef union { + const char *xop_name; + const char *xop_desc; + U32 xop_class; + void (*xop_peep)(pTHX_ OP *o, OP *oldop); + XOP *xop_ptr; +} XOPRETANY; + #define XopFLAGS(xop) ((xop)->xop_flags) #define XOPf_xop_name 0x01 @@ -908,6 +767,15 @@ struct custom_op { #define XOPf_xop_class 0x04 #define XOPf_xop_peep 0x08 +/* used by Perl_custom_op_get_field for option checking */ +typedef enum { + XOPe_xop_ptr = 0, /* just get the XOP *, don't look inside it */ + XOPe_xop_name = XOPf_xop_name, + XOPe_xop_desc = XOPf_xop_desc, + XOPe_xop_class = XOPf_xop_class, + XOPe_xop_peep = XOPf_xop_peep +} xop_flags_enum; + #define XOPd_xop_name PL_op_name[OP_CUSTOM] #define XOPd_xop_desc PL_op_desc[OP_CUSTOM] #define XOPd_xop_class OA_BASEOP @@ -922,6 +790,9 @@ struct custom_op { #define XopENTRY(xop, which) \ ((XopFLAGS(xop) & XOPf_ ## which) ? (xop)->which : XOPd_ ## which) +#define XopENTRYCUSTOM(o, which) \ + (Perl_custom_op_get_field(aTHX_ o, XOPe_ ## which).which) + #define XopDISABLE(xop, which) ((xop)->xop_flags &= ~XOPf_ ## which) #define XopENABLE(xop, which) \ STMT_START { \ @@ -929,11 +800,14 @@ struct custom_op { assert(XopENTRY(xop, which)); \ } STMT_END +#define Perl_custom_op_xop(x) \ + (Perl_custom_op_get_field(x, XOPe_xop_ptr).xop_ptr) + /* =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 +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 @@ -941,123 +815,87 @@ 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 +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 +to the registree to ensure it is accurate. The value returned will be one of the OA_* constants from op.h. +=for apidoc Am|bool|OP_TYPE_IS|OP *o, Optype type +Returns true if the given OP is not a NULL pointer +and if it is of the given type. + +The negation of this macro, C is also available +as well as C and C which elide +the NULL pointer check. + +=for apidoc Am|bool|OP_TYPE_IS_OR_WAS|OP *o, Optype type +Returns true if the given OP is not a NULL pointer and +if it is of the given type or used to be before being +replaced by an OP of type OP_NULL. + +The negation of this macro, C +is also available as well as C +and C which elide +the NULL pointer check. + +=for apidoc Am|bool|OP_HAS_SIBLING|OP *o +Returns true if o has a sibling + +=for apidoc Am|bool|OP_SIBLING|OP *o +Returns the sibling of o, or NULL if there is no sibling + +=for apidoc Am|bool|OP_SIBLING_set|OP *o|OP *sib +Sets the sibling of o to sib + =cut */ #define OP_NAME(o) ((o)->op_type == OP_CUSTOM \ - ? XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_name) \ + ? XopENTRYCUSTOM(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) \ + ? XopENTRYCUSTOM(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) \ + ? XopENTRYCUSTOM(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 -# define MAD_OP 3 -# define MAD_SV 4 - -struct madprop { - MADPROP* mad_next; - void *mad_val; - U32 mad_vlen; -/* short mad_count; */ - char mad_key; - char mad_type; -}; - -struct token { - I32 tk_type; - YYSTYPE tk_lval; - MADPROP* tk_mad; -}; +#define OP_TYPE_IS(o, type) ((o) && (o)->op_type == (type)) +#define OP_TYPE_IS_NN(o, type) ((o)->op_type == (type)) +#define OP_TYPE_ISNT(o, type) ((o) && (o)->op_type != (type)) +#define OP_TYPE_ISNT_NN(o, type) ((o)->op_type != (type)) + +#define OP_TYPE_IS_OR_WAS_NN(o, type) \ + ( ((o)->op_type == OP_NULL \ + ? (o)->op_targ \ + : (o)->op_type) \ + == (type) ) + +#define OP_TYPE_IS_OR_WAS(o, type) \ + ( (o) && OP_TYPE_IS_OR_WAS_NN(o, type) ) + +#define OP_TYPE_ISNT_AND_WASNT_NN(o, type) \ + ( ((o)->op_type == OP_NULL \ + ? (o)->op_targ \ + : (o)->op_type) \ + != (type) ) + +#define OP_TYPE_ISNT_AND_WASNT(o, type) \ + ( (o) && OP_TYPE_ISNT_AND_WASNT_NN(o, type) ) + +#ifdef PERL_OP_PARENT +# define OP_HAS_SIBLING(o) (!cBOOL((o)->op_lastsib)) +# define OP_SIBLING(o) (0 + (o)->op_lastsib ? NULL : (o)->op_sibling) +# define OP_SIBLING_set(o, sib) ((o)->op_sibling = (sib)) +#else +# define OP_HAS_SIBLING(o) (cBOOL((o)->op_sibling)) +# define OP_SIBLING(o) (0 + (o)->op_sibling) +# define OP_SIBLING_set(o, sib) ((o)->op_sibling = (sib)) #endif -/* - * Values that can be held by mad_key : - * ^ unfilled head spot - * , literal , - * ; literal ; (blank if implicit ; at end of block) - * : literal : from ?: or attr list - * + unary + - * ? literal ? from ?: - * ( literal ( - * ) literal ) - * [ literal [ - * ] literal ] - * { literal { - * } literal } - * @ literal @ sigil - * $ literal $ sigil - * * literal * sigil - * ! use is source filtered - * & & or sub - * # whitespace/comment following ; or } - * # $# sigil - * 1 1st ; from for(;;) - * 1 retired protasis - * 2 2nd ; from for(;;) - * 2 retired apodosis - * 3 C-style for list - * a sub or var attributes - * a non-method arrow operator - * A method arrow operator - * A use import args - * b format block - * B retired stub block - * C constant conditional op - * d declarator - * D do block - * e unreached "else" (see C) - * e expression producing E - * E tr/E/R/, /E/ - * f folded constant op - * F peg op for format - * g op was forced to be a word - * i if/unless modifier - * I if/elsif/unless statement - * k local declarator - * K retired kid op - * l last index of array ($#foo) - * L label - * m modifier on regex - * n sub or format name - * o current operator/declarator name - * o else/continue - * O generic optimized op - * p peg to hold extra whitespace at statement level - * P peg op for package declaration - * q opening quote - * = quoted material - * Q closing quote - * Q optimized qw// - * r expression producing R - * R tr/E/R/ s/E/R/ - * s sub signature - * S use import stub (no import) - * S retired sort block - * t unreached "then" (see C) - * U use import op - * v private sv of for loop - * V use version - * w while/until modifier - * W while/for statement - * x optimized qw - * X random thing - * _ whitespace/comments preceding anything else - * ~ =~ operator - */ +#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