X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/4f9115300b43ef6b5f7a27ee5faa266cbbca1243..e2e755386e52b4bdb22a5c9618390859ed5f7323:/op.h diff --git a/op.h b/op.h index fa1230d..c011d66 100644 --- a/op.h +++ b/op.h @@ -1,7 +1,7 @@ /* op.h * - * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, + * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -36,6 +36,7 @@ * 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 @@ -45,35 +46,39 @@ # define MADPROP_IN_BASEOP #endif +typedef PERL_BITFIELD16 Optype; + #ifdef BASEOP_DEFINITION #define BASEOP BASEOP_DEFINITION #else #define BASEOP \ OP* op_next; \ OP* op_sibling; \ - OP* (CPERLscope(*op_ppaddr))(pTHX); \ + OP* (*op_ppaddr)(pTHX); \ MADPROP_IN_BASEOP \ PADOFFSET op_targ; \ - unsigned op_type:9; \ - unsigned op_opt:1; \ - unsigned op_latefree:1; \ - unsigned op_latefreed:1; \ - unsigned op_attached:1; \ - unsigned op_spare:3; \ + 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; \ U8 op_flags; \ U8 op_private; #endif +/* If op_type:9 is changed to :10, also change PUSHEVAL in cop.h. + Also, if the type of op_type is ever changed (e.g. to PERL_BITFIELD32) + 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.*/ + #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) -#define OP_GIMME_REVERSE(flags) \ - ((flags & G_VOID) ? OPf_WANT_VOID : \ - (flags & G_ARRAY) ? OPf_WANT_LIST : \ - OPf_WANT_SCALAR) +#define OP_GIMME_REVERSE(flags) ((flags) & G_WANT) /* =head1 "Gimme" Values @@ -81,7 +86,7 @@ =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 @@ -108,8 +113,6 @@ Deprecated. Use C instead. #define OPf_STACKED 64 /* Some arg is arriving on the stack. */ #define OPf_SPECIAL 128 /* Do something weird for this op: */ /* On local LVAL, don't init local value. */ - /* On OP_CONST, value is the hints hash for - eval, so return a copy from pp_const() */ /* On OP_SORT, subroutine is inlined. */ /* On OP_NOT, inversion was implicit. */ /* On OP_LEAVE, don't restore curpm. */ @@ -120,7 +123,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> */ @@ -135,6 +137,14 @@ Deprecated. Use C instead. /* 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 =~ */ /* old names; don't use in new code, but don't break them, either */ #define OPf_LIST OPf_WANT_LIST @@ -147,7 +157,7 @@ Deprecated. Use C instead. : G_SCALAR) \ : dowantarray()) -/* NOTE: OP_NEXTSTATE, OP_DBSTATE, and OP_SETSTATE (i.e. COPs) carry lower +/* NOTE: OP_NEXTSTATE and OP_DBSTATE (i.e. COPs) carry lower * bits of PL_hints in op_private */ /* Private for lvalues */ @@ -185,11 +195,13 @@ 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. */ +/* Private for OP_RV2SV, OP_RV2AV, OP_RV2AV */ +#define OPpDEREFed 4 /* prev op was OPpDEREF */ /* 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_RV2CV only */ +#define OPpENTERSUB_NOMOD 64 /* Immune to op_lvalue() for :attrlist. */ + /* OP_ENTERSUB and 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. */ @@ -238,6 +250,7 @@ Deprecated. Use C instead. /* 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 []. */ @@ -251,6 +264,9 @@ Deprecated. Use C instead. #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 */ @@ -264,13 +280,6 @@ 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 OP_IS_FILETEST_ACCESS(op) \ - (((op)->op_type) == OP_FTRREAD || \ - ((op)->op_type) == OP_FTRWRITE || \ - ((op)->op_type) == OP_FTREXEC || \ - ((op)->op_type) == OP_FTEREAD || \ - ((op)->op_type) == OP_FTEWRITE || \ - ((op)->op_type) == OP_FTEEXEC) /* Private for OP_(MAP|GREP)(WHILE|START) */ #define OPpGREP_LEX 2 /* iterate over lexical $_ */ @@ -345,48 +354,52 @@ struct pmop { /* BEWARE - something that calls this macro passes (r) which has a side effect. */ #define PM_SETRE(o,r) STMT_START { \ - const REGEXP *const whap = (r); \ - assert(whap); \ - PL_regex_pad[(o)->op_pmoffset] = (SV*)whap; \ + REGEXP *const _pm_setre = (r); \ + assert(_pm_setre); \ + PL_regex_pad[(o)->op_pmoffset] = MUTABLE_SV(_pm_setre); \ } STMT_END #else #define PM_GETRE(o) ((o)->op_pmregexp) #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+7) -#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 */ +/* 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)) + +/* 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)) -/* 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) +/* Return substituted string instead of modifying it. */ +#define PMf_NONDESTRUCT (1<<(PMf_BASE_SHIFT+9)) + +#if PMf_BASE_SHIFT+9 > 31 +# error Too many PMf_ bits used. See above and regnodes.h for any spare in middle +#endif #ifdef USE_ITHREADS @@ -518,21 +531,22 @@ struct loop { #define cSVOPo_sv cSVOPx_sv(o) #define kSVOP_sv cSVOPx_sv(kid) -#define Nullop ((OP*)NULL) +#ifndef PERL_CORE +# define Nullop ((OP*)NULL) +#endif /* Lowest byte-and-a-bit 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) @@ -551,7 +565,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 @@ -599,20 +613,39 @@ struct loop { #endif /* flags used by Perl_load_module() */ -#define PERL_LOADMOD_DENY 0x1 -#define PERL_LOADMOD_NOIMPORT 0x2 -#define PERL_LOADMOD_IMPORT_OPS 0x4 +#define PERL_LOADMOD_DENY 0x1 /* no Module */ +#define PERL_LOADMOD_NOIMPORT 0x2 /* use Module () */ +#define PERL_LOADMOD_IMPORT_OPS 0x4 /* use Module (...) */ #if defined(PERL_IN_PERLY_C) || defined(PERL_IN_OP_C) #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) #endif +#ifdef PERL_CORE +# define my(o) my_attrs((o), NULL) +#endif + #ifdef USE_REENTRANT_API #include "reentr.h" #endif @@ -632,6 +665,195 @@ struct loop { #define FreeOp(p) PerlMemShared_free(p) #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 m|U32|BhkFLAGS|BHK *hk +Return the BHK's flags. + +=for apidoc m|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 Am|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 Am|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 Am|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 m|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 + +/* +=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 @@ -640,7 +862,7 @@ struct loop { struct madprop { MADPROP* mad_next; - const void *mad_val; + void *mad_val; U32 mad_vlen; /* short mad_count; */ char mad_key;