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;