FileSystem.def.m2cc
600 lines (522 with data), 33.4 kB
DEFINITION MODULE FileSystem;
(*========================================================================*)
(* WICHTIG: BITTE NUR DIE DATEI FileSystem.def.m2cc EDITIEREN !!! *)
(*========================================================================*)
(* Hint: *)
(* ===== *)
(* *)
(* You can create the definition file for the ISO M2 IO-channnel *)
(* module by "m2cc -D __ISOIO__ < FileSystem.def.m2cc > FileSystem.def *)
(* *)
(* For the original interface to M.Riedl IO-modules please use *)
(* "m2cc -D __MRI__ < FileSystem.def.m2cc > FileSystem.def *)
(* *)
(*------------------------------------------------------------------------*)
(* Dateisystemschnittstelle f"ur JPI-M2 (DOS), MtC und MOCKA (GMD, UNIX) *)
(* Filesystem interface for JPI-M2 (DOS), MtC,MOCKA (GMD, UNIX), XDS M2 *)
(* and GNU Modula-2 *)
(* *)
(* M.Riedl, im Mai 1991. *)
(*------------------------------------------------------------------------*)
(* Licence : GNU Lesser General Public License (LGPL) *)
(*------------------------------------------------------------------------*)
(* $Id: FileSystem.def.m2cc,v 1.3 2018/01/14 15:30:34 mriedl Exp $ *)
FROM SYSTEM IMPORT BYTE;
#ifdef __ISOIO__
IMPORT RndFile;
#endif
#ifdef __ISOIO__
TYPE File = RndFile.ChanId;
FilePos = LONGLONGCARD;
#endif
#ifdef __MRI__
TYPE File = INTEGER;
FilePos = LONGCARD;
#endif
(* OS/2 mit MtC / gcc (emx) *)
(* Generiert mit MakeOpenFlags von A. Dress. *)
(****
TYPE OpenFlags = (
openRDONLY,
openWRONLY,
openRDWR,
openNONBLOCK,
openAPPEND,
openUndefd_5,
openUndefd_6,
openUndefd_7,
openUndefd_8,
openUndefd_9,
openCREAT,
openTRUNC,
openEXCL,
openUndefd_d,
openSYNC,
openNOCTTY
);
****)
(* Irix, Solaris (System V) *)
(* Generiert mit MakeOpenFlags von A. Dress. *)
(****
TYPE OpenFlags = (
openRDONLY,
openWRONLY,
openRDWR,
openUndefd_3,
openAPPEND,
openSYNC,
openUndefd_6,
openUndefd_7,
openNONBLOCK,
openCREAT,
openTRUNC,
openEXCL,
openNOCTTY
);
****)
(* IBM RS6000 AIX (System V) *)
(* Generiert mit MakeOpenFlags von A. Dress. *)
(****
TYPE OpenFlags = (
openRDONLY,
openWRONLY,
openRDWR,
openNONBLOCK,
openAPPEND,
openSYNC,
openUndefd_6,
openUndefd_7,
openUndefd_8,
openCREAT,
openTRUNC,
openEXCL,
openNOCTTY
);
****)
(* SunOS-4.1.x *)
(****
TYPE OpenFlags = (
openRDONLY, (* 00B *)
openWRONLY, (* 01B *)
openRDWR, (* 02B *)
d1, (* Dumme Platzhalter *)
openAPPEND, (* 08B *)
d2,d3,d4,d5, (* Dumme Platzhalter *)
d6, (* Dumme Platzhalter *)
openCREAT, (* 0200B *)
openTRUNC, (* 0400B *)
openEXCL, (* 0800B *)
d7, (* Dumme Platzhalter *)
openSYNC, (* 02000B *)
openNONBLOCK, (* 04000B *)
openNOCTTY (* 08000B *)
);
****)
(* Linux 386 *)
(****
TYPE OpenFlags = (
openRDONLY, (* 00B *)
openWRONLY, (* 01B *)
openRDWR, (* 02B *)
d1,d2,d3,d4, (* Dumme Platzhalter *)
openCREAT, (* 0100B *)
openEXCL, (* 0200B *)
openNOCTTY, (* 0400B *)
openTRUNC, (* 01000B *)
openAPPEND, (* 02000B *)
openNONBLOCK, (* 04000B *)
openSYNC (* 010000B *)
);
****)
(* Linux Kernel 3.x, 02.12.2014 *)
TYPE OpenFlags = (
openRDONLY,
openWRONLY, (* 01B *)
openRDWR,
openUndefd_3,
openUndefd_4,
openUndefd_5,
openUndefd_6,
openCREAT,
openEXCL,
openNOCTTY,
openTRUNC,
openAPPEND,
openNONBLOCK,
openSYNC,
openUndefd_e,
openDIRECT,
openLARGEFILE,
openDIRECTORY,
openNOFOLLOW,
openNOATIME,
openCLOEXEC,
openUndefd_15,
openPATH,
openUndefd_17,
openUndefd_18,
openUndefd_19,
openUndefd_1a,
openUndefd_1b,
openUndefd_1c,
openUndefd_1d,
openUndefd_1e,
openUndefd_1f
);
TYPE OpenMode = SET OF OpenFlags;
(* In der obigen Form kann der SET OpenMode mit den entsprechend *)
(* gesetzten Flaggen wie die unter "C" veroderten Konstanten *)
(* O_WRONLY, O_RDWR etc. verwandt werden, wenn vor dem Aufruf der *)
(* C-Routine open(...) OpenMode um 1 Bit nach rechts verschoben *)
(* wird. *)
(* In the form given above the SET OpenMode with it approprialy *)
(* set flags can be used like the "C" constans O_WRONLY, O_RDWR *)
(* for a call to "C"-touine open(...) if Openmode is shifted by *)
(* one byte to the right. *)
CONST OpenReadOnly = OpenMode{openRDONLY};
OpenWriteOnly = OpenMode{openWRONLY};
OpenReadWrite = OpenMode{openRDWR};
(* Kommentare aus /usr/include/sys/stat.h. *)
TYPE EntryTypes = ( (* Noch nicht benutzt *)
directory, (* S_IFDIR *)
characterSpecial, (* S_IFCHR *)
blockSpecial, (* S_IFBLK *)
regular, (* S_IFREG *)
symbolicLink, (* S_IFLNK *)
socket, (* S_IFSOCK *)
fifo (* S_IFIFO *)
);
(* Zugriffsrechte, die mit ChMod gesetzt werden k"onnen. *)
TYPE AccessFlags = ( (* Bit *)
otherExecute, (* S_IEXEC >> 6 *) (* 0 *)
otherWrite, (* S_IWRITE >> 6 *) (* 1 *)
otherRead, (* S_IREAD >> 6 *) (* 2 *)
groupExecute, (* S_IEXEC >> 3 *) (* 3 *)
groupWrite, (* S_IWRITE >> 3 *) (* 4 *)
groupRead, (* S_IREAD >> 3 *) (* 5 *)
ownerExecute, (* S_IEXEC *) (* 6 *)
ownerWrite, (* S_IWRITE *) (* 7 *)
ownerRead, (* S_IREAD *) (* 8 *)
saveText, (* S_ISVTX *) (* 9 *)
setGroupId, (* S_ISGID *) (* 10 *)
setUserId (* S_ISUID *) (* 11 *)
);
AccessMode = SET OF AccessFlags;
CONST defaultAccess = AccessMode{ownerRead,ownerWrite,groupRead,otherRead};
VAR Input : File; (* Standardeingabe (Tastatur) *)
Output : File; (* Standardausgabe (Bildschirm) *)
StdErr : File; (* Fehlerkanal *)
CheckIO : BOOLEAN;
(*----------------------------------------------------------------*)
(* Wird CheckIO auf FALSE gesetzt, werden Fehler nicht mehr *)
(* auf der Konsole protokoliert. Die Variable Fehler und *)
(* Fehlerflag werden aber in jedem Fall entsprechende gesetzt, *)
(* so da3 der Benutzer einen Fehler selbst abfangen kann. *)
(* *)
(* If CheckIO is set to false error messages are no more written *)
(* to the standard error channel. But in most cases the variables *)
(* Fehler and Fehlerflag (module Errors) are still set so that *)
(* a potential error can be captured. *)
(*----------------------------------------------------------------*)
PROCEDURE Lookup(VAR f : File;
DName : ARRAY OF CHAR;
creat : BOOLEAN;
OpenMask : OpenMode);
(*----------------------------------------------------------------*)
(* Erzeugen und / oder "Offnen einer Datei. *)
(* *)
(* Aufruf (z.B.) *)
(* *)
(* Lookup(f,"dat",TRUE ,OpenMode{openWRONLY}); *)
(* Lookup(f,"dat",FALSE,OpenMode{openWRONLY,openAPPEND}); *)
(* Lookup(f,"dat",FALSE,OpenMode{openWRONLY,openTRUNC}); *)
(* *)
(* f : R"uckgabeseitig Kanalnummer der ge"offneten oder *)
(* erzeugten Datei, -1 im Fehlerfall. *)
(* DName : Dateiname der zu "offnenden/ezeugenden Datei. *)
(* creat : *)
(* TRUE *)
(* Datei wird erzeugt, falls nicht vorhanden. *)
(* Ist die Datei vorhanden, so wird sie gel"oscht *)
(* und mit der Option openCREAT sowie den *)
(* geforderten Offnungsdirektiven erzeugt und ge- *)
(* "offnet (VORSICHT). *)
(* Lassen die Zugriffsrechte der bestehenden Datei *)
(* diese Prozedur NICHT zu, wird f = -1 zur"uckge- *)
(* geben und Fehlerflag wird entsprechend gesetzt. *)
(* Die Datei wird mit den Zugriffsrechte *)
(* defaultAccess erzeugt. Sind diese nicht er- *)
(* er"unscht, so sind sie gleich nach dem Aufruf von *)
(* Lookup durch einen entsprechenden Aufruf von *)
(* FileSystem.ChMod zu "andern. *)
(* FALSE *)
(* Datei wird mit den in OpenMask geforderten *)
(* Optionen ge"offnet, falls vorhanden. *)
(* Ist die Datei nicht vorhanden oder die Zugriffs- *)
(* rechte lassen ein entsprechendes "Offnen nicht *)
(* zu, so wird f auf -1 gesetzt und *)
(* Errors.Fehlerflag wird entsprechend gesetzt. *)
(* Unter MS-DOS haben nur die Eintr"age *)
(* openRDWR, openRDONLY eine Bedeutung. *)
(* OpenMask : "Uber OpenMask kann die Art des "Offnenes der Datei *)
(* durch die in OpenMode m"oglichen Flaggen *)
(* (openTRUNC,openAPPEND,openRDWR, etc.) gesteuert *)
(* werden. *)
(* Wenn openLARGEFILE in OpenMask wird versucht den *)
(* den Support fuer Dateien groesser (2**31-1) zu *)
(* aktivieren, das funktioniert nur wenn dieser *)
(* vom Dateisystem unterstuetzt wird. *)
(* *)
(* Open or create a file *)
(* *)
(* Example of calls: *)
(* *)
(* Lookup(f,"dat",TRUE ,OpenMode{openWRONLY}); *)
(* Lookup(f,"dat",FALSE,OpenMode{openWRONLY,openAPPEND}); *)
(* Lookup(f,"dat",FALSE,OpenMode{openWRONLY,openTRUNC}); *)
(* *)
(* f : after the call the channel number of the opened *)
(* file, -1 in case of an error *)
(* DName : file name of the file to be opened *)
(* creat : *)
(* TRUE *)
(* File will be creat if not present. *)
(* In case the file is already presen it will be *)
(* erased and recreated with openCREAT and all *)
(* requested open directifes (take care) *)
(* If the actual access right of a file does not *)
(* permit the operation, f is set to -1 and *)
(* Errros.Fehlerflag will be set appropriate *)
(* The new file will be created with access riths *)
(* defaultAccess. If that is not wanted they have to *)
(* be changed immediately by a call to ChMod *)
(* FALSE *)
(* the file, if present, will be opende with the *)
(* options requested in OpenMask *)
(* Optionen ge"offnet, falls vorhanden. *)
(* If the file is not present or access rights do - *)
(* not permit an approprite open of the file f will *)
(* set to -1 and Errors.Fehlerflag will be set *)
(* accordingly *)
(* OpenMask : With parameter OpenMask the way the file is opened *)
(* is controlle. Potential flags for OpenMask can be *)
(* (openTRUNC,openAPPEND,openRDWR, etc.) *)
(* If openLARGEFILE in OpenMask the routine tries *)
(* to activate the support for filess greater then *)
(* (2**31-1). This will only work if it is supported *)
(* by the underlaying file system *)
(*----------------------------------------------------------------*)
PROCEDURE OpenLargeFile(VAR f : File;
name : ARRAY OF CHAR;
creat : BOOLEAN);
(*----------------------------------------------------------------*)
(* Open a file with large large file support enabled. This will *)
(* only work on a filesystem supporting large files (size > *)
(* 2**31 - 1) *)
(* Simplifing the handling - can also be done with Lookup and *)
(* openLARGEFILE in OpenMask *)
(*----------------------------------------------------------------*)
PROCEDURE IsOpen(f : File) : BOOLEAN;
(*----------------------------------------------------------------*)
(* Ermittelt ob zu Kanalnummer f eine Datei geoeffnet wurde. *)
(* *)
(* Checks if for channel number f a file had been opened *)
(*----------------------------------------------------------------*)
PROCEDURE GetFileName( f : File; (* Kanalnummer *)
VAR Name : ARRAY OF CHAR); (* Dateiname *)
(*----------------------------------------------------------------*)
(* Ermittelt den zur Kanalummer f geh\"orenden Dateinamen. *)
(* Die Datei mu3 dabei mit FileSystem.Lookup ge"offnet *)
(* worden sein. L"a3t sich der Dateiname nicht ermitteln, *)
(* wird 0C in Name[0] zur"uckgegeben. *)
(* *)
(* Get the filename "Name" of the open file "f". If the routine *)
(* is unable to get the name 0C is returned. *)
(*----------------------------------------------------------------*)
PROCEDURE ReWrite(VAR f : File);
(*----------------------------------------------------------------*)
(* Zur"ucksetzen der Datei f, wobei deren bisheriger Inhalt *)
(* verloren geht. f mu3 einer ge"offneten Datei zugeordnet *)
(* sein. Im Fehlerfall wird f auf -1 gesetzt. *)
(* Die Datei wird mit der Option oRDWR neu ge"offnet. *)
(* *)
(* Reset the file f. The current content of f is lost. f must *)
(* be an opened file. In case of an erroe f is set to -1, *)
(* otherwise the file had been truncted and is now open with *)
(* mode oRDWR *)
(*----------------------------------------------------------------*)
PROCEDURE Exists(DName : ARRAY OF CHAR) : BOOLEAN;
(*----------------------------------------------------------------*)
(* Test, ob eine Datei mit Namen DName im aktuellen *)
(* Arbeitsverzeichniss vorhanden ist. *)
(* *)
(* Check if a file with name "DName" exits in the actual *)
(* directory *)
(*----------------------------------------------------------------*)
PROCEDURE Close(VAR f : File);
(*----------------------------------------------------------------*)
(* Schlie3t die Datei f. Dabei mu3 f einer ge"offnet Datei *)
(* zugeordnet sein. Im Fehlerfall wird f auf -1 gesetzt, *)
(* ansonsten ist f = 0. *)
(* *)
(* Close opened file f. In case of an error f is set to -1, *)
(* otherwise f is 0 after the call. *)
(*----------------------------------------------------------------*)
PROCEDURE CloseAll();
(*----------------------------------------------------------------*)
(* Schlie\3t alle offenen Dateien, privat f"ur das Projekt. *)
(* *)
(* Closes all open files, privat for the Projekt. *)
(*----------------------------------------------------------------*)
PROCEDURE Delete( Name : ARRAY OF CHAR;
VAR f : File);
(*----------------------------------------------------------------*)
(* L"oscht die Datei Name aus dem Dateiverzeichnis. *)
(* Die Datei f mu3 dabei geo2ffnet und auf Name verweisen. *)
(* Im Fehlerfalle wird f auf -1 gesetzt. *)
(* *)
(* Deletes the file with name "Name". The file f must be opened *)
(* and pointing to the file with name "Name". In case of an error *)
(* f is set to -1 *)
(*----------------------------------------------------------------*)
PROCEDURE Length( f : File;
VAR Len : LONGCARD);
(*----------------------------------------------------------------*)
(* Ermittelt die L"ange der mit f verbundenen, ge"offneten *)
(* Datei in Bytes. Im Fehlerfalle werden nur Fehler und *)
(* Fehlerflag gesetzt und Len auf MAX(LONGCARD). *)
(* *)
(* Get the length file f where f needs to be assigned to an open *)
(* file. In case of an error Fehler and Fehlerfalg (module *)
(* Errors) are set and Len is set to MAX(LONGCARD) *)
(*----------------------------------------------------------------*)
PROCEDURE GetPos( f : File;
VAR Pos : FilePos);
(*----------------------------------------------------------------*)
(* Ermittelt die aktuelle Dateiposition in der ge"offneten *)
(* Datei f. Im Fehlerfall wird Pos auf MAX(LONGCARD) gesetzt. *)
(* *)
(* Get the current file position of file f and return the value *)
(* in "Pos". If case of an error Pos is set to MAX(LONGCARD). *)
(*----------------------------------------------------------------*)
PROCEDURE SetPos(VAR f : File;
Pos : FilePos);
(*----------------------------------------------------------------*)
(* Setzt die Dateiposition der ge"offneten Datei f. *)
(* Im Fehlerfall werden nur Fehler und Fehlerflag gesetzt. *)
(* *)
(* Sets the file position of file f to "Pos". If case of an error *)
(* Fehler and Fehlerfalg (module Errors) are set. *)
(*----------------------------------------------------------------*)
PROCEDURE Rewind(VAR f : File);
(*----------------------------------------------------------------*)
(* Zurueckstellen des Dateizeiger auf Position 0. *)
(* *)
(* Set the position of (large) file f to position zero. *)
(*----------------------------------------------------------------*)
PROCEDURE ReadNBytes( f : File;
VAR Ziel : ARRAY OF BYTE;
n : CARDINAL; (* Anzahl der Bytes *)
VAR m : CARDINAL); (* Anzahl gelesener Bytes *)
(*----------------------------------------------------------------*)
(* Liest n Bytes von der Datei f in Ziel. Ist ein Lesen nicht *)
(* m"oglich, so wird m auf 0 gesetzt. Ist m # 0, m < n, so *)
(* ist das Dateiende erreicht. Ansonsten ist nach verlassen *)
(* der Routine m = n. *)
(* *)
(* Reads n bytes form file f into buffer "Ziel". If reading is *)
(* not possible m will be set to 0. m generally indicates the *)
(* amount of bytes read, if m # 0 and m < n after a call the end *)
(* of file f is most probably reached. In normal cases m = n *)
(* should hold after the call to this procedure *)
(*----------------------------------------------------------------*)
PROCEDURE WriteNBytes( f : File;
VAR Quelle : ARRAY OF BYTE;
n : CARDINAL; (* Anzahl der Bytes *)
VAR m : CARDINAL); (* Anzahl geschriebene Bytes *)
(*----------------------------------------------------------------*)
(* Schreibt n Bytes von Ziel auf die Datei f. Ist ein Schreiben *)
(* nicht m"oglich, so wird m auf 0 gesetzt. Ist m # 0, m < n, so *)
(* wahrscheinlich das Medium, auf das geschrieben werden soll, *)
(* voll. Ansonsten ist nach verlassen der Routine m = n. *)
(* *)
(* Write n bytes from "Quelle" out to file f. If writing is not *)
(* possible m will be set to 0. m generally indicates the amount *)
(* of bytes written, if m # 0 and m < n after a call the device *)
(* the file f is on is most probably full. In normal cases m = n *)
(* should hold after the call to this procedure *)
(*----------------------------------------------------------------*)
PROCEDURE RdBinObj( Ein : File;
VAR A : ARRAY OF BYTE;
N : CARDINAL;
VAR ifehl : INTEGER);
(*----------------------------------------------------------------*)
(* Einlesen ein Objekt A der Groesse N Byte binar vom Kanal Ein. *)
(* Die Routine arbeitet blockorientiert. *)
(* *)
(* ifehl = 0 : Alles in Ordnung *)
(* ifehl = 1 : Ein Lesefehler ist aufgetreten *)
(* ifehl = 2 : A ist zu klein um n Elemente aufnehemn zu k"onnen *)
(* *)
(* Binary read of object A with size N bytes frim file "Aus". *)
(* The routine is working block-oriented *)
(* *)
(* ifehl = 0 : all fine *)
(* ifehl = 1 : a read error occured *)
(* ifehl = 2 : A is smaller than N bytes *)
(*----------------------------------------------------------------*)
PROCEDURE WrBinObj( Aus : File;
VAR A : ARRAY OF BYTE;
N : CARDINAL;
VAR ifehl : INTEGER);
(*----------------------------------------------------------------*)
(* Binaeres scheiben des Objekts A der Groesse N Byte auf Aus. *)
(* Die Routine arbeitet blockorientiert. *)
(* *)
(* ifehl = 0 : Alles in Ordnung *)
(* ifehl = 1 : Ein Schreibfehler ist aufgetreten *)
(* ifehl = 2 : A ist zu klein um n Elemente aufnehemn zu k"onnen *)
(* *)
(* Binary write of object A with size N bytes to file "Aus". *)
(* The routine is working block-oriented *)
(* *)
(* ifehl = 0 : all fine *)
(* ifehl = 1 : a write error occured *)
(* ifehl = 2 : A is smaller than N bytes *)
(*----------------------------------------------------------------*)
(*============== Unix - spezifische Routinen. ==============*)
(*============== F"ur DOS ohne Bedeutung. ==============*)
PROCEDURE ChMod(VAR f : File;
Modus : AccessMode);
(*----------------------------------------------------------------*)
(* Setzt die Zugriffsrechte f"ur die Datei f. Dabei mu3 f einer *)
(* ge"offneten Datei zugeordnet sein. Ist dies nicht der Fall, *)
(* wird f auf -1 gesetzt. Bei sonstigen Fehlern wird nur Fehler *)
(* und Fehlerflag gesetzt. *)
(* *)
(* Sets the acces rights for file f. For that f must be assigend *)
(* to a open file. If that's not the case f is set to -1. If case *)
(* of other failures Fehler and Fehlerflag (module Errors) are *)
(* set. *)
(*----------------------------------------------------------------*)
PROCEDURE Lock(VAR f : File);
(*----------------------------------------------------------------*)
(* Verh"angt eine Schreibsperre f"ur den offenen *)
(* Ausgabekanal f gegen"uber anderen Prozessen. *)
(* *)
(* Locks the file f from access by other processes *)
(*----------------------------------------------------------------*)
PROCEDURE UnLock(VAR f : File);
(*----------------------------------------------------------------*)
(* Hebt die Schreibsperre des offenen Ausgabekanals f *)
(* gegen"uber anderen Prozessen auf. *)
(* *)
(* Removes a lock on file f *)
(*----------------------------------------------------------------*)
PROCEDURE Sync();
(*----------------------------------------------------------------*)
(* Syncronisation des Dateisystms. *)
(* *)
(* sync of the file system *)
(*----------------------------------------------------------------*)
END FileSystem.