OP * Perl_fold_constants(pTHX_ register OP *o) { register OP *curop; I32 type = o->op_type; SV *sv; 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: case OP_LC: case OP_SLT: case OP_SGT: case OP_SLE: case OP_SGE: case OP_SCMP: /* XXX what about the numeric ops? */ if (PL_hints & HINT_LOCALE) goto nope; } if (PL_error_count) goto nope; /* Don't try to run w/ errors */ for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) { if ((curop->op_type != OP_CONST || (curop->op_private & OPpCONST_BARE)) && curop->op_type != OP_LIST && curop->op_type != OP_SCALAR && curop->op_type != OP_NULL && curop->op_type != OP_PUSHMARK) { goto nope; } } curop = LINKLIST(o); o->op_next = 0; PL_op = curop; CALLRUNOPS(aTHX); sv = *(PL_stack_sp--); if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */ pad_swipe(o->op_targ, FALSE); else if (SvTEMP(sv)) { /* grab mortal temp? */ (void)SvREFCNT_inc(sv); SvTEMP_off(sv); } op_free(o); if (type == OP_RV2GV) return newGVOP(OP_GV, 0, (GV*)sv); return newSVOP(OP_CONST, 0, sv); nope: return o; }