#!/usr/bin/perl -w
############################################################
# gensnap
# 
# Copyright 2002 Sony Corporation 
#

use strict;
my $handle = select(STDERR);
$| = 1;                         # Isn't it default?
select($handle);

sub readSection($ );
sub outputEntry($$ );
sub calcKilo($ );
sub readOcf($ );

# reading arguments

my ($prefix, $base, $srcFile, $srcRelocFile, $ocf, $vm) = @ARGV;

# setting constants

my $relocOffset = 0x400000; # determined by the default linker script
my $snapFile = "$base.snap.cc";
my $readelf = "$prefix/bin/mipsel-linux-readelf";

# vars

my %secAddr;
my %secOffset;
my %secSize;
my %secContents;

my %obletOffsets;
my %obletImplMaj;
my %obletImplMin;
my %obletIntfMaj;
my %obletIntfMin;

my $prologueEntry;
my $entryNum = 0;

############################################################
# reading sections
#
open(ELFSECTION, "$readelf -S $srcFile |")
    || die "gensnap: can't open pipe: $readelf $srcFile: $!\n";

while (<ELFSECTION>) {
    if (m{  ^\s+\[.+\] # [Nr]
             \s+(\S*)  # Name:$1 (possibly empty)
             \s+\S+    # Type
             \s+(\S+)  # Addr:$2
             \s+(\S+)  # Offset:$3
	     \s+(\S+)  # Size:$4
	     \s+\S+    # ES
             \s+(\S*)  # Flag:$5 (possibly empty)
             \s+\S+    # Lk
             \s+\S+    # Inf
             \s+\S+    # Al
	     \s+$ 
          }x) {
	my ($name, $addr, $offset, $size, $flag) 
	    = ($1, $2, $3, $4, $5);
	next if $addr eq "Addr";
	next if $flag !~ /A/;
	$secAddr{$name} = hex($addr);
	$secOffset{$name} = hex($offset);
	$secSize{$name} = hex($size);
    }
}
close(ELFSECTION);

############################################################
# reading symbols
#
open(SYMS, "$readelf -Ws $srcFile |")
	|| die "can't open pipe: $readelf -Ws $srcFile\n";
while (<SYMS>) {
    if (/\d+:\s*(\S+)\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+Aperios_Oblet_pGOT_(\S+)_\s*$/) {
	$obletOffsets{$2} = hex($1);
    }
    elsif (/\d+:\s*\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+Aperios_Oblet_Used_(\S+)_Implementation_minor_(\d+)_\s*$/) {
	$obletImplMin{$1} = $2;
    }
    elsif (/\d+:\s*\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+Aperios_Oblet_Used_(\S+)_Implementation_major_(\d+)_\s*$/) {
	$obletImplMaj{$1} = $2;
    }
    elsif (/\d+:\s*\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+Aperios_Oblet_Used_(\S+)_Interface_minor_(\d+)_\s*$/) {
	$obletIntfMin{$1} = $2;
    }
    elsif (/\d+:\s*\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+Aperios_Oblet_Used_(\S+)_Interface_major_(\d+)_\s*$/) {
	$obletIntfMaj{$1} = $2;
    }
    elsif (/\d+:\s*(\S+)\s+\S+\s+\S+\s+\S+\s+\S+\s+\S+\s+PrologueEntry\s*$/) {
	$prologueEntry = hex($1);
    }
}
close(SYMS);

if (!defined($prologueEntry)) {
    die "gensnap: symbol PrologueEntry not fonud\n";
}
$prologueEntry = sprintf("0x%08x", $prologueEntry - $relocOffset);

############################################################
# gen file
#
my  ($instanceName, $moduleName, $metaSpace, $pic, $pid, $heaplib, 
     $stackSize, $heapSize, $sameSpace, $installSelector, $schedPriority, 
     $cache, $tlb, $mode) = readOcf($ocf);
my $type = "IINSTANCE";
$mode = ($mode eq "user" && $vm ne "novm") ? "IUSER": "IKERNEL";
$cache = ($cache eq "cache") ? "ICACHE": "INCACHE";
$tlb = ($tlb eq "tlb" && $vm ne "novm") ? "ITLB": "INTLB";

#------------------------------------------------------------
# .SnapShotHdr
#
open(SNAP, "> $snapFile")
    || die "gensnap: can't open $snapFile: $!\n";
