Return to SETASF.f CVS log

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

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

1.1     ! root        1:       SUBROUTINE SETASF(PP, K)
        !             2:       INTEGER PP, SYMLEN, PLAT, PDSA, SETARG, PNODE, DSA
        !             3:       LOGICAL ERR, SYSERR, ABORT
        !             4:       COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
        !             5:       COMMON /HEAD/ LNODE, PNODE, NODE(500)
        !             6:       COMMON /CTABL/ LDSA, PDSA, DSA(5000)
        !             7:       COMMON /PARAMS/ INUT, I1, NOCHAR, SYMLEN, I2, I3, I4
        !             8:       COMMON /DETECT/ ERR, SYSERR, ABORT
        !             9: C
        !            10: C     SETUP ASF NODE;  IT HAS A NODE JUST LIKE A RTNE
        !            11: C     EXCEPT ITS INDEX IN NODE IS NEGATIVE
        !            12: C     PP-COM ADDRESS OF PARENT SUBPGM
        !            13: C     K-DSA ADDRESS OF ASF ENTRY
        !            14: C
        !            15:       IF (PNODE+1.GT.LNODE) GO TO 40
        !            16:       IF (PLAT+SYMLEN+11.GT.LLAT) GO TO 60
        !            17: C
        !            18: C     CREATE NEW NODE ENTRY
        !            19: C
        !            20:       NODE(PNODE) = -PLAT
        !            21:       PNODE = PNODE + 1
        !            22: C
        !            23: C     ENTER NAME AND ZERO REST OF NODE
        !            24: C
        !            25:       DO 10 I=1,SYMLEN
        !            26:         L = K + 3 + I
        !            27:         LL = PLAT + I - 1
        !            28:         LAT(LL) = DSA(L)
        !            29:    10 CONTINUE
        !            30:       DO 20 I=1,6
        !            31:         L = LL + I
        !            32:         LAT(L) = 0
        !            33:    20 CONTINUE
        !            34: C
        !            35: C     SET LAST ELEMENT TO TYPE OF PGM UNIT
        !            36: C     STORE IN SAME WORD ASF TYPE
        !            37: C
        !            38:       I = IGATT1(K,1)
        !            39:       LAT(L+1) = 4 + 8*MOD(I,8)
        !            40: C
        !            41: C     SETUP PARENT'S LIST TO POINT TO PP IN ASF NODE
        !            42: C
        !            43:       L = PLAT + SYMLEN + 3
        !            44:       LAT(L) = L + 4
        !            45:       LAT(L+4) = PP
        !            46:       LAT(L+5) = 0
        !            47:       KQ = PLAT
        !            48:       PLAT = L + 6
        !            49: C
        !            50: C     SETUP REFERENCE IN PP'S DESCENDENTS LIST
        !            51: C
        !            52:       II = PP + SYMLEN + 4
        !            53:       LAT(PLAT) = KQ
        !            54:       LAT(PLAT+1) = LAT(II)
        !            55:       LAT(II) = PLAT
        !            56:       PLAT = PLAT + 2
        !            57: C
        !            58: C     SETUP ARGUMENTS
        !            59: C
        !            60:       L = KQ + SYMLEN
        !            61:       LAT(L) = SETARG(KQ,K)
        !            62:    30 RETURN
        !            63:    40 CALL ERROR1(34H IN SETASF, TABLE OVERFLOW OF NODE, 34)
        !            64:    50 SYSERR = .TRUE.
        !            65:       GO TO 30
        !            66:    60 CALL ERROR1(33H IN SETASF, TABLE OVERFLOW OF LAT, 33)
        !            67:       GO TO 50
        !            68:       END

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