lib/virt_mem_list_head.ml

   1 (* Memory info command for virtual domains.
   2    (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
   3    http://libvirt.org/
   4
   5    This program is free software; you can redistribute it and/or modify
   6    it under the terms of the GNU General Public License as published by
   7    the Free Software Foundation; either version 2 of the License, or
   8    (at your option) any later version.
   9
  10    This program is distributed in the hope that it will be useful,
  11    but WITHOUT ANY WARRANTY; without even the implied warranty of
  12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13    GNU General Public License for more details.
  14
  15    You should have received a copy of the GNU General Public License
  16    along with this program; if not, write to the Free Software
  17    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18  *)
  19
  20 (* This code will work provided list_head always contains just a
  21  * 'next' and 'prev' pointer.  If it changes, then we'll have to
  22  * import the struct list_head from the kernel version, just like
  23  * every other structure. (XXX)
  24  *)
  25
  26 open Printf
  27
  28 open Virt_mem_utils
  29 open Virt_mem_types
  30
  31 type t =
  32     image                       (* Kernel image. *)
  33     * int64                     (* Pointer to start of head struct. *)
  34     * int64                     (* Offset. *)
  35
  36 let create_base image head offset =
  37   let offset = Int64.of_int offset in
  38   (image, head, offset)
  39
  40 let create image head offset =
  41   let offset = Int64.of_int offset in
  42   let head = head -^ offset in
  43   (image, head, offset)
  44
  45 let get_next_ptr image addr offset =
  46   let addr = addr +^ offset in
  47   let addr = Virt_mem_mmap.follow_pointer image.mem addr in
  48   let addr = addr -^ offset in
  49   addr
  50
  51 let load (image, head, offset) f =
  52   let rec loop image addr =
  53     if addr <> head then (
  54       let image = f image addr in
  55       let addr = get_next_ptr image addr offset in
  56       loop image addr
  57     )
  58     else image
  59   in
  60   let image = loop image (get_next_ptr image head offset) in
  61   image, (image, head, offset)
  62
  63 let load_all t size =
  64   let f image addr =
  65     let mapped = Virt_mem_mmap.is_mapped_range image.mem addr size in
  66     let image =
  67       if not mapped then Virt_mem_types.load_memory image addr size
  68       else image in
  69     image
  70   in
  71   load t f
  72
  73 let fold (image, head, offset) b f =
  74   let rec loop b addr =
  75     if addr <> head then (
  76       let b = f b addr in
  77       let addr = get_next_ptr image addr offset in
  78       loop b addr
  79     )
  80     else b
  81   in
  82   loop b (get_next_ptr image head offset)
  83
  84 (* Iter and map can be implemented in terms of fold. *)
  85 let iter t f =
  86   fold t () (fun () addr -> let () = f addr in ())
  87
  88 let map t f =
  89   List.rev (fold t [] (fun xs addr -> let x = f addr in x :: xs))