+++ /dev/null
-(* 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))