case FF_END: name = "END"; break;
}
if (arg >= 0)
- PerlIO_printf(PerlIO_stderr(), "%-16s%ld\n", name, (long) arg);
+ PerlIO_printf(Perl_debug_log, "%-16s%ld\n", name, (long) arg);
else
- PerlIO_printf(PerlIO_stderr(), "%-16s\n", name);
+ PerlIO_printf(Perl_debug_log, "%-16s\n", name);
} )
switch (*fpc++) {
case FF_LINEMARK:
(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) {
I32 optype;
while (cxstack_ix > cxix) {
+ SV *sv;
cx = &cxstack[cxstack_ix];
DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
(long) cxstack_ix, PL_block_type[CxTYPE(cx)]));
POPSUBST(cx);
continue; /* not break */
case CXt_SUB:
- POPSUB(cx);
+ POPSUB(cx,sv);
+ LEAVESUB(sv);
break;
case CXt_EVAL:
POPEVAL(cx);
if (message) {
if (PL_in_eval & EVAL_KEEPERR) {
- SV **svp;
-
- svp = hv_fetch(ERRHV, message, msglen, TRUE);
- if (svp) {
- if (!SvIOK(*svp)) {
- static char prefix[] = "\t(in cleanup) ";
- SV *err = ERRSV;
- sv_upgrade(*svp, SVt_IV);
- (void)SvIOK_only(*svp);
- if (!SvPOK(err))
- sv_setpv(err,"");
- SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen);
- sv_catpvn(err, prefix, sizeof(prefix)-1);
- sv_catpvn(err, message, msglen);
- if (ckWARN(WARN_UNSAFE)) {
- STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
- Perl_warner(aTHX_ WARN_UNSAFE, SvPVX(err)+start);
- }
+ static char prefix[] = "\t(in cleanup) ";
+ SV *err = ERRSV;
+ char *e = Nullch;
+ if (!SvPOK(err))
+ sv_setpv(err,"");
+ else if (SvCUR(err) >= sizeof(prefix)+msglen-1) {
+ e = SvPV(err, n_a);
+ e += n_a - msglen;
+ if (*e != *message || strNE(e,message))
+ e = Nullch;
+ }
+ if (!e) {
+ SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen);
+ sv_catpvn(err, prefix, sizeof(prefix)-1);
+ sv_catpvn(err, message, msglen);
+ if (ckWARN(WARN_UNSAFE)) {
+ STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1;
+ Perl_warner(aTHX_ WARN_UNSAFE, SvPVX(err)+start);
}
- sv_inc(*svp);
}
}
else
POPBLOCK(cx,PL_curpm);
if (CxTYPE(cx) != CXt_EVAL) {
- PerlIO_write(PerlIO_stderr(), "panic: die ", 11);
- PerlIO_write(PerlIO_stderr(), message, msglen);
+ PerlIO_write(Perl_error_log, "panic: die ", 11);
+ PerlIO_write(Perl_error_log, message, msglen);
my_exit(1);
}
POPEVAL(cx);
/* SFIO can really mess with your errno */
int e = errno;
#endif
- PerlIO_write(PerlIO_stderr(), message, msglen);
- (void)PerlIO_flush(PerlIO_stderr());
+ PerlIO *serr = Perl_error_log;
+
+ PerlIO_write(serr, message, msglen);
+ (void)PerlIO_flush(serr);
#ifdef USE_SFIO
errno = e;
#endif
PUSHs(&PL_sv_undef);
else
PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0)));
- PUSHs(sv_2mortal(newSVpvn(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)),
- SvCUR(GvSV(cx->blk_oldcop->cop_filegv)))));
+ PUSHs(sv_2mortal(newSVsv(CopFILESV(cx->blk_oldcop))));
PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
if (!MAXARG)
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);
}
{
djSP;
register PERL_CONTEXT *cx;
- struct block_loop cxloop;
I32 gimme;
SV **newsp;
PMOP *newpm;
POPBLOCK(cx,newpm);
mark = newsp;
- POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */
+ newsp = PL_stack_base + cx->blk_loop.resetsp;
TAINT_NOT;
if (gimme == G_VOID)
SP = newsp;
PUTBACK;
- POPLOOP2(); /* Stack values are safe: release loop vars ... */
+ POPLOOP(cx); /* Stack values are safe: release loop vars ... */
PL_curpm = newpm; /* ... and pop $1 et al */
LEAVE;
djSP; dMARK;
I32 cxix;
register PERL_CONTEXT *cx;
- struct block_sub cxsub;
bool popsub2 = FALSE;
I32 gimme;
SV **newsp;
PMOP *newpm;
I32 optype = 0;
+ SV *sv;
if (PL_curstackinfo->si_type == PERLSI_SORT) {
if (cxstack_ix == PL_sortcxix || dopoptosub(cxstack_ix) <= PL_sortcxix) {
POPBLOCK(cx,newpm);
switch (CxTYPE(cx)) {
case CXt_SUB:
- POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */
popsub2 = TRUE;
break;
case CXt_EVAL:
if (gimme == G_SCALAR) {
if (MARK < SP) {
if (popsub2) {
- if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) {
+ if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) {
if (SvTEMP(TOPs)) {
*++newsp = SvREFCNT_inc(*SP);
FREETMPS;
/* Stack values are safe: */
if (popsub2) {
- POPSUB2(); /* release CV and @_ ... */
+ POPSUB(cx,sv); /* release CV and @_ ... */
}
+ else
+ sv = Nullsv;
PL_curpm = newpm; /* ... and pop $1 et al */
LEAVE;
+ LEAVESUB(sv);
return pop_return();
}
djSP;
I32 cxix;
register PERL_CONTEXT *cx;
- struct block_loop cxloop;
- struct block_sub cxsub;
I32 pop2 = 0;
I32 gimme;
I32 optype;
OP *nextop;
SV **newsp;
PMOP *newpm;
- SV **mark = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
+ SV **mark;
+ SV *sv = Nullsv;
if (PL_op->op_flags & OPf_SPECIAL) {
cxix = dopoptoloop(cxstack_ix);
dounwind(cxix);
POPBLOCK(cx,newpm);
+ mark = newsp;
switch (CxTYPE(cx)) {
case CXt_LOOP:
- POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */
pop2 = CXt_LOOP;
- nextop = cxloop.last_op->op_next;
+ newsp = PL_stack_base + cx->blk_loop.resetsp;
+ nextop = cx->blk_loop.last_op->op_next;
break;
case CXt_SUB:
- POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */
pop2 = CXt_SUB;
nextop = pop_return();
break;
/* Stack values are safe: */
switch (pop2) {
case CXt_LOOP:
- POPLOOP2(); /* release loop vars ... */
+ POPLOOP(cx); /* release loop vars ... */
LEAVE;
break;
case CXt_SUB:
- POPSUB2(); /* release CV and @_ ... */
+ POPSUB(cx,sv); /* release CV and @_ ... */
break;
}
PL_curpm = newpm; /* ... and pop $1 et al */
LEAVE;
+ LEAVESUB(sv);
return nextop;
}
dTHR;
int ret;
OP *oldop = PL_op;
+ volatile PERL_SI *cursi = PL_curstackinfo;
+ dJMPENV;
#ifdef DEBUGGING
assert(CATCH_GET == TRUE);
#endif
PL_op = o;
redo_body:
- CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_docatch_body));
+ CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body));
switch (ret) {
case 0:
break;
case 3:
- if (PL_restartop) {
+ if (PL_restartop && cursi == PL_curstackinfo) {
PL_op = PL_restartop;
PL_restartop = 0;
goto redo_body;
SAVESPTR(PL_compiling.cop_stash);
PL_compiling.cop_stash = PL_curstash;
}
- SAVESPTR(PL_compiling.cop_filegv);
+ SAVESPTR(CopFILEGV(&PL_compiling));
SAVEI16(PL_compiling.cop_line);
sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq);
- PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
+ CopFILEGV_set(&PL_compiling, gv_fetchfile(tmpbuf+2));
PL_compiling.cop_line = 1;
/* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
deleting the eval's FILEGV from the stash before gv_check() runs
PL_op->op_type = OP_ENTEREVAL;
PL_op->op_flags = 0; /* Avoid uninit warning. */
PUSHBLOCK(cx, CXt_EVAL, SP);
- PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
+ PUSHEVAL(cx, 0, Nullgv);
rop = doeval(G_SCALAR, startop);
POPBLOCK(cx,PL_curpm);
POPEVAL(cx);
if (cv) {
dSP;
PUSHMARK(SP);
- XPUSHs((SV*)PL_compiling.cop_filegv);
+ XPUSHs((SV*)CopFILEGV(&PL_compiling));
PUTBACK;
call_sv((SV*)cv, G_DISCARD);
}
loader = *av_fetch((AV *)SvRV(loader), 0, TRUE);
}
- Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%lx/%s",
- SvANY(loader), name);
+ Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s",
+ PTR2UV(SvANY(loader)), name);
tryname = SvPVX(namesv);
tryrsfp = 0;
}
}
}
- SAVESPTR(PL_compiling.cop_filegv);
- PL_compiling.cop_filegv = gv_fetchfile(tryrsfp ? tryname : name);
+ SAVESPTR(CopFILEGV(&PL_compiling));
+ CopFILEGV_set(&PL_compiling, gv_fetchfile(tryrsfp ? tryname : name));
SvREFCNT_dec(namesv);
if (!tryrsfp) {
if (PL_op->op_type == OP_REQUIRE) {
/* Assume success here to prevent recursive requirement. */
(void)hv_store(GvHVn(PL_incgv), name, strlen(name),
- newSVsv(GvSV(PL_compiling.cop_filegv)), 0 );
+ newSVsv(CopFILESV(&PL_compiling)), 0 );
ENTER;
SAVETMPS;
/* switch to eval mode */
push_return(PL_op->op_next);
PUSHBLOCK(cx, CXt_EVAL, SP);
- PUSHEVAL(cx, name, PL_compiling.cop_filegv);
+ PUSHEVAL(cx, name, Nullgv);
SAVEI16(PL_compiling.cop_line);
PL_compiling.cop_line = 0;
/* switch to eval mode */
- SAVESPTR(PL_compiling.cop_filegv);
+ SAVESPTR(CopFILEGV(&PL_compiling));
sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
- PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2);
+ CopFILEGV_set(&PL_compiling, gv_fetchfile(tmpbuf+2));
PL_compiling.cop_line = 1;
/* XXX For C<eval "...">s within BEGIN {} blocks, this ends up
deleting the eval's FILEGV from the stash before gv_check() runs
push_return(PL_op->op_next);
PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
- PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
+ PUSHEVAL(cx, 0, Nullgv);
/* prepare to compile string */
if (PERLDB_LINE && PL_curstash != PL_debstash)
- save_lines(GvAV(PL_compiling.cop_filegv), PL_linestr);
+ save_lines(CopFILEAV(&PL_compiling), PL_linestr);
PUTBACK;
#ifdef USE_THREADS
MUTEX_LOCK(&PL_eval_mutex);
MEXTEND(mark,0);
*MARK = &PL_sv_undef;
}
+ SP = MARK;
}
else {
/* in case LEAVE wipes old return values */
#ifdef PERL_OBJECT
-#define NO_XSLOCKS
#undef this
#define this pPerl
#include "XSUB.h"
projects / p5sagit/p5-mst-13.2.git / blobdiff