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;