Return to CHK3.f CVS log

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

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

1.1       root        1:       SUBROUTINE CHK3(IDUM, IACT, IDUM8, IACT8, IE, R, NO)
                      2: C
                      3: C     CHECKS PROC ARGUMENTS FOR PROPER USAGE AND TYPE
                      4: C     IDUM LAT INDEX DUMY PROC ARG
                      5: C     IACT LAT INDEX ACTUAL PROC
                      6: C     IDUM8 USAGE DUMMY FROM DSA ATTRIBUTES
                      7: C     IACT8 USAGE ACTUAL FROM LAT ENTRY
                      8: C     IE CALLED RTNE
                      9: C     R STMT NO OF CALL
                     10: C     NO CONTAINS THE NUMBER OF PARAMETER BEING CHECKED BY THIS CALL
                     11: C
                     12:       INTEGER PLAT, R(1), SYMLEN, NO(1)
                     13:       COMMON /PARAMS/ I1, I2, I3, SYMLEN, I4, I5, I6
                     14:       COMMON /GRAPH/ LLAT, PLAT, LAT(6000)
                     15: C     SEPARATE OUT EXTERNAL ENTITIES
                     16:       IF (IDUM8.NE.13) GO TO 20
                     17:       L = IGATT2(IDUM,1)/8
                     18:       IF (L.NE.1) GO TO 50
                     19: C     FURTHER CHECK THAT EPLICITLY TYPED EXTERNAL ENTITIES
                     20: C     MATCH FCNS
                     21:       IF (IACT8.NE.1 .AND. IACT8.NE.6) GO TO 30
                     22: C     CHECK FCN HAS SAME TYPE ACROSS REF BNDRY
                     23:    10 L = IACT + SYMLEN + 6
                     24:       IF (MOD(IGATT2(IDUM,1),8).EQ.LAT(L)/8) GO TO 50
                     25:       CALL ERROR2(40H INCONSISTENT FCN TYPES IN REFERENCE TO , 40,
                     26:      *  LAT(IE), 1, 1, 0)
                     27:       CALL ERROR2(1H1, 0, R(1), -1, 0, 1)
                     28:       GO TO 50
                     29: C     CHECK SUBROUTINES
                     30:    20 IF (IDUM8.EQ.6 .AND. IACT8.EQ.0) GO TO 50
                     31: C     CHECK OUT FCNS
                     32:       IF (IDUM8.EQ.5 .AND. IACT8.EQ.1) GO TO 10
                     33: C     SEPARATE OUT BASIC EXTERNALS BECAUSE THEY ARE CONSIDERED
                     34: C     TYPED BY THE FORTRAN.
                     35:       IF (IDUM8.EQ.5 .AND. IACT8.EQ.6) GO TO 40
                     36:    30 CALL ERROR2(
                     37:      *  50H INCOMPATIBLE PROCEDURE PARAMETER ASSOCIATED WITH ,50,
                     38:      *  NO, -2, 1, 0)
                     39:       CALL ERROR2(17H IN REFERENCE TO ,17, LAT(IE), 1, 0, 0)
                     40:       CALL ERROR2(1H1, 0, R(1), -1, 0, 1)
                     41:       GO TO 50
                     42: C     CHECK BASIC EXTER HAS NOT BEEN EXPLICITLY TYPED
                     43: C     OR ELSE IT HAS TO AGREE WITH THE ACTUAL TYPE
                     44:    40 L = IACT + SYMLEN + 6
                     45:       IF (LAT(L)/8.EQ.1) GO TO 10
                     46:    50 RETURN
                     47:       END

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