#define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o))
-#ifdef PERL_OBJECT
-#define CALLOP this->*PL_op
-#else
-#define CALLOP *PL_op
-#endif
-
static I32 sortcv(pTHXo_ SV *a, SV *b);
static I32 sv_ncmp(pTHXo_ SV *a, SV *b);
static I32 sv_i_ncmp(pTHXo_ SV *a, SV *b);
*rsp = (void*)p;
}
- *p++ = (UV)(RX_MATCH_COPIED(rx) ? rx->subbeg : Nullch);
+ *p++ = PTR2UV(RX_MATCH_COPIED(rx) ? rx->subbeg : Nullch);
RX_MATCH_COPIED_off(rx);
*p++ = rx->nparens;
- *p++ = (UV)rx->subbeg;
+ *p++ = PTR2UV(rx->subbeg);
*p++ = (UV)rx->sublen;
for (i = 0; i <= rx->nparens; ++i) {
*p++ = (UV)rx->startp[i];
rx->nparens = *p++;
- rx->subbeg = (char*)(*p++);
+ rx->subbeg = INT2PTR(char*,*p++);
rx->sublen = (I32)(*p++);
for (i = 0; i <= rx->nparens; ++i) {
rx->startp[i] = (I32)(*p++);
UV *p = (UV*)*rsp;
if (p) {
- Safefree((char*)(*p));
+ Safefree(INT2PTR(char*,*p));
Safefree(p);
*rsp = Null(void*);
}
RESTORE_NUMERIC_LOCAL();
#if defined(USE_LONG_DOUBLE)
if (arg & 256) {
- sprintf(t, "%#*.*Lf",
+ sprintf(t, "%#*.*" PERL_PRIfldbl,
(int) fieldsize, (int) arg & 255, value);
} else {
- sprintf(t, "%*.0Lf", (int) fieldsize, value);
+ sprintf(t, "%*.0" PERL_PRIfldbl, (int) fieldsize, value);
}
#else
if (arg & 256) {
(looks_like_number(left) && *SvPVX(left) != '0') )
{
if (SvNV(left) < IV_MIN || SvNV(right) > IV_MAX)
- Perl_croak(aTHX_ "Range iterator outside integer range");
+ DIE(aTHX_ "Range iterator outside integer range");
i = SvIV(left);
max = SvIV(right);
if (max >= i) {
}
}
+void
+Perl_qerror(pTHX_ SV *err)
+{
+ if (PL_in_eval)
+ sv_catsv(ERRSV, err);
+ else if (PL_errors)
+ sv_catsv(PL_errors, err);
+ else
+ Perl_warn(aTHX_ "%_", err);
+ ++PL_error_count;
+}
+
OP *
Perl_die_where(pTHX_ char *message, STRLEN msglen)
{
else
message = SvPVx(ERRSV, msglen);
- while ((cxix = dopoptoeval(cxstack_ix)) < 0 && PL_curstackinfo->si_prev) {
+ while ((cxix = dopoptoeval(cxstack_ix)) < 0
+ && PL_curstackinfo->si_prev)
+ {
dounwind(-1);
POPSTACK;
}
if (optype == OP_REQUIRE) {
char* msg = SvPVx(ERRSV, n_a);
- DIE(aTHX_ "%s", *msg ? msg : "Compilation failed in require");
+ DIE(aTHX_ "%sCompilation failed in require",
+ *msg ? msg : "Unknown error\n");
}
return pop_return();
}
(looks_like_number(sv) && *SvPVX(sv) != '0')) {
if (SvNV(sv) < IV_MIN ||
SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX)
- Perl_croak(aTHX_ "Range iterator outside integer range");
+ DIE(aTHX_ "Range iterator outside integer range");
cx->blk_loop.iterix = SvIV(sv);
cx->blk_loop.itermax = SvIV((SV*)cx->blk_loop.iterary);
}
*ops++ = cUNOPo->op_first;
if (ops >= oplimit)
Perl_croak(aTHX_ too_deep);
- *ops = 0;
}
+ *ops = 0;
if (o->op_flags & OPf_KIDS) {
dTHR;
/* First try all the kids at this level, since that's likeliest. */
for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
- if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
- && kCOP->cop_label && strEQ(kCOP->cop_label, label))
- {
+ if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
+ kCOP->cop_label && strEQ(kCOP->cop_label, label))
return kid;
- }
}
for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
if (kid == PL_lastgotoprobe)
continue;
- if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
- && (ops == opstack || (ops[-1]->op_type != OP_NEXTSTATE
- && ops[-1]->op_type != OP_DBSTATE)))
- {
+ if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
+ (ops == opstack ||
+ (ops[-1]->op_type != OP_NEXTSTATE &&
+ ops[-1]->op_type != OP_DBSTATE)))
*ops++ = kid;
- *ops = 0;
- }
if (o = dofindlabel(kid, label, ops, oplimit))
return o;
}
}
+ *ops = 0;
return 0;
}
SV** mark;
I32 items = 0;
I32 oldsave;
- int arg_was_real = 0;
retry:
if (!CvROOT(cv) && !CvXSUB(cv)) {
if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL)
DIE(aTHX_ "Can't goto subroutine from an eval-string");
mark = PL_stack_sp;
- if (CxTYPE(cx) == CXt_SUB &&
- cx->blk_sub.hasargs) { /* put @_ back onto stack */
+ if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
+ /* put @_ back onto stack */
AV* av = cx->blk_sub.argarray;
items = AvFILLp(av) + 1;
SvREFCNT_dec(GvAV(PL_defgv));
GvAV(PL_defgv) = cx->blk_sub.savearray;
#endif /* USE_THREADS */
+ /* abandon @_ if it got reified */
if (AvREAL(av)) {
- arg_was_real = 1;
- AvREAL_off(av); /* so av_clear() won't clobber elts */
+ (void)sv_2mortal((SV*)av); /* delay until return */
+ av = newAV();
+ av_extend(av, items-1);
+ AvFLAGS(av) = AVf_REIFY;
+ PL_curpad[0] = (SV*)(cx->blk_sub.argarray = av);
}
- av_clear(av);
}
else if (CvXSUB(cv)) { /* put GvAV(defgv) back onto stack */
AV* av;
}
Copy(mark,AvARRAY(av),items,SV*);
AvFILLp(av) = items - 1;
- /* preserve @_ nature */
- if (arg_was_real) {
- AvREIFY_off(av);
- AvREAL_on(av);
- }
+ assert(!AvREAL(av));
while (items--) {
if (*mark)
SvTEMP_off(*mark);
CV *gotocv;
if (PERLDB_SUB_NN) {
- SvIVX(sv) = (IV)cv; /* Already upgraded, saved */
+ SvIVX(sv) = PTR2IV(cv); /* Already upgraded, saved */
} else {
save_item(sv);
gv_efullname3(sv, CvGV(cv), Nullch);
if (PL_op->op_type == OP_ENTERITER)
DIE(aTHX_ "Can't \"goto\" into the middle of a foreach loop",
label);
- (CALLOP->op_ppaddr)(aTHX);
+ CALL_FPTR(PL_op->op_ppaddr)(aTHX);
}
PL_op = oldop;
}
LEAVE;
if (optype == OP_REQUIRE) {
char* msg = SvPVx(ERRSV, n_a);
- DIE(aTHX_ "%s", *msg ? msg : "Compilation failed in require");
- } else if (startop) {
+ DIE(aTHX_ "%sCompilation failed in require",
+ *msg ? msg : "Unknown error\n");
+ }
+ else if (startop) {
char* msg = SvPVx(ERRSV, n_a);
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
- Perl_croak(aTHX_ "%sCompilation failed in regexp", (*msg ? msg : "Unknown error\n"));
+ Perl_croak(aTHX_ "%sCompilation failed in regexp",
+ (*msg ? msg : "Unknown error\n"));
}
SvREFCNT_dec(PL_rs);
PL_rs = SvREFCNT_inc(PL_nrs);
save the gv to manage the lifespan of
the pipe, but this didn't help. XXX */
filter_child_proc = (GV *)arg;
- SvREFCNT_inc(filter_child_proc);
+ (void)SvREFCNT_inc(filter_child_proc);
}
else {
if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVCV) {
filter_sub = arg;
- SvREFCNT_inc(filter_sub);
+ (void)SvREFCNT_inc(filter_sub);
if (i < count) {
filter_state = SP[i];
- SvREFCNT_inc(filter_state);
+ (void)SvREFCNT_inc(filter_state);
}
if (tryrsfp == 0) {
projects / p5sagit/p5-mst-13.2.git / blobdiff