#!/usr/bin/perl
# Copywrite 2009 - Steven Rostedt
# Licensed under the terms of the GNU GPL License version 2
#
# usage:
#  rb-read.pl <binary-file> [cpu]
#
# cpu is optional. It is used to print out the cpu in the output field.
# without it, it will default to zero.
#
# This file parses the /debugfs/tracing/events directory to find all
# the registered events, and then it reads the input file and parses
# out the data to produce the event trace.
#
# The input file is a file that has been read via the
# /debugfs/tracing/binary_buffers/* files.
#
use strict;

my $timestamp;
my $pagesize;

my $type;
my $len;
my $time_delta;
my $read = 0;

my $PADDING = 0;
my $TIME_EXTEND = 1;
my $TIME_STAMP = 2;
my $DATA = 3;

my $event;
my $cpu;

my %event_types;
my %event_ids;

sub debug_print {
    return;
    printf @_;
}

sub do_read {
    my ($l) = @_;
    my $buffer;
    my $r;

    $r = read IN, $buffer, $l;
    if ($r != $l) {
	print "only read $r but expected $l\n";
	exit(0);
    }
    $read += $l;

    return $buffer;
}

sub read_page_header {
    my $header;

    $header = do_read(16);

    my($time_low, $time_high, $commit_low, $commit_hi) = unpack "I4", $header;
    
    $timestamp = $time_low + ($time_high << 32);
    $pagesize = $commit_low + ($commit_hi << 32);
}

sub read_header {
    my $header;

    $header = do_read(4);

    $header = unpack "I", $header;

    debug_print("header = %08x\n", $header);

    $type = $header & 3;
    $len = ($header & 0x1c) >> 2;

    $time_delta = $header >> 5;

    debug_print("type=%d len=%d timedelta=%x\n", $type, $len, $time_delta);

    if ($type == $PADDING) {
	debug_print("PADDING\n");

	$len = -1;

    } elsif ($type == $TIME_EXTEND) {
	debug_print("TIME_EXTEND\n");

	$header = do_read(4);
	my $time_ext = unpack "I", $header;
	$time_delta |= ($time_ext << 28);

	debug_print("  time delta = %x\n", $time_delta);
	$len = 0;

    } elsif ($type == $TIME_STAMP) {
	debug_print("TIME_STAMP\n");
	do_read(12);
	$len = 0;

    } elsif ($type == $DATA) {
	debug_print("DATA\n");

	if (!$len) {
	    $header = do_read(4);

	    $len = unpack "I", $header;

	    # Len is the size of the array, which includes the
	    # 4 bytes we just read.
	    $len -= 4;

	    debug_print("len = $len\n");
	    $len += 3;
	    $len &= ~3;
	} else {
	    $len *= 4;
	}
    } else {
	print("ERROR!!!!\n");
	exit(-1);
    }

    $timestamp += $time_delta;

    debug_print("record len=%d\n", $len);
}

sub read_event {
    my ($l) = @_;

    return if (!$l);

    $event = do_read($l);

    debug_print "read $l\n";
}

