X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=scope.c;h=7628196b9df493c66fed3f77ec59a626f289c335;hb=b851de6cd1cc79b5e8ed7db02ebd0a9769d34232;hp=12f3595b54969615491282fa9bf8bdd8078c6ec2;hpb=4aa0a1f7324b8447469670a1b2427c3ac2428bae;p=p5sagit%2Fp5-mst-13.2.git diff --git a/scope.c b/scope.c index 12f3595..7628196 100644 --- a/scope.c +++ b/scope.c @@ -1,6 +1,6 @@ /* scope.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. @@ -21,16 +21,18 @@ SV** sp; SV** p; int n; { + dTHR; stack_sp = sp; - av_extend(stack, (p - stack_base) + (n) + 128); + av_extend(curstack, (p - stack_base) + (n) + 128); return stack_sp; } I32 cxinc() { + dTHR; cxstack_max = cxstack_max * 3 / 2; - Renew(cxstack, cxstack_max, CONTEXT); + Renew(cxstack, cxstack_max + 1, CONTEXT); /* XXX should fix CXINC macro */ return cxstack_ix + 1; } @@ -38,6 +40,7 @@ void push_return(retop) OP *retop; { + dTHR; if (retstack_ix == retstack_max) { retstack_max = retstack_max * 3 / 2; Renew(retstack, retstack_max, OP*); @@ -48,6 +51,7 @@ OP *retop; OP * pop_return() { + dTHR; if (retstack_ix > 0) return retstack[--retstack_ix]; else @@ -57,6 +61,7 @@ pop_return() void push_scope() { + dTHR; if (scopestack_ix == scopestack_max) { scopestack_max = scopestack_max * 3 / 2; Renew(scopestack, scopestack_max, I32); @@ -68,6 +73,7 @@ push_scope() void pop_scope() { + dTHR; I32 oldsave = scopestack[--scopestack_ix]; LEAVE_SCOPE(oldsave); } @@ -75,6 +81,7 @@ pop_scope() void markstack_grow() { + dTHR; I32 oldmax = markstack_max - markstack; I32 newmax = oldmax * 3 / 2; @@ -86,6 +93,7 @@ markstack_grow() void savestack_grow() { + dTHR; savestack_max = savestack_max * 3 / 2; Renew(savestack, savestack_max, ANY); } @@ -93,6 +101,7 @@ savestack_grow() void free_tmps() { + dTHR; /* XXX should tmps_floor live in cxstack? */ I32 myfloor = tmps_floor; while (tmps_ix > myfloor) { /* clean up after last statement */ @@ -107,19 +116,15 @@ free_tmps() } } -SV * -save_scalar(gv) -GV *gv; +static SV * +save_scalar_at(sptr) +SV **sptr; { + dTHR; register SV *sv; - SV *osv = GvSV(gv); - - SSCHECK(3); - SSPUSHPTR(gv); - SSPUSHPTR(osv); - SSPUSHINT(SAVEt_SV); + SV *osv = *sptr; - sv = GvSV(gv) = NEWSV(0,0); + sv = *sptr = NEWSV(0,0); if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) { sv_upgrade(sv, SvTYPE(osv)); if (SvGMAGICAL(osv)) { @@ -143,68 +148,60 @@ GV *gv; return sv; } -#ifdef INLINED_ELSEWHERE -void -save_gp(gv) +SV * +save_scalar(gv) GV *gv; { - register GP *gp; - GP *ogp = GvGP(gv); - + dTHR; SSCHECK(3); SSPUSHPTR(gv); - SSPUSHPTR(ogp); - SSPUSHINT(SAVEt_GP); - - Newz(602,gp, 1, GP); - GvGP(gv) = gp; - GvREFCNT(gv) = 1; - GvSV(gv) = NEWSV(72,0); - GvLINE(gv) = curcop->cop_line; - GvEGV(gv) = gv; + SSPUSHPTR(GvSV(gv)); + SSPUSHINT(SAVEt_SV); + return save_scalar_at(&GvSV(gv)); } -#endif SV* save_svref(sptr) SV **sptr; { - register SV *sv; - SV *osv = *sptr; - + dTHR; SSCHECK(3); - SSPUSHPTR(*sptr); SSPUSHPTR(sptr); + SSPUSHPTR(*sptr); SSPUSHINT(SAVEt_SVREF); + return save_scalar_at(sptr); +} - sv = *sptr = NEWSV(0,0); - if (SvTYPE(osv) >= SVt_PVMG && SvMAGIC(osv) && SvTYPE(osv) != SVt_PVGV) { - sv_upgrade(sv, SvTYPE(osv)); - if (SvGMAGICAL(osv)) { - MAGIC* mg; - bool oldtainted = tainted; - mg_get(osv); - if (tainting && tainted && (mg = mg_find(osv, 't'))) { - SAVESPTR(mg->mg_obj); - mg->mg_obj = osv; - } - SvFLAGS(osv) |= (SvFLAGS(osv) & - (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; - tainted = oldtainted; - } - SvMAGIC(sv) = SvMAGIC(osv); - SvFLAGS(sv) |= SvMAGICAL(osv); - localizing = 1; - SvSETMAGIC(sv); - localizing = 0; +void +save_gp(gv, empty) +GV *gv; +I32 empty; +{ + dTHR; + SSCHECK(3); + SSPUSHPTR(SvREFCNT_inc(gv)); + SSPUSHPTR(GvGP(gv)); + SSPUSHINT(SAVEt_GP); + + if (empty) { + register GP *gp; + Newz(602, gp, 1, GP); + GvGP(gv) = gp_ref(gp); + GvSV(gv) = NEWSV(72,0); + GvLINE(gv) = curcop->cop_line; + GvEGV(gv) = gv; + } + else { + gp_ref(GvGP(gv)); + GvINTRO_on(gv); } - return sv; } AV * save_ary(gv) GV *gv; { + dTHR; SSCHECK(3); SSPUSHPTR(gv); SSPUSHPTR(GvAVn(gv)); @@ -218,6 +215,7 @@ HV * save_hash(gv) GV *gv; { + dTHR; SSCHECK(3); SSPUSHPTR(gv); SSPUSHPTR(GvHVn(gv)); @@ -231,6 +229,7 @@ void save_item(item) register SV *item; { + dTHR; register SV *sv; SSCHECK(3); @@ -245,6 +244,7 @@ void save_int(intp) int *intp; { + dTHR; SSCHECK(3); SSPUSHINT(*intp); SSPUSHPTR(intp); @@ -255,6 +255,7 @@ void save_long(longp) long *longp; { + dTHR; SSCHECK(3); SSPUSHLONG(*longp); SSPUSHPTR(longp); @@ -265,6 +266,7 @@ void save_I32(intp) I32 *intp; { + dTHR; SSCHECK(3); SSPUSHINT(*intp); SSPUSHPTR(intp); @@ -272,9 +274,21 @@ I32 *intp; } void +save_I16(intp) +I16 *intp; +{ + dTHR; + SSCHECK(3); + SSPUSHINT(*intp); + SSPUSHPTR(intp); + SSPUSHINT(SAVEt_I16); +} + +void save_iv(ivp) IV *ivp; { + dTHR; SSCHECK(3); SSPUSHIV(*ivp); SSPUSHPTR(ivp); @@ -288,6 +302,7 @@ void save_pptr(pptr) char **pptr; { + dTHR; SSCHECK(3); SSPUSHPTR(*pptr); SSPUSHPTR(pptr); @@ -298,6 +313,7 @@ void save_sptr(sptr) SV **sptr; { + dTHR; SSCHECK(3); SSPUSHPTR(*sptr); SSPUSHPTR(sptr); @@ -308,6 +324,7 @@ void save_nogv(gv) GV *gv; { + dTHR; SSCHECK(2); SSPUSHPTR(gv); SSPUSHINT(SAVEt_NSTAB); @@ -317,6 +334,7 @@ void save_hptr(hptr) HV **hptr; { + dTHR; SSCHECK(3); SSPUSHPTR(*hptr); SSPUSHPTR(hptr); @@ -327,6 +345,7 @@ void save_aptr(aptr) AV **aptr; { + dTHR; SSCHECK(3); SSPUSHPTR(*aptr); SSPUSHPTR(aptr); @@ -337,17 +356,19 @@ void save_freesv(sv) SV *sv; { + dTHR; SSCHECK(2); SSPUSHPTR(sv); SSPUSHINT(SAVEt_FREESV); } void -save_freeop(op) -OP *op; +save_freeop(o) +OP *o; { + dTHR; SSCHECK(2); - SSPUSHPTR(op); + SSPUSHPTR(o); SSPUSHINT(SAVEt_FREEOP); } @@ -355,6 +376,7 @@ void save_freepv(pv) char *pv; { + dTHR; SSCHECK(2); SSPUSHPTR(pv); SSPUSHINT(SAVEt_FREEPV); @@ -364,6 +386,7 @@ void save_clearsv(svp) SV** svp; { + dTHR; SSCHECK(2); SSPUSHLONG((long)(svp-curpad)); SSPUSHINT(SAVEt_CLEARSV); @@ -375,6 +398,7 @@ HV *hv; char *key; I32 klen; { + dTHR; SSCHECK(4); SSPUSHINT(klen); SSPUSHPTR(key); @@ -387,6 +411,7 @@ save_list(sarg,maxsarg) register SV **sarg; I32 maxsarg; { + dTHR; register SV *sv; register I32 i; @@ -405,6 +430,7 @@ save_destructor(f,p) void (*f) _((void*)); void* p; { + dTHR; SSCHECK(3); SSPUSHDPTR(f); SSPUSHPTR(p); @@ -412,9 +438,19 @@ void* p; } void +save_op() +{ + dTHR; + SSCHECK(2); + SSPUSHPTR(op); + SSPUSHINT(SAVEt_OP); +} + +void leave_scope(base) I32 base; { + dTHR; register SV *sv; register SV *value; register GV *gv; @@ -437,26 +473,13 @@ I32 base; case SAVEt_SV: /* scalar reference */ value = (SV*)SSPOPPTR; gv = (GV*)SSPOPPTR; - sv = GvSV(gv); - if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) && - SvTYPE(sv) != SVt_PVGV) - { - (void)SvUPGRADE(value, SvTYPE(sv)); - SvMAGIC(value) = SvMAGIC(sv); - SvFLAGS(value) |= SvMAGICAL(sv); - SvMAGICAL_off(sv); - SvMAGIC(sv) = 0; - } - SvREFCNT_dec(sv); - GvSV(gv) = value; - localizing = 2; - SvSETMAGIC(value); - localizing = 0; - break; + ptr = &GvSV(gv); + goto restore_sv; case SAVEt_SVREF: /* scalar reference */ + value = (SV*)SSPOPPTR; ptr = SSPOPPTR; + restore_sv: sv = *(SV**)ptr; - value = (SV*)SSPOPPTR; if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) && SvTYPE(sv) != SVt_PVGV) { @@ -466,6 +489,14 @@ I32 base; SvMAGICAL_off(sv); SvMAGIC(sv) = 0; } + else if (SvTYPE(value) >= SVt_PVMG && SvMAGIC(value) && + SvTYPE(value) != SVt_PVGV) + { + SvFLAGS(value) |= (SvFLAGS(value) & + (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; + SvMAGICAL_off(value); + SvMAGIC(value) = 0; + } SvREFCNT_dec(sv); *(SV**)ptr = value; localizing = 2; @@ -496,6 +527,10 @@ I32 base; ptr = SSPOPPTR; *(I32*)ptr = (I32)SSPOPINT; break; + case SAVEt_I16: /* I16 reference */ + ptr = SSPOPPTR; + *(I16*)ptr = (I16)SSPOPINT; + break; case SAVEt_IV: /* IV reference */ ptr = SSPOPPTR; *(IV*)ptr = (IV)SSPOPIV; @@ -518,13 +553,14 @@ I32 base; break; case SAVEt_NSTAB: gv = (GV*)SSPOPPTR; - (void)sv_clear(gv); + (void)sv_clear((SV*)gv); break; case SAVEt_GP: /* scalar reference */ ptr = SSPOPPTR; gv = (GV*)SSPOPPTR; gp_free(gv); GvGP(gv) = (GP*)ptr; + SvREFCNT_dec(gv); break; case SAVEt_FREESV: ptr = SSPOPPTR; @@ -532,7 +568,8 @@ I32 base; break; case SAVEt_FREEOP: ptr = SSPOPPTR; - curpad = AvARRAY(comppad); + if (comppad) + curpad = AvARRAY(comppad); op_free((OP*)ptr); break; case SAVEt_FREEPV: @@ -542,7 +579,8 @@ I32 base; case SAVEt_CLEARSV: ptr = (void*)&curpad[SSPOPLONG]; sv = *(SV**)ptr; - if (SvREFCNT(sv) <= 1) { /* Can clear pad variable in place. */ + /* Can clear pad variable in place? */ + if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) { if (SvTHINKFIRST(sv)) { if (SvREADONLY(sv)) croak("panic: leave_scope clearsv"); @@ -562,13 +600,15 @@ I32 base; hv_clear((HV*)sv); break; case SVt_PVCV: - sub_generation++; - cv_undef((CV*)sv); + croak("panic: leave_scope pad code"); + case SVt_RV: + case SVt_IV: + case SVt_NV: + (void)SvOK_off(sv); break; default: - if (SvPOK(sv) && SvLEN(sv)) - (void)SvOOK_off(sv); (void)SvOK_off(sv); + (void)SvOOK_off(sv); break; } } @@ -595,7 +635,19 @@ I32 base; (*SSPOPDPTR)(ptr); break; case SAVEt_REGCONTEXT: - savestack_ix -= SSPOPINT; /* regexp must have croaked */ + { + I32 delta = SSPOPINT; + savestack_ix -= delta; /* regexp must have croaked */ + } + break; + case SAVEt_STACK_POS: /* Position on Perl stack */ + { + I32 delta = SSPOPINT; + stack_sp = stack_base + delta; + } + break; + case SAVEt_OP: + op = (OP*)SSPOPPTR; break; default: croak("panic: leave_scope inconsistency"); @@ -604,92 +656,97 @@ I32 base; } #ifdef DEBUGGING + void cx_dump(cx) CONTEXT* cx; { - fprintf(stderr, "CX %d = %s\n", cx - cxstack, block_type[cx->cx_type]); + dTHR; + PerlIO_printf(Perl_debug_log, "CX %d = %s\n", cx - cxstack, block_type[cx->cx_type]); if (cx->cx_type != CXt_SUBST) { - fprintf(stderr, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp); - fprintf(stderr, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop); - fprintf(stderr, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp); - fprintf(stderr, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp); - fprintf(stderr, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp); - fprintf(stderr, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm); - fprintf(stderr, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR"); + PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp); + PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop); + PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp); + PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp); + PerlIO_printf(Perl_debug_log, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp); + PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm); + PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR"); } switch (cx->cx_type) { case CXt_NULL: case CXt_BLOCK: break; case CXt_SUB: - fprintf(stderr, "BLK_SUB.CV = 0x%lx\n", + PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%lx\n", (long)cx->blk_sub.cv); - fprintf(stderr, "BLK_SUB.GV = 0x%lx\n", + PerlIO_printf(Perl_debug_log, "BLK_SUB.GV = 0x%lx\n", (long)cx->blk_sub.gv); - fprintf(stderr, "BLK_SUB.DFOUTGV = 0x%lx\n", + PerlIO_printf(Perl_debug_log, "BLK_SUB.DFOUTGV = 0x%lx\n", (long)cx->blk_sub.dfoutgv); - fprintf(stderr, "BLK_SUB.OLDDEPTH = %ld\n", + PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n", (long)cx->blk_sub.olddepth); - fprintf(stderr, "BLK_SUB.HASARGS = %d\n", + PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n", (int)cx->blk_sub.hasargs); break; case CXt_EVAL: - fprintf(stderr, "BLK_EVAL.OLD_IN_EVAL = %ld\n", + PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n", (long)cx->blk_eval.old_in_eval); - fprintf(stderr, "BLK_EVAL.OLD_OP_TYPE = %s\n", - op_name[cx->blk_eval.old_op_type]); - fprintf(stderr, "BLK_EVAL.OLD_NAME = %s\n", + PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n", + op_name[cx->blk_eval.old_op_type], + op_desc[cx->blk_eval.old_op_type]); + PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n", cx->blk_eval.old_name); - fprintf(stderr, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n", + PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n", (long)cx->blk_eval.old_eval_root); break; case CXt_LOOP: - fprintf(stderr, "BLK_LOOP.LABEL = %s\n", + PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n", cx->blk_loop.label); - fprintf(stderr, "BLK_LOOP.RESETSP = %ld\n", + PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n", (long)cx->blk_loop.resetsp); - fprintf(stderr, "BLK_LOOP.REDO_OP = 0x%lx\n", + PerlIO_printf(Perl_debug_log, "BLK_LOOP.REDO_OP = 0x%lx\n", (long)cx->blk_loop.redo_op); - fprintf(stderr, "BLK_LOOP.NEXT_OP = 0x%lx\n", + PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%lx\n", (long)cx->blk_loop.next_op); - fprintf(stderr, "BLK_LOOP.LAST_OP = 0x%lx\n", + PerlIO_printf(Perl_debug_log, "BLK_LOOP.LAST_OP = 0x%lx\n", (long)cx->blk_loop.last_op); - fprintf(stderr, "BLK_LOOP.ITERIX = %ld\n", + PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n", (long)cx->blk_loop.iterix); - fprintf(stderr, "BLK_LOOP.ITERARY = 0x%lx\n", + PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%lx\n", (long)cx->blk_loop.iterary); - fprintf(stderr, "BLK_LOOP.ITERVAR = 0x%lx\n", + PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%lx\n", (long)cx->blk_loop.itervar); if (cx->blk_loop.itervar) - fprintf(stderr, "BLK_LOOP.ITERSAVE = 0x%lx\n", + PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%lx\n", (long)cx->blk_loop.itersave); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERLVAL = 0x%lx\n", + (long)cx->blk_loop.iterlval); break; case CXt_SUBST: - fprintf(stderr, "SB_ITERS = %ld\n", + PerlIO_printf(Perl_debug_log, "SB_ITERS = %ld\n", (long)cx->sb_iters); - fprintf(stderr, "SB_MAXITERS = %ld\n", + PerlIO_printf(Perl_debug_log, "SB_MAXITERS = %ld\n", (long)cx->sb_maxiters); - fprintf(stderr, "SB_SAFEBASE = %ld\n", + PerlIO_printf(Perl_debug_log, "SB_SAFEBASE = %ld\n", (long)cx->sb_safebase); - fprintf(stderr, "SB_ONCE = %ld\n", + PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n", (long)cx->sb_once); - fprintf(stderr, "SB_ORIG = %s\n", + PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n", cx->sb_orig); - fprintf(stderr, "SB_DSTR = 0x%lx\n", + PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%lx\n", (long)cx->sb_dstr); - fprintf(stderr, "SB_TARG = 0x%lx\n", + PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%lx\n", (long)cx->sb_targ); - fprintf(stderr, "SB_S = 0x%lx\n", + PerlIO_printf(Perl_debug_log, "SB_S = 0x%lx\n", (long)cx->sb_s); - fprintf(stderr, "SB_M = 0x%lx\n", + PerlIO_printf(Perl_debug_log, "SB_M = 0x%lx\n", (long)cx->sb_m); - fprintf(stderr, "SB_STREND = 0x%lx\n", + PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%lx\n", (long)cx->sb_strend); - fprintf(stderr, "SB_SUBBASE = 0x%lx\n", - (long)cx->sb_subbase); + PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%lx\n", + (long)cx->sb_rxres); break; } }