diff options
Diffstat (limited to 'bin/vxworks_modify.pl')
-rwxr-xr-x | bin/vxworks_modify.pl | 578 |
1 files changed, 0 insertions, 578 deletions
diff --git a/bin/vxworks_modify.pl b/bin/vxworks_modify.pl deleted file mode 100755 index 75d4537b6be..00000000000 --- a/bin/vxworks_modify.pl +++ /dev/null @@ -1,578 +0,0 @@ -eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}' - & eval 'exec perl -S $0 $argv:q' - if 0; - -# ****************************************************************** -# Author: Chad Elliott (elliott_c@ociweb.com) -# Date: 8/14/2000 -# $Id$ -# Description: Modify c++ source for combination with other source -# files into a VxWorks module. -# ****************************************************************** - -# ****************************************************************** -# Pragma Section -# ****************************************************************** - -use strict; -use File::Basename; - -# ****************************************************************** -# Data Section -# ****************************************************************** - -my($name) = ""; -my(@types) = ("short", "int", "long", "unsigned", "size_t", - "char", "float", "double", "void", - "CORBA::Boolean", "CORBA::Short", "CORBA::UShort", - "CORBA::Long", "CORBA::ULong", "CORBA::Octet", - "CORBA::Char", "CORBA::WChar", "CORBA::LongLong", - "CORBA::ULongLong", "CORBA::Float", "CORBA::Double", - "CORBA::LongDouble", "CORBA::Environment", - ); - -# ************************************************************** -# Subroutine Section -# ************************************************************** - -sub needsToBeStatic { - my($line) = shift; - $line =~ s/^\s+//; - $line =~ s/\s+$//; - - if ($line !~ /\s*static\s+/) { - foreach my $type (@types) { - if ($line =~ /^(const\s+)?$type\s*[\*]*[\&]*\s*[^:]+/ || - $line =~ /^(const\s+)?$type\s*[\*]*[\&]*$/) { - return 1; - } - } - } -} - - -sub countChar { - my($line) = shift; - my($char) = shift; - my($len) = length($line); - my($count) = 0; - my($indouble) = 0; - my($insingle) = 0; - - for(my $i = 0; $i < $len; $i++) { - my($ch) = substr($line, $i, 1); - if ($char ne '"' && $ch eq '"') { - $indouble ^= 1; - } - elsif ($char ne '\'' && $ch eq '\'') { - $indouble ^= 1; - } - elsif ($ch eq $char && !$indouble && !$insingle) { - $count++; - } - } - return $count; -} - - -my($orbManager) = undef; -sub lookForOrbRun { - my($line) = shift; - my($status) = 0; - - if ($line =~ /([\w:\-\>\.\(\)]+)->run\s*\(.*\)/ || - $line =~ /.*orb.*\.run/ || - (defined $orbManager && ($line =~ /$orbManager.run/ || - $line =~ /$orbManager->run/))) { - $status = 1; - } - return $status; -} - - -sub modifyOrbRun { - my($line) = shift; - if (defined $orbManager && $line =~ /$orbManager/ && - $line =~ /(.*->run\s*\()([^\)]*)(\).*)/) { - my($p1) = $1; - my($p2) = $2; - my($p3) = $3; - - $p2 =~ s/^\s+//; - $p2 =~ s/\s+$//; - - # I am relying on convention here - if ($p2 !~ /\s/) { - $line = "$p1" . "TAO_TestCombinedThreads::getTimeout() " . - "ACE_ENV_ARG_PARAMETER$p3\n"; - } - } - elsif ($line =~ /(.*->run\s*\()([^\)]*)(\).*)/) { - my($p1) = $1; - my($p2) = $2; - my($p3) = $3; - - $p2 =~ s/^\s+//; - $p2 =~ s/\s+$//; - - # I am relying on convention here - if ($p2 !~ /\s/ && $p2 =~ /env/i) { - $p3 = " ACE_ENV_ARG_PARAMETER$p3"; - $p2 = ""; - } - - if ($p2 eq "") { - $line = $p1 . "TAO_TestCombinedThreads::getTimeout()" . "$p3\n"; - } - } - elsif ($line =~ /(.*\.run\s*\()([^\)]*)(\).*)/) { - my($p1) = $1; - my($p2) = $2; - my($p3) = $3; - - $p2 =~ s/^\s+//; - $p2 =~ s/\s+$//; - - # I am relying on convention here - if ($p2 !~ /\s/ && $p2 =~ /env/i) { - $line = "$p1" . "TAO_TestCombinedThreads::getTimeout() ". - "ACE_ENV_ARG_PARAMETER$p3\n"; - } - } - return $line; -} - - -sub lookForActivate { - my($line) = shift; - my($taskBase) = shift; - if ($line =~ /(\w+)\.activate/) { - $$taskBase = $1; - } -} - -my($orbInitArg) = 0; -sub lookForOrbInit { - my($line) = shift; - my($status) = 0; - if ($line =~ /CORBA::ORB_init\s*\(/) { - $orbInitArg = 0; - $status = 1; - } - return $status; -} - - -sub replaceOrbName { - my($line) = shift; - if ($orbInitArg < 3) { - if ($line =~ /ACE_ENV_ARG_PARAMETER/) { - $line =~ s/ACE_ENV_ARG_PARAMETER/,ACE_ENV_ARG_PARAMETER/; - } - my($length) = length($line); - my($previous) = 0; - for(my $i = 0; $i < $length; $i++) { - my($ch) = substr($line, $i, 1); - ## Add the substr check because the ACE_ENV_ARG_PARAMETER doesn't - ## have a comma before it and the above search and replace doesn't - ## work for multi-lined ORB_init's - if ($ch eq "," || $ch eq ")" || - ($orbInitArg == 2 && $i == $length - 1 && - substr($line, $previous) !~ /^\s+$/)) { - $orbInitArg++; - if ($ch eq ")" && $orbInitArg == 2) { - $orbInitArg = 3; - $previous = $i; - } - if ($orbInitArg == 3) { - my($size) = $i - $previous; - my($part) = substr($line, $previous, $size); - $part =~ s/^\s+//; - $part =~ s/\s+$//; - if ($part eq '""' || $part eq '0') { - substr($line, $previous, $size) = " \"$name\""; - } - elsif ($part eq '') { - substr($line, $previous, $size) = ", \"$name\""; - } - last; - } - $previous = $i + 1; - } - } - if ($line =~ /,ACE_ENV_ARG_PARAMETER/) { - $line =~ s/,ACE_ENV_ARG_PARAMETER/ ACE_ENV_ARG_PARAMETER/; - } - } - return $line; -} - - -my($initChildPOAArg) = 0; -sub lookForInitChildPOA { - my($line) = shift; - my($status) = 0; - if ($line =~ /init_child_poa\s*\(/) { - $initChildPOAArg = 0; - $status = 1; - } - return $status; -} - - -sub replaceChildOrbName { - my($line) = shift; - if ($initChildPOAArg < 4) { - if ($line =~ /ACE_ENV_ARG_PARAMETER/) { - $line =~ s/ACE_ENV_ARG_PARAMETER/,ACE_ENV_ARG_PARAMETER/; - } - my($length) = length($line); - my($previous) = 0; - my($replace) = " TAO_TestCombinedThreads::getRandomString(" . - "\"$name\").c_str()"; - - for(my $i = 0; $i < $length; $i++) { - my($ch) = substr($line, $i, 1); - ## Add the substr check because the ACE_ENV_ARG_PARAMETER doesn't - ## have a comma before it and the above search and replace doesn't - ## work for multi-lined ORB_init's - if ($ch eq "," || $ch eq ")" || - ($orbInitArg == 2 && $i == $length - 1 && - substr($line, $previous) !~ /^\s+$/)) { - $initChildPOAArg++; - if ($initChildPOAArg == 4) { - my($size) = $i - $previous; - my($part) = substr($line, $previous, $size); - # I am relying on convention here - if ($part !~ /env/i) { - substr($line, $previous, $size) = $replace; - } - else { - substr($line, $previous, 0) = "$replace,\n"; - } - last; - } - $previous = $i + 1; - } - } - if ($line =~ /,ACE_ENV_ARG_PARAMETER/) { - $line =~ s/,ACE_ENV_ARG_PARAMETER/ ACE_ENV_ARG_PARAMETER/; - } - } - return $line; -} - - -sub usageAndExit { - my($str) = shift; - if (defined $str) { - print STDERR "$str\n"; - } - print STDERR "Usage: " . basename($0) . - " [-orbcore] [-unix] [-notimeout] [-main <main prefix>]\n" . - " <input file> <output file>\n"; - exit(1); -} - - -sub modifyFileAttributes { - my($orig) = shift; - my($new) = shift; - my(@buf) = stat($orig); - - if (defined $buf[0]) { - utime($buf[8], $buf[9] + 1, $new); - } -} - - -# ************************************************************** -# Main Section -# ************************************************************** - -my($useORBCore) = 0; -my($useThreadM) = 0; -my($unixDefines) = 0; -my($useTimeouts) = 1; - -while(defined $ARGV[0] && $ARGV[0] =~ /^-/) { - if ($ARGV[0] eq '-threadmanager') { - $useThreadM = 1; - shift; - } - elsif ($ARGV[0] eq '-orbcore') { - $useORBCore = 1; - shift; - } - elsif ($ARGV[0] eq '-unix') { - $unixDefines = 1; - shift; - } - elsif ($ARGV[0] eq '-main') { - shift; - if (defined $ARGV[0]) { - $name = $ARGV[0]; - shift; - } - else { - usageAndExit("-main requires a parameter"); - } - } - elsif ($ARGV[0] eq '-notimeout') { - $useTimeouts = 0; - shift; - } - else { - usageAndExit("Unknown option: $ARGV[0]"); - } -} - -## We should have an input and output file name at this point. -if ($#ARGV != 1) { - usageAndExit(); -} - - -# ************************************************************** -# Get the basename and remove the .cpp -# We will use this as the prefix to our main function -# ************************************************************** - -if ($name eq "") { - $name = basename($ARGV[0]); - $name =~ s/\.cpp//; - $name =~ s/\-/_/g; -} - -# ************************************************************** -# Read in the file and push it into an array. Then, print it -# out when we are done modifying it. -# ************************************************************** - -my($status) = 0; -if (open(IN, $ARGV[0])) { - if (open(OUT, ">$ARGV[1]")) { - my(@lines) = (); - my($line) = ""; - if ($useThreadM) { - while(<IN>) { - $line = $_; - $line =~ s/ACE_Thread\s*::\s*join/TAO_TestCombinedThreads::thr_join/g; -# $line =~ s/^\s*template\s*class\s*.*;\s*$//g; - push(@lines, $line); - } - unshift(@lines, "#include <tests/TestUtils/TestCombinedThreads.h>\n"); - } - elsif ($useORBCore) { - my($insideInstance) = 0; - while(<IN>) { - $line = $_; -# $line =~ s/^\s*template\s*class\s*.*;\s*$//g; - if ($line =~ /^TAO_ORB_Core_instance\s*\(.*\)/) { - $insideInstance = 1; - } - if ($insideInstance && $line =~ /return\s+/) { - $line = " // Find the orb for the thread that " . - "registered the ORB id\n" . - " TAO_ORB_Core* hack = orb_table->find(" . - "TAO_TestCombinedThreads::getORBId());\n" . - " if (hack != 0) {\n" . - " return hack;\n" . - " }\n\n" . $line; - $insideInstance = 0; - } - push(@lines, $line); - } - unshift(@lines, "#include <tests/TestUtils/TestCombinedThreads.h>\n"); - } - else { - my($insideComment) = 0; - my($insideParens) = 0; - my($scope) = 0; - my($orbrunFound) = 0; - my($insideORB_init) = 0; - my($insideInitChildPOA) = 0; - my($taskBase) = ""; - while(<IN>) { - $line = $_; - - my($lookForClosingParens) = 1; - ## Remove comments - if ($line =~ /(.*)(\/\/[\/]+.*)/ || $line =~ /(.*)(\/\/.*)/) { - my($qcount) = countChar($1, '"'); - $line = "$1"; - if (($qcount & 1) == 1) { - $line .= $2; - } - $line .= "\n"; - } - if ($line =~ /(.*)(\/\*.*\*\/)(.*)/) { - $line = "$1$3\n"; - } - elsif ($line =~ /(.*)(\/\*.*)/) { - $insideComment = 1; - $line = "$1\n"; - } - elsif ($insideComment && $line =~ /(.*\*\/)(.*)/) { - $insideComment = 0; - $line = $2; - } - elsif ($insideComment) { - $line = "\n"; - } - - if ($line =~ /TAO_ORB_Manager[\*\s]*\s+(\w+)/) { - $orbManager = $1; - } - - lookForActivate($line, \$taskBase); - if ($taskBase ne "" && $line =~ /thr_mgr\s*\(\)\->wait\s*\(\)/) { - $line =~ s/\->wait\s*\(.*\)/\->wait_grp \($taskBase.grp_id\(\)\)/; - } - - $insideInitChildPOA = ($insideInitChildPOA ? 1 : - lookForInitChildPOA($line)); - if ($insideInitChildPOA) { - $line = replaceChildOrbName($line); - if ($line =~ /\)\s*;/) { - $insideInitChildPOA = 0; - } - } - - $insideORB_init = ($insideORB_init ? 1 : lookForOrbInit($line)); - if ($insideORB_init) { - $line = replaceOrbName($line); - if ($line =~ /\)\s*;/) { - $insideORB_init = 0; - } - } - - - if (!$orbrunFound && $useTimeouts) { - if ($orbrunFound = lookForOrbRun($line)) { - $line = modifyOrbRun($line); - } - } - - ## Check the scope - if ($line =~ /{/) { - $scope += countChar($line, '{'); - } - ## Check for parens - if ($line =~ /\(/) { - $insideParens += countChar($line, '('); - ## This takes care of things like - ## int parse_args(...), but allows things like - ## int parse_args(..., - ## ...) to pass through which is what we want - if ($line =~ /\)/) { - $insideParens -= countChar($line, ')'); - $lookForClosingParens = 0; - } - } - - if ($scope == 0) { - ## This section is for forward declarations - if ($line =~ /;$/) { - my($forward_done) = 0; - my($counter) = $#lines; - while(!$forward_done) { - if ($lines[$counter] =~ /,$/) { - if ($lines[$counter] =~ /\s+\w+\s*\(.*,$/ && - needsToBeStatic($lines[$counter])) { - $lines[$counter] = "static $lines[$counter]"; - $forward_done = 1; - } - } - else { - $forward_done = 1; - } - $counter--; - } - } - if (!$insideParens && needsToBeStatic($line)) { - my($test) = $lines[$#lines]; - $test =~ s/^\s+//; - $test =~ s/\s+$//; - if ($test ne "static") { - $line = "static $line"; - } - } - } - - if ($scope == 1 && $orbrunFound && - ($line =~ /\s*return/ || $line =~ /\s*ACE_RETURN/)) { - $orbrunFound = 0; - } - - # Going down in scope - if ($line =~ /}/) { - $scope -= countChar($line, '}'); - if ($orbrunFound && $scope == 1) { - $orbrunFound = 0; - } - } - if ($lookForClosingParens && $line =~ /\)/) { - $insideParens -= countChar($line, ')'); - } - - ## Work backwards to remove the static from - ## the main or a method body - if ($scope == 0 && - ($line =~ /(main\s*(\()?)/ || $line =~ /\w+\s*::\s*\w+\s*\(/)) { - if ($line =~ /^static\s+/) { - $line =~ s/static\s+//; - } - else { - if ($lines[$#lines] =~ /static\s+/) { - $lines[$#lines] =~ s/static\s+//; - } - } - } - - push(@lines, $line); - if ($line =~ /(\smain\s*(\()?)/ || $line =~ /(^main\s*(\()?)/) { - my($saved) = pop(@lines); - if ($1 !~ /^\s*int/) { - my($below) = pop(@lines); - $saved = "$below$saved"; - } - if ($unixDefines) { - push(@lines, "#define main $name" . "_main\n\n"); - } - else { - push(@lines, "#define ace_main $name" . "_main\n" . - "#define ace_main_i $name" . "_main_i\n\n"); - } - push(@lines, $saved); - } - } - ## Look for last include and append include statement - for(my $i = $#lines; $i >= 0; $i--) { - if ($lines[$i] =~ /#include\s+/) { - $lines[$i] .= "#include <tests/" . - "TestUtils/TestCombinedThreads.h>\n"; - last; - } - } - unshift(@lines, "// \$Id\$\n\n"); - } - print OUT @lines; - close(OUT); - - if ($useThreadM || $useORBCore) { - modifyFileAttributes($ARGV[0], $ARGV[1]); - } - } - else { - print STDERR "Unable to open $ARGV[1] for output\n"; - $status = 1; - } - close(IN); -} -else { - print STDERR "Unable to open $ARGV[0] for input\n"; - $status = 1; -} - -exit($status); |