From a4d3037f8b0c032f2ba56b89a35f41fe7939d75a Mon Sep 17 00:00:00 2001
From: Romain Geissler <romain.geissler@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

