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 (* The following finds out for each file, how it does deallocation for each
  26 allocator *)
  27
  28 let collect i =
  29   let info = ref [] in
  30   let rec loop _ =
  31     let l = input_line i in
  32     (if String.length l > 2 && String.get l 0 = '+'
  33     then info := (String.sub l 1 (String.length l - 1))::!info);
  34     loop() in
  35   try loop()
  36   with End_of_file -> List.rev !info
  37
  38 let split l =
  39   let rec loop acc = function
  40     [] -> acc
  41   | x::xs ->
  42       if String.get x 0 = '+' (* the start of a new file *)
  43       then
  44         (match Str.split (Str.regexp " ") x with
  45           _::x::_ -> loop ((x,[])::acc) xs
  46         | _ -> failwith ("no file: "^x))
  47       else
  48         let acc =
  49           match acc with
  50             (file,instances)::rest -> (file,x::instances)::rest
  51           | _ -> failwith "not possible" in
  52         loop acc xs in
  53   let res = List.rev (loop [] l) in
  54   List.map (function (x,l) -> (x,List.rev l)) res
  55
  56 let detect_alloc_free str l =
  57   let try_add a f l =
  58     let (same,diff) = List.partition (function (a1,f1) -> a = a1) l in
  59     match same with
  60       [(a1,f1)] -> if List.mem f f1 then l else (a1,f::f1) :: diff
  61     | _ -> (a,[f])::l in
  62   let rec loop acc = function
  63       [] -> acc
  64     | x::xs ->
  65         match Str.split (Str.regexp (str^"\", ")) x with
  66           _::matches ->
  67             let acc =
  68               List.fold_left
  69                 (function acc ->
  70                   function rest ->
  71                     (match Str.split (Str.regexp "[, )]+") rest with
  72                       alloc::free::_ -> try_add alloc free acc
  73                     | _ -> acc))
  74                 acc matches in
  75             loop acc xs
  76         | _ -> loop acc xs in
  77   List.sort compare
  78     (List.map (function (a,f) -> (a,List.sort compare f)) (loop [] l))
  79
  80 let rec iterate str = function
  81     [] -> []
  82   | (x,l)::xs ->
  83       List.fold_left
  84         (function rest ->
  85           function info ->
  86             let (same,diff) =
  87               List.partition (function (x1,l1) -> l1 = info) rest in
  88             match same with
  89               [(files,info)] -> (x::files,info)::diff
  90             |   _ -> ([x],info)::diff)
  91         (iterate str xs) (detect_alloc_free str l)
  92
  93 (* ------------------------------------------------------------------------ *)
  94 (* The following prints that information *)
  95
  96 let print_output l =
  97   List.iter
  98     (function (files,(a,fs)) ->
  99       List.iter (function x -> Printf.printf "%s\n" x) files;
 100       Printf.printf "   alloc: %s, free: %s\n" a (String.concat ", " fs);
 101       Printf.printf "\n")
 102     l
 103
 104 (* ------------------------------------------------------------------------ *)
 105 (* The following makes a semantic patch for that information *)
 106
 107 let sedify o generic_file dir l =
 108   List.iter
 109     (function (files,(a,fs)) ->
 110       match fs with
 111         [f] ->
 112           let _ =
 113             Sys.command
 114               (Printf.sprintf
 115                  "sed s/ALLOC/%s/ %s | sed s/FREE/%s/ > %s/%s-%s.cocci\n"
 116                  a generic_file f dir a f) in ()
 117       | _ -> ())
 118     l;
 119   List.iter
 120     (function (files,(a,fs)) ->
 121       match fs with
 122         [f] -> Printf.fprintf o "mono_spatch_linux %s-%s.cocci &\n" a f
 123       | _ -> ())
 124     l
 125
 126 let collect_allocs l =
 127   let union =
 128     List.fold_left
 129       (function rest -> function x ->
 130         if List.mem x rest then rest else x::rest) in
 131   List.fold_left
 132     (function rest ->
 133       function (files,(a,fs)) ->
 134         let (same,diff) =
 135           List.partition (function (a1,fs1) -> a = a1) rest in
 136         match same with
 137           [(a1,fs1)] -> (a,union fs fs1)::diff
 138         | [] -> (a,fs)::rest
 139         | _ -> failwith "not possible")
 140     [] l
 141
 142 let sedify_ors o generic_file dir l =
 143   let l = collect_allocs l in
 144   List.iter
 145     (function (a,fs) ->
 146       match fs with
 147         [_] | [] -> ()
 148       | (f::_) ->
 149           let sfs =
 150             Printf.sprintf "\"\\\\\\(%s\\\\\\)\""
 151               (String.concat "\\\\\\|" fs) in
 152           let _ =
 153             Sys.command
 154               (Printf.sprintf
 155                  "sed s/ALLOC/%s/ %s | sed s/FREE/%s/ > %s/%s-%s_et_al.cocci\n"
 156                  a generic_file sfs dir a f) in ())
 157     l;
 158   List.iter
 159     (function (a,fs) ->
 160       match fs with
 161         [_] | [] -> ()
 162       | (f::_) ->
 163           Printf.fprintf o "mono_spatch_linux %s-%s_et_al.cocci &\n" a f)
 164     l
 165
 166 (* ------------------------------------------------------------------------ *)
 167
 168 let sed = ref false
 169 let gen = ref "generic2.cocci"
 170 let dir = ref "p2"
 171 let file = ref ""
 172 let str = ref "detected allocator"
 173
 174 let options = [ "-sed", Arg.Set sed, "sed output";
 175                 "-sp", Arg.String (function x -> gen := x),
 176                 "detection string";
 177                 "-str", Arg.String (function x -> str := x),
 178                 "cocci file for use with sed";
 179                 "-dir", Arg.String (function x -> dir := x),
 180                 "dir for sed output"; ]
 181 let usage = ""
 182
 183 let _ =
 184   Arg.parse (Arg.align options) (fun x -> file := x) usage;
 185   let i = open_in !file in
 186   let l = collect i in
 187   close_in i;
 188   let l = split l in
 189   let l = iterate !str l in
 190   (if !sed
 191   then
 192     begin
 193       let o = open_out (Printf.sprintf "%s/files" !dir) in
 194       Printf.fprintf o "#!/bin/sh\n\n";
 195       sedify o !gen !dir l;
 196       sedify_ors o !gen !dir l;
 197       Printf.fprintf o "\nwait\n/bin/rm tmp*out\n";
 198       close_out o
 199     end);
 200   if not !sed then print_output l