tools/alloc_free.ml

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