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
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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;