From a5f03d96eee482cd84861fc8cefff9eb451c0cad Mon Sep 17 00:00:00 2001
From: xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e>
Date: Sun, 29 Mar 2009 09:47:11 +0000
Subject: Cleaned up configure script. Distribution of CIL as an expanded
 source tree with changes applied (instead of original .tar.gz + patches to be
 applied at config time).

git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1020 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
---
 cil/src/ext/liveness.ml | 190 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 190 insertions(+)
 create mode 100644 cil/src/ext/liveness.ml

(limited to 'cil/src/ext/liveness.ml')

diff --git a/cil/src/ext/liveness.ml b/cil/src/ext/liveness.ml
new file mode 100644
index 00000000..72cd6073
--- /dev/null
+++ b/cil/src/ext/liveness.ml
@@ -0,0 +1,190 @@
+
+(* Calculate which variables are live at
+ * each statememnt.
+ *
+ *
+ *
+ *)
+
+open Cil
+open Pretty
+
+module DF = Dataflow
+module UD = Usedef
+module IH = Inthash
+module E = Errormsg
+
+let debug = ref false
+
+let live_label = ref ""
+let live_func = ref ""
+
+module VS = UD.VS
+
+let debug_print () vs = (VS.fold
+    (fun vi d -> 
+      d ++ text "name: " ++ text vi.vname
+	++ text " id: " ++ num vi.vid ++ text " ")
+    vs nil) ++ line
+
+let min_print () vs = (VS.fold
+    (fun vi d ->
+      d ++ text vi.vname
+	++ text "(" ++ d_type () vi.vtype ++ text ")"
+	++ text ",")
+    vs nil) ++ line
+
+let printer = ref debug_print
+
+module LiveFlow = struct
+  let name = "Liveness"
+  let debug = debug
+  type t = VS.t
+
+  let pretty () vs =
+    let fn = !printer in
+    fn () vs
+    
+  let stmtStartData = IH.create 32
+
+  let combineStmtStartData (stm:stmt) ~(old:t) (now:t) =
+    if not(VS.compare old now = 0)
+    then Some(VS.union old now)
+    else None
+
+  let combineSuccessors = VS.union
+
+  let doStmt stmt =
+    if !debug then ignore(E.log "looking at: %a\n" d_stmt stmt);
+    match stmt.succs with
+      [] -> let u,d = UD.computeUseDefStmtKind stmt.skind in
+      if !debug then ignore(E.log "doStmt: no succs %d\n" stmt.sid);
+      DF.Done u
+    | _ ->
+	let handle_stm vs = match stmt.skind with
+	  Instr _ -> vs
+	| s -> let u, d = UD.computeUseDefStmtKind s in
+	  VS.union u (VS.diff vs d)
+	in
+	DF.Post handle_stm
+
+  let doInstr i vs =
+    let transform vs' =
+      let u,d = UD.computeUseDefInstr i in
+      VS.union u (VS.diff vs' d)
+    in
+    DF.Post transform
+
+  let filterStmt stm1 stm2 = true
+
+end
+
+module L = DF.BackwardsDataFlow(LiveFlow)
+
+let sink_stmts = ref []
+class sinkFinderClass = object(self)
+  inherit nopCilVisitor
+
+  method vstmt s = match s.succs with
+    [] -> (sink_stmts := s :: (!sink_stmts);
+	   DoChildren)
+  | _ -> DoChildren
+
+end
+
+(* gives list of return statements from a function *)
+(* fundec -> stm list *)
+let find_sinks fdec =
+  sink_stmts := [];
+  ignore(visitCilFunction (new sinkFinderClass) fdec);
+  !sink_stmts
+
+(* XXX: This does not compute the best ordering to
+ * give to the work-list algorithm.
+ *)
+let all_stmts = ref []
+class nullAdderClass = object(self)
+  inherit nopCilVisitor
+
+  method vstmt s =
+    all_stmts := s :: (!all_stmts);
+    IH.add LiveFlow.stmtStartData s.sid VS.empty;
+    DoChildren
+
+end
+
+let null_adder fdec =
+  ignore(visitCilFunction (new nullAdderClass) fdec);
+  !all_stmts
+
+let computeLiveness fdec =
+  IH.clear LiveFlow.stmtStartData;
+  UD.onlyNoOffsetsAreDefs := false;
+  all_stmts := [];
+  let a = null_adder fdec in
+  L.compute a
+
+let print_everything () =
+  let d = IH.fold (fun i vs d -> 
+    d ++ num i ++ text ": " ++ LiveFlow.pretty () vs) 
+      LiveFlow.stmtStartData nil in
+  ignore(printf "%t" (fun () -> d))
+
+let match_label lbl = match lbl with
+  Label(str,_,b) ->
+    if !debug then ignore(E.log "Liveness: label seen: %s\n" str);
+    (*b && *)(String.compare str (!live_label) = 0)
+| _ -> false
+
+class doFeatureClass = object(self)
+  inherit nopCilVisitor
+
+  method vfunc fd =
+    if String.compare fd.svar.vname (!live_func) = 0 then 
+      (Cfg.clearCFGinfo fd;
+       ignore(Cfg.cfgFun fd);
+       computeLiveness fd;
+       if String.compare (!live_label) "" = 0 then
+	 (printer := min_print;
+	  print_everything();
+	  SkipChildren)
+       else DoChildren)
+    else SkipChildren
+
+  method vstmt s =
+    if List.exists match_label s.labels then try
+      let vs = IH.find LiveFlow.stmtStartData s.sid in
+      (printer := min_print;
+       ignore(printf "%a" LiveFlow.pretty vs);
+       SkipChildren)
+    with Not_found -> 
+      if !debug then ignore(E.log "Liveness: stmt: %d not found\n" s.sid);
+      DoChildren
+    else 
+      (if List.length s.labels = 0 then
+	if !debug then ignore(E.log "Liveness: no label at sid=%d\n" s.sid);
+      DoChildren)
+
+end
+
+let do_live_feature (f:file) =
+  visitCilFile (new doFeatureClass) f
+
+let feature =
+  {
+   fd_name = "Liveness";
+   fd_enabled = ref false;
+   fd_description = "Spit out live variables at a label";
+   fd_extraopt = [
+   "--live_label",
+   Arg.String (fun s -> live_label := s),
+   "Output the variables live at this label";
+   "--live_func",
+   Arg.String (fun s -> live_func := s),
+   "Output the variables live at each statement in this function.";
+   "--live_debug",
+   Arg.Unit (fun n -> debug := true),
+   "Print lots of debugging info";];
+   fd_doit = do_live_feature;
+   fd_post_check = false
+ }
-- 
cgit