Mercurial > hg > Members > menikon > CbC_xv6
annotate src/gearsTools/update_context.pl @ 213:f4effd36aefc
kpt_alloc
| author | tobaru |
|---|---|
| date | Thu, 23 Jan 2020 21:24:30 +0900 |
| parents | 7f9dac064c5f |
| children |
| rev | line source |
|---|---|
| 97 | 1 #!/usr/bin/env perl |
| 2 use strict; | |
| 3 use warnings; | |
| 4 use Getopt::Std; | |
| 5 | |
|
102
b84aac4ab529
import trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
101
diff
changeset
|
6 use FindBin; |
|
b84aac4ab529
import trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
101
diff
changeset
|
7 use lib "$FindBin::Bin/lib"; |
|
b84aac4ab529
import trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
101
diff
changeset
|
8 use Gears::Util; |
|
b84aac4ab529
import trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
101
diff
changeset
|
9 |
|
100
37a0df8b1889
tweak update_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
99
diff
changeset
|
10 my %opt; |
|
37a0df8b1889
tweak update_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
99
diff
changeset
|
11 getopts("wc" => \%opt); |
|
37a0df8b1889
tweak update_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
99
diff
changeset
|
12 |
| 97 | 13 my $interface_file = shift or die "require itnerface file"; |
|
102
b84aac4ab529
import trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
101
diff
changeset
|
14 my $h2context = Gears::Util->parse_interface($interface_file); |
| 136 | 15 my $context = Gears::Util->h2context_str($h2context); |
| 97 | 16 |
|
100
37a0df8b1889
tweak update_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
99
diff
changeset
|
17 if ($opt{c}) { |
|
37a0df8b1889
tweak update_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
99
diff
changeset
|
18 print "$context"; |
|
37a0df8b1889
tweak update_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
99
diff
changeset
|
19 exit 0; |
|
37a0df8b1889
tweak update_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
99
diff
changeset
|
20 } |
|
37a0df8b1889
tweak update_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
99
diff
changeset
|
21 |
|
37a0df8b1889
tweak update_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
99
diff
changeset
|
22 my ($first,$last) = slup_context_h($h2context->{name}); |
| 97 | 23 |
| 24 if ($opt{w}) { | |
| 25 context_write(@{$first},$context,@{$last}); | |
| 26 } else { | |
| 27 context_dump(@{$first},$context,@{$last}); | |
| 28 } | |
| 29 | |
| 30 | |
| 31 sub slup_context_h { | |
| 32 open my $fh, '<', 'context.h'; | |
| 33 | |
| 34 my $data_gear_name = shift; | |
| 35 | |
| 36 my @first_context_headers = (); | |
| 37 my @last_context_headers = (); | |
| 38 | |
| 39 while (my $line = <$fh>) { | |
| 99 | 40 if ( $line =~ /union Data end/) { |
| 97 | 41 push(@last_context_headers, $line); |
| 42 push(@last_context_headers, <$fh>); | |
| 43 last; | |
| 44 } | |
| 45 if ( $line =~ /struct $data_gear_name/) { | |
| 46 print "WARN! $data_gear_name struct already exists\n"; | |
| 47 exit 1; | |
| 48 } | |
| 49 push(@first_context_headers, $line); | |
| 50 } | |
|
102
b84aac4ab529
import trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
101
diff
changeset
|
51 |
| 97 | 52 close $fh; |
| 53 | |
|
102
b84aac4ab529
import trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
101
diff
changeset
|
54 #print "@first_context_headers\n"; |
|
b84aac4ab529
import trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
101
diff
changeset
|
55 #print "@last_context_headers\n"; |
| 97 | 56 return (\@first_context_headers,\@last_context_headers); |
| 57 } | |
| 58 | |
| 59 sub context_dump { | |
| 60 for my $line (@_) { | |
| 61 print "$line"; | |
| 62 } | |
| 63 } | |
| 64 | |
| 65 sub context_write { | |
| 66 open my $fh, '>', "context.h"; | |
| 67 for my $line (@_) { | |
| 68 print $fh "$line"; | |
| 69 } | |
| 70 close $fh; | |
| 71 } |