extract/codegen/minimizer.ml

   1 (* Memory info command for virtual domains.
   2    (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
   3    http://libvirt.org/
   4
   5    This program is free software; you can redistribute it and/or modify
   6    it under the terms of the GNU General Public License as published by
   7    the Free Software Foundation; either version 2 of the License, or
   8    (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful,
  11    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13    GNU General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18  *)
  19
  20 open ExtList
  21 open ExtString
  22
  23 open Printf
  24
  25 module PP = Pahole_parser
  26
  27 type parser_ = {
  28   pa_i : int;
  29   pa_name : string;
  30   pa_endian : Bitstring.endian;
  31   pa_structure : Pahole_parser.structure;
  32 }
  33
  34 and pahash = (string, parser_) Hashtbl.t
  35
  36 let endian_of_architecture arch =
  37   if String.starts_with arch "i386" ||
  38     String.starts_with arch "i486" ||
  39     String.starts_with arch "i586" ||
  40     String.starts_with arch "i686" ||
  41     String.starts_with arch "x86_64" ||
  42     String.starts_with arch "x86-64" then
  43       Bitstring.LittleEndian
  44   else if String.starts_with arch "ia64" then
  45     Bitstring.LittleEndian (* XXX usually? *)
  46   else if String.starts_with arch "ppc" then
  47     Bitstring.BigEndian
  48   else if String.starts_with arch "sparc" then
  49     Bitstring.BigEndian
  50   else
  51     failwith (sprintf "endian_of_architecture: cannot parse %S" arch)
  52
  53 let unique =
  54   let i = ref 0 in
  55   fun () ->
  56     incr i; !i
  57
  58 let hash_values h = Hashtbl.fold (fun _ v vs -> v :: vs) h []
  59
  60 let minimize_parsers struct_name kernels =
  61   let h = Hashtbl.create 13 in
  62   let rh = Hashtbl.create 13 in
  63
  64   (* Do not change - see Code_generation.re_subst. *)
  65   let name_of i = sprintf "%s_parser_%d" struct_name i in
  66
  67   List.iter (
  68     fun ({ PP.kernel_version = version; arch = arch },
  69          ({ PP.struct_fields = fields; struct_name = name_check }
  70             as structure)) ->
  71       assert (struct_name = name_check);
  72       let endian = endian_of_architecture arch in
  73       let key = endian, fields in
  74       let pa =
  75         try Hashtbl.find h key
  76         with Not_found ->
  77           let i = unique () in
  78           let pa = { pa_i = i; pa_name = name_of i;
  79                      pa_endian = endian;
  80                      pa_structure = structure } in
  81           Hashtbl.add h key pa;
  82           pa in
  83       Hashtbl.add rh version pa
  84   ) kernels;
  85
  86   let pas = hash_values h in
  87   pas, rh