X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=extract%2Fcodegen%2Fkerneldb_to_parser.ml;h=177d607a5d18fb36ee3fa0ac9d617d65b8996dcb;hb=75dd862f41569df1f9f512ea3d9414fe3ea423f1;hp=6b64786afc8511b7946fa229ae2f9c77ea035cbb;hpb=45845eeeff9ccbd4cbda63d6deaa9a29ab1abb05;p=virt-mem.git diff --git a/extract/codegen/kerneldb_to_parser.ml b/extract/codegen/kerneldb_to_parser.ml index 6b64786..177d607 100644 --- a/extract/codegen/kerneldb_to_parser.ml +++ b/extract/codegen/kerneldb_to_parser.ml @@ -28,19 +28,173 @@ and fields we try to parse. *) -let what = [ - "task_struct", ( - "struct task_struct", - [ "state"; "prio"; "normal_prio"; "static_prio"; "tasks"; "comm"] +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 @@ -59,71 +213,582 @@ Example (from toplevel of virt-mem source tree): " arg0 arg0 arg0; exit 2 in - (* Get the *.info files from the kernels database. *) - let infos = Sys.readdir kernelsdir in - let infos = Array.to_list infos in - let infos = List.filter (fun name -> String.ends_with name ".info") infos in - let infos = List.map ((//) kernelsdir) infos 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 - (* Regular expressions. We really really should use ocaml-mikmatch ... *) - let re_oldformat = Pcre.regexp "^RPM: \\d+: \\(build \\d+\\) ([-\\w]+) ([\\w.]+) ([\\w.]+) \\(.*?\\) (\\w+)" in - let re_keyvalue = Pcre.regexp "^(\\w+): (.*)" in + (info, structures) + ) kernels in - (* Parse in the *.info files. These have historically had a few different - * formats that we need to support. + 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 infos = List.map ( - fun filename -> - (* Get the basename (for getting the .data file later on). *) - let basename = Filename.chop_suffix filename ".info" in - - let chan = open_in filename in - let line = input_line chan in - - let name, version = - if Pcre.pmatch ~rex:re_oldformat line then ( - (* If the file starts with "RPM: \d+: ..." then it's the original - * format. Everything in one line. - *) - let subs = Pcre.exec ~rex:re_oldformat line in - let name = Pcre.get_substring subs 1 in - let version = Pcre.get_substring subs 2 in - let release = Pcre.get_substring subs 3 in - let arch = Pcre.get_substring subs 4 in - close_in chan; - name, sprintf "%s-%s.%s" version release arch - ) else ( - (* New-style "key: value" entries, up to end of file or the first - * blank line. - *) - let name, version, release, arch = - ref "", ref "", ref "", ref "" in - let rec loop line = + 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 subs = Pcre.exec ~rex:re_keyvalue line in - let key = Pcre.get_substring subs 1 in - let value = Pcre.get_substring subs 2 in - if key = "Name" then name := value - else if key = "Version" then version := value - else if key = "Release" then release := value - else if key = "Architecture" then arch := value; - let line = input_line chan in - loop line - with - Not_found | End_of_file -> - close_in chan - in - loop line; - let name, version, release, arch = - !name, !version, !release, !arch in - if name = "" || version = "" || release = "" || arch = "" then - failwith (sprintf "%s: missing Name, Version, Release or Architecture key" filename); - name, sprintf "%s-%s.%s" version release arch - ) in - - printf "%s -> %s, %s\n" basename name version; - - (basename, name, version) - ) infos in - - () + 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 +*)