From 985b9e549fd484800c8e9aae896e5e9c5b04d148 Mon Sep 17 00:00:00 2001
From: Gerard Goossen <gerard@ggoossen.net>
Date: Sat, 20 Aug 2011 21:18:44 +0200
Subject: [PATCH] Move non-constant folding parts of fold_constants into a
 separate functions.

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 |  2 ++
 embed.h   |  2 ++
 op.c      | 64 +++++++++++++++++++++++++++++++++++++++++----------------------
 proto.h   | 10 ++++++++++
 4 files changed, 56 insertions(+), 22 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index 106c6c7..b7988df 100644
--- 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
--- a/embed.h
+++ b/embed.h
@@ -1355,6 +1355,8 @@
 #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
--- 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
--- 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	\
-- 
2.7.4