Mercurial > hg > CbC > CbC_xv6
view src/gearsTools/static_gen_header.pl @ 354:fde5f96c6ff1
use common perl script
author | anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Fri, 12 Jun 2020 20:44:01 +0900 |
parents | c958c355f805 |
children | 650fac123133 |
line wrap: on
line source
#!/usr/bin/env perl use strict; use warnings; =head1 DESCRIPTION emit Gears header files =head1 SYNOPSIS % sample.pl --interface list % sample.pl --impl single_linked_list --interface list % sample.pl -w --interface list =cut use Getopt::Long qw/:config posix_default no_ignore_case bundling auto_help/; use Pod::Usage qw/pod2usage/; GetOptions( \my %opt, qw/ interface=s impl=s o=s w /) or pod2usage(1); unless ($opt{interface}) { pod2usage(1); } my ($type, $msg); if ($opt{impl}) { $msg = emit_impl_header($opt{interface}, $opt{impl}); $type = $opt{impl}; } else { $msg = emit_interface_header($opt{interface}); $type = $opt{interface}; } $msg .= emit_last($type); unless ($opt{w} || $opt{o}) { print $msg; exit 0; } my $emit_file; if ($opt{o}) { $emit_file = $opt{o}; } else { $emit_file = "$type.h" } open my $fh, '>', $emit_file; print $fh $msg; close $fh; sub emit_interface_header { my $interface_name = shift; return "typedef struct $interface_name <Type, Impl> {\n"; } sub emit_impl_header { my ($interface_name, $impl_name) = @_; return "typedef struct $impl_name <Type, Isa> impl $interface_name {\n"; } sub emit_last { my $type = shift; my $msg = " __code next(....);\n"; $msg .= "} $type;\n"; return $msg; }