SUBROUTINE IO LOGICAL ERR, SYSERR, TOKPNO, OK, ABORT, TOKLAB INTEGER STMT, PSTMT INTEGER EN(4) LOGICAL SW COMMON /FACTS/ NAME, NOST, ITYP, IASF COMMON /INPUT/ NSTMT, PSTMT, STMT(1327) COMMON /DETECT/ ERR, SYSERR, ABORT COMMON /SWS/ SW(10) DATA EN(1), EN(2), EN(3), EN(4) /34,43,33,63/ C C ROUTINE RECOGNIZES READ,WRITE,REWIND,BACKSPACE,ENDFILE,PAUSE STMTS C OK = .TRUE. ASSIGN 160 TO IFORM IF (ITYP.NE.23 .AND. ITYP.NE.24) GO TO 240 C C SYNTAX OF READ, WRITE STMTS IS THE SAME EXCEPT A BINARY WRITE C NEEDS A <LIST>. (SEE USE OF OK) C "READ" (U<UNIT> / <UNIT> , <FORM>!) U<LIST>! C <UNIT> IS INTEGER SCALAR VARIABLE OR POSITIVE INTEGER CONST C <FORM> IS <LABEL> OR <ARRAY NAME>. C IF (STMT(PSTMT).NE.65) GO TO 230 PSTMT = PSTMT + 1 IF (PSTMT.GE.NSTMT) GO TO 120 10 IF (TOKPNO(PSTMT,K2,K)) GO TO 60 CALL NEXTOK(PSTMT, K2, K) IF (K.EQ.0) GO TO 20 CALL ERROR1(13H ILLEGAL UNIT, 13) GO TO 110 20 K = LOOKUP(K2,.FALSE.) IF (SYSERR) GO TO 110 I1 = IGATT1(K,1) I2 = IGATT1(K,7) I3 = IGATT1(K,8) IF (I3.NE.0) GO TO 30 CALL SATT1(K, 8, 10) GO TO 40 30 IF (I3.EQ.10) GO TO 40 CALL ERROR1(13H ILLEGAL UNIT, 13) 40 IF (I1.NE.0) GO TO 50 I1 = 1 IF (STMT(PSTMT).GE.38 .AND. STMT(PSTMT).LE.43) I1 = 2 CALL SATT1(K, 1, I1) 50 IF (MOD(I1,8).NE.2 .OR. I2.NE.0) CALL ERROR1(13H ILLEGAL UNIT, 13) 60 PSTMT = K2 C C DISTINGUISH ( <UNIT> ) FROM ( <UNIT>,<FORM> ) C IF (ITYP.NE.23 .AND. ITYP.NE.24) GO TO 100 IF (STMT(PSTMT).EQ.68) GO TO 130 IF (STMT(PSTMT).EQ.62 .AND. ITYP.EQ.24) OK = .FALSE. C C CODE FINDS ")" AND TRIES TO FIND LIST C 70 IF (STMT(PSTMT).NE.62) GO TO 230 PSTMT = PSTMT + 1 IF (PSTMT.GE.NSTMT) GO TO 90 CALL LIST GO TO 110 80 CALL ERROR1(20H ILLEGAL PUNCTUATION, 20) PSTMT = PSTMT + 1 GO TO 70 90 IF (OK) GO TO 110 CALL ERROR1(13H MISSING LIST, 13) 100 IF (PSTMT.LT.NSTMT) CALL ERROR1( * 34H EXTRANEOUS INFO AFTER END OF STMT, 34) 110 RETURN 120 CALL ERROR1(15H ILLEGAL SYNTAX, 15) GO TO 110 C C IDENTIFY END= IF THERE C 130 IF (ITYP.NE.23) GO TO IFORM, (160, 80) I1 = PSTMT + 1 DO 140 K=1,4 IF (STMT(I1).NE.EN(K)) GO TO IFORM, (160, 80) I1 = I1 + 1 140 CONTINUE IF (.NOT.SW(1)) CALL ERROR1( * 37H WARNING - NON-PORTABLE EOF CONSTRUCT, 37) C C HAVE FOUND END=, TRY FOR LABEL C PSTMT = I1 IF(.NOT.TOKLAB(1,K2,K,.FALSE.)) 1CALL ERROR1(44H MISSING LABEL IN NON-PORTABLE EOF CONSTRUCT ,44) IF(SYSERR) GOTO 110 150 PSTMT = K2 GO TO 70 C C SEARCH FOR FORM C 160 PSTMT = PSTMT + 1 IF (PSTMT.GE.NSTMT) GO TO 230 IF (TOKLAB(3,K2,K,.FALSE.)) GO TO 220 IF(SYSERR) GOTO 110 CALL NEXTOK(PSTMT, K2, K) IF (K.EQ.0) GO TO 180 170 CALL ERROR1(13H ILLEGAL FORM, 13) GO TO 110 180 K = LOOKUP(K2,.FALSE.) IF (SYSERR) GO TO 110 I1 = IGATT1(K,1) I2 = IGATT1(K,7) I3 = IGATT1(K,8) IF (I3.NE.0) GO TO 190 CALL SATT1(K, 8, 10) GO TO 200 190 IF (I3.EQ.10) GO TO 200 CALL ERROR1(13H ILLEGAL FORM, 13) 200 IF (I1.NE.0) GO TO 210 I1 = 2 IF (STMT(PSTMT).GE.38 .AND. STMT(PSTMT).LE.43) I1 = 2 CALL SATT1(K, 1, I1) 210 IF((MOD(I1,8).NE.2.AND.MOD(I1,8).NE.5).OR.I2.EQ.0) GOTO 170 C C HAVE SUCCESSFULLY FOUND A FORM C 220 IF (SYSERR) GO TO 110 PSTMT = K2 ASSIGN 80 TO IFORM IF (STMT(PSTMT).EQ.68) GO TO 130 GO TO 70 230 CALL ERROR1(20H ILLEGAL PUNCTUATION, 20) GO TO 110 C C LAST 4 I-O STMTS C 240 IF (ITYP.EQ.27 .OR. ITYP.EQ.22) CALL ERROR1( * 39H WARNING - USE OF NON-PORTABLE I/O STMT, 39) IF (ITYP.EQ.22) GO TO 100 IF (PSTMT.LT.NSTMT) GO TO 10 CALL ERROR1(13H MISSING UNIT, 13) GO TO 110 END