![[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] / researchv10no / cmd / pfort|
Return to IO.f CVS log | Up to [Research Unix] / researchv10no / 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.