dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
{
dPOPTOPssrl;
- STRLEN llen;
- char* lpv;
bool lbyte;
STRLEN rlen;
- char* rpv = SvPV(right, rlen); /* mg_get(right) happens here */
- bool rbyte = !DO_UTF8(right), rcopied = FALSE;
+ const char *rpv = SvPV(right, rlen); /* mg_get(right) happens here */
+ const bool rbyte = !DO_UTF8(right);
+ bool rcopied = FALSE;
if (TARG == right && right != left) {
right = sv_2mortal(newSVpvn(rpv, rlen));
}
if (TARG != left) {
- lpv = SvPV(left, llen); /* mg_get(left) may happen here */
+ STRLEN llen;
+ const char* const lpv = SvPV(left, llen); /* mg_get(left) may happen here */
lbyte = !DO_UTF8(left);
sv_setpvn(TARG, lpv, llen);
if (!lbyte)
SvUTF8_off(TARG);
}
else { /* TARG == left */
+ STRLEN llen;
if (SvGMAGICAL(left))
mg_get(left); /* or mg_get(left) may happen here */
if (!SvOK(TARG))
- sv_setpv(left, "");
- lpv = SvPV_nomg(left, llen);
+ sv_setpvn(left, "", 0);
+ (void)SvPV_nomg(left, llen); /* Needed to set UTF8 flag */
lbyte = !DO_UTF8(left);
if (IN_BYTES)
SvUTF8_off(TARG);
{
/* Most of this is lifted straight from pp_defined */
dSP;
- register SV* sv;
+ register SV* const sv = TOPs;
- sv = TOPs;
if (!sv || !SvANY(sv)) {
--SP;
RETURNOP(cLOGOP->op_other);
if ((auvok = SvUOK(TOPm1s)))
auv = SvUVX(TOPm1s);
else {
- register IV aiv = SvIVX(TOPm1s);
+ register const IV aiv = SvIVX(TOPm1s);
if (aiv >= 0) {
auv = aiv;
auvok = 1; /* Now acting as a sign flag. */
if (buvok)
buv = SvUVX(TOPs);
else {
- register IV biv = SvIVX(TOPs);
+ register const IV biv = SvIVX(TOPs);
if (biv >= 0) {
buv = biv;
buvok = 1;
dSP;
AV *av = PL_op->op_flags & OPf_SPECIAL ?
(AV*)PAD_SV(PL_op->op_targ) : GvAV(cGVOP_gv);
- U32 lval = PL_op->op_flags & OPf_MOD;
+ const U32 lval = PL_op->op_flags & OPf_MOD;
SV** svp = av_fetch(av, PL_op->op_private, lval);
SV *sv = (svp ? *svp : &PL_sv_undef);
EXTEND(SP, 1);
PP(pp_print)
{
- dSP; dMARK; dORIGMARK;
+ dVAR; dSP; dMARK; dORIGMARK;
GV *gv;
IO *io;
register PerlIO *fp;
}
if (GIMME == G_ARRAY) {
- I32 maxarg = AvFILL(av) + 1;
+ const I32 maxarg = AvFILL(av) + 1;
(void)POPs; /* XXXX May be optimized away? */
EXTEND(SP, maxarg);
if (SvRMAGICAL(av)) {
}
else if (GIMME_V == G_SCALAR) {
dTARGET;
- I32 maxarg = AvFILL(av) + 1;
+ const I32 maxarg = AvFILL(av) + 1;
SETi(maxarg);
}
RETURN;
{
dSP; dTOPss;
HV *hv;
- I32 gimme = GIMME_V;
+ const I32 gimme = GIMME_V;
+ static const char return_hash_to_lvalue_scalar[] = "Can't return hash to lvalue scalar context";
if (SvROK(sv)) {
wasref:
}
else if (LVRET) {
if (gimme != G_ARRAY)
- Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
+ Perl_croak(aTHX_ return_hash_to_lvalue_scalar );
SETs((SV*)hv);
RETURN;
}
}
else if (LVRET) {
if (gimme != G_ARRAY)
- Perl_croak(aTHX_ "Can't return hash to lvalue"
- " scalar context");
+ Perl_croak(aTHX_ return_hash_to_lvalue_scalar );
SETs((SV*)hv);
RETURN;
}
}
else if (LVRET) {
if (gimme != G_ARRAY)
- Perl_croak(aTHX_ "Can't return hash to lvalue"
- " scalar context");
+ Perl_croak(aTHX_ return_hash_to_lvalue_scalar );
SETs((SV*)hv);
RETURN;
}
HE *didstore;
if (ckWARN(WARN_MISC)) {
+ const char *err;
if (relem == firstrelem &&
SvROK(*relem) &&
(SvTYPE(SvRV(*relem)) == SVt_PVAV ||
SvTYPE(SvRV(*relem)) == SVt_PVHV))
{
- Perl_warner(aTHX_ packWARN(WARN_MISC),
- "Reference found where even-sized list expected");
+ err = "Reference found where even-sized list expected";
}
else
- Perl_warner(aTHX_ packWARN(WARN_MISC),
- "Odd number of elements in hash assignment");
+ err = "Odd number of elements in hash assignment";
+ Perl_warner(aTHX_ packWARN(WARN_MISC), err);
}
tmpstr = NEWSV(29,0);
PP(pp_aassign)
{
- dSP;
+ dVAR; dSP;
SV **lastlelem = PL_stack_sp;
SV **lastrelem = PL_stack_base + POPMARK;
SV **firstrelem = PL_stack_base + POPMARK + 1;
char *truebase; /* Start of string */
register REGEXP *rx = PM_GETRE(pm);
bool rxtainted;
- I32 gimme = GIMME;
+ const I32 gimme = GIMME;
STRLEN len;
I32 minmatch = 0;
- I32 oldsave = PL_savestack_ix;
+ const I32 oldsave = PL_savestack_ix;
I32 update_minmatch = 1;
I32 had_zerolen = 0;
RX_MATCH_TAINTED_on(rx);
TAINT_IF(RX_MATCH_TAINTED(rx));
if (gimme == G_ARRAY) {
- I32 nparens, i, len;
+ const I32 nparens = rx->nparens;
+ I32 i = (global && !nparens) ? 1 : 0;
+ I32 len;
- nparens = rx->nparens;
- if (global && !nparens)
- i = 1;
- else
- i = 0;
SPAGAIN; /* EVAL blocks could move the stack. */
EXTEND(SP, nparens + i);
EXTEND_MORTAL(nparens + i);
OP *
Perl_do_readline(pTHX)
{
- dSP; dTARGETSTACKED;
+ dVAR; dSP; dTARGETSTACKED;
register SV *sv;
STRLEN tmplen = 0;
STRLEN offset;
PerlIO *fp;
- register IO *io = GvIO(PL_last_in_gv);
- register I32 type = PL_op->op_type;
- I32 gimme = GIMME_V;
+ register IO * const io = GvIO(PL_last_in_gv);
+ register const I32 type = PL_op->op_type;
+ const I32 gimme = GIMME_V;
MAGIC *mg;
if (io && (mg = SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar))) {
PP(pp_enter)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
I32 gimme = OP_GIMME(PL_op, -1);
SV **svp;
SV *keysv = POPs;
HV *hv = (HV*)POPs;
- U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
- U32 defer = PL_op->op_private & OPpLVAL_DEFER;
+ const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
+ const U32 defer = PL_op->op_private & OPpLVAL_DEFER;
SV *sv;
#ifdef PERL_COPY_ON_WRITE
- U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvUVX(keysv) : 0;
+ const U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvUVX(keysv) : 0;
#else
- U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0;
+ const U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0;
#endif
I32 preeminent = 0;
SV* lv;
SV* key2;
if (!defer) {
- STRLEN n_a;
- DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
+ DIE(aTHX_ PL_no_helem_sv, keysv);
}
lv = sv_newmortal();
sv_upgrade(lv, SVt_PVLV);
RETURN;
}
if (PL_op->op_private & OPpLVAL_INTRO) {
- if (HvNAME(hv) && isGV(*svp))
+ if (HvNAME_get(hv) && isGV(*svp))
save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL));
else {
if (!preeminent) {
STRLEN keylen;
- char *key = SvPV(keysv, keylen);
+ const char * const key = SvPV(keysv, keylen);
SAVEDELETE(hv, savepvn(key,keylen), keylen);
} else
save_helem(hv, keysv, svp);
PP(pp_leave)
{
- dSP;
+ dVAR; dSP;
register PERL_CONTEXT *cx;
- register SV **mark;
SV **newsp;
PMOP *newpm;
I32 gimme;
if (gimme == G_VOID)
SP = newsp;
else if (gimme == G_SCALAR) {
+ register SV **mark;
MARK = newsp + 1;
if (MARK <= SP) {
if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
}
else if (gimme == G_ARRAY) {
/* in case LEAVE wipes old return values */
+ register SV **mark;
for (mark = newsp + 1; mark <= SP; mark++) {
if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) {
*mark = sv_mortalcopy(*mark);
} else
#endif
{
- SvOOK_off(TARG);
- if (SvLEN(TARG))
- Safefree(SvPVX(TARG));
+ SvPV_free(TARG);
}
SvPV_set(TARG, SvPVX(dstr));
SvCUR_set(TARG, SvCUR(dstr));
PP(pp_grepwhile)
{
- dSP;
+ dVAR; dSP;
if (SvTRUEx(POPs))
PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr];
PP(pp_leavesub)
{
- dSP;
+ dVAR; dSP;
SV **mark;
SV **newsp;
PMOP *newpm;
* get any slower by more conditions */
PP(pp_leavesublv)
{
- dSP;
+ dVAR; dSP;
SV **mark;
SV **newsp;
PMOP *newpm;
}
}
else {
- int type = SvTYPE(dbsv);
+ const int type = SvTYPE(dbsv);
if (type < SVt_PVIV && type != SVt_IV)
sv_upgrade(dbsv, SVt_PVIV);
(void)SvIOK_on(dbsv);
PP(pp_entersub)
{
- dSP; dPOPss;
+ dVAR; dSP; dPOPss;
GV *gv;
HV *stash;
register CV *cv;
register PERL_CONTEXT *cx;
I32 gimme;
- bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
+ const bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
if (!sv)
DIE(aTHX_ "Not a CODE reference");
break;
default:
if (!SvROK(sv)) {
- char *sym;
- STRLEN n_a;
-
+ const char *sym;
if (sv == &PL_sv_yes) { /* unfound import, ignore */
if (hasargs)
SP = PL_stack_base + POPMARK;
goto got_rv;
sym = SvPOKp(sv) ? SvPVX(sv) : Nullch;
}
- else
+ else {
+ STRLEN n_a;
sym = SvPV(sv, n_a);
+ }
if (!sym)
DIE(aTHX_ PL_no_usym, "a subroutine");
if (PL_op->op_private & HINT_STRICT_REFS)
if (hasargs)
{
AV* av;
- SV** ary;
-
#if 0
DEBUG_S(PerlIO_printf(Perl_debug_log,
"%p entersub preparing @_\n", thr));
++MARK;
if (items > AvMAX(av) + 1) {
- ary = AvALLOC(av);
+ SV **ary = AvALLOC(av);
if (AvARRAY(av) != ary) {
AvMAX(av) += AvARRAY(av) - AvALLOC(av);
SvPV_set(av, (char*)ary);
/* Need to copy @_ to stack. Alternative may be to
* switch stack to @_, and copy return values
* back. This would allow popping @_ in XSUB, e.g.. XXXX */
- AV* av;
- I32 items;
- av = GvAV(PL_defgv);
- items = AvFILLp(av) + 1; /* @_ is not tieable */
+ AV * const av = GvAV(PL_defgv);
+ const I32 items = AvFILLp(av) + 1; /* @_ is not tieable */
if (items) {
/* Mark is at the end of the stack. */
{
dSP;
SV** svp;
- SV* elemsv = POPs;
+ SV* const elemsv = POPs;
IV elem = SvIV(elemsv);
AV* av = (AV*)POPs;
const U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
svp = av_fetch(av, elem, lval && !defer);
if (lval) {
#ifdef PERL_MALLOC_WRAP
- static const char oom_array_extend[] =
- "Out of memory during array extend"; /* Duplicated in av.c */
if (SvUOK(elemsv)) {
- UV uv = SvUV(elemsv);
+ const UV uv = SvUV(elemsv);
elem = uv > IV_MAX ? IV_MAX : uv;
}
else if (SvNOK(elemsv))
elem = (IV)SvNV(elemsv);
- if (elem > 0)
+ if (elem > 0) {
+ static const char oom_array_extend[] =
+ "Out of memory during array extend"; /* Duplicated in av.c */
MEM_WRAP_CHECK_1(elem,SV*,oom_array_extend);
+ }
#endif
if (!svp || *svp == &PL_sv_undef) {
SV* lv;
if (SvTYPE(sv) < SVt_RV)
sv_upgrade(sv, SVt_RV);
else if (SvTYPE(sv) >= SVt_PV) {
- SvOOK_off(sv);
- Safefree(SvPVX(sv));
+ SvPV_free(sv);
SvLEN_set(sv, 0);
SvCUR_set(sv, 0);
}
SV* ob;
GV* gv;
HV* stash;
- char* name;
STRLEN namelen;
- char* packname = 0;
+ const char* packname = 0;
SV *packsv = Nullsv;
STRLEN packlen;
+ const char *name = SvPV(meth, namelen);
- name = SvPV(meth, namelen);
sv = *(PL_stack_base + TOPMARK + 1);
if (!sv)
cause UNIVERSAL->can("NoSuchPackage::foo") to croak, and we
don't want that.
*/
- char* leaf = name;
- char* sep = Nullch;
- char* p;
+ const char* leaf = name;
+ const char* sep = Nullch;
+ const char* p;
for (p = name; *p; p++) {
if (*p == '\'')
if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) {
/* the method name is unqualified or starts with SUPER:: */
packname = sep ? CopSTASHPV(PL_curcop) :
- stash ? HvNAME(stash) : packname;
+ stash ? HvNAME_get(stash) : packname;
if (!packname)
Perl_croak(aTHX_
"Can't use anonymous symbol table for method lookup");
* indent-tabs-mode: t
* End:
*
- * vim: shiftwidth=4:
-*/
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
projects / p5sagit/p5-mst-13.2.git / blobdiff