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