🚀 go-pugleaf

MODULE TestPos;
(* Oberon-2 test program for random file access using the 
   ISO Modula-2 I/O-Library. 
   This program runs on VAX/VMS using
   ModulaWare's Oberon-2 Compiler V1.0F and 
   ModulaWare's ISO M2 Std Lib implementation written in Modula-2.

   (c) 1992 by ModulaWare GmbH, written by Elmar Baumgart 10-Mar-1992,
     27-Mar-1992 (skip multiple blank lines)

  - TestPos takes three command line parameters (file names):
    DATA, INSERT and SEARCH
  - If at the start of the program the hash table file DATA does not
    exist, a new file is created and initialized.
    Otherwise, the existing file called DATA is used (random read/write
    access mode).
  - The program reads two files called INSERT and SEARCH. Both files
    may have any text file format.
  - inserts token strings from file INSERT into a hash-table file DATA
  - searches token strings from file SEARCH in file DATA
*)
IMPORT ProgramArgs, STextIO, SWholeIO, IOResult, TextIO, SeqFile, RawIO, 
  RndFile, CTR, Strings;

CONST
  ITEMLENGTH = 40;
  ITEMS = 3877;  (*prime*)   (*creates ITEMS * ITEMLENGTH hash-table on disk*)
  DATA = 0; INSERT = 1; SEARCH = 2;

TYPE
  WCproc = PROCEDURE(n: CTR.CARDINAL; w: CTR.CARDINAL);
  WSproc = PROCEDURE(s: ARRAY OF CHAR);
  ItemType = ARRAY ITEMLENGTH OF CHAR;
  fnam = ARRAY 255 OF CHAR;
  Args = ARRAY 3 OF fnam;

VAR
  ores: RndFile.OpenResults;
  empty: ItemType;
  i: CTR.INTEGER; wrongArgs: BOOLEAN;

  WC: WCproc; WS: WSproc; NL: PROCEDURE;
  data, ins, sea: RndFile.ChanId;
  free: CTR.INTEGER;
  file: Args;
  startPos: RndFile.FilePos;

PROCEDURE CalcPos(Key: CTR.CARDINAL): RndFile.FilePos;
BEGIN
  RETURN RndFile.NewPos(data, Key, ITEMLENGTH, startPos);
END CalcPos;

PROCEDURE CalcKey(item: ARRAY OF CHAR): CTR.CARDINAL;
VAR len, i, key: CTR.CARDINAL;
BEGIN
  len:= Strings.Length(item);
  key:= 1;
  IF len > 0 THEN
    FOR i:= 0 TO len-1 DO
      key:= (key * (ORD(item[i]) MOD 26 + 1)) MOD ITEMS;
    END;
  END;
  RETURN key;
END CalcKey;

PROCEDURE EQUAL(old, new: ARRAY OF CHAR): BOOLEAN;
VAR i: CTR.INTEGER; eq: BOOLEAN; len: CTR.INTEGER;
BEGIN
  i:= 0; eq:= TRUE; len:= Strings.Length(new);
  WHILE (i < len) & eq DO
    eq:= old[i] = new[i]; INC(i);
  END;
  RETURN eq;
END EQUAL;

