IMPLEMENTATION MODULE Streams;
(*------------------------------------------------------------------------*)
(* Implementation : M.Riedl *)
(* *)
(* Letzte Bearbeitung: *)
(* *)
(* 17.01.97, MRi: Durchsicht *)
(* 12.01.15, MRi: Anpassen an ISO M2 (GM2,XDS) *)
(* 22.04.15, MRi: Aufnahme offener Punkte *)
(* 07.05.15, MRi: Einfuehren der Prouzedure "WriteBuffer" *)
(* Sprache der Fehlermeldung kann hier gewaehlt werden *)
(* 07.05.15, MRi: In OpenStream das schreibende Öffnen für eine Datei die *)
(* mit creat=FALSE geoeffnet wird auskommentiert, statt *)
(* dessen response auf FALSE gesetzt so daß der Fehler in *)
(* der rufenden Prozedure abgefangen werden kann. *)
(* 03.04.16, MRi: In CloseStream die Auffrage ob noch etwas ausgeschieben *)
(* werden muss um ... AND (PufLen > 0) THEN erweitert. *)
(* 05.11.17, MRi: Prozeduren IsEOL & IsEOF eingefuegt um kompatipilitaet *)
(* mit dem Strems-Modul fuer ISO chanId zu erreichen *)
(*------------------------------------------------------------------------*)
(* Offene Punkte: *)
(* *)
(* - Klaeren wiso ein Stream nach ausschliesslichem oeffnen und schließen *)
(* Datenmuell enthaelt - hoffentlich behoben (03.04.16) *)
(* - Wieso stehen Daten doppelt in einem Stream wenn dieser auf einen *)
(* anderen Variablennamen kopiert wurde ? *)
(* - Einfuehren bilingualer Fehlermeldungen (bis jetzt nur testweise in *)
(* WriteBuffer) *)
(* - Nachsehen ob response in OpenStream bei fehlen einer zum lesen *)
(* zu oeffnennden Datei immer richtig gesetzt wird (siehe auch Eingabe- *)
(* module im SCF Programm. *)
(*------------------------------------------------------------------------*)
(* Licence : GNU Lesser General Public License (LGPL) *)
(*------------------------------------------------------------------------*)
(* $Id: Streams.mod,v 1.1 2015/09/13 20:48:42 mriedl Exp mriedl $ *)
IMPORT SYSTEM; (* !!! *)
IMPORT ASCII,CommonIO;
FROM Storage IMPORT ALLOCATE,DEALLOCATE;
FROM Errors IMPORT Fehlerflag,Fehler,ErrOut,FatalError;
FROM FileSystem IMPORT File,Lookup,Close,GetFileName,ReadNBytes,WriteNBytes,
OpenMode,openRDWR,openWRONLY,openRDONLY;
IMPORT StringsLib,FileSystem;
IMPORT TIO;
(*---------------------------------------------------------------*)
(* Die folgenden Parameter sind entsprechend des Compilers und *)
(* des Betriebssystems im Definitionsmodul CommonIO zu setzen. *)
(* *)
(* CrLf : TRUE f"ur MSDOS und OS/2. *)
(* FALSE f"ur Unix ( und andere ? ) *)
(* MaxBit : Anzahl der BITs je BITSET. *)
(* *)
(* Die Einstellung von MaxOpenStreams ist lokal. *)
(* *)
(* MaxOpenStreams : 32 sollte reichen, ist h"aufig sogar zuviel. *)
(* H"angt stark vom Betriebssystem ab. *)
(*---------------------------------------------------------------*)
TYPE Sprache = (DE,EN);
VAR Lang : Sprache;
CONST MaxOpenStreams = 32;
MaxBit = CommonIO.MaxBit; (* Maximalzahl Bits je BITSET *)
EoL = CommonIO.EoL; (* Zeichen f"ur Zeilenende. *)
EoF = CommonIO.EoF; (* Zeichen f"ur Dateiende. *)
VAR OpenStreams : ARRAY [0..MaxOpenStreams] OF POINTER TO Stream;
(*---------------------------------------------------------------*)
(* In dem Feld OpenStreams werden die Adressen aller ge"offneten *)
(* Streams gespeichert. Ist als OpenStreams[i] # NIL, so zeigt *)
(* OpenStreams[i] auf einen ge"offneten Stream. Dieser kann nun *)
(* in der Notfallprozedur CloseAll geschlossen werden, bevor der *)
(* aktuelle Prozes terminiert wird. Das Feld OpenStreams sollte *)
(* zu keinem (!) anderen Zweck benutzt werden, der einzige Ort, *)
(* an dem die Prozedur CloseAll gerufen werden sollte, ist *)
(* Errors.FatalError ! *)
(*---------------------------------------------------------------*)
CONST debug = FALSE;
PROCEDURE OpenStream(VAR Str : Stream;
DatName : ARRAY OF CHAR;
creat : BOOLEAN);
VAR Sicher : BOOLEAN;
BEGIN
Sicher := FileSystem.CheckIO;
(* Fehlermeldunden in FileSystem unterdr"ucken *)
FileSystem.CheckIO := FALSE;
Fehler:=FALSE; Fehlerflag:="";
WITH Str DO
IF creat THEN
(* Datei erzeugen, dann Schreiben einzige erlaubte Option. *)
Lookup(Kanal,DatName,creat,OpenMode{openWRONLY}); (* ??? *)
ELSE
(* Vorhandene Datei "offnen, dann Lese- und Schreiboption. *)
Lookup(Kanal,DatName,creat,OpenMode{openRDWR}); (* ??? *)
IF (Kanal = -1) THEN
(* Datei nicht beschreibbar (Lock etc.) ? *)
(* Schreibendes oeffnen auskommentiert, 07.05.15
Lookup(Kanal,DatName,creat,OpenMode{openRDONLY}); *)
res:=notdone; FileSystem.CheckIO:=Sicher; RETURN;
END;
END;
(* Im Fehlerfalle wird Errors.Fehlerflag von FileSystem.Lookup *)
(* entsprechend gesetzt und kann abgefragt werden. *)
IF (Kanal = -1) THEN
res:=notdone; FileSystem.CheckIO:=Sicher; RETURN;
END; (* !!! *)
res:=done;
StringsLib.Copy(Name,DatName);
ALLOCATE(Puf,MaxPufSize);
PufSize:=MaxPufSize; (* Buchf"uhrung, da MaxPufSize variabel *)
EOF:=FALSE;
END;
OpenStreams[Str.Kanal]:=SYSTEM.ADR(Str); (* Buchf"uhrung ! *)
FileSystem.CheckIO := Sicher;
END OpenStream;
PROCEDURE CloseStream(VAR Str : Stream);
VAR i : CARDINAL;
BEGIN
IF CommonIO.CrLf THEN PutChar(Str,CHR(26)); END; (* Ctrl-Z *)
OpenStreams[Str.Kanal]:=NIL; (* Buchf"uhrung ! *)
WITH Str DO
IF (Status = Write) AND (PufPos <= PufSize) AND (PufLen > 0) THEN
IF debug THEN
TIO.WrLn;
TIO.WrStr("Streams.CloseStream"); TIO.WrLn;
TIO.WrLn;
TIO.WrStr("PufSize = "); TIO.WrCard(PufSize,4); TIO.WrLn;
TIO.WrStr("PufLen = "); TIO.WrCard(PufLen,4); TIO.WrLn;
TIO.WrStr("PufPos = "); TIO.WrCard(PufPos,4); TIO.WrLn;
TIO.WrLn;
END;
WriteNBytes(Kanal,Puf^,PufPos,i);
IF (PufPos # i) THEN
Fehlerflag:=('Ausgabefehler auf Datei ');
StringsLib.Append(Fehlerflag,Name);
StringsLib.Append(Fehlerflag," (Streams.CloseStream) !");
ErrOut(Fehlerflag);
END;
END;
Close(Kanal);
IF (Puf # NIL) THEN DEALLOCATE(Puf,PufSize); END;
END;
END CloseStream;
PROCEDURE ConnectStream(VAR Str : Stream;
f : File);
BEGIN
Fehler:=FALSE; Fehlerflag:="";
WITH Str DO
Kanal := f;
(* Im Fehlerfalle wird Errors.Fehlerfalg von FileSystem.Lookup *)
(* entsprechend gesetzt und kann abgefragt werden. *)
IF (Kanal = -1) THEN res:=notdone; RETURN; END; (* !!! *)
res:=done;
GetFileName(f,Name);
ALLOCATE(Puf,MaxPufSize);
PufSize:=MaxPufSize; (* Buchf"uhrung, da MaxPufSize variabel *)
EOF:=FALSE;
END;
OpenStreams[Str.Kanal]:=SYSTEM.ADR(Str); (* Buchf"uhrung ! *)
END ConnectStream;
PROCEDURE CloseAll();
VAR i : CARDINAL;
BEGIN
FOR i:=0 TO MaxOpenStreams DO
IF OpenStreams[i] # NIL THEN
CloseStream(OpenStreams[i]^);
END;
END;
END CloseAll;
PROCEDURE SetWrite(VAR Str : Stream);
BEGIN
WITH Str DO
PufLen:=0;
PufPos:=PufSize;
Status:=Write;
END;
END SetWrite;
PROCEDURE SetRead(VAR Str : Stream);
BEGIN
WITH Str DO
EOF :=FALSE;
PufLen:=PufSize;
PufPos:=PufLen;
Status:=Read;
END;
END SetRead;
PROCEDURE ReWrite(VAR Str : Stream);
BEGIN
FileSystem.ReWrite(Str.Kanal);
SetWrite(Str);
END ReWrite;
(*
* PROCEDURE Append(VAR Datei : Stream);
*
* (*----------------------------------------------------------------*)
* (* Versetzt die ge"offnete Datei Datei in Schreibmodus und stellt *)
* (* den Dateizeiger an das Dateiende. *)
* (*----------------------------------------------------------------*)
*
* BEGIN (* Mu3 noch installiert werden ! *)
* END Append;
*)
PROCEDURE WriteBuffer(VAR Str : Stream);
CONST f1de = "Ausgabefehler auf Datei ";
f1en = "IO error on stream ";
f2de = " nicht im Schreibmodus geoeffnet (Streams.WriteBuffer)";
f2en = " not opened in write mode (Streams.WriteBuffer)";
VAR n : CARDINAL;
BEGIN
WITH Str DO
IF (Status = Write) THEN
IF (PufPos # 0) THEN (* Puffer enthaelt Zeichen *)
WriteNBytes(Kanal,Puf^,PufPos,n);
IF (PufPos # n) THEN
IF (Lang = DE) THEN
Fehlerflag:=f1de;
ELSE
Fehlerflag:=f1en;
END;
StringsLib.Append(Fehlerflag,Name);
StringsLib.Append(Fehlerflag," (Streams.WriteBuffer)");
ErrOut(Fehlerflag);
END;
PufPos:=0;
ELSE
(* tue nichts ;-) *)
END;
ELSE
Fehlerflag:="Stream ";
StringsLib.Append(Fehlerflag,Name);
IF (Lang = DE) THEN
StringsLib.Append(Fehlerflag,f2de);
ELSE
StringsLib.Append(Fehlerflag,f2en);
END;
ErrOut(Fehlerflag);
END;
END;
END WriteBuffer;
PROCEDURE ReSet(VAR Str : Stream);
BEGIN
SetPos(Str,0); Str.EOF:=FALSE;
END ReSet;
PROCEDURE GetPos(VAR Str : Stream;
VAR Pos : LONGCARD);
BEGIN
WITH Str DO
FileSystem.GetPos(Kanal,Pos);
DEC(Pos,VAL(LONGCARD,(Str.PufLen - Str.PufPos)));
IF CommonIO.CrLf AND
(PufLen < PufSize) AND (Puf^[PufLen] = ASCII.sub) THEN
DEC(Pos); (* Crtl-Z *)
END;
END;
END GetPos;
PROCEDURE SetPos(VAR Str : Stream;
Pos : LONGCARD);
VAR StrPos : LONGCARD;
Diff : LONGINT;
InPuf : BOOLEAN;
BEGIN
WITH Str DO
IF (Status # Read) THEN
FatalError('SetPos auf nicht-Lesedatei angewandt (Streams.SetPos).');
END; (* StrPos : Position im Stream vor dem eigendlichen SetPos. *)
EOF:=FALSE; EOL:=FALSE;
GetPos(Str,StrPos);
Diff:=VAL(LONGINT,Pos)-VAL(LONGINT,StrPos); InPuf:=FALSE;
IF (ABS(Diff) < VAL(LONGINT,PufSize)) THEN (* SetPos im Puffer ? *)
IF (Diff <= 0) AND (VAL(CARDINAL,ABS(Diff)) <= PufPos) THEN
PufPos:=PufPos - VAL(CARDINAL,ABS(Diff));
InPuf:=TRUE;
ELSIF (Diff > 0) AND ((PufPos + VAL(CARDINAL,Diff)) < PufLen) THEN
PufPos:=PufPos + VAL(CARDINAL,Diff);
InPuf:=TRUE;
END;
END;
IF NOT InPuf THEN
(* SetPos nicht innerhalb des Puffers m"oglich ! *)
(* Crtl-Z am Ende der Datei sollte unter Unix nicht vorkommen, *)
(* daher sollten Abfragen nichts schaden. *)
FileSystem.SetPos(Str.Kanal,Pos);
ReadNBytes(Kanal,Puf^,PufSize,PufLen);
IF (PufLen > 0) AND (Puf^[0] # ASCII.sub) THEN
IF (Puf^[PufLen-1] = ASCII.sub) THEN DEC(PufLen); END;
EOF:=FALSE; EOL:=FALSE; PufPos:=0;
ELSE
EOF:=TRUE; EOL:=TRUE; PufPos:=0;
END;
END;
IF (PufPos < PufLen) THEN
IF (Puf^[PufPos] = ASCII.lf) THEN
(* ErrOut('lf (Streams.SetPos)'); ?? *)
EOL:=TRUE;
ELSIF CommonIO.CrLf AND (Puf^[PufPos] = ASCII.cr) THEN
EOL:=TRUE;
END;
END;
END; (* WITH *)
END SetPos;
PROCEDURE IsEOL(str : Stream) : BOOLEAN;
BEGIN
RETURN str.EOL;
END IsEOL;
PROCEDURE IsEOF(str : Stream) : BOOLEAN;
BEGIN
RETURN str.EOF;
END IsEOF;
PROCEDURE GetCharCrLf(VAR Datei : Stream;
VAR Char : CHAR);
BEGIN
WITH Datei DO
res := done;
IF (PufPos < PufLen) THEN
Char:=Puf^[PufPos]; INC(PufPos);
ELSE
IF (PufLen = PufSize) THEN
ReadNBytes(Kanal,Puf^,PufSize,PufLen);
IF (PufLen > 0) AND (Puf^[0] # ASCII.sub) THEN
IF (Puf^[PufLen-1] = ASCII.sub) THEN DEC(PufLen); END;
Char:=Puf^[0]; PufPos:=1;
ELSE
EOF:=TRUE; EOL:=TRUE; Char:=EoF; res:=notdone;
RETURN;
END;
ELSE
EOF:=TRUE; EOL:=TRUE; Char:=EoF; res:=notdone;
RETURN;
END;
END;
IF (Char # ASCII.cr) THEN (* Test auf cr,lf = EOL *)
EOL:=FALSE;
ELSE
GetCharCrLf(Datei,Char); (* Lese lf *)
Char:=EoL;
EOL:=TRUE;
END;
END; (* WITH *)
END GetCharCrLf;
PROCEDURE GetChar(VAR Datei : Stream;
VAR Char : CHAR);
BEGIN
IF CommonIO.CrLf THEN GetCharCrLf(Datei,Char); RETURN; END; (* !!! *)
WITH Datei DO
res := done;
IF (PufPos < PufLen) THEN
Char:=Puf^[PufPos]; INC(PufPos);
ELSE
IF (PufLen = PufSize) THEN
ReadNBytes(Kanal,Puf^,PufSize,PufLen);
IF (PufLen > 0) THEN
Char:=Puf^[0]; PufPos:=1;
ELSE (* Dateiende *)
EOF:=TRUE; EOL:=TRUE; Char:=EoF; res:=notdone;
RETURN;
END;
ELSE (* Dateiende erreicht ! *)
EOF:=TRUE; EOL:=TRUE; Char:=EoF; res:=notdone;
RETURN;
END;
END;
IF (Char # ASCII.lf) THEN (* Test auf Zeilenende. *)
EOL:=FALSE;
ELSE
Char:=EoL;
EOL:=TRUE;
END;
END; (* WITH *)
END GetChar;
PROCEDURE PutChar(VAR Aus : Stream;
Char : CHAR);
BEGIN
WITH Aus DO
IF (PufPos < PufSize) THEN
IF (Char # EoL) THEN
Puf^[PufPos]:=Char; INC(PufPos);
RETURN; (* !!! *)
ELSE (* Zeilenumbruch *)
IF CommonIO.CrLf THEN (* Vorsicht, wenn Puffer voll ! *)
Puf^[PufPos]:=ASCII.cr; INC(PufPos);
PutChar(Aus,ASCII.lf);
ELSE (* trivial *)
Puf^[PufPos]:=ASCII.lf; INC(PufPos);
END;
END;
ELSE
IF (PufLen > 0) THEN (* Erstes Schreiben *)
WriteNBytes(Kanal,Puf^,PufSize,PufLen);
IF (PufSize # PufLen) THEN
Fehlerflag:='Ausgabefehler auf Datei ';
StringsLib.Append(Fehlerflag,Name);
StringsLib.Append(Fehlerflag,"(Streams.WrChar) ");
FatalError(Fehlerflag); (* Hier vielleicht kein Abbruchfehler ? *)
END;
ELSE
PufLen:=PufSize;
END;
IF (Char # EoL) THEN
Puf^[0]:=Char; PufPos:=1;
ELSE
PufPos:=0;
IF CommonIO.CrLf THEN Puf^[0]:=ASCII.cr; PufPos:=1; END;
PutChar(Aus,ASCII.lf);
(* Puf^[PufPos]:=ASCII.lf; INC(PufPos); *)
END;
END;
END; (* WITH *)
END PutChar;
VAR i : CARDINAL;
BEGIN
Lang:=DE;
MaxPufSize:=128;
FOR i:=0 TO MaxOpenStreams DO OpenStreams[i]:=NIL; END;
FINALLY
CloseAll();
END Streams.