Mercurial > hg > Gears > Gears
annotate src/parallel_execution/lib/Gears/Util.pm @ 663:24571f9c6187
...
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 18 Aug 2020 19:07:42 +0900 |
parents | 755c2dca04a1 |
children | 9bf4e49d3399 |
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 | |
115 sub parse_with_separate_code_data_gears{ | |
583 | 116 my ($class, $file) = @_; |
117 my $ir = _parse_base($file); | |
118 | |
119 my @data_gears; | |
120 my @code_gears; | |
121 map { push (@data_gears, $_) unless ($_ =~ /enum Code/);} @{$ir->{content}}; | |
122 map { push (@code_gears, $1) if ($_ =~ /enum Code (\w+);/);} @{$ir->{content}}; | |
123 | |
124 open my $fh , '<', $file; | |
125 my $i = 0; | |
126 while (($i < scalar @code_gears) && (my $line = <$fh>)) { | |
127 my $cg = $code_gears[$i]; | |
128 if ($line =~ m|__code $cg\(([()\.\*\s\w,_]+)\)|) { | |
129 $code_gears[$i] = { | |
130 name => $cg, | |
589 | 131 args => $1, |
583 | 132 }; |
133 $i++; | |
134 } | |
135 } | |
136 $ir->{codes} = \@code_gears; | |
137 $ir->{data} = \@data_gears; | |
138 return $ir; | |
139 } | |
140 | |
564
9cca20bcb558
add auto_generate_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
559
diff
changeset
|
141 sub file_checking { |
9cca20bcb558
add auto_generate_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
559
diff
changeset
|
142 my ($class, $file_name) = @_; |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
143 unless (-f $file_name) { |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
144 croak "invalid filepath :$file_name\n"; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
145 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
146 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
147 |
557 | 148 sub slup { |
149 my ($class,$file) = @_; | |
150 open my $fh, '<', $file; | |
151 local $/; | |
152 my $f = <$fh>; | |
153 return $f; | |
154 } | |
155 | |
156 | |
663 | 157 sub find_cbc_sources_from_path { |
158 my $class = shift; | |
159 my $find_path = shift // "."; | |
160 | |
161 my @files; | |
162 find( { wanted => sub { push @files, $_ if /\.cbc/ }, no_chdir => 1 }, $find_path); | |
163 | |
164 return \@files; | |
165 } | |
166 | |
657
3e3f282d62e4
refactoring Gears perl modules
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
652
diff
changeset
|
167 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
|
168 my $class = shift; |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
169 my $find_path = shift // "."; |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
170 |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
171 my @files; |
583 | 172 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
|
173 |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
174 return \@files; |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
175 } |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
176 |
595 | 177 sub extraction_dg_compile_sources { |
178 my ($class, $compile_sources) = @_; | |
179 my %counter; | |
180 my %include_pool = (); | |
181 for my $cbc_file (@{$compile_sources}) { | |
182 open my $fh , '<', $cbc_file; | |
183 while (my $line = <$fh>) { | |
184 if ($line =~ m|//\s*:skip|) { | |
185 next; | |
186 } | |
187 | |
188 if ($line =~ /#interface\s*"(.*)\.h"/) { | |
189 push(@{$counter{interfaces}->{$1}->{$cbc_file}},$.); | |
190 next; | |
191 } | |
192 | |
644 | 193 if ($line =~ /^\/\/\s*include\s*"(.*)\.(?:h|dg)?"/) { |
595 | 194 push(@{$include_pool{$1}->{$cbc_file}},$.); |
195 next; | |
196 } | |
197 | |
198 if ($line =~ m|//\s*Skip:\s*generate_context|) { | |
199 $line = <$fh>; | |
200 next; | |
201 } | |
202 | |
203 | |
598 | 204 if ($line =~ /^(\w+)\*\s*create(\w+)\(([*\w\s]+)\)/) { |
595 | 205 my $interface = $1; |
206 my $implementation = $2; | |
598 | 207 my $arg = $3; |
208 if ($arg eq "") { | |
209 next; | |
210 } | |
595 | 211 push(@{$counter{interfaces}->{$interface}->{$cbc_file}},$.); |
212 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
213 next; | |
214 } | |
215 | |
216 if ($line =~ /Gearef\(context,\s*(\w+)\)/) { | |
217 my $implementation = $1; | |
218 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
219 next; | |
220 } | |
221 | |
222 #Element* element = &ALLOCATE(cbc_context, Element)->Element; | |
223 if ($line =~ /ALLOCATE\w*\((?:cbc_)?context,\s*(\w+)\)/) { | |
224 my $implementation = $1; | |
225 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
226 next; | |
227 } | |
228 | |
229 if ($line =~ /ALLOCATE_(?:PTR_)?ARRAY\((?:cbc_)?context,\s*(\w+),[\s\w]+\)/) { | |
230 my $implementation = $1; | |
231 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
232 next; | |
233 } | |
234 | |
235 if ($line =~ /new\s+(\w+?)\([\w\s]*\);/) { | |
236 my $implementation = $1; | |
237 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
238 next; | |
239 } | |
240 | |
241 if ($line =~ /ALLOCATE_DATA_GEAR\((\w+),\s*(\w+)\)/) { | |
242 my $implementation = $2; | |
243 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
244 next; | |
245 } | |
246 | |
247 #TaskManagerImpl* taskManager = (TaskManagerImpl*)GearImpl(context, TaskManager, taskManager); | |
248 if ($line =~ /\((\w+)\*\)GearImpl\(context,\s*(\w+),\s*(\w+)\)/) { | |
249 my $interface = $2; | |
250 my $implementation = $1; | |
251 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
252 push(@{$counter{interfaces}->{$interface}->{$cbc_file}},$.); | |
253 next; | |
254 } | |
255 | |
256 if ($line =~ /^__code/) { | |
257 while ($line =~ /struct (\w+)\s*\*/g) { | |
258 next if $1 eq "Context"; | |
259 next if (exists $counter{interfaces}->{$1}); | |
260 push(@{$counter{impl}->{$1}->{$cbc_file}},$.); | |
261 } | |
262 } | |
263 } | |
264 close $fh; | |
265 } | |
266 use Data::Dumper; | |
267 | |
268 for my $cg_name (keys %include_pool) { | |
269 my @tmp_cbc_file_names = keys %{$include_pool{$cg_name}}; | |
270 my $tmp_cbc_file_name = shift @tmp_cbc_file_names; | |
271 if (exists $counter{interfaces}->{$cg_name}){ | |
272 push(@{$counter{interfaces}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name}); | |
273 delete $include_pool{$cg_name}; | |
274 next; | |
275 } | |
276 | |
277 if (exists $counter{impl}->{$cg_name}){ | |
278 push(@{$counter{impl}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name}); | |
279 delete $include_pool{$cg_name}; | |
280 next; | |
281 } | |
282 push(@{$counter{interfaces}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name}); | |
283 delete $include_pool{$cg_name}; | |
284 } | |
285 | |
286 $counter{interfaces}->{Meta}++; | |
287 $counter{interfaces}->{TaskManager}++; | |
652
f666c6daba96
omit debug infomation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
644
diff
changeset
|
288 #print "-----------\n"; |
f666c6daba96
omit debug infomation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
644
diff
changeset
|
289 #print Dumper \%counter; |
f666c6daba96
omit debug infomation
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
644
diff
changeset
|
290 #print "-----------\n"; |
595 | 291 return \%counter; |
292 } | |
293 | |
294 | |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
295 1; |