Mercurial > hg > Gears > Gears
annotate src/parallel_execution/lib/Gears/Util.pm @ 667:72b7863ea5b4
...
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 18 Aug 2020 19:56:33 +0900 |
parents | 9bf4e49d3399 |
children | 47910f7c731e |
rev | line source |
---|---|
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
1 package Gears::Util; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
2 use strict; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
3 use warnings; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
4 use Carp qw/croak/; |
557 | 5 use File::Find; |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
6 |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
7 sub parse { |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
8 my ($class, $file_name) = @_; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
9 my $ir = _parse_base($file_name); |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
10 return $ir; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
11 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
12 |
559 | 13 |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
14 sub parse_interface { |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
15 my ($class, $file_name) = @_; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
16 my $ir = _parse_base($file_name); |
663 | 17 |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
18 unless ($ir->{name}) { |
624
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
19 croak "invalid struct name $file_name"; |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
20 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
21 return $ir; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
22 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
23 |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
24 |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
25 sub _parse_base { |
559 | 26 my ($file,$code_verbose) = @_; |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
27 my $ir = {}; |
594 | 28 $ir->{file_name} = $file; |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
29 |
564
9cca20bcb558
add auto_generate_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
559
diff
changeset
|
30 Gears::Util->file_checking($file); |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
31 open my $fh, '<', $file; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
32 my $line = <$fh>; |
598 | 33 my $static_data_gear_write_mode = 0; |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
34 |
624
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
35 my $directory_containing_file = ""; |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
36 |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
37 if ($file =~ m<([\.\w/]+)/\w+\.(?:cbc|h|c)>) { |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
38 $directory_containing_file = $1; |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
39 } |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
40 |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
41 |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
42 while ($line =~ /#include\s+"([\w\/\.]+)"/) { |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
43 my $header_file = $1; |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
44 if ($header_file =~ m|\./context\.h|) { |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
45 next; |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
46 } |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
47 push(@{$ir->{cbc_context_include_headers}}, "$directory_containing_file/$header_file"); |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
48 $line = <$fh>; |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
49 } |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
50 |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
51 # skip space |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
52 |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
53 while ($line =~ /^\s*$/) { |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
54 $line = <$fh>; |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
55 } |
d560184a7ce7
auto load header to context
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
621
diff
changeset
|
56 |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
57 if ($line =~ /typedef struct (\w+)\s?<.*>([\s\w{]+)/) { |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
58 die "invalied struct name $1" unless $1; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
59 $ir->{name} = $1; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
60 |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
61 if ($2 =~ m|\s*impl\s*([\w+]+)\s*{|) { |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
62 $ir->{isa} = $1; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
63 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
64 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
65 |
598 | 66 unless ($ir->{name}) { |
67 return undef; | |
68 } | |
69 | |
597
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
70 my @tmp_args; |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
71 while ($line = <$fh>) { |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
72 if ($line =~ m|\s*/\*|) { |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
73 while ( $line !~ m|\*/|) { |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
74 $line = <$fh>; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
75 next; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
76 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
77 next; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
78 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
79 next if ($line =~ /^\s+$/); |
583 | 80 next if ($line =~ m[^\s*//]); |
575 | 81 next if ($line =~ m[^\}\s*$ir->{name};]); |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
82 |
597
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
83 if ($line =~ m|__code (\w+)|) { |
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
84 push(@tmp_args,"enum Code $1;\n"); |
598 | 85 next if $static_data_gear_write_mode; |
597
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
86 my $args = $'; |
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
87 #$args eq (Impl* vm, pde_t* pgdir, char* init, uint sz, __code next(...)); |
644 | 88 while ($args =~ /\s*(struct|union|const|enum)?\s*([\w*\[\]_]+)\s*(\w+)?,?/g) { |
597
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
89 my $const_type = $1; |
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
90 my $type = $2; |
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
91 my $vname = $3; |
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
92 next if ($type eq '__code'); |
644 | 93 next unless $vname; # __code hoge(int ret, __code next(ret, ...); this is second "ret" case |
625 | 94 $type =~ s/^(?:Impl|Type|Isa)\s*(\*)?/union Data$1/; |
597
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
95 my $val = "$type $vname;\n"; |
598 | 96 push(@tmp_args, $const_type ? "$const_type $val" : $val); |
597
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
97 } |
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
98 next; |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
99 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
100 |
597
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
101 $line =~ s/^\s+//; |
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
102 push(@tmp_args,$line); |
598 | 103 $static_data_gear_write_mode = 1; |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
104 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
105 |
598 | 106 push(@{$ir->{content}}, _uniq(@tmp_args)); |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
107 return $ir; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
108 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
109 |
598 | 110 sub _uniq { |
111 my %seen; | |
112 return grep { !$seen{$_}++ } @_; | |
113 } | |
114 | |
666 | 115 sub separate_code_and_data_gear_after_parse { |
116 # create this data structure | |
117 #\ { | |
118 # codes [ | |
119 # [0] { | |
120 # args "Impl* stackTest, struct Stack* stack, __code next(...)", | |
121 # name "insertTest1" | |
122 # }, | |
123 # [1] { | |
124 # args "Impl* stackTest, struct Stack* stack, __code next(...)", | |
125 # name "insertTest2" | |
126 # }, | |
127 # [2] { | |
128 # args "Impl* stackTest, struct Stack* stack, __code next(...)", | |
129 # name "pop2Test" | |
130 # }, | |
131 # [3] { | |
132 # args "Impl* stackTest, union Data* data, union Data* data1, struct Stack* stack, __code next(...)", | |
133 # name "pop2Test1" | |
134 # }, | |
135 # [4] { | |
136 # args "...", | |
137 # name "next" | |
138 # } | |
139 # ], | |
140 # content [ | |
141 # [0] "enum Code insertTest1; | |
142 #", | |
143 # [1] "union Data* stackTest; | |
144 #", | |
145 # [2] "struct Stack* stack; | |
146 #", | |
147 # [3] "enum Code insertTest2; | |
148 #", | |
149 # [4] "enum Code pop2Test; | |
150 #", | |
151 # [5] "enum Code pop2Test1; | |
152 #", | |
153 # [6] "union Data* data; | |
154 #", | |
155 # [7] "union Data* data1; | |
156 #", | |
157 # [8] "enum Code next; | |
158 #" | |
159 # ], | |
160 # data [ | |
161 # [0] "union Data* stackTest; | |
162 #", | |
163 # [1] "struct Stack* stack; | |
164 #", | |
165 # [2] "union Data* data; | |
166 #", | |
167 # [3] "union Data* data1; | |
168 #" | |
169 # ], | |
170 # file_name "/Users/anatofuz/src/firefly/hg/Gears/Gears/src/parallel_execution/tools/../examples/pop_and_push/StackTest.h", | |
171 # name "StackTest" | |
172 #} | |
173 # | |
174 | |
583 | 175 my ($class, $file) = @_; |
176 my $ir = _parse_base($file); | |
177 | |
178 my @data_gears; | |
179 my @code_gears; | |
180 map { push (@data_gears, $_) unless ($_ =~ /enum Code/);} @{$ir->{content}}; | |
181 map { push (@code_gears, $1) if ($_ =~ /enum Code (\w+);/);} @{$ir->{content}}; | |
182 | |
183 open my $fh , '<', $file; | |
184 my $i = 0; | |
185 while (($i < scalar @code_gears) && (my $line = <$fh>)) { | |
186 my $cg = $code_gears[$i]; | |
187 if ($line =~ m|__code $cg\(([()\.\*\s\w,_]+)\)|) { | |
188 $code_gears[$i] = { | |
189 name => $cg, | |
589 | 190 args => $1, |
583 | 191 }; |
192 $i++; | |
193 } | |
194 } | |
195 $ir->{codes} = \@code_gears; | |
196 $ir->{data} = \@data_gears; | |
197 return $ir; | |
198 } | |
199 | |
564
9cca20bcb558
add auto_generate_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
559
diff
changeset
|
200 sub file_checking { |
9cca20bcb558
add auto_generate_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
559
diff
changeset
|
201 my ($class, $file_name) = @_; |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
202 unless (-f $file_name) { |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
203 croak "invalid filepath :$file_name\n"; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
204 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
205 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
206 |
557 | 207 sub slup { |
208 my ($class,$file) = @_; | |
209 open my $fh, '<', $file; | |
210 local $/; | |
211 my $f = <$fh>; | |
212 return $f; | |
213 } | |
214 | |
215 | |
663 | 216 sub find_cbc_sources_from_path { |
217 my $class = shift; | |
218 my $find_path = shift // "."; | |
219 | |
220 my @files; | |
221 find( { wanted => sub { push @files, $_ if /\.cbc/ }, no_chdir => 1 }, $find_path); | |
222 | |
223 return \@files; | |
224 } | |
225 | |
657
3e3f282d62e4
refactoring Gears perl modules
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
652
diff
changeset
|
226 sub find_headers_from_path { |
573
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
227 my $class = shift; |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
228 my $find_path = shift // "."; |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
229 |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
230 my @files; |
583 | 231 find( { wanted => sub { push @files, $_ if /\.(?:h|dg)/ }, no_chdir => 1 }, $find_path); |
573
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
232 |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
233 return \@files; |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
234 } |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
235 |
595 | 236 sub extraction_dg_compile_sources { |
237 my ($class, $compile_sources) = @_; | |
238 my %counter; | |
239 my %include_pool = (); | |
240 for my $cbc_file (@{$compile_sources}) { | |
241 open my $fh , '<', $cbc_file; | |
242 while (my $line = <$fh>) { | |
243 if ($line =~ m|//\s*:skip|) { | |
244 next; | |
245 } | |
246 | |
247 if ($line =~ /#interface\s*"(.*)\.h"/) { | |
248 push(@{$counter{interfaces}->{$1}->{$cbc_file}},$.); | |
249 next; | |
250 } | |
251 | |
644 | 252 if ($line =~ /^\/\/\s*include\s*"(.*)\.(?:h|dg)?"/) { |
595 | 253 push(@{$include_pool{$1}->{$cbc_file}},$.); |
254 next; | |
255 } | |
256 | |
257 if ($line =~ m|//\s*Skip:\s*generate_context|) { | |
258 $line = <$fh>; | |
259 next; | |
260 } | |
261 | |
262 | |
598 | 263 if ($line =~ /^(\w+)\*\s*create(\w+)\(([*\w\s]+)\)/) { |
595 | 264 my $interface = $1; |
265 my $implementation = $2; | |
598 | 266 my $arg = $3; |
267 if ($arg eq "") { | |
268 next; | |
269 } | |
595 | 270 push(@{$counter{interfaces}->{$interface}->{$cbc_file}},$.); |
271 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
272 next; | |
273 } | |
274 | |
275 if ($line =~ /Gearef\(context,\s*(\w+)\)/) { | |
276 my $implementation = $1; | |
277 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
278 next; | |
279 } | |
280 | |
667 | 281 # ALLOCATE is generated by generate_stub.pl |
282 # because extraction_dg_compile_sources caller after translated .cbc to .c | |
595 | 283 #Element* element = &ALLOCATE(cbc_context, Element)->Element; |
284 if ($line =~ /ALLOCATE\w*\((?:cbc_)?context,\s*(\w+)\)/) { | |
285 my $implementation = $1; | |
286 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
287 next; | |
288 } | |
289 | |
290 if ($line =~ /ALLOCATE_(?:PTR_)?ARRAY\((?:cbc_)?context,\s*(\w+),[\s\w]+\)/) { | |
291 my $implementation = $1; | |
292 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
293 next; | |
294 } | |
295 | |
296 if ($line =~ /new\s+(\w+?)\([\w\s]*\);/) { | |
297 my $implementation = $1; | |
298 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
299 next; | |
300 } | |
301 | |
302 if ($line =~ /ALLOCATE_DATA_GEAR\((\w+),\s*(\w+)\)/) { | |
303 my $implementation = $2; | |
304 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
305 next; | |
306 } | |
307 | |
308 #TaskManagerImpl* taskManager = (TaskManagerImpl*)GearImpl(context, TaskManager, taskManager); | |
309 if ($line =~ /\((\w+)\*\)GearImpl\(context,\s*(\w+),\s*(\w+)\)/) { | |
310 my $interface = $2; | |
311 my $implementation = $1; | |
312 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
313 push(@{$counter{interfaces}->{$interface}->{$cbc_file}},$.); | |
314 next; | |
315 } | |
316 | |
317 if ($line =~ /^__code/) { | |
318 while ($line =~ /struct (\w+)\s*\*/g) { | |
319 next if $1 eq "Context"; | |
320 next if (exists $counter{interfaces}->{$1}); | |
321 push(@{$counter{impl}->{$1}->{$cbc_file}},$.); | |
322 } | |
323 } | |
324 } | |
325 close $fh; | |
326 } | |
327 use Data::Dumper; | |
328 | |
329 for my $cg_name (keys %include_pool) { | |
330 my @tmp_cbc_file_names = keys %{$include_pool{$cg_name}}; | |
331 my $tmp_cbc_file_name = shift @tmp_cbc_file_names; | |
332 if (exists $counter{interfaces}->{$cg_name}){ | |
333 push(@{$counter{interfaces}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name}); | |
334 delete $include_pool{$cg_name}; | |
335 next; | |
336 } | |
337 | |
338 if (exists $counter{impl}->{$cg_name}){ | |
339 push(@{$counter{impl}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name}); | |
340 delete $include_pool{$cg_name}; | |
341 next; | |
342 } | |
343 push(@{$counter{interfaces}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name}); | |
344 delete $include_pool{$cg_name}; | |
345 } | |
346 | |
347 $counter{interfaces}->{Meta}++; | |
348 $counter{interfaces}->{TaskManager}++; | |
652
f666c6daba96
omit debug infomation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
644
diff
changeset
|
349 #print "-----------\n"; |
667 | 350 #print Dumper \%counter; #this line is debug message |
652
f666c6daba96
omit debug infomation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
644
diff
changeset
|
351 #print "-----------\n"; |
595 | 352 return \%counter; |
353 } | |
354 | |
355 | |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
356 1; |