I have corrected my patch with your remarks.

Especially about the debug functions, it takes the debug melt flag into account. Moreover, I have allowed the user to give a message when calling this function, as usual in MELT debug functions. Giving this message was a bit difficult (This is the only argument of the function, so this must be a MELT value, and that uneasy to convert the value into :cstring).

I have used debugeprintf macro into a code_chunk to give the MELT file + line numbers, followed by a outstr_err, which displays the user message. I think the only disavantage is that it puts an end of lines between the two informations. If you think there is a best way to do this, I am ok to try it.

The new changelog:

2011-05-20  Pierre Vittet <pier...@pvittet.com>

    * melt/xtramelt-ana-base.melt
    (is_dominance_info_available, is_post_dominance_info_available,
    calculate_dominance_info_unsafe, calculate_post_dominance_info_unsafe,
free_dominance_info, free_post_dominance_info, calculate_dominance_info,
    calculate_post_dominance_info, debug_dominance_info,
    debug_post_dominance_info, get_immediate_dominator_unsafe,
    get_immediate_dominator, get_immediate_post_dominator_unsafe,
    get_immediate_post_dominator, dominated_by_other_unsafe,
    dominated_by_other, post_dominated_by_other_unsafe,
    post_dominated_by_other, foreach_dominated_unsafe,
dominated_by_bb_iterator): Add primitives, functions, iterators for using
    dominance info.


On 19/05/2011 07:32, Basile Starynkevitch wrote:
On Wed, 18 May 2011 21:04:39 +0200
Pierre Vittet<pier...@pvittet.com>  wrote:

Hello,

I have written a patch to allow the use of the GCC dominance functions
into MELT.
[...]

Changelog:
2011-05-17  Pierre Vittet<pier...@pvittet.com>

      * melt/xtramelt-ana-base.melt
      (is_dominance_info_available, is_post_dominance_info_available,
      calculate_dominance_info_unsafe,
      calculate_post_dominance_info_unsafe,
      free_dominance_info, free_post_dominance_info,
      calculate_dominance_info,
      calculate_post_dominance_info, debug_dominance_info,
      debug_post_dominance_info, get_immediate_dominator_unsafe,
      get_immediate_dominator, get_immediate_post_dominator_unsafe,
      get_immediate_post_dominator, dominated_by_other_unsafe,
      dominated_by_other, post_dominated_by_other_unsafe,
      post_dominated_by_other, foreach_dominated_unsafe,
      dominated_by_bb_iterator): Add primitives, functions, iterators for
      using dominance info.


Thanks for the patch. Some minor tweaks:

First, put a space between formal arguments list&  function name.
So

