X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=b981c12fae68eff64ce85758d9d84a378b4cbb8b;hb=e91177edb0beae74fd07fb1ec08a528ab1fb63c2;hp=6466b314dbd3334ce46134551b2bb145246cbd37;hpb=ac4c12e7aee90d31d5da776601addbfd9d738a5a;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index 6466b31..b981c12 100644 --- a/mg.c +++ b/mg.c @@ -289,18 +289,18 @@ magic_len(SV *sv, MAGIC *mg) register I32 paren; register char *s; register I32 i; - register REGEXP *prx; + register REGEXP *rx; char *t; switch (*mg->mg_ptr) { case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '&': - if (curpm && (prx = curpm->op_pmregexp)) { + if (curpm && (rx = curpm->op_pmregexp)) { paren = atoi(mg->mg_ptr); getparen: - if (paren <= prx->nparens && - (s = prx->startp[paren]) && - (t = prx->endp[paren])) + if (paren <= rx->nparens && + (s = rx->startp[paren]) && + (t = rx->endp[paren])) { i = t - s; if (i >= 0) @@ -309,25 +309,25 @@ magic_len(SV *sv, MAGIC *mg) } return 0; case '+': - if (curpm && (prx = curpm->op_pmregexp)) { - paren = prx->lastparen; + if (curpm && (rx = curpm->op_pmregexp)) { + paren = rx->lastparen; if (paren) goto getparen; } return 0; case '`': - if (curpm && (prx = curpm->op_pmregexp)) { - if ((s = prx->subbeg) && prx->startp[0]) { - i = prx->startp[0] - s; + if (curpm && (rx = curpm->op_pmregexp)) { + if ((s = rx->subbeg) && rx->startp[0]) { + i = rx->startp[0] - s; if (i >= 0) return i; } } return 0; case '\'': - if (curpm && (prx = curpm->op_pmregexp)) { - if (prx->subend && (s = prx->endp[0])) { - i = prx->subend - s; + if (curpm && (rx = curpm->op_pmregexp)) { + if (rx->subend && (s = rx->endp[0])) { + i = rx->subend - s; if (i >= 0) return i; } @@ -353,7 +353,7 @@ magic_get(SV *sv, MAGIC *mg) register I32 paren; register char *s; register I32 i; - register REGEXP *prx; + register REGEXP *rx; char *t; switch (*mg->mg_ptr) { @@ -457,16 +457,16 @@ magic_get(SV *sv, MAGIC *mg) break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '&': - if (curpm && (prx = curpm->op_pmregexp)) { + if (curpm && (rx = curpm->op_pmregexp)) { /* * Pre-threads, this was paren = atoi(GvENAME((GV*)mg->mg_obj)); * XXX Does the new way break anything? */ paren = atoi(mg->mg_ptr); getparen: - if (paren <= prx->nparens && - (s = prx->startp[paren]) && - (t = prx->endp[paren])) + if (paren <= rx->nparens && + (s = rx->startp[paren]) && + (t = rx->endp[paren])) { i = t - s; getrx: @@ -478,7 +478,8 @@ magic_get(SV *sv, MAGIC *mg) } sv_setpvn(sv,s,i); if (tainting) - tainted = was_tainted || RX_MATCH_TAINTED(prx); + tainted = (was_tainted || RX_MATCH_TAINTED(rx) || + (curpm->op_pmflags & PMf_TAINTMEM)); break; } } @@ -486,26 +487,26 @@ magic_get(SV *sv, MAGIC *mg) sv_setsv(sv,&sv_undef); break; case '+': - if (curpm && (prx = curpm->op_pmregexp)) { - paren = prx->lastparen; + if (curpm && (rx = curpm->op_pmregexp)) { + paren = rx->lastparen; if (paren) goto getparen; } sv_setsv(sv,&sv_undef); break; case '`': - if (curpm && (prx = curpm->op_pmregexp)) { - if ((s = prx->subbeg) && prx->startp[0]) { - i = prx->startp[0] - s; + if (curpm && (rx = curpm->op_pmregexp)) { + if ((s = rx->subbeg) && rx->startp[0]) { + i = rx->startp[0] - s; goto getrx; } } sv_setsv(sv,&sv_undef); break; case '\'': - if (curpm && (prx = curpm->op_pmregexp)) { - if (prx->subend && (s = prx->endp[0])) { - i = prx->subend - s; + if (curpm && (rx = curpm->op_pmregexp)) { + if (rx->subend && (s = rx->endp[0])) { + i = rx->subend - s; goto getrx; } } @@ -702,7 +703,7 @@ magic_setenv(SV *sv, MAGIC *mg) s++; if (i >= sizeof tmpbuf /* too long -- assume the worst */ || *tmpbuf != '/' - || (Stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) { + || (PerlLIO_stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) { MgTAINTEDDIR_on(mg); return 0; } @@ -963,15 +964,38 @@ magic_setamagic(SV *sv, MAGIC *mg) #endif /* OVERLOAD */ int +magic_getnkeys(SV *sv, MAGIC *mg) +{ + HV *hv = (HV*)LvTARG(sv); + HE *entry; + I32 i = 0; + + if (hv) { + (void) hv_iterinit(hv); + if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P')) + i = HvKEYS(hv); + else { + /*SUPPRESS 560*/ + while (entry = hv_iternext(hv)) { + i++; + } + } + } + + sv_setiv(sv, (IV)i); + return 0; +} + +int magic_setnkeys(SV *sv, MAGIC *mg) { if (LvTARG(sv)) { hv_ksplit((HV*)LvTARG(sv), SvIV(sv)); - LvTARG(sv) = Nullsv; /* Don't allow a ref to reassign this. */ } return 0; } +/* caller is responsible for stack switching/cleanup */ STATIC int magic_methcall(MAGIC *mg, char *meth, I32 flags, int n, SV *val) { @@ -1006,11 +1030,13 @@ magic_methpack(SV *sv, MAGIC *mg, char *meth) ENTER; SAVETMPS; + PUSHSTACK(SI_MAGIC); if (magic_methcall(mg, meth, G_SCALAR, 2, NULL)) { sv_setsv(sv, *stack_sp--); } + POPSTACK(); FREETMPS; LEAVE; return 0; @@ -1027,9 +1053,12 @@ magic_getpack(SV *sv, MAGIC *mg) int magic_setpack(SV *sv, MAGIC *mg) -{ +{ + dSP; ENTER; + PUSHSTACK(SI_MAGIC); magic_methcall(mg, "STORE", G_SCALAR|G_DISCARD, 3, sv); + POPSTACK(); LEAVE; return 0; } @@ -1044,15 +1073,17 @@ magic_clearpack(SV *sv, MAGIC *mg) U32 magic_sizepack(SV *sv, MAGIC *mg) { - dTHR; + dSP; U32 retval = 0; ENTER; SAVETMPS; + PUSHSTACK(SI_MAGIC); if (magic_methcall(mg, "FETCHSIZE", G_SCALAR, 2, NULL)) { sv = *stack_sp--; retval = (U32) SvIV(sv)-1; } + POPSTACK(); FREETMPS; LEAVE; return retval; @@ -1062,11 +1093,13 @@ int magic_wipepack(SV *sv, MAGIC *mg) { dSP; + ENTER; + PUSHSTACK(SI_MAGIC); PUSHMARK(SP); XPUSHs(mg->mg_obj); PUTBACK; - ENTER; perl_call_method("CLEAR", G_SCALAR|G_DISCARD); + POPSTACK(); LEAVE; return 0; } @@ -1079,6 +1112,7 @@ magic_nextpack(SV *sv, MAGIC *mg, SV *key) ENTER; SAVETMPS; + PUSHSTACK(SI_MAGIC); PUSHMARK(SP); EXTEND(SP, 2); PUSHs(mg->mg_obj); @@ -1089,6 +1123,7 @@ magic_nextpack(SV *sv, MAGIC *mg, SV *key) if (perl_call_method(meth, G_SCALAR)) sv_setsv(key, *stack_sp--); + POPSTACK(); FREETMPS; LEAVE; return 0; @@ -1224,6 +1259,23 @@ magic_setglob(SV *sv, MAGIC *mg) } int +magic_getsubstr(SV *sv, MAGIC *mg) +{ + STRLEN len; + SV *lsv = LvTARG(sv); + char *tmps = SvPV(lsv,len); + I32 offs = LvTARGOFF(sv); + I32 rem = LvTARGLEN(sv); + + if (offs > len) + offs = len; + if (rem + offs > len) + rem = len - offs; + sv_setpvn(sv, tmps + offs, (STRLEN)rem); + return 0; +} + +int magic_setsubstr(SV *sv, MAGIC *mg) { STRLEN len; @@ -1259,6 +1311,72 @@ magic_settaint(SV *sv, MAGIC *mg) } int +magic_getvec(SV *sv, MAGIC *mg) +{ + SV *lsv = LvTARG(sv); + unsigned char *s; + unsigned long retnum; + STRLEN lsvlen; + I32 len; + I32 offset; + I32 size; + + if (!lsv) { + SvOK_off(sv); + return 0; + } + s = (unsigned char *) SvPV(lsv, lsvlen); + offset = LvTARGOFF(sv); + size = LvTARGLEN(sv); + len = (offset + size + 7) / 8; + + /* Copied from pp_vec() */ + + if (len > lsvlen) { + if (size <= 8) + retnum = 0; + else { + offset >>= 3; + if (size == 16) { + if (offset >= lsvlen) + retnum = 0; + else + retnum = (unsigned long) s[offset] << 8; + } + else if (size == 32) { + if (offset >= lsvlen) + retnum = 0; + else if (offset + 1 >= lsvlen) + retnum = (unsigned long) s[offset] << 24; + else if (offset + 2 >= lsvlen) + retnum = ((unsigned long) s[offset] << 24) + + ((unsigned long) s[offset + 1] << 16); + else + retnum = ((unsigned long) s[offset] << 24) + + ((unsigned long) s[offset + 1] << 16) + + (s[offset + 2] << 8); + } + } + } + else if (size < 8) + retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1); + else { + offset >>= 3; + if (size == 8) + retnum = s[offset]; + else if (size == 16) + retnum = ((unsigned long) s[offset] << 8) + s[offset+1]; + else if (size == 32) + retnum = ((unsigned long) s[offset] << 24) + + ((unsigned long) s[offset + 1] << 16) + + (s[offset + 2] << 8) + s[offset+3]; + } + + sv_setuv(sv, (UV)retnum); + return 0; +} + +int magic_setvec(SV *sv, MAGIC *mg) { do_vecset(sv); /* XXX slurp this routine */ @@ -1277,7 +1395,7 @@ magic_getdefelem(SV *sv, MAGIC *mg) targ = HeVAL(he); } else { - AV* av = (AV*)LvTARG(sv); + AV* av = (AV*)LvTARG(sv); if ((I32)LvTARGOFF(sv) <= AvFILL(av)) targ = AvARRAY(av)[LvTARGOFF(sv)]; } @@ -1393,6 +1511,13 @@ magic_freeregexp(SV *sv, MAGIC *mg) return 0; } +int +magic_unchain(SV *sv, MAGIC *mg) +{ + sv_unmagic(sv, mg->mg_type); + return 0; +} + #ifdef USE_LOCALE_COLLATE int magic_setcollxfrm(SV *sv, MAGIC *mg) @@ -1821,17 +1946,13 @@ sighandler(int sig) HV *st; SV *sv, *tSv = Sv; CV *cv = Nullcv; - AV *oldstack; OP *myop = op; U32 flags = 0; I32 o_save_i = savestack_ix, type; - PERL_CONTEXT *cx; XPV *tXpv = Xpv; if (savestack_ix + 15 <= savestack_max) flags |= 1; - if (cxstack_ix < cxstack_max - 2) - flags |= 2; if (markstack_ptr < markstack_max - 2) flags |= 4; if (retstack_ix < retstack_max - 2) @@ -1839,12 +1960,6 @@ sighandler(int sig) if (scopestack_ix < scopestack_max - 3) flags |= 16; - if (flags & 2) { /* POPBLOCK may decrease cxstack too early. */ - cxstack_ix++; /* Protect from overwrite. */ - cx = &cxstack[cxstack_ix]; - type = cx->cx_type; /* Can be during partial write. */ - cx->cx_type = CXt_NULL; /* Make it safe for unwind. */ - } if (!psig_ptr[sig]) die("Signal SIG%s received, but no signal handler set.\n", sig_name[sig]); @@ -1879,11 +1994,6 @@ sighandler(int sig) goto cleanup; } - oldstack = curstack; - if (curstack != signalstack) - AvFILLp(signalstack) = 0; - SWITCHSTACK(curstack, signalstack); - if(psig_name[sig]) { sv = SvREFCNT_inc(psig_name[sig]); flags |= 64; @@ -1892,20 +2002,18 @@ sighandler(int sig) sv = sv_newmortal(); sv_setpv(sv,sig_name[sig]); } + + PUSHSTACK(SI_SIGNAL); PUSHMARK(SP); PUSHs(sv); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); - SWITCHSTACK(signalstack, oldstack); + POPSTACK(); cleanup: if (flags & 1) savestack_ix -= 8; /* Unprotect save in progress. */ - if (flags & 2) { - cxstack[cxstack_ix].cx_type = type; - cxstack_ix -= 1; - } if (flags & 4) markstack_ptr--; if (flags & 8)