changeset 700:8416928992fc

impl collect_codegears_from_all_cbc_sources
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Sat, 22 Aug 2020 13:53:50 +0900
parents 4d99aad53969
children f406b70c6e7a
files src/parallel_execution/generate_stub.pl src/parallel_execution/lib/Gears/Util.pm
diffstat 2 files changed, 57 insertions(+), 23 deletions(-) [+]
line wrap: on
line diff
--- a/src/parallel_execution/generate_stub.pl	Sat Aug 22 08:22:34 2020 +0900
+++ b/src/parallel_execution/generate_stub.pl	Sat Aug 22 13:53:50 2020 +0900
@@ -5,8 +5,6 @@
 use Getopt::Long;
 use File::Path qw/make_path/;
 use File::Basename qw/basename dirname/;
-use File::Spec qw/rel2abs/;
-
 
 use FindBin;
 use lib "$FindBin::Bin/lib";
@@ -172,7 +170,7 @@
                 if ($cbc_source_path) {
                     &getCodeGear($cbc_source_path);
                 }
-                my $vname2type = parseCodeGearDeclarationArg($args);
+                my $vname2type = Gears::Util->parseCodeGearDeclarationArg($args);
                 for my $vname (keys %$vname2type) {
                   $codeGearInfo->{$codeGearName}->{arg}->{$vname} = $vname2type->{$vname};
                 }
@@ -236,7 +234,7 @@
         if (/__code (\w+)/) {
             next if $described_data_gear;
             my $args = $';
-            my $tname2type = parseCodeGearDeclarationArg($args);
+            my $tname2type = Gears::Util->parseCodeGearDeclarationArg($args);
             for my $tname (keys %$tname2type) {
               $var{$name}->{$tname} = $tname2type->{$tname};
             }
@@ -250,23 +248,6 @@
 
 }
 
-sub parseCodeGearDeclarationArg {
-    my ($args) = @_;
-    my %tname2type;
-    while ($args =~ /\s*(struct|union|const|enum)?\s*([\w\[\]_]+)\*?\s*(\w+),?/g) {
-      #$args eq  (Impl* vm, pde_t* pgdir, char* init, uint sz, __code next(...));
-      my $const_type = $1;
-      my $ttype = $2;
-      my $tname = $3;
-
-      $ttype =~ s/(Impl|Isa|Type)/Data/;
-      if ($const_type && ($const_type =~ /(const|enum)/)) {
-        $ttype = "$1 $ttype";
-      }
-      $tname2type{$tname} = $ttype;
-    }
-    return \%tname2type;
-}
 
 sub getCodeGear {
     my ($filename) = @_;
--- a/src/parallel_execution/lib/Gears/Util.pm	Sat Aug 22 08:22:34 2020 +0900
+++ b/src/parallel_execution/lib/Gears/Util.pm	Sat Aug 22 13:53:50 2020 +0900
@@ -4,6 +4,10 @@
 use Carp qw/croak/;
 use File::Find qw/find/;
 
+my $cbc_files;
+my $headers_files;
+my $cbc_files_analyzed_code_gear;
+
 sub uniq {
   my $class = shift;
   my %seen;
@@ -31,20 +35,69 @@
   my ($class, $find_path) = @_;
   $find_path //= ".";
 
+  return $cbc_files if $cbc_files;
+
   my @files;
   find( { wanted => sub { push @files, $_ if /\.cbc/ }, no_chdir => 1 }, $find_path);
 
-  return \@files;
+  $cbc_files = \@files;
+  return $cbc_files;
 }
 
 sub find_headers_from_path {
   my ($class, $find_path) = @_;
   $find_path //= ".";
+  return $headers_files if $headers_files;
 
   my @files;
   find( { wanted => sub { push @files, $_ if /\.(?:h|dg)/ }, no_chdir => 1 }, $find_path);
 
-  return \@files;
+  $headers_files = \@files;
+  return $headers_files;
 }
 
+sub collect_codegears_from_all_cbc_sources {
+  my ($class, $find_path) = @_;
+
+  if ($cbc_files_analyzed_code_gear) {
+    return $cbc_files_analyzed_code_gear;
+  }
+
+  Gears::Util->find_cbc_sources_from_path($find_path) unless ($cbc_files);
+  my $codes;
+  for my $file (@$cbc_files) {
+    open my $fh, '<', $file;
+    while (my $line = <$fh>) {
+      if ($line =~ /^__code\s+(\w+)\((.*)\)\s*\{/) {
+        my $codeGear = $1;
+        my $arg = $2;
+        $codes->{$file}->{$codeGear} = $arg;
+      }
+    }
+    close $fh;
+  }
+
+  $cbc_files_analyzed_code_gear = $codes;
+  return $cbc_files_analyzed_code_gear;
+}
+
+sub parseCodeGearDeclarationArg {
+    my ($clas, $args) = @_;
+    my %tname2type;
+    while ($args =~ /\s*(struct|union|const|enum)?\s*([\w\[\]_]+)\*?\s*(\w+),?/g) {
+      #$args eq  (Impl* vm, pde_t* pgdir, char* init, uint sz, __code next(...));
+      my $const_type = $1;
+      my $ttype = $2;
+      my $tname = $3;
+
+      $ttype =~ s/(Impl|Isa|Type)/Data/;
+      if ($const_type && ($const_type =~ /(const|enum)/)) {
+        $ttype = "$1 $ttype";
+      }
+      $tname2type{$tname} = $ttype;
+    }
+    return \%tname2type;
+}
+
+
 1;