ARM Club 3/TheARMClub_PDCD3.iso/hensa/programming/perl/perl_1/Perl5001/SWEchanges

Text File | 1996-03-04 | 7.3 KB | 202 lines

Mods to Perl by [e-mail].

Compiled Perl without internet..
    changed all the INET #defines in config.h
    also had to change IOCTL in unixish.h
    Had to define the macro EBADF in config.h as it seemed to be
    undefined.
     Note that my compiler would not accept the defn of fileno in acorn.c,
     since ANSI C does not allow access to the filehandle. So I fudged it
     by calling the soft copy of  stdio.h.

..but with syscall,
     defined HAS_SYSCALL in config.h
     recompiled pp_sys with a macro redefining 'syscall' to 'swi':
     used the swi veneer from the utils library (NOT the _kernel).
     See below for an example program using the call.


Implemented dbm support by porting gdbm 1.7.3 and making it into a module.
*NB.* All file protection commands are ignored.

This module goes into system:modules. All the code and stuff is in directory
gdbm-1_7_3. The module is called gdbm and a copy is in the directory.
It uses an official Acorn allocated swi chunk starting at 0x4cc40. For the
swis provided, see  RDBM_FIle in directory riscos.pm, or the header and code
in gdbm-1_7_3. It could of course be used from any language, not just Perl.

The gdbm-1_7_3 directory also contains the actual gdbm routines as a library
file GdbmLib. Note that all file protection commands are ignored, and some
initialisations do not work correctly. However the ordinary 'open' is OK.

The Perl interface package is called RDBM_FIle in directory riscos.pm,
since GDBM_File is used for the UNIX implementation.

In order to make dbmopen work, I also had to put a new version of
AnyDBM_File in lib.pm. If no pathname for the database is provided, it
defaults to '<PerlArchLib$Dir>.work.rdbm.' so this directory must exist.
If you want to change this, alter $workdir in the RDBM_File package.

The RiscosLib package in riscos.pm is the beginning of a riscos library. At
the moment it provides subroutines to create a register mask for syscall
and to implement SWINumberFromString. See the RDBM_File package for example
of  usage. SWINumberFromString is straightforward: just give it the swi name
and it returns the number. For regmask, provide a list of input registers
$in, and output registers $out. Note that they are sent to regmask by
reference. The parameters of syscall are, in order, the swinumber, the mask,
the input registers and the output registers. Perl decides whether they are
integers or strings. But output integers are called by reference which
requires a fudge: see the parameter $len in the program below. If you do not
call the X form of the swi, register 0 is also returned by syscall. If the
X form is used, syscall returns the os_error pointer, but I don't know if
you can do anything with it.

I hope I've cured the backtick bug (see below) but it is difficult to be sure
as the bug is not easily repeatable. Please let me know if you still have
problems. Backtick now does not use popen. If this was the cause (and I'm
far from certain) other pipe operations might be suspect. Note that some
backtick calls return a control O as the last character. This seems to do
no harm, but you might need to watch out when parsing the output.

I've cured the fileglob bug. This was definitely a pipe problem - now the
fileglob calls OS_GBPB 9. Pathnames are premitted, but if directories are
wildcarded only the first matching directory is used. This seems to be a
property of OS_GBPB. If the directory name is invalid, a error is generated.
Of course, if there is no pathname, the CSD is used. The names of all
matching objects, including directories, are returned.

Most of the filetests now behave sensibly. The following is (I hope!) the
defined behaviour. Note that filetests are defined *only* for filenames, not
filehandles. The reason for this is that fstat is rather hard to implement
on an ANSI C system. If sombody wants to try, let me know! You have to keep
track of which FILE * refers to which physical file. Use of filetests for
filehandles will produce a warning.

    -e <filename> returns TRUE if the <filename> exists, even if it is
       a directory, and FALSE otherwise (as before, and as UNIX).

    -T <filename> returns TRUE if the <filename> is a file with filetype
       'Text' (0xFFF) and FALSE if it does not exist, has a different
       filetype, or is a directory.
       (This is different from UNIX, and rather more sensible).
       Testing a filehandle causes a fatal error for -T.

    -B As -T except that it is TRUE if the filetype is *not* 'Text'.

    -f <filename> returns true if the file exists and is not a directory.
       (as UNIX).

    -d <filename> returns true if the object exists and is a directory.
       (as UNIX).

    -s and -z work like UNIX. i.e. -z gives TRUE if file has zero size,
       and -s returns the size.

    -M returns the age of the file in days (like UNIX). Divide by 86400
       to get minutes.

    -A and -C (the other time tests) return undef.

    -r, -w return true if the file is private read/writeable
       respectively. (They refer to effective uid under UNIX.)

    -R, -W return true if the file is public read/writeable
       respectively. (They refer to real uid under UNIX.)

    -x, -o, -X  -O return TRUE if the object exists (i.e. they are
    exactly equivalent to -e).

All the other filetests return undef. The pipe test -p, socket test -S and
teletype test -t might be fixed in a later version, as may testing of
filehandles. The other tests don't really make any sense under RISCOS.


I've made an Impression version of the manual using HTMLload. See
manual.impression.

Steve Ellacott

Follows: Perl scripts to test syscall and dbm. Other examples and test
programs may be found in the pl.tests directory.

----------------------Program to demonstrate syscall-------------------------

use RiscosLib;

$buffer = ' ' x 255;

# Getting the SWI number
$str="OS_SWINumberToString";
$no = SWINumberFromString($str);
print "Swi number for \'$str\' is $no\n";


# Calculation of the register mask;
@in = (0 .. 2);
@out = (2);
$mask = ®mask(\@in,\@out);
print "The mask is $mask\n";

# Fudge to return integer values
$len = ' 'x4;                 # Reserve space for an integer
syscall($no,$mask,0x3C,$buffer,255,$len);# Perl passes address as a parameter
$len = unpack("i",$len);         # Interpret the result as an integer
$len -= 1;                 # We don't want the null
$buffer = substr($buffer, 0, $len);
print "Buffer is $buffer\n";
-----------------------------------------------------------------------------
----------------------Program to demonstrate dbm-----------------------------

use RDBM_File;
dbmopen(%array2,'db2', 0);

$i = 0;
tie(%array,RDBM_File,dbname, 0);

for ('a' .. 'd') {
    $array{$_} = "Value for $_";
    print $i++, "\t$array{$_}\n";
}



$i = 0;
for ('aa' .. 'ad') {
    $array2{$_} = "Value for $_";
    print $i++, "\t$array2{$_}\n";
}


print "Entry for a\n" if  exists $array{'a'};
print "Deleting entry for a\nEntry was:";
print delete($array{'a'});print"\n";
print "Entry for a\n" if  exists $array{'a'};

@keys = keys(%array);

foreach $key ( sort(@keys) ) {
    print"$key: $array{$key}\n";
}

@keys = keys(%array2);

foreach $key ( sort(@keys) ) {
    print"$key: $array2{$key}\n";
}

print "Clearing array2\n";
%array2=();
print "Now try and list it again\n";

@keys = keys(%array2);

foreach $key ( sort(@keys) ) {
    print"$key: $array2{$key}\n";
}

print"That's all folks\n";

dbmclose(%array2);
untie(%array);
-----------------------------------------------------------------------------