(* Memory info command for virtual domains. (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc. http://libvirt.org/ This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. *) (* This code will work provided list_head always contains just a * 'next' and 'prev' pointer. If it changes, then we'll have to * import the struct list_head from the kernel version, just like * every other structure. (XXX) *) open Printf open Virt_mem_utils open Virt_mem_types type t = image (* Kernel image. *) * int64 (* Pointer to start of head struct. *) * int64 (* Offset. *) let create_base image head offset = let offset = Int64.of_int offset in (image, head, offset) let create image head offset = let offset = Int64.of_int offset in let head = head -^ offset in (image, head, offset) let get_next_ptr image addr offset = let addr = addr +^ offset in let addr = Virt_mem_mmap.follow_pointer image.mem addr in let addr = addr -^ offset in addr let load (image, head, offset) f = let rec loop image addr = if addr <> head then ( let image = f image addr in let addr = get_next_ptr image addr offset in loop image addr ) else image in let image = loop image (get_next_ptr image head offset) in image, (image, head, offset) let load_all t size = let f image addr = let mapped = Virt_mem_mmap.is_mapped_range image.mem addr size in let image = if not mapped then Virt_mem_types.load_memory image addr size else image in image in load t f let fold (image, head, offset) b f = let rec loop b addr = if addr <> head then ( let b = f b addr in let addr = get_next_ptr image addr offset in loop b addr ) else b in loop b (get_next_ptr image head offset) (* Iter and map can be implemented in terms of fold. *) let iter t f = fold t () (fun () addr -> let () = f addr in ()) let map t f = List.rev (fold t [] (fun xs addr -> let x = f addr in x :: xs))