Mercurial > hg > GearsTemplate
view src/parallel_execution/generate_stub.pl @ 258:4fe19a06d666
generate next args
author | mir3636 |
---|---|
date | Sat, 28 Jan 2017 12:25:35 +0900 |
parents | 79bbe2c63fb0 |
children | 0cd43e22aee1 |
line wrap: on
line source
#!/usr/bin/perl use strict; use Getopt::Std; # 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) { mkdir $dir; } } for my $fn (@ARGV) { next if ($fn !~ /\.cbc$/); &getDataGear($fn); &generateDataGear($fn); } my %var; my %type; my %code; my %dataGearVar; my %dataGear; my %dataGearName; my $implementation; my $interface; 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+) {/) { $inTypedef = 1; $name = $1; $dataGear{$name} = $_; $code{$name} = []; } elsif (/^(\w+)\* create(\w+)\(/) { if (defined $interface) { die "duplicate interface $interface\n"; } $interface = $1; $implementation = $2; if ( -f "$interface.cbc") { &getDataGear("$interface.cbc"); } } next; } # gather type name and type $dataGear{$name} .= $_; if (/(\w+);$/ and !/^} (\w+)/) { my $tmp = $1 . "\n"; if (/{/) { $tmp = "{" . $'; $tmp =~ s/;$//; } $var{$name} .= $tmp; $tmp = $`; $tmp =~ s/^\s*//; $type{$name} .= $tmp . "\n"; } elsif (/\_\_code (\w+)\(/) { push $code{$name}, $1; } if (/^}/) { $inTypedef = 0; } } } 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) = @_; push @{$dataGearVar{$codeGearName}},$varName; if ($typeField ne $varName) { $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $interface, $varName);\n"; # print STDOUT "$codeGearName \t$typeName* $varName = ($typeName*)GearImpl(context, $typeName, $varName);\n"; } else { for my $ivar ($var{$interface}) { if ($varName eq $ivar) { $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $interface)->$varName;\n"; # print STDOUT "$codeGearName \t$typeName* $varName = Gearef(context, $interface)->$varName;\n"; return; } } $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $typeName);\n"; # print STDOUT "$codeGearName \t$typeName* $varName = Gearef(context, $typeName)->$typeField;\n"; } } 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++; } } open my $fd,">",$fn or die("can't write $fn $!"); my $prevCodeGearName; my $inTypedef = 0; my %stub; my $codeGearName; while (<$in>) { if (! $inTypedef) { if (/^typedef struct (\w+) {/) { $inTypedef = 1; # get __code name } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { $codeGearName = $1; my $args = $2; my $tail = $3; if ($codeGearName =~ /_stub$/) { $stub{$codeGearName} = 1; print $fd $_; next; } if (defined $prevCodeGearName) { if (defined $stub{$prevCodeGearName."_stub"}) { undef $prevCodeGearName; print $fd $_; next; } $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName}); } $prevCodeGearName = $codeGearName; $dataGearVar{$codeGearName} = []; my $newArgs = ""; while($args) { if ($args =~ s/(^\s*,\s*)//) { $newArgs .= $1; } # replace __code next if ($args =~ s/^\_\_code\s(\w+)\(([^)]*)\)//) { my $next = $1; my @args = split(/,/,$3); my $nextArg = $2; # generate stub args of next args while ($nextArg =~ s/union (\w+)(\*)+\s([^,]*)//) { my $typeName = $1.$2; my $varName = $3; my $typeField = lcfirst($1); $newArgs .= "union $typeName\* $3, "; &generateStubArgs($codeGearName, $varName, $1, $typeField, $interface); } $newArgs .= "enum Code $next"; for my $arg (@args) { $arg =~ s/^\s*//; $arg =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//; my $structType = $1; my $typeName = $2; my $varName = $4; my $typeField = lcfirst($typeName); &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface); } } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) { my $structType = $1; my $typeName = $2; my $varName = $4; my $typeField = lcfirst($typeName); $newArgs .= $&; &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface); } elsif ($args =~ s/(.*,)//) { $newArgs .= $1; } else { $newArgs .= $args; last; } } $dataGearName{$codeGearName} .= "\tgoto $codeGearName(context"; for my $arg ( @{$dataGearVar{$codeGearName}}) { $dataGearName{$codeGearName} .= ", $arg"; } $dataGearName{$codeGearName} .= ");"; print $fd "__code $codeGearName($newArgs)$tail\n"; next; } elsif (/^(.*)goto\s(\w+)\((.*)\.\.\.\);/) { #print STDOUT "$3\n"; my $prev = $1; my $args = $3; print $fd "${prev}goto meta(context, $2);\n"; next; } print $fd $_; next; } # gather type name and type if (/^}/) { $inTypedef = 0; } print $fd $_; } if (defined $prevCodeGearName) { if (!defined $stub{$prevCodeGearName."_stub"}) { $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName}); } } } # end