![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to IO.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10dc / cmd / pfort|
Return to IO.f CVS log | Up to [Research Unix] / researchv10dc / cmd / pfort |
1.1 ! root 1: SUBROUTINE IO ! 2: LOGICAL ERR, SYSERR, TOKPNO, OK, ABORT, TOKLAB ! 3: INTEGER STMT, PSTMT ! 4: INTEGER EN(4) ! 5: LOGICAL SW ! 6: COMMON /FACTS/ NAME, NOST, ITYP, IASF ! 7: COMMON /INPUT/ NSTMT, PSTMT, STMT(1327) ! 8: COMMON /DETECT/ ERR, SYSERR, ABORT ! 9: COMMON /SWS/ SW(10) ! 10: DATA EN(1), EN(2), EN(3), EN(4) /34,43,33,63/ ! 11: C ! 12: C ROUTINE RECOGNIZES READ,WRITE,REWIND,BACKSPACE,ENDFILE,PAUSE STMTS ! 13: C ! 14: OK = .TRUE. ! 15: ASSIGN 160 TO IFORM ! 16: IF (ITYP.NE.23 .AND. ITYP.NE.24) GO TO 240 ! 17: C ! 18: C SYNTAX OF READ, WRITE STMTS IS THE SAME EXCEPT A BINARY WRITE ! 19: C NEEDS A <LIST>. (SEE USE OF OK) ! 20: C "READ" (U<UNIT> / <UNIT> , <FORM>!) U<LIST>! ! 21: C <UNIT> IS INTEGER SCALAR VARIABLE OR POSITIVE INTEGER CONST ! 22: C <FORM> IS <LABEL> OR <ARRAY NAME>. ! 23: C ! 24: IF (STMT(PSTMT).NE.65) GO TO 230 ! 25: PSTMT = PSTMT + 1 ! 26: IF (PSTMT.GE.NSTMT) GO TO 120 ! 27: 10 IF (TOKPNO(PSTMT,K2,K)) GO TO 60 ! 28: CALL NEXTOK(PSTMT, K2, K) ! 29: IF (K.EQ.0) GO TO 20 ! 30: CALL ERROR1(13H ILLEGAL UNIT, 13) ! 31: GO TO 110 ! 32: 20 K = LOOKUP(K2,.FALSE.) ! 33: IF (SYSERR) GO TO 110 ! 34: I1 = IGATT1(K,1) ! 35: I2 = IGATT1(K,7) ! 36: I3 = IGATT1(K,8) ! 37: IF (I3.NE.0) GO TO 30 ! 38: CALL SATT1(K, 8, 10) ! 39: GO TO 40 ! 40: 30 IF (I3.EQ.10) GO TO 40 ! 41: CALL ERROR1(13H ILLEGAL UNIT, 13) ! 42: 40 IF (I1.NE.0) GO TO 50 ! 43: I1 = 1 ! 44: IF (STMT(PSTMT).GE.38 .AND. STMT(PSTMT).LE.43) I1 = 2 ! 45: CALL SATT1(K, 1, I1) ! 46: 50 IF (MOD(I1,8).NE.2 .OR. I2.NE.0) CALL ERROR1(13H ILLEGAL UNIT, 13) ! 47: 60 PSTMT = K2 ! 48: C ! 49: C DISTINGUISH ( <UNIT> ) FROM ( <UNIT>,<FORM> ) ! 50: C ! 51: IF (ITYP.NE.23 .AND. ITYP.NE.24) GO TO 100 ! 52: IF (STMT(PSTMT).EQ.68) GO TO 130 ! 53: IF (STMT(PSTMT).EQ.62 .AND. ITYP.EQ.24) OK = .FALSE. ! 54: C ! 55: C CODE FINDS ")" AND TRIES TO FIND LIST ! 56: C ! 57: 70 IF (STMT(PSTMT).NE.62) GO TO 230 ! 58: PSTMT = PSTMT + 1 ! 59: IF (PSTMT.GE.NSTMT) GO TO 90 ! 60: CALL LIST ! 61: GO TO 110 ! 62: 80 CALL ERROR1(20H ILLEGAL PUNCTUATION, 20) ! 63: PSTMT = PSTMT + 1 ! 64: GO TO 70 ! 65: 90 IF (OK) GO TO 110 ! 66: CALL ERROR1(13H MISSING LIST, 13) ! 67: 100 IF (PSTMT.LT.NSTMT) CALL ERROR1( ! 68: * 34H EXTRANEOUS INFO AFTER END OF STMT, 34) ! 69: 110 RETURN ! 70: 120 CALL ERROR1(15H ILLEGAL SYNTAX, 15) ! 71: GO TO 110 ! 72: C ! 73: C IDENTIFY END= IF THERE ! 74: C ! 75: 130 IF (ITYP.NE.23) GO TO IFORM, (160, 80) ! 76: I1 = PSTMT + 1 ! 77: DO 140 K=1,4 ! 78: IF (STMT(I1).NE.EN(K)) GO TO IFORM, (160, 80) ! 79: I1 = I1 + 1 ! 80: 140 CONTINUE ! 81: IF (.NOT.SW(1)) CALL ERROR1( ! 82: * 37H WARNING - NON-PORTABLE EOF CONSTRUCT, 37) ! 83: C ! 84: C HAVE FOUND END=, TRY FOR LABEL ! 85: C ! 86: PSTMT = I1 ! 87: IF(.NOT.TOKLAB(1,K2,K,.FALSE.)) ! 88: 1CALL ERROR1(44H MISSING LABEL IN NON-PORTABLE EOF CONSTRUCT ,44) ! 89: IF(SYSERR) GOTO 110 ! 90: 150 PSTMT = K2 ! 91: GO TO 70 ! 92: C ! 93: C SEARCH FOR FORM ! 94: C ! 95: 160 PSTMT = PSTMT + 1 ! 96: IF (PSTMT.GE.NSTMT) GO TO 230 ! 97: IF (TOKLAB(3,K2,K,.FALSE.)) GO TO 220 ! 98: IF(SYSERR) GOTO 110 ! 99: CALL NEXTOK(PSTMT, K2, K) ! 100: IF (K.EQ.0) GO TO 180 ! 101: 170 CALL ERROR1(13H ILLEGAL FORM, 13) ! 102: GO TO 110 ! 103: 180 K = LOOKUP(K2,.FALSE.) ! 104: IF (SYSERR) GO TO 110 ! 105: I1 = IGATT1(K,1) ! 106: I2 = IGATT1(K,7) ! 107: I3 = IGATT1(K,8) ! 108: IF (I3.NE.0) GO TO 190 ! 109: CALL SATT1(K, 8, 10) ! 110: GO TO 200 ! 111: 190 IF (I3.EQ.10) GO TO 200 ! 112: CALL ERROR1(13H ILLEGAL FORM, 13) ! 113: 200 IF (I1.NE.0) GO TO 210 ! 114: I1 = 2 ! 115: IF (STMT(PSTMT).GE.38 .AND. STMT(PSTMT).LE.43) I1 = 2 ! 116: CALL SATT1(K, 1, I1) ! 117: 210 IF((MOD(I1,8).NE.2.AND.MOD(I1,8).NE.5).OR.I2.EQ.0) GOTO 170 ! 118: C ! 119: C HAVE SUCCESSFULLY FOUND A FORM ! 120: C ! 121: 220 IF (SYSERR) GO TO 110 ! 122: PSTMT = K2 ! 123: ASSIGN 80 TO IFORM ! 124: IF (STMT(PSTMT).EQ.68) GO TO 130 ! 125: GO TO 70 ! 126: 230 CALL ERROR1(20H ILLEGAL PUNCTUATION, 20) ! 127: GO TO 110 ! 128: C ! 129: C LAST 4 I-O STMTS ! 130: C ! 131: 240 IF (ITYP.EQ.27 .OR. ITYP.EQ.22) CALL ERROR1( ! 132: * 39H WARNING - USE OF NON-PORTABLE I/O STMT, 39) ! 133: IF (ITYP.EQ.22) GO TO 100 ! 134: IF (PSTMT.LT.NSTMT) GO TO 10 ! 135: CALL ERROR1(13H MISSING UNIT, 13) ! 136: GO TO 110 ! 137: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.