Return to SETARG.f CVS log

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

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

1.1       root        1:       INTEGER FUNCTION SETARG(PP, N)
                      2:       INTEGER PLAT, DSA, PP, SYMLEN, PDSA
                      3:       LOGICAL ERR, SYSERR, ABORT
                      4:       COMMON /CTABL/ LDSA, PDSA, DSA(5000)
                      5:       COMMON /DETECT/ ERR, SYSERR, ABORT
                      6:       COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
                      7:       COMMON /PARAMS/ INUT, I1, NOCHAR, SYMLEN, I2, I3, I4
                      8: C
                      9: C     SETS UP LIST OF ARGUMENTS , HANGING OFF NODE AT LAT(PP)
                     10: C     ARGES ARE KEPT IN ORDERED LINEAR LINKED LIST
                     11: C     ORDERING CORRESPONDS TO LEFT TO RIGHT APPEARENCE IN DEFN
                     12: C     N-SUBPRGM ENTRY IN DSA
                     13: C     PP- CURRENT RTNE NODE IN LAT
                     14: C     ARGUMENT NODE
                     15: C     WD 1      ATTRIBUTES
                     16: C     WD2       LENGTH WITH -1 FOR VARIABLEY DIMENSIONED ARRAYS
                     17: C     WD3       HEAD OF PARENT REFS LIST
                     18: C     WD4       HEAD OF DESCENDENTS REFS LIST
                     19: C     WD5       PTR TO NEXT ARG
                     20: C
                     21: C     FIND FIRST ARGUMENT & ZERO COUNT
                     22: C
                     23:       J = DSA(N+2)
                     24:       SETARG = 0
                     25:       IPROC = 0
                     26: C
                     27: C     FIND FIRST ENTRY ON DSA ARGLIST;
                     28: C     KK HEAD OF TO BE CREATED ARGLIST IN LAT
                     29: C
                     30:       I = DSA(J)
                     31:       KK = PP + SYMLEN + 1
                     32: C
                     33: C     SETUP STORAGE FOR ARG ENTRY
                     34: C
                     35:    10 IF (PLAT+4.GE.LLAT) GO TO 80
                     36: C
                     37: C     ENTER ATTRIBUTE WORD AND ZERO REST OF ENTRY
                     38: C
                     39:       LAT(PLAT) = DSA(I)
                     40:       LAT(KK) = PLAT
                     41:       KK = PLAT + 3
                     42:       DO 20 IA=1,3
                     43:         L = IA + PLAT
                     44:         LAT(L) = 0
                     45:    20 CONTINUE
                     46:       K = IGATT1(I,8)
                     47:       IF (K.NE.10) GO TO 50
                     48: C
                     49: C     GET STRUCTURE  OF ARG
                     50: C
                     51:       K = IGATT1(I,7)
                     52:       IF (K) 40, 40, 30
                     53: C
                     54: C     ARRAY
                     55: C
                     56:    30 K = DSA(I+2)
                     57:       LAT(PLAT+1) = DSA(K)
                     58:       GO TO 60
                     59: C
                     60: C     SCALAR
                     61: C
                     62:    40 LAT(PLAT+1) = 1
                     63:       GO TO 60
                     64: C     SET RELATIVE ORDER OF PROC ARGS IN ITS 2ND WORD
                     65:    50 IPROC = IPROC + 1
                     66:       LAT(PLAT+1) = IPROC
                     67: C
                     68: C     CHECK FOR MORE ARGS; ADVANCE  PLAT
                     69: C
                     70:    60 PLAT = PLAT + 4
                     71:       SETARG = SETARG + 1
                     72:       IF (DSA(J+1)) 90, 90, 70
                     73:    70 J = DSA(J+1)
                     74:       I = DSA(J)
                     75:       GO TO 10
                     76:    80 SYSERR = .TRUE.
                     77:       CALL ERROR1(33H IN SETARG, TABLE OVERFLOW OF LAT, 33)
                     78:    90 RETURN
                     79:       END

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