X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=371e037ae525e6b28365f5128e99faaa72dae8af;hb=10a676f83f541430b63a3192b246bf6f86d3b189;hp=de3c13b4723a26a61142e9a15b05ba27a2892cbb;hpb=20efc0829f6564c44574762adb07e8865bc14026;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_ctl.c b/pp_ctl.c index de3c13b..371e037 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1,6 +1,6 @@ /* pp_ctl.c * - * Copyright (c) 1991-1994, Larry Wall + * Copyright (c) 1991-1997, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -23,7 +23,7 @@ #define WORD_ALIGN sizeof(U16) #endif -#define DOCATCH(o) (mustcatch ? docatch(o) : (o)) +#define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o)) static OP *docatch _((OP *o)); static OP *doeval _((int gimme)); @@ -50,10 +50,14 @@ PP(pp_wantarray) if (cxix < 0) RETPUSHUNDEF; - if (cxstack[cxix].blk_gimme == G_ARRAY) + switch (cxstack[cxix].blk_gimme) { + case G_ARRAY: RETPUSHYES; - else + case G_SCALAR: RETPUSHNO; + default: + RETPUSHUNDEF; + } } PP(pp_regcmaybe) @@ -115,9 +119,6 @@ PP(pp_substcont) if (!cx->sb_rxtainted) cx->sb_rxtainted = SvTAINTED(TOPs); sv_catsv(dstr, POPs); - if (rx->subbase) - Safefree(rx->subbase); - rx->subbase = cx->sb_subbase; /* Are we done */ if (cx->sb_once || !pregexec(rx, s, cx->sb_strend, orig, @@ -135,10 +136,10 @@ PP(pp_substcont) SvLEN_set(targ, SvLEN(dstr)); SvPVX(dstr) = 0; sv_free(dstr); - (void)SvPOK_only(targ); SvSETMAGIC(targ); SvTAINT(targ); + PUSHs(sv_2mortal(newSViv((I32)cx->sb_iters - 1))); LEAVE_SCOPE(cx->sb_oldsave); POPSUBST(cx); @@ -155,10 +156,7 @@ PP(pp_substcont) cx->sb_m = m = rx->startp[0]; sv_catpvn(dstr, s, m-s); cx->sb_s = rx->endp[0]; - cx->sb_subbase = rx->subbase; cx->sb_rxtainted |= rx->exec_tainted; - - rx->subbase = Nullch; /* so recursion works */ RETURNOP(pm->op_pmreplstart); } @@ -462,7 +460,7 @@ PP(pp_grepstart) if (stack_base + *markstack_ptr == sp) { (void)POPMARK; - if (GIMME != G_ARRAY) + if (GIMME_V == G_SCALAR) XPUSHs(&sv_no); RETURNOP(op->op_next->op_next); } @@ -525,6 +523,7 @@ PP(pp_mapwhile) /* All done yet? */ if (markstack_ptr[-1] > *markstack_ptr) { I32 items; + I32 gimme = GIMME_V; (void)POPMARK; /* pop top */ LEAVE; /* exit outer scope */ @@ -532,12 +531,12 @@ PP(pp_mapwhile) items = --*markstack_ptr - markstack_ptr[-1]; (void)POPMARK; /* pop dst */ SP = stack_base + POPMARK; /* pop original mark */ - if (GIMME != G_ARRAY) { + if (gimme == G_SCALAR) { dTARGET; XPUSHi(items); - RETURN; } - SP += items; + else if (gimme == G_ARRAY) + SP += items; RETURN; } else { @@ -628,7 +627,7 @@ PP(pp_sort) AV *oldstack; CONTEXT *cx; SV** newsp; - bool oldmustcatch = mustcatch; + bool oldcatch = CATCH_GET; SAVETMPS; SAVESPTR(op); @@ -639,7 +638,7 @@ PP(pp_sort) AvREAL_off(sortstack); av_extend(sortstack, 32); } - mustcatch = TRUE; + CATCH_SET(TRUE); SWITCHSTACK(curstack, sortstack); if (sortstash != stash) { firstgv = gv_fetchpv("a", TRUE, SVt_PV); @@ -656,7 +655,7 @@ PP(pp_sort) POPBLOCK(cx,curpm); SWITCHSTACK(sortstack, oldstack); - mustcatch = oldmustcatch; + CATCH_SET(oldcatch); } LEAVE; } @@ -798,11 +797,11 @@ char *label; case CXt_LOOP: if (!cx->blk_loop.label || strNE(label, cx->blk_loop.label) ) { - DEBUG_l(deb("(Skipping label #%d %s)\n", - i, cx->blk_loop.label)); + DEBUG_l(deb("(Skipping label #%ld %s)\n", + (long)i, cx->blk_loop.label)); continue; } - DEBUG_l( deb("(Found label #%d %s)\n", i, label)); + DEBUG_l( deb("(Found label #%ld %s)\n", (long)i, label)); return i; } } @@ -812,16 +811,29 @@ char *label; I32 dowantarray() { + I32 gimme = block_gimme(); + return (gimme == G_VOID) ? G_SCALAR : gimme; +} + +I32 +block_gimme() +{ I32 cxix; cxix = dopoptosub(cxstack_ix); if (cxix < 0) return G_SCALAR; - if (cxstack[cxix].blk_gimme == G_ARRAY) - return G_ARRAY; - else + switch (cxstack[cxix].blk_gimme) { + case G_VOID: + return G_VOID; + case G_SCALAR: return G_SCALAR; + case G_ARRAY: + return G_ARRAY; + default: + croak("panic: bad gimme: %d\n", cxstack[cxix].blk_gimme); + } } static I32 @@ -837,7 +849,7 @@ I32 startingblock; continue; case CXt_EVAL: case CXt_SUB: - DEBUG_l( deb("(Found sub #%d)\n", i)); + DEBUG_l( deb("(Found sub #%ld)\n", (long)i)); return i; } } @@ -856,7 +868,7 @@ I32 startingblock; default: continue; case CXt_EVAL: - DEBUG_l( deb("(Found eval #%d)\n", i)); + DEBUG_l( deb("(Found eval #%ld)\n", (long)i)); return i; } } @@ -889,7 +901,7 @@ I32 startingblock; warn("Exiting pseudo-block via %s", op_name[op->op_type]); return -1; case CXt_LOOP: - DEBUG_l( deb("(Found loop #%d)\n", i)); + DEBUG_l( deb("(Found loop #%ld)\n", (long)i)); return i; } } @@ -976,8 +988,10 @@ char *message; LEAVE; - if (optype == OP_REQUIRE) - DIE("%s", SvPVx(GvSV(errgv), na)); + if (optype == OP_REQUIRE) { + char* msg = SvPVx(GvSV(errgv), na); + DIE("%s", *msg ? msg : "Compilation failed in require"); + } return pop_return(); } } @@ -1036,6 +1050,7 @@ PP(pp_caller) register I32 cxix = dopoptosub(cxstack_ix); register CONTEXT *cx; I32 dbcxix; + I32 gimme; SV *sv; I32 count = 0; @@ -1087,7 +1102,11 @@ PP(pp_caller) PUSHs(sv_2mortal(newSVpv("(eval)",0))); PUSHs(sv_2mortal(newSViv(0))); } - PUSHs(sv_2mortal(newSViv((I32)cx->blk_gimme))); + gimme = (I32)cx->blk_gimme; + if (gimme == G_VOID) + PUSHs(&sv_undef); + else + PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY))); if (cx->cx_type == CXt_EVAL) { if (cx->blk_eval.old_op_type == OP_ENTEREVAL) { PUSHs(cx->blk_eval.cur_text); @@ -1127,8 +1146,8 @@ sortcv(a, b) const void *a; const void *b; { - SV **str1 = (SV **) a; - SV **str2 = (SV **) b; + SV * const *str1 = (SV * const *)a; + SV * const *str2 = (SV * const *)b; I32 oldsaveix = savestack_ix; I32 oldscopeix = scopestack_ix; I32 result; @@ -1154,7 +1173,7 @@ sortcmp(a, b) const void *a; const void *b; { - return sv_cmp(*(SV **)a, *(SV **)b); + return sv_cmp(*(SV * const *)a, *(SV * const *)b); } static int @@ -1162,7 +1181,7 @@ sortcmp_locale(a, b) const void *a; const void *b; { - return sv_cmp_locale(*(SV **)a, *(SV **)b); + return sv_cmp_locale(*(SV * const *)a, *(SV * const *)b); } PP(pp_reset) @@ -1239,7 +1258,7 @@ PP(pp_enteriter) { dSP; dMARK; register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; SV **svp; ENTER; @@ -1271,7 +1290,7 @@ PP(pp_enterloop) { dSP; register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; ENTER; SAVETMPS; @@ -1297,15 +1316,13 @@ PP(pp_leaveloop) mark = newsp; POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */ - if (gimme == G_SCALAR) { - if (op->op_private & OPpLEAVE_VOID) - ; - else { - if (mark < SP) - *++newsp = sv_mortalcopy(*SP); - else - *++newsp = &sv_undef; - } + if (gimme == G_VOID) + ; /* do nothing */ + else if (gimme == G_SCALAR) { + if (mark < SP) + *++newsp = sv_mortalcopy(*SP); + else + *++newsp = &sv_undef; } else { while (mark < SP) @@ -1362,6 +1379,7 @@ PP(pp_return) if (optype == OP_REQUIRE && (MARK == SP || (gimme == G_SCALAR && !SvTRUE(*SP))) ) { + /* Unassume the success we assumed earlier. */ char *name = cx->blk_eval.old_name; (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD); DIE("%s did not return a true value", name); @@ -1369,7 +1387,6 @@ PP(pp_return) break; default: DIE("panic: return"); - break; } if (gimme == G_SCALAR) { @@ -1379,7 +1396,7 @@ PP(pp_return) else *++newsp = &sv_undef; } - else { + else if (gimme == G_ARRAY) { while (++MARK <= SP) *++newsp = (popsub2 && SvTEMP(*MARK)) ? *MARK : sv_mortalcopy(*MARK); @@ -1442,7 +1459,6 @@ PP(pp_last) break; default: DIE("panic: last"); - break; } if (gimme == G_SCALAR) { @@ -1452,7 +1468,7 @@ PP(pp_last) else *++newsp = &sv_undef; } - else { + else if (gimme == G_ARRAY) { while (++MARK <= SP) *++newsp = ((pop2 == CXt_SUB) && SvTEMP(*MARK)) ? *MARK : sv_mortalcopy(*MARK); @@ -1791,12 +1807,10 @@ PP(pp_goto) break; case CXt_NULL: DIE("Can't \"goto\" outside a block"); - break; default: if (ix) DIE("panic: goto"); - else - gotoprobe = main_root; + gotoprobe = main_root; break; } retop = dofindlabel(gotoprobe, label, enterops); @@ -1847,7 +1861,7 @@ PP(pp_goto) if (curstack == signalstack) { restartop = retop; - Siglongjmp(top_env, 3); + JMPENV_JUMP(3); } RETURNOP(retop); @@ -1945,30 +1959,28 @@ docatch(o) OP *o; { int ret; - int oldrunlevel = runlevel; + I32 oldrunlevel = runlevel; OP *oldop = op; - Sigjmp_buf oldtop; + dJMPENV; op = o; - Copy(top_env, oldtop, 1, Sigjmp_buf); #ifdef DEBUGGING - assert(mustcatch == TRUE); + assert(CATCH_GET == TRUE); + DEBUG_l(deb("(Setting up local jumplevel, runlevel = %ld)\n", (long)runlevel+1)); #endif - mustcatch = FALSE; - switch ((ret = Sigsetjmp(top_env,1))) { + JMPENV_PUSH(ret); + switch (ret) { default: /* topmost level handles it */ - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; runlevel = oldrunlevel; - mustcatch = TRUE; op = oldop; - Siglongjmp(top_env, ret); + JMPENV_JUMP(ret); /* NOTREACHED */ case 3: if (!restartop) { PerlIO_printf(PerlIO_stderr(), "panic: restartop\n"); break; } - mustcatch = FALSE; op = restartop; restartop = 0; /* FALL THROUGH */ @@ -1976,9 +1988,8 @@ OP *o; runops(); break; } - Copy(oldtop, top_env, 1, Sigjmp_buf); + JMPENV_POP; runlevel = oldrunlevel; - mustcatch = TRUE; op = oldop; return Nullop; } @@ -2072,8 +2083,10 @@ int gimme; pop_return(); lex_end(); LEAVE; - if (optype == OP_REQUIRE) - DIE("%s", SvPVx(GvSV(errgv), na)); + if (optype == OP_REQUIRE) { + char* msg = SvPVx(GvSV(errgv), na); + DIE("%s", *msg ? msg : "Compilation failed in require"); + } SvREFCNT_dec(rs); rs = SvREFCNT_inc(nrs); RETPUSHUNDEF; @@ -2082,7 +2095,9 @@ int gimme; rs = SvREFCNT_inc(nrs); compiling.cop_line = 0; SAVEFREEOP(eval_root); - if (gimme & G_ARRAY) + if (gimme & G_VOID) + scalarvoid(eval_root); + else if (gimme & G_ARRAY) list(eval_root); else scalar(eval_root); @@ -2239,7 +2254,7 @@ PP(pp_entereval) dSP; register CONTEXT *cx; dPOPss; - I32 gimme = GIMME, was = sub_generation; + I32 gimme = GIMME_V, was = sub_generation; char tmpbuf[32], *safestr; STRLEN len; OP *ret; @@ -2300,23 +2315,20 @@ PP(pp_leaveeval) POPEVAL(cx); retop = pop_return(); - if (gimme == G_SCALAR) { - if (op->op_private & OPpLEAVE_VOID) - MARK = newsp; + if (gimme == G_VOID) + MARK = newsp; + else if (gimme == G_SCALAR) { + MARK = newsp + 1; + if (MARK <= SP) { + if (SvFLAGS(TOPs) & SVs_TEMP) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); + } else { - MARK = newsp + 1; - if (MARK <= SP) { - if (SvFLAGS(TOPs) & SVs_TEMP) - *MARK = TOPs; - else - *MARK = sv_mortalcopy(TOPs); - } - else { - MEXTEND(mark,0); - *MARK = &sv_undef; - } + MEXTEND(mark,0); + *MARK = &sv_undef; } - SP = MARK; } else { for (mark = newsp + 1; mark <= SP; mark++) @@ -2332,10 +2344,10 @@ PP(pp_leaveeval) CvDEPTH(compcv) = 0; if (optype == OP_REQUIRE && - !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) { - char *name = cx->blk_eval.old_name; - + !(gimme == G_SCALAR ? SvTRUE(*sp) : sp > newsp)) + { /* Unassume the success we assumed earlier. */ + char *name = cx->blk_eval.old_name; (void)hv_delete(GvHVn(incgv), name, strlen(name), G_DISCARD); retop = die("%s did not return a true value", name); } @@ -2353,7 +2365,7 @@ PP(pp_entertry) { dSP; register CONTEXT *cx; - I32 gimme = GIMME; + I32 gimme = GIMME_V; ENTER; SAVETMPS; @@ -2383,21 +2395,19 @@ PP(pp_leavetry) POPEVAL(cx); pop_return(); - if (gimme == G_SCALAR) { - if (op->op_private & OPpLEAVE_VOID) - MARK = newsp; + if (gimme == G_VOID) + SP = newsp; + else if (gimme == G_SCALAR) { + MARK = newsp + 1; + if (MARK <= SP) { + if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)) + *MARK = TOPs; + else + *MARK = sv_mortalcopy(TOPs); + } else { - MARK = newsp + 1; - if (MARK <= SP) { - if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP)) - *MARK = TOPs; - else - *MARK = sv_mortalcopy(TOPs); - } - else { - MEXTEND(mark,0); - *MARK = &sv_undef; - } + MEXTEND(mark,0); + *MARK = &sv_undef; } SP = MARK; }