Acorn User 10/AU_CD10.iso/Updates/Perl/Non-RPC/!Perl/riscos/RISCOS/AOF.pm

Text File | 1998-07-31 | 10KB | 409 lines

package RISCOS::AOF::Symbol;
use Carp;
use strict;
use vars qw (@ISA $VERSION);

$VERSION = 0.03;    # Now that I have access to AOF 3.11 info
# 0.03 uses map
@ISA = qw();

sub new ($$$$$) {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self  = {};
    my ($name, $at, $value, $area, $stringtable) = @_;

    return undef unless defined ($self->{__NAME} =
      RISCOS::AOF::aof_string_from_table ($stringtable, $name));

    $self->{__AT} = $at ||= 0;
    carp sprintf "AT field in " . $self->{__NAME}
      . " with value %08X contains unknown bits", $at if (~0xB7F & $at);


    $self->{__AREA} = &RISCOS::AOF::aof_string_from_table ($stringtable, $area)
      unless ($at & 5 == 1);

    $self->{__VALUE} = $value
      if ($at & 0x41);    # Bit 0 or 6 set

    $self->{__SCOPE} = ('Unknown', 'static', 'extern', '')[$at & 3];

    my $misc = [];

    if ($at & 3 == 2) {
    push @$misc, 'case insensitive' if $at & 8;
    push @$misc, 'weak' if $at & 0x10;
    push @$misc, 'common area' if $at & 0x40;
    } elsif ($at & 3 == 3) {
    push @$misc, 'strong' if $at & 0x20;
    }

    push @$misc, 'code datum' if $at & 0x100;
    push @$misc, 'FP args in FP regs' if $at & 0x200;
    push @$misc, 'simple leaf function' if $at & 0x800;

    $self->{__MISC} = $misc if @$misc;

    bless ($self, $class);
}

sub Name {
    my $self = shift;
    $self->{'__NAME'};
}

sub Value {
    my $self = shift;
    return $self->{__VALUE} unless defined $self->{__AREA};
    "$self->{__VALUE} relative to area '$self->{__AREA}'";
}

sub Defined {
    my $self = shift;
    $self->{__AT} & 1;
}

sub Scope {
    my $self = shift;
    $self->{'__SCOPE'};
}

sub Misc {
    my $self = shift;
    @{$self->{'__MISC'}};
}

package RISCOS::AOF;
require RISCOS::Chunkfile;

require Exporter;
use Carp;
use strict;
use vars qw (@ISA $VERSION @EXPORT_OK);

$VERSION = 0.02;
@ISA = qw(Exporter RISCOS::Chunkfile);
@EXPORT_OK = qw(aof_symboltable aof_string_from_table);

