2 #define PERL_NO_GET_CONTEXT
11 #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
13 /* pointer to old PL_check entersub entry to be populated in init */
15 STATIC OP *(*dbl_old_ck_entersub)(pTHX_ OP *op);
17 /* replacement PL_check entersub entry */
19 STATIC OP *dbl_ck_entersub(pTHX_ OP *o) {
26 I32 type = o->op_type;
30 SV** to_lift_pack_ref;
31 HV* to_lift_pack_hash;
32 SV** to_lift_flag_ref;
34 o = dbl_old_ck_entersub(aTHX_ o); /* let the original do its job */
36 kid = cUNOPo->op_first;
38 if (kid->op_type != OP_NULL) /* pushmark for method call ... */
41 last = kLISTOP->op_last;
43 if (last->op_type != OP_NULL) /* not what we expected */
46 kid = cUNOPx(last)->op_first;
48 if (kid->op_type != OP_GV) /* not a GV so ignore */
51 stash = GvSTASH(kGVOP_gv);
53 /* printf("Calling GV %s -> %s\n",
54 HvNAME(stash), GvNAME(kGVOP_gv)); */
56 to_lift = get_hv("Devel::BeginLift::lift", FALSE);
61 to_lift_pack_ref = hv_fetch(to_lift, HvNAME(stash), strlen(HvNAME(stash)),
64 if (!to_lift_pack_ref || !SvROK(*to_lift_pack_ref))
65 return o; /* not a hashref */
67 to_lift_pack_hash = (HV*) SvRV(*to_lift_pack_ref);
69 to_lift_flag_ref = hv_fetch(to_lift_pack_hash, GvNAME(kGVOP_gv),
70 strlen(GvNAME(kGVOP_gv)), FALSE);
72 if (!to_lift_flag_ref || !SvTRUE(*to_lift_flag_ref))
75 /* shamelessly lifted from fold_constants in op.c */
81 if (0) { /* call as macro */
84 /* this means the argument pushing ops are not executed, only the GV to
85 * resolve the call is, and B::OP objects will be made of all the opcodes
87 PUSHMARK(SP); /* push a mark for the arguments */
89 /* push an arg for every sibling op */
90 for ( arg = curop->op_sibling; arg->op_sibling; arg = arg->op_sibling ) {
91 XPUSHs(sv_bless(newRV_inc(newSViv(PTR2IV(arg))), gv_stashpv("B::LISTOP", 0)));
94 /* find the last non null before the lifted entersub */
95 for ( kid = curop; kid->op_next != o; kid = kid->op_next ) {
96 if ( kid->op_type == OP_GV )
100 PL_op = gv; /* make the call to our sub without evaluating the arg ops */
105 /* stop right after the call */
106 saved_next = o->op_next;
114 if (SP > stack_save) { /* sub returned something */
116 if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */
117 pad_swipe(o->op_targ, FALSE);
118 else if (SvTEMP(sv)) { /* grab mortal temp? */
119 (void)SvREFCNT_inc(sv);
123 if (SvROK(sv) && sv_derived_from(sv, "B::OP")) {
124 OP *new = INT2PTR(OP *,SvIV((SV *)SvRV(sv)));
125 new->op_sibling = NULL;
127 /* FIXME this is bullshit */
128 if ( (PL_opargs[new->op_type] & OA_CLASS_MASK) != OA_SVOP ) {
129 new->op_next = saved_next;
137 if (type == OP_RV2GV)
138 return newGVOP(OP_GV, 0, (GV*)sv);
140 if (SvTYPE(sv) == SVt_NULL) {
142 return newOP(OP_NULL, 0);
145 return newSVOP(OP_CONST, 0, sv);
147 /* this bit not lifted, handles the 'sub doesn't return stuff' case
148 which fold_constants can ignore */
150 return newOP(OP_NULL, 0);
154 static int initialized = 0;
156 MODULE = Devel::BeginLift PACKAGE = Devel::BeginLift
163 if (!initialized++) {
164 dbl_old_ck_entersub = PL_check[OP_ENTERSUB];
165 PL_check[OP_ENTERSUB] = dbl_ck_entersub;
171 /* ensure we only uninit when number of teardown calls matches
172 number of setup calls */
173 if (initialized && !--initialized) {
174 PL_check[OP_ENTERSUB] = dbl_old_ck_entersub;