This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
embed.fnc and regen: detect duplicate fn defs
[perl5.git] / regen / embed_lib.pl
CommitLineData
cdde42af
NC
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;
c0b58684
DM
61 my %seen;
62 my $macro_depth = 0;
cdde42af
NC
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 }
c0b58684
DM
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;
cdde42af 87 }
c0b58684
DM
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
cdde42af
NC
101 push @embed, \@args;
102 }
c0b58684 103 die "More #if than #endif by the end of embed.fnc" if $macro_depth != 0;
cdde42af
NC
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
1621;