(**********************************************************************

    :Program.    Errors.mod
    :Contents.   Get errors from *.mode or *.defe-Files
    :Author.     Steffen Reith
    :Address.    Hessenstr. 64, D-8700 Wuerzburg
    :Phone.      None
    :Copyright.  Shareware
    :Language.   Modula-2
    :Translator. M2Amiga A+L V3.2d
    :Imports.    Msg
    :History.    V1.0  10.June 1990

**********************************************************************)
(*$ StackParms:=FALSE Volatile:=FALSE CaseChk:=FALSE *)
(*$ StackChk:=FALSE RangeChk:=FALSE OverflowChk:=FALSE NilChk:=FALSE *)
IMPLEMENTATION MODULE Errors;

FROM DosD    IMPORT FileHandlePtr,readOnly,beginning,current;
FROM DosL    IMPORT Open,Close,Seek,Read;
FROM SYSTEM  IMPORT ADR,ADDRESS;
FROM Msg     IMPORT TitleMsg;

CONST Header=03H;           (* Errorfilekennung                           *)
      ErrorMark=0C1455252H; (* Nun folgt die Fehlerposition im SourceFile *)
                            (* Achtung in Dokumentation falsch deklariert *)
      ErrorMarkHigh=0C145H; (* High-Word von ErrorMark                    *)
      StringMark=0C2H;      (* Nun folgt eine String                      *)

VAR AktFile:FileHandlePtr;

PROCEDURE ReadLongCard(File:FileHandlePtr):LONGCARD;

VAR Dummy:LONGINT;
    Value:LONGCARD;

BEGIN
 Dummy:=Read(File,ADR(Value),SIZE(Value));
 RETURN(Value)
END ReadLongCard;

PROCEDURE ReadCard(File:FileHandlePtr):CARDINAL;

VAR Dummy:LONGINT;
    Value:CARDINAL;

BEGIN
 Dummy:=Read(File,ADR(Value),SIZE(Value));
 RETURN(Value)
END ReadCard;

PROCEDURE ReadChar(File:FileHandlePtr):CHAR;

VAR Dummy:LONGINT;
    Value:CHAR;

BEGIN
 Dummy:=Read(File,ADR(Value),SIZE(Value));
 RETURN(Value)
END ReadChar;

PROCEDURE ReadString(File:FileHandlePtr;VAR String:ARRAY OF CHAR);

VAR Dummy:LONGINT;
    Buffer:CHAR;
    i:INTEGER;

BEGIN
 i:=0;
 LOOP

  IF i>(HIGH(String)-1) THEN
   TitleMsg('String in Errorfile zu lang');
   String[i]:=CHAR(0);
   RETURN
  END;

  Dummy:=Read(File,ADR(String[i]),SIZE(String[i])); (* Zeichen fuer Zeichen *)
  INC(i);                                           (* lesen, da hier Speed *)
  IF String[i-1]=CHAR(0) THEN                       (* egal!!!              *)
   Dummy:=Read(File,ADR(Buffer),SIZE(Buffer));
   (* Evtl. 2. Nullbyte ueberlesen *)
   IF Buffer#CHAR(0) THEN
    Dummy:=Seek(File,-1,current); (* Das war ein kalter 1x zurueck *)
   END;
   RETURN
  END
 END
END ReadString;

PROCEDURE ExistErrorFile(VAR Name:ARRAY OF CHAR):BOOLEAN;

VAR File:FileHandlePtr;
    Flag:BOOLEAN;

BEGIN
 File:=Open(ADR(Name),readOnly);
 Flag:=File#NIL;
 Close(File);
 RETURN(Flag)
END ExistErrorFile;

PROCEDURE OpenErrorFile(VAR Name:ARRAY OF CHAR);

VAR File:FileHandlePtr;

BEGIN
 File:=Open(ADR(Name),readOnly);
 IF File=NIL THEN
  TitleMsg('Kann Errorfile nicht oeffnen !!');
 END;

 IF AktFile#NIL THEN
  Close(AktFile)
 END;
 AktFile:=File;

 IF ReadLongCard(File) # Header THEN TitleMsg('Kein gueltiges Errorfile') END;
END OpenErrorFile;

PROCEDURE NextError(VAR SourcePos:LONGCARD; VAR ErrorNums:ErrorFeld);

CONST BuffLen=31;

VAR Ende:CARDINAL;
    Dummy:LONGINT;
    i:INTEGER;
    Buffer:ARRAY[0..BuffLen] OF CHAR;

BEGIN
 FOR i:=1 TO MaxError DO ErrorNums[i]:=0 END; (* Vorhandene Fehler loeschen *)

 Ende:=ReadCard(AktFile);
 IF Ende=0FFFFH THEN
  SourcePos:=0;
  ErrorNums[1]:=0;
  RETURN
 END;
 Dummy:=Seek(AktFile,-1*SIZE(CARDINAL),current); (* 2x zurueck *)
 IF ReadLongCard(AktFile)#ErrorMark THEN
  TitleMsg('Fehler in ErrorFile');
  RETURN
 END;
 SourcePos:=ReadLongCard(AktFile);
 i:=1;
 LOOP
  IF ReadChar(AktFile)=CHAR(StringMark) THEN
   ReadString(AktFile,Buffer);
  ELSE
   Dummy:=Seek(AktFile,-1*SIZE(CHAR),current); (* 1x zurueck wg. Stringmark *)
   ErrorNums[i]:=ReadCard(AktFile);
   IF ErrorNums[i]=ErrorMarkHigh THEN
    ErrorNums[i]:=0;
    Dummy:=Seek(AktFile,-1*SIZE(CARDINAL),current); (* 2x zurueck *)
    RETURN
   END;
   IF ErrorNums[i]=0FFFFH THEN (* Wenn Ende erreicht beim naechsten Aufruf *)
    ErrorNums[i]:=0;           (* Gleich oben der Fehler !!                *)
    Dummy:=Seek(AktFile,-1*SIZE(CARDINAL),current); (* 2x zurueck *)
    RETURN
   END;
   INC(i);
   IF i=MaxError+1 THEN
    TitleMsg('Implementationsbeschraenkung kann nicht alle Fehler lesen');
    WHILE ReadCard(AktFile)#ErrorMarkHigh DO END; (* Restliche Fehler weg *)
    Dummy:=Seek(AktFile,-1*SIZE(CARDINAL),current); (* 2x zurueck *)
    RETURN
   END
  END
 END
END NextError;

PROCEDURE CloseErrorFile();

BEGIN
 IF AktFile#NIL THEN Close(AktFile) END;
 AktFile:=NIL
END CloseErrorFile;

BEGIN
 AktFile:=NIL;
 CLOSE
  CloseErrorFile()
END Errors.