(*---------------------------------------------------------------------------
   :Program.    DMErr
   :Author.     Fridtjof Björn Siebert (Amok)
   :Address.    Nobileweg 67, D-7000 Stuttgart-40
   :Phone.      (0)711/822509
   :Shortcut.   [fbs]
   :Version.    1.2
   :Date.       14-May-89
   :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].
   :Update.     14-May-89: Now support M2Amiga v3.2 [fbs]
   :Contents.   Program to create DME-reference Files for M2-Errors.
   :Usage.      Usage: DMErr Source [-].
   :Remark.     Source is the Modula-II Sourcetext in which the errors are
   :Remark.     to be marked. The extension ".mod" may be left out.
   :Remark.     "-" avoids DME to be started.
   :Remark.     DME and RUN must occur in the C: Directory or in one
   :Remark.     directory thats specified with the PATH command.
---------------------------------------------------------------------------*)

MODULE DMErr;

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

FROM SYSTEM      IMPORT ADR,ADDRESS,BPTR;
FROM Arts        IMPORT TermProcedure,wbStarted,Terminate,Assert;
FROM Arguments   IMPORT NumArgs,GetArg,GetLock;
FROM Conversions IMPORT ValToStr,StrToVal;
FROM Dos         IMPORT Open,Close,Read,Write,FileHandlePtr,oldFile,newFile,
                        DeleteFile,Rename,Execute,FileLockPtr,FileInfoBlockPtr,
                        Examine,ParentDir,CurrentDir,UnLock,DupLock;
FROM Exec        IMPORT AllocMem,FreeMem,MemReqSet,MemReqs, Message, MessagePtr,
                        MsgPort, MsgPortPtr, PutMsg, WaitPort, GetMsg, SetTaskPri,
                        FindTask, Task, NodeType;
FROM InOut       IMPORT WriteString,WriteLn,WriteCard;
FROM Strings     IMPORT first,last,Delete,Copy,Insert,Compare,Length,Occurs;
FROM Terminal    IMPORT waitCloseGadget;

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

CONST
(*  Constant to start DME:  *)
  RunDMC = "DME ";
