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

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.