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