sub new ($$) {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $self = $class->SUPER::new ($_[0]);

    foreach my $what (qw(OBJ_HEAD OBJ_AREA OBJ_IDFN OBJ_SYMT OBJ_STRT)) {
    if ($self->Multiple ($what)) {
        carp "AOF file has '$what' chunks at positions "
         . join (' ', @{$self->Lookup ($what)})
          if $^W;
        return undef;
    }
    }

    my $chunk = $self->Chunk ('OBJ_HEAD');

    unless (defined $chunk) {
    carp "AOF has no 'OBJ_HEAD'" if $^W;
    return undef;
    }

    unless ($chunk->Length() >= 12) {
    carp "AOF header is far too short" if $^W;
    return undef;
    }
    my ($type, $version, $num_area, $num_sym, $entry_area, $entry_offset)
      = unpack 'I6', (my $head_data = $chunk->Data());

    if ($type != 0xC5E2D080) {
    if ($^W) {
        if ($type == 0xC5E2D081) {
        carp 'Don\'t understand AOF Image type 1';
        } elsif ($type == 0xC5E2D083) {
        carp 'Don\'t understand AOF Image type 2';
        } elsif ($type == 0xC5E2D087) {
        carp 'Don\'t understand AOF Image type 3';
        } else {
        carp sprintf "Don't understand unknown AOF type &%8X", $type;
        }
    }
    return undef;
    }

    unless ($chunk->Length() == 24 + 20 * $num_area) {
    carp "AOF header reports $num_area area(s) - expect length to be "
         . (24 + 20 * $num_sym) . ' bytes, actually ' . $chunk->Length()
         . 'bytes ' if $^W;
    return undef;
    }

    $self->{'VERSION'} = sprintf "%2f", $version / 100;
    if ($entry_area) {
    $self->{'ENTRY_AREA'} = $entry_area - 1;
    $self->{'ENTRY_OFFSET'} = $entry_offset;
    }

    if (defined ($chunk = $self->Chunk ('OBJ_SYMT'))) {
    $self->{'SYMBOLS'}
      = aof_symboltable ($chunk, $self->Chunk ('OBJ_STRT'))
    }

    $chunk = $self->Chunk ('OBJ_AREA');

    unless (defined $chunk) {
    carp "AOF has no 'OBJ_AREA'" if $^W;
    return undef;
    }

    $self->{'AREAS'} = [];

    my $offset = 24;

    while ($num_area--) {
    # Eventually this needs to be "new" object consisting of
    # name (will need symtable in place already)
    # ALignment
    # ATtributes
    # (Size) from Data - hmm - what to do about zero init - use undef?
    # (Number of relocations) - from Data
    # Base address

    push @{$self->{'AREAS'}}, substr $head_data, $offset, 20;
    $offset += 20;
    }

    $self;
}

sub String ($;@) {
    my $self = shift;
    my $stringtable = \($self->Chunk ('OBJ_STRT')->Data());
    return undef unless $stringtable and defined $_[0];

    return aof_string_from_table ($stringtable, $_[0]) unless wantarray;
    map  { aof_string_from_table ($stringtable, $_) } @_;
}

sub Creator ($) {
    my $self = shift;
    # Strip the trailing nulls
    ($self->Chunk ('OBJ_IDFN')->Data()) =~ /^([^\0]+)\0/s;

    $0;
}

sub Version ($) {
    my $self = shift;
    $self->{'VERSION'};
}

sub Symbols ($) {
    my $self = shift;
    $self->{'SYMBOLS'};
}

#
# Subroutines from the pre-OO version.
#
sub aof_stringtable ($) {
    return undef unless defined (my $chunk = shift);

    # And the PRM says
    # "The length stored at the start of the string table itself is identically
    #  the length stored in the OBJ_STRT chunk header."
    # And "ARM AOF Macro Assembler 3.06 (Acorn Computers Ltd)" stores
    # 168 in the chunk header, but 166 at the start of the table
    # (rink's o.rink_rtsys)
    # Nice one Acorn
    # So we will round them up to a multiple of 4

    unless (((3 + unpack ('V', $chunk)) & ~3) == ((3 + length $chunk) & ~3)) {
    carp sprintf "Stringtable reports length as %d, actually %d",
             unpack ('V', $chunk),length $chunk
      if $^W;
    return undef;
    }

    my $entries = {};
    $chunk = substr $chunk, 4;
    my $pos = 4;

    while ($chunk =~ /([^\0]+)/s) {
    $entries->{$pos} = $1;
    $pos += 1 + length $1;
    $chunk = substr $chunk, 1 + length $1;
    }

    $entries;
}

# Because strictly some bugger can write a stringtable with
# "....realloc\0" where 'alloc' is offset 6 and 'realloc' is offset 4
sub aof_string_from_table ($$) {
    my ($ref, $offset) = @_;
    return $ref->{$offset} if ref $ref eq 'HASH';

    return undef unless ref $ref eq 'LVALUE' or ref $ref eq 'SCALAR';

    (substr $$ref, $offset) =~ /^([^\0]+)\0/s;

    $1;
}

