;; -*- Lisp -*- ;; file xtramelt-ana-base.melt ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (comment "*** Copyright 2008, 2009, 2010, 2011 Free Software Foundation, Inc. Contributed by Basile Starynkevitch and Jeremie Salvucci This file is part of GCC. GCC is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 3, or (at your option) any later version. GCC is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GCC; see the file COPYING3. If not see . ***") ;; the copyright notice above apply both to ana-base.melt and ;; to the generated file ana-base*.c ;; a class containing the analysis state (defclass class_analysis_state :super class_proped :fields ( )) (defprimitive install_melt_gcc_pass (:value pass :cstring positioning refpassname :long refpassnum) :void #{ meltgc_register_pass ($pass, $positioning, $refpassname, $refpassnum); }#) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;; gimple & tree related primitives (defprimitive is_gimple (v) :long #{(melt_magic_discr((melt_ptr_t)($v)) == MELTOBMAG_GIMPLE)}# ) (defprimitive make_gimple (discr :gimple g) :value #{(meltgc_new_gimple((meltobject_ptr_t)($discr),($g)))}# ) (defprimitive gimple_content (v) :gimple #{(melt_gimple_content((melt_ptr_t)($v)))}# ) (defprimitive ==g (:gimple g1 g2) :long #{(($g1) == ($g2))}#) (defprimitive null_gimple () :gimple #{((gimple)0)}#) (defprimitive gimple_seq_of_basic_block (:basic_block bb) :gimple_seq #{(($bb)?bb_seq(($bb)):NULL)}#) ;;; copy an unboxed gimple_copy (defprimitive gimple_copy (:gimple g) :gimple #{ (($g)?gimple_copy($g):NULL) }#) ;;;;;;;;;;;;;;;; map associating GCC gimple-s to non-null MELT values (defprimitive is_mapgimple (map) :long #{ (melt_magic_discr((melt_ptr_t)($map)) == MELTOBMAG_MAPGIMPLES) }#) (defprimitive mapgimple_size (map) :long #{ (melt_size_mapgimples((struct meltmapgimples_st*)($map))) }#) ;; primitive to get the attribute count of a mapgimple (defprimitive mapgimple_count (map) :long #{ (melt_count_mapgimples((struct meltmapgimples_st*)($map))) }# ) ;; get an entry in a mapgimple from a C gimple (defprimitive mapgimple_get (map :gimple bb) :value #{(melt_get_mapgimples(($map), ($bb)))}#) ;; primitive for making a new map of gimples (defprimitive make_mapgimple (discr :long len) :value #{(meltgc_new_mapgimples((meltobject_ptr_t) ($discr), ($len)))}#) ;; primitive for putting into a map of gimples (defprimitive mapgimple_put (map :gimple key :value val) :void #{melt_put_mapgimples(($map), ($key), (melt_ptr_t) ($val))}#) ;; primivite for removing from a map of gimples (defprimitive mapgimple_remove (map :gimple key) :void #{meltgc_remove_mapgimples(($map), ($key))}#) ;; primitive to get the nth gimple of a mapgimple (defprimitive mapgimple_nth_attr (map :long n) :gimple #{(melt_nthattr_mapgimples((struct meltmapgimples_st*)($map), (int)($n)))}#) ;; primitive to get the nth value of a mapobject (defprimitive mapgimple_nth_val (map :long n) :value #{(melt_nthval_mapgimples((struct meltmapgimples_st*)($map), (int)($n)))}# ) ;; iterator inside mapgimple (defciterator foreach_mapgimple (gimap) ; startformals eachgimap ;state symbol (:gimple att :value val) ;local formals ;; before expansion #{ /*$eachgimap*/ int $eachgimap#_rk=0; for ($eachgimap#_rk=0; $eachgimap#_rk= 3)}# ;; fill #{ $lhs = gimple_assign_lhs($ga); $rhs1 = gimple_assign_rhs1($ga); $rhs2 = gimple_assign_rhs2($ga); $opcode = gimple_assign_rhs_code($ga); }# ) ;;;;;;;;;;;;;;;; ;;; match a gimple cond less or equal (defcmatcher gimple_cond_lessequal (:gimple gc) (:tree lhs :tree rhs ) gimpcondle ;; test expansion #{($gc && gimple_code($gc)==GIMPLE_COND && gimple_cond_code($gc)==LE_EXPR)}# ;; fill expansion #{ $lhs = gimple_cond_lhs($gc); $rhs = gimple_cond_rhs($gc); }# ) ;;; match a gimple cond less (defcmatcher gimple_cond_less (:gimple gc) (:tree lhs :tree rhs ) gimpcondle ; test expansion #{($gc && gimple_code($gc)==GIMPLE_COND && gimple_cond_code($gc)==LT_EXPR)}# ;; fill expansion #{ $lhs = gimple_cond_lhs($gc); $rhs = gimple_cond_rhs($gc); }# ) ;;;;;;;;;;;;;;;; ;;; match a gimple cond not equal (defcmatcher gimple_cond_notequal (:gimple gc) (:tree lhs :tree rhs ) gimpcondle ;; test expansion #{($gc && gimple_code($gc)==GIMPLE_COND && gimple_cond_code($gc)==NE_EXPR)}# ;; fill expansion #{ $lhs = gimple_cond_lhs($gc); $rhs = gimple_cond_rhs($gc); }#) ;;; match a gimple_cond equal (defcmatcher gimple_cond_equal (:gimple gc) (:tree lhs :tree rhs) gce #{ ($gc && gimple_code ($gc) == GIMPLE_COND && gimple_cond_code ($gc) == EQ_EXPR) }# #{ $lhs = gimple_cond_lhs ($gc); $rhs = gimple_cond_rhs ($gc); }#) ;;; match a gimple cond greater (defcmatcher gimple_cond_greater (:gimple gc) (:tree lhs :tree rhs ) gimpcondle ;; test expansion #{($gc && gimple_code($gc)==GIMPLE_COND && gimple_cond_code($gc)==GT_EXPR)}# ;; fill expansion #{ $lhs = gimple_cond_lhs($gc); $rhs = gimple_cond_rhs($gc); }# ) ;;; match a gimple_cond greater or equal (defcmatcher gimple_cond_greater_or_equal (:gimple gc) (:tree lhs :tree rhs) gcgoe ;; test #{ ($gc && gimple_code ($gc) == GIMPLE_COND && gimple_cond_code ($gc) == GE_EXPR) }# ;; fill #{ $lhs = gimple_cond_lhs ($gc); $rhs = gimple_cond_rhs ($gc); }#) ;; match a gimple cond true (defcmatcher gimple_cond_true (:gimple gc) () gimpcondtr ;;test #{/*$gimpcondtr ? */ ($gc && gimple_code($gc)==GIMPLE_COND && gimple_cond_true_p($gc))}# ;;fill #{ /*$gimpcondtr !*/ }# ) ;; match a gimple cond false (defcmatcher gimple_cond_false (:gimple gc) () gimpcondtr ;;test #{/*$gimpcondtr ?*/ ($gc && gimple_code($gc)==GIMPLE_COND && gimple_cond_false_p($gc))}# ) ;; rarely used pattern to extract the true & false labels. These are ;; often null! (defcmatcher gimple_cond_with_true_false_labels (:gimple gc) (:tree truelab falselab) gimpcondtrlab ;; test #{/*$gimpcondtrlab ?*/ ($gc && gimple_code($gc)==GIMPLE_COND)}# ;;fill #{ $truelab = gimple_cond_true_label($gc); $falselab = gimple_cond_false_label($gc); }# ) ;; pattern to extract the true & false edges of a gimple_cond. (defcmatcher gimple_cond_with_edges (:gimple gc) (:edge truedge falsedge) gimpcondtredges ;; test #{/*$gimpcondtredges ?*/ ($gc && gimple_code($gc)==GIMPLE_COND)}# ;;fill #{ /*$gimpcondtredges !*/ extract_cond_bb_edges ((gimple_bb ($gc)), &($truedge), &($falsedge)); }#) ;;; iterate on each argument of a call function (defciterator foreach_argument_of_gimple_call (:gimple function_call) eaocf (:tree argument) #{ /* before $EAOCF */ int $EAOCF#_i = 0; if ($function_call&& gimple_code($function_call) == GIMPLE_CALL) { int $EAOCF#_n = gimple_call_num_args ($function_call); for ($EAOCF#_i = 0; $EAOCF#_i < $EAOCF#_n; $EAOCF#_i++) { $argument = gimple_call_arg ($function_call, $EAOCF#_i); }# #{ /* after $EAOCF */ } } }#) ;;; match a gimple call to a direct function of any matched arity (defcmatcher gimple_call (:gimple gc) (:tree lhs fndecl :long nbargs ) gimpcall ;; test #{/*$gimpcall ?*/($gc && gimple_code($gc)==GIMPLE_CALL)}# ;; fill #{ /*$gimpcall !*/ $lhs = gimple_call_lhs($gc); $fndecl = gimple_call_fndecl($gc); $nbargs = gimple_call_num_args($gc); }# ) ;; match a gimple call to a direct function of arity 1 exactly (defcmatcher gimple_call_1 (:gimple gc) (:tree lhs fndecl arg0) gimp1call ;; test #{/*$gimp1call ?*/ ($gc && gimple_code($gc)==GIMPLE_CALL && gimple_call_num_args($gc)==1)}# ;; fill #{ /*$gimp1call !*/ $lhs = gimple_call_lhs($gc); $fndecl = gimple_call_fndecl($gc); $arg0 = gimple_call_arg(($gc), 0); }#) ;; match a gimple call to a direct function of arity 1 or more (defcmatcher gimple_call_1_more (:gimple gc) (:tree lhs fndecl arg0 :long nbargs) gimp1calm ;; test #{/*$gimp1calm ?*/ ($gc && gimple_code($gc)==GIMPLE_CALL && gimple_call_num_args($gc)>=1)}# ;; fill #{ /*$gimp1calm !*/ $lhs = gimple_call_lhs($gc); $fndecl = gimple_call_fndecl($gc); $arg0 = gimple_call_arg(($gc), 0); $nbargs = gimple_call_num_args($gc); }#) ;; match a gimple call to a direct function of arity 2 exactly (defcmatcher gimple_call_2 (:gimple gc) (:tree lhs fndecl arg0 arg1) gimp2call ;; test #{/*$gimp2call ?*/ ($gc && gimple_code($gc)==GIMPLE_CALL && gimple_call_num_args($gc)==2)}# ;; fill #{ /*$gimp2call !*/ $lhs = gimple_call_lhs($gc); $fndecl = gimple_call_fndecl($gc); $arg0 = gimple_call_arg(($gc), 0); $arg1 = gimple_call_arg(($gc), 1); }#) ;; match a gimple call to a direct function of arity 2 or more (defcmatcher gimple_call_2_more (:gimple gc) (:tree lhs fndecl arg0 arg1 :long nbargs) gimp2calm ;; test #{/*$gimp2calm ?*/ ($gc && gimple_code($gc)==GIMPLE_CALL && gimple_call_num_args($gc)>=2)}# ;; fill #{ /*$gimp2calm !*/ $lhs = gimple_call_lhs($gc); $fndecl = gimple_call_fndecl($gc); $arg0 = gimple_call_arg(($gc), 0); $arg1 = gimple_call_arg(($gc), 1); $nbargs = gimple_call_num_args($gc); }#) ;; match a gimple call to a direct function of arity 3 exactly (defcmatcher gimple_call_3 (:gimple gc) (:tree lhs fndecl arg0 arg1 arg2) gimp3call ;; test #{/*$gimp3call ?*/ ($gc && gimple_code($gc)==GIMPLE_CALL && gimple_call_num_args($gc)==3)}# ;; fill #{ /*$gimp3call !*/ $lhs = gimple_call_lhs($gc); $fndecl = gimple_call_fndecl($gc); $arg0 = gimple_call_arg(($gc), 0); $arg1 = gimple_call_arg(($gc), 1); $arg2 = gimple_call_arg(($gc), 2); }#) ;; match a gimple call to a direct function of arity 3 or more (defcmatcher gimple_call_3_more (:gimple gc) (:tree lhs fndecl arg0 arg1 arg2 :long nbargs ) gimp3calm ;; test #{/*$gimp3calm ?*/ ($gc && gimple_code($gc)==GIMPLE_CALL && gimple_call_num_args($gc)>=3)}# ;; fill #{ /*$gimp3calm !*/ $lhs = gimple_call_lhs($gc); $fndecl = gimple_call_fndecl($gc); $arg0 = gimple_call_arg(($gc), 0); $arg1 = gimple_call_arg(($gc), 1); $arg2 = gimple_call_arg(($gc), 2); $nbargs = gimple_call_num_args($gc); }#) ;; match a gimple call to a direct function of arity 4 exactly (defcmatcher gimple_call_4 (:gimple gc) (:tree lhs fndecl arg0 arg1 arg2 arg3) gimp4call ;; test #{/*$gimp4call ?*/ ($gc && gimple_code($gc)==GIMPLE_CALL && gimple_call_num_args($gc)==4)}# ;; fill #{ /*$gimp4call !*/ $lhs = gimple_call_lhs($gc); $fndecl = gimple_call_fndecl($gc); $arg0 = gimple_call_arg(($gc), 0); $arg1 = gimple_call_arg(($gc), 1); $arg2 = gimple_call_arg(($gc), 2); $arg3 = gimple_call_arg(($gc), 3); }#) ;; match a gimple call to a direct function of arity 4 or more (defcmatcher gimple_call_4_more (:gimple gc) (:tree lhs fndecl arg0 arg1 arg2 arg3 :long nbargs ) gimp4calm ;; test #{/*$gimp4calm ?*/ ($gc && gimple_code($gc)==GIMPLE_CALL && gimple_call_num_args($gc)>=4)}# ;; fill #{ /*$gimp4calm !*/ $lhs = gimple_call_lhs($gc); $fndecl = gimple_call_fndecl($gc); $arg0 = gimple_call_arg(($gc), 0); $arg1 = gimple_call_arg(($gc), 1); $arg2 = gimple_call_arg(($gc), 2); $arg3 = gimple_call_arg(($gc), 3); $nbargs = gimple_call_num_args($gc); }#) ;;;; ;; match a gimple call to a direct function of arity 5 exactly (defcmatcher gimple_call_5 (:gimple gc) (:tree lhs fndecl arg0 arg1 arg2 arg3 arg4) gimp5call ;; test #{/*$gimp5call ?*/ ($gc && gimple_code($gc)==GIMPLE_CALL && gimple_call_num_args($gc)==5)}# ;; fill #{ /*$gimp5call !*/ $lhs = gimple_call_lhs($gc); $fndecl = gimple_call_fndecl($gc); $arg0 = gimple_call_arg(($gc), 0); $arg1 = gimple_call_arg(($gc), 1); $arg2 = gimple_call_arg(($gc), 2); $arg3 = gimple_call_arg(($gc), 3); $arg4 = gimple_call_arg(($gc), 4); }#) ;; match a gimple call to a direct function of arity 5 or more (defcmatcher gimple_call_5_more (:gimple gc) (:tree lhs fndecl arg0 arg1 arg2 arg3 arg4 :long nbargs ) gimp5calm ;; test #{/*$gimp5calm ?*/ ($gc && gimple_code($gc)==GIMPLE_CALL && gimple_call_num_args($gc)>=5)}# ;; fill #{ /*$gimp5calm !*/ $lhs = gimple_call_lhs($gc); $fndecl = gimple_call_fndecl($gc); $arg0 = gimple_call_arg(($gc), 0); $arg1 = gimple_call_arg(($gc), 1); $arg2 = gimple_call_arg(($gc), 2); $arg3 = gimple_call_arg(($gc), 3); $arg4 = gimple_call_arg(($gc), 4); $nbargs = gimple_call_num_args($gc); }#) ;;;; ;; match a gimple call to a direct function of arity 6 exactly (defcmatcher gimple_call_6 (:gimple gc) (:tree lhs fndecl arg0 arg1 arg2 arg3 arg4 arg5) gimp6call ;; test #{/*$gimp6call ?*/ ($gc && gimple_code($gc)==GIMPLE_CALL && gimple_call_num_args($gc)==6)}# ;; fill #{ /*$gimp6call !*/ $lhs = gimple_call_lhs($gc); $fndecl = gimple_call_fndecl($gc); $arg0 = gimple_call_arg(($gc), 0); $arg1 = gimple_call_arg(($gc), 1); $arg2 = gimple_call_arg(($gc), 2); $arg3 = gimple_call_arg(($gc), 3); $arg4 = gimple_call_arg(($gc), 4); $arg5 = gimple_call_arg(($gc), 5); }#) ;; match a gimple call to a direct function of arity 6 or more (defcmatcher gimple_call_6_more (:gimple gc) (:tree lhs fndecl arg0 arg1 arg2 arg3 arg4 arg5 :long nbargs ) gimp6calm ;; test #{/*$gimp6calm ?*/ ($gc && gimple_code($gc)==GIMPLE_CALL && gimple_call_num_args($gc)>=6)}# ;; fill #{ /*$gimp6calm !*/ $lhs = gimple_call_lhs($gc); $fndecl = gimple_call_fndecl($gc); $arg0 = gimple_call_arg(($gc), 0); $arg1 = gimple_call_arg(($gc), 1); $arg2 = gimple_call_arg(($gc), 2); $arg3 = gimple_call_arg(($gc), 3); $arg4 = gimple_call_arg(($gc), 4); $arg5 = gimple_call_arg(($gc), 5); $nbargs = gimple_call_num_args($gc); }#) ;;;; ;; match a gimple call to a direct function of arity 7 exactly (defcmatcher gimple_call_7 (:gimple gc) (:tree lhs fndecl arg0 arg1 arg2 arg3 arg4 arg5 arg6) gimp7call ;; test #{/*$gimp7call ?*/ ($gc && gimple_code($gc)==GIMPLE_CALL && gimple_call_num_args($gc)==7)}# ;; fill #{ /*$gimp7call !*/ $lhs = gimple_call_lhs($gc); $fndecl = gimple_call_fndecl($gc); $arg0 = gimple_call_arg(($gc), 0); $arg1 = gimple_call_arg(($gc), 1); $arg2 = gimple_call_arg(($gc), 2); $arg3 = gimple_call_arg(($gc), 3); $arg4 = gimple_call_arg(($gc), 4); $arg5 = gimple_call_arg(($gc), 5); $arg6 = gimple_call_arg(($gc), 6); }#) ;; match a gimple call to a direct function of arity 7 or more (defcmatcher gimple_call_7_more (:gimple gc) (:tree lhs fndecl arg0 arg1 arg2 arg3 arg4 arg5 arg6 :long nbargs ) gimp7calm ;; test #{/*$gimp7calm ?*/ ($gc && gimple_code($gc)==GIMPLE_CALL && gimple_call_num_args($gc)>=7)}# ;; fill #{ /*$gimp7calm !*/ $lhs = gimple_call_lhs($gc); $fndecl = gimple_call_fndecl($gc); $arg0 = gimple_call_arg(($gc), 0); $arg1 = gimple_call_arg(($gc), 1); $arg2 = gimple_call_arg(($gc), 2); $arg3 = gimple_call_arg(($gc), 3); $arg4 = gimple_call_arg(($gc), 4); $arg5 = gimple_call_arg(($gc), 5); $arg6 = gimple_call_arg(($gc), 6); $nbargs = gimple_call_num_args($gc); }#) ;;;; fetch the nth argument inside a call (defprimitive gimple_call_nth_arg (:gimple gc :long n) :tree :doc #{Safely retrieve in gimple call $GC its $N-th argument.}# #{(($gc && gimple_code($gc) == GIMPLE_CALL && ($n)>=0 && ($n) < gimple_call_num_args($gc)) ? gimple_call_arg(($gc), ($n)) : (tree)0)}# ) ;;;;;;;;;;;;;;;; ;;;; match a gimple return (defcmatcher gimple_return (:gimple gr) (:tree retval ) gimpret ;; test #{($gr && gimple_code($gr)==GIMPLE_RETURN)}# ;; fill #{ $retval = gimple_return_retval($gr); }# ) ;;;;;;;;;;;;;;;; ;;;; match a goto [to a label or var for indirect goto] (defcmatcher gimple_goto (:gimple gr) (:tree tlabeld) gimpgoto ;; test #{ /* $gimpgoto ? */ ($gr && gimple_code($gr) == GIMPLE_GOTO) }# ;; fill #{ /* $gimpgoto ! */ $tlabeld = gimple_goto_dest($gr); }# ) ;;; match a gimple error mark or a nil; probably not very useful! (defcmatcher gimple_error_mark_or_nil (:gimple gr) () gimperrnil ;; test #{ /*$gimperrnil ? */ (!$gr || gimple_code($gr) == GIMPLE_ERROR_MARK) }# ;; no fill ) ;; match any gimple_debug (defcmatcher gimple_debug (:gimple gr) () gimpdbg ;; test #{ (($gr) && is_gimple_debug(($gr))) }# ;; no fill ) ;; match a gimple_debug_bind (defcmatcher gimple_debug_bind (:gimple gr) (:tree tvar tval) gimpdbgbind ;; test #{ /* $gimpdbgbind ? */ (($gr) && gimple_debug_bind_p (($gr))) }# ;; fill #{ /* $gimpdbgbind ! */ $tvar = gimple_debug_bind_get_var ($gr); $tval = gimple_debug_bind_get_value ($gr); }#) ;;; match a label (defcmatcher gimple_label (:gimple gr) (:tree tlabel) gimplab ;; test #{ /* $gimplab ? */ ($gr && gimple_code($gr) == GIMPLE_LABEL) }# ;; fill #{ /* $gimplab ! */ $tlabel = gimple_label_label($gr); }# ) ;;; match a nop (defcmatcher gimple_nop (:gimple gr) () gimpnop ;; test #{ /* $gimpnop ?*/ ($gr && gimple_code($gr) == GIMPLE_NOP) }# ;; no fill #{ /* $gimpnop ! */ }#) ;;; match a gimple bind (defcmatcher gimple_bind (:gimple gr) (:tree tvars tblock :gimple_seq gbody ) gimpbind ;; test #{ /* $gimpbind ? */ ($gr && gimple_code($gr) == GIMPLE_BIND) }# ;; fill #{ /* $gimpbind ! */ $tvars = gimple_bind_vars($gr); $tblock = gimple_bind_block($gr); $gbody = gimple_bind_body($gr); }# ) ;;; match a gimple asm (defcmatcher gimple_asm (:gimple gr) (:cstring asmstr :long ninputs noutputs nclobbers) gimpasm ;; test #{ /* $gimpasm ? */ ($gr && gimple_code($gr) == GIMPLE_ASM) }# ;; fill #{ /* $gimpasm ! */ $asmstr = gimple_asm_string ($gr); $ninputs = gimple_asm_ninputs ($gr); $noutputs = gimple_asm_noutputs ($gr); $nclobbers = gimple_asm_nclobbers ($gr); }# ) ;;;;;;;;;;;;;;;; ;;; match a gimple switch (defcmatcher gimple_switch (:gimple gr) (:tree tindex :long numlabels) gimpswitch ;; test #{ /* $gimpswitch ? */ ($gr && gimple_code($gr) == GIMPLE_SWITCH) }# ;; fill #{ /* $gimpswitch ! */ $tindex = gimple_switch_index ($gr); $numlabels = gimple_switch_num_labels ($gr); }# ) ;;; return the index of a switch (defprimitive gimple_switch_index (:gimple gs) :tree :doc #{Retrieve the index of gimple switch $GS.}# #{ (($gs) && gimple_code($gs) == GIMPLE_SWITCH) ? gimple_switch_index_ptr($gs) : NULL }#) ;;; return a tree label (defprimitive gimple_switch_label (:gimple gs :long n) :tree :doc #{Safely retrieve the $N-th label in gimple switch $GS.}# #{ (($gs) && gimple_code($gs) == GIMPLE_SWITCH && $n>= 0&& $n< gimple_switch_num_labels($gs)) ? gimple_switch_label($gs, $n) : NULL }#) ;;; iterator on switch cases (defciterator foreach_case_of_gimple_switch (:gimple gs) ecos (:tree case) #{ /* before $ECOS */ int $ECOS#_i = 0; if ($gs&& gimple_code($gs) == GIMPLE_SWITCH) { int $ECOS#_n = gimple_switch_num_labels($gs); for ($ECOS#_i = 0; $ECOS#_i < $ECOS#_n; $ECOS#_i++) { $case = gimple_switch_label ($gs, $ECOS#_i); }# #{ /* after $ECOS */ } } }# ) ;;;;;;;;;;;;;;;; ;;; match a phi node (defcmatcher gimple_phi (:gimple gr) (:tree lres ;left hand result :long numargs) gimphi ;; test #{ /* $gimphi ? */ ($gr && gimple_code ($gr) == GIMPLE_PHI) }# ;; fill #{ /* $gimphi ! */ $lres = gimple_phi_result ($gr); $numargs = gimple_phi_num_args ($gr); }# ) ;;; safely retrieve the N-th argdeftree of a gimple phinode (defprimitive gimple_phi_nth_arg_def (:gimple g :long n) :tree #{ ( ($g && gimple_code($g) == GIMPLE_PHI && n >= 0 && n < gimple_phi_num_args ($g)) ? gimple_phi_arg_def($g, $n) : NULL) }#) ;;; safely retrieve the N-th argedge of a gimple phinode (defprimitive gimple_phi_nth_arg_edge (:gimple g :long n) :edge #{ ( ($g && gimple_code($g) == GIMPLE_PHI && n >= 0 && n < gimple_phi_num_args ($g)) ? gimple_phi_arg_edge($g, $n) : NULL) }#) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; issue a notice or a warning at a gimple location (defprimitive inform_at_gimple (:gimple g :cstring msg) :void #{ inform (($g ? gimple_location($g) : UNKNOWN_LOCATION), $msg); }# ) (defprimitive warning_at_gimple (:gimple g :cstring msg) :void #{ warning_at(($g ? gimple_location($g) : UNKNOWN_LOCATION), 0, $msg); }# ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defprimitive is_gimpleseq (v) :long #{(melt_magic_discr((melt_ptr_t)($v)) == MELTOBMAG_GIMPLESEQ)}# ) (defprimitive make_gimpleseq (discr :gimple_seq g) :value #{(meltgc_new_gimpleseq((meltobject_ptr_t)($discr),($g)))}# ) (defprimitive gimpleseq_content (v) :gimple_seq #{(melt_gimpleseq_content((melt_ptr_t)($v)))}# ) (defprimitive is_tree (v) :long #{(melt_magic_discr((melt_ptr_t)($v)) == MELTOBMAG_TREE)}# ) (defprimitive make_tree (discr :tree g) :value #{(meltgc_new_tree((meltobject_ptr_t)($discr),($g)))}# ) (defprimitive tree_content (v) :tree #{(melt_tree_content((melt_ptr_t)($v)))}# ) (defprimitive ==t (:tree t1 t2) :long #{(($t1) == ($t2))}# ) (defprimitive null_tree () :tree #{((tree)0)}#) (defprimitive inform_at_tree (:tree tr :cstring msg) :void ;; if DECL_P(tr) use DECL_SOURCE_LOCATION(tr) ;; if EXPR_P(tr) use EXPR_LOCATION(tr) ;; otherwise no location #{ inform((($tr && DECL_P($tr))? DECL_SOURCE_LOCATION($tr) : ($tr && EXPR_P($tr)) ? EXPR_LOCATION($tr) : UNKNOWN_LOCATION), $msg ); }# ) (defprimitive warning_at_tree (:tree tr :cstring msg) :void ;; if DECL_P(tr) use DECL_SOURCE_LOCATION(tr) ;; if EXPR_P(tr) use EXPR_LOCATION(tr) ;; otherwise no location #{ warning_at( (($tr && DECL_P($tr))? DECL_SOURCE_LOCATION($tr) : ($tr && EXPR_P($tr)) ? EXPR_LOCATION($tr) : UNKNOWN_LOCATION), 0, $msg); }# ) (defprimitive tree_type (:tree tr) :tree #{(($tr)?TREE_TYPE($tr):NULL)}#) (defprimitive tree_uid (:tree tr) :long #{(($tr) ? (long) DECL_UID($tr) : NULL)}#) ;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;; ;; pattern (tree_function_decl ) match a tree for a function ;; declaration (defcmatcher tree_function_decl (:tree tr) ;matched ;; output (:cstring funame :tree initialdcl ) treefun ;state symbol ;; test expansion #{ (($tr) && TREE_CODE($tr) == FUNCTION_DECL) }# ;; fill expansion #{ $funame = NULL; $initialdcl = NULL; if (DECL_NAME($tr)) $funame = IDENTIFIER_POINTER(DECL_NAME($tr)); $initialdcl = DECL_RESULT($tr); }# ) ;; pattern (tree_function_type ) match a tree function type. (defcmatcher tree_function_type (:tree tr) (:tree ret_tr) tfunt ;; test expansion #{ /* $tfunt ? */ (($tr) && TREE_CODE($tr) == FUNCTION_TYPE) }# ;; fill expansion #{ /* $tfunt ! */ $ret_tr = TREE_TYPE($tr); }#) ;;;;;;;;;;;;;;;; (defcmatcher tree_of_type (:tree tr) (:tree typetr) treeoftype ;; test expansion #{ /*$treeoftype ?*/ ($tr) != NULL }# ;; fill expansion #{ /*$treeoftype !*/ $typetr = TREE_TYPE($tr); }# ) ;;;;;;;;;;;;;;;; ;; similarily pattern (tree_var_decl ) (defcmatcher tree_var_decl (:tree tr) (:tree type :cstring varname :long uid) treevard ;statesym ;; test expansion #{/*$treevard ?*/ (($tr) && TREE_CODE($tr) == VAR_DECL) }# ;; fill expansion #{/*$treevard !*/ $varname =NULL; $type = TREE_TYPE($tr); $uid = DECL_UID($tr); if (DECL_NAME($tr)) $varname = IDENTIFIER_POINTER(DECL_NAME($tr)); }# ) ;; pattern for a var_decl of given name (defcmatcher tree_var_decl_named (:tree tr :cstring varname) () treevarn ;statesym ;; test expansion #{ /*$treevarn ?*/ (($tr) && TREE_CODE($tr) == VAR_DECL && DECL_NAME($tr) && !strcmp($varname, IDENTIFIER_POINTER(DECL_NAME($tr)))) }# ;; fill expansion #{ /*$treevarn !*/ }# ) ;;;;;;;;;;;;;;;; ;; pattern tree_block matches a block (defcmatcher tree_block (:tree tr) ( ;output :tree trvars trsubblocks ) treeblock ;statesym ;; test expander #{/*$treeblock ?*/ (($tr) && TREE_CODE($tr) == BLOCK)}# ;; fill expander #{ /*$treeblock !*/ $trvars = BLOCK_VARS($tr); $trsubblocks =BLOCK_SUBBLOCKS($tr); }# ) ;;;;;;;;;;;;;;;; ;;; pattern tree_parm_decl matches a formal parameter declaration (defcmatcher tree_parm_decl (:tree tr) ( ;output :tree trargtype trdecl :cstring name ) treeparmdecl ;statesym ;; test expander #{(($tr) && TREE_CODE($tr) == PARM_DECL)}# ;; fill expander #{ $trargtype = DECL_ARG_TYPE($tr); $trdecl = DECL_NAME($tr); $name = DECL_NAME($tr) ? IDENTIFIER_POINTER(DECL_NAME($tr)) : NULL; }# ) ;;;;;;;;;;;;;;;; ;;; pattern tree_identifier matches any identifier node (defcmatcher tree_identifier (:tree tr) (:cstring name) treeident #{ /*$TREEIDENT ?*/ $TR && TREE_CODE ($TR) == IDENTIFIER_NODE }# #{ /*$TREEIDENT !*/ $NAME = (const char*) IDENTIFIER_POINTER ($TR) }# ) ;;; pattern tree_list matches any tree list node (defcmatcher tree_list (:tree tr) (:tree trvalue trpurpose trchain) treelist #{ /*$TREELIST ?*/ $TR && TREE_CODE ($TR) == TREE_LIST }# #{ /*$TREELIST !*/ $TRVALUE = TREE_VALUE ($TR); $TRPURPOSE = TREE_PURPOSE ($TR); $TRCHAIN = TREE_CHAIN ($TR); }# ) ;;; pattern tree_vec matches any tree vector node (defcmatcher tree_vec (:tree tr) (:long len :tree trchain) treevec #{ /*$TREEVEC ?*/ $TR && TREE_CODE ($TR) == TREE_VEC }# #{ /*$TREEVEC !*/ $LEN = TREE_VEC_LENGTH ($TR); $TRCHAIN = TREE_CHAIN ($TR); }# ) ;;;;;;;;;;;;;;;; ;;; pattern tree_decl matches any declaration (defcmatcher tree_decl (:tree tr) ( ;output :tree trdecl :cstring name :long uid ) treedecl ;statesym ;; test expander #{(($tr) && DECL_P($tr))}# ;; fill expander #{ tree $treedecl#_name = DECL_NAME($tr); $trdecl = $treedecl#_name; $name = ($treedecl#_name) ? IDENTIFIER_POINTER($treedecl#_name) : NULL; $uid = DECL_UID($tr); }# ) ;; pattern tree_void_type (defcmatcher tree_void_type (:tree tr) (:tree type) treevt #{ (($tr) && TREE_CODE ($tr) == VOID_TYPE) }# #{ $type = TYPE_NAME ($tr); }#) ;;;;;;;;;;;;;;;; ;;; pattern tree_integer_type (defcmatcher tree_integer_type (:tree tr) ( ;output :tree type :value minbig maxbig :tree size ) treeinty ;statesym ;; test expander #{ /*$treeinty ?*/ (($tr) && TREE_CODE($tr) == INTEGER_TYPE) }# ;; fill expander #{ /*$treeinty !*/ mpz_t $treeinty#_minz; mpz_t $treeinty#_maxz; $type = TYPE_NAME($tr); $size = TYPE_SIZE($tr); mpz_init ($treeinty#_minz); mpz_init ($treeinty#_maxz); get_type_static_bounds($tr, $treeinty#_minz, $treeinty#_maxz); $minbig = meltgc_new_mixbigint_mpz((meltobject_ptr_t) MELT_PREDEF (DISCR_MIXED_BIGINT), NULL, $treeinty#_minz); $maxbig = meltgc_new_mixbigint_mpz((meltobject_ptr_t) MELT_PREDEF (DISCR_MIXED_BIGINT), NULL, $treeinty#_maxz); mpz_clear ($treeinty#_minz); mpz_clear ($treeinty#_maxz); }#) ;; Pattern tree_type_declaration. (defcmatcher tree_type_declaration (:tree tr) (:tree declaration) titd #{ (($tr) && TREE_CODE($tr) == TYPE_DECL) }# #{ $declaration = DECL_NAME($tr); }#) ;;; pattern tree_real_type. It matches any real type. ;;; asked by Marie Krumpe. (defcmatcher tree_real_type (:tree tr) ( ;output :tree type :tree size ) tranyfloaty #{ /* $tranyfloaty ? */ (($tr) && TREE_CODE($tr) == REAL_TYPE) }# #{ /* $tranyfloaty ! */ $type = TYPE_NAME($tr); $size = TYPE_SIZE($tr); }# ) ;;; pattern tree_integer_cst (defcmatcher tree_integer_cst (:tree tr) ( ;output :long n ) treeintk ;; test expander #{ /*$treeintk ?*/ (($tr) && TREE_CODE($tr) == INTEGER_CST) }# ;; fill expander #{ /*$treeintk !*/ $n = tree_low_cst(($tr), 0); }# ) ;;; pattern tree_real_cst (defcmatcher tree_real_cst (:tree tr) (:value v) treerealc ;; test expander #{ /* $treerealc ?*/ (($tr) && TREE_CODE($tr) == REAL_CST) }# ;; fill expander #{ /* treerealc! */ $v = meltgc_new_real ((meltobject_ptr_t) MELT_PREDEF (DISCR_REAL), TREE_REAL_CST(($tr))); }# ) (defcmatcher tree_string_cst (:tree tr) (:value v) treestringc ;; test expander #{ /* $treestringc ? */ (($tr) && TREE_CODE ($tr) == STRING_CST) }# ;; fill expander #{ /* $treestringc ! */ $v = meltgc_new_string_raw_len ((meltobject_ptr_t) MELT_PREDEF (DISCR_STRING), TREE_STRING_POINTER ($tr), TREE_STRING_LENGTH ($tr)); }#) ;;; pattern for pointer types (defcmatcher tree_pointer_type_p (:tree tr) (:tree typetr) treeisptrt ;; test #{ /*$treeisptrt ?*/ (($tr) && POINTER_TYPE_P(($tr))) }# ;; fill #{ /*$treeisptrt !*/ $typetr = TREE_TYPE($tr); }# ;;; :doc annotation are not yet accepted in cmatcher-s! ; :doc #{The $TREE_POINTER_TYPE_P cmatchers matches pointer & ; reference type trees.}# ) ;;; pattern for indirect references (defcmatcher tree_indirect_reference (:tree tr) (:tree type :tree reference) treeir #{ (($tr) && INDIRECT_REF_P ($tr)) }# #{ $type = TREE_TYPE ($tr); $reference = TREE_OPERAND ($tr, 0); }#) (defcmatcher tree_address_expression (:tree tr) (:tree type :tree expression) treeae #{ (($tr) && TREE_CODE ($tr) == ADDR_EXPR) }# #{ $type = TREE_TYPE ($tr); $expression = TREE_OPERAND ($tr, 0); }#) (defcmatcher tree_component_ref (:tree tr) (:tree type :tree arg0 :tree arg1) treecr #{ (($tr) && TREE_CODE ($tr) == COMPONENT_REF) }# #{ $type = TREE_TYPE ($tr); $arg0 = TREE_OPERAND ($tr, 0); $arg1 = TREE_OPERAND ($tr, 1); }#) (defcmatcher tree_record_type (:tree tr) (:tree type) treert #{ (($tr) && TREE_CODE ($tr) == RECORD_TYPE) }# #{ $type = TYPE_NAME ($tr); }#) (defcmatcher tree_field_declaration (:tree tr) (:tree name) treefd #{ (($tr) && TREE_CODE ($tr) == FIELD_DECL) }# #{ $name = DECL_NAME ($tr); }#) ;;;; matcher for patter ssa_name (defcmatcher tree_ssa_name (:tree tr) (:tree tvar tvalu :long vers :gimple defstmt) treessa ;; test expander #{ (($tr) && TREE_CODE($tr) == SSA_NAME) }# ;; fill expander #{ $tvar = SSA_NAME_VAR($tr); $tvalu = SSA_NAME_VALUE($tr); $vers = SSA_NAME_VERSION($tr); $defstmt = SSA_NAME_DEF_STMT($tr); }# ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defprimitive is_basicblock (v) :long #{ (melt_magic_discr((melt_ptr_t)($v)) == MELTOBMAG_BASICBLOCK)}# ) (defprimitive isnull_basicblock (:basic_block bb) :long #{($bb == (basic_block)0)}# ) (defprimitive notnull_basicblock (:basic_block bb) :long #{($bb != (basic_block)0)}# ) (defprimitive null_basicblock () :basic_block #{((basic_block)0)}#) (defprimitive make_basicblock (discr :basic_block bb) :value #{(meltgc_new_basicblock((meltobject_ptr_t)($discr),($bb)))}# ) (defprimitive basicblock_content (v) :basic_block #{(melt_basicblock_content((melt_ptr_t)($v)))}# ) (defprimitive basicblock_gimpleseq (v) :gimple_seq #{(melt_basicblock_gimpleseq((melt_ptr_t)($v)))}# ) (defprimitive basicblock_phinodes (v) :gimple_seq #{(melt_basicblock_phinodes((melt_ptr_t)($v)))}# ) (defprimitive ppstrbuf_gimple (sbuf :long indent :gimple g) :void #{ meltgc_ppstrbuf_gimple((melt_ptr_t)($sbuf), (int) ($indent), ($g)) }# ) (defprimitive ppstrbuf_gimple_seq (sbuf :long indent :gimple_seq gseq) :void #{ meltgc_ppstrbuf_gimple_seq((melt_ptr_t)($sbuf), (int) ($indent), ($gseq)) }# ) (defprimitive ppstrbuf_tree (sbuf :long indent :tree t) :void #{ meltgc_ppstrbuf_tree((melt_ptr_t)($sbuf), (int) ($indent), ($t)) }# ) (defprimitive ppstrbuf_basicblock (sbuf :long indent :basic_block bb) :void #{ meltgc_ppstrbuf_basicblock((melt_ptr_t)($sbuf), (int) ($indent), ($bb)) }# ) (defprimitive basicblock_single_succ (:basic_block bb) :basic_block #{(($bb && single_succ_p($bb))?single_succ($bb):NULL)}# ) (defprimitive basicblock_nb_succ (:basic_block bb) :long #{(($bb)?EDGE_COUNT($bb->succs):0)}#) (defprimitive basicblock_nth_succ_edge (:basic_block bb :long ix) :edge #{(($bb && $ix>=0 && $ixsuccs))?EDGE_SUCC($bb,$ix):NULL)}#) ;;;; (defprimitive null_gimpleseq () :gimple_seq #{((gimple_seq)0)}#) ;;;;;;;;;;;;;;;; (defprimitive is_mapbasicblock (map) :long #{(melt_magic_discr((melt_ptr_t)($map)) == MELTOBMAG_MAPBASICBLOCKS)}# ) (defprimitive mapbasicblock_size (map) :long #{(melt_size_mapbasicblocks((struct meltmapbasicblocks_st*)($map)))}#) ;; primitive to get the attribute count of a mapbasicblock (defprimitive mapbasicblock_count (map) :long #{(melt_count_mapbasicblocks((struct meltmapbasicblocks_st*)($map)))}#) ;; get an entry in a mapbasicblock from a C basicblock (defprimitive mapbasicblock_get (map :basic_block bb) :value #{(melt_get_mapbasicblocks(($map), ($bb)))}#) ;; primitive for making a new map of basicblocks (defprimitive make_mapbasicblock (discr :long len) :value #{(meltgc_new_mapbasicblocks( (meltobject_ptr_t) ($discr), ($len)))}#) ;; primitive for putting into a map of basicblocks (defprimitive mapbasicblock_put (map :basic_block key :value val) :void #{melt_put_mapbasicblocks(($map), ($key), (melt_ptr_t) ($val))}#) ;; primivite for removing from a map of basicblocks (defprimitive mapbasicblock_remove (map :basic_block key) :void #{meltgc_remove_mapbasicblocks(($map), ($key))}#) ;; primitive to get the nth basicblock of a mapbasicblock (defprimitive mapbasicblock_nth_attr (map :long n) :basic_block #{(melt_nthattr_mapbasicblocks((struct meltmapbasicblocks_st*)($map), (int)($n)))}#) ;; primitive to get the nth value of a mapobject (defprimitive mapbasicblock_nth_val (map :long n) :value #{(melt_nthval_mapbasicblocks((struct meltmapbasicblocks_st*)($map), (int)($n)))}#) (defciterator foreach_mapbasicblock (bbmap) ; startformals eachmapbb ;state symbol (:basic_block bbatt :value bbval) ;local formals ;; before expansion #{ /*eachbbmap*/ int $eachmapbb#_rk=0; for ( $eachmapbb#_rk=0; $eachmapbb#_rksuccs) : 0; int $eachbbsucc#_ix = 0; for ($eachbbsucc#_ix=0; $eachbbsucc#_ix < $eachbbsucc#_nbsuc; $eachbbsucc#_ix++) { $e = EDGE_SUCC(($bb), $eachbbsucc#_ix); if (!$e) continue; $eix = $eachbbsucc#_ix; }# #{ /* $eachbbsucc end */ } }# ) ;; Iterator on function argument (defciterator foreach_argument_in_function_tree (:tree tr_fun) eachtrfun (:tree tr_arg) #{ /* $eachtrfun start */ function_args_iterator $eachtrfun#_args_iter; tree $eachtrfun#_t = NULL; if ($tr_fun && TREE_CODE($tr_fun) == FUNCTION_TYPE) { FOREACH_FUNCTION_ARGS($tr_fun, $eachtrfun#_t, $eachtrfun#_args_iter) { }# #{ $tr_arg = $eachtrfun#_t; } } /* $eachtrfun end */ }#) ;;;;;;;;;;;;;;;; (defprimitive is_maptree (map) :long #{ (melt_magic_discr((melt_ptr_t)($map)) == MELTOBMAG_MAPTREES) }#) (defprimitive maptree_size (map) :long #{ (melt_size_maptrees((struct meltmaptrees_st*)($map))) }#) ;; primitive to get the attribute count of a maptree (defprimitive maptree_count (map) :long #{ (melt_count_maptrees((struct meltmaptrees_st*)($map))) }# ) ;; get an entry in a maptree from a C tree (defprimitive maptree_get (map :tree bb) :value #{(melt_get_maptrees(($map), ($bb)))}#) ;; primitive for making a new map of trees (defprimitive make_maptree (discr :long len) :value #{(meltgc_new_maptrees((meltobject_ptr_t) ($discr), ($len)))}#) ;; primitive for putting into a map of trees (defprimitive maptree_put (map :tree key :value val) :void #{melt_put_maptrees(($map), ($key), (melt_ptr_t) ($val))}#) ;; primivite for removing from a map of trees (defprimitive maptree_remove (map :tree key) :void #{meltgc_remove_maptrees( (struct meltmaptrees_st*) ($map), ($key))}#) ;; primitive to get the nth tree of a maptree (defprimitive maptree_nth_attr (map :long n) :tree #{(melt_nthattr_maptrees((struct meltmaptrees_st*)($map), (int)($n)))}#) ;; primitive to get the nth value of a mapobject (defprimitive maptree_nth_val (map :long n) :value #{(melt_nthval_maptrees((struct meltmaptrees_st*)($map), (int)($n)))}# ) ;; iterator inside maptree (defciterator foreach_maptree (trmap) ; startformals eachmaptr ;state symbol (:tree tratt :value trval) ;local formals ;; before expansion #{ /*eachtrmap*/ int $eachmaptr#_rk=0; for ($eachmaptr#_rk=0; $eachmaptr#_rknext) { tree $eachcgrfun#_dcl = NULL; gimple_seq $eachcgrfun#_bdy = NULL; $eachcgrfun#_dcl = $eachcgrfun#_nd->decl; if (!$eachcgrfun#_dcl) continue; if (TREE_CODE($eachcgrfun#_dcl) != FUNCTION_DECL) continue; $eachcgrfun#_bdy = gimple_body($eachcgrfun#_dcl); if (!$eachcgrfun#_bdy) continue; $funtree = $eachcgrfun#_dcl; $funbody = $eachcgrfun#_bdy; }# ;;after expansion #{ } /* $EACHCGRFUN - */ }# ) ;;; iterate on every cgraph_node which is a function with a CFG and an ;;; entryblock (defciterator each_cgraph_fun_entryblock () ;startformals eachcgrafunentrblo ;state symbol (:tree funtree :basic_block funentrybb funexitbb) ;local formals ;;before expansion #{ /* $EACHCGRAFUNENTRBLO + */ struct cgraph_node *$EACHCGRAFUNENTRBLO#_nd = NULL; for ($EACHCGRAFUNENTRBLO#_nd = cgraph_nodes; $EACHCGRAFUNENTRBLO#_nd != NULL; $EACHCGRAFUNENTRBLO#_nd = $EACHCGRAFUNENTRBLO#_nd->next) { tree $EACHCGRAFUNENTRBLO#_dcl = NULL; basic_block $EACHCGRAFUNENTRBLO#_entrybb = NULL; basic_block $EACHCGRAFUNENTRBLO#_exitbb = NULL; struct function *$EACHCGRAFUNENTRBLO#_fun = NULL; $EACHCGRAFUNENTRBLO#_dcl = $EACHCGRAFUNENTRBLO#_nd->decl; if (! $EACHCGRAFUNENTRBLO#_dcl) continue; if (TREE_CODE($EACHCGRAFUNENTRBLO#_dcl) != FUNCTION_DECL) continue; $EACHCGRAFUNENTRBLO#_fun = DECL_STRUCT_FUNCTION($EACHCGRAFUNENTRBLO#_dcl); if (!$EACHCGRAFUNENTRBLO#_fun) continue; /* this assert fails when in a pass without control flow graph */ melt_assertmsg ("no cfg in each_cgraph_fun_entryblock $EACHCGRAFUNENTRBLO", $EACHCGRAFUNENTRBLO#_fun->cfg != NULL); $EACHCGRAFUNENTRBLO#_entrybb = ENTRY_BLOCK_PTR_FOR_FUNCTION ($EACHCGRAFUNENTRBLO#_fun); if (! $EACHCGRAFUNENTRBLO#_entrybb) continue; $EACHCGRAFUNENTRBLO#_exitbb = EXIT_BLOCK_PTR_FOR_FUNCTION ($EACHCGRAFUNENTRBLO#_fun); if (! $EACHCGRAFUNENTRBLO#_exitbb) continue; $funtree = $EACHCGRAFUNENTRBLO#_dcl; $funentrybb = $EACHCGRAFUNENTRBLO#_entrybb; $funexitbb = $EACHCGRAFUNENTRBLO#_exitbb; }# ;;after expansion #{ } /* $EACHCGRAFUNENTRBLO - */ }# ) ;; iterator on every cgraph_node which is a function with a CFG, and ;; retrieve its entry block, exit block, tuple of blocks, and uses a ;; temporary value TMPV (defciterator each_cgraph_fun_call_flow_graph () ;start formals eachcgrafuncfg (:tree funtree :basic_block funentrybb funexitbb :value bbtup tmpv) ;; before expansion #{ /* $EACHCGRAFUNCFG + */ struct cgraph_node *$EACHCGRAFUNCFG#_nd = NULL; for ($EACHCGRAFUNCFG#_nd = cgraph_nodes; $EACHCGRAFUNCFG#_nd != NULL; $EACHCGRAFUNCFG#_nd = $EACHCGRAFUNCFG#_nd->next) { tree $EACHCGRAFUNCFG#_dcl = NULL; basic_block $EACHCGRAFUNCFG#_entrybb = NULL; basic_block $EACHCGRAFUNCFG#_exitbb = NULL; basic_block $EACHCGRAFUNCFG#_curbb = NULL; struct function *$EACHCGRAFUNCFG#_fun = NULL; int $EACHCGRAFUNCFG#_n_bb = 0; int $EACHCGRAFUNCFG#_ix = 0; $EACHCGRAFUNCFG#_dcl = $EACHCGRAFUNCFG#_nd->decl; if (! $EACHCGRAFUNCFG#_dcl) continue; if (TREE_CODE($EACHCGRAFUNCFG#_dcl) != FUNCTION_DECL) continue; $EACHCGRAFUNCFG#_fun = DECL_STRUCT_FUNCTION($EACHCGRAFUNCFG#_dcl); if (!$EACHCGRAFUNCFG#_fun) continue; debugeprintf("$EACHCGRAFUNCFG#_fun %p", $EACHCGRAFUNCFG#_fun); $TMPV = NULL; /* this assert fails when in a pass without control flow graph */ melt_assertmsg ("no cfg in each_cgraph_fun_call_flow_graph $EACHCGRAFUNCFG", $EACHCGRAFUNCFG#_fun->cfg != NULL); $EACHCGRAFUNCFG#_n_bb = n_basic_blocks_for_function ($EACHCGRAFUNCFG#_fun); /* $EACHCGRAFUNCFG create the tuple of basic blocks */ $BBTUP = meltgc_new_multiple ((meltobject_ptr_t) MELT_PREDEF (DISCR_MULTIPLE), $EACHCGRAFUNCFG#_n_bb); for ($EACHCGRAFUNCFG#_ix = 0; $EACHCGRAFUNCFG#_ix < $EACHCGRAFUNCFG#_n_bb; $EACHCGRAFUNCFG#_ix ++) { $EACHCGRAFUNCFG#_curbb = BASIC_BLOCK_FOR_FUNCTION($EACHCGRAFUNCFG#_fun, $EACHCGRAFUNCFG#_ix); if (!$EACHCGRAFUNCFG#_curbb) continue; $TMPV = meltgc_new_basicblock ((meltobject_ptr_t) MELT_PREDEF (DISCR_BASIC_BLOCK), $EACHCGRAFUNCFG#_curbb); meltgc_multiple_put_nth ((melt_ptr_t)$BBTUP, $EACHCGRAFUNCFG#_ix, $TMPV); } /* $EACHCGRAFUNCFG done bb tuple */ $TMPV = NULL; }# ;; after expansion #{ /* $EACHCGRAFUNCFG - */ $TMPV = NULL; } }# ) ;;;;;;;;;;;;;;;; ;;;; iterate on every cgraph_node which is a declaration (defciterator each_cgraph_decl () eachcgrdcl (:tree decl) ;;before expansion #{ /* $eachcgrdcl */ struct cgraph_node *$eachcgrdcl#_nd = NULL; for ($eachcgrdcl#_nd = cgraph_nodes; $eachcgrdcl#_nd != NULL; $eachcgrdcl#_nd = $eachcgrdcl#_nd->next) { tree $eachcgrdcl#_dcl = NULL; $eachcgrdcl#_dcl = $eachcgrdcl#_nd->decl; if (!$eachcgrdcl#_dcl) continue; $decl = $eachcgrdcl#_dcl; }# ;; after expansion #{ /* end $eachcgrdcl */ } }# ) ;;; iterate on evey basicblock of the current cfun (defciterator each_bb_cfun () ;startformals eachbbcfun ;state symbol ( ;local formals :basic_block cfunbb :tree cfundecl ) ;;before expansion #{ /* start $eachbbcfun */ if (cfun && cfun->cfg) { basic_block $eachbbcfun#_bb = NULL; $cfundecl = cfun->decl; FOR_EACH_BB_FN($eachbbcfun#_bb, cfun) { if (!$eachbbcfun#_bb) continue; $cfunbb = $eachbbcfun#_bb; }# ;;after expansion #{ }} else melt_fatal_error ("each_bb_cfun used with invalid cfun=%p [$eachbbcfun]", cfun); /* end $eachbbcfun */ }# ) ;; debug_tree is ok even for nil trees (defprimitive debugtree (:cstring msg :tree tr) :void #{ do {debugeprintfnonl("debugtree %s @%p /%s ", $msg, (void*)$tr, ($tr)?tree_code_name[TREE_CODE($tr)]:" *niltree*"); if (flag_melt_debug) debug_tree($tr);}while(0) }# ) ;; debug_edge is ok even for nil (defprimitive debugedge (:cstring msg :edge eg) :void #{ do {debugeprintfnonl("debugedge %s @%p ", $msg, (void*)$eg); if (flag_melt_debug) { if ($eg) dump_edge_info(stderr,$eg,1); fputc('\n',stderr); } }while(0) }# ) ;; the basic block source of an edge (defprimitive edge_src_bb (:edge eg) :basic_block #{ ($eg)?($eg->src):NULL }#) ;; the basic block destination of an edge (defprimitive edge_dest_bb (:edge eg) :basic_block #{ ($eg)?($eg->dest):NULL }#) ;; test if an edge is for a true value of a branch (defprimitive edge_for_true_value (:edge eg) :long #{ ($eg && $eg->flags & EDGE_TRUE_VALUE) }#) ;; test if an edge is for a false value of a branch (defprimitive edge_for_false_value (:edge eg) :long #{ ($eg && $eg->flags & EDGE_FALSE_VALUE) }#) (defprimitive debugtreecodenum (:cstring msg :long opcod) :void #{ debugeprintf("debugtreecodenum %s #%ld %s", $msg, $opcod, tree_code_name[$opcod]); }#) (defprimitive make_gimple_mixloc (:gimple g :long num :value val dis) :value :doc #{Make a mixed location for the location of gimple $G with value $VAL and discriminant $DIS, usually $DISCR_MIXED_LOCATION.}# #{ (($g && gimple_location($g))? meltgc_new_mixloc((meltobject_ptr_t)($dis), (melt_ptr_t)($val), ($num), (location_t)gimple_location(($g))):NULL) }#) ;; debug_gimple_stmt is ok even for nil gimples (defprimitive debuggimple(:cstring msg :gimple g) :void #{ do{debugeprintfnonl("debuggimple %s @%p /%s ", $msg , (void*)$g, ($g)?gimple_code_name[gimple_code($g)]: "*nil*"); if ($g && gimple_location($g)) debugeprintf_raw("{%s:%d} ", LOCATION_FILE(gimple_location($g)), LOCATION_LINE(gimple_location($g))); if (flag_melt_debug) debug_gimple_stmt($g);} while(0) }# ) (defprimitive debuggimpleseq(:cstring msg :gimple_seq gs) :void #{ do{debugeprintf("debuggimpleseq %s @%p", $msg, (void*)$gs); if (flag_melt_debug && $gs) debug_gimple_seq($gs);}while(0) }#) (defprimitive debugbasicblock(:cstring msg :basic_block bb) :void #{ do{debugeprintf("debugbasicblock %s @%p", $msg, (void*)$bb); if (flag_melt_debug && $bb) debug_bb($bb);}while(0) }#) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; gimpleseq iteration ;;;; iterate on a gimpleseq (defciterator each_in_gimpleseq (:gimple_seq gseq) ;start formals eachgimplseq (:gimple g) ;local formals ;;; before expansion #{ gimple_stmt_iterator gsi_$eachgimplseq; if ($gseq) for (gsi_$eachgimplseq = gsi_start ($gseq); !gsi_end_p (gsi_$eachgimplseq); gsi_next (&gsi_$eachgimplseq)) { $g = gsi_stmt (gsi_$eachgimplseq); }# ;;; after expansion #{ } }# ) ;;;; reverseiterate on a gimpleseq (defciterator reveach_in_gimpleseq (:gimple_seq gseq) ;start formals eachgimplseq (:gimple g) ;local formals ;;; before expansion #{ gimple_stmt_iterator gsi_$eachgimplseq; if ($gseq) for (gsi_$eachgimplseq = gsi_last ($gseq); !gsi_end_p (gsi_$eachgimplseq); gsi_prev (&gsi_$eachgimplseq)) { $g = gsi_stmt (gsi_$eachgimplseq); }# ;;; after expansion #{ } }# ) ;; apply a function to each boxed gimple in a gimple seq (defun do_each_gimpleseq (f :gimple_seq gseq) (each_in_gimpleseq (gseq) (:gimple g) (let ( (gplval (make_gimple discr_gimple g)) ) (f gplval))) ) ;; apply a function to each boxed gimple in a gimple seq (defun do_reveach_gimpleseq (f :gimple_seq gseq) (reveach_in_gimpleseq (gseq) (:gimple g) (let ( (gplval (make_gimple discr_gimple g)) ) (f gplval))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; basicblock iteration (defciterator eachgimple_in_basicblock (:basic_block bb) ;start formals eachgimpbb (:gimple g) ;local formals ;;; before expansion #{ /* start $eachgimpbb */ gimple_stmt_iterator gsi_$eachgimpbb; if ($bb) for (gsi_$eachgimpbb = gsi_start_bb ($bb); !gsi_end_p (gsi_$eachgimpbb); gsi_next (&gsi_$eachgimpbb)) { $g = gsi_stmt (gsi_$eachgimpbb); }# ;;; after expansion #{ } /* end $eachgimpbb */ }# ) (defun do_eachgimple_in_basicblock (f :basic_block bb) (eachgimple_in_basicblock (bb) (:gimple g) (let ( (gplval (make_gimple discr_gimple g)) ) (f gplval))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;; gimpleseq iteration ;;;; iterate on a function formal parameters (defciterator each_param_in_fundecl ( :tree fundeclt ) ;start formals eachparamfun ( :tree paramdclt ) ;local formals ;;; before expansion #{ /*eachparaminfunctiondecl*/ tree $eachparamfun#_tr=NULL; if (($fundeclt) && TREE_CODE($fundeclt) == FUNCTION_DECL) for ($eachparamfun#_tr = DECL_ARGUMENTS($fundeclt); $eachparamfun#_tr != NULL; $eachparamfun#_tr = TREE_CHAIN($eachparamfun#_tr)) { $paramdclt = $eachparamfun#_tr; }# ;;; after expansion #{ }/*end eachparaminfunctiondecl*/ }# ) ;;; iterate on fields of a structure (defciterator foreach_field_in_record_type (:tree first_field) efirt (:tree field) #{ if ($first_field && TREE_CODE ($first_field) == FIELD_DECL) { tree $efirt#_current; for ($efirt#_current = $first_field; $efirt#_current != NULL; $efirt#_current = TREE_CHAIN ($efirt#_current)) { $field = $efirt#_current; }# #{ } } }#) ;;; gimple iterator (defun gimple_iterator (f data :gimple g) (each_bb_cfun () (:basic_block body :tree header) (let ((:gimple_seq instructions (gimple_seq_of_basic_block body))) (each_in_gimpleseq (instructions) (:gimple instruction) (f data instruction)))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;; loop related operations (defprimitive is_loop (v) :long #{(melt_magic_discr((melt_ptr_t)($v)) == MELTOBMAG_LOOP)}# ) (defprimitive make_loop (discr :loop l) :value #{(meltgc_new_loop((meltobject_ptr_t)($discr),($l)))}# ) (defprimitive loop_content (v) :loop #{(melt_loop_content((melt_ptr_t)($v)))}# ) ;;; safe queries to the cfun (when cfun is null, return null or 0) (defprimitive has_cfun () :long #{ cfun != NULL }#) (defprimitive cfun_gimple_body () :gimple_seq #{ (cfun?(cfun->gimple_body):NULL) }#) (defprimitive cfun_decl () :tree #{ (cfun?(cfun->decl):NULL) }#) (defprimitive cfun_static_chain_decl () :tree #{ (cfun?(cfun->static_chain_decl):NULL) }#) (defprimitive cfun_nonlocal_goto_save_area () :tree #{ (cfun?(cfun->nonlocal_goto_save_area):NULL) }#) (defprimitive cfun_local_decls () :tree #{ (cfun?(cfun->local_decls):NULL) }#) (defprimitive cfun_has_cfg () :long #{ (cfun?(cfun->cfg != NULL):0) }#) (defprimitive cfun_cfg_entry_block () :basic_block #{ ((cfun && cfun->cfg)? ENTRY_BLOCK_PTR_FOR_FUNCTION(cfun):NULL) }#) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (export_values ==g ==t basicblock_content basicblock_gimpleseq basicblock_nb_succ basicblock_phinodes basicblock_single_succ cfun_decl cfun_gimple_body cfun_has_cfg cfun_local_decls cfun_nonlocal_goto_save_area cfun_static_chain_decl clear_special debug_ppl_coefficient debug_ppl_constraint debug_ppl_linear_expression debug_ppl_polyhedron debugbasicblock debugedge debuggimple debuggimpleseq debugloop debugtree debugtreecodenum each_bb_cfun each_cgraph_decl each_cgraph_fun_body each_cgraph_fun_call_flow_graph each_cgraph_fun_entryblock each_in_gimpleseq each_loop each_param_in_fundecl eachgimple_in_basicblock edge_dest_bb edge_for_false_value edge_for_true_value edge_src_bb foreach_argument_in_function_tree foreach_argument_of_gimple_call foreach_basicblock_succ_edge foreach_case_of_gimple_switch foreach_field_in_record_type foreach_mapbasicblock foreach_mapgimple foreach_maptree gimple_asm gimple_assign_binaryop gimple_assign_cast gimple_assign_ceil_div gimple_assign_ceil_mod gimple_assign_copy gimple_assign_exact_div gimple_assign_floor_div gimple_assign_floor_mod gimple_assign_minus gimple_assign_mult gimple_assign_plus gimple_assign_pointerplus gimple_assign_rdiv gimple_assign_round_div gimple_assign_round_mod gimple_assign_single gimple_assign_ssa_name_copy gimple_assign_trunc_div gimple_assign_trunc_mod gimple_assign_unary_minus gimple_assign_unary_nop gimple_bind gimple_call gimple_call_1 gimple_call_1_more gimple_call_2 gimple_call_2_more gimple_call_3 gimple_call_3_more gimple_call_4 gimple_call_4_more gimple_call_5 gimple_call_5_more gimple_call_6 gimple_call_6_more gimple_call_7 gimple_call_7_more gimple_call_nth_arg gimple_cond_equal gimple_cond_false gimple_cond_greater gimple_cond_greater_or_equal gimple_cond_less gimple_cond_lessequal gimple_cond_notequal gimple_cond_true gimple_cond_with_edges gimple_cond_with_true_false_labels gimple_content gimple_copy gimple_debug gimple_debug_bind gimple_error_mark_or_nil gimple_goto gimple_iterator gimple_label gimple_nop gimple_phi gimple_phi_nth_arg_def gimple_phi_nth_arg_edge gimple_return gimple_seq_of_basic_block gimple_switch gimple_switch_index gimple_switch_label gimpleseq_content gimpleval has_cfun inform_at_gimple inform_at_tree insert_ppl_constraint_in_boxed_system install_melt_gcc_pass is_basicblock is_gimple is_gimpleseq is_mapbasicblock is_mapgimple is_maptree is_tree isnull_basicblock make_basicblock make_gimple make_gimpleseq make_gimple_mixloc make_mapbasicblock make_mapgimple make_maptree make_ppl_constraint make_ppl_linear_expression make_ppl_polyhedron_cloned make_ppl_polyhedron_same make_tree mapbasicblock_count mapbasicblock_get mapbasicblock_nth_attr mapbasicblock_nth_val mapbasicblock_put mapbasicblock_remove mapbasicblock_size mapedge_count mapedge_get mapedge_nth_attr mapedge_nth_val mapedge_put mapedge_remove mapedge_size mapgimple_count mapgimple_get mapgimple_nth_attr mapgimple_nth_val mapgimple_put mapgimple_remove mapgimple_size maploop_count maploop_get maploop_nth_attr maploop_nth_val maploop_put maploop_remove maploop_size maptree_count maptree_get maptree_nth_attr maptree_nth_val maptree_put maptree_remove maptree_size notnull_basicblock null_basicblock null_gimple null_gimpleseq null_tree pop_cfun ppl_Constraint_System_insert_Constraint ppl_Linear_Expression_add_to_coefficient ppl_Linear_Expression_add_to_inhomogeneous ppl_NNC_Polyhedron_from_Constraint_System ppl_Polyhedron_add_constraint ppl_Polyhedron_is_empty ppl_clone_constraint_system ppl_coefficient_content ppl_coefficient_from_long ppl_coefficient_from_tree ppl_constraint_content ppl_constraint_system_content ppl_delete_Coefficient ppl_delete_Constraint ppl_delete_Linear_Expression ppl_delete_Polyhedron ppl_new_empty_constraint_system ppl_new_unsatisfiable_constraint_system ppl_polyhedron_content ppl_ppstrbuf ppstrbuf_basicblock ppstrbuf_gimple ppstrbuf_gimple_seq ppstrbuf_tree push_cfun_decl raw_new_ppl_empty_constraint_system raw_new_ppl_unsatisfiable_constraint_system reveach_in_gimpleseq tree_address_expression tree_block tree_component_ref tree_content tree_decl tree_field_declaration tree_function_decl tree_function_type tree_identifier tree_indirect_reference tree_integer_cst tree_integer_type tree_list tree_of_type tree_pointer_type_p tree_parm_decl tree_real_cst tree_real_type tree_record_type tree_ssa_name tree_string_cst tree_type tree_type_declaration tree_uid tree_var_decl tree_var_decl_named tree_vec tree_void_type warning_at_gimple warning_at_tree ) (export_class class_analysis_state ) ;; eof ana-base.melt