Return to IO.f CVS log

Up to [Research Unix] / researchv10no / cmd / pfort

researchv10 Norman

      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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.