| 1 | #!/usr/bin/perl -w |
| 2 | use strict; |
| 3 | |
| 4 | # read embed.fnc and regen/opcodes, needed by regen/embed.pl and makedef.pl |
| 5 | |
| 6 | require 5.004; # keep this compatible, an old perl is all we may have before |
| 7 | # we build the new one |
| 8 | |
| 9 | # Records the current pre-processor state: |
| 10 | my @state; |
| 11 | # Nested structure to group functions by the pre-processor conditions that |
| 12 | # control when they are compiled: |
| 13 | my %groups; |
| 14 | |
| 15 | sub current_group { |
| 16 | my $group = \%groups; |
| 17 | # Nested #if blocks are effectively &&ed together |
| 18 | # For embed.fnc, ordering within the && isn't relevant, so we can |
| 19 | # sort them to try to group more functions together. |
| 20 | foreach (sort @state) { |
| 21 | $group->{$_} ||= {}; |
| 22 | $group = $group->{$_}; |
| 23 | } |
| 24 | return $group->{''} ||= []; |
| 25 | } |
| 26 | |
| 27 | sub add_level { |
| 28 | my ($level, $indent, $wanted) = @_; |
| 29 | my $funcs = $level->{''}; |
| 30 | my @entries; |
| 31 | if ($funcs) { |
| 32 | if (!defined $wanted) { |
| 33 | @entries = @$funcs; |
| 34 | } else { |
| 35 | foreach (@$funcs) { |
| 36 | if ($_->[0] =~ /A/) { |
| 37 | push @entries, $_ if $wanted eq 'A'; |
| 38 | } elsif ($_->[0] =~ /E/) { |
| 39 | push @entries, $_ if $wanted eq 'E'; |
| 40 | } else { |
| 41 | push @entries, $_ if $wanted eq ''; |
| 42 | } |
| 43 | } |
| 44 | } |
| 45 | @entries = sort {$a->[2] cmp $b->[2]} @entries; |
| 46 | } |
| 47 | foreach (sort grep {length $_} keys %$level) { |
| 48 | my @conditional = add_level($level->{$_}, $indent . ' ', $wanted); |
| 49 | push @entries, |
| 50 | ["#${indent}if $_"], @conditional, ["#${indent}endif"] |
| 51 | if @conditional; |
| 52 | } |
| 53 | return @entries; |
| 54 | } |
| 55 | |
| 56 | sub setup_embed { |
| 57 | my $prefix = shift || ''; |
| 58 | open IN, '<', $prefix . 'embed.fnc' or die $!; |
| 59 | |
| 60 | my @embed; |
| 61 | my %seen; |
| 62 | my $macro_depth = 0; |
| 63 | |
| 64 | while (<IN>) { |
| 65 | chomp; |
| 66 | next if /^:/; |
| 67 | next if /^$/; |
| 68 | while (s|\\$||) { |
| 69 | $_ .= <IN>; |
| 70 | chomp; |
| 71 | } |
| 72 | s/\s+$//; |
| 73 | my @args; |
| 74 | if (/^\s*(#|$)/) { |
| 75 | @args = $_; |
| 76 | } |
| 77 | else { |
| 78 | @args = split /\s*\|\s*/, $_; |
| 79 | } |
| 80 | if (@args == 1) { |
| 81 | if ($args[0] !~ /^#\s*(?:if|ifdef|ifndef|else|endif)/) { |
| 82 | die "Illegal line $. '$args[0]' in embed.fnc"; |
| 83 | } |
| 84 | $macro_depth++ if $args[0] =~/^#\s*if(n?def)?\b/; |
| 85 | $macro_depth-- if $args[0] =~/^#\s*endif\b/; |
| 86 | die "More #endif than #if in embed.fnc:$." if $macro_depth < 0; |
| 87 | } |
| 88 | else { |
| 89 | die "Illegal line (less than 3 fields) in embed.fnc:$.: $_" |
| 90 | unless @args >= 3; |
| 91 | my $name = $args[2]; |
| 92 | # only check for duplicates outside of #if's - otherwise |
| 93 | # they may be alternate definitions of the same function |
| 94 | if ($macro_depth == 0) { |
| 95 | die "Duplicate function name: '$name' in embed.fnc:$." |
| 96 | if exists $seen{$name}; |
| 97 | } |
| 98 | $seen{$name} = 1; |
| 99 | } |
| 100 | |
| 101 | push @embed, \@args; |
| 102 | } |
| 103 | die "More #if than #endif by the end of embed.fnc" if $macro_depth != 0; |
| 104 | |
| 105 | close IN or die "Problem reading embed.fnc: $!"; |
| 106 | |
| 107 | open IN, '<', $prefix . 'regen/opcodes' or die $!; |
| 108 | { |
| 109 | my %syms; |
| 110 | |
| 111 | while (<IN>) { |
| 112 | chomp; |
| 113 | next unless $_; |
| 114 | next if /^#/; |
| 115 | my $check = (split /\t+/, $_)[2]; |
| 116 | next if $syms{$check}++; |
| 117 | |
| 118 | # These are all indirectly referenced by globals.c. |
| 119 | push @embed, ['pR', 'OP *', $check, 'NN OP *o']; |
| 120 | } |
| 121 | } |
| 122 | close IN or die "Problem reading regen/opcodes: $!"; |
| 123 | |
| 124 | # Cluster entries in embed.fnc that have the same #ifdef guards. |
| 125 | # Also, split out at the top level the three classes of functions. |
| 126 | # Output structure is actually the same as input structure - an |
| 127 | # (ordered) list of array references, where the elements in the |
| 128 | # reference determine what it is - a reference to a 1-element array is a |
| 129 | # pre-processor directive, a reference to 2+ element array is a function. |
| 130 | |
| 131 | my $current = current_group(); |
| 132 | |
| 133 | foreach (@embed) { |
| 134 | if (@$_ > 1) { |
| 135 | push @$current, $_; |
| 136 | next; |
| 137 | } |
| 138 | $_->[0] =~ s/^#\s+/#/; |
| 139 | $_->[0] =~ /^\S*/; |
| 140 | $_->[0] =~ s/^#ifdef\s+(\S+)/#if defined($1)/; |
| 141 | $_->[0] =~ s/^#ifndef\s+(\S+)/#if !defined($1)/; |
| 142 | if ($_->[0] =~ /^#if\s*(.*)/) { |
| 143 | push @state, $1; |
| 144 | } elsif ($_->[0] =~ /^#else\s*$/) { |
| 145 | die "Unmatched #else in embed.fnc" unless @state; |
| 146 | $state[-1] = "!($state[-1])"; |
| 147 | } elsif ($_->[0] =~ m!^#endif\s*(?:/\*.*\*/)?$!) { |
| 148 | die "Unmatched #endif in embed.fnc" unless @state; |
| 149 | pop @state; |
| 150 | } else { |
| 151 | die "Unhandled pre-processor directive '$_->[0]' in embed.fnc"; |
| 152 | } |
| 153 | $current = current_group(); |
| 154 | } |
| 155 | |
| 156 | return ([add_level(\%groups, '')], |
| 157 | [add_level(\%groups, '', '')], # core |
| 158 | [add_level(\%groups, '', 'E')], # ext |
| 159 | [add_level(\%groups, '', 'A')]); # api |
| 160 | } |
| 161 | |
| 162 | 1; |