Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
embed.pl	15.68 KB	-r-xr-xr-x	2014-12-27 11:49
embed_lib.pl	3.58 KB	-r--r--r--	2014-12-27 11:49
feature.pl	20.29 KB	-r-xr-xr-x	2014-12-27 12:46
genpacksizetables.pl	2.95 KB	-r--r--r--	2014-12-27 11:49
keywords.pl	4.33 KB	-r-xr-xr-x	2014-12-27 11:49
lib_cleanup.pl	6.41 KB	-r--r--r--	2014-12-27 11:49
mg_vtable.pl	12.29 KB	-r--r--r--	2014-12-27 11:49
miniperlmain.pl	316 B	-r--r--r--	2014-12-27 11:49
mk_PL_charclass.pl	10.19 KB	-r--r--r--	2014-12-27 11:49
mk_invlists.pl	9.5 KB	-r--r--r--	2014-12-27 11:49
opcode.pl	13.71 KB	-r-xr-xr-x	2014-12-27 11:49
opcodes	15.82 KB	-r--r--r--	2014-12-27 11:49
overload.pl	3.64 KB	-r--r--r--	2014-12-27 11:49
reentr.pl	29.01 KB	-r--r--r--	2014-12-27 11:49
regcharclass.pl	62.15 KB	-r-xr-xr-x	2014-12-27 11:49
regcharclass_multi_char_folds.pl	5.8 KB	-r--r--r--	2014-12-27 11:49
regcomp.pl	11.5 KB	-r--r--r--	2014-12-27 11:49
regen_lib.pl	6.34 KB	-r--r--r--	2014-12-27 11:49
uconfig_h.pl	616 B	-r-xr-xr-x	2014-12-27 11:49
unicode_constants.pl	5.58 KB	-r--r--r--	2014-12-27 11:49
warnings.pl	35.51 KB	-r--r--r--	2014-12-27 11:49

Rename

#!/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
}