Return to CHKALL.f CVS log

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

researchv10 Norman

      SUBROUTINE CHKALL
C
C      CHKALL READS IN REFS FROM OUTUT4 AND CHECKS THEM
C      EXPANDS ALL INDIRECTS AND CHECKS THEM, IF ALL OK
C      WRITES THE EXPANDED VERSION OUT ON OUTUT3
C     TEMPLATE WRITTEN OUT CONSISTS OF
C     PREF - NO OF WORDS TO FOLLOW
C     IBR - CODE .LT.3 TO SHOW OK REF
C     REF(1) - 2*NO OF ARGS
C     IJR - LAT INDEX OF CALLED P.U.
C     REF(3) - STMT NO OF REF
C     REF(4) - CODE 0-SUBR, 1-FCN
C     REF(5 -) - ARG ENTRIES
C      FOR DIRECT REFS  IF OK WRITES THE DIRECT REF OUT ON OUTUT3
C      CHKALL WRITES END OF REFS ON OUTUT3 BEFORE RETURNING
C
      INTEGER OUTUT3, OUTUT4, DSA, PDSA, REF, PREF, PLAT, SYMLEN, FINDND
      INTEGER CHK1, CHK2
      LOGICAL ERR, SYSERR, ABORT, QP2, QBR
      COMMON /PARAMS/ I1, I2, I3, SYMLEN, I4, OUTUT3, OUTUT4
      COMMON /CTABL/ LDSA, PDSA, DSA(5000)
      COMMON /CREF/ LREF, PREF, REF(100)
      COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
      COMMON /DETECT/ ERR, SYSERR, ABORT
      COMMON /FACTS/ NAME, NOST, ITYP, IASF
      COMMON /PASS/ QP2, QBR
      DATA IBR /1/, JBR /3/
C      IJK IS CALLING PGM UNIT; IJR IS PGM UNIT CALLED
      IJK = FINDND(DSA(NAME+4),L1)
   10 IF (INREF(OUTUT4)) 20, 20, 30
C      WRITE END OF REFS AND RETURN
   20 WRITE (OUTUT3) IBR, JBR, IBR
      QBR = .FALSE.
      RETURN
C      CHECK IF REF INDIRECT OR DIRECT
   30 IF (IGATT1(REF(2),4).EQ.1) GO TO 40
C      HAVE A DIRECT REF
      IJR = REF(2)
      IJR = FINDND(DSA(IJR+4),L1)
      IBAR = CHK2(IJK,IJR)
      IF (SYSERR) GO TO 20
      IF (IBAR.EQ.1) WRITE (OUTUT3) PREF, IBR, REF(1), IJR,
     *    (REF(L),L=3,PREF)
      GO TO 10
C      HAVE AN INDIRECT REF
   40 K = IJK + SYMLEN + 5
      K = LAT(K)
C      NOTE HAVE FLAGGED THIS ERROR OF NO ACTUALS AT LAT(IM)
C      BEFORE IN PROC SO NOW SKIP OVER REF
      IF (K.EQ.0) GO TO 10
C      K POINTS TO ACTUALS TEMPLATE AT CALLING PGM
      L = REF(2)
      L = DSA(L+2)
      J = IJK + SYMLEN + 1
      J = LAT(J)
      IF (L.LE.1) GO TO 60
      DO 50 LL=2,L
        J = LAT(J+3)
   50 CONTINUE
   60 L = LAT(J+1)
C      L IS OFFSET IN ACTUALS TEMPLATE OF ACTUALS
C      CORRESP TO THIS DUMMY
   70 J = K + L
      IJR = LAT(J)
      QBR = .TRUE.
      IF (CHK1(IJK,IJR).NE.1) GO TO 80
      IBAR = CHK2(IJK,IJR)
      IF (SYSERR) GO TO 20
      IF (IBAR.EQ.1) WRITE (OUTUT3) PREF, IBR, REF(1), IJR,
     *    (REF(L),L=3,PREF)
   80 QBR = .FALSE.
      K = LAT(K) + K
      K = LAT(K)
      IF (K) 10, 10, 70
      END

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