!
%SYSTEMROUTINESPEC CONSOLE(%INTEGER EP, %INTEGERNAME ADR, LEN)
%SYSTEMROUTINESPEC MOVE(%INTEGER BYTES, FROM, TO)
%SYSTEMROUTINESPEC REROUTE CONTINGENCY(%INTEGER CLASS, SUBCLASS,  %C
      %LONGINTEGER MASK, %ROUTINENAME RR, %INTEGERNAME FLAG)
%EXTERNALINTEGERFNSPEC READ ID(%INTEGER ADR)
%EXTERNALROUTINESPEC DRESUME(%INTEGER LNB, PC, ADR)
%EXTERNALINTEGERFNSPEC DISC ID
%SYSTEMROUTINESPEC ITOE(%INTEGER ADDR, LEN)
%SYSTEMSTRINGFNSPEC ITOS(%INTEGER I)
%EXTERNALROUTINESPEC ECTM ENTER(%STRING(31) NAME)
%EXTERNALROUTINESPEC ECTM RESULT(%INTEGER RC)
!
! Contingency handling routines
!
%OWNLONGINTEGER NIL = -1
%OWNINTEGER LONG DESC = X'30000000'
%OWNINTEGER LENGTH MASK = X'00FFFFFF'
!
%OWNINTEGER CONTINUE = 0, QOUTSTANDING = 0, SAVE TYPE, SAVE SUBTYPE
%OWNINTEGER QINHIBIT
%OWNLONGINTEGERARRAY TRAP DESC(0:2) = -1(3)
%OWNINTEGERARRAY SAVE AREA(1:18)
!
%ROUTINE TRAP(%INTEGER TYPE, SUBTYPE)
!
! General interrupt trap - intercepts all relevant contingencies
! and reroutes them to the user-nominated routine, if any.
!
%LONGINTEGER DESC
%OWNLONGINTEGER MESS
%INTEGER CLASS, RC, DR0, DR1
!
SAVE TYPE = TYPE
SAVE SUBTYPE = SUBTYPE
%IF TYPE = 65 %THEN %START
      ITOE(ADDR(SUBTYPE)+3,1)
      TYPE = 50
      CLASS = 2
      %FINISH  %C
%ELSE %START
      SUBTYPE = X'07777777'
      CLASS = 0
      %FINISH
%UNLESS QOUTSTANDING = 1 %THEN %START
      RC = READ ID(ADDR(SAVE AREA(1)))
      CONTINUE = 1
      %IF RC > 0 %THEN SUBTYPE = SUBTYPE ! X'08000000' %AND CONTINUE = 0
      %FINISH
%IF QINHIBIT = 1 %THEN %START
      QOUTSTANDING = 1
      %IF CONTINUE = 1 %THEN DRESUME(0,0,ADDR(SAVE AREA(1)))
      %STOP
      %FINISH
%IF TRAP DESC(CLASS) = NIL %THEN %START
      SELECT OUTPUT(0)
      PRINT STRING("Contingency type ".ITOS(TYPE))
      %UNLESS SUBTYPE > 255 %THEN  %C
         PRINT STRING(", subtype ".ITOS(SUBTYPE&X'000000FF'))
      NEW LINE
      %FINISH  %C
%ELSE %START
      DESC = TRAP DESC(CLASS)
      INTEGER(ADDR(MESS)) = SUBTYPE
      INTEGER(ADDR(MESS)+4) = TYPE
      DR0 = LONG DESC ! 1
      DR1 = ADDR(MESS)
      *PRCL_   4
      *LSS_    DR0
      *ST_     %TOS
      *LSS_    DR1
      *ST_     %TOS
      *LD_     DESC
      *RALN_   7
      *CALL_   (%DR)
      %FINISH
%IF QOUTSTANDING = 1 %THEN %RETURN
%IF CONTINUE = 1 %THEN DRESUME(0,0,ADDR(SAVE AREA(1)))
%STOP
%END
!
%EXTERNALROUTINE ECTM INHIBIT
QINHIBIT = 1
%END
!
%EXTERNALROUTINE ECTM ALLOW
!
%INTEGER I
!
CONSOLE(9,I,I)
QINHIBIT = 0
%IF QOUTSTANDING = 1 %THEN TRAP(SAVE TYPE, SAVE SUBTYPE)
QOUTSTANDING = 0
%END
!
%EXTERNALINTEGERFN ECTM SET TRAP
!
! Called from INITIALISE CTM, this routine sets up a contingency
! trap via the subsystem to reroute all program errors and all
! terminal interrupts except the EMAS standard INT:'s A, C, T, W, X, Y.
!
%INTEGER FLAG
!
!REROUTE CONTINGENCY(4,0,X'0000000000003DFF',TRAP,FLAG)
!%IF FLAG > 0 %THEN %RESULT = FLAG
REROUTE CONTINGENCY(2,65,X'FFFFFFFFFFFFFFFF',TRAP,FLAG)
%IF FLAG > 0 %THEN %RESULT = FLAG
REROUTE CONTINGENCY(3,65,X'FFFFFFFFFC6FFFF5',TRAP,FLAG)
%RESULT = FLAG
%END
!
%EXTERNALINTEGERFN CTM INFORM(%INTEGER CLASS,  %C
      %LONGINTEGER PROCEDURE, %INTEGER MASK, IC LIMIT)
%INTEGER RC
!
ECTM ENTER("INFORM") 
%IF CLASS & X'80000000' # 0 %THEN TRAP DESC(0) = PROCEDURE
%IF CLASS & X'40000000' # 0 %THEN TRAP DESC(1) = PROCEDURE
%IF CLASS & X'20000000' # 0 %THEN TRAP DESC(2) = PROCEDURE
RC = 0 %AND -> RETURN
!
RETURN:
ECTM RESULT(RC)
%RESULT = RC
%END
!
%EXTERNALINTEGERFN CTM DISCARD ID
!
%INTEGER RC
!
ECTM ENTER("DISCARD ID")
CONTINUE = 0
RC = 0 %AND -> RETURN
!
RETURN:
ECTM RESULT(RC)
%RESULT = RC
%END
!
%EXTERNALINTEGERFN CTM READ ID(%INTEGER DATA DR0, DATA DR1,  %C
      LENGTH DR0, LENGTH DR1)
!
%INTEGER RC, LEN
!
ECTM ENTER("READ ID")
LEN = DATA DR0 & LENGTH MASK
%IF LEN > 18 %THEN LEN = 18
MOVE(LEN*4,ADDR(SAVE AREA(1)),DATA DR1)
INTEGER(LENGTH DR1) = LEN
RC = 0
-> RETURN
!
RETURN:
ECTM RESULT(RC)
%RESULT = RC
%END
!
%ENDOFFILE