Mercurial > hg > CbC > CbC_xv6
annotate src/gearsTools/update_context.pl @ 125:f103beea19f4
tweak
| author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
|---|---|
| date | Tue, 03 Dec 2019 09:32:33 +0900 |
| parents | b84aac4ab529 |
| children | fb75c5e661c2 |
| 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); |
| 97 | 15 my $context = dump_h2context($h2context); |
| 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 dump_h2context { | |
| 60 my $h2context = shift; | |
| 61 my $context = ''; | |
| 62 my $space = ' '; | |
|
102
b84aac4ab529
import trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
101
diff
changeset
|
63 #print "${space}struct $h2context->{name} {\n"; |
| 97 | 64 $context = "${space}struct $h2context->{name} {\n"; |
| 65 for my $datum (@{$h2context->{data}}) { | |
|
102
b84aac4ab529
import trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
101
diff
changeset
|
66 #print "${space}${space}$datum; \n"; |
|
100
37a0df8b1889
tweak update_context.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
99
diff
changeset
|
67 $context .= "${space}${space}$datum;\n"; |
| 97 | 68 } |
| 69 for my $code (@{$h2context->{codes}}) { | |
|
102
b84aac4ab529
import trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
101
diff
changeset
|
70 #print "${space}${space}enum Code $code;\n"; |
| 97 | 71 $context .= "${space}${space}enum Code $code;\n"; |
| 72 } | |
|
102
b84aac4ab529
import trans_impl.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
101
diff
changeset
|
73 #print "${space}} $h2context->{name};\n"; |
| 97 | 74 $context .= "${space}} $h2context->{name};\n"; |
| 75 return $context; | |
| 76 } | |
| 77 | |
| 78 sub context_dump { | |
| 79 for my $line (@_) { | |
| 80 print "$line"; | |
| 81 } | |
| 82 } | |
| 83 | |
| 84 sub context_write { | |
| 85 open my $fh, '>', "context.h"; | |
| 86 for my $line (@_) { | |
| 87 print $fh "$line"; | |
| 88 } | |
| 89 close $fh; | |
| 90 } |