(* Errors       General module to store error messages   Moe 21.03.84
   ======       ======================================
This module stores information about syntax errors and semantic errors.
The information can either be retrieved afterwards or or be printed
automatically as simple error messages.
Furthermore the module contains procedures to report compiler errors
and implementation restrictions. These procedures cause a program stop.
----------------------------------------------------------------------*)
IMPLEMENTATION MODULE Errors;

(*imports of definition module*)
FROM FileSystem IMPORT File;

(*imports of implementation module*)
FROM FileIO  IMPORT con, Write, WriteCard, WriteLn, WriteString, WriteText;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;


TYPE
  Semerrptr = POINTER TO Semerror;
  Semerror  = RECORD
    nr,line,col: CARDINAL;
    next: Semerrptr;
    END;
  Synerrptr = POINTER TO Synerror;
  Synerror  = RECORD
    symbols: Errorptr;
    line,col: CARDINAL;
    next: Synerrptr;
    END;

VAR
  semerr: Semerrptr;
  synerr: Synerrptr;


(* CompErr      Reports compiler error nr and stops the program
----------------------------------------------------------------------*)
PROCEDURE CompErr(nr:CARDINAL);
VAR dummy:CARDINAL;
BEGIN
  PrintSynErrors(con,dummy); PrintSemErrors(con,dummy);
  WriteString(con,"Compiler error "); WriteCard(con,nr,0);
  WriteString(con,". Program terminated.$");
  HALT;                                     (*25.11.,C,Dob*)
  END CompErr;


(* GetNextSemErr     Gets next semantic error information
-----------------------------------------------------------------------*)
PROCEDURE GetNextSemErr(VAR nr,line,col:CARDINAL);
VAR p: Semerrptr;
BEGIN
  IF semerr=NIL
    THEN nr:=0; line:=0; col:=0;
    ELSE
      p:=semerr;
      nr:=p^.nr; line:=p^.line; col:=p^.col;
      semerr:=p^.next; DEALLOCATE(p, 0);
      END;
  END GetNextSemErr;


(* GetNextSynErr     Gets next syntax error information
------------------------------------------------------------------------*)
PROCEDURE GetNextSynErr(VAR symbols:Errorptr; VAR line,col:CARDINAL);
VAR p: Synerrptr;
BEGIN
  IF synerr=NIL
    THEN symbols:=NIL; line:=0; col:=0;
    ELSE
      p:=synerr;
      symbols:=p^.symbols; line:=p^.line; col:=p^.col;
      synerr:=p^.next; DEALLOCATE(p, 0);
      END;
  END GetNextSynErr;


(* GetNumberOfErrors    Gets the total number of errors that occured
-----------------------------------------------------------------------*)
PROCEDURE GetNumberOfErrors(VAR synerrors,semerrors:CARDINAL);
VAR
  syn: Synerrptr;
  sem: Semerrptr;
BEGIN
  synerrors:=0; syn:=synerr;
  WHILE syn<>NIL DO INC(synerrors); syn:=syn^.next; END;
  semerrors:=0; sem:=semerr;
  WHILE sem<>NIL DO INC(semerrors); sem:=sem^.next; END;
  END GetNumberOfErrors;


(* PrintSemErrors      Prints simple error messages for semantic errors
------------------------------------------------------------------------*)
PROCEDURE PrintSemErrors(VAR f:File; VAR semerrors:CARDINAL);
VAR
  p:         Semerrptr;
  synerrors: CARDINAL;
BEGIN
  GetNumberOfErrors(synerrors,semerrors);
  IF semerrors>0 THEN
    WriteString(f,"Semantic errors:$$");
    p:=semerr;
    WHILE p<>NIL DO
      WriteString(f,"line"); WriteCard(f,p^.line,5);
      WriteString(f," col"); WriteCard(f,p^.col,3);
      WriteString(f,": error "); WriteCard(f,p^.nr,0);
      WriteLn(f);
      p:=p^.next;
      END;
    END;
  END PrintSemErrors;


(* PrintSynErrors      Prints simple error messages for syntax errors
------------------------------------------------------------------------*)
PROCEDURE PrintSynErrors(VAR f:File; VAR synerrors:CARDINAL);
CONST
  llinit  = 18;             (*initial linelength*)
  linelen = 10;             (*length of line number printing*)
  llmax   = 71;             (*maximal line length*)
