IMPLEMENTATION MODULE FileSystem;
(* 05-Jun-93/bp *)

(* maxFileName von 63 auf 255 gesetzt *)

(*$
    LargeVars:=FALSE
    StackChk:=FALSE
    Volatile:=FALSE
    NilChk:=FALSE
    StackParms:=FALSE
    LongAlign:=TRUE
*)

FROM SYSTEM IMPORT
 CAST, ADDRESS, BYTE, ADR, ASSEMBLE;
IMPORT
 Arts,ASCII,DosD,DosL,ExecD,ExecL;

CONST
 maxFileName=63;

(*
 * Usage of the fields in the user's file variable:
 *	bufa:	points to the current file buffer
 *	ina:	points to the first character behind all legal data
 *	ela:	points to next character to be read from file
 *	topa:	points to first byte behind the file buffer
 *
 * Simple rule:
 *	bufa <= ela <=ina <=topa
 *)
TYPE
 IFilePtr=POINTER TO IFile;
 IFile=RECORD
  next: IFilePtr;
  size: LONGINT;
  fileName: ARRAY [0..maxFileName] OF CHAR;
  userFile: File
  (* user buffer: ARRAY [0..x] OF CHAR *)
 END;

VAR
 openFiles: IFilePtr;

PROCEDURE ClearFile(VAR f: File);
BEGIN
 WITH f DO
  bufa:=NIL; topa:=NIL; ela:=NIL; ina:=NIL;
  bufPos:=0; filePos:=0;
  file:=NIL; mode:=FileModeSet{};
  eof:=FALSE;
 END
END ClearFile;

PROCEDURE Link(if: IFilePtr);
BEGIN
(* add this internal file structure to the chains of files. Do not use the
 * user's file variable for anything. It could be a local variable and illegal
 * for long when used in termination procedure.
 *)
 WITH if^ DO
  next:=openFiles;
 END;
 openFiles:=if;
END Link;

PROCEDURE UnLink(VAR f: File);
VAR
 if,help: IFilePtr;
