Mercurial > hg > CbC > CbC_xv6
view src/gearsTools/lib/Gears/Context.pm @ 395:17e8a4bc06a7 default tip
add macOS AR/RANLIB
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 14 Dec 2020 21:59:50 +0900 |
parents | 599ad98aee00 |
children |
line wrap: on
line source
package Gears::Context; use strict; use warnings; use Gears::Util; use Module::Load qw/load/; use Carp qw/croak carp/; sub new { my ($class, %args) = @_; my $self = { data_gears_with_count => {}, find_root => $args{find_root} // ".", output => $args{output}, template => $args{template} // "Gears::Context::Template", }; if ($args{compile_sources}) { $self->{compile_sources} = $args{compile_sources}; map { Gears::Util->file_checking($_); } @{$self->{compile_sources}}; } return bless $self, $class; } sub extraction_dg_compile_sources { my ($self, $compile_sources) = @_; return Gears::Util->extraction_dg_compile_sources($compile_sources); } sub set_data_gear_header_path { my $self = shift; my @data_gears_name; map { push (@data_gears_name,$_) if $_ ne "Context" } @_; return Gears::Util->docking_header_name_to_path($self->{find_root},\@data_gears_name); } sub update_dg_each_header_path { my ($self, $dgs, $dg2path) = @_; my $new_dgs; for my $kind (keys %$dgs) { for my $dg_name (keys %{$dgs->{$kind}}) { if ($dg2path->{$dg_name}) { $new_dgs->{$kind}->{$dg_name} = $dg2path->{$dg_name}; } else { croak "failed trans header $dg_name\n"; } } } for my $kind (keys %$dgs) { map { if ($new_dgs->{$kind}->{$_} =~ /^\d+$/) { carp "failed: not found $_.(h|dg)\n"; delete $new_dgs->{$kind}->{$_}; } } keys %{$new_dgs->{$kind}}; } return $new_dgs; } sub tree2create_context_h { my ($self, $dg2path) = @_; unless ($dg2path) { croak "require ast at tree2create_context_h"; } my $template = $self->{template}; load $template; my ($data_struct_str, $from_header_to_caller) = $self->tree2data_struct_str($dg2path); my $output = $self->_select_output(); $template->emit_top_header($output); if (%{$from_header_to_caller}) { $template->emit_include_header($output,$from_header_to_caller); } $template->emit_start_context($output); $template->emit_data_gears($output,$data_struct_str); $template->emit_last_header($output); close $output; } sub _select_output { my $self = shift; print "$self->{output}\n"; if ($self->{output} eq 'stdout') { return *STDOUT; } open my $fh, '>', $self->{output}; return $fh; } # Generate a header with include file list from a structure's tree structure sub tree2data_struct_str { my ($self, $dg_str) = @_; my %from_header_to_caller; my $data_struct_str = ""; for my $interface (sort keys %$dg_str) { my $elem = $dg_str->{$interface}->{elem}; $data_struct_str .= $self->h2context_str_w_macro($elem); for my $header (_find_include_header_each_cbc($elem)) { push(@{$from_header_to_caller{$header}},$elem->{file_name}); } my $root_impl = $dg_str->{$interface}->{impl}; next unless ($root_impl); for my $impl_name (sort keys %{$root_impl}) { my $impl = $root_impl->{$impl_name}; $data_struct_str .= $self->h2context_str_w_macro($impl); for my $header (_find_include_header_each_cbc($impl)) { push(@{$from_header_to_caller{$header}},$impl->{file_name}); } } } return $data_struct_str, \%from_header_to_caller; } sub _find_include_header_each_cbc { my $ir = shift; unless (exists $ir->{cbc_context_include_headers}) { return (); } return @{$ir->{cbc_context_include_headers}}; } sub createImplTree_from_header { my ($self, $dg2path) = @_; my %dg_str = (); my $inters = $dg2path->{interfaces}; my $impls = $dg2path->{impl}; use Data::Dumper; # print Dumper $dg2path; # print Dumper $self; map { my $ir = Gears::Util->parse_interface($inters->{$_}); $dg_str{$_}->{elem} = $ir if $ir} keys %$inters; map { my $res = Gears::Util->parse($impls->{$_}); if ($res) { if ($res->{isa}) { $dg_str{$res->{isa}}->{impl}->{$_} = $res; } else { $dg_str{$_}->{elem} = $res; } } } keys %$impls; return \%dg_str; } sub h2context_str_w_macro { my ($self, $h2context) = @_; my $space = ' '; my $context = "${space}//$h2context->{file_name}\n"; $context .= "#ifndef ". uc($h2context->{name}) ."_STRUCT \n"; $context .= $self->h2context_str($h2context); $context .= "#define ". uc($h2context->{name}) ."_STRUCT \n"; $context .= "#else\n"; $context .= "${space}struct $h2context->{name};\n"; $context .= "#endif\n"; return $context; } sub h2context_str { my ($self, $h2context) = @_; my $space = ' '; my $context = "${space}struct $h2context->{name} {\n"; my $content_space; my @enumCodes; my @var; for my $c (@{$h2context->{content}}) { if ($c =~ /\A\s*enum Code/) { push(@enumCodes,$c); } else { push(@var,$c); } } if (@var){ my @chars = split //, $var[0]; for my $w (@chars) { last if ($w !~ /\s/); $content_space .= $w; } } unless (defined $content_space) { $content_space = ""; } for my $c (@var) { $c =~ s/$content_space//; $context .= "${space}${space}$c"; } for my $c (@enumCodes) { $c =~ s/$content_space//; $context .= "${space}${space}$c"; } $context .= "${space}} $h2context->{name};\n"; return $context; } 1;