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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
#!/usr/bin/perl -w
use strict;
# read embed.fnc and regen/opcodes, needed by regen/embed.pl and makedef.pl
require 5.004; # keep this compatible, an old perl is all we may have before
# we build the new one
# Records the current pre-processor state:
my @state;
# Nested structure to group functions by the pre-processor conditions that
# control when they are compiled:
my %groups;
sub current_group {
my $group = \%groups;
# Nested #if blocks are effectively &&ed together
# For embed.fnc, ordering within the && isn't relevant, so we can
# sort them to try to group more functions together.
foreach (sort @state) {
$group->{$_} ||= {};
$group = $group->{$_};
}
return $group->{''} ||= [];
}
sub add_level {
my ($level, $indent, $wanted) = @_;
my $funcs = $level->{''};
my @entries;
if ($funcs) {
if (!defined $wanted) {
@entries = @$funcs;
} else {
foreach (@$funcs) {
if ($_->[0] =~ /A/) {
push @entries, $_ if $wanted eq 'A';
} elsif ($_->[0] =~ /E/) {
push @entries, $_ if $wanted eq 'E';
} else {
push @entries, $_ if $wanted eq '';
}
}
}
@entries = sort {$a->[2] cmp $b->[2]} @entries;
}
foreach (sort grep {length $_} keys %$level) {
my @conditional = add_level($level->{$_}, $indent . ' ', $wanted);
push @entries,
["#${indent}if $_"], @conditional, ["#${indent}endif"]
if @conditional;
}
return @entries;
}
sub setup_embed {
my $prefix = shift || '';
open IN, '<', $prefix . 'embed.fnc' or die $!;
my @embed;
my %seen;
my $macro_depth = 0;
while (<IN>) {
chomp;
next if /^:/;
next if /^$/;
while (s|\\$||) {
$_ .= <IN>;
chomp;
}
s/\s+$//;
my @args;
if (/^\s*(#|$)/) {
@args = $_;
}
else {
@args = split /\s*\|\s*/, $_;
}
if (@args == 1) {
if ($args[0] !~ /^#\s*(?:if|ifdef|ifndef|else|endif)/) {
die "Illegal line $. '$args[0]' in embed.fnc";
}
$macro_depth++ if $args[0] =~/^#\s*if(n?def)?\b/;
$macro_depth-- if $args[0] =~/^#\s*endif\b/;
die "More #endif than #if in embed.fnc:$." if $macro_depth < 0;
}
else {
die "Illegal line (less than 3 fields) in embed.fnc:$.: $_"
unless @args >= 3;
my $name = $args[2];
# only check for duplicates outside of #if's - otherwise
# they may be alternate definitions of the same function
if ($macro_depth == 0) {
die "Duplicate function name: '$name' in embed.fnc:$."
if exists $seen{$name};
}
$seen{$name} = 1;
}
push @embed, \@args;
}
die "More #if than #endif by the end of embed.fnc" if $macro_depth != 0;
close IN or die "Problem reading embed.fnc: $!";
open IN, '<', $prefix . 'regen/opcodes' or die $!;
{
my %syms;
while (<IN>) {
chomp;
next unless $_;
next if /^#/;
my $check = (split /\t+/, $_)[2];
next if $syms{$check}++;
# These are all indirectly referenced by globals.c.
push @embed, ['pR', 'OP *', $check, 'NN OP *o'];
}
}
close IN or die "Problem reading regen/opcodes: $!";
# Cluster entries in embed.fnc that have the same #ifdef guards.
# Also, split out at the top level the three classes of functions.
# Output structure is actually the same as input structure - an
# (ordered) list of array references, where the elements in the
# reference determine what it is - a reference to a 1-element array is a
# pre-processor directive, a reference to 2+ element array is a function.
my $current = current_group();
foreach (@embed) {
if (@$_ > 1) {
push @$current, $_;
next;
}
$_->[0] =~ s/^#\s+/#/;
$_->[0] =~ /^\S*/;
$_->[0] =~ s/^#ifdef\s+(\S+)/#if defined($1)/;
$_->[0] =~ s/^#ifndef\s+(\S+)/#if !defined($1)/;
if ($_->[0] =~ /^#if\s*(.*)/) {
push @state, $1;
} elsif ($_->[0] =~ /^#else\s*$/) {
die "Unmatched #else in embed.fnc" unless @state;
$state[-1] = "!($state[-1])";
} elsif ($_->[0] =~ m!^#endif\s*(?:/\*.*\*/)?$!) {
die "Unmatched #endif in embed.fnc" unless @state;
pop @state;
} else {
die "Unhandled pre-processor directive '$_->[0]' in embed.fnc";
}
$current = current_group();
}
return ([add_level(\%groups, '')],
[add_level(\%groups, '', '')], # core
[add_level(\%groups, '', 'E')], # ext
[add_level(\%groups, '', 'A')]); # api
}
1;
|
