IMPLEMENTATION MODULE FileSystem;
(*------------------------------------------------------------------------*)
(* Implementation einer Dateisystemschittstelle f"ur Modula-2 *)
(* (MtC, MOCKA, XDS M2, GM2). *)
(* Implementation of a file system interface for 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 *)
(* 25.02.16, MRi: Einfuehrung der Prozedur IsOpen *)
(* 31.10.16, MRi: RdBinObj & WrBinObj eingefuehrt *)
(* 19.01.18, MRi: Prozedur Rewindn und OpenLargeFiel, Felder IsLarge und *)
(* OpenModes eingefuehrt. Unterstuetzung von *)
(* Dateien > 2**31-1 hinzugefuegt. *)
(*------------------------------------------------------------------------*)
(* Offene Punkte *)
(* *)
(* - Prozeduren Lookup und Rewrite durchsehen - eventuell kann dass *)
(* Loeschen und Wiederanlegen eine Datei bei "create" als *)
(* OS/2 Relikt entfallen. *)
(* - UseStat = TRUE resultiert in einem Fehler unter XDS *)
(* Auf Linux64 mit GM2 laeuft es nach Korrektur der Definition des *)
(* Stat-RECORDS. *)
(*------------------------------------------------------------------------*)
(* Licence : GNU Lesser General Public License (LGPL) *)
(*------------------------------------------------------------------------*)
(* $Id: FileSystem.mod,v 1.2 2016/11/22 22:21:35 mriedl Exp mriedl $ *)
FROM SYSTEM IMPORT TSIZE,BYTE,ADR,CAST;
FROM UnixLib IMPORT open,lseek,open64,lseek64,
close,read,write,unlink,Stat,fstat,chmod,sync,
LockExclusive,LockUnlock,LockNoblock,flock;
IMPORT UnixLib; (* SIGNED *)
IMPORT fslength;
FROM Storage IMPORT ALLOCATE,DEALLOCATE;
IMPORT StringsLib;
FROM Errors IMPORT Fehler,Fehlerflag,ErrOut,FatalError;
IMPORT Errors;
(*--------------------------- Lokale Objekte --------------------------------*)
TYPE OpenModeRec = RECORD (* Eingef"ugt 28.11.14 *)
CASE : INTEGER OF
| 1: openmode : OpenMode;
| 2: int : INTEGER; (* avoid type cast *)
ELSE
END;
END;
AccessModeRec = RECORD
CASE : INTEGER OF
| 1: accessmode : AccessMode;
| 2: int : INTEGER; (* s.o. *)
ELSE
END;
END;
CONST MaxOpenFiles = 36; (* _POSIX_OPEN_MAX *)
MaxDateiNamenLaenge = 255; (* _POSIX_PATH_MAX *)
SeekCur = 2;
Debug = FALSE;
UseStat = FALSE; (* TRUE fuer GM2 64 bit, XDS auf 32 bit *)
VAR DateiNamen : ARRAY [0..MaxOpenFiles-1] OF POINTER TO
ARRAY [0..MaxDateiNamenLaenge] OF CHAR;
Geoeffnet : ARRAY [0..MaxOpenFiles-1] OF BOOLEAN;
IsLarge : ARRAY [0..MaxOpenFiles-1] OF BOOLEAN;
(*
* Fuer Zukuenftige Nutzung um bei ReWrite die Oeffnungsmodi
* beruecksichtigen zu k"onnen.
*)
OpenModes : ARRAY [0..MaxOpenFiles-1] OF UnixLib.SIGNED;
PROCEDURE StoreFileName(f : File; (* Kanalnummer *)
Name : ARRAY OF CHAR); (* Dateiname *)
(*-----------------------------------------------------------------*)
(* Speichert die Dateinamen aller ge\"offneten Dateien in dem *)
(* globalen Zeigerfeld Dateinamen. *)
(*-----------------------------------------------------------------*)
BEGIN
IF (DateiNamen[f] # NIL) OR Geoeffnet[f] THEN
IF Debug THEN
Errors.WriteString("Kanalnummer (StoreFileName) : ");
Errors.WriteCard(VAL(CARDINAL,f));
IF Geoeffnet[f] THEN Errors.WriteString(" Kanal geoeffnet !"); END;
IF DateiNamen[f] # NIL THEN
Errors.WriteString(" Dateiname nicht NIL !");
Errors.WriteLn;
Errors.WriteString(" Dateiname = ");
Errors.WriteString(DateiNamen[f]^);
Errors.WriteLn;
END;
Errors.WriteLn;
END;
ErrOut("in FileSystem.StoreFileName !");
END;
NEW(DateiNamen[f]);
IF (DateiNamen[f] = NIL) THEN
FatalError("Kein Freispeicher vorhanden (FileSystem.StoreFileName) !");
END;
IF Debug THEN
Errors.WriteString("StoreFileName : Datei (1) `"); Errors.WriteString(Name);
Errors.WriteChar("'"); Errors.WriteLn;
END;
StringsLib.Copy(DateiNamen[f]^,Name);
IF Debug THEN
Errors.WriteString("StoreFileName : Datei (2) `");
Errors.WriteString(DateiNamen[f]^);
Errors.WriteChar("'"); Errors.WriteLn;
END;
END StoreFileName;
PROCEDURE RemoveFileName(f : File); (* Kanalnummer *)
BEGIN
IF (DateiNamen[f] = NIL) OR (DateiNamen[f]^[0] = 0C) THEN
Fehlerflag:=
"Fehler in FileSystem.RemoveFileName !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; RETURN;
ELSE
IF Debug THEN
Errors.WriteString("Dateiname #"); Errors.WriteString(DateiNamen[f]^);
Errors.WriteChar("#"); Errors.WriteLn;
END;
DISPOSE(DateiNamen[f]);
DateiNamen[f]:=NIL; (* MR, 15.02.2015 *)
END;
END RemoveFileName;
PROCEDURE IstZulaessigeKanalnummer(f : File) : BOOLEAN;
BEGIN
RETURN NOT ((f < 0) OR (f >= MaxOpenFiles));
END IstZulaessigeKanalnummer;
(*--------------------------- Globale Objekte --------------------------------*)
PROCEDURE GetFileName( f : File; (* Kanalnummer *)
VAR Name : ARRAY OF CHAR); (* Dateiname *)
BEGIN
IF NOT Geoeffnet[f] THEN
Name[0] := 0C;
ELSE
StringsLib.Copy(Name,DateiNamen[f]^);
END;
END GetFileName;
PROCEDURE IsOpen(f : File) : BOOLEAN;
BEGIN
IF (f < MaxOpenFiles) THEN
RETURN Geoeffnet[f];
ELSE
RETURN FALSE;
END;
END IsOpen;
PROCEDURE Lookup(VAR f : File;
Name : ARRAY OF CHAR;
creat : BOOLEAN;
OpenMask : OpenMode);
CONST debug = FALSE;
VAR DName : ARRAY [0..MaxDateiNamenLaenge] OF CHAR;
err : INTEGER;
OM : OpenModeRec;
OMloc : OpenModeRec;
islarge : BOOLEAN;
AccMode : UnixLib.modeT;
omode : UnixLib.SIGNED;
BEGIN
Fehler := FALSE;
IF (StringsLib.Length(Name) = 0) THEN
Fehlerflag:="Dateiname leer (FileSystem.Lookup) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; f:=-1;
RETURN;
END;
StringsLib.Copy(DName,Name); (* Wegen m"oglicherweise fehlendem 0C *)
IF debug THEN
Errors.WriteString(" Oeffnen/Erzeuge ... ");
Errors.WriteString(Name);
Errors.WriteLn;
END;
IF (openLARGEFILE IN OpenMask) THEN
IF debug THEN
Errors.WriteString("Oeffne eine 64 Bit Datei ... ");
Errors.WriteLn;
END;
islarge := TRUE;
ELSE
islarge := FALSE;
END;
(* "Offnen oder Erzeugen der Datei. *)
OM.openmode:=OpenMask;
IF creat THEN
OMloc.int:=0;
INCL(OMloc.openmode,openRDONLY);
IF islarge THEN
IF debug THEN
Errors.WriteString(" Datei 64 bit, oeffnen fuer test ... ");
Errors.WriteLn;
END;
INCL(OMloc.openmode,openLARGEFILE);
OMloc.int := ((OMloc.int + 0) DIV 2); (* Shift *)
AccMode := UnixLib.sIRUSR + UnixLib.sIWUSR;
f := open64(ADR(DName),OMloc.int,AccMode);
ELSE
IF debug THEN
Errors.WriteString(" Datei 32 bit, oeffnen fuer test ... ");
Errors.WriteLn;
END;
OMloc.int := ((OMloc.int + 0) DIV 2); (* Shift *)
f := open(ADR(DName),OMloc.int);
END;
IF debug THEN
IF (f = -1) THEN
Errors.WriteString(" Datei nicht vorhanden ... ");
Errors.WriteLn;
END;
END;
IF (f # -1) THEN (* Datei vorhanden, also L"oschen. *)
IF debug THEN
Errors.WriteString(" Datei vorhanden, also Loeschen ... ");
Errors.WriteLn;
END;
f := close(f);
f := unlink(ADR(DName));
IF (f = -1) THEN (* Datei nicht zu l"oschen ! *)
Fehler:=TRUE;
Fehlerflag:="Zugriff verweigert (FileSystem.Lookup) !";
fslength.SetErrFlag(Fehlerflag);
IF CheckIO THEN ErrOut(Fehlerflag); END;
RETURN;
END;
END;
(* Datei (neu) anlegen. *)
IF debug THEN
Errors.WriteString(" Datei (neu) anlegen ... ");
Errors.WriteLn;
END;
INCL(OM.openmode,openCREAT);
IF islarge THEN
INCL(OM.openmode,openLARGEFILE);
(* Shift von OpenMask wegen "uberz"ahligem Bit 28.11.2014 *)
OM.int := ((OM.int + 0) DIV 2);
AccMode := UnixLib.sIRUSR + UnixLib.sIWUSR;
f := open64(ADR(DName),OM.int,AccMode);
ELSE
(* Shift von OpenMask wegen "uberz"ahligem Bit 28.11.2014 *)
OM.int := ((OM.int + 0) DIV 2);
f := open(ADR(DName),OM.int);
END;
omode := OM.int;
err := chmod(ADR(DName),CAST(INTEGER,defaultAccess));
ELSE (* "Offnen zum Lesen, Schreiben etc. *)
IF debug THEN
Errors.WriteString(" Datei Oeffen zum Lesen, Schreieb ... ");
Errors.WriteLn;
END;
IF islarge THEN
INCL(OM.openmode,openLARGEFILE);
OM.int := ((OM.int + 0) DIV 2);
AccMode := UnixLib.sIRUSR + UnixLib.sIWUSR;
f := open64(ADR(DName),OM.int,AccMode);
ELSE
OM.int := ((OM.int + 0) DIV 2);
f := open(ADR(DName),OM.int);
omode := OM.int;
END;
END;
IF (f = -1) THEN
IF creat THEN
Fehlerflag:="Fehler bei Erstellen der Datei '";
ELSE
Fehlerflag:="Fehler bei Oeffnen der Datei '";
END;
IF debug THEN
ErrOut(Fehlerflag);
END;
StringsLib.Append(Fehlerflag,DName);
StringsLib.Append(Fehlerflag,"' (FileSystem.Lookup) !");
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; RETURN;
ELSIF (f >= MaxOpenFiles) THEN
Fehlerflag:="Zuviele geoeffnete Dateien (FileSystem.Lookup) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; f:=-1; RETURN;
ELSE (* Eintagen in die Liste der ge"offneten Dateien. *)
StoreFileName(f,DName);
Geoeffnet[f] := TRUE;
IsLarge [f] := islarge;
OpenModes[f] := omode; (* Speicher den Modus des Oeffnens *)
(* Sperren gegen Beschreiben durch andere Prozesse. *)
(* lockf(f,1,MAX(LONGINT)); *)
END;
END Lookup;
PROCEDURE OpenLargeFile(VAR f : File;
name : ARRAY OF CHAR;
creat : BOOLEAN);
VAR OpenMask : OpenMode;
BEGIN
OpenMask:=OpenMode{openRDWR,openLARGEFILE};
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;
islarge : BOOLEAN;
flag : UnixLib.SIGNED;
AccMode : UnixLib.modeT;
BEGIN
Fehler:=FALSE;
IF NOT Geoeffnet[f] THEN
Fehlerflag:=" Datei nicht geoeffnet (FileSystem.ReWrite) ";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler := TRUE; f:=-1; RETURN;
END;
GetFileName(f,DName); (* Dateiname von f ermitteln, dann *)
IF Debug THEN
Errors.WriteString("ReWrite, Dateiname : "); Errors.WriteString(DName);
Errors.WriteChar("#"); Errors.WriteLn;
Errors.WriteString("ReWrite, Kanalnummer : "); Errors.WriteInt(f);
Errors.WriteLn;
END;
islarge := IsLarge[f]; (* War die Datei als "large" geoeffnet ? *)
Close(f); (* Schlie3en und neu"offnen mit Abschneiden. *)
(* Hier fehlt die ermittlung, in welchem Modus die Datei urspr"unglich *)
(* ge"offnet wurde (z.B. openRDONLY). *)
IF islarge THEN
flag := ((CAST(UnixLib.SIGNED,
OpenMode{openRDWR,openTRUNC,openLARGEFILE}) + 0
) DIV 2);
AccMode := UnixLib.sIRUSR + UnixLib.sIWUSR;
f := open64(ADR(DName),flag,AccMode);
ELSE
flag := ((CAST(INTEGER,OpenMode{openRDWR,openTRUNC}) + 0) DIV 2);
f := open(ADR(DName),flag);
END;
IF Debug THEN
Errors.WriteString("ReWrite, Kanalnummer (neu) : ");
Errors.WriteInt(f); Errors.WriteLn;
END;
IF (f = -1) THEN
Fehlerflag:=" Dateioeffnungsfehler (FileSystem.ReWrite) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; RETURN;
ELSIF (f >= MaxOpenFiles) THEN
Fehlerflag:="Zuviele geoeffnete Dateien (FileSystem.ReWrite) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; f:=-1; RETURN;
ELSE (* Eintagen in die Liste der ge"offneten Dateien. *)
StoreFileName(f,DName);
Geoeffnet[f] := TRUE;
IsLarge[f] := islarge;
(*
* OpenModes[f] := flag;
*)
(* Sperren gegen Beschreiben durch andere Prozesse. *)
(* lockf(f,1,MAX(LONGINT)); *)
END;
IF Debug THEN
Errors.WriteString("ReWrite, Dateiname : #"); Errors.WriteString(DName);
Errors.WriteChar("#"); Errors.WriteLn;
Errors.WriteString("Dateiname (eingetragener) : `");
Errors.WriteString(DateiNamen[f]^); Errors.WriteChar("'"); Errors.WriteLn;
END;
END ReWrite;
PROCEDURE Exists(DName : ARRAY OF CHAR) : BOOLEAN;
VAR datei : File;
interim : BOOLEAN;
BEGIN
interim:=CheckIO;
CheckIO:=FALSE;
Lookup(datei,DName,FALSE,OpenReadOnly);
CheckIO:=interim;
IF (datei = -1) THEN
RETURN FALSE;
ELSE
Close(datei);
RETURN TRUE;
END;
END Exists;
PROCEDURE Close(VAR f : File);
BEGIN
IF NOT Geoeffnet[f] THEN
Fehlerflag:=" Datei nicht geoeffnet (FileSystem.Close) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; f:=-1;
RETURN;
END;
RemoveFileName(f); (* Reihenfolge beachten ! *)
Geoeffnet[f] := FALSE;
IsLarge [f] := FALSE;
(* unlockf(f); (* Sperre freigeben *) *)
f := close(f);
IF (f < 0) THEN
ErrOut("Fehler in FileSystem.Close !");
END;
END Close;
PROCEDURE CloseAll();
VAR f : File;
i : INTEGER;
BEGIN
FOR i:=3 TO MaxOpenFiles-1 DO
f:=VAL(File,i);
IF Geoeffnet[f] THEN Close(f); END;
END;
END CloseAll;
PROCEDURE Delete( Name : ARRAY OF CHAR;
VAR f : File);
VAR DName : ARRAY [0..MaxDateiNamenLaenge] OF CHAR;
BEGIN
Fehler:=FALSE;
GetFileName(f,DName);
IF (StringsLib.Compare(DName,Name) # StringsLib.equal) OR NOT Geoeffnet[f] THEN
Fehlerflag:=" Datei nicht geoeffnet (FileSystem.Delete) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; RETURN;
ELSE
Close(f);
f := unlink(ADR(Name));
IF (f = -1) THEN
Fehlerflag:=" Zugriff verweiget (FileSystem.Delete) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; RETURN;
END;
END;
END Delete;
PROCEDURE Length( f : File;
VAR Len : LONGCARD);
VAR StatPuf : Stat;
DName : ARRAY [0..MaxDateiNamenLaenge] OF CHAR;
error : INTEGER;
BEGIN
Fehler:=FALSE;
IF NOT IstZulaessigeKanalnummer(f) THEN
FatalError(" Unzulassige Kanalnummer (FileSystem.Length) !");
END;
IF NOT Geoeffnet[f] THEN
Fehlerflag:=" Datei nicht geoeffnet (FileSystem.Length) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; RETURN;
END;
IF NOT UseStat THEN (* Viel zu kompliziert, fstat ist einfacher *)
GetFileName(f,DName); (* Dateiname von f ermitteln, dann *)
fslength.FileLength(Len,error,DName);
ELSE
(* error := stat(ADR(DName),StatPuf); *)
error := fstat(f,StatPuf);
END;
IF (error = -1) THEN
(* Fehlerflag := strerror(errno); *)
Fehlerflag:="Dateilaenge nicht ermittelbar (FileSystem.Length) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; Len:=MAX(LONGCARD);
END;
IF UseStat THEN
Len := StatPuf.stSize;
END;
END Length;
PROCEDURE GetPos( f : File;
VAR Pos : LONGCARD);
VAR IPos : LONGINT;
BEGIN
Fehler:=FALSE;
IF (IsLarge[f]) THEN
Fehlerflag:="Datei benoetigt 64 Bit Dateizeiger (FileSystem.GetPos)";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; RETURN;
END;
IPos := VAL(LONGINT,lseek(f,0,SeekCur));
IF (IPos = -1) THEN
Fehlerflag:=" Fehler in FileSystem.GetPos";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; Pos:=MAX(LONGCARD);
RETURN;
END;
Pos := VAL(LONGCARD,IPos);
END GetPos;
PROCEDURE SetPos(VAR f : File;
Pos : LONGCARD);
VAR IPos : LONGINT;
BEGIN
Fehler:=FALSE;
IF NOT Geoeffnet[f] THEN
Fehlerflag:=" Datei nicht geoeffnet (FileSystem.SetPos) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; RETURN;
END;
IF (IsLarge[f]) THEN
Fehlerflag:="Datei benoetigt 64 Bit Dateizeiger (FileSystem.SetPos)";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; RETURN;
END;
IPos := VAL(LONGINT,lseek(f,Pos,0));
IF (IPos = -1) THEN
Fehlerflag:=" SetPos nicht moeglich (FileSystem.SetPos) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE;
END;
END SetPos;
PROCEDURE Rewind(VAR f : File);
VAR whence : UnixLib.SIGNED;
pos : UnixLib.FilePtr64;
BEGIN
IF (IsLarge[f]) THEN
whence := 0; (* SEEK_SET *)
pos := 0;
pos := lseek64(f,pos,whence);
IF (pos # 0) THEN
ErrOut("Fehler beim Zurueckstellen der Datei (FileSystem.Rewind");
END;
ELSE
SetPos(f,0);
END;
END Rewind;
PROCEDURE ReadNBytes( f : File;
VAR Ziel : ARRAY OF BYTE;
n : CARDINAL;
VAR m : CARDINAL);
VAR nbyte : INTEGER;
BEGIN
nbyte := read(f,ADR(Ziel),n);
IF (nbyte = -1) THEN
fslength.SetErrFlag(Fehlerflag);
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; m:=0;
RETURN;
END;
m := VAL(CARDINAL,ABS(nbyte));
END ReadNBytes;
PROCEDURE WriteNBytes( f : File;
VAR Quelle : ARRAY OF BYTE;
n : CARDINAL;
VAR m : CARDINAL);
VAR nbytes : INTEGER;
BEGIN
Fehler:=FALSE;
nbytes := write(f,ADR(Quelle),n);
IF (nbytes = -1) THEN
Fehlerflag:=" Schreiben nicht moeglich (FileSystem.WriteNBytes) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; m := 0; RETURN;
END;
m := VAL(CARDINAL,nbytes);
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. ==============*)
PROCEDURE ChMod(VAR f : File;
Modus : AccessMode);
VAR err : INTEGER;
DName : ARRAY [0..MaxDateiNamenLaenge] OF CHAR;
Mode : AccessModeRec;
BEGIN
Fehler:=FALSE;
IF NOT Geoeffnet[f] THEN
Fehlerflag:=" Datei nicht geoeffnet (FileSystem.ChMod) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; f:=-1; RETURN;
END;
GetFileName(f,DName); (* Dateiname von f ermitteln, dann *)
Mode.accessmode:=Modus;
err := chmod(ADR(DName),Mode.int);
IF (err = -1) THEN (* Zugriff verweigert ? *)
Fehlerflag:=" Datei nicht gefunden (FileSystm.ChMod) !";
IF CheckIO THEN ErrOut(Fehlerflag); END;
Fehler:=TRUE; RETURN;
END;
END ChMod;
PROCEDURE Lock(VAR f : File);
VAR err,lex,lnb,lock : INTEGER;
tmp : BITSET;
BEGIN
(* Folgendes Konstrukt ist n"otig, da CAST(TYPE,CONST) bei einigen *)
(* "Ubersetzern nicht m"oglich. *)
lex := LockExclusive;
lnb := LockNoblock;
tmp := CAST(BITSET,lex) + CAST(BITSET,lnb);
lock := CAST(INTEGER,tmp);
err := flock(f,lock);
IF (err # 0) THEN
fslength.SetErrFlag(Fehlerflag);
ErrOut(Fehlerflag);
END;
END Lock;
PROCEDURE UnLock(VAR f : File);
VAR err : INTEGER;
BEGIN
err := flock(f,LockUnlock);
IF (err # 0) THEN
fslength.SetErrFlag(Fehlerflag);
ErrOut(Fehlerflag);
END;
END UnLock;
PROCEDURE Sync();
BEGIN
sync();
END Sync;
VAR i : CARDINAL;
(* dummy : File; *)
BEGIN
FOR i:=0 TO MaxOpenFiles-1 DO
Geoeffnet[i]:=FALSE;
IsLarge [i]:=FALSE;
DateiNamen[i]:=NIL;
(* OpenModes[i] := VAL(UnixLib.SIGNED,0); *)
END;
Input :=0;
Output:=1;
StdErr:=2;
NEW(DateiNamen[Input ]);
NEW(DateiNamen[Output]);
NEW(DateiNamen[StdErr]);
Geoeffnet[Input ] := TRUE; DateiNamen[Input ]^ := "Input";
Geoeffnet[Output] := TRUE; DateiNamen[Output]^ := "Output";
Geoeffnet[StdErr] := TRUE; DateiNamen[StdErr]^ := "StdErr";
(* Wenn TRUE, kann es zu kaskadierenden Fehermeldungen im Modul *)
(* Streams kommen. *)
CheckIO := TRUE;
FINALLY
CheckIO := FALSE;
CloseAll();
END FileSystem.