MODULE Err EXPORTS Err, Err_impl;

(***************************************************************************)
(*                      Copyright (C) Olivetti 1989                        *)
(*                          All Rights reserved                            *)
(*                                                                         *)
(* Use and copy of this software and preparation of derivative works based *)
(* upon this software are permitted to any person, provided this same      *)
(* copyright notice and the following Olivetti warranty disclaimer are     *) 
(* included in any copy of the software or any modification thereof or     *)
(* derivative work therefrom made by any person.                           *)
(*                                                                         *)
(* This software is made available AS IS and Olivetti disclaims all        *)
(* warranties with respect to this software, whether expressed or implied  *)
(* under any law, including all implied warranties of merchantibility and  *)
(* fitness for any purpose. In no event shall Olivetti be liable for any   *)
(* damages whatsoever resulting from loss of use, data or profits or       *)
(* otherwise arising out of or in connection with the use or performance   *)
(* of this software.                                                       *)
(***************************************************************************)

IMPORT Text, Thread;
IMPORT ProgName, Wr, Stdio, RTMisc;


TYPE
  DefaultPrintClosure = PrintClosure OBJECT
  OVERRIDES print := DefaultPrint
  END;


PROCEDURE DefaultPrint(
    p: PrintClosure; (* ignored *)
    severity: Severity;
    msg: Text.T)
    RAISES {} =
  BEGIN
    TRY
      WITH err = Stdio.stderr DO
        Wr.PutText(err, msg);
        Wr.Flush(err);
      END;
    EXCEPT
    | Wr.Failure, Thread.Alerted => (* give up *)
    END;
  END DefaultPrint;


VAR
  mutex_g := NEW(MUTEX);
  warnings_g, errors_g := 0;
  print_g: PrintClosure := NEW(DefaultPrintClosure);


PROCEDURE SetPrintClosure(p: PrintClosure): PrintClosure RAISES {} =
  VAR
    old: PrintClosure;
  BEGIN
    LOCK mutex_g DO
      old := print_g;
      print_g := p;
    END;
    RETURN old;
  END SetPrintClosure;


EXCEPTION
  Disaster;


PROCEDURE Print(
    msg: Text.T;
    severity: Severity := Severity.Fatal;
    newline: BOOLEAN := TRUE)
    RAISES {} =
  VAR
    first, second, third: Text.T;
    print: PrintClosure;
  BEGIN
    IF severity = Severity.Continue THEN
      first := "";
    ELSE
      LOCK mutex_g DO
        IF severity = Severity.Warning THEN
          INC(warnings_g);
        ELSIF severity = Severity.Error THEN
          INC(errors_g);
        END;
        first := ProgName.Get() & ": ";
      END;
    END;
    CASE severity OF
    | Severity.Warning => second := "(Warning) ";
    | Severity.Error => second := "(Error) ";
    | Severity.Fatal => second := "(Fatal error) ";
    | Severity.Disaster => second := "(Disaster) ";
    ELSE second := "";
    END;
    IF newline THEN third := "\n" ELSE third := "" END;
    LOCK mutex_g DO print := print_g END;
    print.print(severity, first & second & msg & third);
    IF severity = Severity.Fatal THEN
      RTMisc.Exit(1);
    ELSIF severity = Severity.Disaster THEN
      <*FATAL Disaster*> BEGIN RAISE Disaster; END;
    END;
  END Print;

PROCEDURE Warnings(reset := FALSE): INTEGER RAISES {}=
  BEGIN
    LOCK mutex_g DO
      VAR
        result := warnings_g;
      BEGIN
        IF reset THEN warnings_g := 0 END;
        RETURN result;
      END;
    END; (* lock *)
  END Warnings;


PROCEDURE Errors(reset := FALSE): INTEGER RAISES {}=
  BEGIN
    LOCK mutex_g DO
      VAR
        result := errors_g;
      BEGIN
        IF reset THEN errors_g := 0 END;
        RETURN result;
      END;
    END; (* lock *)
  END Errors;


BEGIN
END Err.