1 #!/usr/bin/ocamlrun /usr/bin/ocaml
6 (* Convert *.qtr (qemu block device trace) to Postscript. By Richard
7 * W.M. Jones <rjones@redhat.com>.
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.
18 type op = Read | Write
20 (* If 'true' then print debug messages. *)
23 (* Width of each row (in sectors) in the output. *)
26 (* Desirable alignment (sectors). *)
29 (* Height (in 1/72 inch) of the final image. *)
32 (* Width (in 1/72 inch) of the final image. *)
35 (* Reserve at left for the sector number (comes out of width). *)
39 if Array.length Sys.argv = 2 then
42 failwith "usage: tracetops filename.qtr"
44 (* Read the input file. *)
45 let nb_sectors, accesses =
46 let chan = open_in input in
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"
52 sscanf summary "S %d" (fun x -> x) in
54 if nb_sectors mod row_size <> 0 then
55 failwith (sprintf "input nb_sectors (%d) not divisible by row size (%d)"
58 (* Read the reads and writes from the remainder of the file. *)
59 let accesses = ref [] in
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
65 | 'R' -> Read | 'W' -> Write
67 (sprintf "%s: error reading input: got '%c', expecting 'R' or 'W'"
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;
78 failwith (sprintf "%s: error reading input: %s" input msg)
82 let accesses = List.rev !accesses in
85 eprintf "%s: nb_sectors = %d, accesses = %d\n"
86 input nb_sectors (List.length accesses)
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
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;
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
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) :: []
113 | (false, _) :: (false, _) :: (true, _) :: rest
114 | (false, _) :: (true, _) :: rest
115 | (true, _) :: rest ->
117 | (false, i1) :: rest ->
119 let rest = List.dropwhile (function (v, _) -> not v) rest in
122 | (_, i2) :: rest -> (i0, i1) :: loop i2 rest)
125 loop 0 (List.tl rows) in
128 eprintf "%s: rows = %d (ranges = %d)\n" input nr_rows (List.length ranges);
131 eprintf " %d - %d (rows %d - %d)\n"
132 (i0 * row_size) ((i1 + 1) * row_size - 1) i0 i1
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
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
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
153 (* Create a higher-order function to iterate over the rows. *)
154 let rec iter_rows f =
155 let rec loop row = function
159 let y = float (row+i-i0) *. row_height in
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
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
175 let row_y = Hashtbl.create nr_rows in
179 | Some i -> Hashtbl.replace row_y i y
183 (* Create a function which maps from the sector number to the final
184 * position that we will draw it.
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
193 iter_rows, mapxy, row_height, cell_width
195 (* Start the PostScript file. *)
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";
207 printf "/min { 2 copy gt { exch } if pop } def\n";
208 printf "/max { 2 copy lt { exch } if pop } def\n";
210 (* Function for drawing cells. *)
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";
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";
227 (* Get width of text. *)
228 printf "/textwidth { stringwidth pop } def\n";
230 (* Draw the outline. *)
231 printf "/outline {\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";
241 (* Draw the outline breaks. *)
242 printf "/breaks {\n";
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
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";
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"
268 f (sn_width -. 6.) (sn_width +. 6.);
269 f (width -. 6.) (width +. 6.)
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;
282 let sector = i * row_size in
284 printf " /s { (%d) } def\n" sector;
285 printf " %g s textwidth sub 4 sub %g moveto\n" sn_width (y +. 2.);
293 printf " /Times-Roman findfont\n";
294 printf " 10. scalefont\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;
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;
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;
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;
316 (* Draw the accesses. *)
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.
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')
330 let accesses = List.sort ~cmp accesses in
336 | Read, false, s, n ->
337 "unalignedread", s, n
338 | Write, false, s, n ->
339 "unalignedwrite", s, n
340 | Read, true, 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
351 (* Finish off the PostScript output. *)
353 printf "outline breaks labels key\n";