xref: /openbsd/gnu/usr.bin/perl/regen/embed_lib.pl (revision 3bef86f7) 
1#!/usr/bin/perl -w
2use 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
7require 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:
11my @state;
12# Nested structure to group functions by the pre-processor conditions that
13# control when they are compiled:
14my %groups;
15
16sub 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
28sub 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
58sub 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
1641;
165