print SNAP "// This files is generated by gensnap\n";
print SNAP "#define		USE_INITIALIZER_LIST\n";
print SNAP "#define		NEW_V131_SNAP\n";
print SNAP "#include        <SnapShotHdr.h>\n";
print SNAP "#include        <RelocationInfo.h>\n";
print SNAP "#include        <ObletInitInfo.h>\n";
print SNAP "#include        <ObletDependencyDescrList.h>\n";
print SNAP "#include	<MIPSRelocationInfo.h>\n";
print SNAP "#include        <MetaSpaceConf.h>\n";
print SNAP "\n";
print SNAP "SnapShotHdr snapshot [] =  {\n";
print SNAP "    {\n";
print SNAP "	\"$instanceName\",	/* object name */\n";
print SNAP "	\"$moduleName\",		/* module name */\n";
print SNAP "	$type,			/* object type */\n";
print SNAP "\n";
print SNAP "	/* InstanceInfo */\n";
print SNAP "	{\n";
print SNAP "	    \"$metaSpace\",	/* metaspace name */\n";
print SNAP "	    $stackSize,		/* stack size */\n";
print SNAP "	    $heapSize,		/* heap size */\n";
print SNAP "	    NULL,		/* aux */\n";
print SNAP "	    $mode,		/* execution mode */\n";
print SNAP "	    $cache,		/* cache usage */\n";
print SNAP "	    $tlb,		/* TLB usage */\n";
print SNAP "	    64,			/* number of selectors */\n";
print SNAP "	    0,			/* CPU priority */\n";
print SNAP "	    $schedPriority,	/* scheduling priority */\n";
print SNAP "	    \"$sameSpace\",	/* virtual address space */\n";
print SNAP "	},\n";
print SNAP "\n";
print SNAP "	/* Layout */\n";
print SNAP "	{\n";
print SNAP "	    (void*) 0x0,	/* segment start */\n";
print SNAP "	    (void*) 0xffffffff,	/* entry point */\n";
print SNAP "	    (void*) 0x0,	/* text segment start */\n";
print SNAP "	    (void*) 0x0,	/* text physical start */\n";
print SNAP "	    (void*) 0x0,	/* data segment */\n";
print SNAP "	    (void*) 0x0,	/* data physical start */\n";
print SNAP "	    0x0,		/* text size */\n";
print SNAP "	    0x0,		/* data size */\n";
print SNAP "	    0x0,		/* bss size */\n";
print SNAP "	},\n";
print SNAP "\n";
print SNAP "	/* RelInfo */\n";
print SNAP "	{\n";
print SNAP "	    3,		 /* relocation type */\n";
print SNAP "	    0,		 /* relocation method */\n";
print SNAP "	    NULL,	 /* aux */\n";
print SNAP "	},\n";
print SNAP "    },\n";
print SNAP "};\n";
print SNAP "\n";

#------------------------------------------------------------
# .ObletDependincyDescr
#
print SNAP "asm(\".section\t.ObletDependencyDescr\");\n";
print SNAP "ObletDependencyDescr  snapDependency [] = {\n";
my $oblet;
my $count = 0;
foreach $oblet (keys(%obletOffsets)) {
    if (!exists($obletImplMin{$oblet}) ||
	!exists($obletImplMaj{$oblet}) ||
	!exists($obletIntfMin{$oblet}) ||
	!exists($obletIntfMaj{$oblet})) {
	die "oblet version symbol not found in $srcFile: $oblet\n";
    }
    my $offset = sprintf("%08x", $obletOffsets{$oblet} - $relocOffset);
    print SNAP "  {0x$offset, \"$oblet\", " . 
	"{$obletIntfMaj{$oblet}, $obletIntfMin{$oblet}}, " .
	    "{$obletImplMaj{$oblet}, $obletImplMin{$oblet}}},\n";
    $count++;
}
print SNAP "};\n\n";

#------------------------------------------------------------
# .ObletDependincyDescrList
#
print SNAP "asm(\".section\t.ObletDependencyDescrList\");\n";
print SNAP "ObletDependencyDescrList  snapDependencyList = {\n";
print SNAP "	/*   number_of_entries, pointer_to_Descr  */\n";
print SNAP "        $count, NULL\n";
print SNAP "};\n";
print SNAP "\n";

#------------------------------------------------------------
# .RelDataEntry
#
print SNAP "asm(\".section\t.RelDataEntry\");\n";
print SNAP "MIPSRelocationEntry snapDataRelocationEntries[] = {\n";

open(READRELOC, "$readelf -r $srcRelocFile |")
    || die "can't open pipe: readelf -r $srcRelocFile : $!\n";
my %ignoreType = (
		  R_MIPS_CALL16  => 1,
		  R_MIPS_HI16    => 1,
		  R_MIPS_GPREL32 => 1,
		  R_MIPS_LO16    => 1,
		  R_MIPS_GOT16   => 1,
		  R_MIPS_PC32    => 1
		  );
