(*---------------------------------------------------------------------------
   :Program.    DMErr
   :Author.     Fridtjof Björn Siebert (Amok)
   :Address.    Nobileweg 67, D-7000 Stuttgart-40
   :Phone.      (0)711/822509
   :Shortcut.   [fbs]
   :Version.    1.1
   :Date.       17.04.88
   :Copyright.  PD, but of course contributions are wellcomed.
   :Language.   Modula-II
   :Translator. M2Amiga
   :Imports.    none.
   :Update.     15-Nov-88: Works fine from Workbench now [fbs].
   :Contents.   Program to create DME-reference Files for M2-Errors.
   :Remark.     Usage: DMErr Source [-].
   :Remark.     The way to start DME can be changed by changing `RunDMC'
   :Remark.     No DMErr stoppes if ErrorList is corrupt.
   :Bugs.       None known
---------------------------------------------------------------------------*)

(*-------------------------------------------------------------------------*)
(*                            -----------------                            *)
(*                 -   -   -   -  D M E R R  -  -  -  -  -                 *)
(*                            -----------------                            *)
(*                                                                         *)
(*  © 1988 by Fridtjof Siebert                                             *)
(*            Nobileweg 67                                                 *)
(*            7000 Stuttgart 40 (Stammheim)                                *)
(*            Germany                                                      *)
(*     Phone: (0)711/822509                                                *)
(*                                                                         *)
(*  Usage:                                                                 *)
(*    DMErr Source [-]                                                     *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

MODULE DMErr;

(*------  Importlist:  ------*)

FROM SYSTEM IMPORT ADR,ADDRESS,BYTE,WORD,BITSET,SHIFT,CAST;
FROM Arts IMPORT TermProcedure, wbStarted, Terminate;
FROM Arguments IMPORT NumArgs,GetArg, GetLock;
FROM Dos IMPORT Open,Close,Read,Write,FileHandlePtr,oldFile,newFile,
       DeleteFile,Rename,Execute, FileLockPtr, FileInfoBlockPtr, Examine,
       ParentDir, CurrentDir;
FROM Exec IMPORT AllocMem,FreeMem,MemReqSet,MemReqs;
FROM InOut IMPORT WriteString,WriteLn,WriteCard;
FROM Strings IMPORT first,last,Delete,Copy,Insert,Compare,Length,Occurs;
FROM Conversions IMPORT ValToStr,StrToVal;
FROM Terminal IMPORT waitCloseGadget;

(*------  Constants:  ------*)

CONST
(*  Constant to start DME:  *)
  RunDMC = "run DME ";
(*  dies Konstante kannst Du so ändern, wie Dein DME gestartet werden  *)
(*  soll. Sie kann z. B. `run ram:DME -fRam:DMErr.edrc' lauten, wenn   *)
(*  sich der DME in Ram: befindet und DMErr.edrc nicht in s:.edrc ein- *)
(*  gebunden ist.                                                      *)

  M2Errs = "s:Modula-2 Fehlermeldungen";
  Refs   = "s:DME.refs";
  Errs   = "s:M2.errs";

(*------  Types:  ------*)

TYPE
  ArgStr  = ARRAY[0..255] OF CHAR;
  String2 = ARRAY[0..1] OF CHAR;
  BufferPtr = POINTER TO ARRAY[0..255] OF CHAR;

(*------  Variables:  ------*)

VAR
  argc: CARDINAL;                     (* count args                  *)
  SourceFile,ModXFile: ArgStr;        (* The Modula-File             *)
  ErrFile: ArgStr;                    (* The Error-File              *)
  Number:ArgStr;                      (* For Numberstrings           *)
  i,j: INTEGER;                       (* no special use              *)
  ic,jc:CARDINAL;                     (* no special use              *)
  InBuffer: POINTER TO CARDINAL;      (* Buffer for Input            *)
  LongInBuf: POINTER TO ARRAY[0..15] OF LONGCARD;
  SInBuffer: BufferPtr;               (* Source-File                 *)
  RefsOutBuffer: BufferPtr;           (* Ref-file                    *)
  ErrsOutBuffer: BufferPtr;           (* Error-File                  *)
  ModXOutBuffer: BufferPtr;           (* created Modula-File         *)
  InH,SInH,RefsOutH,ErrsOutH,ModXOutH: FileHandlePtr; (* FileHandles *)
  len: LONGINT;                       (* for saving Writes's result  *)
  ok: BOOLEAN;                        (* for getting boolean results *)
  ErrorNum: POINTER TO ARRAY[0..2A7FH] OF CARDINAL; (* ErrorMsgs     *)
  ErrorTxt: POINTER TO ARRAY[0..54FFH] OF CHAR;
  TextAdr: ADDRESS;                   (* Address in source           *)
  Char: CHAR;
  ErrAdr: ADDRESS;
  ErrCnt,ErrorCnt: CARDINAL;          (* this counts errors          *)
  ReadChrCnt,ReadChrLen: LONGINT;     (* Variables for ReadChar      *)
  WriteChrCnt,WriteChrLen: LONGINT;   (* Variables for WriteChar     *)
  StartDME: BOOLEAN;                  (* False if 2. Arg is `-'      *)
  RunDMCTxt: ArgStr;                  (* RunDMC + SourceFile         *)
  end: BOOLEAN;
  OldLock: FileLockPtr;

(*------  GetFilename:  ------*)

PROCEDURE GetName(File:FileLockPtr;VAR Name:ARRAY OF CHAR);
VAR     Info:FileInfoBlockPtr;
        Old: FileLockPtr;
        Ok:BOOLEAN;
BEGIN
  Ok:=FALSE;
  Info := AllocMem(SIZE(Info^),MemReqSet{memClear});
  IF Info#NIL THEN
    Old := CurrentDir(File);
    WHILE File#NIL DO
      IF (Examine(File,Info)#0) AND (Info^.dirEntryType>0) THEN
        Insert(Name,0,"/");
        Insert(Name,0,Info^.fileName);
        Ok:=TRUE;
      END;
      File:=ParentDir(File);
    END;
    IF Ok THEN
      Name[Occurs(Name,0,"/",FALSE)]:=":";
    END;
    Old := CurrentDir(Old);
  END;
  FreeMem(Info,SIZE(Info^));
END GetName;


(*----------------------  CleanUp:  ---------------------------------------*)

PROCEDURE CleanUp();

BEGIN
(*------  Close Files:  ------*)

  IF InH#NIL      THEN Close(InH) END;
  IF SInH#NIL     THEN Close(SInH) END;
  IF RefsOutH#NIL THEN Close(RefsOutH) END;
  IF ErrsOutH#NIL THEN Close(ErrsOutH) END;
  IF ModXOutH#NIL THEN Close(ModXOutH) END;

(*------  Rename .modx and Delete when finished correctly  ------*)


  IF NOT(end) AND (Length(ModXFile)#0) THEN
    len := DeleteFile(ADR(ModXFile));   (* programm aborted: delete .modx *)
  END;

(*------  Give Mem back:  ------*)

  IF InBuffer#NIL THEN FreeMem(InBuffer,1280+5500H) END;

END CleanUp;

(*----------------------  ReadChar  ---------------------------------------*)

PROCEDURE ReadChar(VAR ok: BOOLEAN): CHAR;

BEGIN
  ok := TRUE;
  IF ReadChrCnt=ReadChrLen THEN
    ReadChrLen := Read(SInH,SInBuffer,256); ReadChrCnt := 0;
    IF (ReadChrLen<=0) THEN
      ok := FALSE;
      RETURN 0C;
    END;
  END;
  INC(ReadChrCnt);
  RETURN SInBuffer^[ReadChrCnt-1];
END ReadChar;

(*----------------------  WriteChar  --------------------------------------*)

PROCEDURE WriteChar(Chr: CHAR);

BEGIN
  IF WriteChrCnt=WriteChrLen THEN
    len := Write(ModXOutH,ModXOutBuffer,WriteChrLen); WriteChrCnt := 0;
  END;
  ModXOutBuffer^[WriteChrCnt] := Chr;
  INC(WriteChrCnt);
END WriteChar;

(*-------------------  LineFeed ausgeben:  --------------------------------*)

PROCEDURE LF(Lines: CARDINAL;OutH:FileHandlePtr; OutBuffer: BufferPtr);

BEGIN
  OutBuffer^[0] := CHR(10); len := Write(OutH,OutBuffer,1);
  WHILE Lines>1 DO
    len := Write(OutH,OutBuffer,1); DEC(Lines);
  END;
END LF;

(*---------------  Errormessage ausgeben:  --------------------------------*)

PROCEDURE ErrorMsg(Number:CARDINAL);

VAR
  i: LONGCARD;
  j: CARDINAL;
  P: POINTER TO LONGCARD;
  Error: ARRAY[0..255] OF CHAR;
  SplitErr: ARRAY[0..69] OF CHAR;

BEGIN
  i:=0; j:=0; Error := "";
  LOOP
    IF ErrorNum^[SHIFT(i,-1)+2]>=Number THEN EXIT END;
    P := ADR(ErrorTxt^[i]);
    IF i>=P^ THEN EXIT END;
    i := P^;
  END;
  IF ErrorNum^[(i DIV 2)+2]=Number THEN
    WHILE ErrorTxt^[i+5]#CHAR(0) DO
      Error[j] := ErrorTxt^[i+6]; INC(i); INC(j);
    END;
  ELSE
    Error := "???";
  END;
  IF Length(Error)>66 THEN
    Copy(SplitErr,Error,0,65);
    Delete(Error,0,65);
    Insert(ErrsOutBuffer^,last,SplitErr);
    Insert(ErrsOutBuffer^,last,"-.");
    len := Write(ErrsOutH,ErrsOutBuffer,Length(ErrsOutBuffer^));
    LF(1,ErrsOutH,ErrsOutBuffer);
    ErrsOutBuffer^ := "         ";
  END;
  Insert(ErrsOutBuffer^,last,Error);
END ErrorMsg;

(*-------------------------  Start  ---------------------------------------*)

BEGIN
  InBuffer := NIL;
  InH := NIL; SInH := NIL; RefsOutH := NIL; ErrsOutH := NIL; ModXOutH := NIL;
  end := TRUE; ModXFile := "";
  TermProcedure(CleanUp);

(*------  Get Commandline:  ------*)

argc := NumArgs();
IF argc>2 THEN WriteString("Too many parameters"); WriteLn(); Terminate(0); END;

IF argc=2 THEN
  GetArg(2,Number,j);
  IF Number[0]="-" THEN
    StartDME := FALSE;
  ELSE
    WriteString("Falsche Paramter"); WriteLn; Terminate(0);
  END;
ELSE
  StartDME := TRUE;
END;

(*------  No Parameters? Then type Usage:  ------*)

IF argc=0 THEN
  WriteString("DMErr -- V1.1 -- 15-Nov-88"); WriteLn;
  WriteString("Usage:  DMErr Source [-]"); WriteLn;
  WriteLn;
  WriteString("  Source: The File which the errors are to be shown of."); WriteLn;
  WriteString("  `-' avoids starting DME after creating Errorlist."); WriteLn;
  WriteLn;
  WriteString(" © 1988 by Fridtjof Siebert, Nobileweg 67, D-7000 Stgt-40"); WriteLn;
  WriteString("    Phone: (0)711/822509"); WriteLn;
  Terminate(0);
END;

(*------  Title:  ------*)

WriteString(" DMErr v1.1 -- markiere Fehler."); WriteLn;

(*------  read parameter  ------*)

GetArg(1,SourceFile,j);
ErrFile := SourceFile; Insert(ErrFile,last,"E");
ModXFile:= SourceFile; Insert(ModXFile,last,"X");

(*------  get Memory  ------*)

InBuffer  := AllocMem(1280+5500H,MemReqSet{chip,memClear});
IF InBuffer=NIL THEN
  WriteString("Zu wenig Speicher"); WriteLn;
  Terminate(0);
END;
LongInBuf := ADDRESS(InBuffer);
SInBuffer := ADDRESS(ADDRESS(InBuffer) + 256);
RefsOutBuffer := ADDRESS(ADDRESS(InBuffer) + 512);
ErrsOutBuffer := ADDRESS(ADDRESS(InBuffer) + 768);
ModXOutBuffer := ADDRESS(ADDRESS(InBuffer) + 1024);
ErrorNum := ADDRESS(ADDRESS(InBuffer)+1280);
ErrorTxt := ADDRESS(ErrorNum);

(*------  Read Errormessages:  ------*)

InH := Open(ADR(M2Errs),oldFile);
IF InH=NIL THEN
  WriteString("Konnte Fehlermelmeldungen nicht öffnen."); WriteLn;
  Terminate(0);
END;

len := Read(InH,ErrorNum,5500H);
Close(InH);
InH := NIL;

(*------  Init Main Loop:  ------*)

ReadChrCnt := 0; ReadChrLen := 0; (* defaults for ReadChar *)
WriteChrCnt := 0; WriteChrLen := 256;
TextAdr := 0; (* the current Address in Source *)
ErrCnt := 0; (* this counts the errors *)

(*------  Open Error file:  ------*)

InH := Open(ADR(ErrFile),oldFile);
IF InH=NIL THEN
  WriteLn; WriteString("Kein Fehler enthalten."); WriteLn;
ELSE

(*------  Open Files:  ------*)

  SInH := Open(ADR(SourceFile),oldFile);
  RefsOutH := Open(ADR(Refs),newFile);
  ErrsOutH := Open(ADR(Errs),newFile);
  ModXOutH := Open(ADR(ModXFile),newFile);
  IF (InH=NIL) OR (SInH=NIL) OR (RefsOutH=NIL) OR (ErrsOutH=NIL)
     OR (ModXOutH=NIL) THEN
    WriteString("Konnte Datei nicht öffnen."); WriteLn;
    Terminate(0);
  END;

  len := Read(InH,InBuffer,4); len := Read(InH,InBuffer,2); (* `AE' *)

(*------  Main Loop:  ------*)

  WHILE (InBuffer^#0FFFFH) AND (len#0) DO
    len := Read(InH,InBuffer,2);        (* `RR' *)
    len := Read(InH,InBuffer,4);        (* Address in Source *)
    ErrAdr := ADDRESS(LongInBuf^[0]);

    IF (TextAdr<ErrAdr) OR (TextAdr=0) THEN
      INC(ErrCnt);
      WHILE TextAdr<ErrAdr DO
        WriteChar(ReadChar(ok)); INC(TextAdr);
      END;
      WriteChar(" "); WriteChar("X"); WriteChar("X");
      ValToStr(ErrCnt,FALSE,Number,10,3,"0",ok);
      FOR ic:=0 TO 2 DO WriteChar(Number[ic]) END;
      WriteChar(" ");

      ErrsOutBuffer^ := "ok."; len := Write(ErrsOutH,ErrsOutBuffer,3);
      LF(1,ErrsOutH,ErrsOutBuffer);
      ValToStr(ErrCnt,FALSE,ErrsOutBuffer^,16,2,"0",ok);
      Insert(ErrsOutBuffer^,last,">");

      RefsOutBuffer^ := "XX"; Insert(RefsOutBuffer^,last,Number);
      Insert(RefsOutBuffer^,last," ok s:M2.errs ");
      Insert(RefsOutBuffer^,last,ErrsOutBuffer^);
      len:= Write(RefsOutH,RefsOutBuffer,Length(RefsOutBuffer^));
      LF(1,RefsOutH,RefsOutBuffer);
    ELSE
      ErrsOutBuffer^ := "   ";
    END;
    len := Read(InH,InBuffer,2);         (* Error-Number *)
    ValToStr(InBuffer^,FALSE,Number,10,4," ",ok);
    Insert(ErrsOutBuffer^,last,Number);
    Insert(ErrsOutBuffer^,last,": ");
    REPEAT
      ErrorMsg(InBuffer^);
      Insert(ErrsOutBuffer^,last," ");
      len := Read(InH,InBuffer,2);         (* second Errornumber *)
    UNTIL (InBuffer^=0FFFFH) OR (InBuffer^=0C145H) OR (len=0);
    Insert(ErrsOutBuffer^,last,".");
    len := Write(ErrsOutH,ErrsOutBuffer,Length(ErrsOutBuffer^));
    LF(1,ErrsOutH,ErrsOutBuffer);
    INC(ErrorCnt);
  END;

  WriteLn; WriteCard(ErrorCnt,4); WriteString(" Fehler enthalten.");
  IF ErrorCnt>25 THEN WriteString(" Viel Spaß !!") END;
  WriteLn;

  Char := ReadChar(ok);

  WHILE ok DO
    WriteChar(Char);
    Char := ReadChar(ok);
  END;

  WriteChrLen := WriteChrCnt; WriteChar(0C);

  Close(InH); InH := NIL;
  Close(SInH); SInH := NIL;
  Close(RefsOutH); RefsOutH := NIL;
  Close(ErrsOutH); ErrsOutH := NIL;
  Close(ModXOutH); ModXOutH := NIL;

(*------  Rename .modX and start DME:  ------*)

  len := DeleteFile(ADR(SourceFile));
  len := Rename(ADR(ModXFile),ADR(SourceFile));

END;   (* IF InH=NIL THEN ... ELSE ... *)

end := TRUE;
GetName(GetLock(1),SourceFile);
Insert(SourceFile,first,'"');
Insert(SourceFile,last ,'"');
IF StartDME THEN
  RunDMCTxt := RunDMC;
  Insert(RunDMCTxt,last,SourceFile);
  i := Execute(ADR(RunDMCTxt),NIL,NIL);      (* start DME *)
END;

waitCloseGadget := FALSE;

(*------  That's it! ------*)

END DMErr.

(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*  Don't forget: This isn't the hole source. There is the File DMErr.edrc *)
(*  containing the new DME-Commands.                                       *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)