!* MODIFIED 24/01/78 08.00
!*
CONSTINTEGER OPSYS=0 ;! *** EMAS ***
CONSTINTEGER EMAS=0 ;! *** EMAS ***
EXTRINSICINTEGER ICL9CEFAC
EXTRINSICINTEGER ICL9CEMAINLNB
!*
!* SSLEVEL NOW IN COMREG(1)
!%OWNINTEGER SSLEVEL; !-1 ABORTING
! 0 INITIALISING
! 1 COMMAND PROCESSOR
! 2 TRUSTED FACILITY(E.G. COMPILER)
! 3 USER PROGRAM
!*
EXTRINSICINTEGER ICL9CEJSTATE; ! 0 NO CURRENT USER JOB
! 1 PROCESSING USER JOB
! 2 JOB ABORTING(E.G. REQUEST FOR UNAVAIL. RESOURCE
! 3 TIME EXCEEDED
! 4 OUTPUT EXCEEDED
! 5 USER PROG DIAGS FAILURE
! 6 SOFTWARE DETECTED ERROR(SUBSYS IN CONTROL)
! 7 I/0 ERROR ON PRIMARY OUTPUT STREAM
! 8 HARDWARE DETECTED ERROR WHILE IN SUBSYS
! 9 SUBSYSTEM LOGICAL ERROR
!10 ABORTING!
EXTERNALROUTINESPEC DRESUME(INTEGER LNB,PC,ADR18)
!*
!*
!****** BBASE FUNCTIONS
!*
SYSTEMROUTINESPEC SUPERSTOP ;! *** EMAS ***
SYSTEMROUTINESPEC STOPBASE
SYSTEMROUTINESPEC READID(INTEGER AREA ADDRESS)
SYSTEMROUTINESPEC DISCID
SYSTEMROUTINESPEC LOG(INTEGER M,N)
EXTERNALSTRING (8) FNSPEC C
INTTOSTRING(INTEGER M,N)
!*
!****** MAIN
!*
SYSTEMROUTINESPEC MOVE(INTEGER LEN,FROM,TO)
SYSTEMROUTINESPEC SIM2(INTEGER EP,P1,P2,INTEGERNAME F)
SYSTEMROUTINESPEC IOCP(INTEGER I,J)
SYSTEMINTEGERMAPSPEC COMREG(INTEGER I)
SYSTEMINTEGERMAPSPEC FDMAP(INTEGER I)
SYSTEMROUTINESPEC CONNECT(STRING (15) S, C
INTEGER ACCESS, MAXBYTES, USE, RECORDNAME R, C
INTEGERNAME FLAG)
SYSTEMROUTINESPEC TIDY EXIT
!*
!****** DIAG
!*
SYSTEMROUTINESPEC NDIAG(INTEGER PC,LNB,FAULT,EXTRA)
SYSTEMROUTINESPEC SSMESS(INTEGER N)
SYSTEMROUTINESPEC NCODE(INTEGER START,FINISH,AD)
!*
ROUTINESPEC ALLDIAGS(INTEGER PC)
!*
!*
!*
SYSTEMROUTINE SSERR(INTEGER N)
!* ROUTE FOR SOFTWARE DETECTED ERRORS
INTEGER I
STRING (32) S
IF N=0 THEN ->EXIT
IF (COMREG(1)=3 OR ICL9CEFAC=4) AND N<256 THENSTART ;! ERROR WHILE EXECUTING USER PROG.
COMREG(1)=1;! IN CASE OF ERROR ON ERROR
*STLN_I
NDIAG(0,I,N,0)
FINISHELSESTART ;! REPORT ERROR AND RETURN TO MAIN CONTROL
IF N>=256 THEN COMREG(1)=-1;! TO ENSURE ABORT
IOCP(11,-1)
SELECTOUTPUT(107) UNLESS ICL9CEMAINLNB=0 AND ICL9CEFAC#4
UNLESS ICL9CEJSTATE>1 OR 230<=N<=231 THEN ICL9CEJSTATE=6
SSMESS(N)
EXIT:
UNLESS 0<=ICL9CEFAC<=3 THEN TIDY EXIT
I=ICL9CEMAINLNB
IF I=0 THENSTART
IF OPSYS=EMAS START ;! *** EMAS ***
S="INIT. FAILS - ".INTTOSTRING(N,4) ;! *** EMAS ***
LOG(ADDR(S)+1,LENGTH(S)) ;! *** EMAS ***
FINISH ;! *** EMAS ***
STOPBASE
FINISH
*LLN_I
*EXIT_-64
FINISH
END ;! SSERR
!*
ROUTINE ON CPU LIMIT(INTEGER PC,LNB)
ICL9CEJSTATE=3 IF ICL9CEJSTATE<3
IF COMREG(1)=3 THEN COMREG(1)=1 AND NDIAG(PC,LNB,211,0)
SSERR(211)
END ;! ON CPU LIMIT
!*
SYSTEMROUTINE ON OUTPUT LIMIT
RETURN UNLESS ICL9CEFAC=0
ICL9CEJSTATE=4
SSERR(212)
END ;! ON OUTPUT LIMIT
!*
SYSTEMROUTINE ON DIAGS FAIL
ICL9CEJSTATE=5 IF ICL9CEJSTATE<5
IF COMREG(1)>1 THEN COMREG(1)=1
SSERR(31)
END ;! ON DIAGS FAIL
!*
ROUTINE ON OP INT(INTEGER SUBCLASS)
UNLESS SUBCLASS=1 THEN COMREG(2)=2;! BATCH TERMINATION
ICL9CEJSTATE=3 IF ICL9CEJSTATE<3
COMREG(1)=1
SSERR(213)
END ;! ON OP INT
!*
!*
!*
RECORDFORMAT SIGDATAFMT(INTEGER PC, LNB, CLASS, SUBCLASS, C
INTEGERARRAY A(0 : 17))
!*
!*
SYSTEMROUTINE ONTRAPACT(INTEGER MODE, CLASS, SUBCLASS, OLDPC, OLDLNB)
RECORD OWND(SIGDATAFMT) ;! FOR EARLY CALLS
RECORDNAME D(SIGDATAFMT)
OWNINTEGER LATEST
OWNINTEGER ABORT
INTEGER I, J, K, L, F, SIGLEVEL
SWITCH SW(0 : 4)
IF OPSYS=EM AS START ;! *** EMAS ***
IF CLASS = 65 START ;! SINGLE CHARACTER INT:
IF SUB CLASS='A' OR SUBCLASS='X' THEN SUPERSTOP ;! ABORT JOBBER
FINISH
FINISH ;! *** EMAS ***
F=0
I=COMREG(33)
SIGLEVEL=COMREG(34)
IF SIGLEVEL=0 AND INTEGER(I+4)=-1 THENSTART
! ERROR AFTER ICL9CEJINIT + EXTERNAL ROUTINE
SIGLEVEL=1
INTEGER(I+4)=0
INTEGER(I+88)=0;! ENSURE PC=0 FOR DIRECT NDIAG CALL
FINISH
IF SIGLEVEL <= 0 THENSTART
F = 1 UNLESS CLASS=64;! EXCEPT CPU TIME EXCEEDED
SIGLEVEL = 0
FINISH
I = I+88*SIGLEVEL
IF I&X'FFFC0000'=0 THEN I=ADDR(OWND) ;! BEFORE C 33 SET.
D == RECORD(I)
-> SW(MODE)
!*
SW(0): D_CLASS = CLASS
D_SUBCLASS = SUBCLASS
READID(ADDR(D_A(0))); ! READ INTERRUPT DATA (18 WORD VECTOR DESCRIPTOR)
SIGLEVEL = SIGLEVEL-1
! IGNORE BROADCASTS AND MESSAGES
! THE DRESUME TIDIES UP LIKE A DISCID AND CH INTS: OTHER THAN 'A'
IF OPSYS=EMAS AND (CLASS=66 OR CLASS=65) C
THEN DRESUME(0,0,ADDR(D_A(0)))
DISCID; ! DISCARD INTERRUPT DATA
IF ABORT=0 THENSTART
ABORT=1
IF D_A(16)>>18=D_A(2)>>18 THEN I=D_A(16) ELSE I=D_A(2)
IF F#0 OR COMREG(25)<2 THEN ALLDIAGS(I)
FINISHELSESTART
ABORT=ABORT-1
IF ABORT#0 THEN STOPBASE
FINISH
IF F # 0 THENSTART
ABORT=2
PRINTSTRING('
***JOB ABORTED
')
NEWPAGE
NEWLINE
STOPBASE
FINISH
ABORT=0;! APPEARS TO BE IN CONTROL
IF CLASS=64 THEN ON CPU LIMIT(D_A(2),D_A(0))
IF CLASS=52 THENSTART ;! INTERRUPT JOB BY OPERATOR
IF SUBCLASS=3 THEN STOPBASE
ON OP INT(SUBCLASS)
FINISH
MEET: INTEGER(COMREG(33)-4) = SIGLEVEL
COMREG(34)=SIGLEVEL
LATEST = I+8
I = D_PC
J = D_LNB
IF I=0 THENSTART
NDIAG(D_A(2),D_A(0),10,CLASS)
STOP
FINISH
K = X'28000012'; ! 18 WORD DESCRIPTOR
L = ADDR(D_CLASS)
**I
*PUT_X'4998'; ! ST (TOS)
**J
*PUT_X'4998'; ! ST (TOS)
**K
*PUT_X'4998'; ! ST (TOS)
**L
*PUT_X'4998'; ! ST (TOS)
*PUT_X'6598'; ! LSD (TOS)
*PUT_X'7D98'; ! LLN (TOS)
*PUT_X'1B98'; ! J (TOS)
!*
SW(2): SIGLEVEL = SIGLEVEL-1
-> A
!*
SW(3): I = ADDR(COMREG(33))
D == RECORD(I)
A: D_CLASS = CLASS
D_SUBCLASS = SUBCLASS
D_A(0) = OLDLNB
D_A(2) = OLDPC
-> MEET
!*
SW(4): IF LATEST # 0 THEN MOVE(72,LATEST,I+8)
SIGLEVEL = SIGLEVEL-1
-> MEET
END ; ! ONTRAPACT
!*
!*
SYSTEMROUTINE ONTRAPE(INTEGER CLASS,C
SUBCLASS)
ONTRAPACT(0,CLASS,SUBCLASS,0,0)
END
!*
SYSTEMROUTINE ONTRAP(INTEGER SUBCLASS,CLASS)
!***********************************************************************
!* ENTERED BY EXEC AFTER CONTINGENCY *
!***********************************************************************
ONTRAPACT(0,CLASS,SUBCLASS,0,0)
END
!*
SYSTEMROUTINE ONTRAPB(INTEGER EVENT,SUBCLASS,CLASS)
ONTRAPACT(0,CLASS,SUBCLASS,0,0)
END ;! ONTRAPB
!*
!*
!*
ROUTINESPEC PX(INTEGER H)
!*
SYSTEMROUTINE PHEX(INTEGER N)
PX(ADDR(N))
END ; ! PHEX
!*
CONSTBYTEINTEGERARRAY C(0 : 15) = '0','1','2','3',
'4','5','6','7','8','9','A','B','C','D','E','F'
ROUTINE PX(INTEGER H)
INTEGER I,J
CYCLE I = 0,1,3
J=BYTEINTEGER(I+H)
PRINTSYMBOL(C(J>>4))
PRINTSYMBOL(C(J&15))
REPEAT
END ; !OF PX
!*
SYSTEMROUTINE DUMP(INTEGER START, LEN)
INTEGER I, J, CNT, FINISH,LASTLINE,STAR
CONSTBYTEINTEGERARRAY BPATT(0:132)= C
10,'*',' '(32),'*',' '(2),'(',' '(8),')',' '(86)
OWNBYTEINTEGERARRAY B(0:132)
INTEGER BP
ROUTINESPEC P(INTEGER AD,K)
NEWLINE
CNT = 32
RETURNIF LEN <= 0
IF LEN>START THENSTART ;! OLD DEFN OF DUMP
LEN=LEN-START
FINISH
FINISH = START+LEN
START = START&X'FFFFFFFC'
NEWLINE
LASTLINE=0
STAR=0
WHILE START < FINISH CYCLE
IF LASTLINE#0 THENSTART
CYCLE I=0,4,CNT-4
UNLESS INTEGER(START+I)=INTEGER(LASTLINE+I) THEN ->NO MATCH
REPEAT
STAR=1
->NEXT
FINISH
NO MATCH: BP=2
MOVE(132,ADDR(BPATT(0)),ADDR(B(0)))
CYCLE I = 0,1,CNT-1
J = BYTEINTEGER(START+I)
UNLESS 32 <= J <= 95 THEN J = ' '
B(BP)=J
BP=BP+1
REPEAT
P(ADDR(START),38)
IF STAR#0 THEN B(48)='*' ELSE B(48)=' '
STAR=0
LASTLINE=START
BP=49
CYCLE I = 0,4,CNT-4
P(START+I,BP)
BP=BP+9
REPEAT
SIM2(1,ADDR(B(0)),120,I)
NEXT: START=START+CNT
REPEAT
RETURN
ROUTINE P(INTEGER AD,K)
INTEGER I,J
CYCLE I=0,1,3
J=BYTEINTEGER(I+AD)
B(K)=C(J>>4)
B(K+1)=C(J&15)
K=K+2
REPEAT
END ;! P
END ; ! DUMP
!*
ROUTINESPEC DUMPGLA
ROUTINESPEC DUMPCOM
ROUTINESPEC DUMPSIG
ROUTINESPEC VFMAP(INTEGER MODE)
!*
SYSTEMROUTINE ALLDIAGS(INTEGER PC)
INTEGER I,SF,CS,CE
*STSF_SF
! SELECT OUTPUT(99) %UNLESS ICL9CEMAINLNB=0 %AND ICL9CEFAC#4
SELECT OUTPUT(107)
DUMPCOM
DUMPSIG
VFMAP(0)
PRINTSTRING('
CODE:
')
IF PC#0 THENSTART
CS=PC-128
CE=PC+128
IF CS<CE THEN NCODE(CS,CE,CS)
FINISH
NEWPAGE
IF PC=0 THENSTART
*STLN_I
PRINTSTRING('
LNB=')
PHEX(I)
FINISH
I=SF&X'FFFC0000'
PRINTSTRING('
STACK:
')
DUMP(I,SF-I)
I=COMREG(37)
IF I#0 THENSTART
PRINTSTRING('
AUX STACK:
')
DUMP(I,INTEGER(I)-I)
FINISH
NEWPAGE
DUMPGLA
END ;! ALLDIAGS
!*
!*
ROUTINE P(INTEGER START, N)
INTEGER I
NEWLINE
CYCLE I = 1,1,N
PHEX(INTEGER(START))
SPACES(2)
START = START+4
REPEAT
END ; ! P
!*
ROUTINE DUMPSIG
INTEGER I,SIGLEVEL
I = COMREG(33); ! ADDR(SIGDATA(0))
SIGLEVEL=COMREG(34)
RETURN IF I=0
PRINTSTRING('
SIGDATA:
SIGLEVEL =')
WRITE(SIGLEVEL,1)
CYCLE I = I,88,I+176
NEWLINES(2)
SPACES(20)
PRINTSTRING('CLASS SUBCLASS')
P(I,4)
PRINTSTRING('
LNB PSR PC SSR SF')
P(I+16,8)
PRINTSTRING('
XNB B DR0 DR1 ')
PRINTSTRING('A0 A1 A2 A3')
P(I+48,10)
REPEAT
NEWLINES(2)
END ; ! DUMPSIG
!*
ROUTINE DUMPGLA
RECORDFORMAT RF(INTEGER CONAD,CURL,DATASTART,DATAEND)
RECORD R(RF)
INTEGER I,F
CONNECT('SS#GLA',0,0,0,R,F)
IF F#0 THENSTART
RETURN
FINISH
PRINTSTRING('
USER PLT:
')
I=INTEGER(R_CONAD)
UNLESS 16<=I<=X'4000' THEN I=X'1000'
DUMP(R_CONAD,I)
END ;! DUMPFILE
ROUTINE DUMPCOM
INTEGER I, J, K
RETURN UNLESS COMREG(25)=0
PRINTSTRING('COMREG:
')
J = 0
CYCLE I = 0,1,59
K=COMREG(I)
IF K#0 THENSTART
WRITE(I,4); SPACES(2); PHEX(COMREG(I))
J = (J+1)&3
NEWLINE IF J = 0
FINISH
REPEAT
PRINTSTRING('
FDMAP:
')
J = 0
CYCLE I = 0,1,109
K = FDMAP(I)
IF K # 0 THENSTART
WRITE(I,4); SPACES(2); PHEX(K)
J = (J+1)&3
NEWLINE IF J = 0
FINISH
REPEAT
NEWLINE
CYCLE I=0,1,109
K=FDMAP(I)
IF K#0 THENSTART
PRINTSTRING('
FD FOR FILE')
WRITE(I,1)
NEWLINE
DUMP(K,112)
NEWLINE
FINISH
REPEAT
END ;! DUMPCOM
!*
!*
RECORDFORMAT VFDESC(STRING (15) S, C
INTEGER CONAD, CURL, MAXL, LINK,MODE,DESC0,DESC1)
!*
ROUTINE VFMAP(INTEGER MODE)
!* MODE = 0 MAP ONLY
!* 1 DUMP FILES
RECORDNAME VF(VFDESC)
INTEGER I
RETURN UNLESS COMREG(25)=0
I=COMREG(30);! HEAD OF VF ENTRIES
RETURN IF I=0
PRINTSTRING('
AREA MAP:
')
WHILE I # 0 CYCLE
VF == RECORD(I)
PRINTSTRING('IDEN: '.VF_S)
SPACES(16-LENGTH(VF_S))
PRINTSTRING('CONAD: ')
PHEX(VF_CONAD)
PRINTSTRING(' CURL: ')
PHEX(VF_CURL)
PRINTSTRING(' MAXL: ')
PHEX(VF_MAXL)
NEWLINE
IF MODE = 1 THEN DUMP(VF_CONAD,VF_CURL)
I = VF_LINK
REPEAT
END ; ! VFMAP
!*
!*
ENDOFFILE