my $section;
my $inTarget = 0;
while(<READRELOC>) {
    if (/Relocation section '\.rel(.*)'/) {
	$section = $1;
	$inTarget = exists($secSize{$section});
    }
    elsif ($inTarget) {
	if (/Offset\s+Info\s+Type/) {
	    # nothing to do
	}
	elsif (/(\S+)\s+\S+\s+(\S+)\s+\S+\s+(\S+)/) {
	    if ($ignoreType{$2}) {
		# nothing to do
	    }
	    elsif ($2 eq "R_MIPS_32") {
		print SNAP outputEntry($section, hex($1));
	    }
	    else {
		die "gensnap: unknown relocation type: $2\n";
	    }
	}
    }
}
close(READRELOC);

my $gotSize = $secSize{".got"};
my $i = 0;
for ($i = 0; $i < $gotSize; $i += 4) {
    print SNAP outputEntry(".got", $i);
}
print SNAP "};\n";
print SNAP "\n";

#------------------------------------------------------------
# .RelEntry
#
print SNAP "asm(\".section\t.RelEntry\");\n";
print SNAP "MIPSRelocationInfo snapRelInfo = {\n";
print SNAP "	 /* BaseRegister for text */ \n";
print SNAP "	{0x16, BaseRegister::relative, 0x0}, \n";
print SNAP "\n";
print SNAP "	/* BaseRegister for data */\n";
print SNAP "	{0x19, BaseRegister::relative, 0x8000}, \n";
print SNAP "\n";
print SNAP "	/* entry point */\n";
print SNAP "	(void*) $prologueEntry,\n";
print SNAP "	/* text relocation entry table */\n";
print SNAP "	{0, 0x0},\n";
print SNAP "	/* data relocation entry table */\n";
print SNAP "	{$entryNum, 0x0}\n";
print SNAP "};\n";
close(SNAP);
exit(0);

############################################################
# subs
#

sub readSection($ ) {
    my $section = shift;
    my $offset = $secOffset{$section};
    my $size = $secSize{$section};
    open(SRC, $srcFile)
	|| die "gensnap: can't open $srcFile\n";
    binmode(SRC);
    seek(SRC, $offset, 0)
	|| die "gensnap: can't seek $srcFile: $!\n";
    my $contents;
    if (read(SRC, $contents, $size) != $size) {
	die "gensnap: can't read $srcFile\n";
    }
    close(SRC);
    $contents;
}

sub outputEntry($$ ) {
    my ($section, $offset) = @_;
    if (!exists($secContents{$section})) {
	$secContents{$section} = readSection($section);
    }
    my $value = unpack("V", substr($secContents{$section}, $offset, 4));
    if ($value) {
	$value -= $relocOffset;
    }
    $entryNum++;
    sprintf("        {R_DataStart, R_MIPS_AP_32, 0x%x, 0x%x},\n", 
	    $secAddr{$section} + $offset - $relocOffset, $value);
}

sub readOcf($ ) {
    my $ocf = shift;
    open(OCF, "$ocf")
	|| die "gensnap: can't open $ocf\n";
    my $contents = "";
    while (<OCF>) {
	s/#.*$//;
	$contents .= $_;
    }
    close(OCF);
    my @words = split(" ", $contents);
    if (shift(@words) ne "object") {
	die "gensnap: ocf format error: $ocf\n";
    }
    my ($instanceName, $moduleName, $metaSpace, $pic, $pid, $heaplib, 
	$stackSize, $heapSize, $sameSpace, $installSelector, $schedPriority, 
	$cache, $tlb, $mode);
    if (@words == 7) {
	($instanceName, $stackSize, $heapSize, $schedPriority, $cache, $tlb, $mode)
	    = @words;
	$moduleName = $instanceName;
	$metaSpace = "mCOOP";
	$pic = "pic";
	$pid = "pid";
	$heaplib = "none";
	$sameSpace = "none";
	$installSelector = -1;
    }
    elsif (@words == 14) {
	($instanceName, $moduleName, $metaSpace, $pic, $pid, $heaplib, 
	 $stackSize, $heapSize, $sameSpace, $installSelector, $schedPriority, 
	 $cache, $tlb, $mode) 
	    = @words;
    }
    else {
	die "gensnap: ocf format error: $ocf\n";
    }
    $stackSize = calcKilo($stackSize);
    $heapSize = calcKilo($heapSize);
    return ($instanceName, $moduleName, $metaSpace, $pic, $pid, $heaplib, 
	    $stackSize, $heapSize, $sameSpace, $installSelector, $schedPriority, 
	    $cache, $tlb, $mode);
}

#   interpret number with 'K'.
#   e.g. 3K -> 3072
#
sub calcKilo($ )
{
    my $num = shift;
    if ($num =~ /(.*)[kK]$/) {
	$num = $1 * 1024;
    }
    $num;
}
