X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/d164302a58430157957e90a71e7a08de7eabbc94..3097ec408171fa0c7fc407cae0375c8689b8a222:/op.c diff --git a/op.c b/op.c index 915dd78..d2cb4f0 100644 --- a/op.c +++ b/op.c @@ -365,7 +365,7 @@ S_bad_type(pTHX_ I32 n, const char *t, const char *name, const OP *kid) } STATIC void -S_no_bareword_allowed(pTHX_ const OP *o) +S_no_bareword_allowed(pTHX_ OP *o) { PERL_ARGS_ASSERT_NO_BAREWORD_ALLOWED; @@ -374,6 +374,7 @@ S_no_bareword_allowed(pTHX_ const OP *o) qerror(Perl_mess(aTHX_ "Bareword \"%"SVf"\" not allowed while \"strict subs\" in use", SVfARG(cSVOPo_sv))); + o->op_private &= ~OPpCONST_STRICT; /* prevent warning twice about the same OP */ } /* "register" allocation */ @@ -1169,8 +1170,6 @@ Perl_scalarvoid(pTHX_ OP *o) } else useless = "a constant (undef)"; - if (o->op_private & OPpCONST_ARYBASE) - useless = NULL; /* don't warn on optimised away booleans, eg * use constant Foo, 5; Foo || print; */ if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT) @@ -1218,6 +1217,52 @@ Perl_scalarvoid(pTHX_ OP *o) o->op_ppaddr = PL_ppaddr[OP_I_PREDEC]; break; + case OP_SASSIGN: { + OP *rv2gv; + UNOP *refgen, *rv2cv; + LISTOP *exlist; + + if ((o->op_private & ~OPpASSIGN_BACKWARDS) != 2) + break; + + rv2gv = ((BINOP *)o)->op_last; + if (!rv2gv || rv2gv->op_type != OP_RV2GV) + break; + + refgen = (UNOP *)((BINOP *)o)->op_first; + + if (!refgen || refgen->op_type != OP_REFGEN) + break; + + exlist = (LISTOP *)refgen->op_first; + if (!exlist || exlist->op_type != OP_NULL + || exlist->op_targ != OP_LIST) + break; + + if (exlist->op_first->op_type != OP_PUSHMARK) + break; + + rv2cv = (UNOP*)exlist->op_last; + + if (rv2cv->op_type != OP_RV2CV) + break; + + assert ((rv2gv->op_private & OPpDONT_INIT_GV) == 0); + assert ((o->op_private & OPpASSIGN_CV_TO_GV) == 0); + assert ((rv2cv->op_private & OPpMAY_RETURN_CONSTANT) == 0); + + o->op_private |= OPpASSIGN_CV_TO_GV; + rv2gv->op_private |= OPpDONT_INIT_GV; + rv2cv->op_private |= OPpMAY_RETURN_CONSTANT; + + break; + } + + case OP_AASSIGN: { + inplace_aassign(o); + break; + } + case OP_OR: case OP_AND: kid = cLOGOPo->op_first; @@ -1432,6 +1477,8 @@ S_finalize_op(pTHX_ OP* o) OP *prop_op = (OP *) mp->mad_val; /* We only need "Relocate sv to the pad for thread safety.", but this easiest way to make sure it traverses everything */ + if (prop_op->op_type == OP_CONST) + cSVOPx(prop_op)->op_private &= ~OPpCONST_STRICT; finalize_op(prop_op); } mp = mp->mad_next; @@ -1445,14 +1492,15 @@ S_finalize_op(pTHX_ OP* o) PL_curcop = ((COP*)o); /* for warnings */ break; case OP_EXEC: - if (o->op_next && o->op_next->op_type == OP_NEXTSTATE + if ( o->op_sibling + && (o->op_sibling->op_type == OP_NEXTSTATE || o->op_sibling->op_type == OP_DBSTATE) && ckWARN(WARN_SYNTAX)) { - if (o->op_next->op_sibling) { - const OPCODE type = o->op_next->op_sibling->op_type; + if (o->op_sibling->op_sibling) { + const OPCODE type = o->op_sibling->op_sibling->op_type; if (type != OP_EXIT && type != OP_WARN && type != OP_DIE) { const line_t oldline = CopLINE(PL_curcop); - CopLINE_set(PL_curcop, CopLINE((COP*)o->op_next)); + CopLINE_set(PL_curcop, CopLINE((COP*)o->op_sibling)); Perl_warner(aTHX_ packWARN(WARN_EXEC), "Statement unlikely to be reached"); Perl_warner(aTHX_ packWARN(WARN_EXEC), @@ -1478,6 +1526,9 @@ S_finalize_op(pTHX_ OP* o) break; case OP_CONST: + if (cSVOPo->op_private & OPpCONST_STRICT) + no_bareword_allowed(o); + /* FALLTHROUGH */ #ifdef USE_ITHREADS case OP_HINTSEVAL: case OP_METHOD_NAMED: @@ -1672,35 +1723,19 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) return o; } + assert( (o->op_flags & OPf_WANT) != OPf_WANT_VOID ); + switch (o->op_type) { case OP_UNDEF: localize = 0; PL_modcount++; return o; - case OP_CONST: - if (!(o->op_private & OPpCONST_ARYBASE)) - goto nomod; - localize = 0; - if (PL_eval_start && PL_eval_start->op_type == OP_CONST) { - CopARYBASE_set(&PL_compiling, - (I32)SvIV(cSVOPx(PL_eval_start)->op_sv)); - PL_eval_start = 0; - } - else if (!type) { - SAVECOPARYBASE(&PL_compiling); - CopARYBASE_set(&PL_compiling, 0); - } - else if (type == OP_REFGEN) - goto nomod; - else - Perl_croak(aTHX_ "That use of $[ is unsupported"); - break; case OP_STUB: if ((o->op_flags & OPf_PARENS) || PL_madskills) break; goto nomod; case OP_ENTERSUB: - if ((type == OP_UNDEF || type == OP_REFGEN) && + if ((type == OP_UNDEF || type == OP_REFGEN || type == OP_LOCK) && !(o->op_flags & OPf_STACKED)) { o->op_type = OP_RV2CV; /* entersub => rv2cv */ /* Both ENTERSUB and RV2CV use this bit, but for different pur- @@ -1711,8 +1746,6 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) op_null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */ break; } - else if (o->op_private & OPpENTERSUB_NOMOD) - return o; else { /* lvalue subroutine call */ o->op_private |= OPpLVAL_INTRO |(OPpENTERSUB_INARGS * (type == OP_LEAVESUBLV)); @@ -1970,7 +2003,10 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) case OP_LIST: localize = 0; for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) - op_lvalue(kid, type); + /* elements might be in void context because the list is + in scalar context or because they are attribute sub calls */ + if ( (kid->op_flags & OPf_WANT) != OPf_WANT_VOID ) + op_lvalue(kid, type); break; case OP_RETURN: @@ -2011,14 +2047,6 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) return o; } -/* Do not use this. It will be removed after 5.14. */ -OP * -Perl_mod(pTHX_ OP *o, I32 type) -{ - return op_lvalue(o,type); -} - - STATIC bool S_scalar_mod_type(const OP *o, I32 type) { @@ -2129,7 +2157,9 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref) o->op_private &= ~1; } else if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV){ - o->op_private |= OPpENTERSUB_DEREF; + o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV + : type == OP_RV2HV ? OPpDEREF_HV + : OPpDEREF_SV); o->op_flags |= OPf_MOD; } @@ -2313,7 +2343,6 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp) op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, pack, list(arg)), newSVOP(OP_METHOD_NAMED, 0, meth))); - imop->op_private |= OPpENTERSUB_NOMOD; /* Combine the ops. */ *imopsp = op_append_elem(OP_LIST, *imopsp, imop); @@ -2711,11 +2740,23 @@ Perl_newPROG(pTHX_ OP *o) PERL_ARGS_ASSERT_NEWPROG; if (PL_in_eval) { + PERL_CONTEXT *cx; if (PL_eval_root) return; PL_eval_root = newUNOP(OP_LEAVEEVAL, ((PL_in_eval & EVAL_KEEPERR) ? OPf_SPECIAL : 0), o); + + cx = &cxstack[cxstack_ix]; + assert(CxTYPE(cx) == CXt_EVAL); + + if ((cx->blk_gimme & G_WANT) == G_VOID) + scalarvoid(PL_eval_root); + else if ((cx->blk_gimme & G_WANT) == G_ARRAY) + list(PL_eval_root); + else + scalar(PL_eval_root); + /* don't use LINKLIST, since PL_eval_root might indirect through * a rather expensive function call and LINKLIST evaluates its * argument more than once */ @@ -2724,6 +2765,8 @@ Perl_newPROG(pTHX_ OP *o) OpREFCNT_set(PL_eval_root, 1); PL_eval_root->op_next = 0; CALL_PEEP(PL_eval_start); + finalize_optree(PL_eval_root); + } else { if (o->op_type == OP_STUB) { @@ -2831,6 +2874,45 @@ Perl_jmaybe(pTHX_ OP *o) return o; } +PERL_STATIC_INLINE OP * +S_op_std_init(pTHX_ OP *o) +{ + I32 type = o->op_type; + + PERL_ARGS_ASSERT_OP_STD_INIT; + + if (PL_opargs[type] & OA_RETSCALAR) + scalar(o); + if (PL_opargs[type] & OA_TARGET && !o->op_targ) + o->op_targ = pad_alloc(type, SVs_PADTMP); + + return o; +} + +PERL_STATIC_INLINE OP * +S_op_integerize(pTHX_ OP *o) +{ + I32 type = o->op_type; + + PERL_ARGS_ASSERT_OP_INTEGERIZE; + + /* integerize op, unless it happens to be C<-foo>. + * XXX should pp_i_negate() do magic string negation instead? */ + if ((PL_opargs[type] & OA_OTHERINT) && (PL_hints & HINT_INTEGER) + && !(type == OP_NEGATE && cUNOPo->op_first->op_type == OP_CONST + && (cUNOPo->op_first->op_private & OPpCONST_BARE))) + { + dVAR; + o->op_ppaddr = PL_ppaddr[type = ++(o->op_type)]; + } + + if (type == OP_NEGATE) + /* XXX might want a ck_negate() for this */ + cUNOPo->op_first->op_private &= ~OPpCONST_STRICT; + + return o; +} + static OP * S_fold_constants(pTHX_ register OP *o) { @@ -2849,28 +2931,10 @@ S_fold_constants(pTHX_ register OP *o) PERL_ARGS_ASSERT_FOLD_CONSTANTS; - if (PL_opargs[type] & OA_RETSCALAR) - scalar(o); - if (PL_opargs[type] & OA_TARGET && !o->op_targ) - o->op_targ = pad_alloc(type, SVs_PADTMP); - - /* integerize op, unless it happens to be C<-foo>. - * XXX should pp_i_negate() do magic string negation instead? */ - if ((PL_opargs[type] & OA_OTHERINT) && (PL_hints & HINT_INTEGER) - && !(type == OP_NEGATE && cUNOPo->op_first->op_type == OP_CONST - && (cUNOPo->op_first->op_private & OPpCONST_BARE))) - { - o->op_ppaddr = PL_ppaddr[type = ++(o->op_type)]; - } - if (!(PL_opargs[type] & OA_FOLDCONST)) goto nope; switch (type) { - case OP_NEGATE: - /* XXX might want a ck_negate() for this */ - cUNOPo->op_first->op_private &= ~OPpCONST_STRICT; - break; case OP_UCFIRST: case OP_LCFIRST: case OP_UC: @@ -3030,6 +3094,13 @@ Perl_convert(pTHX_ I32 type, I32 flags, OP *o) if (!(PL_opargs[type] & OA_MARK)) op_null(cLISTOPo->op_first); + else { + OP * const kid2 = cLISTOPo->op_first->op_sibling; + if (kid2 && kid2->op_type == OP_COREARGS) { + op_null(cLISTOPo->op_first); + kid2->op_private |= OPpCOREARGS_PUSHMARK; + } + } o->op_type = (OPCODE)type; o->op_ppaddr = PL_ppaddr[type]; @@ -3039,7 +3110,7 @@ Perl_convert(pTHX_ I32 type, I32 flags, OP *o) if (o->op_type != (unsigned)type) return o; - return fold_constants(o); + return fold_constants(op_integerize(op_std_init(o))); } /* @@ -3587,7 +3658,7 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first) if (unop->op_next) return (OP*)unop; - return fold_constants((OP *) unop); + return fold_constants(op_integerize(op_std_init((OP *) unop))); } /* @@ -3637,7 +3708,7 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last) binop->op_last = binop->op_first->op_sibling; - return fold_constants((OP *)binop); + return fold_constants(op_integerize(op_std_init((OP *)binop))); } static int uvcompare(const void *a, const void *b) @@ -4807,6 +4878,76 @@ S_is_list_assignment(pTHX_ register const OP *o) } /* + Helper function for newASSIGNOP to detection commonality between the + lhs and the rhs. Marks all variables with PL_generation. If it + returns TRUE the assignment must be able to handle common variables. +*/ +PERL_STATIC_INLINE bool +S_aassign_common_vars(pTHX_ OP* o) +{ + OP *curop; + for (curop = cUNOPo->op_first; curop; curop=curop->op_sibling) { + if (PL_opargs[curop->op_type] & OA_DANGEROUS) { + if (curop->op_type == OP_GV) { + GV *gv = cGVOPx_gv(curop); + if (gv == PL_defgv + || (int)GvASSIGN_GENERATION(gv) == PL_generation) + return TRUE; + GvASSIGN_GENERATION_set(gv, PL_generation); + } + else if (curop->op_type == OP_PADSV || + curop->op_type == OP_PADAV || + curop->op_type == OP_PADHV || + curop->op_type == OP_PADANY) + { + if (PAD_COMPNAME_GEN(curop->op_targ) + == (STRLEN)PL_generation) + return TRUE; + PAD_COMPNAME_GEN_set(curop->op_targ, PL_generation); + + } + else if (curop->op_type == OP_RV2CV) + return TRUE; + else if (curop->op_type == OP_RV2SV || + curop->op_type == OP_RV2AV || + curop->op_type == OP_RV2HV || + curop->op_type == OP_RV2GV) { + if (cUNOPx(curop)->op_first->op_type != OP_GV) /* funny deref? */ + return TRUE; + } + else if (curop->op_type == OP_PUSHRE) { +#ifdef USE_ITHREADS + if (((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff) { + GV *const gv = MUTABLE_GV(PAD_SVl(((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff)); + if (gv == PL_defgv + || (int)GvASSIGN_GENERATION(gv) == PL_generation) + return TRUE; + GvASSIGN_GENERATION_set(gv, PL_generation); + } +#else + GV *const gv + = ((PMOP*)curop)->op_pmreplrootu.op_pmtargetgv; + if (gv) { + if (gv == PL_defgv + || (int)GvASSIGN_GENERATION(gv) == PL_generation) + return TRUE; + GvASSIGN_GENERATION_set(gv, PL_generation); + } +#endif + } + else + return TRUE; + } + + if (curop->op_flags & OPf_KIDS) { + if (aassign_common_vars(curop)) + return TRUE; + } + } + return FALSE; +} + +/* =for apidoc Am|OP *|newASSIGNOP|I32 flags|OP *left|I32 optype|OP *right Constructs, checks, and returns an assignment op. I and I @@ -4854,18 +4995,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) bool maybe_common_vars = TRUE; PL_modcount = 0; - /* Grandfathering $[ assignment here. Bletch.*/ - /* Only simple assignments like C<< ($[) = 1 >> are allowed */ - PL_eval_start = (left->op_type == OP_CONST) ? right : NULL; left = op_lvalue(left, OP_AASSIGN); - if (PL_eval_start) - PL_eval_start = 0; - else if (left->op_type == OP_CONST) { - deprecate("assignment to $["); - /* FIXME for MAD */ - /* Result of assignment is always 1 (or we'd be dead already) */ - return newSVOP(OP_CONST, 0, newSViv(1)); - } curop = list(force_list(left)); o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop); o->op_private = (U8)(0 | (flags >> 8)); @@ -4944,64 +5074,10 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) */ if (maybe_common_vars) { - OP *lastop = o; PL_generation++; - for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) { - if (PL_opargs[curop->op_type] & OA_DANGEROUS) { - if (curop->op_type == OP_GV) { - GV *gv = cGVOPx_gv(curop); - if (gv == PL_defgv - || (int)GvASSIGN_GENERATION(gv) == PL_generation) - break; - GvASSIGN_GENERATION_set(gv, PL_generation); - } - else if (curop->op_type == OP_PADSV || - curop->op_type == OP_PADAV || - curop->op_type == OP_PADHV || - curop->op_type == OP_PADANY) - { - if (PAD_COMPNAME_GEN(curop->op_targ) - == (STRLEN)PL_generation) - break; - PAD_COMPNAME_GEN_set(curop->op_targ, PL_generation); - - } - else if (curop->op_type == OP_RV2CV) - break; - else if (curop->op_type == OP_RV2SV || - curop->op_type == OP_RV2AV || - curop->op_type == OP_RV2HV || - curop->op_type == OP_RV2GV) { - if (lastop->op_type != OP_GV) /* funny deref? */ - break; - } - else if (curop->op_type == OP_PUSHRE) { -#ifdef USE_ITHREADS - if (((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff) { - GV *const gv = MUTABLE_GV(PAD_SVl(((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff)); - if (gv == PL_defgv - || (int)GvASSIGN_GENERATION(gv) == PL_generation) - break; - GvASSIGN_GENERATION_set(gv, PL_generation); - } -#else - GV *const gv - = ((PMOP*)curop)->op_pmreplrootu.op_pmtargetgv; - if (gv) { - if (gv == PL_defgv - || (int)GvASSIGN_GENERATION(gv) == PL_generation) - break; - GvASSIGN_GENERATION_set(gv, PL_generation); - } -#endif - } - else - break; - } - lastop = curop; - } - if (curop != o) + if (aassign_common_vars(o)) o->op_private |= OPpASSIGN_COMMON; + LINKLIST(o); } if (right && right->op_type == OP_SPLIT && !PL_madskills) { @@ -5061,19 +5137,8 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) scalar(right)); } else { - PL_eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/ o = newBINOP(OP_SASSIGN, flags, scalar(right), op_lvalue(scalar(left), OP_SASSIGN) ); - if (PL_eval_start) - PL_eval_start = 0; - else { - if (!PL_madskills) { /* assignment to $[ is ignored when making a mad dump */ - deprecate("assignment to $["); - op_free(o); - o = newSVOP(OP_CONST, 0, newSViv(CopARYBASE_get(&PL_compiling))); - o->op_private |= OPpCONST_ARYBASE; - } - } } return o; } @@ -5121,9 +5186,6 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) cop->op_next = (OP*)cop; cop->cop_seq = seq; - /* CopARYBASE is now "virtual", in that it's stored as a flag bit in - CopHINTS and a possible value in cop_hints_hash, so no need to copy it. - */ cop->cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings); CopHINTHASH_set(cop, cophh_copy(CopHINTHASH_get(PL_curcop))); if (label) { @@ -5542,6 +5604,12 @@ Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right) flip->op_private = left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0; flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0; + /* check barewords before they might be optimized aways */ + if (flip->op_private && cSVOPx(left)->op_private & OPpCONST_STRICT) + no_bareword_allowed(left); + if (flop->op_private && cSVOPx(right)->op_private & OPpCONST_STRICT) + no_bareword_allowed(right); + flip->op_next = o; if (!flip->op_private || !flop->op_private) LINKLIST(o); /* blow off optimizer unless constant */ @@ -6180,8 +6248,6 @@ Perl_cv_ckproto_len(pTHX_ const CV *cv, const GV *gv, const char *p, { PERL_ARGS_ASSERT_CV_CKPROTO_LEN; - /* Can't just use a strcmp on the prototype, as CONSTSUBs "cheat" by - relying on SvCUR, and doubling up the buffer to hold CvFILE(). */ if (((!p != !SvPOK(cv)) /* One has prototype, one has not. */ || (p && (len != SvCUR(cv) /* Not the same length. */ || memNE(p, SvPVX_const(cv), len)))) @@ -6541,12 +6607,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) CvOUTSIDE(PL_compcv) = temp_cv; CvPADLIST(PL_compcv) = temp_av; -#ifdef USE_ITHREADS - if (CvFILE(cv) && !CvISXSUB(cv)) { - /* for XSUBs CvFILE point directly to static memory; __FILE__ */ + if (CvFILE(cv) && CvDYNFILE(cv)) { Safefree(CvFILE(cv)); } -#endif CvFILE_set_from_cop(cv, PL_curcop); CvSTASH_set(cv, PL_curstash); @@ -6805,7 +6868,7 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv) CopSTASH_set(PL_curcop,stash); } - /* file becomes the CvFILE. For an XS, it's supposed to be static storage, + /* file becomes the CvFILE. For an XS, it's usually static storage, and so doesn't get free()d. (It's expected to be from the C pre- processor __FILE__ directive). But we need a dynamically allocated one, and we need it to get freed. */ @@ -6833,40 +6896,10 @@ Perl_newXS_flags(pTHX_ const char *name, XSUBADDR_t subaddr, PERL_ARGS_ASSERT_NEWXS_FLAGS; if (flags & XS_DYNAMIC_FILENAME) { - /* We need to "make arrangements" (ie cheat) to ensure that the - filename lasts as long as the PVCV we just created, but also doesn't - leak */ - STRLEN filename_len = strlen(filename); - STRLEN proto_and_file_len = filename_len; - char *proto_and_file; - STRLEN proto_len; - - if (proto) { - proto_len = strlen(proto); - proto_and_file_len += proto_len; - - Newx(proto_and_file, proto_and_file_len + 1, char); - Copy(proto, proto_and_file, proto_len, char); - Copy(filename, proto_and_file + proto_len, filename_len + 1, char); - } else { - proto_len = 0; - proto_and_file = savepvn(filename, filename_len); - } - - /* This gets free()d. :-) */ - sv_usepvn_flags(MUTABLE_SV(cv), proto_and_file, proto_and_file_len, - SV_HAS_TRAILING_NUL); - if (proto) { - /* This gives us the correct prototype, rather than one with the - file name appended. */ - SvCUR_set(cv, proto_len); - } else { - SvPOK_off(cv); - } - CvFILE(cv) = proto_and_file + proto_len; - } else { - sv_setpv(MUTABLE_SV(cv), proto); + CvFILE(cv) = savepv(filename); + CvDYNFILE_on(cv); } + sv_setpv(MUTABLE_SV(cv), proto); return cv; } @@ -6942,6 +6975,7 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename) (void)gv_fetchfile(filename); CvFILE(cv) = (char *)filename; /* NOTE: not copied, as it is expected to be an external constant string */ + assert(!CvDYNFILE(cv)); /* cv_undef should have turned it off */ CvISXSUB_on(cv); CvXSUB(cv) = subaddr; @@ -6998,6 +7032,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) CvSTART(cv) = LINKLIST(CvROOT(cv)); CvROOT(cv)->op_next = 0; CALL_PEEP(CvSTART(cv)); + finalize_optree(CvROOT(cv)); #ifdef PERL_MAD op_getmad(o,pegop,'n'); op_getmad_weak(block, pegop, 'b'); @@ -7180,14 +7215,6 @@ Perl_ck_bitop(pTHX_ OP *o) PERL_ARGS_ASSERT_CK_BITOP; -#define OP_IS_NUMCOMPARE(op) \ - ((op) == OP_LT || (op) == OP_I_LT || \ - (op) == OP_GT || (op) == OP_I_GT || \ - (op) == OP_LE || (op) == OP_I_LE || \ - (op) == OP_GE || (op) == OP_I_GE || \ - (op) == OP_EQ || (op) == OP_I_EQ || \ - (op) == OP_NE || (op) == OP_I_NE || \ - (op) == OP_NCMP || (op) == OP_I_NCMP) o->op_private = (U8)(PL_hints & HINT_INTEGER); if (!(o->op_flags & OPf_STACKED) /* Not an assignment */ && (o->op_type == OP_BIT_OR @@ -7627,6 +7654,7 @@ Perl_ck_fun(pTHX_ OP *o) register OP *kid = cLISTOPo->op_first; OP *sibl; I32 numargs = 0; + bool seen_optional = FALSE; if (kid->op_type == OP_PUSHMARK || (kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)) @@ -7634,10 +7662,25 @@ Perl_ck_fun(pTHX_ OP *o) tokid = &kid->op_sibling; kid = kid->op_sibling; } - if (!kid && PL_opargs[type] & OA_DEFGV) - *tokid = kid = newDEFSVOP(); + if (kid && kid->op_type == OP_COREARGS) { + bool optional = FALSE; + while (oa) { + numargs++; + if (oa & OA_OPTIONAL) optional = TRUE; + oa = oa >> 4; + } + if (optional) o->op_private |= numargs; + return o; + } + + while (oa) { + if (oa & OA_OPTIONAL || (oa & 7) == OA_LIST) { + if (!kid && !seen_optional && PL_opargs[type] & OA_DEFGV) + *tokid = kid = newDEFSVOP(); + seen_optional = TRUE; + } + if (!kid) break; - while (oa && kid) { numargs++; sibl = kid->op_sibling; #ifdef PERL_MAD @@ -7907,7 +7950,6 @@ Perl_ck_glob(pTHX_ OP *o) } #if !defined(PERL_EXTERNAL_GLOB) - /* XXX this can be tightened up and made more failsafe. */ if (!(gv && GvCVu(gv) && GvIMPORTED_CV(gv))) { GV *glob_gv; ENTER; @@ -8488,7 +8530,7 @@ Perl_ck_select(pTHX_ OP *o) o->op_type = OP_SSELECT; o->op_ppaddr = PL_ppaddr[OP_SSELECT]; o = ck_fun(o); - return fold_constants(o); + return fold_constants(op_integerize(op_std_init(o))); } } o = ck_fun(o); @@ -9188,6 +9230,94 @@ Perl_ck_entersub_args_proto_or_list(pTHX_ OP *entersubop, return ck_entersub_args_list(entersubop); } +OP * +Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv) +{ + int opnum = SvTYPE(protosv) == SVt_PVCV ? 0 : (int)SvUV(protosv); + OP *aop = cUNOPx(entersubop)->op_first; + + PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_CORE; + + if (!opnum) { + OP *cvop; + if (!aop->op_sibling) + aop = cUNOPx(aop)->op_first; + aop = aop->op_sibling; + for (cvop = aop; cvop->op_sibling; cvop = cvop->op_sibling) ; + if (PL_madskills) while (aop != cvop && aop->op_type == OP_STUB) { + aop = aop->op_sibling; + continue; + } + if (aop != cvop) + (void)too_many_arguments(entersubop, GvNAME(namegv)); + + op_free(entersubop); + switch(GvNAME(namegv)[2]) { + case 'F': return newSVOP(OP_CONST, 0, + newSVpv(CopFILE(PL_curcop),0)); + case 'L': return newSVOP( + OP_CONST, 0, + Perl_newSVpvf(aTHX_ + "%"IVdf, (IV)CopLINE(PL_curcop) + ) + ); + case 'P': return newSVOP(OP_CONST, 0, + (PL_curstash + ? newSVhek(HvNAME_HEK(PL_curstash)) + : &PL_sv_undef + ) + ); + } + assert(0); + } + else { + OP *prev, *cvop; + U32 paren; +#ifdef PERL_MAD + bool seenarg = FALSE; +#endif + if (!aop->op_sibling) + aop = cUNOPx(aop)->op_first; + + prev = aop; + aop = aop->op_sibling; + prev->op_sibling = NULL; + for (cvop = aop; + cvop->op_sibling; + prev=cvop, cvop = cvop->op_sibling) +#ifdef PERL_MAD + if (PL_madskills && cvop->op_sibling + && cvop->op_type != OP_STUB) seenarg = TRUE +#endif + ; + prev->op_sibling = NULL; + paren = OPf_SPECIAL * !(cvop->op_private & OPpENTERSUB_NOPAREN); + op_free(cvop); + if (aop == cvop) aop = NULL; + op_free(entersubop); + + switch (PL_opargs[opnum] & OA_CLASS_MASK) { + case OA_UNOP: + case OA_BASEOP_OR_UNOP: + case OA_FILESTATOP: + return aop ? newUNOP(opnum,paren,aop) : newOP(opnum,paren); + case OA_BASEOP: + if (aop) { +#ifdef PERL_MAD + if (!PL_madskills || seenarg) +#endif + (void)too_many_arguments(aop, GvNAME(namegv)); + op_free(aop); + } + return newOP(opnum,0); + default: + return convert(opnum,0,aop); + } + } + assert(0); + return entersubop; +} + /* =for apidoc Am|void|cv_get_call_checker|CV *cv|Perl_call_checker *ckfun_p|SV **ckobj_p @@ -9376,21 +9506,6 @@ Perl_ck_trunc(pTHX_ OP *o) } OP * -Perl_ck_unpack(pTHX_ OP *o) -{ - OP *kid = cLISTOPo->op_first; - - PERL_ARGS_ASSERT_CK_UNPACK; - - if (kid->op_sibling) { - kid = kid->op_sibling; - if (!kid->op_sibling) - kid->op_sibling = newDEFSVOP(); - } - return ck_fun(o); -} - -OP * Perl_ck_substr(pTHX_ OP *o) { PERL_ARGS_ASSERT_CK_SUBSTR; @@ -9475,59 +9590,57 @@ S_opt_scalarhv(pTHX_ OP *rep_op) { return (OP*)unop; } -/* Checks if o acts as an in-place operator on an array. oright points to the - * beginning of the right-hand side. Returns the left-hand side of the - * assignment if o acts in-place, or NULL otherwise. */ +/* Check for in place reverse and sort assignments like "@a = reverse @a" + and modify the optree to make them work inplace */ -STATIC OP * -S_is_inplace_av(pTHX_ OP *o, OP *oright) { - OP *o2; - OP *oleft = NULL; +STATIC void +S_inplace_aassign(pTHX_ OP *o) { - PERL_ARGS_ASSERT_IS_INPLACE_AV; + OP *modop, *modop_pushmark; + OP *oright; + OP *oleft, *oleft_pushmark; - if (!oright || - (oright->op_type != OP_RV2AV && oright->op_type != OP_PADAV) - || oright->op_next != o - || (oright->op_private & OPpLVAL_INTRO) - ) - return NULL; + PERL_ARGS_ASSERT_INPLACE_AASSIGN; - /* o2 follows the chain of op_nexts through the LHS of the - * assign (if any) to the aassign op itself */ - o2 = o->op_next; - if (!o2 || o2->op_type != OP_NULL) - return NULL; - o2 = o2->op_next; - if (!o2 || o2->op_type != OP_PUSHMARK) - return NULL; - o2 = o2->op_next; - if (o2 && o2->op_type == OP_GV) - o2 = o2->op_next; - if (!o2 - || (o2->op_type != OP_PADAV && o2->op_type != OP_RV2AV) - || (o2->op_private & OPpLVAL_INTRO) - ) - return NULL; - oleft = o2; - o2 = o2->op_next; - if (!o2 || o2->op_type != OP_NULL) - return NULL; - o2 = o2->op_next; - if (!o2 || o2->op_type != OP_AASSIGN - || (o2->op_flags & OPf_WANT) != OPf_WANT_VOID) - return NULL; + assert((o->op_flags & OPf_WANT) == OPf_WANT_VOID); - /* check that the sort is the first arg on RHS of assign */ + assert(cUNOPo->op_first->op_type == OP_NULL); + modop_pushmark = cUNOPx(cUNOPo->op_first)->op_first; + assert(modop_pushmark->op_type == OP_PUSHMARK); + modop = modop_pushmark->op_sibling; - o2 = cUNOPx(o2)->op_first; - if (!o2 || o2->op_type != OP_NULL) - return NULL; - o2 = cUNOPx(o2)->op_first; - if (!o2 || o2->op_type != OP_PUSHMARK) - return NULL; - if (o2->op_sibling != o) - return NULL; + if (modop->op_type != OP_SORT && modop->op_type != OP_REVERSE) + return; + + /* no other operation except sort/reverse */ + if (modop->op_sibling) + return; + + assert(cUNOPx(modop)->op_first->op_type == OP_PUSHMARK); + oright = cUNOPx(modop)->op_first->op_sibling; + + if (modop->op_flags & OPf_STACKED) { + /* skip sort subroutine/block */ + assert(oright->op_type == OP_NULL); + oright = oright->op_sibling; + } + + assert(cUNOPo->op_first->op_sibling->op_type == OP_NULL); + oleft_pushmark = cUNOPx(cUNOPo->op_first->op_sibling)->op_first; + assert(oleft_pushmark->op_type == OP_PUSHMARK); + oleft = oleft_pushmark->op_sibling; + + /* Check the lhs is an array */ + if (!oleft || + (oleft->op_type != OP_RV2AV && oleft->op_type != OP_PADAV) + || oleft->op_sibling + || (oleft->op_private & OPpLVAL_INTRO) + ) + return; + + /* Only one thing on the rhs */ + if (oright->op_sibling) + return; /* check the array is the same on both sides */ if (oleft->op_type == OP_RV2AV) { @@ -9537,14 +9650,26 @@ S_is_inplace_av(pTHX_ OP *o, OP *oright) { || cGVOPx_gv(cUNOPx(oleft)->op_first) != cGVOPx_gv(cUNOPx(oright)->op_first) ) - return NULL; + return; } else if (oright->op_type != OP_PADAV || oright->op_targ != oleft->op_targ ) - return NULL; + return; + + /* This actually is an inplace assignment */ + + modop->op_private |= OPpSORT_INPLACE; - return oleft; + /* transfer MODishness etc from LHS arg to RHS arg */ + oright->op_flags = oleft->op_flags; + + /* remove the aassign op and the lhs */ + op_null(o); + op_null(oleft_pushmark); + if (oleft->op_type == OP_RV2AV && cUNOPx(oleft)->op_first) + op_null(cUNOPx(oleft)->op_first); + op_null(oleft); } #define MAX_DEFERRED 4 @@ -9646,11 +9771,6 @@ Perl_rpeep(pTHX_ register OP *o) } break; - case OP_CONST: - if (cSVOPo->op_private & OPpCONST_STRICT) - no_bareword_allowed(o); - break; - case OP_CONCAT: if (o->op_next && o->op_next->op_type == OP_STRINGIFY) { if (o->op_next->op_private & OPpTARGET_MY) { @@ -9706,9 +9826,7 @@ Perl_rpeep(pTHX_ register OP *o) pop->op_next->op_type == OP_AELEM && !(pop->op_next->op_private & (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)) && - (i = SvIV(((SVOP*)pop)->op_sv) - CopARYBASE_get(PL_curcop)) - <= 255 && - i >= 0) + (i = SvIV(((SVOP*)pop)->op_sv)) <= 255 && i >= 0) { GV *gv; if (cSVOPx(pop)->op_private & OPpCONST_STRICT) @@ -9853,37 +9971,15 @@ Perl_rpeep(pTHX_ register OP *o) DEFER(cPMOP->op_pmstashstartu.op_pmreplstart); break; - case OP_RV2SV: - case OP_RV2AV: - case OP_RV2HV: - if (oldop && - ( - ( - ( oldop->op_type == OP_AELEM - || oldop->op_type == OP_PADSV - || oldop->op_type == OP_RV2SV - || oldop->op_type == OP_RV2GV - || oldop->op_type == OP_HELEM - ) - && (oldop->op_private & OPpDEREF) - ) - || ( oldop->op_type == OP_ENTERSUB - && oldop->op_private & OPpENTERSUB_DEREF ) - ) - ) { - o->op_private |= OPpDEREFed; - } - case OP_SORT: { - /* will point to RV2AV or PADAV op on LHS/RHS of assign */ - OP *oleft; - OP *o2; - /* check that RHS of sort is a single plain array */ OP *oright = cUNOPo->op_first; if (!oright || oright->op_type != OP_PUSHMARK) break; + if (o->op_private & OPpSORT_INPLACE) + break; + /* reverse sort ... can be optimised. */ if (!cUNOPo->op_sibling) { /* Nothing follows us on the list. */ @@ -9903,72 +9999,16 @@ Perl_rpeep(pTHX_ register OP *o) } } - /* make @a = sort @a act in-place */ - - oright = cUNOPx(oright)->op_sibling; - if (!oright) - break; - if (oright->op_type == OP_NULL) { /* skip sort block/sub */ - oright = cUNOPx(oright)->op_sibling; - } - - oleft = is_inplace_av(o, oright); - if (!oleft) - break; - - /* transfer MODishness etc from LHS arg to RHS arg */ - oright->op_flags = oleft->op_flags; - o->op_private |= OPpSORT_INPLACE; - - /* excise push->gv->rv2av->null->aassign */ - o2 = o->op_next->op_next; - op_null(o2); /* PUSHMARK */ - o2 = o2->op_next; - if (o2->op_type == OP_GV) { - op_null(o2); /* GV */ - o2 = o2->op_next; - } - op_null(o2); /* RV2AV or PADAV */ - o2 = o2->op_next->op_next; - op_null(o2); /* AASSIGN */ - - o->op_next = o2->op_next; - break; } case OP_REVERSE: { OP *ourmark, *theirmark, *ourlast, *iter, *expushmark, *rv2av; OP *gvop = NULL; - OP *oleft, *oright; LISTOP *enter, *exlist; - /* @a = reverse @a */ - if ((oright = cLISTOPo->op_first) - && (oright->op_type == OP_PUSHMARK) - && (oright = oright->op_sibling) - && (oleft = is_inplace_av(o, oright))) { - OP *o2; - - /* transfer MODishness etc from LHS arg to RHS arg */ - oright->op_flags = oleft->op_flags; - o->op_private |= OPpREVERSE_INPLACE; - - /* excise push->gv->rv2av->null->aassign */ - o2 = o->op_next->op_next; - op_null(o2); /* PUSHMARK */ - o2 = o2->op_next; - if (o2->op_type == OP_GV) { - op_null(o2); /* GV */ - o2 = o2->op_next; - } - op_null(o2); /* RV2AV or PADAV */ - o2 = o2->op_next->op_next; - op_null(o2); /* AASSIGN */ - - o->op_next = o2->op_next; + if (o->op_private & OPpSORT_INPLACE) break; - } enter = (LISTOP *) o->op_next; if (!enter) @@ -10054,51 +10094,6 @@ Perl_rpeep(pTHX_ register OP *o) break; } - case OP_SASSIGN: { - OP *rv2gv; - UNOP *refgen, *rv2cv; - LISTOP *exlist; - - if ((o->op_flags & OPf_WANT) != OPf_WANT_VOID) - break; - - if ((o->op_private & ~OPpASSIGN_BACKWARDS) != 2) - break; - - rv2gv = ((BINOP *)o)->op_last; - if (!rv2gv || rv2gv->op_type != OP_RV2GV) - break; - - refgen = (UNOP *)((BINOP *)o)->op_first; - - if (!refgen || refgen->op_type != OP_REFGEN) - break; - - exlist = (LISTOP *)refgen->op_first; - if (!exlist || exlist->op_type != OP_NULL - || exlist->op_targ != OP_LIST) - break; - - if (exlist->op_first->op_type != OP_PUSHMARK) - break; - - rv2cv = (UNOP*)exlist->op_last; - - if (rv2cv->op_type != OP_RV2CV) - break; - - assert ((rv2gv->op_private & OPpDONT_INIT_GV) == 0); - assert ((o->op_private & OPpASSIGN_CV_TO_GV) == 0); - assert ((rv2cv->op_private & OPpMAY_RETURN_CONSTANT) == 0); - - o->op_private |= OPpASSIGN_CV_TO_GV; - rv2gv->op_private |= OPpDONT_INIT_GV; - rv2cv->op_private |= OPpMAY_RETURN_CONSTANT; - - break; - } - - case OP_QR: case OP_MATCH: if (!(cPMOP->op_pmflags & PMf_ONCE)) { @@ -10216,77 +10211,72 @@ Perl_custom_op_register(pTHX_ Perl_ppaddr_t ppaddr, const XOP *xop) =for apidoc core_prototype This function assigns the prototype of the named core function to C, or to a new mortal SV if C is NULL. It returns the modified C, or -NULL if the core function has no prototype. - -If the C is not a Perl keyword, it croaks if C is true, or -returns NULL if C is false. +NULL if the core function has no prototype. C is a code as returned +by C. It must be negative and unequal to -KEY_CORE. =cut */ SV * -Perl_core_prototype(pTHX_ SV *sv, const char *name, const STRLEN len, - const bool croak) +Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code, + int * const opnum) { - const int code = keyword(name, len, 1); int i = 0, n = 0, seen_question = 0, defgv = 0; I32 oa; #define MAX_ARGS_OP ((sizeof(I32) - 1) * 2) char str[ MAX_ARGS_OP * 2 + 2 ]; /* One ';', one '\0' */ + bool nullret = FALSE; PERL_ARGS_ASSERT_CORE_PROTOTYPE; - if (!code) { - if (croak) - return (SV *)Perl_die(aTHX_ - "Can't find an opnumber for \"%s\"", name - ); - return NULL; - } - - if (code > 0) return NULL; /* Not overridable */ + assert (code < 0 && code != -KEY_CORE); if (!sv) sv = sv_newmortal(); -#define retsetpvs(x) sv_setpvs(sv, x); return sv +#define retsetpvs(x,y) sv_setpvs(sv, x); if(opnum) *opnum=(y); return sv switch (-code) { case KEY_and : case KEY_chop: case KEY_chomp: case KEY_cmp : case KEY_exec: case KEY_eq : case KEY_ge : case KEY_gt : case KEY_le : - case KEY_lstat : case KEY_lt : case KEY_ne : case KEY_or : - case KEY_stat : case KEY_system: case KEY_x : case KEY_xor: - return NULL; - case KEY_keys: case KEY_values: case KEY_each: - retsetpvs("+"); - case KEY_push: case KEY_unshift: - retsetpvs("+@"); - case KEY_pop: case KEY_shift: - retsetpvs(";+"); + case KEY_lt : case KEY_ne : case KEY_or : + case KEY_select: case KEY_system: case KEY_x : case KEY_xor: + if (!opnum) return NULL; nullret = TRUE; goto findopnum; + case KEY_keys: retsetpvs("+", OP_KEYS); + case KEY_values: retsetpvs("+", OP_VALUES); + case KEY_each: retsetpvs("+", OP_EACH); + case KEY_push: retsetpvs("+@", OP_PUSH); + case KEY_unshift: retsetpvs("+@", OP_UNSHIFT); + case KEY_pop: retsetpvs(";+", OP_POP); + case KEY_shift: retsetpvs(";+", OP_SHIFT); case KEY_splice: - retsetpvs("+;$$@"); + retsetpvs("+;$$@", OP_SPLICE); case KEY___FILE__: case KEY___LINE__: case KEY___PACKAGE__: - retsetpvs(""); + retsetpvs("", 0); case KEY_readpipe: name = "backtick"; } #undef retsetpvs + findopnum: while (i < MAXO) { /* The slow way. */ if (strEQ(name, PL_op_name[i]) || strEQ(name, PL_op_desc[i])) { + if (nullret) { assert(opnum); *opnum = i; return NULL; } goto found; } i++; } - return NULL; /* Should not happen... */ + assert(0); return NULL; /* Should not happen... */ found: defgv = PL_opargs[i] & OA_DEFGV; oa = PL_opargs[i] >> OASHIFT; while (oa) { - if (oa & OA_OPTIONAL && !seen_question && (!defgv || n)) { + if (oa & OA_OPTIONAL && !seen_question && ( + !defgv || (oa & (OA_OPTIONAL - 1)) == OA_FILEREF + )) { seen_question = 1; str[n++] = ';'; } @@ -10303,19 +10293,86 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const STRLEN len, str[n++] = '$'; str[n++] = '@'; str[n++] = '%'; + if (i == OP_LOCK) str[n++] = '&'; str[n++] = '*'; str[n++] = ']'; } else str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)]; + if (oa & OA_OPTIONAL && defgv && str[n-1] == '$') { + str[n-1] = '_'; defgv = 0; + } oa = oa >> 4; } - if (defgv && str[0] == '$') - str[0] = '_'; + if (code == -KEY_not || code == -KEY_getprotobynumber) str[n++] = ';'; str[n++] = '\0'; sv_setpvn(sv, str, n - 1); + if (opnum) *opnum = i; return sv; } +OP * +Perl_coresub_op(pTHX_ SV * const coreargssv, const int code, + const int opnum) +{ + OP * const argop = newSVOP(OP_COREARGS,0,coreargssv); + OP *o; + + PERL_ARGS_ASSERT_CORESUB_OP; + + switch(opnum) { + case 0: + return op_append_elem(OP_LINESEQ, + argop, + newSLICEOP(0, + newSVOP(OP_CONST, 0, newSViv(-code % 3)), + newOP(OP_CALLER,0) + ) + ); + case OP_SELECT: /* which represents OP_SSELECT as well */ + if (code) + return newCONDOP( + 0, + newBINOP(OP_GT, 0, + newAVREF(newGVOP(OP_GV, 0, PL_defgv)), + newSVOP(OP_CONST, 0, newSVuv(1)) + ), + coresub_op(newSVuv((UV)OP_SSELECT), 0, + OP_SSELECT), + coresub_op(coreargssv, 0, OP_SELECT) + ); + /* FALL THROUGH */ + default: + switch (PL_opargs[opnum] & OA_CLASS_MASK) { + case OA_BASEOP: + return op_append_elem( + OP_LINESEQ, argop, + newOP(opnum, + opnum == OP_WANTARRAY ? OPpOFFBYONE << 8 : 0) + ); + case OA_BASEOP_OR_UNOP: + o = newUNOP(opnum,0,argop); + if (opnum == OP_CALLER) o->op_private |= OPpOFFBYONE; + else { + onearg: + if (is_handle_constructor(o, 1)) + argop->op_private |= OPpCOREARGS_DEREF1; + } + return o; + default: + o = convert(opnum,0,argop); + if (is_handle_constructor(o, 2)) + argop->op_private |= OPpCOREARGS_DEREF2; + if (scalar_mod_type(NULL, opnum)) + argop->op_private |= OPpCOREARGS_SCALARMOD; + if (opnum == OP_SUBSTR) { + o->op_private |= OPpMAYBE_LVSUB; + return o; + } + else goto onearg; + } + } +} + #include "XSUB.h" /* Efficient sub that returns a constant scalar value. */