Mercurial > hg > CbC > CbC_xv6
comparison src/gearsTools/update_context.pl @ 97:70eae4b230f2
add update_context.pl
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Thu, 14 Nov 2019 10:14:15 +0900 |
parents | |
children | d0aea70fe1b0 |
comparison
equal
deleted
inserted
replaced
96:d5c4016c65b8 | 97:70eae4b230f2 |
---|---|
1 #!/usr/bin/env perl | |
2 use strict; | |
3 use warnings; | |
4 use Getopt::Std; | |
5 | |
6 my $interface_file = shift or die "require itnerface file"; | |
7 my $h2context = parse_interface($interface_file); | |
8 my $context = dump_h2context($h2context); | |
9 my ($first,$last) = slup_context_h($h2context->{name}); | |
10 | |
11 my %opt; | |
12 getopts("w" => \%opt); | |
13 | |
14 if ($opt{w}) { | |
15 context_write(@{$first},$context,@{$last}); | |
16 } else { | |
17 context_dump(@{$first},$context,@{$last}); | |
18 } | |
19 | |
20 | |
21 sub slup_context_h { | |
22 open my $fh, '<', 'context.h'; | |
23 | |
24 my $data_gear_name = shift; | |
25 | |
26 my @first_context_headers = (); | |
27 my @last_context_headers = (); | |
28 | |
29 while (my $line = <$fh>) { | |
30 if ( $line =~ /this is necessary for context generator/) { | |
31 push(@last_context_headers, $line); | |
32 push(@last_context_headers, <$fh>); | |
33 last; | |
34 } | |
35 if ( $line =~ /struct $data_gear_name/) { | |
36 print "WARN! $data_gear_name struct already exists\n"; | |
37 exit 1; | |
38 } | |
39 push(@first_context_headers, $line); | |
40 } | |
41 | |
42 close $fh; | |
43 | |
44 print "@first_context_headers\n"; | |
45 print "@last_context_headers\n"; | |
46 return (\@first_context_headers,\@last_context_headers); | |
47 } | |
48 | |
49 sub parse_interface { | |
50 my $file_name = shift; | |
51 | |
52 open my $fh, '<', $file_name; | |
53 | |
54 my $h2context = {}; | |
55 | |
56 while (my $line = <$fh>) { | |
57 if ($line =~ /typedef struct (\w+)\s?<.*/) { | |
58 die "invalied struct name $1" unless $1; | |
59 $h2context->{name} = $1; | |
60 next; | |
61 } | |
62 | |
63 if ($line =~ m[/\*|//|}]) { | |
64 next; | |
65 } | |
66 | |
67 if ($line =~ /__code (\w+)\(.*/) { | |
68 push(@{$h2context->{codes}},$1); | |
69 next; | |
70 } | |
71 | |
72 $line =~ s/\s*([\w\s\*]+);\s*/$1/; | |
73 push(@{$h2context->{data}},$1); | |
74 } | |
75 | |
76 close $fh; | |
77 return $h2context; | |
78 } | |
79 | |
80 | |
81 sub dump_h2context { | |
82 my $h2context = shift; | |
83 my $context = ''; | |
84 my $space = ' '; | |
85 #print "${space}struct $h2context->{name} {\n"; | |
86 $context = "${space}struct $h2context->{name} {\n"; | |
87 for my $datum (@{$h2context->{data}}) { | |
88 #print "${space}${space}$datum; \n"; | |
89 $context .= "${space}${space}$datum; \n"; | |
90 } | |
91 for my $code (@{$h2context->{codes}}) { | |
92 #print "${space}${space}enum Code $code;\n"; | |
93 $context .= "${space}${space}enum Code $code;\n"; | |
94 } | |
95 #print "${space}} $h2context->{name};\n"; | |
96 $context .= "${space}} $h2context->{name};\n"; | |
97 return $context; | |
98 } | |
99 | |
100 sub context_dump { | |
101 for my $line (@_) { | |
102 print "$line"; | |
103 } | |
104 } | |
105 | |
106 sub context_write { | |
107 open my $fh, '>', "context.h"; | |
108 for my $line (@_) { | |
109 print $fh "$line"; | |
110 } | |
111 close $fh; | |
112 } |