(*  diese 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   = "t: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            *)
  ChrInBuf: BufferPtr;
  LongInBuf: POINTER TO LONGCARD;
  ReadInBuf: BufferPtr;
  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,ReadInCnt,ReadInLen: LONGINT;
  WriteChrCnt,WriteChrLen: LONGINT;   (* Variables for WriteChar     *)
  StartDME: BOOLEAN;                  (* False if 2. Arg is `-'      *)
  RunDMCTxt: ArgStr;                  (* RunDMC + SourceFile         *)
  OldLock: FileLockPtr;
  nili,nilo: FileHandlePtr;
  First: BOOLEAN;

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

PROCEDURE GetName(File:FileLockPtr;VAR Name:ARRAY OF CHAR);
VAR
  Info:FileInfoBlockPtr;
  New: FileLockPtr;
  i: INTEGER;

BEGIN
  Info := AllocMem(SIZE(Info^),MemReqSet{memClear});
  IF Info#NIL THEN
    WHILE File#NIL DO
      IF Examine(File,Info) THEN
        Insert(Name,0,"/"); Insert(Name,0,Info^.fileName)
      END;
      New:=ParentDir(File); UnLock(File); File := New; New := NIL;
    END; i:=0;
    LOOP CASE Name[i] OF "/": Name[i] := ":"; EXIT | 0C: EXIT ELSE END; INC(i) END;
    FreeMem(Info,SIZE(Info^));
  END;
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;
  IF nili#NIL     THEN Close(nili) END;
  IF nilo#NIL     THEN Close(nilo) END;

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

  IF InBuffer#NIL THEN FreeMem(InBuffer,1536+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;

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

PROCEDURE ReadIn(l: INTEGER);

VAR q: INTEGER;

BEGIN
  q := 0;
  WHILE q<l DO
    IF ReadInCnt=ReadInLen THEN
      ReadInLen := Read(InH,ReadInBuf,256); ReadInCnt := 0;
    END;
    ChrInBuf^[q] := ReadInBuf^[ReadInCnt];
    INC(ReadInCnt); INC(q)
  END;
  IF ReadInLen=0 THEN len := 0 ELSE len := l END;
END ReadIn;

(*----------------------  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^[i/2+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;
  ModXFile := ""; nili := NIL; nilo := NIL;
  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.2 -- 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(" © 1989 by Fridtjof Siebert, Nobileweg 67, D-7000 Stgt-40"); WriteLn;
  WriteString("    Phone: (0)711/822509"); WriteLn;
  Terminate(0);
END;

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

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

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

GetArg(1,SourceFile,j);
IF (Occurs(SourceFile,0,".",FALSE)<0) THEN
  Insert(SourceFile,last,".mod");
END;
ErrFile := SourceFile; Insert(ErrFile,last,"E");
ModXFile:= SourceFile; Insert(ModXFile,last,"X");

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

InBuffer  := AllocMem(1536+5500H,MemReqSet{memClear});
IF InBuffer=NIL THEN
  WriteString("Zu wenig Speicher"); WriteLn;
  Terminate(0);
END;
ChrInBuf := ADDRESS(InBuffer);
LongInBuf := ADDRESS(InBuffer);
SInBuffer := ADDRESS(ADDRESS(InBuffer) + 256);
RefsOutBuffer := ADDRESS(ADDRESS(InBuffer) + 512);
ErrsOutBuffer := ADDRESS(ADDRESS(InBuffer) + 768);
ModXOutBuffer := ADDRESS(ADDRESS(InBuffer) + 1024);
ReadInBuf := ADDRESS(ADDRESS(InBuffer)+1280);
ErrorNum := ADDRESS(ADDRESS(InBuffer)+1536);
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; ReadInCnt := 0; ReadInLen := 0;
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;

  ReadIn(4);
  IF LongInBuf^#3 THEN WriteString("Formatfehler!"); WriteLn; Terminate(0) END;

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

  ReadIn(2);
  LOOP
    IF (len=0) OR (InBuffer^#0C145H) THEN EXIT END;
    ReadIn(2); IF (InBuffer^#05252H) THEN EXIT END;
    ReadIn(4);
    ErrAdr := ADDRESS(LongInBuf^);

    IF (TextAdr<ErrAdr) THEN
      INC(ErrCnt);
      REPEAT
        WriteChar(ReadChar(ok)); INC(TextAdr);
      UNTIL (TextAdr=ErrAdr) OR NOT(ok);
      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 ");
      Insert(RefsOutBuffer^,last,Errs);
      Insert(RefsOutBuffer^,last," ");
      Insert(RefsOutBuffer^,last,ErrsOutBuffer^);
      len:= Write(RefsOutH,RefsOutBuffer,Length(RefsOutBuffer^));
      LF(1,RefsOutH,RefsOutBuffer);
    ELSE
      ErrsOutBuffer^ := "   ";
    END;
    First := TRUE;
    LOOP
      ReadIn(2);         (* Error-Number *)
      IF (ChrInBuf^[0]=CHAR(0C1H)) AND (ChrInBuf^[1]=CHAR(045H)) OR (len=0) OR
         (ChrInBuf^[0]=CHAR(0FFH)) AND (ChrInBuf^[1]=CHAR(0FFH)) THEN EXIT END;
      IF ChrInBuf^[0]=CHAR(0C2H) THEN
        i := 1; j := Length(ErrsOutBuffer^); ChrInBuf^[0] := ChrInBuf^[1];
        REPEAT
          ReadIn(1);
          ErrsOutBuffer^[j] := ChrInBuf^[0];
          IF j>75 THEN
            Insert(ErrsOutBuffer^,last,"-");
            len := Write(ErrsOutH,ErrsOutBuffer,Length(ErrsOutBuffer^));
            LF(1,ErrsOutH,ErrsOutBuffer);
            ErrsOutBuffer^ := "         ";
            j := 8;
          END;
          INC(i); INC(j);
        UNTIL ChrInBuf^[0]=0C;
        IF NOT(ODD(i)) THEN ReadIn(1) END;
        Insert(ErrsOutBuffer^,last,ChrInBuf^);
      ELSE
        IF First THEN
          ValToStr(InBuffer^,FALSE,Number,10,4," ",ok);
          Insert(ErrsOutBuffer^,last,Number);
          Insert(ErrsOutBuffer^,last,": ");
        END;
        ErrorMsg(InBuffer^);
        Insert(ErrsOutBuffer^,last," ");
      END;
      First := FALSE;
    END;
    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:  ------*)

  IF DeleteFile(ADR(SourceFile)) AND Rename(ADR(ModXFile),ADR(SourceFile)) THEN END;

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

IF StartDME THEN
  IF wbStarted THEN GetName(GetLock(1),SourceFile) END;
  Insert(SourceFile,first,'"');
  Insert(SourceFile,last ,'"');
  RunDMCTxt := RunDMC;
  Insert(RunDMCTxt,last,SourceFile);
  nili := Open(ADR("NIL:"),oldFile);
  nilo := Open(ADR("NIL:"),newFile);
  i := Execute(ADR(RunDMCTxt),nili,nilo);
END;

waitCloseGadget := FALSE;

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

END DMErr.