Move non-constant folding parts of fold_constants into a separate functions.
authorGerard Goossen <gerard@ggoossen.net>
Sat, 20 Aug 2011 19:18:44 +0000 (21:18 +0200)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 5 Sep 2011 15:33:27 +0000 (08:33 -0700)
The non-constant folding parts of fold_constants are moved into
separate functions. op_integerize handles converting ops to integer
(and special case of OP_NEGATE), op_std_init handling some standard
functionality (forced scalar context and allocating the TARGET).
Both functions are called where fold_constants is called (but we might
want to make that a bit some selective and use op_std_init in other
places).

embed.fnc
embed.h
op.c
proto.h

index 106c6c7..b7988df 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -406,6 +406,8 @@ p   |char*  |find_script    |NN const char *scriptname|bool dosearch \
                                |NULLOK const char *const *const search_ext|I32 flags
 #if defined(PERL_IN_OP_C)
 s      |OP*    |force_list     |NULLOK OP* arg
+i      |OP*    |op_integerize  |NN OP *o
+i      |OP*    |op_std_init    |NN OP *o
 : FIXME
 s      |OP*    |fold_constants |NN OP *o
 #endif
diff --git a/embed.h b/embed.h
index 4ac70e7..120567f 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define new_logop(a,b,c,d)     S_new_logop(aTHX_ a,b,c,d)
 #define no_bareword_allowed(a) S_no_bareword_allowed(aTHX_ a)
 #define no_fh_allowed(a)       S_no_fh_allowed(aTHX_ a)
+#define op_integerize(a)       S_op_integerize(aTHX_ a)
+#define op_std_init(a)         S_op_std_init(aTHX_ a)
 #define opt_scalarhv(a)                S_opt_scalarhv(aTHX_ a)
 #define pmtrans(a,b,c)         S_pmtrans(aTHX_ a,b,c)
 #define process_special_blocks(a,b,c)  S_process_special_blocks(aTHX_ a,b,c)
diff --git a/op.c b/op.c
index af67720..b9b4378 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2894,6 +2894,44 @@ Perl_jmaybe(pTHX_ OP *o)
     return o;
 }
 
+PERL_STATIC_INLINE OP *
+S_op_std_init(pTHX_ OP *o)
+{
+    I32 type = o->op_type;
+
+    PERL_ARGS_ASSERT_OP_STD_INIT;
+
+    if (PL_opargs[type] & OA_RETSCALAR)
+       scalar(o);
+    if (PL_opargs[type] & OA_TARGET && !o->op_targ)
+       o->op_targ = pad_alloc(type, SVs_PADTMP);
+
+    return o;
+}
+
+PERL_STATIC_INLINE OP *
+S_op_integerize(pTHX_ OP *o)
+{
+    I32 type = o->op_type;
+
+    PERL_ARGS_ASSERT_OP_INTEGERIZE;
+
+    /* integerize op, unless it happens to be C<-foo>.
+     * XXX should pp_i_negate() do magic string negation instead? */
+    if ((PL_opargs[type] & OA_OTHERINT) && (PL_hints & HINT_INTEGER)
+       && !(type == OP_NEGATE && cUNOPo->op_first->op_type == OP_CONST
+            && (cUNOPo->op_first->op_private & OPpCONST_BARE)))
+    {
+       o->op_ppaddr = PL_ppaddr[type = ++(o->op_type)];
+    }
+
+    if (type == OP_NEGATE)
+       /* XXX might want a ck_negate() for this */
+       cUNOPo->op_first->op_private &= ~OPpCONST_STRICT;
+
+    return o;
+}
+
 static OP *
 S_fold_constants(pTHX_ register OP *o)
 {
@@ -2912,28 +2950,10 @@ S_fold_constants(pTHX_ register OP *o)
 
     PERL_ARGS_ASSERT_FOLD_CONSTANTS;
 
-    if (PL_opargs[type] & OA_RETSCALAR)
-       scalar(o);
-    if (PL_opargs[type] & OA_TARGET && !o->op_targ)
-       o->op_targ = pad_alloc(type, SVs_PADTMP);
-
-    /* integerize op, unless it happens to be C<-foo>.
-     * XXX should pp_i_negate() do magic string negation instead? */
-    if ((PL_opargs[type] & OA_OTHERINT) && (PL_hints & HINT_INTEGER)
-       && !(type == OP_NEGATE && cUNOPo->op_first->op_type == OP_CONST
-            && (cUNOPo->op_first->op_private & OPpCONST_BARE)))
-    {
-       o->op_ppaddr = PL_ppaddr[type = ++(o->op_type)];
-    }
-
     if (!(PL_opargs[type] & OA_FOLDCONST))
        goto nope;
 
     switch (type) {
-    case OP_NEGATE:
-       /* XXX might want a ck_negate() for this */
-       cUNOPo->op_first->op_private &= ~OPpCONST_STRICT;
-       break;
     case OP_UCFIRST:
     case OP_LCFIRST:
     case OP_UC:
@@ -3109,7 +3129,7 @@ Perl_convert(pTHX_ I32 type, I32 flags, OP *o)
     if (o->op_type != (unsigned)type)
        return o;
 
-    return fold_constants(o);
+    return fold_constants(op_integerize(op_std_init(o)));
 }
 
 /*
@@ -3657,7 +3677,7 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
     if (unop->op_next)
        return (OP*)unop;
 
-    return fold_constants((OP *) unop);
+    return fold_constants(op_integerize(op_std_init((OP *) unop)));
 }
 
 /*
@@ -3707,7 +3727,7 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
 
     binop->op_last = binop->op_first->op_sibling;
 
-    return fold_constants((OP *)binop);
+    return fold_constants(op_integerize(op_std_init((OP *)binop)));
 }
 
 static int uvcompare(const void *a, const void *b)
@@ -8562,7 +8582,7 @@ Perl_ck_select(pTHX_ OP *o)
            o->op_type = OP_SSELECT;
            o->op_ppaddr = PL_ppaddr[OP_SSELECT];
            o = ck_fun(o);
-           return fold_constants(o);
+           return fold_constants(op_integerize(op_std_init(o)));
        }
     }
     o = ck_fun(o);
diff --git a/proto.h b/proto.h
index 4c79414..58fc77e 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5569,6 +5569,16 @@ STATIC OP*       S_no_fh_allowed(pTHX_ OP *o)
 #define PERL_ARGS_ASSERT_NO_FH_ALLOWED \
        assert(o)
 
+PERL_STATIC_INLINE OP* S_op_integerize(pTHX_ OP *o)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_OP_INTEGERIZE \
+       assert(o)
+
+PERL_STATIC_INLINE OP* S_op_std_init(pTHX_ OP *o)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_OP_STD_INIT   \
+       assert(o)
+
 STATIC OP*     S_opt_scalarhv(pTHX_ OP* rep_op)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_OPT_SCALARHV  \