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