X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=5e649bb9b985582df9eac726b36bf1421d087f09;hb=cf8a192df3df82f50274b83f7996aab39275728a;hp=9461515662350264326db8324cd99d200cc5d68c;hpb=3d37d572263f014bc820cfc5b23dcae8df5b95f1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index 9461515..5e649bb 100644 --- a/mg.c +++ b/mg.c @@ -21,6 +21,58 @@ #endif */ +/* + * Use the "DESTRUCTOR" scope cleanup to reinstate magic. + */ + +struct magic_state { + SV* mgs_sv; + U32 mgs_flags; +}; +typedef struct magic_state MGS; + +static void restore_magic _((void *p)); + +static MGS * +save_magic(sv) +SV* sv; +{ + MGS* mgs; + + assert(SvMAGICAL(sv)); + + mgs = (MGS*)safemalloc(sizeof(MGS)); + mgs->mgs_sv = sv; + mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv); + SAVEDESTRUCTOR(restore_magic, mgs); + + SvMAGICAL_off(sv); + SvREADONLY_off(sv); + SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; + + return mgs; +} + +static void +restore_magic(p) +void* p; +{ + MGS *mgs = (MGS*)p; + SV* sv = mgs->mgs_sv; + + if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) + { + if (mgs->mgs_flags) + SvFLAGS(sv) |= mgs->mgs_flags; + else + mg_magical(sv); + if (SvGMAGICAL(sv)) + SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); + } + + Safefree(mgs); +} + void mg_magical(sv) @@ -44,30 +96,28 @@ int mg_get(sv) SV* sv; { + MGS* mgs; MAGIC* mg; - U32 savemagic = SvMAGICAL(sv) | SvREADONLY(sv); + MAGIC** mgp; - assert(SvGMAGICAL(sv)); - SvMAGICAL_off(sv); - SvREADONLY_off(sv); - SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; + ENTER; + mgs = save_magic(sv); - for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { + mgp = &SvMAGIC(sv); + while ((mg = *mgp) != 0) { MGVTBL* vtbl = mg->mg_virtual; if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) { (*vtbl->svt_get)(sv, mg); - if (mg->mg_flags & MGf_GSKIP) - savemagic = 0; + /* Ignore this magic if it's been deleted */ + if (*mgp == mg && (mg->mg_flags & MGf_GSKIP)) + mgs->mgs_flags = 0; } + /* Advance to next magic (complicated by possible deletion) */ + if (*mgp == mg) + mgp = &mg->mg_moremagic; } - if (savemagic) - SvFLAGS(sv) |= savemagic; - else - mg_magical(sv); - if (SvGMAGICAL(sv)) - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - + LEAVE; return 0; } @@ -75,33 +125,25 @@ int mg_set(sv) SV* sv; { + MGS* mgs; MAGIC* mg; MAGIC* nextmg; - U32 savemagic = SvMAGICAL(sv); - SvMAGICAL_off(sv); - SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; + ENTER; + mgs = save_magic(sv); for (mg = SvMAGIC(sv); mg; mg = nextmg) { MGVTBL* vtbl = mg->mg_virtual; nextmg = mg->mg_moremagic; /* it may delete itself */ if (mg->mg_flags & MGf_GSKIP) { mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */ - savemagic = 0; + mgs->mgs_flags = 0; } if (vtbl && vtbl->svt_set) (*vtbl->svt_set)(sv, mg); } - if (SvMAGIC(sv)) { - if (savemagic) - SvFLAGS(sv) |= savemagic; - else - mg_magical(sv); - if (SvGMAGICAL(sv)) - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - } - + LEAVE; return 0; } @@ -116,18 +158,11 @@ SV* sv; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; if (vtbl && vtbl->svt_len) { - U32 savemagic = SvMAGICAL(sv); - - SvMAGICAL_off(sv); - SvFLAGS(sv) |= (SvFLAGS(sv)&(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; - + ENTER; + save_magic(sv); /* omit MGf_GSKIP -- not changed here */ len = (*vtbl->svt_len)(sv, mg); - - SvFLAGS(sv) |= savemagic; - if (SvGMAGICAL(sv)) - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - + LEAVE; return len; } } @@ -141,10 +176,9 @@ mg_clear(sv) SV* sv; { MAGIC* mg; - U32 savemagic = SvMAGICAL(sv); - SvMAGICAL_off(sv); - SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; + ENTER; + save_magic(sv); for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; @@ -154,10 +188,7 @@ SV* sv; (*vtbl->svt_clear)(sv, mg); } - SvFLAGS(sv) |= savemagic; - if (SvGMAGICAL(sv)) - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); - + LEAVE; return 0; } @@ -301,6 +332,25 @@ MAGIC *mg; case '\004': /* ^D */ sv_setiv(sv,(I32)(debug & 32767)); break; + case '\005': /* ^E */ +#ifdef VMS + { +# include +# include + char msg[255]; + $DESCRIPTOR(msgdsc,msg); + sv_setnv(sv,(double)vaxc$errno); + if (sys$getmsg(vaxc$errno,&msgdsc.dsc$w_length,&msgdsc,0,0) & 1) + sv_setpvn(sv,msgdsc.dsc$a_pointer,msgdsc.dsc$w_length); + else + sv_setpv(sv,""); + } +#else + sv_setnv(sv,(double)errno); + sv_setpv(sv, errno ? Strerror(errno) : ""); +#endif + SvNOK_on(sv); /* what a wonderful hack! */ + break; case '\006': /* ^F */ sv_setiv(sv,(I32)maxsysfd); break; @@ -313,6 +363,9 @@ MAGIC *mg; else sv_setsv(sv,&sv_undef); break; + case '\017': /* ^O */ + sv_setpv(sv,osname); + break; case '\020': /* ^P */ sv_setiv(sv,(I32)perldb); break; @@ -430,7 +483,11 @@ MAGIC *mg; sv_setpv(sv,ofmt); break; case '!': +#ifdef VMS + sv_setnv(sv,(double)((errno == EVMSERR) ? vaxc$errno : errno)); +#else sv_setnv(sv,(double)errno); +#endif sv_setpv(sv, errno ? Strerror(errno) : ""); SvNOK_on(sv); /* what a wonderful hack! */ break; @@ -967,6 +1024,7 @@ SV* sv; MAGIC* mg; { mg->mg_len = -1; + SvSCREAM_off(sv); return 0; } @@ -1008,6 +1066,13 @@ MAGIC* mg; debug = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) | 0x80000000; DEBUG_x(dump_all()); break; + case '\005': /* ^E */ +#ifdef VMS + set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); +#else + SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),4); /* will anyone ever use this? */ +#endif + break; case '\006': /* ^F */ maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); break; @@ -1022,6 +1087,14 @@ MAGIC* mg; else inplace = Nullch; break; + case '\017': /* ^O */ + if (osname) + Safefree(osname); + if (SvOK(sv)) + osname = savepv(SvPV(sv,na)); + else + osname = Nullch; + break; case '\020': /* ^P */ i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); if (i != perldb) { @@ -1078,19 +1151,10 @@ MAGIC* mg; multiline = (i != 0); break; case '/': - if (SvOK(sv)) { - nrs = rs = SvPV_force(sv,rslen); - nrslen = rslen; - if (rspara = !rslen) { - nrs = rs = "\n\n"; - nrslen = rslen = 2; - } - nrschar = rschar = rs[rslen - 1]; - } - else { - nrschar = rschar = 0777; /* fake a non-existent char */ - nrslen = rslen = 1; - } + SvREFCNT_dec(nrs); + nrs = newSVsv(sv); + SvREFCNT_dec(rs); + rs = SvREFCNT_inc(nrs); break; case '\\': if (ors) @@ -1114,7 +1178,7 @@ MAGIC* mg; statusvalue = FIXSTATUS(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '!': - SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),SS$_ABORT); /* will anyone ever use this? */ + SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),SvIV(sv) == EVMSERR ? 4 : vaxc$errno); /* will anyone ever use this? */ break; case '<': uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);