Mercurial > hg > Members > Moririn
view src/parallel_execution/generate_stub.pl @ 424:3c6af75b13d4
fix RedBlackTree.cbc
author | mir3636 |
---|---|
date | Fri, 06 Oct 2017 18:00:28 +0900 |
parents | d839c9cb7c83 |
children | 481fce540daf |
line wrap: on
line source
#!/usr/bin/perl use strict; use Getopt::Std; use File::Path qw(make_path); # interface.cbc # 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, Impl>{ # 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(context, Stack)->stack = nodeStack->stack; # Gearef(context, Stack)->data = (union Data*)node; # Gearef(context, Stack)->next = C_stackTest3; # goto meta(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 (/^(\s)*(\w+)\-\>(\w+)\s\=\s\((.*)\)create(\w+)\((.*)\);$/) { #my $intfn = ucfirst($2); my $impln = $5; if ( -f "$impln.cbc") { &getCodeGear("$impln.cbc"); } } elsif(/^(.*)par goto (\w+)\((.*)\)/) { my $codeGearName = $2; 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) (\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; } if (defined $name) { if (/^\_\_code (\w+)$impln\((.*)\)(.*)/) { my $args = $2; my $method = $1; $code{$name}->{$method} = []; while($args) { if ($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) (\w+)(\*)+\s(\w+)//) { my $structType = $1; my $typeName = $2; my $varName = $4; my $typeField = lcfirst($typeName); push(@{$code{$name}->{$method}},"$typeName $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+)\((.*?)\)//) { $inputIncFlag = 0; $outputCount = split(/,/,$3); $outputCount--; } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) { if($inputIncFlag) { $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* context) {\n"; print $fd $dataGearName; print $fd "\n} \n\n"; return 1; } sub generateStubArgs { my($codeGearName, $varName, $typeName, $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(context, $interface, $varName);\n"; } else { 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** O_$varName = &Gearef(context, $interface)->$varName;\n"; $outputVar{$codeGearName} .= "\t$typeName* $varName;\n"; return 1; } $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $interface)->$varName;\n"; return 1; } } } for my $cName (keys %{$code{$interface}}) { if ($varName eq $cName) { # continuation field $dataGearName{$codeGearName} .= "\tenum Code $varName = Gearef(context, $interface)->$varName;\n"; return 1; } } # global or local variable case if ($typeName eq "Code") { $dataGearName{$codeGearName} .= "\tenum $typeName $varName = Gearef(context, $interface)->$varName;\n"; return 1; } $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(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 $inParGoto = 0; my $inMain = 0 ; my %stub; my $codeGearName; while (<$in>) { if (! $inTypedef && ! $inStub && ! $inMain) { if (/^typedef struct (\w+) {/) { $inTypedef = 1; } elsif (/^int main\((.*)\) {/) { $inMain = 1; } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { $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 *context,"; if ($args=~/^struct Context\s*\*\s*context/) { $newArgs = ""; } 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) (\w+)(\*)+\s(\w+)//; my $structType = $1; my $typeName = $2; my $varName = $4; my $typeField = lcfirst($typeName); push(@{$outputArgs{$codeGearName}->{$next}}, $varName); if (&generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface,1)) { $newArgs .= ",$structType $typeName **O_$varName"; } } } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) { my $structType = $1; my $typeName = $2; my $varName = $4; my $typeField = lcfirst($typeName); $newArgs .= $&; # assuming no duplicate &generateStubArgs($codeGearName, $varName, $typeName, $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(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 (/^(.*)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 @args = split(/,/,$4); my @types = @{$dataGearVarType{$codeGearName}}; my $ntype; my $ftype; for my $v (@{$dataGearVar{$codeGearName}}) { my $t = shift @types; if ($v eq $next) { $ntype = $t; $ftype = lcfirst($ntype); } } print $fd "\tGearef(context, $ntype)->$ftype = $next->$ftype;\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$//) { print $fd "\tGearef(context, $ntype)->$pName = C_$arg;\n"; } elsif ($pType =~ s/Data$//){ print $fd "\tGearef(context, $ntype)->$pName = (union Data*) $arg;\n"; } else { print $fd "\tGearef(context, $ntype)->$pName = $arg;\n"; } $i++; } print $fd "${prev}goto meta(context, $next->$ftype->$ntype.$method);\n"; next; } elsif(/^(.*)par goto (\w+)\((.*)\);/) { # handling par goto statement # convert it to the parallel my $prev = $1; my $codeGearName = $2; my $inputCount = $codeGear{$codeGearName}->{'input'}; my $outputCount = $codeGear{$codeGearName}->{'output'}; my @dataGears = split(/,\s*/, $3); my $nextCodeGear = pop(@dataGears); my @iterateCounts; # parse examples 'par goto(.., iterate(10), exit);' if ($3 =~ /iterate\((.*)?\)/) { @iterateCounts = split(/,/,$1);; $inputCount--; # pop iterate statement pop(@dataGears); } if (! $inParGoto) { $inParGoto = 1; print $fd "${prev}struct Element* element;\n"; } my $initTask = << "EOFEOF"; ${prev}context->task = NEW(struct Context); ${prev}initContext(context->task); ${prev}context->task->next = C_$codeGearName; ${prev}context->task->idgCount = $inputCount; ${prev}context->task->idg = context->task->dataNum; ${prev}context->task->maxIdg = context->task->idg + $inputCount; ${prev}context->task->odg = context->task->maxIdg; ${prev}context->task->maxOdg = context->task->odg + $outputCount; EOFEOF print $fd $initTask; if (@iterateCounts) { print $fd "${prev}context->task->iterate = 0;\n"; my $len = @iterateCounts; if ($len == 1) { print $fd "${prev}context->task->iterator = createMultiDimIterator(context, $iterateCounts[0], 1, 1);\n"; } elsif ($len == 2) { print $fd "${prev}context->task->iterator = createMultiDimIterator(context, $iterateCounts[0], $iterateCounts[1], 1);\n"; } elsif ($len == 3) { print $fd "${prev}context->task->iterator = createMultiDimIterator(context, $iterateCounts[0], $iterateCounts[1], $iterateCounts[2]);\n"; } } for my $i (0..$inputCount-1) { print $fd "${prev}context->task->data[context->task->idg+$i] = (union Data*)@dataGears[$i];\n"; } for my $i (0..$outputCount-1) { print $fd "${prev}context->task->data[context->task->odg+$i] = (union Data*)@dataGears[$inputCount+$i];\n"; } my $putTask = << "EOFEOF"; ${prev}element = &ALLOCATE(context, Element)->Element; ${prev}element->next = NULL; ${prev}element->data = (union Data*)context->task; ${prev}context->tasks->queue->SingleLinkedQueue.last->next = element; ${prev}context->tasks->queue->SingleLinkedQueue.last = 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; 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 ($inParGoto) { print $fd "${prev}taskManager->tasks = context->tasks;\n"; print $fd "${prev}taskManager->next1 = C_$next;\n"; print $fd "${prev}goto meta(context, C_$next);\n"; } else { print $fd "${prev}goto meta(context, $next);\n"; } next; } if ($inParGoto) { print $fd "${prev}taskManager->tasks = context->tasks;\n"; print $fd "${prev}taskManager->next1 = C_$next;\n"; print $fd "${prev}goto meta(context, C_$next);\n"; next; } elsif ($next eq "meta") { print $fd $_; next; } else { print $fd "${prev}goto meta(context, C_$next);\n"; next; } } elsif(/^}/) { $inParGoto = 0; } else { s/new\s+(\w+)\(\)/\&ALLOCATE(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_context->next = C_$next;\n"; print $fd "${prev}goto start_code(main_context);\n"; next; } } if (/^}/) { $inStub = 0; $inTypedef = 0; $inMain = 0; } print $fd $_; } if (defined $prevCodeGearName) { if (!defined $stub{$prevCodeGearName."_stub"}) { $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName}); } } } # end