Mercurial > hg > Members > menikon > CbC_xv6
diff 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 |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/gearsTools/lib/Gears/Context.pm Wed Nov 27 21:21:42 2019 +0900 @@ -0,0 +1,200 @@ +package Gears::Context; + +use strict; +use warnings; + +use Gears::Util; +use Gears::Context::Template::XV6; +use Carp qw/croak/; + +sub new { + my ($class, %args) = @_; + my $self = { + data_gears_with_count => {}, + find_root => $args{find_root} // ".", + output => $args{output}, + }; + + 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 = shift; + my %counter; + for my $cbc_file (@{$self->{compile_sources}}) { + open my $fh , '<', $cbc_file; + while (my $line = <$fh>) { + if ($line =~ /#interface\s*"(.*)\.h"/ || $line =~ /^\/\/\s*use\s*"(.*)\.h"/) { + $self->{data_gears_with_count}->{$1}->{caller}->{$cbc_file}++; + $counter{interfaces}->{$1}++; + next; + } + + if ($line =~ /^(\w+)(\*)+ *create(\w+)\(([^]]*)\)/) { + my $interface = $1; + my $implementation = $3; + $self->{data_gears_with_count}->{$interface}->{caller}->{$cbc_file}++; + $self->{data_gears_with_count}->{$implementation}->{caller}->{$cbc_file}++; + $counter{interfaces}->{$interface}++; + $counter{impl}->{$implementation}++; + next; + } + + if ($line =~ /Gearef\(context,\s*(\w+)\)/) { + my $implementation = $1; + $counter{impl}->{$implementation}++; + $self->{data_gears_with_count}->{$implementation}->{caller}->{$cbc_file}++; + next; + } + + if ($line =~ /ALLOCATE_(?:PTR_)?ARRAY\(context,\s*(\w+),[\s\w]+\)/) { + my $implementation = $1; + $counter{impl}->{$implementation}++; + $self->{data_gears_with_count}->{$implementation}->{caller}->{$cbc_file}++; + next; + } + + if ($line =~ /ALLOCATE_DATA_GEAR\((\w+),\s*(\w+)\)/) { + my $implementation = $2; + $counter{impl}->{$implementation}++; + $self->{data_gears_with_count}->{$implementation}->{caller}->{$cbc_file}++; + next; + } + + #TaskManagerImpl* taskManager = (TaskManagerImpl*)GearImpl(context, TaskManager, taskManager); + if ($line =~ /\((\w+)\*\)GearImpl\(context,\s*(\w+),\s*(\w+)\)/) { + my $interface = $2; + my $implementation = $1; + $self->{data_gears_with_count}->{$interface}->{caller}->{$cbc_file}++; + $counter{interfaces}->{$interface}++; + $counter{impl}->{$implementation}++; + next; + } + + if ($line =~ /^__code/) { + while ($line =~ /struct (\w+)\s*\*/g) { + next if $1 eq "Context"; + $self->{data_gears_with_count}->{$1}->{caller}->{$cbc_file}++; + next if (exists $counter{interfaces}->{$1}); + $counter{impl}->{$1}++; + } + } + } + close $fh; + } + $counter{interfaces}->{Meta}++; + $counter{interfaces}->{TaskManager}++; + $self->{data_gears_with_count}->{Meta}++; + $self->{data_gears_with_count}->{TaskManager}++; + return \%counter; +} + +sub set_data_gear_header_path { + my $self = shift; + my @data_gears_name; + if (@_) { + @data_gears_name = @_; + } else { + map { push (@data_gears_name,$_) if $_ ne "Context" } keys %{$self->{data_gears_with_count}}; + } + return _find_headers($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"; + } + } + } + return $new_dgs; +} + +sub tree2create_context_h { + my ($self, $dg2path) = @_; + + my $data_struct_str = $dg2path ? $self->tree2data_struct_str($dg2path) : "\n"; + + my $output = $self->_select_output(); + Gears::Context::Template::XV6->emit_top_header($output); + Gears::Context::Template::XV6->emit_data_gears($output,$data_struct_str); + Gears::Context::Template::XV6->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; +} + +sub tree2data_struct_str { + my ($self, $dg_str) = @_; + my $data_struct_str = ""; + for my $interface (sort keys %$dg_str) { + $data_struct_str .= Gears::Util->h2context_str($dg_str->{$interface}->{elem}); + next unless ($dg_str->{$interface}->{impl}); + for my $impl (sort keys %{$dg_str->{$interface}->{impl}}) { + $data_struct_str .= Gears::Util->h2context_str($dg_str->{$interface}->{impl}->{$impl}); + } + } + return $data_struct_str; +} + +sub createImplTree_from_header { + my ($self, $dg2path) = @_; + my %dg_str = (); + + my $inters = $dg2path->{interfaces}; + my $impls = $dg2path->{impl}; + + use Data::Dumper; + use DDP {deparse => 1}; + print Dumper $dg2path; + p $self; + + map { $dg_str{$_}->{elem} = Gears::Util->parse_interface($inters->{$_}) } keys %$inters; + + map { + my $res = Gears::Util->parse($impls->{$_}); + if ($res->{isa}) { + $dg_str{$res->{isa}}->{impl}->{$_} = $res; + } else { + $dg_str{$_}->{elem} = $res; + } + } keys %$impls; + return \%dg_str; +} + +sub _find_headers { + my ($search_bash_path, $targets) = @_; + my %res; + map { $res{$_}++ } @$targets; + + my $header_paths = Gears::Util->find_headers_path($search_bash_path); + map { + /(\w+)\.h/; + my $header_tile = $1; + if (exists $res{$header_tile}){ + $res{$header_tile} = $_; + } + } @$header_paths; + return \%res; +} + +1;