Mercurial > hg > CbC > CbC_xv6
changeset 341:97e3acfa9fba
update trans_impl from gears
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 24 Feb 2020 16:15:52 +0900 |
parents | b09689bf7f8d |
children | 1a63c120f2ba |
files | src/gearsTools/trans_impl.pl |
diffstat | 1 files changed, 42 insertions(+), 31 deletions(-) [+] |
line wrap: on
line diff
--- a/src/gearsTools/trans_impl.pl Fri Feb 21 21:41:46 2020 +0900 +++ b/src/gearsTools/trans_impl.pl Mon Feb 24 16:15:52 2020 +0900 @@ -18,19 +18,32 @@ my $inter_ir = Gears::Util->parse_with_separate_code_data_gears($interface_file); +my $interface_var_name = shift @{$inter_ir->{data}}; + +if ($interface_var_name =~ /union\s*Data\*\s*(\w+)/) { + $interface_var_name = $1; +} + +my $impl_var_name = lcfirst $impl_ir->{name}; +$impl_var_name =~ s/([A-Z])/_\l$1/g; + +my $interface = {ir => $inter_ir, var_name => $interface_var_name}; +my $impl = {ir => $impl_ir, var_name => $impl_var_name}; + + my $output_file = $impl_file; $output_file =~ s/\.h/.cbc/; my $stdout = *STDOUT; if ($opt{w}) { if(-f $output_file) { - update_file($output_file, $inter_ir, $impl_ir, $impl_file); + update_file($output_file, $interface, $impl, $impl_file); exit 0; } open $stdout, '>', $output_file; } elsif ($opt{o}) { if(-f $opt{o}) { - update_file($opt{o}, $inter_ir, $impl_ir, $impl_file); + update_file($opt{o}, $interface, $impl, $impl_file); exit 0; } open $stdout, '>', $opt{o}; @@ -38,7 +51,7 @@ emit_include_part($stdout, $inter_ir->{name}); emit_impl_header_in_comment($stdout, $impl_file); -emit_constracutor($stdout,$impl_ir,$inter_ir); +emit_constracutor($stdout,$impl,$interface); emit_code_gears($stdout,$impl_ir,$inter_ir); close $stdout; @@ -59,25 +72,23 @@ print $out "// ----\n\n"; } + sub emit_constracutor { - my ($out, $impl_ir, $inter_ir) = @_; + my ($out, $impl, $interface) = @_; + + my $impl_ir = $impl->{ir}; + my $inter_ir = $impl->{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}}; - my $instance_inter = shift @inter_data; - - if ($instance_inter =~ /union\s*Data\*\s*(\w+)/) { - $instance_inter = $1; - } - - my $instance_impl = lcfirst $impl_ir->{name}; - $instance_impl =~ s/([A-Z])/_\l$1/g; print $out <<"EOF"; $impl_ir->{isa}* create$impl_ir->{name}(struct Context* cbc_context) { - struct $impl_ir->{isa}* $instance_inter = new $impl_ir->{isa}(); - struct $impl_ir->{name}* $instance_impl = new $impl_ir->{name}(); - $instance_inter->$instance_inter = (union Data*)$instance_impl; + 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) { @@ -87,20 +98,20 @@ } if ($datum =~ /\w+\s\w+\*\s(\w+)/) { - print $out " ${instance_impl}->$1 = NULL;\n"; + print $out " ${impl_var_name}->$1 = NULL;\n"; next; } if ($datum =~ /\w+\s\w+\s(\w+)/) { - print $out " ${instance_impl}->$1 = 0;\n"; + 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 " ${instance_impl}->$var_name = NULL;\n"; + print $out " ${impl_var_name}->$var_name = NULL;\n"; } else { - print $out " ${instance_impl}->$var_name = 0;\n"; + print $out " ${impl_var_name}->$var_name = 0;\n"; } } } @@ -109,16 +120,16 @@ for my $code (@{$impl_ir->{codes}}) { my $code_gear = $code->{name}; next if $code_gear eq 'next'; - print $out " ${instance_impl}->$code_gear = C_$code_gear;\n" + print $out " ${impl_var_name}->$code_gear = C_$code_gear$impl_ir->{name};\n" } for my $code (@{$inter_ir->{codes}}) { my $code_gear = $code->{name}; next if $code_gear eq 'next'; - print $out " ${instance_inter}->$code_gear = C_$code_gear$impl_ir->{name};\n" + print $out " ${interface_var_name}->$code_gear = C_$code_gear$impl_ir->{name};\n" } -print $out " return $instance_inter;\n"; +print $out " return $interface_var_name;\n"; print $out "}\n"; } @@ -129,12 +140,12 @@ my $interface_name = $inter_ir->{name}; my @inter_data = @{$inter_ir->{data}}; - my $instance_inter = shift @inter_data; - if ($instance_inter =~ /union\s*Data\*\s*(\w+)/) { - $instance_inter = $1; + my $interface_var_name = shift @inter_data; + if ($interface_var_name =~ /union\s*Data\*\s*(\w+)/) { + $interface_var_name = $1; } - my $instance_impl = lcfirst $impl_ir->{name}; - $instance_impl =~ s/([A-Z])/_\l$1/g; + my $impl_var_name = lcfirst $impl_ir->{name}; + $impl_var_name =~ s/([A-Z])/_\l$1/g; my $data_gear_types = {}; if (defined $impl_ir->{codes}) { @@ -189,12 +200,12 @@ } sub update_file { - my ($output_file, $inter_ir, $impl_ir, $impl_file) = @_; - my $under_code = collection_save_code_gears($output_file,$inter_ir->{name}); + my ($output_file, $interface, $impl, $impl_file) = @_; + my $under_code = collection_save_code_gears($output_file,$interface->{var_name}); open my $fh, '>', $output_file; - emit_include_part($fh, $inter_ir->{name}); + emit_include_part($fh, $interface->{var_name}); emit_impl_header_in_comment($fh, $impl_file); - emit_constracutor($fh,$impl_ir,$inter_ir); + emit_constracutor($fh,$impl,$interface); map { print $fh $_ } @{$under_code}; close $fh; }