!* MODIFIED 20/02/78 09.00
!*
EXTRINSICINTEGER ICL9CEFDMAP
!*NE %EXTRINSICINTEGER ICL9CEFAC
EXTRINSICINTEGER ICL9CETC
!*
CONSTINTEGER INDEFAULT=5
CONSTINTEGER OUTDEFAULT=6
!*
!*
!****** BBASE FUNCTIONS
!*
!*E; %SYSTEMROUTINESPEC EXPAND PRIMARY OUTPUT FILE(%RECORDNAME F)
!*NE %SYSTEMINTEGERFNSPEC SET SQ MODE(%INTEGER AD REC CCY,ACCESS TYPE,MODE)
SYSTEMINTEGERFNSPEC POSITION SQ FILE(INTEGER ACCESS DR ADDR, C
POSITION)
!%SYSTEMINTEGERFNSPEC FILEOP(%INTEGER ACCESS DR ADDR,ACCESS TYPE, %C
! OPTYPE,BUFFAD,BUFFLEN,DISPLACEMENT)
!*NE %SYSTEMINTEGERFNSPEC DA FILE OP(%INTEGER ADA,ACC,OPTYPE,DISP)
!*NE %SYSTEMINTEGERFNSPEC FAST FILE OP(%INTEGER ADA)
!*
!****** MAIN
!*
!*NE %SYSTEMINTEGERMAPSPEC COMREG(%INTEGER I)
SYSTEMROUTINESPEC MOVE(INTEGER L, FROM, TO)
SYSTEMROUTINESPEC OUTPUT TRAP
SYSTEMROUTINESPEC SIGNAL(INTEGER I,J,K,INTEGERNAME F)
!*
!****** FILE
!*
SYSTEMINTEGERFNSPEC OPEN(INTEGER AFD,MODE)
SYSTEMINTEGERFNSPEC CLOSE(INTEGER AFD)
!*NE %SYSTEMINTEGERFNSPEC LOCATE CHANNEL(%INTEGER CHAN)
!*NE %SYSTEMINTEGERFNSPEC JBR CALL(%INTEGER ENTRY,%INTEGERNAME PARAM)
!*
!****** DIAG
!*
SYSTEMROUTINESPEC SSERR(INTEGER N)
SYSTEMROUTINESPEC NDIAG(INTEGER PCOUNT,LNB,FAULT,INF)
SYSTEMROUTINESPEC FAUX1(INTEGER EP,P1,P2)
!*
!*
!*E; %SYSTEMINTEGERFNSPEC GET ROUTE(%INTEGER AFD)
!*
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)
!*
!*
OWNINTEGER CURRENT FD
!*
SYSTEMINTEGERFN NEWFILEOP(INTEGER DSNUM,ACTION,TYPE,INTEGERNAME AFD)
INTEGERFNSPEC SPECIAL ACTION
CONSTBYTEINTEGERARRAY SIMPLE VALID ACTION (0:7)= C
0,X'73',X'7D',X'7E',X'70',X'7C',0,0
RECORDNAME F(NRFDFMT)
INTEGER I,J,K
!*
UNLESS 0 < DSNUM < 100 THEN RESULT = 164;! INVALID DATA SET NUMBER
!*E; LOOK:
I=INTEGER(ICL9CEFDMAP+DSNUM<<2)
IF I=0 THENSTART
!*NE %IF ICL9CEFAC>0 %THENSTART
!*NE I=LOCATE CHANNEL(DSNUM)
!*NE %IF I=0 %THEN ->LOOK
!*NE %UNLESS I=151 %THEN %RESULT=I
!*NE %FINISH
IF DSNUM=IN DEFAULT THENSTART
I=INTEGER(ICL9CEFDMAP+108<<2)
FINISHELSESTART
IF DSNUM=OUT DEFAULT THENSTART
I=INTEGER(ICL9CEFDMAP+99<<2)
SELECTOUTPUT(99)
FINISHELSESTART
RESULT = 151 ;!DATA SET NOT DEFINED
FINISH
FINISH
!*NE %IF ICL9CEFAC=4 %THEN INTEGER(ICL9CEFDMAP+DSNUM<<2)=I;! TO AVOID
! REPEATED CALLS ON LOCATE CHANNEL
FINISH
F==RECORD(I)
!*E; %IF F_MODEOFUSE=0 %START ;! TABLES IGNORANT
!*E; F_MODEOFUSE=TYPE
!*E; %IF TYPE=1 %THEN INTEGER(F_C0+24)=0 %AND INTEGER(F_C0+12)=3 ;! SET UP AS CHAR
!*E; %FINISH
AFD=I
CURRENT FD=I
!*
J=F_CUR STATE
UNLESS 0 <=J <=7 THEN RESULT = 1008;! CORRUPT DESCRIPTOR
IF F_ACCESS ROUTE=6 THEN DSNUM=F_ASVAR AND ->LOOK
IF ACTION & F_VALID ACTION = 0 THENSTART ;! INVALID I/O OP
IF ACTION=2 THEN RESULT =162;! NO WRITE PERMISSION
RESULT =171
FINISH
IF ACTION & SIMPLE VALID ACTION(J)=0 THENSTART ;! INVALID OR DETAILED PROCESSING
K=SPECIAL ACTION
IF K > 0 THEN RESULT = K
IF K < 0 THEN RESULT = 0
FINISH
!*
IF ACTION=1 THENSTART ;! READ
F_CUR STATE=2
RESULT =0
FINISH
!*
IF ACTION=2 THENSTART ;!WRITE
F_CURSTATE=3
RESULT =0
FINISH
!*
IF ACTION=4 THENSTART ;!REWIND
J=4
K=0
IF F_ACCESS ROUTE=3 THENSTART ;! MAPPED
F_C2=F_C1
!*E; F_RECORDS=0
I=0
->SET STATE
FINISH
POS: IF F_CURSTATE = 1 THEN I = 0 AND -> SET STATE
!*NE %IF F_CURSTATE = 3 %OR F_CURSTATE = 6 %THEN %START
!*NE ! IF LAST ACTION WAS WRITE OR ENDFILE SET TO READ AT END OF FILE
!*NE I = SET SQ MODE(ADDR(F_C0),F_MODE,3)
!*NE %FINISH
I = POSITION SQ FILE (ADDR(F_C0),K)
!*NE %IF I=153 %THEN I=0;! IGNORE PSEUDO-NODE WARNING
!*NE %IF I > 0 %THEN %RESULT = I
SET STATE: F_CUR STATE=J
!*NE %IF I>0 %AND I#153 %THEN %RESULT=I %ELSE %RESULT=0
!*E; %RESULT=I
FINISH
!*
IF ACTION=8 THENSTART ;! BACKSPACE
J=5
K=-1
I=0
->POS
FINISH
!*
IF ACTION=16 THENSTART ;!ENDFILE
!*E; %RESULT=0 %IF F_CURSTATE=6 ;! LAST ACTION ENDFILE
!*E; I=POSITION SQ FILE(ADDR(F_C0),1)
!*NE %IF F_CUR STATE # 3 %THENSTART ;! CLEAR SUBSEQUENT RECORDS UNLESS IN WRITE MODE
!*NE I=SET SQMODE(ADDR(F_C0),F_MODE,2)
!*NE %IF I<0 %THEN I=0
!*NE %FINISHELSE I=0
F_CUR STATE=6
RESULT =I
FINISH
!*
IF ACTION=32 THENSTART ;! CLOSE
I=CLOSE(AFD)
IF I>0 THEN RESULT =I
F_CURSTATE=0
RESULT =0
FINISH
!*
IF ACTION=64 THENSTART ;! FIND
RESULT =0
FINISH
!*
RESULT = 1013;! INVALID ACTION REQUESTED
!*
INTEGERFN SPECIAL ACTION
INTEGER I,J
SWITCH S(0:7)
->S(F_CUR STATE)
!*
!****** CLOSED
S(0): IF ACTION=2 AND F_MODE<12 THEN J=2 ELSE J=1;! SQ WRITE ELSE SQ READ OR DA
I=OPEN(CURRENT FD,J)
!*E; %IF F_MODEOFUSE=6 %AND %C
INTEGER(F_C0+12)=3 THEN F_MODEOFUSE=1
IF I<=0 THEN F_CUR STATE=1 AND RESULT =0
RESULT =I
!*
!****** AFTER OPEN
S(1): RESULT =-1;! NO ACTION REQUIRED FOR REWIND/BACKSPACE
!*
!****** AFTER READ
S(2): IF F_MODE<12 THENSTART ;! SQ
!*NE I=SET SQMODE(ADDR(F_C0),F_MODE,2);! TO ALLOW WRITE AFTER READ
!*E; %RESULT=0
!*NE %RESULT=I
FINISHELSE RESULT =0
!*
!****** AFTER WRITE
S(3): IF F_MODE<12 THENSTART
RESULT =156;!READ AFTER WRITE ERROR
FINISHELSE RESULT =0
!*
!****** AFTER REWIND
S(4): IF ACTION=4 OR ACTION=8 THEN RESULT =-1
!*
!****** AFTER BACKSPACE
S(5):
!*NE %IF 1<=ACTION<=2 %THENRESULT=SETSQMODE(ADDR(F_C0),F_MODE,ACTION)
RESULT =0
!*
!****** AFTER ENDFILE
S(6): IF ACTION=1 THEN RESULT =156;!READ AFTER WRITE
IF ACTION=2 THEN RESULT =157;!WRITE AFTER END FILE
IF ACTION=4 THEN RESULT =0;!NORMAL REWIND PROCESSING
IF ACTION=8 THENSTART ;! AFTER BACKSPACE
F_CUR STATE=3 ;! IN WRITE MODE AFTER LAST RECORD
RESULT =-1
FINISH
IF ACTION=16 THEN RESULT =-1 ;! IGNORE MULTIPLE ENDFILE
RESULT =1013;! INVALID ACTION
!*
!****** AFTER END OF FILE DETECTED ON READ
S(7): IF ACTION=1 THEN RESULT =153;!REPEAT END OF FILE CONDITION
IF ACTION=2 THEN ->S(2);!TO SET WRITE MODE
IF ACTION=16 THEN RESULT =-1;!ENDFILE ALREADY
RESULT =0
END ;! SPECIAL ACTION
!*
END ;!NEW FILE OP
!*
CONSTINTEGER FIXED=1, VARIABLE=2
!*
SYSTEMINTEGERFN INREC
RECORDNAME F(NRFDFMT)
RECORDNAME TC(TCFMT)
!*E; %BYTEINTEGER L1
!*NE %INTEGER I,FAC,K,A
INTEGER J
!*E; %SWITCH MOF(0:7)
!*E; %LONGINTEGER ALIGN2
!*E; %INTEGER PIDR0,PIDR1
!*E; %INTEGER L,DATAEND
F==RECORD(CURRENT FD)
IF F_CURSTATE=7 THEN RESULT =153;! INPUT ENDED
!*NE FAC=ICL9CEFAC
!*NE %IF FAC=0 %THENSTART;! JOBBER
!*NE K=F_ACCESS ROUTE
!*NE !*SJ %IF K&3=3 %THENSTART;! MAPPED FILE
!*NE !*SJ %IF F_C2>=F_C3 %THENSTART;! END OF FILE CONDITION
!*NE !*SJ F_CURSTATE=7
!*NE !*SJ %RESULT=153
!*NE !*SJ %FINISH
!*NE !*SJ A=F_C2
!*NE !*SJ F_AREC=A
!*NE !*SJ %IF K=7 %THENSTART;! CHECK FOR EOF IN PRIMARY INPUT
!*NE !*SJ %IF BYTEINTEGER(A)=X'61' %THENSTART
!*NE !*SJ %IF BYTEINTEGER(A+1)=X'61' %THEN %RESULT=153
!*NE !*SJ %FINISH
!*NE !*SJ %FINISH
!*NE !*SJ F_C2=A+80
!*NE !*SJ F_RECSIZE=80
!*NE !*SJ %RESULT=0
!*NE !*SJ %FINISH
!*SJ; TC==RECORD(ICL9CETC)
!*NE !*SJ %UNLESS F_ACCESS ROUTE=1 %THENSTART
IF F_MODE<12 THEN J=0 ELSE J=F_DARECNUM
!*K I=FILEOP(ADDR(F_C0),F_MODE,1,F_AREC,F_MAXREC,J-1)
!*NE !*B %IF F_MODE&15<12 %THEN I=FASTFILEOP(ADDR(F_C0)) %ELSE %C
!*NE I=DA FILE OP(ADDR(F_C0),F_MODE&15,1,J-1)
!*NE %IF I<=0 %THENSTART
!*E; %UNLESS F_ACCESS ROUTE = 1 %OR F_ACCESS ROUTE = 9 %THENC
TC_USER TRANSFER COUNT = TC_USER TRANSFER COUNT+1
IF F_ACCESS ROUTE=3 THEN ->MOF(1) ELSEC
DATAEND=F_C0+INTEGER(F_C0)
!*E; -> MOF(F_MODE OF USE)
!*E; !!
!*E; MOF(1):
!*E;
!*E; ! STREAM
!*E; F_AREC=F_C2
!*E; PIDR0=F_RECORDS
!*E; %IF PIDR0=0 %THEN %START
IF F_ACCESS ROUTE=3 THEN PIDR0=X'58000000'!(F_C3-F_C2) ELSEC
PIDR0=X'58000000'!(INTEGER(F_C0)-INTEGER(F_C0+4))
FINISH
!*E; PIDR1=F_C2
!*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; L=PIDR1-F_C2 ;! FIND OUT LINE LENGTH
!*E; %IF F_ACCESS ROUTE=9 %OR F_ACCESS ROUTE=3 %START ;! CHECK FOR //
!*E; %IF BYTEINTEGER(F_C2)='/' %START
!*E; %IF BYTEINTEGER(F_C2+1)='/' %THEN %RESULT=153
!*E; %FINISH
!*E; %FINISH
!*E; F_C2=F_C2+L
!*E; L=L-1 ;! FORTRAN DOES NOT SEE NL
UNLESS F_ACCESS ROUTE=3 START
!*E; %IF L > F_MAXREC %THEN L = F_MAXREC
FINISH
!*E; F_RECORDS=PIDR0
!*E; F_RECSIZE=L
!*E; %RESULT=0
!*E; !!
!*E; MOF(2):
!*E;
!*E; ! SEQUENTIAL
!*E; MOF(6):
!*E;
!*E; !FORTRAN
IF F_RECTYPE=VARIABLE START
!*E; %IF F_LASTREC=0 %START ;! AT START OF FILE
!*E; F_LASTREC=1
!*E; %FINISH %ELSE %START
!*E; F_LASTREC=F_C2
!*E; F_RECSIZE=(BYTEINTEGER(F_C2)<<8)!BYTEINTEGER(F_C2+1)
!*E; F_C2=F_C2+F_RECSIZE
!*E; %FINISH
IF F_C2>=DATAEND THEN ->EOF
IF F_RECSIZE<=0 THEN RESULT =172
F_AREC=F_C2+2
!*E; F_RECSIZE=((BYTEINTEGER(F_C2)<<8)!BYTEINTEGER(F_C2+1))-2
FINISHELSESTART ;! FIXED
F_C2=F_C2+F_RECSIZE
F_AREC=F_C2
FINISH
!*E; F_RECORDS=F_RECORDS+1
!*E; %RESULT=0
!*E; !!
!*E; MOF(0):
!*E; MOF(4):
!*E;
!*E; MOF(5):
!*E;
!*E; ! UNNASSIGNED
!*E; !!
!*E; %RESULT=182
!*E; MOF(3):
!*E;
!*E;
!*E; MOF(7):
!*E;
!*E; %RESULT=181
IF J#0 THENSTART
J=J+1
F_DARECNUM=J
IF F_FLAGS&4=0 THEN INTEGER(F_ASVAR)=J C
ELSE MOVE(2,ADDR(J)+2,F_ASVAR)
FINISH
!*NE %IF FAC=0 %THENSTART
!*NE !*SJ %IF F_ACCESS ROUTE=1 %THENSTART;! CHECK FOR END OF FILE
!*NE !*SJ %IF BYTEINTEGER(F_AREC)=X'61' %THENSTART;! LOOK FOR /
!*NE !*SJ %IF BYTEINTEGER(F_AREC+1)=X'61' %THENSTART;! AND AGAIN
!*NE !*SJ COMREG(56)=1
!*NE !*SJ %RESULT=153
!*NE !*SJ %FINISH
!*NE !*SJ %FINISH
!*NE !*SJ %FINISH
!*NE %FINISH
!*
!*K K=F_AREC
!*K J=BYTEINTEGER(K)
!*K %IF J=X'5C' %OR J=X'61' %THENSTART;! * OR /
!*K %IF BYTEINTEGER(K+1)=J %THENSTART
!*K %IF BYTEINTEGER(K+2)=J %THENSTART
!*K %IF BYTEINTEGER(K+3)=J%THEN I=153
!*K %FINISH
!*K %FINISH
!*K %FINISH
!*NE %FINISHELSESTART
!*NE %IF I=153 %THEN F_CURSTATE=7
!*NE %FINISH
! %RESULT=I
!*E; EOF: F_CURSTATE=7
!*E; %RESULT=153
END ;! INREC
!*
SYSTEMINTEGERFN OUTREC(INTEGER LEN)
RECORDNAME F(NRFDFMT)
RECORDNAME TC(TCFMT)
!*E; %INTEGER TRECSIZE,SPACE
INTEGER I,J,PAGE COUNT,FAC
!*NE FAC=ICL9CEFAC
!NE !*SJ %IF FAC=0 %THENC
TC==RECORD(ICL9CETC)
!E*; TC==RECORD(ICL9CETC)
F==RECORD(CURRENT FD)
IF F_VALID ACTION&2=0 THEN RESULT =162;! NO WRITE PERM
IF F_MODE<12 THEN J=0 ELSE J=F_DARECNUM
IF F_ACCESS ROUTE=2 THENSTART ;! DEFAULT PRINTER
!*E; PAGE COUNT=TC_PAGE COUNT
!*SJ %IF FAC=0 %THEN PAGE COUNT=TC_PAGE COUNT
I=BYTEINTEGER(F_AREC)
!*E; %IF I='1' %START
!*NE %IF I=X'F1' %THENSTART
BYTEINTEGER(F_AREC)=X'0C';! NEWPAGE
!*SJ; PAGE COUNT=0
->PRINT
FINISH
!*E; %IF I='0' %START
!*NE %IF I=X'F0' %THENSTART;! '0' ;! TWO NEWLINES
!*NE BYTEINTEGER(F_AREC)=X'15'
!*E; BYTEINTEGER(F_AREC)=NL
!*NE F_RECSIZE=1
!*E; F_RECSIZE=2
!*K I=FILEOP(ADDR(F_C0),F_MODE,2,F_AREC,1,0)
!*NE !*B I=FASTFILEOP(ADDR(F_C0))
!*NE %IF I>0 %THEN %RESULT=I
!*E; %CYCLE I=LEN,-1,0
!*E; BYTEINTEGER(F_AREC+I+1)=BYTEINTEGER(F_AREC+I)
!*E; %REPEAT
!*E; BYTEINTEGER(F_AREC+1)=NL
!E*; BYTEINTEGER(F_AREC)=NL
!*E; F_C2=F_C2+2
!*E; INTEGER(F_C0)=F_C2-F_C0
!*SJ; PAGE COUNT=PAGE COUNT-1
->PRINT
FINISH
!*E; %IF I='+' %THEN BYTEINTEGER(F_AREC)=X'D' %AND ->PRINT
!*NE %IF I=X'4E' %THEN BYTEINTEGER(F_AREC)=X'0D' %AND ->PRINT
!*NE BYTEINTEGER(F_AREC)=X'15';! NEWLINE FOR ALL OTHERS
!*E; BYTEINTEGER(F_AREC)=NL
PRINT:
!*NE !*SJ %IF FAC=0 %THENSTART;! JOBBER MODE
!*SJ PAGE COUNT = PAGE COUNT - 1
!*SJ; %IF PAGE COUNT<0 %THEN OUTPUT TRAP %ELSESTART
!*SJ; TC_PAGE COUNT=PAGE COUNT
!*SJ; %FINISH
!*NE !*SJ %FINISH
!*SJ; ->CALL OP
FINISH
!*SJ; %IF FAC=0 %THEN %C
TC_USER TRANSFER COUNT = TC_USER TRANSFER COUNT + 1
CALL OP:
!*NE !%IF LEN<132 %THEN FILL(132-LEN,F_AREC+LEN,X'40')
F_RECSIZE=LEN
!*K I=FILEOP(ADDR(F_C0),F_MODE,2,F_AREC,LEN,J-1)
!*NE !*B %IF F_MODE < 12 %THEN I=FASTFILEOP(ADDR(F_C0)) %ELSE %C
!*NE I = DA FILE OP(ADDR(F_C0),F_MODE,2,J-1)
!*NE %IF J#0 %AND I<=0 %THENSTART
!*NE J=J+1
!*NE %IF F_FLAGS&4=0 %THEN INTEGER(F_ASVAR)=J %C
!*NE %ELSE MOVE(2,ADDR(J)+2,F_ASVAR)
!*NE %FINISH
!E - WATCH OUT FOR FORTRAN PRIMARY OUTPUT - TREAT AS STREAM
!*E; %IF F_MODE OF USE>1 %AND F_ACCESS ROUTE # 2 %START ;! NOT STREAM
IF F_RECTYPE=VARIABLE START
!*E; TRECSIZE=LEN+2
!*E; MOVE(2,ADDR(TRECSIZE)+2,F_C2)
!*E; F_LASTREC=F_C2
!*E; F_C2=F_C2+TRECSIZE
!*E; F_AREC=F_C2+2
FINISHELSESTART ;! FIXED
F_C2=F_C2+LEN
F_AREC=F_C2
FINISH
!*E; F_RECORDS=F_RECORDS+1
IF F_RECORDS>INTEGER(F_C0+28) THEN INTEGER(F_C0+28)=F_RECORDS
!*E; !
!*E; ! IF NEAR END OF FILE LET FIO KNOW BY REDUCING MAXREC
!*E; ! NOTE: IF FIO HAS INSUFFICIENT ROOM IT WILL GIVE
!*E; ! RECORD TOO SMALL.
!*E; SPACE=F_C3-F_AREC+1
!*E; %IF SPACE<F_MAXREC %THEN F_MAXREC=SPACE
!*E; %FINISHELSESTART
!*E; F_C2 = F_C2+LEN
!*E; %IF F_C2+F_MAXREC>F_C3 %THEN %START
!*E; EXPAND PRIMARY OUTPUT FILE(F)
!*E; %FINISH
F_AREC=F_C2
!*E; %FINISH
!*E; INTEGER(F_C0) =F_C2-F_C0
!*E; I = 0
RESULT =I
END ;! OUTREC
!*
!*
SYSTEMINTEGERFN FORTRANDF(INTEGER DSNUM,NUMBLOCKS,BLKSIZE,ASVARDESCAD)
INTEGER I
RECORDNAME F(NRFDFMT)
UNLESS 0<DSNUM<100 THEN RESULT =164;! INVALID DSNUM
!*NE LOOK:
I=INTEGER(ICL9CEFDMAP+DSNUM<<2)
IF I=0 THENSTART ;! FILE NOT DEFINED?
!*NE %IF ICL9CEFAC#0 %THENSTART
!*NE I=LOCATE CHANNEL(DSNUM)
!*NE %IF I=0 %THEN ->LOOK %ELSE %RESULT=I
!*NE %FINISH
RESULT =151;! NOT DEFINED
FINISH
F==RECORD(I)
F_ASVAR=INTEGER(ASVARDESCAD+4)
F_MAXSIZE=NUMBLOCKS
!*E; F_VALIDACTION=X'63'
!*E F_VALIDACTION=X'43';! FIND,WRITE,READ
F_MODEOFUSE=2
F_MODE=13
IF INTEGER(ASVARDESCAD)>>24=X'58' THEN F_FLAGS=F_FLAGS!4 C
ELSE F_FLAGS=F_FLAGS&X'FB'
RESULT =0
END ;! FORTRANDF
!*
SYSTEMROUTINE FAUX(INTEGER EP, P1, P2)
OWNINTEGER INITSTATE;! 0 AFTER FAUX(0,...) 1 AFTER FAUX1(0,...)
INTEGER I,J, F
!*E; %SWITCH E(0:8)
!*NE %SWITCH E(0:9)
UNLESS 0<=EP<=8 THEN RETURN
->E(EP)
!*
!****** PRIME CONTINGENCY
!*NE E(9):
E(0): SIGNAL(0,P1,P2,F)
INITSTATE=0
RETURN
!*
!****** HARDWARE DETECTED FAULT
E(1):
I=INTEGER(P2+16); ! PC
J=INTEGER(P2+72); ! FAILING INST
IF I>>18 = J>>18 THEN I=J
NDIAG(I,INTEGER(P2+8),10,INTEGER(P2))
EXIT: SSERR(0)
!*
!****** SOFTWARE DETECTED FAULT
E(2):
*STLN_I
IF P1=1 THEN P1=11; ! UNASSIGNED
IF P1=2 THEN P1=6; ! ARRAY BOUND
IF P1=3 THEN P1=36;! WRONG NO OF PARAMS
NDIAG(0,INTEGER(I),P1,P2)
->EXIT
!*
!****** PAUSE
E(3):
!*
!****** STOP
E(4):
CALLFAUX1:
FAUX1(EP,P1,P2)
RETURN
!*
!****** TRACE1
!* P1>0 LABEL
!* P1=-1 RETURN
E(5):
!*
!****** TRACE2
!* ENTRY TO FN/SUBR
E(6):
IF INITSTATE=0 THENSTART
FAUX1(0,0,0)
INITSTATE=1
FINISH
->CALLFAUX1
!*
E(7): ! FORTRAN I/O ERROR
E(8): ! FORTRAN FORMAT ERROR
*STLN_I
J=INTEGER(INTEGER(I)+8)-4; ! PC OF USER PROGRAM
IF P1=-1 THEN I=INTEGER(INTEGER(I)); ! LNB OF USER PROGRAM
NDIAG(J,I,-1,0)
RETURN
END ; ! FAUX
!*
!*
!*
SYSTEMROUTINE OPENSQ(INTEGER CHAN)
RECORDNAME SQFD(NRFDFMT)
INTEGER AFD, I
SSERR(164) UNLESS 1<=CHAN<=99; ! INVALID DATA SET NUMBER
!*NE LOOK:
AFD=INTEGER(ICL9CEFDMAP+CHAN<<2);! GET ADDRESS OF FILE DESCRIPTOR
IF AFD=0 START
!*NE %IF ICL9CEFAC=4 %START; ! STAND-ALONE
!*NE I=LOCATE CHANNEL(CHAN)
!*NE %IF I=0 %THEN ->LOOK
!*NE %FINISHELSE I=151
SSERR(I)
FINISH
SQFD==RECORD(AFD)
SSERR(176) UNLESS SQFD_STATUS<2
! FILE ALREADY OPEN
IF SQFD_STATUS = 0 THEN START
!*E; I=GET ROUTE(AFD)
!*NE I=JBR CALL(2,AFD);! ==GET ROUTE(AFD)
IF I # 0 THEN SSERR(I)
FINISH
SQFD_STATUS=2; ! SET OPEN
!*NE %RETURN
END ; ! OF OPENSQ
!
!*
SYSTEMROUTINE CLOSESQ (INTEGER CHAN)
INTEGER FLAG, AFD
SSERR(164) UNLESS 1 <= CHAN <= 99; ! INVALID DATA SET NUMBER
FLAG = NEW FILE OP (CHAN, 32, 2, AFD)
SSERR(FLAG) UNLESS FLAG <= 0; ! FILE NOT OPEN
!*NE %RETURN
END ; ! OF CLOSESQ
!*
SYSTEMROUTINE OPENDA(INTEGER CHAN)
RECORDNAME DAFD(NRFDFMT)
INTEGER AFD, I
SSERR(164) UNLESS 1<=CHAN<=99; ! INVALID FILE NUMBER
!*NE LOOK:
AFD=INTEGER(ICL9CEFDMAP+CHAN<<2)
IF AFD=0 START
!*NE %IF ICL9CEFAC=4 %START; ! STAND-ALONE
!*NE I=LOCATE CHANNEL(CHAN)
!*NE %IF I=0 %THEN ->LOOK
!*NE %FINISHELSE I=151
SSERR(I)
FINISH
DAFD==RECORD(AFD)
SSERR(176) UNLESS DAFD_STATUS<2
IF DAFD_STATUS = 0 THEN START
!*E; I=GET ROUTE(AFD)
!*NE I=JBR CALL(2,AFD);! ==GET ROUTE(AFD)
IF I # 0 THEN SSERR(I)
FINISH
DAFD_STATUS=2
DAFD_MODE=13;! FOR CORRECT I/O OPERATIONS
END
!
!*
SYSTEMROUTINE CLOSEDA (INTEGER CHAN)
INTEGER FLAG, AFD
SSERR(164) UNLESS 1 <= CHAN <= 99; ! INVALID DATA SET NUMBER
FLAG = NEW FILE OP (CHAN, 32, 2, AFD)
SSERR(FLAG) UNLESS FLAG <= 0; ! FILE NOT OPEN
!*NE %RETURN
END ; ! OF CLOSE DA
!*
!*
!E %EXTERNALINTEGERFN ICL9CEINDEX(%INTEGER L0,A0,L1,A1)
!E %INTEGER I,J,K
!E L0=L0&255
!E L1=L1&255
!E %IF L0<L1 %THEN %RESULT=0
!E %IF L0=0 %OR L1=0 %THEN %RESULT=0
!E J=BYTEINTEGER(A0)
!E %CYCLE I=0,1,L1-1
!E %IF J=BYTEINTEGER(A1+I) %THENSTART
!E %IF L1-I<L0 %THEN %RESULT=0
!E %CYCLE K=0,1,L0-1
!E %IF BYTEINTEGER(A0+K)#BYTEINTEGER(A1+I+K) %THEN ->LOOP
!E %REPEAT
!E %RESULT=I+1
!E %FINISH
!E LOOP: %REPEAT
!E %RESULT=0
!E %END;! ICL9CEINDEX
!*
ENDOFFILE