V10/cmd/pfort/IO.f

      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