IMPLEMENTATION MODULE FileSystem;
(*------------------------------------------------------------------------*)
(* Implementation einer Dateisystemschittstelle f"ur Modula-2 *)
(* (MtC, MOCKA, XDS M2, GM2). *)
(* *)
(* Letzte Aenderung: *)
(* 91, MRi: Erstellen der ersten Version fuer JPI M2 *)
(* 13.05.93, MRi: Erstellen der ersten Version (MtC) *)
(* 06.01.98, MRi: Anpassungen an Mocka. *)
(* 28.11.14, MRi: Anpassungen an XDS / GM2 *)
(* 08.01.15, MRi: Ersetzen des Aufrufs von stat durch fstat *)
(* *)
(* 03.11.17, MRi: Anpassen an ISO M2 so dass Typ "file" mit IOChan.ChanId *)
(* identisch ist *)
(* 19.01.18, MRi: OpenLargeFile und Rewind wg. kompatibilitaet *)
(* eingefuehrt *)
(*------------------------------------------------------------------------*)
(* Status : Entwicklung *)
(*------------------------------------------------------------------------*)
(* Offene Punkte *)
(* *)
(* - Testen von SetPos *)
(* - Testen von GetPos *)
(* *)
(*------------------------------------------------------------------------*)
(* Licence : GNU Lesser General Public License (LGPL) *)
(*------------------------------------------------------------------------*)
(* $Id: FileSystem.mod,v 1.2 2017/11/04 14:25:26 mriedl Exp mriedl $ *)
FROM SYSTEM IMPORT TSIZE,BYTE,LOC,ADR,CAST;
IMPORT Strings;
FROM Errors IMPORT Fehler,Fehlerflag,ErrOut;
IMPORT Errors;
FROM Deklera IMPORT Locale;
IMPORT IOConsts;
IMPORT ChanConsts;
IMPORT IOChan;
IMPORT RndFile;
IMPORT StdChans;
FROM ChanConsts IMPORT OpenResults;
FROM IOConsts IMPORT ReadResults;
FROM ChanConsts IMPORT ChanFlags;
IMPORT STextIO;
(*--------------------------- Lokale Objekte --------------------------------*)
CONST MaxDateiNamenLaenge = 255; (* _POSIX_PATH_MAX *)
debug = FALSE;
VAR Lang : Locale;
CONST WrChar = STextIO.WriteChar;
WrStr = STextIO.WriteString;
WrLn = STextIO.WriteLn;
PROCEDURE WrOpenResults(res : RndFile.OpenResults);
BEGIN
WrStr(" OpenResult = ");
CASE res OF
| opened : WrStr("opened");
| wrongNameFormat : WrStr("wrongNameFormat");
| wrongFlags : WrStr("wrongFlags");
| tooManyOpen : WrStr("tooManyOpen");
| outOfChans : WrStr("outOfChans");
| wrongPermissions : WrStr("wrongPermissions");
| noRoomOnDevice : WrStr("noRoomOnDevice");
| noSuchFile : WrStr("noSuchFile");
| fileExists : WrStr("fileExists");
| wrongFileType : WrStr("wrongFileType");
| noTextOperations : WrStr("noTextOperations");
| noRawOperations : WrStr("noRawOperations");
| noMixedOperations : WrStr("noMixedOperations");
| alreadyOpen : WrStr("alreadyOpen");
| otherProblem : WrStr("otherProblem");
ELSE
END;
WrLn;
END WrOpenResults;
PROCEDURE WrReadResults(res : IOConsts.ReadResults);
BEGIN
WrStr(" ReadResult = ");
CASE res OF
| notKnown : WrStr("notKnown");
| allRight : WrStr("allRight");
| outOfRange : WrStr("outOfRange");
| wrongFormat : WrStr("wrongFormat");
| endOfLine : WrStr("endOfLine");
| endOfInput : WrStr("endOfInput");
ELSE
END;
WrLn;
END WrReadResults;
(*--------------------------- Globale Objekte --------------------------------*)
PROCEDURE GetFileName( f : File; (* Kanalnummer *)
VAR Name : ARRAY OF CHAR); (* Dateiname *)
BEGIN
IF NOT RndFile.IsRndFile(f) THEN
Name[0] := 0C;
ELSE
IOChan.GetName(f,Name);
END;
END GetFileName;
PROCEDURE IsOpen(f : File) : BOOLEAN;
BEGIN
RETURN RndFile.IsRndFile(f);
END IsOpen;
PROCEDURE Lookup(VAR f : File;
Name : ARRAY OF CHAR;
creat : BOOLEAN;
OpenMask : OpenMode);
VAR DName : ARRAY [0..MaxDateiNamenLaenge] OF CHAR;
flags : RndFile.FlagSet;
res : RndFile.OpenResults;
BEGIN
Fehler := FALSE;
IF (Strings.Length(Name) = 0) THEN
IF (Lang = DE) THEN
Fehlerflag:="Dateiname leer (FileSystem.Lookup) !";
ELSE
Fehlerflag:="empty file name (FileSystem.Lookup) !";
END;
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE;
RETURN;
END;
Strings.Assign(Name,DName); (* Wegen m"oglicherweise fehlendem 0C *)
(* "Offnen oder Erzeugen der Datei. *)
IF debug THEN
WrLn;
WrStr(" Lookup("); WrStr(Name); WrChar(" ");
END;
IF creat THEN
IF debug THEN
WrStr(" creat ");
END;
flags := RndFile.FlagSet{ChanConsts.rawFlag,
ChanConsts.writeFlag};
IF (openRDWR IN OpenMask) THEN
INCL(flags,ChanConsts.readFlag);
END;
RndFile.OpenClean(f,Name,flags,res);
IF (res = fileExists) THEN
INCL(flags,ChanConsts.oldFlag);
RndFile.OpenClean(f,Name,flags,res);
IF debug THEN
WrStr("Lookup creat 2. Versuch ");
WrOpenResults(res);
END;
END;
ELSE (* "Offnen zum Lesen, Schreiben etc. *)
IF debug THEN
WrStr(" NOT creat ");
END;
flags := RndFile.FlagSet{ChanConsts.rawFlag,
ChanConsts.oldFlag};
IF (openRDONLY IN OpenMask) THEN
INCL(flags,ChanConsts.readFlag);
IF debug THEN
WrStr("{rawFlag,oldFlag,readFlag}"); WrLn;
END;
ELSIF (openWRONLY IN OpenMask) THEN
INCL(flags,ChanConsts.writeFlag);
IF debug THEN
WrStr("{rawFlag,oldFlag,writeFlag}"); WrLn;
END;
ELSIF (openRDWR IN OpenMask) THEN
INCL(flags,ChanConsts.readFlag);
INCL(flags,ChanConsts.writeFlag);
IF debug THEN
WrStr("{rawFlag,oldFlag,readFlag,writeFlag}"); WrLn;
END;
END;
RndFile.OpenOld(f,Name,flags,res);
END;
IF (res # opened) THEN
IF debug THEN
WrOpenResults(res);
END;
IF creat THEN
IF (Lang = DE) THEN
Fehlerflag:="Fehler beim Erstellen der Datei '";
ELSE
Fehlerflag:="Error while creating file '";
END;
ELSE
IF (Lang = DE) THEN
Fehlerflag:="Fehler beim Oeffnen der Datei '";
ELSE
Fehlerflag:="Error opening file '";
END;
END;
Strings.Append(DName,Fehlerflag);
Strings.Append("' (FileSystem.Lookup) !",Fehlerflag);
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; RETURN;
END;
END Lookup;
PROCEDURE OpenLargeFile(VAR f : File;
name : ARRAY OF CHAR;
creat : BOOLEAN);
VAR OpenMask : OpenMode;
BEGIN
OpenMask:=OpenMode({OpenRDWR});
IF creat THEN INCL(OpenMask,OpenRDWR); END;
Lookup(f,name,creat,OpenMask);
END OpenLargeFile;
PROCEDURE ReWrite(VAR f : File);
VAR DName : ARRAY [0..MaxDateiNamenLaenge] OF CHAR;
res : RndFile.OpenResults;
flags : RndFile.FlagSet;
BEGIN
Fehler:=FALSE;
IF NOT RndFile.IsRndFile(f) THEN
IF (Lang = DE) THEN
Fehlerflag:=" Datei nicht geoeffnet (FileSystem.ReWrite)";
ELSE
Fehlerflag:=" file not open (FileSystem.ReWrite)";
END;
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler := TRUE;
RETURN;
END;
flags := IOChan.CurrentFlags(f); (* Get flags of file *)
IOChan.GetName(f,DName); (* Dateiname von f ermitteln, dann *)
IF debug THEN
Errors.WriteString("ReWrite, Dateiname : "); Errors.WriteString(DName);
Errors.WriteLn;
END;
RndFile.Close(f); (* Schlie3en und neu"offnen mit Abschneiden. *)
INCL(flags,ChanConsts.oldFlag);
RndFile.OpenClean(f,DName,flags,res);
IF (res # opened) THEN
IF (Lang = DE) THEN
Fehlerflag:=" Dateioeffnungsfehler (FileSystem.ReWrite) !";
ELSE
Fehlerflag:=" file open error (FileSystem.ReWrite) !";
END;
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; RETURN;
END;
END ReWrite;
PROCEDURE Exists(DName : ARRAY OF CHAR) : BOOLEAN;
VAR datei : RndFile.ChanId;
res : RndFile.OpenResults;
BEGIN
RndFile.OpenOld(datei,DName,ChanConsts.raw,res);
IF (res # fileExists) THEN
RETURN FALSE;
ELSE
RndFile.Close(datei);
RETURN TRUE;
END;
END Exists;
PROCEDURE Close(VAR f : File);
BEGIN
IF NOT RndFile.IsRndFile(f) THEN
IF (Lang = DE) THEN
Fehlerflag:=" Datei nicht geoeffnet (FileSystem.Close) !";
ELSE
Fehlerflag:=" file not open (FileSystem.Close) !";
END;
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE;
RETURN;
END;
RndFile.Close(f);
IF RndFile.IsRndFileException() THEN
IF (Lang = DE) THEN
ErrOut("Fehler in FileSystem.Close !");
ELSE
ErrOut("Error in FileSystem.Close !");
END;
END;
END Close;
PROCEDURE CloseAll();
BEGIN
(* No idea how to implement *)
END CloseAll;
PROCEDURE Delete( Name : ARRAY OF CHAR;
VAR f : File);
BEGIN
Errors.WriteString("Error with file ");
Errors.WriteString(Name);
Errors.ErrOut
("FileSystem.Delete not implemented for ISO M2 IO interface.");
IOChan.SetReadResult(f,notKnown);
END Delete;
PROCEDURE Length( f : File;
VAR Len : LONGCARD);
BEGIN
Errors.ErrOut
("FileSystem.Length not implemented for ISO M2 IO interface.");
IOChan.SetReadResult(f,notKnown);
Len := MAX(LONGCARD);
END Length;
PROCEDURE GetPos( f : File;
VAR Pos : FilePos);
VAR IPos : RndFile.FilePos;
BEGIN
Fehler:=FALSE;
IPos:=RndFile.CurrentPos(f);
IF RndFile.IsRndFileException() THEN
IF (Lang = DE) THEN
Fehlerflag:=" Fehler in FileSystem.GetPos";
ELSE
Fehlerflag:=" error in FileSystem.GetPos";
END;
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; Pos:=MAX(FilePos);
RETURN;
END;
Pos := CAST(FilePos,IPos);
END GetPos;
PROCEDURE SetPos(VAR f : File;
Pos : FilePos);
VAR IPos : RndFile.FilePos;
BEGIN (* Testen *)
Fehler:=FALSE;
IF NOT RndFile.IsRndFile(f) THEN
IF (Lang = DE) THEN
Fehlerflag:=" Datei nicht geoeffnet (FileSystem.SetPos) !";
ELSE
Fehlerflag:=" file not open (FileSystem.SetPos) !";
END;
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; RETURN;
END;
IPos:=CAST(RndFile.FilePos,Pos);
RndFile.SetPos(f,IPos);
IF RndFile.IsRndFileException() THEN
IF (Lang = DE) THEN
Fehlerflag:=" SetPos nicht moeglich (FileSystem.SetPos) !";
ELSE
Fehlerflag:=" SetPos not possible (FileSystem.SetPos) !";
END;
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE;
END;
END SetPos;
PROCEDURE Rewind(VAR f : File);
BEGIN
SetPos(f,0);
END Rewind;
PROCEDURE WrChanFlags(flags : RndFile.FlagSet);
BEGIN
WrChar("{");
IF (readFlag IN flags) THEN
WrStr("readFlag"); WrChar(",");
END;
IF (writeFlag IN flags) THEN
WrStr("writeFlag"); WrChar(",");
END;
IF (oldFlag IN flags) THEN
WrStr("oldFlag"); WrChar(",");
END;
IF (textFlag IN flags) THEN
WrStr("textFlag"); WrChar(",");
END;
IF (rawFlag IN flags) THEN
WrStr("rawFlag"); WrChar(",");
END;
IF (interactiveFlag IN flags) THEN
WrStr("interactiveFlag"); WrChar(",");
END;
IF (echoFlag IN flags) THEN
WrStr("echoFlag"); WrChar(",");
END;
WrChar("}"); WrLn;
END WrChanFlags;
PROCEDURE ReadNBytes( f : File;
VAR Ziel : ARRAY OF BYTE;
n : CARDINAL;
VAR m : CARDINAL);
VAR nbyts : CARDINAL;
target : POINTER TO ARRAY [0..MAX(INTEGER)-1] OF LOC;
RdResult : IOConsts.ReadResults;
flags : RndFile.FlagSet;
BEGIN (* Testen *)
IF debug THEN
flags := IOChan.CurrentFlags(f); (* Get flags of file *)
WrChanFlags(flags);
END;
target := ADR(Ziel);
IF debug THEN
WrStr("Aufruf von RawRead ... ");
END;
IOChan.RawRead(f,target,n,nbyts);
IF debug THEN
WrStr("beendet !"); WrLn;
END;
RdResult:=IOChan.ReadResult(f);
IF (RdResult # IOConsts.allRight) THEN
IF debug THEN
WrReadResults(RdResult);
END;
Fehlerflag:=" Lesefehler (FileSystem.ReadNBytes) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; m:=0; RETURN;
END;
m := nbyts;
END ReadNBytes;
PROCEDURE WriteNBytes( f : File;
VAR Quelle : ARRAY OF BYTE;
n : CARDINAL;
VAR m : CARDINAL);
BEGIN (* Testen *)
Fehler:=FALSE;
IOChan.RawWrite(f,ADR(Quelle),n);
(*
RdResult:=IOChan.ReadResult(f);
IF (RdResult # IOConsts.allRight) THEN
Fehlerflag:=" Schreiben nicht moeglich (FileSystem.WriteNBytes) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; m := 0; RETURN;
END;
*)
m := n;
END WriteNBytes;
PROCEDURE RdBinObj( Ein : File;
VAR A : ARRAY OF BYTE;
N : CARDINAL;
VAR ifehl : INTEGER);
CONST BlockSize = 16*1024;
BlockLen = BlockSize DIV TSIZE(BYTE);
VAR NBytes,NBlocks,rest : CARDINAL;
iblk,ii,nbytes : CARDINAL;
BEGIN
ifehl:=0;
IF (N > HIGH(A)+1) THEN
ifehl:=2;
Fehler:= TRUE; Fehlerflag:="Feld A zu klein (RdBinObj)";
ErrOut(Fehlerflag);
RETURN;
END;
NBytes := N*TSIZE(BYTE);
NBlocks := NBytes DIV BlockSize;
rest := NBytes MOD BlockSize;
ii:=0;
IF (NBlocks > 0) THEN
iblk:=1;
REPEAT
ReadNBytes(Ein,(*ADR*)A[ii],BlockSize,nbytes);
Fehler:= (nbytes # BlockSize);
INC(iblk); INC(ii,BlockLen);
UNTIL (iblk > NBlocks) OR Fehler;
END;
IF NOT Fehler AND (rest > 0) THEN
ReadNBytes(Ein,(*ADR*)A[ii],rest,nbytes);
Fehler:= (nbytes # rest);
END;
IF Fehler THEN
ifehl:=1;
Fehlerflag:="Keine ausreichende Zahl Bytes einlesbar (RdBinObj)";
ErrOut(Fehlerflag);
END;
END RdBinObj;
PROCEDURE WrBinObj( Aus : File;
VAR A : ARRAY OF BYTE;
N : CARDINAL;
VAR ifehl : INTEGER);
CONST BlockSize = 16*1024;
BlockLen = BlockSize DIV TSIZE(BYTE);
VAR NBytes,NBlocks,rest : CARDINAL;
iblk,ii,nbytes : CARDINAL;
BEGIN
ifehl:=0;
IF (N > HIGH(A)+1) THEN
ifehl:=2;
Fehler:= TRUE; Fehlerflag:="Feld A zu klein (WrBinObj)";
ErrOut(Fehlerflag);
RETURN;
END;
NBytes := N*TSIZE(BYTE);
NBlocks := NBytes DIV BlockSize;
rest := NBytes MOD BlockSize;
ii:=0;
IF (NBlocks > 0) THEN
iblk:=1;
REPEAT
WriteNBytes(Aus,(*ADR*)A[ii],BlockSize,nbytes);
Fehler:= (nbytes # BlockSize);
INC(iblk); INC(ii,BlockLen);
UNTIL (iblk > NBlocks) OR Fehler;
END;
IF NOT Fehler AND (rest # 0) THEN
WriteNBytes(Aus,(*ADR*)A[ii],rest,nbytes);
Fehler:= (nbytes # rest);
END;
IF Fehler THEN
ifehl:=1;
Fehlerflag:="Keine ausreichende Zahl Bytes einlesbar (WrBinObj)";
ErrOut(Fehlerflag);
END;
END WrBinObj;
(*============== Unix - spezifische Routinen. ==============*)
(*============== F"ur DOS ohne Bedeutung. ==============*)
PROCEDURE ChMod(VAR f : File;
Modus : AccessMode);
BEGIN
Errors.ErrOut
("FileSystem.ChMod not implemented for ISO M2 IO interface.");
IOChan.SetReadResult(f,notKnown);
END ChMod;
PROCEDURE Lock(VAR f : File);
BEGIN
Errors.ErrOut
("FileSystem.Lock not implemented for ISO M2 IO interface.");
IOChan.SetReadResult(f,notKnown);
END Lock;
PROCEDURE UnLock(VAR f : File);
BEGIN
Errors.ErrOut
("FileSystem.UnLock not implemented for ISO M2 IO interface.");
IOChan.SetReadResult(f,notKnown);
END UnLock;
PROCEDURE Sync();
BEGIN
Errors.ErrOut
("FileSystem.Sync not implemented for ISO M2 IO interface.");
END Sync;
BEGIN
Input :=StdChans.StdInChan();
Output:=StdChans.StdOutChan();
StdErr:=StdChans.StdErrChan();
(* Wenn TRUE, kann es zu kaskadierenden Fehermeldungen im Modul *)
(* Streams kommen. *)
CheckIO := TRUE;
Lang := DE;
FINALLY
CheckIO := FALSE;
CloseAll();
END FileSystem.