remove2.pl

#!/usr/bin/perl -w

use strict;

my $print = 0;
my %machines = ();
while (<>) {
  if (/m([0-9]+)\| ([0-9]+) ENTERING (.*):/) {
    $print = 0;
    $machines{$1} = {} unless defined $machines{$1};
    my $threads = $machines{$1};
    $threads->{$2} = [[], [], {}] unless defined $threads->{$2};
    my $held = $threads->{$2}->[0];
    my $history = $threads->{$2}->[1];
    my $orders = $threads->{$2}->[2];
    push @$held, $3;
    if ($#$held > 0) {
      my $inverse = $orders->{$3};
    ESTABLISH:
      for my $prec (@$held) {
        if ($prec eq $3) {
          last ESTABLISH;
        }
        $orders->{$prec} = {} unless defined $orders->{$prec};
        my $prechash = $orders->{$prec};
        if (!defined $prechash->{$3}) {
          $print = 24;
          print "establishing lock order $prec before $3 in $1 thread $2", $/;
          print "$1: ", join(' ', @$held), $/;
          if (defined $inverse->{$prec}) {
            print "lock order $3 before $prec violated in $1 thread $2!!", $/;
          }
          print "history since first lock:", $/;
            print join('', @$history);
          $prechash->{$3} = 1;
        }
      }
    }
  } elsif (/m([0-9]+)\| ([0-9]+) LEAVING (.*):/) {
    my $threads = $machines{$1};
    my $held = $threads->{$2}->[0];
    if ($3 ne $held->[$#$held]) {
      print "Scoped locking rules violated on $1 thread $2!!", $/;
      print " trying to unlock $3", $/;
      print " locks currently held:", $/;
      print join(' ', @$held), $/;
      $print = 24;
    }
    pop @$held;
    if ($#$held == -1) {
      my $history = $threads->{$2}->[1];
      @$history = ();
    }
  }
  if (/m([0-9]+)\| ([0-9]+)/) {
    my $threads = $machines{$1};
    my $held = $threads->{$2}->[0];
    if ($#$held >= 0) {
      my $history = $threads->{$2}->[1];
      push @$history, $_;
    }
  }
  if ($print > 0) {
    $print--;
    print $_;
  }
}