Return to CHKALL.f CVS log

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

Annotation of researchv10no/cmd/pfort/CHKALL.f, revision 1.1.1.1

1.1       root        1:       SUBROUTINE CHKALL
                      2: C
                      3: C      CHKALL READS IN REFS FROM OUTUT4 AND CHECKS THEM
                      4: C      EXPANDS ALL INDIRECTS AND CHECKS THEM, IF ALL OK
                      5: C      WRITES THE EXPANDED VERSION OUT ON OUTUT3
                      6: C     TEMPLATE WRITTEN OUT CONSISTS OF
                      7: C     PREF - NO OF WORDS TO FOLLOW
                      8: C     IBR - CODE .LT.3 TO SHOW OK REF
                      9: C     REF(1) - 2*NO OF ARGS
                     10: C     IJR - LAT INDEX OF CALLED P.U.
                     11: C     REF(3) - STMT NO OF REF
                     12: C     REF(4) - CODE 0-SUBR, 1-FCN
                     13: C     REF(5 -) - ARG ENTRIES
                     14: C      FOR DIRECT REFS  IF OK WRITES THE DIRECT REF OUT ON OUTUT3
                     15: C      CHKALL WRITES END OF REFS ON OUTUT3 BEFORE RETURNING
                     16: C
                     17:       INTEGER OUTUT3, OUTUT4, DSA, PDSA, REF, PREF, PLAT, SYMLEN, FINDND
                     18:       INTEGER CHK1, CHK2
                     19:       LOGICAL ERR, SYSERR, ABORT, QP2, QBR
                     20:       COMMON /PARAMS/ I1, I2, I3, SYMLEN, I4, OUTUT3, OUTUT4
                     21:       COMMON /CTABL/ LDSA, PDSA, DSA(5000)
                     22:       COMMON /CREF/ LREF, PREF, REF(100)
                     23:       COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
                     24:       COMMON /DETECT/ ERR, SYSERR, ABORT
                     25:       COMMON /FACTS/ NAME, NOST, ITYP, IASF
                     26:       COMMON /PASS/ QP2, QBR
                     27:       DATA IBR /1/, JBR /3/
                     28: C      IJK IS CALLING PGM UNIT; IJR IS PGM UNIT CALLED
                     29:       IJK = FINDND(DSA(NAME+4),L1)
                     30:    10 IF (INREF(OUTUT4)) 20, 20, 30
                     31: C      WRITE END OF REFS AND RETURN
                     32:    20 WRITE (OUTUT3) IBR, JBR, IBR
                     33:       QBR = .FALSE.
                     34:       RETURN
                     35: C      CHECK IF REF INDIRECT OR DIRECT
                     36:    30 IF (IGATT1(REF(2),4).EQ.1) GO TO 40
                     37: C      HAVE A DIRECT REF
                     38:       IJR = REF(2)
                     39:       IJR = FINDND(DSA(IJR+4),L1)
                     40:       IBAR = CHK2(IJK,IJR)
                     41:       IF (SYSERR) GO TO 20
                     42:       IF (IBAR.EQ.1) WRITE (OUTUT3) PREF, IBR, REF(1), IJR,
                     43:      *    (REF(L),L=3,PREF)
                     44:       GO TO 10
                     45: C      HAVE AN INDIRECT REF
                     46:    40 K = IJK + SYMLEN + 5
                     47:       K = LAT(K)
                     48: C      NOTE HAVE FLAGGED THIS ERROR OF NO ACTUALS AT LAT(IM)
                     49: C      BEFORE IN PROC SO NOW SKIP OVER REF
                     50:       IF (K.EQ.0) GO TO 10
                     51: C      K POINTS TO ACTUALS TEMPLATE AT CALLING PGM
                     52:       L = REF(2)
                     53:       L = DSA(L+2)
                     54:       J = IJK + SYMLEN + 1
                     55:       J = LAT(J)
                     56:       IF (L.LE.1) GO TO 60
                     57:       DO 50 LL=2,L
                     58:         J = LAT(J+3)
                     59:    50 CONTINUE
                     60:    60 L = LAT(J+1)
                     61: C      L IS OFFSET IN ACTUALS TEMPLATE OF ACTUALS
                     62: C      CORRESP TO THIS DUMMY
                     63:    70 J = K + L
                     64:       IJR = LAT(J)
                     65:       QBR = .TRUE.
                     66:       IF (CHK1(IJK,IJR).NE.1) GO TO 80
                     67:       IBAR = CHK2(IJK,IJR)
                     68:       IF (SYSERR) GO TO 20
                     69:       IF (IBAR.EQ.1) WRITE (OUTUT3) PREF, IBR, REF(1), IJR,
                     70:      *    (REF(L),L=3,PREF)
                     71:    80 QBR = .FALSE.
                     72:       K = LAT(K) + K
                     73:       K = LAT(K)
                     74:       IF (K) 10, 10, 70
                     75:       END

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