Mercurial > hg > Gears > Gears
view src/parallel_execution/lib/Gears/Util.pm @ 666:9bf4e49d3399
...
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 18 Aug 2020 19:45:26 +0900 |
parents | 24571f9c6187 |
children | 72b7863ea5b4 |
line wrap: on
line source
package Gears::Util; use strict; use warnings; use Carp qw/croak/; 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"; } return $ir; } sub _parse_base { 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{]+)/) { die "invalied struct name $1" unless $1; $ir->{name} = $1; if ($2 =~ 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); 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; while (($i < scalar @code_gears) && (my $line = <$fh>)) { my $cg = $code_gears[$i]; if ($line =~ m|__code $cg\(([()\.\*\s\w,_]+)\)|) { $code_gears[$i] = { name => $cg, args => $1, }; $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; } #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; #print "-----------\n"; return \%counter; } 1;