Mercurial > hg > Members > menikon > CbC_xv6
view src/gearsTools/update_context.pl @ 213:f4effd36aefc
kpt_alloc
author | tobaru |
---|---|
date | Thu, 23 Jan 2020 21:24:30 +0900 |
parents | 7f9dac064c5f |
children |
line wrap: on
line source
#!/usr/bin/env perl use strict; use warnings; use Getopt::Std; use FindBin; use lib "$FindBin::Bin/lib"; use Gears::Util; my %opt; getopts("wc" => \%opt); my $interface_file = shift or die "require itnerface file"; my $h2context = Gears::Util->parse_interface($interface_file); my $context = Gears::Util->h2context_str($h2context); if ($opt{c}) { print "$context"; exit 0; } my ($first,$last) = slup_context_h($h2context->{name}); if ($opt{w}) { context_write(@{$first},$context,@{$last}); } else { context_dump(@{$first},$context,@{$last}); } sub slup_context_h { open my $fh, '<', 'context.h'; my $data_gear_name = shift; my @first_context_headers = (); my @last_context_headers = (); while (my $line = <$fh>) { if ( $line =~ /union Data end/) { push(@last_context_headers, $line); push(@last_context_headers, <$fh>); last; } if ( $line =~ /struct $data_gear_name/) { print "WARN! $data_gear_name struct already exists\n"; exit 1; } push(@first_context_headers, $line); } close $fh; #print "@first_context_headers\n"; #print "@last_context_headers\n"; return (\@first_context_headers,\@last_context_headers); } sub context_dump { for my $line (@_) { print "$line"; } } sub context_write { open my $fh, '>', "context.h"; for my $line (@_) { print $fh "$line"; } close $fh; }