}
STATIC void
-S_bad_type(pTHX_ I32 n, const char *t, const char *name, OP *kid)
+S_bad_type(pTHX_ I32 n, const char *t, const char *name, const OP *kid)
{
yyerror(Perl_form(aTHX_ "Type of arg %d to %s must be %s (not %s)",
(int)n, name, t, OP_DESC(kid)));
}
STATIC void
-S_no_bareword_allowed(pTHX_ OP *o)
+S_no_bareword_allowed(pTHX_ const OP *o)
{
qerror(Perl_mess(aTHX_
"Bareword \"%"SVf"\" not allowed while \"strict subs\" in use",
void
Perl_op_free(pTHX_ OP *o)
{
- register OP *kid, *nextkid;
OPCODE type;
PADOFFSET refcnt;
}
if (o->op_flags & OPf_KIDS) {
+ register OP *kid, *nextkid;
for (kid = cUNOPo->op_first; kid; kid = nextkid) {
nextkid = kid->op_sibling; /* Get before next freeing kid */
op_free(kid);
op_clear(o);
FreeOp(o);
+#ifdef DEBUG_LEAKING_SCALARS
+ if (PL_op == o)
+ PL_op = Nullop;
+#endif
}
void
OP *
Perl_linklist(pTHX_ OP *o)
{
- register OP *kid;
if (o->op_next)
return o->op_next;
/* establish postfix order */
if (cUNOPo->op_first) {
+ register OP *kid;
o->op_next = LINKLIST(cUNOPo->op_first);
for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
if (kid->op_sibling)
{
if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
if (ckWARN(WARN_SYNTAX)) {
- line_t oldline = CopLINE(PL_curcop);
+ const line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NOLINE)
CopLINE_set(PL_curcop, PL_copline);
OP *
Perl_listkids(pTHX_ OP *o)
{
- OP *kid;
if (o && o->op_flags & OPf_KIDS) {
+ OP *kid;
for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
list(kid);
}
OP *
Perl_scalarseq(pTHX_ OP *o)
{
- OP *kid;
-
if (o) {
if (o->op_type == OP_LINESEQ ||
o->op_type == OP_SCOPE ||
o->op_type == OP_LEAVE ||
o->op_type == OP_LEAVETRY)
{
+ OP *kid;
for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
if (kid->op_sibling) {
scalarvoid(kid);
STATIC OP *
S_modkids(pTHX_ OP *o, I32 type)
{
- OP *kid;
if (o && o->op_flags & OPf_KIDS) {
+ OP *kid;
for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
mod(kid, type);
}
}
STATIC bool
-S_scalar_mod_type(pTHX_ OP *o, I32 type)
+S_scalar_mod_type(pTHX_ const OP *o, I32 type)
{
switch (type) {
case OP_SASSIGN:
}
STATIC bool
-S_is_handle_constructor(pTHX_ OP *o, I32 argnum)
+S_is_handle_constructor(pTHX_ const OP *o, I32 argnum)
{
switch (o->op_type) {
case OP_PIPE_OP:
OP *
Perl_refkids(pTHX_ OP *o, I32 type)
{
- OP *kid;
if (o && o->op_flags & OPf_KIDS) {
+ OP *kid;
for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
ref(kid, type);
}
meth = newSVpvn("import", 6);
(void)SvUPGRADE(meth, SVt_PVIV);
(void)SvIOK_on(meth);
- PERL_HASH(SvUVX(meth), SvPVX(meth), SvCUR(meth));
+ {
+ U32 hash;
+ PERL_HASH(hash, SvPVX(meth), SvCUR(meth));
+ SvUV_set(meth, hash);
+ }
imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL|OPf_WANT_VOID,
append_elem(OP_LIST,
prepend_elem(OP_LIST, pack, list(arg)),
*/
void
-Perl_apply_attrs_string(pTHX_ char *stashpv, CV *cv,
- char *attrstr, STRLEN len)
+Perl_apply_attrs_string(pTHX_ const char *stashpv, CV *cv,
+ const char *attrstr, STRLEN len)
{
OP *attrs = Nullop;
while (len) {
for (; isSPACE(*attrstr) && len; --len, ++attrstr) ;
if (len) {
- char *sstr = attrstr;
+ const char *sstr = attrstr;
for (; !isSPACE(*attrstr) && len; --len, ++attrstr) ;
attrs = append_elem(OP_LIST, attrs,
newSVOP(OP_CONST, 0,
STATIC OP *
S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
{
- OP *kid;
I32 type;
if (!o || PL_error_count)
type = o->op_type;
if (type == OP_LIST) {
+ OP *kid;
for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
my_kid(kid, attrs, imopsp);
} else if (type == OP_UNDEF) {
OP*
Perl_block_end(pTHX_ I32 floor, OP *seq)
{
- int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
+ const int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
OP* retval = scalarseq(seq);
LEAVE_SCOPE(floor);
PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
STATIC OP *
S_newDEFSVOP(pTHX)
{
- I32 offset = pad_findmy("$_");
+ const I32 offset = pad_findmy("$_");
if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS(offset) & SVpad_OUR) {
return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
}
Perl_gen_constant_list(pTHX_ register OP *o)
{
register OP *curop;
- I32 oldtmps_floor = PL_tmps_floor;
+ const I32 oldtmps_floor = PL_tmps_floor;
list(o);
if (PL_error_count)
o->op_flags |= flags;
o = CHECKOP(type, o);
- if (o->op_type != type)
+ if (o->op_type != (unsigned)type)
return o;
return fold_constants(o);
if (!last)
return first;
- if (first->op_type != type
+ if (first->op_type != (unsigned)type
|| (type == OP_LIST && (first->op_flags & OPf_PARENS)))
{
return newLISTOP(type, 0, first, last);
if (!last)
return (OP*)first;
- if (first->op_type != type)
+ if (first->op_type != (unsigned)type)
return prepend_elem(type, (OP*)first, (OP*)last);
- if (last->op_type != type)
+ if (last->op_type != (unsigned)type)
return append_elem(type, (OP*)first, (OP*)last);
first->op_last->op_sibling = last->op_first;
if (!last)
return first;
- if (last->op_type == type) {
+ if (last->op_type == (unsigned)type) {
if (type == OP_LIST) { /* already a PUSHMARK there */
first->op_sibling = ((LISTOP*)last)->op_first->op_sibling;
((LISTOP*)last)->op_first->op_sibling = first;
void
Perl_package(pTHX_ OP *o)
{
- char *name;
+ const char *name;
STRLEN len;
save_hptr(&PL_curstash);
meth = newSVpvn("VERSION",7);
sv_upgrade(meth, SVt_PVIV);
(void)SvIOK_on(meth);
- PERL_HASH(SvUVX(meth), SvPVX(meth), SvCUR(meth));
+ {
+ U32 hash;
+ PERL_HASH(hash, SvPVX(meth), SvCUR(meth));
+ SvUV_set(meth, hash);
+ }
veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
append_elem(OP_LIST,
prepend_elem(OP_LIST, pack, list(version)),
meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);
(void)SvUPGRADE(meth, SVt_PVIV);
(void)SvIOK_on(meth);
- PERL_HASH(SvUVX(meth), SvPVX(meth), SvCUR(meth));
+ {
+ U32 hash;
+ PERL_HASH(hash, SvPVX(meth), SvCUR(meth));
+ SvUV_set(meth, hash);
+ }
imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
append_elem(OP_LIST,
prepend_elem(OP_LIST, pack, list(arg)),
}
}
{
- line_t ocopline = PL_copline;
- COP *ocurcop = PL_curcop;
- int oexpect = PL_expect;
+ const line_t ocopline = PL_copline;
+ COP * const ocurcop = PL_curcop;
+ const int oexpect = PL_expect;
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
veop, modname, imop);
}
STATIC I32
-S_list_assignment(pTHX_ register OP *o)
+S_list_assignment(pTHX_ register const OP *o)
{
if (!o)
return TRUE;
o = cUNOPo->op_first;
if (o->op_type == OP_COND_EXPR) {
- I32 t = list_assignment(cLOGOPo->op_first->op_sibling);
- I32 f = list_assignment(cLOGOPo->op_first->op_sibling->op_sibling);
+ const I32 t = list_assignment(cLOGOPo->op_first->op_sibling);
+ const I32 f = list_assignment(cLOGOPo->op_first->op_sibling->op_sibling);
if (t && f)
return TRUE;
GV *gv = cGVOPx_gv(curop);
if (gv == PL_defgv || (int)SvCUR(gv) == PL_generation)
break;
- SvCUR(gv) = PL_generation;
+ SvCUR_set(gv, PL_generation);
}
else if (curop->op_type == OP_PADSV ||
curop->op_type == OP_PADAV ||
if (PAD_COMPNAME_GEN(curop->op_targ)
== (STRLEN)PL_generation)
break;
- PAD_COMPNAME_GEN(curop->op_targ)
- = PL_generation;
+ PAD_COMPNAME_GEN_set(curop->op_targ, PL_generation);
}
else if (curop->op_type == OP_RV2CV)
#endif
if (gv == PL_defgv || (int)SvCUR(gv) == PL_generation)
break;
- SvCUR(gv) = PL_generation;
+ SvCUR_set(gv, PL_generation);
}
}
else
SV **svp = av_fetch(CopFILEAV(PL_curcop), (I32)CopLINE(cop), FALSE);
if (svp && *svp != &PL_sv_undef ) {
(void)SvIOK_on(*svp);
- SvIVX(*svp) = PTR2IV(cop);
+ SvIV_set(*svp, PTR2IV(cop));
}
}
}
else {
/* check for C<my $x if 0>, or C<my($x,$y) if 0> */
- OP *o2 = other;
+ const OP *o2 = other;
if ( ! (o2->op_type == OP_LIST
&& (( o2 = cUNOPx(o2)->op_first))
&& o2->op_type == OP_PUSHMARK
else if (ckWARN(WARN_MISC) && (first->op_flags & OPf_KIDS) &&
type != OP_DOR) /* [#24076] Don't warn for <FH> err FOO. */
{
- OP *k1 = ((UNOP*)first)->op_first;
- OP *k2 = k1->op_sibling;
+ const OP *k1 = ((UNOP*)first)->op_first;
+ const OP *k2 = k1->op_sibling;
OPCODE warnop = 0;
switch (first->op_type)
{
break;
}
if (warnop) {
- line_t oldline = CopLINE(PL_curcop);
+ const line_t oldline = CopLINE(PL_curcop);
CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ packWARN(WARN_MISC),
"Value of %s%s can be \"0\"; test with defined()",
*/
SV *
-Perl_op_const_sv(pTHX_ OP *o, CV *cv)
+Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
{
SV *sv = Nullsv;
Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
{
STRLEN n_a;
- char *name;
- char *aname;
+ const char *name;
+ const char *aname;
GV *gv;
char *ps;
register CV *cv=0;
const_sv = op_const_sv(block, Nullcv);
if (cv) {
- bool exists = CvROOT(cv) || CvXSUB(cv);
+ const bool exists = CvROOT(cv) || CvXSUB(cv);
#ifdef GV_UNIQUE_CHECK
if (exists && GvUNIQUE(gv)) {
|| (CvCONST(cv)
&& (!const_sv || sv_cmp(cv_const_sv(cv), const_sv))))
{
- line_t oldline = CopLINE(PL_curcop);
+ const line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NOLINE)
CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
op_free(block);
block = Nullop;
if (name) {
- char *s = strrchr(name, ':');
+ const char *s = strrchr(name, ':');
s = s ? s+1 : name;
if (strEQ(s, "BEGIN")) {
const char not_safe[] =
}
if (name || aname) {
- char *s;
- char *tname = (name ? name : aname);
+ const char *s;
+ const char *tname = (name ? name : aname);
if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
SV *sv = NEWSV(0,0);
goto done;
if (strEQ(s, "BEGIN") && !PL_error_count) {
- I32 oldscope = PL_scopestack_ix;
+ const I32 oldscope = PL_scopestack_ix;
ENTER;
SAVECOPFILE(&PL_compiling);
SAVECOPLINE(&PL_compiling);
/* already defined (or promised) */
if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv))
&& strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
- line_t oldline = CopLINE(PL_curcop);
+ const line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NOLINE)
CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
}
CvGV(cv) = gv;
(void)gv_fetchfile(filename);
- CvFILE(cv) = filename; /* NOTE: not copied, as it is expected to be
+ CvFILE(cv) = (char *)filename; /* NOTE: not copied, as it is expected to be
an external constant string */
CvXSUB(cv) = subaddr;
GvMULTI_on(gv);
if ((cv = GvFORM(gv))) {
if (ckWARN(WARN_REDEFINE)) {
- line_t oldline = CopLINE(PL_curcop);
+ const line_t oldline = CopLINE(PL_curcop);
if (PL_copline != NOLINE)
CopLINE_set(PL_curcop, PL_copline);
Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
/* STUB */
(void)o;
+#ifndef HASATTRIBUTE
+ /* No __attribute__, so the compiler doesn't know that croak never returns
+ */
+ return 0;
+#endif
}
OP *
|| o->op_type == OP_BIT_AND
|| o->op_type == OP_BIT_XOR))
{
- OP * left = cBINOPo->op_first;
- OP * right = left->op_sibling;
+ const OP * left = cBINOPo->op_first;
+ const OP * right = left->op_sibling;
if ((OP_IS_NUMCOMPARE(left->op_type) &&
(left->op_flags & OPf_PARENS) == 0) ||
(OP_IS_NUMCOMPARE(right->op_type) &&
OP *
Perl_ck_concat(pTHX_ OP *o)
{
- OP *kid = cUNOPo->op_first;
+ const OP *kid = cUNOPo->op_first;
if (kid->op_type == OP_CONCAT && !(kid->op_private & OPpTARGET_MY) &&
!(kUNOP->op_first->op_flags & OPf_MOD))
o->op_flags |= OPf_STACKED;
if (o->op_flags & OPf_KIDS) {
OP* newop;
OP* kid;
- OPCODE type = o->op_type;
+ const OPCODE type = o->op_type;
o = modkids(ck_fun(o), type);
kid = cUNOPo->op_first;
newop = kUNOP->op_first->op_sibling;
OP *
Perl_ck_eof(pTHX_ OP *o)
{
- I32 type = o->op_type;
+ const I32 type = o->op_type;
if (o->op_flags & OPf_KIDS) {
if (cLISTOPo->op_first->op_type == OP_STUB) {
OP *
Perl_ck_exec(pTHX_ OP *o)
{
- OP *kid;
if (o->op_flags & OPf_STACKED) {
+ OP *kid;
o = ck_fun(o);
kid = cUNOPo->op_first->op_sibling;
if (kid->op_type == OP_RV2GV)
OP *
Perl_ck_ftst(pTHX_ OP *o)
{
- I32 type = o->op_type;
+ const I32 type = o->op_type;
if (o->op_flags & OPf_REF) {
/* nothing */
OP *
Perl_ck_fun(pTHX_ OP *o)
{
- register OP *kid;
- OP **tokid;
- OP *sibl;
- I32 numargs = 0;
- int type = o->op_type;
+ const int type = o->op_type;
register I32 oa = PL_opargs[type] >> OASHIFT;
if (o->op_flags & OPf_STACKED) {
}
if (o->op_flags & OPf_KIDS) {
- tokid = &cLISTOPo->op_first;
- kid = cLISTOPo->op_first;
+ OP **tokid = &cLISTOPo->op_first;
+ register OP *kid = cLISTOPo->op_first;
+ OP *sibl;
+ I32 numargs = 0;
+
if (kid->op_type == OP_PUSHMARK ||
(kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK))
{
else if (op->op_type == OP_PADAV
|| op->op_type == OP_PADHV) {
/* lexicalvar $a[] or $h{} */
- char *padname =
+ const char *padname =
PAD_COMPNAME_PV(op->op_targ);
if (padname)
tmpstr =
{
LOGOP *gwop;
OP *kid;
- OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
+ const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
I32 offset;
o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
OP* k;
o = ck_sort(o);
kid = cLISTOPo->op_first->op_sibling;
+ if (!cUNOPx(kid)->op_next)
+ Perl_croak(aTHX_ "panic: ck_grep");
for (k = cUNOPx(kid)->op_first; k; k = k->op_next) {
kid = k;
}
OP *
Perl_ck_lfun(pTHX_ OP *o)
{
- OPCODE type = o->op_type;
+ const OPCODE type = o->op_type;
return modkids(ck_fun(o), type);
}
OP *
Perl_ck_rfun(pTHX_ OP *o)
{
- OPCODE type = o->op_type;
+ const OPCODE type = o->op_type;
return refkids(ck_fun(o), type);
}
Perl_ck_match(pTHX_ OP *o)
{
if (o->op_type != OP_QR) {
- I32 offset = pad_findmy("$_");
+ const I32 offset = pad_findmy("$_");
if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS(offset) & SVpad_OUR)) {
o->op_targ = offset;
o->op_private |= OPpTARGET_MY;
if (*s == ':' && s[1] == ':') {
*s = '/';
Move(s+2, s+1, strlen(s+2)+1, char);
- --SvCUR(kid->op_sv);
+ SvCUR_set(kid->op_sv, SvCUR(kid->op_sv) - 1);
}
}
if (SvREADONLY(kid->op_sv)) {
OP *
Perl_ck_return(pTHX_ OP *o)
{
- OP *kid;
if (CvLVALUE(PL_compcv)) {
+ OP *kid;
for (kid = cLISTOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
mod(kid, OP_LEAVESUBLV);
}
OP *
Perl_ck_shift(pTHX_ OP *o)
{
- I32 type = o->op_type;
+ const I32 type = o->op_type;
if (!(o->op_flags & OPf_KIDS)) {
OP *argop;
Perl_ck_join(pTHX_ OP *o)
{
if (ckWARN(WARN_SYNTAX)) {
- OP *kid = cLISTOPo->op_first->op_sibling;
+ const OP *kid = cLISTOPo->op_first->op_sibling;
if (kid && kid->op_type == OP_MATCH) {
- const char *pmstr = "STRING";
- if (PM_GETRE(kPMOP))
- pmstr = PM_GETRE(kPMOP)->precomp;
+ const REGEXP *re = PM_GETRE(kPMOP);
+ const char *pmstr = re ? re->precomp : "STRING";
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"/%s/ should probably be written as \"%s\"",
pmstr, pmstr);
I32 contextclass = 0;
char *e = 0;
STRLEN n_a;
- bool delete=0;
+ bool delete_op = 0;
o->op_private |= OPpENTERSUB_HASTARG;
for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
o->op_private |= OPpENTERSUB_DB;
}
else {
- delete=1;
+ delete_op = 1;
if (ckWARN(WARN_ASSERTIONS) && !(PL_hints & HINT_ASSERTIONSSEEN)) {
Perl_warner(aTHX_ packWARN(WARN_ASSERTIONS),
"Impossible to activate assertion call");
break;
case ']':
if (contextclass) {
- char *p = proto;
- char s = *p;
+ char *p = proto;
+ const char s = *p;
contextclass = 0;
*p = '\0';
while (*--p != '[');
if (proto && !optional &&
(*proto && *proto != '@' && *proto != '%' && *proto != ';'))
return too_few_arguments(o, gv_ename(namegv));
- if(delete) {
+ if(delete_op) {
op_free(o);
o=newSVOP(OP_CONST, 0, newSViv(0));
}
* Despite being a "constant", the SV is written to,
* for reference counts, sv_upgrade() etc. */
if (cSVOP->op_sv) {
- PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP);
+ const PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP);
if (o->op_type == OP_CONST && SvPADTMP(cSVOPo->op_sv)) {
/* If op_sv is already a PADTMP then it is being used by
* some pad, so make a copy. */
o->op_next->op_sibling->op_type != OP_EXIT &&
o->op_next->op_sibling->op_type != OP_WARN &&
o->op_next->op_sibling->op_type != OP_DIE) {
- line_t oldline = CopLINE(PL_curcop);
+ const line_t oldline = CopLINE(PL_curcop);
CopLINE_set(PL_curcop, CopLINE((COP*)o->op_next));
Perl_warner(aTHX_ packWARN(WARN_EXEC),
LEAVE;
}
-
-
-const char* Perl_custom_op_name(pTHX_ const OP* o)
+char*
+Perl_custom_op_name(pTHX_ const OP* o)
{
const IV index = PTR2IV(o->op_ppaddr);
SV* keysv;
return SvPV_nolen(HeVAL(he));
}
-const char* Perl_custom_op_desc(pTHX_ const OP* o)
+char*
+Perl_custom_op_desc(pTHX_ const OP* o)
{
const IV index = PTR2IV(o->op_ppaddr);
SV* keysv;
return SvPV_nolen(HeVAL(he));
}
-
#include "XSUB.h"
/* Efficient sub that returns a constant scalar value. */
ST(0) = (SV*)XSANY.any_ptr;
XSRETURN(1);
}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * vim: shiftwidth=4:
+*/
projects / p5sagit/p5-mst-13.2.git / blobdiff