Return to TOKLAB.f CVS log

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

Annotation of researchv10no/cmd/pfort/TOKLAB.f, revision 1.1

1.1     ! root        1:       LOGICAL FUNCTION TOKLAB(K1, K2, KK, DEF)
        !             2:       INTEGER STMT, PSTMT, SYMHD, DSA, PDSA, BNEXT, DOPT, DOLIST
        !             3:       LOGICAL DEF, NON0, SYSERR, ABORT, ERR
        !             4:       COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
        !             5:       COMMON /TABL/ NEXT, LABHD, SYMHD, BNEXT
        !             6:       COMMON /CTABL/ LDSA, PDSA, DSA(5000)
        !             7:       COMMON /DETECT/ ERR, SYSERR, ABORT
        !             8:       COMMON /DOS/ DOPT, LDO, DOLIST(192)
        !             9:       COMMON /FACTS/ NAME, NOST, ITYPE, IASF
        !            10: C
        !            11: C     LOOKS FOR DEFNS OF LABEL IF DEF = .TRUE., ELSE LOOKS FOR
        !            12: C     REFS. IF IT FINDS A LABEL TOKLAB=.TRUE.
        !            13: C     IN REFERENCE LABEL IS IN STMT(PSTMT)-STMT(K2-1)
        !            14: C     IN DEFN LABEL IS IN STMT(1)-STMT(K2-1)
        !            15: C     KK IS SYMBOL TABLE INDEX OF LABEL
        !            16: C     K1 IS TYPE OF LABEL EXPECTED OR DEFINED--1-EXECUTABLE
        !            17: C     2-NONEXECUTABLE, 3-FORMAT
        !            18: C     IN REF, ROUTINE SETS USAGE OF SYMBOL AND CHECKS FOR
        !            19: C     COMPATIBLE REFERENCES(I.E. GOTO 5 AND WRITE(6,5) ARE INCOMPAT.)
        !            20: C     IN DEF, ROUTINE SETS USAGE OF SYMBOL, CHECKS FOR DUPLICATE
        !            21: C     DEFNS, CHECKS FOR COMPATIBLITY BETWEEN DEFN AND PREVIOUS
        !            22: C     REFS, CREATES SCOPE AREA FOR LABEL INITIALIZING WORD1 TO
        !            23: C     CURRENT HEADING STMT NO ON DOLIST AND WORD2 TO CURRENT LEVEL
        !            24: C     IN REFS AND DEFS LABELS MUST BE POSITIVE NUMBERS
        !            25: C
        !            26:       TOKLAB = .FALSE.
        !            27:       IF (DEF) GO TO 80
        !            28:       NON0 = .FALSE.
        !            29:       J = PSTMT + 4
        !            30:       IF (J.GT.NSTMT) J = NSTMT
        !            31:       K3 = PSTMT
        !            32:       DO 10 K2 = PSTMT,J
        !            33:         IF(STMT(K2).GT.9 .OR. STMT(K2).LT.0) GOTO 60
        !            34:         IF(STMT(K2) .GT. 0) NON0 = .TRUE.
        !            35:         IF(.NOT.NON0) K3 = K3+1
        !            36:  10   CONTINUE
        !            37:       K2 = J+1
        !            38:       IF(.NOT.NON0) GOTO 70
        !            39: C     NOTE CAN CHANGE PSTMT HERE BECAUSE WE KNOW WE HAVE A LAB
        !            40:  20   PSTMT = K3
        !            41:       KK = LOOKUP(K2,.TRUE.)
        !            42:       IF (SYSERR) GO TO 50
        !            43:       IF (ITYPE.EQ.14) DSA(BNEXT+1) = -DSA(BNEXT+1)
        !            44:       I = IGATT1(KK,8)
        !            45:       IF (I.EQ.0) CALL SATT1(KK, 8, 9)
        !            46:       I1 = IGATT1(KK,1)
        !            47:       IF (I1.NE.0) GO TO 30
        !            48:       CALL SATT1(KK, 1, K1)
        !            49:       GO TO 40
        !            50:    30 IF (K1.NE.I1) CALL ERROR1(30H INCOMPATIBLE LABEL REFERENCES, 30)
        !            51:    40 TOKLAB = .TRUE.
        !            52:    50 RETURN
        !            53:    60 IF (K2.EQ.PSTMT) GO TO 50
        !            54:       IF (NON0) GO TO 20
        !            55:    70 CALL ERROR1(30H LABEL MUST BE POSITIVE NUMBER, 30)
        !            56:       GO TO 50
        !            57: C
        !            58: C     TAKES DEF OF LABEL; CHECKS FOR DUPLICATE DEFS.; SETS DEFINED
        !            59: C     BIT IN SYMBOL TABLE;  STORES BEGINNING BINDING STMT NO
        !            60: C
        !            61:    80 K2 = 0
        !            62:       NON0 = .FALSE.
        !            63:       DO 90 I=1,5
        !            64:         IF (STMT(I).EQ.69) GO TO 90
        !            65:         IF ((STMT(I).GT.9) .OR. (STMT(I).LT.0)) GO TO 140
        !            66:         IF (STMT(I).GT.0) NON0 = .TRUE.
        !            67:         IF (.NOT.NON0) GO TO 90
        !            68:         K2 = K2 + 1
        !            69:         STMT(K2) = STMT(I)
        !            70:    90 CONTINUE
        !            71:       IF (K2.EQ.0) GO TO 50
        !            72:       IF (.NOT.NON0) GO TO 70
        !            73:       K2 = K2 + 1
        !            74:       KK = LOOKUP(K2,.TRUE.)
        !            75:       IF (SYSERR) GO TO 50
        !            76:       I = IGATT1(KK,2)
        !            77:       IF (I.EQ.1) GO TO 120
        !            78:       CALL SATT1(KK, 2, 1)
        !            79:       CALL SATT1(KK, 8, 9)
        !            80:       I1 = IGATT1(KK,1)
        !            81:       IF (I1.EQ.0) GO TO 100
        !            82:       IF (I1.EQ.K1) GO TO 110
        !            83:       CALL ERROR1(44H ILLEGAL REFERENCE TO LABEL IN PREVIOUS CODE, 44)
        !            84:   100 CALL SATT1(KK, 1, K1)
        !            85:   110 IF (K1.NE.1) GO TO 40
        !            86:       IF (NEXT+2.GE.BNEXT) GO TO 130
        !            87:       DSA(KK+2) = NEXT
        !            88:       DSA(NEXT) = DOLIST(DOPT)
        !            89:       DSA(NEXT+1) = -DOPT/6
        !            90:       NEXT = NEXT + 2
        !            91:       GO TO 40
        !            92:   120 CALL ERROR1(16H DUPLICATE LABEL, 16)
        !            93:       GO TO 50
        !            94:   130 CALL ERROR1(33H IN TOKLAB, TABLE OVERFLOW OF DSA, 33)
        !            95:       SYSERR = .TRUE.
        !            96:       GO TO 50
        !            97:   140 CALL ERROR1(24H ILLEGAL SYMBOL IN LABEL, 24)
        !            98:       GO TO 50
        !            99:       END

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