Topspeed_JPI/TS-V3/MODBASE/ERRORMAN.MOD

IMPLEMENTATION MODULE ErrorManager;
(*
 *  REPERTOIRE
 *  Release 1.6
 *  By Charles Bradford and Cole Brecheen
 *  (c) Copyright 1985-1992 PMI
 *  Green Bay, Wisconsin
 *  All rights reserved
 *  (414) 468-6040
 *
 *  $Header:   D:/logfiles/mods/errorman.mov   1.8   10 Mar 1991 15:27:10   coleb  $
 *
 *)


IMPORT KbdInput;
IMPORT LowLevel;
IMPORT M2Strings;
IMPORT StrConv;
IMPORT StrEdit;
IMPORT StringIO;
IMPORT SYSTEM;
IMPORT FAPI;
IMPORT VStorage;

VAR
  Initialized : BOOLEAN;

CONST
  MaxStaticProcs = 8;
TYPE
  AProcRecPtr = POINTER TO AProcRec;
  AProcRec =
    RECORD
      TheProc: ATermProc;
      prv: AProcRecPtr;
      fromblock: BOOLEAN;
    END;

VAR
  TermProcStackTop : AProcRecPtr;
  TermProcsDoneOnce: BOOLEAN;
    (*This keeps us from getting in trouble with recursive calls
      to DoTermProcs.*)
  ErrorReturn : CARDINAL;
  Aborting: BOOLEAN;
    (*And this prevents recursive calls to WARN.*)
  StaticProcs : ARRAY [1..MaxStaticProcs] OF AProcRec;
    (*We have this StaticProcs array because certain Repertoire
      modules need to add TermProcs in their initialization
      blocks, which are executed before the user tells us where
      DOS memory is coming from.  We can't allocate new elements
      of the TermProcList until we can get memory. *)
  ProcCount : CARDINAL;


  PROCEDURE CallHalt( TheMessage: ARRAY OF CHAR );
    BEGIN
      IF Aborting THEN
        RETURN
      ELSE
        Aborting := TRUE;
      END;
      IF (M2Strings.Length( TheMessage ) > 0) THEN
        IF NOT AbortConfirmed( TheMessage ) THEN
          Aborting := FALSE;
          RETURN;
        END;
      END;
      DoTermProcs();
      HALT();
    END CallHalt;


  PROCEDURE DefaultWarnNumber( TheMessage: ARRAY OF CHAR;
      TheErrorNum: CARDINAL );
    VAR
      tmpstr: ARRAY [0..79] OF CHAR;
    BEGIN
      StrConv.CardinalToStr( TheErrorNum, 0, tmpstr );
      M2Strings.Insert( ' ', tmpstr, 0 );
      M2Strings.Insert( TheMessage, tmpstr, 0 );
      WARN( tmpstr );
    END DefaultWarnNumber;

  PROCEDURE StraightToDOS( TheMessage: ARRAY OF CHAR );
    BEGIN
      IF Aborting THEN
        RETURN
      ELSE
        Aborting := TRUE;
      END;
      IF (M2Strings.Length( TheMessage ) > 0) THEN
        IF NOT AbortConfirmed( TheMessage ) THEN
          Aborting := FALSE;
          RETURN;
        END;
      END;
      DoTermProcs();
      FAPI.DOSEXIT(0, 0);
    END StraightToDOS;


  PROCEDURE DoTermProcs();
    VAR
      LocalProcRecPtr: AProcRecPtr;
      count : CARDINAL;
    BEGIN
      IF TermProcsDoneOnce OR (TermProcStackTop = NIL) THEN
        RETURN
      ELSE
        TermProcsDoneOnce := TRUE;
      END;
      LocalProcRecPtr := TermProcStackTop;
      WHILE LocalProcRecPtr # NIL DO
        LocalProcRecPtr^.TheProc();
        LocalProcRecPtr := LocalProcRecPtr^.prv;
          (* We don't attempt to deallocate the TermProc list as
             we go, because it's about to be released to the
             operating system anyway. *)
      END;
    END DoTermProcs;


  PROCEDURE AddTermProc( TheTermProc: ATermProc );
    VAR
      LocalProcRecPtr: AProcRecPtr;
        (* Although it may look like a mistake for this to be local,
           the object to which it points will be on the heap, and
           that's what we're adding to the TermProcStack, not the
           pointer itself. *)
    BEGIN
      INC(ProcCount);
      IF ProcCount <= MaxStaticProcs THEN
        StaticProcs[ ProcCount ].TheProc := TheTermProc;
        LocalProcRecPtr := SYSTEM.ADR(StaticProcs[ ProcCount ]);
        LocalProcRecPtr^.fromblock := TRUE;
      ELSE
        VStorage.DosAlloc( LocalProcRecPtr, SYSTEM.TSIZE(AProcRec) );
        LocalProcRecPtr^.fromblock := FALSE;
      END;
      LocalProcRecPtr^.TheProc := TheTermProc;
      LocalProcRecPtr^.prv := TermProcStackTop;
      TermProcStackTop := LocalProcRecPtr;
    END AddTermProc;


  PROCEDURE RemoveTermProc(TheTermProc: ATermProc);
    VAR
      LocalProcRecPtr, nxt: AProcRecPtr;
    BEGIN
      LocalProcRecPtr := TermProcStackTop;
      nxt := NIL;
      WHILE (LocalProcRecPtr # NIL) AND
          (SYSTEM.ADDRESS(LocalProcRecPtr^.TheProc) #
           SYSTEM.ADDRESS(TheTermProc)) DO
        nxt := LocalProcRecPtr;
        LocalProcRecPtr := LocalProcRecPtr^.prv;
      END;
      IF LocalProcRecPtr = NIL THEN
        RETURN;
      END;
      IF (LocalProcRecPtr = TermProcStackTop) THEN
        TermProcStackTop := LocalProcRecPtr^.prv;
      END;
      IF nxt # NIL THEN
        nxt^.prv := LocalProcRecPtr^.prv;
      END;
      LocalProcRecPtr^.prv := NIL;
      LocalProcRecPtr^.TheProc := ATermProc(NIL);
      IF NOT LocalProcRecPtr^.fromblock THEN
        VStorage.DosDealloc( LocalProcRecPtr, SYSTEM.TSIZE(AProcRec) );
      END;
    END RemoveTermProc;


  PROCEDURE DefaultConfirm( TheMessage: ARRAY OF CHAR ): BOOLEAN;
    VAR
      dummy: ARRAY [0..255] OF CHAR;
    BEGIN
      M2Strings.Assign( TheMessage, dummy );
      StrEdit.Append( dummy, '. Press C to continue, anything else to abort.' );
      StringIO.WriteEol( StringIO.ErrorOutp, '' );
      StringIO.WriteEol( StringIO.ErrorOutp, dummy );
      RETURN KbdInput.CAPkey( KbdInput.KeyHit(KbdInput.AnyKeyNum) ) # ORD('C');
    END DefaultConfirm;


  PROCEDURE InitStatProcs();
  (* Initialize the StaticProcs array. *)
    VAR
      i: CARDINAL;
    BEGIN
      FOR i := 1 TO (MaxStaticProcs - 1)  DO
        StaticProcs[i].prv := SYSTEM.ADR(StaticProcs[i+1]);
        StaticProcs[i].fromblock := TRUE;
        StaticProcs[i].TheProc := ATermProc(NIL);
      END;
      StaticProcs[MaxStaticProcs].prv := NIL;
      StaticProcs[MaxStaticProcs].fromblock := TRUE;
      StaticProcs[MaxStaticProcs].TheProc := ATermProc(NIL);
    END InitStatProcs;


PROCEDURE Init();
  BEGIN
    IF Initialized THEN
      RETURN;
    ELSE
      Initialized := TRUE;
    END;
    KbdInput.Init();
    LowLevel.Init();
    M2Strings.Init();
    StrConv.Init();
    StrEdit.Init();
    StringIO.Init();
    VStorage.Init();

    KbdInput.Init();
    Aborting := FALSE;
    TermProcStackTop := NIL;
    TermProcsDoneOnce := FALSE;
    WARN := CallHalt;
    WarnNumber := DefaultWarnNumber;
    AbortConfirmed := DefaultConfirm;
    ProcCount := 0;
    InitStatProcs();
  END Init;


BEGIN
  Initialized := FALSE;
  Init();
END ErrorManager.