view src/parallel_execution/lib/Gears/Interface.pm @ 696:69a00f5ff08c

green status
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Fri, 21 Aug 2020 17:40:35 +0900
parents aeab4866ee36
children 4d99aad53969
line wrap: on
line source

package Gears::Interface;
use strict;
use warnings;
use Carp qw/croak carp/;


use Gears::Util;

sub parse {

    # create this data structure

  my ($class, $file) = @_;
  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 @data_gears;
  while ($line = <$fh>) {
    chomp $line;
    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(@data_gears,"enum Code $1;"); #this case insert __code name (__code hoge -> enum Code hoge;)

      #In the case of writing field variables one line at a time, cancel the following
      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;";
        push(@data_gears, $const_type ?  "$const_type $val" : $val);
      }
      next;
    }

    #this is a case of writing field variables one line at a time
    $line =~ s/^\s+//;
    push(@data_gears,$line);
    $static_data_gear_write_mode = 1;
  }

  push(@{$ir->{content}}, Gears::Util->uniq(@data_gears));
  return $ir;
}

sub separate_code_and_data_gear_after_parse {
  my ($class, $file)  = @_;
  my $ir = Gears::Interface->parse($file);

  unless ($ir) {
    return undef;
  }

  $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 =~ /(struct|union|const|enum)?\s*([\w*]+)\s(\w+),?/g) {
            my $structType = $1;
            my $ttype = $2;
            my $tname = $3;
            $ir->{hasOutputArgs}->{$codeGearName}->{$tname} = $ttype;
          }
        }
        $i++;
      }
  }

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


1;