PROCEDURE Insert(item: ARRAY OF CHAR);
VAR Key, offset: CTR.CARDINAL; atPos: ItemType; eq: BOOLEAN;
BEGIN
  IF free > 0 THEN
    Key:= CalcKey(item);
    RndFile.SetPos(data, CalcPos(Key));
    RawIO.Read(data, atPos); offset:= 0; 
    eq:= EQUAL(atPos, item);
    WHILE ~ eq & (atPos[0] # 0X) & (offset < ITEMS) DO
      IF IOResult.ReadResult(data) = IOResult.endOfInput THEN
        RndFile.SetPos(data, startPos);
      END;
      RawIO.Read(data, atPos);
      eq:= EQUAL(atPos, item); INC(offset);
    END;
    IF eq THEN WS('already inserted');
    ELSE
      RndFile.SetPos(data, CalcPos((Key + offset) MOD ITEMS));
      RawIO.Write(data, item);
      WS('        inserted');
      DEC(free);
    END;
    WC(offset, 4); WS(' "'); WS(item); WS('"'); NL;
  ELSE WS('-table full-'); NL;
  END;
END Insert;

PROCEDURE Search(item: ARRAY OF CHAR);
VAR Key, offset: CTR.CARDINAL; atPos: ItemType; eq: BOOLEAN;
BEGIN
  Key:= CalcKey(item);
  RndFile.SetPos(data, CalcPos(Key));
  RawIO.Read(data, atPos); offset:= 0; 
  eq:= EQUAL(atPos, item);
  WHILE ~ eq & (atPos[0] # 0X) & (offset < ITEMS) DO 
    IF IOResult.ReadResult(data) = IOResult.endOfInput THEN
      RndFile.SetPos(data, startPos);
    END;
    RawIO.Read(data, atPos);
    eq:= EQUAL(atPos, item); INC(offset);
  END;
  IF offset >= ITEMS THEN eq:= FALSE;
  END;
  IF eq THEN WS('    found');
  ELSE WS('not found');
  END;
  WC(offset, 4); WS(' "'); WS(item); WS('"'); NL;
END Search;

PROCEDURE InsertIt;
VAR item: ItemType;
BEGIN
  SeqFile.OpenRead(ins, file[INSERT], RndFile.text, ores);
  IF ores # RndFile.opened THEN WS('failed to open '); WS(file[INSERT]); NL;
  ELSE
    WS('Inserting token strings from file '); WS(file[INSERT]); NL;
    TextIO.ReadToken(ins, item);
    WHILE IOResult.ReadResult(ins) # IOResult.endOfInput DO
      Insert(item);
      TextIO.ReadToken(ins, item);
      WHILE IOResult.ReadResult(ins) = IOResult.endOfLine DO 
        TextIO.SkipLine(ins);
        TextIO.ReadToken(ins, item);
      END;
    END;
    SeqFile.Close(ins);
  END;
END InsertIt;

PROCEDURE SearchIt;
VAR item: ItemType;
BEGIN
  SeqFile.OpenRead(sea, file[SEARCH], RndFile.text, ores);
  IF ores # RndFile.opened THEN WS('failed to open '); WS(file[SEARCH]); NL;
  ELSE
    WS('Searching token strings from file '); WS(file[SEARCH]); NL;
    TextIO.ReadToken(sea, item);
    WHILE IOResult.ReadResult(sea) # IOResult.endOfInput DO
      Search(item);
      TextIO.ReadToken(sea, item);
      WHILE IOResult.ReadResult(sea) = IOResult.endOfLine DO 
        TextIO.SkipLine(sea);
        TextIO.ReadToken(sea, item);
      END;
    END;
    SeqFile.Close(sea);
  END;
END SearchIt;

PROCEDURE TestIt;
BEGIN
  InsertIt; NL;
  SearchIt;
END TestIt;


BEGIN
  free:= ITEMS;
  FOR i:= 0 TO ITEMLENGTH-1 DO empty[i]:= 0X;
  END;
  WC:= SWholeIO.WriteCard; WS:= STextIO.WriteString; NL:= STextIO.WriteLn;
  i:= 0;
  WHILE (IOResult.ReadResult(ProgramArgs.ArgChan()) # IOResult.endOfInput) & (i <= SEARCH) DO
    TextIO.ReadToken(ProgramArgs.ArgChan(), file[i]); INC(i);
  END;

  IF (IOResult.ReadResult(ProgramArgs.ArgChan()) # IOResult.endOfInput) & (i > SEARCH) THEN
    RndFile.OpenOld(data, file[DATA], 
      RndFile.read + RndFile.write + RndFile.binary, ores);
    IF ores = RndFile.noSuchFile THEN
      RndFile.OpenClean(data, file[DATA], 
        RndFile.read + RndFile.write + RndFile.binary, ores); 
      IF ores = RndFile.opened THEN
        FOR i:= 1 TO ITEMS DO RawIO.Write(data, empty);
        END;
        startPos:= RndFile.StartPos(data);
        TestIt;
        RndFile.Close(data);
      ELSE WS('data file not present, create failed'); NL;
      END;
    ELSIF ores = RndFile.opened THEN
      startPos:= RndFile.StartPos(data);
      i:= 0; RawIO.Read(data, empty);
      WHILE IOResult.ReadResult(data) # IOResult.endOfInput DO
        INC(i); RawIO.Read(data, empty);
        IF empty[0] # 0X THEN DEC(free);
        END;
      END;
      IF i # ITEMS THEN WS(file[DATA]); WS(' is of illegal size'); NL;
      ELSE TestIt; 
      END;
      RndFile.Close(data);
    ELSE WS('data file present, access failed'); NL;
    END;
    WC(free, 1); WS(' entries free in '); WS(file[DATA]); NL;
  ELSE WS('  TESTPOS hash-file insert-file search-file '); NL;
  END;
END TestPos.

Guenter Dotzel, ModulaWare GmbH, Wilhelmstr. 17A, D-W 8520 Erlangen/F.R.Germany
Modula-2 & Oberon-2 Compiler Manufactur (VAX/VMS, OS/2 and Unix-Platforms)
Tel. +49 (9131) 208395, Fax +49 (9131) 28205.
E-mail/Internet: 100023.2527@compuserve.com
                 g_dotzel@ame.nbg.sub.org