Hi, I added a few primitives about trees, plus a string_to_long conversion primitive and a foreach_pair_between iterator that allows to iterate between two pairs of the same list (and thus iterate on sublist).
Note: again, it's a git patch for Pierre until Basil returns. Romain
0001-Add-a-few-functions.Changelog
Description: Binary data
From a4d3037f8b0c032f2ba56b89a35f41fe7939d75a Mon Sep 17 00:00:00 2001
From: Romain Geissler <romain.geiss...@st.com>
Date: Tue, 2 Aug 2011 16:55:02 +0200
Subject: [PATCH] Add a few functions.
---
gcc/melt/warmelt-first.melt | 28 +++++++++++++++++++++
gcc/melt/xtramelt-ana-base.melt | 51 +++++++++++++++++++++++++++++++++++++++
2 files changed, 79 insertions(+), 0 deletions(-)
diff --git a/gcc/melt/warmelt-first.melt b/gcc/melt/warmelt-first.melt
index ef8affd..33383dc 100644
--- a/gcc/melt/warmelt-first.melt
+++ b/gcc/melt/warmelt-first.melt
@@ -1162,6 +1162,12 @@ an integer $I if $I is greater than $N.}#
:doc #{Test that value string $S1 is greater than $S2.}#
#{melt_string_less((melt_ptr_t)($s2), (melt_ptr_t)($s1))}#)
+(defprimitive string_to_long (string) :long
+ :doc #{Read a string value and returns the corresponding
+ long stuff. 0 is returned if an error occurs while reading.}#
+ #{
+ atol(melt_string_str($string))
+ }#)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -3225,6 +3231,26 @@ nil.}#
;;;;;;;;;;;;;;;;
+;;; citerator on pairs
+(defciterator foreach_pair_between
+ (start_pair end_pair) ;start formals
+ eachpair ;state
+ (curpair curcomp) ;local formals
+ :doc #{The $FOREACH_PAIR_BETWEEN iterator goes between two (linked) pairs,
+ given by the start formal $START_PAIR and $END_PAIR. Local formals are $CURPAIR,
+ bound to the current pair, and $CURCOMP, bound to the current component within
+ the pair.}#
+ #{/* start $eachpair */
+ for ($curpair = $start_pair;
+ melt_magic_discr($curpair) == MELTOBMAG_PAIR;
+ $curpair = melt_pair_tail($curpair)) {
+ $curcomp = melt_pair_head($curpair); }#
+ #{
+ if ($curpair == $end_pair) {
+ break;
+ }
+ } /* end $eachpair */}#
+)
;;; citerator on lists
(defciterator foreach_in_list
@@ -4085,6 +4111,7 @@ also $CLASS_ANY_BINDING and $CLASS_ENVIRONMENT.}#
shortbacktrace_dbg
string<
string>
+ string_to_long
stringconst2val
the_meltcallcount
the_callcount
@@ -4207,6 +4234,7 @@ also $CLASS_ANY_BINDING and $CLASS_ENVIRONMENT.}#
;; export the citerators & cmatchers defined above
(export_values
+ foreach_pair_between
foreach_in_list
foreach_in_mapobject
foreach_in_mapstring
diff --git a/gcc/melt/xtramelt-ana-base.melt b/gcc/melt/xtramelt-ana-base.melt
index 34afcf2..af29fde 100644
--- a/gcc/melt/xtramelt-ana-base.melt
+++ b/gcc/melt/xtramelt-ana-base.melt
@@ -1494,6 +1494,51 @@
(defprimitive tree_uid (:tree tr) :long
#{(($tr) ? (long) DECL_UID($tr) : NULL)}#)
+(defprimitive tree_chain_prepend (:tree purpose value chain) :tree
+ :doc #{Create a new TREE_LIST node with $PURPOSE and $VALUE trees
+ and chain it at the begining of $CHAIN. Returns the newly created
+ chain.}#
+ #{
+ tree_cons ($PURPOSE, $VALUE, $CHAIN)
+ }#)
+
+(defprimitive tree_chain_append (:tree purpose value chain) :tree
+ :doc #{Create a new TREE_LIST node with $PURPOSE and $VALUE trees
+ and chain it at the end of $CHAIN. Returns the newly created
+ chain (different from $CHAIN if $CHAIN is NULL_TREE).}#
+ #{
+ chainon ($CHAIN, tree_cons ($PURPOSE, $VALUE, NULL_TREE))
+ }#)
+
+(defprimitive tree_chain_join (:tree chain1 chain2) :tree
+ :doc #{Append $CHAIN2 to $CHAIN1 and returns the newly created
+ chain (different from $CHAIN1 if $CHAIN1 is NULL_TREE).}#
+ #{
+ chainon ($CHAIN1, $CHAIN2)
+ }#)
+
+(defprimitive build_identifier_tree (name) :tree
+ :doc #{Create and returns a new IDENTIFIER_NODE tree whose
+ name is $NAME.}#
+ #{
+ get_identifier (melt_string_str ($NAME))
+ }#)
+
+(defprimitive build_string_tree (string_value) :tree
+ :doc #{Create and returns a new STRING_CST tree whose
+ value is $STRING_VALUE.}#
+ #{
+ build_string (strlen (melt_string_str ($STRING_VALUE)), melt_string_str ($STRING_VALUE))
+ }#)
+
+(defprimitive build_int_tree (int_value) :tree
+ :doc #{Create and returns a new INTEGER_CST tree whose
+ value is $INT_VALUE and type is the default language
+ integer type.}#
+ #{
+ build_int_cst (integer_type_node, (int)melt_get_int ($INT_VALUE))
+ }#)
+
;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;
@@ -3409,6 +3454,9 @@ and discriminant $DIS, usually $DISCR_MIXED_LOCATION.}#
basicblock_nb_succ
basicblock_phinodes
basicblock_single_succ
+ build_identifier_tree
+ build_int_tree
+ build_string_tree
cfun_decl
cfun_gimple_body
cfun_has_cfg
@@ -3656,6 +3704,9 @@ and discriminant $DIS, usually $DISCR_MIXED_LOCATION.}#
tree_array_ref_full
tree_array_type
tree_block
+ tree_chain_append
+ tree_chain_join
+ tree_chain_prepend
tree_component_ref
tree_component_ref_full
tree_component_ref_typed
--
1.7.6
