contrib/visualize-alignment/tracetops.ml

   1 #!/usr/bin/ocamlrun /usr/bin/ocaml
   2
   3 #use "topfind";;
   4 #require "extlib";;
   5
   6 (* Convert *.qtr (qemu block device trace) to Postscript.  By Richard
   7  * W.M. Jones <rjones@redhat.com>.
   8  *
   9  * Note that we use ordinary OCaml ints, which means this program is
  10  * limited to: ~1TB disks for 32 bit machines, or effectively unlimited
  11  * for 64 bit machines.
  12  *)
  13
  14 open ExtList
  15 open Scanf
  16 open Printf
  17
  18 type op = Read | Write
  19
  20 (* If 'true' then print debug messages. *)
  21 let debug = false
  22
  23 (* Width of each row (in sectors) in the output. *)
  24 let row_size = 64
  25
  26 (* Desirable alignment (sectors). *)
  27 let alignment = 8
  28
  29 (* Height (in 1/72 inch) of the final image. *)
  30 let height = 6.*.72.
  31
  32 (* Width (in 1/72 inch) of the final image. *)
  33 let width = 6.*.72.
  34
  35 (* Reserve at left for the sector number (comes out of width). *)
  36 let sn_width = 36.
  37
  38 let input =
  39   if Array.length Sys.argv = 2 then
  40     Sys.argv.(1)
  41   else
  42     failwith "usage: tracetops filename.qtr"
  43
  44 (* Read the input file. *)
  45 let nb_sectors, accesses =
  46   let chan = open_in input in
  47   let nb_sectors =
  48     let summary = input_line chan in
  49     if String.length summary < 1 || summary.[0] <> 'S' then
  50       failwith (sprintf "%s: input is not a qemu block device trace file"
  51                   input);
  52     sscanf summary "S %d" (fun x -> x) in
  53
  54   if nb_sectors mod row_size <> 0 then
  55     failwith (sprintf "input nb_sectors (%d) not divisible by row size (%d)"
  56                 nb_sectors row_size);
  57
  58   (* Read the reads and writes from the remainder of the file. *)
  59   let accesses = ref [] in
  60   let rec loop () =
  61     let line = input_line chan in
  62     let rw, s, n = sscanf line "%c %d %d" (fun rw s n -> (rw, s, n)) in
  63     let rw =
  64       match rw with
  65       | 'R' -> Read | 'W' -> Write
  66       | c -> failwith
  67           (sprintf "%s: error reading input: got '%c', expecting 'R' or 'W'"
  68              input c) in
  69     if n < 0 || s < 0 || s+n > nb_sectors then
  70       failwith (sprintf "%s: s (%d), n (%d) out of range" input s n);
  71     let aligned = s mod alignment = 0 && n mod alignment = 0 in
  72     accesses := (rw, aligned, s, n) :: !accesses;
  73     loop ()
  74   in
  75   (try loop () with
  76    | End_of_file -> ()
  77    | Scan_failure msg ->
  78        failwith (sprintf "%s: error reading input: %s" input msg)
  79   );
  80   close_in chan;
  81
  82   let accesses = List.rev !accesses in
  83
  84   if debug then (
  85     eprintf "%s: nb_sectors = %d, accesses = %d\n"
  86       input nb_sectors (List.length accesses)
  87   );
  88
  89   nb_sectors, accesses
  90
  91 let ranges =
  92   (* Given the number of sectors, make the row array. *)
  93   let nr_rows = nb_sectors / row_size in
  94   let rows = Array.make nr_rows false in
  95
  96   List.iter (
  97     fun (_, _, s, n) ->
  98       let i0 = s / row_size in
  99       let i1 = (s+n-1) / row_size in
 100       for i = i0 to i1 do rows.(i) <- true done;
 101   ) accesses;
 102
 103   (* Coalesce rows into a list of ranges of rows we will draw. *)
 104   let rows = Array.to_list rows in
 105   let rows = List.mapi (fun i v -> (v, i)) rows in
 106   let ranges =
 107     (* When called, we are in the middle of a range which started at i0. *)
 108     let rec loop i0 = function
 109       | (false, _) :: (false, _) :: (true, i1) :: []
 110       | _ :: (_, i1) :: []
 111       | (_, i1) :: [] ->
 112           [i0, i1]
 113       | (false, _) :: (false, _) :: (true, _) :: rest
 114       | (false, _) :: (true, _) :: rest
 115       | (true, _) :: rest ->
 116           loop i0 rest
 117       | (false, i1) :: rest ->
 118           let i1 = i1 - 1 in
 119           let rest = List.dropwhile (function (v, _) -> not v) rest in
 120           (match rest with
 121            | [] -> [i0, i1]
 122            | (_, i2) :: rest -> (i0, i1) :: loop i2 rest)
 123       | [] -> assert false
 124     in
 125     loop 0 (List.tl rows) in
 126
 127   if debug then (
 128     eprintf "%s: rows = %d (ranges = %d)\n" input nr_rows (List.length ranges);
 129     List.iter (
 130       fun (i0, i1) ->
 131         eprintf "  %d - %d (rows %d - %d)\n"
 132           (i0 * row_size) ((i1 + 1) * row_size - 1) i0 i1
 133     ) ranges
 134   );
 135
 136   ranges
 137
 138 (* Locate where we will draw the rows and cells in the final image. *)
 139 let iter_rows, mapxy, row_height, cell_width =
 140   let nr_ranges = List.length ranges in
 141   let nr_breaks = nr_ranges - 1 in
 142   let nr_rows =
 143     List.fold_left (+) 0 (List.map (fun (i0,i1) -> i1-i0+1) ranges) in
 144   let nr_rnb = nr_rows + nr_breaks in
 145   let row_height = height /. float nr_rnb in
 146   let cell_width = (width -. sn_width) /. float row_size in
 147
 148   if debug then (
 149     eprintf "number of rows and breaks = %d\n" nr_rnb;
 150     eprintf "row_height x cell_width = %g x %g\n" row_height cell_width
 151   );
 152
 153   (* Create a higher-order function to iterate over the rows. *)
 154   let rec iter_rows f =
 155     let rec loop row = function
 156       | [] -> ()
 157       | (i0,i1) :: rows ->
 158           for i = i0 to i1 do
 159             let y = float (row+i-i0) *. row_height in
 160             f y (Some i)
 161           done;
 162           (* Call an extra time for the break. *)
 163           let y = float (row+i1-i0+1) *. row_height in
 164           if rows <> [] then f y None;
 165           (* extra +1 here is to skip the break *)
 166           loop (row+i1-i0+1+1) rows
 167     in
 168     loop 0 ranges
 169   in
 170
 171   (* Create a hash which maps from the row number to the position
 172    * where we draw the row.  If the row is not drawn, the hash value
 173    * is missing.
 174    *)
 175   let row_y = Hashtbl.create nr_rows in
 176   iter_rows (
 177     fun y ->
 178       function
 179       | Some i -> Hashtbl.replace row_y i y
 180       | None -> ()
 181   );
 182
 183   (* Create a function which maps from the sector number to the final
 184    * position that we will draw it.
 185    *)
 186   let mapxy s =
 187     let r = s / row_size in
 188     let y = try Hashtbl.find row_y r with Not_found -> assert false in
 189     let x = sn_width +. cell_width *. float (s mod row_size) in
 190     x, y
 191   in
 192
 193   iter_rows, mapxy, row_height, cell_width
 194
 195 (* Start the PostScript file. *)
 196 let () =
 197   printf "%%!PS-Adobe-3.0 EPSF-3.0\n";
 198   printf "%%%%BoundingBox: -10 -10 %g %g\n"
 199     (width +. 10.) (height +. row_height +. 20.);
 200   printf "%%%%Creator: tracetops.ml (part of libguestfs)\n";
 201   printf "%%%%Title: %s\n" input;
 202   printf "%%%%LanguageLevel: 2\n";
 203   printf "%%%%Pages: 1\n";
 204   printf "%%%%Page: 1 1\n";
 205   printf "\n";
 206
 207   printf "/min { 2 copy gt { exch } if pop } def\n";
 208   printf "/max { 2 copy lt { exch } if pop } def\n";
 209
 210   (* Function for drawing cells. *)
 211   printf "/cell {\n";
 212   printf "  newpath\n";
 213   printf "    moveto\n";
 214   printf "    %g 0 rlineto\n" cell_width;
 215   printf "    0 %g rlineto\n" row_height;
 216   printf "    -%g 0 rlineto\n" cell_width;
 217   printf "  closepath\n";
 218   printf "  gsave fill grestore 0.75 setgray stroke\n";
 219   printf "} def\n";
 220
 221   (* Define colours for different cell types. *)
 222   printf "/unalignedread  { 0.95 0.95 0 setrgbcolor } def\n";
 223   printf "/unalignedwrite { 0.95 0 0    setrgbcolor } def\n";
 224   printf "/alignedread    { 0 0.95 0    setrgbcolor } def\n";
 225   printf "/alignedwrite   { 0 0 0.95    setrgbcolor } def\n";
 226
 227   (* Get width of text. *)
 228   printf "/textwidth { stringwidth pop } def\n";
 229
 230   (* Draw the outline. *)
 231   printf "/outline {\n";
 232   printf "  newpath\n";
 233   printf "    %g 0 moveto\n" sn_width;
 234   printf "    %g 0 lineto\n" width;
 235   printf "    %g %g lineto\n" width height;
 236   printf "    %g %g lineto\n" sn_width height;
 237   printf "  closepath\n";
 238   printf "  0.5 setlinewidth 0.3 setgray stroke\n";
 239   printf "} def\n";
 240
 241   (* Draw the outline breaks. *)
 242   printf "/breaks {\n";
 243   iter_rows (
 244     fun y ->
 245       function
 246       | Some _ -> ()
 247       | None ->
 248           let f xmin xmax =
 249             let yll = y +. row_height /. 3. -. 2. in
 250             let ylr = y +. row_height /. 2. -. 2. in
 251             let yur = y +. 2. *. row_height /. 3. in
 252             let yul = y +. row_height /. 2. in
 253             printf "  newpath\n";
 254             printf "    %g %g moveto\n" xmin yll;
 255             printf "    %g %g lineto\n" xmax ylr;
 256             printf "    %g %g lineto\n" xmax yur;
 257             printf "    %g %g lineto\n" xmin yul;
 258             printf "  closepath\n";
 259             printf "  1 setgray fill\n";
 260             printf "  newpath\n";
 261             printf "    %g %g moveto\n" xmin yll;
 262             printf "    %g %g lineto\n" xmax ylr;
 263             printf "    %g %g moveto\n" xmax yur;
 264             printf "    %g %g lineto\n" xmin yul;
 265             printf "  closepath\n";
 266             printf "  0.5 setlinewidth 0.3 setgray stroke\n"
 267           in
 268           f (sn_width -. 6.) (sn_width +. 6.);
 269           f (width -. 6.) (width +. 6.)
 270   );
 271   printf "} def\n";
 272
 273   (* Draw the labels. *)
 274   printf "/labels {\n";
 275   printf "  /Courier findfont\n";
 276   printf "  0.75 %g mul 10 min scalefont\n" row_height;
 277   printf "  setfont\n";
 278   iter_rows (
 279     fun y ->
 280       function
 281       | Some i ->
 282           let sector = i * row_size in
 283           printf "  newpath\n";
 284           printf "    /s { (%d) } def\n" sector;
 285           printf "    %g s textwidth sub 4 sub %g moveto\n" sn_width (y +. 2.);
 286           printf "  s show\n"
 287       | None -> ()
 288   );
 289   printf "} def\n";
 290
 291   (* Print the key. *)
 292   printf "/key {\n";
 293   printf "  /Times-Roman findfont\n";
 294   printf "  10. scalefont\n";
 295   printf "  setfont\n";
 296   let x = sn_width and y = height +. 10. in
 297   printf "  unalignedwrite %g %g cell\n" x y;
 298   let x = x +. cell_width +. 4. in
 299   printf "  newpath %g %g moveto (unaligned write) 0.3 setgray show\n" x y;
 300   let x = x +. 72. in
 301   printf "  unalignedread %g %g cell\n" x y;
 302   let x = x +. cell_width +. 4. in
 303   printf "  newpath %g %g moveto (unaligned read) 0.3 setgray show\n" x y;
 304   let x = x +. 72. in
 305   printf "  alignedwrite %g %g cell\n" x y;
 306   let x = x +. cell_width +. 4. in
 307   printf "  newpath %g %g moveto (aligned write) 0.3 setgray show\n" x y;
 308   let x = x +. 72. in
 309   printf "  alignedread %g %g cell\n" x y;
 310   let x = x +. cell_width +. 4. in
 311   printf "  newpath %g %g moveto (aligned read) 0.3 setgray show\n" x y;
 312   printf "} def\n";
 313
 314   printf "\n"
 315
 316 (* Draw the accesses. *)
 317 let () =
 318   (* Sort the accesses so unaligned ones are displayed at the end (on
 319    * top of aligned ones) and writes on top of reads.  This isn't
 320    * really perfect, but it'll do.
 321    *)
 322   let cmp (rw, aligned, s, n) (rw', aligned', s', n') =
 323     let r = compare rw rw' (* Write later *) in
 324     if r <> 0 then r else (
 325       let r = compare aligned' aligned (* unaligned later *) in
 326       if r <> 0 then r else
 327         compare (n, s) (n', s')
 328     )
 329   in
 330   let accesses = List.sort ~cmp accesses in
 331
 332   List.iter (
 333     fun op ->
 334       let col, s, n =
 335         match op with
 336         | Read, false, s, n ->
 337             "unalignedread", s, n
 338         | Write, false, s, n ->
 339             "unalignedwrite", s, n
 340         | Read, true, s, n ->
 341             "alignedread", s, n
 342         | Write, true, s, n ->
 343             "alignedwrite", s, n in
 344       for i = s to s+n-1 do
 345         let x, y = mapxy i in
 346         printf "%s %g %g cell\n" col x y
 347       done;
 348       printf "\n"
 349   ) accesses
 350
 351 (* Finish off the PostScript output. *)
 352 let () =
 353   printf "outline breaks labels key\n";
 354   printf "%%%%EOF\n"