BEGIN
(*
 * remove this file from the list of internal files.
 *)
 WITH f DO
  IF bufa#NIL THEN
   if:=CAST(ADDRESS,CAST(LONGINT,bufa)-SIZE(IFile));
   IF if=ADDRESS(openFiles) THEN
    openFiles:=openFiles^.next;
    ExecL.FreeMem(if,if^.size);
   ELSIF openFiles#NIL THEN
    help:=openFiles;
    WHILE (help#NIL) & (help^.next#ADDRESS(if)) DO
     help:=help^.next
    END;
    IF help#NIL THEN
     help^.next:=if^.next;
     ExecL.FreeMem(if,if^.size)
    END
   END;
   bufa:=NIL; ela:=NIL; ina:=NIL; topa:=NIL; filePos:=0; bufPos:=0
  END
 END
END UnLink;

PROCEDURE Store(VAR f:  File);
VAR
 if: IFilePtr;
BEGIN
(* Copy the current user file variable into the internal file structure. *)
 if:=CAST(ADDRESS,CAST(LONGINT,f.bufa)-SIZE(IFile));
 if^.userFile:=f
END Store;

PROCEDURE SetResponse(VAR res: Response; default: Response);
VAR
 ioErr: LONGINT;
BEGIN
(* Set the file response to whatever event caused the error. If IoErr() does
 * not return any known value the default response is used *)
 ioErr:=DosL.IoErr();
 IF ioErr=103 THEN	res:=memErr
 ELSIF ioErr=202 THEN	res:=inUse
 ELSIF ioErr=205 THEN	res:=notFound
 ELSIF ioErr=214 THEN	res:=diskWriteProtected
 ELSIF ioErr=218 THEN	res:=deviceNotMounted
 ELSIF ioErr=219 THEN	res:=seekErr
 ELSIF ioErr=221 THEN	res:=diskFull
 ELSIF ioErr=222 THEN	res:=deleteProtected
 ELSIF ioErr=223 THEN	res:=writeProtected
 ELSIF ioErr=225 THEN	res:=notDosDisk
 ELSIF ioErr=226 THEN	res:=noDisk
 ELSE			res:=default
 END
END SetResponse;

PROCEDURE ReadSimpleBytes(VAR f: File; adr: ADDRESS;
                          size: LONGINT; VAR actual: LONGINT);
BEGIN
(* Just read the bytes from the file using DosL.Read, set result if something
 * extraordinary happens. It is assumed the res is already set to done *)
 WITH f DO
  actual:=DosL.Read(file,adr,size);
(* DEFINITION: eof is only TRUE if an attempt is made to read after every
 *             single byte has been read from the file *);
  IF actual<0 THEN
   SetResponse(res,readErr)
  ELSE
   eof:=actual=0;
  END
 END
END ReadSimpleBytes;

PROCEDURE WriteSimpleBytes(VAR f: File; adr: ADDRESS;
                           size: LONGINT; VAR actual: LONGINT);
BEGIN
 WITH f DO
  actual:=DosL.Write(file,adr,size);
  IF actual=-1 THEN
   SetResponse(res,writeErr)
  END
 END
END WriteSimpleBytes;

PROCEDURE DoIO(VAR f: File);
VAR
 pos,size: LONGINT;
BEGIN
 WITH f DO
(* Check if we have to write the current buffer to the file, if nobody
 * ever wrote into this buffer then there is no need to write it out to
 * the file. *)
  IF (res=done) & (write IN mode) THEN
(* Position the file on the buffer's position. *)
   IF filePos#bufPos THEN
    pos:=DosL.Seek(file,bufPos,DosD.beginning)
   ELSE
    pos:=0
   END;
(* Check result of seek operation. *)
   IF pos#-1 THEN
(* Compute size of legal data in buffer and write it to the file. *)
    size:=LONGINT(ina)-LONGINT(bufa);
    pos:=DosL.Write(file,ADDRESS(bufa),size);
    IF pos#size THEN
     res:=writeErr;
    ELSE
     INC(bufPos,size);
     filePos:=bufPos;
    END
   ELSE
    res:=seekErr
   END;
(* remove write from mode, buffer is cleared now *)
   mode:=mode-FileModeSet{write}
  END;
(* initialize for reading/writing next datablock from file *)
  ela:=bufa; ina:=bufa;
(* Do we have to read a new data block? *)
  IF (res=done) & (read IN mode) THEN
(* Compute buffer size and try to fill it with file data *)
   size:=LONGINT(topa)-LONGINT(bufa);
   pos:=DosL.Read(file,ADDRESS(bufa),size);
(* If no error was encountered set bufferPos and ina to the actual values. *)
   IF pos>=0 THEN
    bufPos:=filePos;
    INC(filePos,pos);
    ina:=CAST(ADDRESS,CAST(LONGINT,bufa)+pos)
   ELSE
    res:=readErr
   END
  END;
(* Whatever happend, get IoErr() and set res accordingly *)
  SetResponse(res,res)
 END
END DoIO;

(*$ CopyDyn:=FALSE *)
PROCEDURE Lookup(VAR f: File; name: ARRAY OF CHAR;
                 bufferSize: CARDINAL; new: BOOLEAN);
VAR
 size,openMode: LONGINT;
 i: INTEGER;
 if: IFilePtr;
BEGIN
 ClearFile(f);
 f.res:=notdone;
 size:=LONGINT(SIZE(IFile))+LONGINT(bufferSize);
 if:=ExecL.AllocMem(size,ExecD.MemReqSet{ExecD.memClear});
 IF if#NIL THEN
  if^.size:=size;
  WITH if^ DO
   i:=0;
   WHILE (i<maxFileName) & (i<=HIGH(name)) & (name[i]#ASCII.nul) DO
    fileName[i]:=name[i]; INC(i)
   END;
   fileName[i]:=ASCII.nul;
   WITH userFile DO
    res:=done;
    IF new THEN
     openMode:=DosD.newFile
    ELSE
     openMode:=DosD.oldFile
    END;
    file:=DosL.Open(ADR(fileName),openMode);
    IF file=NIL THEN
     SetResponse(res,openErr)
    END;
    bufa:=ADDRESS(LONGINT(if)+LONGINT(SIZE(IFile)));
    topa:=CAST(ADDRESS,CAST(LONGCARD,bufa)+bufferSize);
    IF bufferSize#0 THEN
     mode:=FileModeSet{}
    ELSE
     mode:=FileModeSet{noBuffer}
    END;
    IF res=done THEN
     ina:=bufa; ela:=bufa;
     filePos:=0; bufPos:=0;
     f:=userFile;
     Link(if);
    ELSE
     f.res:=res;
     ExecL.FreeMem(if,if^.size)
    END
   END
  END
 ELSE
  f.res:=memErr;
 END
END Lookup;

PROCEDURE Close(VAR f: File);
BEGIN
 WITH f DO
  IF file#NIL THEN
   res:=done;
   IF write IN mode THEN
    mode:=FileModeSet{write};
    DoIO(f)
   END;
   DosL.Close(file); file:=NIL;
  END
 END;
 UnLink(f);
 ClearFile(f);
END Close;

PROCEDURE Delete(VAR f: File);
VAR
 if: IFilePtr;
 ok: BOOLEAN;
BEGIN
 WITH f DO
  IF res=done THEN
   DosL.Close(file); file:=NIL;
   if:=CAST(ADDRESS,CAST(LONGINT,bufa)-SIZE(IFile));
   ok:=DosL.DeleteFile(ADR(if^.fileName));
   UnLink(f);
   IF ok THEN
    res:=done
   ELSE
    SetResponse(res,notdone)
   END
  END
 END
END Delete;

PROCEDURE SetPos(VAR f: File; pos: LONGINT);
BEGIN
 WITH f DO
  IF res=done THEN
   IF noBuffer IN mode THEN
    IF DosL.Seek(file,pos,DosD.beginning)=-1 THEN
     SetResponse(res,seekErr)
    END
   ELSE
    IF (bufPos<=pos) & (pos<bufPos+LONGINT(ADDRESS(ina)-ADDRESS(bufa))) THEN
     ela:=CAST(ADDRESS,CAST(ADDRESS,bufa)+pos-bufPos)
    ELSE
     mode:=mode-FileModeSet{read};
     DoIO(f);
     IF DosL.Seek(file,pos,DosD.beginning)#-1 THEN
      filePos:=pos; bufPos:=pos; ela:=bufa; ina:=bufa;
     ELSE
      SetResponse(res,seekErr)
     END
    END
   END;
   Store(f)
  END
 END
END SetPos;

PROCEDURE GetPos(VAR f: File; VAR pos: LONGINT);
BEGIN
 WITH f DO
  IF res=done THEN
   IF noBuffer IN mode THEN
    pos:=DosL.Seek(file,0,DosD.current);
    IF pos=-1 THEN
     SetResponse(res,seekErr); pos:=0
    END
   ELSE
    pos:=bufPos+LONGINT(ADDRESS(ela)-ADDRESS(bufa))
   END
  END
 END
END GetPos;

PROCEDURE Length(VAR f: File; VAR pos: LONGINT);
VAR
 oldPos: LONGINT;
BEGIN
 WITH f DO
  IF res=done THEN
   oldPos:=DosL.Seek(file,0,DosD.end);
   pos:=DosL.Seek(file,oldPos,DosD.beginning);
   IF (write IN mode) THEN
    oldPos:=bufPos+LONGINT(ina)-LONGINT(bufa);
    IF oldPos>pos THEN
     pos:=oldPos
    END
   END
  END
 END
END Length;

PROCEDURE ReadChar(VAR f: File; VAR ch: CHAR);
VAR
 actual: LONGINT;
BEGIN
 ch:=ASCII.nul;
 WITH f DO
  IF res=done THEN
   IF noBuffer IN mode THEN
    ReadSimpleBytes(f,ADR(ch),1,actual)
   ELSE
    mode:=mode+FileModeSet{read};
    IF ADDRESS(ela)=ADDRESS(ina) THEN
     DoIO(f)
    END;
(*
 *  IF ADDRESS(ela)=ADDRESS(ina) THEN
 *   eof:=TRUE
 *  ELSIF res=done THEN
 *   ch:=ela^; INC(ADDRESS(ela))
 *  END
 *)
    eof:=ADDRESS(ela)=ADDRESS(ina);
    IF ~eof & (res=done) THEN
     ch:=ela^; INC(ADDRESS(ela))
    END
   END;
   Store(f)
  END
 END
END ReadChar;

PROCEDURE WriteChar(VAR f: File; ch: CHAR);
VAR
 actual: LONGINT;
BEGIN
 WITH f DO
  IF res=done THEN
   IF noBuffer IN mode THEN
    WriteSimpleBytes(f,ADR(ch),1,actual)
   ELSE
    mode:=mode+FileModeSet{write};
    IF ADDRESS(ela)=ADDRESS(topa) THEN
     DoIO(f)
    END;
    IF res=done THEN
     ela^:=ch; INC(ADDRESS(ela));
     IF ADDRESS(ela)>ADDRESS(ina) THEN ina:=ela END
    END
   END;
   Store(f)
  END
 END
END WriteChar;

PROCEDURE ReadBytes(VAR f: File; adr: ADDRESS;
                    len: LONGINT; VAR actual: LONGINT);
VAR
 blen: LONGINT;
BEGIN
 WITH f DO
  IF res=done THEN
   IF noBuffer IN mode THEN
    ReadSimpleBytes(f,adr,len,actual)
   ELSE
    actual:=0;
    LOOP
     mode:=mode+FileModeSet{read};
     IF ADDRESS(ina)=ADDRESS(ela) THEN
      DoIO(f)
     END;
     eof:=(ADDRESS(ina)=ADDRESS(ela));
     IF res#done THEN
      EXIT
     ELSIF eof THEN
      eof:=actual=0;
      EXIT
     END;
     blen:=LONGINT(ina)-LONGINT(ela);
     IF blen>len THEN
      blen:=len
     END;
     ExecL.CopyMem(ela,adr,blen);
     DEC(len,blen); INC(actual,blen);
     INC(ADDRESS(ela),blen); INC(adr,blen);
     IF len=0 THEN
      EXIT
     END
    END
   END;
   Store(f)
  END
 END
END ReadBytes;

PROCEDURE WriteBytes(VAR f: File; adr: ADDRESS;
                     len: LONGINT; VAR actual: LONGINT);
VAR
 blen: LONGINT;
BEGIN
 WITH f DO
  IF res=done THEN
   IF noBuffer IN mode THEN
    WriteSimpleBytes(f,adr,len,actual)
   ELSE
    actual:=0;
    LOOP
     mode:=mode+FileModeSet{write};
     blen:=LONGINT(topa)-LONGINT(ela);
     IF blen>len THEN
      blen:=len
     END;
     ExecL.CopyMem(adr,ela,blen);
     DEC(len,blen); INC(actual,blen);
     INC(ADDRESS(ela),blen); INC(adr,blen);
     IF LONGINT(ela)>LONGINT(ina) THEN
      ina:=ela
     END;
     IF len=0 THEN
      EXIT
     ELSE
      DoIO(f);
      IF res#done THEN
       EXIT
      END
     END
    END
   END;
   Store(f)
  END
 END
END WriteBytes;

PROCEDURE ReadByteBlock(VAR f: File; VAR block: ARRAY OF BYTE);
VAR
 actual: LONGINT;
BEGIN
 WITH f DO
  IF res=done THEN
   ReadBytes(f,ADR(block),HIGH(block)+1,actual);
   IF (actual#HIGH(block)+1) & (actual#0) & (res=done) THEN
    res:=notdone
   END;
   Store(f)
  END
 END
END ReadByteBlock;

PROCEDURE WriteByteBlock(VAR f: File; VAR block: ARRAY OF BYTE);
VAR
 actual: LONGINT;
BEGIN
 WITH f DO
  IF res=done THEN
   WriteBytes(f,ADR(block),HIGH(block)+1,actual);
   IF actual#HIGH(block)+1 THEN
    SetResponse(f.res,notdone);
    Store(f)
   END
  END
 END
END WriteByteBlock;

BEGIN
 (* openFiles:=NIL; *)

CLOSE

 WHILE (openFiles#NIL) DO
  Close(openFiles^.userFile)
 END
END FileSystem.