X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=a9c137bf9e95618a03fe67822b4db8d60666e508;hb=4eb8286e4c6ac94fdae21a64c54a936bc836983e;hp=e7472a6ec7a736cfa5ab556767f5e513aba3538a;hpb=455ece5e082708b1bd94cff001612bd4efb4d2e9;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index e7472a6..a9c137b 100644 --- a/mg.c +++ b/mg.c @@ -1,6 +1,6 @@ /* mg.c * - * Copyright (c) 1991-1997, Larry Wall + * Copyright (c) 1991-1999, 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. @@ -31,6 +31,7 @@ #else # define VTBL *vtbl static void restore_magic _((void *p)); +static int magic_methcall(SV *sv, MAGIC *mg, char *meth, I32 f, int n, SV *val); #endif /* @@ -47,6 +48,7 @@ struct magic_state { STATIC void save_magic(I32 mgs_ix, SV *sv) { + dTHR; MGS* mgs; assert(SvMAGICAL(sv)); @@ -65,6 +67,7 @@ save_magic(I32 mgs_ix, SV *sv) STATIC void restore_magic(void *p) { + dTHR; MGS* mgs = SSPTR((I32)p, MGS*); SV* sv = mgs->mgs_sv; @@ -92,10 +95,13 @@ restore_magic(void *p) */ if (PL_savestack_ix == mgs->mgs_ss_ix) { - assert(SSPOPINT == SAVEt_DESTRUCTOR); + I32 popval = SSPOPINT; + assert(popval == SAVEt_DESTRUCTOR); PL_savestack_ix -= 2; - assert(SSPOPINT == SAVEt_ALLOC); - PL_savestack_ix -= SSPOPINT; + popval = SSPOPINT; + assert(popval == SAVEt_ALLOC); + popval = SSPOPINT; + PL_savestack_ix -= popval; } } @@ -120,6 +126,7 @@ mg_magical(SV *sv) int mg_get(SV *sv) { + dTHR; I32 mgs_ix; MAGIC* mg; MAGIC** mgp; @@ -154,6 +161,7 @@ mg_get(SV *sv) int mg_set(SV *sv) { + dTHR; I32 mgs_ix; MAGIC* mg; MAGIC* nextmg; @@ -267,13 +275,15 @@ mg_find(SV *sv, int type) } int -mg_copy(SV *sv, SV *nsv, char *key, I32 klen) +mg_copy(SV *sv, SV *nsv, const char *key, I32 klen) { int count = 0; MAGIC* mg; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { if (isUPPER(mg->mg_type)) { - sv_magic(nsv, mg->mg_obj, toLOWER(mg->mg_type), key, klen); + sv_magic(nsv, + mg->mg_type == 'P' ? SvTIED_obj(sv, mg) : mg->mg_obj, + toLOWER(mg->mg_type), key, klen); count++; } } @@ -307,7 +317,7 @@ mg_free(SV *sv) #include #endif -int +U32 magic_regdata_cnt(SV *sv, MAGIC *mg) { dTHR; @@ -316,9 +326,14 @@ magic_regdata_cnt(SV *sv, MAGIC *mg) register REGEXP *rx; char *t; - if (PL_curpm && (rx = PL_curpm->op_pmregexp)) - return rx->lastparen; - return -1; + if (PL_curpm && (rx = PL_curpm->op_pmregexp)) { + if (mg->mg_obj) /* @+ */ + return rx->nparens; + else /* @- */ + return rx->lastparen; + } + + return (U32)-1; } int @@ -340,9 +355,9 @@ magic_regdatum_get(SV *sv, MAGIC *mg) (t = rx->endp[paren])) { if (mg->mg_obj) /* @+ */ - i = t - rx->subbase; + i = t - rx->subbeg; else /* @- */ - i = s - rx->subbase; + i = s - rx->subbeg; sv_setiv(sv,i); } } @@ -406,8 +421,10 @@ magic_len(SV *sv, MAGIC *mg) return (STRLEN)PL_orslen; } magic_get(sv,mg); - if (!SvPOK(sv) && SvNIOK(sv)) - sv_2pv(sv, &PL_na); + if (!SvPOK(sv) && SvNIOK(sv)) { + STRLEN n_a; + sv_2pv(sv, &n_a); + } if (SvPOK(sv)) return SvCUR(sv); return 0; @@ -457,16 +474,20 @@ magic_get(SV *sv, MAGIC *mg) break; case '\002': /* ^B */ /* printf("magic_get $^B: ") ; */ - if (curcop->cop_warnings == WARN_NONE) + if (PL_curcop->cop_warnings == WARN_NONE) /* printf("WARN_NONE\n"), */ sv_setpvn(sv, WARN_NONEstring, WARNsize) ; - else if (curcop->cop_warnings == WARN_ALL) + else if (PL_curcop->cop_warnings == WARN_ALL) /* printf("WARN_ALL\n"), */ sv_setpvn(sv, WARN_ALLstring, WARNsize) ; else - /* printf("some %s\n", printW(curcop->cop_warnings)), */ - sv_setsv(sv, curcop->cop_warnings); + /* printf("some %s\n", printW(PL_curcop->cop_warnings)), */ + sv_setsv(sv, PL_curcop->cop_warnings); break; + case '\003': /* ^C */ + sv_setiv(sv, (IV)PL_minus_c); + break; + case '\004': /* ^D */ sv_setiv(sv, (IV)(PL_debug & 32767)); break; @@ -489,8 +510,11 @@ magic_get(SV *sv, MAGIC *mg) sv_setnv(sv, (double)errno); sv_setpv(sv, errno ? Strerror(errno) : ""); } else { - if (errno != errno_isOS2) - Perl_rc = _syserrno(); + if (errno != errno_isOS2) { + int tmp = _syserrno(); + if (tmp) /* 2nd call to _syserrno() makes it 0 */ + Perl_rc = tmp; + } sv_setnv(sv, (double)Perl_rc); sv_setpv(sv, os2error(Perl_rc)); } @@ -823,7 +847,8 @@ magic_setenv(SV *sv, MAGIC *mg) int magic_clearenv(SV *sv, MAGIC *mg) { - my_setenv(MgPV(mg,PL_na),Nullch); + STRLEN n_a; + my_setenv(MgPV(mg,n_a),Nullch); return 0; } @@ -836,12 +861,13 @@ magic_set_all_env(SV *sv, MAGIC *mg) dTHR; if (PL_localizing) { HE* entry; + STRLEN n_a; magic_clear_all_env(sv,mg); hv_iterinit((HV*)sv); while (entry = hv_iternext((HV*)sv)) { I32 keylen; my_setenv(hv_iterkey(entry, &keylen), - SvPV(hv_iterval((HV*)sv, entry), PL_na)); + SvPV(hv_iterval((HV*)sv, entry), n_a)); } } #endif @@ -854,7 +880,7 @@ magic_clear_all_env(SV *sv, MAGIC *mg) #if defined(VMS) die("Can't make list assignment to %%ENV on this system"); #else -#ifdef WIN32 +# ifdef WIN32 char *envv = GetEnvironmentStrings(); char *cur = envv; STRLEN len; @@ -864,24 +890,27 @@ magic_clear_all_env(SV *sv, MAGIC *mg) *end = '\0'; my_setenv(cur,Nullch); *end = '='; - cur += strlen(end+1)+1; + cur = end + strlen(end+1)+2; } else if ((len = strlen(cur))) cur += len+1; } FreeEnvironmentStrings(envv); -#else +# else +# ifndef PERL_USE_SAFE_PUTENV I32 i; if (environ == PL_origenviron) - New(901, environ, 1, char*); + environ = (char**)safesysmalloc(sizeof(char*)); else for (i = 0; environ[i]; i++) - Safefree(environ[i]); + safesysfree(environ[i]); +# endif /* PERL_USE_SAFE_PUTENV */ + environ[0] = Nullch; -#endif -#endif +# endif /* WIN32 */ +#endif /* VMS */ return 0; } @@ -889,11 +918,12 @@ int magic_getsig(SV *sv, MAGIC *mg) { I32 i; + STRLEN n_a; /* Are we fetching a signal entry? */ - i = whichsig(MgPV(mg,PL_na)); + i = whichsig(MgPV(mg,n_a)); if (i) { - if(psig_ptr[i]) - sv_setsv(sv,psig_ptr[i]); + if(PL_psig_ptr[i]) + sv_setsv(sv,PL_psig_ptr[i]); else { Sighandler_t sigstate = rsignal_state(i); @@ -902,7 +932,7 @@ magic_getsig(SV *sv, MAGIC *mg) sv_setpv(sv,"IGNORE"); else sv_setsv(sv,&PL_sv_undef); - psig_ptr[i] = SvREFCNT_inc(sv); + PL_psig_ptr[i] = SvREFCNT_inc(sv); SvTEMP_off(sv); } } @@ -912,16 +942,17 @@ int magic_clearsig(SV *sv, MAGIC *mg) { I32 i; + STRLEN n_a; /* Are we clearing a signal entry? */ - i = whichsig(MgPV(mg,PL_na)); + i = whichsig(MgPV(mg,n_a)); if (i) { - if(psig_ptr[i]) { - SvREFCNT_dec(psig_ptr[i]); - psig_ptr[i]=0; + if(PL_psig_ptr[i]) { + SvREFCNT_dec(PL_psig_ptr[i]); + PL_psig_ptr[i]=0; } - if(psig_name[i]) { - SvREFCNT_dec(psig_name[i]); - psig_name[i]=0; + if(PL_psig_name[i]) { + SvREFCNT_dec(PL_psig_name[i]); + PL_psig_name[i]=0; } } return 0; @@ -934,8 +965,9 @@ magic_setsig(SV *sv, MAGIC *mg) register char *s; I32 i; SV** svp; + STRLEN len; - s = MgPV(mg,PL_na); + s = MgPV(mg,len); if (*s == '_') { if (strEQ(s,"__DIE__")) svp = &PL_diehook; @@ -958,12 +990,12 @@ magic_setsig(SV *sv, MAGIC *mg) warner(WARN_SIGNAL, "No such signal: SIG%s", s); return 0; } - SvREFCNT_dec(psig_name[i]); - SvREFCNT_dec(psig_ptr[i]); - psig_ptr[i] = SvREFCNT_inc(sv); + SvREFCNT_dec(PL_psig_name[i]); + SvREFCNT_dec(PL_psig_ptr[i]); + PL_psig_ptr[i] = SvREFCNT_inc(sv); SvTEMP_off(sv); /* Make sure it doesn't go away on us */ - psig_name[i] = newSVpv(s, strlen(s)); - SvREADONLY_on(psig_name[i]); + PL_psig_name[i] = newSVpvn(s, len); + SvREADONLY_on(PL_psig_name[i]); } if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) { if (i) @@ -972,7 +1004,7 @@ magic_setsig(SV *sv, MAGIC *mg) *svp = SvREFCNT_inc(sv); return 0; } - s = SvPV_force(sv,PL_na); + s = SvPV_force(sv,len); if (strEQ(s,"IGNORE")) { if (i) (void)rsignal(i, SIG_IGN); @@ -992,7 +1024,7 @@ magic_setsig(SV *sv, MAGIC *mg) * tell whether HINT_STRICT_REFS is in force or not. */ if (!strchr(s,':') && !strchr(s,'\'')) - sv_setpv(sv, form("main::%s", s)); + sv_insert(sv, 0, 0, "main::", 6); if (i) (void)rsignal(i, PL_sighandlerp); else @@ -1008,8 +1040,6 @@ magic_setisa(SV *sv, MAGIC *mg) return 0; } -#ifdef OVERLOAD - int magic_setamagic(SV *sv, MAGIC *mg) { @@ -1018,7 +1048,6 @@ magic_setamagic(SV *sv, MAGIC *mg) return 0; } -#endif /* OVERLOAD */ int magic_getnkeys(SV *sv, MAGIC *mg) @@ -1029,7 +1058,7 @@ magic_getnkeys(SV *sv, MAGIC *mg) if (hv) { (void) hv_iterinit(hv); - if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P')) + if (! SvTIED_mg((SV*)hv, 'P')) i = HvKEYS(hv); else { /*SUPPRESS 560*/ @@ -1054,13 +1083,13 @@ magic_setnkeys(SV *sv, MAGIC *mg) /* caller is responsible for stack switching/cleanup */ STATIC int -magic_methcall(MAGIC *mg, char *meth, I32 flags, int n, SV *val) +magic_methcall(SV *sv, MAGIC *mg, char *meth, I32 flags, int n, SV *val) { dSP; PUSHMARK(SP); EXTEND(SP, n); - PUSHs(mg->mg_obj); + PUSHs(SvTIED_obj(sv, mg)); if (n > 1) { if (mg->mg_ptr) { if (mg->mg_len >= 0) @@ -1089,7 +1118,7 @@ magic_methpack(SV *sv, MAGIC *mg, char *meth) SAVETMPS; PUSHSTACKi(PERLSI_MAGIC); - if (magic_methcall(mg, meth, G_SCALAR, 2, NULL)) { + if (magic_methcall(sv, mg, meth, G_SCALAR, 2, NULL)) { sv_setsv(sv, *PL_stack_sp--); } @@ -1114,7 +1143,7 @@ magic_setpack(SV *sv, MAGIC *mg) dSP; ENTER; PUSHSTACKi(PERLSI_MAGIC); - magic_methcall(mg, "STORE", G_SCALAR|G_DISCARD, 3, sv); + magic_methcall(sv, mg, "STORE", G_SCALAR|G_DISCARD, 3, sv); POPSTACK; LEAVE; return 0; @@ -1136,7 +1165,7 @@ magic_sizepack(SV *sv, MAGIC *mg) ENTER; SAVETMPS; PUSHSTACKi(PERLSI_MAGIC); - if (magic_methcall(mg, "FETCHSIZE", G_SCALAR, 2, NULL)) { + if (magic_methcall(sv, mg, "FETCHSIZE", G_SCALAR, 2, NULL)) { sv = *PL_stack_sp--; retval = (U32) SvIV(sv)-1; } @@ -1153,7 +1182,7 @@ int magic_wipepack(SV *sv, MAGIC *mg) ENTER; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); - XPUSHs(mg->mg_obj); + XPUSHs(SvTIED_obj(sv, mg)); PUTBACK; perl_call_method("CLEAR", G_SCALAR|G_DISCARD); POPSTACK; @@ -1172,7 +1201,7 @@ magic_nextpack(SV *sv, MAGIC *mg, SV *key) PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); EXTEND(SP, 2); - PUSHs(mg->mg_obj); + PUSHs(SvTIED_obj(sv, mg)); if (SvOK(key)) PUSHs(key); PUTBACK; @@ -1200,11 +1229,12 @@ magic_setdbline(SV *sv, MAGIC *mg) I32 i; GV* gv; SV** svp; + STRLEN n_a; gv = PL_DBline; i = SvTRUE(sv); svp = av_fetch(GvAV(gv), - atoi(MgPV(mg,PL_na)), FALSE); + atoi(MgPV(mg,n_a)), FALSE); if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp))) o->op_private = i; else @@ -1321,10 +1351,11 @@ magic_setglob(SV *sv, MAGIC *mg) { register char *s; GV* gv; + STRLEN n_a; if (!SvOK(sv)) return 0; - s = SvPV(sv, PL_na); + s = SvPV(sv, n_a); if (*s == '*' && s[1]) s++; gv = gv_fetchpv(s,TRUE, SVt_PVGV); @@ -1524,6 +1555,7 @@ vivify_defelem(SV *sv) return; if (mg->mg_obj) { SV *ahv = LvTARG(sv); + STRLEN n_a; if (SvTYPE(ahv) == SVt_PVHV) { HE *he = hv_fetch_ent((HV*)ahv, mg->mg_obj, TRUE, 0); if (he) @@ -1535,7 +1567,7 @@ vivify_defelem(SV *sv) value = *svp; } if (!value || value == &PL_sv_undef) - croak(no_helem, SvPV(mg->mg_obj, PL_na)); + croak(PL_no_helem, SvPV(mg->mg_obj, n_a)); } else { AV* av = (AV*)LvTARG(sv); @@ -1544,7 +1576,7 @@ vivify_defelem(SV *sv) else { SV** svp = av_fetch(av, LvTARGOFF(sv), TRUE); if (!svp || (value = *svp) == &PL_sv_undef) - croak(no_aelem, (I32)LvTARGOFF(sv)); + croak(PL_no_aelem, (I32)LvTARGOFF(sv)); } } (void)SvREFCNT_inc(value); @@ -1603,7 +1635,7 @@ int magic_setcollxfrm(SV *sv, MAGIC *mg) { /* - * René Descartes said "I think not." + * RenE Descartes said "I think not." * and vanished with a faint plop. */ if (mg->mg_ptr) { @@ -1629,18 +1661,23 @@ magic_set(SV *sv, MAGIC *mg) case '\002': /* ^B */ if ( ! (PL_dowarn & G_WARN_ALL_MASK)) { if (memEQ(SvPVX(sv), WARN_ALLstring, WARNsize)) - compiling.cop_warnings = WARN_ALL; + PL_compiling.cop_warnings = WARN_ALL; else if (memEQ(SvPVX(sv), WARN_NONEstring, WARNsize)) - compiling.cop_warnings = WARN_NONE; + PL_compiling.cop_warnings = WARN_NONE; else { - if (compiling.cop_warnings != WARN_NONE && - compiling.cop_warnings != WARN_ALL) - sv_setsv(compiling.cop_warnings, sv); + if (PL_compiling.cop_warnings != WARN_NONE && + PL_compiling.cop_warnings != WARN_ALL) + sv_setsv(PL_compiling.cop_warnings, sv); else - compiling.cop_warnings = newSVsv(sv) ; + PL_compiling.cop_warnings = newSVsv(sv) ; } } break; + + case '\003': /* ^C */ + PL_minus_c = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); + break; + case '\004': /* ^D */ PL_debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000; DEBUG_x(dump_all()); @@ -1667,7 +1704,7 @@ magic_set(SV *sv, MAGIC *mg) if (PL_inplace) Safefree(PL_inplace); if (SvOK(sv)) - PL_inplace = savepv(SvPV(sv,PL_na)); + PL_inplace = savepv(SvPV(sv,len)); else PL_inplace = Nullch; break; @@ -1675,7 +1712,7 @@ magic_set(SV *sv, MAGIC *mg) if (PL_osname) Safefree(PL_osname); if (SvOK(sv)) - PL_osname = savepv(SvPV(sv,PL_na)); + PL_osname = savepv(SvPV(sv,len)); else PL_osname = Nullch; break; @@ -1705,12 +1742,12 @@ magic_set(SV *sv, MAGIC *mg) break; case '^': Safefree(IoTOP_NAME(GvIOp(PL_defoutgv))); - IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,PL_na)); + IoTOP_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len)); IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO); break; case '~': Safefree(IoFMT_NAME(GvIOp(PL_defoutgv))); - IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,PL_na)); + IoFMT_NAME(GvIOp(PL_defoutgv)) = s = savepv(SvPV(sv,len)); IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO); break; case '=': @@ -1767,7 +1804,7 @@ magic_set(SV *sv, MAGIC *mg) case '#': if (PL_ofmt) Safefree(PL_ofmt); - PL_ofmt = savepv(SvPV(sv,PL_na)); + PL_ofmt = savepv(SvPV(sv,len)); break; case '[': PL_compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); @@ -1875,7 +1912,7 @@ magic_set(SV *sv, MAGIC *mg) case ')': #ifdef HAS_SETGROUPS { - char *p = SvPV(sv, PL_na); + char *p = SvPV(sv, len); Groups_t gary[NGROUPS]; SET_NUMERIC_STANDARD(); @@ -1923,7 +1960,7 @@ magic_set(SV *sv, MAGIC *mg) PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid)); break; case ':': - PL_chopset = SvPV_force(sv,PL_na); + PL_chopset = SvPV_force(sv,len); break; case '0': if (!PL_origalen) { @@ -1936,7 +1973,10 @@ magic_set(SV *sv, MAGIC *mg) || PL_origargv[i] == s + 2 #endif ) - s += strlen(++s); /* this one is ok too */ + { + ++s; + s += strlen(s); /* this one is ok too */ + } else break; } @@ -1949,8 +1989,10 @@ magic_set(SV *sv, MAGIC *mg) my_setenv("NoNe SuCh", Nullch); /* force copy of environment */ for (i = 0; PL_origenviron[i]; i++) - if (PL_origenviron[i] == s + 1) - s += strlen(++s); + if (PL_origenviron[i] == s + 1) { + ++s; + s += strlen(s); + } else break; } @@ -1997,7 +2039,6 @@ magic_mutexfree(SV *sv, MAGIC *mg) croak("panic: magic_mutexfree"); MUTEX_DESTROY(MgMUTEXP(mg)); COND_DESTROY(MgCONDP(mg)); - SvREFCNT_dec(sv); return 0; } #endif /* USE_THREADS */ @@ -2007,9 +2048,9 @@ whichsig(char *sig) { register char **sigv; - for (sigv = sig_name+1; *sigv; sigv++) + for (sigv = PL_sig_name+1; *sigv; sigv++) if (strEQ(sig,*sigv)) - return sig_num[sigv - sig_name]; + return PL_sig_num[sigv - PL_sig_name]; #ifdef SIGCLD if (strEQ(sig,"CHLD")) return SIGCLD; @@ -2058,9 +2099,9 @@ sighandler(int sig) if (PL_scopestack_ix < PL_scopestack_max - 3) flags |= 16; - if (!psig_ptr[sig]) + if (!PL_psig_ptr[sig]) die("Signal SIG%s received, but no signal handler set.\n", - sig_name[sig]); + PL_sig_name[sig]); /* Max number of items pushed there is 3*n or 4. We cannot fix infinity, so we fix 4 (in fact 5): */ @@ -2078,27 +2119,27 @@ sighandler(int sig) if (flags & 16) PL_scopestack_ix += 1; /* sv_2cv is too complicated, try a simpler variant first: */ - if (!SvROK(psig_ptr[sig]) || !(cv = (CV*)SvRV(psig_ptr[sig])) + if (!SvROK(PL_psig_ptr[sig]) || !(cv = (CV*)SvRV(PL_psig_ptr[sig])) || SvTYPE(cv) != SVt_PVCV) - cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE); + cv = sv_2cv(PL_psig_ptr[sig],&st,&gv,TRUE); if (!cv || !CvROOT(cv)) { if (ckWARN(WARN_SIGNAL)) warner(WARN_SIGNAL, "SIG%s handler \"%s\" not defined.\n", - sig_name[sig], (gv ? GvENAME(gv) + PL_sig_name[sig], (gv ? GvENAME(gv) : ((cv && CvGV(cv)) ? GvENAME(CvGV(cv)) : "__ANON__"))); goto cleanup; } - if(psig_name[sig]) { - sv = SvREFCNT_inc(psig_name[sig]); + if(PL_psig_name[sig]) { + sv = SvREFCNT_inc(PL_psig_name[sig]); flags |= 64; sig_sv = sv; } else { sv = sv_newmortal(); - sv_setpv(sv,sig_name[sig]); + sv_setpv(sv,PL_sig_name[sig]); } PUSHSTACKi(PERLSI_SIGNAL);