Mercurial > hg > Members > menikon > CbC_xv6
annotate src/gearsTools/lib/Gears/Context.pm @ 110:8c7c1ea49f21
impl auto gen context tools
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Wed, 27 Nov 2019 21:21:42 +0900 |
parents | |
children | 239bd73abac6 |
rev | line source |
---|---|
110
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
1 package Gears::Context; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
2 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
3 use strict; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
4 use warnings; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
5 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
6 use Gears::Util; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
7 use Gears::Context::Template::XV6; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
8 use Carp qw/croak/; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
9 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
10 sub new { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
11 my ($class, %args) = @_; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
12 my $self = { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
13 data_gears_with_count => {}, |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
14 find_root => $args{find_root} // ".", |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
15 output => $args{output}, |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
16 }; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
17 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
18 if ($args{compile_sources}) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
19 $self->{compile_sources} = $args{compile_sources}; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
20 map { Gears::Util->file_checking($_); } @{$self->{compile_sources}}; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
21 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
22 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
23 return bless $self, $class; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
24 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
25 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
26 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
27 sub extraction_dg_compile_sources { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
28 my $self = shift; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
29 my %counter; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
30 for my $cbc_file (@{$self->{compile_sources}}) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
31 open my $fh , '<', $cbc_file; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
32 while (my $line = <$fh>) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
33 if ($line =~ /#interface\s*"(.*)\.h"/ || $line =~ /^\/\/\s*use\s*"(.*)\.h"/) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
34 $self->{data_gears_with_count}->{$1}->{caller}->{$cbc_file}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
35 $counter{interfaces}->{$1}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
36 next; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
37 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
38 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
39 if ($line =~ /^(\w+)(\*)+ *create(\w+)\(([^]]*)\)/) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
40 my $interface = $1; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
41 my $implementation = $3; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
42 $self->{data_gears_with_count}->{$interface}->{caller}->{$cbc_file}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
43 $self->{data_gears_with_count}->{$implementation}->{caller}->{$cbc_file}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
44 $counter{interfaces}->{$interface}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
45 $counter{impl}->{$implementation}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
46 next; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
47 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
48 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
49 if ($line =~ /Gearef\(context,\s*(\w+)\)/) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
50 my $implementation = $1; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
51 $counter{impl}->{$implementation}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
52 $self->{data_gears_with_count}->{$implementation}->{caller}->{$cbc_file}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
53 next; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
54 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
55 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
56 if ($line =~ /ALLOCATE_(?:PTR_)?ARRAY\(context,\s*(\w+),[\s\w]+\)/) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
57 my $implementation = $1; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
58 $counter{impl}->{$implementation}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
59 $self->{data_gears_with_count}->{$implementation}->{caller}->{$cbc_file}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
60 next; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
61 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
62 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
63 if ($line =~ /ALLOCATE_DATA_GEAR\((\w+),\s*(\w+)\)/) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
64 my $implementation = $2; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
65 $counter{impl}->{$implementation}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
66 $self->{data_gears_with_count}->{$implementation}->{caller}->{$cbc_file}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
67 next; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
68 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
69 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
70 #TaskManagerImpl* taskManager = (TaskManagerImpl*)GearImpl(context, TaskManager, taskManager); |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
71 if ($line =~ /\((\w+)\*\)GearImpl\(context,\s*(\w+),\s*(\w+)\)/) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
72 my $interface = $2; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
73 my $implementation = $1; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
74 $self->{data_gears_with_count}->{$interface}->{caller}->{$cbc_file}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
75 $counter{interfaces}->{$interface}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
76 $counter{impl}->{$implementation}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
77 next; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
78 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
79 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
80 if ($line =~ /^__code/) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
81 while ($line =~ /struct (\w+)\s*\*/g) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
82 next if $1 eq "Context"; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
83 $self->{data_gears_with_count}->{$1}->{caller}->{$cbc_file}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
84 next if (exists $counter{interfaces}->{$1}); |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
85 $counter{impl}->{$1}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
86 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
87 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
88 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
89 close $fh; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
90 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
91 $counter{interfaces}->{Meta}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
92 $counter{interfaces}->{TaskManager}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
93 $self->{data_gears_with_count}->{Meta}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
94 $self->{data_gears_with_count}->{TaskManager}++; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
95 return \%counter; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
96 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
97 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
98 sub set_data_gear_header_path { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
99 my $self = shift; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
100 my @data_gears_name; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
101 if (@_) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
102 @data_gears_name = @_; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
103 } else { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
104 map { push (@data_gears_name,$_) if $_ ne "Context" } keys %{$self->{data_gears_with_count}}; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
105 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
106 return _find_headers($self->{find_root},\@data_gears_name); |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
107 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
108 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
109 sub update_dg_each_header_path { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
110 my ($self, $dgs, $dg2path) = @_; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
111 my $new_dgs; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
112 for my $kind (keys %$dgs) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
113 for my $dg_name (keys %{$dgs->{$kind}}) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
114 if ($dg2path->{$dg_name}) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
115 $new_dgs->{$kind}->{$dg_name} = $dg2path->{$dg_name}; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
116 } else { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
117 croak "failed trans header $dg_name\n"; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
118 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
119 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
120 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
121 return $new_dgs; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
122 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
123 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
124 sub tree2create_context_h { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
125 my ($self, $dg2path) = @_; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
126 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
127 my $data_struct_str = $dg2path ? $self->tree2data_struct_str($dg2path) : "\n"; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
128 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
129 my $output = $self->_select_output(); |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
130 Gears::Context::Template::XV6->emit_top_header($output); |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
131 Gears::Context::Template::XV6->emit_data_gears($output,$data_struct_str); |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
132 Gears::Context::Template::XV6->emit_last_header($output); |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
133 close $output; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
134 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
135 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
136 sub _select_output { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
137 my $self = shift; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
138 print "$self->{output}\n"; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
139 if ($self->{output} eq 'stdout') { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
140 return *STDOUT; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
141 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
142 open my $fh, '>', $self->{output}; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
143 return $fh; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
144 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
145 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
146 sub tree2data_struct_str { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
147 my ($self, $dg_str) = @_; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
148 my $data_struct_str = ""; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
149 for my $interface (sort keys %$dg_str) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
150 $data_struct_str .= Gears::Util->h2context_str($dg_str->{$interface}->{elem}); |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
151 next unless ($dg_str->{$interface}->{impl}); |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
152 for my $impl (sort keys %{$dg_str->{$interface}->{impl}}) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
153 $data_struct_str .= Gears::Util->h2context_str($dg_str->{$interface}->{impl}->{$impl}); |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
154 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
155 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
156 return $data_struct_str; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
157 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
158 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
159 sub createImplTree_from_header { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
160 my ($self, $dg2path) = @_; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
161 my %dg_str = (); |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
162 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
163 my $inters = $dg2path->{interfaces}; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
164 my $impls = $dg2path->{impl}; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
165 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
166 use Data::Dumper; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
167 use DDP {deparse => 1}; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
168 print Dumper $dg2path; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
169 p $self; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
170 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
171 map { $dg_str{$_}->{elem} = Gears::Util->parse_interface($inters->{$_}) } keys %$inters; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
172 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
173 map { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
174 my $res = Gears::Util->parse($impls->{$_}); |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
175 if ($res->{isa}) { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
176 $dg_str{$res->{isa}}->{impl}->{$_} = $res; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
177 } else { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
178 $dg_str{$_}->{elem} = $res; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
179 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
180 } keys %$impls; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
181 return \%dg_str; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
182 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
183 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
184 sub _find_headers { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
185 my ($search_bash_path, $targets) = @_; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
186 my %res; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
187 map { $res{$_}++ } @$targets; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
188 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
189 my $header_paths = Gears::Util->find_headers_path($search_bash_path); |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
190 map { |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
191 /(\w+)\.h/; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
192 my $header_tile = $1; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
193 if (exists $res{$header_tile}){ |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
194 $res{$header_tile} = $_; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
195 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
196 } @$header_paths; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
197 return \%res; |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
198 } |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
199 |
8c7c1ea49f21
impl auto gen context tools
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
200 1; |