Mercurial > hg > Gears > Gears

annotate src/parallel_execution/generate_stub.pl @ 718:7c79694229d3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
check impl interface CodeGear
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Tue, 01 Sep 2020 20:32:46 +0900
parents 284fa7d7326e
children 2316193f7999
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;
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/;
661
b6a3e1638f3a Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 658
diff changeset
8
658
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 655
diff changeset
9 use FindBin;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 655
diff changeset
10 use lib "$FindBin::Bin/lib";
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 655
diff changeset
11
693
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
12 use Gears::Interface;
661
b6a3e1638f3a Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 658
diff changeset
13 use Gears::Util;
716
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
14 use Gears::Stub;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
15
482
5859bed4edff Refactoring spawnTasks method
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 468
diff changeset
16 # interface.h
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
17 # typedef struct Worker {
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
18 # int id;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
19 # struct Context* contexts;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
20 # enum Code execute;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
21 # enum Code taskSend;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
22 # enum Code taskRecive;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
23 # enum Code shutdown;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
24 # struct Queue* tasks;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
25 # } Worker;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
26
630
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
27 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
28
629
90309637c4c8 Getopt::Std to Getopt::Long
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 625
diff changeset
29 GetOptions(
631
5189c60b9707 update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 630
diff changeset
30 "o=s" => \$opt_o,
5189c60b9707 update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 630
diff changeset
31 "d=s" => \$opt_d,
5189c60b9707 update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 630
diff changeset
32 "h" => \$opt_h,
5189c60b9707 update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 630
diff changeset
33 "project=s" => \$opt_project,
629
90309637c4c8 Getopt::Std to Getopt::Long
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 625
diff changeset
34 );
255
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
35
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
36 my $dir = ".";
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
37 if ($opt_d) {
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
38 $dir = $opt_d;
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
39 if (! -d $dir) {
393
99c50356d917 fix generate_stub.pl
mir3636
parents: 391
diff changeset
40 make_path $dir;
255
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
41 }
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
42 }
254
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
43
630
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
44
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 my %projects = (
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
47 gears => { cotnext => "context" },
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
48 xv6 => { context => "cbc_context" },
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
49 );
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 my $context_name = "context";
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
53 if ($opt_project && exists $projects{$opt_project}) {
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
54 $context_name = $projects{$opt_project}->{context};
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
55 }
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
56
677
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
57
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
58
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
59 my %var;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
60 my %code;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
61 my %dataGearVar;
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
62 my %outputVar; # output var initializer
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
63 my %outputArgs; # continuation's output variables
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
64 my %dataGear;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
65 my %dataGearName;
384
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
66 my %generic;
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
67 my %dataGearVarType;
396
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
68 my %codeGear;
661
b6a3e1638f3a Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 658
diff changeset
69 my %call_interfaces;
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
70 my $headerNameToInfo = createHeaderNameToInfo($FindBin::Bin);
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
71 my $searchCbCFromCodeGearNameWCurrentFrileName = createSearchCbCFromCodeGearNameWCurrentFrileName($FindBin::Bin);
676
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 675
diff changeset
72 my %filename2EachCodeGearArgs;
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
73 my %stub;
668
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
74
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
75 my $implInterfaceInfo = {isImpl => undef, implementation => undef, interface => undef, parsedInterfaceInfo => undef, genConstructor => undef};
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
76 my $generateHaveOutputStub = { counter => undef, list => undef };
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
77 my $replaceCodeGearNames = {};
665
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 663
diff changeset
78
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 663
diff changeset
79
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 663
diff changeset
80 # this for statement is main routine
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 663
diff changeset
81 for my $fn (@ARGV) {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 663
diff changeset
82 next if ($fn !~ /\.cbc$/);
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 663
diff changeset
83 getDataGear($fn);
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 663
diff changeset
84 generateDataGear($fn);
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 663
diff changeset
85 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 663
diff changeset
86
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
87
384
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
88 # interface definision
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
89 #
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
90 # typedef struct Stack<Type, Impl>{
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
91 # Type* stack;
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
92 # Type* data;
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
93 # Type* data1;
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
94 # __code whenEmpty(...);
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
95 # __code clear(Impl* stack,__code next(...));
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
96 # __code push(Impl* stack,Type* data, __code next(...));
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
97 # __code pop(Impl* stack, __code next(Type*, ...));
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
98 # __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
99 # __code isEmpty(Impl* stack, __code next(...), __code whenEmpty(...));
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
100 # __code get(Impl* stack, Type** data, __code next(...));
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
101 # __code get2(Impl* stack,..., __code next(...));
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
102 # __code next(...);
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
103 # } Stack;
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 # calling example
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 # goto nodeStack->push((union Data*)node, stackTest3);
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
108 #
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
109 # generated meta level code
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
110 #
442
481fce540daf Fix goto implement method of generate_stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 424
diff changeset
111 # Gearef(context, Stack)->stack = (union Data*)nodeStack;
384
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
112 # Gearef(context, Stack)->data = (union Data*)node;
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
113 # Gearef(context, Stack)->next = C_stackTest3;
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
114 # goto meta(context, nodeStack->push);
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
115
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
116 sub getDataGear {
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
117 my ($filename) = @_;
647
dac9cc4dd52d bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 646
diff changeset
118
679
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
119 my ($codeGearName, $name, $inTypedef,$described_data_gear, $currentCodeGear, $codeGearInfo);
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
120 open my $fd,"<",$filename or die("can't open $filename $!");
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
121 while (<$fd>) {
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
122 if (! $inTypedef) {
675
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 672
diff changeset
123 #this scope is usually parsing cbc file
384
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
124 if (/^typedef struct (\w+)\s*<(.*)>/) {
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
125 $inTypedef = 1;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
126 $name = $1;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
127 $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
128 $var{$name} = {};
195518ab62fc fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
129 $code{$name} = {};
384
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
130 $generic{$name} = \split(/,/,$2);
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
131 } elsif (/^typedef struct (\w+)/) {
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
132 $inTypedef = 1;
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
133 $name = $1;
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
134 $dataGear{$name} = $_;
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
135 $var{$name} = {};
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
136 $code{$name} = {};
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
137 $generic{$name} = [];
677
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
138 } elsif (/^(\w+)(\*)+ create(\w+)\(/) { # this case implementation constructor
715
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
139 #if (defined $implInterfaceInfo->{interface} ) {
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
140 # die "duplicate interface $implInterfaceInfo->{interface}\n";
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
141 # }
677
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
142 my $interfaceName = $1;
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
143 $implInterfaceInfo->{isImpl} = 1;
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
144 $implInterfaceInfo->{interface} = $interfaceName;
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
145 $implInterfaceInfo->{implementation} = $3;
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
146 my $cbc_source_path = $searchCbCFromCodeGearNameWCurrentFrileName->($interfaceName, $filename);
677
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
147 if ($cbc_source_path) {
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
148 # Probably not executed
677
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
149 &getDataGear($cbc_source_path);
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
150 }
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
151 $implInterfaceInfo->{genConstructor} = 0;
396
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
152 } elsif(/^(.*)par goto (\w+)\((.*)\)/) {
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
153 my $codeGearName = $2;
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
154 my $cbc_source_path = $searchCbCFromCodeGearNameWCurrentFrileName->($codeGearName, $filename);
675
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 672
diff changeset
155 if ($cbc_source_path) {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 672
diff changeset
156 &getCodeGear($cbc_source_path);
396
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
157 }
595
00429c9e0a45 bump PerlSciripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 548
diff changeset
158 } 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
159 # use interface
461
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
160 my $interfaceHeader = $1;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
161 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
162 $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
163 my $interfaceName = $1;
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
164 includeInterface(\%call_interfaces, $filename, $interfaceName, $headerNameToInfo);
716
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
165 # #impl "Stack.h" for "SingleLinkedStack.h"
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
166 } elsif(/^#impl "(.*?)"(?:\s+for\s+"(.*)")?/) {
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
167 # use interface
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
168 my $interfaceHeader = $1;
716
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
169 my $implName = $2;
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
170
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
171 $interfaceHeader =~ m|(\w+)\.\w+$|; #remove filename extention
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
172 my $interfaceName = $1;
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
173 includeInterface(\%call_interfaces, $filename, $interfaceName, $headerNameToInfo);
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
174 my $interfacePATH = $headerNameToInfo->{$interfaceName}->{path};
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
175
716
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
176 unless ($implName) {
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
177 $implName = basename $filename;
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
178 }
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
179 $implName =~ s/(\w+)\.\w+$/$1/;
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
180
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
181 $implInterfaceInfo->{isImpl} = 1;
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
182 $implInterfaceInfo->{interface} = $interfaceName;
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
183 $implInterfaceInfo->{implementation} = $implName;
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
184 $implInterfaceInfo->{genConstructor} = 1;
716
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
185 $implInterfaceInfo->{parsedInterfaceInfo} = Gears::Interface->detailed_parse($interfacePATH);
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
186
527
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
187 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) {
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
188 my $codeGearName = $1;
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
189 my $args = $2;
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
190
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
191 if ($codeGearName =~ /_stub$/) {
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
192 $stub{$codeGearName}->{static} = 1;
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
193 $stub{$codeGearName}->{wrote} = 1;
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
194 $currentCodeGear = undef;
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
195 next;
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
196 }
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
197
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
198 if ($implInterfaceInfo->{parsedInterfaceInfo}) {
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
199 if (exists_codegear_in_interface({codeGearName => $codeGearName, parsedInfo => $implInterfaceInfo->{parsedInterfaceInfo}})) {
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
200 my $replaceCodeGear = "${codeGearName}$implInterfaceInfo->{implementation}"; #${pop}SingleLinkedStack
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
201 $replaceCodeGearNames->{$codeGearName} = $replaceCodeGear;
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
202 $codeGearName = $replaceCodeGear;
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
203 }
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
204 }
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
205
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
206 my $cbc_source_path = $searchCbCFromCodeGearNameWCurrentFrileName->($codeGearName, $filename);
675
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 672
diff changeset
207 if ($cbc_source_path) {
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
208 &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
209 }
700
8416928992fc impl collect_codegears_from_all_cbc_sources
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 699
diff changeset
210 my $vname2type = Gears::Util->parseCodeGearDeclarationArg($args);
679
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
211 for my $vname (keys %$vname2type) {
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
212 $codeGearInfo->{$codeGearName}->{arg}->{$vname} = $vname2type->{$vname};
675
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 672
diff changeset
213 }
677
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
214 $currentCodeGear = $codeGearName;
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
215 } elsif ((/^\s*(union|struct|const|enum)?\s*(\w+)(\*)\s+(\w+)\s+=/) && $currentCodeGear) { # collect local variables
679
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
216 my $structType = $1;
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
217 my $interfaceName = $2;
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
218 my $instance = $4;
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
219 $codeGearInfo->{$currentCodeGear}->{localVar}->{$instance} = $interfaceName;
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
220 } elsif (/^(.*)goto (\w+)\-\>(\w+)\((.*)\);/) {
675
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 672
diff changeset
221 # handling goto statement
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
222 # determine the interface you are using, and in the case of a goto CodeGear with output, create a special stub flag
675
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 672
diff changeset
223 my $prev = $1;
679
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
224 my $instance = $2;
675
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 672
diff changeset
225 my $method = $3;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 672
diff changeset
226 my $tmpArgs = $4;
679
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
227 my $typeName = $codeGearInfo->{$currentCodeGear}->{arg}->{$instance};
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
228 unless ($typeName) {
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
229 #this case is not __code arguments.
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
230 for my $localVar (keys %{$codeGearInfo->{$currentCodeGear}->{localVar}}) {
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
231 if ($localVar eq $instance) {
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
232 $typeName = $codeGearInfo->{$currentCodeGear}->{localVar}->{$localVar};
681
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 680
diff changeset
233 last;
679
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
234 }
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
235 }
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
236 unless ($typeName){
693
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
237 die "[ERROR] not found $instance type $.: $_\n";
679
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
238 }
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
239 }
704
d05e327cbc50 removed trailing space in stub codegear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 700
diff changeset
240 unless (exists $call_interfaces{$filename}->{$typeName}) {
705
cf82fc3512dd fix collect local variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 704
diff changeset
241 warn "[AUTOINCLUDE] Forget #interface '$typeName' declaration in $filename";
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
242 includeInterface(\%call_interfaces, $filename, $typeName, $headerNameToInfo);
704
d05e327cbc50 removed trailing space in stub codegear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 700
diff changeset
243 }
d05e327cbc50 removed trailing space in stub codegear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 700
diff changeset
244
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
245
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
246 if ($implInterfaceInfo->{parsedInterfaceInfo}) {
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
247 if (exists_codegear_in_interface({codeGearName => $tmpArgs, parsedInfo => $implInterfaceInfo->{parsedInterfaceInfo}})) {
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
248 my $replaceCodeGear = "${tmpArgs}$implInterfaceInfo->{implementation}"; #${pop}SingleLinkedStack
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
249 $tmpArgs = $replaceCodeGear;
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
250 }
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
251 }
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
252
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
253 my $nextOutPutArgs = findExistsOutputDataGear($typeName, $method);
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
254 my $outputStubElem = { modifyEnumCode => $currentCodeGear, createStubName => $tmpArgs };
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
255
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
256 if ($nextOutPutArgs) {
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
257 my $tmpArgHash = {};
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
258 map { $tmpArgHash->{$_} = $typeName } @$nextOutPutArgs;
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
259
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
260 $outputStubElem->{args} = $tmpArgHash;
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
261
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
262 #We're assuming that $tmpArgs only contains the name of the next CodeGear.
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
263 #Eventually we need to parse the contents of the argument. (eg. @parsedArgs)
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
264 my @parsedArgs = split /,/ , $tmpArgs; #
704
d05e327cbc50 removed trailing space in stub codegear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 700
diff changeset
265 if (scalar(@parsedArgs) != 1) {
d05e327cbc50 removed trailing space in stub codegear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 700
diff changeset
266 warn '[WARN] TBD';
d05e327cbc50 removed trailing space in stub codegear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 700
diff changeset
267 }
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
268
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
269 $generateHaveOutputStub->{counter}->{$tmpArgs}++;
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
270 $outputStubElem->{counter} = $generateHaveOutputStub->{counter}->{$tmpArgs};
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
271 $generateHaveOutputStub->{list}->{$currentCodeGear} = $outputStubElem;
697
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
272 }
679
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
273 } elsif (/^}$/) {
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
274 $currentCodeGear = undef;
226
68c03e7057d9 get arg
mir3636
parents: 201
diff changeset
275 }
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
276 next;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
277 }
661
b6a3e1638f3a Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 658
diff changeset
278
b6a3e1638f3a Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 658
diff changeset
279 #this scope does parsing of header files
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
280 # gather type name and type
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
281 $dataGear{$name} .= $_;
385
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
282 if (/^\s*(.*)\s+(\w+);$/ ) {
280
2c2e4e597eb0 generate no compile errors
mir3636
parents: 278
diff changeset
283 my $ttype = $1;
2c2e4e597eb0 generate no compile errors
mir3636
parents: 278
diff changeset
284 my $tname = $2;
670
f8b98e469256 use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 669
diff changeset
285 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
286 my $structType = $1;
f8b98e469256 use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 669
diff changeset
287 my $vname = $2;
f8b98e469256 use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 669
diff changeset
288 if ($structType ne 'const') {
f8b98e469256 use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 669
diff changeset
289 $ttype = $vname;
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
290 } else {
670
f8b98e469256 use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 669
diff changeset
291 if ($structType =~ /(const|enum)/) {
f8b98e469256 use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 669
diff changeset
292 $ttype = "$structType $vname";
625
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 617
diff changeset
293 }
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
294 }
280
2c2e4e597eb0 generate no compile errors
mir3636
parents: 278
diff changeset
295 }
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
296 $described_data_gear = 1;
280
2c2e4e597eb0 generate no compile errors
mir3636
parents: 278
diff changeset
297 $var{$name}->{$tname} = $ttype;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
298 }
595
00429c9e0a45 bump PerlSciripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 548
diff changeset
299 if (/__code (\w+)/) {
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
300 next if $described_data_gear;
595
00429c9e0a45 bump PerlSciripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 548
diff changeset
301 my $args = $';
700
8416928992fc impl collect_codegears_from_all_cbc_sources
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 699
diff changeset
302 my $tname2type = Gears::Util->parseCodeGearDeclarationArg($args);
675
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 672
diff changeset
303 for my $tname (keys %$tname2type) {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 672
diff changeset
304 $var{$name}->{$tname} = $tname2type->{$tname};
595
00429c9e0a45 bump PerlSciripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 548
diff changeset
305 }
00429c9e0a45 bump PerlSciripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 548
diff changeset
306 }
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
307 if (/^}/) {
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
308 $inTypedef = 0;
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
309 }
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
310 }
461
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
311
718
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
312
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
313 if ($implInterfaceInfo->{isImpl}) {
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
314 for my $shouldImplCode (map { $_->{name} } @{$implInterfaceInfo->{parsedInterfaceInfo}->{codes}}) {
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
315 my $isDefine = $shouldImplCode;
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
316 for my $implCode (keys %{$codeGearInfo}) {
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
317 if ($implCode =~ /$shouldImplCode/) {
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
318 $isDefine = 1;
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
319 next;
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
320 }
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
321 }
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
322
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
323 if ($isDefine ne 1) {
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
324 die "[ERROR] Not define $isDefine at $filename\n";
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
325 }
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
326 }
7c79694229d3 check impl interface CodeGear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 716
diff changeset
327 }
679
c65f8f00ba6f analyze the interface when goto using the interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 677
diff changeset
328 $filename2EachCodeGearArgs{$filename} = $codeGearInfo;
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
329 }
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
330
705
cf82fc3512dd fix collect local variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 704
diff changeset
331 sub includeInterface {
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
332 my ($call_interfaces, $filename, $interfaceName, $headerNameToInfo) = @_;
705
cf82fc3512dd fix collect local variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 704
diff changeset
333 $call_interfaces->{$filename}->{$interfaceName} = 1;
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
334 my $interface_path = $headerNameToInfo->{$interfaceName}->{path};
705
cf82fc3512dd fix collect local variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 704
diff changeset
335 if ($interface_path) {
cf82fc3512dd fix collect local variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 704
diff changeset
336 getDataGear($interface_path);
cf82fc3512dd fix collect local variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 704
diff changeset
337 getCodeGear($interface_path);
cf82fc3512dd fix collect local variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 704
diff changeset
338 }
cf82fc3512dd fix collect local variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 704
diff changeset
339 }
cf82fc3512dd fix collect local variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 704
diff changeset
340
675
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 672
diff changeset
341
385
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
342 sub getCodeGear {
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
343 my ($filename) = @_;
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
344 open my $fd,"<",$filename or die("can't open $filename $!");
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
345 my ($name,$impln);
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
346 while (<$fd>) {
633
8b295624ea4b bug fix drop interface whitespace
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 631
diff changeset
347 if (/^(\w+)\s*(\*)+ create(\w+)\(/) {
385
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
348 $name = $1;
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
349 $impln = $3;
633
8b295624ea4b bug fix drop interface whitespace
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 631
diff changeset
350 } 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
351 $name = $1;
385
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
352 }
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
353 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
354 if (/^\s*\_\_code (\w+)\((.*)\);/) {
385
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
355 my $args = $2;
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
356 my $method = $1;
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
357 $code{$name}->{$method} = [];
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
358 while($args) {
461
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
359 # replace comma
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
360 $args =~ s/(^\s*,\s*)//;
385
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
361 # continuation case
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
362 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) {
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
363 my $next = $2;
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
364 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
365 push(@{$code{$name}->{$method}},"\_\_code $next");
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
366 } elsif ($args =~ s/^(struct|union|const)?\s*(\w+)(\**)\s+(\w+)//) {
385
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
367 my $structType = $1;
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
368 my $typeName = $2;
466
831b7f6fd687 Fix warning pointer type
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 464
diff changeset
369 my $ptrType = $3;
385
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
370 my $varName = $4;
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
371 my $typeField = lcfirst($typeName);
670
f8b98e469256 use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 669
diff changeset
372 if ($structType && ($structType =~ /const/)) {
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
373 $typeName = "$structType $typeName";
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
374 }
466
831b7f6fd687 Fix warning pointer type
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 464
diff changeset
375 push(@{$code{$name}->{$method}},"$typeName$ptrType $varName");
385
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
376 } elsif ($args =~ s/(.*,)//) {
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
377 } else {
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
378 last;
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
379 }
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
380 }
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
381 }
396
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
382 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) {
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
383 my $codeGearName = $1;
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
384 my $args = $2;
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
385 my $inputCount = 0;
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
386 my $outputCount = 0;
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
387 my $inputIncFlag = 1;
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
388 while($args) {
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
389 if ($args =~ s/(^\s*,\s*)//) {
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
390 }
404
c5cd9888bf2a Fix bitonicSort
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 403
diff changeset
391 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
392 $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
393 $inputIncFlag = 0;
527
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
394 my @outputs = split(/,/,$3);
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
395 for my $output (@outputs) {
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
396 if ($output =~ /\s*(struct|union|const)?\s*(\w+)(\*)?+\s(\w+)/) {
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
397 my $structType = $1;
527
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
398 my $type = $2;
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
399 my $varName = $4;
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
400 if ($structType =~ /const/) {
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
401 $type = "$structType $type";
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
402 }
527
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
403 $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
404 $outputCount++;
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
405 }
396
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
406 }
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
407 } elsif ($args =~ s/^(struct|union|const)?\s*(\w+)(\*)?+\s(\w+)// && $inputIncFlag) {
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
408 my $structType = $1;
527
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
409 my $type = $2;
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
410 my $varName = $4;
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
411 if ($structType =~ /const/) {
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
412 $type = "$structType $type";
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
413 }
527
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
414 $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
415 $inputCount++;
396
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
416 } elsif ($args =~ s/(.*,)//) {
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
417 } else {
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
418 last;
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
419 }
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
420 }
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
421 $codeGear{$codeGearName}->{"input"} = $inputCount;
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
422 $codeGear{$codeGearName}->{"output"} = $outputCount;
385
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
423 }
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
424 }
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
425 }
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
426
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
427 sub generateStub {
251
0ab52d6e2fd9 fix sub generateStub
mir3636
parents: 250
diff changeset
428 my($fd,$prevCodeGearName,$dataGearName) = @_;
630
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
429 print $fd "__code ", $prevCodeGearName ,"_stub(struct Context* $context_name) {\n";
251
0ab52d6e2fd9 fix sub generateStub
mir3636
parents: 250
diff changeset
430 print $fd $dataGearName;
704
d05e327cbc50 removed trailing space in stub codegear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 700
diff changeset
431 print $fd "\n}\n\n";
251
0ab52d6e2fd9 fix sub generateStub
mir3636
parents: 250
diff changeset
432 return 1;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
433 }
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
434
697
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
435 sub generateImplStubArgs {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
436 my ($codeGearName, $varName, $typeName, $ptrType, $output, $interfaceName, $isImpl) = @_;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
437 return 0 unless $isImpl;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
438 for my $ivar (keys %{$var{$interfaceName}}) {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
439 # input data gear field
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
440 if ($varName eq $ivar) {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
441 if ($typeName eq $var{$interfaceName}->{$ivar}) {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
442 if ($output) {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
443 $dataGearName{$codeGearName} .= "\t$typeName$ptrType* O_$varName = &Gearef($context_name, $interfaceName)->$varName;\n";
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
444 $outputVar{$codeGearName} .= "\t$typeName$ptrType $varName __attribute__((unused)) = *O_$varName;\n";
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
445 return 1;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
446 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
447 $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = Gearef($context_name, $interfaceName)->$varName;\n";
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
448 return 1;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
449 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
450 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
451 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
452
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
453 # interface continuation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
454 for my $cName (keys %{$code{$interfaceName}}) {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
455 if ($varName eq $cName) {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
456 # continuation field
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
457 $dataGearName{$codeGearName} .= "\tenum Code $varName = Gearef($context_name, $interfaceName)->$varName;\n";
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
458 return 1;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
459 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
460 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
461 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
462
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
463 sub generateStubArgs {
677
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
464 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
465
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
466 my $isImpl = $implInterfaceInfo->{isImpl};
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
467 my $interfaceName = $implInterfaceInfo->{interface};
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
468 my $implName = $implInterfaceInfo->{implementation};
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
469
672
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 670
diff changeset
470 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
471 for my $n ( @{$dataGearVar{$codeGearName}} ) {
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
472 # we already have it
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
473 return 0 if ( $n eq $varname1);
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
474 }
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
475 push @{$dataGearVar{$codeGearName}}, $varname1;
384
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
476 push @{$dataGearVarType{$codeGearName}}, $typeName;
697
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
477
677
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
478 if ($isImpl){
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
479 if ($implName eq $typeName) {
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
480 # get implementation
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
481 $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
482 return 1;
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
483 }
655
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
484 }
670
f8b98e469256 use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 669
diff changeset
485
697
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
486 return 1 if generateImplStubArgs($codeGearName, $varName, $typeName, $ptrType, $output, $interfaceName, $isImpl);
655
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
487
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
488 # par goto var
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
489 for my $var (keys %{$codeGear{$codeGearName}->{"var"}}) {
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
490 # input data gear field
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
491 if ($varName eq $var) {
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
492 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
493 if ($typeName eq $type) {
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
494 if ($output) {
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
495 $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
496 $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
497 return 1;
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
498 }
655
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
499 $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
500 return 1;
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
501 }
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
502 }
655
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
503 }
527
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
504
655
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
505 # par goto continuation
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
506 for my $cName (keys %{$codeGear{$codeGearName}->{"code"}}) {
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
507 if ($varName eq $cName) {
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
508 # continuation field
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
509 $dataGearName{$codeGearName} .= "\tenum Code $varName = ${context_name}\->next;\n";
389
d9a7620a1106 handle continuation in stub
masataka
parents: 388
diff changeset
510 return 1;
d9a7620a1106 handle continuation in stub
masataka
parents: 388
diff changeset
511 }
655
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
512 }
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
513
670
f8b98e469256 use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 669
diff changeset
514
655
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
515 # par goto continuation
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
516 # global or local variable case
677
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
517 if (($typeName eq "Code") && $isImpl) {
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
518 $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
519 return 1;
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
520 }
655
4846c5f8ccbf tweak generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 653
diff changeset
521 $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
522 return 1;
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
523 }
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
524
693
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
525
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
526
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
527 sub findExistsOutputDataGear {
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
528 my ($interfaceName, $method) = @_;
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
529
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
530 my $interfacePATH = $headerNameToInfo->{$interfaceName}->{path};
693
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
531 unless ($interfacePATH) {
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
532 return undef;
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
533 }
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
534
716
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
535 my $parsedInterface = Gears::Interface->detailed_parse($interfacePATH);
693
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
536
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
537 unless ($parsedInterface) {
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
538 return undef;
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
539 }
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
540
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
541 unless (exists $parsedInterface->{hasOutputArgs}->{$method}) {
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
542 return undef;
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
543 }
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
544
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
545 my $vname2types = $parsedInterface->{hasOutputArgs}->{$method};
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
546
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
547 my @outputArgs = keys %$vname2types;
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
548 return \@outputArgs;
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
549 }
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
550
aeab4866ee36 defined separate_code_and_data_gear_after_parse test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 681
diff changeset
551
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
552 sub generateDataGear {
647
dac9cc4dd52d bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 646
diff changeset
553 my ($filename) = @_;
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
554 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
555
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
556 my $fn;
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
557 if ($opt_o) {
396
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
558 $fn = $opt_o;
254
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
559 } else {
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
560 my $fn1 = $filename;
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
561 $fn1 =~ s/\.cbc/.c/;
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
562 my $i = 1;
255
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
563 $fn = "$dir/$fn1";
254
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
564 while ( -f $fn) {
255
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
565 $fn = "$dir/$fn1.$i";
254
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
566 $i++;
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
567 }
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
568 }
259
195518ab62fc fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
569 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
570 if (! -d $1) {
393
99c50356d917 fix generate_stub.pl
mir3636
parents: 391
diff changeset
571 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
572 }
195518ab62fc fix type gathering pattern match in generate_stub.pl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 255
diff changeset
573 }
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
574 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
575
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
576 my $prevCodeGearName;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
577 my $inTypedef = 0;
278
23767f714f4a fix generate_stub
mir3636
parents: 274
diff changeset
578 my $inStub = 0;
546
d8e87b3b2be0 fix goto parGotoMeta
mir3636
parents: 529
diff changeset
579 my $hasParGoto = 0;
418
a74bec89c198 generate main
mir3636
parents: 415
diff changeset
580 my $inMain = 0 ;
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
581 my $inCode = 0 ;
251
0ab52d6e2fd9 fix sub generateStub
mir3636
parents: 250
diff changeset
582 my $codeGearName;
444
0c024ea61601 Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 442
diff changeset
583 my %localVarType;
254
edb3aff688d0 fix generator CLI
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 253
diff changeset
584
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
585 while (<$in>) {
418
a74bec89c198 generate main
mir3636
parents: 415
diff changeset
586 if (! $inTypedef && ! $inStub && ! $inMain) {
633
8b295624ea4b bug fix drop interface whitespace
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 631
diff changeset
587 if (/^typedef struct (\w+)\s*\{/) {
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
588 $inTypedef = 1;
454
77de0283ac92 Debug RedBlackTree.cbc.
ryokka
parents: 447
diff changeset
589 } elsif (/^int main\((.*)\) \{/) {
418
a74bec89c198 generate main
mir3636
parents: 415
diff changeset
590 $inMain = 1;
715
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
591 } elsif(/^#impl "(.*)"/) {
716
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
592 next unless ($implInterfaceInfo->{genConstructor});
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
593
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
594 my $constructInterface = {
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
595 name => $implInterfaceInfo->{interface},
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
596 path => $headerNameToInfo->{$implInterfaceInfo->{interface}}->{path}
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
597 };
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
598
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
599 my $constructImpl = {
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
600 name => $implInterfaceInfo->{implementation},
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
601 path => $headerNameToInfo->{$implInterfaceInfo->{implementation}}->{path}
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
602 };
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
603
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
604 unless ($constructImpl->{path}) {
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
605 warn "[WARN] Not found $constructImpl->{name}.h";
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
606 }
284fa7d7326e automatic generation of constructors at stub creation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 715
diff changeset
607 print $fd Gears::Stub->generate_constructor($constructInterface, $constructImpl);
715
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
608 next;
468
ac244346c85d Change used interface syntax from #include to #interface
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 467
diff changeset
609 } elsif(/^#interface "(.*)"/) {
462
8d7e5d48cad3 Running CPU examples
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 461
diff changeset
610 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
611 # #interface not write
462
8d7e5d48cad3 Running CPU examples
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 461
diff changeset
612 next unless ($interfaceHeader =~ /context.h/);
699
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
613 } elsif (/^#include "(.*).h"$/) {
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
614 my $headerName = $1;
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
615 if ($headerName =~ m|/?context$|) {
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
616 print $fd $_;
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
617 next;
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
618 }
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
619
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
620 # This process assumes that there are no header files of the same name
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
621 my $path = $headerNameToInfo->{$headerName}->{path};
699
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
622 unless ($path) {
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
623 print $fd $_;
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
624 next;
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
625 }
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
626
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
627 print $fd '#include "' .$path . '"';
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
628 print $fd "\n";
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
629 next;
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
630
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
631 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) {
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
632 $inCode = 1;
670
f8b98e469256 use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 669
diff changeset
633 %localVarType = ();
251
0ab52d6e2fd9 fix sub generateStub
mir3636
parents: 250
diff changeset
634 $codeGearName = $1;
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
635 my $args = $2;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
636 my $tail = $3;
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
637
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
638 #replace Code Gear Name to Implemenatation
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
639 if (exists $replaceCodeGearNames->{$codeGearName}) {
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
640 $codeGearName = $replaceCodeGearNames->{$codeGearName};
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
641 }
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
642
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
643 if ($codeGearName =~ /_stub$/) {
262
2c56a9536c0d add comments
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
644 # don't touch already existing stub
278
23767f714f4a fix generate_stub
mir3636
parents: 274
diff changeset
645 $inStub = 1;
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
646 $stub{$codeGearName}->{static} = 1;
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
647 $stub{$codeGearName}->{wrote} = 1;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
648 print $fd $_;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
649 next;
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
650 }
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
651 if (defined $prevCodeGearName) {
262
2c56a9536c0d add comments
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
652 # stub is generated just before next CodeGear
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
653 if (defined $stub{$prevCodeGearName."_stub"}->{wrote}) {
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
654 undef $prevCodeGearName;
278
23767f714f4a fix generate_stub
mir3636
parents: 274
diff changeset
655 } else {
23767f714f4a fix generate_stub
mir3636
parents: 274
diff changeset
656 &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName});
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
657 $stub{$prevCodeGearName."_stub"}->{wrote} = 1;
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
658 }
249
afa1e02e4386 fix generate stub
mir3636
parents: 243
diff changeset
659 }
262
2c56a9536c0d add comments
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
660 # analyzing CodeGear argument
2c56a9536c0d add comments
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
661 # these arguments are extract from current context's arugment DataGear Interface
2c56a9536c0d add comments
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
662 # and passed to the CodeGear
2c56a9536c0d add comments
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
663 # struct Implementaion needs special handling
2c56a9536c0d add comments
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
664 # __code next(...) ---> enum Code next
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
665 $prevCodeGearName = $codeGearName;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
666 $dataGearVar{$codeGearName} = [];
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
667 $outputVar{$codeGearName} = "";
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
668 $outputArgs{$codeGearName} = {};
630
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
669 my $newArgs = "struct Context *${context_name},";
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
670 if ($args=~/^struct Context\s*\*\s*${context_name}/) {
305
ec0a5b4fba05 CUDAWorker
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 280
diff changeset
671 $newArgs = "";
ec0a5b4fba05 CUDAWorker
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 280
diff changeset
672 }
521
393e1d2d06f2 fix about no argument code gear of generate_stub.pl
mir3636
parents: 509
diff changeset
673 if (!$args){
630
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
674 $newArgs = "struct Context *${context_name}";
521
393e1d2d06f2 fix about no argument code gear of generate_stub.pl
mir3636
parents: 509
diff changeset
675 }
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
676 while($args) {
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
677 if ($args =~ s/(^\s*,\s*)//) {
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
678 $newArgs .= $1;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
679 }
262
2c56a9536c0d add comments
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
680 # continuation case
280
2c2e4e597eb0 generate no compile errors
mir3636
parents: 278
diff changeset
681 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) {
2c2e4e597eb0 generate no compile errors
mir3636
parents: 278
diff changeset
682 my $next = $2;
2c2e4e597eb0 generate no compile errors
mir3636
parents: 278
diff changeset
683 my @args = split(/,/,$3);
677
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
684 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
685 $newArgs .= "enum Code $next";
258
4fe19a06d666 generate next args
mir3636
parents: 255
diff changeset
686 }
262
2c56a9536c0d add comments
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
687 # analyze continuation arguments
2c56a9536c0d add comments
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
688 # output arguments are defined in the Interface take the pointer of these
2c56a9536c0d add comments
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
689 # output arguments are put into the Interface DataGear just before the goto
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
690 for my $arg (@args) {
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
691 $arg =~ s/^\s*//;
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
692 last if ($arg =~ /\.\.\./);
625
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 617
diff changeset
693 $arg =~ s/^(struct|union|const|enum)?\s*(\w+)(\**)\s(\w+)//;
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
694 my $structType = $1;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
695 my $typeName = $2;
466
831b7f6fd687 Fix warning pointer type
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 464
diff changeset
696 my $ptrType = $3;
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
697 my $varName = $4;
715
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
698 if ($structType =~ /(const|enum)/) {
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
699 $typeName = "$structType $typeName";
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
700 }
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
701 my $typeField = lcfirst($typeName);
260
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
702 push(@{$outputArgs{$codeGearName}->{$next}}, $varName);
677
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
703 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
704 $newArgs .= ",$structType $typeName **O_$varName";
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
705 }
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
706 }
625
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 617
diff changeset
707 } elsif ($args =~ s/^(struct|union|const|enum)?\s*(\w+)(\**)\s(\w+)//) {
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
708 my $structType = $1;
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
709 my $typeName = $2;
466
831b7f6fd687 Fix warning pointer type
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 464
diff changeset
710 my $ptrType = $3;
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
711 my $varName = $4;
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
712 $newArgs .= $&; # assuming no duplicate
670
f8b98e469256 use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 669
diff changeset
713 if ($structType && ($structType =~ /(const|enum)/)) {
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
714 $typeName = "$structType $typeName";
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
715 }
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
716 my $typeField = lcfirst($typeName);
677
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
717 generateStubArgs($codeGearName, $varName, $typeName, $ptrType, $typeField, $implInterfaceInfo,0);
255
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
718 } 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
719 $newArgs .= $1;
255
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
720 } else {
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
721 $newArgs .= $args;
79bbe2c63fb0 cmake generate c from cbc
mir3636
parents: 254
diff changeset
722 last;
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
723 }
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
724 }
262
2c56a9536c0d add comments
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
725 # 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
726 $dataGearName{$codeGearName} .= "\tgoto $codeGearName(${context_name}";
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
727 for my $arg ( @{$dataGearVar{$codeGearName}}) {
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
728 $dataGearName{$codeGearName} .= ", $arg";
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
729 }
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
730 $dataGearName{$codeGearName} .= ");";
262
2c56a9536c0d add comments
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 261
diff changeset
731 # generate CodeGear header with new arguments
253
ebc13549394c generate stubArgs
mir3636
parents: 252
diff changeset
732 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
733 if ($outputVar{$codeGearName} ne "") {
324
d9887056ae5b Update Todo and Add comment to perl script
one
parents: 305
diff changeset
734 # output data var can be use before write
d9887056ae5b Update Todo and Add comment to perl script
one
parents: 305
diff changeset
735 # 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
736 print $fd $outputVar{$codeGearName};
6b5444bbea8a generated stub no comiple errors
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 259
diff changeset
737 }
250
8a8963ce9858 fix generate_stub
mir3636
parents: 249
diff changeset
738 next;
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
739 } elsif (! $inCode) {
670
f8b98e469256 use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 669
diff changeset
740 s/new\s+(\w+)\(\)/\&ALLOCATE(${context_name}, $1)->$1/g; # replacing new
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
741 print $fd $_;
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
742 next;
384
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
743 } 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
744 # handling goto statement
384
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
745 # 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
746 my $prev = $1;
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
747 my $next = $2;
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
748 my $method = $3;
529
e5e3025f503a Generate twice stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 528
diff changeset
749 my $tmpArgs = $4;
698
73ebf05f48ee fix Gearef indent
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 697
diff changeset
750 my $indent = get_indent_len($prev);
708
4e80cdea307d not add C_ to a goto predefined variable
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 706
diff changeset
751 my $currentCodeGearInfo = $filename2EachCodeGearArgs{$filename}->{$codeGearName};
548
4fdeb0afc187 tweak GearsExamples, generate_stubs
anatofuz
parents: 547
diff changeset
752 #$tmpArgs =~ s/\(.*\)/\(\)/;
529
e5e3025f503a Generate twice stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 528
diff changeset
753 my @args = split(/,/,$tmpArgs);
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
754 if (! defined $dataGearVarType{$codeGearName}) {
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
755 print $fd $_ ;
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
756 next ;
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
757 }
384
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
758 my @types = @{$dataGearVarType{$codeGearName}};
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
759 my $ntype;
415
eec6553a2aa6 fix redblacktree
mir3636
parents: 407
diff changeset
760 my $ftype;
384
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
761 for my $v (@{$dataGearVar{$codeGearName}}) {
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
762 my $t = shift @types;
528
82ff74c2f162 Delete stub for bitonicSort
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 527
diff changeset
763 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
764 $ntype = $t;
415
eec6553a2aa6 fix redblacktree
mir3636
parents: 407
diff changeset
765 $ftype = lcfirst($ntype);
384
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
766 }
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
767 }
444
0c024ea61601 Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 442
diff changeset
768 if (!defined $ntype) {
0c024ea61601 Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 442
diff changeset
769 $ntype = $localVarType{$next};
0c024ea61601 Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 442
diff changeset
770 $ftype = lcfirst($ntype);
0c024ea61601 Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 442
diff changeset
771 }
698
73ebf05f48ee fix Gearef indent
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 697
diff changeset
772 print $fd "${indent}Gearef(${context_name}, $ntype)->$ftype = (union Data*) $next;\n";
415
eec6553a2aa6 fix redblacktree
mir3636
parents: 407
diff changeset
773 # Put interface argument
384
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
774 my $prot = $code{$ntype}->{$method};
385
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
775 my $i = 1;
384
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
776 for my $arg (@args) {
415
eec6553a2aa6 fix redblacktree
mir3636
parents: 407
diff changeset
777 my $pType;
eec6553a2aa6 fix redblacktree
mir3636
parents: 407
diff changeset
778 my $pName;
385
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
779 my $p = @$prot[$i];
457
2b36a1878c6f Refactor TaskManagerImpl
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 447
diff changeset
780 next if ($p eq $arg);
387
590f03af1a2c fix getCodeGear
mir3636
parents: 385
diff changeset
781 $p =~ s/^(.*)\s(\w+)//;
415
eec6553a2aa6 fix redblacktree
mir3636
parents: 407
diff changeset
782 $pType = $1;
eec6553a2aa6 fix redblacktree
mir3636
parents: 407
diff changeset
783 $pName = $2;
387
590f03af1a2c fix getCodeGear
mir3636
parents: 385
diff changeset
784 $arg =~ s/^(\s)*(\w+)/$2/;
590f03af1a2c fix getCodeGear
mir3636
parents: 385
diff changeset
785 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
786 if ($arg =~ /(\w+)\(.*\)/) {
698
73ebf05f48ee fix Gearef indent
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 697
diff changeset
787 print $fd "${indent}Gearef(${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
788 } else {
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
789 my $hasGotoArgOrLocalVar = undef;
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
790 my $outputStubElem = $generateHaveOutputStub->{list}->{$codeGearName};
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
791
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
792 if ($implInterfaceInfo->{parsedInterfaceInfo}) {
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
793 if (exists_codegear_in_interface({codeGearName => $arg, parsedInfo => $implInterfaceInfo->{parsedInterfaceInfo}})) {
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
794 my $replaceCodeGear = "${arg}$implInterfaceInfo->{implementation}"; #${pop}SingleLinkedStack
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
795 $arg = $replaceCodeGear;
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
796 }
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
797 }
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
798
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
799 if ($outputStubElem && !$stub{$outputStubElem->{createStubName}."_stub"}->{static}) {
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
800 my $pick_next = "$outputStubElem->{createStubName}_$outputStubElem->{counter}";
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
801 print $fd "${indent}Gearef(${context_name}, $ntype)->$pName = C_$pick_next;\n";
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
802 $i++;
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
803 next;
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
804 }
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
805
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
806 # find __code of argument or local variable
708
4e80cdea307d not add C_ to a goto predefined variable
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 706
diff changeset
807 for my $localVarType (qw/arg localVar/) {
4e80cdea307d not add C_ to a goto predefined variable
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 706
diff changeset
808 my $foundVarType = $currentCodeGearInfo->{$localVarType}->{$arg};
4e80cdea307d not add C_ to a goto predefined variable
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 706
diff changeset
809 if ($foundVarType && $foundVarType eq '__code') {
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
810 $hasGotoArgOrLocalVar = 1;
708
4e80cdea307d not add C_ to a goto predefined variable
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 706
diff changeset
811 }
4e80cdea307d not add C_ to a goto predefined variable
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 706
diff changeset
812 }
4e80cdea307d not add C_ to a goto predefined variable
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 706
diff changeset
813
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
814 # inteface case
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
815
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
816 if ($arg =~ /->/) {
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
817 print $fd "${indent}Gearef(${context_name}, $ntype)->$pName = $arg;\n"; #Gearef->()->next = bar->baz;
708
4e80cdea307d not add C_ to a goto predefined variable
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 706
diff changeset
818 $i++;
4e80cdea307d not add C_ to a goto predefined variable
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 706
diff changeset
819 next;
4e80cdea307d not add C_ to a goto predefined variable
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 706
diff changeset
820 }
4e80cdea307d not add C_ to a goto predefined variable
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 706
diff changeset
821
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
822 if ($hasGotoArgOrLocalVar) {
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
823 print $fd "${indent}Gearef(${context_name}, $ntype)->$pName = $arg;\n"; #Gearef->()->next = next;
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
824 $i++;
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
825 next;
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
826 }
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
827
698
73ebf05f48ee fix Gearef indent
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 697
diff changeset
828 print $fd "${indent}Gearef(${context_name}, $ntype)->$pName = C_$arg;\n";
708
4e80cdea307d not add C_ to a goto predefined variable
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 706
diff changeset
829 $i++;
4e80cdea307d not add C_ to a goto predefined variable
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 706
diff changeset
830 next;
444
0c024ea61601 Using cas interface but occurred warning
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 442
diff changeset
831 }
466
831b7f6fd687 Fix warning pointer type
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 464
diff changeset
832 } elsif ($pType =~ /Data\**$/){
698
73ebf05f48ee fix Gearef indent
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 697
diff changeset
833 print $fd "${indent}Gearef(${context_name}, $ntype)->$pName = (union $pType) $arg;\n";
387
590f03af1a2c fix getCodeGear
mir3636
parents: 385
diff changeset
834 } else {
698
73ebf05f48ee fix Gearef indent
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 697
diff changeset
835 print $fd "${indent}Gearef(${context_name}, $ntype)->$pName = $arg;\n";
387
590f03af1a2c fix getCodeGear
mir3636
parents: 385
diff changeset
836 }
385
c1512f358c37 add getCodeGear to generate_stub.pl
mir3636
parents: 384
diff changeset
837 $i++;
384
ee5d2b1685d7 Fix perlscript
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 383
diff changeset
838 }
641
b486bf9d1280 update generate_*.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 633
diff changeset
839 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
840 next;
396
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
841 } elsif(/^(.*)par goto (\w+)\((.*)\);/) {
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
842 # handling par goto statement
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
843 # convert it to the parallel
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
844 my $prev = $1;
bba401f93dcd Add handle par goto statement
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 393
diff changeset
845 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
846 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
847 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
848 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
849 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
850 # 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
851 if ($args =~ /iterate\((.*)?\),/) {
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
852 @iterateCounts = split(/,/,$1);;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
853 $inputCount--;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
854 }
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
855 # replace iterate keyword
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
856 $args =~ s/iterate\((.*)?\),//;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
857 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
858 my $nextCodeGear = pop(@dataGears);
546
d8e87b3b2be0 fix goto parGotoMeta
mir3636
parents: 529
diff changeset
859 if (! $hasParGoto) {
d8e87b3b2be0 fix goto parGotoMeta
mir3636
parents: 529
diff changeset
860 $hasParGoto = 1;
461
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
861 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
862 }
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
863 my $initTask = << "EOFEOF";
630
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
864 ${prev}${context_name}\->task = NEW(struct Context);
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
865 ${prev}initContext(${context_name}\->task);
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
866 ${prev}${context_name}\->task->next = C_$codeGearName;
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
867 ${prev}${context_name}\->task->idgCount = $inputCount;
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
868 ${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
869 ${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
870 ${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
871 ${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
872 EOFEOF
461
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
873 print $fd $initTask;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
874 if (@iterateCounts) {
630
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
875 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
876 my $len = @iterateCounts;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
877 if ($len == 1) {
630
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
878 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
879 } elsif ($len == 2) {
630
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
880 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
881 } elsif ($len == 3) {
630
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
882 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
883 }
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
884 }
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
885 for my $dataGear (@dataGears) {
630
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
886 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
887 }
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
888 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
889 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
890 }
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
891 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
892 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
893 }
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
894 my $putTask = << "EOFEOF";
630
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
895 ${prev}element = &ALLOCATE(${context_name}, Element)->Element;
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
896 ${prev}element->data = (union Data*)${context_name}\->task;
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
897 ${prev}element->next = ${context_name}\->taskList;
0baef27a18f4 common perl scripts
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 629
diff changeset
898 ${prev}${context_name}\->taskList = element;
398
fc4fcd441700 Fix spanwTasks
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 397
diff changeset
899 EOFEOF
461
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
900 print $fd $putTask;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
901 next;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
902 } elsif (/^(.*)goto (\w+)\((.*)\);/) {
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
903 # handling goto statement
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
904 # 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
905 my $prev = $1;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
906 my $next = $2;
527
929aa06a12f9 Generate par goto code gear stub
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 521
diff changeset
907 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
908 my $v = 0;
647
dac9cc4dd52d bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 646
diff changeset
909 my $arg_context = $context_name;
dac9cc4dd52d bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 646
diff changeset
910 if ($prev =~ /kernel/) {
dac9cc4dd52d bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 646
diff changeset
911 $prev = "";
dac9cc4dd52d bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 646
diff changeset
912 $arg_context = "kernel";
dac9cc4dd52d bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 646
diff changeset
913 }
dac9cc4dd52d bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 646
diff changeset
914
461
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
915 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
916 # continuation arguments
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
917 $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
918 }
715
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
919
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
920 if (exists_codegear_in_interface({codeGearName => $next, parsedInfo => $implInterfaceInfo->{parsedInterfaceInfo}})) {
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
921 my $replaceCodeGear = "${next}$implInterfaceInfo->{implementation}"; #${pop}SingleLinkedStack
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
922 if ($replaceCodeGearNames->{$next}) {
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
923 $next = $replaceCodeGear;
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
924 }
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
925 }
677
47910f7c731e remove some global variables
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 676
diff changeset
926 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
927 # 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
928 # 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
929 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
930 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
931 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
932 }
546
d8e87b3b2be0 fix goto parGotoMeta
mir3636
parents: 529
diff changeset
933 if ($hasParGoto) {
647
dac9cc4dd52d bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 646
diff changeset
934 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
935 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
936 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
937 } else {
647
dac9cc4dd52d bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 646
diff changeset
938 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
939 }
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
940 next;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
941 }
546
d8e87b3b2be0 fix goto parGotoMeta
mir3636
parents: 529
diff changeset
942 if ($hasParGoto) {
647
dac9cc4dd52d bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 646
diff changeset
943 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
944 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
945 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
946 next;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
947 } 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
948 print $fd $_;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
949 next;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
950 } else {
647
dac9cc4dd52d bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 646
diff changeset
951 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
952 next;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
953 }
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
954 } 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
955 my $type = $2;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
956 my $varName = $3;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
957 $localVarType{$varName} = $type;
670
f8b98e469256 use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 669
diff changeset
958 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
959 } elsif(/^}/) {
546
d8e87b3b2be0 fix goto parGotoMeta
mir3636
parents: 529
diff changeset
960 $hasParGoto = 0;
461
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
961 } else {
670
f8b98e469256 use warnings at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 669
diff changeset
962 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
963 }
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
964 # 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
965 } elsif ($inMain) {
631
5189c60b9707 update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 630
diff changeset
966 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
967 print $fd $_;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
968 next;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
969 } elsif (/^(.*)goto (\w+)\((.*)\);/) {
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
970 my $prev = $1;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
971 my $next = $2;
631
5189c60b9707 update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 630
diff changeset
972 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
973 print $fd "${prev}initContext(main_${context_name});\n";
5189c60b9707 update gears tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 630
diff changeset
974 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
975 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
976 next;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
977 }
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
978 }
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
979 if (/^}/) {
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
980 $inStub = 0;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
981 $inTypedef = 0;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
982 $inMain = 0;
598
32388e7467bc pull from xv6
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 596
diff changeset
983 $inCode = 0;
461
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
984 }
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
985 print $fd $_;
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
986 }
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
987 if (defined $prevCodeGearName) {
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
988 if (!defined $stub{$prevCodeGearName."_stub"}->{wrote}) {
715
fd9b9fa4ec98 fix pop_and_push test
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 714
diff changeset
989 $stub{$prevCodeGearName."_stub"}->{wrote} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName});
461
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
990 }
6b71cf5b1c22 Change Interface files from cbc to header
Tatsuki IHA <innparusu@cr.ie.u-ryukyu.ac.jp>
parents: 458
diff changeset
991 }
697
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 693
diff changeset
992
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
993
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
994
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
995 #Create a stub when the output is a different interface
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
996 for my $modifyEnumCodeCodeGear (keys %{$generateHaveOutputStub->{list}}) {
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
997 my $outputStubElem = $generateHaveOutputStub->{list}->{$modifyEnumCodeCodeGear};
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
998 my $targetStubName = $outputStubElem->{createStubName};
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
999 my $createStubName = "$outputStubElem->{createStubName}_$outputStubElem->{counter}";
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
1000 my $replaceArgs = $outputStubElem->{args};
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1001 my $replaceStubContents = $dataGearName{$targetStubName};
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1002
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1003 #If the stub was handwritten, skip
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1004 if ($stub{"${targetStubName}_stub"}->{static}) {
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1005 next;
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1006 }
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1007
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1008 for my $arg (keys %$replaceArgs) {
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1009 my $interface = $replaceArgs->{$arg};
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
1010 $replaceStubContents =~ s/,(.*)\)->$arg/, $interface)->$arg/;
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1011 }
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1012
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1013 generateStub($fd,$createStubName,$replaceStubContents);
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1014 }
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1015
194
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
1016 }
081607dcf893 create generate_stub.pl
mir3636
parents:
diff changeset
1017
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1018 sub createHeaderNameToInfo {
663
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 661
diff changeset
1019 my $search_root = shift;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 661
diff changeset
1020 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
1021 my $interface_name2headerpath = {};
b6a3e1638f3a Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 658
diff changeset
1022
699
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
1023 #This process assumes that there are no header files of the same name
661
b6a3e1638f3a Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 658
diff changeset
1024 for my $file (@{$files}) {
b6a3e1638f3a Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 658
diff changeset
1025 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
1026 my $file_name = $1;
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1027 my $isInterface = Gears::Interface->isThisFileInterface($file);
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1028 $interface_name2headerpath->{$file_name} = { path => $file, isInterface => $isInterface };
661
b6a3e1638f3a Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 658
diff changeset
1029 }
b6a3e1638f3a Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 658
diff changeset
1030 }
b6a3e1638f3a Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 658
diff changeset
1031
b6a3e1638f3a Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 658
diff changeset
1032 return $interface_name2headerpath;
b6a3e1638f3a Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 658
diff changeset
1033 }
b6a3e1638f3a Search headerfile first at generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 658
diff changeset
1034
663
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 661
diff changeset
1035 sub create_cbc_name_to_source_path {
668
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1036 # create this structure
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1037 #
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1038 # {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1039 # SemaphoreImpl.cbc [
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1040 # [0] "/Users/anatofuz/src/firefly/hg/Gears/Gears/src/parallel_execution/SemaphoreImpl.cbc",
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1041 # [1] "/Users/anatofuz/src/firefly/hg/Gears/Gears/src/parallel_execution/examples/boundedBuffer/SemaphoreImpl.cbc"
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1042 # ],
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1043 # SingleLinkedQueue.cbc [
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1044 # [0] "/Users/anatofuz/src/firefly/hg/Gears/Gears/src/parallel_execution/SingleLinkedQueue.cbc"
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1045 # ],
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1046 # }
663
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 661
diff changeset
1047 my $search_root = shift;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 661
diff changeset
1048 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
1049
663
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 661
diff changeset
1050 my $cbc_name2_source_path = {};
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 661
diff changeset
1051 for my $file (@{$files}) {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 661
diff changeset
1052 my $cbc_name = basename $file;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 661
diff changeset
1053 $cbc_name =~ s/\.cbc//;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 661
diff changeset
1054 push(@{$cbc_name2_source_path->{$cbc_name}},$file);
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 661
diff changeset
1055 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 661
diff changeset
1056 return $cbc_name2_source_path;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 661
diff changeset
1057 }
647
dac9cc4dd52d bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 646
diff changeset
1058
709
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1059 sub createSearchCbCFromCodeGearNameWCurrentFrileName {
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1060 #Find the cbc file that contains CodeGear.
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1061 #If there are more than one cbc file, the one whose namespace is the same as the filename has priority.
ed7183a46dca create a stub when the output is a different interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 708
diff changeset
1062
668
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1063 my $search_root = shift;
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1064 my $cbc_name2_source_path = create_cbc_name_to_source_path($search_root);
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1065
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1066 # return sub is create clojure
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1067 return sub {
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1068 my ($codeGearName, $filename) = @_;
672
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 670
diff changeset
1069 my $cbc_files = $cbc_name2_source_path->{$codeGearName} // [];
668
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1070
672
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 670
diff changeset
1071 if (scalar(@{$cbc_files}) == 0) { # Not Found
668
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1072 return 0; #false case
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1073 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1074
672
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 670
diff changeset
1075 if (scalar(@{$cbc_files}) == 1) { # this case $codeGearName.cbc is single (SingleLinkedQueue.cbc)
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 670
diff changeset
1076 return $cbc_files->[0]; # return "/Users/anatofuz/src/firefly/hg/Gears/Gears/src/parallel_execution/SingleLinkedQueue.cbc"
668
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1077 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1078
669
e8800c60811a fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 668
diff changeset
1079 my $cbc_dir_name = dirname $filename;
e8800c60811a fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 668
diff changeset
1080
672
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 670
diff changeset
1081 for my $cbc_file (@{$cbc_files}) {
669
e8800c60811a fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 668
diff changeset
1082 if ($cbc_file =~ /$cbc_dir_name/) {
e8800c60811a fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 668
diff changeset
1083 return $cbc_file;
e8800c60811a fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 668
diff changeset
1084 }
e8800c60811a fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 668
diff changeset
1085 }
e8800c60811a fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 668
diff changeset
1086
e8800c60811a fix search cbc file
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 668
diff changeset
1087 return 0; # Not found
668
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1088 }
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 665
diff changeset
1089 }
698
73ebf05f48ee fix Gearef indent
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 697
diff changeset
1090
73ebf05f48ee fix Gearef indent
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 697
diff changeset
1091 sub get_indent_len {
73ebf05f48ee fix Gearef indent
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 697
diff changeset
1092 my $prev = shift;
699
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
1093 if ($prev =~ /^(\s+).*$/) {
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
1094 return $1;
698
73ebf05f48ee fix Gearef indent
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 697
diff changeset
1095 }
699
4d99aad53969 replace include at generate_stub
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 698
diff changeset
1096 return "";
698
73ebf05f48ee fix Gearef indent
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 697
diff changeset
1097 }
73ebf05f48ee fix Gearef indent
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 697
diff changeset
1098
714
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
1099 sub exists_codegear_in_interface {
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
1100 my $arg = shift;
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
1101
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
1102 my $codeGearName = $arg->{codeGearName};
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
1103 my $parsedInterfaceInfo = $arg->{parsedInfo};
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
1104 my @res = grep { $_->{name} eq $codeGearName } @{$parsedInterfaceInfo->{codes}};
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
1105 return @res;
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
1106 }
d5bd1c640db0 impl name space at gears
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents: 709
diff changeset
1107