Mercurial > hg > CbC > CbC_xv6

comparison src/gearsTools/static_gen_header.pl @ 343:a9aba14b2b6a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
add static_gen_header script
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Thu, 27 Feb 2020 16:17:40 +0900
parents
children 0e72eb96b6b1
comparison
equal deleted inserted replaced
342:1a63c120f2ba 343:a9aba14b2b6a
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4
5 =head1 DESCRIPTION
6
7 emit Gears header files
8
9 =head1 SYNOPSIS
10
11 % sample.pl --interface list
12 % sample.pl --impl single_linked_list --interface list
13 % sample.pl -w --interface list
14
15 =cut
16
17 use Getopt::Long qw/:config posix_default no_ignore_case bundling auto_help/;
18
19 use Pod::Usage qw/pod2usage/;
20
21 GetOptions(
22 \my %opt, qw/
23 interface=s
24 impl=s
25 o=s
26 w
27 /) or pod2usage(1);
28
29
30 unless ($opt{interface}) {
31 pod2usage(1);
32 }
33
34 my ($type, $msg);
35
36 if ($opt{impl}) {
37 $msg = emit_impl_header($opt{interface}, $opt{impl});
38 $type = $opt{impl};
39 } else {
40 $msg = emit_interface_header($opt{interface});
41 $type = $opt{interface};
42 }
43
44 $msg .= emit_last($type);
45
46 unless ($opt{w} || $opt{o}) {
47 print $msg;
48 exit 0;
49 }
50
51 my $emit_file;
52
53 if ($opt{o}) {
54 $emit_file = $opt{o};
55 } else {
56 $emit_file = "$type.h"
57 }
58
59
60 open my $fh, '>', $emit_file;
61 print $fh $msg;
62 close $fh;
63
64 sub emit_interface_header {
65 my $interface_name = shift;
66 return "typedef struct $interface_name <Type, Impl> {\n";
67 }
68
69 sub emit_impl_header {
70 my ($interface_name, $impl_name) = @_;
71 return "typedef struct $impl_name <Type, Isa> impl $interface_name {\n";
72 }
73
74 sub emit_last {
75 my $type = shift;
76 my $msg = <<"EOF";
77 __code next(....);
78 } $type;
79 EOF
80 return $msg;
81 }