IMPLEMENTATION MODULE Handler;
(*
        Title:          Exception and Event Handling.
        Author:         JCM
        29 Aug 84       Reduce information for missing handler to bare bones.
        31 Aug 84       make exceptions as per specification
        06 Sep 84       cure bug in handler of signals
                        and  introduce InstalPanosHandler
        11 Sep 84       Introduce CallHandler.
        24 Sep 84       Remove Error Class
        25 Sep 84       If no handler for module then call program.stop
                        Disable BBC events on initial push
        26 Sep 84       CallHandler returns error if no handler.
        05 Oct 84       New hardware error facility
        26 Oct 84       Use existing user stack for conditions and events.
        29 Oct 84       Implement user event 255.
*)

FROM String    IMPORT CopyLC ;

FROM SYSTEM    IMPORT ADDRESS,WORD,TKCALL,REGISTER,TSIZE,ADR;
FROM Error     IMPORT ErrorCode,Facility,Panic,HandlerFacilityErrors;
FROM Store     IMPORT Allocate,Deallocate;
FROM TKCalls   IMPORT TKsetEventHandler,TKbyte;

IMPORT Program;
IMPORT DirtyHandler;
IMPORT Debug;
IMPORT Fields;
CONST OkHandled  = 1;
      NotHandled = 0;
(* ========================================================================= *)

PROCEDURE Version( VAR String : ARRAY OF CHAR ) ;
BEGIN
   CopyLC( "Handler         0.01/29  07 Dec 84 16:27:21" , String ) ;
END Version ;

(* ========================================================================= *)

PROCEDURE HandlerError( Error : HandlerFacilityErrors ) : INTEGER;
(* Produce a system error from one of out local ones *)
BEGIN
   RETURN ErrorCode (HandlerFacility,ORD(Error),"")
END HandlerError ;

(* ========================================================================= *)

PROCEDURE NS32000Error( Error : CARDINAL ) : INTEGER;
(* Produce a 32000 hardware error from one of out local ones *)
BEGIN
   RETURN ErrorCode (NS32000Facility,Error,"")
END NS32000Error ;

(* ========================================================================= *)

TYPE ExceptionProc      = PROCEDURE;
TYPE LinkTableEntryPTR  = POINTER TO RECORD
                             LinkEntry:ConditionHandlerType;
                          END;

VAR VirtualDispatchTable : ARRAY ExceptionType OF ExceptionProc ; 


TYPE EventPTR =  POINTER TO EventRecord;
     EventRecord=
        RECORD
            NextEvent : EventPTR;
            HandleOfEvent:CARDINAL;
            EventProc:UserEventHandler;
        END;

TYPE EventDef  = RECORD
                     EventStat:BOOLEAN;
                     EventChain :EventPTR;
                 END;

CONST PanosEventMax = 10;           (* Internally Panos events numbered 0..10*)
CONST UserEventMax  = PanosEventMax-1;(* user events are 0...9 and 255 *)

CONST ConditionStackSize =1024;
CONST EventStackSize     =1024;

TYPE EventFramePTR = POINTER TO EventFrame;
     EventFrame =
       RECORD
          PreviousEventFrame : EventFramePTR;
          EventStackHigh     : ADDRESS;
          ConditionStackHigh : ADDRESS;
          SavedClosure       : UsersEnvironmentPTR;
          Events             : ARRAY [0..PanosEventMax] OF EventDef;
       END;

CONST TKControlEvent= 57;  (* Pandora svc to enable disable Pandora events *)  

      EventDisable  = 13;  (* osbyte to disable BBC events *)
      EventEnable   = 14;  (* osbyte to enable  BBC events *)

VAR CurrentFramePTR:EventFramePTR;

     
CONST HandlerEntry    = -1;
CONST SizeOfLinkEntry =  4; (* four bytes *)

VAR Closure:UsersEnvironment;



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

