(****************************************
*     MODULA-2 Multi-Pass Compiler      *
*     ****************************      *
*                                       *
*       VAX/VMS Implementation          *
*                                       *
*                                       *
*     MVCErrors:                        *
*                                       *
*     error message handling used by    *
*     used by all passes.               *
*                                       * 
*                                       *
*     Version 3.1 of  1-FEB-1983        *
*                                       *
*                                       *
*                                       *
*                                       *
****************************************)

(****************************************
* Updates:                              *
****************************************)
(*$T-*)

IMPLEMENTATION MODULE MVCErrors;    (* VAX:  M. Mall *)

  IMPORT MVCPublic, Storage, ConditionHandlingProcedures, MODDefinitions, VMS;

  FROM MVCPublic IMPORT Compilerstatus,compstat;
  FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  FROM ConditionHandlingProcedures IMPORT LIB$SIGNAL;
  FROM MODDefinitions IMPORT MOD$_;
  FROM VMS IMPORT SYS$GETMSG;

  (* EXPORT QUALIFIED HaltMessage, InsertError, GetErrorText; *)


  CONST
    errormax = 300;

  TYPE
    Erptr = POINTER TO Errec;
    Errec = RECORD
              errline : CARDINAL;
              errpos : CARDINAL;
              errnum : CARDINAL;
              link : Erptr;
            END;

  VAR
    head : Erptr;
    errorcount : CARDINAL;


  PROCEDURE HaltMessage(num: CARDINAL);

  BEGIN
    LIB$SIGNAL(num*8+MOD$_);
  END HaltMessage;


  PROCEDURE InsertError(line, pos, num: CARDINAL);

    VAR
      ep : Erptr;

    PROCEDURE Search(VAR ep: Erptr): BOOLEAN;

      VAR
        hp : Erptr;

    BEGIN
      IF ep <> NIL THEN
        WITH ep^ DO
          IF errline < line THEN
            RETURN TRUE
          ELSIF errline = line THEN
            IF errpos < pos THEN
              RETURN TRUE
            ELSIF errpos = pos THEN
              IF errnum <= num THEN
                RETURN errnum > num
              END
            END
          END
        END; (* WITH *)
      END;
      (* Insert NOW AND RETURN POINTER *)
      NEW(hp);
      WITH hp^ DO
        errline := line;
        errpos := pos;
        errnum := num;
        link := ep;
      END;
      ep := hp;
      RETURN FALSE;
    END Search;

  BEGIN
    INC(errorcount);
    INCL(compstat,passerrs);
    IF errorcount <= errormax THEN
      IF errorcount = errormax THEN
        num := 5;
      END;
      IF Search(head) THEN
        ep := head;
        WHILE Search(ep^.link) DO
          ep := ep^.link
        END;
      END;
    ELSIF errorcount >= 10000 THEN
      HaltMessage(5);
    END;
  END InsertError;


  PROCEDURE GetErrorText(num: CARDINAL; VAR text: ARRAY OF CHAR);

    VAR
      Result: CARDINAL;
      OutLen: CARDINAL;

  BEGIN
    OutLen := 0;
    Result := SYS$GETMSG (num*8+MOD$_,OutLen,text,1,0);
    IF (OutLen <= HIGH(text)) THEN
      text[OutLen] := 0C;
    END;
  END GetErrorText;


  PROCEDURE GetError(VAR line, pos: CARDINAL; VAR text: ARRAY OF CHAR);

  BEGIN
    IF head = NIL THEN
      line := 0;
      pos := 0;
      text[0] := 0C;
    ELSE
      WITH head^ DO
        line := errline;
        pos := errpos;
        GetErrorText(errnum, text);
        head := link;
      END;
    END;
  END GetError;


BEGIN
  errorcount := 0;
  head := NIL;
END MVCErrors.