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