Mercurial > hg > GearsTemplate
annotate src/parallel_execution/generate_stub.pl @ 393:99c50356d917
fix generate_stub.pl
author | mir3636 |
---|---|
date | Tue, 01 Aug 2017 18:49:56 +0900 (2017-08-01) |
parents | 2d9c500f263e |
children | bba401f93dcd |
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 |
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; |
253 | 44 my $implementation; |
45 my $interface; | |
250 | 46 |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
47 # interface definision |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
48 # |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
49 # typedef struct Stack<Type, Impl>{ |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
50 # Type* stack; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
51 # Type* data; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
52 # Type* data1; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
53 # __code whenEmpty(...); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
54 # __code clear(Impl* stack,__code next(...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
55 # __code push(Impl* stack,Type* data, __code next(...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
56 # __code pop(Impl* stack, __code next(Type*, ...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
57 # __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
|
58 # __code isEmpty(Impl* stack, __code next(...), __code whenEmpty(...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
59 # __code get(Impl* stack, Type** data, __code next(...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
60 # __code get2(Impl* stack,..., __code next(...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
61 # __code next(...); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
62 # } Stack; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
63 # |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
64 # calling example |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
65 # |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
66 # goto nodeStack->push((union Data*)node, stackTest3); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
67 # |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
68 # generated meta level code |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
69 # |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
70 # Gearef(context, Stack)->stack = nodeStack->stack; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
71 # Gearef(context, Stack)->data = (union Data*)node; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
72 # Gearef(context, Stack)->next = C_stackTest3; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
73 # goto meta(context, nodeStack->push); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
74 |
194 | 75 sub getDataGear { |
76 my ($filename) = @_; | |
253 | 77 my ($codeGearName, $name, $inTypedef); |
194 | 78 open my $fd,"<",$filename or die("can't open $filename $!"); |
79 while (<$fd>) { | |
80 if (! $inTypedef) { | |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
81 if (/^typedef struct (\w+)\s*<(.*)>/) { |
194 | 82 $inTypedef = 1; |
83 $name = $1; | |
84 $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
|
85 $var{$name} = {}; |
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
86 $code{$name} = {}; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
87 $generic{$name} = \split(/,/,$2); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
88 } elsif (/^typedef struct (\w+)/) { |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
89 $inTypedef = 1; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
90 $name = $1; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
91 $dataGear{$name} = $_; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
92 $var{$name} = {}; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
93 $code{$name} = {}; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
94 $generic{$name} = []; |
269 | 95 } elsif (/^(\w+)(\*)+ create(\w+)\(/) { |
249 | 96 if (defined $interface) { |
97 die "duplicate interface $interface\n"; | |
98 } | |
99 $interface = $1; | |
269 | 100 $implementation = $3; |
250 | 101 if ( -f "$interface.cbc") { |
102 &getDataGear("$interface.cbc"); | |
103 } | |
393 | 104 } elsif (/^(\s)*(\w+)\-\>(\w+)\s\=\s\((.*)\)create(\w+)\((.*)\);$/) { |
385 | 105 #my $intfn = ucfirst($2); |
106 my $impln = $5; | |
107 if ( -f "$impln.cbc") { | |
108 &getCodeGear("$impln.cbc"); | |
109 } | |
226 | 110 } |
194 | 111 next; |
112 } | |
249 | 113 # gather type name and type |
194 | 114 $dataGear{$name} .= $_; |
385 | 115 if (/^\s*(.*)\s+(\w+);$/ ) { |
280 | 116 my $ttype = $1; |
117 my $tname = $2; | |
118 if ($ttype =~ /^(union|struct) (\w+)/) { | |
119 $ttype = $2; | |
120 } | |
121 $var{$name}->{$tname} = $ttype; | |
250 | 122 } |
194 | 123 if (/^}/) { |
124 $inTypedef = 0; | |
125 } | |
126 } | |
127 } | |
128 | |
385 | 129 sub getCodeGear { |
130 my ($filename) = @_; | |
131 open my $fd,"<",$filename or die("can't open $filename $!"); | |
132 my ($name,$impln); | |
133 while (<$fd>) { | |
134 if (/^(\w+)(\*)+ create(\w+)\(/) { | |
135 $name = $1; | |
136 $impln = $3; | |
137 } | |
138 if (defined $name) { | |
139 if (/^\_\_code (\w+)$impln\((.*)\)(.*)/) { | |
140 my $args = $2; | |
141 my $method = $1; | |
142 $code{$name}->{$method} = []; | |
143 while($args) { | |
144 if ($args =~ s/(^\s*,\s*)//) { | |
145 } | |
146 # continuation case | |
147 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) { | |
148 my $next = $2; | |
149 my @args = split(/,/,$3); | |
387 | 150 push(@{$code{$name}->{$method}},"\_\_code $next"); |
385 | 151 } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) { |
152 my $structType = $1; | |
153 my $typeName = $2; | |
154 my $varName = $4; | |
155 my $typeField = lcfirst($typeName); | |
387 | 156 push(@{$code{$name}->{$method}},"$typeName $varName"); |
385 | 157 } elsif ($args =~ s/(.*,)//) { |
158 } else { | |
159 last; | |
160 } | |
161 } | |
162 } | |
163 } | |
164 } | |
165 } | |
166 | |
250 | 167 sub generateStub { |
251 | 168 my($fd,$prevCodeGearName,$dataGearName) = @_; |
274 | 169 print $fd "__code ", $prevCodeGearName ,"_stub(struct Context* context) {\n"; |
251 | 170 print $fd $dataGearName; |
250 | 171 print $fd "\n} \n\n"; |
251 | 172 return 1; |
250 | 173 } |
174 | |
253 | 175 sub generateStubArgs { |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
176 my($codeGearName, $varName, $typeName, $typeField, $interface,$output) = @_; |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
177 my $varname1 = $output?"O_$varName":$varName; |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
178 for my $n ( @{$dataGearVar{$codeGearName}} ) { |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
179 # we already have it |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
180 return 0 if ( $n eq $varname1); |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
181 } |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
182 push @{$dataGearVar{$codeGearName}}, $varname1; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
183 push @{$dataGearVarType{$codeGearName}}, $typeName; |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
184 if ($typeName eq $implementation) { |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
185 # get implementation |
258 | 186 $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $interface, $varName);\n"; |
253 | 187 } else { |
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
188 for my $ivar (keys %{$var{$interface}}) { |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
189 # input data gear field |
253 | 190 if ($varName eq $ivar) { |
280 | 191 if ($typeName eq $var{$interface}->{$ivar}) { |
192 if ($output) { | |
193 $dataGearName{$codeGearName} .= "\t$typeName** O_$varName = &Gearef(context, $interface)->$varName;\n"; | |
194 $outputVar{$codeGearName} .= "\t$typeName* $varName;\n"; | |
195 return 1; | |
196 } | |
197 | |
198 $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
|
199 return 1; |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
200 } |
253 | 201 } |
202 } | |
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
203 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
|
204 if ($varName eq $cName) { |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
205 # 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
|
206 $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
|
207 return 1; |
253 | 208 } |
209 } | |
389 | 210 # global or local variable case |
211 if ($typeName eq "Code") { | |
212 $dataGearName{$codeGearName} .= "\tenum $typeName $varName = Gearef(context, $interface)->$varName;\n"; | |
213 return 1; | |
214 } | |
268 | 215 $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
|
216 return 1; |
253 | 217 } |
218 } | |
219 | |
194 | 220 sub generateDataGear { |
249 | 221 my ($filename) = @_; |
222 open my $in,"<",$filename or die("can't open $filename $!"); | |
254 | 223 |
224 my $fn; | |
225 if ($opt_o) { | |
226 $fn = $opt_o; | |
227 } else { | |
228 my $fn1 = $filename; | |
229 $fn1 =~ s/\.cbc/.c/; | |
230 my $i = 1; | |
255 | 231 $fn = "$dir/$fn1"; |
254 | 232 while ( -f $fn) { |
255 | 233 $fn = "$dir/$fn1.$i"; |
254 | 234 $i++; |
235 } | |
250 | 236 } |
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
237 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
|
238 if (! -d $1) { |
393 | 239 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
|
240 } |
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
241 } |
249 | 242 open my $fd,">",$fn or die("can't write $fn $!"); |
254 | 243 |
249 | 244 my $prevCodeGearName; |
250 | 245 my $inTypedef = 0; |
278 | 246 my $inStub = 0; |
250 | 247 my %stub; |
251 | 248 my $codeGearName; |
254 | 249 |
249 | 250 while (<$in>) { |
278 | 251 if (! $inTypedef && ! $inStub) { |
249 | 252 if (/^typedef struct (\w+) {/) { |
253 $inTypedef = 1; | |
253 | 254 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { |
251 | 255 $codeGearName = $1; |
253 | 256 my $args = $2; |
257 my $tail = $3; | |
250 | 258 if ($codeGearName =~ /_stub$/) { |
262 | 259 # don't touch already existing stub |
278 | 260 $inStub = 1; |
250 | 261 $stub{$codeGearName} = 1; |
262 print $fd $_; | |
263 next; | |
264 } | |
249 | 265 if (defined $prevCodeGearName) { |
262 | 266 # stub is generated just before next CodeGear |
250 | 267 if (defined $stub{$prevCodeGearName."_stub"}) { |
268 undef $prevCodeGearName; | |
278 | 269 } else { |
270 &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName}); | |
271 $stub{$prevCodeGearName."_stub"} = 1; | |
250 | 272 } |
249 | 273 } |
262 | 274 # analyzing CodeGear argument |
275 # these arguments are extract from current context's arugment DataGear Interface | |
276 # and passed to the CodeGear | |
277 # struct Implementaion needs special handling | |
278 # __code next(...) ---> enum Code next | |
253 | 279 $prevCodeGearName = $codeGearName; |
280 $dataGearVar{$codeGearName} = []; | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
281 $outputVar{$codeGearName} = ""; |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
282 $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
|
283 my $newArgs = "struct Context *context,"; |
305 | 284 if ($args=~/^struct Context\s*\*\s*context/) { |
285 $newArgs = ""; | |
286 } | |
253 | 287 while($args) { |
288 if ($args =~ s/(^\s*,\s*)//) { | |
289 $newArgs .= $1; | |
290 } | |
262 | 291 # continuation case |
280 | 292 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) { |
293 my $next = $2; | |
294 my @args = split(/,/,$3); | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
295 if ( &generateStubArgs($codeGearName, $next, "Code", $next, $interface,0) ) { |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
296 $newArgs .= "enum Code $next"; |
258 | 297 } |
262 | 298 # analyze continuation arguments |
299 # output arguments are defined in the Interface take the pointer of these | |
300 # output arguments are put into the Interface DataGear just before the goto | |
253 | 301 for my $arg (@args) { |
302 $arg =~ s/^\s*//; | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
303 last if ($arg =~ /\.\.\./); |
253 | 304 $arg =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//; |
305 my $structType = $1; | |
306 my $typeName = $2; | |
307 my $varName = $4; | |
308 my $typeField = lcfirst($typeName); | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
309 push(@{$outputArgs{$codeGearName}->{$next}}, $varName); |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
310 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
|
311 $newArgs .= ",$structType $typeName **O_$varName"; |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
312 } |
253 | 313 } |
314 } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) { | |
315 my $structType = $1; | |
316 my $typeName = $2; | |
317 my $varName = $4; | |
318 my $typeField = lcfirst($typeName); | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
319 $newArgs .= $&; # assuming no duplicate |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
320 &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface,0); |
255 | 321 } elsif ($args =~ s/(.*,)//) { |
322 $newArgs .= $1; | |
323 } else { | |
324 $newArgs .= $args; | |
325 last; | |
253 | 326 } |
327 } | |
262 | 328 # generate goto statement from stub to the CodeGear in the buffer |
253 | 329 $dataGearName{$codeGearName} .= "\tgoto $codeGearName(context"; |
330 for my $arg ( @{$dataGearVar{$codeGearName}}) { | |
331 $dataGearName{$codeGearName} .= ", $arg"; | |
332 } | |
333 $dataGearName{$codeGearName} .= ");"; | |
262 | 334 # generate CodeGear header with new arguments |
253 | 335 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
|
336 if ($outputVar{$codeGearName} ne "") { |
324 | 337 # output data var can be use before write |
338 # 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
|
339 print $fd $outputVar{$codeGearName}; |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
340 } |
250 | 341 next; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
342 } elsif (/^(.*)goto (\w+)\-\>(\w+)\((.*)\);/) { |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
343 # handling goto statement |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
344 # 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
|
345 my $prev = $1; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
346 my $next = $2; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
347 my $method = $3; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
348 my @args = split(/,/,$4); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
349 my @types = @{$dataGearVarType{$codeGearName}}; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
350 my $ntype; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
351 for my $v (@{$dataGearVar{$codeGearName}}) { |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
352 my $t = shift @types; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
353 if ($v eq $next) { |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
354 $ntype = $t; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
355 } |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
356 } |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
357 print $fd "\tGearef(context, $ntype)->$next = $next->$next;\n"; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
358 # Put interface argument |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
359 my $prot = $code{$ntype}->{$method}; |
385 | 360 my $i = 1; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
361 for my $arg (@args) { |
385 | 362 my $p = @$prot[$i]; |
363 next if ( $p eq $arg); | |
387 | 364 $p =~ s/^(.*)\s(\w+)//; |
365 my $pType = $1; | |
366 my $pName = $2; | |
367 $arg =~ s/^(\s)*(\w+)/$2/; | |
368 if ($pType =~ s/\_\_code$//) { | |
369 print $fd "\tGearef(context, $ntype)->$pName = C_$arg;\n"; | |
391 | 370 } elsif ($pType =~ s/Data$//){ |
371 print $fd "\tGearef(context, $ntype)->$pName = (union Data*) $arg;\n"; | |
387 | 372 } else { |
373 print $fd "\tGearef(context, $ntype)->$pName = $arg;\n"; | |
374 } | |
385 | 375 $i++; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
376 } |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
377 print $fd "${prev}goto meta(context, $next->$next->$ntype.$method);\n"; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
378 next; |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
379 } elsif (/^(.*)goto (\w+)\((.*)\);/) { |
278 | 380 # handling goto statement |
262 | 381 # convert it to the meta call form with two arugments, that is context and enum Code |
250 | 382 my $prev = $1; |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
383 my $next = $2; |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
384 my @args = split(/,/,$3); |
388 | 385 my $v = 0; |
386 for my $n ( @{$dataGearVar{$codeGearName}} ) { | |
387 # continuation arguments | |
388 $v = 1 if ( $n eq $next); | |
389 } | |
390 if ($v || defined $code{$interface}->{$next}) { | |
278 | 391 # write continuation's arguments into the interface arguments |
392 # we may need a commit for a shared DataGear | |
393 for my $arg ( @{$outputArgs{$codeGearName}->{$next}} ) { | |
394 my $v = shift(@args); | |
395 print $fd "\t*O_$arg = $v;\n"; | |
396 } | |
397 print $fd "${prev}goto meta(context, $next);\n"; | |
398 next; | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
399 } |
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
400 } else { |
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
401 s/new\s+(\w+)\(\)/\&ALLOCATE(context, \1)->\1/g; # replacing new |
249 | 402 } |
403 # gather type name and type | |
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
404 } elsif (/^}/) { |
278 | 405 $inStub = 0; |
249 | 406 $inTypedef = 0; |
407 } | |
250 | 408 print $fd $_; |
194 | 409 } |
250 | 410 if (defined $prevCodeGearName) { |
411 if (!defined $stub{$prevCodeGearName."_stub"}) { | |
251 | 412 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName}); |
250 | 413 } |
228 | 414 } |
194 | 415 } |
416 | |
417 # end |