#include "EXTERN.h"
#include "perl.h"
+#ifdef PERL_OBJECT
+#define CHECKCALL this->*check
+#else
+#define CHECKCALL *check
+#endif
+
/*
* In the following definition, the ", Nullop" is just to make the compiler
* think the expression is of the right type: croak actually does a Siglongjmp.
? ( op_free((OP*)o), \
croak("%s trapped by operation mask", op_desc[type]), \
Nullop ) \
- : (*check[type])((OP*)o))
+ : (CHECKCALL[type])((OP*)o))
+static bool scalar_mod_type _((OP *o, I32 type));
+#ifndef PERL_OBJECT
static I32 list_assignment _((OP *o));
static void bad_type _((I32 n, char *t, char *name, OP *kid));
static OP *modkids _((OP *o, I32 type));
static OP *no_fh_allowed _((OP *o));
-static bool scalar_mod_type _((OP *o, I32 type));
static OP *scalarboolean _((OP *o));
static OP *too_few_arguments _((OP *o, char* name));
static OP *too_many_arguments _((OP *o, char* name));
CV* startcv, I32 cx_ix));
static OP *newDEFSVOP _((void));
static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
+#endif
-static char*
+STATIC char*
gv_ename(GV *gv)
{
SV* tmpsv = sv_newmortal();
return SvPV(tmpsv,na);
}
-static OP *
+STATIC OP *
no_fh_allowed(OP *o)
{
yyerror(form("Missing comma after first argument to %s function",
return o;
}
-static OP *
+STATIC OP *
too_few_arguments(OP *o, char *name)
{
yyerror(form("Not enough arguments for %s", name));
return o;
}
-static OP *
+STATIC OP *
too_many_arguments(OP *o, char *name)
{
yyerror(form("Too many arguments for %s", name));
return o;
}
-static void
+STATIC void
bad_type(I32 n, char *t, char *name, OP *kid)
{
yyerror(form("Type of arg %d to %s must be %s (not %s)",
return off;
}
-static PADOFFSET
+STATIC PADOFFSET
pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
{
dTHR;
break;
#endif /* USE_THREADS */
default:
- if (!(o->op_flags & OPf_REF) || (check[o->op_type] != ck_ftst))
+ if (!(o->op_flags & OPf_REF)
+ || (check[o->op_type] != FUNC_NAME_TO_PTR(ck_ftst)))
break;
/* FALL THROUGH */
case OP_GVSV:
Safefree(o);
}
-static void
+STATIC void
null(OP *o)
{
if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
return o;
}
-static OP *
+STATIC OP *
scalarboolean(OP *o)
{
if (dowarn &&
return o;
}
-static OP *
+STATIC OP *
modkids(OP *o, I32 type)
{
OP *kid;
return retval;
}
-static OP *
+STATIC OP *
newDEFSVOP(void)
{
#ifdef USE_THREADS
curop = LINKLIST(o);
o->op_next = 0;
op = curop;
- runops();
+ CALLRUNOPS();
sv = *(stack_sp--);
if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */
pad_swipe(o->op_targ);
op = curop = LINKLIST(o);
o->op_next = 0;
pp_pushmark(ARGS);
- runops();
+ CALLRUNOPS();
op = curop;
pp_anonlist(ARGS);
tmps_floor = oldtmps_floor;
list(force_list(listval)) );
}
-static I32
+STATIC I32
list_assignment(register OP *o)
{
if (!o)
list(force_list(left)) );
o->op_private = 0 | (flags >> 8);
if (!(left->op_private & OPpLVAL_INTRO)) {
- static int generation = 100;
OP *curop;
OP *lastop = o;
generation++;
return new_logop(type, flags, &first, &other);
}
-static OP *
+STATIC OP *
new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
{
dTHR;
}
#ifdef DEBUG_CLOSURES
-static void
+STATIC void
cv_dump(cv)
CV* cv;
{
}
#endif /* DEBUG_CLOSURES */
-static CV *
+STATIC CV *
cv_clone2(CV *proto, CV *outside)
{
dTHR;
SV *
cv_const_sv(CV *cv)
{
- OP *o;
- SV *sv;
-
if (!cv || !SvPOK(cv) || SvCUR(cv))
return Nullsv;
+ return op_const_sv(CvSTART(cv), cv);
+}
- sv = Nullsv;
- for (o = CvSTART(cv); o; o = o->op_next) {
+SV *
+op_const_sv(OP *o, CV *cv)
+{
+ SV *sv = Nullsv;
+
+ if(!o)
+ return Nullsv;
+
+ if(o->op_type == OP_LINESEQ && cLISTOPo->op_first)
+ o = cLISTOPo->op_first->op_sibling;
+
+ for (; o; o = o->op_next) {
OPCODE type = o->op_type;
-
+
+ if(sv && o->op_next == o)
+ return sv;
if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
continue;
if (type == OP_LEAVESUB || type == OP_RETURN)
return Nullsv;
if (type == OP_CONST)
sv = cSVOPo->op_sv;
- else if (type == OP_PADSV) {
+ else if (type == OP_PADSV && cv) {
AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
/* already defined (or promised)? */
if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
SV* const_sv;
+ bool const_changed = TRUE;
if (!block) {
/* just a "sub foo;" when &foo is already defined */
SAVEFREESV(compcv);
/* ahem, death to those who redefine active sort subs */
if (curstackinfo->si_type == SI_SORT && sortcop == CvSTART(cv))
croak("Can't redefine active sort subroutine %s", name);
- const_sv = cv_const_sv(cv);
- if (const_sv || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
+ if(const_sv = cv_const_sv(cv))
+ const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
+ if ((const_sv && const_changed) || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
&& HvNAME(GvSTASH(CvGV(cv)))
&& strEQ(HvNAME(GvSTASH(CvGV(cv))),
"autouse"))) {
}
CV *
-newXS(char *name, void (*subaddr) (CV *), char *filename)
+newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename)
{
dTHR;
GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);