Mercurial > hg > Members > Moririn

annotate src/parallel_execution/generate_stub.pl @ 261:0cd43e22aee1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sat, 28 Jan 2017 15:48:54 +0900
parents 6b5444bbea8a 4fe19a06d666
children 2c56a9536c0d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
1 #!/usr/bin/perl
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
2
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
3 use strict;
254
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
4 use Getopt::Std;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
5
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
6 # interface.cbc
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
7 # typedef struct Worker {
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
8 # int id;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
9 # struct Context* contexts;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
10 # enum Code execute;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
11 # enum Code taskSend;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
12 # enum Code taskRecive;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
13 # enum Code shutdown;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
14 # struct Queue* tasks;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
15 # } Worker;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
16
255
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
17 our($opt_o,$opt_d,$opt_h);
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
18 getopts('o:d:h');
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
19
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
20 my $dir = ".";
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
21 if ($opt_d) {
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
22 $dir = $opt_d;
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
23 if (! -d $dir) {
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
24 mkdir $dir;
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
25 }
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
26 }
254
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
27
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
28 for my $fn (@ARGV) {
255
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
29 next if ($fn !~ /\.cbc$/);
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
30 &getDataGear($fn);
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
31 &generateDataGear($fn);
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
32 }
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
33
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
34 my %var;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
35 my %code;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
36 my %dataGearVar;
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
37 my %outputVar; # output var initializer
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
38 my %outputArgs; # continuation's output variables
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
39 my %dataGear;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
40 my %dataGearName;
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
41 my $implementation;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
42 my $interface;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
43
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
44 sub getDataGear {
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
45 my ($filename) = @_;
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
46 my ($codeGearName, $name, $inTypedef);
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
47 open my $fd,"<",$filename or die("can't open $filename $!");
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
48 while (<$fd>) {
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
49 if (! $inTypedef) {
259
195518ab62fc fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
50 if (/^typedef struct (\w+)/) {
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
51 $inTypedef = 1;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
52 $name = $1;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
53 $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
54 $var{$name} = {};
195518ab62fc fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
55 $code{$name} = {};
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
56 } elsif (/^(\w+)\* create(\w+)\(/) {
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
57 if (defined $interface) {
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
58 die "duplicate interface $interface\n";
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
59 }
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
60 $interface = $1;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
61 $implementation = $2;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
62 if ( -f "$interface.cbc") {
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
63 &getDataGear("$interface.cbc");
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
64 }
226
68c03e7057d9 get arg
mir3636
parents: 201
diff changeset
65 }
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
66 next;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
67 }
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
68 # gather type name and type
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
69 $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
70 if (/^\s*(.*)\s+(\w+);$/ ) {
195518ab62fc fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
71 $var{$name}->{$2} = $1;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
72 } elsif (/\_\_code (\w+)\(/) {
259
195518ab62fc fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
73 $code{$name}->{$1} = 1;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
74 }
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
75 if (/^}/) {
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
76 $inTypedef = 0;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
77 }
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
78 }
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
79 }
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
80
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
81 sub generateStub {
251
0ab52d6e2fd9 fix sub generateStub
mir3636
parents: 250
diff changeset
82 my($fd,$prevCodeGearName,$dataGearName) = @_;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
83 print $fd "__code ", $prevCodeGearName ,"_stub (struct Context* context) {\n";
251
0ab52d6e2fd9 fix sub generateStub
mir3636
parents: 250
diff changeset
84 print $fd $dataGearName;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
85 print $fd "\n} \n\n";
251
0ab52d6e2fd9 fix sub generateStub
mir3636
parents: 250
diff changeset
86 return 1;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
87 }
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
88
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
89 sub generateStubArgs {
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
90 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
91 my $varname1 = $output?"O_$varName":$varName;
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
92 for my $n ( @{$dataGearVar{$codeGearName}} ) {
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
93 # we already have it
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
94 return 0 if ( $n eq $varname1);
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
95 }
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
96 push @{$dataGearVar{$codeGearName}}, $varname1;
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
97 if ($typeName eq $implementation) {
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
98 # get implementation
258
4fe19a06d666 generate next args
mir3636
parents: 255
diff changeset
99 $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $interface, $varName);\n";
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
100 } else {
259
195518ab62fc fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
101 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
102 # input data gear field
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
103 if ($varName eq $ivar) {
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
104 if ($output) {
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
105 $dataGearName{$codeGearName} .= "\t$typeName** O_$varName = &Gearef(context, $interface)->$varName;\n";
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
106 $outputVar{$codeGearName} .= "\t$typeName* $varName;\n";
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
107 return 1;
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
108 }
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
109 $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
110 return 1;
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
111 }
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
112 }
259
195518ab62fc fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
113 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
114 if ($varName eq $cName) {
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
115 # 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
116 $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
117 return 1;
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
118 }
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
119 }
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
120 # global variable case
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
121 $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $typeName)->$typeField;\n";
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
122 return 1;
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
123 }
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
124 }
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
125
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
126 sub generateDataGear {
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
127 my ($filename) = @_;
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
128 open my $in,"<",$filename or die("can't open $filename $!");
254
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
129
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
130 my $fn;
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
131 if ($opt_o) {
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
132 $fn = $opt_o;
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
133 } else {
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
134 my $fn1 = $filename;
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
135 $fn1 =~ s/\.cbc/.c/;
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
136 my $i = 1;
255
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
137 $fn = "$dir/$fn1";
254
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
138 while ( -f $fn) {
255
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
139 $fn = "$dir/$fn1.$i";
254
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
140 $i++;
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
141 }
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
142 }
259
195518ab62fc fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
143 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
144 if (! -d $1) {
195518ab62fc fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
145 mkdir $1;
195518ab62fc fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
146 }
195518ab62fc fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
147 }
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
148 open my $fd,">",$fn or die("can't write $fn $!");
254
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
149
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
150 my $prevCodeGearName;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
151 my $inTypedef = 0;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
152 my %stub;
251
0ab52d6e2fd9 fix sub generateStub
mir3636
parents: 250
diff changeset
153 my $codeGearName;
254
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
154
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
155 while (<$in>) {
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
156 if (! $inTypedef) {
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
157 if (/^typedef struct (\w+) {/) {
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
158 $inTypedef = 1;
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
159 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) {
251
0ab52d6e2fd9 fix sub generateStub
mir3636
parents: 250
diff changeset
160 $codeGearName = $1;
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
161 my $args = $2;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
162 my $tail = $3;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
163 if ($codeGearName =~ /_stub$/) {
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
164 $stub{$codeGearName} = 1;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
165 print $fd $_;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
166 next;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
167 }
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
168 if (defined $prevCodeGearName) {
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
169 if (defined $stub{$prevCodeGearName."_stub"}) {
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
170 undef $prevCodeGearName;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
171 print $fd $_;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
172 next;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
173 }
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
174 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName});
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
175 }
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
176 $prevCodeGearName = $codeGearName;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
177 $dataGearVar{$codeGearName} = [];
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
178 $outputVar{$codeGearName} = "";
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
179 $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
180 my $newArgs = "struct Context *context,";
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
181 while($args) {
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
182 if ($args =~ s/(^\s*,\s*)//) {
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
183 $newArgs .= $1;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
184 }
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
185 # replace __code next
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
186 if ($args =~ s/^\_\_code\s+(\w+)\(([^)]*)\)//) {
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
187 my $next = $1;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
188 my @args = split(/,/,$2);
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
189 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
190 $newArgs .= "enum Code $next";
258
4fe19a06d666 generate next args
mir3636
parents: 255
diff changeset
191 }
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
192 for my $arg (@args) {
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
193 $arg =~ s/^\s*//;
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
194 last if ($arg =~ /\.\.\./);
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
195 $arg =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
196 my $structType = $1;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
197 my $typeName = $2;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
198 my $varName = $4;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
199 my $typeField = lcfirst($typeName);
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
200 push(@{$outputArgs{$codeGearName}->{$next}}, $varName);
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
201 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
202 $newArgs .= ",$structType $typeName **O_$varName";
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
203 }
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
204 }
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
205 } elsif ($args =~ s/^(struct|union) (\w+)(\*)+\s(\w+)//) {
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
206 my $structType = $1;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
207 my $typeName = $2;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
208 my $varName = $4;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
209 my $typeField = lcfirst($typeName);
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
210 $newArgs .= $&; # assuming no duplicate
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
211 &generateStubArgs($codeGearName, $varName, $typeName, $typeField, $interface,0);
255
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
212 } elsif ($args =~ s/(.*,)//) {
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
213 $newArgs .= $1;
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
214 } else {
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
215 $newArgs .= $args;
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
216 last;
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
217 }
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
218 }
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
219 $dataGearName{$codeGearName} .= "\tgoto $codeGearName(context";
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
220 for my $arg ( @{$dataGearVar{$codeGearName}}) {
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
221 $dataGearName{$codeGearName} .= ", $arg";
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
222 }
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
223 $dataGearName{$codeGearName} .= ");";
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
224 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
225 if ($outputVar{$codeGearName} ne "") {
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
226 print $fd $outputVar{$codeGearName};
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
227 }
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
228 next;
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
229 } elsif (/^(.*)goto (\w+)\((.*)\);/) {
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
230 my $prev = $1;
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
231 my $next = $2;
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
232 my @args = split(/,/,$3);
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
233 # write continuation's arguments
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
234 # we may need a commit for a shared DataGear
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
235 for my $arg ( @{$outputArgs{$codeGearName}->{$next}} ) {
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
236 my $v = shift(@args);
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
237 print $fd "\t*O_$arg = $v;\n";
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
238 }
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
239 print $fd "${prev}goto meta(context, $next);\n";
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
240 next;
259
195518ab62fc fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
241 } else {
195518ab62fc fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
242 s/new\s+(\w+)\(\)/\&ALLOCATE(context, \1)->\1/g; # replacing new
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
243 }
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
244 # 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
245 } elsif (/^}/) {
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
246 $inTypedef = 0;
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
247 }
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
248 print $fd $_;
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
249 }
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
250 if (defined $prevCodeGearName) {
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
251 if (!defined $stub{$prevCodeGearName."_stub"}) {
251
0ab52d6e2fd9 fix sub generateStub
mir3636
parents: 250
diff changeset
252 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName});
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
253 }
228
55260ff44c8c generate stub
mir3636
parents: 226
diff changeset
254 }
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
255 }
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
256
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
257 # end