tools/gdb_mutex_contention.pl

#!/usr/bin/perl
#
# Licensed to the Apache Software Foundation (ASF) under one
# or more contributor license agreements.  See the NOTICE file
# distributed with this work for additional information
# regarding copyright ownership.  The ASF licenses this file
# to you under the Apache License, Version 2.0 (the
# "License"); you may not use this file except in compliance
# with the License.  You may obtain a copy of the License at
#
#      http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

# This script requires that you run futexes.stp system tap script first
# https://sourceware.org/systemtap/examples/#process/futexes.stp

use strict;
use warnings;
use Getopt::Std;

sub usage() {
  print "gdb_mutex_contention.pl -f futexes_output [-s symbols] [-m mutexes]\n";
  print "Example:\n";
  print "\tsudo timeout 30 ./futexes.stp > futexes.out\n";
  print "\tsudo ./gdb_mutex_contention.pl -f futexes.out\n";

  exit 1;
}

{
  my %opts;
  getopts('m:f:s:', \%opts);
  usage() if (! defined$opts{f});

  my $pid = 0;
  my $file = $opts{f};
  my $symbols = $opts{s} || 20;
  my $mutexes = $opts{m} || 10;
  my %locks;

  # Read output from futexes.stp
  open(INPUT, $file) || die $!;
  while(<INPUT>) {
    chomp;
    if (m/(ET_NET|traffic_server).+\[(\d+)\] lock (\S+) contended (\d+) times, (\d+) avg us/) {
      $pid = $2;
      my $lock = $3;
      my $frequency = $4;
      my $wait = $5;
      $locks{$lock}->{frequency} = $frequency;
      $locks{$lock}->{line} = $_;
      $locks{$lock}->{wait} = $wait * $frequency;
    }
  }

  # Grab the binary from the running pid
  my $binary = `ps --pid $pid -o command -h`;
  chomp $binary;

  # Print out what we are going to run gdb on
  print "Running gdb over binary: $binary and pid: $pid\n";

  # Loop over the futexes that had the highest total wait time
  my $count = 0;
  foreach my $lock (sort { $locks{$b}->{wait} <=> $locks{$a}->{wait} } keys %locks) {
    print "lock: $locks{$lock}->{line} - total wait: $locks{$lock}->{wait}\n";

    open(MACRO, "> gdb.auto.mutex.macro") || die $!;
    print MACRO "handle SIGPIPE nostop\n";
    print MACRO "handle SIGPIPE noprint\n\n";
    print MACRO "rwatch *$lock\n\n";
    print MACRO "cont\n";
    print MACRO "bt 40\n";
    close(MACRO);

    system("gdb -x gdb.auto.mutex.macro --batch $binary $pid >& gdb.out");

    open(GDB_OUT, "gdb.out") || die $!;
    my $gdb_out_lines = 1;
    while (<GDB_OUT>) {
      chomp;
      if (m|\#\d+ (.+)|) {
        print "\t$_\n";
        last if ++$gdb_out_lines > $symbols;
      }

    }
    close(GDB_OUT);
    last if ++$count > $mutexes;
    print "\n";
  }

  unlink("gdb.auto.mutex.macro");
  unlink("gdb.out");
  close(INPUT);
}