X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/cb85b2dba9dd71becf505fd4190513a7648f1ff8..cc2ebcd7902:/op.h diff --git a/op.h b/op.h index f23ff2d..1d4f571 100644 --- a/op.h +++ b/op.h @@ -28,8 +28,10 @@ * 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_slabbed allocated via opslab + * op_savefree on savestack via SAVEFREEOP * - * op_spare three spare bits! + * op_spare a 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 @@ -62,7 +64,9 @@ typedef PERL_BITFIELD16 Optype; 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:1; \ U8 op_flags; \ U8 op_private; #endif @@ -131,7 +135,8 @@ Deprecated. Use C instead. /* On OP_DBSTATE, indicates breakpoint * (runtime property) */ /* On OP_REQUIRE, was seen as CORE::require */ - /* On OP_ENTERWHEN, there's no condition */ + /* 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 */ @@ -143,7 +148,10 @@ Deprecated. Use C instead. that was optimised away, so it should not be bound via =~ */ /* On OP_CONST, from a constant CV */ - /* On OP_GLOB, use Perl glob function */ + /* 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 @@ -159,8 +167,8 @@ Deprecated. Use C instead. /* 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 lower - * bits of PL_hints in op_private */ +/* 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 */ @@ -179,7 +187,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 */ @@ -204,9 +212,9 @@ Deprecated. Use C instead. /* OP_ENTERSUB only */ #define OPpENTERSUB_DB 16 /* Debug subroutine. */ -#define OPpENTERSUB_HASTARG 32 /* Called from OP tree. */ -#define OPpENTERSUB_INARGS 4 /* Lval used as arg to a sub. */ -#define OPpENTERSUB_DEREF 1 /* Lval call that autovivifies. */ +#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 */ @@ -221,11 +229,15 @@ Deprecated. Use C instead. #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_[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_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) */ @@ -234,6 +246,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) */ +#define OPpALLOW_FAKE 16 /* OK to return fake glob */ /* Private for OP_ENTERITER and OP_ITER */ #define OPpITER_REVERSED 4 /* for (reverse ...) */ @@ -244,9 +257,8 @@ Deprecated. Use C instead. #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_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. */ @@ -287,23 +299,31 @@ Deprecated. Use C instead. #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 and OP_WANTARRAY */ +/* 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. See pp.c:S_rv2gv. */ +/* 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 }; @@ -352,11 +372,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 @@ -415,26 +439,47 @@ struct pmop { /* Return substituted string instead of modifying it. */ #define PMf_NONDESTRUCT (1<<(PMf_BASE_SHIFT+9)) -#if PMf_BASE_SHIFT+9 > 31 +/* 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 @@ -657,7 +702,7 @@ least an C. /* 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 @@ -668,19 +713,66 @@ least an C. #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. + */ + +#if !defined(PL_OP_SLAB_ALLOC) && defined(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 */ + OPSLOT opslab_slots; /* slots begin here */ +}; + +# define OPSLOT_HEADER STRUCT_OFFSET(OPSLOT, opslot_op) +# define OPSLOT_HEADER_P (OPSLOT_HEADER/sizeof(I32 *)) +# ifdef DEBUGGING +# define OpSLOT(o) (assert(o->op_slabbed), \ + (OPSLOT *)(((char *)o)-OPSLOT_HEADER)) +# else +# define OpSLOT(o) ((OPSLOT *)(((char *)o)-OPSLOT_HEADER)) +# endif +# 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 { @@ -976,11 +1068,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: */