home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Acorn User 10
/
AU_CD10.iso
/
Updates
/
Perl
/
Non-RPC
/
!Perl
/
riscos
/
RISCOS
/
Module.pm
< prev
next >
Wrap
Text File
|
1998-07-26
|
24KB
|
958 lines
package RISCOS::Module::Command;
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
my ($module, $offset) = @_;
$self->{'__NAME'} = RISCOS::Module::getmodtext ($module, $offset);
return wantarray ? () : undef
unless defined ($self->{'__NAME'}) && length $self->{'__NAME'};
# This is now fileswitch proof:
$offset = ($offset + length ($self->{'__NAME'}) + 4) & ~3;
my ($code, $min, $gs, $max, $flags, $syntax, $help)
= unpack 'ICaC2I2', substr $module, $offset;
return undef unless defined $help;
$self->{'__MIN'} = $min;
$self->{'__MAX'} = $max;
$self->{'__GS'} = $gs;
$self->{'__CODE'} = $code
if (RISCOS::Module::isvalid_not_zero (length ($module), $code) & 7) == 1;
$syntax = RISCOS::Module::getmodtext ($module, $syntax);
$self->{'__SYNTAX'} = $syntax if defined $syntax;
my $_flags = [];
push @$_flags, 'filing system command' if ($flags & 0x80);
push @$_flags, 'status command' if ($flags & 0x40);
if ($flags & 0x20) {
push @$_flags, 'help is code';
$self->{'__HELP'} = $help
if (RISCOS::Module::isvalid_not_zero (length ($module), $help) & 7)
== 1;
} else {
$help = RISCOS::Module::getmodtext ($module, $help);
$self->{'__HELP'} = $help if defined $help;
}
$self->{'__FLAGS'} = $_flags if @$_flags;
bless ($self, $class);
return $self unless wantarray;
($self, $offset + 16, $self->{'__NAME'})
}
sub Name {
my $self = shift;
$self->{'__NAME'};
}
sub Min {
my $self = shift;
$self->{'__MIN'};
}
sub Max {
my $self = shift;
$self->{'__MAX'};
}
sub GS_Flags {
my $self = shift;
return $self->{'__GS'} unless wantarray;
split //, unpack 'b*', $self->{'__GS'};
}
sub Code {
my $self = shift;
$self->{'__CODE'};
}
sub Syntax {
my $self = shift;
$self->{'__SYNTAX'};
}
sub Help {
my $self = shift;
$self->{'__HELP'};
}
sub Flags {
my $self = shift;
return wantarray ? () : undef
unless defined $self->{'__FLAGS'};
return @{$self->{'__FLAGS'}} if wantarray;
join ', ', @{$self->{'__FLAGS'}};
}
sub Dump {
my $self = shift;
my @lines = ("Name:\t\t" . $self->Name()
. ($self->Flags() ? "\t(" . $self->Flags() . ')' : ''));
push @lines, "Syntax:\t\t" . $self->Syntax if defined $self->Syntax;
push @lines, "Help:\t\t" . $self->Help if defined $self->Help;
push @lines, "Parameters:\t" . (($self->Min == $self->Max)
? $self->Min
: $self->Min . ' - ' . $self->Max);
push @lines, "GS Trans map:\t" . join ' ', $self->GS_Flags if $self->Max;
return @lines if wantarray;
join "\n", @lines, '';
}
package RISCOS::Module;
use RISCOS::SWI;
use RISCOS::ValidateAddr;
use RISCOS::File 0.02;
require Exporter;
#use SelfLoader;
use Carp;
use strict;
use vars qw (@ISA @EXPORT_OK $VERSION $os_mods $code_mask $work_mask
$unsqueeze_code @offsets);
@ISA = qw(Exporter);
@EXPORT_OK = qw(rm_private_word rm_workspace rm_code_addr rm_grab
rmensure rm_unsqueeze split_help_string modules modules_only);
$VERSION = 0.02;
$code_mask = ®mask([0,1],[3]);
$work_mask = ®mask([0,1],[4]);
# Hmm. Magic numbers
# Bits 0,1
# 0 is invalid
# 1 is in module
# 2 is exactly at end
# 3 is in module but top bit set
# Bit 4 => Not word aligned
@offsets = ( # 1 (word aligned in module) is always valid.
['start', 0, \&start_valid],
['init', 4], # Not [1,2] as we are checking after unsqueeze
['final', 8, [3,7]],
['service', 12],
['title', 16, [5]],
['help', 20, [0,4,5]],
['command', 24, [5]], # fileswitch has a non-word aligned table !!
['SWIchunk', 28, \&swichunk_valid], # Not a pointer :-)
['SWIhandler', 32, [0,1,4]],
['SWItable', 36, [0,1,4,5]],
['SWIdecode', 40, [0,1,4]],
['tokenfile', 44, [0,1,4,5]]
);
$unsqueeze_code = # A little bit of raw ARM code never hurt anyone
'8-) û ã?Îã å, Oâ ?‘è
@à ‘Jà€⇨à⇨o•â Vá` ±⇧àqŷà
P á @ ã á 0àã°[â) ºÕä