Mercurial > hg > CbC > CbC_xv6
annotate src/gearsTools/generate_stub.pl @ 245:9471a8635489
fix regex at collection for data gears at generate_stub
| author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
|---|---|
| date | Tue, 04 Feb 2020 09:22:07 +0900 |
| parents | f0821818e3ed |
| children | 63a65e3a5340 |
| rev | line source |
|---|---|
| 44 | 1 #!/usr/bin/perl |
| 2 | |
| 3 use strict; | |
| 4 use Getopt::Std; | |
| 5 use File::Path qw(make_path); | |
| 6 | |
| 7 # interface.h | |
| 8 # typedef struct Worker { | |
| 9 # int id; | |
| 10 # struct Context* contexts; | |
| 11 # enum Code execute; | |
| 12 # enum Code taskSend; | |
| 13 # enum Code taskRecive; | |
| 14 # enum Code shutdown; | |
| 15 # struct Queue* tasks; | |
| 16 # } Worker; | |
| 17 | |
| 18 our($opt_o,$opt_d,$opt_h); | |
| 19 getopts('o:d:h'); | |
| 20 | |
| 21 my $dir = "."; | |
| 22 if ($opt_d) { | |
| 23 $dir = $opt_d; | |
| 24 if (! -d $dir) { | |
| 25 make_path $dir; | |
| 26 } | |
| 27 } | |
| 28 | |
| 29 for my $fn (@ARGV) { | |
| 30 next if ($fn !~ /\.cbc$/); | |
| 31 &getDataGear($fn); | |
| 32 &generateDataGear($fn); | |
| 33 } | |
| 34 | |
| 35 my %var; | |
| 36 my %code; | |
| 37 my %dataGearVar; | |
| 38 my %outputVar; # output var initializer | |
| 39 my %outputArgs; # continuation's output variables | |
| 40 my %dataGear; | |
| 41 my %dataGearName; | |
| 42 my %generic; | |
| 43 my %dataGearVarType; | |
| 44 my %codeGear; | |
| 45 my $implementation; | |
| 46 my $interface; | |
| 47 | |
| 48 # interface definision | |
| 49 # | |
| 50 # typedef struct Stack<Type, Impl>{ | |
| 51 # Type* stack; | |
| 52 # Type* data; | |
| 53 # Type* data1; | |
| 54 # __code whenEmpty(...); | |
| 55 # __code clear(Impl* stack,__code next(...)); | |
| 56 # __code push(Impl* stack,Type* data, __code next(...)); | |
| 57 # __code pop(Impl* stack, __code next(Type*, ...)); | |
| 58 # __code pop2(Impl* stack, Type** data, Type** data1, __code next(Type**, Type**, ...)); | |
| 59 # __code isEmpty(Impl* stack, __code next(...), __code whenEmpty(...)); | |
| 60 # __code get(Impl* stack, Type** data, __code next(...)); | |
| 61 # __code get2(Impl* stack,..., __code next(...)); | |
| 62 # __code next(...); | |
| 63 # } Stack; | |
| 64 # | |
| 65 # calling example | |
| 66 # | |
| 67 # goto nodeStack->push((union Data*)node, stackTest3); | |
| 68 # | |
| 69 # generated meta level code | |
| 70 # | |
| 52 | 71 # Gearef(cbc_context, Stack)->stack = (union Data*)nodeStack; |
| 72 # Gearef(cbc_context, Stack)->data = (union Data*)node; | |
| 73 # Gearef(cbc_context, Stack)->next = C_stackTest3; | |
| 74 # goto meta(cbc_context, nodeStack->push); | |
| 44 | 75 |
| 76 sub getDataGear { | |
| 77 my ($filename) = @_; | |
| 78 my ($codeGearName, $name, $inTypedef); | |
| 79 open my $fd,"<",$filename or die("can't open $filename $!"); | |
| 80 while (<$fd>) { | |
| 81 if (! $inTypedef) { | |
| 82 if (/^typedef struct (\w+)\s*<(.*)>/) { | |
| 83 $inTypedef = 1; | |
| 84 $name = $1; | |
| 85 $dataGear{$name} = $_; | |
| 86 $var{$name} = {}; | |
| 87 $code{$name} = {}; | |
| 88 $generic{$name} = \split(/,/,$2); | |
| 89 } elsif (/^typedef struct (\w+)/) { | |
| 90 $inTypedef = 1; | |
| 91 $name = $1; | |
| 92 $dataGear{$name} = $_; | |
| 93 $var{$name} = {}; | |
| 94 $code{$name} = {}; | |
| 95 $generic{$name} = []; | |
| 96 } elsif (/^(\w+)(\*)+ create(\w+)\(/) { | |
| 97 if (defined $interface) { | |
| 98 die "duplicate interface $interface\n"; | |
| 99 } | |
| 100 $interface = $1; | |
| 101 $implementation = $3; | |
| 102 if ( -f "$interface.cbc") { | |
| 103 &getDataGear("$interface.cbc"); | |
| 104 } | |
| 105 } elsif(/^(.*)par goto (\w+)\((.*)\)/) { | |
| 106 my $codeGearName = $2; | |
| 107 if ($filename =~ /^(.*)\/(.*)/) { | |
| 108 $codeGearName = "$1/$codeGearName"; | |
| 109 } | |
| 110 if ( -f "$codeGearName.cbc") { | |
| 111 &getCodeGear("$codeGearName.cbc"); | |
| 112 } | |
|
242
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
113 } elsif(/^#interface "(.*)"/) { |
| 44 | 114 # use interface |
| 115 my $interfaceHeader = $1; | |
| 116 next if ($interfaceHeader =~ /context.h/); | |
| 117 if (-f $interfaceHeader) { | |
| 118 &getDataGear("$interfaceHeader"); | |
| 119 &getCodeGear("$interfaceHeader"); | |
| 120 } | |
| 121 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { | |
| 122 my $codeGearName = $1; | |
| 123 if ($filename =~ /^(.*)\/(.*)/) { | |
| 124 $codeGearName = "$1/$codeGearName"; | |
| 125 } | |
| 126 if ( -f "$codeGearName.cbc") { | |
| 127 &getCodeGear("$codeGearName.cbc"); | |
| 128 } | |
| 129 } | |
| 130 next; | |
| 131 } | |
| 132 # gather type name and type | |
| 133 $dataGear{$name} .= $_; | |
| 134 if (/^\s*(.*)\s+(\w+);$/ ) { | |
| 135 my $ttype = $1; | |
| 136 my $tname = $2; | |
| 137 if ($ttype =~ /^(union|struct)?\s*(\w+)/) { | |
| 138 $ttype = $2; | |
| 139 } | |
| 140 $var{$name}->{$tname} = $ttype; | |
| 141 } | |
|
242
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
142 if (/__code (\w+)/) { |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
143 my $args = $'; |
|
245
9471a8635489
fix regex at collection for data gears at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
244
diff
changeset
|
144 while ($args =~ /(struct|union|const)?\s*([\w\[\]_]+)\*?\s*(\w+),?/g) { |
|
242
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
145 #$args eq (Impl* vm, pde_t* pgdir, char* init, uint sz, __code next(...)); |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
146 my $const_type = $1; |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
147 my $ttype = $2; |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
148 my $tname = $3; |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
149 |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
150 $ttype =~ s/Impl/struct $name/; |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
151 if ($const_type eq 'const') { |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
152 $ttype = "const $ttype"; |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
153 } |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
154 $var{$name}->{$tname} = $ttype; |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
155 } |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
156 } |
| 44 | 157 if (/^}/) { |
| 158 $inTypedef = 0; | |
| 159 } | |
| 160 } | |
| 161 | |
| 162 } | |
| 163 | |
| 164 sub getCodeGear { | |
| 165 my ($filename) = @_; | |
| 166 open my $fd,"<",$filename or die("can't open $filename $!"); | |
| 167 my ($name,$impln); | |
| 168 while (<$fd>) { | |
| 169 if (/^(\w+)(\*)+ create(\w+)\(/) { | |
| 170 $name = $1; | |
| 171 $impln = $3; | |
| 172 } elsif(/^typedef struct (.*)<.*>\s*{/) { | |
| 173 $name = $1; | |
| 174 } | |
| 175 if (defined $name) { | |
| 176 if (/^\s*\_\_code (\w+)\((.*)\);/) { | |
| 177 my $args = $2; | |
| 178 my $method = $1; | |
| 179 $code{$name}->{$method} = []; | |
| 180 while($args) { | |
| 181 # replace comma | |
| 182 $args =~ s/(^\s*,\s*)//; | |
| 183 # continuation case | |
| 184 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) { | |
| 185 my $next = $2; | |
| 186 my @args = split(/,/,$3); | |
| 187 push(@{$code{$name}->{$method}},"\_\_code $next"); | |
| 188 } elsif ($args =~ s/^(struct|union)?\s*(\w+)(\**)\s+(\w+)//) { | |
| 189 my $structType = $1; | |
| 190 my $typeName = $2; | |
| 191 my $ptrType = $3; | |
| 192 my $varName = $4; | |
| 193 my $typeField = lcfirst($typeName); | |
| 194 push(@{$code{$name}->{$method}},"$typeName$ptrType $varName"); | |
| 195 } elsif ($args =~ s/(.*,)//) { | |
| 196 } else { | |
| 197 last; | |
| 198 } | |
| 199 } | |
| 200 } | |
| 201 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { | |
| 202 my $codeGearName = $1; | |
| 203 my $args = $2; | |
| 204 my $inputCount = 0; | |
| 205 my $outputCount = 0; | |
| 206 my $inputIncFlag = 1; | |
| 207 while($args) { | |
| 208 if ($args =~ s/(^\s*,\s*)//) { | |
| 209 } | |
| 210 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\((.*?)\)//) { | |
| 211 $codeGear{$codeGearName}->{"code"}->{$2} = "\_\_code"; | |
| 212 $inputIncFlag = 0; | |
| 213 my @outputs = split(/,/,$3); | |
| 214 for my $output (@outputs) { | |
| 215 if ($output =~ /\s*(struct|union)?\s*(\w+)(\*)?+\s(\w+)/) { | |
| 216 my $type = $2; | |
| 217 my $varName = $4; | |
| 218 $codeGear{$codeGearName}->{"var"}->{$varName} = "$type $outputCount"; | |
| 219 $outputCount++; | |
| 220 } | |
| 221 } | |
| 222 } elsif ($args =~ s/^(struct|union)?\s*(\w+)(\*)?+\s(\w+)// && $inputIncFlag) { | |
| 223 my $type = $2; | |
| 224 my $varName = $4; | |
| 225 $codeGear{$codeGearName}->{"var"}->{$varName} = "$type $inputCount"; | |
| 226 $inputCount++; | |
| 227 } elsif ($args =~ s/(.*,)//) { | |
| 228 } else { | |
| 229 last; | |
| 230 } | |
| 231 } | |
| 232 $codeGear{$codeGearName}->{"input"} = $inputCount; | |
| 233 $codeGear{$codeGearName}->{"output"} = $outputCount; | |
| 234 } | |
| 235 } | |
| 236 } | |
| 237 | |
| 238 sub generateStub { | |
| 239 my($fd,$prevCodeGearName,$dataGearName) = @_; | |
| 52 | 240 print $fd "__code ", $prevCodeGearName ,"_stub(struct Context* cbc_context) {\n"; |
| 44 | 241 print $fd $dataGearName; |
| 242 print $fd "\n} \n\n"; | |
| 243 return 1; | |
| 244 } | |
| 245 | |
| 246 sub generateStubArgs { | |
| 247 my($codeGearName, $varName, $typeName, $ptrType, $typeField, $interface,$output) = @_; | |
| 248 my $varname1 = $output?"O_$varName":$varName; | |
| 249 for my $n ( @{$dataGearVar{$codeGearName}} ) { | |
| 250 # we already have it | |
| 251 return 0 if ( $n eq $varname1); | |
| 252 } | |
| 253 push @{$dataGearVar{$codeGearName}}, $varname1; | |
| 254 push @{$dataGearVarType{$codeGearName}}, $typeName; | |
| 255 if ($typeName eq $implementation) { | |
| 256 # get implementation | |
| 52 | 257 $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(cbc_context, $interface, $varName);\n"; |
| 44 | 258 } else { |
| 259 # interface var | |
| 260 for my $ivar (keys %{$var{$interface}}) { | |
| 261 # input data gear field | |
| 262 if ($varName eq $ivar) { | |
| 263 if ($typeName eq $var{$interface}->{$ivar}) { | |
| 264 if ($output) { | |
| 52 | 265 $dataGearName{$codeGearName} .= "\t$typeName$ptrType* O_$varName = &Gearef(cbc_context, $interface)->$varName;\n"; |
| 82 | 266 $outputVar{$codeGearName} .= "\t$typeName$ptrType $varName __attribute__((unused)) = *O_$varName;\n"; |
| 44 | 267 return 1; |
| 268 } | |
| 52 | 269 $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = Gearef(cbc_context, $interface)->$varName;\n"; |
| 44 | 270 return 1; |
| 271 } | |
| 272 } | |
| 273 } | |
| 274 | |
| 275 # interface continuation | |
| 276 for my $cName (keys %{$code{$interface}}) { | |
| 277 if ($varName eq $cName) { | |
| 278 # continuation field | |
| 52 | 279 $dataGearName{$codeGearName} .= "\tenum Code $varName = Gearef(cbc_context, $interface)->$varName;\n"; |
| 44 | 280 return 1; |
| 281 } | |
| 282 } | |
| 283 | |
| 284 # par goto var | |
| 285 for my $var (keys %{$codeGear{$codeGearName}->{"var"}}) { | |
| 286 # input data gear field | |
| 287 if ($varName eq $var) { | |
| 288 my ($type, $count) = split(/\s/, $codeGear{$codeGearName}->{"var"}->{$var}); | |
| 289 if ($typeName eq $type) { | |
| 290 if ($output) { | |
| 52 | 291 $dataGearName{$codeGearName} .= "\t$typeName$ptrType* O_$varName = ($typeName $ptrType*)&cbc_context->data[cbc_context->odg + $count];\n"; |
| 44 | 292 $outputVar{$codeGearName} .= "\t$typeName$ptrType $varName = *O_$varName;\n"; |
| 293 return 1; | |
| 294 } | |
| 52 | 295 $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = &cbc_context->data[cbc_context->idg + $count]->$typeName;\n"; |
| 44 | 296 return 1; |
| 297 } | |
| 298 } | |
| 299 } | |
| 300 | |
| 301 # par goto continuation | |
| 302 for my $cName (keys %{$codeGear{$codeGearName}->{"code"}}) { | |
| 303 if ($varName eq $cName) { | |
| 304 # continuation field | |
| 52 | 305 $dataGearName{$codeGearName} .= "\tenum Code $varName = cbc_context->next;\n"; |
| 44 | 306 return 1; |
| 307 } | |
| 308 } | |
| 309 | |
| 310 # par goto continuation | |
| 311 # global or local variable case | |
| 312 if ($typeName eq "Code") { | |
| 52 | 313 $dataGearName{$codeGearName} .= "\tenum $typeName$ptrType $varName = Gearef(cbc_context, $interface)->$varName;\n"; |
| 44 | 314 return 1; |
| 315 } | |
| 52 | 316 $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = Gearef(cbc_context, $typeName);\n"; |
| 44 | 317 return 1; |
| 318 } | |
| 319 } | |
| 320 | |
| 321 sub generateDataGear { | |
| 322 my ($filename) = @_; | |
| 323 open my $in,"<",$filename or die("can't open $filename $!"); | |
| 324 | |
| 325 my $fn; | |
| 326 if ($opt_o) { | |
| 327 $fn = $opt_o; | |
| 328 } else { | |
| 329 my $fn1 = $filename; | |
| 330 $fn1 =~ s/\.cbc/.c/; | |
| 331 my $i = 1; | |
| 332 $fn = "$dir/$fn1"; | |
| 333 while ( -f $fn) { | |
| 334 $fn = "$dir/$fn1.$i"; | |
| 335 $i++; | |
| 336 } | |
| 337 } | |
| 338 if ( $fn =~ m=(.*)/[^/]+$= ) { | |
| 339 if (! -d $1) { | |
| 340 make_path $1; | |
| 341 } | |
| 342 } | |
| 343 open my $fd,">",$fn or die("can't write $fn $!"); | |
| 344 | |
| 345 my $prevCodeGearName; | |
| 346 my $inTypedef = 0; | |
| 347 my $inStub = 0; | |
| 45 | 348 my $hasParGoto = 0; |
| 44 | 349 my $inMain = 0 ; |
| 52 | 350 my $inCode = 0 ; |
| 44 | 351 my %stub; |
| 352 my $codeGearName; | |
| 353 my %localVarType; | |
| 52 | 354 my %localCode; |
| 44 | 355 |
| 356 while (<$in>) { | |
| 357 if (! $inTypedef && ! $inStub && ! $inMain) { | |
| 358 if (/^typedef struct (\w+) \{/) { | |
| 359 $inTypedef = 1; | |
| 360 } elsif (/^int main\((.*)\) \{/) { | |
| 361 $inMain = 1; | |
| 362 } elsif(/^#interface "(.*)"/) { | |
| 363 my $interfaceHeader = $1; | |
| 364 # #interface not write | |
| 365 next unless ($interfaceHeader =~ /context.h/); | |
| 52 | 366 } elsif (/^\s\s*_\_code (\w+)\((.*)\)(.*)/) { |
| 367 $localCode{$1} = 1; | |
| 368 } elsif (/^\s\s*_\_code *\(\s*\*\s*(\w+)\)\((.*)\)(.*)/) { | |
| 369 $localCode{$1} = 1; | |
| 44 | 370 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { |
| 52 | 371 $inCode = 1; |
| 372 %localCode = {}; | |
| 44 | 373 %localVarType = {}; |
| 374 $codeGearName = $1; | |
| 375 my $args = $2; | |
| 376 my $tail = $3; | |
| 377 if ($codeGearName =~ /_stub$/) { | |
| 378 # don't touch already existing stub | |
| 379 $inStub = 1; | |
| 380 $stub{$codeGearName} = 1; | |
| 381 print $fd $_; | |
| 382 next; | |
| 383 } | |
| 384 if (defined $prevCodeGearName) { | |
| 385 # stub is generated just before next CodeGear | |
| 386 if (defined $stub{$prevCodeGearName."_stub"}) { | |
| 387 undef $prevCodeGearName; | |
| 388 } else { | |
| 389 &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName}); | |
| 390 $stub{$prevCodeGearName."_stub"} = 1; | |
| 391 } | |
| 392 } | |
| 393 # analyzing CodeGear argument | |
| 394 # these arguments are extract from current context's arugment DataGear Interface | |
| 395 # and passed to the CodeGear | |
| 396 # struct Implementaion needs special handling | |
| 397 # __code next(...) ---> enum Code next | |
| 398 $prevCodeGearName = $codeGearName; | |
| 399 $dataGearVar{$codeGearName} = []; | |
| 400 $outputVar{$codeGearName} = ""; | |
| 401 $outputArgs{$codeGearName} = {}; | |
| 52 | 402 my $newArgs = "struct Context *cbc_context,"; |
| 403 if ($args=~/^struct Context\s*\*\s*cbc_context/) { | |
| 44 | 404 $newArgs = ""; |
| 405 } | |
| 406 if (!$args){ | |
| 52 | 407 $newArgs = "struct Context *cbc_context"; |
| 44 | 408 } |
| 409 while($args) { | |
| 410 if ($args =~ s/(^\s*,\s*)//) { | |
| 411 $newArgs .= $1; | |
| 412 } | |
| 413 # continuation case | |
| 414 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) { | |
| 415 my $next = $2; | |
| 416 my @args = split(/,/,$3); | |
| 417 if (&generateStubArgs($codeGearName, $next, "Code", "", $next, $interface,0) ) { | |
| 418 $newArgs .= "enum Code $next"; | |
| 419 } | |
| 420 # analyze continuation arguments | |
| 421 # output arguments are defined in the Interface take the pointer of these | |
| 422 # output arguments are put into the Interface DataGear just before the goto | |
| 423 for my $arg (@args) { | |
| 424 $arg =~ s/^\s*//; | |
| 425 last if ($arg =~ /\.\.\./); | |
| 426 $arg =~ s/^(struct|union)?\s*(\w+)(\**)\s(\w+)//; | |
| 427 my $structType = $1; | |
| 428 my $typeName = $2; | |
| 429 my $ptrType = $3; | |
| 430 my $varName = $4; | |
| 431 my $typeField = lcfirst($typeName); | |
| 432 push(@{$outputArgs{$codeGearName}->{$next}}, $varName); | |
| 433 if (&generateStubArgs($codeGearName, $varName, $typeName, $ptrType, $typeField, $interface,1)) { | |
| 434 $newArgs .= ",$structType $typeName **O_$varName"; | |
| 435 } | |
| 436 } | |
| 437 } elsif ($args =~ s/^(struct|union)?\s*(\w+)(\**)\s(\w+)//) { | |
| 438 my $structType = $1; | |
| 439 my $typeName = $2; | |
| 440 my $ptrType = $3; | |
| 441 my $varName = $4; | |
| 442 my $typeField = lcfirst($typeName); | |
| 443 $newArgs .= $&; # assuming no duplicate | |
| 444 &generateStubArgs($codeGearName, $varName, $typeName, $ptrType, $typeField, $interface,0); | |
| 445 } elsif ($args =~ s/(.*,)//) { | |
| 446 $newArgs .= $1; | |
| 447 } else { | |
| 448 $newArgs .= $args; | |
| 449 last; | |
| 450 } | |
| 451 } | |
| 452 # generate goto statement from stub to the CodeGear in the buffer | |
| 52 | 453 $dataGearName{$codeGearName} .= "\tgoto $codeGearName(cbc_context"; |
| 44 | 454 for my $arg ( @{$dataGearVar{$codeGearName}}) { |
| 455 $dataGearName{$codeGearName} .= ", $arg"; | |
| 456 } | |
| 457 $dataGearName{$codeGearName} .= ");"; | |
| 458 # generate CodeGear header with new arguments | |
| 459 print $fd "__code $codeGearName($newArgs)$tail\n"; | |
| 460 if ($outputVar{$codeGearName} ne "") { | |
| 461 # output data var can be use before write | |
| 462 # it should be initialze by gearef | |
| 463 print $fd $outputVar{$codeGearName}; | |
| 464 } | |
| 465 next; | |
| 52 | 466 } elsif (! $inCode) { |
| 82 | 467 s/new\s+(\w+)\(\)/\&ALLOCATE(cbc_context, \1)->\1/g; # replacing new |
| 52 | 468 print $fd $_; |
| 469 next; | |
| 44 | 470 } elsif (/^(.*)goto (\w+)\-\>(\w+)\((.*)\);/) { |
| 471 # handling goto statement | |
| 472 # convert it to the meta call form with two arugments, that is context and enum Code | |
| 473 my $prev = $1; | |
| 474 my $next = $2; | |
| 475 my $method = $3; | |
| 476 my $tmpArgs = $4; | |
| 82 | 477 #$tmpArgs =~ s/\(.*\)/\(\)/; |
| 44 | 478 my @args = split(/,/,$tmpArgs); |
| 52 | 479 if (! defined $dataGearVarType{$codeGearName}) { |
| 480 print $fd $_ ; | |
| 481 next ; | |
| 482 } | |
| 44 | 483 my @types = @{$dataGearVarType{$codeGearName}}; |
| 484 my $ntype; | |
| 485 my $ftype; | |
| 486 for my $v (@{$dataGearVar{$codeGearName}}) { | |
| 487 my $t = shift @types; | |
| 488 if ($v eq $next || $v eq "O_$next") { | |
| 489 $ntype = $t; | |
| 490 $ftype = lcfirst($ntype); | |
| 491 } | |
| 492 } | |
| 493 if (!defined $ntype) { | |
| 494 $ntype = $localVarType{$next}; | |
| 495 $ftype = lcfirst($ntype); | |
| 496 } | |
| 52 | 497 print $fd "\tGearef(cbc_context, $ntype)->$ftype = (union Data*) $next;\n"; |
| 44 | 498 # Put interface argument |
| 499 my $prot = $code{$ntype}->{$method}; | |
| 500 my $i = 1; | |
| 501 for my $arg (@args) { | |
| 502 my $pType; | |
| 503 my $pName; | |
| 504 my $p = @$prot[$i]; | |
| 505 next if ($p eq $arg); | |
| 506 $p =~ s/^(.*)\s(\w+)//; | |
| 507 $pType = $1; | |
| 508 $pName = $2; | |
| 509 $arg =~ s/^(\s)*(\w+)/$2/; | |
| 510 if ($pType =~ s/\_\_code$//) { | |
| 511 if ($arg =~ /(\w+)\(.*\)/) { | |
| 52 | 512 print $fd "\tGearef(cbc_context, $ntype)->$pName = $1;\n"; |
| 44 | 513 } else { |
| 52 | 514 print $fd "\tGearef(cbc_context, $ntype)->$pName = C_$arg;\n"; |
| 44 | 515 } |
| 516 } elsif ($pType =~ /Data\**$/){ | |
| 52 | 517 print $fd "\tGearef(cbc_context, $ntype)->$pName = (union $pType) $arg;\n"; |
| 44 | 518 } else { |
| 52 | 519 print $fd "\tGearef(cbc_context, $ntype)->$pName = $arg;\n"; |
| 44 | 520 } |
| 521 $i++; | |
| 522 } | |
| 52 | 523 # print $fd "${prev}cbc_context->before = C_$codeGearName;\n"; |
| 524 print $fd "${prev}goto meta(cbc_context, $next->$method);\n"; | |
| 44 | 525 next; |
| 526 } elsif(/^(.*)par goto (\w+)\((.*)\);/) { | |
| 527 # handling par goto statement | |
| 528 # convert it to the parallel | |
| 529 my $prev = $1; | |
| 530 my $codeGearName = $2; | |
| 531 my $args = $3; | |
| 532 my $inputCount = $codeGear{$codeGearName}->{'input'}; | |
| 533 my $outputCount = $codeGear{$codeGearName}->{'output'}; | |
| 534 my @iterateCounts; | |
| 535 # parse examples 'par goto(.., iterate(10), exit);' | |
| 536 if ($args =~ /iterate\((.*)?\),/) { | |
| 537 @iterateCounts = split(/,/,$1);; | |
| 538 $inputCount--; | |
| 539 } | |
| 540 # replace iterate keyword | |
| 541 $args =~ s/iterate\((.*)?\),//; | |
| 542 my @dataGears = split(/,\s*/, $args); | |
| 543 my $nextCodeGear = pop(@dataGears); | |
| 45 | 544 if (! $hasParGoto) { |
| 545 $hasParGoto = 1; | |
| 44 | 546 print $fd "${prev}struct Element* element;\n"; |
| 547 } | |
| 548 my $initTask = << "EOFEOF"; | |
| 52 | 549 ${prev}cbc_context->task = NEW(struct Context); |
| 550 ${prev}initContext(cbc_context->task); | |
| 551 ${prev}cbc_context->task->next = C_$codeGearName; | |
| 552 ${prev}cbc_context->task->idgCount = $inputCount; | |
| 553 ${prev}cbc_context->task->idg = cbc_context->task->dataNum; | |
| 554 ${prev}cbc_context->task->maxIdg = cbc_context->task->idg + $inputCount; | |
| 555 ${prev}cbc_context->task->odg = cbc_context->task->maxIdg; | |
| 556 ${prev}cbc_context->task->maxOdg = cbc_context->task->odg + $outputCount; | |
| 44 | 557 EOFEOF |
| 558 print $fd $initTask; | |
| 559 if (@iterateCounts) { | |
| 52 | 560 print $fd "${prev}cbc_context->task->iterate = 0;\n"; |
| 44 | 561 my $len = @iterateCounts; |
| 562 if ($len == 1) { | |
| 52 | 563 print $fd "${prev}cbc_context->task->iterator = createMultiDimIterator(cbc_context, $iterateCounts[0], 1, 1);\n"; |
| 44 | 564 } elsif ($len == 2) { |
| 52 | 565 print $fd "${prev}cbc_context->task->iterator = createMultiDimIterator(cbc_context, $iterateCounts[0], $iterateCounts[1], 1);\n"; |
| 44 | 566 } elsif ($len == 3) { |
| 52 | 567 print $fd "${prev}cbc_context->task->iterator = createMultiDimIterator(cbc_context, $iterateCounts[0], $iterateCounts[1], $iterateCounts[2]);\n"; |
| 44 | 568 } |
| 569 } | |
| 570 for my $dataGear (@dataGears) { | |
| 52 | 571 print $fd "${prev}GET_META($dataGear)->wait = createSynchronizedQueue(cbc_context);\n"; |
| 44 | 572 } |
| 573 for my $i (0..$inputCount-1) { | |
| 52 | 574 print $fd "${prev}cbc_context->task->data[cbc_context->task->idg+$i] = (union Data*)@dataGears[$i];\n"; |
| 44 | 575 } |
| 576 for my $i (0..$outputCount-1) { | |
| 52 | 577 print $fd "${prev}cbc_context->task->data[cbc_context->task->odg+$i] = (union Data*)@dataGears[$inputCount+$i];\n"; |
| 44 | 578 } |
| 579 my $putTask = << "EOFEOF"; | |
| 52 | 580 ${prev}element = &ALLOCATE(cbc_context, Element)->Element; |
| 581 ${prev}element->data = (union Data*)cbc_context->task; | |
| 582 ${prev}element->next = cbc_context->taskList; | |
| 583 ${prev}cbc_context->taskList = element; | |
| 44 | 584 EOFEOF |
| 585 print $fd $putTask; | |
| 586 next; | |
| 587 } elsif (/^(.*)goto (\w+)\((.*)\);/) { | |
| 588 # handling goto statement | |
| 589 # convert it to the meta call form with two arugments, that is context and enum Code | |
| 590 my $prev = $1; | |
| 591 my $next = $2; | |
| 592 my @args = split(/,/, $3); | |
| 593 my $v = 0; | |
| 52 | 594 if (defined $localCode{$next}) { |
| 595 print $fd $_; next; | |
| 596 } | |
| 44 | 597 for my $n ( @{$dataGearVar{$codeGearName}} ) { |
| 598 # continuation arguments | |
| 599 $v = 1 if ( $n eq $next); | |
| 600 } | |
| 601 if ($v || defined $code{$interface}->{$next}) { | |
| 602 # write continuation's arguments into the interface arguments | |
| 603 # we may need a commit for a shared DataGear | |
| 604 for my $arg ( @{$outputArgs{$codeGearName}->{$next}} ) { | |
| 605 my $v = shift(@args); | |
| 606 print $fd "\t*O_$arg = $v;\n"; | |
| 607 } | |
| 45 | 608 if ($hasParGoto) { |
| 52 | 609 print $fd "${prev}Gearef(cbc_context, TaskManager)->taskList = cbc_context->taskList;\n"; |
| 610 print $fd "${prev}Gearef(cbc_context, TaskManager)->next1 = C_$next;\n"; | |
| 611 print $fd "${prev}goto meta(cbc_context, C_$next);\n"; | |
| 44 | 612 } else { |
| 52 | 613 # print $fd "${prev}cbc_context->before = C_$codeGearName;\n"; |
| 614 print $fd "${prev}goto meta(cbc_context, $next);\n"; | |
| 44 | 615 } |
| 616 next; | |
| 617 } | |
| 45 | 618 if ($hasParGoto) { |
| 52 | 619 print $fd "${prev}Gearef(cbc_context, TaskManager)->taskList = cbc_context->taskList;\n"; |
| 620 print $fd "${prev}Gearef(cbc_context, TaskManager)->next1 = C_$next;\n"; | |
| 621 print $fd "${prev}goto parGotoMeta(cbc_context, C_$next);\n"; | |
| 44 | 622 next; |
| 623 } elsif ($next eq "meta") { | |
| 624 print $fd $_; | |
| 625 next; | |
| 626 } else { | |
| 52 | 627 # print $fd "${prev}cbc_context->before = C_$codeGearName;\n"; |
| 628 print $fd "${prev}goto meta(cbc_context, C_$next);\n"; | |
| 44 | 629 next; |
| 630 } | |
| 631 } elsif(/^.*(struct|union)?\s(\w+)\*\s(\w+)\s?[=;]/) { | |
| 632 my $type = $2; | |
| 633 my $varName = $3; | |
| 634 $localVarType{$varName} = $type; | |
| 52 | 635 s/new\s+(\w+)\(\)/\&ALLOCATE(cbc_context, \1)->\1/g; # replacing new |
| 44 | 636 } elsif(/^}/) { |
| 45 | 637 $hasParGoto = 0; |
| 44 | 638 } else { |
| 52 | 639 s/new\s+(\w+)\(\)/\&ALLOCATE(cbc_context, \1)->\1/g; # replacing new |
| 44 | 640 } |
| 641 # gather type name and type | |
| 642 } elsif ($inMain) { | |
| 643 if (/^(.*)goto start_code\(main_context\);/) { | |
| 644 print $fd $_; | |
| 645 next; | |
| 646 } elsif (/^(.*)goto (\w+)\((.*)\);/) { | |
| 647 my $prev = $1; | |
| 648 my $next = $2; | |
| 649 print $fd "${prev}struct Context* main_context = NEW(struct Context);\n"; | |
| 650 print $fd "${prev}initContext(main_context);\n"; | |
| 52 | 651 print $fd "${prev}main_cbc_context->next = C_$next;\n"; |
| 44 | 652 print $fd "${prev}goto start_code(main_context);\n"; |
| 653 next; | |
| 654 } | |
| 655 } | |
| 656 if (/^}/) { | |
| 657 $inStub = 0; | |
| 658 $inTypedef = 0; | |
| 659 $inMain = 0; | |
| 52 | 660 $inCode = 0; |
| 44 | 661 } |
| 662 print $fd $_; | |
| 663 } | |
| 664 if (defined $prevCodeGearName) { | |
| 665 if (!defined $stub{$prevCodeGearName."_stub"}) { | |
| 666 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName}); | |
| 667 } | |
| 668 } | |
| 669 } | |
| 670 | |
| 671 # end |