-open IN, "embed.fnc" or die $!;
-
-my @embed;
-my (%has_va, %has_nocontext);
-
-while (<IN>) {
- chomp;
- next if /^:/;
- next if /^$/;
- while (s|\\$||) {
- $_ .= <IN>;
- chomp;
- }
- s/\s+$//;
- my @args;
- if (/^\s*(#|$)/) {
- @args = $_;
- }
- else {
- @args = split /\s*\|\s*/, $_;
- my $func = $args[2];
- if ($func) {
- ++$has_va{$func} if $args[-1] =~ /\.\.\./;
- ++$has_nocontext{$1} if $func =~ /(.*)_nocontext/;
- }
- }
- if (@args == 1 && $args[0] !~ /^#\s*(?:if|ifdef|ifndef|else|endif)/) {
- die "Illegal line $. '$args[0]' in embed.fnc";
- }
- push @embed, \@args;
-}
-
-open IN, 'regen/opcodes' or die $!;
-{
- my %syms;
-
- while (<IN>) {
- chop;
- next unless $_;
- next if /^#/;
- my (undef, undef, $check) = split /\t+/, $_;
- ++$syms{$check};
- }
-
- foreach (keys %syms) {
- # These are all indirectly referenced by globals.c.
- push @embed, ['pR', 'OP *', $_, 'NN OP *o'];
- }
-}
-close IN;
-
-my (@core, @ext, @api);
-{
- # Cluster entries in embed.fnc that have the same #ifdef guards.
- # Also, split out at the top level the three classes of functions.
- # Output structure is actually the same as input structure - an
- # (ordered) list of array references, where the elements in the reference
- # determine what it is - a reference to a 1-element array is a
- # pre-processor directive, a reference to 2+ element array is a function.
-
- # Records the current pre-processor state:
- my @state;
- # Nested structure to group functions by the pre-processor conditions that
- # control when they are compiled:
- my %groups;
-
- sub current_group {
- my $group = \%groups;
- # Nested #if blocks are effectively &&ed together
- # For embed.fnc, ordering within the && isn't relevant, so we can
- # sort them to try to group more functions together.
- foreach (sort @state) {
- $group->{$_} ||= {};
- $group = $group->{$_};
- }
- return $group->{''} ||= [];
- }
-
- my $current = current_group();
-
- foreach (@embed) {
- if (@$_ > 1) {
- push @$current, $_;
- next;
- }
- $_->[0] =~ s/^#\s+/#/;
- $_->[0] =~ /^\S*/;
- $_->[0] =~ s/^#ifdef\s+(\S+)/#if defined($1)/;
- $_->[0] =~ s/^#ifndef\s+(\S+)/#if !defined($1)/;
- if ($_->[0] =~ /^#if\s*(.*)/) {
- push @state, $1;
- } elsif ($_->[0] =~ /^#else\s*$/) {
- die "Unmatched #else in embed.fnc" unless @state;
- $state[-1] = "!($state[-1])";
- } elsif ($_->[0] =~ m!^#endif\s*(?:/\*.*\*/)?$!) {
- die "Unmatched #endif in embed.fnc" unless @state;
- pop @state;
- } else {
- die "Unhandled pre-processor directive '$_->[0]' in embed.fnc";
- }
- $current = current_group();
- }
-
- sub add_level {
- my ($level, $indent, $wanted) = @_;
- my $funcs = $level->{''};
- my @entries;
- if ($funcs) {
- if (!defined $wanted) {
- @entries = @$funcs;
- } else {
- foreach (@$funcs) {
- if ($_->[0] =~ /A/) {
- push @entries, $_ if $wanted eq 'A';
- } elsif ($_->[0] =~ /E/) {
- push @entries, $_ if $wanted eq 'E';
- } else {
- push @entries, $_ if $wanted eq '';
- }
- }
- }
- @entries = sort {$a->[2] cmp $b->[2]} @entries;
- }
- foreach (sort grep {length $_} keys %$level) {
- my @conditional = add_level($level->{$_}, $indent . ' ', $wanted);
- push @entries,
- ["#${indent}if $_"], @conditional, ["#${indent}endif"]
- if @conditional;
- }
- return @entries;
- }
- @core = add_level(\%groups, '', '');
- @ext = add_level(\%groups, '', 'E');
- @api = add_level(\%groups, '', 'A');
-
- @embed = add_level(\%groups, '');
-}
-
-# walk table providing an array of components in each line to
-# subroutine, printing the result
-sub walk_table (&@) {
- my ($function, $filename) = @_;
- my $F;
- if (ref $filename) { # filehandle
- $F = $filename;
- }
- else {
- $F = open_print_header($filename);
- }
- foreach (@embed) {
- my @outs = &{$function}(@$_);
- # $function->(@args) is not 5.003
- print $F @outs;
- }
- unless (ref $filename) {
- read_only_bottom_close_and_rename($F);
- }
-}
https://perl5.git.perl.org / perl5.git / blobdiff