Subversion Repositories DevTools

########################################################################
# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.
#
# Module name   : jats_runtime_gcc.pm
# Module type   : Makefile system
# Compiler(s)   : Perl
# Description   : JATS Make Time Support for the GCC toolchain
#
#                 This package contains functions that are invoked by the JATS
#                 generated makefiles to perform complicated operations at Make Time
#
#                 The functions are designed to be invoked as:
#                   $(GBE_PERL) -Mjats_runtime_gcc -e <function> -- <args>+
#
#                 The functions in this packages are designed to take parameters
#                 from @ARVG as this makes the interface easier to read.
#
#                 This package is used to speedup and simplify the JATS builds
#                 Some things are easier to do in Perl than shell hidden inside
#                 a makefile
#
#......................................................................#

require 5.006_001;
use strict;
use warnings;

package jats_runtime_gcc;

our (@ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS, $VERSION);
use Exporter;
use JatsError qw(:name=GCC);

$VERSION = 1.00;
@ISA = qw(Exporter);

# Symbols to autoexport (:DEFAULT tag)
@EXPORT = qw( splitscript
              printenv
            );

#
#   Parsed options are stored globally
#
our %opts;

#BEGIN
#{
#    print "-------jats_runtime_gcc initiated\n";
#}

#-------------------------------------------------------------------------------
# Function        : process_options
#
# Description     : Extract options from the front of the command stream
#
#                   Options of the form --Opt=Val are split out
#                   Options of the form --Opt will set (or increment a value)
#
# Inputs          : None: Uses global ARGV
#
# Returns         : None: Resets global argv
#                         Populates the %opts hash
#
sub process_options
{
    while ( my $entry = shift @ARGV ) {
        if ( $entry =~  m/^--(.*)/  ) {
            if ( $1 =~ m/(.*)=(.*)/ ) {
                $opts{$1} = $2;
            } else {
                $opts{$1}++;
            }
        } else {
            unshift @ARGV, $entry;
            last;
        }
    }
    #
    #   Process some known options
    #   These are the same as those provided by 'jats_runtime'
    #
    $opts{'Progress'} = $opts{'Verbose'}    if ( $opts{'Verbose'} );
    ErrorConfig( 'name', $opts{Name})       if ( $opts{'Name'} );
    ErrorConfig( 'verbose', $opts{Verbose}) if ( $opts{'Verbose'} );
    DebugDumpData("RunTime Opts", \%opts )  if ( $opts{'ShowOpts'} );;
    Message ("RunTime args: @ARGV")         if ( $opts{'ShowArgs'} );
    printenv()                              if ( $opts{'ShowEnv'} );
    Message ($opts{'Message'})              if ( $opts{'Message'} );
}

#-------------------------------------------------------------------------------
# Function        : printenv
#
# Description     : Display all EnvVars
#
# Inputs          : None
#
# Returns         :
#
sub printenv
{
    foreach my $entry ( sort keys %ENV ) {
        print "    $entry=$ENV{$entry}\n";
    }
}

#-------------------------------------------------------------------------------
# Function        : splitscript
#
# Description     : Workaround broken linker (ld) that cannot handle a linkerscript
#                   correctly.
#                   
#                   The linker cannot handle a linkerscript with a 'VERSION" section
#                   The linker can handle a linker script with an EXTERN section
#                   and a --version-script
#                   
#                   This workaround will take the linker script and break it into two
#                   parts. This must be done at make-time in case the linker script is
#                   generated.
#
# Inputs          : @ARGV
#                       -src=Input              - Original LinkerScript
#                       -vs=VersionScript       - Name of version script to generate
#                       -ls=LinkerScript        - Name of the (simple) Linker Script to generate
#
# Returns         : 
#
sub splitscript
{
    process_options();
    Message ("Split Linker Script");
    Error ("No Source Script") unless ( defined $opts{'src'} );
    Error ("No Version Script Name") unless ( defined $opts{'vs'} );
    Error ("No Linker Script Name") unless ( defined $opts{'ls'} );

    #
    #   Open the file and slurp in all the data
    #   Remove returnss and leave newline characters
    #
    open (my $fh, '<' , $opts{'src'} ) || Error ("Cannot open: $opts{'src'}", "Reason:$!");
    $/ = undef;
    my $data = <$fh>;
    close $fh;
    $data =~ s~\r~~g;
    #print $data;

    #
    #   Process the contents character by character
    #   Expecting
    #       EXTERN (.... )
    #       VERSION { { .... } }
    #
    my @items;
    my $item;

    my $omatch;
    my $cmatch;
    my $mode = 0;
    my $depth;
    foreach my $char (split //, $data)
    {
    #print("-----$char, $mode, $depth\n");
        $item .= $char;
        if ($mode == 0) {
            if ($char =~ m~[({[<]~) {
                $mode = 1;
                $omatch = $char;
                $cmatch = $char;
                $cmatch =~ tr~({[<~)}]>~;
                $depth=1;
            }

        } elsif ($mode == 1 ) {
            if ($char eq $omatch) {
                $depth++;
            }
            if ($char eq $cmatch) {
                $depth--;
                if ($depth == 0 ) {
                    $mode = 0;
                    $item =~ s~^\s+~~;
                    push @items, $item;
                    $item = '';
                }
            }
        }
    }

    #
    #   Generate simple LinkerScript and VersionScript
    #   Must generate one of each - even if its a dummy
    #
    my $versionSeen,
    my $externSeen;
    foreach $item ( @items) {
        my $name = 'UNKNOWN SECTION:';
        if ($item =~ m~^VERSION~i) {
            $versionSeen = 1;
            $item =~ s~.*VERSION.*{~JATS_VERSION {~si;
            $item =~ s~};.*~};~si;
            FileWrite(  $opts{'vs'}, $item);

        } elsif ($item =~ m~^EXTERN~i) {
            $externSeen = 1;
            FileWrite(  $opts{'ls'}, $item);
        } else {
            Warning ("Unknown section in linker script - ignored", $data);
        }
    }

    #
    #   Generate dummy sections if required
    #
    unless ($versionSeen) {
        FileWrite(  $opts{'vs'}, 'VX {};');
    }

    unless ($externSeen) {
        FileWrite(  $opts{'ls'}, 'jats_dummy = 1;');
    }

}

#-------------------------------------------------------------------------------
# Function        : FileWrite 
#
# Description     : Simple file writer
#
# Inputs          : $fname  - Path to file to create
#                   $data   - Data to write to the file
#
# Returns         : 
#

sub FileWrite
{
    my ($fname, $data) = @_;
    Message ("Generate: $fname");
    open  (my $fh, '>', $fname ) || Error( "Cannot create file: $fname", "Reason: $!" );
    print $fh $data . "\n";
    close $fh;
}


1;