view src/parallel_execution/lib/Gears/Util.pm @ 681:04df4583de36

...
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Fri, 21 Aug 2020 05:59:24 +0900
parents c65f8f00ba6f
children 49d57e7fce39
line wrap: on
line source

package Gears::Util;
use strict;
use warnings;
use Carp qw/croak carp/;
use File::Find;

sub parse {
  my ($class, $file_name) = @_;
  my $ir = _parse_base($file_name);
  return $ir;
}


sub parse_interface {
  my ($class, $file_name) = @_;
  my $ir = _parse_base($file_name);

  unless ($ir->{name}) {
    croak "invalid struct name $file_name";
}


sub _parse_base {

    # create this data structure
    #  \ {
    #    content     [
    #        [0]  "union Data* stack;
    #",
    #        [1]  "union Data* data;
    #",
    #        [2]  "union Data* data1;
    #",
    #        [3]  "enum Code whenEmpty;
    #",
    #        [4]  "enum Code clear;
    #",
    #        [5]  "enum Code push;
    #",
    #        [6]  "enum Code pop;
    #",
    #        [7]  "enum Code pop2;
    #",
    #        [8]  "enum Code isEmpty;
    #",
    #        [9]  "enum Code get;
    #",
    #        [10] "enum Code get2;
    #",
    #        [11] "enum Code next;
    #"
    #    ],
    #    file_name   "/Users/anatofuz/src/firefly/hg/Gears/Gears/src/parallel_execution/tools/../Stack.h",
    #    name        "Stack"
    #}

  my ($file,$code_verbose) = @_;
  my $ir  = {};
  $ir->{file_name} = $file;

  Gears::Util->file_checking($file);
  open my $fh, '<', $file;
  my $line = <$fh>;
  my $static_data_gear_write_mode = 0;

  my $directory_containing_file = "";

  if ($file  =~ m<([\.\w/]+)/\w+\.(?:cbc|h|c)>) {
     $directory_containing_file = $1;
  }


  while ($line =~ /#include\s+"([\w\/\.]+)"/) {
    my $header_file = $1;
    if ($header_file =~ m|\./context\.h|) {
      next;
     }
    push(@{$ir->{cbc_context_include_headers}}, "$directory_containing_file/$header_file");
    $line = <$fh>;
  }

  # skip space

  while ($line =~ /^\s*$/) {
    $line = <$fh>;
  }

  if ($line =~ /typedef struct (\w+)\s?<.*>([\s\w{]+)/) {
    my $vname = $1;
    unless ($vname) {
      carp "[WARN] invalied struct name from $file";
      return undef;
    }
    $ir->{name} = $vname;
    my $annotation = $2;

    if ($annotation =~ m|\s*impl\s*([\w+]+)\s*{|) {
      $ir->{isa} = $1;
    }
  }

  unless ($ir->{name}) {
    return undef;
  }

  my @tmp_args;
  while ($line = <$fh>) {
    if ($line =~ m|\s*/\*|) {
      while ( $line !~ m|\*/|) {
        $line = <$fh>;
        next;
      }
      next;
    }
    next if ($line =~ /^\s+$/);
    next if ($line =~ m[^\s*//]);
    next if ($line =~ m[^\}\s*$ir->{name};]);

    if ($line =~ m|__code (\w+)|) {
      push(@tmp_args,"enum Code $1;\n");
      next if $static_data_gear_write_mode;
      my $args = $';
      #$args eq  (Impl* vm, pde_t* pgdir, char* init, uint sz, __code next(...));
      while ($args =~ /\s*(struct|union|const|enum)?\s*([\w*\[\]_]+)\s*(\w+)?,?/g) {
        my $const_type = $1;
        my $type = $2;
        my $vname = $3;
        next if ($type eq '__code');
        next unless $vname; # __code hoge(int ret, __code next(ret, ...); this is second "ret" case
        $type =~ s/^(?:Impl|Type|Isa)\s*(\*)?/union Data$1/;
        my $val = "$type $vname;\n";
        push(@tmp_args, $const_type ?  "$const_type $val" : $val);
      }
      next;
    }

    $line =~ s/^\s+//;
    push(@tmp_args,$line);
    $static_data_gear_write_mode = 1;
  }

  push(@{$ir->{content}}, _uniq(@tmp_args));
  return $ir;
}

sub _uniq {
  my %seen;
  return grep { !$seen{$_}++ } @_;
}

sub separate_code_and_data_gear_after_parse {
# create this data structure
#\ {
#    codes       [
#        [0] {
#            args   "Impl* stackTest, struct Stack* stack, __code next(...)",
#            name   "insertTest1"
#        },
#        [1] {
#            args   "Impl* stackTest, struct Stack* stack, __code next(...)",
#            name   "insertTest2"
#        },
#        [2] {
#            args   "Impl* stackTest, struct Stack* stack, __code next(...)",
#            name   "pop2Test"
#        },
#        [3] {
#            args   "Impl* stackTest, union Data* data, union Data* data1, struct Stack* stack, __code next(...)",
#            name   "pop2Test1"
#        },
#        [4] {
#            args   "...",
#            name   "next"
#        }
#    ],
#    content     [
#        [0] "enum Code insertTest1;
#",
#        [1] "union Data* stackTest;
#",
#        [2] "struct Stack* stack;
#",
#        [3] "enum Code insertTest2;
#",
#        [4] "enum Code pop2Test;
#",
#        [5] "enum Code pop2Test1;
#",
#        [6] "union Data* data;
#",
#        [7] "union Data* data1;
#",
#        [8] "enum Code next;
#"
#    ],
#    data        [
#        [0] "union Data* stackTest;
#",
#        [1] "struct Stack* stack;
#",
#        [2] "union Data* data;
#",
#        [3] "union Data* data1;
#"
#    ],
#    file_name   "/Users/anatofuz/src/firefly/hg/Gears/Gears/src/parallel_execution/tools/../examples/pop_and_push/StackTest.h",
#    name        "StackTest"
#}
#

  my ($class, $file)  = @_;
  my $ir = _parse_base($file);

  $ir->{hasOutputArgs} = {};

  my @data_gears;
  my @code_gears;
  map { push (@data_gears, $_) unless ($_ =~ /enum Code/);} @{$ir->{content}};
  map { push (@code_gears, $1) if ($_ =~ /enum Code (\w+);/);} @{$ir->{content}};

  open my $fh , '<', $file;
  my $i = 0;
  my @have_output_data;
  while (($i < scalar @code_gears) && (my $line = <$fh>)) {
      my $codeGearName = $code_gears[$i];
      if ($line =~ m|__code $codeGearName\(([()\.\*\s\w,_]+)\)|) {
        my $arg = $1;
        $code_gears[$i] = {
          name => $codeGearName,
          args => $arg,
        };
        # args   "Impl* stack, __code next(Type* data, Type* data1, ...)",
        if ($arg =~ /__code \w+\((.+),\s*\.\.\.\s*\)/) {
          my $outputArgs = $1;
          while ($outputArgs =~ /([\w*]+)\s(\w+),?/g) {
            my $ttype = $1;
            my $tname = $2;
            $ir->{hasOutputArgs}->{$codeGearName}->{$tname} = $ttype;
          }
        }
        $i++;
      }
  }

  $ir->{codes} = \@code_gears;
  $ir->{data}  = \@data_gears;
  return $ir;
}

sub file_checking {
  my ($class, $file_name) = @_;
  unless (-f $file_name) {
    croak "invalid filepath :$file_name\n";
  }
}

sub slup {
  my ($class,$file) = @_;
  open my $fh, '<', $file;
  local $/;
  my $f = <$fh>;
  return $f;
}


sub find_cbc_sources_from_path {
  my $class = shift;
  my $find_path = shift // ".";

  my @files;
  find( { wanted => sub { push @files, $_ if /\.cbc/ }, no_chdir => 1 }, $find_path);

  return \@files;
}

sub find_headers_from_path {
  my $class = shift;
  my $find_path = shift // ".";

  my @files;
  find( { wanted => sub { push @files, $_ if /\.(?:h|dg)/ }, no_chdir => 1 }, $find_path);

  return \@files;
}

sub extraction_dg_compile_sources {
  my ($class, $compile_sources) = @_;
  my %counter;
  my %include_pool = ();
  for my $cbc_file (@{$compile_sources}) {
    open my $fh , '<', $cbc_file;
    while (my $line = <$fh>) {
        if ($line =~ m|//\s*:skip|) {
         next;
        }

       if ($line =~ /#interface\s*"(.*)\.h"/) {
          push(@{$counter{interfaces}->{$1}->{$cbc_file}},$.);
          next;
       }

       if ($line =~ /^\/\/\s*include\s*"(.*)\.(?:h|dg)?"/) {
          push(@{$include_pool{$1}->{$cbc_file}},$.);
          next;
       }

       if ($line =~ m|//\s*Skip:\s*generate_context|) {
         $line = <$fh>;
         next;
       }


       if ($line =~ /^(\w+)\*\s*create(\w+)\(([*\w\s]+)\)/) {
          my $interface = $1;
          my $implementation = $2;
          my $arg = $3;
          if ($arg eq "") {
            next;
          }
          push(@{$counter{interfaces}->{$interface}->{$cbc_file}},$.);
          push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.);
          next;
       }

       if ($line =~ /Gearef\(context,\s*(\w+)\)/) {
          my $implementation = $1;
          push(@{$counter{impl}->{$implementation}->{$cbc_file}},$.);
          next;
       }

    # ALLOCATE is generated by generate_stub.pl
    # because extraction_dg_compile_sources caller after translated .cbc to .c
    #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;
  }
  use Data::Dumper;

  for my $cg_name (keys %include_pool) {
    my @tmp_cbc_file_names  = keys %{$include_pool{$cg_name}};
    my $tmp_cbc_file_name  = shift @tmp_cbc_file_names;
    if (exists $counter{interfaces}->{$cg_name}){
      push(@{$counter{interfaces}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name});
      delete $include_pool{$cg_name};
      next;
    }

    if (exists $counter{impl}->{$cg_name}){
      push(@{$counter{impl}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name});
      delete $include_pool{$cg_name};
      next;
    }
    push(@{$counter{interfaces}->{$cg_name}->{$tmp_cbc_file_name}},$include_pool{$cg_name}->{$tmp_cbc_file_name});
    delete $include_pool{$cg_name};
  }

  $counter{interfaces}->{Meta}++;
  $counter{interfaces}->{TaskManager}++;
  #print "-----------\n";
  #print Dumper \%counter; #this line is debug message
  #print "-----------\n";
  return \%counter;
}


1;