(**********************************************************************

    :Program.    (Turbo)Files
    :Contents.   Module for filehandling, like FileSystem
    :Author.     Stefan Salewski
    :Address.    Stefan Salewski, Stolper Weg 3, D-2160 Stade
    :Copyright.  FD
    :Language.   Oberon/68000-Assembler
    :Translator. Amiga-Oberon-Compiler V2.0 and A68k
    :History.    V2.0     12-06-91
    :Remark.     The modules Files and TurboFiles does the same, but
    :Remark.     TurboFiles is quicker, because the important
    :Remark.     Procedures are coded in Assembler.

**********************************************************************)

MODULE Files;
  IMPORT SYSTEM,
         OberonLib,
         Dos,
         SecureDos,
         Exec,
         Random,
         ASCII,
         Strings;

  CONST
    D0= 0; D1= 1;
    A0= 8; A1= 9;

  CONST
    newFile* = TRUE;    (* open new file (delete old one) for read/write *)
    oldFile* = FALSE;   (* open existing file for read/write *)

  CONST (* Error-Codes = file.res *)
    done*         = 0;
    notdone*      = 1;
    notOpen*      = 2;
    openError*    = 3;
    readError*    = 4;
    writeError*   = 5;
    seekError*    = 6;
    endOfFile*    = 7;
    outOfMem*     = 8;
    notExists*    = 9;

  CONST (* Modes for SetPos *)
    beginning* = Dos.beginning;
    current*   = Dos.current;
    end*       = Dos.end;

  TYPE
    File* = RECORD
              fhPtr:Dos.FileHandlePtr;
              dosBase:Exec.ADDRESS;
              base:Exec.ADDRESS;
              top:Exec.ADDRESS;
              filePos:LONGINT;
              startLength:LONGINT;
              act:Exec.ADDRESS;
              readTop:Exec.ADDRESS;
              writeBase:Exec.ADDRESS;
              writeTop:Exec.ADDRESS;
              open:BOOLEAN;
              res*:SHORTINT;
           END;

  VAR
    DosBase:Exec.ADDRESS;
    ExecBase[4]:Exec.ADDRESS;

  PROCEDURE CopyMem{ExecBase,-624}(source{8}:Exec.ADDRESS;
                                   dest{9}:Exec.ADDRESS;
                                   size{0}:LONGINT);

  PROCEDURE DosRead{DosBase,-42}(file{1}:Dos.FileHandlePtr;
                                 buffer{2}:Exec.ADDRESS;
                                 length{3}:LONGINT):LONGINT;

  PROCEDURE DosWrite{DosBase,-48}(file{1}:Dos.FileHandlePtr;
                                  buffer{2}:Exec.ADDRESS;
                                  length{3}:LONGINT):LONGINT;

  PROCEDURE DeleteFile*{DosBase,-72}(name{1}:ARRAY OF CHAR):BOOLEAN;

  PROCEDURE MaxLongInt(i,j:LONGINT):LONGINT;
  BEGIN
    IF i>j THEN RETURN i ELSE RETURN j END;
  END MaxLongInt;

  PROCEDURE MinLongInt(i,j:LONGINT):LONGINT;
  BEGIN
    IF i<j THEN RETURN i ELSE RETURN j END;
  END MinLongInt;

  PROCEDURE Exists*(name: ARRAY OF CHAR;VAR size:LONGINT):BOOLEAN;
  (* $CopyArrays- *)
    VAR
      flPtr:Dos.FileLockPtr;
      (* info:Dos.FileInfoBlock; must be on a 4 byte boundary !!! *)
      infoPtr:Dos.FileInfoBlockPtr;
      exists:BOOLEAN;
  BEGIN
    exists:=FALSE;
    size:=0;
    flPtr:=SecureDos.Lock(name,Dos.sharedLock);
    IF flPtr#NIL THEN
      NEW(infoPtr);
      IF infoPtr#NIL THEN
        IF Dos.Examine(flPtr,infoPtr^) THEN
          exists:=TRUE;
          IF infoPtr.dirEntryType<0 THEN (* is a file *)
            size:=infoPtr.size;
          ELSE
            size:=-1                  (* is a directory *)
          END;
        END;
        DISPOSE(infoPtr);
      END;
      SecureDos.UnLock(flPtr);
    END;
    RETURN exists
  END Exists;

  PROCEDURE Open*(VAR f:File;name:ARRAY OF CHAR;
                  bufferSize:LONGINT;new:BOOLEAN):BOOLEAN;
  (* $CopyArrays- *)
    VAR
      buf:Exec.ADDRESS;
      mode:LONGINT;
  BEGIN
    f.open:=FALSE;
    IF new THEN
      f.startLength:=0;
      mode:=Dos.newFile
    ELSE
      mode:=Dos.oldFile;
      IF NOT Exists(name,f.startLength) OR (f.startLength<0) THEN
        f.res:=notExists;
        RETURN FALSE
      END;
    END;
    IF bufferSize<1 THEN bufferSize:=1 END;
    OberonLib.New(buf,bufferSize);
    IF buf=NIL THEN
      f.res:=outOfMem;
      RETURN FALSE
    END;
    f.fhPtr:=SecureDos.Open(name,mode);
    IF f.fhPtr=NIL THEN
      OberonLib.Dispose(buf);
      f.res:=openError;
      RETURN FALSE
    ELSE
      f.dosBase:=DosBase;
      f.filePos:=0;
      f.base:=buf;
      f.top:=buf+bufferSize;
      f.act:=buf;
      f.readTop:=buf;
      f.writeTop:=buf;
      f.writeBase:=f.top;
      f.open:=TRUE;
      f.res:=done;
      RETURN TRUE;
    END;
  END Open;

  PROCEDURE Close*(VAR f:File):BOOLEAN;
  BEGIN
    IF (NOT f.open) OR (f.res=notOpen) THEN RETURN FALSE END;
    IF f.writeTop>f.writeBase THEN
      IF Dos.Seek(f.fhPtr,f.writeBase-f.readTop,Dos.current) > 0 THEN END;
      IF DosWrite(f.fhPtr,f.writeBase,f.writeTop-f.writeBase)> 0 THEN END;
    END;
    SecureDos.Close(f.fhPtr);
    OberonLib.Dispose(f.base);
    f.open:=FALSE;
    f.res:=notOpen;
    RETURN TRUE;
  END Close;

  PROCEDURE SaveBuffer(VAR f:File):BOOLEAN;
    VAR
      t,l:LONGINT;
  BEGIN
    t:=f.writeBase-f.readTop;
    IF t#0 THEN
      l:=Dos.Seek(f.fhPtr,t,Dos.current);
    END;
    t:=f.writeTop-f.writeBase;
    l:=DosWrite(f.fhPtr,f.writeBase,t);
    IF l#t THEN
      f.res:=writeError;
      RETURN FALSE
    END;
    t:=f.act-f.writeTop;
    IF t#0 THEN
      l:=Dos.Seek(f.fhPtr,t,Dos.current)
    END;
    f.filePos:=f.filePos+f.act-f.readTop;
    f.writeTop:=f.base;
    f.writeBase:=f.top;
    RETURN TRUE
  END SaveBuffer;

  PROCEDURE ReadBytes*(VAR f:File;adr:Exec.ADDRESS;len:LONGINT):LONGINT;
    VAR
      actual,l,toRead:LONGINT;
  BEGIN
    actual:=0;
    IF (f.res#done) OR (NOT f.open) OR (len<=0) THEN
      RETURN 0
    END;
    LOOP
      IF (f.act>=f.readTop) AND (f.act>=f.writeTop) THEN
        IF f.writeTop>f.writeBase THEN
          IF NOT SaveBuffer(f) THEN EXIT END;
        END;
        l:=DosRead(f.fhPtr,f.base,f.top-f.base);
        INC(f.filePos,l);
        IF l=0 THEN
          f.res:=endOfFile;
          EXIT
        END;
        f.act:=f.base;
        f.readTop:=f.base+l;
      END;
      toRead:=MinLongInt(MaxLongInt(f.readTop,f.writeTop)-f.act,len);
      CopyMem(f.act,adr,toRead);
      INC(f.act,toRead);
      INC(adr,toRead);
      DEC(len,toRead);
      INC(actual,toRead);
      IF len=0 THEN
        EXIT
      END
    END;
    RETURN actual;
  END ReadBytes;

  PROCEDURE WriteBytes*(VAR f:File;adr:Exec.ADDRESS;len:LONGINT):BOOLEAN;
    VAR
      toWrite:LONGINT;
  BEGIN
    IF (f.res#done) OR (NOT f.open) OR (len<=0) THEN
      RETURN FALSE
    END;
    LOOP
      IF f.act=f.top THEN
        IF f.writeTop>f.writeBase THEN
          IF NOT SaveBuffer(f) THEN RETURN FALSE END;
        END;
        f.act:=f.base;
        f.readTop:=f.base;
      END;
      IF f.act<f.writeBase THEN f.writeBase:=f.act END;
      toWrite:=MinLongInt(f.top-f.act,len);
      CopyMem(adr,f.act,toWrite);
      INC(adr,toWrite);
      INC(f.act,toWrite);
      DEC(len,toWrite);
      IF f.act>f.writeTop THEN f.writeTop:=f.act END;
      IF len=0 THEN
        EXIT
      END
    END;
    RETURN TRUE
  END WriteBytes;

  PROCEDURE ReadChar*(VAR f:File;VAR ch:BYTE):BOOLEAN;
  BEGIN
    RETURN ReadBytes(f,SYSTEM.ADR(ch),1)=1
  END ReadChar;

  PROCEDURE WriteChar*(VAR f:File;ch:BYTE):BOOLEAN;
  BEGIN
    RETURN WriteBytes(f,SYSTEM.ADR(ch),1)
  END WriteChar;

  PROCEDURE Read*(VAR f:File;VAR block:ARRAY OF BYTE):BOOLEAN;
  BEGIN
    RETURN ReadBytes(f,SYSTEM.ADR(block),LEN(block))=LEN(block)
  END Read;

  PROCEDURE Write*(VAR f:File;block:ARRAY OF BYTE):BOOLEAN;
  (* $CopyArrays- *)
  BEGIN
    RETURN WriteBytes(f,SYSTEM.ADR(block),LEN(block))
  END Write;

  PROCEDURE ReadString*(VAR f:File;VAR str:ARRAY OF CHAR):INTEGER;
    VAR i:INTEGER;
  BEGIN
    i:=-1;
    LOOP
      INC(i);
      IF i=LEN(str) THEN EXIT END;
      IF NOT ReadChar(f,str[i]) THEN EXIT END;
      IF (str[i]=ASCII.nul) OR (str[i]=ASCII.eol) THEN EXIT END;
    END;
    IF i<LEN(str) THEN str[i]:=0X END;
    RETURN i
  END ReadString;

  PROCEDURE WriteString*(VAR f:File;str:ARRAY OF CHAR):BOOLEAN;
  (* CopyArrays- *)
    VAR i:INTEGER;
  BEGIN
    i:=0;
    WHILE (i<LEN(str)) AND (str[i]#0X) DO
      IF WriteChar(f,str[i]) THEN END;
      INC(i);
    END;
    RETURN f.res=done;
  END WriteString;

  PROCEDURE WriteLn*(VAR f:File):BOOLEAN;
  BEGIN
    RETURN WriteChar(f,ASCII.lf);
  END WriteLn;

  PROCEDURE Size*(VAR f:File):LONGINT;
  VAR
    getPos:LONGINT;
  BEGIN
    IF (f.res#done) OR (NOT f.open) THEN
      RETURN -1
    END;
    getPos:=f.filePos+f.act-f.readTop;
    RETURN MaxLongInt(f.startLength,getPos);
  END Size;

  PROCEDURE GetPos*(VAR f:File):LONGINT;
  BEGIN
    IF (f.res#done) OR (NOT f.open) THEN
      RETURN -1
    ELSE
      RETURN f.filePos+f.act-f.readTop
    END
  END GetPos;

  PROCEDURE SetPos*(VAR f:File;offset:LONGINT;mode:LONGINT):BOOLEAN;
    VAR
      l,newPos,bufTop,getPos:Exec.ADDRESS;
  BEGIN
    IF (f.res#done) OR (NOT f.open) THEN
      RETURN FALSE
    END;
    f.startLength:=Size(f);
    getPos:=f.filePos+f.act-f.readTop;
    bufTop:=MaxLongInt(f.readTop,f.writeTop);
    IF mode=beginning THEN
      offset:=ABS(offset)-getPos
    ELSIF mode=end THEN
      offset:=f.startLength-getPos-ABS(offset)
    END;
    newPos:=f.act+offset;
    IF (newPos>=f.base) AND (newPos<bufTop) THEN
      f.act:=newPos;
      RETURN TRUE
    ELSE
      newPos:=getPos+offset;
      IF (newPos<0) OR (newPos>f.startLength) THEN
        f.res:=seekError;
        RETURN FALSE
      ELSE
        IF f.writeTop>f.writeBase THEN
          l:=Dos.Seek(f.fhPtr,f.writeBase-f.readTop,Dos.current);
          getPos:=f.writeTop-f.writeBase;
          l:=DosWrite(f.fhPtr,f.writeBase,getPos);
          IF l#getPos THEN
            f.res:=writeError;
            RETURN FALSE
          END;
          f.writeTop:=f.base;
          f.writeBase:=f.top;
        END;
        l:=Dos.Seek(f.fhPtr,newPos,Dos.beginning);
        f.filePos:=newPos;
        f.act:=f.base;
        f.readTop:=f.base;
        RETURN TRUE;
      END;
    END;
  END SetPos;

  PROCEDURE Search*(VAR f:File;str:ARRAY OF BYTE;len:INTEGER):LONGINT;
  (* $CopyArrays- *)
  VAR
    i:INTEGER;
    b:BYTE;
  BEGIN
    IF NOT (f.open) OR (f.res#done) THEN RETURN -1 END;
    IF (len>LEN(str)) OR (len<=0) THEN
      len:=LEN(str)
    END;
    DEC(len);
    LOOP
      i:=0;
      LOOP
        IF NOT ReadChar(f,b) THEN RETURN -1 END;
        IF (b#str[i]) OR (i=len) THEN
          EXIT
        END;
        INC(i);
      END;
      IF (str[i]=b) AND SetPos(f,-i-1,current) THEN
        RETURN GetPos(f)
      ELSIF (i>0) THEN
       IF SetPos(f,-i,current) THEN END;
      END;
    END;
  END Search;

  PROCEDURE Code*(fileName,codeWord:ARRAY OF CHAR;decode:BOOLEAN):BOOLEAN;
  (* $CopyArrays- *)
    CONST
      Mult=2;
      CodeStringSize=127;
      BufferSize=1024;
    TYPE
      CodeString=ARRAY CodeStringSize OF SHORTINT;

    VAR
      act,i:LONGINT;
      cWLen:LONGINT;
      f:File;
      eof:BOOLEAN;
      code,readPuffer,writePuffer,index:CodeString;

    PROCEDURE Permute(VAR index,code:CodeString;len:SHORTINT);
    VAR
      qsum:LONGINT;
      i,h,rnd:SHORTINT;
    BEGIN
      (* generating a permutation of the numbers 0..(len-1).
         This permutation depends on code and will be
         stored in index
      *)
      qsum:=0;
      i:=0;
      WHILE i<len DO
        INC(qsum,code[i]);
        index[i]:=i;
        INC(i);
      END;
      Random.PutSeed(qsum);
      i:=0;
      WHILE i<len DO
        rnd:=SHORT(Random.RND(len));
        h:=index[i];
        index[i]:=index[rnd];
        index[rnd]:=h;
        INC(i);
      END;
    END Permute;

  BEGIN
    cWLen:=MinLongInt(Strings.Length(codeWord),CodeStringSize);
    CopyMem(SYSTEM.ADR(codeWord),SYSTEM.ADR(code),cWLen);
    IF cWLen<=0 THEN
      RETURN FALSE
    END;
    IF Open(f,fileName,BufferSize,oldFile) THEN
      WHILE cWLen < (CodeStringSize DIV 2) DO
        CopyMem(SYSTEM.ADR(code),SYSTEM.ADR(code)+cWLen,cWLen);
        INC(cWLen,cWLen);
      END;
      Permute(index,code,SHORT(SHORT(cWLen)));
      i:=0;
      WHILE i<cWLen DO
        (* $OvflChk- *)
        code[i]:=code[i]*Mult;
        (* $OvflChk= *)
        INC(i);
      END;
      eof:=FALSE;
      WHILE NOT eof DO
        act:=ReadBytes(f,SYSTEM.ADR(readPuffer),cWLen);
        IF act<cWLen THEN
          eof:=TRUE;
          f.res:=done; (* So I can write to the file again *)
          Permute(index,code,SHORT(SHORT(act)))
        END;
        IF NOT decode THEN
          i:=0;
          WHILE i<act DO
            (* $OvflChk- *)
            INC(readPuffer[i],code[i]);
            (* $OvflChk= *)
            INC(i);
          END;
          i:=0;
          WHILE i<act DO
            writePuffer[i]:=readPuffer[index[i]];
            INC(i);
          END;
        ELSE
          i:=0;
          WHILE i<act DO
            writePuffer[index[i]]:=readPuffer[i];
            INC(i);
          END;
          i:=0;
          WHILE i<act DO
            (* $OvflChk- *)
            DEC(writePuffer[i],code[i]);
            (* $OvflChk= *)
            INC(i);
          END;
        END;
        IF SetPos(f,-act,current) THEN END;
        IF WriteBytes(f,SYSTEM.ADR(writePuffer),act) THEN END;
      END;
      IF Close(f) THEN END;
      RETURN TRUE
    ELSE
      RETURN FALSE
    END;
  END Code;

BEGIN
  DosBase:=Dos.dos;
  IF DosBase=NIL THEN HALT(0) END;

END Files.