tools/alloc_free.ml

   1 (*
   2  * Copyright 2012, INRIA
   3  * Julia Lawall, Gilles Muller
   4  * Copyright 2010-2011, INRIA, University of Copenhagen
   5  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   6  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   7  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   8  * This file is part of Coccinelle.
   9  *
  10  * Coccinelle is free software: you can redistribute it and/or modify
  11  * it under the terms of the GNU General Public License as published by
  12  * the Free Software Foundation, according to version 2 of the License.
  13  *
  14  * Coccinelle is distributed in the hope that it will be useful,
  15  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  16  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17  * GNU General Public License for more details.
  18  *
  19  * You should have received a copy of the GNU General Public License
  20  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  21  *
  22  * The authors reserve the right to distribute this or future versions of
  23  * Coccinelle under other licenses.
  24  *)
  25
  26
  27 # 0 "./alloc_free.ml"
  28 (*
  29  * Copyright 2012, INRIA
  30  * Julia Lawall, Gilles Muller
  31  * Copyright 2010-2011, INRIA, University of Copenhagen
  32  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
  33  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
  34  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
  35  * This file is part of Coccinelle.
  36  *
  37  * Coccinelle is free software: you can redistribute it and/or modify
  38  * it under the terms of the GNU General Public License as published by
  39  * the Free Software Foundation, according to version 2 of the License.
  40  *
  41  * Coccinelle is distributed in the hope that it will be useful,
  42  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  43  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  44  * GNU General Public License for more details.
  45  *
  46  * You should have received a copy of the GNU General Public License
  47  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  48  *
  49  * The authors reserve the right to distribute this or future versions of
  50  * Coccinelle under other licenses.
  51  *)
  52
  53
  54 # 0 "./alloc_free.ml"
  55 (* The following finds out for each file, how it does deallocation for each
  56 allocator *)
  57
  58 let collect i =
  59   let info = ref [] in
  60   let rec loop _ =
  61     let l = input_line i in
  62     (if String.length l > 2 && String.get l 0 = '+'
  63     then info := (String.sub l 1 (String.length l - 1))::!info);
  64     loop() in
  65   try loop()
  66   with End_of_file -> List.rev !info
  67
  68 let split l =
  69   let rec loop acc = function
  70     [] -> acc
  71   | x::xs ->
  72       if String.get x 0 = '+' (* the start of a new file *)
  73       then
  74         (match Str.split (Str.regexp " ") x with
  75           _::x::_ -> loop ((x,[])::acc) xs
  76         | _ -> failwith ("no file: "^x))
  77       else
  78         let acc =
  79           match acc with
  80             (file,instances)::rest -> (file,x::instances)::rest
  81           | _ -> failwith "not possible" in
  82         loop acc xs in
  83   let res = List.rev (loop [] l) in
  84   List.map (function (x,l) -> (x,List.rev l)) res
  85
  86 let detect_alloc_free str l =
  87   let try_add a f l =
  88     let (same,diff) = List.partition (function (a1,f1) -> a = a1) l in
  89     match same with
  90       [(a1,f1)] -> if List.mem f f1 then l else (a1,f::f1) :: diff
  91     | _ -> (a,[f])::l in
  92   let rec loop acc = function
  93       [] -> acc
  94     | x::xs ->
  95         match Str.split (Str.regexp (str^"\", ")) x with
  96           _::matches ->
  97             let acc =
  98               List.fold_left
  99                 (function acc ->
 100                   function rest ->
 101                     (match Str.split (Str.regexp "[, )]+") rest with
 102                       alloc::free::_ -> try_add alloc free acc
 103                     | _ -> acc))
 104                 acc matches in
 105             loop acc xs
 106         | _ -> loop acc xs in
 107   List.sort compare
 108     (List.map (function (a,f) -> (a,List.sort compare f)) (loop [] l))
 109
 110 let rec iterate str = function
 111     [] -> []
 112   | (x,l)::xs ->
 113       List.fold_left
 114         (function rest ->
 115           function info ->
 116             let (same,diff) =
 117               List.partition (function (x1,l1) -> l1 = info) rest in
 118             match same with
 119               [(files,info)] -> (x::files,info)::diff
 120             |   _ -> ([x],info)::diff)
 121         (iterate str xs) (detect_alloc_free str l)
 122
 123 (* ------------------------------------------------------------------------ *)
 124 (* The following prints that information *)
 125
 126 let print_output l =
 127   List.iter
 128     (function (files,(a,fs)) ->
 129       List.iter (function x -> Printf.printf "%s\n" x) files;
 130       Printf.printf "   alloc: %s, free: %s\n" a (String.concat ", " fs);
 131       Printf.printf "\n")
 132     l
 133
 134 (* ------------------------------------------------------------------------ *)
 135 (* The following makes a semantic patch for that information *)
 136
 137 let sedify o generic_file dir l =
 138   List.iter
 139     (function (files,(a,fs)) ->
 140       match fs with
 141         [f] ->
 142           let _ =
 143             Sys.command
 144               (Printf.sprintf
 145                  "sed s/ALLOC/%s/ %s | sed s/FREE/%s/ > %s/%s-%s.cocci\n"
 146                  a generic_file f dir a f) in ()
 147       | _ -> ())
 148     l;
 149   List.iter
 150     (function (files,(a,fs)) ->
 151       match fs with
 152         [f] -> Printf.fprintf o "mono_spatch_linux %s-%s.cocci &\n" a f
 153       | _ -> ())
 154     l
 155
 156 let collect_allocs l =
 157   let union =
 158     List.fold_left
 159       (function rest -> function x ->
 160         if List.mem x rest then rest else x::rest) in
 161   List.fold_left
 162     (function rest ->
 163       function (files,(a,fs)) ->
 164         let (same,diff) =
 165           List.partition (function (a1,fs1) -> a = a1) rest in
 166         match same with
 167           [(a1,fs1)] -> (a,union fs fs1)::diff
 168         | [] -> (a,fs)::rest
 169         | _ -> failwith "not possible")
 170     [] l
 171
 172 let sedify_ors o generic_file dir l =
 173   let l = collect_allocs l in
 174   List.iter
 175     (function (a,fs) ->
 176       match fs with
 177         [_] | [] -> ()
 178       | (f::_) ->
 179           let sfs =
 180             Printf.sprintf "\"\\\\\\(%s\\\\\\)\""
 181               (String.concat "\\\\\\|" fs) in
 182           let _ =
 183             Sys.command
 184               (Printf.sprintf
 185                  "sed s/ALLOC/%s/ %s | sed s/FREE/%s/ > %s/%s-%s_et_al.cocci\n"
 186                  a generic_file sfs dir a f) in ())
 187     l;
 188   List.iter
 189     (function (a,fs) ->
 190       match fs with
 191         [_] | [] -> ()
 192       | (f::_) ->
 193           Printf.fprintf o "mono_spatch_linux %s-%s_et_al.cocci &\n" a f)
 194     l
 195
 196 (* ------------------------------------------------------------------------ *)
 197
 198 let sed = ref false
 199 let gen = ref "generic2.cocci"
 200 let dir = ref "p2"
 201 let file = ref ""
 202 let str = ref "detected allocator"
 203
 204 let options = [ "-sed", Arg.Set sed, "sed output";
 205                 "-sp", Arg.String (function x -> gen := x),
 206                 "detection string";
 207                 "-str", Arg.String (function x -> str := x),
 208                 "cocci file for use with sed";
 209                 "-dir", Arg.String (function x -> dir := x),
 210                 "dir for sed output"; ]
 211 let usage = ""
 212
 213 let _ =
 214   Arg.parse (Arg.align options) (fun x -> file := x) usage;
 215   let i = open_in !file in
 216   let l = collect i in
 217   close_in i;
 218   let l = split l in
 219   let l = iterate !str l in
 220   (if !sed
 221   then
 222     begin
 223       let o = open_out (Printf.sprintf "%s/files" !dir) in
 224       Printf.fprintf o "#! /bin/sh\n\n";
 225       sedify o !gen !dir l;
 226       sedify_ors o !gen !dir l;
 227       Printf.fprintf o "\nwait\n/bin/rm tmp*out\n";
 228       close_out o
 229     end);
 230   if not !sed then print_output l