SIO.mod.m2cc
682 lines (610 with data), 20.7 kB
IMPLEMENTATION MODULE SIO;
(*========================================================================*)
(* WICHTIG: BITTE NUR DIE DATEI SIO.mod.m2cc EDITIEREN !!! *)
(*========================================================================*)
(* Hint: *)
(* ===== *)
(* *)
(* You can create the definition file for the ISO M2 IO-channnel *)
(* module by "m2cc -D __ISOIO__ < SIO.mod.m2cc > SIO.mod *)
(* *)
(* For the original interface to M.Riedl IO-modules please use *)
(* "m2cc -D __MRI__ < SIO.mod.m2cc > SIO.mod *)
(* *)
(*------------------------------------------------------------------------*)
(* Streamorientierte Lese- und Schreibprozeduren *)
(* Stream oriented read and write procedures *)
(*------------------------------------------------------------------------*)
(* Letzte Bearbeitung: *)
(* *)
(* 17.02.95, MRi: Korrekturen *)
(* 04.05.15, MRi: Prozedureb WrLngInts und WrReal eingefuegt *)
(* 10.07.15, MRi: Einfuegen der Prozedure ReadLine aus SCF Eingabe *)
(* 24.11.16, MRi: Prozeduren WrBits eingef"uhrt. *)
(* 04.11.17, MRi: Anpassen an ISO M2 chanId mit Praeprozessordirektiven *)
(* 05.11.17, MRi: Korrektur in SIO.RdStr fuer ISO-IO *)
(* 21.03.18, MRi: Prozedure SetExpAnz eingefuegt *)
(* 08.06.18, MRi: Ausgabe in WrBits "invertiert" *)
(*------------------------------------------------------------------------*)
(* Offene Punkte *)
(* *)
(* - Die Varibale ExpAnz in einer Prozedur nach aussen kapseln *)
(*------------------------------------------------------------------------*)
(* Implementation : Michael Riedl *)
(* Licence : GNU Lesser General Public License (LGPL) *)
(*------------------------------------------------------------------------*)
(* $Id: SIO.mod.m2cc,v 1.3 2018/03/21 11:05:30 mriedl Exp mriedl $ *)
IMPORT ASCII,CommonIO;
IMPORT StringsLib;
FROM Errors IMPORT Fehlerflag,Fehler,ErrOut;
FROM ConvTypes IMPORT ConvResults;
FROM CommonIO IMPORT MaxBit;
#ifdef __ISOIO__
FROM Streams IMPORT Stream,IsEOL,IsEOF;
#endif
#ifdef __MRI__
FROM Streams IMPORT Stream,Response;
#endif
IMPORT Streams;
FROM NumConvert IMPORT CardToString,StringToCard,
CardToStrBased,StrToCardBased,CardToBitStr,
LongCardToString,StringToLongCard,
IntToString,StringToInt,LongIntToString;
FROM RealConvert IMPORT RealToFloatString,RealToFixString,StringToReal;
#ifdef __ISOIO__
IMPORT IOConsts;
IMPORT IOResult;
IMPORT IOChan;
IMPORT TextIO;
#endif
(*---------------------------------------------------------------*)
(* Die folgenden Parameter sind entsprechend des Compilers und *)
(* des Betriebssystems zu setzen. *)
(* CrLf : TRUE f"ur MSDOS und OS/2. *)
(* FALSE f"ur Unix ( und andere ? ) *)
(*---------------------------------------------------------------*)
CONST WriteError = TRUE; (* Fehlermeldungen ausgeben ? *)
CONST MaxTrennZeichen = 6;
MaxCardStr = 15; (* L"ange eines Ausgabestings f"ur Card-Typen *)
MaxLCardStr = 31; (* L"ange des Ausgabestings f. LongCard-Typen *)
MaxRealStr = 31; (* L"ange eines Ausgabestings f"ur Real-Typen *)
VAR result : ConvResults;
FFlag : ARRAY [strAllRight..strEmpty] OF
ARRAY [0..31] OF CHAR;
Trenner : ARRAY [1..MaxTrennZeichen] OF CHAR;
TrennAnzahl : CARDINAL; (* Anzahl der aktuell benutzten Trenner *)
PROCEDURE IstTrennZeichen(chr : CHAR) : BOOLEAN;
VAR i : CARDINAL;
BEGIN
FOR i:=1 TO TrennAnzahl DO
IF (chr = Trenner[i]) THEN RETURN TRUE; END;
END;
RETURN FALSE;
END IstTrennZeichen;
PROCEDURE SetExpAnz(n : CARDINAL);
(*----------------------------------------------------------------*)
(* Andern von ExpAnz, soll den direkten Zugriff ersetzen *)
(* Give access to varibale ExpAnz, shall replace direct access *)
(*----------------------------------------------------------------*)
BEGIN
IF (n < 1) OR (n > 4) THEN n:=2; END;
ExpAnz := n;
END SetExpAnz;
(*==================== Globale Objekte ================================*)
PROCEDURE RdChar(VAR Datei : Stream;
VAR Char : CHAR);
BEGIN
Streams.GetChar(Datei,Char);
END RdChar;
PROCEDURE WrChar(VAR Datei : Stream;
Char : CHAR);
BEGIN
Streams.PutChar(Datei,Char);
END WrChar;
PROCEDURE WrCharN(VAR Aus : Stream;
chr : CHAR;
Anzahl : CARDINAL);
VAR i : CARDINAL;
BEGIN
FOR i:=1 TO Anzahl DO WrChar(Aus,chr); END;
END WrCharN;
PROCEDURE RdWort(VAR Datei : Stream;
VAR Wort : ARRAY OF CHAR);
VAR i,Laenge : CARDINAL;
Chr : CHAR;
BEGIN
REPEAT
RdChar(Datei,Chr);
#ifdef __ISOIO__
IF (IsEOF(Datei)) THEN Wort[0]:=0C; RETURN; END;
#endif
#ifdef __MRI__
IF Datei.EOF THEN Wort[0]:=0C; RETURN; END;
#endif
UNTIL NOT IstTrennZeichen(Chr);
Wort[0]:=Chr; i:=1; Laenge:=HIGH(Wort);
LOOP
IF (i = Laenge) THEN EXIT; END;
RdChar(Datei,Chr);
#ifdef __MRI__
IF IstTrennZeichen(Chr) OR Datei.EOF THEN EXIT; END;
#endif
#ifdef __ISOIO__
IF IstTrennZeichen(Chr) OR IsEOF(Datei) THEN EXIT; END;
#endif
Wort[i]:=Chr;
INC(i);
END;
Wort[i]:=0C; (* Endmarkierung *)
END RdWort;
PROCEDURE RdStr(VAR Datei : Stream;
VAR String : ARRAY OF CHAR);
VAR i : CARDINAL;
BEGIN
#ifdef __ISOIO__
TextIO.ReadString(Datei,String);
TextIO.SkipLine(Datei);
RETURN;
#endif
i:=0;
LOOP
RdChar(Datei,String[i]);
#ifdef __MRI__
IF Datei.EOL THEN EXIT; END;
#endif
#ifdef __ISOIO__
IF (String[i] = CommonIO.EoL) THEN EXIT; END;
IF IsEOL(Datei) THEN EXIT; END;
#endif
INC(i); IF (i = HIGH(String)) THEN EXIT; END;
END;
String[i]:=0C;
END RdStr;
PROCEDURE WrStr(VAR Datei : Stream;
String : ARRAY OF CHAR);
VAR i : CARDINAL;
BEGIN
i:=0;
WHILE (i <= HIGH(String)) AND (String[i] # 0C) DO
WrChar(Datei,String[i]); INC(i);
END;
END WrStr;
PROCEDURE WrStrForm(VAR Aus : Stream;
Str : ARRAY OF CHAR;
Breite : INTEGER);
VAR len : CARDINAL;
fuell : INTEGER;
BEGIN
len := StringsLib.Length(Str);
fuell := ABS(Breite) - VAL(INTEGER,len);
IF (Breite > 0) AND (fuell > 0) THEN WrCharN(Aus,' ',fuell); END;
WrStr(Aus,Str);
IF (Breite < 0) AND (fuell > 0) THEN WrCharN(Aus,' ',fuell); END;
END WrStrForm;
PROCEDURE ReadLine(VAR Ein : Stream; VAR Line : ARRAY OF CHAR);
VAR i : CARDINAL;
BEGIN
Fehler:=FALSE;
i:=0;
LOOP
RdChar(Ein,Line[i]);
#ifdef __MRI__
IF (Ein.res # done) THEN
Line[i]:=0C; Fehler:=TRUE;
Fehlerflag:="Lesefehler (SIO.ReadLine)";
ErrOut(Fehlerflag);
RETURN;
END;
#endif
#ifdef __ISOIO__
IF IsEOL(Ein) THEN EXIT; END;
#endif
#ifdef __MRI__
IF Ein.EOL THEN EXIT; END;
#endif
IF (i = HIGH(Line)) THEN
Line[i]:=0C; Fehler:=TRUE;
Fehlerflag:="Zeilenstring zu kurz (SIO.ReadLine)";
ErrOut(Fehlerflag);
RETURN;
END;
INC(i);
END;
Line[i]:=0C;
END ReadLine;
PROCEDURE WrLn(VAR Aus : Stream);
BEGIN
WrChar(Aus,CommonIO.EoL);
END WrLn;
PROCEDURE WrLnN(VAR Datei : Stream;
Anz : CARDINAL);
VAR i : CARDINAL;
BEGIN
FOR i:=1 TO Anz DO
IF CommonIO.CrLf THEN WrChar(Datei,ASCII.cr); END;
WrChar(Datei,ASCII.lf);
END;
END WrLnN;
PROCEDURE RdCard(VAR Datei : Stream;
VAR c : CARDINAL);
VAR CardStr : ARRAY [0..MaxCardStr] OF CHAR;
BEGIN
RdWort(Datei,CardStr);
StringToCard(CardStr,c,result);
IF (result # strAllRight) THEN
StringsLib.Concat(Fehlerflag,FFlag[result]," (SIO.RdCard) !");
IF WriteError THEN ErrOut(Fehlerflag); END;
c:=MAX(CARDINAL);
#ifdef __MRI__
Datei.res := notdone;
#endif
#ifdef __ISOIO__
IOChan.SetReadResult(Datei,IOConsts.wrongFormat);
#endif
RETURN;
END;
#ifdef __MRI__
Datei.res := done;
#endif
END RdCard;
PROCEDURE WrCard(VAR Datei : Stream;
c : CARDINAL;
n : CARDINAL); (* Feldbreite *)
VAR ZahlStr : ARRAY [0..MaxCardStr] OF CHAR;
AllRight : BOOLEAN;
BEGIN
CardToString(c,n,ZahlStr,AllRight);
IF NOT AllRight THEN
#ifdef __MRI__
Datei.res := notdone;
#endif
#ifdef __ISOIO__
IOChan.SetReadResult(Datei,IOConsts.wrongFormat);
#endif
RETURN;
END;
WrStr(Datei,ZahlStr);
END WrCard;
PROCEDURE RdHex(VAR Datei : Stream;
VAR c : CARDINAL);
VAR CardStr : ARRAY [0..MaxCardStr] OF CHAR;
C : LONGCARD;
BEGIN
RdWort(Datei,CardStr);
StrToCardBased(CardStr,16,C,result);
IF (result # strAllRight) THEN
StringsLib.Concat(Fehlerflag,FFlag[result]," (SIO.RdCard) !");
IF WriteError THEN ErrOut(Fehlerflag); END;
c:=MAX(CARDINAL);
#ifdef __MRI__
Datei.res := notdone;
#endif
#ifdef __ISOIO__
IOChan.SetReadResult(Datei,IOConsts.wrongFormat);
#endif
RETURN;
END;
IF (C > VAL(LONGCARD,MAX(CARDINAL))) THEN
StringsLib.Concat(Fehlerflag,FFlag[strOutOfRange]," (SIO.RdHex) !");
IF WriteError THEN ErrOut(Fehlerflag); END;
c:=MAX(CARDINAL);
#ifdef __MRI__
Datei.res := notdone;
#endif
#ifdef __ISOIO__
IOChan.SetReadResult(Datei,IOConsts.outOfRange);
#endif
RETURN;
END;
#ifdef __MRI__
Datei.res := done;
#endif
#ifdef __ISOIO__
IOChan.SetReadResult(Datei,IOConsts.allRight);
#endif
c := VAL(CARDINAL,C);
END RdHex;
PROCEDURE WrHex(VAR Datei : Stream;
c : CARDINAL;
n : CARDINAL); (* Feldbreite *)
VAR ZahlStr : ARRAY [0..MaxCardStr] OF CHAR;
AllRight : BOOLEAN;
len,i : CARDINAL;
BEGIN
CardToStrBased(VAL(LONGCARD,c),ZahlStr,16,AllRight);
#ifdef __MRI__
IF NOT AllRight THEN Datei.res:=notdone; RETURN; END;
#endif
#ifdef __ISOIO__
IF NOT AllRight THEN
IOChan.SetReadResult(Datei,IOConsts.outOfRange);
RETURN;
END;
#endif
len := StringsLib.Length(ZahlStr);
IF (n > len) THEN
FOR i:=1 TO (n - len) DO WrChar(Datei," "); END;
END;
WrStr(Datei,ZahlStr);
END WrHex;
PROCEDURE WrBits(VAR Datei : Stream;
c : CARDINAL;
nbits : CARDINAL); (* Feldbreite *)
VAR Str : ARRAY [0..127] OF CHAR;
i : CARDINAL;
BEGIN
CardToBitStr(c,Str,nbits);
FOR i:=LENGTH(Str)-1 TO 0 BY -1 DO
WrChar(Datei,Str[i]);
END;
END WrBits;
PROCEDURE RdLngCard(VAR Datei : Stream;
VAR C : LONGCARD);
VAR ZahlStr : ARRAY [0..MaxLCardStr] OF CHAR;
BEGIN
RdWort(Datei,ZahlStr);
StringToLongCard(ZahlStr,C,result);
IF (result # strAllRight) THEN
StringsLib.Concat(Fehlerflag,FFlag[result]," (SIO.RdLngCard)");
IF WriteError THEN ErrOut(Fehlerflag); END;
C:=MAX(LONGCARD);
#ifdef __MRI__
Datei.res := notdone;
#endif
#ifdef __ISOIO__
IOChan.SetReadResult(Datei,IOConsts.wrongFormat);
#endif
RETURN;
END;
#ifdef __MRI__
Datei.res := done;
#endif
#ifdef __ISOIO__
IOChan.SetReadResult(Datei,IOConsts.allRight);
#endif
END RdLngCard;
PROCEDURE WrLngCard(VAR Datei : Stream;
C : LONGCARD;
n : CARDINAL); (* Feldbreite *)
VAR ZahlStr : ARRAY [0..MaxLCardStr] OF CHAR;
AllRight : BOOLEAN;
BEGIN
LongCardToString(C,n,ZahlStr,AllRight);
IF NOT AllRight THEN
WrCharN(Datei,"*",n);
#ifdef __MRI__
Datei.res:=notdone;
#endif
#ifdef __ISOIO__
IOChan.SetReadResult(Datei,IOConsts.outOfRange);
#endif
RETURN;
END;
WrStr(Datei,ZahlStr);
END WrLngCard;
PROCEDURE WrCardBN(VAR Aus : Stream;
c : CARDINAL;
Breite : CARDINAL);
(* Nochmal testen wegen vorgegebener Breite !!! *)
VAR p,i,null : CARDINAL;
BEGIN
p:=1; i:=c; (* p : miniale Breite die n"otig ist, um c auszuschreiben. *)
WHILE ((i DIV 10) > 0) DO i:=i DIV 10; INC(p); END;
null:=0;
IF (p <= Breite) THEN null:= Breite - p; END;
FOR i:=1 TO null DO WrChar(Aus,"0"); END;
WrCard(Aus,c,1);
END WrCardBN;
PROCEDURE RdInt(VAR Datei : Stream;
VAR i : INTEGER);
VAR ZahlStr : ARRAY [0..MaxCardStr] OF CHAR;
BEGIN
RdWort(Datei,ZahlStr);
StringToInt(ZahlStr,i,result);
IF (result # strAllRight) THEN
StringsLib.Concat(Fehlerflag,FFlag[result]," (SIO.RdInt) !");
IF WriteError THEN ErrOut(Fehlerflag); END;
i:=MAX(INTEGER);
#ifdef __MRI__
Datei.res := notdone;
#endif
#ifdef __ISOIO__
IOChan.SetReadResult(Datei,IOConsts.wrongFormat);
#endif
RETURN;
END;
#ifdef __MRI__
Datei.res := done;
#endif
#ifdef __ISOIO__
IOChan.SetReadResult(Datei,IOConsts.allRight);
#endif
END RdInt;
PROCEDURE WrInt(VAR Datei : Stream;
i : INTEGER;
n : CARDINAL); (* Feldbreite *)
VAR ZahlStr : ARRAY [0..MaxCardStr] OF CHAR;
AllRight : BOOLEAN;
BEGIN
IntToString(i,n,ZahlStr,AllRight);
IF NOT AllRight THEN
#ifdef __MRI__
Datei.res:=notdone;
#endif
#ifdef __ISOIO__
IOChan.SetReadResult(Datei,IOConsts.outOfRange);
#endif
WrCharN(Datei,"*",n);
RETURN;
END;
WrStr(Datei,ZahlStr);
END WrInt;
PROCEDURE WrLngInt(VAR Datei : Stream;
I : LONGINT;
n : CARDINAL); (* Feldbreite *)
VAR ZahlStr : ARRAY [0..MaxCardStr] OF CHAR;
AllRight : BOOLEAN;
BEGIN
LongIntToString(I,n,ZahlStr,AllRight);
IF NOT AllRight THEN
#ifdef __MRI__
Datei.res:=notdone;
#endif
#ifdef __ISOIO__
IOChan.SetReadResult(Datei,IOConsts.outOfRange);
#endif
WrCharN(Datei,"*",n);
RETURN;
END;
WrStr(Datei,ZahlStr);
END WrLngInt;
PROCEDURE RdLngReal(VAR Datei : Stream;
VAR x : LONGREAL);
VAR ZahlStr : ARRAY [0..MaxRealStr] OF CHAR;
BEGIN
#ifdef __MRI__
Datei.res:=done;
#endif
#ifdef __ISOIO__
IOChan.SetReadResult(Datei,IOConsts.allRight);
#endif
RdWort(Datei,ZahlStr);
StringToReal(ZahlStr,x,result);
IF (result # strAllRight) THEN
StringsLib.Concat(Fehlerflag,FFlag[result]," (SIO.RdLngReal)");
IF WriteError THEN ErrOut(Fehlerflag); END;
#ifdef __MRI__
Datei.res:=notdone;
#endif
#ifdef __ISOIO__
IOChan.SetReadResult(Datei,IOConsts.wrongFormat);
#endif
x:=MAX(LONGREAL);
END;
END RdLngReal;
PROCEDURE WrLngReal(VAR Datei : Stream;
x : LONGREAL;
Breite : CARDINAL; (* n : Feldbreite *)
Komma : INTEGER); (* m : Nachkommastellen *)
VAR AllRight : BOOLEAN;
ZahlStr : ARRAY [0..MaxRealStr] OF CHAR;
k : CARDINAL;
BEGIN
IF (Breite > MaxRealStr) THEN Breite:=MaxRealStr; END;
k:=VAL(CARDINAL,ABS(Komma));
IF (Komma < 0) THEN
(* Rueckanpassung FUSCH ???
RealToFloatString(ZahlStr,x,Breite,k,ExpAnz,AllRight);
*)
RealToFloatString(ZahlStr,x,Breite,Komma,ExpAnz,AllRight);
ELSE
RealToFixString(ZahlStr,x,Breite,k,AllRight);
END;
IF NOT AllRight THEN
(* WrCharN(Datei,"*",Breite); *)
WrStr(Datei,ZahlStr);
#ifdef __MRI__
Datei.res:=notdone;
#endif
#ifdef __ISOIO__
IOChan.SetReadResult(Datei,IOConsts.outOfRange);
#endif
ELSE
WrStr(Datei,ZahlStr);
#ifdef __MRI__
Datei.res:=done;
#endif
END;
END WrLngReal;
PROCEDURE WrReal(VAR Datei : Stream;
x : REAL;
Breite : CARDINAL; (* n : Feldbreite *)
Komma : INTEGER); (* m : Nachkommastellen *)
BEGIN
WrLngReal(Datei,VAL(LONGREAL,x),Breite,Komma);
END WrReal;
PROCEDURE WrLngCmplx(VAR Datei : Stream;
x : LONGCOMPLEX;
Breite : CARDINAL; (* Feldbreite *)
Komma : INTEGER); (* Nachkommastellen *)
BEGIN
WrLngReal(Datei,RE(x),Breite,Komma);
IF (IM(x) >= 0.0) THEN
WrStr(Datei,' + i');
ELSE
WrStr(Datei,' - i');
END;
WrLngReal(Datei,ABS(IM(x)),Breite,Komma);
END WrLngCmplx;
PROCEDURE WrBool(VAR Datei : Stream;
Bool : BOOLEAN);
BEGIN
IF Bool THEN WrStr(Datei,' TRUE '); ELSE WrStr(Datei,' FALSE '); END;
END WrBool;
PROCEDURE RdBitSet(VAR Datei : Stream;
VAR b : BITSET);
VAR i,bit : CARDINAL;
chr : CHAR;
BitStr : ARRAY [0..3] OF CHAR;
result : ConvResults;
BEGIN
b:={};
Fehler:=FALSE;
REPEAT RdChar(Datei,chr); UNTIL NOT IstTrennZeichen(chr);
IF (chr # "{") THEN Fehler:=TRUE; b:={}; RETURN END;
REPEAT
i:=0;
REPEAT
RdChar(Datei,chr);
#ifdef __ISOIO__
IF IsEOF(Datei) THEN Fehler:=TRUE; b:={}; RETURN END;
#endif
#ifdef __MRI__
IF Datei.EOF THEN Fehler:=TRUE; b:={}; RETURN END;
#endif
BitStr[i]:=chr;
INC(i);
UNTIL (chr = ",") OR (chr = "}");
BitStr[i-1]:=0C;
IF (i > 1) THEN (* Wegen leerem Bitset *)
StringToCard(BitStr,bit,result);
IF (result # strAllRight) THEN Fehler:=TRUE; b:={}; RETURN END;
IF (bit > MaxBit) THEN Fehler:=TRUE; b:={}; RETURN END;
INCL(b,bit);
END;
UNTIL (chr = "}");
END RdBitSet;
PROCEDURE WrBitSet(VAR Datei : Stream;
b : BITSET);
VAR second : BOOLEAN;
i : CARDINAL;
BEGIN
WrChar(Datei,"{");
second:=FALSE;
FOR i:=0 TO MaxBit DO
IF (i IN b) THEN
IF second THEN WrChar(Datei,","); END;
WrCard(Datei,i,1);
second:=TRUE;
END;
END;
WrChar(Datei,"}");
END WrBitSet;
BEGIN
ExpAnz:=2;
TrennAnzahl:=3;
Trenner[1]:=" ";
Trenner[2]:=ASCII.tab;
Trenner[3]:=ASCII.lf;
IF CommonIO.CrLf THEN
Trenner[3]:=EoL; (* Wegen Umsetzen in RdChar *)
Trenner[4]:=ASCII.cr;
Trenner[5]:=ASCII.lf;
Trenner[6]:=ASCII.sub; (* Ctrl-Z *)
TrennAnzahl := 6;
END;
FFlag[strAllRight] := 'In Ordnung !';
FFlag[strOutOfRange] := 'Wertebereichs"uberschreitung !';
FFlag[strWrongFormat] := 'Falsches Format !';
FFlag[strEmpty] := 'Zeichenkette leer !';
END SIO.