--- a
+++ b/FileSystem.ISO.mi
@@ -0,0 +1,619 @@
+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.