Mercurial > hg > Members > menikon > CbC_xv6
view src/gearsTools/lib/Gears/Context.pm @ 181:f9df567f7f2d
tweak_gen_context.pl
author | anatofuz |
---|---|
date | Mon, 20 Jan 2020 16:44:55 +0900 |
parents | 2842d9e65751 |
children | f431400da994 |
line wrap: on
line source
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 =~ m|//\s*:skip|) { next; } if ($line =~ /#interface\s*"(.*)\.h"/ || $line =~ /^\/\/\s*data_gear\s*"(.*)\.(?:h|dg)?"/) { push(@{$counter{interfaces}->{$1}->{$cbc_file}},$.); next; } if ($line =~ m|//\s*Skip:\s*generate_context|) { $line = <$fh>; 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; push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); next; } #Element* element = &ALLOCATE(cbc_context, Element)->Element; if ($line =~ /ALLOCATE\w*\((?:cbc_)?context,\s*(\w+)\)/) { my $implementation = $1; push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); next; } if ($line =~ /ALLOCATE_(?:PTR_)?ARRAY\((?:cbc_)?context,\s*(\w+),[\s\w]+\)/) { my $implementation = $1; push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); next; } if ($line =~ /new\s+(\w+?)\([\w\s]*\);/) { my $implementation = $1; push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); next; } if ($line =~ /ALLOCATE_DATA_GEAR\((\w+),\s*(\w+)\)/) { my $implementation = $2; push(@{$counter{impl}->{$implementation}->{$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; push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.); push(@{$counter{interfaces}->{$interface}->{$cbc_file}},$.); next; } if ($line =~ /^__code/) { while ($line =~ /struct (\w+)\s*\*/g) { next if $1 eq "Context"; next if (exists $counter{interfaces}->{$1}); push(@{$counter{impl}->{$1}->{$cbc_file}},$.); } } } close $fh; } $counter{interfaces}->{Meta}++; $counter{interfaces}->{TaskManager}++; $self->{data_gears_with_count}->{Meta}++; $self->{data_gears_with_count}->{TaskManager}++; use Data::Dumper; print "-----------\n"; print Dumper \%counter; print "-----------\n"; return \%counter; } sub set_data_gear_header_path { my $self = shift; my @data_gears_name; map { push (@data_gears_name,$_) if $_ ne "Context" } @_; 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 = ""; # 定義順で大変なのでオミット ##もとのxv6に登録されているものはcontext.hには定義を書かない #my $alread_defined_str = _already_defined_struct(); #for my $str (sort keys %$dg_str) { # if (defined $alread_defined_str->{$str}) { # my $str_name = $alread_defined_str->{$str}; # $data_struct_str .= "struct $str_name $str_name;\n"; # delete $dg_str->{$str_name}; # } #} #定義されてないものはcontext.hに書くフォーマットに合わせておく 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; print Dumper $dg2path; print Dumper $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 { if (/(\w+)\.(?:h|dg)/) { my $header_file = $1; if (exists $res{$header_file}) { if ($res{$header_file} =~ /^\d+$/){ $res{$header_file} = $_; } elsif (($_ =~ /\.dg$/) && ($res{$header_file} =~ /\.h$/)) { $res{$header_file} = $_; } } } } sort @$header_paths; return \%res; } sub _already_defined_struct { my @struct_list = qw/ __jmp_buf_tag buf cbc_devsw context cpu devsw dinode dirent elfhdr file inode pipe proc proghdr spinlock stat superblock trapframe /; my %def_hash; map { $def_hash{$_} = $_} @struct_list; return \%def_hash; } 1;