+ (* 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
+
+ in
+
+ let datas = List.map (
+ fun (basename, version, bodies) ->
+ let structures = List.filter_map (
+ fun (name, (_, _, _, wanted_fields)) ->
+ let body =
+ try Some (Hashtbl.find bodies name) with Not_found -> None in
+ match body with
+ | None -> None
+ | Some body ->
+ let body = List.tl body in (* Don't care about opener line. *)
+ let fields = parse basename body in
+
+ (* That got us all the fields, but we only care about
+ * the wanted_fields.
+ *)
+ let fields = List.filter (
+ fun (name, _) -> List.mem name wanted_fields
+ ) fields in
+
+ (* Also check we have all the wanted fields. *)
+ List.iter (
+ fun wanted_field ->
+ if not (List.mem_assoc wanted_field fields) then
+ failwith (sprintf "%s: structure %s is missing required field %s" basename name wanted_field)
+ ) wanted_fields;
+
+ Some (name, fields)
+ ) what in
+
+ (basename, version, structures)
+ ) datas in
+
+ (* If you're debugging, uncomment this to print out the parsed
+ * structures.
+ *)
+(*
+ List.iter (
+ fun (basename, version, structures) ->
+ printf "%s (version: %s):\n" basename version;
+ List.iter (
+ fun (struct_name, fields) ->
+ printf " struct %s {\n" struct_name;
+ List.iter (
+ fun (field_name, (typ, offset, size)) ->
+ (match typ with
+ | `Int -> printf " int %s; " field_name
+ | `Ptr struct_name ->
+ printf " struct %s *%s; " struct_name field_name
+ | `Str width ->
+ printf " char %s[%d]; " field_name width
+ );
+ printf " /* offset = %d, size = %d */\n" offset size
+ ) fields;
+ printf " }\n\n";
+ ) structures;
+ ) datas;
+*)
+
+ (* Let's generate some code! *)
+
+
+
git.annexia.org / virt-mem.git / blobdiff