Return to DOCHK.f CVS log

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

researchv10 Norman

      SUBROUTINE DOCHK(KK)
      INTEGER DOLIST, DOPT, OUTUT, SYMLEN, OUTUT2, DSA, PDSA, OUTUT3,
     *    STACK, OUTUT4
      COMMON /DOS/ DOPT, LDO, DOLIST(192)
      COMMON /CEXPRS/ LSTACK, STACK(620)
      COMMON /PARAMS/ INUT, OUTUT, NOCHAR, SYMLEN, OUTUT2, OUTUT3,
     *    OUTUT4
      COMMON /FACTS/ NAME, NOST, ITYP, IASF
      COMMON /CTABL/ LDSA, PDSA, DSA(5000)
C
C     KK IS SYMBOL TABLE ENTRY OF LABEL
C     ROUTINE CHECKS ALL LABELS FOR BEING END OF DO-STMTS; IF LABEL IS
C     END-OF-DO, ALL LABELS WITHIN THAT DO, HAVE END-OF-DEFN STMT NO
C     RECORDED IN THEM; DOPT IS DECREMENTED, A MOCK END-OF-DO IS
C     CREATED BY THE END STMT IN THE PGM UNIT; DOLIST MUST BE EMPTY
C     AFTER THIS PROCESSING OF AN END,
C     PERFORMS FIXUP ON SCOPE OF LABELS ENDING MULTIPLE NESTED DO'S
C
      IF (ITYP.EQ.28) GO TO 50
      IF (DOLIST(DOPT+1).NE.KK) GO TO 40
   10 CALL FIXLAB(.FALSE.)
      DOPT = DOPT - 6
      IF (ITYP.EQ.15 .OR. ITYP.EQ.16 .OR. (ITYP.GE.19 .AND.
     *    ITYP.LE.22)) CALL ERROR1(26H ILLEGAL ENDING STMT ON DO, 26)
      IF (DOLIST(DOPT+1).NE.KK) GO TO 40
C
C     GET REFERENCE TO NESTED DO ENDING AND MAKE REFERENCE
C     TO DO STATEMENT  A NEGATIVE  NUMBER
C     SO IT WON'T BE AN ILLEGAL BRANCH
C
      K = DSA(KK+1)
      L = DOLIST(DOPT)
   20 IF (DSA(K).EQ.L) GO TO 30
      K = DSA(K+1)
      GO TO 20
   30 DSA(K) = -DSA(K)
      GO TO 10
   40 RETURN
   50 CALL FIXLAB(.TRUE.)
      IF (DOPT-6.LE.0) GO TO 40
      LL = 1
      L = DOPT/6
      DO 60 I=1,L
        J = DOPT + 7 - 6*I
        K = DOLIST(J)
        CALL S5UNPK(DSA(K+4), STACK(LL), 6)
        LL = LL + 6
   60 CONTINUE
      LL = LL - 1
      IF (LL.LE.55) GO TO 70
99999 FORMAT (/25H MISSING DO ENDING LABEL , 55A1)
      WRITE (OUTUT,99999) (STACK(L),L=1,55)
      WRITE (OUTUT,99998) (STACK(L),L=56,LL)
      GO TO 40
99998 FORMAT (25X, 55A1)
   70 WRITE (OUTUT,99999) (STACK(L),L=1,LL)
      GO TO 40
      END

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