X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=gv.c;h=251e45373396f291f691474de00fd1b9dede1a46;hb=8ec5e241bff6550c56f30587b70b41dc3236277c;hp=6c912a0e9b365aa3e1e9e95275ab0308d341d4cd;hpb=fc36a67e8855d031b2a6921819d899eb149eee2d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/gv.c b/gv.c index 6c912a0..251e453 100644 --- a/gv.c +++ b/gv.c @@ -22,8 +22,7 @@ EXT char rcsid[]; GV * -gv_AVadd(gv) -register GV *gv; +gv_AVadd(register GV *gv) { if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) croak("Bad symbol for array"); @@ -33,8 +32,7 @@ register GV *gv; } GV * -gv_HVadd(gv) -register GV *gv; +gv_HVadd(register GV *gv) { if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) croak("Bad symbol for hash"); @@ -44,8 +42,7 @@ register GV *gv; } GV * -gv_IOadd(gv) -register GV *gv; +gv_IOadd(register GV *gv) { if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) croak("Bad symbol for filehandle"); @@ -55,9 +52,9 @@ register GV *gv; } GV * -gv_fetchfile(name) -char *name; +gv_fetchfile(char *name) { + dTHR; char smallbuf[256]; char *tmpbuf; STRLEN tmplen; @@ -79,19 +76,15 @@ char *name; sv_setpv(GvSV(gv), name); if (*name == '/' && (instr(name, "/lib/") || instr(name, ".pm"))) GvMULTI_on(gv); - if (perldb) + if (PERLDB_LINE) hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L'); return gv; } void -gv_init(gv, stash, name, len, multi) -GV *gv; -HV *stash; -char *name; -STRLEN len; -int multi; +gv_init(GV *gv, HV *stash, char *name, STRLEN len, int multi) { + dTHR; register GP *gp; sv_upgrade((SV*)gv, SVt_PVGV); @@ -112,9 +105,7 @@ int multi; } static void -gv_init_sv(gv, sv_type) -GV* gv; -I32 sv_type; +gv_init_sv(GV *gv, I32 sv_type) { switch (sv_type) { case SVt_PVIO: @@ -130,11 +121,7 @@ I32 sv_type; } GV * -gv_fetchmeth(stash, name, len, level) -HV* stash; -char* name; -STRLEN len; -I32 level; +gv_fetchmeth(HV *stash, char *name, STRLEN len, I32 level) { AV* av; GV* topgv; @@ -170,8 +157,8 @@ I32 level; gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE); av = (gvp && (gv = *gvp) && gv != (GV*)&sv_undef) ? GvAV(gv) : Nullav; - /* create @.*::SUPER::ISA on demand */ - if (!av) { + /* create and re-create @.*::SUPER::ISA on demand */ + if (!av || !SvMAGIC(av)) { char* packname = HvNAME(stash); STRLEN packlen = strlen(packname); @@ -182,6 +169,7 @@ I32 level; basestash = gv_stashpvn(packname, packlen, TRUE); gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE); if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) { + dTHR; /* just for SvREFCNT_dec */ gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE); if (!gvp || !(gv = *gvp)) croak("Cannot create %s::ISA", HvNAME(stash)); @@ -195,7 +183,8 @@ I32 level; if (av) { SV** svp = AvARRAY(av); - I32 items = AvFILL(av) + 1; + /* NOTE: No support for tied ISA */ + I32 items = AvFILLp(av) + 1; while (items--) { SV* sv = *svp++; HV* basestash = gv_stashsv(sv, FALSE); @@ -245,19 +234,15 @@ I32 level; } GV * -gv_fetchmethod(stash, name) -HV* stash; -char* name; +gv_fetchmethod(HV *stash, char *name) { return gv_fetchmethod_autoload(stash, name, TRUE); } GV * -gv_fetchmethod_autoload(stash, name, autoload) -HV* stash; -char* name; -I32 autoload; +gv_fetchmethod_autoload(HV *stash, char *name, I32 autoload) { + dTHR; register char *nend; char *nsplit = 0; GV* gv; @@ -316,11 +301,7 @@ I32 autoload; } GV* -gv_autoload4(stash, name, len, method) -HV* stash; -char* name; -STRLEN len; -I32 method; +gv_autoload4(HV *stash, char *name, STRLEN len, I32 method) { static char autoload[] = "AUTOLOAD"; static STRLEN autolen = 8; @@ -363,18 +344,13 @@ I32 method; } HV* -gv_stashpv(name,create) -char *name; -I32 create; +gv_stashpv(char *name, I32 create) { return gv_stashpvn(name, strlen(name), create); } HV* -gv_stashpvn(name,namelen,create) -char *name; -U32 namelen; -I32 create; +gv_stashpvn(char *name, U32 namelen, I32 create) { char smallbuf[256]; char *tmpbuf; @@ -403,9 +379,7 @@ I32 create; } HV* -gv_stashsv(sv,create) -SV *sv; -I32 create; +gv_stashsv(SV *sv, I32 create) { register char *ptr; STRLEN len; @@ -415,11 +389,9 @@ I32 create; GV * -gv_fetchpv(nambeg,add,sv_type) -char *nambeg; -I32 add; -I32 sv_type; +gv_fetchpv(char *nambeg, I32 add, I32 sv_type) { + dTHR; register char *name = nambeg; register GV *gv = 0; GV**gvp; @@ -611,7 +583,8 @@ I32 sv_type; AV* av = GvAVn(gv); GvMULTI_on(gv); sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0); - if (add & 2 && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILL(av) == -1) + /* NOTE: No support for tied ISA */ + if (add & 2 && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILLp(av) == -1) { char *pname; av_push(av, newSVpv(pname = "NDBM_File",0)); @@ -632,7 +605,7 @@ I32 sv_type; if (strEQ(name, "OVERLOAD")) { HV* hv = GvHVn(gv); GvMULTI_on(gv); - sv_magic((SV*)hv, (SV*)gv, 'A', 0, 0); + hv_magic(hv, gv, 'A'); } break; #endif /* OVERLOAD */ @@ -740,6 +713,7 @@ I32 sv_type; case '7': case '8': case '9': + case '\023': ro_magicalize: SvREADONLY_on(GvSV(gv)); magicalize: @@ -771,10 +745,7 @@ I32 sv_type; } void -gv_fullname3(sv, gv, prefix) -SV *sv; -GV *gv; -char *prefix; +gv_fullname3(SV *sv, GV *gv, char *prefix) { HV *hv = GvSTASH(gv); if (!hv) { @@ -788,10 +759,7 @@ char *prefix; } void -gv_efullname3(sv, gv, prefix) -SV *sv; -GV *gv; -char *prefix; +gv_efullname3(SV *sv, GV *gv, char *prefix) { GV *egv = GvEGV(gv); if (!egv) @@ -801,25 +769,22 @@ char *prefix; /* XXX compatibility with versions <= 5.003. */ void -gv_fullname(sv,gv) -SV *sv; -GV *gv; +gv_fullname(SV *sv, GV *gv) { gv_fullname3(sv, gv, sv == (SV*)gv ? "*" : ""); } /* XXX compatibility with versions <= 5.003. */ void -gv_efullname(sv,gv) -SV *sv; -GV *gv; +gv_efullname(SV *sv, GV *gv) { gv_efullname3(sv, gv, sv == (SV*)gv ? "*" : ""); } IO * -newIO() +newIO(void) { + dTHR; IO *io; GV *iogv; @@ -827,15 +792,17 @@ newIO() sv_upgrade((SV *)io,SVt_PVIO); SvREFCNT(io) = 1; SvOBJECT_on(io); - iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV); + iogv = gv_fetchpv("FileHandle::", FALSE, SVt_PVHV); + if (!iogv) + iogv = gv_fetchpv("IO::Handle::", TRUE, SVt_PVHV); SvSTASH(io) = (HV*)SvREFCNT_inc(GvHV(iogv)); return io; } void -gv_check(stash) -HV* stash; +gv_check(HV *stash) { + dTHR; register HE *entry; register I32 i; register GV *gv; @@ -869,8 +836,7 @@ HV* stash; } GV * -newGVgen(pack) -char *pack; +newGVgen(char *pack) { return gv_fetchpv(form("%s::_GEN_%ld", pack, (long)gensym++), TRUE, SVt_PVGV); @@ -879,8 +845,7 @@ char *pack; /* hopefully this is only called on local symbol table entries */ GP* -gp_ref(gp) -GP* gp; +gp_ref(GP *gp) { gp->gp_refcnt++; if (gp->gp_cv) { @@ -899,8 +864,7 @@ GP* gp; } void -gp_free(gv) -GV* gv; +gp_free(GV *gv) { GP* gp; CV* cv; @@ -960,15 +924,15 @@ register GV *gv; /* Updates and caches the CV's */ bool -Gv_AMupdate(stash) -HV* stash; +Gv_AMupdate(HV *stash) { + dTHR; GV** gvp; HV* hv; GV* gv; CV* cv; MAGIC* mg=mg_find((SV*)stash,'c'); - AMT *amtp=mg ? (AMT*)mg->mg_ptr: NULL; + AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL; AMT amt; if (mg && amtp->was_ok_am == amagic_generation @@ -1120,12 +1084,9 @@ HV* stash; * advised to call SPAGAIN macro in your code after call */ SV* -amagic_call(left,right,method,flags) -SV* left; -SV* right; -int method; -int flags; +amagic_call(SV *left, SV *right, int method, int flags) { + dTHR; MAGIC *mg; CV *cv; CV **cvp=NULL, **ocvp=NULL; @@ -1137,7 +1098,7 @@ int flags; && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c')) && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table - : NULL)) + : (CV **) NULL)) && ((cv = cvp[off=method+assignshift]) || (assign && amtp->fallback > AMGfallNEVER && /* fallback to * usual method */ @@ -1230,7 +1191,7 @@ int flags; && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),'c')) && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (amtp = (AMT*)mg->mg_ptr)->table - : NULL)) + : (CV **) NULL)) && (cv = cvp[off=method])) { /* Method for right * argument found */ lr=1; @@ -1337,12 +1298,12 @@ int flags; myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED; ENTER; - SAVESPTR(op); + SAVEOP(); op = (OP *) &myop; - if (perldb && curstash != debstash) + if (PERLDB_SUB && curstash != debstash) op->op_private |= OPpENTERSUB_DB; PUTBACK; - pp_pushmark(); + pp_pushmark(ARGS); EXTEND(sp, notfound + 5); PUSHs(lr>0? right: left); @@ -1354,7 +1315,7 @@ int flags; PUSHs((SV*)cv); PUTBACK; - if (op = pp_entersub()) + if (op = pp_entersub(ARGS)) runops(); LEAVE; SPAGAIN; @@ -1402,3 +1363,4 @@ int flags; } } #endif /* OVERLOAD */ +