- fun (name, (_, _, mandatory, _)) ->
- if mandatory && not (Hashtbl.mem bodies name) then
- failwith (sprintf "%s: structure %s not found in this kernel" basename name)
- ) what;
-
- (basename, version, arch, bodies)
- ) infos in
-
- (* Now parse each structure body.
- * XXX This would be better as a proper lex/yacc parser.
- * XXX Even better would be to have a proper interface to libdwarves.
- *)
- let re_offsetsize = Pcre.regexp "/\\*\\s+(\\d+)\\s+(\\d+)\\s+\\*/" in
- let re_intfield = Pcre.regexp "int\\s+(\\w+);" in
- let re_ptrfield = Pcre.regexp "struct\\s+(\\w+)\\s*\\*\\s*(\\w+);" in
- let re_strfield = Pcre.regexp "char\\s+(\\w+)\\[(\\d+)\\];" in
- let re_structopener = Pcre.regexp "(struct|union)\\s+.*{$" in
- let re_structcloser = Pcre.regexp "}\\s*(\\w+)?(\\[\\d+\\])?;" in
-
- (* 'basename' is the source file, and second parameter ('body') is
- * the list of text lines which covers this structure (minus the
- * opener line). Result is the list of parsed fields from this
- * structure.
- *)
- let rec parse basename = function
- | [] -> assert false
- | [_] -> [] (* Just the closer line, finished. *)
- | line :: lines when Pcre.pmatch ~rex:re_structopener line ->
- (* Recursively parse a sub-structure. First search for the
- * corresponding closer line.
- *)
- let rec loop depth acc = function
- | [] ->
- eprintf "%s: %S has no matching close structure line\n%!"
- basename line;
- assert false
- | line :: lines when Pcre.pmatch ~rex:re_structopener line ->
- loop (depth+1) (line :: acc) lines
- | line :: lines
- when depth = 0 && Pcre.pmatch ~rex:re_structcloser line ->
- (line :: acc), lines
- | line :: lines
- when depth > 0 && Pcre.pmatch ~rex:re_structcloser line ->
- loop (depth-1) (line :: acc) lines
- | line :: lines -> loop depth (line :: acc) lines
- in
- let nested_body, rest = loop 0 [] lines in
-
- (* Then parse the sub-structure. *)
- let struct_name, nested_body =
- match nested_body with
- | [] -> assert false
- | closer :: _ ->
- let subs = Pcre.exec ~rex:re_structcloser closer in
- let struct_name =
- try Some (Pcre.get_substring subs 1) with Not_found -> None in
- struct_name, List.rev nested_body in
- let nested_fields = parse basename nested_body in
-
- (* Prefix the sub-fields with the name of the structure. *)
- let nested_fields =
- match struct_name with
- | None -> nested_fields
- | Some prefix ->
- List.map (
- fun (name, details) -> (prefix ^ "'" ^ name, details)
- ) nested_fields in
-
- (* Parse the rest. *)
- nested_fields @ parse basename rest
-
- | line :: lines when Pcre.pmatch ~rex:re_intfield line ->
- (* An int field. *)
- let subs = Pcre.exec ~rex:re_intfield line in
- let name = Pcre.get_substring subs 1 in
- (try
- let subs = Pcre.exec ~rex:re_offsetsize line in
- let offset = int_of_string (Pcre.get_substring subs 1) in
- let size = int_of_string (Pcre.get_substring subs 2) in
- (name, (`Int, offset, size)) :: parse basename lines
- with
- Not_found -> parse basename lines
- );
-
- | line :: lines when Pcre.pmatch ~rex:re_ptrfield line ->
- (* A pointer-to-struct field. *)
- let subs = Pcre.exec ~rex:re_ptrfield line in
- let struct_name = Pcre.get_substring subs 1 in
- let name = Pcre.get_substring subs 2 in
- (try
- let subs = Pcre.exec ~rex:re_offsetsize line in
- let offset = int_of_string (Pcre.get_substring subs 1) in
- let size = int_of_string (Pcre.get_substring subs 2) in
- (name, (`Ptr struct_name, offset, size))
- :: parse basename lines
- with
- Not_found -> parse basename lines
- );
-
- | line :: lines when Pcre.pmatch ~rex:re_strfield line ->
- (* A string (char array) field. *)
- let subs = Pcre.exec ~rex:re_strfield line in
- let name = Pcre.get_substring subs 1 in
- let width = int_of_string (Pcre.get_substring subs 2) in
- (try
- let subs = Pcre.exec ~rex:re_offsetsize line in
- let offset = int_of_string (Pcre.get_substring subs 1) in
- let size = int_of_string (Pcre.get_substring subs 2) in
- (name, (`Str width, offset, size))
- :: parse basename lines
- with
- Not_found -> parse basename lines
- );
-
- | _ :: lines ->
- (* Just ignore any other field we can't parse. *)
- parse basename lines
+ 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