Mercurial > hg > Members > Moririn
annotate src/parallel_execution/generate_stub.pl @ 324:d9887056ae5b
Update Todo and Add comment to perl script
| author | one |
|---|---|
| date | Fri, 14 Apr 2017 19:52:26 +0900 |
| parents | ec0a5b4fba05 |
| children | 3529c7e93c4f |
| rev | line source |
|---|---|
| 194 | 1 #!/usr/bin/perl |
| 2 | |
| 250 | 3 use strict; |
| 254 | 4 use Getopt::Std; |
| 250 | 5 |
| 194 | 6 # interface.cbc |
| 7 # typedef struct Worker { | |
| 8 # int id; | |
| 9 # struct Context* contexts; | |
| 10 # enum Code execute; | |
| 11 # enum Code taskSend; | |
| 12 # enum Code taskRecive; | |
| 13 # enum Code shutdown; | |
| 14 # struct Queue* tasks; | |
| 15 # } Worker; | |
| 16 | |
| 255 | 17 our($opt_o,$opt_d,$opt_h); |
| 18 getopts('o:d:h'); | |
| 19 | |
| 20 my $dir = "."; | |
| 21 if ($opt_d) { | |
| 22 $dir = $opt_d; | |
| 23 if (! -d $dir) { | |
| 24 mkdir $dir; | |
| 25 } | |
| 26 } | |
| 254 | 27 |
| 28 for my $fn (@ARGV) { | |
| 255 | 29 next if ($fn !~ /\.cbc$/); |
| 249 | 30 &getDataGear($fn); |
| 31 &generateDataGear($fn); | |
| 194 | 32 } |
| 33 | |
| 250 | 34 my %var; |
| 35 my %code; | |
| 36 my %dataGearVar; | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
37 my %outputVar; # output var initializer |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
38 my %outputArgs; # continuation's output variables |
| 250 | 39 my %dataGear; |
| 40 my %dataGearName; | |
| 253 | 41 my $implementation; |
| 42 my $interface; | |
| 250 | 43 |
| 194 | 44 sub getDataGear { |
| 45 my ($filename) = @_; | |
| 253 | 46 my ($codeGearName, $name, $inTypedef); |
| 194 | 47 open my $fd,"<",$filename or die("can't open $filename $!"); |
| 48 while (<$fd>) { | |
| 49 if (! $inTypedef) { | |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
50 if (/^typedef struct (\w+)/) { |
| 194 | 51 $inTypedef = 1; |
| 52 $name = $1; | |
| 53 $dataGear{$name} = $_; | |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
54 $var{$name} = {}; |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
55 $code{$name} = {}; |
| 269 | 56 } elsif (/^(\w+)(\*)+ create(\w+)\(/) { |
| 249 | 57 if (defined $interface) { |
| 58 die "duplicate interface $interface\n"; | |
| 59 } | |
| 60 $interface = $1; | |
| 269 | 61 $implementation = $3; |
| 250 | 62 if ( -f "$interface.cbc") { |
| 63 &getDataGear("$interface.cbc"); | |
| 64 } | |
| 226 | 65 } |
| 194 | 66 next; |
| 67 } | |
| 249 | 68 # gather type name and type |
| 194 | 69 $dataGear{$name} .= $_; |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
70 if (/^\s*(.*)\s+(\w+);$/ ) { |
| 280 | 71 my $ttype = $1; |
| 72 my $tname = $2; | |
| 73 if ($ttype =~ /^(union|struct) (\w+)/) { | |
| 74 $ttype = $2; | |
| 75 } | |
| 76 $var{$name}->{$tname} = $ttype; | |
| 250 | 77 } elsif (/\_\_code (\w+)\(/) { |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
78 $code{$name}->{$1} = 1; |
| 250 | 79 } |
| 194 | 80 if (/^}/) { |
| 81 $inTypedef = 0; | |
| 82 } | |
| 83 } | |
| 84 } | |
| 85 | |
| 250 | 86 sub generateStub { |
| 251 | 87 my($fd,$prevCodeGearName,$dataGearName) = @_; |
| 274 | 88 print $fd "__code ", $prevCodeGearName ,"_stub(struct Context* context) {\n"; |
| 251 | 89 print $fd $dataGearName; |
| 250 | 90 print $fd "\n} \n\n"; |
| 251 | 91 return 1; |
| 250 | 92 } |
| 93 | |
| 253 | 94 sub generateStubArgs { |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
95 my($codeGearName, $varName, $typeName, $typeField, $interface,$output) = @_; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
96 my $varname1 = $output?"O_$varName":$varName; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
97 for my $n ( @{$dataGearVar{$codeGearName}} ) { |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
98 # we already have it |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
99 return 0 if ( $n eq $varname1); |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
100 } |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
101 push @{$dataGearVar{$codeGearName}}, $varname1; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
102 if ($typeName eq $implementation) { |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
103 # get implementation |
| 258 | 104 $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $interface, $varName);\n"; |
| 253 | 105 } else { |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
106 for my $ivar (keys %{$var{$interface}}) { |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
107 # input data gear field |
| 253 | 108 if ($varName eq $ivar) { |
| 280 | 109 if ($typeName eq $var{$interface}->{$ivar}) { |
| 110 if ($output) { | |
| 111 $dataGearName{$codeGearName} .= "\t$typeName** O_$varName = &Gearef(context, $interface)->$varName;\n"; | |
| 112 $outputVar{$codeGearName} .= "\t$typeName* $varName;\n"; | |
| 113 return 1; | |
| 114 } | |
| 115 | |
| 116 $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $interface)->$varName;\n"; | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
117 return 1; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
118 } |
| 253 | 119 } |
| 120 } | |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
121 for my $cName (keys %{$code{$interface}}) { |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
122 if ($varName eq $cName) { |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
123 # continuation field |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
124 $dataGearName{$codeGearName} .= "\tenum Code $varName = Gearef(context, $interface)->$varName;\n"; |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
125 return 1; |
| 253 | 126 } |
| 127 } | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
128 # global variable case |
| 268 | 129 $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $typeName);\n"; |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
130 return 1; |
| 253 | 131 } |
| 132 } | |
| 133 | |
| 194 | 134 sub generateDataGear { |
| 249 | 135 my ($filename) = @_; |
| 136 open my $in,"<",$filename or die("can't open $filename $!"); | |
| 254 | 137 |
| 138 my $fn; | |
| 139 if ($opt_o) { | |
| 140 $fn = $opt_o; | |
| 141 } else { | |
| 142 my $fn1 = $filename; | |
| 143 $fn1 =~ s/\.cbc/.c/; | |
| 144 my $i = 1; | |
| 255 | 145 $fn = "$dir/$fn1"; |
| 254 | 146 while ( -f $fn) { |
| 255 | 147 $fn = "$dir/$fn1.$i"; |
| 254 | 148 $i++; |
| 149 } | |
| 250 | 150 } |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
151 if ( $fn =~ m=(.*)/[^/]+$= ) { |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
152 if (! -d $1) { |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
153 mkdir $1; |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
154 } |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
155 } |
| 249 | 156 open my $fd,">",$fn or die("can't write $fn $!"); |
| 254 | 157 |
| 249 | 158 my $prevCodeGearName; |
| 250 | 159 my $inTypedef = 0; |
| 278 | 160 my $inStub = 0; |
| 250 | 161 my %stub; |
| 251 | 162 my $codeGearName; |
| 254 | 163 |
| 249 | 164 while (<$in>) { |
| 278 | 165 if (! $inTypedef && ! $inStub) { |
| 249 | 166 if (/^typedef struct (\w+) {/) { |
| 167 $inTypedef = 1; | |
| 253 | 168 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { |
| 251 | 169 $codeGearName = $1; |
| 253 | 170 my $args = $2; |
| 171 my $tail = $3; | |
| 250 | 172 if ($codeGearName =~ /_stub$/) { |
| 262 | 173 # don't touch already existing stub |
| 278 | 174 $inStub = 1; |
| 250 | 175 $stub{$codeGearName} = 1; |
| 176 print $fd $_; | |
| 177 next; | |
| 178 } | |
| 249 | 179 if (defined $prevCodeGearName) { |
| 262 | 180 # stub is generated just before next CodeGear |
| 250 | 181 if (defined $stub{$prevCodeGearName."_stub"}) { |
| 182 undef $prevCodeGearName; | |
| 278 | 183 } else { |
| 184 &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName}); | |
| 185 $stub{$prevCodeGearName."_stub"} = 1; | |
| 250 | 186 } |
| 249 | 187 } |
| 262 | 188 # analyzing CodeGear argument |
| 189 # these arguments are extract from current context's arugment DataGear Interface | |
| 190 # and passed to the CodeGear | |
| 191 # struct Implementaion needs special handling | |
| 192 # __code next(...) ---> enum Code next | |
| 253 | 193 $prevCodeGearName = $codeGearName; |
| 194 $dataGearVar{$codeGearName} = []; | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
195 $outputVar{$codeGearName} = ""; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
196 $outputArgs{$codeGearName} = {}; |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
197 my $newArgs = "struct Context *context,"; |
| 305 | 198 if ($args=~/^struct Context\s*\*\s*context/) { |
| 199 $newArgs = ""; | |
| 200 } | |
| 253 | 201 while($args) { |
| 202 if ($args =~ s/(^\s*,\s*)//) { | |
| 203 $newArgs .= $1; | |
| 204 } | |
| 262 | 205 # continuation case |
| 280 | 206 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) { |
| 207 my $next = $2; | |
| 208 my @args = split(/,/,$3); | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
209 if ( &generateStubArgs($codeGearName, $next, "Code", $next, $interface,0) ) { |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
210 $newArgs .= "enum Code $next"; |
| 258 | 211 } |
| 262 | 212 # analyze continuation arguments |
| 213 # output arguments are defined in the Interface take the pointer of these | |
| 214 # output arguments are put into the Interface DataGear just before the goto | |
| 253 | 215 for my $arg (@args) { |
| 216 $arg =~ s/^\s*//; | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
217 last if ($arg =~ /\.\.\./); |
| 253 | 218 $arg =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//; |
| 219 my $structType = $1; | |
| 220 my $typeName = $2; | |
| 221 my $varName = $4; | |
| 222 my $typeField = lcfirst($typeName); | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
223 push(@{$outputArgs{$codeGearName}->{$next}}, $varName); |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
224 if (&generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface,1)) { |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
225 $newArgs .= ",$structType $typeName **O_$varName"; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
226 } |
| 253 | 227 } |
| 228 } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) { | |
| 229 my $structType = $1; | |
| 230 my $typeName = $2; | |
| 231 my $varName = $4; | |
| 232 my $typeField = lcfirst($typeName); | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
233 $newArgs .= $&; # assuming no duplicate |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
234 &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface,0); |
| 255 | 235 } elsif ($args =~ s/(.*,)//) { |
| 236 $newArgs .= $1; | |
| 237 } else { | |
| 238 $newArgs .= $args; | |
| 239 last; | |
| 253 | 240 } |
| 241 } | |
| 262 | 242 # generate goto statement from stub to the CodeGear in the buffer |
| 253 | 243 $dataGearName{$codeGearName} .= "\tgoto $codeGearName(context"; |
| 244 for my $arg ( @{$dataGearVar{$codeGearName}}) { | |
| 245 $dataGearName{$codeGearName} .= ", $arg"; | |
| 246 } | |
| 247 $dataGearName{$codeGearName} .= ");"; | |
| 262 | 248 # generate CodeGear header with new arguments |
| 253 | 249 print $fd "__code $codeGearName($newArgs)$tail\n"; |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
250 if ($outputVar{$codeGearName} ne "") { |
| 324 | 251 # output data var can be use before write |
| 252 # it should be initialze by gearef | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
253 print $fd $outputVar{$codeGearName}; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
254 } |
| 250 | 255 next; |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
256 } elsif (/^(.*)goto (\w+)\((.*)\);/) { |
| 278 | 257 # handling goto statement |
| 262 | 258 # convert it to the meta call form with two arugments, that is context and enum Code |
| 250 | 259 my $prev = $1; |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
260 my $next = $2; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
261 my @args = split(/,/,$3); |
| 278 | 262 if (defined $code{$interface}->{$next}) { |
| 263 # write continuation's arguments into the interface arguments | |
| 264 # we may need a commit for a shared DataGear | |
| 265 for my $arg ( @{$outputArgs{$codeGearName}->{$next}} ) { | |
| 266 my $v = shift(@args); | |
| 267 print $fd "\t*O_$arg = $v;\n"; | |
| 268 } | |
| 269 print $fd "${prev}goto meta(context, $next);\n"; | |
| 270 next; | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
271 } |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
272 } else { |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
273 s/new\s+(\w+)\(\)/\&ALLOCATE(context, \1)->\1/g; # replacing new |
| 249 | 274 } |
| 275 # gather type name and type | |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
276 } elsif (/^}/) { |
| 278 | 277 $inStub = 0; |
| 249 | 278 $inTypedef = 0; |
| 279 } | |
| 250 | 280 print $fd $_; |
| 194 | 281 } |
| 250 | 282 if (defined $prevCodeGearName) { |
| 283 if (!defined $stub{$prevCodeGearName."_stub"}) { | |
| 251 | 284 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName}); |
| 250 | 285 } |
| 228 | 286 } |
| 194 | 287 } |
| 288 | |
| 289 # end |