Return to TOKLAB.f CVS log

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

researchv10 Norman

      LOGICAL FUNCTION TOKLAB(K1, K2, KK, DEF)
      INTEGER STMT, PSTMT, SYMHD, DSA, PDSA, BNEXT, DOPT, DOLIST
      LOGICAL DEF, NON0, SYSERR, ABORT, ERR
      COMMON /INPUT/ NSTMT, PSTMT, STMT(1327)
      COMMON /TABL/ NEXT, LABHD, SYMHD, BNEXT
      COMMON /CTABL/ LDSA, PDSA, DSA(5000)
      COMMON /DETECT/ ERR, SYSERR, ABORT
      COMMON /DOS/ DOPT, LDO, DOLIST(192)
      COMMON /FACTS/ NAME, NOST, ITYPE, IASF
C
C     LOOKS FOR DEFNS OF LABEL IF DEF = .TRUE., ELSE LOOKS FOR
C     REFS. IF IT FINDS A LABEL TOKLAB=.TRUE.
C     IN REFERENCE LABEL IS IN STMT(PSTMT)-STMT(K2-1)
C     IN DEFN LABEL IS IN STMT(1)-STMT(K2-1)
C     KK IS SYMBOL TABLE INDEX OF LABEL
C     K1 IS TYPE OF LABEL EXPECTED OR DEFINED--1-EXECUTABLE
C     2-NONEXECUTABLE, 3-FORMAT
C     IN REF, ROUTINE SETS USAGE OF SYMBOL AND CHECKS FOR
C     COMPATIBLE REFERENCES(I.E. GOTO 5 AND WRITE(6,5) ARE INCOMPAT.)
C     IN DEF, ROUTINE SETS USAGE OF SYMBOL, CHECKS FOR DUPLICATE
C     DEFNS, CHECKS FOR COMPATIBLITY BETWEEN DEFN AND PREVIOUS
C     REFS, CREATES SCOPE AREA FOR LABEL INITIALIZING WORD1 TO
C     CURRENT HEADING STMT NO ON DOLIST AND WORD2 TO CURRENT LEVEL
C     IN REFS AND DEFS LABELS MUST BE POSITIVE NUMBERS
C
      TOKLAB = .FALSE.
      IF (DEF) GO TO 80
      NON0 = .FALSE.
      J = PSTMT + 4
      IF (J.GT.NSTMT) J = NSTMT
      K3 = PSTMT
      DO 10 K2 = PSTMT,J
        IF(STMT(K2).GT.9 .OR. STMT(K2).LT.0) GOTO 60
        IF(STMT(K2) .GT. 0) NON0 = .TRUE.
        IF(.NOT.NON0) K3 = K3+1
 10   CONTINUE
      K2 = J+1
      IF(.NOT.NON0) GOTO 70
C     NOTE CAN CHANGE PSTMT HERE BECAUSE WE KNOW WE HAVE A LAB
 20   PSTMT = K3
      KK = LOOKUP(K2,.TRUE.)
      IF (SYSERR) GO TO 50
      IF (ITYPE.EQ.14) DSA(BNEXT+1) = -DSA(BNEXT+1)
      I = IGATT1(KK,8)
      IF (I.EQ.0) CALL SATT1(KK, 8, 9)
      I1 = IGATT1(KK,1)
      IF (I1.NE.0) GO TO 30
      CALL SATT1(KK, 1, K1)
      GO TO 40
   30 IF (K1.NE.I1) CALL ERROR1(30H INCOMPATIBLE LABEL REFERENCES, 30)
   40 TOKLAB = .TRUE.
   50 RETURN
   60 IF (K2.EQ.PSTMT) GO TO 50
      IF (NON0) GO TO 20
   70 CALL ERROR1(30H LABEL MUST BE POSITIVE NUMBER, 30)
      GO TO 50
C
C     TAKES DEF OF LABEL; CHECKS FOR DUPLICATE DEFS.; SETS DEFINED
C     BIT IN SYMBOL TABLE;  STORES BEGINNING BINDING STMT NO
C
   80 K2 = 0
      NON0 = .FALSE.
      DO 90 I=1,5
        IF (STMT(I).EQ.69) GO TO 90
        IF ((STMT(I).GT.9) .OR. (STMT(I).LT.0)) GO TO 140
        IF (STMT(I).GT.0) NON0 = .TRUE.
        IF (.NOT.NON0) GO TO 90
        K2 = K2 + 1
        STMT(K2) = STMT(I)
   90 CONTINUE
      IF (K2.EQ.0) GO TO 50
      IF (.NOT.NON0) GO TO 70
      K2 = K2 + 1
      KK = LOOKUP(K2,.TRUE.)
      IF (SYSERR) GO TO 50
      I = IGATT1(KK,2)
      IF (I.EQ.1) GO TO 120
      CALL SATT1(KK, 2, 1)
      CALL SATT1(KK, 8, 9)
      I1 = IGATT1(KK,1)
      IF (I1.EQ.0) GO TO 100
      IF (I1.EQ.K1) GO TO 110
      CALL ERROR1(44H ILLEGAL REFERENCE TO LABEL IN PREVIOUS CODE, 44)
  100 CALL SATT1(KK, 1, K1)
  110 IF (K1.NE.1) GO TO 40
      IF (NEXT+2.GE.BNEXT) GO TO 130
      DSA(KK+2) = NEXT
      DSA(NEXT) = DOLIST(DOPT)
      DSA(NEXT+1) = -DOPT/6
      NEXT = NEXT + 2
      GO TO 40
  120 CALL ERROR1(16H DUPLICATE LABEL, 16)
      GO TO 50
  130 CALL ERROR1(33H IN TOKLAB, TABLE OVERFLOW OF DSA, 33)
      SYSERR = .TRUE.
      GO TO 50
  140 CALL ERROR1(24H ILLEGAL SYMBOL IN LABEL, 24)
      GO TO 50
      END

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