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;