Mercurial > hg > Members > Moririn
annotate src/parallel_execution/generate_stub.pl @ 278:23767f714f4a
fix generate_stub
| author | mir3636 |
|---|---|
| date | Thu, 02 Feb 2017 20:27:56 +0900 |
| parents | d14eb393023d |
| children | 2c2e4e597eb0 |
| 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+);$/ ) { |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
71 $var{$name}->{$2} = $1; |
| 250 | 72 } 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
|
73 $code{$name}->{$1} = 1; |
| 250 | 74 } |
| 194 | 75 if (/^}/) { |
| 76 $inTypedef = 0; | |
| 77 } | |
| 78 } | |
| 79 } | |
| 80 | |
| 250 | 81 sub generateStub { |
| 251 | 82 my($fd,$prevCodeGearName,$dataGearName) = @_; |
| 274 | 83 print $fd "__code ", $prevCodeGearName ,"_stub(struct Context* context) {\n"; |
| 251 | 84 print $fd $dataGearName; |
| 250 | 85 print $fd "\n} \n\n"; |
| 251 | 86 return 1; |
| 250 | 87 } |
| 88 | |
| 253 | 89 sub generateStubArgs { |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
90 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
|
91 my $varname1 = $output?"O_$varName":$varName; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
92 for my $n ( @{$dataGearVar{$codeGearName}} ) { |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
93 # we already have it |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
94 return 0 if ( $n eq $varname1); |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
95 } |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
96 push @{$dataGearVar{$codeGearName}}, $varname1; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
97 if ($typeName eq $implementation) { |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
98 # get implementation |
| 258 | 99 $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $interface, $varName);\n"; |
| 253 | 100 } else { |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
101 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
|
102 # input data gear field |
| 253 | 103 if ($varName eq $ivar) { |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
104 if ($output) { |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
105 $dataGearName{$codeGearName} .= "\t$typeName** O_$varName = &Gearef(context, $interface)->$varName;\n"; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
106 $outputVar{$codeGearName} .= "\t$typeName* $varName;\n"; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
107 return 1; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
108 } |
| 253 | 109 $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
|
110 return 1; |
| 253 | 111 } |
| 112 } | |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
113 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
|
114 if ($varName eq $cName) { |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
115 # 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
|
116 $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
|
117 return 1; |
| 253 | 118 } |
| 119 } | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
120 # global variable case |
| 268 | 121 $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
|
122 return 1; |
| 253 | 123 } |
| 124 } | |
| 125 | |
| 194 | 126 sub generateDataGear { |
| 249 | 127 my ($filename) = @_; |
| 128 open my $in,"<",$filename or die("can't open $filename $!"); | |
| 254 | 129 |
| 130 my $fn; | |
| 131 if ($opt_o) { | |
| 132 $fn = $opt_o; | |
| 133 } else { | |
| 134 my $fn1 = $filename; | |
| 135 $fn1 =~ s/\.cbc/.c/; | |
| 136 my $i = 1; | |
| 255 | 137 $fn = "$dir/$fn1"; |
| 254 | 138 while ( -f $fn) { |
| 255 | 139 $fn = "$dir/$fn1.$i"; |
| 254 | 140 $i++; |
| 141 } | |
| 250 | 142 } |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
143 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
|
144 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
|
145 mkdir $1; |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
146 } |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
147 } |
| 249 | 148 open my $fd,">",$fn or die("can't write $fn $!"); |
| 254 | 149 |
| 249 | 150 my $prevCodeGearName; |
| 250 | 151 my $inTypedef = 0; |
| 278 | 152 my $inStub = 0; |
| 250 | 153 my %stub; |
| 251 | 154 my $codeGearName; |
| 254 | 155 |
| 249 | 156 while (<$in>) { |
| 278 | 157 if (! $inTypedef && ! $inStub) { |
| 249 | 158 if (/^typedef struct (\w+) {/) { |
| 159 $inTypedef = 1; | |
| 253 | 160 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { |
| 251 | 161 $codeGearName = $1; |
| 253 | 162 my $args = $2; |
| 163 my $tail = $3; | |
| 250 | 164 if ($codeGearName =~ /_stub$/) { |
| 262 | 165 # don't touch already existing stub |
| 278 | 166 $inStub = 1; |
| 250 | 167 $stub{$codeGearName} = 1; |
| 168 print $fd $_; | |
| 169 next; | |
| 170 } | |
| 249 | 171 if (defined $prevCodeGearName) { |
| 262 | 172 # stub is generated just before next CodeGear |
| 250 | 173 if (defined $stub{$prevCodeGearName."_stub"}) { |
| 174 undef $prevCodeGearName; | |
| 278 | 175 } else { |
| 176 &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName}); | |
| 177 $stub{$prevCodeGearName."_stub"} = 1; | |
| 250 | 178 } |
| 249 | 179 } |
| 262 | 180 # analyzing CodeGear argument |
| 181 # these arguments are extract from current context's arugment DataGear Interface | |
| 182 # and passed to the CodeGear | |
| 183 # struct Implementaion needs special handling | |
| 184 # __code next(...) ---> enum Code next | |
| 253 | 185 $prevCodeGearName = $codeGearName; |
| 186 $dataGearVar{$codeGearName} = []; | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
187 $outputVar{$codeGearName} = ""; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
188 $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
|
189 my $newArgs = "struct Context *context,"; |
| 253 | 190 while($args) { |
| 191 if ($args =~ s/(^\s*,\s*)//) { | |
| 192 $newArgs .= $1; | |
| 193 } | |
| 262 | 194 # continuation case |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
195 if ($args =~ s/^\_\_code\s+(\w+)\(([^)]*)\)//) { |
| 253 | 196 my $next = $1; |
| 197 my @args = split(/,/,$2); | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
198 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
|
199 $newArgs .= "enum Code $next"; |
| 258 | 200 } |
| 262 | 201 # analyze continuation arguments |
| 202 # output arguments are defined in the Interface take the pointer of these | |
| 203 # output arguments are put into the Interface DataGear just before the goto | |
| 253 | 204 for my $arg (@args) { |
| 205 $arg =~ s/^\s*//; | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
206 last if ($arg =~ /\.\.\./); |
| 253 | 207 $arg =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//; |
| 208 my $structType = $1; | |
| 209 my $typeName = $2; | |
| 210 my $varName = $4; | |
| 211 my $typeField = lcfirst($typeName); | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
212 push(@{$outputArgs{$codeGearName}->{$next}}, $varName); |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
213 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
|
214 $newArgs .= ",$structType $typeName **O_$varName"; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
215 } |
| 253 | 216 } |
| 217 } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) { | |
| 218 my $structType = $1; | |
| 219 my $typeName = $2; | |
| 220 my $varName = $4; | |
| 221 my $typeField = lcfirst($typeName); | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
222 $newArgs .= $&; # assuming no duplicate |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
223 &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface,0); |
| 255 | 224 } elsif ($args =~ s/(.*,)//) { |
| 225 $newArgs .= $1; | |
| 226 } else { | |
| 227 $newArgs .= $args; | |
| 228 last; | |
| 253 | 229 } |
| 230 } | |
| 262 | 231 # generate goto statement from stub to the CodeGear in the buffer |
| 253 | 232 $dataGearName{$codeGearName} .= "\tgoto $codeGearName(context"; |
| 233 for my $arg ( @{$dataGearVar{$codeGearName}}) { | |
| 234 $dataGearName{$codeGearName} .= ", $arg"; | |
| 235 } | |
| 236 $dataGearName{$codeGearName} .= ");"; | |
| 262 | 237 # generate CodeGear header with new arguments |
| 253 | 238 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
|
239 if ($outputVar{$codeGearName} ne "") { |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
240 print $fd $outputVar{$codeGearName}; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
241 } |
| 250 | 242 next; |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
243 } elsif (/^(.*)goto (\w+)\((.*)\);/) { |
| 278 | 244 # handling goto statement |
| 262 | 245 # convert it to the meta call form with two arugments, that is context and enum Code |
| 250 | 246 my $prev = $1; |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
247 my $next = $2; |
|
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
248 my @args = split(/,/,$3); |
| 278 | 249 if (defined $code{$interface}->{$next}) { |
| 250 # write continuation's arguments into the interface arguments | |
| 251 # we may need a commit for a shared DataGear | |
| 252 for my $arg ( @{$outputArgs{$codeGearName}->{$next}} ) { | |
| 253 my $v = shift(@args); | |
| 254 print $fd "\t*O_$arg = $v;\n"; | |
| 255 } | |
| 256 print $fd "${prev}goto meta(context, $next);\n"; | |
| 257 next; | |
|
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
258 } |
|
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
259 } else { |
|
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
260 s/new\s+(\w+)\(\)/\&ALLOCATE(context, \1)->\1/g; # replacing new |
| 249 | 261 } |
| 262 # 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
|
263 } elsif (/^}/) { |
| 278 | 264 $inStub = 0; |
| 249 | 265 $inTypedef = 0; |
| 266 } | |
| 250 | 267 print $fd $_; |
| 194 | 268 } |
| 250 | 269 if (defined $prevCodeGearName) { |
| 270 if (!defined $stub{$prevCodeGearName."_stub"}) { | |
| 251 | 271 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName}); |
| 250 | 272 } |
| 228 | 273 } |
| 194 | 274 } |
| 275 | |
| 276 # end |