SUBROUTINE COMMON INTEGER PSTMT, PDSA, STMT, DSA, BNEXT, SYMHD, S(4) LOGICAL ERR, SYSERR, ABORT, ARDECL COMMON /INPUT/ NSTMT, PSTMT, STMT(1327) COMMON /CTABL/ LDSA, PDSA, DSA(5000) COMMON /TABL/ NEXT, LABHD, SYMHD, BNEXT COMMON /DETECT/ ERR, SYSERR, ABORT COMMON /FACTS/ NAME, NOST, ITYP, IASF DATA S(1) /66/, S(2) /32/, S(3) /44/, S(4) /42/ C C PROCESSES A COMMON STMT C FIRST, PEEL OFF NAME OF COMMON AND SET SYMBOL TABLE ENTRY USAGE C CHECK NAME HAS NOT APPEARED BEFORE IN PGM UNIT C IF (STMT(PSTMT).EQ.67) GO TO 30 C C SET SYMBOL TABLE ENTRY FOR BLANK COMMON C 10 I1 = IGATT1(NAME,8) IF (I1.EQ.11) GO TO 170 IF (PSTMT.GE.NSTMT) GO TO 200 L = PSTMT DO 20 I1=1,4 STMT(I1) = S(I1) 20 CONTINUE PSTMT = 1 KK = LOOKUP(5,.FALSE.) IF (SYSERR) GO TO 190 PSTMT = L CALL SATT1(KK, 8, 7) GO TO 60 30 PSTMT = PSTMT + 1 IF (STMT(PSTMT).NE.67) GO TO 40 PSTMT = PSTMT + 1 GO TO 10 40 IF (PSTMT.GE.NSTMT) GO TO 200 CALL NEXTOK(PSTMT, K2, L) IF (L.NE.0) GO TO 200 KK = LOOKUP(K2,.FALSE.) IF (SYSERR) GO TO 190 I1 = IGATT1(KK,1) N = IGATT1(KK,8) IF (I1.EQ.0 .AND. (N.EQ.0 .OR. N.EQ.7)) GO TO 50 CALL ERROR1(20H ILLEGAL COMMON NAME, 20) GO TO 190 50 CALL SATT1(KK, 8, 7) I1 = IGATT1(NAME,8) IF (I1.EQ.11) CALL SATT1(KK, 2, 1) PSTMT = K2 + 1 IF (PSTMT.GE.NSTMT .OR. STMT(K2).NE.67) GO TO 200 C C ELEMENTS IN COMMON: ARRAYS,VARIABLES,DECLARATIONS OF ARRAYS( NOT C VARIABLY DIMENSIONED). IMPLICITLY TYPE THEM C 60 IF (ARDECL(K2,N)) GO TO 70 CALL ERROR1(47H COMMON ELEMENT NOT VARIABLE, ARRAY, DECLARATOR, * 47) GO TO 190 70 IF (SYSERR .OR. ERR) GO TO 190 C C SET SYMBOL TABLE ENTRY OF ELEMENT TO SHOW ITS IN COMMON C PUT POINTER TO COMMON NAME INTO 3D WORD OF ENTRY (OR OFF 3D C WORD--FOR ARRAYS C I1 = IGATT1(N,2) IF (I1.NE.0) GO TO 160 CALL SATT1(N, 2, 1) I1 = IGATT1(N,7) IF (I1.EQ.0) GO TO 80 L = DSA(N+2) DSA(L+1) = KK GO TO 90 80 CALL SATT1(N, 8, 10) IF (NEXT+2.GE.BNEXT) GO TO 180 DSA(N+2) = NEXT DSA(NEXT) = 0 DSA(NEXT+1) = KK NEXT = NEXT + 2 C C SETUP CHAIN OF ELEMENTS OF COMMON HANGING OFF SYMBOL TABLE C ENTRY OF COMMON NAME C 90 IF (DSA(KK+2).EQ.0) GO TO 130 L = DSA(KK+2) 100 IF (DSA(L+1).EQ.0) GO TO 110 L = DSA(L+1) GO TO 100 110 IF (NEXT+2.GE.BNEXT) GO TO 180 DSA(L+1) = NEXT 120 DSA(NEXT) = N DSA(NEXT+1) = 0 NEXT = NEXT + 2 GO TO 140 130 IF (NEXT+2.GE.BNEXT) GO TO 180 DSA(KK+2) = NEXT GO TO 120 C C CHECK FOR END OF STMT C 140 IF (K2.EQ.NSTMT) GO TO 190 IF (STMT(K2).NE.68) GO TO 150 PSTMT = K2 + 1 GO TO 60 150 IF (STMT(K2).NE.67) GO TO 200 PSTMT = K2 GO TO 30 160 CALL ERROR1(23H ELEMENT IN TWO COMMONS, 23) GO TO 140 170 CALL ERROR1( * 51H BLANK COMMON NOT ALLOWED IN BLOCK DATA SUBPROGRAMS, 51) GO TO 190 180 SYSERR = .TRUE. CALL ERROR1(33H IN COMMON, TABLE OVERFLOW OF DSA,33) 190 RETURN 200 CALL ERROR1(15H ILLEGAL SYNTAX, 15) GO TO 190 END