Add regen/embed_lib.pl, for the code that processes embed.fnc and regen/opcodes

Move setup_embed() and the helper functions add_level() and current_group()
to it from regen/embed.pl

diff --git a/MANIFEST b/MANIFEST
index a192e3510094db9a22f7cf7f383611a5f5a58ac4..9592a50641e9ddd1addbe80f282ecf780955315c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -4634,6 +4634,7 @@ regcharclass.h                    Generated by regen/regcharclass.pl
 regcomp.c                      Regular expression compiler
 regcomp.h                      Private declarations for above
 regcomp.sym                    Data for regnodes.h
+regen/embed_lib.pl             Reads embed.fnc and regen/opcodes
 regen/embed.pl                 Produces {embed,embedvar,proto}.h, global.sym
 regen/keywords.pl              Program to write keywords.h
 regen/mg_vtable.pl             generate mg_vtable.h

diff --git a/regen/embed.pl b/regen/embed.pl
index bf872346b08b888ebf19747f9b878cc961a335bd..8327d37737014d144a9ab637bff794b336e849d7 100755 (executable)
--- a/regen/embed.pl
+++ b/regen/embed.pl
@@ -28,6 +28,7 @@ use strict;
 BEGIN {
     # Get function prototypes
     require 'regen/regen_lib.pl';
+    require 'regen/embed_lib.pl';
 }
 
 my $SPLINT = 0; # Turn true for experimental splint support http://www.splint.org
@@ -51,139 +52,6 @@ sub open_print_header {
                      copyright => [1993 .. 2009], quote => $quote });
 }
 
-{
-    # 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->{''} ||= [];
-    }
-
-    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;
-    }
-
-    sub setup_embed {
-       open IN, 'embed.fnc' or die $!;
-
-       my @embed;
-
-       while (<IN>) {
-           chomp;
-           next if /^:/;
-           next if /^$/;
-           while (s|\\$||) {
-               $_ .= <IN>;
-               chomp;
-           }
-           s/\s+$//;
-           my @args;
-           if (/^\s*(#|$)/) {
-               @args = $_;
-           }
-           else {
-               @args = split /\s*\|\s*/, $_;
-           }
-           if (@args == 1 && $args[0] !~ /^#\s*(?:if|ifdef|ifndef|else|endif)/) {
-               die "Illegal line $. '$args[0]' in embed.fnc";
-           }
-           push @embed, \@args;
-       }
-
-       close IN or die "Problem reading embed.fnc: $!";
-
-       open IN, 'regen/opcodes' or die $!;
-       {
-           my %syms;
-
-           while (<IN>) {
-               chomp;
-               next unless $_;
-               next if /^#/;
-               my $check = (split /\t+/, $_)[2];
-               next if $syms{$check}++;
-
-               # These are all indirectly referenced by globals.c.
-               push @embed, ['pR', 'OP *', $check, 'NN OP *o'];
-           }
-       }
-       close IN or die "Problem reading regen/opcodes: $!";
-
-       # 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.
-
-       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();
-       }
-
-       return ([add_level(\%groups, '')],
-               [add_level(\%groups, '', '')],    # core
-               [add_level(\%groups, '', 'E')],   # ext
-               [add_level(\%groups, '', 'A')]);  # api
-    }
-}
-
 my ($embed, $core, $ext, $api) = setup_embed();
 
 # walk table providing an array of components in each line to

diff --git a/regen/embed_lib.pl b/regen/embed_lib.pl
new file mode 100644 (file)
index 0000000..fbcc8e2
--- /dev/null
+++ b/regen/embed_lib.pl
@@ -0,0 +1,141 @@
+#!/usr/bin/perl -w
+use strict;
+
+# read embed.fnc and regen/opcodes, needed by regen/embed.pl and makedef.pl
+
+require 5.004; # keep this compatible, an old perl is all we may have before
+                # we build the new one
+
+# 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->{''} ||= [];
+}
+
+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;
+}
+
+sub setup_embed {
+    my $prefix = shift || '';
+    open IN, $prefix . 'embed.fnc' or die $!;
+
+    my @embed;
+
+    while (<IN>) {
+       chomp;
+       next if /^:/;
+       next if /^$/;
+       while (s|\\$||) {
+           $_ .= <IN>;
+           chomp;
+       }
+       s/\s+$//;
+       my @args;
+       if (/^\s*(#|$)/) {
+           @args = $_;
+       }
+       else {
+           @args = split /\s*\|\s*/, $_;
+       }
+       if (@args == 1 && $args[0] !~ /^#\s*(?:if|ifdef|ifndef|else|endif)/) {
+           die "Illegal line $. '$args[0]' in embed.fnc";
+       }
+       push @embed, \@args;
+    }
+
+    close IN or die "Problem reading embed.fnc: $!";
+
+    open IN, $prefix . 'regen/opcodes' or die $!;
+    {
+       my %syms;
+
+       while (<IN>) {
+           chomp;
+           next unless $_;
+           next if /^#/;
+           my $check = (split /\t+/, $_)[2];
+           next if $syms{$check}++;
+
+           # These are all indirectly referenced by globals.c.
+           push @embed, ['pR', 'OP *', $check, 'NN OP *o'];
+       }
+    }
+    close IN or die "Problem reading regen/opcodes: $!";
+
+    # 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.
+
+    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();
+    }
+
+    return ([add_level(\%groups, '')],
+           [add_level(\%groups, '', '')],    # core
+           [add_level(\%groups, '', 'E')],   # ext
+           [add_level(\%groups, '', 'A')]);  # api
+}
+
+1;