Mercurial > hg > Gears > Gears
changeset 678:8c147f6e1346
add Stub library
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Wed, 19 Aug 2020 19:31:23 +0900 |
parents | 47910f7c731e |
children | c65f8f00ba6f |
files | src/parallel_execution/lib/Gears/Stub.pm src/parallel_execution/lib/Gears/Stub/GenerateConstructor.pm src/parallel_execution/lib/Gears/Stub/GenerateDataGear.pm |
diffstat | 3 files changed, 121 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parallel_execution/lib/Gears/Stub.pm Wed Aug 19 19:31:23 2020 +0900 @@ -0,0 +1,39 @@ +package Gears::Stub; +use strict; +use warnings; +use Carp qw/croak/; +use File::Find; +use Gears::Util; + +use DDP {deparse => 1}; + +sub new { + my ($class, %args) = @_; + + my $self = {}; + $self->{file_name} = $args{file_name} || croak 'invalid file_name!'; + + return bless $self, $class; +} + + + +sub findInterfacewImpl { + my $self = shift; + my $cbc_file = shift // $self->{file_name}; + my $findInterfaces = Gears::Util->extraction_dg_compile_sources([$cbc_file]); + my $edgcs = Gears::Util->extraction_dg_compile_sources([$cbc_file]); + my $findInterfaces = {}; + + my %ifs = (); + map { $ifs{$_}++ } keys %{$edgcs->{interfaces}}; + delete $ifs{Meta}; + delete $ifs{TaskManager}; + + push(@{$findInterfaces->{interfaces}}, keys %ifs); + push(@{$findInterfaces->{impls}}, keys %{$edgcs->{impl}}); + + return $findInterfaces; +} + +1;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parallel_execution/lib/Gears/Stub/GenerateConstructor.pm Wed Aug 19 19:31:23 2020 +0900 @@ -0,0 +1,68 @@ +package Gears::Stub::GenerateConstructor; + +use strict; +use warnings; + +use Gears::Util; + +sub generate { + my ($out, $impl, $interface) = @_; + + my $impl_ir = $impl->{ir}; + my $inter_ir = $interface->{ir}; + my $impl_var_name = $impl->{var_name}; + my $interface_var_name = $interface->{var_name}; + + my @inter_data = @{$inter_ir->{data}}; + my @impl_data = @{$impl_ir->{data}}; + + print $out <<"EOF"; +$impl_ir->{isa}* create$impl_ir->{name}(struct Context* context) { + struct $impl_ir->{isa}* $interface_var_name = new $impl_ir->{isa}(); + struct $impl_ir->{name}* $impl_var_name = new $impl_ir->{name}(); + $interface_var_name->$interface_var_name = (union Data*)$impl_var_name; +EOF + + for my $datum (@impl_data) { + $datum =~ s|//[\s\w]+||; + if ($datum =~ /^\s+#/) { + next; + } + + if ($datum =~ /\w+\s\w+\*\s(\w+)/) { + print $out " ${impl_var_name}->$1 = NULL;\n"; + next; + } + if ($datum =~ /\w+\s\w+\s(\w+)/) { + print $out " ${impl_var_name}->$1 = 0;\n"; + } + + if ($datum =~ /\w+(\*)?\s(\w+)/) { + my $is_pointer = $1; + my $var_name = $2; + if ($1) { + print $out " ${impl_var_name}->$var_name = NULL;\n"; + } else { + print $out " ${impl_var_name}->$var_name = 0;\n"; + } + } + } + + + for my $code (@{$impl_ir->{codes}}) { + my $code_gear = $code->{name}; + next if $code_gear eq 'next'; + print $out " ${impl_var_name}->$code_gear = C_$code_gear;\n" + } + + for my $code (@{$inter_ir->{codes}}) { + my $code_gear = $code->{name}; + next if $code_gear eq 'next'; + print $out " ${interface_var_name}->$code_gear = C_${code_gear}_$impl_ir->{name};\n" + } + +print $out " return $interface_var_name;\n"; +print $out "}\n"; +} + +1;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/parallel_execution/lib/Gears/Stub/GenerateDataGear.pm Wed Aug 19 19:31:23 2020 +0900 @@ -0,0 +1,14 @@ +package Gears::Stub::GenerateDataGear; +use strict; +use warnings; + + +sub new { + my ($class, %args) = @_; + my $self = {}; + + return bless $self, $class; +} + + +1;