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