+++ /dev/null
-(* Memory info for virtual domains.
- (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
- http://libvirt.org/
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-*)
-
-(* This program takes the kernel database (in kernels/ in toplevel
- directory) and generates parsing code for the various structures
- in the kernel that we are interested in.
-
- The output programs -- *.ml, *.mli files of generated code -- go
- into lib/ at the toplevel, eg. lib/kernel_task_struct.ml
-
- The stuff at the top of this file determine what structures
- and fields we try to parse.
-*)
-
-type struct_t = {
- opener : string; (* String in pa_hole file which starts this struct. *)
- closer : string; (* String in pa_hole file which ends this struct. *)
- mandatory_struct : bool; (* Is this struct mandatory? *)
- fields : (string * field_t) list; (* List of interesting fields. *)
-}
-and field_t = {
- mandatory_field : bool; (* Is this field mandatory? *)
- list_head_adjustment : bool; (* Only applies if the field points to a
- * struct list_head: If true, then we do the
- * list_head adjustment, so the field points
- * to the start of the structure. If false,
- * leave the pointer intact. The list_head
- * adjustment only works if the list_head
- * is in the same type of structure.
- *)
-}
-
-let ordinary_field = { mandatory_field = true; list_head_adjustment = true; }
-
-(*----------------------------------------------------------------------
- * This controls what structures & fields we will parse out.
- *----------------------------------------------------------------------*)
-let structs = [
- "task_struct", {
- opener = "struct task_struct {"; closer = "};"; mandatory_struct = true;
- fields = [
- "state", ordinary_field;
- "prio", ordinary_field;
- "normal_prio", ordinary_field;
- "static_prio", ordinary_field;
- "tasks'prev", ordinary_field;
- "tasks'next", ordinary_field;
- "mm", ordinary_field;
- "active_mm", ordinary_field;
- "comm", ordinary_field;
- "pid", ordinary_field;
- ]
- };
-(*
- "mm_struct", (
- "struct mm_struct {", "};", true,
- [ ]
- );
-*)
- "net_device", {
- opener = "struct net_device {"; closer = "};"; mandatory_struct = true;
- fields = [
- "dev_list'prev", { mandatory_field = false; list_head_adjustment = true };
- "dev_list'next", { mandatory_field = false; list_head_adjustment = true };
- "next", { mandatory_field = false; list_head_adjustment = true };
- "name", ordinary_field;
- "flags", ordinary_field;
- "operstate", ordinary_field;
- "mtu", ordinary_field;
- "perm_addr", ordinary_field;
- "addr_len", ordinary_field;
- "ip_ptr", ordinary_field;
- "ip6_ptr", ordinary_field;
- ]
- };
- "net", {
- opener = "struct net {"; closer = "};"; mandatory_struct = false;
- fields = [
- "dev_base_head'next",
- (* Don't do list_head adjustment on this field, because it points
- * to a net_device struct.
- *)
- { mandatory_field = true; list_head_adjustment = false };
- ]
- };
- "in_device", {
- opener = "struct in_device {"; closer = "};"; mandatory_struct = true;
- fields = [
- "ifa_list", ordinary_field;
- ];
- };
- "inet6_dev", {
- opener = "struct inet6_dev {"; closer = "};"; mandatory_struct = true;
- fields = [
- "addr_list", ordinary_field;
- ];
- };
- "in_ifaddr", {
- opener = "struct in_ifaddr {"; closer = "};"; mandatory_struct = true;
- fields = [
- "ifa_next", ordinary_field;
- "ifa_local", ordinary_field;
- "ifa_address", ordinary_field;
- "ifa_mask", ordinary_field;
- "ifa_broadcast", ordinary_field;
- ];
- };
- "inet6_ifaddr", {
- opener = "struct inet6_ifaddr {"; closer = "};"; mandatory_struct = true;
- fields = [
- (*"addr'in6_u'u6_addr8", ordinary_field;*)
- "prefix_len", ordinary_field;
- "lst_next", ordinary_field;
- ];
- };
-]
-
-let debug = true
-
-open Camlp4.PreCast
-open Syntax
-(*open Ast*)
-
-open ExtList
-open ExtString
-open Printf
-
-module PP = Pahole_parser
-
-let (//) = Filename.concat
-
-(* Couple of handy camlp4 construction functions which do some
- * things that ought to be easy/obvious but aren't.
- *
- * 'concat_str_items' concatenates a list of str_item together into
- * one big str_item.
- *
- * 'concat_record_fields' concatenates a list of records fields into
- * a record. The list must have at least one element.
- *
- * 'build_record' builds a record out of record fields.
- *
- * 'build_tuple_from_exprs' builds an arbitrary length tuple from
- * a list of expressions of length >= 2.
- *
- * Thanks to bluestorm on #ocaml for getting these working.
- *)
-let concat_str_items _loc items =
- match items with
- | [] -> <:str_item< >>
- | x :: xs ->
- List.fold_left (fun xs x -> <:str_item< $xs$ $x$ >>) x xs
-
-let concat_sig_items _loc items =
- match items with
- | [] -> <:sig_item< >>
- | x :: xs ->
- List.fold_left (fun xs x -> <:sig_item< $xs$ $x$ >>) x xs
-
-let concat_record_fields _loc fields =
- match fields with
- | [] -> assert false
- | f :: fs ->
- List.fold_left (fun fs f -> <:ctyp< $fs$ ; $f$ >>) f fs
-
-let concat_record_bindings _loc rbs =
- match rbs with
- | [] -> assert false
- | rb :: rbs ->
- List.fold_left (fun rbs rb -> <:rec_binding< $rbs$ ; $rb$ >>) rb rbs
-
-let build_record _loc rbs =
- Ast.ExRec (_loc, rbs, Ast.ExNil _loc)
-
-let build_tuple_from_exprs _loc exprs =
- match exprs with
- | [] | [_] -> assert false
- | x :: xs ->
- Ast.ExTup (_loc,
- List.fold_left (fun xs x -> Ast.ExCom (_loc, x, xs)) x xs)
-
-let () =
- let args = Array.to_list Sys.argv in
-
- let kernelsdir, outputdir =
- match args with
- | [_;kd;od] -> kd,od
- | _ ->
- let arg0 = Filename.basename Sys.executable_name in
- eprintf "%s - Turn kernels database into code modules.
-
-Usage:
- %s <kernelsdir> <outputdir>
-
-Example (from toplevel of virt-mem source tree):
- %s kernels/ lib/
-" arg0 arg0 arg0;
- exit 2 in
-
- let kernels = PP.list_kernels kernelsdir in
- let nr_kernels = List.length kernels in
-
- let kernels = List.mapi (
- fun i info ->
- printf "Loading kernel data file %d/%d\r%!" (i+1) nr_kernels;
-
- let struct_names = List.map fst structs in
- let structures = PP.load_structures info struct_names in
-
- (* Make sure we got all the mandatory structures & fields. *)
- List.iter (
- fun (struct_name,
- { mandatory_struct = mandatory; fields = wanted_fields }) ->
- try
- let s =
- List.find (fun s -> struct_name = s.PP.struct_name)
- structures in
-
- (* Check we have all the mandatory fields. *)
- let all_fields = s.PP.struct_fields in
- List.iter (
- fun (wanted_field, { mandatory_field = mandatory }) ->
- let got_it =
- List.exists (
- fun { PP.field_name = name } -> name = wanted_field
- ) all_fields in
- if mandatory && not got_it then (
- eprintf "%s: structure %s is missing required field %s\n"
- info.PP.basename struct_name wanted_field;
- eprintf "fields found in this structure:\n";
- List.iter (
- fun { PP.field_name = name } -> eprintf "\t%s\n" name
- ) all_fields;
- exit 1
- );
- ) wanted_fields
-
- with Not_found ->
- if mandatory then
- failwith (sprintf "%s: structure %s not found in this kernel"
- info.PP.basename struct_name)
- ) structs;
-
- let structures =
- List.map (
- fun ({ PP.struct_name = struct_name; PP.struct_fields = fields }
- as structure) ->
- let { fields = wanted_fields } = List.assoc struct_name structs in
-
- (* That got us all the fields, but we only care about
- * the wanted_fields.
- *)
- let fields = List.filter (
- fun { PP.field_name = name } -> List.mem_assoc name wanted_fields
- ) fields in
-
- (* Prefix all the field names with the structure name. *)
- let fields =
- List.map (
- fun ({ PP.field_name = name } as field) ->
- let name = struct_name ^ "_" ^ name in
- { field with PP.field_name = name }
- ) fields in
- { structure with PP.struct_fields = fields }
- ) structures in
-
- (info, structures)
- ) kernels in
-
- if debug then
- List.iter (
- fun (info, structures) ->
- printf "%s ----------\n" (PP.string_of_info info);
- List.iter (
- fun structure ->
- printf "%s\n\n" (PP.string_of_structure structure);
- ) structures;
- ) kernels;
-
- (* First output file is a simple list of kernels, to support the
- * 'virt-mem --list-kernels' option.
- *)
- let () =
- let _loc = Loc.ghost in
-
- let versions = List.map (
- fun ({ PP.kernel_version = version }, _) -> version
- ) kernels in
-
- (* Sort them in reverse because we are going to generate the
- * final list in reverse.
- *)
- let cmp a b = compare b a in
- let versions = List.sort ~cmp versions in
-
- let xs =
- List.fold_left (fun xs version -> <:expr< $str:version$ :: $xs$ >>)
- <:expr< [] >> versions in
-
- let code = <:str_item<
- let kernels = $xs$
- >> in
-
- let output_file = outputdir // "virt_mem_kernels.ml" in
- printf "Writing list of kernels to %s ...\n%!" output_file;
- Printers.OCaml.print_implem ~output_file code in
-
- (* We'll generate a code file for each structure type (eg. task_struct
- * across all kernel versions), so rearrange 'kernels' for that purpose.
- *
- * XXX This loop is O(n^3), luckily n is small!
- *)
- let files =
- List.map (
- fun (struct_name, _) ->
- let kernels =
- List.filter_map (
- fun (info, structures) ->
- try
- let structure =
- List.find (
- fun { PP.struct_name = name } -> name = struct_name
- ) structures in
- Some (info, structure)
- with Not_found ->
- None
- ) kernels in
-
- (* Sort the kernels, which makes the generated output more stable
- * and makes patches more useful.
- *)
- let kernels = List.sort kernels in
-
- struct_name, kernels
- ) structs in
-
- let kernels = () in ignore kernels; (* garbage collect *)
-
-(*
- (* Get just the field types.
- *
- * It's plausible that a field with the same name has a different
- * type between kernel versions, so we must check that didn't
- * happen.
- *
- * This is complicated because of non-mandatory fields, which don't
- * appear in every kernel version.
- *)
- let files = List.map (
- fun (struct_name, kernels) ->
- let field_types =
- (* Get the list of fields expected in this structure. *)
- let { fields = struct_fields } = List.assoc struct_name structs in
-
- (* Get the list of fields that we found in each kernel version. *)
- let found_fields =
- List.flatten
- (List.map (fun (_, _, _, (fields, _)) -> fields) kernels) in
-
- (* Determine a hash from each field name to the type. As we add
- * fields, we might get a conflicting type (meaning the type
- * changed between kernel versions).
- *)
- let hash = Hashtbl.create 13 in
-
- List.iter (
- fun (field_name, (typ, _, _)) ->
- try
- let field_type = Hashtbl.find hash field_name in
- if typ <> field_type then
- failwith (sprintf "%s.%s: structure field changed type between kernel versions" struct_name field_name);
- with Not_found ->
- Hashtbl.add hash field_name typ
- ) found_fields;
-
- (* Now get a type for each structure field. *)
- List.filter_map (
- fun (field_name, ft) ->
- try
- let field_name = struct_name ^ "_" ^ field_name in
- let typ = Hashtbl.find hash field_name in
- Some (field_name, (typ, ft))
- with Not_found ->
- let msg =
- sprintf "%s.%s: this field was not found in any kernel version"
- struct_name field_name in
- if ft.mandatory_field then failwith msg else prerr_endline msg;
- None
- ) struct_fields in
- (struct_name, kernels, field_types)
- ) files in
-
- (* To minimize generated code size, we want to fold together all
- * structures where the particulars (eg. offsets, sizes, endianness)
- * of the fields we care about are the same -- eg. between kernel
- * versions which are very similar.
- *)
- let endian_of_architecture arch =
- if String.starts_with arch "i386" ||
- String.starts_with arch "i486" ||
- String.starts_with arch "i586" ||
- String.starts_with arch "i686" ||
- String.starts_with arch "x86_64" ||
- String.starts_with arch "x86-64" then
- Bitstring.LittleEndian
- else if String.starts_with arch "ia64" then
- Bitstring.LittleEndian (* XXX usually? *)
- else if String.starts_with arch "ppc" then
- Bitstring.BigEndian
- else if String.starts_with arch "sparc" then
- Bitstring.BigEndian
- else
- failwith (sprintf "endian_of_architecture: cannot parse %S" arch)
- in
-
- let files =
- List.map (
- fun (struct_name, kernels, field_types) ->
- let hash = Hashtbl.create 13 in
- let i = ref 0 in
- let xs = ref [] in
- let kernels =
- List.map (
- fun (basename, version, arch, (fields, total_size)) ->
- let key = endian_of_architecture arch, fields in
- let j =
- try Hashtbl.find hash key
- with Not_found ->
- incr i;
- xs := (!i, key) :: !xs; Hashtbl.add hash key !i;
- !i in
- (basename, version, arch, total_size, j)
- ) kernels in
- let parsers = List.rev !xs in
- struct_name, kernels, field_types, parsers
- ) files in
-
- (* How much did we save by sharing? *)
- if debug then
- List.iter (
- fun (struct_name, kernels, _, parsers) ->
- printf "struct %s:\n" struct_name;
- printf " number of kernel versions: %d\n" (List.length kernels);
- printf " number of parser functions needed after sharing: %d\n"
- (List.length parsers)
- ) files;
-
- (* Extend the parsers fields by adding on any optional fields which
- * are not actually present in the specific kernel.
- *)
- let files =
- List.map (
- fun (struct_name, kernels, field_types, parsers) ->
- let parsers = List.map (
- fun (i, (endian, fields)) ->
- let fields_not_present =
- List.filter_map (
- fun (field_name, _) ->
- if List.mem_assoc field_name fields then None
- else Some field_name
- ) field_types in
- (i, (endian, fields, fields_not_present))
- ) parsers in
- (struct_name, kernels, field_types, parsers)
- ) files in
-
- (* Let's generate some code! *)
- let files =
- List.map (
- fun (struct_name, kernels, field_types, parsers) ->
- (* Dummy location required - there are no real locations for
- * output files.
- *)
- let _loc = Loc.ghost in
-
- (* The structure type. *)
- let struct_type, struct_sig =
- let fields = List.map (
- function
- | (name, (`Int, { mandatory_field = true })) ->
- <:ctyp< $lid:name$ : int64 >>
- | (name, (`Int, { mandatory_field = false })) ->
- <:ctyp< $lid:name$ : int64 option >>
- | (name, ((`VoidPtr|`Ptr _), { mandatory_field = true })) ->
- <:ctyp< $lid:name$ : Virt_mem_mmap.addr >>
- | (name, ((`VoidPtr|`Ptr _), { mandatory_field = false })) ->
- <:ctyp< $lid:name$ : Virt_mem_mmap.addr option >>
- | (name, (`Str _, { mandatory_field = true })) ->
- <:ctyp< $lid:name$ : string >>
- | (name, (`Str _, { mandatory_field = false })) ->
- <:ctyp< $lid:name$ : string option >>
- ) field_types in
- let fields = concat_record_fields _loc fields in
- let struct_type = <:str_item< type t = { $fields$ } >> in
- let struct_sig = <:sig_item< type t = { $fields$ } >> in
- struct_type, struct_sig in
-
- (* Create a "field signature" which describes certain aspects
- * of the fields which vary between kernel versions.
- *)
- let fieldsig_type, fieldsigs =
- let fieldsig_type =
- let fields = List.map (
- fun (name, _) ->
- let fsname = "__fs_" ^ name in
- <:ctyp< $lid:fsname$ : Virt_mem_types.fieldsig >>
- ) field_types in
- let fields = concat_record_fields _loc fields in
- <:str_item< type fs_t = { $fields$ } >> in
-
- let fieldsigs = List.map (
- fun (i, (_, fields, fields_not_present)) ->
- let make_fieldsig field_name available offset =
- let available =
- if available then <:expr< true >> else <:expr< false >> in
- let fsname = "__fs_" ^ field_name in
- <:rec_binding<
- $lid:fsname$ =
- { Virt_mem_types.field_available = $available$;
- field_offset = $`int:offset$ }
- >>
- in
- let fields = List.map (
- fun (field_name, (_, offset, _)) ->
- make_fieldsig field_name true offset
- ) fields in
- let fields_not_present = List.map (
- fun field_name ->
- make_fieldsig field_name false (-1)
- ) fields_not_present in
-
- let fieldsigs = fields @ fields_not_present in
- let fsname = sprintf "fieldsig_%d" i in
- let fieldsigs = concat_record_bindings _loc fieldsigs in
- let fieldsigs = build_record _loc fieldsigs in
- <:str_item<
- let $lid:fsname$ = $fieldsigs$
- >>
- ) parsers in
-
- let fieldsigs = concat_str_items _loc fieldsigs in
-
- fieldsig_type, fieldsigs in
-
- (* The shared parser functions.
- *
- * We could include bitmatch statements directly in here, but
- * what happens is that the macros get expanded here, resulting
- * in (even more) unreadable generated code. So instead just
- * do a textual substitution later by post-processing the
- * generated files. Not type-safe, but we can't have
- * everything.
- *)
- let parser_stmts, parser_subs =
- let parser_stmts = List.map (
- fun (i, _) ->
- let fnname = sprintf "parser_%d" i in
- <:str_item<
- let $lid:fnname$ bits = $str:fnname$
- >>
- ) parsers in
-
- let parser_stmts = concat_str_items _loc parser_stmts in
-
- (* What gets substituted for "parser_NN" ... *)
- let parser_subs = List.map (
- fun (i, (endian, fields, fields_not_present)) ->
- let fnname = sprintf "parser_%d" i in
- let endian =
- match endian with
- | Bitstring.LittleEndian -> "littleendian"
- | Bitstring.BigEndian -> "bigendian"
- | _ -> assert false in
- let patterns =
- (* Fields must be sorted by offset, otherwise bitmatch
- * will complain.
- *)
- let cmp (_, (_, o1, _)) (_, (_, o2, _)) = compare o1 o2 in
- let fields = List.sort ~cmp fields in
- String.concat ";\n " (
- List.map (
- function
- | (field_name, ((`Int|`Ptr _|`VoidPtr), offset, size)) ->
- (* 'zero+' is a hack to force the type to int64. *)
- sprintf "%s : zero+%d : offset(%d), %s"
- field_name (size*8) (offset*8) endian
- | (field_name, (`Str width, offset, size)) ->
- sprintf "%s : %d : offset(%d), string"
- field_name (width*8) (offset*8)
- ) fields
- ) in
- let assignments =
- List.map (
- fun (field_name, typ) ->
- let (_, { mandatory_field = mandatory;
- list_head_adjustment = list_head_adjustment }) =
- try List.assoc field_name field_types
- with Not_found ->
- failwith (sprintf "%s: not found in field_types"
- field_name) in
- match typ, mandatory, list_head_adjustment with
- | (`Ptr "list_head", offset, size), true, true ->
- sprintf "%s = Int64.sub %s %dL"
- field_name field_name offset
- | (`Ptr "list_head", offset, size), false, true ->
- sprintf "%s = Some (Int64.sub %s %dL)"
- field_name field_name offset
- | _, true, _ ->
- sprintf "%s = %s" field_name field_name
- | _, false, _ ->
- sprintf "%s = Some %s" field_name field_name
- ) fields in
- let assignments_not_present =
- List.map (
- fun field_name -> sprintf "%s = None" field_name
- ) fields_not_present in
-
- let assignments =
- String.concat ";\n "
- (assignments @ assignments_not_present) in
-
- let sub =
- sprintf "
- bitmatch bits with
- | { %s } ->
- { %s }
- | { _ } ->
- raise (Virt_mem_types.ParseError (struct_name, %S, match_err))"
- patterns assignments fnname in
-
- fnname, sub
- ) parsers in
-
- parser_stmts, parser_subs in
-
- (* Define a map from kernel versions to parsing functions. *)
- let version_map =
- let stmts = List.fold_left (
- fun stmts (_, version, arch, total_size, i) ->
- let parserfn = sprintf "parser_%d" i in
- let fsname = sprintf "fieldsig_%d" i in
- <:str_item<
- $stmts$
- let v = ($lid:parserfn$, $`int:total_size$, $lid:fsname$)
- let map = StringMap.add $str:version$ v map
- >>
- ) <:str_item< let map = StringMap.empty >> kernels in
-
- <:str_item<
- module StringMap = Map.Make (String) ;;
- $stmts$
- >> in
-
- (* Accessors for the field signatures. *)
- let fsaccess, fsaccess_sig =
- let fields = List.map (
- fun (field_name, _) ->
- let fsname = "__fs_" ^ field_name in
- <:str_item<
- let $lid:"field_signature_of_"^field_name$ version =
- let _, _, fs = StringMap.find version map in
- fs.$lid:fsname$
- >>
- ) field_types in
-
- let fsaccess = concat_str_items _loc fields in
-
- let fields = List.map (
- fun (field_name, _) ->
- <:sig_item<
- val $lid:"field_signature_of_"^field_name$ : kernel_version ->
- Virt_mem_types.fieldsig
- >>
- ) field_types in
-
- let fsaccess_sig = concat_sig_items _loc fields in
-
- fsaccess, fsaccess_sig in
-
- (* Code (.ml file). *)
- let code = <:str_item<
- let zero = 0
- let struct_name = $str:struct_name$
- let match_err = "failed to match kernel structure" ;;
- $struct_type$
- $fieldsig_type$
- $fieldsigs$
- $parser_stmts$
- $version_map$
-
- type kernel_version = string
- let $lid:struct_name^"_known"$ version = StringMap.mem version map
- let $lid:struct_name^"_size"$ version =
- let _, size, _ = StringMap.find version map in
- size
- let $lid:struct_name^"_of_bits"$ version bits =
- let parsefn, _, _ = StringMap.find version map in
- parsefn bits
- let $lid:"get_"^struct_name$ version mem addr =
- let parsefn, size, _ = StringMap.find version map in
- let bytes = Virt_mem_mmap.get_bytes mem addr size in
- let bits = Bitstring.bitstring_of_string bytes in
- parsefn bits ;;
- $fsaccess$
- >> in
-
- (* Interface (.mli file). *)
- let interface = <:sig_item<
- $struct_sig$
-
- val struct_name : string
- type kernel_version = string
- val $lid:struct_name^"_known"$ : kernel_version -> bool
- val $lid:struct_name^"_size"$ : kernel_version -> int
- val $lid:struct_name^"_of_bits"$ :
- kernel_version -> Bitstring.bitstring -> t
- val $lid:"get_"^struct_name$ : kernel_version ->
- ('a, 'b, [`HasMapping]) Virt_mem_mmap.t -> Virt_mem_mmap.addr -> t;;
- $fsaccess_sig$
- >> in
-
- (struct_name, code, interface, parser_subs)
- ) files in
-
- (* Finally generate the output files. *)
- let re_subst = Pcre.regexp "^(.*)\"(parser_\\d+)\"(.*)$" in
-
- List.iter (
- fun (struct_name, code, interface, parser_subs) ->
- (* Interface (.mli file). *)
- let output_file = outputdir // "kernel_" ^ struct_name ^ ".mli" in
- printf "Writing %s interface to %s ...\n%!" struct_name output_file;
- Printers.OCaml.print_interf ~output_file interface;
-
- (* Implementation (.ml file). *)
- let output_file = outputdir // "kernel_" ^ struct_name ^ ".ml" in
- printf "Writing %s implementation to %s ...\n%!" struct_name output_file;
-
- let new_output_file = output_file ^ ".new" in
- Printers.OCaml.print_implem ~output_file:new_output_file code;
-
- (* Substitute the parser bodies in the output file. *)
- let ichan = open_in new_output_file in
- let ochan = open_out output_file in
-
- output_string ochan "\
-(* WARNING: This file and the corresponding mli (interface) are
- * automatically generated by the extract/codegen/kerneldb_to_parser.ml
- * program.
- *
- * Any edits you make to this file will be lost.
- *
- * To update this file from the latest kernel database, it is recommended
- * that you do 'make update-kernel-structs'.
- *)\n\n";
-
- let rec loop () =
- let line = input_line ichan in
- let line =
- if Pcre.pmatch ~rex:re_subst line then (
- let subs = Pcre.exec ~rex:re_subst line in
- let start = Pcre.get_substring subs 1 in
- let template = Pcre.get_substring subs 2 in
- let rest = Pcre.get_substring subs 3 in
- let sub = List.assoc template parser_subs in
- start ^ sub ^ rest
- ) else line in
- output_string ochan line; output_char ochan '\n';
- loop ()
- in
- (try loop () with End_of_file -> ());
-
- close_out ochan;
- close_in ichan;
-
- Unix.unlink new_output_file
- ) files
-*)
git.annexia.org / virt-mem.git / blobdiff