!TITLE Contingency Handling
! The contingency scheme works as follows. If the subsystem has not
! called PRIME CONTINGENCY, and a contingency occurs, then the process
! is stopped with an Oper message SIGNAL FAIL 1. If PRIME CONTINGENCY
! has been called, the ONTRAP routine is executed, with LNB set to the
! value of SF at the time of the contingency, and SF set 7 words higher.
! (If there is deemed to be insufficient space above SF to execute the
! ONTRAP routine, LNB is set to a suitably lower value. In this case an
! "OFF STACK TOP" contingency (Class 67) is generated. The ONTRAP
! routine should be declared to have two integer parameters CLASS and
! SUBCLASS. CLASS will be set (by Director when it calls the routine)
! according to the table below.
!
! SUBCLASS will normally be zero, except as shown below:
!
! (i) for single-character INT: messages (Class 65) it contains the
! INT: character.
!
! (ii) for text messages (Class 66), if non-zero, it contains two
! half-word pointers, being offsets of the first byte and byte
! after last byte of a broadcast text message in the file
! VOLUMS.BROADCAST.
!
! (iii) for "off stack top" (Class 67) it is the Class of the original
! contingency.
!
! (iv) for a System Call error (Class 16) it is
!
! 0 I-value out of range
! 1 J-value out of range
! 2 ACR check (insufficient privilege)
! 3 New stack invalid (validate fails, SSN+1 not resident, or
! new stack=current stack)
! 4 Task call (not implemented)
! 5 Invalid inward return
! 33 ACR check (outward call ACR < current ACR, or inward call
! ACR > current ACR)
! 34 Invalid code or PLT descriptor in SCT entry.
!
! Once PRIME CONTINGENCY has been called, the ONTRAP routine environment
! remains recorded, and is invoked on the specified contingencies until
! a further call of PRIME CONTINGENCY specifies a different ONTRAP
! routine or until a call of DRESET CONTINGENCY (see below) causes the
! first-set ONTRAP routine environment (if any) to be reinstated.
!
! However, before the ONTRAP routine can be re-invoked for a further
! contingency after a contingency has occurred, the function DRESUME
! (see below) must be called. Indeed, occurrence of a further
! synchronous interrupt, other than "instruction counter", before DRESUME
! is called will cause repeated contingencies, culminating in a SIGNAL
! FAIL 3 (signal loop stop). Execution of the ONTRAP routine will
! normally be followed by a call of READ ID (read interrupt data,
! described below), which gives details of the process environment at the
! time of the contingency, and then a call of DRESUME.
!
! If an asynchronous interrupt has occurred and the ONTRAP routine is
! entered, further asynchronous interrupts are inhibited until a call of
! DRESUME is made. Inhibited asynchronous interrupts are queued up to a
! current maximum of 4, after which they are discarded, with a main Oper
! message MESSAGE LOST.
!
! Note that, at process start-up, asynchronous messages are inhibited
! until the subsystem calls DRESUME, LNB=-2. Also note that only
! asynchronous contingencies can be queued.
!
! Contingency CLASS
!
! Floating overflow 0
! Floating underflow 1
! Fixed overflow 2
! Decimal overflow 3
! Zero divide 4
! Bound check 5
! Size error 6
! B overflow 7
! Stack error 8
! Privilege 9
! Descriptor 10
! String 11
! Instruction 12
! Accumulator 13
! System Call 16
! Instruction counter 17
! Disc transfer fail 18
! Block wrong length 19
! ("should not occur")
! Hard store fault 20
! Illegal OUT 21
! Local Controller error 22
! Virtual store error 32
! Instruction counter 64
! Single-character "INT:" 65
! Text message 66
! Off stack top 67
!
! Failures on the Signal Stack
! ----------------------------
!
! Director sometimes fails on the 'signal stack' for one of the following
! reasons:
!
!
conststring (36)array SIGFAIL(1:16) = C
"1 NO CONTINGENCY INFO",
"2 PROGERR IN ONTRAP RT",
"3 SIGNAL LOOP STOP",
"4 FINAL IC INTERRUPT",
"5 INT STACK OVERFLOW",
"6 DIRECTOR FAILED",
"7 ILLEGAL RESUME (LNB TOO HIGH)",
"8 ILLEGAL RESUME (NOT STACK 1)",
"9 ILLEGAL RESUME (AFTER VSERROR)",
"10 ILLEGAL RESUME (NOT FROM ONTRAP)",
"11 SHOULD NOT OCCUR",
"12 INVALID UNINHIBIT",
"13 XST RECEIVED",
"14 ST RECEIVED",
"15 TOO MANY LOST MESSAGES",
"16 DSTOP on user stk. (Not an error)"
!
!<DASYNCINH
externalintegerfn DASYNC INH(integer ACT, ADR2)
!
! This procedure supplies a subsystem with a means of inhibiting
! asynchronous contingencies for short periods of time (such as that
! required for updating critical tables). A call with ACT=0 is used to
! initialise the arrangements for inhibiting contingencies, ADR2 must be
! the address of two words permanently available in read and write modes
! to Director (if the words are, or become, inaccessible, Director treats
! asynchronous contingencies as though this call had not been made).
!
! The first of the two words is inspected by Director whenever an
! asynchronous contingency is received. The contingency is queued if the
! word is positive, otherwise it takes immediate effect. The second word
! is updated (if accessible) by Director whenever an asynchronous message
! is received and whenever one is un-queued, the word contains the number
! of messages currently queued, and may be inspected by the subsystem,
! for example when it wishes to uninhibit contingencies by setting the
! first word to zero. If the second word is positive it may then choose
! to invoke the queued contingency, by calling
! DASYNC INH(1,0)
!>
! ACT = 0 SET USER-INHIBIT FEATURE
! 1 PROVOKE A Q'D ASYNC INT
RESULT =8 UNLESS 0<=ACT<=1
IF ACT=0 THEN UINH AD=ADR2 ELSE DRESUME(-3,0,0)
RESULT =0
END ; ! DASYNC INH
!
!-----------------------------------------------------------------------
!
EXTERNALINTEGERFN D SET INT MESSAGE(STRING (255)S)
RESULT = 53 IF UINF_REASON # INTER
IOSTAT_INTMESS <- S
RESULT = 0
END
!
!-----------------------------------------------------------------------
!
ROUTINE LMSG(STRING (255) S)
WRSS("SIGNAL ------------- ", S)
END ; ! LMSG
!
!-----------------------------------------------------------------------
!
ROUTINE SET BAD PAGE(INTEGER INTPARAM)
INTEGER SEG,RELP,RELK,J,DA,ENT,REL EPG IN SEG,REL EPG IN BLK
SEG=INTPARAM>>18
RELK=(INTPARAM>>10)&X'FF'; ! offset in Kbytes from SEG
REL EPG IN SEG=RELK//EPAGE SIZE
REL EPG IN BLK=REL EPG IN SEG&(BLKSI-1)
RELP=0
DA=0
ENT=SST(SEG)
!
UNLESS ENT = ENDSST START
ENT = ENT + 1 UNLESS REL EPG IN SEG < BLKSI
DA = CBTA(ENT)_DA + REL EPG IN BLK
J = BAD PAGE(1, DA>>24, DA<<8>>8) UNLESS DA = 0
FINISH
END ; ! SET BAD PAGE
!
!-----------------------------------------------------------------------
!
STRINGFN TIM(INTEGER SECS)
INTEGER MINS
STRING (31) WK1
MINS=SECS//60
SECS=SECS - MINS*60
WK1=""
IF MINS>0 THEN WK1=ITOS(MINS)."M "
RESULT =WK1.ITOS(SECS)
END ; ! TIM
!
!-----------------------------------------------------------------------
!
INTEGERFN UIVAL
RESULT = 0 IF UINH AD & 3 > 0
!
RESULT = 0 UNLESS UINH AD >> 18 = 34 ORC
X'100000' <= UINH AD < X'107000'
!
RESULT = VAL(UINH AD, 8, 1, 0)
END ; ! UIVAL
!
!-----------------------------------------------------------------------
!
!
EXTERNALROUTINE SIGNAL
! ACTIVATED BY LOCAL CONTROLLER FOR 3 REASONS
INTEGER SSNP1AD,SIGWORD,STKNO,WAITSNO,J,K,DACT,A3,LNB,PC,STK LIM
INTEGER ERRTYPE,DIRFAIL,PSRHERE,REASON,STK1PSR,SSNAD
INTEGER LNB AT FAIL,INTPARAM,CLASS,SUBCLASS,CONTPC
INTEGER OPERNO,RLNBSEG,RSFSEG
!
RECORDFORMAT SIGOUTPF(RECORD (PARMF) P, C
INTEGER ERRTYPE,STKNO,SSNAD,WAITSNO)
!
STRING (255) S,S1,S2
!
ROUTINESPEC PRINT DUMPS
!
RECORDFORMAT OBJF(INTEGER NEXTFREEBYTE,CODERELST,GLARELST,LDRELST)
RECORD (OBJF)NAME H
RECORD (ACF)NAME ACCTS
RECORD (PARMF)NAME P
RECORD (PARMF)NAME DP
RECORD (SIGOUTPF)NAME PP
RECORD (PARMF)NAME PS
RECORD (PARMF)ASYNCM
!
RECORD (SIGOUTPF)COPY SIGOUTP
!
OWNINTEGER LOOPCOUNT=0
OWNINTEGER LOSTCOUNT = 0
!
!
OWNRECORD (PARMF)ARRAY AMS(0:3)
OWNINTEGER IN,NEXT
!
RECORD (RF)NAME R
RECORDFORMAT DISPLAF(INTEGER PREVLNB,LK0,LK1,PLT0,PLT1, C
CLASS,SUBCLASS)
RECORD (DISPLAF)NAME DISPLAY
!
CONSTSTRING (8)ARRAY ASTYPE(0:TOPASACT)= C
"INVALID", "INT: MSG", "RESUME", "TEXT MSG",
"UNINHIB", "DIR MSG", "NULL ACT", "USECOUNT",
"CLOSEMSG", "INTER"
SWITCH ASACT(0:TOPASACT)
SWITCH POST ACT(1 : 11)
!
!
CONSTSTRING (24)ARRAY PEI(0:TOPEI) = C
"Floating point overflow",
"Floating point underflow",
"Fixed point overflow",
"Decimal underflow",
"Zero divide",
"Bound check",
"Size",
"B overflow",
"Stack",
"Privilege",
"Descriptor",
"String",
"Instruction",
"Accumulator",
"Esr errors",
"--15--",
"System call",
"Instruction counter",
"Disc transfer fail",
"Block wrong length",
"Hard store fault",
"Illegal OUT",
"Local Controller Error"
!
!
SWITCH TYPE(1:3)
!
ROUTINE OPER(INTEGER SRCE,STRING (255)S)
RECORD (PARMF)NAME P
INTEGER L
SRCE = X'320007' IF SRCE>>8 = 0; ! JUST IN CASE I FORGOT !
P == RECORD(OUTPAD)
!
WRSS("SIGOP: ", S)
!
CYCLE
P = 0
P_DEST = SRCE
P_S <- S
*OUT_6
L = LENGTH(S) - 23
RETURN UNLESS L > 0
LENGTH(S) = L
MOVE(L, ADDR(S)+24, ADDR(S)+1)
REPEAT
END ; ! OF LOCAL VERSION OF OPER WHICH REPLIES TO CALLER
!
!-----------------------------------------------------------------------
!
ROUTINE PRINTREGS
INTEGER J
INTEGERNAME I
CONSTSTRING (3)ARRAY PRE(0:12) = "LNB", "PSR", "PC ", "SSR", "SF ",
"IT ", "IC ", "CTB", "XNB", "B ", "DR ", "", "ACC"
LMSG("CONTINGENCY OCCURRED")
!
CYCLE J = 0, 1, 15
I == INTEGER(SSNP1AD + J << 2)
IF J # 11 AND J < 13 START
NEWLINE
PRINTSTRING(PRE(J))
FINISH
SPACE
PRHEX(I)
REPEAT
NEWLINE
END ; ! OF PRINTREGS
!
!-----------------------------------------------------------------------
!
BACK IN:
OUTPAD=SIGOUTP0
DP == RECORD(DIROUTP0); ! The DIROUT record
PP==RECORD(SIGOUTP0)
COPY SIGOUTP=PP
PP==COPY SIGOUTP
P==RECORD(ADDR(COPY SIGOUTP))
INTPARAM=P_P1
ERRTYPE=PP_ERRTYPE
STKNO=PP_STKNO; ! 1 = LOCAL 4, 2 = SIG STACK LOCAL 6, 3 = USER STACK (UP TO SS)
SSNAD=PP_SSNAD
WAITSNO=PP_WAITSNO
IF PROCUSER="DIRECT" THEN LOG ACTION=LOG ACTION ! LOG
SIGWORD=SIGMO
SSNP1AD=SSNAD + 1<<18
DIRFAIL=0
S1=""
LOOPCOUNT=LOOPCOUNT + 1
!
IF LOOPCOUNT>=SIGLOOPSTOP START
IF LOOPCOUNT>SIGLOOPSTOP THEN DSTOP(2)
REASON=3
-> MON OUT
FINISH
!
!
!
SUBCLASS=0
R==RECORD(SSNP1AD); ! REGISTER SET IN OLD SSN+1
!
IF ONTRAP=0 START
SAVE DIROUTP = DP
RESUMEREGS=R
RESUMEWAIT=WAITSNO
RESUMESTACK=STKNO
FINISH
!
UNLESS SIGWORD & 2 = 0 START
PREC("SIGNAL: ", P, 1)
WRSN(" ERRTYPE ", ERRTYPE)
FINISH
!
PRINTREGS IF SIGWORD&64#0
-> TYPE(ERRTYPE)
!-----------------------------------------------------------------------
TYPE(1):! VIRTUAL STORE ERROR
S1="VIRTUAL STORE ERROR, PARAMETER=".HTOS(INTPARAM,8)
CLASS=32; ! JOBBER-DEFINED
SUBCLASS=INTPARAM
VSERR=1; ! USED TO PREVENT STRAIGHT RESUMPTION AFTER VS ERROR
-> DIAGNOSE
TYPE(2):! PROGRAM ERROR
CLASS=INTPARAM&X'7F'
SUBCLASS=(INTPARAM>>8) & 255
S1="PROGRAM ERROR, PARAMETER=".HTOS(INTPARAM,8). C
" CLASS=".ITOS(CLASS)."/".ITOS(SUBCLASS)." "
S1=S1.PEI(CLASS) IF CLASS<=TOPEI
! EXCLUDE ARITHMETIC EXCEPTIONS FROM CONTINGENCY LOOP COUNT
IF CLASS<=4 THEN LOOPCOUNT=LOOPCOUNT - 1
IF CLASS=18 THEN SET BAD PAGE(INTPARAM); ! disc transfer fail, INTPARAM=VA of the page
-> DIAGNOSE
!------------------------------ ASYNCHRONOUS INTERRUPT ---------------
!
TYPE(3): ! ASYNCHRONOUS INTERRUPT
LOOP COUNT=LOOP COUNT - 1
DACT=P_DEST&X'FFFF'
UNLESS 0<DACT<=TOPASACT THEN DACT=0
!
IF SIGWORD&64#0 START
WRSS("Async int received, SIGOUTP TYPE = ", ASTYPE(DACT))
DDUMP(ADDR(COPY SIGOUTP),ADDR(COPY SIGOUTP)+48,-1,-1)
PRINT DUMPS
FINISH
!
OPERNO=0
! LNB AT FAIL is required only so that SIGMON can be used to get a
! dump of the stack asynchronously.
LNB AT FAIL=R_LNB
CLASS=99; ! not required, but otherwise unassigned, and confusing
! Remember here that we may be in the process of shuffling the CBT
! (not implemented at Feb 80). Make sure that actions which are not
! inhibited do not refer to any VM other than Dir code, Dir GLA, stack
! or sig stack.
-> ASACT(DACT)
!
ASACT(INTDACT): ASACT(TXTDACT): ! INT MSG, TXT MSG
ASACT(CLODACT): ! CLOSE MSG
ASACT(9): ! receive class 68 int, twixt process
QUEUE IT:
IF AQD>MAXM1 START
OPER(OPERNO,"MESSAGE LOST")
LOST COUNT = LOST COUNT + 1
-> RESUME IF LOST COUNT < 0; ! enough is enough!!
PREC("LOST: ", PP, 0)
!
ASYNCM = LOUTP
S = LOUTP STATE
K = ADDR(ASYNCM)
PRINTSTRING("SRCE: ")
PRINTSTRING(LOUTP STATE)
CYCLE J = 0, 4, 28
SPACE
PRHEX(INTEGER(K+J))
REPEAT
NEWLINE
IF LOST COUNT > 5 START
LOST COUNT = -1000; ! If more are queued, they just resume
! and let the process get on with stopping
REASON = 15
-> MONOUT
FINISH
-> RESUME
FINISH
!
PREC("QUEUE: ", PP, 0) UNLESS SIGWORD & 2 = 0
!
AMS(IN) = PP_P
IN = (IN+1) & MAXM1
AQD = AQD+1
GIVE NEXT:
K = UIVAL; ! K is 0 if UINH AD is BAD
INTEGER(UINH AD+4) = AQD IF K > 0
!
UNLESS SIGWORD & 2 = 0 START
WRSN("ASYNC INH ", ASYNCINHIB)
WRSN("K ", K)
WRSN("UINH AD ", INTEGER(UINHAD)) UNLESS K = 0
FINISH
!
-> RESUME IF ONTRAP # 0 ORC
ASYNC INHIB # 0 ORC
(K # 0 AND INTEGER(UINH AD) > 0)
ASYNCM = AMS(NEXT)
NEXT = (NEXT+1) & MAXM1
AQD = AQD - 1
!
PREC("NEXT: ", ASYNCM, 0) UNLESS SIGWORD & 2 = 0
!
INTEGER(UINH AD+4) = AQD IF K > 0
DACT = ASYNCM_DEST & X'FFFF'
-> POST ACT(DACT)
!
ASACT(UHIDACT): ! KICK TO DISPATCH ASYNC INTS, POSSIBLY
IF ONTRAP#0 OR AQD=0 THEN REASON=12 AND -> MON OUT
-> GIVE NEXT
!
ASACT(DIRDACT): ! DIR MSGS
OPERNO=P_SRCE
PS==P
S=PS_S
!
IF S = "PMON" AND PAGEMON # 0 AND INTEGER(PAGEMON) = 32 START
J = DMON("SWITCHON")
OPER(OPERNO, "J = " . ITOS(J))
-> RESUME
FINISH
!
IF S="TIME?" AND PROCUSER # "DIRECT" START
ACCTS==RECORD(ACCTSA)
J=UINF_PREVIC
K=GETIC
OPER(OPERNO,"T=".TIM((ACCTS_KINSTRS+(J-K)) C
//COM_KINSTRS).",PT=". C
ITOS(ACCTS_PTRNS))
-> RESUME
FINISH
!
IF S->S1.("XST").S2 AND S1="" START
IF ASYNC INHIB#0 START
OPER(OPERNO,"Async msgs inhibited")
-> RESUME
FINISH
IF S2 = "" THEN REASON = 13 ELSE REASON = P_P6 AND -> MONOUT1
-> MONOUT
FINISH
IF S = "CMP" THEN PRINTMP(0,0) AND -> RESUME
IF S = "ST" THEN PS_DEST = 2 AND -> QUEUE IT
IF S = "VST" THEN PS_DEST = 10 AND -> QUEUE IT
IF S = "EMPTYDVM" THEN PS_DEST = 11 AND -> QUEUE IT
!
IF S -> ("INT ") . S START
!
-> QUERY IF S = ""
!
IF LENGTH(S) > 1 START
J = DSETINTMESSAGE(S)
-> RESUME
FINISH
! SINGLE CH
PS_DEST = 1
STRING(ADDR(P_P3)) = S
-> QUEUE IT
FINISH
!
IF S="SRCE" START
ASYNCM=LOUTP; ! use as work area
S=LOUTP STATE
K=ADDR(ASYNCM)
CYCLE J=0,8,24
OPER(OPERNO,HTOS(INTEGER(K+J),8)." ". C
HTOS(INTEGER(K+J+4),8))
REPEAT
OPER(OPERNO,S)
OPER(OPERNO, "PC=" . HTOS(R_PC, 8))
PRINT DUMPS
-> RESUME
FINISH
!
IF S->("USECOUNT").S START
IF S="" THEN J=-1 ELSE START
WHILE S->(" ").S CYCLE ; REPEAT
J=STOI(S)
FINISH
UNLESS -1<=J<=99 THEN -> QUERY
J=SHOW USECOUNT(J, 1, OPERNO); ! local process count
-> RESUME
FINISH
!
IF S="FAIL" THEN J=INTEGER(-1) AND -> RESUME
!
IF S->S1.(" ").S2 START
J=STOI(S2)
UNLESS J#INVI AND C
(S1="DIRMON" OR S1="SIGMON") THEN -> QUERY
IF S1="DIRMON" THEN DIRMON=J C
ELSE SIGMO=J
-> RESUME
FINISH
QUERY:
OPER(OPERNO,S."?")
-> RESUME
ASACT(USEDACT): ! entry to PON a use-count number for fsys P_P1
! back to the DIRECT process.
P_DEST=P_SRCE
P_P2=FSYS USECOUNT(P_P1)
DPONI(P)
-> RESUME
!------------------------------------------------------------------------------------
!
POST ACT(1): ! INT MSG
CLASS=65
SUBCLASS=BYTEINTEGER(ADDR(ASYNCM_P3)+1); ! THE SINGLE INT: CHAR
IF SUBCLASS=0 START
! Interactive terminal address, currently 4 bytes as follows
! binary 3 (no of bytes following)
! Node no, Terminal no, Buffer no.
UINF_ITADDR0=(ASYNCM_P3<<16) ! (ASYNCM_P4>>16)
-> RESUME
FINISH
!
SUBCLASS = 'Y' IF SUBCLASS = 25
DOPER2(PROCUSER.": EOT") IF SUBCLASS = 'Y'
SUBCLASS = 'Y' AND DOPER2(PROCUSER.": TCP FAIL") IF SUBCLASS = 26
!
-> ACTIVATE ONTRAP
!
POST ACT(2): ! "ST" RECEIVED
PA2:
CLASS=65; ! single-char INT message
SUBCLASS='X'
-> ACTIVATE ONTRAP
POST ACT(3): ! TXT MSG
PA3:
CLASS=66
SUBCLASS=ASYNCM_P3; ! THE TEXT POINTERS
-> ACTIVATE ONTRAP
POST ACT(8): ! CLOSE MSG
!
! This msg acts exactly as TXT MSG or as DIR MSG "ST" (according to
! the setting of P_P1), except that the message is ignored if the
! process has zero use-counts for all discs which are to be closed.
! The variable FSYS WARN is set (if the user might have to go) or
! cleared (if he now has no segments connected on closing FSYSes).
! This variable is used (only) in routine DDISCONNECTI, before return,
! to decide whether or not to clear the index area VM.
!
K=0
RECYCLE:
CYCLE J=99,-1,0
IF FSYS USECOUNT(J)#0 AND AV(J,0)=0 START
IF K=0 START
EMPTY DVM
K=1
-> RECYCLE
FINISH
FSYS WARN=1
IF ASYNCM_P1=0 START
! This next line relates only to async messages sent by DIRECT
! to the executive processes just to get the FSYS WARN variable
! set.
IF ASYNCM_P3=0 THEN -> RESUME
-> PA3
FINISH ELSE -> PA2
FINISH
REPEAT
FSYS WARN=0
-> RESUME
POST ACT(9):
CLASS = 68
SUBCLASS = ASYNCM_P1
-> ACTIVATE ONTRAP
POST ACT(10): ! "VST" received (end of session)
CLASS = 65
SUBCLASS = 'V'
-> ACTIVATE ONTRAP
POST ACT(11):
EMPTYDVM
-> RESUME
!
!
!-------------------------------------------------------------------------
!
DIAGNOSE:
LNB AT FAIL=R_LNB
! FOR A SYSTEM CALL ERROR SIGNAL, DROP LNB TO PREVIOUS LEVEL,
! BECAUSE PRECALL SEQUENCE HAS BEEN EXECUTED.
! LIKEWISE FOR AN INSTRUCTION-COUNTER INTERRUPT, BECAUSE THE INTERRUPT
! (WHICH IS NON-STACK-SWITCHING) HAS MADE A NEW DISPLAY.
! AND LIKEWISE IF THE CAUSE OF THE PROGRAM ERROR WAS AN ATTEMPTED
! JUMP TO AN UNSATISFIED EXTERNAL REFERENCE, WHEN DR0 HAS "NORT"
! IN IT, THE PRECALL SEQUENCE HAS BEEN EXECUTED.
IF CLASS=16 OR CLASS=17 OR R_DR0=M'NORT' START
DISPLAY==RECORD(LNB AT FAIL)
R_PSR=DISPLAY_LK0
R_PC=DISPLAY_LK1
R_SF=LNB AT FAIL
LNB AT FAIL=INTEGER(LNB AT FAIL)
R_LNB=LNB AT FAIL
FINISH
!
! DID ERROR OCCUR IN A DIRECTOR ROUTINE ?
! CHECK CURRENT ACR AGAINST ACR IN DISPLAY ON STACK (AT LNB+1WORD).
! WE TRUST, FOR NOW, THAT THIS WORD IS ACCESSIBLE.. BE MORE CAREFUL LATER.
*LSS_(LNB +1)
*ST_PSRHERE
STK1PSR=R_PSR
!
! SET DIRFAIL IF WE CAN TELL THAT THE FAILURE WAS IN DIRECTOR.
! FOR A DIRECTOR FAIL, PC WILL BE <= TOP OF DIRECTOR CODE SEGMENT (INCLUDES
! PUBLIC CODE SEGS) AND ACR MUST BE THE SAME AS THAT HERE ON THE SIGNAL
! STACK. WE ALSO DON'T WANT DIRFAIL SET FOR ASYNCHRONOUS EVENTS.
DIRFAIL = 1 IF 0<R_PC<=CODEAD + X'3FFFF' C
AND C
(STK1PSR>>20)&15 = (PSRHERE>>20)&15 C
AND C
ERRTYPE#3
DIRFAIL = 1 IF STKNO=2; ! ERROR ON SIGNAL STACK
DIRFAIL = 1 IF CLASS = 22; ! Local Controller error
!
IF CLASS=17 START
!
! MAP INSTRUCTION-COUNTER INTERRUPT TO JOBBER-DEFINED PROCESS TIME
! INTERVAL CLASS
! SESSION LIMIT REACHED?
IF INTEGER(AREVS)<-1 THEN REASON=4 AND -> MONOUT
CLASS=64
DIRFAIL=0; ! AASIGN FAILURE TO USER
FINISH
IF DIRFAIL#0 THEN SIGWORD = SIGWORD ! 99 AND PRINTREGS
REASON=6
WRS(S1) IF SIGWORD & 2 > 0
PRINT DUMPS
IF DIRFAIL#0 THEN -> MON OUT
!
! LIMIT NUMBER OF CONTINGENCIES TO A FINITE NUMBER
!
!================== ACTIVATE CONTINGENCY PROCEDURE ======================
ACTIVATE ONTRAP:
REASON=1
IF CALLDR0=0 THEN -> MON OUT
ONTRAP=1
ACTIVATE STOP:
! CHECK THAT THERE'S ENOUGH (SAY 4096 BYTES) ROOM ON THE STACK TO
! ACTIVATE THE ONTRAP ROUTINE.
ST==ARRAY(0,STF)
STK LIM=(ST(SSNP1AD>>19<<1)_APFLIM & X'3FF80') ! X'7F'
! These next tests are for the cases of
! a program error caused by SF getting into a different segment from LNB.
! for when LNB is just not (reasonably) valid.
RLNBSEG=R_LNB>>18
RSFSEG=R_SF>>18
UNLESS (RLNBSEG=NORMAL STACK SEG OR 32<=RLNBSEG<=(HISEG-1)&(¬1)) ANDC
RLNBSEG=RSFSEG ANDC
R_SF&X'3FFFF'<=STK LIM - X'1000' C
START
STK LIM=(ST(NORMAL STACK SEG>>18)_APFLIM & X'3FF80') ! X'7F'
J=STK LIM - X'2000'
J=0 IF J<0; ! Ultra-cautious!
R_SF=NORMAL STACK SEG<<18 + J
SUBCLASS=CLASS
CLASS=67
FINISH
!
IF PROCUSER = "DIRECT" C
THEN R_LNB = PROC1 LNB C
ELSE R_LNB = R_SF
!
R_SF=R_LNB+28; ! TWO INTEGER PARAMS TO CONT PROCEDURE (7 WORDS DISPLAY)
J =CALLDR0>>24; ! DRTYPE
CONTPC=0
CONTPC = CALLDR1 IF J=X'E1' OR J = X'E0'; ! CODE DESCRIPTOR
CONTPC = INTEGER(CALLDR1 + 4) IF J=X'B0' OR J=X'B1'
MONITOR IF CONTPC=0
R_PSR=CALLPSR
R_PC=CONTPC
R_SSR=R_SSR & X'7FFFF7FF'; ! REMOVE II BIT FROM SSR AND ALLOW IC INTERRUPTS
R_XNB=CALLXNB
R_DR0=CALLDR0
R_DR1=CALLDR1
IF SIGWORD&64#0 START
LMSG("ACTIVATE ONTRAP. SSN+1")
WRSNT("Class ", CLASS, 5)
WRSNT(" Subclass ", SUBCLASS, 2)
DDUMP(ADDR(R),ADDR(R)+X'50',-1,-1)
FINISH
! AND SET UP THINGS IN THE DISPLAY, GIVING a nutty ADDRESS as link PC
DISPLAY==RECORD(R_LNB)
DISPLAY_PREVLNB=LNB AT FAIL
DISPLAY_LK0=X'00100000'; ! ACR 1 to give prog err at exit
DISPLAY_LK1=M'TRAP'
DISPLAY_CLASS=CLASS
DISPLAY_SUBCLASS=SUBCLASS
!
! Set STKNO to be what R_LNB describes
STKNO=1
IF R_LNB>>18 # 4 THEN STKNO=3
OUTPAD=DIROUTP0
P==RECORD(SIGOUTP0)
P_P1=STKNO
P_P2=0; ! "RUN"
*OUT_19
IF P_DEST=-1 START
OUTPAD=SIGOUTP0
WRSS(PROCUSER, " OUT 19 FAILED")
DDUMP(0,4096,-1,-1)
DOPER2(PROCUSER." OUT_19 FAILED")
P = 0
P_P2=INVOC
STRING(ADDR(P_P3))=PROCUSER
*OUT_0
FINISH
-> BACK IN
ASACT(6): ! NULL, EXCEPT UPDATE ACCOUNTS
ASACT(0): ! INVALID
RESUME:
OUTPAD=DIROUTP0
P==RECORD(SIGOUTP0)
P_P1=STKNO; ! STACK NO TO RESUME TO
P_P2=WAITSNO
*OUT_19; ! RESUME
-> BACK IN
!======================================================================
!
ASACT(RESDACT): ! RESUME
IF ONTRAP=0 THEN REASON=10 AND -> MON OUT
LNB=P_P1
PC=P_P2
A3=P_P3; ! ADDRESS OF 18 WORDS CONTAINING REGS AT TIME OF CONTINGENCY
! (FOR LNB>0).
IF LNB=0 THEN R=RESUMEREGS AND DP = SAVE DIROUTP ELSE START
RESUMESTACK=1
IF LNB>>18 # 4 THEN RESUMESTACK=3
SSNP1AD=LNB>>18<<18 ! X'40000'
R==RECORD(SSNP1AD)
R_LNB=LNB
R_PC=PC
! FOR JOBBER SOFTWARE, ACC TO CONTAIN DESCRIPTOR TO 18 WORDS
! CONTAINING REGS AT TIME OF CONTINGENCY.
R_A2=X'28000012'
R_A3=A3
! TAKE PSR FROM ORIGINAL POINT
R_PSR=(CALLPSR & (¬3)) ! 2; ! SET ACCSIZE TO 64 BITS
RESUMEWAIT=0; ! RUN
FINISH
ONTRAP=0; VSERR=0
IF AQD>0 START
SAVE DIROUTP = DP
RESUMEREGS=R
-> GIVE NEXT
FINISH
R_SSR=R_SSR & ALLOW IC INTS
IF SIGWORD&64#0 START
LMSG("RESUME. SSN+1 :")
DDUMP(SSNP1AD,SSNP1AD+X'50',-1,-1)
WRSNT("WAITSNO=", RESUMEWAIT, 2)
FINISH
OUTPAD=DIROUTP0
P==RECORD(SIGOUTP0)
P_P1=RESUMESTACK
P_P2=RESUMEWAIT
*OUT_19
-> BACK IN
!=======================================================================
MON OUT:
S=PROCUSER." SIGNAL FAIL ".SIGFAIL(REASON)
LMSG(S)
LENGTH(S)=21
DOPER2(S); ! (no oper msg for DSTOP on user stack)
MON OUT1:
IF SIGWORD#0 = DIRFAIL START
WRS(S1)
MONITOR IF LNB AT FAIL#X'00100004'
PRINT DUMPS
FINISH
! EXECUTE THIS STOP ROUTINE ON THE USER STACK, BECAUSE WE ARE NOT ALLOWED
! TO "SUSPEND" (WHICH CAN HAPPEN FOR SEMAPHORES OR OTHER "OUT"S")
! ON THE SIGNAL STACK
STKNO=1
SSNP1AD=(NORMAL STACK SEG ! 1)<<18; ! ALWAYS STOP ON NORMAL STACK
R==RECORD(SSNP1AD)
CLASS=0; SUBCLASS=0
AQD=0; ! THROW AWAY ASYNC MSGS
SET STOP
CLASS = REASON
-> ACTIVATE STOP
!-----------------------------------------------------------------------
ROUTINE SEGMENT TABLE
INTEGER I, J, SAVE
WRS("Segment table")
SAVE = LOG ACTION
LOG ACTION = SAVE & (¬DT)
J = 0
CYCLE I = 0, 1, 127
UNLESS ST(I)_APFLIM = X'7F' AND ST(I)_USERA = 0 START
WRITE(I, 4)
SPACE
PRHEX(ST(I)_APFLIM)
SPACE
PRHEX(ST(I)_USERA)
!
J = J + 1
NEWLINE IF J & 3 = 0
FINISH
REPEAT
NEWLINE
LOG ACTION = SAVE
!
WRS("Director variables...")
WRSN("D Callers ACR", D CALLERS ACR)
WRSNT("D Callers PSR", D CALLERS PSR, 2)
END
!
!
!
ROUTINE PRINT DUMPS
INTEGER SAVELNB
!
IF SIGWORD & 1 > 0 C
AND C
LNB AT FAIL # X'00100004' C
START
!
*LSS_(LNB +0)
*ST_SAVELNB
!
*LSS_LNB AT FAIL
*ST_(LNB +0)
MONITOR
!
*LSS_SAVELNB
*ST_(LNB +0)
!
FINISH
!
IF SIGWORD & 32 > 0 C
START
NCODE(R_PC)
SEGMENT TABLE
FINISH
!
IF SIGWORD & 16 > 0 START
PRINTMP(0,0)
LMSG("REGISTERS FROM SSN+1 SEGMENT-----------")
DDUMP(SSNP1AD,SSNP1AD+X'50',-1,-1)
FINISH
!
IF SIGWORD&4#0 START
WRSN("LOCAL STACK LNB AT FAIL = ", LNB AT FAIL)
DDUMP(LNB AT FAIL&X'FFFC0000', R_SF+X'40',-1,-1); ! BE GENEROUS BY X40 BYTES
WRS("DIRECTOR CODE SEGMENT - FILE HEADER")
DDUMP(CODEAD,CODEAD+X'40',-1,-1)
FINISH
IF SIGWORD&8#0 START
WRS("DIRECTOR GLA AND LOAD DATA")
H==RECORD(CODEAD)
DDUMP(GLAD,GLAD+(H_NEXTFREEBYTE-H_GLARELST),-1,-1)
FINISH
END ; ! PRINT DUMPS
!
!-----------------------------------------------------------------------
!
END ; ! SIGNAL
!
!-----------------------------------------------------------------------
!
EXTERNALROUTINE STOP ONE(INTEGER A,B)
! This routine is used in the 'SIGNAL FAIL n' sequence. The routine
! is passed as a parameter to PRIME CONTINGENCY in order to activate it
! as an 'ONTRAP' routine.
DSTOP(A)
END ; ! STOP ONE
!
!-----------------------------------------------------------------------
!
!<DCLEARINTMESSAGE
externalintegerfn DCLEAR INT MESSAGE
!
! When a terminal user presses the ESC key, the TCP software generates
! a prompt string "INT:". The message input by the user in response is
! called an "INT: message" and is transmitted to the user process
! independently of the input and output streams enabled by the DENABLE
! TERMINAL STREAM procedure. INT: messages may be at most 15 characters
! long, the character used to terminate the message not forming part of
! the message.
!
! The EMAS 2900 System distinguishes single-character INT: messages from
! multi-character INT: messages (null INT: messages are discarded by the
! TCP). In the former case, the "contingency mechanism" is invoked. The
! DCLEAR INT MESSAGE procedure has no relevance in this case.
!
! Multi-character INT: messages, by contrast, are placed in a location
! visible to programs running at any level of privilege, and in
! particular to the subsystem. Thus an INT: message may arrive
! asynchronously with respect to the user process and may be used by it,
! for example, to re-direct the course of the computation or to take a
! particular action and then resume the computation.
!
! The location of the INT: message may be referenced by using the
! address supplied in the AIOSTAT field of the UINF record . The format
! of the record at this address is given by IOSTATF, below. Access to
! the location can be achieved as in the following example:
! .
! .
! %recordformat IOSTATF(%integer IAD, %string(15)INT MESS,
! %integer INBUFLEN, OUTBUFLEN, INSTREAM, OUTSTREAM)
! %record(IOSTATF)%name IOSTAT
! %stringname INT MESSAGE
! .
! .
! IOSTAT == RECORD(UINF_AIOSTAT)
! INT MESSAGE == IOSTAT_INT MESS
! .
! .
! %if INT MESSAGE = "STOP" %start
! .
! .
! When the process has noted the presence of a multi-character INT:
! message, the message should be cleared so that further examination
! of the message location will not yield the same message. The
! message can only be cleared by a call of the procedure DCLEAR INT
! MESSAGE, since the message location is not writable at the subsystem's
! level of privilege.
!
! Any INT: message arriving before a previous message has been cleared
! overwrites the previous message.
!>
INTEGER J
J = IN2(256 + 10)
-> OUT UNLESS J = 0
!
J = 53
-> OUT UNLESS UINF_REASON = INTER
!
J = 0
IOSTAT_INT MESS=""
OUT:
RESULT = OUT(J, "")
END ; ! DCLEAR INT MESSAGE
!
!-----------------------------------------------------------------------
!
!<DISCID
externalintegerfn DISCID
!
! This function has exactly the same effect as calling DRESUME(-1, 0, 0).
! It should be called from the ONTRAP routine and uninhibits asynchronous
! contingencies.
!>
DRESUME(-1,0,0); ! ALLOW ANY FURTHER ASYNC INTS
RESULT =0
END ; ! DISCID
!
!-----------------------------------------------------------------------
!
!<DRESETCONTINGENCY
externalroutine DRESET CONTINGENCY
!
! This procedure causes the first-set ONTRAP routine to be reinstated as
! the contingency procedure.
!>
INTEGER J
J = IN2(256 + 74)
-> OUT UNLESS J = 0
!
CALLDR0=ACALLDR0
CALLDR1=ACALLDR1
CALLPSR=ACALLPSR
CALLXNB=ACALLXNB
OUT:
J = OUT(J, "")
END ; ! DRESET CONTINGENCY
!
!-----------------------------------------------------------------------
!
!<DRESUME
externalroutine DRESUME(integer LNB, PC, ADR18)
!
! This routine is provided first to notify Director that the subsystem's
! ONTRAP routine (see the PRIME CONTINGENCY procedure) has completed that
! section of its code during execution of which it could not reasonably
! resume following a subsequent asynchronous contingency. Asynchronous
! contingencies are inhibited by Director until this notification is
! received, program or virtual store errors will cause looping.
!
! Likely tasks in this inhibited state (called the "ONTRAP state") are
!
! i) determination of a new environment (e.g. an "ABORT" position,
! or a diagnostic routine), or
!
! ii) output of a text message, or
!
! iii) determination of other subsequent action (e.g. ignore
! asynchronous interrupt, and continue the former computation).
!
!
! Secondly, DRESUME provides the means for the ONTRAP routine to specify
! the original or a chosen new environment, for resumption of normal
! computation.
!
! The action taken is determined by the value of the parameter LNB.
! Parameter ADR18 is relevant only when LNB=0, and PC only when LNB is
! greater than zero.
!
! LNB=-2 At process start-up, asynchronous interrupts are
! inhibited until the subsystem calls this entry point
! to DRESUME. This enables the subsystem to initialise
! itself properly for action. Subsequent calls of
! this entry point have no effect.
!
! LNB=-1 This entry point tells Director that the ONTRAP
! routine has completed its critical operations and can
! again accept asynchronous interrupts. If a
! contingency is in fact queued at the time that this
! entry point is called by the ONTRAP routine, a new
! invocation of the ONTRAP routine is immediately
! created. The environment supplied, by procedure READ
! ID, to the new ONTRAP routine is that following the
! call of DRESUME in the previous ONTRAP routine.
!
! LNB=0 This entry point may be called only from the ONTRAP
! state (otherwise the process stops with a main Oper
! message SIGNAL FAIL 10) following an asynchronous
! contingency or program error (SIGNAL FAIL 9 following
! a virtual store error). The call informs Director
! that computation is to be resumed at the point of
! interruption. Parameter ADR18 must point to a copy
! of the environment supplied to the subsystem by the
! READ ID procedure. The process leaves the ONTRAP
! state.
!
! LNB>0 The values LNB, PC are transferred to the process
! registers LNB and PC, and computation continues at PC
! The value ADR18 is placed in the ACC, single length,
! as a means of passing information to the new
! computation.
! The values assigned to the other registers are
! indeterminate, therefore it is expected that PC will
! point at or near an EXIT instruction so that a well-
! defined environment can be reached. The LNB value
! must be more than 5 words below the SF at the time
! of the contingency, otherwise SIGNAL FAIL 7 occurs.
! The process leaves the ONTRAP state.
!>
INTEGER CALLERS LNB,CALLERS PC,TYPE,DACT
RECORD (PARMF)Q
RECORD (PARMF)NAME P
SWITCH DRES(-4:1)
DACT=RESDACT
*LSS_(LNB +0); ! CALLER'S LNB
*ST_CALLERS LNB
*LSS_(LNB +2)
*ST_CALLERS PC; ! REQUIRED ONLY FOR DIAGNOSTIC PURPOSES, SEE BELOW
TYPE=LNB
TYPE=1 IF TYPE>0 OR TYPE<-4; ! INCLUDES REASONABLE LOCAL AND PUBLIC LNB VALUES
-> DRES(TYPE)
DRES(-4): ! DIRECTOR ENTRY TO DISPATCH ASYNC INTS
! (but only if there's something to dispatch and user is
! not in ONTRAP state).
IF AQD=0 OR ONTRAP#0 THEN RETURN
DACT=UHIDACT
-> PONMESS
DRES(-2): ! CLEAR INITIAL 'ASYNC INHIB' VALUE (SET NON-ZERO UNTIL
! SUBSYSTEM IS SET UP AND CALLS THIS ENTRY
IF ASYNC INHIB=100 START ; ! THIS HAS TO HAPPEN ONCE ONLY !
ASYNC INHIB=0
AQD=0; ! THROW AWAY
FINISH
RETURN
DRES(-1): ! Leave 'ontrap' state and kick to dispatch async ints,possibly.
! (Subsystem entry)
! Cancel the VSerr flag for the case following a VSerr where we don't
! go through the ASACT(RESDACT) code. (The flag is intended only to
! stop a resume-where-you-were following a VSerr.
VSERR=0
ONTRAP=0
DRES(-3): ! Kick to dispatch async ints.
IF AQD=0 THEN RETURN
DACT=UHIDACT
-> PONMESS
DRES(0): ! RESUME WHERE YOU WERE
IF ONTRAP=0 THEN DSTOP(10)
IF VSERR#0 THEN DSTOP(9)
! SHOULD CHECK VALIDITY OF INFO SUPPLIED !!
-> PONMESS
DRES(1): ! RESUME AT THIS LNB/PC
IF LNB>>18=6 THEN DSTOP(8)
IF ONTRAP=0 START
UNLESS LNB<CALLERS LNB - 20 THEN DSTOP(7)
*LSS_(LNB +1)
*ST_(1); ! SET BACK TO CALLER'S PSR
*LSS_PC
*ST_TOS
*LDTB_X'28000012'
*LDA_ADR18
*CYD_0
*LLN_LNB
*J_TOS
FINISH ELSE START
UNLESS LNB<=RESUMEREGS_SF-20<CALLERS LNB THEN DSTOP(7)
FINISH
PONMESS:
P==RECORD(DIROUTP0)
Q=0
Q_DEST=((COM_ASYNC DEST + PROCESS)<<16) ! DACT
Q_P1=LNB
Q_P2=PC
Q_P3=ADR18
Q_P4=CALLERS PC; ! ONLY TO GET IT DISPLAYED IN SIGNAL DIAGNOSTICS
IF SIGMO&64#0 START
WRS("BEFORE OUT 6")
DDUMP(ADDR(Q),ADDR(Q)+32,-1,-1)
FINISH
P=Q
*OUT_6; ! PON AND CONTINUE
! SHOULD NOT RETURN, EXCEPT FOR THE "UNINHIBIT" ENTRY
RETURN IF DACT=UHIDACT
Q=P
WRS("AFTER OUT 6")
DDUMP(ADDR(Q),ADDR(Q)+32,-1,-1)
DSTOP(11); ! SHOULD NOT OCCUR
END ; ! DRESUME
!
!-----------------------------------------------------------------------
!
!<PRIMECONTINGENCY
externalintegerfn PRIME CONTINGENCY(integer DR0, DR1, J, XNBVALUE)
!
! The purpose of this procedure is to nominate a routine (the actual
! parameter) which is to be executed on the occurrence of various
! contingencies, both synchronous and asynchronous. The types of
! contingencies which will invoke the ONTRAP routine are as follows:
!
! Synchronous
!
! *Virtual store errors.
!
! *Program errors.
!
! *Instruction counter interrupt (treated as program error).
!
! Asynchronous
!
! *Arrival of single-character "INT:" messages (as in INT:A, for
! example, from an interactive terminal, or a TERMINATE to a
! batch process from the main Oper console).
!
! *Arrival of text messages from the machine operator or from
! other processes.
!
! *Arrival of "POFF" messages from other processes or from the
! Supervisor (available only to privileged processes).
!>
! THIS FUNCTION IS CALLED WITH FORMAL AND ACTUAL PARAMETER OF TYPE
! ROUTINE, WHCIH LEADS TO FOUR WORDS BEING PASSED.
! FOR AN EXTERNAL ROUTINE PARAMETER
! DR0, DR1 ARE AN "EXT RT SPEC" DESCRIPTOR-DESCRIPTOR TO
! THE ROUTINE
! Z IS ZERO
! XNBVALUE IS ZERO (NOT USED OR REQUIRED, THAT IS)
! FOR AN INTERNAL ROUTINE PARAMETER
! DR0, DR1 ARE A CODE DESCRIPTOR TO THE ROUTINE
! Z IS ZERO
! XNBVALUE POINTS TO THE DISPLAY OF THE OUTER PROCEDURE
! (THE ONE CALLING THIS FUNCTION)
J=IN2(91)
IF J = 0 START
CALLPSR=D CALLERS PSR
CALLDR0=DR0
CALLDR1=DR1
CALLXNB=XNBVALUE
!
IF ACALLDR0=-1 START
! REMEMBER FIRST ENVIRONMENT SET, SO THAT IT CAN BE RESET BY "RESET CONTINGENCY"
ACALLDR0=CALLDR0
ACALLDR1=CALLDR1
ACALLPSR=CALLPSR
ACALLXNB=CALLXNB
FINISH
!
ASYNC INHIB = 1 AND AQD = 0 IF ASYNC INHIB = 101
FINISH
!
RESULT = OUT(J, "")
END ; ! PRIME CONTINGENCY
!
!-----------------------------------------------------------------------
!
!<READID
externalintegerfn READID(integer ADR)
!
! This function provides the process environment as it was at the
! occurrence of the most recent contingency. The information is written
! to the area whose address is given by parameter ADR. Currently, 18
! words - the processor registers plus PC of erring or current
! instruction - are returned, but space should be left for 32 words
! altogether (for future extensions).
!
! The interrupt data remains available for repeated reading until a call
! of DRESUME (described below) is executed. An error result of 53 is
! returned if no interrupt data is available, or of 45 if the address
! supplied is not accessible.
!>
! RESULT = 0 OK
! 53 NO INT DATA
INTEGER J
RECORD (RF)NAME R
RESULT =53 IF ONTRAP=0
!
J = IN2(93)
IF J = 0 START
J = 45
IF VAL(ADR, 72, 1, D CALLERS PSR) = YES START
R==RECORD(ADR)
R=RESUMEREGS
J = 0
FINISH
FINISH
!
RESULT = OUT(J, "")
END ; ! READID
!
!-------------------end-of-included-text---------------------------------
!