[patch] xsub AUTOLOAD fix/optimization

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

diff --git a/gv.c b/gv.c
index 8f9395f..f2931ae 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1,6 +1,6 @@
 /*    gv.c
  *
- *    Copyright (c) 1991-2000, Larry Wall
+ *    Copyright (c) 1991-2001, 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.
@@ -412,7 +412,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
        return Nullgv;
     cv = GvCV(gv);
 
-    if (!CvROOT(cv))
+    if (!(CvROOT(cv) || CvXSUB(cv)))
        return Nullgv;
 
     /*
@@ -424,6 +424,20 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
          "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated",
             HvNAME(stash), (int)len, name);
 
+#ifndef USE_THREADS
+    if (CvXSUB(cv)) {
+        /* rather than lookup/init $AUTOLOAD here
+         * only to have the XSUB do another lookup for $AUTOLOAD
+         * and split that value on the last '::',
+         * pass along the same data via some unused fields in the CV
+         */
+        CvSTASH(cv) = stash;
+        SvPVX(cv) = (char *)name; /* cast to loose constness warning */
+        SvCUR(cv) = len;
+        return gv;
+    }
+#endif
+
     /*
      * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
      * The subroutine's original name may not be "AUTOLOAD", so we don't
@@ -1155,7 +1169,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
 
   if (mg && amtp->was_ok_am == PL_amagic_generation
       && amtp->was_ok_sub == PL_sub_generation)
-      return AMT_AMAGIC(amtp);
+      return AMT_OVERLOADED(amtp);
   if (amtp && AMT_AMAGIC(amtp)) {      /* Have table. */
     int i;
     for (i=1; i<NofAMmeth; i++) {
@@ -1174,8 +1188,8 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
   amt.flags = 0;
 
   {
-    int filled = 0;
-    int i;
+    int filled = 0, have_ovl = 0;
+    int i, lim = 1;
     const char *cp;
     SV* sv = NULL;
 
@@ -1187,15 +1201,18 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
        sv = GvSV(gv);
 
     if (!gv)
-       goto no_table;
+       lim = DESTROY_amg;              /* Skip overloading entries. */
     else if (SvTRUE(sv))
        amt.fallback=AMGfallYES;
     else if (SvOK(sv))
        amt.fallback=AMGfallNEVER;
 
-    for (i = 1; i < NofAMmeth; i++) {
-       char *cooky = PL_AMG_names[i];
-       char *cp = AMG_id2name(i); /* Human-readable form, for debugging */
+    for (i = 1; i < lim; i++)
+       amt.table[i] = Nullcv;
+    for (; i < NofAMmeth; i++) {
+       char *cooky = (char*)PL_AMG_names[i];
+       /* Human-readable form, for debugging: */
+       char *cp = (i >= DESTROY_amg ? cooky : AMG_id2name(i));
        STRLEN l = strlen(cooky);
 
        DEBUG_o( Perl_deb(aTHX_ "Checking overloading of `%s' in package `%.256s'\n",
@@ -1231,13 +1248,17 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
                         cp, HvNAME(stash), HvNAME(GvSTASH(CvGV(cv))),
                         GvNAME(CvGV(cv))) );
            filled = 1;
+           if (i < DESTROY_amg)
+               have_ovl = 1;
        }
        amt.table[i]=(CV*)SvREFCNT_inc(cv);
     }
     if (filled) {
       AMT_AMAGIC_on(&amt);
+      if (have_ovl)
+         AMT_OVERLOADED_on(&amt);
       sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMT));
-      return TRUE;
+      return have_ovl;
     }
   }
   /* Here we have no table: */
@@ -1247,6 +1268,32 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
   return FALSE;
 }
 
+
+CV*
+Perl_gv_handler(pTHX_ HV *stash, I32 id)
+{
+    dTHR;
+    MAGIC *mg;
+    AMT *amtp;
+
+    if (!stash)
+        return Nullcv;
+    mg = mg_find((SV*)stash,'c');
+    if (!mg) {
+      do_update:
+       Gv_AMupdate(stash);
+       mg = mg_find((SV*)stash,'c');
+    }
+    amtp = (AMT*)mg->mg_ptr;
+    if ( amtp->was_ok_am != PL_amagic_generation
+        || amtp->was_ok_sub != PL_sub_generation )
+       goto do_update;
+    if (AMT_AMAGIC(amtp))
+       return amtp->table[id];
+    return Nullcv;
+}
+
+
 SV*
 Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 {