1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
#!perl -w
use strict;
use Pod::Usage;
use Getopt::Std;
$Getopt::Std::STANDARD_HELP_VERSION = 1;
my $trysource = "try.c";
my $tryout = "try.i";
getopts('fF:ekvI:X', \my %opt) or pod2usage();
my($expr, @headers) = @ARGV ? splice @ARGV : "-";
pod2usage "-f and -F <tool> are exclusive\n" if $opt{f} and $opt{F};
foreach($trysource, $tryout) {
unlink $_ if $opt{e};
die "You already have a $_" if -e $_;
}
if ($expr eq '-') {
warn "reading from stdin...\n";
$expr = do { local $/; <> };
}
my($macro, $args) = $expr =~ /^\s*(\w+)((?:\s*\(.*\))?)\s*;?\s*$/s
or pod2usage "$expr doesn't look like a macro-name or macro-expression to me";
if (!(@ARGV = @headers)) {
open my $fh, '<', 'MANIFEST' or die "Can't open MANIFEST: $!";
while (<$fh>) {
push @ARGV, $1 if m!^([^/]+\.h)\t!;
}
push @ARGV, 'config.h' if -f 'config.h';
}
my $header;
while (<>) {
next unless /^#\s*define\s+$macro\b/;
my ($def_args) = /^#\s*define\s+$macro\(([^)]*)\)/;
if (defined $def_args && !$args) {
my @args = split ',', $def_args;
print "# macro: $macro args: @args in $_\n" if $opt{v};
my $argname = "A0";
$args = '(' . join (', ', map {$argname++} 1..@args) . ')';
}
$header = $ARGV;
last;
}
die "$macro not found\n" unless defined $header;
open my $out, '>', $trysource or die "Can't open $trysource: $!";
my $sentinel = "$macro expands to";
my %done_header;
sub do_header {
my $header = shift;
return if $done_header{$header}++;
print $out qq{#include "$header"\n};
}
print $out <<'EOF' if $opt{X};
/* Need to do this like this, as cflags.sh sets it for us come what may. */
#undef PERL_CORE
EOF
do_header('EXTERN.h');
do_header('perl.h');
do_header($header);
do_header('XSUB.h') if $opt{X};
print $out <<"EOF";
#line 4 "$sentinel"
$macro$args
EOF
close $out or die "Can't close $trysource: $!";
print "doing: make $tryout\n" if $opt{v};
system "make $tryout" and die;
# if user wants 'indent' formatting ..
my $out_fh;
if ($opt{f} || $opt{F}) {
# a: indent is a well behaved filter when given 0 arguments, reading from
# stdin and writing to stdout
# b: all our braces should be balanced, indented back to column 0, in the
# headers, hence everything before our #line directive can be ignored
#
# We can take advantage of this to reduce the work to indent.
my $indent_command = $opt{f} ? 'indent' : $opt{F};
if (defined $opt{I}) {
$indent_command .= " $opt{I}";
}
open $out_fh, '|-', $indent_command or die $?;
} else {
$out_fh = \*STDOUT;
}
open my $fh, '<', $tryout or die "Can't open $tryout: $!";
while (<$fh>) {
print $out_fh $_ if /$sentinel/o .. 1;
}
unless ($opt{k}) {
foreach($trysource, $tryout) {
die "Can't unlink $_" unless unlink $_;
}
}
__END__
=head1 NAME
expand-macro.pl - expand C macros using the C preprocessor
=head1 SYNOPSIS
expand-macro.pl [options] [ < macro-name | macro-expression | - > [headers] ]
options:
-f use 'indent' to format output
-F <tool> use <tool> to format output (instead of -f)
-e erase try.[ic] instead of failing when they're present (errdetect)
-k keep them after generating (for handy inspection)
-v verbose
-I <indent-opts> passed into indent
-X include "XSUB.h" (and undefine PERL_CORE)
=cut
|
