First working TIEARRAY and other misc tie fixes

[p5sagit/p5-mst-13.2.git] / gv.c

diff --git a/gv.c b/gv.c
index 6c912a0..251e453 100644 (file)
--- 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 */
+