X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=BeginLift.xs;h=ebf9279ec2ee735b4f3a4c5bf2cea82ffb2f64a4;hb=HEAD;hp=59cd790210d418bbea77685a13479f53098092d6;hpb=c0f47301771431ee488220ae667425f2c741e71b;p=p5sagit%2FDevel-BeginLift.git

diff --git a/BeginLift.xs b/BeginLift.xs
index 59cd790..ebf9279 100644
--- a/BeginLift.xs
+++ b/BeginLift.xs
@@ -6,89 +6,116 @@
 #include <stdio.h>
 #include <string.h>
 
+#include "hook_op_check_entersubforcv.h"
+
 /* lifted from op.c */
 
 #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
 
-/* pointer to old PL_check entersub entry to be populated in init */
-
-STATIC OP *(*dbl_old_ck_entersub)(pTHX_ OP *op);
-
-/* replacement PL_check entersub entry */
+#ifndef linklist
+# define linklist(o) THX_linklist(aTHX_ o)
+STATIC OP *THX_linklist(pTHX_ OP *o) {
+  OP *first;
+  if(o->op_next)
+    return o->op_next;
+  first = cUNOPo->op_first;
+  if (first) {
+    OP *kid;
+    o->op_next = LINKLIST(first);
+    kid = first;
+    for (;;) {
+      if (kid->op_sibling) {
+   kid->op_next = LINKLIST(kid->op_sibling);
+   kid = kid->op_sibling;
+      } else {
+   kid->op_next = o;
+   break;
+      }
+    }
+  } else {
+    o->op_next = o;
+  }
+  return o->op_next;
+}
+#endif /* !linklist */
 