VAR
  err,err1:  Synerrptr;
  p,q:       Errorptr;
  ll:        CARDINAL;          (*line length*)
  i:         CARDINAL;
  first:     BOOLEAN;
  semerrors: CARDINAL;
BEGIN
  GetNumberOfErrors(synerrors,semerrors);
  IF synerrors>0 THEN
    WriteString(f,"Syntax errors:$$");
    err:=synerr;
    WHILE err<>NIL DO
      WriteString(f,'line'); WriteCard(f,err^.line,5);
      p:=err^.symbols;
      IF p=NIL THEN  (*simple error message*)
        WriteString(f," column"); WriteCard(f,err^.col,4); WriteLn(f);
        RETURN;
        END;
      WriteString(f,' near '); WriteText(f,p^.txt,p^.l); WriteString(f,' : ');
      ll:=llinit+p^.l; p:=p^.next; first:=TRUE;
      WHILE p<>NIL DO
        IF first
          THEN first:=FALSE
          ELSE                          (*print separator*)
            IF p^.next=NIL
              THEN WriteString(f,' or '); ll:=ll+4;   (*or*)
              ELSE WriteString(f,', '); ll:=ll+2;     (*, *)
              END
            END;
        IF ll+p^.l>llmax THEN  (*skip to next line*)
          WriteLn(f); ll:=linelen;
          FOR i:=1 TO linelen DO Write(f,' '); END;
          END;
        IF p^.l=1              (*print symbol*)
          THEN                           (*in quotes*)
            Write(f,'"'); Write(f,p^.txt[1]); Write(f,'"');
            ll:=ll+p^.l+2;
          ELSE                           (*without quotes*)
            WriteText(f,p^.txt,p^.l);
            ll:=ll+p^.l;
            END;
        q:=p; p:=p^.next; DEALLOCATE(q, 0);
        END;
      WriteString(f,' expected'); WriteLn(f);
      err1:=err; err:=err^.next; DEALLOCATE(err1, 0);
      END;
    END;
  END PrintSynErrors;


(* Restriction Reports implementation restriction nr and stops the program
----------------------------------------------------------------------*)
PROCEDURE Restriction(nr:CARDINAL);
VAR dummy:CARDINAL;
BEGIN
  PrintSynErrors(con,dummy); PrintSemErrors(con,dummy);
  WriteString(con,"Implementation restriction "); WriteCard(con,nr,0);
  WriteString(con,". Program terminated.$");
  HALT;                                     (*25.11.,C,Dob*)
  END Restriction;


(* SemErr         Stores information about semantic error
----------------------------------------------------------------------*)
PROCEDURE SemErr(nr,line,col:CARDINAL);
VAR e,p,q: Semerrptr;
BEGIN
  ALLOCATE(e, SIZE(e^)); e^.nr:=nr; e^.line:=line; e^.col:=col;
  p:=semerr; q:=NIL;
  WHILE (p<>NIL) AND (p^.line<line) DO q:=p; p:=p^.next; END;
  WHILE (p<>NIL) AND (p^.line=line) AND (p^.col<col) DO
    q:=p; p:=p^.next;
    END;
  IF q=NIL THEN semerr:=e; ELSE q^.next:=e; END;
  e^.next:=p;
  END SemErr;


(* SyntaxError         Stores information about syntax error
----------------------------------------------------------------------*)
PROCEDURE SyntaxError(symbols:Errorptr; line,col:CARDINAL);
VAR e,p,q: Synerrptr;
BEGIN
  ALLOCATE(e, SIZE(e^)); e^.symbols:=symbols; e^.line:=line; e^.col:=col;
  p:=synerr; q:=NIL;
  WHILE (p<>NIL) AND (p^.line<line) DO q:=p; p:=p^.next; END;
  WHILE (p<>NIL) AND (p^.line=line) AND (p^.col<col) DO
    q:=p; p:=p^.next;
    END;
  IF q=NIL THEN synerr:=e; ELSE q^.next:=e; END;
  e^.next:=p;
  END SyntaxError;

BEGIN  (*Errors*)
  synerr:=NIL; semerr:=NIL;
  END Errors.