let files =
List.map (
fun (name, _) ->
- name,
- List.filter_map (
- fun (basename, version, arch, structures) ->
- try Some (basename, version, arch, List.assoc name structures)
- with Not_found -> None
- ) datas
+ let kernels =
+ List.filter_map (
+ fun (basename, version, arch, structures) ->
+ try Some (basename, version, arch, List.assoc name structures)
+ with Not_found -> None
+ ) datas in
+
+ (* Sort the kernels, which makes the generated output more stable
+ * and makes patches more useful.
+ *)
+ let kernels = List.sort kernels in
+
+ name, kernels
) what in
let datas = () in ignore datas; (* garbage collect *)
!i in
(basename, version, arch, total_size, j)
) kernels in
- struct_name, kernels, field_types, List.rev !xs
+ let parsers = List.rev !xs in
+ struct_name, kernels, field_types, parsers
) files in
(* How much did we save by sharing? *)
*)
let cmp (_, (_, o1, _)) (_, (_, o2, _)) = compare o1 o2 in
let fields = List.sort ~cmp fields in
- String.concat ";\n " (
+ String.concat ";\n " (
List.map (
function
| (field_name, (`Int, offset, size))
) fields
) in
let assignments =
- String.concat ";\n " (
+ String.concat ";\n " (
List.map (
function
| (field_name, (`Ptr "list_head", offset, size)) ->
) in
let sub =
- sprintf "\
+ sprintf "
bitmatch bits with
- | { %s } -> { %s }
- | { _ } -> raise (ParseError (%S, %S, \"failed to match kernel structure\"))"
- patterns assignments struct_name fnname in
+ | { %s } ->
+ { %s }
+ | { _ } ->
+ raise (ParseError (struct_name, %S, match_err))"
+ patterns assignments fnname in
fnname, sub
) parsers in
let code = <:str_item<
let warning = "This code is automatically generated from the kernel database by kerneldb-to-parser program. Any edits you make will be lost."
let zero = 0
+ let struct_name = $str:struct_name$
+ let match_err = "failed to match kernel structure"
exception ParseError of string * string * string;;
$struct_type$
$parser_stmts$
exception ParseError of string * string * string;;
$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