INTEGER FUNCTION CHK2(IR, IE) C C PROGRAM UNIT AT LAT(IR) CALLS PROGRAM UNIT AT LAT(IE) C CHK2 RETURNS 1 IF REF IS OK, ELSE 0 C CHECKS TYPE OF FCN IF FCN IS REFERENCED, C CHECKS PROC PARAMETERF FOR COMPATIBLE USAGE AND TYPE C TYPE AND STRUCTURE OF VARIABLE C AND ARRAY ARGS, BUILDS UPWARD LINKS BETWEEN C DUMMIES FOR SETTING INFO TRANSFER IN SCAN C BAD STRUCTURE MATCHING MAKES REF BAD C NO DUMMY LINKS CREATED IN THIS CASE C INTEGER REF, PREF, PDSA, DSA, PLAT, SYMLEN, FINDND, AER(1) LOGICAL ERR, SYSERR, ABORT COMMON /DETECT/ ERR, SYSERR, ABORT COMMON /CREF/ LREF, PREF, REF(100) COMMON /CTABL/ LDSA, PDSA, DSA(5000) COMMON /GRAPH/ LLAT, PLAT, LAT(6000) COMMON /PARAMS/ I1, I2, I3, SYMLEN, I4, I5, I6 COMMON /FACTS/ NAME, NOST, ITYP, IASF CHK2 = 1 C CHECK TYPE OF FCN CALLED IF A FCN IF (REF(4).NE.1) GO TO 10 I = IE + SYMLEN + 6 IF (MOD(IGATT1(REF(2),1),8).EQ.LAT(I)/8) GO TO 10 IF (MOD(LAT(I),8).EQ.6 .AND. IGATT1(REF(2),1)/8.NE.1) GO TO 10 CALL ERROR2(39H INCOMPATIBLE FCN TYPE IN REFERENCE TO , 39, * LAT(IE), 1, 1, 0) CALL ERROR2(1H1, 0, REF(3), -1, 0, 1) C CYCLE THROUGH ARGS IF ANY 10 I = IE + SYMLEN IF (LAT(I).EQ.0) GO TO 170 I = LAT(I) N = IE + SYMLEN + 1 L = 5 DO 160 K=1,I AER(1) = K L1 = IGATT2(LAT(N),8) IF (L1.EQ.13 .OR. L1.EQ.6 .OR. L1.EQ.5) GO TO 90 C CHECK STRUCTURE AND TYPE OF VARIABLES C AND ARRAY ARGUMENTS K1 = MOD(IGATT2(LAT(N),1),8) K2 = IGATT2(LAT(N),7) IF (K2.GT.1) K2 = 1 L1 = MOD(REF(L+1),8) L2 = MOD(REF(L+1),32)/8 C C CHECK TYPE, CHECK HOLLERITH CONSTANTS MATCHED C ALWAYS TO INTEGER ARRAYS C IF (L1.NE.5 .OR. REF(L).NE.0) GO TO 20 IF (REF(4).EQ.0 .AND. K2.NE.0 .AND. K1.EQ.2) GO TO 40 CALL ERROR2(33H HOLLERITH CONST ASSOCIATED WITH ,33,AER,-2,1,0) CALL ERROR2(17H IN REFERENCE TO , 17,LAT(IE),1, 0, 0) CALL ERROR2(1H1, 0, REF(3), -1, 0, 1) CHK2 = 0 GO TO 150 20 IF (K1.EQ.L1 .OR. K1.EQ.2 .AND. L1.EQ.5) GO TO 30 CALL ERROR2(33H MISMATCHED TYPE ASSOCIATED WITH ,33,AER,-2,1,0) CALL ERROR2(17H IN REFERENCE TO ,17,LAT(IE),1, 0, 0) CALL ERROR2(1H1, 0, REF(3), -1, 0, 1) C C CHECK STRUCTURE L2 = 0 SCALAR, 1 ARRAY, 2 ARRAY ELE C 30 IF (K2.EQ.1 .AND. L2.GT.0 .OR. K2.EQ.0 .AND. (L2.EQ.2 .OR. * L2.EQ.0)) GO TO 40 CALL ERROR2(38H MISMATCHED STRUCTURE ASSOCIATED WITH ,38,AER,-2, * 1, 0) CALL ERROR2(17H IN REFERENCE TO , 17, LAT(IE),1, 0, 0) CALL ERROR2(1H1, 0, REF(3), -1,0,1) CHK2 = 0 GO TO 150 C C CHECK IF ACTUAL ARG IS NON-PROC DUMMY ARG IN CURRENT PGM UNIT C IF SO CREATE ARGLINK. C NO ARGLINK CREATED IF FCN CALLED IS AN ASF C 40 IF (REF(L).LE.0 .OR. REF(4).EQ.4) GO TO 150 K1 = IGATT1(REF(L),4) IF (K1.EQ.0) GO TO 150 C C FIND REL. POSITION OF CALLING PGM C DUMMY , L1 PTS TO IT IN LAT L3 = DSA(NAME+2) KK = 0 50 KK = KK + 1 IF (DSA(L3).EQ.REF(L)) GO TO 60 L3 = DSA(L3+1) GO TO 50 60 K2 = 0 L1 = IR + SYMLEN - 2 70 L1 = LAT(L1+3) K2 = K2 + 1 IF (K2.LT.KK) GO TO 70 C FIND REL POSITION OF CALLED DUMMY ARG C L2 PTS TO IT IN LAT K1 = 0 L2 = IE + SYMLEN - 2 80 L2 = LAT(L2+3) K1 = K1 + 1 IF (K1.LT.K) GO TO 80 IF (MATCH(LAT(L2+2),1,L1).NE.0) GO TO 150 IF (PLAT+2.GT.LLAT) GO TO 180 LAT(PLAT) = L1 LAT(PLAT+1) = LAT(L2+2) LAT(L2+2) = PLAT PLAT = PLAT + 2 GO TO 150 C CHECK PROC ARGUMENTS TO SEE THEY ARE CORRECT USAGE AND TYPE C LAT(N) PTS TO DUMMY ARG ENTRY IN LAT C REF(L) PTS TO CORRESP REF ARG IN DSA 90 IF (IGATT1(REF(L),4).EQ.1) GO TO 110 C REFERENCE CONTAINS AN AACTUAL PROC NAME C CHECK FOR MISSING SUBPROGRAM L3 = REF(L) L2 = FINDND(DSA(L3+4),L3) IF (L2.NE.0) GO TO 100 L3 = REF(L) + 4 CALL ERROR2(20H MISSING SUBPROGRAM , 20, DSA(L3), 1, 1, 0) CALL ERROR2(17H IN REFERENCE TO , 17, LAT(IE), 1, 0, 0) CALL ERROR2(1H1, 0, REF(3), -1, 0, 1) GO TO 150 C CALL CHK3 TO PREFORM CHECKS 100 L5 = L2 + SYMLEN + 6 CALL CHK3(LAT(N), L2, L1, MOD(LAT(L5),8), IE, REF(3), AER) GO TO 150 C REFERENCE CONTAINS A DUMMY ARGUMENT MUST CHECK ALL ACTUALS C WHICH CAN CORRESPOND TO THAT DUMMY C FIRST FIND ITS CORRESP ACTUAL, IF ANY 110 L2 = REF(L) L2 = DSA(L2+2) C L2 IS OFFSET AMONG ALL DUMMIES OF LAT(IR) C OF THE DUMMY ARG AT REF(L) L3 = IR + SYMLEN + 1 L3 = LAT(L3) IF (L2.EQ.1) GO TO 130 DO 120 L4=2,L2 L3 = LAT(L3+3) 120 CONTINUE C L3 PTS TO DUMMY ARG IN CALLING RTNE 130 L3 = LAT(L3+1) C L3 CONTAINS OFFSET FOR PROC ACTUALS C MATCHED TO THIS DUMMY ARG C IN TEMPLATED OFF LAT(IR) L2 = IR + SYMLEN + 5 IF (LAT(L2).NE.0) GO TO 140 L3 = REF(L) + 4 CALL ERROR2(35H NO ACTUAL PROCS SUBSTITUTABLE FOR , 35, * DSA(L3), 1, 1, 0) CALL ERROR2(17H IN REFERENCE TO , 17, LAT(IE), 1, 0, 0) CALL ERROR2(1H1, 0, REF(3), -1, 0, 1) GO TO 150 C L2 PTS TO ACTUALS TEMPLATE 140 L2 = LAT(L2) L4 = L2 + L3 C LAT(L4) IS ACTUAL PAIRED TO REF(L) L5 = LAT(L4) + SYMLEN + 6 CALL CHK3(LAT(N), LAT(L4), L1, MOD(LAT(L5),8), IE, REF(3), AER) C CYCLE TO NEXT ACTUAL L2 = LAT(L2) + L2 IF (LAT(L2)) 150, 150, 140 150 L = L + 2 N = LAT(N) + 3 160 CONTINUE 170 RETURN 180 SYSERR = .TRUE. CHK2 = 0 CALL ERROR1(31H IN CHK2, TABLE OVERFLOW OF LAT, 31) GO TO 170 END