ISO M2 I/O-Lib test file: TestPos.MOD 
Author Message
 ISO M2 I/O-Lib test file: TestPos.MOD

MODULE TestPos;
(* ISO Modula-2 I/O-Library test program
   (c) 1992 by ModulaWare GmbH, written by Elmar Baumgart 10-Mar-1992

  - 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.
  - 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

    A detailed description of this program can be found in the associated
    message (also available on CompuServe's CodePort forum/Lib 11,
    file archive TestIO.ARC.

    Module TestPos was extracted from "The ModulaTor", ModulaWare's monthly,
    non-commercial Modula-2 & Oberon-2 & Edison-2 newsletter. Suggestions and
    improvements are welcome!

  G~unter Dotzel/11-Mar-1992
  ModulaWare GmbH, Wilhelmstr. 17A, D-W 8520 Erlangen/F.R.Germany
  Tel. +49 (9131) 208395, Fax +49 (9131) 28205.


*)
FROM ProgramArgs IMPORT IsArgPresent, ArgChan;
IMPORT STextIO, SWholeIO;
FROM IOResult IMPORT ReadResult, ReadResults;
FROM TextIO IMPORT WriteString, ReadToken, SkipLine, ReadString;
IMPORT SeqFile;
FROM RndFile IMPORT OpenClean, OpenOld, read, write, text, binary,
  ChanId, OpenResults, Close, FilePos, SetPos, NewPos, StartPos;
FROM RawIO IMPORT Write, Read;

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

TYPE
  WCproc = PROCEDURE(CARDINAL, CARDINAL);
  WSproc = PROCEDURE(ARRAY OF CHAR);
  ItemType = ARRAY[0..ITEMLENGTH-1] OF CHAR;
  fnam = ARRAY[0..255] OF CHAR;
  Args = ARRAY[DATA..SEARCH] OF fnam;

VAR
  WC: WCproc; WS: WSproc; NL: PROC;
  data, ins, sea: ChanId;
  free: INTEGER;
  file: Args;
  startPos: FilePos;

PROCEDURE CalcPos(Key: CARDINAL): FilePos;
BEGIN
  RETURN NewPos(data, VAL(INTEGER, Key), ITEMLENGTH, startPos);
END CalcPos;

PROCEDURE CalcKey(item: ARRAY OF CHAR): CARDINAL;
VAR len, i, key: CARDINAL;
BEGIN
  len:= 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: INTEGER; eq: BOOLEAN; len: CARDINAL;
BEGIN
  i:= 0; eq:= TRUE; len:= LENGTH(new);
  WHILE (i < VAL(INTEGER, len)) AND eq DO
    eq:= old[i] = new[i]; INC(i);
  END;
  RETURN eq;
END EQUAL;

PROCEDURE Insert(item: ARRAY OF CHAR);
VAR Key, offset: CARDINAL; atPos: ItemType; eq: BOOLEAN;
BEGIN
  IF free > 0 THEN
    Key:= CalcKey(item);
    SetPos(data, CalcPos(Key));
    Read(data, atPos); offset:= 0;
    eq:= EQUAL(atPos, item);
    WHILE NOT eq AND (atPos[0] <> 0C) AND (offset < ITEMS) DO
      IF ReadResult(data) = endOfInput THEN SetPos(data, startPos);
      END;
      Read(data, atPos);
      eq:= EQUAL(atPos, item); INC(offset);
    END;
    IF eq THEN WS('already inserted');
    ELSE
      SetPos(data, CalcPos((Key + offset) MOD ITEMS));
      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: CARDINAL; atPos: ItemType; eq: BOOLEAN;
BEGIN
  Key:= CalcKey(item);
  SetPos(data, CalcPos(Key));
  Read(data, atPos); offset:= 0;
  eq:= EQUAL(atPos, item);
  WHILE NOT eq AND (atPos[0] <> 0C) AND (offset < ITEMS) DO
    IF ReadResult(data) = endOfInput THEN SetPos(data, startPos);
    END;
    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], text, ores);
  IF ores <> opened THEN WS('failed to open '); WS(file[INSERT]); NL;
  ELSE
    WS('Inserting token strings from file '); WS(file[INSERT]); NL;
    ReadToken(ins, item);
    WHILE ReadResult(ins) <> endOfInput DO
      Insert(item);
      ReadToken(ins, item);
      IF ReadResult(ins) = endOfLine THEN
        SkipLine(ins);
        ReadToken(ins, item);
      END;
    END;
    SeqFile.Close(ins);
  END;
END InsertIt;

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

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

VAR
  ores: OpenResults;
  empty: ItemType;
  i: INTEGER; wrongArgs: BOOLEAN;

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

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



Fri, 09 Sep 1994 15:00:07 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. ISO M2 I/O-Lib test file: TestExam.MOD

2. ISO M2 Std Lib Defs .ARC

3. ISO M2 Std Lib Defs .ARC

4. ISO M2 COMPLEX-number constructor test

5. ISO Modula-2 Standard I/O-Lib test progr

6. Oberon-2 random file access w ISO M2 Std

7. check digit ISO 7064 MOD 11, 10

8. Editing LIB Files to Change Functions Within LIB Files

9. DIV, MOD, /, REM (M2,O2)

10. IOTRANSFER: why was it modified in ISO M2?

11. Status of M2 ISO Standard

12. ISO M2 Library for Oberon-2

 

 
Powered by phpBB® Forum Software