+(defprimitive calculate_dominance_info_unsafe() :void
should be
+(defprimitive calculate_dominance_info_unsafe () :void

Then, please put the defined name on the same line that defprimitive or
defun or def... When consecutive MELT formals have the same ctype, you
don't need to repeat it

So

+(defprimitive
+  dominated_by_other_unsafe(:basic_block bbA :basic_block bbB) :long

should be

+(defprimitive dominated_by_other_unsafe (:basic_block bbA bbB) :long

In :doc strings, document when something is a boxed value
(distinction between values&  stuffs is crucial), so write instead
[I added the boxed word, it is important]

+(defun get_immediate_dominator (bb)
+ :doc#{Return the next immediate dominator of the boxed basic_block
$BB as a MELT +value.}#

At last, all debug* operations should only output debug to stderr only
when flag_melt_debug is set and give the MELT source position (because
we don't want any debug printing in the usual case when -fmelt-debug is
not given to our cc1) Look at debugloop in xtramelt-ana-base.melt for
an example (notice that debugeprintfnonl is a C macro printing the MELT
source position.


So please resubmit a slightly improved patch.

Regards.

Index: gcc/melt/xtramelt-ana-base.melt
===================================================================
--- gcc/melt/xtramelt-ana-base.melt     (revision 173936)
+++ gcc/melt/xtramelt-ana-base.melt     (working copy)
@@ -1871,7 +1871,6 @@
 (defprimitive make_basicblock (discr :basic_block bb) :value
  
#{/*make_basicblock*/(meltgc_new_basicblock((meltobject_ptr_t)($discr),($bb)))}#
 )
 
-
 (defprimitive basicblock_content (v) :basic_block
  #{(melt_basicblock_content((melt_ptr_t)($v)))}# )
 
@@ -1910,6 +1909,243 @@
 (defprimitive basicblock_nth_succ_edge  (:basic_block bb :long ix) :edge
   #{(($bb && $ix>=0 && $ix<EDGE_COUNT($bb->succs))?EDGE_SUCC($bb,$ix):NULL)}#)
 
+;; Primitives concerning dominance in basic_blocks
+;; those functions mainly come from gcc/dominance.c
+
+(defprimitive is_dominance_info_available () :long
+  :doc #{Check if dominance info are already calculated.
+        User normally doesn't have to call this primitive, as MELT functions
+        check if there is a need to use this.}#
+  #{dom_info_available_p(CDI_DOMINATORS)}#
+)
+
+(defprimitive is_post_dominance_info_available () :long
+  :doc #{Check if post dominance info are already calculated.
+        User normally doesn't have to call this primitive, as MELT functions
+        check if there is a need to use this.}#
+  #{dom_info_available_p(CDI_POST_DOMINATORS)}#
+)
+
+(defprimitive calculate_dominance_info_unsafe () :void
+  :doc #{This primitive is internaly called, user doesn't need it.
+        Build the struct containing dominance info.
+        This struct is necessary to use others dominance related function.
+        This function is unsafe because it does not register any future call to
+        free_dominance_info.}#
+  #{calculate_dominance_info(CDI_DOMINATORS)}#
+)
+
+(defprimitive calculate_post_dominance_info_unsafe () :void
+  :doc #{This primitive is internaly called, user doesn't need it.
+        Build the struct containing post dominance info.
+        This struct is necessary to use other dominance related function.
+        This function is unsafe because it does not register any future call to
+        free_dominance_info.}#
+  #{calculate_dominance_info(CDI_POST_DOMINATORS)}#
+)
+
+(defprimitive free_dominance_info () :void
+  :doc #{This primitive is internaly called, user doesn't need it.
+        Clear dominance info if they have been allocated.}#
+  #{free_dominance_info(CDI_DOMINATORS)}#
+)
+
+(defprimitive free_post_dominance_info () :void
+  :doc #{This primitive is internaly called, user doesn't need it.
+    Clear post dominance info if they have been allocated.}#
+  #{free_dominance_info(CDI_POST_DOMINATORS)}#
+)
+
+(defun calculate_dominance_info ()
+  :doc #{This primitive is internaly called, user doesn't need it.
+      Build the struct containing dominance info.
+      This struct is necessary to use other dominance related info.
+      It place a call to free dominance info when pass is finished if it is
+      necessary.}#
+  (if (is_dominance_info_available)
+    () ;; do nothing
+    (progn ;; else calculate dom and ask to free them at end of pass
+      (calculate_dominance_info_unsafe)
+      (at_end_melt_pass_first free_dominance_info)
+    ))
+)
+
+(defun calculate_post_dominance_info () 
+  :doc #{This primitive is internaly called, user doesn't need it
+      Build the struct containing post dominance info.
+      This struct is necessary to use other post dominance related info.
+      It place a call to free dominance info when pass is finished if it is
+      necessary.}#
+  (if (is_post_dominance_info_available)
+    ()  ;; do nothing
+    (progn ;; else calculate dom and ask to free them at end of pass
+      (calculate_post_dominance_info_unsafe)
+      (at_end_melt_pass_first free_post_dominance_info)
+    ))
+)
+
+(defun debug_dominance_info (msg) 
+  :doc#{Print to stderr all dominance relation, in the format "bb1->bb2".}#
+  (calculate_dominance_info)
+    (code_chunk debugdomchunk #{
+      /*$DEBUGDOMCHUNK*/
+      debugeprintf("debugdominanceinfo: ");}#)
+      (outstr_err msg)
+  (each_bb_current_fun () (:basic_block curbb)
+    (let ((:basic_block dombb (basicblock_content (get_immediate_dominator
+                                  (make_basicblock discr_basic_block curbb)))))
+      (if dombb 
+        (code_chunk debugbbdomchunk 
+        #{
+        if (flag_melt_debug)
+          fprintf (stderr, "%i dominated by %i\n", $CURBB->index, 
+                                                   $DOMBB->index);
+        }#
+      ))
+    )
+  )
+)
+
+(defun debug_post_dominance_info (msg)
+  :doc#{Print to stderr all post dominance relation, in the format
+      "bb1 dominated_by bb2".}#
+  (calculate_post_dominance_info) 
+    (outstr_dbg msg)
+    (code_chunk debugpostdomchunk #{
+      /*$DEBUGPOSTDOMCHUNK*/
+      debugeprintf("debugpostdominanceinfo: ");}#)
+      (outstr_err msg)
+  (each_bb_current_fun () (:basic_block curbb)
+    (let ( (:basic_block dombb (basicblock_content 
+              (get_immediate_post_dominator (make_basicblock discr_basic_block
+                                                                    curbb)))))
+      (if dombb 
+        (code_chunk debugbbpostdomchunk 
+        #{
+        if(flag_melt_debug)
+          fprintf (stderr, "%i post-dominated by %i\n", $CURBB->index,
+                                                        $DOMBB->index);
+        }#
+      ))
+    )
+  )
+)
+
+(defprimitive get_immediate_dominator_unsafe (:basic_block bb) :basic_block
+  :doc#{It doesn't check that dominance info are build, use
+      get_immediate_dominator instead.}#
+  #{($bb) ? get_immediate_dominator (CDI_DOMINATORS, $bb) : NULL}#
+)
+
+(defun get_immediate_dominator (bb) 
+ :doc#{Return the next immediate dominator of the boxed basic_block $BB as a
+      MELT value.}#
+  (if (is_basicblock bb)
+  (progn
+    (calculate_dominance_info) 
+    (return (make_basicblock discr_basic_block 
+      (get_immediate_dominator_unsafe (basicblock_content bb))))))
+)
+
+(defprimitive get_immediate_post_dominator_unsafe (:basic_block bb) 
:basic_block
+  :doc#{It doesn't check that post_dominance info are build, use
+      get_immediate_post_dominator instead.}#
+  #{($bb) ? get_immediate_dominator (CDI_POST_DOMINATORS, $bb) : NULL}#
+)
+
+(defun get_immediate_post_dominator (bb)
+ :doc#{Return the next immediate post dominator of the boxed basic_block $BB as
+      a MELT value.}#
+ (if (is_basicblock bb)
+ (progn
+ (calculate_post_dominance_info) 
+  (return (make_basicblock discr_basic_block 
+    (get_immediate_post_dominator_unsafe (basicblock_content bb))))))
+)
+
+(defprimitive dominated_by_other_unsafe (:basic_block bbA bbB) :long
+  :doc#{It doesn't check that dominance info are build, use
+      dominated_by_other instead.}#
+  #{ (($bbA) && ($bbB)) ?
+      dominated_by_p (CDI_DOMINATORS, $bbA, $bbB) 
+      : 0 
+  }#
+)
+
+(defun dominated_by_other (bbA bbB)
+  :doc#{true if boxed basic_block $BBA is dominated by boxed basic_block 
$BBB.}#
+  (if (and (is_basicblock bbA) (is_basicblock bbB))
+  (progn
+    (calculate_dominance_info) 
+    (if (dominated_by_other_unsafe (basicblock_content bbA) 
+                                   (basicblock_content bbB))
+      (return :true)
+    )))
+)
+
+(defprimitive post_dominated_by_other_unsafe (:basic_block bbA bbB) :long
+  :doc#{It doesn't check that post_dominance info are build, use
+      post_dominated_by_other instead.}#
+  #{ (($bbA) && ($bbB)) ?
+      dominated_by_p (CDI_POST_DOMINATORS, $bbA, $bbB) 
+      : 0 
+  }#
+)
+
+(defun post_dominated_by_other (bbA bbB)
+  :doc#{true if boxed basic_block $BBA is post dominated by boxed basic_block
+      $BBB.}#
+  (if (and (is_basicblock bbA) (is_basicblock bbB))
+  (progn
+    (calculate_post_dominance_info) 
+    (if (post_dominated_by_other_unsafe (basicblock_content bbA) 
+                                   (basicblock_content bbB))
+      (return :true)
+    )))
+)
+
+(defciterator foreach_dominated_unsafe
+  (:basic_block dominator_bb)
+  ebbdomd
+  (:basic_block dominated_bb)
+  #{
+    /* $EBBDOMD before+ */
+
+    VEC (basic_block, heap)*  $EBBDOMD#_bbvec = 0;
+    unsigned int $EBBDOMD#_ix = 0;
+    basic_block $EBBDOMD#_bb = 0;
+
+    if($DOMINATOR_BB){
+      $EBBDOMD#_bbvec = get_dominated_by(CDI_DOMINATORS, $DOMINATOR_BB);
+      if($EBBDOMD#_bbvec){
+        FOR_EACH_VEC_ELT (basic_block, $EBBDOMD#_bbvec, 
+          $EBBDOMD#_ix, $EBBDOMD#_bb){
+          if (!$EBBDOMD#_ix)
+            continue;
+          $DOMINATED_BB = $EBBDOMD#_bb;
+     /*$EBBDOMD before- */}#
+      ;; after expansion
+  #{/*$EBBDOMD after+ */
+          }
+      }}
+    VEC_free (basic_block, heap, $EBBDOMD#_bbvec);
+    $EBBDOMD#_bbvec = 0;
+    $EBBDOMD#_bb = 0;
+    /* $EBBDOMD after- */}#
+)
+
+(defun dominated_by_bb_iterator (f data bb)
+  :doc #{run function $F on every basicblocks dominated by boxed basic_block
+      $BB with $DATA as first parameters and ending with the dominated
+      basicblock as last parameters.}#
+  (calculate_dominance_info)
+  (foreach_dominated_unsafe
+    ((basicblock_content bb))
+    (:basic_block dominated_bb)
+    (f data dominated_bb)
+  )
+)
+
 ;;;;
 (defprimitive null_gimpleseq () :gimple_seq #{((gimple_seq)0)}#)
 ;;;;;;;;;;;;;;;;
@@ -2931,6 +3167,17 @@ and discriminant $DIS, usually $DISCR_MIXED_LOCATI
  basicblock_nb_succ
  basicblock_phinodes
  basicblock_single_succ 
+ debug_dominance_info
+ debug_post_dominance_info
+ get_immediate_dominator
+ get_immediate_post_dominator
+ dominated_by_other
+ post_dominated_by_other
+ dominated_by_bb_iterator
+ get_immediate_dominator
+ get_immediate_post_dominator
+ dominated_by_other
+ post_dominated_by_other
  cfun_decl
  cfun_gimple_body
  cfun_has_cfg

Reply via email to