Mercurial > hg > Gears > Gears
annotate src/parallel_execution/lib/Gears/Util.pm @ 625:d02866506b9b
...
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 09 Jun 2020 15:01:53 +0900 |
parents | d560184a7ce7 |
children | 670b972b6ff0 |
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); |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
17 |
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(...)); |
618 | 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'); |
625 | 93 $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
|
94 my $val = "$type $vname;\n"; |
598 | 95 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
|
96 } |
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
97 next; |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
98 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
99 |
597
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
100 $line =~ s/^\s+//; |
410924949569
impl auto search data gear
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
595
diff
changeset
|
101 push(@tmp_args,$line); |
598 | 102 $static_data_gear_write_mode = 1; |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
103 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
104 |
598 | 105 push(@{$ir->{content}}, _uniq(@tmp_args)); |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
106 return $ir; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
107 } |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
108 |
598 | 109 sub _uniq { |
110 my %seen; | |
111 return grep { !$seen{$_}++ } @_; | |
112 } | |
113 | |
114 sub parse_with_separate_code_data_gears{ | |
583 | 115 my ($class, $file) = @_; |
116 my $ir = _parse_base($file); | |
117 | |
118 my @data_gears; | |
119 my @code_gears; | |
120 map { push (@data_gears, $_) unless ($_ =~ /enum Code/);} @{$ir->{content}}; | |
121 map { push (@code_gears, $1) if ($_ =~ /enum Code (\w+);/);} @{$ir->{content}}; | |
122 | |
123 open my $fh , '<', $file; | |
124 my $i = 0; | |
125 while (($i < scalar @code_gears) && (my $line = <$fh>)) { | |
126 my $cg = $code_gears[$i]; | |
127 if ($line =~ m|__code $cg\(([()\.\*\s\w,_]+)\)|) { | |
128 $code_gears[$i] = { | |
129 name => $cg, | |
589 | 130 args => $1, |
583 | 131 }; |
132 $i++; | |
133 } | |
134 } | |
135 $ir->{codes} = \@code_gears; | |
136 $ir->{data} = \@data_gears; | |
137 return $ir; | |
138 } | |
139 | |
564
9cca20bcb558
add auto_generate_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
559
diff
changeset
|
140 sub file_checking { |
9cca20bcb558
add auto_generate_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
559
diff
changeset
|
141 my ($class, $file_name) = @_; |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
142 unless (-f $file_name) { |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
143 croak "invalid filepath :$file_name\n"; |
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
144 } |
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 |
557 | 147 sub slup { |
148 my ($class,$file) = @_; | |
149 open my $fh, '<', $file; | |
150 local $/; | |
151 my $f = <$fh>; | |
152 return $f; | |
153 } | |
154 | |
598 | 155 sub find_using_interface_header { |
558 | 156 my $class = shift; |
157 my $header_name = shift; | |
158 | |
159 my $find_path = shift // "."; | |
589 | 160 my @header_list = (); |
558 | 161 |
557 | 162 find( |
163 { | |
164 wanted => sub { | |
595 | 165 if ($_ =~ /\/$header_name\.(h|dg)$/) { |
589 | 166 push(@header_list,$_); |
557 | 167 } |
168 }, | |
169 no_chdir => 1, | |
170 }, | |
558 | 171 $find_path); |
589 | 172 my @find_headers = grep { $_ =~ /\/$header_name\.(h|dg)/} @header_list; |
173 if (@find_headers > 1) { | |
174 @find_headers = grep { $_ =~ /\/$header_name\.dg/} @find_headers; | |
175 } | |
176 return shift @find_headers; | |
557 | 177 } |
178 | |
573
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
179 sub find_headers_path { |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
180 my $class = shift; |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
181 my $find_path = shift // "."; |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
182 |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
183 my @files; |
583 | 184 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
|
185 |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
186 return \@files; |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
187 } |
5f4b7ff18a34
set header path each include struct
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
564
diff
changeset
|
188 |
595 | 189 sub extraction_dg_compile_sources { |
190 my ($class, $compile_sources) = @_; | |
191 my %counter; | |
192 my %include_pool = (); | |
193 for my $cbc_file (@{$compile_sources}) { | |
194 open my $fh , '<', $cbc_file; | |
195 while (my $line = <$fh>) { | |
196 if ($line =~ m|//\s*:skip|) { | |
197 next; | |
198 } | |
199 | |
200 if ($line =~ /#interface\s*"(.*)\.h"/) { | |
201 push(@{$counter{interfaces}->{$1}->{$cbc_file}},$.); | |
202 next; | |
203 } | |
204 | |
205 if ($line =~ /^\/\/\s*data_gear\s*"(.*)\.(?:h|dg)?"/) { | |
206 push(@{$include_pool{$1}->{$cbc_file}},$.); | |
207 next; | |
208 } | |
209 | |
210 if ($line =~ m|//\s*Skip:\s*generate_context|) { | |
211 $line = <$fh>; | |
212 next; | |
213 } | |
214 | |
215 | |
598 | 216 if ($line =~ /^(\w+)\*\s*create(\w+)\(([*\w\s]+)\)/) { |
595 | 217 my $interface = $1; |
218 my $implementation = $2; | |
598 | 219 my $arg = $3; |
220 if ($arg eq "") { | |
221 next; | |
222 } | |
595 | 223 push(@{$counter{interfaces}->{$interface}->{$cbc_file}},$.); |
224 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
225 next; | |
226 } | |
227 | |
228 if ($line =~ /Gearef\(context,\s*(\w+)\)/) { | |
229 my $implementation = $1; | |
230 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
231 next; | |
232 } | |
233 | |
234 #Element* element = &ALLOCATE(cbc_context, Element)->Element; | |
235 if ($line =~ /ALLOCATE\w*\((?:cbc_)?context,\s*(\w+)\)/) { | |
236 my $implementation = $1; | |
237 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
238 next; | |
239 } | |
240 | |
241 if ($line =~ /ALLOCATE_(?:PTR_)?ARRAY\((?:cbc_)?context,\s*(\w+),[\s\w]+\)/) { | |
242 my $implementation = $1; | |
243 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
244 next; | |
245 } | |
246 | |
247 if ($line =~ /new\s+(\w+?)\([\w\s]*\);/) { | |
248 my $implementation = $1; | |
249 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
250 next; | |
251 } | |
252 | |
253 if ($line =~ /ALLOCATE_DATA_GEAR\((\w+),\s*(\w+)\)/) { | |
254 my $implementation = $2; | |
255 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
256 next; | |
257 } | |
258 | |
259 #TaskManagerImpl* taskManager = (TaskManagerImpl*)GearImpl(context, TaskManager, taskManager); | |
260 if ($line =~ /\((\w+)\*\)GearImpl\(context,\s*(\w+),\s*(\w+)\)/) { | |
261 my $interface = $2; | |
262 my $implementation = $1; | |
263 push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); | |
264 push(@{$counter{interfaces}->{$interface}->{$cbc_file}},$.); | |
265 next; | |
266 } | |
267 | |
268 if ($line =~ /^__code/) { | |
269 while ($line =~ /struct (\w+)\s*\*/g) { | |
270 next if $1 eq "Context"; | |
271 next if (exists $counter{interfaces}->{$1}); | |
272 push(@{$counter{impl}->{$1}->{$cbc_file}},$.); | |
273 } | |
274 } | |
275 } | |
276 close $fh; | |
277 } | |
278 use Data::Dumper; | |
279 | |
280 for my $cg_name (keys %include_pool) { | |
281 my @tmp_cbc_file_names = keys %{$include_pool{$cg_name}}; | |
282 my $tmp_cbc_file_name = shift @tmp_cbc_file_names; | |
283 if (exists $counter{interfaces}->{$cg_name}){ | |
284 push(@{$counter{interfaces}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name}); | |
285 delete $include_pool{$cg_name}; | |
286 next; | |
287 } | |
288 | |
289 if (exists $counter{impl}->{$cg_name}){ | |
290 push(@{$counter{impl}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name}); | |
291 delete $include_pool{$cg_name}; | |
292 next; | |
293 } | |
294 push(@{$counter{interfaces}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name}); | |
295 delete $include_pool{$cg_name}; | |
296 } | |
297 | |
298 $counter{interfaces}->{Meta}++; | |
299 $counter{interfaces}->{TaskManager}++; | |
300 print "-----------\n"; | |
301 print Dumper \%counter; | |
302 print "-----------\n"; | |
303 return \%counter; | |
304 } | |
305 | |
306 sub docking_header_name_to_path { | |
307 my ($class, $search_bash_path, $targets) = @_; | |
308 my %res; | |
309 map { $res{$_}++ } @$targets; | |
310 | |
311 my $header_paths = Gears::Util->find_headers_path($search_bash_path); | |
312 map { | |
313 if (/(\w+)\.(?:h|dg)$/) { | |
314 my $header_file = $1; | |
315 if (exists $res{$header_file}) { | |
316 if ($res{$header_file} =~ /^\d+$/){ | |
317 $res{$header_file} = $_; | |
318 } elsif (($_ =~ /\.dg$/) && ($res{$header_file} =~ /\.h$/)) { | |
319 $res{$header_file} = $_; | |
320 } | |
321 } | |
322 } | |
323 } sort @$header_paths; | |
324 return \%res; | |
325 } | |
326 | |
556
a0b7eb5e58c0
add Gears::Util module
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
327 1; |