- <:str_item<
- let $lid:sf_name^"_follower"$ load followers map addr shape =
- $body$
- >>
- ) sflist
- ) xs in
- let strs = List.concat strs in
-
- (* A follower function for every kernel version / structure. When this
- * function is called starting at some known root, it will load every
- * reachable kernel structure.
- *)
- let strs =
- let common =
- (* Share as much common code as possible to minimize generated
- * code size and benefit i-cache.
- *)
- <:str_item<
- let kv_follower kernel_version struct_name total_size
- parserfn followerfn
- load followers map addr =
- if addr <> 0L && not (AddrMap.mem addr map) then (
- let map = AddrMap.add addr (struct_name, total_size) map in
- let bits = load struct_name addr total_size in
- let shape, _ = parserfn kernel_version bits in
- followerfn load followers map addr shape
- )
- else map
- >> in
-
- let fs =
- List.map (
- fun (struct_name, (kernels, _, sfhash, pahash)) ->
- List.map (
- fun ({ PP.kernel_version = version; kv_i = kv_i },
- { PP.struct_total_size = total_size }) ->
- let { SC.pa_name = pa_name } = Hashtbl.find pahash version in
- let { SC.sf_name = sf_name } = Hashtbl.find sfhash version in
-
- let fname = sprintf "%s_kv%d_follower" struct_name kv_i in
-
- <:str_item<
- let $lid:fname$ =
- kv_follower
- $str:version$ $str:struct_name$ $`int:total_size$
- $lid:pa_name$ $lid:sf_name^"_follower"$
- >>
- ) kernels
- ) xs in
-
- let strs = strs @ [ common ] @ List.concat fs in
- strs in
-
- (* A map from kernel versions to follower functions.
- *
- * For each struct, we have a list of kernel versions which contain
- * that struct. Some kernels are missing a particular struct, so
- * that is turned into a ParseError exception.
- *)
- let strs =
- let nr_kernels =
- List.fold_left max 0
- (List.map (fun (_, (kernels, _, _, _)) -> List.length kernels) xs) in
- let nr_structs = List.length xs in
- let array = Array.make_matrix nr_kernels (nr_structs+1) (Missing "") in
- List.iteri (
- fun si (struct_name, _) ->
- for i = 0 to nr_kernels - 1 do
- array.(i).(si+1) <- Missing struct_name
- done
- ) xs;
- List.iteri (
- fun si (struct_name, (kernels, _, _, _)) ->
- List.iter (
- fun ({ PP.kernel_version = version; kv_i = kv_i }, _) ->
- array.(kv_i).(0) <- KernelVersion version;
- array.(kv_i).(si+1) <-
- Follower (sprintf "%s_kv%d_follower" struct_name kv_i)
- ) kernels
- ) xs;
-
- let array = Array.map (
- fun row ->
- match Array.to_list row with
- | [] | (Missing _|Follower _) :: _ -> assert false
- | KernelVersion kernel_version :: followers -> kernel_version, followers
- ) array in
-
- let map = List.fold_left (
- fun map (kernel_version, followers) ->
- let followers = List.map (
- function
- | Follower fname ->
- <:expr< $lid:fname$ >>
-
- (* no follower for this kernel/struct combination *)
- | Missing struct_name ->