[cig-commits] commit: Added some analysis scripts for Underworld in ./scripts/macroanalyze
Mercurial
hg at geodynamics.org
Tue Mar 23 10:33:10 PDT 2010
changeset: 268:7bf0431deb5f
branch: 1.4.x
user: mvelic at localhost.localdomain
date: Thu Feb 04 16:24:29 2010 +1100
files: script/macroanalyze/createtables.sh script/macroanalyze/doominc.pl script/macroanalyze/doomstr.pl script/macroanalyze/getdefargs.pl script/macroanalyze/getstructs.pl script/macroanalyze/lineage.pl script/macroanalyze/proto.pl script/macroanalyze/readdefarg.pl script/macroanalyze/readme.txt script/macroanalyze/readstruct.pl script/macroanalyze/rungetdefs.sh script/macroanalyze/rungetstructs.sh script/macroanalyze/runproto.sh
description:
Added some analysis scripts for Underworld in ./scripts/macroanalyze
See the readme.txt file located there.
diff -r 5dc06c77b275 -r 7bf0431deb5f script/macroanalyze/createtables.sh
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/script/macroanalyze/createtables.sh Thu Feb 04 16:24:29 2010 +1100
@@ -0,0 +1,5 @@
+#!/bin/sh
+rm -f proto.txt defargs.txt parentchildhashtable.txt structs.txt
+./script/macroanalyze/runproto.sh
+./script/macroanalyze/rungetdefs.sh
+./script/macroanalyze/rungetstructs.sh
diff -r 5dc06c77b275 -r 7bf0431deb5f script/macroanalyze/doominc.pl
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/script/macroanalyze/doominc.pl Thu Feb 04 16:24:29 2010 +1100
@@ -0,0 +1,528 @@
+#################################################################################################################################
+#################################################################################################################################
+sub getargsfromdefarg{
+ my ($str) = @_;
+ my $res;
+ if($str=~/_(\w+)_New/){
+ $str = uc $1;
+ $str = "$str"."_DEFARGS";
+ }
+ #if($str eq "STG_CLASS_DEFARGS" || $str eq "STG_OBJECT_DEFARGS" || $str eq "STG_COMPONENT_DEFARGS"){
+ if($str eq "STG_CLASS_DEFARGS"){
+ #print "str is $str\n";
+ $str="SizeT _sizeOfSelf, Type type, Stg_Class_DeleteFunction* _delete, Stg_Class_PrintFunction* _print, Stg_Class_CopyFunction* _copy";
+ return "$str";
+ }
+ else{
+ my $nextpart = $getdefarg{ $str };
+ #print "str is $str\n";
+ if($nextpart ne ''){
+ #print "From defargs.txt \n $nextpart\n";
+ $nextpart =~ s/\n//g;
+ $nextpart =~ s/\\//g;
+ $nextpart =~ s/\s+/ /g;
+ $nextpart =~ /\#define\s+(\w+)\s+(\w+)\s*\,*\s*(.*)/;
+ if($nextpart eq ''){
+ return "Failed!\n";
+ }
+ my $rem = $3;
+ #print "$1 $2 $3 \n";
+ my $tmp=$2;
+ $tmp=~s/\s*(\w+)\s*/$1/;
+ $tmp=~s/(\w+)_\w*ARGS/$1_DEFARGS/; ## some of the defs in this file have *_ARGS instead of *_DEFARGS
+ #print "XX$tmp -- $nextpart"."XX\n";
+ if($tmp =~ /SizeT/){
+ return "$tmp"." $rem";
+ }
+ my $str = &getargsfromdefarg($tmp);
+ if($rem ne ''){
+ $res = "$str".", $rem";
+ }
+ else{
+ $res = "$str";
+ }
+ return $res;
+ }
+ else{
+ return "str $str Failed";
+ }
+ }
+
+}
+sub getall{
+ my ($str) = @_;
+ my $res;
+ if($str=~/_(\w+)_New/){
+ $str = uc $1;
+ $str = "$str"."_DEFARGS";
+ }
+ #if($str eq "STG_CLASS_DEFARGS" || $str eq "STG_OBJECT_DEFARGS" || $str eq "STG_COMPONENT_DEFARGS"){
+ if($str eq "STG_CLASS_DEFARGS"){
+ #print "str is $str\n";
+ $str="SizeT _sizeOfSelf, Type type, Stg_Class_DeleteFunction* _delete, Stg_Class_PrintFunction* _print, Stg_Class_CopyFunction* _copy";
+ return "$str";
+ }
+ else{
+ my $nextpart = $getproperdefarg{ $str };
+ print "str is $str\n";
+ if($nextpart eq ''){
+ return "Failed!\n";
+ }
+ if($nextpart ne ''){
+ $nextpart =~ s/\n//g;
+ $nextpart =~ s/\s+/ /g;
+ $nextpart =~ s/\\//g;
+ $nextpart =~ /\#define\s*\\?\s*(\w+)\s+(\w+)\s*\,*\s*(.*)/;
+ my $rem = $3;
+ #print "$1 $2 $3 $rem\n";
+ my $tmp=$2;
+ $tmp=~s/\s*(\w+.*\w+)\s*/$1/;
+ my $str = &getall($tmp);
+ if($rem ne ''){
+ #$res = "$str".", $rem";
+ $res = "$str".", $rem";
+ }
+ else{
+ $res = "$str";
+ }
+ return $res;
+ }
+ else{
+ return "str $str Failed";
+ }
+ }
+
+}
+sub getlocationofArg{# returns first location of arg in list
+ my($arg, @list) = @_;
+ my $i;
+ my $loc=-1;
+ for $i (0 ..$#list){
+ if($arg eq $list[$i]){
+ $loc = $i;
+ return $loc;
+ }
+ }
+ return $loc;
+}
+sub getlocationArrayofArgs{
+ my ($a, $l) = @_;
+ my @args;
+ my @list;
+ my $i;
+ my @loc;
+ @args = @$a;
+ @list = @$l;
+ for $i (0 .. $#args){
+ $loc[$i]=&getlocationofArg($args[$i], at list);
+ if($loc[$i] != -1){
+ $list[$loc[$i]] = "$list[$loc[$i]]"."removed"; # remove arg from list so we don't find it twice if we have repeated args
+ }
+ }
+ return @loc;
+}
+sub getlocationArrayofArgsNEWOLD{
+ my ($ta, $a, $tb, $b) = @_;
+ my @args;
+ my @list;
+ my $i;
+ my @loc;
+ my $tmp;
+ @targsA=@$ta;
+ @targsB=@$tb;
+ @argsA = @$a;
+ @argsB = @$b;
+ for $i (0 .. $#targsA){
+ $tmp = "$targsA[$i]"."$argsA[$i]";
+ $tmp =~ s/_//g;
+ $tmp =~ s/\*//g;
+ $tmp = uc $tmp;
+ $args[$i]=$tmp;
+ }
+ for $i (0 .. $#targsB){
+ $tmp = "$targsB[$i]"."$argsB[$i]";
+ $tmp =~ s/_//g;
+ $tmp =~ s/\*//g;
+ $tmp = uc $tmp;
+ $list[$i]=$tmp;
+ }
+ for $i (0 .. $#args){
+ $loc[$i]=&getlocationofArg($args[$i], at list);
+ if($loc[$i] != -1){
+ $list[$loc[$i]] = "$list[$loc[$i]]"."removed"; # remove arg from list so we don't find it twice if we have repeated args
+ }
+ }
+ return @loc;
+}
+sub cleanargs{
+ my (@args) = @_;
+ my $i=0;
+ foreach $term (@args){
+ $term =~ s/^\s*(.+)/$1/;
+ if($term =~ /^(.+)\s+$/){ $term = $1;}
+ $args[$i] = $term;
+ $i++;
+ }
+ return @args;
+}
+sub capandreduceargs{
+ my (@args) = @_;
+ my $i=0;
+ foreach $term (@args){
+ $term =~ s/^\s*(.+)/$1/;
+ if($term =~ /^(.+)\s+$/){ $term = $1;}
+ $term =~ s/_//g;
+ $term = uc $term;
+ $args[$i] = $term;
+ $i++;
+ }
+ return @args;
+}
+sub gettypes{
+ my ($key) = @_;
+ my $args;
+ my $argsarray;
+ my $term;
+ my $stars;
+ my $word;
+ my @type=();
+ my $i;
+
+ #print "$key in gettypes\n";
+ #print Dumper(@type);
+ #print " ..in gettypes\n";
+ $args = $getproto{$key};
+ $args =~ s/\r//g;
+ #print "In getypes $key gives\n$args\n";
+ @argsarray = split(/,/,$args);
+ #print Dumper(@argsarray);
+ $i=0;
+ if($#argsarray > 0){
+
+ foreach $term (@argsarray){
+ #print "$term\n";
+ $term =~ s/^\s*(.+)/$1/;
+ if($term =~ /^(.+)\s+$/){ $term = $1;}
+ if($term =~ /$reg/){
+ #print "$1 $2 $3\n";
+ $stars = $2;
+ $word = $1;
+
+ #$var[$i] = "$3";
+
+ #print "$word >>$3<<\n";
+
+ $stars =~ s/\s+//g;
+ $word =~ s/\s+/ /g;
+ $type[$i] = "$word$stars";
+ #print "$type[$i] >$var[$i]<\n";
+ }
+ else{
+ print "Empty arg? >>$args<<\n";
+
+ exit;
+ }
+ #print "$term\n";
+
+
+ $i++;
+ }#foreach
+ }
+ return @type;
+}
+sub getvars{
+ my ($key) = @_;
+ my $args;
+ my $argsarray;
+ my $term;
+ my @var=();
+ my $i;
+
+ #print "$key in getvars\n";
+ #print Dumper(@var);
+ #print ".. in getvars\n";
+ $args = $getproto{$key};
+ $args =~ s/\r//g;
+ #print "$args\n";
+ @argsarray = split(/,/,$args);
+ #print Dumper(@argsarray);
+ $i=0;
+ if($#argsarray > 0){
+
+ foreach $term (@argsarray){
+ #print "$term\n";
+ $term =~ s/^\s*(.+)/$1/;
+ if($term =~ /^(.+)\s+$/){ $term = $1;}
+ if($term =~ /$reg/){
+ #print "$1 $2 $3\n";
+ #$stars = $2;
+ #$word = $1;
+
+ $var[$i] = "$3";
+
+ #print "$word >>$3<<\n";
+
+ #$stars =~ s/\s+//g;
+ #$word =~ s/\s+/ /g;
+ #$type[$i] = "$word$stars";
+ #print "$type[$i] >$var[$i]<\n";
+ }
+ else{
+ print "Empty arg in getvars? >>$args<<\n";
+ print "filename $filename\n";
+ exit;
+ }
+ #print "$term\n";
+
+
+ $i++;
+ }#foreach
+ }
+ return @var;
+}
+sub gettypesfromstr{
+ my ($args) = @_;
+ my $argsarray;
+ my $term;
+ my $stars;
+ my $word;
+ my @type=();
+ my $i;
+
+ $args =~ s/\r//g;
+ #print "$args\n";
+ @argsarray = split(/,/,$args);
+ #print Dumper(@argsarray);
+ $i=0;
+ if($#argsarray > 0){
+
+ foreach $term (@argsarray){
+ #print "$term\n";
+ $term =~ s/^\s*(.+)/$1/;
+ if($term =~ /^(.+)\s+$/){ $term = $1;}
+ if($term =~ /$reg/){
+ #print "$1 $2 $3\n";
+ $stars = $2;
+ $word = $1;
+
+ #$var[$i] = "$3";
+
+ #print "$word >>$3<<\n";
+
+ $stars =~ s/\s+//g;
+ $word =~ s/\s+/ /g;
+ $type[$i] = "$word$stars";
+ #print "$type[$i] >$var[$i]<\n";
+ }
+ else{
+ print "Empty arg? gettypesfromstr >>$args<<\n";
+ print "filename $filename\n";
+ exit;
+ }
+ #print "$term\n";
+
+
+ $i++;
+ }#foreach
+ }
+ return @type;
+}
+sub getvarsfromstr{
+ my ($args) = @_;
+ my $argsarray=();
+ my $term;
+ my @var=();
+ my $i;
+
+ $args =~ s/\r//g;
+ if($args =~ /\,/){## need at least one comma for a list
+ @argsarray = split(/,/,$args);
+ }
+ else{## handle case where we have a list of one element
+ $argsarray[0] = $args;
+ $term=$args;
+ $term =~ s/^\s*(.+)/$1/;
+ if($term =~ /^(.+)\s+$/){ $term = $1;}
+ if($term =~ /$reg/){
+
+ $var[0] = "$3";
+
+ }
+ #print "HERE >>$args<< >>$var[0]<<\n\n";
+ return @var;
+ }
+ #print Dumper(@argsarray);
+ $i=0;
+ if($#argsarray > 0){
+
+ foreach $term (@argsarray){
+ #print "$term\n";
+ $term =~ s/^\s*(.+)/$1/;
+ if($term =~ /^(.+)\s+$/){ $term = $1;}
+ if($term =~ /$reg/){
+
+ $var[$i] = "$3";
+
+ }
+ else{
+ print "Empty arg in getvarsfromstr? >>$args<<\n";
+ print "filename $filename\n";
+ exit;
+ }
+ #print "$term\n";
+
+
+ $i++;
+ }#foreach
+ }
+ return @var;
+}
+sub getclass{
+ my ($fn) = @_;
+ my $class = $fn;
+
+ if($class =~ /_*(\w+)_[A-Za-z]*New/){
+ $class = $1;
+ $class = uc $class;
+ } else { $class = 'x'; }
+
+ return $class;
+}
+sub getfargsverbatim{
+ my ($fn) = @_;
+ my $args = $fn;
+ $args =~ s/\w+New[^()]*($paren)[^{}]*.*/$1/s;
+ $args =~ s/\((.*)\)/$1/s;
+ return $args;
+}
+sub cleanstr{
+ my ($str) = @_;
+ $str =~ s/^\((.*)\)$/$1/s;
+ $str =~ s{/\* (?: (?!\*/). )* \*/}{}gxs; #match /*any*/ as long as 'any' does not contain '*/'
+ $str =~ s/assert\s*$paren\s*\;//; # get rid of pesky assert functions
+ $str =~ s{//.*}{}g; # get rid of any c++ style comments as well
+ $str =~ s{\n([ \t]*\n)*}{\n}g;
+ $str =~ s{^([ \t]*\n)+}{}g;
+ $str =~ s/\n//g;
+ $str =~ s/[ \t]+/ /g;
+ return $str;
+}
+sub getfargs{
+ my ($fn) = @_;
+ my $args = $fn;
+ $args =~ s/\w+New[^()]*($paren)[^{}]*.*/$1/s;
+ $args =~ s/^\((.*)\)$/$1/s;
+ $args =~ s{/\* (?: (?!\*/). )* \*/}{}gxs; #match /*any*/ as long as 'any' does not contain '*/'
+ $args =~ s{//.*}{}g; # get rid of any c++ style comments as well
+ $args =~ s{\n([ \t]*\n)*}{\n}g;
+ $args =~ s{^([ \t]*\n)+}{}g;
+ $args =~ s/\n//g;
+ $args =~ s/[ \t]+/ /g;
+ return $args;
+}
+sub getfargsany{
+ my ($fn) = @_;
+ my $args = $fn;
+ $args =~ s/\w+[^()]*($paren)[^{}]*.*/$1/s;
+ $args =~ s/^\((.*)\)$/$1/s;
+ $args =~ s{/\* (?: (?!\*/). )* \*/}{}gxs; #match /*any*/ as long as 'any' does not contain '*/'
+ $args =~ s{//.*}{}g; # get rid of any c++ style comments as well
+ $args =~ s{\n([ \t]*\n)*}{\n}g;
+ $args =~ s{^([ \t]*\n)+}{}g;
+ $args =~ s/\n//g;
+ $args =~ s/[ \t]+/ /g;
+ return $args;
+}
+sub getfname{
+ my ($fn) = @_;
+ my $name = $fn;
+ $name =~ s/(^\w+New\w*)\s*\(.*$/$1/s;
+ return $name;
+}
+sub getfnameany{
+ my ($fn) = @_;
+ my $name = $fn;
+ $name =~ s/(^\w+)\s*\(.*$/$1/s;
+ return $name;
+}
+sub getfbodyverbatim{
+ my ($fn) = @_;
+ my $body = $fn;
+ $body =~ s/\w+New[^{}]*($cparen)[^{}]*/$1/s;
+ return $body;
+}
+sub getfbodyverbatimany{
+ my ($fn) = @_;
+ my $body = $fn;
+ $body =~ s/\w+[^{}]*($cparen)[^{}]*/$1/s;
+ return $body;
+}
+sub getfbody{
+ my ($fn) = @_;
+ my $body = $fn;
+ $body =~ s/\w+New[^{}]*($cparen)[^{}]*/$1/s; #match /*any*/ as long as 'any' does not contain '*/'
+ $body =~ s/assert\s*$paren\s*\;//; # get rid of pesky assert functions
+ $body =~ s{/\* (?: (?!\*/). )* \*/}{}gxs;
+ $body =~ s{\#if 0(?:(?!\#endif).)*\#endif}{}gs;
+ $body =~ s{\/\/.*}{}g;
+ $body =~ s{^[ \t]*\n([ \t]*\n)*}{\n}g;
+ #$body =~ s{^([ \t]*\n)+}{}g; #removes all blank lines
+ return $body;
+}
+sub getfbodyany{
+ my ($fn) = @_;
+ my $body = $fn;
+ $body =~ s/\w+[^{}]*($cparen)[^{}]*/$1/s; #match /*any*/ as long as 'any' does not contain '*/'
+ $body =~ s/assert\s*$paren\s*\;//; # get rid of pesky assert functions
+ $body =~ s{/\* (?: (?!\*/). )* \*/}{}gxs;
+ $body =~ s{\#if 0(?:(?!\#endif).)*\#endif}{}gs;
+ $body =~ s{\/\/.*}{}g;
+ $body =~ s{^[ \t]*\n([ \t]*\n)*}{\n}g;
+ #$body =~ s{^([ \t]*\n)+}{}g; #removes all blank lines
+ return $body;
+}
+sub getYnotinX{#returns Y-(Y && X)
+ my ( $Y, $X) = @_;
+ my %original = ();
+ my @subY = ();
+ map { $original{$_} = 'x' } @$X;
+ @subY = grep { !defined $original{$_} } @$Y; ## i.e. $_ takes values from the @Y array and sees if they are in the original hash table
+ return @subY ; # returns a subset of @Y
+}
+sub getYinX{#returns (Y && X)
+ my ( $Y, $X) = @_;
+ my %original = ();
+ my @subY = ();
+ map { $original{$_} = 'x' } @$X;
+ @subY = grep { defined $original{$_} } @$Y; ## i.e. $_ takes values from the @Y array and sees if they are in the original hash table
+ return @subY ; # returns a subset of @Y
+}
+sub createdefinestr{
+ my ($macro) = @_;
+ my $def;
+ $def = qr/ ([ \t]*\#define[ \t]+$macro.*\n ## the space between the [] is important; it is a literal space here
+ (?:.*\\[ \t]*\n)* # anything that has a backslash as last character i.e. a continuation slash
+ #^ needed a . here instead of \s because \s seems to match \n as well while . doesn't unless we use s on the
+ # end of the regexp i.e. "xs" instead of "x"
+ .*\n) # then get very next line only
+ /x;
+ return $def;
+}
+sub createdefinestruct{
+ my ($macro) = @_;
+ my $def;
+ $def = qr/ ([ \t]*\#define[ \t]+$macro\s+[\s\\]* ## the space between the [] is important; it is a literal space here
+ (?:.*\\[ \t]*\n)* # anything that has a backslash as last character i.e. a continuation slash
+ #^ needed a . here instead of \s because \s seems to match \n as well while . doesn't unless we use s on the
+ # end of the regexp i.e. "xs" instead of "x"
+ .*\n) # then get very next line only
+ /x;
+ return $def;
+}
+sub repAwithBinCretC{#replace A with B in C and return new C
+ my ($a,$b,$c)=@_;
+ my $ameta=quotemeta($a);
+ $c =~ s/$ameta/$b/;
+ return $c;
+}
+1;
diff -r 5dc06c77b275 -r 7bf0431deb5f script/macroanalyze/doomstr.pl
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/script/macroanalyze/doomstr.pl Thu Feb 04 16:24:29 2010 +1100
@@ -0,0 +1,32 @@
+#our ($paren);
+$paren = qr/ ##THIS one seems to work OK.
+ \(
+ (?:
+ [^()]+ # Not parens
+ |
+ (??{ $paren }) # Another balanced group (not interpolated yet)
+ )*
+ \)
+ /x;
+$cparen = qr/ ##THIS one seems to work OK.
+ \{
+ (?:
+ [^{}]+ # Not parens
+ |
+ (??{ $cparen }) # Another balanced group (not interpolated yet)
+ )*
+ \}
+ /x;
+$getdefinesall = qr/ ([ \t]*\#define[ \t]+\w+ARGS.*\\[ \t]*\n
+ (?:.*\\[ \t]*\n)* # anything that has a backslash as last character i.e. a continuation slash
+ .*\n) # then get very next line only
+ /x;
+# $getdefinesrem = qr/ [ \t]*\#define[ \t]+\w+ARGS[ \t]*\\[ \t]*\n
+# ((?:.*\\[ \t]*\n)* # anything that has a backslash as last character i.e. a continuation slash
+# .*\n) # then get very next line only
+# /x;
+$reg = qr/^\s*(\w+(?:[ \t]+\w+)*)
+ ([ \t\*]+)
+ ((?:\w|[\[\]]*)+)\s*$
+ # (\w+)
+ /x;
diff -r 5dc06c77b275 -r 7bf0431deb5f script/macroanalyze/getdefargs.pl
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/script/macroanalyze/getdefargs.pl Thu Feb 04 16:24:29 2010 +1100
@@ -0,0 +1,315 @@
+#!/usr/bin/perl
+
+use Term::ANSIColor;
+use Data::Dumper;
+
+$dir=`pwd`;
+$dir =~ /((\/\w+)+\/stgUnderworld\w*).*/;
+$UWdir = $1;
+$LIST="$UWdir"."/script/macroanalyze";
+
+unshift(@INC, $LIST);
+
+our $paren;
+our $cparen;
+our $getdefinesall;
+our $reg;
+require 'doomstr.pl';
+require 'doominc.pl';
+our $dir;
+our $UWdir;
+our $filename;
+our $pc;
+our $hugestr;
+our $defargsfile;
+our $withrepofile;
+our %getparent;
+our %getdefarg;
+
+
+#################################################################################################################################
+$dir=`pwd`; #print "$dir\n";
+$dir =~ /((?:\/\w+)+\/stgUnderworld\w+)(.*)/;
+$UWdir = $1;
+
+
+$filename="$ARGV[0]";
+open FILE, "$filename" or die "can't find file: $!\n";
+$hugestr='';
+
+while (<FILE>){
+
+ $hugestr .= "$_";
+
+}
+$pc = "$UWdir\/"."parentchildhashtable.txt";
+$defargsfile = "$UWdir\/"."defargs.txt";
+
+## populate the hash tables from file: the files may or may not exist
+open FILE, "$pc";
+while (<FILE>){
+ /(\w+)\s(\w+)/;
+ $getparent{ $1 } = $2;
+}
+close FILE;
+open FILE, "$defargsfile";
+while (<FILE>){
+ /(\w+)\s(.*)/;
+ $getdefarg{ $1 } = $2;
+}
+close FILE;
+
+#################################################################################################################################
+#################################################################################################################################
+#################################################################################################################################
+#################################################################################################################################
+#### find all functions that are of the form ?X_?New ############################################################################
+ at functions=$hugestr=~/\w+(?:\**\s+|\s+\**|\s+\**\s+)(_\w+New\w*\s*\([^{}]+$cparen)/g; ## Only looking at _X_?New functions now i.e. starting with _
+######### is of form / (?: | | | )( ) / 2nd pair of brackets is the match #################################################
+#################################################################################################################################
+# get fname fbody and fargs and fargslist from the function defn ################################################################
+#######print "filename is $filename\n"; ########################################################################################
+$i=0; $goforth = 1;# $numparents = 0;
+foreach (@functions){
+ ##print "$_ :::::\n\n";
+ $fname[$i]=&getfname($_);
+ $fbody[$i]=&getfbodyverbatim($_);
+ ## get parent functions
+ $subfuncs[$i]=[$fbody[$i]=~/\W(_(?:\w+_*)+_New[^()]*$paren)/g]; ## must have a _ in front of name i.e. they should because they are private constructors
+ $fbodyclean[$i]=&getfbody($_);
+ $subfuncsclean[$i]=[$fbodyclean[$i]=~/\W(_(?:\w+_*)+_New[^()]*$paren)/g];
+ @pfunc=@{$subfuncsclean[$i]};
+ # $#pfunc should be either 0 or -1; else there are too many parent functions in a child function
+ if( $#pfunc > 0 ){
+ open FILE, ">>log.txt"; print FILE "Function $fname[$i] has too many _New functions in file $filename\n"; close FILE;
+ $goforth = 0 ; ## stop processing
+ exit;
+ }
+ if($goforth == 1){
+ $cclass[$i]=&getclass($fname[$i]); #list of potential child class names #print "Child class is $cclass[$i] num pfunc = $#pfunc\n";
+ if($#pfunc == -1){ $pclass[$i] = $cclass[$i];} # this will remove it when we do AminusB test
+ foreach (@pfunc){
+ s/\n//g; #print ">>>>>>>>>>$_<<<<<<<<<<<<\n";
+ $pclass[$i] = &getclass($_); #list of potential parent class names
+ s/[ \t]+/ /g; #print "Class of $_\n is pclass >>$pclass[$i]<<\n"; #if($cclass[$i] ne $pclass[$i]){ $numparents++;}
+ }
+ }
+ $i++;
+}# foreach (@functions)
+ at pclasssub = &getYnotinX(\@pclass,\@cclass);
+if($#pclasssub > 0) { open FILE, ">>log.txt"; print FILE "More than one child parent relation found in file $filename\n"; close FILE; }
+# If we are here we have a 1-1 or 1-0 relation between child and parent functions
+# i.e. no child function X has more than 1 parent function Y and may have none
+foreach $Yclass (@pclasssub){
+ #print "Y $Yclass mm\n";
+ $i=0; $j=0;
+ foreach $Xclass (@pclass){
+ #print "X $Xclass nn\n";
+ if($Xclass eq $Yclass){
+ $pclass[$i] = NULL;
+ $cclasssub[$j] = $cclass[$i];
+ $Xfunc[$j] = $functions[$i]; ## functions in their original form
+ $Xname[$j] = $fname[$i];
+ $Xbody[$j] = &getfbody($functions[$i]);
+ $Xargs[$j] = &getfargs($functions[$i]);
+ $XargsVerbatim[$j] = &getfargsverbatim($functions[$i]);
+ $XbodyVerbatim[$j] = &getfbodyverbatim($functions[$i]);
+ $Yfunc[$j] = $subfuncs[$i][0];## functions in their original form
+ $Yname[$j] = &getfname($Yfunc[$j]);
+ $Yargs[$j] = &getfargs($Yfunc[$j]);
+ #print "Yargs = $Yargs[$j]\n";
+ $YargsVerbatim[$j] = &getfargsverbatim($Yfunc[$j]);
+ $j++;
+ #print "Found a class $cclass\n";
+ }
+ $i++;
+ }
+}
+ at Yclass = @pclasssub;
+ at Xclass = @cclasssub;
+
+$i=0;
+$reponame=$ARGV[0];
+$reponame =~ /\.\/(\w+)\/.*/;
+$reponame=$1;
+open FILE, ">>$pc";
+open WREP, ">>$withrepofile";
+$i=0;
+foreach (@Xname){
+ if( !exists $getparent{ $_ } ){
+ print FILE "$_ $Yname[$i]\n";
+ print WREP "$_ $Yname[$i] $reponame\n";
+ $getparent{ $_ } = $Yname[$i];
+ }
+ $i++;
+}
+close FILE;
+close WREP;
+### At this point we have all the child parent functions and their classes
+### Usually the above arrays have only one member each
+#################################################################################################################################
+#################################################################################################################################
+### Now check for macros
+$i=0;
+# cool it looks like ALL macros as args end in 'ARGS'
+# Lets just worry about the DEFARGS part i.e. the args to X
+# because we will construct PASSARGS from the DEFARGS anyway
+foreach $args (@Xargs){
+ @Xargset = split(/,/,$args);
+ #print Dumper(@Xargset);
+ $Xhasmacro[$i]=0;
+ $Xisplugin[$i]=0;
+ if( $#Xargset == 0 ){
+ #print "Only has one argument\n";
+ if( ($args !~ /\w+\W+\w+/) && ($args !~ /void/) ){
+ #print color 'blue'; print "Is a macro $args in $filename\n"; print color 'reset';
+ if($args !~ /ARGS/){
+ open FILE, ">>log.txt";
+ print FILE "Looks like macro but doesn't have ARGS in name $Xname[$i] $args in $filename\n";
+ close FILE;
+ }
+ $Xhasmacro[$i] =1;
+ }
+ else{
+ if($args =~ /ARGS/){
+ open FILE, ">>log.txt"; print FILE "has 2 parts to args but has ARGS in it $Xname[$i] $args $filename\n"; close FILE; }
+ #print "Is a plugin $Xname[$i] $args $filename\n";
+ $Xisplugin[$i]=1;
+ }
+ }
+ $i++;
+}
+
+#Now we know who has macros and who are probably plugins
+## Process the functions that have macros now and build the defarg hash table
+$i=0;
+foreach $Xfuncname (@Xname){
+ ###########################################################################################################
+ if($Xhasmacro[$i]){
+ $Xargs[$i] =~ /(\w+)/;
+ $macname = $1;
+ $propermacname = "$Xclass[$i]"."_DEFARGS";
+ print ">>>>>>>>>$propermacname<<<<<<<<<<<< >>>>>>>>>>>>>>>$macname<<<<<<<<<<<<<<<<\n";
+ $headerfile=$filename; $headerfile =~ s/\.c/\.h/; # get the headerfile
+ ###########################################################################################################
+ if( -e $headerfile){
+ open FILE, "$headerfile"; $headerstr='';
+ while (<FILE>){ $headerstr .= $_; }
+ close FILE;
+ $getmacrodefine=&createdefinestr($macname);
+ $headerstr =~ /$getmacrodefine/g;
+ $hashdefine = $1;
+ $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
+ #print "$hashdefine\n";
+ ###########################################################################################################
+ if($hashdefine eq ''){
+ print "Could not find definition for $macname. Try again by trying proper macro name\n";
+ # Try what the name should be
+ $macname=$propermacname;
+ $getmacrodefine=&createdefinestr($macname);
+ $headerstr =~ /$getmacrodefine/g;
+ $hashdefine = $1;
+ $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
+ #print "$hashdefine\n";
+ if($hashdefine eq ''){
+ #print "Could not find definition for $macname. Try again by remangling macro name to proper but with ARGS instead of DEFARGS\n";
+ # Try what it might be
+ $macname = "$Xclass[$i]"."_ARGS";
+ $getmacrodefine=&createdefinestr($macname);
+ $headerstr =~ /$getmacrodefine/g;
+ $hashdefine = $1;
+ $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
+ #print "$hashdefine\n";
+ if($hashdefine eq ''){
+ open FILE, ">>log.txt";
+ print FILE "Could not find definition for $macname used by $Xname[$i] in $filename. We can assume is equivalent to proper macro that doesn't exist yet!\n";
+ close FILE;
+ # OK...if a macroname was used but not defined in a function and was not found
+ # then it must be defined elsewhere but can be taken to be the same as the proper macro name because it works
+ if( !exists $getdefarg{$propermacname} ) {
+ $Xargs[$i] =~ /(\w+)/; $macname = $1; # get original macro name from the Xargs again
+ open FILE, ">>$defargsfile"; print FILE "$propermacname $macname \#define $propermacname $macname\n"; close FILE;
+ # this one won't appear in the properdefargs file because we cannot define it in the proper way yet
+ }
+ }
+ }
+ }# if($hashdefine eq '')
+ ###########################################################################################################
+ if( !exists $getdefarg{$macname} && $hashdefine ne '' ){# then write out the current defn to defargs file
+ open FILE, ">>$defargsfile";
+ print FILE "$macname $propermacname $hashdefine\n";
+ if($macname ne $propermacname){
+ print FILE "$propermacname $macname $hashdefine\n";
+ }
+ close FILE;
+ }# if macro name doesn't exist already and we found a defn for it
+ if( !exists $getdefarg{$propermacname} && $hashdefine ne '' ){# then write out the current defn to defargs file
+ open FILE, ">>$defargsfile";
+ print FILE "$propermacname $propermacname $hashdefine\n";
+ close FILE;
+ }# if proper macro name doesn't exist already and we found a defn for it
+ ###########################################################################################################
+ }# if headerfile exists
+ ###########################################################################################################
+ else{
+ open FILE, ">>log.txt"; print FILE "Where is the goddam header file for $filename??\n"; close FILE;
+ }# if headerfile exists
+ ###########################################################################################################
+
+ }## if function has a macro for args
+ else{## function does not have a macro in its args but we are going to check headerfile anyway to see if a macro is defined there.
+ ## Some macros use macros that are defined but not used in their own class's args to its function
+ if($Xisplugin[$i] == 0){## and not a plugin
+ $propermacname = "$Xclass[$i]"."_DEFARGS";
+ $macname = $propermacname;
+ $headerfile=$filename; $headerfile =~ s/\.c/\.h/; # get the headerfile
+ ###########################################################################################################
+ if( -e $headerfile){
+ open FILE, "$headerfile"; $headerstr='';
+ while (<FILE>){ $headerstr .= $_; }
+ close FILE;
+ $getmacrodefine=&createdefinestr($macname);
+ $headerstr =~ /$getmacrodefine/g;
+ $hashdefine = $1;
+ $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
+ #print "$hashdefine\n";
+ ###########################################################################################################
+ if($hashdefine eq ''){
+ #print "Could not find definition for $macname. Try again by remangling macro name to proper but with ARGS instead of DEFARGS\n";
+ # Try what it might be
+ $macname = "$Xclass[$i]"."_ARGS";
+ $getmacrodefine=&createdefinestr($macname);
+ $headerstr =~ /$getmacrodefine/g;
+ $hashdefine = $1;
+ $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
+ #print "$hashdefine\n";
+ }# if($hashdefine eq '')
+ ## if we still don't find a macro here it doesn't matter..probably doesn't exist
+ ###########################################################################################################
+ if( !exists $getdefarg{$macname} && $hashdefine ne '' ){# then write out the current defn to defargs file
+ open FILE, ">>$defargsfile";
+ print FILE "$macname $propermacname $hashdefine\n";
+ if($macname ne $propermacname){
+ print FILE "$propermacname $macname $hashdefine\n";
+ }
+ close FILE;
+ }# if macro name doesn't exist already and we found a defn for it
+ if( !exists $getdefarg{$propermacname} && $hashdefine ne '' ){# then write out the current defn to defargs file
+ open FILE, ">>$defargsfile";
+ print FILE "$propermacname $propermacname $hashdefine\n";
+ close FILE;
+ }# if proper macro name doesn't exist already and we found a defn for it
+ ###########################################################################################################
+ }# if headerfile exists
+ ###########################################################################################################
+ else{
+ open FILE, ">>log.txt"; print FILE "Where is the goddam header file for $filename??\n"; close FILE;
+ }# if headerfile exists
+ ###########################################################################################################
+ }
+ }## does not have macro in functions args
+ $i++;
+ ###########################################################################################################
+}
+#################################################################################################################################
+#################################################################################################################################
diff -r 5dc06c77b275 -r 7bf0431deb5f script/macroanalyze/getstructs.pl
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/script/macroanalyze/getstructs.pl Thu Feb 04 16:24:29 2010 +1100
@@ -0,0 +1,274 @@
+#!/usr/bin/perl
+
+use Term::ANSIColor;
+use Data::Dumper;
+
+$dir=`pwd`;
+$dir =~ /((\/\w+)+\/stgUnderworld\w*).*/;
+$UWdir = $1;
+$LIST="$UWdir"."/script/macroanalyze";
+
+unshift(@INC, $LIST);
+
+our $paren;
+our $cparen;
+our $getdefinesall;
+our $reg;
+require 'doomstr.pl';
+require 'doominc.pl';
+our $dir;
+our $UWdir;
+our $filename;
+our $pc;
+our $hugestr;
+our $structsfile;
+
+#################################################################################################################################
+$dir=`pwd`; #print "$dir\n";
+$dir =~ /((?:\/\w+)+\/stgUnderworld\w+)(.*)/;
+$UWdir = $1;
+
+
+$filename="$ARGV[0]";
+open FILE, "$filename" or die "can't find file: $!\n";
+$hugestr='';
+
+while (<FILE>){
+
+ $hugestr .= "$_";
+
+}
+
+$structsfile = "$UWdir\/"."structs.txt";
+
+
+# open FILE, "$structsfile";
+# while (<FILE>){
+# /(\w+)\s(.*)/;
+# $getdefarg{ $1 } = $2;
+# }
+# close FILE;
+
+#################################################################################################################################
+#################################################################################################################################
+#################################################################################################################################
+#################################################################################################################################
+#### find all functions that are of the form ?X_?New ############################################################################
+ at functions=$hugestr=~/\w+(?:\**\s+|\s+\**|\s+\**\s+)(_\w+New\w*\s*\([^{}]+$cparen)/g; ## Only looking at _X_?New functions now i.e. starting with _
+######### is of form / (?: | | | )( ) / 2nd pair of brackets is the match #################################################
+#################################################################################################################################
+# get fname fbody and fargs and fargslist from the function defn ################################################################
+#######print "filename is $filename\n"; ########################################################################################
+$i=0; $goforth = 1;# $numparents = 0;
+
+$headerfile=$filename; $headerfile =~ s/\.c/\.h/; # get the headerfile
+###########################################################################################################
+if( -e $headerfile){
+
+ open FILE, "$headerfile"; $headerstr='';
+ while (<FILE>){ $headerstr .= $_; }
+ close FILE;
+ $headerstr =~ s/\r//g;
+ #$headerstr = &cleanstr($headerstr);
+ $headerstr =~ s{/\* (?: (?!\*/). )* \*/}{}gxs;
+ $headerstr =~ s{//.*}{}g; # get rid of any c++ style comments as well
+ foreach (@functions){
+ $fname[$i]=&getfname($_);
+ ## Construct a macro name
+ $Xstructname = $fname[$i];
+ $Xstructname =~ s/(.*)_New/_$1/;
+
+ print "Structname $Xstructname\n";
+ $getmacrodefine=&createdefinestruct($Xstructname);
+
+ while ($headerstr =~ /$getmacrodefine/g){
+ $hashdefine = $1;
+ $hashdefine = &cleanstr($hashdefine); # clean it up a bit and make it fit on one line
+ $hashdefine =~ s/\\//g;
+ $hashdefine = &cleanstr($hashdefine);
+ $hashdefine =~ s/^\s*//;
+ $hashdefine =~ s/(\W)struct(\W)/$1$2/g;
+ $hashdefine =~ s/\{//g;
+ $hashdefine =~ s/\}//g;
+ $hashdefine =~ s/\s*$//;
+ $hashdefine = &cleanstr($hashdefine);
+ $hashdefine =~ s/\#define//;
+ $hashdefine =~ s/^\s*//;
+ print "Define $hashdefine\n";
+ open FILE, ">>$structsfile";
+ ##print FILE "$Xstructname $hashdefine\n";
+ print FILE "$hashdefine\n";
+ close FILE;
+ }
+ $i++;
+ }# foreach (@functions)
+
+}# if headerfile exists
+exit;
+
+#################################################################################################################################
+#################################################################################################################################
+### Now check for macros
+$i=0;
+# cool it looks like ALL macros as args end in 'ARGS'
+# Lets just worry about the DEFARGS part i.e. the args to X
+# because we will construct PASSARGS from the DEFARGS anyway
+foreach $args (@Xargs){
+ @Xargset = split(/,/,$args);
+ #print Dumper(@Xargset);
+ $Xhasmacro[$i]=0;
+ $Xisplugin[$i]=0;
+ if( $#Xargset == 0 ){
+ #print "Only has one argument\n";
+ if( ($args !~ /\w+\W+\w+/) && ($args !~ /void/) ){
+ #print color 'blue'; print "Is a macro $args in $filename\n"; print color 'reset';
+ if($args !~ /ARGS/){
+ open FILE, ">>log.txt";
+ print FILE "Looks like macro but doesn't have ARGS in name $Xname[$i] $args in $filename\n";
+ close FILE;
+ }
+ $Xhasmacro[$i] =1;
+ }
+ else{
+ if($args =~ /ARGS/){
+ open FILE, ">>log.txt"; print FILE "has 2 parts to args but has ARGS in it $Xname[$i] $args $filename\n"; close FILE; }
+ #print "Is a plugin $Xname[$i] $args $filename\n";
+ $Xisplugin[$i]=1;
+ }
+ }
+ $i++;
+}
+
+#Now we know who has macros and who are probably plugins
+## Process the functions that have macros now and build the defarg hash table
+$i=0;
+foreach $Xfuncname (@Xname){
+ ###########################################################################################################
+ if($Xhasmacro[$i]){
+ $Xargs[$i] =~ /(\w+)/;
+ $macname = $1;
+ $propermacname = "$Xclass[$i]"."_DEFARGS";
+ print ">>>>>>>>>$propermacname<<<<<<<<<<<< >>>>>>>>>>>>>>>$macname<<<<<<<<<<<<<<<<\n";
+ $headerfile=$filename; $headerfile =~ s/\.c/\.h/; # get the headerfile
+ ###########################################################################################################
+ if( -e $headerfile){
+ open FILE, "$headerfile"; $headerstr='';
+ while (<FILE>){ $headerstr .= $_; }
+ close FILE;
+ $getmacrodefine=&createdefinestr($macname);
+ $headerstr =~ /$getmacrodefine/g;
+ $hashdefine = $1;
+ $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
+ #print "$hashdefine\n";
+ ###########################################################################################################
+ if($hashdefine eq ''){
+ print "Could not find definition for $macname. Try again by trying proper macro name\n";
+ # Try what the name should be
+ $macname=$propermacname;
+ $getmacrodefine=&createdefinestr($macname);
+ $headerstr =~ /$getmacrodefine/g;
+ $hashdefine = $1;
+ $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
+ #print "$hashdefine\n";
+ if($hashdefine eq ''){
+ #print "Could not find definition for $macname. Try again by remangling macro name to proper but with ARGS instead of DEFARGS\n";
+ # Try what it might be
+ $macname = "$Xclass[$i]"."_ARGS";
+ $getmacrodefine=&createdefinestr($macname);
+ $headerstr =~ /$getmacrodefine/g;
+ $hashdefine = $1;
+ $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
+ #print "$hashdefine\n";
+ if($hashdefine eq ''){
+ open FILE, ">>log.txt";
+ print FILE "Could not find definition for $macname used by $Xname[$i] in $filename. We can assume is equivalent to proper macro that doesn't exist yet!\n";
+ close FILE;
+ # OK...if a macroname was used but not defined in a function and was not found
+ # then it must be defined elsewhere but can be taken to be the same as the proper macro name because it works
+ if( !exists $getdefarg{$propermacname} ) {
+ $Xargs[$i] =~ /(\w+)/; $macname = $1; # get original macro name from the Xargs again
+ open FILE, ">>$defargsfile"; print FILE "$propermacname $macname \#define $propermacname $macname\n"; close FILE;
+ # this one won't appear in the properdefargs file because we cannot define it in the proper way yet
+ }
+ }
+ }
+ }# if($hashdefine eq '')
+ ###########################################################################################################
+ if( !exists $getdefarg{$macname} && $hashdefine ne '' ){# then write out the current defn to defargs file
+ open FILE, ">>$defargsfile";
+ print FILE "$macname $propermacname $hashdefine\n";
+ if($macname ne $propermacname){
+ print FILE "$propermacname $macname $hashdefine\n";
+ }
+ close FILE;
+ }# if macro name doesn't exist already and we found a defn for it
+ if( !exists $getdefarg{$propermacname} && $hashdefine ne '' ){# then write out the current defn to defargs file
+ open FILE, ">>$defargsfile";
+ print FILE "$propermacname $propermacname $hashdefine\n";
+ close FILE;
+ }# if proper macro name doesn't exist already and we found a defn for it
+ ###########################################################################################################
+ }# if headerfile exists
+ ###########################################################################################################
+ else{
+ open FILE, ">>log.txt"; print FILE "Where is the goddam header file for $filename??\n"; close FILE;
+ }# if headerfile exists
+ ###########################################################################################################
+
+ }## if function has a macro for args
+ else{## function does not have a macro in its args but we are going to check headerfile anyway to see if a macro is defined there.
+ ## Some macros use macros that are defined but not used in their own class's args to its function
+ if($Xisplugin[$i] == 0){## and not a plugin
+ $propermacname = "$Xclass[$i]"."_DEFARGS";
+ $macname = $propermacname;
+ $headerfile=$filename; $headerfile =~ s/\.c/\.h/; # get the headerfile
+ ###########################################################################################################
+ if( -e $headerfile){
+ open FILE, "$headerfile"; $headerstr='';
+ while (<FILE>){ $headerstr .= $_; }
+ close FILE;
+ $getmacrodefine=&createdefinestr($macname);
+ $headerstr =~ /$getmacrodefine/g;
+ $hashdefine = $1;
+ $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
+ #print "$hashdefine\n";
+ ###########################################################################################################
+ if($hashdefine eq ''){
+ #print "Could not find definition for $macname. Try again by remangling macro name to proper but with ARGS instead of DEFARGS\n";
+ # Try what it might be
+ $macname = "$Xclass[$i]"."_ARGS";
+ $getmacrodefine=&createdefinestr($macname);
+ $headerstr =~ /$getmacrodefine/g;
+ $hashdefine = $1;
+ $hashdefine =~ s/\s+/ /g; # clean it up a bit and make it fit on one line
+ #print "$hashdefine\n";
+ }# if($hashdefine eq '')
+ ## if we still don't find a macro here it doesn't matter..probably doesn't exist
+ ###########################################################################################################
+ if( !exists $getdefarg{$macname} && $hashdefine ne '' ){# then write out the current defn to defargs file
+ open FILE, ">>$defargsfile";
+ print FILE "$macname $propermacname $hashdefine\n";
+ if($macname ne $propermacname){
+ print FILE "$propermacname $macname $hashdefine\n";
+ }
+ close FILE;
+ }# if macro name doesn't exist already and we found a defn for it
+ if( !exists $getdefarg{$propermacname} && $hashdefine ne '' ){# then write out the current defn to defargs file
+ open FILE, ">>$defargsfile";
+ print FILE "$propermacname $propermacname $hashdefine\n";
+ close FILE;
+ }# if proper macro name doesn't exist already and we found a defn for it
+ ###########################################################################################################
+ }# if headerfile exists
+ ###########################################################################################################
+ else{
+ open FILE, ">>log.txt"; print FILE "Where is the goddam header file for $filename??\n"; close FILE;
+ }# if headerfile exists
+ ###########################################################################################################
+ }
+ }## does not have macro in functions args
+ $i++;
+ ###########################################################################################################
+}
+#################################################################################################################################
+#################################################################################################################################
diff -r 5dc06c77b275 -r 7bf0431deb5f script/macroanalyze/lineage.pl
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/script/macroanalyze/lineage.pl Thu Feb 04 16:24:29 2010 +1100
@@ -0,0 +1,21 @@
+#!/usr/bin/perl
+
+$pc = "parentchildhashtable.txt";
+
+open FILE, "$pc";
+while (<FILE>){
+ /(\w+)\s(\w+)/;
+ $getparent{ $1 } = $2;
+}
+
+$parent="$ARGV[0]";
+
+print " $parent";
+
+while ($parent ne ''){
+ if($getparent{ $parent } ne ''){
+ print " => $getparent{ $parent }";
+ }
+ $parent = $getparent{ $parent };
+}
+print "\n";
diff -r 5dc06c77b275 -r 7bf0431deb5f script/macroanalyze/proto.pl
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/script/macroanalyze/proto.pl Thu Feb 04 16:24:29 2010 +1100
@@ -0,0 +1,79 @@
+#!/usr/bin/perl
+#use Tie::File;
+use Term::ANSIColor;
+$dir=`pwd`;
+$dir =~ /((\/\w+)+\/stgUnderworld\w*).*/;
+$UWdir = $1;
+$LIST="$UWdir"."/script/macroanalyze";
+
+unshift(@INC, $LIST);
+
+our $paren;
+our $cparen;
+our $getdefinesall;
+our $reg;
+require 'doomstr.pl';
+require 'doominc.pl';
+our $dir;
+our $UWdir;
+our $filename;
+our $pc;
+our $hugestr;
+our $defargsfile;
+our $properdefargsfile;
+our $protofile;
+our %getparent;
+our %getdefarg;
+our %getproperdefarg;
+our %getproto;
+#################################################################################################################################
+$dir=`pwd`; #print "$dir\n";
+$dir =~ /((\/\w+)+\/stgUnderworld\w+).*/;
+$UWdir = $1;
+
+$filename="$ARGV[0]";
+
+open FILE, "$filename" or die "can't find file: $!\n";
+$hugestr='';
+
+while (<FILE>){
+
+ $hugestr .= "$_";
+
+}
+
+$protofile = "$UWdir\/"."proto.txt";
+#print "Protofile is $protofile\n";
+open FILE, "$protofile";
+while (<FILE>){
+ /(\w+)\s(.*)/;
+ $getproto{ $1 } = $2;
+}
+close FILE;
+#################################################################################################################################
+#################################################################################################################################
+#################################################################################################################################
+#################################################################################################################################
+#### find all functions that are of the form ?X_?New ############################################################################
+ at functions=$hugestr=~/\w+(?:\**\s+|\s+\**|\s+\**\s+)(\w+New\w*\s*\([^{}]+$cparen)/g;
+# is of form / (?: | | | )( ) / 2nd pair of brackets is the match
+#################################################################################################################################
+# get fname fbody and fargs and fargslist from the function defn
+$i=0;
+foreach (@functions){
+
+ $fname[$i]=&getfname($_);
+ $fbody[$i]=&getfbodyverbatim($_);
+ $fargs[$i]=&getfargs($_);
+ #print "$fname[$i] ( $fargs[$i] )\n";
+ if($fname[$i] =~ /^_\w+/ && !exists $getproto{$fname[$i]} ){
+ #print "Yarrrr!\n";
+ open FILE, ">>$protofile";
+ print FILE "$fname[$i] $fargs[$i]\n";
+ close FILE;
+ }
+ $i++;
+
+}
+#################################################################################################################################
+#################################################################################################################################
diff -r 5dc06c77b275 -r 7bf0431deb5f script/macroanalyze/readdefarg.pl
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/script/macroanalyze/readdefarg.pl Thu Feb 04 16:24:29 2010 +1100
@@ -0,0 +1,82 @@
+#!/usr/bin/perl
+use Term::ANSIColor;
+$dir=`pwd`; #print "$dir\n";
+$dir =~ /((\/\w+)+\/stgUnderworld\w*\/*).*/;
+$UWdir = $1;
+#print "UWDIR = $UWdir\n\n";
+$properdefargsfile = "$UWdir\/"."properdefargs.txt";
+#print "using $properdefargsfile\n\n";
+open FILE, "$properdefargsfile";
+while (<FILE>){
+ /(\w+)\s+(.*)/;
+ $getproperdefarg{ $1 } = $2;
+}
+close FILE;
+$defargsfile = "$UWdir\/"."defargs.txt";
+open FILE, "$defargsfile";
+while (<FILE>){
+ /(\w+)\s+(.*)/;
+ $getdefarg{ $1 } = $2;
+ #print "==============> $1 $2 <=============\n";
+}
+close FILE;
+
+sub getall{
+ my ($str) = @_;
+ my $res;
+ if($str=~/_(\w+)_New/){
+ $str = uc $1;
+ $str = "$str"."_DEFARGS";
+ }
+ #if($str eq "STG_CLASS_DEFARGS" || $str eq "STG_OBJECT_DEFARGS" || $str eq "STG_COMPONENT_DEFARGS"){
+ if($str eq "STG_CLASS_DEFARGS"){
+ print "$str\n";
+ $str="SizeT _sizeOfSelf, Type type, Stg_Class_DeleteFunction* _delete, Stg_Class_PrintFunction* _print, Stg_Class_CopyFunction* _copy";
+ return "$str";
+ }
+ else{
+ my $nextpart = $getdefarg{ $str };
+ print "$str\n";
+ if($nextpart eq ''){
+ return "Failed!\n";
+ }
+ if($nextpart ne ''){
+ $nextpart =~ s/\n//g;
+ $nextpart =~ s/\s+/ /g;
+ $nextpart =~ s/\\//g;
+ $nextpart =~ /\#define\s*\\?\s*(\w+)\s+(\w+)\s*\,*\s*(.*)/;
+ my $rem = $3;
+ #print "$1 $2 $3 $rem\n";
+ my $tmp=$2;
+ $tmp=~s/\s*(\w+.*\w+)\s*/$1/;
+ my $str = &getall($tmp);
+ if($rem ne ''){
+ #$res = "$str".", $rem";
+ $res = "$str".";\n $rem";
+ }
+ else{
+ $res = "$str";
+ }
+ return $res;
+ }
+ else{
+ return "str $str Failed";
+ }
+ }
+
+}
+
+$arg="$ARGV[0]";
+
+$test = &getall($arg);
+$test =~ s/\,\s+/\,\n/g;
+$test =~ s/\;\s+/\;\n/g;
+print "\n";
+ at ar = split(/;/,$test);
+for $j (0 .. $#ar){
+ if($j % 2 == 1){print color 'green'; print "$ar[$j]\n"; print color 'reset';}
+ else { print color 'yellow'; print "$ar[$j]\n"; print color 'reset';}
+}
+#print color 'green';
+#print "$test\n";
+#print color 'reset';
diff -r 5dc06c77b275 -r 7bf0431deb5f script/macroanalyze/readme.txt
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/script/macroanalyze/readme.txt Thu Feb 04 16:24:29 2010 +1100
@@ -0,0 +1,118 @@
+Run all scripts from top level directory in stgUnderworld.
+
+Run ./script/macroanalyze/createtables.sh first to create the necessary tables.
+This creates 4 txt files.
+defargs.txt <- contains all macro DEFARG definitions.
+parentchildhashtable.txt <- contains all parent child _X_New function relations
+proto.txt <- contains all parent child _X_New function prototype arguments
+structs.txt <- contains all struct definitions
+
+The scripts than can be directly called are:
+-------------------------------------------------------------------------------------------------------------------
+lineage.pl : uses parentchildhashtable.txt
+Usage:
+./script/macroanalyze/lineage _X_New
+e.g.
+./script/macroanalyze/lineage _PCDVC_New
+will produce the hierarchy of functions
+ _PCDVC_New => _DVCWeights_New => _WeightsCalculator_New => _Stg_Component_New => _Stg_Object_New => _Stg_Class_New
+
+-------------------------------------------------------------------------------------------------------------------
+readdefarg.pl : uses defargs.txt
+Usage:
+./script/macroanalyze/readdefarg.pl _X_DEFARGS
+or
+./script/macroanalyze/readdefarg.pl _X_New
+e.g.
+./script/macroanalyze/readdefarg.pl _PCDVC_New (or PCDVC_DEFARGS)
+will give a list of the hierarchy of macros followed by the expanded form of the macro,
+(with alternating colors of sets of args corresponding to additional args given by each parent macro)
+
+PCDVC_DEFARGS
+DVCWEIGHTS_DEFARGS
+WEIGHTSCALCULATOR_DEFARGS
+STG_COMPONENT_DEFARGS
+STG_OBJECT_DEFARGS
+STG_CLASS_DEFARGS
+SizeT _sizeOfSelf,
+Type type,
+Stg_Class_DeleteFunction* _delete,
+Stg_Class_PrintFunction* _print,
+Stg_Class_CopyFunction* _copy
+
+Name name,
+AllocationType nameAllocationType
+
+Stg_Component_DefaultConstructorFunction* _defaultConstructor,
+Stg_Component_ConstructFunction* _construct,
+Stg_Component_BuildFunction* _build,
+Stg_Component_InitialiseFunction* _initialise,
+Stg_Component_ExecuteFunction* _execute,
+Stg_Component_DestroyFunction* _destroy
+
+WeightsCalculator_CalculateFunction* _calculate
+
+-------------------------------------------------------------------------------------------------------------------
+readstruct.pl : uses structs.txt
+Usage:
+./script/macroanalyze/readstruct.pl __X
+e.g.
+./script/macroanalyze/readstruct.pl __PCDVC
+will give a list of the hierarchy of structs followed by the expanded form of the struct,
+(with alternating colors of sets of terms corresponding to additional terms given by each parent struct)
+
+__PCDVC
+__DVCWeights
+__WeightsCalculator
+__Stg_Component
+__Stg_Object
+__Stg_Class
+
+SizeT _sizeOfSelf;
+Type type;
+Stg_Class_DeleteFunction* _delete;
+Stg_Class_PrintFunction* _print;
+Stg_Class_CopyFunction* _copy
+Name name;
+AllocationType nameAllocationType;
+Stg_Component_DefaultConstructorFunction* _defaultConstructor;
+Stg_Component_ConstructFunction* _construct;
+Stg_Component_BuildFunction* _build;
+Stg_Component_InitialiseFunction* _initialise;
+Stg_Component_ExecuteFunction* _execute;
+Stg_Component_DestroyFunction* _destroy;
+Bool isConstructed;
+Bool isBuilt;
+Bool isInitialised;
+Bool hasExecuted;
+Bool isDestroyed;
+Type constructType;
+Type buildType;
+Type initialiseType;
+Type executeType;
+Type destroyType;
+FiniteElementContext* context;
+WeightsCalculator_CalculateFunction* _calculate;
+double cellLocalVolume;
+Dimension_Index dim;
+int resX;
+int resY;
+int resZ;
+MaterialPointsSwarm* materialPointsSwarm;
+double upperT;
+double lowerT;
+Bool splitInInterfaceCells;
+Bool deleteInInterfaceCells;
+int maxDeletions;
+int maxSplits;
+Bool Inflow;
+double CentPosRatio;
+int ParticlesPerCell;
+double Threshold;
+int maxDeletions_orig;
+int maxSplits_orig;
+Bool Inflow_orig;
+Bool splitInInterfaceCells_orig;
+Bool deleteInInterfaceCells_orig;
+
+-------------------------------------------------------------------------------------------------------------------
\ No newline at end of file
diff -r 5dc06c77b275 -r 7bf0431deb5f script/macroanalyze/readstruct.pl
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/script/macroanalyze/readstruct.pl Thu Feb 04 16:24:29 2010 +1100
@@ -0,0 +1,75 @@
+#!/usr/bin/perl
+use Term::ANSIColor;
+$dir=`pwd`; #print "$dir\n";
+$dir =~ /((\/\w+)+\/stgUnderworld\w*\/*).*/;
+$UWdir = $1;
+
+$structfile = "$UWdir\/"."structs.txt";
+open FILE, "$structfile";
+while (<FILE>){
+ /(\w+)\s+(.*)/;
+ $getstruct{ $1 } = $2;
+ #print "==============> $1 $2 <=============\n";
+}
+close FILE;
+
+sub getall{
+ my ($str) = @_;
+ my $res;
+ if($str=~/_(\w+)_New/){
+ $str = uc $1;
+ $str = "$str"."_DEFARGS";
+ }
+ if($str eq "__Stg_Class"){
+ print "$str\n";
+ $str="SizeT _sizeOfSelf; Type type; Stg_Class_DeleteFunction* _delete; Stg_Class_PrintFunction* _print; Stg_Class_CopyFunction* _copy";
+ return "$str";
+ }
+ else{
+ my $nextpart = $getstruct{ $str };
+ print "$str\n";
+ if($nextpart eq ''){
+ return "Failed!\n";
+ }
+ if($nextpart ne ''){
+ $nextpart =~ s/\n//g;
+ $nextpart =~ s/\s+/ /g;
+ $nextpart =~ s/\\//g;
+ $nextpart =~ /\s*(\w+)\s+(.*)/;
+ my $rem = $2;
+ #print "$1 $2 $3 $rem\n";
+ my $tmp=$1;
+ $tmp=~s/^\s*(\w+)/$1/;
+ $tmp=~s/(\w+)\s*$/$1/;
+ my $str = &getall($tmp);
+ if($rem ne ''){
+ #$res = "$str".", $rem";
+ $res = "$str".":\n $rem";
+ }
+ else{
+ $res = "$str";
+ }
+ return $res;
+ }
+ else{
+ return "str $str Failed";
+ }
+ }
+
+}
+
+$arg="$ARGV[0]";
+
+$test = &getall($arg);
+$test =~ s/\,\s+/\,\n/g;
+$test =~ s/\;\s+/\;\n/g;
+print "\n";
+ at ar = split(/:/,$test);
+for $j (0 .. $#ar){
+ $ar[$j] =~ s/^\s*//;
+ if($j % 2 == 1){print color 'green'; print "$ar[$j]\n"; print color 'reset';}
+ else { print color 'yellow'; print "$ar[$j]\n"; print color 'reset';}
+}
+#print color 'green';
+#print "$test\n";
+#print color 'reset';
diff -r 5dc06c77b275 -r 7bf0431deb5f script/macroanalyze/rungetdefs.sh
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/script/macroanalyze/rungetdefs.sh Thu Feb 04 16:24:29 2010 +1100
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+find -name "*.c" -exec ./script/macroanalyze/getdefargs.pl \{\} \;
diff -r 5dc06c77b275 -r 7bf0431deb5f script/macroanalyze/rungetstructs.sh
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/script/macroanalyze/rungetstructs.sh Thu Feb 04 16:24:29 2010 +1100
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+find -name "*.c" -exec ./script/macroanalyze/getstructs.pl \{\} \;
diff -r 5dc06c77b275 -r 7bf0431deb5f script/macroanalyze/runproto.sh
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/script/macroanalyze/runproto.sh Thu Feb 04 16:24:29 2010 +1100
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+find -name "*.c" -exec ./script/macroanalyze/proto.pl \{\} \;
More information about the CIG-COMMITS
mailing list