Mercurial > hg > CbC > CbC_xv6

comparison src/gearsTools/update_header.pl @ 255:07c731e47330

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
add update_header.pl (uncomplete...)
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Tue, 04 Feb 2020 16:51:27 +0900
parents
children
comparison
equal deleted inserted replaced
253:124c51584208 255:07c731e47330
1 #!/usr/bibn/env perl
2 use strict;
3 use warnings;
4
5 use Carp qw/croak/;
6 use DDP {deparse => 1};
7
8 my $header_file = shift // croak 'require header file!';
9 my ($header_con,$interface_name) = search_slurp_header_file($header_file);
10
11 my %cbc_code_names = ( order => 0, codes => {});
12
13 while (@ARGV) {
14 face_or_impl = find_codes_from_cbc(shift @ARGV, $interface_name, \%cbc_code_names);
15 }
16
17 map { push(@{$cbc_code_names{order_list}}, [$_,$cbc_code_names{codes}->{$_}->{order}])}
18 sort { $cbc_code_names{codes}->{$a}->{order} <=> $cbc_code_names{codes}->{$b}->{order} } keys %{$cbc_code_names{codes}};
19
20 p $header_con;
21 p %cbc_code_names;
22
23 sub search_slurp_header_file {
24 my $header_file = shift;
25
26 my %contents;
27 my %order;
28 my $i = 0;
29 my $interface_name;
30
31 open my $fh, '<', $header_file;
32
33 if (<$fh> =~ /struct (\w+)\s*</) {
34 $interface_name = $1;
35 }
36 while (my $line = <$fh>) {
37 chomp $line;
38 if ($line =~ /\A\s*__code (\w+)\(/) {
39 $contents{$1} = $line;
40 $order{$1} = $i;
41 $i++;
42 }
43 }
44 close $fh;
45 my @order_code_names;
46 map { push(@order_code_names, [$_,$order{$_}])} sort { $order{$a} <=> $order{$b} } keys %order;
47 return { codes => \%contents, order => \@order_code_names }, $interface_name;
48 }
49
50 sub find_codes_from_cbc {
51 my ($cbc_file, $inter_name, $ccn) = @_;
52
53 #my $inter_name = $header_type->{interface} // undef;
54 #my $impl_name = $header_type->{impl} // undef;
55
56
57 open my $fh, '<', $cbc_file;
58 while (my $line = <$fh>) {
59 chomp $line;
60 if ($line =~ /\A\s*__code (\w+)\(/) {
61 my $cg_name = $1;
62 $line =~ s/\s+{\s*/;/;
63 $line =~ s/struct $inter_name/Type/g;
64 $ccn->{codes}->{$cg_name} = { line =>$line, file => $cbc_file, order => $ccn->{order} };
65 $ccn->{order}++;
66 }
67 }
68 close $fh;
69 }
70
71 sub create_new_header_codes {
72 my ($header_con, $cbc_con) = @_;
73 while (@{$header_con->{order}}) {
74 my ($header_cg_name, $hader_cg_order) = @{$header_con->{order}->[0]};
75 }
76 }