+ (* Write the main header. *)
+ write_header machine.Diskimage.m_disks;
+
+ (* Iterate over the disks. *)
+ List.iteri (
+ fun disknum { Diskimage.d_name = name; d_dev = disk } ->
+ let blocksize = disk#blocksize in
+ let size = disk#size in (* Size in bytes. *)
+ let nr_blocks = size /^ blocksize in (* Number of disk sectors. *)
+
+ if !Diskimage.debug then
+ eprintf "Writing disk %s (%s sectors) ...\n%!"
+ disk#name (Int63.to_string nr_blocks);
+
+ (* Get the lookup function for this disk. *)
+ let lookup_offset =
+ Diskimage.get_owners_lookup machine ownership disk in
+
+ (* Convenience function to look up a block and test freeness. *)
+ let block_is_free blk =
+ let offset = blk *^ blocksize in
+ Diskimage.offset_is_free (lookup_offset offset)
+ in
+
+ (* Look up owners for each sector in turn. *)
+ let rec loop start_blk =
+ if start_blk < nr_blocks then (
+ (* The current sector (start_blk) is either free or not free.
+ * Look for a stretch of sectors which are the same.
+ *)
+ let current_free = block_is_free start_blk in
+ let rec find_end blk =
+ if blk < nr_blocks then (
+ if block_is_free blk = current_free then
+ find_end (Int63.succ blk)
+ else
+ blk
+ ) else
+ nr_blocks (* End of the disk image. *)
+ in
+ let end_blk = find_end (Int63.succ start_blk) in
+
+ let len_blks = end_blk -^ start_blk in
+
+ let start_offset = start_blk *^ blocksize in
+ let len_bytes = len_blks *^ blocksize in
+
+ (* Current stretch is from start_blk .. end_blk-1. *)
+ if !Diskimage.debug then
+ eprintf " %s stretch %s to %s-1 (%s bytes)\n%!"
+ (if current_free then "free" else "used")
+ (Int63.to_string start_blk) (Int63.to_string end_blk)
+ (Int63.to_string (len_blks *^ blocksize));
+
+ (* Write the stretch to stdout. *)
+ write_stretch_header disknum current_free start_offset len_bytes;
+
+ (* Write the data (note: we only need to write it if
+ * it's not marked as free!).
+ *)
+ if not current_free then write_stretch disk start_offset len_bytes;
+
+ loop end_blk
+ )
+ in
+ loop ~^0
+ ) machine.Diskimage.m_disks;