sub print_event {
    
    my ($type, $flags, $pc, $dummy, $pid, $tgid, $rest) =
	unpack "CCCcIIa*", $event;

    my $index = 12; # 4 bytes and 2 words

    debug_print("type=%d flags=%x pc=%d pid=%d tgid=%s\n",
	   $type, $flags, $pc, $pid, $tgid);

    if (!defined($event_ids{$type})) {
	print "UNKNOWN TYPE $type\n";
	return;
    }

    if (!defined(${$event_ids{$type}}{"print"})) {
	return;
    }

    my @fields;

    # use the format string to help determine type
    my $idx = 1;
    my @delims;
    my $fmt;

    $fmt = ${$event_ids{$type}}{"print"};
    $fmt =~ s/%%//;
    @delims = split /%/, $fmt;

    foreach my $f (@{${$event_ids{$type}}{"fields"}}) {
	my $field = $f->{"field"};
	my $offset = $f->{"offset"};
	my $size = $f->{"size"};
	my $delim;

	$delim = $delims[$idx++];

	debug_print(" delim: $delim\n");

	# check for holes
	if ($index < $offset) {
	    my $pad = $offset - $index;

	    $index += $pad;

	    debug_print("pad for index: $index and offset: $offset\n");

	    ($pad, $rest) = unpack "a$pad a*", $rest;
	}

	if ($field =~ /\bint\b/ || $field =~ /\blong\b/ ||
	    $field =~ /\bpid_t\b/ ) {
	    my $e;

	    if ($size == 4) {
		($e, $rest) = unpack "Ia*", $rest;
		$index += 4;

	    } elsif ($size == 8) {
		my $e2;

		($e, $e2, $rest) = unpack "IIa*", $rest;
		$e += $e2 << 32;
		$index += 8;

	    } else {
		print "Funny size for integer: $size\n";
		return;
	    }
	    $fields[$#fields+1] = $e;

	} else {
	    my $rec;

	    ($rec, $rest) = unpack "A$size a*", $rest;
	    $index += $size;

	    debug_print("non-int field: '%s'\n", $rec);

	    # Perl sucks with this. If we have a string and it
	    # has NULL characters, perl will still print those
	    # NULL characters. This hack removes them.
	    if ($delim =~ /^[\d\.]*s/) {
		my @arr = split /\000/, $rec;
		$rec = $arr[0];
	    }

	    $fields[$#fields+1] = $rec;

	}
    }

    my $secs;
    $secs = $timestamp / 1000000000;

    printf ("%10d  [%03d]  %.6f: (%s) ", $pid, $cpu, $secs,
	    $event_ids{$type}{"name"});

    if (defined(${$event_ids{$type}}{"print"})) {
	printf ${$event_ids{$type}}{"print"}, @fields;
    }
    print "\n";
}


sub read_page {
    read_page_header;

    debug_print("timestamp = %llx\n", $timestamp);
    debug_print("pagesize = %llx (%d)\n", $pagesize, $pagesize);

    my $end = $read + $pagesize;

    while ($read < $end) {

	read_header;
	if ($len) {
	    read_event($len);
	    print_event($event);
	}
    }
    # skip the rest of the page

    my $rem = $read & 0xfff;
    debug_print ("rem=%d read=%d\n", $rem, $read);
    my $rest = do_read(0x1000 - $rem);
    $rest = unpack "I", $rest;
    debug_print "rest = %x read=%d\n", $rest, $read;
}

sub find_mount {
    open (M, "/proc/mounts") || die "can't open mounts file\n";

    my $debugfs;

    while (<M>) {
	if (/^debugfs\s+(\S+)\s/) {
	    $debugfs = $1;
	    last;
	}
    }
    defined($debugfs) || die "can't find debugfs mount\n";

    return $debugfs;
}

sub read_format {
    my ($event_format, $file) = @_;

    if (defined($event_types{$event_format})) {
	die "$event_format already defined!";
    }
    $event_types{$event_format} = 1;

    my %hash;
    my @hdr;
    my @fields;

    debug_print "reading $file\n";
    debug_print "  for event $event_format\n";

    my ($name, $id, $print_fmt);

    my $format = 0;

    open (F, $file) || die "can't read $file\n";
    while (<F>) {
	chomp;
	if (/^\s*name:\s*(.*)$/) {
	    $name = $1;
	    debug_print "name = $name\n";
	    $hash{"name"} = $name;

	} elsif (/^\s*ID:\s*(\d+)/) {
	    $id = $1;
	    debug_print "id = $id\n";

	} elsif (/^\s*print fmt:\s"*(.*)"\s*$/) {
	    $print_fmt = $1;
	    debug_print ("print_fmt = %s\n", $print_fmt);
	    $hash{"print"} = $print_fmt;

	} elsif (/^\s*format:/) {
	    $format = 1;

	} elsif ($format) {
	    if (/^\s*$/) {
		$format++;
		next;
	    }
	    if (/^\s*field( special)?:([^;]*);\s*offset:(\d+);\s*size:(\d+);/) {
		my ($special, $field, $offset, $size) = ($1, $2, $3, $4);

		my %fhash;
		$fhash{"field"} = $field;
		$fhash{"offset"} = $offset;
		$fhash{"size"} = $size;
		if (defined($special)) {
		    $fhash{"special"} = 1;
		} else {
		    $fhash{"special"} = 0;
		}

		if ($format == 1) {
		    debug_print "hdr ";
		    $hdr[$#hdr+1] = \%fhash;
		} else {
		    $fields[$#fields+1] = \%fhash;
		}
		    
		debug_print "field: $field, offset: $offset, size: $size\n";
	    }
	}
    }

    if (defined($event_ids{$id})) {
	print "WARNING ID $id IS DUPLICATED\n";
	return;
    }

    $hash{"name"} = $name;
    $hash{"hdr"} = \@hdr;
    $hash{"fields"} = \@fields;

    $event_ids{$id} = \%hash;
}

sub check_subsys {
    my ($subsys, $dir) = @_;

    debug_print ("read sys $subsys  $dir\n");
    opendir DIR, $dir;
    my @files = readdir DIR;
    closedir DIR;

    foreach my $file (@files) {
	my $f = "$dir/$file";
	if (-d $f) {
	    if (-f "$f/format") {
		read_format("$subsys:$file", "$f/format");
	    }
	}
    }
}

sub read_formats() {
    my $mount = find_mount;

    debug_print "$mount\n";

    my $eventdir = $mount . "/tracing/events";
    if (! -d $eventdir) {
	die "$eventdir does not exist\n";
    }

    opendir DIR, $eventdir || die "can't open $eventdir";

    my @files = readdir DIR;

    closedir DIR;

    foreach my $dir (@files) {
	next if ($dir =~ /^\./);
	my $d = "$eventdir/$dir";
	if (-d "$d") {
	    if (-f "$d/format") {
		read_format($dir, "$d/format");
	    }
	    check_subsys($dir, $d);
	}
    }
}

$#ARGV >= 0 || die "usage: rb-read.pl <inputfile> [cpu]\n";

my $file;
($file, $cpu) = @ARGV;

$cpu = 0 if (!defined($cpu));

read_formats;

open(IN, $file) || die "can't read $file\n";

for (;;) {
    read_page;
};