Mercurial > hg > Gears > Gears
annotate src/parallel_execution/generate_stub.pl @ 677:47910f7c731e
remove some global variables
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Wed, 19 Aug 2020 19:31:00 +0900 |
parents | 4b0ca2c6c8cb |
children | c65f8f00ba6f |
rev | line source |
---|---|
194 | 1 #!/usr/bin/perl |
2 | |
250 | 3 use strict; |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
4 use warnings; |
629
90309637c4c8
Getopt::Std to Getopt::Long
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
625
diff
changeset
|
5 use Getopt::Long; |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
6 use File::Path qw/make_path/; |
669
e8800c60811a
fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
668
diff
changeset
|
7 use File::Basename qw/basename dirname/; |
663 | 8 use File::Spec qw/rel2abs/; |
9 | |
661
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
10 |
658 | 11 use FindBin; |
12 use lib "$FindBin::Bin/lib"; | |
13 | |
661
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
14 use Gears::Util; |
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
15 |
250 | 16 |
482
5859bed4edff
Refactoring spawnTasks method
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
468
diff
changeset
|
17 # interface.h |
194 | 18 # typedef struct Worker { |
19 # int id; | |
20 # struct Context* contexts; | |
21 # enum Code execute; | |
22 # enum Code taskSend; | |
23 # enum Code taskRecive; | |
24 # enum Code shutdown; | |
25 # struct Queue* tasks; | |
26 # } Worker; | |
27 | |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
28 our($opt_o,$opt_d,$opt_h, $opt_project); |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
29 |
629
90309637c4c8
Getopt::Std to Getopt::Long
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
625
diff
changeset
|
30 GetOptions( |
631
5189c60b9707
update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
630
diff
changeset
|
31 "o=s" => \$opt_o, |
5189c60b9707
update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
630
diff
changeset
|
32 "d=s" => \$opt_d, |
5189c60b9707
update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
630
diff
changeset
|
33 "h" => \$opt_h, |
5189c60b9707
update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
630
diff
changeset
|
34 "project=s" => \$opt_project, |
629
90309637c4c8
Getopt::Std to Getopt::Long
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
625
diff
changeset
|
35 ); |
255 | 36 |
37 my $dir = "."; | |
38 if ($opt_d) { | |
39 $dir = $opt_d; | |
40 if (! -d $dir) { | |
393 | 41 make_path $dir; |
255 | 42 } |
43 } | |
254 | 44 |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
45 |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
46 |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
47 my %projects = ( |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
48 gears => { cotnext => "context" }, |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
49 xv6 => { context => "cbc_context" }, |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
50 ); |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
51 |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
52 |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
53 my $context_name = "context"; |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
54 if ($opt_project && exists $projects{$opt_project}) { |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
55 $context_name = $projects{$opt_project}->{context}; |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
56 } |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
57 |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
58 |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
59 |
250 | 60 my %var; |
61 my %code; | |
62 my %dataGearVar; | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
63 my %outputVar; # output var initializer |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
64 my %outputArgs; # continuation's output variables |
250 | 65 my %dataGear; |
66 my %dataGearName; | |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
67 my %generic; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
68 my %dataGearVarType; |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
69 my %codeGear; |
661
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
70 my %call_interfaces; |
676 | 71 my $interfaceNameToHeaderPath = createInterfaceNameToHeaderPath($FindBin::Bin); |
72 my $searchCbCFromCodeGearAndFilename = createSearchCbCFileFromCodeGearNameAndFilename($FindBin::Bin); | |
73 my %filename2EachCodeGearArgs; | |
668 | 74 |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
75 my $implInterfaceInfo = {isImpl => undef, implementation => undef, interface => undef}; |
665 | 76 |
77 | |
78 # this for statement is main routine | |
79 for my $fn (@ARGV) { | |
80 next if ($fn !~ /\.cbc$/); | |
81 getDataGear($fn); | |
82 generateDataGear($fn); | |
83 } | |
84 | |
250 | 85 |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
86 # interface definision |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
87 # |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
88 # typedef struct Stack<Type, Impl>{ |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
89 # Type* stack; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
90 # Type* data; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
91 # Type* data1; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
92 # __code whenEmpty(...); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
93 # __code clear(Impl* stack,__code next(...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
94 # __code push(Impl* stack,Type* data, __code next(...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
95 # __code pop(Impl* stack, __code next(Type*, ...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
96 # __code pop2(Impl* stack, Type** data, Type** data1, __code next(Type**, Type**, ...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
97 # __code isEmpty(Impl* stack, __code next(...), __code whenEmpty(...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
98 # __code get(Impl* stack, Type** data, __code next(...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
99 # __code get2(Impl* stack,..., __code next(...)); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
100 # __code next(...); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
101 # } Stack; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
102 # |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
103 # calling example |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
104 # |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
105 # goto nodeStack->push((union Data*)node, stackTest3); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
106 # |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
107 # generated meta level code |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
108 # |
442
481fce540daf
Fix goto implement method of generate_stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
424
diff
changeset
|
109 # Gearef(context, Stack)->stack = (union Data*)nodeStack; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
110 # Gearef(context, Stack)->data = (union Data*)node; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
111 # Gearef(context, Stack)->next = C_stackTest3; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
112 # goto meta(context, nodeStack->push); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
113 |
194 | 114 sub getDataGear { |
115 my ($filename) = @_; | |
647
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
116 |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
117 my ($codeGearName, $name, $inTypedef,$described_data_gear, $codeGearName2Args, $currentCodeGear); |
194 | 118 open my $fd,"<",$filename or die("can't open $filename $!"); |
119 while (<$fd>) { | |
120 if (! $inTypedef) { | |
675 | 121 #this scope is usually parsing cbc file |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
122 if (/^typedef struct (\w+)\s*<(.*)>/) { |
194 | 123 $inTypedef = 1; |
124 $name = $1; | |
125 $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
|
126 $var{$name} = {}; |
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
127 $code{$name} = {}; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
128 $generic{$name} = \split(/,/,$2); |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
129 } elsif (/^typedef struct (\w+)/) { |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
130 $inTypedef = 1; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
131 $name = $1; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
132 $dataGear{$name} = $_; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
133 $var{$name} = {}; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
134 $code{$name} = {}; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
135 $generic{$name} = []; |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
136 } elsif (/^(\w+)(\*)+ create(\w+)\(/) { # this case implementation constructor |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
137 if (defined $implInterfaceInfo->{interface} ) { |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
138 die "duplicate interface $implInterfaceInfo->{interface}\n"; |
249 | 139 } |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
140 my $interfaceName = $1; |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
141 $implInterfaceInfo->{isImpl} = 1; |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
142 $implInterfaceInfo->{interface} = $interfaceName; |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
143 $implInterfaceInfo->{implementation} = $3; |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
144 my $cbc_source_path = $searchCbCFromCodeGearAndFilename->($interfaceName, $filename); |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
145 if ($cbc_source_path) { |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
146 &getDataGear($cbc_source_path); |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
147 } |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
148 } elsif (/^(\w+)(\*)\s+(\w+)\s+=\s+create(\w+)\(.*\);/) { # this case use constructor |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
149 my $interfaceName = $1; |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
150 my $instance = $2; |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
151 my $impl = $3; |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
152 my $cbc_source_path = $searchCbCFromCodeGearAndFilename->($interfaceName, $filename); |
675 | 153 if ($cbc_source_path) { |
154 &getDataGear($cbc_source_path); | |
250 | 155 } |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
156 } elsif(/^(.*)par goto (\w+)\((.*)\)/) { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
157 my $codeGearName = $2; |
676 | 158 my $cbc_source_path = $searchCbCFromCodeGearAndFilename->($codeGearName, $filename); |
675 | 159 if ($cbc_source_path) { |
160 &getCodeGear($cbc_source_path); | |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
161 } |
595 | 162 } elsif(/^#interface "(.*)"/) { |
468
ac244346c85d
Change used interface syntax from #include to #interface
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
467
diff
changeset
|
163 # use interface |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
164 my $interfaceHeader = $1; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
165 next if ($interfaceHeader =~ /context.h/); |
661
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
166 $interfaceHeader =~ m|(\w+)\.\w+$|; #remove filename extention |
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
167 my $interfaceName = $1; |
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
168 $call_interfaces{$filename}->{$interfaceName} = 1; |
676 | 169 my $interface_path = $interfaceNameToHeaderPath->{$interfaceName}; |
675 | 170 if ($interface_path) { |
171 &getDataGear($interface_path); | |
172 &getCodeGear($interface_path); | |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
173 } |
527
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
174 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { |
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
175 my $codeGearName = $1; |
675 | 176 my $args = $2; |
676 | 177 my $cbc_source_path = $searchCbCFromCodeGearAndFilename->($codeGearName, $filename); |
675 | 178 if ($cbc_source_path) { |
179 &getCodeGear($cbc_source_path); | |
527
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
180 } |
675 | 181 my $tname2type = parseCodeGearDeclarationArg($args); |
182 for my $tname (keys %$tname2type) { | |
183 $codeGearName2Args->{$codeGearName}->{$tname} = $tname2type->{$tname}; | |
184 } | |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
185 $currentCodeGear = $codeGearName; |
675 | 186 } elsif (/^(.*)goto (\w+)\-\>(\w+)\((.*)\);/) { |
187 # handling goto statement | |
188 # convert it to the meta call form with two arugments, that is context and enum Code | |
189 my $prev = $1; | |
190 my $next = $2; | |
191 my $method = $3; | |
192 my $tmpArgs = $4; | |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
193 |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
194 |
226 | 195 } |
194 | 196 next; |
197 } | |
661
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
198 |
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
199 #this scope does parsing of header files |
249 | 200 # gather type name and type |
194 | 201 $dataGear{$name} .= $_; |
385 | 202 if (/^\s*(.*)\s+(\w+);$/ ) { |
280 | 203 my $ttype = $1; |
204 my $tname = $2; | |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
205 if ($ttype =~ /^(union|struct|const|enum)\s*(\w+)/) { |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
206 my $structType = $1; |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
207 my $vname = $2; |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
208 if ($structType ne 'const') { |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
209 $ttype = $vname; |
598 | 210 } else { |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
211 if ($structType =~ /(const|enum)/) { |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
212 $ttype = "$structType $vname"; |
625 | 213 } |
598 | 214 } |
280 | 215 } |
598 | 216 $described_data_gear = 1; |
280 | 217 $var{$name}->{$tname} = $ttype; |
250 | 218 } |
595 | 219 if (/__code (\w+)/) { |
598 | 220 next if $described_data_gear; |
595 | 221 my $args = $'; |
675 | 222 my $tname2type = parseCodeGearDeclarationArg($args); |
223 for my $tname (keys %$tname2type) { | |
224 $var{$name}->{$tname} = $tname2type->{$tname}; | |
595 | 225 } |
226 } | |
194 | 227 if (/^}/) { |
228 $inTypedef = 0; | |
229 } | |
230 } | |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
231 |
676 | 232 $filename2EachCodeGearArgs{$filename} = $codeGearName2Args; |
233 | |
194 | 234 } |
235 | |
675 | 236 sub parseCodeGearDeclarationArg { |
237 my ($args) = @_; | |
238 my %tname2type; | |
239 while ($args =~ /\s*(struct|union|const|enum)?\s*([\w\[\]_]+)\*?\s*(\w+),?/g) { | |
240 #$args eq (Impl* vm, pde_t* pgdir, char* init, uint sz, __code next(...)); | |
241 my $const_type = $1; | |
242 my $ttype = $2; | |
243 my $tname = $3; | |
244 | |
245 $ttype =~ s/(Impl|Isa|Type)/Data/; | |
246 if ($const_type && ($const_type =~ /(const|enum)/)) { | |
247 $ttype = "$1 $ttype"; | |
248 } | |
249 $tname2type{$tname} = $ttype; | |
250 } | |
251 return \%tname2type; | |
252 } | |
253 | |
385 | 254 sub getCodeGear { |
255 my ($filename) = @_; | |
256 open my $fd,"<",$filename or die("can't open $filename $!"); | |
257 my ($name,$impln); | |
258 while (<$fd>) { | |
633
8b295624ea4b
bug fix drop interface whitespace
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
631
diff
changeset
|
259 if (/^(\w+)\s*(\*)+ create(\w+)\(/) { |
385 | 260 $name = $1; |
261 $impln = $3; | |
633
8b295624ea4b
bug fix drop interface whitespace
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
631
diff
changeset
|
262 } elsif(/^typedef struct (\w+)\s*<.*>\s*{/) { |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
263 $name = $1; |
385 | 264 } |
265 if (defined $name) { | |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
266 if (/^\s*\_\_code (\w+)\((.*)\);/) { |
385 | 267 my $args = $2; |
268 my $method = $1; | |
269 $code{$name}->{$method} = []; | |
270 while($args) { | |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
271 # replace comma |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
272 $args =~ s/(^\s*,\s*)//; |
385 | 273 # continuation case |
274 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) { | |
275 my $next = $2; | |
276 my @args = split(/,/,$3); | |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
277 push(@{$code{$name}->{$method}},"\_\_code $next"); |
598 | 278 } elsif ($args =~ s/^(struct|union|const)?\s*(\w+)(\**)\s+(\w+)//) { |
385 | 279 my $structType = $1; |
280 my $typeName = $2; | |
466
831b7f6fd687
Fix warning pointer type
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
464
diff
changeset
|
281 my $ptrType = $3; |
385 | 282 my $varName = $4; |
283 my $typeField = lcfirst($typeName); | |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
284 if ($structType && ($structType =~ /const/)) { |
598 | 285 $typeName = "$structType $typeName"; |
286 } | |
466
831b7f6fd687
Fix warning pointer type
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
464
diff
changeset
|
287 push(@{$code{$name}->{$method}},"$typeName$ptrType $varName"); |
385 | 288 } elsif ($args =~ s/(.*,)//) { |
289 } else { | |
290 last; | |
291 } | |
292 } | |
293 } | |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
294 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
295 my $codeGearName = $1; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
296 my $args = $2; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
297 my $inputCount = 0; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
298 my $outputCount = 0; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
299 my $inputIncFlag = 1; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
300 while($args) { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
301 if ($args =~ s/(^\s*,\s*)//) { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
302 } |
404
c5cd9888bf2a
Fix bitonicSort
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
403
diff
changeset
|
303 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\((.*?)\)//) { |
527
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
304 $codeGear{$codeGearName}->{"code"}->{$2} = "\_\_code"; |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
305 $inputIncFlag = 0; |
527
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
306 my @outputs = split(/,/,$3); |
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
307 for my $output (@outputs) { |
598 | 308 if ($output =~ /\s*(struct|union|const)?\s*(\w+)(\*)?+\s(\w+)/) { |
309 my $structType = $1; | |
527
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
310 my $type = $2; |
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
311 my $varName = $4; |
598 | 312 if ($structType =~ /const/) { |
313 $type = "$structType $type"; | |
314 } | |
527
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
315 $codeGear{$codeGearName}->{"var"}->{$varName} = "$type $outputCount"; |
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
316 $outputCount++; |
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
317 } |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
318 } |
598 | 319 } elsif ($args =~ s/^(struct|union|const)?\s*(\w+)(\*)?+\s(\w+)// && $inputIncFlag) { |
320 my $structType = $1; | |
527
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
321 my $type = $2; |
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
322 my $varName = $4; |
598 | 323 if ($structType =~ /const/) { |
324 $type = "$structType $type"; | |
325 } | |
527
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
326 $codeGear{$codeGearName}->{"var"}->{$varName} = "$type $inputCount"; |
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
327 $inputCount++; |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
328 } elsif ($args =~ s/(.*,)//) { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
329 } else { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
330 last; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
331 } |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
332 } |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
333 $codeGear{$codeGearName}->{"input"} = $inputCount; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
334 $codeGear{$codeGearName}->{"output"} = $outputCount; |
385 | 335 } |
336 } | |
337 } | |
338 | |
250 | 339 sub generateStub { |
251 | 340 my($fd,$prevCodeGearName,$dataGearName) = @_; |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
341 print $fd "__code ", $prevCodeGearName ,"_stub(struct Context* $context_name) {\n"; |
251 | 342 print $fd $dataGearName; |
250 | 343 print $fd "\n} \n\n"; |
251 | 344 return 1; |
250 | 345 } |
346 | |
253 | 347 sub generateStubArgs { |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
348 my($codeGearName, $varName, $typeName, $ptrType, $typeField, $implInterfaceInfo,$output) = @_; |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
349 |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
350 my $isImpl = $implInterfaceInfo->{isImpl}; |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
351 my $interfaceName = $implInterfaceInfo->{interface}; |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
352 my $implName = $implInterfaceInfo->{implementation}; |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
353 |
672 | 354 my $varname1 = $output ? "O_$varName" : $varName; |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
355 for my $n ( @{$dataGearVar{$codeGearName}} ) { |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
356 # we already have it |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
357 return 0 if ( $n eq $varname1); |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
358 } |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
359 push @{$dataGearVar{$codeGearName}}, $varname1; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
360 push @{$dataGearVarType{$codeGearName}}, $typeName; |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
361 if ($isImpl){ |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
362 if ($implName eq $typeName) { |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
363 # get implementation |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
364 $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl($context_name, $interfaceName, $varName);\n"; |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
365 return 1; |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
366 } |
655
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
367 } |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
368 |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
369 |
655
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
370 # interface var |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
371 if ($isImpl) { |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
372 for my $ivar (keys %{$var{$interfaceName}}) { |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
373 # input data gear field |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
374 if ($varName eq $ivar) { |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
375 if ($typeName eq $var{$interfaceName}->{$ivar}) { |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
376 if ($output) { |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
377 $dataGearName{$codeGearName} .= "\t$typeName$ptrType* O_$varName = &Gearef($context_name, $interfaceName)->$varName;\n"; |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
378 $outputVar{$codeGearName} .= "\t$typeName$ptrType $varName __attribute__((unused)) = *O_$varName;\n"; |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
379 return 1; |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
380 } |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
381 $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = Gearef($context_name, $interfaceName)->$varName;\n"; |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
382 return 1; |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
383 } |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
384 } |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
385 } |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
386 |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
387 # interface continuation |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
388 for my $cName (keys %{$code{$interfaceName}}) { |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
389 if ($varName eq $cName) { |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
390 # continuation field |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
391 $dataGearName{$codeGearName} .= "\tenum Code $varName = Gearef($context_name, $interfaceName)->$varName;\n"; |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
392 return 1; |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
393 } |
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
394 } |
655
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
395 } |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
396 |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
397 # par goto var |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
398 for my $var (keys %{$codeGear{$codeGearName}->{"var"}}) { |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
399 # input data gear field |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
400 if ($varName eq $var) { |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
401 my ($type, $count) = split(/\s/, $codeGear{$codeGearName}->{"var"}->{$var}); |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
402 if ($typeName eq $type) { |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
403 if ($output) { |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
404 $dataGearName{$codeGearName} .= "\t$typeName$ptrType* O_$varName = ($typeName $ptrType*)&${context_name}->data[${context_name}\->odg + $count];\n"; |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
405 $outputVar{$codeGearName} .= "\t$typeName$ptrType $varName = *O_$varName;\n"; |
527
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
406 return 1; |
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
407 } |
655
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
408 $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = &${context_name}->data[${context_name}\->idg + $count]->$typeName;\n"; |
527
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
409 return 1; |
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
410 } |
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
411 } |
655
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
412 } |
527
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
413 |
655
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
414 # par goto continuation |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
415 for my $cName (keys %{$codeGear{$codeGearName}->{"code"}}) { |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
416 if ($varName eq $cName) { |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
417 # continuation field |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
418 $dataGearName{$codeGearName} .= "\tenum Code $varName = ${context_name}\->next;\n"; |
389 | 419 return 1; |
420 } | |
655
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
421 } |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
422 |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
423 |
655
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
424 # par goto continuation |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
425 # global or local variable case |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
426 if (($typeName eq "Code") && $isImpl) { |
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
427 $dataGearName{$codeGearName} .= "\tenum $typeName$ptrType $varName = Gearef(${context_name}, $interfaceName)->$varName;\n"; |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
428 return 1; |
253 | 429 } |
655
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
430 $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = Gearef($context_name, $typeName);\n"; |
4846c5f8ccbf
tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
653
diff
changeset
|
431 return 1; |
253 | 432 } |
433 | |
194 | 434 sub generateDataGear { |
647
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
435 my ($filename) = @_; |
249 | 436 open my $in,"<",$filename or die("can't open $filename $!"); |
254 | 437 |
438 my $fn; | |
439 if ($opt_o) { | |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
440 $fn = $opt_o; |
254 | 441 } else { |
442 my $fn1 = $filename; | |
443 $fn1 =~ s/\.cbc/.c/; | |
444 my $i = 1; | |
255 | 445 $fn = "$dir/$fn1"; |
254 | 446 while ( -f $fn) { |
255 | 447 $fn = "$dir/$fn1.$i"; |
254 | 448 $i++; |
449 } | |
250 | 450 } |
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
451 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
|
452 if (! -d $1) { |
393 | 453 make_path $1; |
259
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
454 } |
195518ab62fc
fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
255
diff
changeset
|
455 } |
249 | 456 open my $fd,">",$fn or die("can't write $fn $!"); |
254 | 457 |
249 | 458 my $prevCodeGearName; |
250 | 459 my $inTypedef = 0; |
278 | 460 my $inStub = 0; |
546 | 461 my $hasParGoto = 0; |
418 | 462 my $inMain = 0 ; |
598 | 463 my $inCode = 0 ; |
250 | 464 my %stub; |
251 | 465 my $codeGearName; |
444
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
466 my %localVarType; |
254 | 467 |
249 | 468 while (<$in>) { |
418 | 469 if (! $inTypedef && ! $inStub && ! $inMain) { |
633
8b295624ea4b
bug fix drop interface whitespace
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
631
diff
changeset
|
470 if (/^typedef struct (\w+)\s*\{/) { |
249 | 471 $inTypedef = 1; |
454 | 472 } elsif (/^int main\((.*)\) \{/) { |
418 | 473 $inMain = 1; |
468
ac244346c85d
Change used interface syntax from #include to #interface
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
467
diff
changeset
|
474 } elsif(/^#interface "(.*)"/) { |
462
8d7e5d48cad3
Running CPU examples
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
461
diff
changeset
|
475 my $interfaceHeader = $1; |
468
ac244346c85d
Change used interface syntax from #include to #interface
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
467
diff
changeset
|
476 # #interface not write |
462
8d7e5d48cad3
Running CPU examples
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
461
diff
changeset
|
477 next unless ($interfaceHeader =~ /context.h/); |
253 | 478 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { |
598 | 479 $inCode = 1; |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
480 %localVarType = (); |
251 | 481 $codeGearName = $1; |
253 | 482 my $args = $2; |
483 my $tail = $3; | |
250 | 484 if ($codeGearName =~ /_stub$/) { |
262 | 485 # don't touch already existing stub |
278 | 486 $inStub = 1; |
250 | 487 $stub{$codeGearName} = 1; |
488 print $fd $_; | |
489 next; | |
490 } | |
249 | 491 if (defined $prevCodeGearName) { |
262 | 492 # stub is generated just before next CodeGear |
250 | 493 if (defined $stub{$prevCodeGearName."_stub"}) { |
494 undef $prevCodeGearName; | |
278 | 495 } else { |
496 &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName}); | |
497 $stub{$prevCodeGearName."_stub"} = 1; | |
250 | 498 } |
249 | 499 } |
262 | 500 # analyzing CodeGear argument |
501 # these arguments are extract from current context's arugment DataGear Interface | |
502 # and passed to the CodeGear | |
503 # struct Implementaion needs special handling | |
504 # __code next(...) ---> enum Code next | |
253 | 505 $prevCodeGearName = $codeGearName; |
506 $dataGearVar{$codeGearName} = []; | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
507 $outputVar{$codeGearName} = ""; |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
508 $outputArgs{$codeGearName} = {}; |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
509 my $newArgs = "struct Context *${context_name},"; |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
510 if ($args=~/^struct Context\s*\*\s*${context_name}/) { |
305 | 511 $newArgs = ""; |
512 } | |
521
393e1d2d06f2
fix about no argument code gear of generate_stub.pl
mir3636
parents:
509
diff
changeset
|
513 if (!$args){ |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
514 $newArgs = "struct Context *${context_name}"; |
521
393e1d2d06f2
fix about no argument code gear of generate_stub.pl
mir3636
parents:
509
diff
changeset
|
515 } |
253 | 516 while($args) { |
517 if ($args =~ s/(^\s*,\s*)//) { | |
518 $newArgs .= $1; | |
519 } | |
262 | 520 # continuation case |
280 | 521 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) { |
522 my $next = $2; | |
523 my @args = split(/,/,$3); | |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
524 if (generateStubArgs($codeGearName, $next, "Code", "", $next, $implInterfaceInfo,0) ) { |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
525 $newArgs .= "enum Code $next"; |
258 | 526 } |
262 | 527 # analyze continuation arguments |
528 # output arguments are defined in the Interface take the pointer of these | |
529 # output arguments are put into the Interface DataGear just before the goto | |
253 | 530 for my $arg (@args) { |
531 $arg =~ s/^\s*//; | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
532 last if ($arg =~ /\.\.\./); |
625 | 533 $arg =~ s/^(struct|union|const|enum)?\s*(\w+)(\**)\s(\w+)//; |
253 | 534 my $structType = $1; |
535 my $typeName = $2; | |
466
831b7f6fd687
Fix warning pointer type
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
464
diff
changeset
|
536 my $ptrType = $3; |
253 | 537 my $varName = $4; |
625 | 538 if ($structType =~ /(const|enum)/) { |
598 | 539 $typeName = "$structType $typeName"; |
540 } | |
253 | 541 my $typeField = lcfirst($typeName); |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
542 push(@{$outputArgs{$codeGearName}->{$next}}, $varName); |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
543 if (generateStubArgs($codeGearName, $varName, $typeName, $ptrType, $typeField, $implInterfaceInfo,1)) { |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
544 $newArgs .= ",$structType $typeName **O_$varName"; |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
545 } |
253 | 546 } |
625 | 547 } elsif ($args =~ s/^(struct|union|const|enum)?\s*(\w+)(\**)\s(\w+)//) { |
253 | 548 my $structType = $1; |
549 my $typeName = $2; | |
466
831b7f6fd687
Fix warning pointer type
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
464
diff
changeset
|
550 my $ptrType = $3; |
253 | 551 my $varName = $4; |
598 | 552 $newArgs .= $&; # assuming no duplicate |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
553 if ($structType && ($structType =~ /(const|enum)/)) { |
598 | 554 $typeName = "$structType $typeName"; |
555 } | |
253 | 556 my $typeField = lcfirst($typeName); |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
557 generateStubArgs($codeGearName, $varName, $typeName, $ptrType, $typeField, $implInterfaceInfo,0); |
255 | 558 } elsif ($args =~ s/(.*,)//) { |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
559 $newArgs .= $1; |
255 | 560 } else { |
561 $newArgs .= $args; | |
562 last; | |
253 | 563 } |
564 } | |
262 | 565 # generate goto statement from stub to the CodeGear in the buffer |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
566 $dataGearName{$codeGearName} .= "\tgoto $codeGearName(${context_name}"; |
253 | 567 for my $arg ( @{$dataGearVar{$codeGearName}}) { |
568 $dataGearName{$codeGearName} .= ", $arg"; | |
569 } | |
570 $dataGearName{$codeGearName} .= ");"; | |
262 | 571 # generate CodeGear header with new arguments |
253 | 572 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
|
573 if ($outputVar{$codeGearName} ne "") { |
324 | 574 # output data var can be use before write |
575 # it should be initialze by gearef | |
260
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
576 print $fd $outputVar{$codeGearName}; |
6b5444bbea8a
generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
259
diff
changeset
|
577 } |
250 | 578 next; |
598 | 579 } elsif (! $inCode) { |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
580 s/new\s+(\w+)\(\)/\&ALLOCATE(${context_name}, $1)->$1/g; # replacing new |
598 | 581 print $fd $_; |
582 next; | |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
583 } elsif (/^(.*)goto (\w+)\-\>(\w+)\((.*)\);/) { |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
584 # handling goto statement |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
585 # convert it to the meta call form with two arugments, that is context and enum Code |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
586 my $prev = $1; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
587 my $next = $2; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
588 my $method = $3; |
529
e5e3025f503a
Generate twice stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
528
diff
changeset
|
589 my $tmpArgs = $4; |
548 | 590 #$tmpArgs =~ s/\(.*\)/\(\)/; |
529
e5e3025f503a
Generate twice stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
528
diff
changeset
|
591 my @args = split(/,/,$tmpArgs); |
598 | 592 if (! defined $dataGearVarType{$codeGearName}) { |
593 print $fd $_ ; | |
594 next ; | |
595 } | |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
596 my @types = @{$dataGearVarType{$codeGearName}}; |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
597 my $ntype; |
415 | 598 my $ftype; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
599 for my $v (@{$dataGearVar{$codeGearName}}) { |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
600 my $t = shift @types; |
528
82ff74c2f162
Delete stub for bitonicSort
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
527
diff
changeset
|
601 if ($v eq $next || $v eq "O_$next") { |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
602 $ntype = $t; |
415 | 603 $ftype = lcfirst($ntype); |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
604 } |
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
605 } |
444
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
606 if (!defined $ntype) { |
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
607 $ntype = $localVarType{$next}; |
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
608 $ftype = lcfirst($ntype); |
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
609 } |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
610 print $fd "\tGearef(${context_name}, $ntype)->$ftype = (union Data*) $next;\n"; |
415 | 611 # Put interface argument |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
612 my $prot = $code{$ntype}->{$method}; |
385 | 613 my $i = 1; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
614 for my $arg (@args) { |
415 | 615 my $pType; |
616 my $pName; | |
385 | 617 my $p = @$prot[$i]; |
457
2b36a1878c6f
Refactor TaskManagerImpl
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
447
diff
changeset
|
618 next if ($p eq $arg); |
387 | 619 $p =~ s/^(.*)\s(\w+)//; |
415 | 620 $pType = $1; |
621 $pName = $2; | |
387 | 622 $arg =~ s/^(\s)*(\w+)/$2/; |
623 if ($pType =~ s/\_\_code$//) { | |
444
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
624 if ($arg =~ /(\w+)\(.*\)/) { |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
625 print $fd "\tGearef(${context_name}, $ntype)->$pName = $1;\n"; |
444
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
626 } else { |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
627 print $fd "\tGearef(${context_name}, $ntype)->$pName = C_$arg;\n"; |
444
0c024ea61601
Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
442
diff
changeset
|
628 } |
466
831b7f6fd687
Fix warning pointer type
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
464
diff
changeset
|
629 } elsif ($pType =~ /Data\**$/){ |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
630 print $fd "\tGearef(${context_name}, $ntype)->$pName = (union $pType) $arg;\n"; |
387 | 631 } else { |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
632 print $fd "\tGearef(${context_name}, $ntype)->$pName = $arg;\n"; |
387 | 633 } |
385 | 634 $i++; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
635 } |
641
b486bf9d1280
update generate_*.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
633
diff
changeset
|
636 print $fd "${prev}${context_name}->before = C_$codeGearName;\n"; |
b486bf9d1280
update generate_*.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
633
diff
changeset
|
637 print $fd "${prev}goto meta(${context_name}, $next->$method);\n"; |
384
ee5d2b1685d7
Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
383
diff
changeset
|
638 next; |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
639 } elsif(/^(.*)par goto (\w+)\((.*)\);/) { |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
640 # handling par goto statement |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
641 # convert it to the parallel |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
642 my $prev = $1; |
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
643 my $codeGearName = $2; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
644 my $args = $3; |
401
408b4aab7610
Supported par goto iterate statement for perl script
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
400
diff
changeset
|
645 my $inputCount = $codeGear{$codeGearName}->{'input'}; |
408b4aab7610
Supported par goto iterate statement for perl script
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
400
diff
changeset
|
646 my $outputCount = $codeGear{$codeGearName}->{'output'}; |
403
83c9aeb1fe3e
Generate MultiDimIterator by perl script
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
402
diff
changeset
|
647 my @iterateCounts; |
401
408b4aab7610
Supported par goto iterate statement for perl script
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
400
diff
changeset
|
648 # parse examples 'par goto(.., iterate(10), exit);' |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
649 if ($args =~ /iterate\((.*)?\),/) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
650 @iterateCounts = split(/,/,$1);; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
651 $inputCount--; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
652 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
653 # replace iterate keyword |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
654 $args =~ s/iterate\((.*)?\),//; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
655 my @dataGears = split(/,\s*/, $args); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
656 my $nextCodeGear = pop(@dataGears); |
546 | 657 if (! $hasParGoto) { |
658 $hasParGoto = 1; | |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
659 print $fd "${prev}struct Element* element;\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
660 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
661 my $initTask = << "EOFEOF"; |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
662 ${prev}${context_name}\->task = NEW(struct Context); |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
663 ${prev}initContext(${context_name}\->task); |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
664 ${prev}${context_name}\->task->next = C_$codeGearName; |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
665 ${prev}${context_name}\->task->idgCount = $inputCount; |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
666 ${prev}${context_name}\->task->idg = ${context_name}\->task->dataNum; |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
667 ${prev}${context_name}\->task->maxIdg = ${context_name}\->task->idg + $inputCount; |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
668 ${prev}${context_name}\->task->odg = ${context_name}\->task->maxIdg; |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
669 ${prev}${context_name}\->task->maxOdg = ${context_name}\->task->odg + $outputCount; |
396
bba401f93dcd
Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
393
diff
changeset
|
670 EOFEOF |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
671 print $fd $initTask; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
672 if (@iterateCounts) { |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
673 print $fd "${prev}${context_name}\->task->iterate = 0;\n"; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
674 my $len = @iterateCounts; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
675 if ($len == 1) { |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
676 print $fd "${prev}${context_name}\->task->iterator = createMultiDimIterator(${context_name}, $iterateCounts[0], 1, 1);\n"; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
677 } elsif ($len == 2) { |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
678 print $fd "${prev}${context_name}\->task->iterator = createMultiDimIterator(${context_name}, $iterateCounts[0], $iterateCounts[1], 1);\n"; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
679 } elsif ($len == 3) { |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
680 print $fd "${prev}${context_name}\->task->iterator = createMultiDimIterator(${context_name}, $iterateCounts[0], $iterateCounts[1], $iterateCounts[2]);\n"; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
681 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
682 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
683 for my $dataGear (@dataGears) { |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
684 print $fd "${prev}GET_META($dataGear)->wait = createSynchronizedQueue(${context_name});\n"; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
685 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
686 for my $i (0..$inputCount-1) { |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
687 print $fd "${prev}${context_name}\->task->data[${context_name}\->task->idg+$i] = (union Data*)$dataGears[$i];\n"; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
688 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
689 for my $i (0..$outputCount-1) { |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
690 print $fd "${prev}${context_name}\->task->data[${context_name}\->task->odg+$i] = (union Data*)$dataGears[$inputCount+$i];\n"; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
691 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
692 my $putTask = << "EOFEOF"; |
630
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
693 ${prev}element = &ALLOCATE(${context_name}, Element)->Element; |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
694 ${prev}element->data = (union Data*)${context_name}\->task; |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
695 ${prev}element->next = ${context_name}\->taskList; |
0baef27a18f4
common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
629
diff
changeset
|
696 ${prev}${context_name}\->taskList = element; |
398
fc4fcd441700
Fix spanwTasks
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
397
diff
changeset
|
697 EOFEOF |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
698 print $fd $putTask; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
699 next; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
700 } elsif (/^(.*)goto (\w+)\((.*)\);/) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
701 # handling goto statement |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
702 # convert it to the meta call form with two arugments, that is context and enum Code |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
703 my $prev = $1; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
704 my $next = $2; |
527
929aa06a12f9
Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
521
diff
changeset
|
705 my @args = split(/,/, $3); |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
706 my $v = 0; |
647
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
707 my $arg_context = $context_name; |
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
708 if ($prev =~ /kernel/) { |
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
709 $prev = ""; |
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
710 $arg_context = "kernel"; |
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
711 } |
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
712 |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
713 for my $n ( @{$dataGearVar{$codeGearName}} ) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
714 # continuation arguments |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
715 $v = 1 if ( $n eq $next); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
716 } |
677
47910f7c731e
remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
676
diff
changeset
|
717 if ($v || ($implInterfaceInfo->{isImpl} && defined $code{$implInterfaceInfo->{interface}}->{$next})) { |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
718 # write continuation's arguments into the interface arguments |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
719 # we may need a commit for a shared DataGear |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
720 for my $arg ( @{$outputArgs{$codeGearName}->{$next}} ) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
721 my $v = shift(@args); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
722 print $fd "\t*O_$arg = $v;\n"; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
723 } |
546 | 724 if ($hasParGoto) { |
647
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
725 print $fd "${prev}Gearef(${arg_context}, TaskManager)->taskList = ${arg_context}->taskList;\n"; |
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
726 print $fd "${prev}Gearef(${arg_context}, TaskManager)->next1 = C_$next;\n"; |
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
727 print $fd "${prev}goto meta(${arg_context}, C_$next);\n"; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
728 } else { |
647
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
729 print $fd "${prev}${arg_context}->before = C_$codeGearName;\n"; |
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
730 print $fd "${prev}goto meta(${arg_context}, $next);\n"; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
731 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
732 next; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
733 } |
546 | 734 if ($hasParGoto) { |
647
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
735 print $fd "${prev}Gearef(${arg_context}, TaskManager)->taskList = ${arg_context}\->taskList;\n"; |
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
736 print $fd "${prev}Gearef(${arg_context}, TaskManager)->next1 = C_$next;\n"; |
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
737 print $fd "${prev}goto parGotoMeta(${arg_context}, C_$next);\n"; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
738 next; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
739 } elsif ($next eq "meta") { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
740 print $fd $_; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
741 next; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
742 } else { |
647
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
743 print $fd "${prev}${arg_context}\->before = C_$codeGearName;\n"; |
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
744 print $fd "${prev}goto meta(${arg_context}, C_$next);\n"; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
745 next; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
746 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
747 } elsif(/^.*(struct|union)?\s(\w+)\*\s(\w+)\s?[=;]/) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
748 my $type = $2; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
749 my $varName = $3; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
750 $localVarType{$varName} = $type; |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
751 s/new\s+(\w+)\(\)/\&ALLOCATE(${context_name}, $1)->$1/g; # replacing new |
462
8d7e5d48cad3
Running CPU examples
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
461
diff
changeset
|
752 } elsif(/^}/) { |
546 | 753 $hasParGoto = 0; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
754 } else { |
670
f8b98e469256
use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
669
diff
changeset
|
755 s/new\s+(\w+)\(\)/\&ALLOCATE(${context_name}, $1)->$1/g; # replacing new |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
756 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
757 # gather type name and type |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
758 } elsif ($inMain) { |
631
5189c60b9707
update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
630
diff
changeset
|
759 if (/^(.*)goto start_code\(main_${context_name}\);/) { |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
760 print $fd $_; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
761 next; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
762 } elsif (/^(.*)goto (\w+)\((.*)\);/) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
763 my $prev = $1; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
764 my $next = $2; |
631
5189c60b9707
update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
630
diff
changeset
|
765 print $fd "${prev}struct Context* main_${context_name} = NEW(struct Context);\n"; |
5189c60b9707
update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
630
diff
changeset
|
766 print $fd "${prev}initContext(main_${context_name});\n"; |
5189c60b9707
update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
630
diff
changeset
|
767 print $fd "${prev}main_${context_name}->next = C_$next;\n"; |
5189c60b9707
update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
630
diff
changeset
|
768 print $fd "${prev}goto start_code(main_${context_name});\n"; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
769 next; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
770 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
771 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
772 if (/^}/) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
773 $inStub = 0; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
774 $inTypedef = 0; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
775 $inMain = 0; |
598 | 776 $inCode = 0; |
461
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
777 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
778 print $fd $_; |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
779 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
780 if (defined $prevCodeGearName) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
781 if (!defined $stub{$prevCodeGearName."_stub"}) { |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
782 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName}); |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
783 } |
6b71cf5b1c22
Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents:
458
diff
changeset
|
784 } |
194 | 785 } |
786 | |
676 | 787 sub createInterfaceNameToHeaderPath { |
663 | 788 my $search_root = shift; |
789 my $files = Gears::Util->find_headers_from_path($search_root); | |
661
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
790 my $interface_name2headerpath = {}; |
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
791 |
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
792 for my $file (@{$files}) { |
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
793 if ($file =~ m|/(\w+)\.\w+$|) { |
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
794 my $file_name = $1; |
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
795 $interface_name2headerpath->{$file_name} = $file; |
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
796 } |
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
797 } |
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
798 |
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
799 return $interface_name2headerpath; |
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
800 } |
b6a3e1638f3a
Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
658
diff
changeset
|
801 |
663 | 802 sub create_cbc_name_to_source_path { |
668 | 803 # create this structure |
804 # | |
805 # { | |
806 # SemaphoreImpl.cbc [ | |
807 # [0] "/Users/anatofuz/src/firefly/hg/Gears/Gears/src/parallel_execution/SemaphoreImpl.cbc", | |
808 # [1] "/Users/anatofuz/src/firefly/hg/Gears/Gears/src/parallel_execution/examples/boundedBuffer/SemaphoreImpl.cbc" | |
809 # ], | |
810 # SingleLinkedQueue.cbc [ | |
811 # [0] "/Users/anatofuz/src/firefly/hg/Gears/Gears/src/parallel_execution/SingleLinkedQueue.cbc" | |
812 # ], | |
813 # } | |
663 | 814 my $search_root = shift; |
815 my $files = Gears::Util->find_cbc_sources_from_path($search_root); | |
647
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
816 |
663 | 817 my $cbc_name2_source_path = {}; |
818 for my $file (@{$files}) { | |
819 my $cbc_name = basename $file; | |
820 $cbc_name =~ s/\.cbc//; | |
821 push(@{$cbc_name2_source_path->{$cbc_name}},$file); | |
822 } | |
823 return $cbc_name2_source_path; | |
824 } | |
647
dac9cc4dd52d
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
646
diff
changeset
|
825 |
676 | 826 sub createSearchCbCFileFromCodeGearNameAndFilename { |
668 | 827 my $search_root = shift; |
828 my $cbc_name2_source_path = create_cbc_name_to_source_path($search_root); | |
829 | |
830 # return sub is create clojure | |
831 return sub { | |
832 my ($codeGearName, $filename) = @_; | |
672 | 833 my $cbc_files = $cbc_name2_source_path->{$codeGearName} // []; |
668 | 834 |
672 | 835 if (scalar(@{$cbc_files}) == 0) { # Not Found |
668 | 836 return 0; #false case |
837 } | |
838 | |
672 | 839 if (scalar(@{$cbc_files}) == 1) { # this case $codeGearName.cbc is single (SingleLinkedQueue.cbc) |
840 return $cbc_files->[0]; # return "/Users/anatofuz/src/firefly/hg/Gears/Gears/src/parallel_execution/SingleLinkedQueue.cbc" | |
668 | 841 } |
842 | |
843 | |
669
e8800c60811a
fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
668
diff
changeset
|
844 my $cbc_dir_name = dirname $filename; |
e8800c60811a
fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
668
diff
changeset
|
845 |
672 | 846 for my $cbc_file (@{$cbc_files}) { |
669
e8800c60811a
fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
668
diff
changeset
|
847 if ($cbc_file =~ /$cbc_dir_name/) { |
e8800c60811a
fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
668
diff
changeset
|
848 return $cbc_file; |
e8800c60811a
fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
668
diff
changeset
|
849 } |
e8800c60811a
fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
668
diff
changeset
|
850 } |
e8800c60811a
fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
668
diff
changeset
|
851 |
e8800c60811a
fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
668
diff
changeset
|
852 return 0; # Not found |
668 | 853 } |
854 } |