-STATIC OP *dbl_ck_entersub(pTHX_ OP *o) {
-  OP *kid;
-  OP *last;
-  OP *curop;
-  HV *stash;
-  I32 type = o->op_type;
+STATIC OP *lift_cb(pTHX_ OP *o, CV *cv, void *user_data) {
+  dSP;
   SV *sv;
-  SV** stack_save;
-  HV* to_lift;
-  SV** to_lift_pack_ref;
-  HV* to_lift_pack_hash;
-  SV** to_lift_flag_ref;
-
-  o = dbl_old_ck_entersub(aTHX_ o); /* let the original do its job */
-
-  kid = cUNOPo->op_first;
-
-  if (kid->op_type != OP_NULL) /* pushmark for method call ... */
-    return o;
-
-  last = kLISTOP->op_last;
-
-  if (last->op_type != OP_NULL) /* not what we expected */
-    return o;
-
-  kid = cUNOPx(last)->op_first;
-
-  if (kid->op_type != OP_GV) /* not a GV so ignore */
-    return o;
-
-  stash = GvSTASH(kGVOP_gv);
-
-  /* printf("Calling GV %s -> %s\n",
-    HvNAME(stash), GvNAME(kGVOP_gv)); */
-
-  to_lift = get_hv("Devel::BeginLift::lift", FALSE);
+  SV **stack_save;
+  OP *curop, *kid, *saved_next;
+  I32 type = o->op_type;
 
-  if (!to_lift)
-    return o;
+  /* shamelessly lifted from fold_constants in op.c */
 
-  to_lift_pack_ref = hv_fetch(to_lift, HvNAME(stash), strlen(HvNAME(stash)),
-                               FALSE);
+  stack_save = SP;
 
-  if (!to_lift_pack_ref || !SvROK(*to_lift_pack_ref))
-    return o; /* not a hashref */
+  curop = LINKLIST(o);
 
-  to_lift_pack_hash = (HV*) SvRV(*to_lift_pack_ref);
+  if (0) { /* call as macro */
+    OP *arg;
+    OP *gv;
+    /* this means the argument pushing ops are not executed, only the GV to
+     * resolve the call is, and B::OP objects will be made of all the opcodes
+     * */
+    PUSHMARK(SP); /* push a mark for the arguments */
+
+    /* push an arg for every sibling op */
+    for ( arg = curop->op_sibling; arg->op_sibling; arg = arg->op_sibling ) {
+      XPUSHs(sv_bless(newRV_inc(newSViv(PTR2IV(arg))), gv_stashpv("B::LISTOP", 0)));
+    }
 
-  to_lift_flag_ref = hv_fetch(to_lift_pack_hash, GvNAME(kGVOP_gv),
-                                strlen(GvNAME(kGVOP_gv)), FALSE);
+    /* find the last non null before the lifted entersub */
+    for ( kid = curop; kid->op_next != o; kid = kid->op_next ) {
+      if ( kid->op_type == OP_GV )
+          gv = kid;
+    }
 
-  if (!to_lift_flag_ref || !SvTRUE(*to_lift_flag_ref))
-    return o;
+    PL_op = gv; /* make the call to our sub without evaluating the arg ops */
+  } else {
+    PL_op = curop;
+  }
 
-  /* shamelessly lifted from fold_constants in op.c */
+  /* stop right after the call */
+  saved_next = o->op_next;
+  o->op_next = NULL;
 
-  stack_save = PL_stack_sp;
-  curop = LINKLIST(o);
-  o->op_next = 0;
-  PL_op = curop;
+  PUTBACK;
+  SAVETMPS;
   CALLRUNOPS(aTHX);
+  SPAGAIN;
 
-  if (PL_stack_sp > stack_save) { /* sub returned something */
-    sv = *(PL_stack_sp--);
+  if (SP > stack_save) { /* sub returned something */
+    sv = POPs;
     if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */
       pad_swipe(o->op_targ,  FALSE);
     else if (SvTEMP(sv)) {      /* grab mortal temp? */
       (void)SvREFCNT_inc(sv);
       SvTEMP_off(sv);
     }
-    op_free(o);
+
+    if (SvROK(sv) && sv_derived_from(sv, "B::OP")) {
+      OP *new = INT2PTR(OP *,SvIV((SV *)SvRV(sv)));
+      new->op_sibling = NULL;
+
+      /* FIXME this is bullshit */
+      if ( (PL_opargs[new->op_type] & OA_CLASS_MASK) != OA_SVOP ) {
+        new->op_next = saved_next;
+      } else {
+        new->op_next = new;
+      }
+
+      return new;
+    }
+
     if (type == OP_RV2GV)
       return newGVOP(OP_GV, 0, (GV*)sv);
+
+	if (SvTYPE(sv) == SVt_NULL) {
+		op_free(o);
+		return newOP(OP_NULL, 0);
+	}
+
     return newSVOP(OP_CONST, 0, sv);
   } else {
     /* this bit not lifted, handles the 'sub doesn't return stuff' case
@@ -98,25 +125,18 @@ STATIC OP *dbl_ck_entersub(pTHX_ OP *o) {
   }
 }
 
-static int initialized = 0;
-
 MODULE = Devel::BeginLift  PACKAGE = Devel::BeginLift
 
 PROTOTYPES: DISABLE
 
-void
-setup()
+UV
+setup_for_cv (class, CV *cv)
   CODE:
-  if (!initialized++) {
-    dbl_old_ck_entersub = PL_check[OP_ENTERSUB];
-    PL_check[OP_ENTERSUB] = dbl_ck_entersub;
-  }
+    RETVAL = (UV)hook_op_check_entersubforcv (cv, lift_cb, NULL);
+  OUTPUT:
+    RETVAL
 
 void
-teardown()
+teardown_for_cv (class, UV id)
   CODE:
-  /* ensure we only uninit when number of teardown calls matches 
-     number of setup calls */
-  if (initialized && !--initialized) {
-    PL_check[OP_ENTERSUB] = dbl_old_ck_entersub;
-  }
+    hook_op_check_entersubforcv_remove ((hook_op_check_id)id);