Hi,
src/ext/cfg.ml changed several times in the past few years. A bug-report
used to notice that some global variables didn't make sense anymore and
that the documentation was not updated. This bug has been fixed in 1.3.7
(and cfg.mli updated) but the global variables are still there, making
the code harder to understand than necessary (IMHO).
Anyway, I had to change it for my own needs, so here is my patch if
anybody is interrested. Basically, it removes the obsolete numNodes and
nodeList global variables, uses start_id instead of the former and
creates the latter dynamically in cfgFun.
Regards,
--
Gabriel Kerneis
diff -rN -u old-cil-patched/src/ext/cfg.ml new-cil-patched/src/ext/cfg.ml
--- old-cil-patched/src/ext/cfg.ml 2009-06-02 15:13:01.000000000 +0200
+++ new-cil-patched/src/ext/cfg.ml 2009-06-02 15:13:01.000000000 +0200
@@ -69,13 +69,7 @@
None means the succ is the function return. It does not mean the break/cont
is invalid. We assume the validity has already been checked.
*)
-(* At the end of CFG computation,
- - numNodes = total number of CFG nodes
- - length(nodeList) = numNodes
-*)
-let numNodes = ref 0 (* number of nodes in the CFG *)
-let nodeList : stmt list ref = ref [] (* All the nodes in a flat list *) (* ab: Added to change dfs from quadratic to linear *)
let start_id = ref 0 (* for unique ids across many functions *)
class caseLabeledStmtFinder slr = object(self)
@@ -107,39 +101,41 @@
filled in *)
let rec cfgFun (fd : fundec): int =
begin
- numNodes := !start_id;
- nodeList := [];
+ let initial_id = !start_id in
+ let nodeList = ref [] in
- cfgBlock fd.sbody None None None;
+ cfgBlock fd.sbody None None None nodeList;
- fd.smaxstmtid <- Some(!numNodes);
+ fd.smaxstmtid <- Some(!start_id);
fd.sallstmts <- List.rev !nodeList;
- nodeList := [];
- !numNodes - !start_id
+ !start_id - initial_id
end
and cfgStmts (ss: stmt list)
- (next:stmt option) (break:stmt option) (cont:stmt option) =
+ (next:stmt option) (break:stmt option) (cont:stmt option)
+ (nodeList:stmt list ref) =
match ss with
[] -> ();
- | [s] -> cfgStmt s next break cont
+ | [s] -> cfgStmt s next break cont nodeList
| hd::tl ->
- cfgStmt hd (Some (List.hd tl)) break cont;
- cfgStmts tl next break cont
+ cfgStmt hd (Some (List.hd tl)) break cont nodeList;
+ cfgStmts tl next break cont nodeList
and cfgBlock (blk: block)
- (next:stmt option) (break:stmt option) (cont:stmt option) =
- cfgStmts blk.bstmts next break cont
+ (next:stmt option) (break:stmt option) (cont:stmt option)
+ (nodeList:stmt list ref) =
+ cfgStmts blk.bstmts next break cont nodeList
(* Fill in the CFG info for a stmt
Meaning of next, break, cont should be clear from earlier comment
*)
-and cfgStmt (s: stmt) (next:stmt option) (break:stmt option) (cont:stmt option) =
- incr numNodes;
- s.sid <- !numNodes;
+and cfgStmt (s: stmt) (next:stmt option) (break:stmt option) (cont:stmt option)
+ (nodeList:stmt list ref) =
+ incr start_id;
+ s.sid <- !start_id;
nodeList := s :: !nodeList; (* Future traversals can be made in linear time. e.g. *)
if s.succs <> [] then
E.s (bug "CFG must be cleared before being computed!");
@@ -183,11 +179,11 @@
(* The succs of If is [true branch;false branch] *)
addBlockSucc blk2 next;
addBlockSucc blk1 next;
- cfgBlock blk1 next break cont;
- cfgBlock blk2 next break cont
+ cfgBlock blk1 next break cont nodeList;
+ cfgBlock blk2 next break cont nodeList
| Block b ->
addBlockSucc b next;
- cfgBlock b next break cont
+ cfgBlock b next break cont nodeList
| Switch(_,blk,l,_) ->
let bl = findCaseLabeledStmts blk in
List.iter addSucc (List.rev bl(*l*)); (* Add successors in order *)
@@ -199,11 +195,11 @@
bl)
then
addOptionSucc next;
- cfgBlock blk next next cont
+ cfgBlock blk next next cont nodeList
| Loop(blk, loc, s1, s2) ->
s.skind <- Loop(blk, loc, (Some s), next);
addBlockSucc blk (Some s);
- cfgBlock blk (Some s) next (Some s)
+ cfgBlock blk (Some s) next (Some s) nodeList
(* Since all loops have terminating condition true, we don't put
any direct successor to stmt following the loop *)
| TryExcept _ | TryFinally _ ->
@@ -305,7 +301,7 @@
forallStmts clear fd
let clearFileCFG (f : file) =
- start_id := 0; numNodes := 0;
+ start_id := 0;
iterGlobals f (fun g ->
match g with GFun(fd,_) ->
clearCFGinfo fd
@@ -314,8 +310,7 @@
let computeFileCFG (f : file) =
iterGlobals f (fun g ->
match g with GFun(fd,_) ->
- numNodes := cfgFun fd;
- start_id := !start_id + !numNodes
+ ignore(cfgFun fd)
| _ -> ())
let allStmts (f : file) : stmt list =
------------------------------------------------------------------------------
OpenSolaris 2009.06 is a cutting edge operating system for enterprises
looking to deploy the next generation of Solaris that includes the latest
innovations from Sun and the OpenSource community. Download a copy and
enjoy capabilities such as Networking, Storage and Virtualization.
Go to: http://p.sf.net/sfu/opensolaris-get
_______________________________________________
CIL-users mailing list
CIL-users@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/cil-users
