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