sub aof_symboltable ($$) {
    return undef unless defined (my $chunk = shift);


    my ($stringtable) = @_;
    my $symboltable;

    unless (ref $stringtable) {
    carp "aof_symboltable not passed a reference" if $^W;
    return ();
    }

    if (ref $stringtable eq 'RISCOS::Chunk') {
    if ($stringtable->ID ne 'OBJ_STRT') {
        carp "aof_symboltable passed a reference to '" . $stringtable->ID
          . "', not a stringtable" if $^W;
        return ();
    }
    $stringtable = \$stringtable->Data;    # Ref to scalar data
    }
    elsif (ref $stringtable ne 'HASH') {
    carp "aof_symboltable not passed a recognised reference" if $^W;
    return ();
    }

    if (ref $chunk eq 'RISCOS::Chunk') {
    if ($chunk->ID ne 'OBJ_SYMT') {
        carp "aof_symboltable passed a reference to '" . $chunk->ID
          . "', not a symboltable" if $^W;
        return ();
    }
    $chunk = $chunk->Data;
    }

    if (0xF & length $chunk) {
    carp "symbol table length " . length $chunk
      . " is not a multiplte of 16" if $^W;
    return ();
    }
    my $result = [];
    while ($chunk =~ s/(.{16})//s) {
    my $symbol = new RISCOS::AOF::Symbol unpack ('V4', $1), $stringtable;
    push @$result, $symbol if defined $symbol;
    }

    $result;
}
1;
__END__

=head1 NAME

RISCOS::AOF -- manipulate ARM Object Format files

=head1 SYNOPSIS

    use RISCOS::AOF;

    my $obj_file = new RISCOS::AOF $file;
    foreach my $symbol (@{$obj_file->Symbols}) {
    print $symbol->Name(), "\n" if $symbol->Scope eq 'extern';
    }

=head1 DESCRIPTION

C<RISCOS::AOF> provides a class derived from C<RISCOS::Chunkfile> to manipulate
the contents of B<A>RM B<O>ject B<F>ormat files. It provides a class
C<RISCOS::AOF::Symbol> to store details of each symbol in an C<AOF> file.

Currently the implementation is incomplete - only methods to manipulate the
symbol table have been written. Methods to manipulate area data are currently
unimplemented.

=head2 Methods

=over 4

=item new <array_ref>

=item new <file>

If passed a reference to an array it is assumed to be an array of
C<RISCOS::Chunk> objects to use as the file contents. Otherwise calls
C<RISCOS::File::load> to loads the file specified using and checks that it is
C<AOF>. Hence I<file> can be a filename, a reference to a filehandle, or a
reference to a scalar which is used as the file's contents.

If passed an array reference then this is used internally in the object, so
should be created with the anonymous array constructor C<[]> rather than a
reference to a named array variable (see  L<perldsc/Common Mistakes>).

Returns undefined if there was an error, or the file contents are corrupt.

=item String <offset> [...]

Looks up strings in the stringtable.

In scalar context returns the string at the first offset given. In array context
returns the list of strings referred to by the supplied list of offsets.

=item Creator

Returns whatever string is stored in the C<OBJ_IDFN> chunk - typically a
string identifying the creator of the C<AOF> file.

=item Version

Returns the version number from the C<AOF> file.

=item Symbols

Returns a reference to the array of C<RISCOS::AOF::Symbol> objects describing
the symbols in the C<AOF> file.

=back

=head1 RISCOS::AOF::Symbol

The C<RISCOS::AOF::Symbol> class is used to hold information about a symbol in
an C<AOF> file. The class provides the following methods to access this
information:

=over 4

=item Name

Returns the symbol name.

=item Value

Returns the symbol value. If the symbol is absolute then this is just a number.
Otherwise it is a string of the form "C<I<value> relative to area 'I<area>'>".

=item Defined

Returns true if the symbol is defined in this C<AOF> file. Returns false if it
is defined externally.

=item Scope

Returns the scope of the symbol ('C<static>', 'C<extern>' or '').

=item Misc

Returns an array of strings describing other properties of the symbol - I<e.g.>
'C<case insensitive>', 'C<weak>', 'C<strong>', 'C<common area>'.

=back

=head1 BUGS

As noted, methods to manipulate areas are currently unimplemented.

=head1 AUTHOR

Nicholas Clark <F<[e-mail]>>