From 3374af6d26f8a75cfc4eb3084dc53dd63e77bc16 Mon Sep 17 00:00:00 2001
From: Sergey Petrov <s.petrov@postgrespro.ru>
Date: Wed, 28 Dec 2016 08:50:53 +0300
Subject: [PATCH] AIX stack probes and stack collapse script

---
 aix-perf.pl          | 31 ++++++++++++++++++++++
 stackcollapse-aix.pl | 61 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 92 insertions(+)
 create mode 100755 aix-perf.pl
 create mode 100755 stackcollapse-aix.pl

diff --git a/aix-perf.pl b/aix-perf.pl
new file mode 100755
index 00000000..1edd082e
--- /dev/null
+++ b/aix-perf.pl
@@ -0,0 +1,31 @@
+#!/usr/bin/perl
+
+use Getopt::Std;
+
+getopt('urt');
+
+unless ($opt_r && $opt_t){
+	print "Usage: $0 [ -u user] -r sample_count -t sleep_time\n";
+	exit(0);
+}
+
+my $i;
+my @proc = "";
+for ($i = 0; $i < $opt_r ; $i++){
+    if ($opt_u){
+	$proc = `/usr/sysv/bin/ps -u $opt_u `;
+	$proc =~ s/^.*\n//;
+	$proc =~ s/\s*(\d+).*\n/\1 /g;
+	@proc = split(/\s+/,$proc);
+    } else {
+	opendir(my $dh, '/proc') || die "Cant't open /proc: $!";
+	@proc = grep { /^[\d]+$/ } readdir($dh);
+	closedir ($dh);
+    }	
+
+    foreach my $pid (@proc){
+	my $command = "/usr/bin/procstack $pid";
+	print `$command 2>/dev/null`;
+    }
+    select(undef, undef, undef, $opt_t);
+}
diff --git a/stackcollapse-aix.pl b/stackcollapse-aix.pl
new file mode 100755
index 00000000..8456d56b
--- /dev/null
+++ b/stackcollapse-aix.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/perl -ws
+#
+# stackcollapse-aix  Collapse AIX /usr/bin/procstack backtraces
+#
+# Parse a list of backtraces as generated with the poor man's aix-perf.pl
+# profiler 
+#
+
+use strict;
+
+my $process = "";
+my $current = "";
+my $previous_function = "";
+
+my %stacks;
+
+while(<>) {
+  chomp;
+  if (m/^\d+:/) {
+    if(!($current eq "")) {
+      $current = $process . ";" . $current;
+      $stacks{$current} += 1;
+      $current = "";
+    }
+    m/^\d+: ([^ ]*)/;
+    $process = $1;
+    $current = "";
+  }
+  elsif(m/^---------- tid# \d+/){
+    if(!($current eq "")) {
+      $current = $process . ";" . $current;
+      $stacks{$current} += 1;
+    }
+    $current = "";
+  }
+  elsif(m/^(0x[0-9abcdef]*) *([^ ]*) ([^ ]*) ([^ ]*)/) {
+    my $function = $2;
+    my $alt = $1;
+    $function=~s/\(.*\)?//;
+    if($function =~ /^\[.*\]$/) {
+      $function = $alt;
+    }
+    if ($current) {
+      $current = $function . ";" . $current;
+    }
+    else {
+      $current = $function;
+    }
+  }
+}
+
+if(!($current eq "")) {
+  $current = $process . ";" . $current;
+  $stacks{$current} += 1;
+  $current = "";
+  $process = "";
+}
+
+foreach my $k (sort { $a cmp $b } keys %stacks) {
+  print "$k $stacks{$k}\n";
+}