(**********************************************************************

    :Program.    Exceptions.mod
    :Contents.   Lets you install multiple exception handlers to a task
    :Author.     Nicolas Benezan, Amok [bne]
    :Address.    Postwiesenstr. 2, D7000 Stuttgart 60
    :Phone.      711/333679
    :Copyright.  Public Domain
    :Language.   Modula-2
    :Translator. M2Amiga A+L V3.2d
    :Imports.    TaskMemory [bne]
    :History.    V1.0 [bne] 1.Apr.1989
    :History.    V1.1 [bne] 17.Apr.1989 (+ Add/RemHandler, Dispatch)
    :History.    V1.2 [bne] 19.Apr.1989 (+ CommonMask)
    :History.    V1.3 [bne] 22.Jul.1989 (ScheduleHandlers optimized)
    :History.    V1.4 [bne] 22.Jul.1989 (+ allocation procedures)

**********************************************************************)

IMPLEMENTATION MODULE Exceptions;

FROM Arts        IMPORT StkChk;
FROM Exec        IMPORT Byte, Enqueue, FindTask, List, ListPtr, Node,
                        Remove, SetExcept, TaskPtr, Forbid, Permit;
FROM ExecSupport IMPORT NewList;
FROM TaskMemory  IMPORT Allocate, Deallocate;
FROM SYSTEM      IMPORT ADDRESS, ADR, CAST, LONGSET, REG, SETREG;

CONST
  NodeName="exception";
  AllBits=LONGSET{1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,
                  21,22,23,24,25,26,27,28,29,30,31};

VAR IgnoreOld:LONGSET; (* Dummy *)

PROCEDURE ExceptionServer; (* $S- *)
  VAR
    SchedulePtr:ListPtr;
    RcvdSignals:LONGSET;
  BEGIN
    SchedulePtr:=ADDRESS(REG(9));      (* Task.exceptData in A9 *)
    RcvdSignals:=CAST(LONGSET,REG(0)); (* received Signals in D0 *)
    StkChk(-18);
    IF ScheduleHandlers(SchedulePtr^,RcvdSignals) THEN END;
    SETREG(0,RcvdSignals); (* restore D0 *)
  END ExceptionServer; (* $S= *)

PROCEDURE ScheduleHandlers(Schedule: List;
                           Signals: LONGSET): BOOLEAN;
  VAR
    Handler: HandlerNodePtr;
    SignalMask: LONGSET;
  BEGIN
    Handler:=ADDRESS(Schedule.head);
    WHILE (Handler^.node.succ#NIL) DO
      WITH Handler^ DO
        SignalMask:=Signals*sigMask;
        IF (SignalMask#LONGSET{}) AND NOT handler(SignalMask, userData) THEN
          RETURN FALSE
        END;
        Handler:=ADDRESS(node.succ);
      END;
    END;
    RETURN TRUE
  END ScheduleHandlers;

PROCEDURE InstallExcept(Handler:HandlerProc;
                        SignalMask:LONGSET;
                        DataPtr:ADDRESS;
                        Priority:Byte):HandlerNodePtr;
  VAR
    Task:TaskPtr;
    SchedulePtr:ListPtr;
    NewNode:HandlerNodePtr;
  BEGIN
    Task:=FindTask(NIL);
    SchedulePtr:=Task^.exceptData;
    NewNode:=InstallHandler(SchedulePtr^,Handler,SignalMask,DataPtr,Priority);
    IF NewNode#NIL THEN
      IgnoreOld:=SetExcept(SignalMask,SignalMask);
    END;
    RETURN NewNode;
  END InstallExcept;

PROCEDURE InstallHandler(VAR Schedule:List;
                             Handler:HandlerProc;
                             SignalMask:LONGSET;
                             DataPtr:ADDRESS;
                             Priority:Byte):HandlerNodePtr;
  VAR
    NewNode:HandlerNodePtr;
  BEGIN
    ExceptAllocProc(NewNode,SIZE(HandlerNode));
    IF NewNode#NIL THEN
      WITH NewNode^ DO
        WITH node DO
          pri:=Priority;
          name:=ADR(NodeName);
        END;
        sigMask:=SignalMask;
        handler:=Handler;
        userData:=DataPtr;
      END;
      Enqueue(ADR(Schedule),NewNode);
    END;
    RETURN NewNode;
  END InstallHandler;

PROCEDURE RemoveExcept(Handler:HandlerNodePtr);
  VAR
    Task:TaskPtr;
    HandlerList:ListPtr;
    SignalMask:LONGSET;
  BEGIN
    Task:=FindTask(NIL);
    HandlerList:=Task^.exceptData;
    RemoveHandler(Handler);
    IgnoreOld:=SetExcept(CommonMask(HandlerList^),AllBits);
  END RemoveExcept;

PROCEDURE RemoveHandler(Handler:HandlerNodePtr);
  BEGIN
    Forbid;
    Remove(Handler);
    Permit;
    ExceptDeallocProc(Handler);
  END RemoveHandler;

PROCEDURE InitTaskExceptions():BOOLEAN;
  VAR
    Task:TaskPtr;
    HandlerList:ListPtr;
  BEGIN
    IgnoreOld:=SetExcept(LONGSET{},AllBits);
    Task:=FindTask(NIL);
    ExceptAllocProc(HandlerList,SIZE(List));
    IF HandlerList#NIL THEN
      NewList(HandlerList);
      Task^.exceptData:=HandlerList;
      Task^.exceptCode:=ExceptionServer;
      RETURN TRUE;
    ELSE
      RETURN FALSE;
    END;
  END InitTaskExceptions;

PROCEDURE CommonMask(Schedule:List):LONGSET;
  VAR
    Mask:LONGSET;
    Node:HandlerNodePtr;
  BEGIN
    Mask:=LONGSET{};
    Node:=ADDRESS(Schedule.head);
    WHILE Node^.node.succ#NIL DO
      Mask:=Mask+Node^.sigMask;
      Node:=ADDRESS(Node^.node.succ);
    END;
    RETURN Mask;
  END CommonMask;

BEGIN
  ExceptAllocProc:=Allocate;
  ExceptDeallocProc:=Deallocate;
END Exceptions.