PROCEDURE Initialise():INTEGER;

   VAR Junk : INTEGER;

   BEGIN
      DirtyHandler.Initialise();
      CurrentFramePTR := NIL; (* there isn't an event environment initially!*)
      IF DirtyHandler.MakeClosure(Closure) THEN
         (*there is one-and all events are disabled*)
         RETURN PushEnvironment(Closure);
      ELSE
         Panic("Handler : LongJump failure");
      END;
   END Initialise;




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

PROCEDURE SignalHandler(VAR EnvExcept:UsersEnvironment;
                        Reason:INTEGER):INTEGER;

VAR TheUsersHandler:ConditionHandlerType;
    res:INTEGER;
    EnvNext:UsersEnvironment;
    CallType:TypeCode;
   BEGIN
     EnvNext := EnvExcept;
     CallType := Except;
     LOOP
        ConditionHandlerOf(TheUsersHandler,CARDINAL(EnvNext.Mod));
(*
Debug.WriteS ("*NAbout to call handler for ");
Debug.WriteH (EnvNext.Mod);
Debug.WriteS (" : ");
Debug.WriteH (EnvNext.PC);
Debug.WriteS ("*N");
Debug.WriteS ("Reason : ");
Debug.WriteH (Reason);
Debug.Writeln;
*)
        res := DirtyHandler.CallConditionProc(TheUsersHandler,
                                              CallType,Reason,
                                              EnvNext,EnvExcept);

        IF res >= 2 THEN res := 0 END;
        IF res < 0 THEN  (*request to exit program*) EXIT  END;
        IF (CallType = Unwind) AND (res = NotHandled) THEN 
           (*if would not Unwind return*) EXIT
        END;
        IF res = NotHandled THEN (*call handler again-ask for Unwind*)
           CallType := Unwind;
        ELSE
          IF CallType = Unwind THEN (*unwind was ok so pass it on*)
             CallType := ExceptPassedOn;
          ELSE (*CallType NOT Unwind*) EXIT             
          END;
        END;
     END; (*END LOOP*)
     (*Return res *)
     RETURN res;
   END SignalHandler;





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

PROCEDURE NoHandler(Type:TypeCode;
                    Error:INTEGER;
                    VAR Env1:UsersEnvironment;
                    VAR EnvExcept:UsersEnvironment):INTEGER;
   BEGIN
 
    Debug.WriteS("*N<<<<  Missing Handler >>>>*N MOD= ");

    Debug.WriteH(Env1.Mod);
    Debug.WriteS(" PC= ");
    Debug.WriteH(Env1.PC);

    Debug.WriteS("*NError Code =");
    Debug.WriteH(Error);
    Debug.WriteS(" MOD= ");
    Debug.WriteH(EnvExcept.Mod);
    Debug.WriteS(" PC= ");
    Debug.WriteH(EnvExcept.PC);
    Debug.WriteS(" SP1= ");
    Debug.WriteH(EnvExcept.SP1);
    Debug.Writeln();

    Program.Stop (Error);

   END NoHandler;




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

PROCEDURE ConditionHandlerOf(VAR ProcResult:ConditionHandlerType;
                             ModuleNumber:CARDINAL);

   VAR LinkTableOffset:INTEGER;
   VAR HandlerEntryPTR:LinkTableEntryPTR;
   VAR  ModRecordPTR:PointerToModuleRecord;

   BEGIN
      ModRecordPTR     := PointerToModuleRecord(ModuleNumber); 
      LinkTableOffset  := INTEGER(ModRecordPTR^.LinkTableBase);
      HandlerEntryPTR  := 
             LinkTableEntryPTR(LinkTableOffset+(HandlerEntry*SizeOfLinkEntry));
      IF INTEGER(HandlerEntryPTR^.LinkEntry) = 0 THEN
         ProcResult    := NoHandler;
      ELSE
         ProcResult    := HandlerEntryPTR^.LinkEntry;
      END;
   END ConditionHandlerOf;




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

PROCEDURE PopEnvironment():INTEGER;

   VAR result:INTEGER;
       tempeventptr:EventPTR;
       eventnumber:INTEGER;
   BEGIN

   DisableEvents();   (*disable all events*)

   (* give back heap taken for the current event environment*)

   (*first give back heap taken for event chain*)
   eventnumber := 0;
   WHILE eventnumber <= PanosEventMax DO
        tempeventptr :=CurrentFramePTR^.Events[eventnumber].EventChain;
        WHILE tempeventptr # NIL DO
           (*give back the space taken for event record*)
           result :=Deallocate(ADDRESS(tempeventptr));
           tempeventptr := tempeventptr^.NextEvent;
        END;
     eventnumber := eventnumber + 1;
  END;

   (*then give back event frame*)
    result :=Deallocate(ADDRESS(CurrentFramePTR));

(*   (* give back space used for Condition stack *)
   result:= Deallocate(ADDRESS(
                               CARDINAL(CurrentFramePTR^.ConditionStackHigh)
                               -ConditionStackSize
                              )
                      );

   (* give back space used for space for Event stack *)
   result:= Deallocate(ADDRESS(
                               CARDINAL(CurrentFramePTR^.EventStackHigh)
                               - EventStackSize
                              )
                      );

  *)

   (* and take the current frame off chain of frames making previous*)
   (* the new current*)
    CurrentFramePTR := CurrentFramePTR^. PreviousEventFrame;


   (*enable or disable events-for program to be resumed*)
      eventnumber := 0;
      WHILE eventnumber < PanosEventMax DO
         IF CurrentFramePTR^.Events[eventnumber].EventStat = TRUE THEN
            (*enable the event*)
            result := TKCALL(TKbyte,EventEnable,eventnumber);
         ELSE(*disable the event*)
            result := TKCALL(TKbyte,EventDisable,eventnumber);
         END;
         eventnumber := eventnumber + 1;
      END;

   RETURN 0;

   END PopEnvironment;




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

PROCEDURE PushEnvironment(VAR Closure:UsersEnvironment):INTEGER;
   VAR result            :INTEGER;
       BlockAddress      :ADDRESS;
       NewFramePTR       :EventFramePTR;
       OldFramePTR       :EventFramePTR;
       eventnumber       :CARDINAL;
       sink              :INTEGER;
       EventRecPTR       :EventPTR;
       UserEventNumber   :CARDINAL;
   BEGIN
   (* give the new program a new event environment*)
   (* ie grab some space from heap for Event Frame,initialise it*)
   (* and make it current.*)
   result:= Allocate(BlockAddress,TSIZE(EventFrame)); 
   IF result < 0 THEN RETURN result END;

   NewFramePTR  := EventFramePTR(BlockAddress);

   IF CurrentFramePTR = NIL THEN
      (* if there is no current environment then *)
      (* event environment of first program has all events null*)
      (* add new to empty chain of event frames  *)

      DisableEvents();   (*disable all events*)

      NewFramePTR^.PreviousEventFrame  := CurrentFramePTR;
      CurrentFramePTR                  := NewFramePTR;
      (*give first program to run an event environment*)
      (*with all event status false and no handler chains*)
      eventnumber   := 0;
      WHILE eventnumber <= PanosEventMax DO
         UserEventNumber := ConvertPanosToUserEventNumber(eventnumber);
         sink            := SetEventStatus(UserEventNumber,FALSE);
         CurrentFramePTR^.Events[eventnumber].EventChain    := NIL;
         eventnumber     := eventnumber + 1;
      END;
   ELSE
      (*New event frame is a copy of 'father' event environment.*)
      (*Point at fathers environment frame*)
      OldFramePTR := CurrentFramePTR ;
      (* add new to chain of event frames - at the front*);
      NewFramePTR^.PreviousEventFrame  := CurrentFramePTR;
      CurrentFramePTR                  := NewFramePTR;
      
      eventnumber := 0;
      WHILE (* A *) eventnumber <= PanosEventMax DO
         UserEventNumber := ConvertPanosToUserEventNumber(eventnumber);
         sink := SetEventStatus( UserEventNumber,
                                 OldFramePTR^.Events[eventnumber].EventStat);
         CurrentFramePTR^.Events[eventnumber].EventChain := NIL;
         EventRecPTR := OldFramePTR^.Events[eventnumber].EventChain;

         WHILE (* B *) EventRecPTR # NIL DO
            result := DeclareEventHandler( EventRecPTR^.EventProc,
                                          UserEventNumber,
                                          0 (*add to end of chain*),
                                          EventRecPTR^.HandleOfEvent);
            IF result < 0 THEN RETURN result END;
            EventRecPTR := EventRecPTR^.NextEvent;
         END (*while B *);
      eventnumber := eventnumber + 1;
      END (*while A *);

   END;

(*   (* take space for Condition stack *)
   result := Allocate(BlockAddress,ConditionStackSize); 
   IF result < 0 THEN RETURN result END;
   CurrentFramePTR^.ConditionStackHigh :=
             ADDRESS( CARDINAL(BlockAddress) +ConditionStackSize );

   (* take space for Event stack *)
   result:= Allocate(BlockAddress,EventStackSize); 
   IF result < 0 THEN RETURN result END;
   CurrentFramePTR^.EventStackHigh :=
             ADDRESS( CARDINAL(BlockAddress) + EventStackSize );
*)  
   CurrentFramePTR^.SavedClosure := ADR( Closure ) ;

   RETURN 0;
   END PushEnvironment;




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

PROCEDURE DeclareEventHandler(NewHandler:UserEventHandler;
                    Event:CARDINAL;
                    Action:CARDINAL;
                    Handle:CARDINAL):INTEGER;

   VAR tempptr          : EventPTR;
       scanptr          : EventPTR;
       result           : INTEGER;
       BlockAddress     : ADDRESS;
       PanosEventNumber : CARDINAL;
   BEGIN
    IF NOT CheckUserEventNumber(Event)THEN
        RETURN HandlerError(IllegalEvent) END;
    IF Action > 2             THEN RETURN HandlerError( IllegalAction  ) END;
    PanosEventNumber := ConvertUserToPanosEventNumber( Event );
    (* take some space for event record *)
     result := Allocate(BlockAddress,TSIZE(EventRecord));
     IF result < 0 THEN RETURN result END;
     (*initialise it*)
     tempptr                := EventPTR(BlockAddress);
     tempptr^.HandleOfEvent := Handle ;
     tempptr^.EventProc     := NewHandler ;

    CASE Action OF
       0: (*put it on end of event chain*)
          (*look for last*)
          scanptr := ADR(CurrentFramePTR^.Events[PanosEventNumber].EventChain);
          WHILE  scanptr^.NextEvent # NIL DO
            scanptr := scanptr^.NextEvent;
          END;
          (*scanptr now points at last in chain*)
          tempptr^.NextEvent := NIL;  (*it is the new last*)
          scanptr^.NextEvent :=tempptr;
    |  1:(*put on start of event chain*)
          (*put it on front of event chain*)
          tempptr^.NextEvent:=
                          CurrentFramePTR^.Events[PanosEventNumber].EventChain;
          CurrentFramePTR^.Events[PanosEventNumber].EventChain :=tempptr;
       
    |  2:(*remove all from entries in event chain amd put this on front*)
        scanptr :=CurrentFramePTR^.Events[PanosEventNumber].EventChain;
        WHILE scanptr # NIL DO
           (*give back the space taken for event record*)
           result :=Deallocate(ADDRESS(scanptr));
           scanptr := scanptr^.NextEvent;
        END;
        tempptr^.NextEvent := NIL;(*this is the last*)
        CurrentFramePTR^.Events[PanosEventNumber].EventChain :=
                                                    EventPTR(BlockAddress);
    END;
   RETURN 0;
   END DeclareEventHandler;



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

PROCEDURE RemoveEventHandler(Handler:UserEventHandler;
                    Event:CARDINAL;
                    Handle:CARDINAL):INTEGER;
   VAR ptr:EventPTR;
       ptrprev:EventPTR;
       found:BOOLEAN;
       result:INTEGER;
       PanosEventNumber : CARDINAL;
   BEGIN
    IF NOT CheckUserEventNumber(Event)THEN
       RETURN HandlerError(IllegalEvent) END;
    PanosEventNumber := ConvertUserToPanosEventNumber( Event );

      (*Search down chain for the instance specified*)
      ptr := CurrentFramePTR^.Events[PanosEventNumber].EventChain;
      ptrprev:= ADR(CurrentFramePTR^.Events[PanosEventNumber].EventChain);
      WHILE (ptr # NIL) AND (NOT found) DO
         found := (ptr^.HandleOfEvent = Handle) AND
          (CARDINAL(ptr^.EventProc) = CARDINAL(Handler));
         IF found THEN (*fantastic*)
         ELSE
        (*point ptrprev at previous*)
         ptrprev :=ptr;
         (*point ptr at next in chain*)
         ptr := ptr^.NextEvent;
        END;
     END;
     (*ptr # NIL then it points at the Event record to be removed*)
     (*and ptrprev points at previous*)
     ptrprev^.NextEvent := ptr^.NextEvent;
     result :=Deallocate(ADDRESS(ptr));
   END RemoveEventHandler;



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

PROCEDURE EventStatus(Event:CARDINAL):INTEGER;
   VAR PanosEventNumber : CARDINAL;
   BEGIN
      IF NOT CheckUserEventNumber(Event)THEN
        RETURN HandlerError(IllegalEvent) END;
      PanosEventNumber := ConvertUserToPanosEventNumber( Event );
      RETURN  INTEGER(CurrentFramePTR^.Events[PanosEventNumber].EventStat);
   END EventStatus;



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

PROCEDURE DisableEvents();
   VAR result:INTEGER;
       eventnumber:INTEGER;
   BEGIN
      eventnumber := 0 ;
      WHILE eventnumber < PanosEventMax DO
        result := TKCALL(TKbyte,EventDisable,eventnumber);
        eventnumber := eventnumber +1;
      END;
   END DisableEvents;



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

PROCEDURE Signal(Cause:INTEGER;Buffer:ADDRESS);
   BEGIN
     DirtyHandler.Signal();
   END Signal;



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

PROCEDURE GetUsersCondStackHigh():ADDRESS;
   BEGIN
      RETURN CurrentFramePTR^.ConditionStackHigh;
   END GetUsersCondStackHigh;




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

PROCEDURE GetUsersEventStackHigh():ADDRESS;
   BEGIN
      RETURN CurrentFramePTR^.EventStackHigh;
   END GetUsersEventStackHigh;




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

PROCEDURE Abandon(Result:INTEGER);
   VAR Closure: UsersEnvironmentPTR;
   BEGIN
    Closure := CurrentFramePTR^.SavedClosure ;
    Closure^.Register[ 0 ] := WORD( Result );
    IF PopEnvironment() < 0 THEN
       Panic("Abandon");
    END;
    DirtyHandler.LongJump(Closure);
    Panic("Not LongJumpped");
   END Abandon;




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

PROCEDURE Lock();
   BEGIN
   END Lock;




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

PROCEDURE Unlock();
   BEGIN
   END Unlock;




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

PROCEDURE SetEventStatus(Event:CARDINAL;Enable:BOOLEAN):INTEGER;
   VAR result           : INTEGER;
       oldstatus        : INTEGER;
       PanosEventNumber : CARDINAL ;
   BEGIN
      IF NOT CheckUserEventNumber(Event)THEN
      RETURN HandlerError(IllegalEvent) END;
      PanosEventNumber := ConvertUserToPanosEventNumber(Event);
      oldstatus:=INTEGER(CurrentFramePTR^.Events[PanosEventNumber].EventStat);
      CurrentFramePTR^.Events[PanosEventNumber].EventStat := Enable;
      (*tell HOST*)
      
      IF Enable THEN
         result := TKCALL(TKbyte,EventEnable,Event);
      ELSE
         result := TKCALL(TKbyte,EventDisable,Event);
      END;
      RETURN  oldstatus;

   END SetEventStatus;




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

PROCEDURE CheckUserEventNumber(UserEventNumber:CARDINAL):BOOLEAN;
   BEGIN
      IF (UserEventNumber > UserEventMax) AND (UserEventNumber # 255) THEN
         RETURN FALSE ;
      ELSE
         RETURN TRUE;
      END
   END CheckUserEventNumber;



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

PROCEDURE ConvertUserToPanosEventNumber(UserEventNumber:CARDINAL): CARDINAL;
   BEGIN
      IF UserEventNumber = 255 THEN 
         RETURN PanosEventMax ;
      ELSE
         RETURN UserEventNumber;
      END;
   END ConvertUserToPanosEventNumber;



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

PROCEDURE ConvertPanosToUserEventNumber(PanosEventNumber:CARDINAL): CARDINAL;
   BEGIN
      IF PanosEventNumber = PanosEventMax THEN
         RETURN  255 ;
      ELSE
         RETURN PanosEventNumber; 
      END;
   END ConvertPanosToUserEventNumber;




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

PROCEDURE PANOSConditionHandler(  t:TypeCode;
                                   i:INTEGER;
                              VAR CurrentEnvironment:UsersEnvironment;
                              VAR EUnused:UsersEnvironment ) :INTEGER;
TYPE FramePTR = POINTER TO RECORD
                    OldFP : ADDRESS;
                    OldPC : ADDRESS;
                    OldMod: ADDRESS;
                END;
VAR Frame : FramePTR ;
VAR tempcard : CARDINAL;
BEGIN

  IF t= Except THEN RETURN 0 END;
  IF t = Unwind THEN
     (*unwind one frame*)
      IF NOT (fp IN CurrentEnvironment.Validity) THEN RETURN 0 END;
      Frame                         :=    FramePTR(CurrentEnvironment.FP);
      CurrentEnvironment.PC         :=    Frame^.OldPC;
      CurrentEnvironment.FP         :=    Frame^.OldFP;
      CurrentEnvironment.Mod        :=    Frame^.OldMod;
      CurrentEnvironment.Validity   :=    RegisterTypes {pc,fp,mod};
     tempcard :=CARDINAL(CurrentEnvironment.Mod);
     Fields.Insert( tempcard,16,31,0);
     CurrentEnvironment.Mod := ADDRESS(tempcard);
     RETURN 1;   (*UNWIND OK*)
     END;
 
     (* except passed on*)
     RETURN 0;

END PANOSConditionHandler ;




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

PROCEDURE InstallPANOSHandler();

   VAR LinkTableOffset:INTEGER;
   VAR HandlerEntryPTR:LinkTableEntryPTR;
   VAR ModRecordPTR:PointerToModuleRecord;
   VAR ModuleNumber:CARDINAL;

BEGIN
   ModuleNumber    := DirtyHandler.CurrentMod();
   ModRecordPTR    := PointerToModuleRecord(ModuleNumber); 
   LinkTableOffset := INTEGER(ModRecordPTR^.LinkTableBase);
   HandlerEntryPTR := 
            LinkTableEntryPTR(LinkTableOffset+HandlerEntry*SizeOfLinkEntry);
   HandlerEntryPTR^.LinkEntry :=PANOSConditionHandler ;

END InstallPANOSHandler;



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

PROCEDURE SystemSignal( Error:INTEGER;NumberOfDoubles:CARDINAL);


(* The real work of this is done in dirtyhandler *)


BEGIN

DirtyHandler.SystemSignal (Error, NumberOfDoubles);

END SystemSignal;





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

PROCEDURE DeclareConditionHandler(ConditionHandler:ConditionHandlerType)
                                  :INTEGER;

VAR LinkTableOffset:INTEGER;
VAR HandlerEntryPTR:LinkTableEntryPTR;
VAR ModRecordPTR:PointerToModuleRecord;
VAR ModuleNumber:CARDINAL;

BEGIN
   ModuleNumber    := DirtyHandler.CurrentMod();
   ModRecordPTR    := PointerToModuleRecord(ModuleNumber); 
   LinkTableOffset := INTEGER(ModRecordPTR^.LinkTableBase);
   HandlerEntryPTR := 
         LinkTableEntryPTR(LinkTableOffset+HandlerEntry*SizeOfLinkEntry);
   HandlerEntryPTR^.LinkEntry := ConditionHandler;
   RETURN 0;

END DeclareConditionHandler;



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

PROCEDURE CallHandler(          Type:TypeCode;
                           Parameter:INTEGER;
                      VAR CurrentEnv:UsersEnvironment;
                      VAR  ExceptEnv:UsersEnvironment):INTEGER;
VAR res:INTEGER;
    TheUsersHandler:ConditionHandlerType;

BEGIN
   ConditionHandlerOf(TheUsersHandler,CARDINAL(CurrentEnv.Mod));
   IF CARDINAL(TheUsersHandler)=CARDINAL(NoHandler) THEN
      RETURN HandlerError(NoHandlerInstalled);
   END;
   res := DirtyHandler.CallConditionProc(TheUsersHandler,
                                         Type,Parameter,
                                         CurrentEnv,ExceptEnv);
   RETURN res;

END CallHandler;




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

PROCEDURE PANOSEventHandler(EventCode:CARDINAL;
                            EventData1:INTEGER;
                            EventData2:INTEGER;
                            VAR Env:UsersEnvironment):INTEGER;

   VAR CurrentFrame:EventPTR;

   BEGIN
   (*entry here from 'DirtyHandler' code*)

    IF  CurrentFramePTR = NIL THEN 
         Debug.WriteS("Current Frame=0-no handler-ret from PANOSEventH..*N");
    ELSE
      (*Now call each handler in chain*)

         CurrentFrame := CurrentFramePTR^.Events[EventCode].EventChain;

       IF CurrentFrame = NIL THEN Debug.WriteS("No EVENT HANDLER*N");
       RETURN -1;
       END;
            REPEAT
               DirtyHandler.CallEventProc(CurrentFrame^.EventProc,
                                          EventCode,EventData1,EventData2,
                                          CurrentFrame^.HandleOfEvent,Env);
               CurrentFrame := CurrentFrame^.NextEvent;
            UNTIL CurrentFrame = NIL;

      RETURN 0;
   END;
   RETURN 0;

END PANOSEventHandler;






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



BEGIN
END Handler.