annotate src/gearsTools/generate_stub.pl @ 45:5f19e9554c30

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