Return to DOCHK.f CVS log

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

Annotation of researchv10no/cmd/pfort/DOCHK.f, revision 1.1

1.1     ! root        1:       SUBROUTINE DOCHK(KK)
        !             2:       INTEGER DOLIST, DOPT, OUTUT, SYMLEN, OUTUT2, DSA, PDSA, OUTUT3,
        !             3:      *    STACK, OUTUT4
        !             4:       COMMON /DOS/ DOPT, LDO, DOLIST(192)
        !             5:       COMMON /CEXPRS/ LSTACK, STACK(620)
        !             6:       COMMON /PARAMS/ INUT, OUTUT, NOCHAR, SYMLEN, OUTUT2, OUTUT3,
        !             7:      *    OUTUT4
        !             8:       COMMON /FACTS/ NAME, NOST, ITYP, IASF
        !             9:       COMMON /CTABL/ LDSA, PDSA, DSA(5000)
        !            10: C
        !            11: C     KK IS SYMBOL TABLE ENTRY OF LABEL
        !            12: C     ROUTINE CHECKS ALL LABELS FOR BEING END OF DO-STMTS; IF LABEL IS
        !            13: C     END-OF-DO, ALL LABELS WITHIN THAT DO, HAVE END-OF-DEFN STMT NO
        !            14: C     RECORDED IN THEM; DOPT IS DECREMENTED, A MOCK END-OF-DO IS
        !            15: C     CREATED BY THE END STMT IN THE PGM UNIT; DOLIST MUST BE EMPTY
        !            16: C     AFTER THIS PROCESSING OF AN END,
        !            17: C     PERFORMS FIXUP ON SCOPE OF LABELS ENDING MULTIPLE NESTED DO'S
        !            18: C
        !            19:       IF (ITYP.EQ.28) GO TO 50
        !            20:       IF (DOLIST(DOPT+1).NE.KK) GO TO 40
        !            21:    10 CALL FIXLAB(.FALSE.)
        !            22:       DOPT = DOPT - 6
        !            23:       IF (ITYP.EQ.15 .OR. ITYP.EQ.16 .OR. (ITYP.GE.19 .AND.
        !            24:      *    ITYP.LE.22)) CALL ERROR1(26H ILLEGAL ENDING STMT ON DO, 26)
        !            25:       IF (DOLIST(DOPT+1).NE.KK) GO TO 40
        !            26: C
        !            27: C     GET REFERENCE TO NESTED DO ENDING AND MAKE REFERENCE
        !            28: C     TO DO STATEMENT  A NEGATIVE  NUMBER
        !            29: C     SO IT WON'T BE AN ILLEGAL BRANCH
        !            30: C
        !            31:       K = DSA(KK+1)
        !            32:       L = DOLIST(DOPT)
        !            33:    20 IF (DSA(K).EQ.L) GO TO 30
        !            34:       K = DSA(K+1)
        !            35:       GO TO 20
        !            36:    30 DSA(K) = -DSA(K)
        !            37:       GO TO 10
        !            38:    40 RETURN
        !            39:    50 CALL FIXLAB(.TRUE.)
        !            40:       IF (DOPT-6.LE.0) GO TO 40
        !            41:       LL = 1
        !            42:       L = DOPT/6
        !            43:       DO 60 I=1,L
        !            44:         J = DOPT + 7 - 6*I
        !            45:         K = DOLIST(J)
        !            46:         CALL S5UNPK(DSA(K+4), STACK(LL), 6)
        !            47:         LL = LL + 6
        !            48:    60 CONTINUE
        !            49:       LL = LL - 1
        !            50:       IF (LL.LE.55) GO TO 70
        !            51: 99999 FORMAT (/25H MISSING DO ENDING LABEL , 55A1)
        !            52:       WRITE (OUTUT,99999) (STACK(L),L=1,55)
        !            53:       WRITE (OUTUT,99998) (STACK(L),L=56,LL)
        !            54:       GO TO 40
        !            55: 99998 FORMAT (25X, 55A1)
        !            56:    70 WRITE (OUTUT,99999) (STACK(L),L=1,LL)
        !            57:       GO TO 40
        !            58:       END

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