|
194
|
1 #!/usr/bin/perl
|
|
|
2
|
|
250
|
3 use strict;
|
|
254
|
4 use Getopt::Std;
|
|
250
|
5
|
|
194
|
6 # interface.cbc
|
|
|
7 # typedef struct Worker {
|
|
|
8 # int id;
|
|
|
9 # struct Context* contexts;
|
|
|
10 # enum Code execute;
|
|
|
11 # enum Code taskSend;
|
|
|
12 # enum Code taskRecive;
|
|
|
13 # enum Code shutdown;
|
|
|
14 # struct Queue* tasks;
|
|
|
15 # } Worker;
|
|
|
16
|
|
255
|
17 our($opt_o,$opt_d,$opt_h);
|
|
|
18 getopts('o:d:h');
|
|
|
19
|
|
|
20 my $dir = ".";
|
|
|
21 if ($opt_d) {
|
|
|
22 $dir = $opt_d;
|
|
|
23 if (! -d $dir) {
|
|
|
24 mkdir $dir;
|
|
|
25 }
|
|
|
26 }
|
|
254
|
27
|
|
|
28 for my $fn (@ARGV) {
|
|
255
|
29 next if ($fn !~ /\.cbc$/);
|
|
249
|
30 &getDataGear($fn);
|
|
|
31 &generateDataGear($fn);
|
|
194
|
32 }
|
|
|
33
|
|
250
|
34 my %var;
|
|
|
35 my %type;
|
|
|
36 my %code;
|
|
|
37 my %dataGearVar;
|
|
|
38 my %dataGear;
|
|
|
39 my %dataGearName;
|
|
253
|
40 my $implementation;
|
|
|
41 my $interface;
|
|
250
|
42
|
|
194
|
43 sub getDataGear {
|
|
|
44 my ($filename) = @_;
|
|
253
|
45 my ($codeGearName, $name, $inTypedef);
|
|
194
|
46 open my $fd,"<",$filename or die("can't open $filename $!");
|
|
|
47 while (<$fd>) {
|
|
|
48 if (! $inTypedef) {
|
|
|
49 if (/^typedef struct (\w+) {/) {
|
|
|
50 $inTypedef = 1;
|
|
|
51 $name = $1;
|
|
|
52 $dataGear{$name} = $_;
|
|
253
|
53 $code{$name} = [];
|
|
249
|
54 } elsif (/^(\w+)\* create(\w+)\(/) {
|
|
|
55 if (defined $interface) {
|
|
|
56 die "duplicate interface $interface\n";
|
|
|
57 }
|
|
|
58 $interface = $1;
|
|
250
|
59 $implementation = $2;
|
|
|
60 if ( -f "$interface.cbc") {
|
|
|
61 &getDataGear("$interface.cbc");
|
|
|
62 }
|
|
226
|
63 }
|
|
194
|
64 next;
|
|
|
65 }
|
|
249
|
66 # gather type name and type
|
|
194
|
67 $dataGear{$name} .= $_;
|
|
196
|
68 if (/(\w+);$/ and !/^} (\w+)/) {
|
|
250
|
69 my $tmp = $1 . "\n";
|
|
200
|
70 if (/{/) {
|
|
|
71 $tmp = "{" . $';
|
|
201
|
72 $tmp =~ s/;$//;
|
|
200
|
73 }
|
|
|
74 $var{$name} .= $tmp;
|
|
196
|
75 $tmp = $`;
|
|
|
76 $tmp =~ s/^\s*//;
|
|
|
77 $type{$name} .= $tmp . "\n";
|
|
250
|
78 } elsif (/\_\_code (\w+)\(/) {
|
|
|
79 push $code{$name}, $1;
|
|
|
80 }
|
|
194
|
81 if (/^}/) {
|
|
|
82 $inTypedef = 0;
|
|
|
83 }
|
|
|
84 }
|
|
|
85 }
|
|
|
86
|
|
250
|
87 sub generateStub {
|
|
251
|
88 my($fd,$prevCodeGearName,$dataGearName) = @_;
|
|
250
|
89 print $fd "__code ", $prevCodeGearName ,"_stub (struct Context* context) {\n";
|
|
251
|
90 print $fd $dataGearName;
|
|
250
|
91 print $fd "\n} \n\n";
|
|
251
|
92 return 1;
|
|
250
|
93 }
|
|
|
94
|
|
253
|
95 sub generateStubArgs {
|
|
|
96 my($codeGearName, $varName, $typeName, $typeField, $interface) = @_;
|
|
|
97 push @{$dataGearVar{$codeGearName}},$varName;
|
|
|
98 if ($typeField ne $varName) {
|
|
258
|
99 $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $interface, $varName);\n";
|
|
253
|
100 # print STDOUT "$codeGearName \t$typeName* $varName = ($typeName*)GearImpl(context, $typeName, $varName);\n";
|
|
|
101 } else {
|
|
|
102 for my $ivar ($var{$interface}) {
|
|
|
103 if ($varName eq $ivar) {
|
|
|
104 $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $interface)->$varName;\n";
|
|
|
105 # print STDOUT "$codeGearName \t$typeName* $varName = Gearef(context, $interface)->$varName;\n";
|
|
|
106 return;
|
|
|
107 }
|
|
|
108 }
|
|
258
|
109 $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $typeName);\n";
|
|
253
|
110 # print STDOUT "$codeGearName \t$typeName* $varName = Gearef(context, $typeName)->$typeField;\n";
|
|
|
111 }
|
|
|
112 }
|
|
|
113
|
|
194
|
114 sub generateDataGear {
|
|
249
|
115 my ($filename) = @_;
|
|
|
116 open my $in,"<",$filename or die("can't open $filename $!");
|
|
254
|
117
|
|
|
118 my $fn;
|
|
|
119 if ($opt_o) {
|
|
|
120 $fn = $opt_o;
|
|
|
121 } else {
|
|
|
122 my $fn1 = $filename;
|
|
|
123 $fn1 =~ s/\.cbc/.c/;
|
|
|
124 my $i = 1;
|
|
255
|
125 $fn = "$dir/$fn1";
|
|
254
|
126 while ( -f $fn) {
|
|
255
|
127 $fn = "$dir/$fn1.$i";
|
|
254
|
128 $i++;
|
|
|
129 }
|
|
250
|
130 }
|
|
249
|
131 open my $fd,">",$fn or die("can't write $fn $!");
|
|
254
|
132
|
|
249
|
133 my $prevCodeGearName;
|
|
250
|
134 my $inTypedef = 0;
|
|
|
135 my %stub;
|
|
251
|
136 my $codeGearName;
|
|
254
|
137
|
|
249
|
138 while (<$in>) {
|
|
|
139 if (! $inTypedef) {
|
|
|
140 if (/^typedef struct (\w+) {/) {
|
|
|
141 $inTypedef = 1;
|
|
258
|
142 # get __code name
|
|
253
|
143 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) {
|
|
251
|
144 $codeGearName = $1;
|
|
253
|
145 my $args = $2;
|
|
|
146 my $tail = $3;
|
|
250
|
147 if ($codeGearName =~ /_stub$/) {
|
|
|
148 $stub{$codeGearName} = 1;
|
|
|
149 print $fd $_;
|
|
|
150 next;
|
|
|
151 }
|
|
249
|
152 if (defined $prevCodeGearName) {
|
|
250
|
153 if (defined $stub{$prevCodeGearName."_stub"}) {
|
|
|
154 undef $prevCodeGearName;
|
|
|
155 print $fd $_;
|
|
|
156 next;
|
|
|
157 }
|
|
253
|
158 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName});
|
|
249
|
159 }
|
|
253
|
160 $prevCodeGearName = $codeGearName;
|
|
|
161 $dataGearVar{$codeGearName} = [];
|
|
|
162 my $newArgs = "";
|
|
|
163 while($args) {
|
|
|
164 if ($args =~ s/(^\s*,\s*)//) {
|
|
|
165 $newArgs .= $1;
|
|
|
166 }
|
|
|
167 # replace __code next
|
|
258
|
168 if ($args =~ s/^\_\_code\s(\w+)\(([^)]*)\)//) {
|
|
253
|
169 my $next = $1;
|
|
258
|
170 my @args = split(/,/,$3);
|
|
|
171 my $nextArg = $2;
|
|
|
172 # generate stub args of next args
|
|
|
173 while ($nextArg =~ s/union (\w+)(\*)+\s([^,]*)//) {
|
|
|
174 my $typeName = $1.$2;
|
|
|
175 my $varName = $3;
|
|
|
176 my $typeField = lcfirst($1);
|
|
|
177 $newArgs .= "union $typeName\* $3, ";
|
|
|
178 &generateStubArgs($codeGearName, $varName, $1, $typeField, $interface);
|
|
|
179 }
|
|
253
|
180 $newArgs .= "enum Code $next";
|
|
|
181 for my $arg (@args) {
|
|
|
182 $arg =~ s/^\s*//;
|
|
|
183 $arg =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//;
|
|
|
184 my $structType = $1;
|
|
|
185 my $typeName = $2;
|
|
|
186 my $varName = $4;
|
|
|
187 my $typeField = lcfirst($typeName);
|
|
|
188 &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface);
|
|
|
189 }
|
|
|
190 } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) {
|
|
|
191 my $structType = $1;
|
|
|
192 my $typeName = $2;
|
|
|
193 my $varName = $4;
|
|
|
194 my $typeField = lcfirst($typeName);
|
|
|
195 $newArgs .= $&;
|
|
|
196 &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface);
|
|
255
|
197 } elsif ($args =~ s/(.*,)//) {
|
|
|
198 $newArgs .= $1;
|
|
|
199 } else {
|
|
|
200 $newArgs .= $args;
|
|
|
201 last;
|
|
253
|
202 }
|
|
|
203 }
|
|
|
204 $dataGearName{$codeGearName} .= "\tgoto $codeGearName(context";
|
|
|
205 for my $arg ( @{$dataGearVar{$codeGearName}}) {
|
|
|
206 $dataGearName{$codeGearName} .= ", $arg";
|
|
|
207 }
|
|
|
208 $dataGearName{$codeGearName} .= ");";
|
|
|
209 print $fd "__code $codeGearName($newArgs)$tail\n";
|
|
|
210 next;
|
|
258
|
211 } elsif (/^(.*)goto\s(\w+)\((.*)\.\.\.\);/) {
|
|
|
212 #print STDOUT "$3\n";
|
|
250
|
213 my $prev = $1;
|
|
258
|
214 my $args = $3;
|
|
|
215 print $fd "${prev}goto meta(context, $2);\n";
|
|
250
|
216 next;
|
|
249
|
217 }
|
|
250
|
218 print $fd $_;
|
|
249
|
219 next;
|
|
|
220 }
|
|
|
221 # gather type name and type
|
|
|
222 if (/^}/) {
|
|
|
223 $inTypedef = 0;
|
|
|
224 }
|
|
250
|
225 print $fd $_;
|
|
194
|
226 }
|
|
250
|
227 if (defined $prevCodeGearName) {
|
|
|
228 if (!defined $stub{$prevCodeGearName."_stub"}) {
|
|
251
|
229 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName});
|
|
250
|
230 }
|
|
228
|
231 }
|
|
194
|
232 }
|
|
|
233
|
|
|
234 # end
|
