Listing 1: vtrace

#! /usr/bin/perl
# Listing 1
# Program:      vtrace
# Usage:        vtrace process-id
# Output:       The stack trace for the process

eval "exec perl -S $0 ${1+\"$@\"}"
if $running_under_some_shell;

require "open2.pl";

if ($#ARGV < 0 || @ARGV[0] eq '-?') {
die "Usage: vtrace pid\n";
}
else {
$pslot = &get_pslot(@ARGV[0]);
if ($pslot == -1) {
die "Cannot process PID @ARGV[0].\n";
}
else {
print &get_trace($pslot);
}
0;
}

# Function:     get_pslot
# Usage:        &get_pslot(process-id)
# Return:       The process slot number for the process with the process-id.

sub get_pslot
{
local($pid) = @_;

&open2("INCRASH", "OUTCRASH", "crash 2>/dev/null");
print OUTCRASH "p #", $pid, "\n";
close(OUTCRASH);
$slot = -1;
while (<INCRASH>) {
if (/^SLOT/o) {
$_ = <INCRASH>;
s/^[\s]*//o;
if (/not/o) {
$slot = -1;
}
else {
($slot) = split;
}
last;
}
}
close(INCRASH);
$slot;
}

# Function:     get_trace
# Usage:        &get_trace(process-slot)
# Return:       The system call stack trace for the process.

sub get_trace
{
local($pid) = @_;
local(@tr_out) = ();

&open2("INCRASH", "OUTCRASH", "crash 2>/dev/null");
print OUTCRASH "t $pid\n";
close(OUTCRASH);
@tr_out = <INCRASH>;
close(INCRASH);
@tr_out;
}