Return to CHK1.f CVS log

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

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

1.1       root        1:       INTEGER FUNCTION CHK1(IR, IE)
                      2: C
                      3: C      PROGRAM UNIT AT LAT(IR) CALLS PROGRAM UNIT AT LAT(IE)
                      4: C      CHK1 RETURNS 1 IF REF OK ELSE 0
                      5: C      CHECKS FOR INCONSISTENT SYBPGM USAGE, CORRECT NO. OF
                      6: C      ARGS, CORRECT USAGE MATCH UP OF ARGS
                      7: C
                      8:       INTEGER PREF, REF, PDSA, DSA, PLAT, SYMLEN, IBR(1)
                      9:       COMMON /CREF/ LREF, PREF, REF(100)
                     10:       COMMON /CTABL/ LDSA, PDSA, DSA(5000)
                     11:       COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
                     12:       COMMON /PARAMS/ I1, I2, I3, SYMLEN, I4, I5, I6
                     13:       CHK1 = 0
                     14: C      CHECKS FOR SELF RECURSION
                     15:       IF (IE.NE.IR) GO TO 10
                     16:       CALL ERROR2(24H RECURSIVE CALL OF SELF , 24, REF(3), -1, 1, 1)
                     17:       GO TO 100
                     18: C      CHECKS FOR USAGE OF SUBPGM CONSISTENT WITH DEF
                     19:    10 I = IE + SYMLEN + 6
                     20:       N = MOD(LAT(I),8)
                     21:       IF (N.EQ.REF(4) .OR. N.EQ.6 .AND. REF(4).EQ.1) GO TO 20
                     22:       CALL ERROR2(38H INCONSISTENT REFERENCE TO SUBPROGRAM , 38,
                     23:      *  LAT(IE), 1, 1, 0)
                     24:       CALL ERROR2(1H1, 0, REF(3), -1, 0, 1)
                     25:       GO TO 100
                     26: C      CHECKS FOR CORRECT NO. ARGS
                     27:    20 I = IE + SYMLEN
                     28:       IF (LAT(I).EQ.REF(1)/2) GO TO 30
                     29:       CALL ERROR2(42H INCORRECT NUMBER OF ARGS IN REFERENCE TO , 42,
                     30:      *  LAT(IE), 1, 1, 0)
                     31:       CALL ERROR2(1H1, 0, REF(3), -1, 0, 1)
                     32:       GO TO 100
                     33: C      ARE DONE WITH REF IF IT HAS NO ARGS
                     34:  30   CHK1 = 1
                     35:       IF(LAT(I)) 100, 100, 40
                     36: C      CHECK USAGES OF ARGS IN CALL VS USAGES OF ARGS IN DEF
                     37: C      N POINTS TO DUMMY ARG ENTRY
                     38:    40 I = LAT(I)
                     39:       N = IE + SYMLEN + 1
                     40:       L = 5
                     41:       DO 80 K=1,I
                     42:         MD = IGATT2(LAT(N),8)
                     43:         IF (MD.NE.13 .AND. MD.NE.5 .AND. MD.NE.6) GO TO 60
                     44: C      HAVE A PROC ARG IN DEF
                     45: C      NEED A PROC ARG IN REF
                     46:         IF (REF(L).EQ.0) GO TO 50
                     47:         MR = IGATT1(REF(L),8)
                     48:         IF (MR.EQ.13 .OR. MR.EQ.6 .OR. MR.EQ.5) GO TO 70
                     49:  50   IBR(1) = K
                     50:       CALL ERROR2(36H INCOMPATIBLE USAGE ASSOCIATED WITH ,36,IBR,-2,1,0)
                     51:       CALL ERROR2(17H IN REFERENCE TO ,17,LAT(IE), 1, 0, 0)
                     52:       CALL ERROR2(1H1, 0, REF(3), -1, 0, 1)
                     53:       CHK1 = 0
                     54:       GOTO 70
                     55: C      HAVE VARIABLE OR ARRAY AS ARG IN DEF
                     56: C      NEED SAME IN REF
                     57:    60   IF (REF(L).EQ.0) GO TO 70
                     58:         MR = IGATT1(REF(L),8)
                     59:         IF (MR.EQ.13 .OR. MR.EQ.5 .OR. MR.EQ.6) GO TO 50
                     60:    70   N = LAT(N) + 3
                     61:         L = L + 2
                     62:    80 CONTINUE
                     63:   100 RETURN
                     64:       END

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