Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Convert method_named to subs if possible, +3.95% faster

From: Doug MacEachern <dougm@covalent.net>
To: Gurusamy Sarathy <gsar@ActiveState.com>
cc: Ben Tilly <ben_tilly@hotmail.com>, perl5-porters@perl.com
Date: Thu, 15 Jun 2000 23:03:15 -0700 (PDT)
Message-ID: <Pine.LNX.4.10.10006152259140.344-100000@mojo.covalent.net>

If &Foo::bar exists, Foo::->bar() could be changed at
compile time to a subroutine call, as can typed object calls:
    my Foo $obj = shift;
    $obj->bar();
  • Loading branch information...
commit 7a305aae0b3351c5044af48e93f90e62f058c21e 1 parent bc520e2
Reini Urban authored July 28, 2011

Showing 1 changed file with 100 additions and 0 deletions. Show diff stats Hide diff stats

  1. 100  op.c
100  op.c
@@ -9041,6 +9041,98 @@ Perl_cv_set_call_checker(pTHX_ CV *cv, Perl_call_checker ckfun, SV *ckobj)
9041 9041
     }
9042 9042
 }
9043 9043
 
  9044
+/* If &Foo::bar exists or if %Foo:: isn't modified at run time, Foo::->bar() 
  9045
+ * could be resolved at compile time to a subroutine call.
  9046
+ * Foo->bar(args...) :
  9047
+ *   pushmark
  9048
+ *   const PV => "Foo"
  9049
+ *     args ...
  9050
+ *   method_named => PV "bar"
  9051
+ *   entersub
  9052
+ * =>
  9053
+ *   pushmark
  9054
+ *   const PV => "Foo"
  9055
+ *     args ...
  9056
+ *   gv => *Foo::bar
  9057
+ *   entersub
  9058
+ * 
  9059
+ * Also if the class is typed, as in 
  9060
+ *   my Foo $obj = shift;
  9061
+ *   $obj->bar(args...);
  9062
+ *
  9063
+ *   pushmark
  9064
+ *   padsv GV => *Foo
  9065
+ *     args ...
  9066
+ *   method_named => PV "bar"
  9067
+ *   entersub
  9068
+ */
  9069
+STATIC OP *
  9070
+S_method_to_entersub(pTHX_ OP *o, OP *svop)
  9071
+{
  9072
+    GV *gv;
  9073
+    SV *method = ((SVOP*)svop)->op_sv;
  9074
+    char *methname;
  9075
+    STRLEN methlen;
  9076
+    HV *stash;
  9077
+    OP *nop;
  9078
+    OP *mop;
  9079
+
  9080
+    if (svop->op_type == OP_METHOD_NAMED)
  9081
+        methname = SvPV(method, methlen);
  9082
+    else
  9083
+        return ((OP*)NULL);
  9084
+
  9085
+    if (o->op_type == OP_CONST) {
  9086
+        /* const class: Foo->bar() */
  9087
+        STRLEN len;
  9088
+        char *package = SvPV(((SVOP*)o)->op_sv, len);
  9089
+        stash = gv_stashpvn(package, len, FALSE);
  9090
+    }
  9091
+    else if (o->op_type == OP_PADSV) {
  9092
+        /* typed class: my Foo $obj; $obj->bar */
  9093
+        SV *sv = *av_fetch(PL_comppad_name, o->op_targ, FALSE);
  9094
+        if (sv && SvOBJECT(sv))
  9095
+            stash = SvSTASH(sv);
  9096
+        else
  9097
+	    return ((OP*)NULL);
  9098
+    }
  9099
+    else
  9100
+	return ((OP*)NULL);
  9101
+
  9102
+    /* XXX: emulate method_common() */
  9103
+    if (!(stash && (gv = gv_fetchmeth(stash, methname, methlen, 0)) && 
  9104
+          isGV(gv)))
  9105
+	return ((OP*)NULL);
  9106
+
  9107
+    if (GvSTASH(CvGV(GvCV(gv))) != stash) {
  9108
+        /* XXX TODO Check readonly @ISA and stash at compile time to make sure 
  9109
+	 * this lookup is valid.
  9110
+	 */
  9111
+        return ((OP*)NULL); 	/* if stash and @ISA is not frozen */
  9112
+
  9113
+        gv = CvGV(GvCV(gv)); 	/* point to the real gv */
  9114
+    }
  9115
+
  9116
+    if (o->op_type == OP_PADSV) {
  9117
+	DEBUG_v(PerlIO_printf(Perl_debug_log, "method_named (%s)$o->%s => entersub at 0x%p, GV=0x%p\n",
  9118
+			      HvNAME(stash), methname, o, gv));
  9119
+    } else {
  9120
+	DEBUG_v(PerlIO_printf(Perl_debug_log, "method_named %s->%s => entersub at 0x%p, GV=0x%p\n",
  9121
+			      HvNAME(stash), methname, o, gv));
  9122
+    }
  9123
+
  9124
+    /* remove bareword-ness of class name */
  9125
+    o->op_private &= ~(OPpCONST_BARE|OPpCONST_STRICT); 
  9126
+    for (mop = o; mop->op_sibling->op_sibling; mop = mop->op_sibling) ;
  9127
+
  9128
+    op_free(mop->op_sibling); /* loose OP_METHOD_NAMED */
  9129
+    mop->op_sibling = scalar(newGVOP(OP_GV, 0, gv));
  9130
+    nop = convert(OP_ENTERSUB, OPf_STACKED, o);
  9131
+
  9132
+    /* DEBUG_v(op_dump(nop)); */
  9133
+    return nop;
  9134
+}
  9135
+
9044 9136
 OP *
9045 9137
 Perl_ck_subr(pTHX_ OP *o)
9046 9138
 {
@@ -9067,6 +9159,14 @@ Perl_ck_subr(pTHX_ OP *o)
9067 9159
 	o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
9068 9160
 	op_null(cvop);
9069 9161
     } else if (cvop->op_type == OP_METHOD || cvop->op_type == OP_METHOD_NAMED) {
  9162
+	if (aop->op_type == OP_CONST || aop->op_type == OP_PADSV) {
  9163
+	    /* Named or typed methods, if &Foo::bar exists or if the inheritence is known, 
  9164
+	       can be resolved at compile time to a subroutine call. */
  9165
+	    OP *nop;
  9166
+	    if ((nop = S_method_to_entersub(aTHX_ aop, cvop))) {
  9167
+		return nop;
  9168
+	    }
  9169
+	}
9070 9170
 	if (aop->op_type == OP_CONST)
9071 9171
 	    aop->op_private &= ~OPpCONST_STRICT;
9072 9172
 	else if (aop->op_type == OP_LIST) {

0 notes on commit 7a305aa

Please sign in to comment.
Something went wrong with that request. Please try again.