regen/embed_lib.pl

   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
  62     while (<IN>) {
  63         chomp;
  64         next if /^:/;
  65         next if /^$/;
  66         while (s|\\$||) {
  67             $_ .= <IN>;
  68             chomp;
  69         }
  70         s/\s+$//;
  71         my @args;
  72         if (/^\s*(#|$)/) {
  73             @args = $_;
  74         }
  75         else {
  76             @args = split /\s*\|\s*/, $_;
  77         }
  78         if (@args == 1 && $args[0] !~ /^#\s*(?:if|ifdef|ifndef|else|endif)/) {
  79             die "Illegal line $. '$args[0]' in embed.fnc";
  80         }
  81         push @embed, \@args;
  82     }
  83
  84     close IN or die "Problem reading embed.fnc: $!";
  85
  86     open IN, $prefix . 'regen/opcodes' or die $!;
  87     {
  88         my %syms;
  89
  90         while (<IN>) {
  91             chomp;
  92             next unless $_;
  93             next if /^#/;
  94             my $check = (split /\t+/, $_)[2];
  95             next if $syms{$check}++;
  96
  97             # These are all indirectly referenced by globals.c.
  98             push @embed, ['pR', 'OP *', $check, 'NN OP *o'];
  99         }
 100     }
 101     close IN or die "Problem reading regen/opcodes: $!";
 102
 103     # Cluster entries in embed.fnc that have the same #ifdef guards.
 104     # Also, split out at the top level the three classes of functions.
 105     # Output structure is actually the same as input structure - an
 106     # (ordered) list of array references, where the elements in the
 107     # reference determine what it is - a reference to a 1-element array is a
 108     # pre-processor directive, a reference to 2+ element array is a function.
 109
 110     my $current = current_group();
 111
 112     foreach (@embed) {
 113         if (@$_ > 1) {
 114             push @$current, $_;
 115             next;
 116         }
 117         $_->[0] =~ s/^#\s+/#/;
 118         $_->[0] =~ /^\S*/;
 119         $_->[0] =~ s/^#ifdef\s+(\S+)/#if defined($1)/;
 120         $_->[0] =~ s/^#ifndef\s+(\S+)/#if !defined($1)/;
 121         if ($_->[0] =~ /^#if\s*(.*)/) {
 122             push @state, $1;
 123         } elsif ($_->[0] =~ /^#else\s*$/) {
 124             die "Unmatched #else in embed.fnc" unless @state;
 125             $state[-1] = "!($state[-1])";
 126         } elsif ($_->[0] =~ m!^#endif\s*(?:/\*.*\*/)?$!) {
 127             die "Unmatched #endif in embed.fnc" unless @state;
 128             pop @state;
 129         } else {
 130             die "Unhandled pre-processor directive '$_->[0]' in embed.fnc";
 131         }
 132         $current = current_group();
 133     }
 134
 135     return ([add_level(\%groups, '')],
 136             [add_level(\%groups, '', '')],    # core
 137             [add_level(\%groups, '', 'E')],   # ext
 138             [add_level(\%groups, '', 'A')]);  # api
 139 }
 140
 141 1;