xref: /openbsd/gnu/usr.bin/perl/regen/embed_lib.pl (revision 264ca280) 
1#!/usr/bin/perl -w
2use strict;
3
4# read embed.fnc and regen/opcodes, needed by regen/embed.pl and makedef.pl
5
6require 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:
10my @state;
11# Nested structure to group functions by the pre-processor conditions that
12# control when they are compiled:
13my %groups;
14
15sub 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
27sub 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
56sub 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
1411;
142