Update to Unicode 16.0.0
[xapian.git] / xapian-maintainer-tools / profiling / strace-analyse
blob2d0e912fcc9ff0e3b4ed3969c01f97f6b19717cf
1 #!/usr/bin/perl
3 # Copyright (C) 2013,2014,2019 Olly Betts
5 # Permission is hereby granted, free of charge, to any person obtaining a copy
6 # of this software and associated documentation files (the "Software"), to
7 # deal in the Software without restriction, including without limitation the
8 # rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
9 # sell copies of the Software, and to permit persons to whom the Software is
10 # furnished to do so, subject to the following conditions:
12 # The above copyright notice and this permission notice shall be included in
13 # all copies or substantial portions of the Software.
15 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18 # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19 # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
20 # FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
21 # IN THE SOFTWARE.
23 use strict;
24 use warnings;
26 # Usage:
28 # Analyses logs from the LD_PRELOAD library profiler.so or from strace.
30 # If using strace, run it like so:
32 # strace -y -s0 -efdatasync,fsync,pread64,pwrite64 -o strace.log COMMAND ARGS...
33 # ./strace-analyse strace.log
35 # Or for strace < 4.7:
37 # strace -s0 -eclose,dup,dup2,dup3,fdatasync,fsync,open,pread64,pwrite64 -o strace.log COMMAND ARGS...
38 # ./strace-analyse strace.log
40 # Passing -s0 is optional, but doing so reduces the log size by stopping strace
41 # from writing out any of the contents of blocks being read or written (default
42 # is to write up to 32 bytes).
44 # You can also pass -r, -i, -t, -tt and/or -ttt - the script can parse out the
45 # extra information these add, but it currently doesn't do anything with it.
47 # Track the filename currently corresponding to each fd (unless -y is used).
48 my @fd = qw(STDIN STDOUT STDERR);
49 while (<>) {
50 my $systime;
51 if (s/ <([0-9.]+)>$//) {
52 # -T was used.
53 $systime = 0 + $1;
55 my $time_t;
56 if (s/^\s*([0-9.]+) //) {
57 my $t = 0 + $1;
58 if ($t < 1e9) {
59 # -r was used - relative time since start of previous syscall.
60 } else {
61 # -ttt was used - seconds since epoch.
62 $time_t = $t;
64 } elsif (s/^[0-9][0-9]:[0-9][0-9]:[0-9][0-9](?:\.[0-9]*)? //) {
65 # -t or -tt was used.
67 my $addr;
68 if (s/^\[([0-9a-f]+)\] //) {
69 # -i was used: instruction pointer.
70 $addr = $1;
72 if (/^pread(?:64)?\((\d+)(?:<(.*?)>)?, .*, (\d+), (\d+)\)/) {
73 my ($fd, $path, $blocksize, $off) = ($1, $2, $3, $4);
74 my $block = $off / $blocksize;
75 $path //= $fd[$fd];
76 print "read $block from $path\n";
77 } elsif (/^pwrite(?:64)?\((\d+)(?:<(.*?)>)?, .*, (\d+), (\d+)\)/) {
78 my ($fd, $path, $blocksize, $off) = ($1, $2, $3, $4);
79 my $block = $off / $blocksize;
80 $path //= $fd[$fd];
81 print "write $block to $path\n";
82 } elsif (/^open\("(.*)".* = (\d+)$/) {
83 $fd[$2] = $1;
84 } elsif (/^openat\(AT_FDCWD, "(.*)".* = (\d+)$/) {
85 $fd[$2] = $1;
86 } elsif (/^close\((\d+)\)/) {
87 $fd[$1] = undef;
88 } elsif (/^dup[23]?\((\d+)[^<].* = (\d+)/) {
89 $fd[$2] = $fd[$1];
90 } elsif (/^f(?:data)?sync\((\d+)(?:<(.*?)>)?\)/) {
91 my $path = $2 // $fd[$1];
92 print "sync $path\n";