+ (* Block-based read. Inefficient so normally overridden in subclasses. *)
+ method read offset len =
+ if offset < 0L || len < 0 then
+ invalid_arg "device: read: negative offset or length";
+
+ let blocksize64 = Int64.of_int self#blocksize in
+
+ (* Break the request into blocks.
+ * Find the first and last blocks of this request.
+ *)
+ let first_blk = offset /^ blocksize64 in
+ let offset_in_first_blk = offset -^ first_blk *^ blocksize64 in
+ let last_blk = (offset +^ Int64.of_int (len-1)) /^ blocksize64 in
+
+ (* Buffer for the result. *)
+ let buf = Buffer.create len in
+
+ let not_mapped_error () = invalid_arg "device: read: block not mapped" in
+
+ (* Copy the first block (partial). *)
+ (match self#mapblock first_blk with
+ | [] -> not_mapped_error ()
+ | (dev, base) :: _ ->
+ let len =
+ min len (Int64.to_int (blocksize64 -^ offset_in_first_blk)) in
+ let str = dev#read (base +^ offset_in_first_blk) len in
+ Buffer.add_string buf str
+ );
+
+ (* Copy the middle blocks. *)
+ let rec loop blk =
+ if blk < last_blk then (
+ (match self#mapblock blk with
+ | [] -> not_mapped_error ()
+ | (dev, base) :: _ ->
+ let str = dev#read 0L self#blocksize in
+ Buffer.add_string buf str
+ );
+ loop (Int64.succ blk)
+ )
+ in
+ loop (Int64.succ first_blk);
+
+ (* Copy the last block (partial). *)
+ if first_blk < last_blk then (
+ match self#mapblock last_blk with
+ | [] -> not_mapped_error ()
+ | (dev, base) :: _ ->
+ let len = (offset +^ Int64.of_int len) -^ last_blk *^ blocksize64 in
+ let len = Int64.to_int len in
+ let str = dev#read 0L len in
+ Buffer.add_string buf str
+ );
+
+ assert (len = Buffer.length buf);
+ Buffer.contents buf