#!/usr/bin/perl -w use strict; use English; # gives us $OSNAME use File::Temp; use File::Spec; use Cwd; my @ADAPTER_OPTIONS = (); my @TRKSERVEROPTIONS = (); my $DUMP_POSTFIX ='.bin'; my $ENDIANESS ='little'; my $isUnix = $OSNAME eq 'linux' ? 1 : 0; my $MAKE= $isUnix ? 'make' : 'nmake'; my $trkservername; my $runTrkServer = 1; my $waitAdapter = 0; my $usage=<; $trkservername = ('TRKSERVER-' . $userid) unless defined $trkservername; my $gdbserverip= '127.0.0.1'; my $gdbserverport= 2222 + $userid; system('fuser', '-n', 'tcp', '-k', $gdbserverport) if ($isUnix); # Who writes that? my $tempFile = File::Spec->catfile(File::Temp::tempdir(), $trkservername); unlink ($tempFile) if -f $tempFile; # ------- Launch trkserver if ($runTrkServer) { my $MEMORYDUMP='TrkDump-78-6a-40-00' . $DUMP_POSTFIX; my @ADDITIONAL_DUMPS=('0x00402000' . $DUMP_POSTFIX, '0x786a4000' . $DUMP_POSTFIX, '0x00600000' . $DUMP_POSTFIX); my @TRKSERVER_ARGS; if ($isUnix) { push(@TRKSERVER_ARGS, File::Spec->catfile(File::Spec->curdir(), 'trkserver')); } else { push(@TRKSERVER_ARGS, 'cmd.exe', '/c', 'start', File::Spec->catfile(File::Spec->curdir(), 'debug', 'trkserver.exe')); } push(@TRKSERVER_ARGS, @TRKSERVEROPTIONS, $trkservername, $MEMORYDUMP, @ADDITIONAL_DUMPS); print '### Executing: ', join(' ', @TRKSERVER_ARGS), "\n"; my $trkserverpid = fork(); if ($trkserverpid == 0) { exec(@TRKSERVER_ARGS); exit(0); } push(@ADAPTER_OPTIONS, '-s'); sleep(1); } # ------- Launch adapter my @ADAPTER_ARGS; if ($isUnix) { push(@ADAPTER_ARGS, File::Spec->catfile(File::Spec->curdir(), 'adapter')); } else { push(@ADAPTER_ARGS, 'cmd.exe', '/c', 'start', File::Spec->catfile(File::Spec->curdir(), 'debug', 'adapter.exe')); } push(@ADAPTER_ARGS, @ADAPTER_OPTIONS, $trkservername, $gdbserverip . ':' . $gdbserverport); print '### Executing: ', join(' ', @ADAPTER_ARGS), "\n"; my $adapterpid=fork(); if ($adapterpid == 0) { exec(@ADAPTER_ARGS); exit(0); } die ('Unable to launch adapter') if $adapterpid == -1; if ($waitAdapter > 0) { print '### kill -USR1 ',$adapterpid,"\n"; waitpid($adapterpid, 0); } # ------- Write out .gdbinit my $gdbInit = <' . $gdbInitFile) or die ('Cannot write to ' . $gdbInitFile . ' ' . $!); print GDB_INIT $gdbInit; close( GDB_INIT);