--- a
+++ b/Streams.MRI.mi
@@ -0,0 +1,460 @@
+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.