#!/usr/bin/perl use strict; use Getopt::Std; use File::Path qw(make_path); # interface.h # typedef struct Worker { # int id; # struct Context* contexts; # enum Code execute; # enum Code taskSend; # enum Code taskRecive; # enum Code shutdown; # struct Queue* tasks; # } Worker; our($opt_o,$opt_d,$opt_h); getopts('o:d:h'); my $dir = "."; if ($opt_d) { $dir = $opt_d; if (! -d $dir) { make_path $dir; } } for my $fn (@ARGV) { next if ($fn !~ /\.cbc$/); &getDataGear($fn); &generateDataGear($fn); } my %var; my %code; my %dataGearVar; my %outputVar; # output var initializer my %outputArgs; # continuation's output variables my %dataGear; my %dataGearName; my %generic; my %dataGearVarType; my %codeGear; my $implementation; my $interface; # interface definision # # typedef struct Stack{ # Type* stack; # Type* data; # Type* data1; # __code whenEmpty(...); # __code clear(Impl* stack,__code next(...)); # __code push(Impl* stack,Type* data, __code next(...)); # __code pop(Impl* stack, __code next(Type*, ...)); # __code pop2(Impl* stack, Type** data, Type** data1, __code next(Type**, Type**, ...)); # __code isEmpty(Impl* stack, __code next(...), __code whenEmpty(...)); # __code get(Impl* stack, Type** data, __code next(...)); # __code get2(Impl* stack,..., __code next(...)); # __code next(...); # } Stack; # # calling example # # goto nodeStack->push((union Data*)node, stackTest3); # # generated meta level code # # Gearef(cbc_context, Stack)->stack = (union Data*)nodeStack; # Gearef(cbc_context, Stack)->data = (union Data*)node; # Gearef(cbc_context, Stack)->next = C_stackTest3; # goto meta(cbc_context, nodeStack->push); sub getDataGear { my ($filename) = @_; my ($codeGearName, $name, $inTypedef); open my $fd,"<",$filename or die("can't open $filename $!"); while (<$fd>) { if (! $inTypedef) { if (/^typedef struct (\w+)\s*<(.*)>/) { $inTypedef = 1; $name = $1; $dataGear{$name} = $_; $var{$name} = {}; $code{$name} = {}; $generic{$name} = \split(/,/,$2); } elsif (/^typedef struct (\w+)/) { $inTypedef = 1; $name = $1; $dataGear{$name} = $_; $var{$name} = {}; $code{$name} = {}; $generic{$name} = []; } elsif (/^(\w+)(\*)+ create(\w+)\(/) { if (defined $interface) { die "duplicate interface $interface\n"; } $interface = $1; $implementation = $3; if ( -f "$interface.cbc") { &getDataGear("$interface.cbc"); } } elsif(/^(.*)par goto (\w+)\((.*)\)/) { my $codeGearName = $2; if ($filename =~ /^(.*)\/(.*)/) { $codeGearName = "$1/$codeGearName"; } if ( -f "$codeGearName.cbc") { &getCodeGear("$codeGearName.cbc"); } } elsif(/^#interface "(.*)"/) { # use interface my $interfaceHeader = $1; next if ($interfaceHeader =~ /context.h/); if (-f $interfaceHeader) { &getDataGear("$interfaceHeader"); &getCodeGear("$interfaceHeader"); } } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { my $codeGearName = $1; if ($filename =~ /^(.*)\/(.*)/) { $codeGearName = "$1/$codeGearName"; } if ( -f "$codeGearName.cbc") { &getCodeGear("$codeGearName.cbc"); } } next; } # gather type name and type $dataGear{$name} .= $_; if (/^\s*(.*)\s+(\w+);$/ ) { my $ttype = $1; my $tname = $2; if ($ttype =~ /^(union|struct)?\s*(\w+)/) { $ttype = $2; } $var{$name}->{$tname} = $ttype; } if (/^}/) { $inTypedef = 0; } } } sub getCodeGear { my ($filename) = @_; open my $fd,"<",$filename or die("can't open $filename $!"); my ($name,$impln); while (<$fd>) { if (/^(\w+)(\*)+ create(\w+)\(/) { $name = $1; $impln = $3; } elsif(/^typedef struct (.*)<.*>\s*{/) { $name = $1; } if (defined $name) { if (/^\s*\_\_code (\w+)\((.*)\);/) { my $args = $2; my $method = $1; $code{$name}->{$method} = []; while($args) { # replace comma $args =~ s/(^\s*,\s*)//; # continuation case if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) { my $next = $2; my @args = split(/,/,$3); push(@{$code{$name}->{$method}},"\_\_code $next"); } elsif ($args =~ s/^(struct|union)?\s*(\w+)(\**)\s+(\w+)//) { my $structType = $1; my $typeName = $2; my $ptrType = $3; my $varName = $4; my $typeField = lcfirst($typeName); push(@{$code{$name}->{$method}},"$typeName$ptrType $varName"); } elsif ($args =~ s/(.*,)//) { } else { last; } } } } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { my $codeGearName = $1; my $args = $2; my $inputCount = 0; my $outputCount = 0; my $inputIncFlag = 1; while($args) { if ($args =~ s/(^\s*,\s*)//) { } if ($args =~ s/^(\s)*\_\_code\s+(\w+)\((.*?)\)//) { $codeGear{$codeGearName}->{"code"}->{$2} = "\_\_code"; $inputIncFlag = 0; my @outputs = split(/,/,$3); for my $output (@outputs) { if ($output =~ /\s*(struct|union)?\s*(\w+)(\*)?+\s(\w+)/) { my $type = $2; my $varName = $4; $codeGear{$codeGearName}->{"var"}->{$varName} = "$type $outputCount"; $outputCount++; } } } elsif ($args =~ s/^(struct|union)?\s*(\w+)(\*)?+\s(\w+)// && $inputIncFlag) { my $type = $2; my $varName = $4; $codeGear{$codeGearName}->{"var"}->{$varName} = "$type $inputCount"; $inputCount++; } elsif ($args =~ s/(.*,)//) { } else { last; } } $codeGear{$codeGearName}->{"input"} = $inputCount; $codeGear{$codeGearName}->{"output"} = $outputCount; } } } sub generateStub { my($fd,$prevCodeGearName,$dataGearName) = @_; print $fd "__code ", $prevCodeGearName ,"_stub(struct Context* cbc_context) {\n"; print $fd $dataGearName; print $fd "\n} \n\n"; return 1; } sub generateStubArgs { my($codeGearName, $varName, $typeName, $ptrType, $typeField, $interface,$output) = @_; my $varname1 = $output?"O_$varName":$varName; for my $n ( @{$dataGearVar{$codeGearName}} ) { # we already have it return 0 if ( $n eq $varname1); } push @{$dataGearVar{$codeGearName}}, $varname1; push @{$dataGearVarType{$codeGearName}}, $typeName; if ($typeName eq $implementation) { # get implementation $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(cbc_context, $interface, $varName);\n"; } else { # interface var for my $ivar (keys %{$var{$interface}}) { # input data gear field if ($varName eq $ivar) { if ($typeName eq $var{$interface}->{$ivar}) { if ($output) { $dataGearName{$codeGearName} .= "\t$typeName$ptrType* O_$varName = &Gearef(cbc_context, $interface)->$varName;\n"; $outputVar{$codeGearName} .= "\t$typeName$ptrType $varName __attribute__((unused)) = *O_$varName;\n"; return 1; } $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = Gearef(cbc_context, $interface)->$varName;\n"; return 1; } } } # interface continuation for my $cName (keys %{$code{$interface}}) { if ($varName eq $cName) { # continuation field $dataGearName{$codeGearName} .= "\tenum Code $varName = Gearef(cbc_context, $interface)->$varName;\n"; return 1; } } # par goto var for my $var (keys %{$codeGear{$codeGearName}->{"var"}}) { # input data gear field if ($varName eq $var) { my ($type, $count) = split(/\s/, $codeGear{$codeGearName}->{"var"}->{$var}); if ($typeName eq $type) { if ($output) { $dataGearName{$codeGearName} .= "\t$typeName$ptrType* O_$varName = ($typeName $ptrType*)&cbc_context->data[cbc_context->odg + $count];\n"; $outputVar{$codeGearName} .= "\t$typeName$ptrType $varName = *O_$varName;\n"; return 1; } $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = &cbc_context->data[cbc_context->idg + $count]->$typeName;\n"; return 1; } } } # par goto continuation for my $cName (keys %{$codeGear{$codeGearName}->{"code"}}) { if ($varName eq $cName) { # continuation field $dataGearName{$codeGearName} .= "\tenum Code $varName = cbc_context->next;\n"; return 1; } } # par goto continuation # global or local variable case if ($typeName eq "Code") { $dataGearName{$codeGearName} .= "\tenum $typeName$ptrType $varName = Gearef(cbc_context, $interface)->$varName;\n"; return 1; } $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = Gearef(cbc_context, $typeName);\n"; return 1; } } sub generateDataGear { my ($filename) = @_; open my $in,"<",$filename or die("can't open $filename $!"); my $fn; if ($opt_o) { $fn = $opt_o; } else { my $fn1 = $filename; $fn1 =~ s/\.cbc/.c/; my $i = 1; $fn = "$dir/$fn1"; while ( -f $fn) { $fn = "$dir/$fn1.$i"; $i++; } } if ( $fn =~ m=(.*)/[^/]+$= ) { if (! -d $1) { make_path $1; } } open my $fd,">",$fn or die("can't write $fn $!"); my $prevCodeGearName; my $inTypedef = 0; my $inStub = 0; my $hasParGoto = 0; my $inMain = 0 ; my $inCode = 0 ; my %stub; my $codeGearName; my %localVarType; my %localCode; while (<$in>) { if (! $inTypedef && ! $inStub && ! $inMain) { if (/^typedef struct (\w+) \{/) { $inTypedef = 1; } elsif (/^int main\((.*)\) \{/) { $inMain = 1; } elsif(/^#interface "(.*)"/) { my $interfaceHeader = $1; # #interface not write next unless ($interfaceHeader =~ /context.h/); } elsif (/^\s\s*_\_code (\w+)\((.*)\)(.*)/) { $localCode{$1} = 1; } elsif (/^\s\s*_\_code *\(\s*\*\s*(\w+)\)\((.*)\)(.*)/) { $localCode{$1} = 1; } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { $inCode = 1; %localCode = {}; %localVarType = {}; $codeGearName = $1; my $args = $2; my $tail = $3; if ($codeGearName =~ /_stub$/) { # don't touch already existing stub $inStub = 1; $stub{$codeGearName} = 1; print $fd $_; next; } if (defined $prevCodeGearName) { # stub is generated just before next CodeGear if (defined $stub{$prevCodeGearName."_stub"}) { undef $prevCodeGearName; } else { &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName}); $stub{$prevCodeGearName."_stub"} = 1; } } # analyzing CodeGear argument # these arguments are extract from current context's arugment DataGear Interface # and passed to the CodeGear # struct Implementaion needs special handling # __code next(...) ---> enum Code next $prevCodeGearName = $codeGearName; $dataGearVar{$codeGearName} = []; $outputVar{$codeGearName} = ""; $outputArgs{$codeGearName} = {}; my $newArgs = "struct Context *cbc_context,"; if ($args=~/^struct Context\s*\*\s*cbc_context/) { $newArgs = ""; } if (!$args){ $newArgs = "struct Context *cbc_context"; } while($args) { if ($args =~ s/(^\s*,\s*)//) { $newArgs .= $1; } # continuation case if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) { my $next = $2; my @args = split(/,/,$3); if (&generateStubArgs($codeGearName, $next, "Code", "", $next, $interface,0) ) { $newArgs .= "enum Code $next"; } # analyze continuation arguments # output arguments are defined in the Interface take the pointer of these # output arguments are put into the Interface DataGear just before the goto for my $arg (@args) { $arg =~ s/^\s*//; last if ($arg =~ /\.\.\./); $arg =~ s/^(struct|union)?\s*(\w+)(\**)\s(\w+)//; my $structType = $1; my $typeName = $2; my $ptrType = $3; my $varName = $4; my $typeField = lcfirst($typeName); push(@{$outputArgs{$codeGearName}->{$next}}, $varName); if (&generateStubArgs($codeGearName, $varName, $typeName, $ptrType, $typeField, $interface,1)) { $newArgs .= ",$structType $typeName **O_$varName"; } } } elsif ($args =~ s/^(struct|union)?\s*(\w+)(\**)\s(\w+)//) { my $structType = $1; my $typeName = $2; my $ptrType = $3; my $varName = $4; my $typeField = lcfirst($typeName); $newArgs .= $&; # assuming no duplicate &generateStubArgs($codeGearName, $varName, $typeName, $ptrType, $typeField, $interface,0); } elsif ($args =~ s/(.*,)//) { $newArgs .= $1; } else { $newArgs .= $args; last; } } # generate goto statement from stub to the CodeGear in the buffer $dataGearName{$codeGearName} .= "\tgoto $codeGearName(cbc_context"; for my $arg ( @{$dataGearVar{$codeGearName}}) { $dataGearName{$codeGearName} .= ", $arg"; } $dataGearName{$codeGearName} .= ");"; # generate CodeGear header with new arguments print $fd "__code $codeGearName($newArgs)$tail\n"; if ($outputVar{$codeGearName} ne "") { # output data var can be use before write # it should be initialze by gearef print $fd $outputVar{$codeGearName}; } next; } elsif (! $inCode) { s/new\s+(\w+)\(\)/\&ALLOCATE(cbc_context, \1)->\1/g; # replacing new print $fd $_; next; } elsif (/^(.*)goto (\w+)\-\>(\w+)\((.*)\);/) { # handling goto statement # convert it to the meta call form with two arugments, that is context and enum Code my $prev = $1; my $next = $2; my $method = $3; my $tmpArgs = $4; #$tmpArgs =~ s/\(.*\)/\(\)/; my @args = split(/,/,$tmpArgs); if (! defined $dataGearVarType{$codeGearName}) { print $fd $_ ; next ; } my @types = @{$dataGearVarType{$codeGearName}}; my $ntype; my $ftype; for my $v (@{$dataGearVar{$codeGearName}}) { my $t = shift @types; if ($v eq $next || $v eq "O_$next") { $ntype = $t; $ftype = lcfirst($ntype); } } if (!defined $ntype) { $ntype = $localVarType{$next}; $ftype = lcfirst($ntype); } print $fd "\tGearef(cbc_context, $ntype)->$ftype = (union Data*) $next;\n"; # Put interface argument my $prot = $code{$ntype}->{$method}; my $i = 1; for my $arg (@args) { my $pType; my $pName; my $p = @$prot[$i]; next if ($p eq $arg); $p =~ s/^(.*)\s(\w+)//; $pType = $1; $pName = $2; $arg =~ s/^(\s)*(\w+)/$2/; if ($pType =~ s/\_\_code$//) { if ($arg =~ /(\w+)\(.*\)/) { print $fd "\tGearef(cbc_context, $ntype)->$pName = $1;\n"; } else { print $fd "\tGearef(cbc_context, $ntype)->$pName = C_$arg;\n"; } } elsif ($pType =~ /Data\**$/){ print $fd "\tGearef(cbc_context, $ntype)->$pName = (union $pType) $arg;\n"; } else { print $fd "\tGearef(cbc_context, $ntype)->$pName = $arg;\n"; } $i++; } # print $fd "${prev}cbc_context->before = C_$codeGearName;\n"; print $fd "${prev}goto meta(cbc_context, $next->$method);\n"; next; } elsif(/^(.*)par goto (\w+)\((.*)\);/) { # handling par goto statement # convert it to the parallel my $prev = $1; my $codeGearName = $2; my $args = $3; my $inputCount = $codeGear{$codeGearName}->{'input'}; my $outputCount = $codeGear{$codeGearName}->{'output'}; my @iterateCounts; # parse examples 'par goto(.., iterate(10), exit);' if ($args =~ /iterate\((.*)?\),/) { @iterateCounts = split(/,/,$1);; $inputCount--; } # replace iterate keyword $args =~ s/iterate\((.*)?\),//; my @dataGears = split(/,\s*/, $args); my $nextCodeGear = pop(@dataGears); if (! $hasParGoto) { $hasParGoto = 1; print $fd "${prev}struct Element* element;\n"; } my $initTask = << "EOFEOF"; ${prev}cbc_context->task = NEW(struct Context); ${prev}initContext(cbc_context->task); ${prev}cbc_context->task->next = C_$codeGearName; ${prev}cbc_context->task->idgCount = $inputCount; ${prev}cbc_context->task->idg = cbc_context->task->dataNum; ${prev}cbc_context->task->maxIdg = cbc_context->task->idg + $inputCount; ${prev}cbc_context->task->odg = cbc_context->task->maxIdg; ${prev}cbc_context->task->maxOdg = cbc_context->task->odg + $outputCount; EOFEOF print $fd $initTask; if (@iterateCounts) { print $fd "${prev}cbc_context->task->iterate = 0;\n"; my $len = @iterateCounts; if ($len == 1) { print $fd "${prev}cbc_context->task->iterator = createMultiDimIterator(cbc_context, $iterateCounts[0], 1, 1);\n"; } elsif ($len == 2) { print $fd "${prev}cbc_context->task->iterator = createMultiDimIterator(cbc_context, $iterateCounts[0], $iterateCounts[1], 1);\n"; } elsif ($len == 3) { print $fd "${prev}cbc_context->task->iterator = createMultiDimIterator(cbc_context, $iterateCounts[0], $iterateCounts[1], $iterateCounts[2]);\n"; } } for my $dataGear (@dataGears) { print $fd "${prev}GET_META($dataGear)->wait = createSynchronizedQueue(cbc_context);\n"; } for my $i (0..$inputCount-1) { print $fd "${prev}cbc_context->task->data[cbc_context->task->idg+$i] = (union Data*)@dataGears[$i];\n"; } for my $i (0..$outputCount-1) { print $fd "${prev}cbc_context->task->data[cbc_context->task->odg+$i] = (union Data*)@dataGears[$inputCount+$i];\n"; } my $putTask = << "EOFEOF"; ${prev}element = &ALLOCATE(cbc_context, Element)->Element; ${prev}element->data = (union Data*)cbc_context->task; ${prev}element->next = cbc_context->taskList; ${prev}cbc_context->taskList = element; EOFEOF print $fd $putTask; next; } elsif (/^(.*)goto (\w+)\((.*)\);/) { # handling goto statement # convert it to the meta call form with two arugments, that is context and enum Code my $prev = $1; my $next = $2; my @args = split(/,/, $3); my $v = 0; if (defined $localCode{$next}) { print $fd $_; next; } for my $n ( @{$dataGearVar{$codeGearName}} ) { # continuation arguments $v = 1 if ( $n eq $next); } if ($v || defined $code{$interface}->{$next}) { # write continuation's arguments into the interface arguments # we may need a commit for a shared DataGear for my $arg ( @{$outputArgs{$codeGearName}->{$next}} ) { my $v = shift(@args); print $fd "\t*O_$arg = $v;\n"; } if ($hasParGoto) { print $fd "${prev}Gearef(cbc_context, TaskManager)->taskList = cbc_context->taskList;\n"; print $fd "${prev}Gearef(cbc_context, TaskManager)->next1 = C_$next;\n"; print $fd "${prev}goto meta(cbc_context, C_$next);\n"; } else { # print $fd "${prev}cbc_context->before = C_$codeGearName;\n"; print $fd "${prev}goto meta(cbc_context, $next);\n"; } next; } if ($hasParGoto) { print $fd "${prev}Gearef(cbc_context, TaskManager)->taskList = cbc_context->taskList;\n"; print $fd "${prev}Gearef(cbc_context, TaskManager)->next1 = C_$next;\n"; print $fd "${prev}goto parGotoMeta(cbc_context, C_$next);\n"; next; } elsif ($next eq "meta") { print $fd $_; next; } else { # print $fd "${prev}cbc_context->before = C_$codeGearName;\n"; print $fd "${prev}goto meta(cbc_context, C_$next);\n"; next; } } elsif(/^.*(struct|union)?\s(\w+)\*\s(\w+)\s?[=;]/) { my $type = $2; my $varName = $3; $localVarType{$varName} = $type; s/new\s+(\w+)\(\)/\&ALLOCATE(cbc_context, \1)->\1/g; # replacing new } elsif(/^}/) { $hasParGoto = 0; } else { s/new\s+(\w+)\(\)/\&ALLOCATE(cbc_context, \1)->\1/g; # replacing new } # gather type name and type } elsif ($inMain) { if (/^(.*)goto start_code\(main_context\);/) { print $fd $_; next; } elsif (/^(.*)goto (\w+)\((.*)\);/) { my $prev = $1; my $next = $2; print $fd "${prev}struct Context* main_context = NEW(struct Context);\n"; print $fd "${prev}initContext(main_context);\n"; print $fd "${prev}main_cbc_context->next = C_$next;\n"; print $fd "${prev}goto start_code(main_context);\n"; next; } } if (/^}/) { $inStub = 0; $inTypedef = 0; $inMain = 0; $inCode = 0; } print $fd $_; } if (defined $prevCodeGearName) { if (!defined $stub{$prevCodeGearName."_stub"}) { $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName}); } } } # end