Mercurial > hg > Gears > GearsAgda
annotate src/parallel_execution/generate_stub.pl @ 461:6b71cf5b1c22
Change Interface files from cbc to header
author | Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Wed, 20 Dec 2017 17:54:15 +0900 |
parents | 3025d00eb87d |
children | 8d7e5d48cad3 |
rev | line source |
---|---|
194 | 1 #!/usr/bin/perl |
2 | |
250 | 3 use strict; |
254 | 4 use Getopt::Std; |
393 | 5 use File::Path qw(make_path); |
250 | 6 |
194 | 7 # interface.cbc |
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 | |
255 | 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) { | |
393 | 25 make_path $dir; |
255 | 26 } |
27 } | |
254 | 28 |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
29 for my $fn (@ARGV) { |
255 | 30 next if ($fn !~ /\.cbc$/); |
249 | 31 &getDataGear($fn); |
32 &generateDataGear($fn); | |
194 | 33 } |
34 | |
250 | 35 my %var; |
36 my %code; | |
37 my %dataGearVar; | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
38 my %outputVar; # output var initializer |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
39 my %outputArgs; # continuation's output variables |
250 | 40 my %dataGear; |
41 my %dataGearName; | |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
42 my %generic; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
43 my %dataGearVarType; |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
44 my %codeGear; |
253 | 45 my $implementation; |
46 my $interface; | |
250 | 47 |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
48 # interface definision |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
49 # |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
50 # typedef struct Stack<Type, Impl>{ |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
51 # Type* stack; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
52 # Type* data; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
53 # Type* data1; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
54 # __code whenEmpty(...); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
55 # __code clear(Impl* stack,__code next(...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
56 # __code push(Impl* stack,Type* data, __code next(...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
57 # __code pop(Impl* stack, __code next(Type*, ...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
58 # __code pop2(Impl* stack, Type** data, Type** data1, __code next(Type**, Type**, ...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
59 # __code isEmpty(Impl* stack, __code next(...), __code whenEmpty(...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
60 # __code get(Impl* stack, Type** data, __code next(...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
61 # __code get2(Impl* stack,..., __code next(...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
62 # __code next(...); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
63 # } Stack; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
64 # |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
65 # calling example |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
66 # |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
67 # goto nodeStack->push((union Data*)node, stackTest3); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
68 # |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
69 # generated meta level code |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
70 # |
442
481fce540daf
Fix goto implement method of generate_stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
424
diff
changeset
|
71 # Gearef(context, Stack)->stack = (union Data*)nodeStack; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
72 # Gearef(context, Stack)->data = (union Data*)node; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
73 # Gearef(context, Stack)->next = C_stackTest3; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
74 # goto meta(context, nodeStack->push); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
75 |
194 | 76 sub getDataGear { |
77 my ($filename) = @_; | |
253 | 78 my ($codeGearName, $name, $inTypedef); |
194 | 79 open my $fd,"<",$filename or die("can't open $filename $!"); |
80 while (<$fd>) { | |
81 if (! $inTypedef) { | |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
82 if (/^typedef struct (\w+)\s*<(.*)>/) { |
194 | 83 $inTypedef = 1; |
84 $name = $1; | |
85 $dataGear{$name} = $_; | |
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
86 $var{$name} = {}; |
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
87 $code{$name} = {}; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
88 $generic{$name} = \split(/,/,$2); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
89 } elsif (/^typedef struct (\w+)/) { |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
90 $inTypedef = 1; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
91 $name = $1; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
92 $dataGear{$name} = $_; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
93 $var{$name} = {}; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
94 $code{$name} = {}; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
95 $generic{$name} = []; |
269 | 96 } elsif (/^(\w+)(\*)+ create(\w+)\(/) { |
249 | 97 if (defined $interface) { |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
98 die "duplicate interface $interface\n"; |
249 | 99 } |
100 $interface = $1; | |
269 | 101 $implementation = $3; |
250 | 102 if ( -f "$interface.cbc") { |
103 &getDataGear("$interface.cbc"); | |
104 } | |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
105 } elsif(/^(.*)par goto (\w+)\((.*)\)/) { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
106 my $codeGearName = $2; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
107 if ($filename =~ /^(.*)\/(.*)/) { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
108 $codeGearName = "$1/$codeGearName"; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
109 } |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
110 if ( -f "$codeGearName.cbc") { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
111 &getCodeGear("$codeGearName.cbc"); |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
112 } |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
113 } elsif(/^#include "(.*)"/) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
114 # interface include |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
115 my $interfaceHeader = $1; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
116 next if ($interfaceHeader =~ /context.h/); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
117 if (-f $interfaceHeader) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
118 &getDataGear("$interfaceHeader"); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
119 &getCodeGear("$interfaceHeader"); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
120 } |
226 | 121 } |
194 | 122 next; |
123 } | |
249 | 124 # gather type name and type |
194 | 125 $dataGear{$name} .= $_; |
385 | 126 if (/^\s*(.*)\s+(\w+);$/ ) { |
280 | 127 my $ttype = $1; |
128 my $tname = $2; | |
129 if ($ttype =~ /^(union|struct) (\w+)/) { | |
130 $ttype = $2; | |
131 } | |
132 $var{$name}->{$tname} = $ttype; | |
250 | 133 } |
194 | 134 if (/^}/) { |
135 $inTypedef = 0; | |
136 } | |
137 } | |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
138 |
194 | 139 } |
140 | |
385 | 141 sub getCodeGear { |
142 my ($filename) = @_; | |
143 open my $fd,"<",$filename or die("can't open $filename $!"); | |
144 my ($name,$impln); | |
145 while (<$fd>) { | |
146 if (/^(\w+)(\*)+ create(\w+)\(/) { | |
147 $name = $1; | |
148 $impln = $3; | |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
149 } elsif(/^typedef struct (.*)<.*>\s*{/) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
150 $name = $1; |
385 | 151 } |
152 if (defined $name) { | |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
153 if (/^\s*\_\_code (\w+)\((.*)\);/) { |
385 | 154 my $args = $2; |
155 my $method = $1; | |
156 $code{$name}->{$method} = []; | |
157 while($args) { | |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
158 # replace comma |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
159 $args =~ s/(^\s*,\s*)//; |
385 | 160 # continuation case |
161 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) { | |
162 my $next = $2; | |
163 my @args = split(/,/,$3); | |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
164 push(@{$code{$name}->{$method}},"\_\_code $next"); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
165 } elsif ($args =~ s/^(struct|union)?\s*(\w+)(\*)?+\s(\w+)//) { |
385 | 166 my $structType = $1; |
167 my $typeName = $2; | |
168 my $varName = $4; | |
169 my $typeField = lcfirst($typeName); | |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
170 push(@{$code{$name}->{$method}},"$typeName $varName"); |
385 | 171 } elsif ($args =~ s/(.*,)//) { |
172 } else { | |
173 last; | |
174 } | |
175 } | |
176 } | |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
177 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
178 my $codeGearName = $1; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
179 my $args = $2; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
180 my $inputCount = 0; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
181 my $outputCount = 0; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
182 my $inputIncFlag = 1; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
183 while($args) { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
184 if ($args =~ s/(^\s*,\s*)//) { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
185 } |
404
c5cd9888bf2a
Fix bitonicSort
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
403
diff
changeset
|
186 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\((.*?)\)//) { |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
187 $inputIncFlag = 0; |
404
c5cd9888bf2a
Fix bitonicSort
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
403
diff
changeset
|
188 $outputCount = split(/,/,$3); |
c5cd9888bf2a
Fix bitonicSort
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
403
diff
changeset
|
189 $outputCount--; |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
190 } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
191 if($inputIncFlag) { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
192 $inputCount++; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
193 } |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
194 } elsif ($args =~ s/(.*,)//) { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
195 } else { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
196 last; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
197 } |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
198 } |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
199 $codeGear{$codeGearName}->{"input"} = $inputCount; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
200 $codeGear{$codeGearName}->{"output"} = $outputCount; |
385 | 201 } |
202 } | |
203 } | |
204 | |
250 | 205 sub generateStub { |
251 | 206 my($fd,$prevCodeGearName,$dataGearName) = @_; |
274 | 207 print $fd "__code ", $prevCodeGearName ,"_stub(struct Context* context) {\n"; |
251 | 208 print $fd $dataGearName; |
250 | 209 print $fd "\n} \n\n"; |
251 | 210 return 1; |
250 | 211 } |
212 | |
253 | 213 sub generateStubArgs { |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
214 my($codeGearName, $varName, $typeName, $typeField, $interface,$output) = @_; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
215 my $varname1 = $output?"O_$varName":$varName; |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
216 for my $n ( @{$dataGearVar{$codeGearName}} ) { |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
217 # we already have it |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
218 return 0 if ( $n eq $varname1); |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
219 } |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
220 push @{$dataGearVar{$codeGearName}}, $varname1; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
221 push @{$dataGearVarType{$codeGearName}}, $typeName; |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
222 if ($typeName eq $implementation) { |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
223 # get implementation |
258 | 224 $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $interface, $varName);\n"; |
253 | 225 } else { |
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
226 for my $ivar (keys %{$var{$interface}}) { |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
227 # input data gear field |
253 | 228 if ($varName eq $ivar) { |
280 | 229 if ($typeName eq $var{$interface}->{$ivar}) { |
230 if ($output) { | |
231 $dataGearName{$codeGearName} .= "\t$typeName** O_$varName = &Gearef(context, $interface)->$varName;\n"; | |
232 $outputVar{$codeGearName} .= "\t$typeName* $varName;\n"; | |
233 return 1; | |
234 } | |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
235 |
280 | 236 $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $interface)->$varName;\n"; |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
237 return 1; |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
238 } |
253 | 239 } |
240 } | |
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
241 for my $cName (keys %{$code{$interface}}) { |
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
242 if ($varName eq $cName) { |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
243 # continuation field |
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
244 $dataGearName{$codeGearName} .= "\tenum Code $varName = Gearef(context, $interface)->$varName;\n"; |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
245 return 1; |
253 | 246 } |
247 } | |
389 | 248 # global or local variable case |
249 if ($typeName eq "Code") { | |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
250 $dataGearName{$codeGearName} .= "\tenum $typeName $varName = Gearef(context, $interface)->$varName;\n"; |
389 | 251 return 1; |
252 } | |
268 | 253 $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $typeName);\n"; |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
254 return 1; |
253 | 255 } |
256 } | |
257 | |
194 | 258 sub generateDataGear { |
249 | 259 my ($filename) = @_; |
260 open my $in,"<",$filename or die("can't open $filename $!"); | |
254 | 261 |
262 my $fn; | |
263 if ($opt_o) { | |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
264 $fn = $opt_o; |
254 | 265 } else { |
266 my $fn1 = $filename; | |
267 $fn1 =~ s/\.cbc/.c/; | |
268 my $i = 1; | |
255 | 269 $fn = "$dir/$fn1"; |
254 | 270 while ( -f $fn) { |
255 | 271 $fn = "$dir/$fn1.$i"; |
254 | 272 $i++; |
273 } | |
250 | 274 } |
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
275 if ( $fn =~ m=(.*)/[^/]+$= ) { |
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
276 if (! -d $1) { |
393 | 277 make_path $1; |
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
278 } |
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
279 } |
249 | 280 open my $fd,">",$fn or die("can't write $fn $!"); |
254 | 281 |
249 | 282 my $prevCodeGearName; |
250 | 283 my $inTypedef = 0; |
278 | 284 my $inStub = 0; |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
285 my $inParGoto = 0; |
418 | 286 my $inMain = 0 ; |
250 | 287 my %stub; |
251 | 288 my $codeGearName; |
444
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
289 my %localVarType; |
254 | 290 |
249 | 291 while (<$in>) { |
418 | 292 if (! $inTypedef && ! $inStub && ! $inMain) { |
454 | 293 if (/^typedef struct (\w+) \{/) { |
249 | 294 $inTypedef = 1; |
454 | 295 } elsif (/^int main\((.*)\) \{/) { |
418 | 296 $inMain = 1; |
253 | 297 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { |
444
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
298 %localVarType = {}; |
251 | 299 $codeGearName = $1; |
253 | 300 my $args = $2; |
301 my $tail = $3; | |
250 | 302 if ($codeGearName =~ /_stub$/) { |
262 | 303 # don't touch already existing stub |
278 | 304 $inStub = 1; |
250 | 305 $stub{$codeGearName} = 1; |
306 print $fd $_; | |
307 next; | |
308 } | |
249 | 309 if (defined $prevCodeGearName) { |
262 | 310 # stub is generated just before next CodeGear |
250 | 311 if (defined $stub{$prevCodeGearName."_stub"}) { |
312 undef $prevCodeGearName; | |
278 | 313 } else { |
314 &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName}); | |
315 $stub{$prevCodeGearName."_stub"} = 1; | |
250 | 316 } |
249 | 317 } |
262 | 318 # analyzing CodeGear argument |
319 # these arguments are extract from current context's arugment DataGear Interface | |
320 # and passed to the CodeGear | |
321 # struct Implementaion needs special handling | |
322 # __code next(...) ---> enum Code next | |
253 | 323 $prevCodeGearName = $codeGearName; |
324 $dataGearVar{$codeGearName} = []; | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
325 $outputVar{$codeGearName} = ""; |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
326 $outputArgs{$codeGearName} = {}; |
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
327 my $newArgs = "struct Context *context,"; |
305 | 328 if ($args=~/^struct Context\s*\*\s*context/) { |
329 $newArgs = ""; | |
330 } | |
253 | 331 while($args) { |
332 if ($args =~ s/(^\s*,\s*)//) { | |
333 $newArgs .= $1; | |
334 } | |
262 | 335 # continuation case |
280 | 336 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) { |
337 my $next = $2; | |
338 my @args = split(/,/,$3); | |
398
fc4fcd441700
Fix spanwTasks
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
397
diff
changeset
|
339 if (&generateStubArgs($codeGearName, $next, "Code", $next, $interface,0) ) { |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
340 $newArgs .= "enum Code $next"; |
258 | 341 } |
262 | 342 # analyze continuation arguments |
343 # output arguments are defined in the Interface take the pointer of these | |
344 # output arguments are put into the Interface DataGear just before the goto | |
253 | 345 for my $arg (@args) { |
346 $arg =~ s/^\s*//; | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
347 last if ($arg =~ /\.\.\./); |
253 | 348 $arg =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//; |
349 my $structType = $1; | |
350 my $typeName = $2; | |
351 my $varName = $4; | |
352 my $typeField = lcfirst($typeName); | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
353 push(@{$outputArgs{$codeGearName}->{$next}}, $varName); |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
354 if (&generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface,1)) { |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
355 $newArgs .= ",$structType $typeName **O_$varName"; |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
356 } |
253 | 357 } |
358 } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) { | |
359 my $structType = $1; | |
360 my $typeName = $2; | |
361 my $varName = $4; | |
362 my $typeField = lcfirst($typeName); | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
363 $newArgs .= $&; # assuming no duplicate |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
364 &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface,0); |
255 | 365 } elsif ($args =~ s/(.*,)//) { |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
366 $newArgs .= $1; |
255 | 367 } else { |
368 $newArgs .= $args; | |
369 last; | |
253 | 370 } |
371 } | |
262 | 372 # generate goto statement from stub to the CodeGear in the buffer |
253 | 373 $dataGearName{$codeGearName} .= "\tgoto $codeGearName(context"; |
374 for my $arg ( @{$dataGearVar{$codeGearName}}) { | |
375 $dataGearName{$codeGearName} .= ", $arg"; | |
376 } | |
377 $dataGearName{$codeGearName} .= ");"; | |
262 | 378 # generate CodeGear header with new arguments |
253 | 379 print $fd "__code $codeGearName($newArgs)$tail\n"; |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
380 if ($outputVar{$codeGearName} ne "") { |
324 | 381 # output data var can be use before write |
382 # it should be initialze by gearef | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
383 print $fd $outputVar{$codeGearName}; |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
384 } |
250 | 385 next; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
386 } elsif (/^(.*)goto (\w+)\-\>(\w+)\((.*)\);/) { |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
387 # handling goto statement |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
388 # convert it to the meta call form with two arugments, that is context and enum Code |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
389 my $prev = $1; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
390 my $next = $2; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
391 my $method = $3; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
392 my @args = split(/,/,$4); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
393 my @types = @{$dataGearVarType{$codeGearName}}; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
394 my $ntype; |
415 | 395 my $ftype; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
396 for my $v (@{$dataGearVar{$codeGearName}}) { |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
397 my $t = shift @types; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
398 if ($v eq $next) { |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
399 $ntype = $t; |
415 | 400 $ftype = lcfirst($ntype); |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
401 } |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
402 } |
444
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
403 if (!defined $ntype) { |
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
404 $ntype = $localVarType{$next}; |
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
405 $ftype = lcfirst($ntype); |
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
406 } |
442
481fce540daf
Fix goto implement method of generate_stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
424
diff
changeset
|
407 print $fd "\tGearef(context, $ntype)->$ftype = (union Data*) $next;\n"; |
415 | 408 # Put interface argument |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
409 my $prot = $code{$ntype}->{$method}; |
385 | 410 my $i = 1; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
411 for my $arg (@args) { |
415 | 412 my $pType; |
413 my $pName; | |
385 | 414 my $p = @$prot[$i]; |
457
2b36a1878c6f
Refactor TaskManagerImpl
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
447
diff
changeset
|
415 next if ($p eq $arg); |
387 | 416 $p =~ s/^(.*)\s(\w+)//; |
415 | 417 $pType = $1; |
418 $pName = $2; | |
387 | 419 $arg =~ s/^(\s)*(\w+)/$2/; |
420 if ($pType =~ s/\_\_code$//) { | |
444
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
421 if ($arg =~ /(\w+)\(.*\)/) { |
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
422 print $fd "\tGearef(context, $ntype)->$pName = $1;\n"; |
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
423 } else { |
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
424 print $fd "\tGearef(context, $ntype)->$pName = C_$arg;\n"; |
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
425 } |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
426 } elsif ($pType =~ s/Data$//){ |
391 | 427 print $fd "\tGearef(context, $ntype)->$pName = (union Data*) $arg;\n"; |
387 | 428 } else { |
429 print $fd "\tGearef(context, $ntype)->$pName = $arg;\n"; | |
430 } | |
385 | 431 $i++; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
432 } |
442
481fce540daf
Fix goto implement method of generate_stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
424
diff
changeset
|
433 print $fd "${prev}goto meta(context, $next->$method);\n"; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
434 next; |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
435 } elsif(/^(.*)par goto (\w+)\((.*)\);/) { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
436 # handling par goto statement |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
437 # convert it to the parallel |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
438 my $prev = $1; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
439 my $codeGearName = $2; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
440 my $args = $3; |
401
408b4aab7610
Supported par goto iterate statement for perl script
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
400
diff
changeset
|
441 my $inputCount = $codeGear{$codeGearName}->{'input'}; |
408b4aab7610
Supported par goto iterate statement for perl script
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
400
diff
changeset
|
442 my $outputCount = $codeGear{$codeGearName}->{'output'}; |
403
83c9aeb1fe3e
Generate MultiDimIterator by perl script
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
402
diff
changeset
|
443 my @iterateCounts; |
401
408b4aab7610
Supported par goto iterate statement for perl script
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
400
diff
changeset
|
444 # parse examples 'par goto(.., iterate(10), exit);' |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
445 if ($args =~ /iterate\((.*)?\),/) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
446 @iterateCounts = split(/,/,$1);; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
447 $inputCount--; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
448 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
449 # replace iterate keyword |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
450 $args =~ s/iterate\((.*)?\),//; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
451 my @dataGears = split(/,\s*/, $args); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
452 my $nextCodeGear = pop(@dataGears); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
453 if (! $inParGoto) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
454 $inParGoto = 1; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
455 print $fd "${prev}struct Element* element;\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
456 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
457 my $initTask = << "EOFEOF"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
458 ${prev}context->task = NEW(struct Context); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
459 ${prev}initContext(context->task); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
460 ${prev}context->task->next = C_$codeGearName; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
461 ${prev}context->task->idgCount = $inputCount; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
462 ${prev}context->task->idg = context->task->dataNum; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
463 ${prev}context->task->maxIdg = context->task->idg + $inputCount; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
464 ${prev}context->task->odg = context->task->maxIdg; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
465 ${prev}context->task->maxOdg = context->task->odg + $outputCount; |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
466 EOFEOF |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
467 print $fd $initTask; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
468 if (@iterateCounts) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
469 print $fd "${prev}context->task->iterate = 0;\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
470 my $len = @iterateCounts; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
471 if ($len == 1) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
472 print $fd "${prev}context->task->iterator = createMultiDimIterator(context, $iterateCounts[0], 1, 1);\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
473 } elsif ($len == 2) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
474 print $fd "${prev}context->task->iterator = createMultiDimIterator(context, $iterateCounts[0], $iterateCounts[1], 1);\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
475 } elsif ($len == 3) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
476 print $fd "${prev}context->task->iterator = createMultiDimIterator(context, $iterateCounts[0], $iterateCounts[1], $iterateCounts[2]);\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
477 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
478 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
479 for my $dataGear (@dataGears) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
480 print $fd "${prev}GET_META($dataGear)->wait = createSynchronizedQueue(context);\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
481 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
482 for my $i (0..$inputCount-1) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
483 print $fd "${prev}context->task->data[context->task->idg+$i] = (union Data*)@dataGears[$i];\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
484 } |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
485 |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
486 for my $i (0..$outputCount-1) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
487 print $fd "${prev}context->task->data[context->task->odg+$i] = (union Data*)@dataGears[$inputCount+$i];\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
488 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
489 my $putTask = << "EOFEOF"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
490 ${prev}element = &ALLOCATE(context, Element)->Element; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
491 ${prev}element->next = NULL; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
492 ${prev}element->data = (union Data*)context->task; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
493 ${prev}context->tasks->queue->SingleLinkedQueue.last->next = element; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
494 ${prev}context->tasks->queue->SingleLinkedQueue.last = element; |
398
fc4fcd441700
Fix spanwTasks
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
397
diff
changeset
|
495 EOFEOF |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
496 print $fd $putTask; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
497 next; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
498 } elsif (/^(.*)goto (\w+)\((.*)\);/) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
499 # handling goto statement |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
500 # convert it to the meta call form with two arugments, that is context and enum Code |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
501 my $prev = $1; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
502 my $next = $2; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
503 my @args = split(/, /,$3); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
504 my $v = 0; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
505 for my $n ( @{$dataGearVar{$codeGearName}} ) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
506 # continuation arguments |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
507 $v = 1 if ( $n eq $next); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
508 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
509 if ($v || defined $code{$interface}->{$next}) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
510 # write continuation's arguments into the interface arguments |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
511 # we may need a commit for a shared DataGear |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
512 for my $arg ( @{$outputArgs{$codeGearName}->{$next}} ) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
513 my $v = shift(@args); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
514 print $fd "\t*O_$arg = $v;\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
515 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
516 if ($inParGoto) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
517 print $fd "${prev}taskManager->tasks = context->tasks;\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
518 print $fd "${prev}taskManager->next1 = C_$next;\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
519 print $fd "${prev}goto meta(context, C_$next);\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
520 } else { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
521 print $fd "${prev}goto meta(context, $next);\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
522 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
523 next; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
524 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
525 if ($inParGoto) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
526 print $fd "${prev}taskManager->tasks = context->tasks;\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
527 print $fd "${prev}taskManager->next1 = C_$next;\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
528 print $fd "${prev}goto meta(context, C_$next);\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
529 next; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
530 } elsif ($next eq "meta") { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
531 print $fd $_; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
532 next; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
533 } else { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
534 print $fd "${prev}goto meta(context, C_$next);\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
535 next; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
536 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
537 } elsif(/^.*(struct|union)?\s(\w+)\*\s(\w+)\s?[=;]/) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
538 my $type = $2; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
539 my $varName = $3; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
540 $localVarType{$varName} = $type; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
541 s/new\s+(\w+)\(\)/\&ALLOCATE(context, \1)->\1/g; # replacing new |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
542 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
543 elsif(/^}/) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
544 $inParGoto = 0; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
545 } else { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
546 s/new\s+(\w+)\(\)/\&ALLOCATE(context, \1)->\1/g; # replacing new |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
547 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
548 # gather type name and type |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
549 } elsif ($inMain) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
550 if (/^(.*)goto start_code\(main_context\);/) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
551 print $fd $_; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
552 next; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
553 } elsif (/^(.*)goto (\w+)\((.*)\);/) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
554 my $prev = $1; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
555 my $next = $2; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
556 print $fd "${prev}struct Context* main_context = NEW(struct Context);\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
557 print $fd "${prev}initContext(main_context);\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
558 print $fd "${prev}main_context->next = C_$next;\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
559 print $fd "${prev}goto start_code(main_context);\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
560 next; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
561 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
562 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
563 if (/^}/) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
564 $inStub = 0; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
565 $inTypedef = 0; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
566 $inMain = 0; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
567 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
568 print $fd $_; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
569 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
570 if (defined $prevCodeGearName) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
571 if (!defined $stub{$prevCodeGearName."_stub"}) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
572 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName}); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
573 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
574 } |
194 | 575 } |
576 | |
577 # end |