source: trunk/essentials/dev-lang/perl/embed.pl@ 3609

#!/usr/bin/perl -w

require 5.003;  # keep this compatible, an old perl is all we may have before
                # we build the new one

BEGIN {
    # Get function prototypes
    require 'regen_lib.pl';
}

#
# See database of global and static function prototypes in embed.fnc
# This is used to generate prototype headers under various configurations,
# export symbols lists for different platforms, and macros to provide an
# implicit interpreter context argument.
#

sub do_not_edit ($)
{
    my $file = shift;

    my $years = '1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006';

    $years =~ s/1999,/1999,\n  / if length $years > 40;

    my $warning = <<EOW;
 -*- buffer-read-only: t -*-

   $file

   Copyright (C) $years, by Larry Wall and others

   You may distribute under the terms of either the GNU General Public
   License or the Artistic License, as specified in the README file.

!!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
This file is built by embed.pl from data in embed.fnc, embed.pl,
pp.sym, intrpvar.h, perlvars.h and thrdvar.h.
Any changes made here will be lost!

Edit those files and run 'make regen_headers' to effect changes.

EOW

    $warning .= <<EOW if $file eq 'perlapi.c';

Up to the threshold of the door there mounted a flight of twenty-seven
broad stairs, hewn by some unknown art of the same black stone.  This
was the only entrance to the tower.


EOW

    if ($file =~ m:\.[ch]$:) {
        $warning =~ s:^: * :gm;
        $warning =~ s: +$::gm;
        $warning =~ s: :/:;
        $warning =~ s:$:/:;
    }
    else {
        $warning =~ s:^:# :gm;
        $warning =~ s: +$::gm;
    }
    $warning;
} # do_not_edit

open IN, "embed.fnc" or die $!;

# walk table providing an array of components in each line to
# subroutine, printing the result
sub walk_table (&@) {
    my $function = shift;
    my $filename = shift || '-';
    my $leader = shift;
    defined $leader or $leader = do_not_edit ($filename);
    my $trailer = shift;
    my $F;
    local *F;
    if (ref $filename) {        # filehandle
        $F = $filename;
    }
    else {
        safer_unlink $filename if $filename ne '/dev/null';
        open F, ">$filename" or die "Can't open $filename: $!";
        binmode F;
        $F = \*F;
    }
    print $F $leader if $leader;
    seek IN, 0, 0;              # so we may restart
    while (<IN>) {
        chomp;
        next if /^:/;
        while (s|\\$||) {
            $_ .= <IN>;
            chomp;
        }
        s/\s+$//;
        my @args;
        if (/^\s*(#|$)/) {
            @args = $_;
        }
        else {
            @args = split /\s*\|\s*/, $_;
        }
        my @outs = &{$function}(@args);
        print $F @outs; # $function->(@args) is not 5.003
    }
    print $F $trailer if $trailer;
    unless (ref $filename) {
        close $F or die "Error closing $filename: $!";
    }
}

sub munge_c_files () {
    my $functions = {};
    unless (@ARGV) {
        warn "\@ARGV empty, nothing to do\n";
        return;
    }
    walk_table {
        if (@_ > 1) {
            $functions->{$_[2]} = \@_ if $_[@_-1] =~ /\.\.\./;
        }
    } '/dev/null', '', '';
    local $^I = '.bak';
    while (<>) {
#       if (/^#\s*include\s+"perl.h"/) {
#           my $file = uc $ARGV;