;; -*- Lisp -*-
;; file ana-base.bysl
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(comment "
    Copyright 2008 Free Software Foundation, Inc.
    Contributed by Basile Starynkevitch <basile@starynkevitch.net>

    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
    <http://www.gnu.org/licenses/>.
")

;; the copyright notice above apply both to ana-base.bysl and 
;; to the generated file  ana-base*.c

;; a class containing the analysis state
(defclass class_analysis_state
  :super class_proped
  :fields (
))


;;; primitive to access the gdbmstate

(defprimitive fetch_gdbmstate_constr (:cstring keystr) :value
  "(basilysgc_fetch_gdbmstate_const((" keystr ")))")

(defprimitive fetch_gdbmstate (key) :value
  "(basilysgc_fetch_gdbmstate((" key ")))")

(defprimitive put_gdbmstate_constr (:cstring keystr :value data) :void
  "basilysgc_put_gdbmstate_const((" keystr "), (basilys_ptr_t) (" data "))")

(defprimitive put_gdbmstate (key data) :void
  "basilysgc_put_gdbmstate((basilys_ptr_t)(" key "), (basilys_ptr_t)(" data "))")

(defun install_gcc_pass (pass)
  (assert_msg "check pass" (is_a pass class_gcc_pass))
  (mapstring_putstr (unsafe_get_field :sysdata_pass_dict initial_system_data)
		 (unsafe_get_field :named_name pass)
		 pass)
  (debug_msg pass "installed gcc pass")
)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;; gimple & tree related primitives

(defprimitive is_gimple (v) :long
  "(basilys_magic_discr((basilys_ptr_t)(" v ")) == OBMAG_GIMPLE)")

(defprimitive make_gimple (discr :gimple g) :value
  "(basilysgc_new_gimple((basilysobject_ptr_t)(" discr "),(" g ")))")

(defprimitive gimple_content (v) :gimple
  "(basilys_gimple_content((basilys_ptr_t)(" v ")))")

(defprimitive is_gimpleseq (v) :long
  "(basilys_magic_discr((basilys_ptr_t)(" v ")) == OBMAG_GIMPLESEQ)")

(defprimitive make_gimpleseq (discr :gimpleseq g) :value
  "(basilysgc_new_gimpleseq((basilysobject_ptr_t)(" discr "),(" g ")))")

(defprimitive gimpleseq_content (v) :gimpleseq
  "(basilys_gimpleseq_content((basilys_ptr_t)(" v ")))")

(defprimitive is_tree (v) :long
  "(basilys_magic_discr((basilys_ptr_t)(" v ")) == OBMAG_TREE)")

(defprimitive make_tree (discr :tree g) :value
  "(basilysgc_new_tree((basilysobject_ptr_t)(" discr "),(" g ")))")

(defprimitive tree_content (v) :tree
  "(basilys_tree_content((basilys_ptr_t)(" v ")))")

(defprimitive is_basicblock (v) :long
  "(basilys_magic_discr((basilys_ptr_t)(" v ")) == OBMAG_BASICBLOCK)")

(defprimitive make_basicblock (discr :basicblock bb) :value
  "(basilysgc_new_basicblock((basilysobject_ptr_t)(" discr "),(" bb ")))")

(defprimitive basicblock_content (v) :basicblock
  "(basilys_basicblock_content((basilys_ptr_t)(" v ")))")

(defprimitive basicblock_gimpleseq (v) :gimpleseq
  "(basilys_basicblock_gimpleseq((basilys_ptr_t)(" v ")))")
  
(defprimitive basicblock_phinodes (v) :gimpleseq
  "(basilys_basicblock_phinodes((basilys_ptr_t)(" v ")))")
  
(defprimitive ppstrbuf_gimple (sbuf :long indent :gimple g) :void
  "basilysgc_ppstrbuf_gimple((basilys_ptr_t)(" sbuf 
  "), (int) (" indent "), (" g "))")

(defprimitive ppstrbuf_gimple_seq (sbuf :long indent :gimpleseq gseq) :void
  "basilysgc_ppstrbuf_gimple_seq((basilys_ptr_t)(" sbuf 
  "), (int) (" indent "), (" gseq "))")

(defprimitive ppstrbuf_tree (sbuf :long indent :tree t) :void
  "basilysgc_ppstrbuf_tree((basilys_ptr_t)(" sbuf 
  "), (int) (" indent "), (" t "))")

(defprimitive ppstrbuf_basicblock (sbuf :long indent :basicblock bb) :void
  "basilysgc_ppstrbuf_basicblock((basilys_ptr_t)(" sbuf 
  "), (int) (" indent "), (" bb "))")

;;;; boxed gimple debug
(defun dbgout_boxgimple_method (self dbgi :long depth)
  (assert_msg "check dbgi" (is_a dbgi class_debuginfo))
  (let ( (dis (discrim self)) 
	 (sbuf  (unsafe_get_field :dbgi_sbuf dbgi)) ) 
    (add2sbuf_strconst sbuf " ?/")
    (if (is_a dis class_named) (add2sbuf_string sbuf (unsafe_get_field :named_name dis)))
    (add2sbuf_strconst sbuf "/{ ")
    (ppstrbuf_gimple sbuf depth (gimple_content self))
    (add2sbuf_strconst sbuf "}/ ")
    )
  )
(install_method discr_gimple dbg_output dbgout_boxgimple_method)

;;;; boxed gimple seq debug
(defun dbgout_boxgimpleseq_method (self dbgi :long depth)
  (assert_msg "check dbgi" (is_a dbgi class_debuginfo))
  (let ( (dis (discrim self)) 
	 (sbuf  (unsafe_get_field :dbgi_sbuf dbgi)) ) 
    (add2sbuf_strconst sbuf " ?/")
    (if (is_a dis class_named) (add2sbuf_string sbuf (unsafe_get_field :named_name dis)))
    (add2sbuf_strconst sbuf "/{ ")
    (ppstrbuf_gimple_seq sbuf depth (gimpleseq_content self))
    (add2sbuf_strconst sbuf "}/ ")
    )
  )
(install_method discr_gimpleseq dbg_output dbgout_boxgimpleseq_method)

;;;; boxed tree debug
(defun dbgout_boxtree_method (self dbgi :long depth)
  (assert_msg "check dbgi" (is_a dbgi class_debuginfo))
  (let ( (dis (discrim self)) 
	 (sbuf  (unsafe_get_field :dbgi_sbuf dbgi)) ) 
    (add2sbuf_strconst sbuf " ?/")
    (if (is_a dis class_named) (add2sbuf_string sbuf (unsafe_get_field :named_name dis)))
    (add2sbuf_strconst sbuf "/{ ")
    (ppstrbuf_tree sbuf depth (tree_content self))
    (add2sbuf_strconst sbuf "}/ ")
    )
  )
(install_method discr_tree dbg_output dbgout_boxtree_method)

;;;; boxed basicblock debug
(defun dbgout_boxbasicblock_method (self dbgi :long depth)
  (assert_msg "check dbgi" (is_a dbgi class_debuginfo))
  (let ( (dis (discrim self)) 
	 (sbuf  (unsafe_get_field :dbgi_sbuf dbgi)) ) 
    (add2sbuf_strconst sbuf " ?/")
    (if (is_a dis class_named) (add2sbuf_string sbuf (unsafe_get_field :named_name dis)))
    (add2sbuf_strconst sbuf "/{ ")
    (ppstrbuf_basicblock sbuf depth (basicblock_content self))
    (add2sbuf_strconst sbuf "}/ ")
    )
  )
(install_method discr_basicblock dbg_output dbgout_boxbasicblock_method)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;; G C C      P A S S E S 
;; the named_name of passes is builtin in gcc/basilys.c [lowercase]


;;;;;;;;;;;;;;;;;; lowering pass
;; the CFG is available, but the tree is not in SSA form
(definstance basilys_lowering_gccpass 
  class_gcc_pass
  :named_name (make_stringconst discr_string "basilys-lowering")
  :gccpass_data ()
)
(install_gcc_pass basilys_lowering_gccpass)

;;;;;;;;;;;;;;;;;; ipa (interprocedural analysis) pass
;; the CFG is available & tree is in SSA form
(definstance basilys_ipa_gccpass 
  class_gcc_pass
  :named_name (make_stringconst discr_string "basilys-ipa")
  :gccpass_gate ()
  :gccpass_exec ()
  :gccpass_data ()
)
(install_gcc_pass basilys_ipa_gccpass)


;;;;;;;;;;;;;;;;;; early optimisation pass
;; code in SSA
(definstance basilys_earlyopt_gccpass
  class_gcc_pass
  :named_name (make_stringconst discr_string "basilys-earlyopt")
  :gccpass_data ()
)
(install_gcc_pass basilys_earlyopt_gccpass)

;;;;;;;;;;;;;;;;;; late optimisation pass
;; code in SSA, soon to be removed
(definstance basilys_lateopt_gccpass class_gcc_pass
  :named_name (make_stringconst discr_string "basilys-lateopt")
  :gccpass_data ()
)
(install_gcc_pass basilys_lateopt_gccpass)


;;;;;;;;;;;;;;;;;; late ssa pass
;; code in SSA, soon to be removed
(definstance basilys_latessa_gccpass class_gcc_pass
  :named_name (make_stringconst discr_string "basilys-latessa")
  :gccpass_data ()
)
(install_gcc_pass basilys_latessa_gccpass)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; iterators needed in our analysis

;;; an iterator is simply something which translates to a for loop in
;;; C. It usually binds some variables (local to the iterated body)
;;; to some C stuff.

;;; Be careful to not declare any iterator related stuff in
;;; warmelt*.bysl file, because we want to be able to bootstrap
;;; Basilys/MELT (ie to generate the warmelt*.c files) even when GCC
;;; internal representation changes a little.

;;;;;;;;;;;;;;;;
;;;; iterate on every cgraph_node which is a function with a body
(defciterator each_cgraph_fun_body 
  ()					; startformals
  eachcgrfun 				;state symbol
  (:tree funtree :gimpleseq funbody)	;local formals
  (					;; before expansion
   "struct cgraph_node *" eachcgrfun "_nd=0; "
   "for (" eachcgrfun "_nd = cgraph_nodes; "
   eachcgrfun "_nd != 0; "
   eachcgrfun "_nd = " eachcgrfun "_nd->next) {\n"
   "tree " eachcgrfun "_dcl = 0;\n"
   "gimple_seq " eachcgrfun "_bdy = 0;\n"
   "if (flag_basilys_debug) "
   "{ debugeprintf(\"" eachcgrfun " nd=%p\", (void*)"  eachcgrfun "_nd);"
   "debug_cgraph_node(" eachcgrfun "_nd);};\n"
   eachcgrfun "_dcl = " eachcgrfun "_nd->decl;\n"
   "if (!" eachcgrfun "_dcl) continue;\n"
   "if (TREE_CODE(" eachcgrfun "_dcl) != FUNCTION_DECL) continue;\n"
   eachcgrfun "_bdy = gimple_body(" eachcgrfun "_dcl);\n"
   "if (!" eachcgrfun "_bdy) continue;\n"
   funtree " = " eachcgrfun "_dcl;\n"
   funbody " = " eachcgrfun "_bdy;\n"
   )
  ( ;;after expansion
   "}"
   )
  )


;;; iterate on every cgraph_node which is a function with a CFG and an
;;; entryblock
(defciterator each_cgraph_fun_entryblock
  ()					;startformals
  eachcgrblo				;state symbol
  (:tree funtree :basicblock funbb)	;local formals
  (					;before expansion
   "struct cgraph_node *" eachcgrblo "_nd=0; "
   "for (" eachcgrblo "_nd = cgraph_nodes; "
   eachcgrblo "_nd != 0; "
   eachcgrblo "_nd = " eachcgrblo "_nd->next) {\n"
   "tree " eachcgrblo "_dcl = 0;\n"
   "basic_block " eachcgrblo "_bb = 0;\n"
   "struct function *" eachcgrblo "_fun = 0;\n"
   "if (flag_basilys_debug) "
   "{ debugeprintf(\"" eachcgrblo " nd=%p\", (void*)"  eachcgrblo "_nd);"
   "debug_cgraph_node(" eachcgrblo "_nd);};\n"
   eachcgrblo "_dcl = " eachcgrblo "_nd->decl;\n"
   "if (!" eachcgrblo "_dcl) continue;\n"
   "if (TREE_CODE(" eachcgrblo "_dcl) != FUNCTION_DECL) continue;\n"
   eachcgrblo "_fun = DECL_STRUCT_FUNCTION("eachcgrblo "_dcl);\n"
   "if (!"eachcgrblo "_fun) continue;\n"
   eachcgrblo "_bb = ENTRY_BLOCK_PTR_FOR_FUNCTION(" eachcgrblo "_fun);\n"
   "if (!" eachcgrblo "_bb) continue;\n"
   funtree " = " eachcgrblo "_dcl;\n"
   funbb " = " eachcgrblo "_bb;\n"
   )
  (					;after expansion
   "}"
   )
)


;;; iterate on evey basicblock of the current cfun
(defciterator each_bb_cfun
  ()					;startformals
  eachbbcfun				;state symbol
  (					;local formals
   :basicblock cfunbb 
   :tree cfundecl
   )	
  (					;before expansion
   "/*start " eachbbcfun "*/\n"
   "basic_block " eachbbcfun  "_bb=NULL;\n"
   "debugeprintf(\" each_bb_cfun " eachbbcfun " cfun=%p\", cfun);\n"
   "if (cfun) {\n"
   " " cfundecl " = cfun->decl;\n"
   " FOR_EACH_BB_FN("eachbbcfun "_bb, cfun) {"
   "  if (flag_basilys_debug) { debugeprintf(\"each_bb_cfun " 
   eachbbcfun  "_bb =%p\", (void*)" eachbbcfun "_bb);\n"
   "    debug_bb(" eachbbcfun "_bb);};\n"
   "  if (!" eachbbcfun "_bb) continue;\n"
   "  " cfunbb " = " eachbbcfun "_bb;\n"
   )
  (					;after expansion
   "debugeprintf(\" each_bb_cfun " eachbbcfun " done cfun=%p\", cfun);\n"
   "}}/*end " eachbbcfun "*/\n"
   )
  )


(defprimitive debugtree (:cstring msg :tree tr) :void
  " do{debugeprintf(\"debugtree %s @%p\", " msg ", (void*)" tr ");"
  "if (flag_basilys_debug) debug_tree(" tr ");}while(0) "
)

(defprimitive debuggimple(:cstring msg :gimple g) :void
  " do{debugeprintf(\"debuggimple %s @%p\", " msg ", (void*)" g ");"
  "if (flag_basilys_debug) debug_gimple_stmt(" g ");}while(0) "
)

(defprimitive debuggimpleseq(:cstring msg :gimpleseq g) :void
  " do{debugeprintf(\"debuggimpleseq %s @%p\", " msg ", (void*)" g ");"
  "if (flag_basilys_debug) debug_gimple_seq(" g ");}while(0) "
)

(defprimitive debugbasicblock(:cstring msg :basicblock bb) :void
  " do{debugeprintf(\"debugbasicblock %s @%p\", " msg ", (void*)" bb ");"
  "if (flag_basilys_debug) debug_bb(" bb ");}while(0) "
)

;; apply a function to every cfun -its decl & bodyseq
(defun do_each_cfun_body (f)
  (debug_msg f "do_each_cfun_body f")
  (each_cgraph_fun_body
   () 
   (:tree decl :gimpleseq bdy)
   (debugtree "do_each_cfun_body decl" decl)
   (debuggimpleseq "do_each_cfun_body bdy" bdy)
   (let ( (dclval (make_tree discr_tree decl)) 
	  (bdyval (make_gimpleseq discr_gimpleseq bdy))
	  )
     (debug_msg dclval "do_each_cfun_body inside dclval")
     (debug_msg bdyval "do_each_cfun_body inside bdyval")
     (f dclval bdyval)
     )))


;; apply a function to every cfun -its decl & basicblock
(defun do_each_cfun_entrybb (f)
  (debug_msg f "do_each_cfun_bb f")
  (each_cgraph_fun_entryblock
   () 
   (:tree decl :basicblock bb)
   (debugtree "do_each_cfun_entrybb decl" decl)
   (debugbasicblock "do_each_cfun_entrybb bdy" bb)
   (let ( (dclval (make_tree discr_tree decl)) 
	  (bbval (make_basicblock discr_basicblock bb))
	  )
     (debug_msg dclval "do_each_cfun_entrybb inside dclval")
     (debug_msg bbval "do_each_cfun_entrybb inside bbval")
     (f dclval bbval)
     )))

;;; apply a function to eevery basicblock in the current cfun
(defun do_each_bb_cfun (f)
  (debug_msg f "do_each_bb_cfun_start")
  (each_bb_cfun 
   ()
   (:basicblock cfbb :tree cfdecl)
   (let ( (cfbbval (make_basicblock discr_basicblock cfbb)) )
     (debug_msg cfbbval "do_each_bb_cfun cfbbval before")
     (debugtree "do_each_bb_cfun cfdecl" cfdecl)
     (f cfbbval cfdecl)
     ))
  (debug_msg f "do_each_bb_cfun end")
)



;;;;;;;;;;;;;;;;;;;;;;;;;;;; gimpleseq iteration
;;;; iterate on a gimpleseq
(defciterator each_in_gimpleseq
  (:gimpleseq gseq)			;start formals
  eachgimplseq
  (:gimple g)				;local formals
  ( ;;; before expansion
   "gimple_stmt_iterator gsi_" eachgimplseq ";\n"
   "if (" gseq ") for (gsi_" eachgimplseq " = gsi_start (" gseq
        "); !gsi_end_p (gsi_" eachgimplseq ");"
   " gsi_next (&gsi_" eachgimplseq ")) {\n"
    g " = gsi_stmt (gsi_" eachgimplseq ");"
   )
  ( ;;; after expansion
   "}"
   )
)

;;;; reverseiterate on a gimpleseq
(defciterator reveach_in_gimpleseq
  (:gimpleseq gseq)			;start formals
  eachgimplseq
  (:gimple g)				;local formals
  ( ;;; before expansion
   "gimple_stmt_iterator gsi_" eachgimplseq ";\n"
   "if (" gseq ") for (gsi_" eachgimplseq " = gsi_last (" gseq "); !gsi_end_p (gsi_" eachgimplseq ");"
   " gsi_prev (&gsi_" eachgimplseq ")) {\n"
    g " = gsi_stmt (gsi_" eachgimplseq ");"
   )
  ( ;;; after expansion
   "}"
   )
)

;; apply a function to each boxed gimple in a gimple seq
(defun do_each_gimpleseq (f :gimpleseq 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 :gimpleseq gseq)
  (reveach_in_gimpleseq 
   (gseq) (:gimple g)
   (let ( (gplval (make_gimple discr_gimple g)) )
     (f gplval)))
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;; basicblock iteration

(defciterator eachgimple_in_basicblock
  (:basicblock bb)			;start formals
  eachgimpbb
  (:gimple g)				;local formals
  ( ;;; before expansion
   "/* " eachgimpbb "*/ gimple_stmt_iterator gsi_" eachgimpbb ";\n"
   "if (" bb ") for (gsi_" eachgimpbb " = gsi_start_bb (" bb
        "); !gsi_end_p (gsi_" eachgimpbb ");"
   " gsi_next (&gsi_" eachgimpbb ")) {\n"
    g " = gsi_stmt (gsi_" eachgimpbb ");"
   )
  ( ;;; after expansion
   "} /* end " eachgimpbb "*/"
   )
)

(defun do_eachgimple_in_basicblock (f :basicblock bb)
  (eachgimple_in_basicblock 
   (bb) (:gimple g)
   (let ( (gplval (make_gimple discr_gimple g)) )
     (f gplval)))
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; our simple analysis gate for ipa
(defun simpana_ipagate (ipapass)
  (debug_msg ipapass "simpana_ipagate start")
  (debug_msg ipapass "simpana_ipagate end")
  (return ipapass)
)

;;; apparently only the entrybb loop matter in the ipa pass...
(defun simpana_ipaexec (ipapass)
  (debug_msg ipapass "simpana_ipaexec start")
  (debug_msg (unsafe_get_field :named_name ipapass) "simpana_ipaexec start name")
  (do_each_cfun_body 
   (lambda (declv bodyv)
     (debug_msg declv "simpana_ipaexec eachcfunbdy declv")
     (debug_msg bodyv "simpana_ipaexec eachcfunbdy bodyv")
     ))
  (debug_msg ipapass "simpana_ipaexec after eachbody before eachentrybb")
  (do_each_cfun_entrybb 
   (lambda (declv bbv)
     (debug_msg declv "simpana_ipaexec eachcfunentrybb declv")
     (debug_msg bbv "simpana_ipaexec eachcfunentrybb bbv")
     (let ( (:gimpleseq gs (basicblock_gimpleseq bbv))
	    (gsv (if gs (make_gimpleseq discr_gimpleseq gs)))
	    )
       (debug_msg gsv "simpana_ipaexec eachcfunentrybb gsv")
     )))
  (debug_msg (unsafe_get_field :named_name ipapass) "simpana_ipaexec end name")
  (debug_msg ipapass "simpana_ipaexec end")
)



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; our simple analysis gate for earlyopt
(defun simpana_earlyoptgate (earlyoptpass)
  (debug_msg earlyoptpass "simpana_earlyoptgate start")
  (debug_msg earlyoptpass "simpana_earlyoptgate end")
  (return earlyoptpass)
)

;;; apparently only the entrybb loop matter in the earlyopt pass...
(defun simpana_earlyoptexec (earlyoptpass)
  (debug_msg earlyoptpass "simpana_earlyoptexec start")
  (debug_msg (unsafe_get_field :named_name earlyoptpass) "simpana_earlyoptexec start name")
  (do_each_cfun_body 
   (lambda (declv bodyv)
     (debug_msg declv "simpana_earlyoptexec eachcfunbdy declv")
     (debug_msg bodyv "simpana_earlyoptexec eachcfunbdy bodyv")
     ))
  (debug_msg earlyoptpass "simpana_earlyoptexec after eachbody before eachentrybb")
  (do_each_cfun_entrybb 
   (lambda (declv bbv)
     (debug_msg declv "simpana_earlyoptexec eachcfunentrybb declv")
     (debug_msg bbv "simpana_earlyoptexec eachcfunentrybb bbv")
     ))
  (debug_msg (unsafe_get_field :named_name earlyoptpass) "simpana_earlyoptexec end name")
  (debug_msg earlyoptpass "simpana_earlyoptexec end")
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; our simple analysis gate for latessa
(defun simpana_latessagate (latessapass)
  (debug_msg latessapass "simpana_latessagate start")
  (debug_msg latessapass "simpana_latessagate end")
  (return latessapass)
)

;;; apparently only the entrybb loop matter in the latessa pass...
(defun simpana_latessaexec (latessapass)
  (debug_msg latessapass "simpana_latessaexec start")
  (debug_msg (unsafe_get_field :named_name latessapass) "simpana_latessaexec start name")
  (do_each_cfun_body 
   (lambda (declv bodyv)
     (debug_msg declv "simpana_latessaexec eachcfunbdy declv")
     (debug_msg bodyv "simpana_latessaexec eachcfunbdy bodyv")
     ))
  (debug_msg latessapass "simpana_latessaexec after eachbody before eachentrybb")
  (do_each_cfun_entrybb 
   (lambda (declv bbv)
     (debug_msg declv "simpana_latessaexec eachcfunentrybb declv")
     (debug_msg bbv "simpana_latessaexec eachcfunentrybb bbv")
     (let ( (:gimpleseq gs (basicblock_gimpleseq bbv))
	    (gsv (if gs (make_gimpleseq discr_gimpleseq gs))) 
	    (:gimpleseq phis (basicblock_phinodes bbv))
	    (phisv (if phis (make_gimpleseq discr_gimpleseq phis)))
	    )
       (debug_msg gsv "simpana_latessaexec eachcfunentrybb gsv")
       (debug_msg phisv "simpana_latessaexec eachcfunentrybb phisv")
       ))) 
  (debug_msg latessapass "simpana_latessaexec after eachentrybb before eachbbcfun")
  (do_each_bb_cfun
   (lambda (cfbbv :tree cfdecl)
     (debug_msg cfbbv "simpana_latessaexec eachbbcfun cfbbv")
     (let ( (:gimpleseq bbseq
			(basicblock_gimpleseq cfbbv))
	    (:gimpleseq bbphis (basicblock_phinodes cfbbv))
	    )
       (debuggimpleseq "simpana_latessaexec bbseq" bbseq)
       (do_each_gimpleseq
	(lambda (gimv)
	  (debug_msg gimv "simpana_latessaexec gimv"))
	bbseq
	)
       (debuggimpleseq "simpana_latessaexec bbphis" bbphis)
       (do_each_gimpleseq
	(lambda (gphiv)
	  (debug_msg gphiv "simpana_latessaexec gimv"))
	bbphis
	)
       (do_eachgimple_in_basicblock
	(lambda (gbbv)
	  (debug_msg gbbv "simpana_latessaexec gbbv"))
	(basicblock_content cfbbv))
       )))
  (debug_msg (unsafe_get_field :named_name latessapass) "simpana_latessaexec end name")
  (debug_msg latessapass "simpana_latessaexec end")
  )




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; our simple analysis command -fbasilys=simpana
(defun simpana_command (dispatcher arg secarg moduldata)
  ;(debug_msg moduldata "simpana moduldata")
  ;; fill the earlyopt pass
  (unsafe_put_fields basilys_earlyopt_gccpass
  :gccpass_gate simpana_earlyoptgate
  :gccpass_exec simpana_earlyoptexec)
  (debug_msg basilys_earlyopt_gccpass "simpana sets basilys_earlyopt_gccpass")
  ;; fill the ipa pass
  (unsafe_put_fields basilys_ipa_gccpass
  :gccpass_gate simpana_ipagate
  :gccpass_exec simpana_ipaexec)
  (debug_msg basilys_ipa_gccpass "simpana sets basilys_ipa_gccpass")
  ;; fill the latessa pass
  (unsafe_put_fields basilys_latessa_gccpass
  :gccpass_gate simpana_latessagate
  :gccpass_exec simpana_latessaexec)
  (debug_msg basilys_latessa_gccpass "simpana sets basilys_latessa_gccpass")
  (return dispatcher)			;return non-nil to continue compilation
  )

(install_initial_command 
 (stringconst2val discr_string "simpana") simpana_command)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(export_values
 basilys_earlyopt_gccpass
 basilys_ipa_gccpass
 basilys_lateopt_gccpass
 basilys_latessa_gccpass
 basilys_lowering_gccpass
 each_cgraph_fun_body
 each_cgraph_fun_entryblock
 each_in_gimpleseq
 fetch_gdbmstate
 fetch_gdbmstate_constr
 install_gcc_pass
 put_gdbmstate
 put_gdbmstate_constr
 reveach_in_gimpleseq
)

(export_class
 class_analysis_state
)
;; eof ana-base.bysl