SYSTEMROUTINESPEC ALLDIAGS(INTEGER PC)
!* MODIFIED 24/01/78 08.30
!*
!*
EXTRINSICINTEGER ASSCOM
EXTERNALLONGINTEGER ICL9CEAUXST
!*E; %EXTERNALINTEGER ICL9CEFAC=0
!*NE %EXTERNALINTEGER ICL9CEFAC=4
!*NE %EXTERNALINTEGER ICL9CEDETOI
!*NE %EXTERNALINTEGER ICL9CEDITOE
!*
!*
OWNINTEGER OPSYS=0; ! 0 EMAS
! 1 VME/B
! 2 VME/K
!*
OWNINTEGERARRAY SSCOMREG(0 : 63) =240,0(63)
!*
!*
!****** OPEH INTERFACE
!*
!*NE %EXTERNALROUTINESPEC ICL9HEDIAGOUT(%INTEGERNAME POSITION,%INTEGER D0,D1)
!*
!*
!****** BBASE FUNCTIONS
!*
!*NE %SYSTEMROUTINESPEC DATE AND TIME(%STRINGNAME DATE, TIME)
!*NE %SYSTEMINTEGERFNSPEC READ CPU TIME
!*NE %SYSTEMINTEGERFNSPEC FASTFILEOP(%INTEGER ADA)
!%SYSTEMINTEGERFNSPEC FILEOP(%INTEGER ACCESS DR ADDR,ACCESS TYPE, %C
! OPTYPE,BUFFAD,BUFFLEN,DISPLACEMENT)
SYSTEMROUTINESPEC LOG(INTEGER MSG ADR,MSG LEN)
SYSTEMROUTINESPEC STOPBASE
!*
!****** MAIN
!*
SYSTEMROUTINESPEC IOCP(INTEGER I,J)
!*
!****** FILE
!*
SYSTEMINTEGERMAPSPEC FDMAP(INTEGER I)
SYSTEMINTEGERFNSPEC OPEN(INTEGER AFD, MODE)
SYSTEMINTEGERFNSPEC CLOSE(INTEGER AFD)
!*NE %SYSTEMINTEGERFNSPEC LOCATE CHANNEL(%INTEGER CHAN)
SYSTEMINTEGERFNSPEC SET CONTENT LIMIT(STRING (15) S, C
INTEGER NEW LIMIT)
SYSTEMINTEGERFNSPEC INITCOMP(INTEGER COMP,MODE,NEWP)
!%EXTERNALROUTINESPEC ICL9CEJINIT
!*
!****** DIAG
!*
SYSTEMROUTINESPEC ONTRAPACT(INTEGER MODE,CLASS,SUBCLASS, C
OLDPC,OLDLNB)
!*E; %SYSTEMROUTINESPEC EXPAND PRIMARY OUTPUT FILE(%RECORDNAME F)
SYSTEMROUTINESPEC SSERR(INTEGER I)
!*SJ; %SYSTEMROUTINESPEC ON OUTPUT LIMIT
!*
!*
OWNINTEGER BASECPU
!*
!*
OWNINTEGER INFD
OWNINTEGER INREQFD
OWNINTEGER LOG99SET
OWNINTEGER OUTFD
OWNINTEGER OUTREQFD
!*NE %OWNINTEGER OUTPUT LIMIT=10000
OWNSTRING (31) OBJ FILE ENTRY
!*
!*
INTEGERFNSPEC SELECTIO(INTEGER MODE, STREAM, INTEGERNAME MARGINS)
!*
RECORDFORMAT NRFDFMT(INTEGER LINK,DSNUM, C
BYTEINTEGER STATUS, ACCESS ROUTE, VALID ACTION, CUR STATE, C
BYTEINTEGER MODEOFUSE, MODE, FILE ORG, DEV CLASS, C
BYTEINTEGER REC TYPE, FLAGS, LM, RM, C
INTEGER ASVAR, AREC, RECSIZE, MINREC, MAXREC, MAXSIZE,ROUTECCY, C
INTEGER C0, C1, C2, C3, TRANSFERS, C
INTEGER DARECNUM,LASTREC,RECORDS, C
STRING (31) IDEN)
!*
RECORDFORMAT TCFMT(INTEGER PAGE COUNT,USER TRANSFER COUNT, C
USER PRINT COUNT,TOTAL PRINT COUNT, C
OUTPUT LIMIT,PAGE SIZE)
!*
OWNRECORD TC(TCFMT)
!*
OWNINTEGERARRAY BASICFDS(0:111);! FOR STREAMS 99,101,102,108
!*
!*NE %CONSTBYTEINTEGERARRAY ITOETAB(0 : 255) = %C
!NE* 0,
!NE* 1, 2, 3, 55, 45,
!NE* 46, 47, 22, 5, 21,
!NE* 11, 12, 13, 14, 15,
!NE* 16, 17, 18, 19, 60,
!NE* 61, 50, 38, 24, 25,
!NE* 63, 39, 28, 29, 30,
!NE* 31, 64, 79, 127, 123,
!NE* 91, 108, 80, 125, 77,
!NE* 93, 92, 78, 107, 96,
!NE* 75, 97, 240, 241, 242,
!NE* 243, 244, 245, 246, 247,
!NE* 248, 249, 122, 94, 76,
!NE* 126, 110, 111, 124, 193,
!NE* 194, 195, 196, 197, 198,
!NE* 199, 200, 201, 209, 210,
!NE* 211, 212, 213, 214, 215,
!NE* 216, 217, 226, 227, 228,
!NE* 229, 230, 231, 232, 233,
!NE* 74, 224, 90, 95, 109,
!NE* 121, 129, 130, 131, 132,
!NE* 133, 134, 135, 136, 137,
!NE* 145, 146, 147, 148, 149,
!NE* 150, 151, 152, 153, 162,
!NE* 163, 164, 165, 166, 167,
!NE* 168, 169, 192, 106, 208,
!NE* 161, 7, 32, 33, 34,
!NE* 35, 36, 37, 6, 23,
!NE* 40, 41, 42, 43, 44,
!NE* 9, 10, 27, 48, 49,
!NE* 26, 51, 52, 53, 54,
!NE* 8, 56, 57, 58, 59,
!NE* 4, 20, 62, 225, 65,
!NE* 66, 67, 68, 69, 70,
!NE* 71, 72, 73, 81, 82,
!NE* 83, 84, 85, 86, 87,
!NE* 88, 89, 98, 99, 100,
!NE* 101, 102, 103, 104, 105,
!NE* 112, 113, 114, 115, 116,
!NE* 117, 118, 119, 120, 128,
!NE* 138, 139, 140, 141, 142,
!NE* 143, 144, 154, 155, 156,
!NE* 157, 158, 159, 160, 170,
!NE* 171, 172, 173, 174, 175,
!NE* 176, 177, 178, 179, 180,
!NE* 181, 182, 183, 184, 185,
!NE* 186, 187, 188, 189, 190,
!NE* 191, 202, 203, 204, 205,
!NE* 206, 207, 218, 219, 220,
!NE* 221, 222, 223, 234, 235,
!NE* 236, 237, 238, 239, 250,
!NE* 251, 252, 253, 254, 255
!NE*
!NE* %CONSTBYTEINTEGERARRAY ETOITAB(0 : 255) = %C
!NE* 0,
!NE* 1, 2, 3, 156, 9,
!NE* 134, 127, 151, 141, 142,
!NE* 11, 12, 13, 14, 15,
!NE* 16, 17, 18, 19, 157,
!NE* 10, 8, 135, 24, 25,
!NE* 146, 143, 28, 29, 30,
!NE* 31, 128, 129, 130, 131,
!NE* 132, 133, 23, 27, 136,
!NE* 137, 138, 139, 140, 5,
!NE* 6, 7, 144, 145, 22,
!NE* 147, 148, 149, 150, 4,
!NE* 152, 153, 154, 155, 20,
!NE* 21, 158, 26, 32, 160,
!NE* 161, 162, 163, 164, 165,
!NE* 166, 167, 168, 91, 46,
!NE* 60, 40, 43, 33, 38,
!NE* 169, 170, 171, 172, 173,
!NE* 174, 175, 176, 177, 93,
!NE* 36, 42, 41, 59, 94,
!NE* 45, 47, 178, 179, 180,
!NE* 181, 182, 183, 184, 185,
!NE* 124, 44, 37, 95, 62,
!NE* 63, 186, 187, 188, 189,
!NE* 190, 191, 192, 193, 194,
!NE* 96, 58, 35, 64, 39,
!NE* 61, 34, 195, 97, 98,
!NE* 99, 100, 101, 102, 103,
!NE* 104, 105, 196, 197, 198,
!NE* 199, 200, 201, 202, 106,
!NE* 107, 108, 109, 110, 111,
!NE* 112, 113, 114, 203, 204,
!NE* 205, 206, 207, 208, 209,
!NE* 126, 115, 116, 117, 118,
!NE* 119, 120, 121, 122, 210,
!NE* 211, 212, 213, 214, 215,
!NE* 216, 217, 218, 219, 220,
!NE* 221, 222, 223, 224, 225,
!NE* 226, 227, 228, 229, 230,
!NE* 231, 123, 65, 66, 67,
!NE* 68, 69, 70, 71, 72,
!NE* 73, 232, 233, 234, 235,
!NE* 236, 237, 125, 74, 75,
!NE* 76, 77, 78, 79, 80,
!NE* 81, 82, 238, 239, 240,
!NE* 241, 242, 243, 92, 159,
!NE* 83, 84, 85, 86, 87,
!NE* 88, 89, 90, 244, 245,
!NE* 246, 247, 248, 249, 48,
!NE* 49, 50, 51, 52, 53,
!NE* 54, 55, 56, 57, 250,
!NE* 251, 252, 253, 254, 255
!*
!*
!*
SYSTEMROUTINE INITMAIN(INTEGER SYS,MODE)
!* MODE = 0 INITIAL ENTRY
!* 1 NEW PRIMARY OUTPUT FILE BEING OPENED
!* 2 INITIALISATION COMPLETE, SET 'NO CURRENT STREAM'
!* 3 INITIAL ENTRY FOR EXECUTE JOB
INTEGER I
IF MODE=2 THEN OUTFD=-1 AND RETURN
OPSYS=SYS
OUTFD=0
RETURN IF MODE=1
LOG99SET=0
BASECPU=0
!*NE ICL9CEDETOI=ADDR(ETOITAB(0))
!*NE ICL9CEDITOE=ADDR(ITOETAB(0))
CYCLE I=0,1,63
SSCOMREG(I)=0
REPEAT
SSCOMREG(11)=INTEGER(ASSCOM+44)
SSCOMREG(12)=INTEGER(ASSCOM+48)
SSCOMREG(21)=ADDR(BASICFDS(0))
SSCOMREG(29)=ADDR(SSCOMREG(0))
SSCOMREG(49)=ADDR(TC_PAGE COUNT)
SSCOMREG(57)=ADDR(OBJ FILE ENTRY)
OBJ FILE ENTRY=''
!*SJ; TC_OUTPUT LIMIT=10000
!*SJ; TC_PAGE SIZE=66
!*SJ; TC_TOTAL PRINT COUNT = 0
!*SJ; TC_USER PRINT COUNT = 0
!*SJ; TC_USER TRANSFER COUNT = 0
INFD=0;! WILL ENSURE %THAT INITIAL SELECT IS PERFORMED
!*NE %IF MODE=3 %THEN ICL9CEFAC=4;! EXECUTE, ICL9CEFAC NOT SET
END ;! INITMAIN
!*
!*
!*NE %SYSTEMLONGREALFN CPUTIME
!*NE %INTEGER I
!*NE I = READ CPU TIME
!*NE %IF BASECPU=0 %THEN BASECPU=I
!*NE %RESULT = (I-BASECPU)*0.001
!*NE %END; ! CPUTIME
!*
!*NE %SYSTEMROUTINE DATIME(%STRINGNAME DATE,TIME)
!*NE %STRING (10) D, T, U, V
!*NE D='YYYY.MM.DD'
!*NE T='HH:MM:SS'
!*NE DATE AND TIME(D,T)
!*NE TIME=T
!*NE %IF D -> ('19').T.('/').U.('/').V %C
!*NE %THEN D = V.'/'.U.'/'.T
!*NE DATE=D
!*NE %END;! DATIME
!*
!*
!*
ROUTINESPEC SIGNAL(INTEGER EP,P1,P2,INTEGERNAME F)
!*
SYSTEMINTEGERFN COMPILE(INTEGER COMP,MODE,NEWP)
!*
!****** CALL APPROPRIATE COMPILER
!*
LONGINTEGER DESC
INTEGER I,SAVELNB
*STSF_I
SAVELNB=SSCOMREG(36)
SSCOMREG(36)=I
I=INITCOMP(COMP,MODE,NEWP)
IF I>0 THEN RESULT =I
DESC=LONGINTEGER(SSCOMREG(59)+(COMP-1)<<3)
*STLN_TOS
*ASF_4
*LD_DESC
*RALN_5
*PUT_X'1FDC' ;! CALL @(DR)
!*
!****************
!*
SSCOMREG(36)=SAVELNB
SIGNAL(1,0,0,I);! POP UP CONTINGENCY
I=SET CONTENT LIMIT('SS#WRK',0)
RESULT =0
END ;! COMPILE
!*
SYSTEMROUTINE OUTPUT TRAP
!*SJ; TC_OUTPUT LIMIT=TC_OUTPUT LIMIT-TC_PAGE SIZE
!*SJ; TC_USER PRINT COUNT = TC_USER PRINT COUNT + TC_PAGE SIZE
!*SJ; TC_PAGE COUNT=TC_PAGE SIZE
!*E; %IF TC_OUTPUT LIMIT<0 %START
!*NE !*SJ %IF TC_OUTPUT LIMIT<0 %AND ICL9CEFAC=0 %THENSTART
!*SJ TC_OUTPUT LIMIT=200
!*E; TC_OUTPUT LIMIT=5000 ;! 200 NOT ENOUGH FOR DIAGNOSTICS!
!*E; ALLDIAGS(0) %IF SSCOMREG(25)&1=1
!*SJ; IOCP(11,-1)
!*SJ; ON OUTPUT LIMIT
!*SJ; %FINISH
END
!*
SYSTEMROUTINESPEC MOVE(INTEGER LENGTH, FROM, TO)
!*NE %INTEGER I
!*NE %RETURNIF LENGTH <= 0
!*NE I = X'18000000'!LENGTH
!*NE *LSS_FROM
!*NE *LUH_I
!*NE *LDTB_I
!*NE *LDA_TO
!*NE *MV_%L=%DR
!*NE %END; !OF MOVE
!*NE !*
!*NE %SYSTEMROUTINE FILL(%INTEGER LENGTH, FROM,FILLER)
!*NE %INTEGER I
!*NE %RETURNIF LENGTH <= 0
!*NE I = X'18000000'!LENGTH
!*NE *LDTB_I
!*NE *LDA_FROM
!*NE *LB_FILLER
!*NE *MVL_%L=%DR
!*NE %END
!*NE !*
!*NE %SYSTEMROUTINE ETOI(%INTEGER AD, L)
!*NE %INTEGER I, J, K
!*NE I = ADDR(ETOITAB(0))
!*NE %RETURNIF L <= 0
!*NE J = X'18000100'
!*NE K = X'18000000'!L
!*NE *LSS_I
!*NE *LUH_J
!*NE *LDTB_K
!*NE *LDA_AD
!*NE *TTR_%L=%DR
!*NE %END; ! ETOI
!*NE !*
!*NE %SYSTEMROUTINE ITOE(%INTEGER AD, L)
!*NE %INTEGER I, J, K
!*NE I = ADDR(ITOETAB(0))
!*NE %RETURNIF L <= 0
!*NE J = X'18000100'
!*NE K = X'18000000'!L
!*NE *LSS_I
!*NE *LUH_J
!*NE *LDTB_K
!*NE *LDA_AD
!*NE *TTR_%L=%DR
!*NE %END; ! ITOE
!*NE !*
!*
SYSTEMROUTINE SIM2(INTEGER EP, R1, R2, INTEGERNAME R3)
OWNINTEGER EMNL = X'190A0000'
INTEGER I,J,FIRST,ROUTE,PAGE COUNT
INTEGER AFD
RECORDNAME F(NRFDFMT)
!*E; %INTEGER PIDR0,PIDR1,K,NEWSIZE,FSF
OWNBYTEINTEGERARRAY LOGBUFF(0:119)
SWITCH ENTRY(0 : 17)
SWITCH IN(0:9),OUT(0:8)
-> ENTRY(EP)
!***************************************************************
ENTRY(0): ! READ A RECORD FROM CURR SELECTED I/P STREAM
! R1 = ADDR(BUFFER) (@ 160 BYTE BUFFER)
! R2 = MODE
! 0 FULL RECORD, EM FOR //
! 1 FULL RECORD
! 2 NEXT FULL RECORD
! ON EXIT R3<0 ERROR
! =0 160 CHARS(NO NL
! >0 LENGTH
IF INFD=0 THEN SELECT INPUT(108);! DEFAULT INPUT
F == RECORD(INFD)
ROUTE=F_ACCESS ROUTE
->IN(ROUTE)
!****** PRIMARY INPUT
IN(1):
!*NE !*SJ %IF SSCOMREG(56)=0 %THENSTART
!*K I=FILEOP(ADDR(F_C0),F_MODE&15,1,F_AREC,80,0)
!*NE !*B I=FASTFILEOP(ADDR(F_C0))
!*NE %IF I>0 %THENSTART
!*E; EOF:%IF R1=-1 %THEN R3=-1 %ELSESTART
! NOTE EOF: SHIFTED UP ONE LINE FOR EMAS 2970
MOVE(2,ADDR(EMNL),R1)
R3 = 2
!*E; %FINISH
RETURN
!*NE %FINISH
!*NE !*SJ %FINISH
!*NE I=F_AREC
!*NE J=F_RECSIZE
!*NE !*SJ SSCOMREG(56)=0
!*NE MOVE(J,I,R1)
!*NE ETOI(R1,J)
!*NE BYTEINTEGER(R1+J)=NL
!*NE R3=J+1
!*K %IF ICL9CEFAC#0 %THEN ->KCHECK
!*NE !*SJ %IF BYTEINTEGER(R1)#'/' %THEN %RETURN
!*NE !*SJ %IF R2#0 %OR BYTEINTEGER(R1+1)#'/' %THEN %RETURN
!*NE !*SJ SSCOMREG(56)=1
!*NE !*SJ ->EOF
!*NE %RETURN
!*NE !****** MAPPED PRIMARY INPUT
!*NE IN(7):
!*NE !****** MAPPED FILE
!*NE IN(3):
!*NE I=F_C2
!*NE %IF I>=F_C3 %THEN ->EOF
!*NE MOVE(80,I,R1)
!*NE !*NE ETOI(R1,80)
!*NE BYTEINTEGER(R1+80)=NL
!*NE %IF ROUTE=7 %AND R2=0 %THENSTART
!*NE %IF BYTEINTEGER(R1)='/' %AND BYTEINTEGER(R1+1)='/' %THEN ->EOF
!*NE %FINISH
!*NE F_C2=I+80
!*NE R3=81
!*NE %RETURN
!****** STANDARD FILE
!*NE IN(4):
!*K I=FILEOP(ADDR(F_C0),F_MODE&15,1,F_AREC,F_MAXREC,0)
!*NE !*B I=FASTFILEOP(ADDR(F_C0))
!*NE %IF I>0 %THENSTART
!*NE %IF I=153 %THEN ->EOF
!*NE SSERR(I)
!*NE %FINISH
!*NE !*S J TC_USER TRANSFER COUNT = TC_USER TRANSFER COUNT + 1
!*NE I=F_RECSIZE
!*NE %IF I>160 %THEN I=160
!*NE MOVE(I,F_AREC,R1)
!*NE ETOI(R1,I)
!*NE BYTEINTEGER(R1+I)=NL
!*NE R3=I+1
!*NE KCHECK:
!*K %IF OPSYS=2 %THENSTART
!*K I=BYTEINTEGER(R1)
!*K %IF I='*' %OR I='/' %THENSTART
!*K %IF BYTEINTEGER(R1+1)=I %THENSTART
!*K %IF BYTEINTEGER(R1+2)=I %AND BYTEINTEGER(R1+3)=I %THEN ->EOF
!*K %FINISH
!*K %FINISH
!*K %FINISH
!*NE %RETURN
!****** EMAS PRIMARY INPUT
IN(9):
!****** EMAS MAPPED FILE
IN(3):
IN(8):
!*E*; %IF INTEGER(F_C0+12)=4 %START ;! FORTRAN SQ FILE
!*E; %IF F_C2>=F_C0+INTEGER(F_C0) %THEN ->EOF
!*E*; K=((BYTEINTEGER(F_C2)<<8)!BYTEINTEGER(F_C2+1))-2
!*E; F_C2=F_C2+2
!*E; FSF=K
!*E; %FINISHELSESTART
!*E; FSF=0
!*E; PIDR0=F_RECORDS
!*E; %IF PIDR0=0 %THEN %START
IF ROUTE=3 THEN PIDR0=X'58000000'!(F_C3-F_C2) ELSEC
PIDR0=X'58000000'!(INTEGER(F_C0)-INTEGER(F_C0+4))
FINISH
!*E; !!
!*E; PIDR1=F_C2
!*E; !!
!*E; *LDTB_PIDR0
!*E; *LDA_PIDR1
!*E; *LB_10 ;! NL
!*E; *PUT_X'A300' ;! SWNE
!*E; *JCC_8,<EOF> ;!BIT 0 OF CC SET IF NOT FOUND
!*E; *MODD_1 ;! GET PAST NL
!*E; *STD_PIDR0
!*E; !!
!*E; K=PIDR1-F_C2 ;! FIND OUT LINE LENGTH
!*E; !!
!*E; !! IMP EQUIVELANT
!*E; ! %CYCLE K=F_C2,1,F_C0+INTEGER(F_C0)
!*E; ! %IF BYTEINTEGER(K)=10 %THEN %EXIT
!*E; ! %REPEAT
!*E; ! K=K+1-F_C2
!*E; %FINISH
!*E; %IF K>160 %THEN K=160
!*E; MOVE(K,F_C2,R1) %UNLESS R1=-1
!*E; %IF FSF#0 %THEN BYTEINTEGER(R1+K)=NL %AND K=K+1
!*E; R3=K
!*E; %IF ROUTE=3 %OR ROUTE=9 %THENSTART;! CHECK FOR //
!*E; %IF BYTEINTEGER(F_C2)='/' %THENSTART
!*E; %IF R2=0 %AND BYTEINTEGER(F_C2+1)='/' %THEN ->EOF
!*E; %FINISH
!*E; %FINISH
!*E; %IF FSF=0 %THEN F_C2=PIDR1 %ELSE F_C2=F_C2+FSF
!*E; F_RECORDS=PIDR0
!*E; %RETURN
!*
!***************************************************************
ENTRY(1): ! WRITE A RECORD
! R1 = ADDR(BUFFER)
! R2 = LENGTH
! FIRST CHAR IS CONTROL CR,NL,NP
IF OUTFD=-1 THENSTART
OUTFD=0
SIM2(15,1,99,I)
FINISH
F == RECORD(OUTFD)
FIRST=BYTEINTEGER(R1)
IF OUTFD=0 OR F_DSNUM=100 THENSTART ;! DEFAULT TO LOG
R1=R1+1
R2=R2-1
I=ADDR(LOGBUFF(0))
!*NE %IF R2>120 %THEN R2=120
IF R2<=0 THENSTART ;! AT LEAST 1 CHAR REQUIRED
BYTEINTEGER(I)=' '
R2=1
FINISHELSESTART
MOVE(R2,R1,I)
FINISH
!*NE %IF OPSYS#0 %THEN ITOE(I,R2)
!*NE %IF LOG99SET=2 %THENSTART;! OPEH OUTPUT
!*NE J=-1
!*NE ICL9HEDIAGOUT(J,X'18000000'!R2,I)
!*NE %FINISHELSE %C
LOG(I,R2)
!*E; LOG(I,R2)
R3=0
RETURN
FINISH
->OUT(F_ACCESS ROUTE)
!****** PRIMARY OUTPUT
OUT(2): IF R2>133 THEN R2=133
!*E; F_RECSIZE=R2
!*NE I=F_AREC
!*NE MOVE(R2,R1,I)
!*NE ITOE(I,R2)
!*NE ! %IF R2<133 %THEN FILL(133-R2,I+R2,X'40')
!*NE F_RECSIZE=R2
!*K I=FILE OP(ADDR(F_C0),F_MODE&15,2,F_AREC,R2,0)
!*NE !*B I=FASTFILEOP(ADDR(F_C0))
!*NE %IF I>0 %THENSTART
!*E; %IF F_C2+R2>F_C3 %THEN EXPAND PRIMARY OUTPUT FILE(F)
!*NE OUTFD=0
!*NE LOG99SET=1
!*NE IOCP(11,-1)
!*NE PRINTSTRING('
!*NE ***FAILURE WHILE WRITING TO PRIMARY OUTPUT FILE - FILE FULL
!*NE ')
!*NE STOPBASE
!*NE %FINISH
!*E; MOVE(R2,R1,F_C2)
!*E; F_C2=F_C2+R2 ;! INCREMENT CURRENT POINTER
!*E; INTEGER(F_C0)=F_C2-F_C0 ;! PUT CURRENT SIZE IN FILE HEADER
!*E; F_AREC=F_C2
!*NE !*SJ %IF ICL9CEFAC=0 %THENSTART;! JOBBER MODE
!*SJ; PAGE COUNT=TC_PAGE COUNT
!*SJ; %IF FIRST=12 %THEN PAGE COUNT=0
!*SJ; PAGE COUNT=PAGE COUNT-1
!*SJ; %IF PAGECOUNT<0 %THEN OUTPUT TRAP %ELSESTART
!*SJ; TC_PAGE COUNT=PAGE COUNT
!*SJ; %FINISH
!*NE !*SJ %FINISH
RETURN
!****** MAPPED FILE
OUT(3):
OUT(7): SSERR(183);! INVALID I/O OPERATION
!****** STANDARD FILE
OUT(4): UNLESS BYTEINTEGER(R1)=12 THENSTART ;! EXCEPT NEWPAGE
R1=R1+1
R2=R2-1
FINISH
OUT(8):
IF R2<=0 THENSTART
BYTEINTEGER(R1)=' '
R2=1
FINISH
!*NE %IF R2>F_MAXREC %THEN R2=F_MAXREC
!*NE I=F_AREC
!*NE MOVE(R2,R1,I)
!*NE ITOE(I,R2)
!*NE !*SJ TC_USER TRANSFER COUNT = TC_USER TRANSFER COUNT + 1
F_RECSIZE=R2
!*K I=FILEOP(ADDR(F_C0),F_MODE&15,2,I,R2,0)
!*NE !*B I=FASTFILEOP(ADDR(F_C0))
!*NE %IF I#0 %THEN SSERR(I)
!*E; %IF F_C2+R2>F_C3 %THEN SSERR(I)
!*E; MOVE(R2,R1,F_C2)
!*E; F_C2=F_C2+R2
!*E; INTEGER(F_C0)=F_C2-F_C0
!*E; F_AREC=F_C2
RETURN
!*
!**************************************************************
ENTRY(14): ! SELECTOUTPUT(COMREG(23))
R1=1
R2=SSCOMREG(23)
RETURN IF R2=0
SSCOMREG(23)=0;! TO FORCE FULL ACTION
!*
!*************************************************************
ENTRY(15): ! SELECT INPUT-OUTPUT STREAM
IF R2=100 THENSTART
OUTFD=0
SSCOMREG(23)=0
R3=X'184'
RETURN
FINISH
I=SELECTIO(R1,R2,R3)
IF I>0 THENSTART
!*E; R3 = -1 ;! PASS BACK ERROR
!*NE %UNLESS R2=99 %AND I=152 %AND ICL9CEFAC#0 %THEN SSERR(I)
FINISH
RETURN
!*****************************************************************
ENTRY(16): ! SET MARGINS
IF R1 = 0 THEN F == RECORD(INREQFD) C
ELSE F == RECORD(OUTREQFD)
F_LM = (R2>>8)&X'FF'
F_RM = R2&X'FF'
RETURN
!*****************************************************************
ENTRY(17): ! CLOSE STREAM
! R1 = STREAM
IF R1 = SSCOMREG(22) OR R1 = SSCOMREG(23) THEN SSERR(29);! STREAM IN USE
AFD = FDMAP(R1)
IF AFD = 0 THEN SSERR(24);! STREAM NOT DEFINED
I=CLOSE(AFD)
IF I>0 THEN SSERR(I)
R3 = 0
RETURN
END ; ! SIM2
!***** *****
INTEGERFN SELECTIO(INTEGER MODE, STREAM, INTEGERNAME MARGINS)
!**** ***
! STREAM=STREAM NUMBER TO BE SELECTED
! MODE=0 FOR READ,1 FOR WRITE
!**** ***
RECORDNAME F(NRFDFMT)
INTEGER I, AFD
INTEGER REQST, REQFD
! %IF STREAM = 0 %THEN STREAM = 90+MODE;! MAP 0 TO 90 OR 91 FOR TTY
UNLESS 0<STREAM<=109 THEN RESULT =24
REQST = STREAM
REQFD = 0
IF MODE=1 AND LOG99SET=1 AND STREAM=99 THENSTART
MARGINS=X'184';! MARGINS
OUTFD=0
RESULT =0
FINISH
START:
IF STREAM = SSCOMREG(22+MODE) THENSTART
IF REQFD = 0 THENSTART
IF MODE = 0 THEN REQFD = INFD C
ELSE REQFD = OUTFD
FINISH
-> MARGINS
FINISH
LOOK: AFD = FDMAP(STREAM)
IF AFD = 0 THENSTART
IF STREAM=107 THENSTART
!*E; STREAM=99
!*E; ->LOOK
!*NE %IF ICL9CEFAC=0 %THEN STREAM=99 %AND ->LOOK;! JOBBER
OUTFD=0;! SELECT 100
SSCOMREG(23)=0
MARGINS=X'184'
RESULT =0
FINISH
IF STREAM=104 AND MODE=0 THEN INFD=0 AND ->M1AND132
!*NE %IF ICL9CEFAC>0 %THENSTART
!*NE I=LOCATE CHANNEL(STREAM)
!*NE %IF I=0 %THEN ->LOOK
!*NE %FINISH
IF 1<=STREAM<=2 THEN STREAM=100-STREAM AND -> LOOK
IF STREAM=98 THEN STREAM=108 AND ->LOOK
IF STREAM=89 THEN STREAM=99 AND ->LOOK
RESULT =24;! STREAM NOT DEFINED
FINISH
! NOT DEFINED
F == RECORD(AFD)
IF REQFD = 0 THEN REQFD = AFD
IF F_ACCESS ROUTE = 6 THENSTART
STREAM = F_ASVAR
! %IF STREAM = 0 %THEN STREAM = 90+MODE
-> START
FINISH
IF F_FLAGS&3+MODE=2 THEN RESULT =29;! STREAM IN ALTERNATE USE
IF F_STATUS<3 THENSTART
IF MODE=0 THENSTART ;! INPUT
F_VALID ACTION=X'21';! READ,CLOSE
UNLESS F_MODE=0 THEN F_MODE=2;! OPEN FOR FORWARD READ
FINISHELSESTART ;! OUTPUT
F_VALID ACTION=X'22';! WRITE,CLOSE
IF STREAM=99 THEN F_MODE=6 ELSE F_MODE=11;! OPEN FOR READ,WRITE
FINISH
I=OPEN(AFD,MODE+1)
IF I > 0 THENSTART
IF STREAM = 99 OR STREAM=108 THENSTART
OUTFD=0
!E*; SELECT OUTPUT(100)
!E*; SSERR(I)
!*; STOPBASE
! SSABORT(1)
FINISH
RESULT =I
FINISH
FINISH
!*E; %IF MODE=1 %AND INTEGER(F_C0+12)=4 %THENC
INTEGER(F_C0+12)=3
IF MODE = 0 THEN INFD = AFD ELSE OUTFD = AFD
F_FLAGS = F_FLAGS!(1<<MODE)
MARGINS:
IF MODE = 0 THEN INREQFD = REQFD C
ELSE OUTREQFD = REQFD
SSCOMREG(22+MODE) = REQST
F == RECORD(REQFD)
! MARGINS = (F_LM<<8)!F_RM
M1AND132:MARGINS=X'184'
RESULT =0
END ; ! SELECTIO
!*
SYSTEMINTEGERMAP COMREG(INTEGER I)
RESULT = ADDR(SSCOMREG(I))
END ; !OF COMREG
!*
SYSTEMROUTINE LOG99
OUTFD=0
LOG99SET=1
END ;! LOG99
!*
OWNINTEGER SAVE OUTFD
!*
SYSTEMROUTINE OPEH99(INTEGER MODE)
!* MODE = 0 REVERT TO PREVIOUS STATE
!* 1 DEFAULT TO DIAGOUT
IF MODE#0 THENSTART
SAVE OUTFD=OUTFD
OUTFD=0
LOG99SET=2
FINISHELSESTART
OUTFD=SAVE OUTFD
LOG99SET=0
FINISH
!*
END ;! OPEH99
!*
CONSTINTEGER MAXSIGLEVEL=2
!*
RECORDFORMAT SIGDATAFMT(INTEGER PC, LNB, CLASS, SUBCLASS, C
INTEGERARRAY A(0 : 17))
!*
SYSTEMROUTINE SIGNAL(INTEGER EP, P1, P2, INTEGERNAME F)
!***********************************************************************
!* EP = 0 STACK RECOVERY INFO *
!* P1 = PC *
!* P2 = LNB
!* 1 UNSTACK RECOVERY INFORMATION *
!* P1 = 0 ONE LEVEL *
!* 1 ALL LEVELS *
!* 2 SIGNAL ERROR OF CLASS P1 AND SUBCLASS P2 AT CURRENT LEVEL *
!* 3 DITTO AT OUTER LEVEL *
!* 4 REPEAT LATEST CONTINGENCY AT CURRENT LEVEL *
!* 5 RETURN TO USER MODE WITH NOMINATED ENVIRONMENT *
!* 6 SET INTEGER AT P1 TO CURRENT NUMBER OF LEVELS *
!***********************************************************************
RECORDNAME D(SIGDATAFMT)
INTEGER I,SIGLEVEL
SWITCH SW(-1 : 6)
F = 0
SIGLEVEL=SSCOMREG(34)
-> SW(EP)
!*
SW(0):
!*NE %UNLESS ICL9CEFAC=0 %THENSTART
!*NE %IF INTEGER(P2+4)>>28#X'E' %THEN I=INTEGER(P2) %ELSE I=P2
!*NE COMREG(36)=I
!*NE %FINISH
SW(-1): ! CALL FROM NDIAG
! %IF EP=0 %THENSTART
! %IF ICL9CEAUXST=0 %THEN ->INIT
! I=INTEGER(P2+4)>>24
! %IF I#X'E1' %THENSTART;! NOT A CODE DESCRIPTOR
! %IF I=X'E3' %THENSTART;! WAS OUTWARD CALL FROM SYS
!INIT: ICL9CEJINIT
! SIGLEVEL=0
! COMREG(36)=P2
! ICL9CEFAC=4
! %FINISHELSESTART
! I=INTEGER(INTEGER(P2)+4)>>24
! %IF I=X'E3' %THEN ->INIT
! %FINISH
! %FINISH
! %FINISH
IF SIGLEVEL>=MAXSIGLEVEL THEN F=1 AND RETURN
SIGLEVEL =SIGLEVEL+1
!TEMP TO STOP NDIAG IFNOT INITED
!*E; %RETURN %IF SSCOMREG(33)=0
D == RECORD(SSCOMREG(33)+88*SIGLEVEL)
D_PC = P1
D_LNB = P2
OUT: SSCOMREG(34)=SIGLEVEL
INTEGER(SSCOMREG(33)+4)=0;! ENSURE FALLBACK TRAP EFFECTIVE
RETURN
!*
SW(1): IF SIGLEVEL <= 0 THEN F = 1 ANDRETURN
IF P1 = 0 THEN SIGLEVEL = SIGLEVEL-1 C
ELSE SIGLEVEL = 0
-> OUT
!*
SW(2):
!*
SW(3): *PUT_X'5D98'; ! STLN (TOS)
*PUT_X'6398'; ! LSS (TOS)
**=I
ONTRAPACT(EP,P1,P2,INTEGER(I+8),INTEGER(I))
!*
SW(4): ONTRAPACT(4,P1,P2,0,0)
!*
SW(5): MONITOR ;STOP
!*
SW(6): INTEGER(P1) = SIGLEVEL
END ; ! SIGNAL
!*
!*
!*
!*NE %EXTERNALINTEGERFNSPEC ICL9HENOMDESC(%LONGINTEGER NAME DESC, %C
INTEGER P0,P1,P2,P3)
!*
!*NE %SYSTEMINTEGERFN NOMDESC(%LONGINTEGER NAME DESC,%INTEGER P0,P1,P2,P3)
!*NE %RESULT=ICL9HENOMDESC(NAME DESC,X'B0000002',P1,0,0)
!*NE %END;! NOMDESC
!*
!*
!%OWNLONGINTEGERARRAY AREADESC(0:47)
!%OWNINTEGERARRAY AREAADDR(1:16)
!%CONSTINTEGER NUMAREASENV = 21, %C
! NUMFILESENV = 7, %C
! NUMFILESFAC = 6
!%SYSTEMINTEGERFNSPEC READ LOAD DETAILS(%INTEGER AREAADDR, ADDRDESC, %C
! %INTEGERNAME LEN)
!%ROUTINESPEC CHECKAREAS(%INTEGER AD1,AD2,DESC1,DESC2)
SYSTEMROUTINE GET AREA DESCS(INTEGER M1,M2,DM1,DM2, F1,F2,DF1,DF2, C
D1,D2,DD1,DD2, O1,O2,DO1,DO2, C
LP1,LP2,DLP1,DLP2, C
FL1,FL2,DFL1,DFL2, AL1,AL2,DAL1,DAL2)
!%LONGINTEGERARRAYFORMAT COMPSF(1:6)
!%LONGINTEGERARRAYNAME COMPS
!%INTEGER I,RC,INDEX,LEN,TRACE
!%STRING(16)%FN HEXOF(%LONGINTEGER DEC)
!%INTEGER I,DIGIT
!%STRING(16) S
!%CONSTSTRING(1)%ARRAY HT (0:15) = '0','1','2','3','4','5',
! '6','7','8','9','A','B','C','D','E','F'
!S = ""
!%CYCLE I = 1,1,16
!DIGIT = DEC&15
!S = HT(DIGIT).S
!DEC=DEC>>4
!%REPEAT
!%RESULT=S
!%END
!TRACE=COMREG(26)>>31
!COMPS == ARRAY(SSCOMREG(59),COMPSF)
!%CYCLE I=1,1,6
! %IF COMPS(I)#0 %C
! %THEN AREAADDR(I)=INTEGER((COMPS(I)&X'00000000FFFFFFFF')+4) %C
! %ELSE AREAADDR(I)=0
!%REPEAT
!%IF TRACE#0 %THENSTART
!%CYCLE I=1,1,6
! WRITE(AREAADDR(I),10)
! NEWLINE
!%REPEAT
!%FINISH
!%IF ICL9CEFAC=0 %THEN INDEX=4 %ELSE INDEX=ICL9CEFAC
!RC=READ LOAD DETAILS(AREAADDR(INDEX),ADDR(AREADESC(NUMAREASENV)),LEN)
!%IF TRACE#0 %THENSTART
!WRITE(LEN,5); NEWLINE
!%FINISH
!%RETURN %IF RC > 0
!CHECK AREAS(1,NUMFILESFAC,NUMAREASENV,LEN)
!!*
!AREAADDR(7) = INTEGER(M2+4)
!AREAADDR(8) = INTEGER(F2+4)
!AREAADDR(9) = INTEGER(D2+4)
!AREAADDR(10)= INTEGER(O2+4)
!AREAADDR(11)= INTEGER(LP2+4)
!AREAADDR(12)= INTEGER(FL2+4)
!AREAADDR(13)= INTEGER(AL2+4)
!%IF TRACE#0 %THENSTART
!%CYCLE I=7,1,13
! WRITE(AREAADDR(I),10)
! NEWLINE
!%REPEAT
!%FINISH
!RC=READ LOAD DETAILS(AREAADDR(7),ADDR(AREADESC(0)),LEN)
!%IF TRACE#0 %THENSTART
!WRITE(LEN,5); NEWLINE
!%FINISH
!%RETURN %IF RC > 0
!CHECKAREAS(NUMFILESFAC+1,NUMFILESENV,0,LEN)
!%IF TRACE#0 %THENSTART
!%CYCLE I = 0,1,47
!PRINTSTRING(HEXOF(AREADESC(I)))
!NEWLINE
!%REPEAT
!%CYCLE I=1,1,16
! WRITE(AREAADDR(I),10)
! NEWLINE
!%REPEAT
!%FINISH
END ; ! OF GET AREA DESCS
!*
!%ROUTINE CHECK AREAS(%INTEGER ADDR1,ADDR2,DESC1,DESC2)
!%INTEGER I,J,FLAG,ADR,BOUND
!%CYCLE I=ADDR1,1,ADDR1+ADDR2-1
! %IF AREAADDR(I)#0 %THEN %START
! FLAG=0
! %CYCLE J=DESC1,1,DESC1+DESC2
! BOUND=INTEGER(ADDR(AREADESC(J)))&X'00FFFFFF'
! ADR=INTEGER(ADDR(AREADESC(J))+4)
! %IF ADR<=AREAADDR(I)<ADR+BOUND %THEN FLAG=1 %AND %EXIT
! %REPEAT
! %IF FLAG=1 %THEN AREAADDR(I)=ADDR(AREADESC(J)) %ELSE AREAADDR(I)=0
! %FINISH
!%REPEAT
!%END
ENDOFFILE