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

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.