Mercurial > hg > CbC > CbC_xv6
changeset 339:75df4b25f6a5
update from Gears
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Fri, 21 Feb 2020 21:41:05 +0900 |
parents | 2cbaa4c74d15 |
children | b09689bf7f8d |
files | src/gearsTools/trans_impl.pl |
diffstat | 1 files changed, 24 insertions(+), 21 deletions(-) [+] |
line wrap: on
line diff
--- a/src/gearsTools/trans_impl.pl Sun Feb 16 18:30:06 2020 +0900 +++ b/src/gearsTools/trans_impl.pl Fri Feb 21 21:41:05 2020 +0900 @@ -74,7 +74,7 @@ $instance_impl =~ s/([A-Z])/_\l$1/g; print $out <<"EOF"; -$impl_ir->{isa}* create$impl_ir->{name}(struct Context* cbc_context) { +$impl_ir->{isa}* create$impl_ir->{name}(struct Context* 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; @@ -108,11 +108,13 @@ 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" } 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" } @@ -136,36 +138,37 @@ my $data_gear_types = {}; if (defined $impl_ir->{codes}) { - for my $cg (@{$impl_ir->{codes}}) { - my $data_gears = $cg->{args}; - while ($data_gears =~ /Type\*\s*(\w+),/g) { - $data_gears =~ s/Type\*/struct $impl*/; - } + replace_code_gears($impl_ir,$impl,$interface_name,1,$out); + } + replace_code_gears($inter_ir,$impl,$interface_name,0,$out); +} + +sub replace_code_gears { + my ($ir, $impl, $interface_name, $is_impl, $out) = @_; + my $replace_impl = $is_impl ? $impl : $interface_name; + + for my $cg (@{$ir->{codes}}) { + next if ($cg->{name} eq 'next'); + my $data_gears = $cg->{args}; + while ($data_gears =~ /Type\*\s*(\w+),/g) { + $data_gears =~ s/Type\*/struct $replace_impl*/; + } + + if ($is_impl) { while ($data_gears =~ /Isa\*\s*(\w+),/g) { $data_gears =~ s/Isa\*/struct $interface_name*/; } - print $out "__code $cg->{name}$impl("; - print $out "$data_gears) {\n\n"; - _emit_cg($out,$data_gears); - + } else { + $data_gears =~ s/Impl/struct $impl/g; } - } - - for my $code_ir (@{$inter_ir->{codes}}) { - my $data_gears = $code_ir->{args}; - $data_gears =~ s/Impl/struct $impl/g; - - while ($data_gears =~ /Type\*\s*(\w+),/g) { - $data_gears =~ s/Type\*/struct $interface_name*/; - } - - print $out "__code $code_ir->{name}$impl("; + print $out "__code $cg->{name}$impl("; print $out "$data_gears) {\n\n"; _emit_cg($out,$data_gears); } } + sub _emit_cg { my ($out, $data_gears) = @_; my @cg = ();