Return to IDLIST.f CVS log

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

researchv10 Norman

      LOGICAL FUNCTION IDLIST(IDO)
      INTEGER PSTMT, STMT
      LOGICAL ERR, SYSERR, ABORT, IDO
      COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
      COMMON /DETECT/ ERR, SYSERR, ABORT
C
C     RECOGNIZES  IDLIST=<ID>  �, <ID>! ;LAST <ID> CANNOT BE FOLLOWED BY
C     A '='; IDLIST MUST CONTAIN AT LEAST ONE ID.  IDLIST=.FALSE. WILL
C     BE RETURNED FOR AN IRRECOVERABLE SYNTAX ERROR.
C     IDO SET TO .TRUE. WHEN <IDLIST> IS FOLLOWED BY <DOSPEC>
C
      IDO = .FALSE.
      IDLIST = .TRUE.
      IF (PSTMT.GE.NSTMT) GO TO 60
      CALL NEXTOK(PSTMT, K2, K)
      IF (K.NE.0) GO TO 60
      IF (STMT(K2).EQ.63) GO TO 20
      CALL ID(K2)
      IF (ERR .OR. SYSERR) GO TO 20
   10 PSTMT = K2
      IF (STMT(PSTMT).EQ.68 .AND. STMT(PSTMT+1).EQ.65 .OR.
     *    STMT(PSTMT).EQ.62 .OR. PSTMT.EQ.NSTMT) GO TO 30
      IF (STMT(PSTMT).EQ.68) GO TO 50
      CALL ERROR1(35H ILLEGAL TOKEN FOLLOWING IDENTIFIER, 35)
   20 IDLIST = .FALSE.
      ERR = .FALSE.
   30 RETURN
   40 IDO = .TRUE.
      GO TO 30
C
C     MAKE SURE <ID> =  ISN'T NEXT CONSTRUCT
C
   50 K2 = K2 + 1
      IF (K2.GE.NSTMT) GO TO 60
      CALL NEXTOK(K2, K3, K)
      IF (STMT(K3).EQ.63) GO TO 40
      PSTMT = K2
      K2 = K3
      CALL ID(K2)
      IF (ERR .OR. SYSERR) GO TO 20
      GO TO 10
   60 CALL ERROR1(23H ILLEGAL SYNTAX IN LIST, 23)
      GO TO 20
      END

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