SUBROUTINE MAIN LOGICAL*1 NAME(15), ARG(40) INTEGER FD, FFLAG, NFILES, I, RELNUM INTEGER OPEN, GETARG, INDEXC INTEGER PBP, PBSIZE LOGICAL*1 PBBUF(10) COMMON/CPBACK/PBP, PBSIZE, PBBUF LOGICAL*1 USESTR(31) LOGICAL*1 STDINP(2) DATA USESTR(1)/117/,USESTR(2)/115/,USESTR(3)/97/,USESTR(4)/103/,US *ESTR(5)/101/,USESTR(6)/58/,USESTR(7)/32/,USESTR(8)/32/,USESTR(9)/9 *7/,USESTR(10)/120/,USESTR(11)/114/,USESTR(12)/101/,USESTR(13)/102/ *,USESTR(14)/32/,USESTR(15)/91/,USESTR(16)/45/,USESTR(17)/102/,USES *TR(18)/114/,USESTR(19)/93/,USESTR(20)/32/,USESTR(21)/91/,USESTR(22 *)/102/,USESTR(23)/105/,USESTR(24)/108/,USESTR(25)/101/,USESTR(26)/ *93/,USESTR(27)/32/,USESTR(28)/46/,USESTR(29)/46/,USESTR(30)/46/,US *ESTR(31)/0/ DATA STDINP(1)/45/,STDINP(2)/0/ DATA FFLAG/0/, NFILES/0/, RELNUM/0/ CALL QUERY(USESTR) CALL PBINIT(10) I = 1 23000 IF (.NOT.(GETARG(I, ARG, 40) .NE. -1))GOTO 23002 IF (.NOT.(ARG(1) .EQ. 45 .AND. ARG(2) .NE. 0))GOTO 23003 CALL FOLD(ARG) IF (.NOT.(INDEXC(ARG, 102) .GT. 0))GOTO 23005 FFLAG = 1 23005 CONTINUE IF (.NOT.(INDEXC(ARG, 114) .GT. 0))GOTO 23007 RELNUM = 1 23007 CONTINUE GOTO 23004 23003 CONTINUE IF (.NOT.(ARG(1) .EQ. 45))GOTO 23009 FD = 1 GOTO 23010 23009 CONTINUE FD = OPEN(ARG, 1) 23010 CONTINUE IF (.NOT.(FD .EQ. -3))GOTO 23011 CALL CANT(ARG) 23011 CONTINUE CALL DOXREF(ARG, FD, FFLAG, RELNUM) IF (.NOT.(FD .NE. 1))GOTO 23013 CALL CLOSE(FD) 23013 CONTINUE NFILES = NFILES + 1 23004 CONTINUE 23001 I = I + 1 GOTO 23000 23002 CONTINUE IF (.NOT.(NFILES .EQ. 0))GOTO 23015 CALL DOXREF(STDINP, 1, FFLAG, RELNUM) 23015 CONTINUE RETURN END INTEGER FUNCTION BALLOC(N) INTEGER N INTEGER BUF(15000) LOGICAL*1 CBUF(30000) EQUIVALENCE (BUF(1), CBUF(1)) INTEGER NEXTBF COMMON / CXREF / NEXTBF, BUF NEXTBF = NEXTBF + N IF (.NOT.(NEXTBF .GT. 15000))GOTO 23017 CALL ERROR(15Hout of storage.) 23017 CONTINUE BALLOC=(NEXTBF - N) RETURN END SUBROUTINE DOXREF(FILE, FD, FFLAG, RELNUM) INTEGER FD, FFLAG, RELNUM INTEGER T, ROOT, LINENO, I, LSTLIN LOGICAL*1 GETTOK LOGICAL*1 TOKEN(15), FILE(40), NAME(40) INTEGER BUF(15000) LOGICAL*1 CBUF(30000) EQUIVALENCE (BUF(1), CBUF(1)) INTEGER NEXTBF COMMON / CXREF / NEXTBF, BUF LINENO = 1 I = 1 CALL STCOPY(FILE, 1, NAME, I) CALL CHCOPY(47, NAME, I) 23019 CONTINUE LSTLIN = LINENO ROOT = 0 NEXTBF = 1 23022 CONTINUE T = GETTOK(TOKEN, 15, FD) IF (.NOT.(T .EQ. -1 .OR. T .EQ. 30))GOTO 23025 GOTO 23024 23025 CONTINUE IF (.NOT.(T .EQ. 1))GOTO 23027 IF (.NOT.(FFLAG .EQ. 1))GOTO 23029 CALL FOLD(TOKEN) 23029 CONTINUE CALL INSTL(TOKEN, LINENO, ROOT) GOTO 23028 23027 CONTINUE IF (.NOT.(T .EQ. 10))GOTO 23031 LINENO = LINENO + 1 23031 CONTINUE 23028 CONTINUE 23023 GOTO 23022 23024 CONTINUE IF (.NOT.(LINENO .GT. LSTLIN))GOTO 23033 CALL PUTLIN(NAME, 2) CALL PUTCH(58, 2) CALL PUTCH(10, 2) CALL TPRINT(ROOT) 23033 CONTINUE IF (.NOT.(T .EQ. 30))GOTO 23035 CALL SCOPY(TOKEN, 1, NAME, I) IF (.NOT.(RELNUM .EQ. 1))GOTO 23037 LINENO = 1 GOTO 23038 23037 CONTINUE LINENO = LINENO + 1 23038 CONTINUE 23035 CONTINUE 23020 IF (.NOT.(T .EQ. -1))GOTO 23019 23021 CONTINUE RETURN END LOGICAL*1 FUNCTION GETTOK(TOKEN, SIZE, FD) LOGICAL*1 TOKEN(100) INTEGER SIZE, FD LOGICAL*1 NGETCH, TYPE INTEGER I LOGICAL*1 C, LSTTOK, T DATA LSTTOK /10/ C=NGETCH(C, FD) 23039 IF (.NOT.(C .NE. -1))GOTO 23041 IF (.NOT.(LSTTOK .EQ. 10 .AND. C .EQ. 35))GOTO 23042 I = 1 IF (.NOT.(NGETCH(C, FD) .EQ. 45))GOTO 23044 CALL CHCOPY(C, TOKEN, I) IF (.NOT.(NGETCH(C, FD) .EQ. 104))GOTO 23046 CALL CHCOPY(C, TOKEN, I) IF (.NOT.(NGETCH(C, FD) .EQ. 45))GOTO 23048 CALL CHCOPY(C, TOKEN, I) IF (.NOT.(NGETCH(C, FD) .EQ. 32))GOTO 23050 23052 IF (.NOT.(NGETCH(C, FD) .EQ. 32))GOTO 23053 GOTO 23052 23053 CONTINUE TOKEN(1) = C I=2 23054 IF (.NOT.(NGETCH(C, FD) .NE. 32))GOTO 23056 TOKEN(I) = C 23055 I=I+1 GOTO 23054 23056 CONTINUE TOKEN(I) = 0 23057 IF (.NOT.(NGETCH(C, FD) .NE. 10))GOTO 23058 GOTO 23057 23058 CONTINUE LSTTOK = 10 GETTOK=(30) RETURN 23050 CONTINUE 23048 CONTINUE 23046 CONTINUE 23044 CONTINUE CALL CHCOPY(C, TOKEN, I) CALL PBSTR(TOKEN) LSTTOK = 35 GOTO 23043 23042 CONTINUE IF (.NOT.(TYPE(C) .EQ. 1))GOTO 23059 TOKEN(1) = C I = 2 23061 IF (.NOT.(NGETCH(C, FD) .NE. -1))GOTO 23063 T = TYPE(C) IF (.NOT.(T .EQ. 1 .OR. T .EQ. 2 .OR. T .EQ. 95))GOTO 23064 IF (.NOT.(I .LT. SIZE))GOTO 23066 TOKEN(I) = C 23066 CONTINUE GOTO 23065 23064 CONTINUE GOTO 23063 23065 CONTINUE 23062 I = I + 1 GOTO 23061 23063 CONTINUE CALL PUTBAK(C) IF (.NOT.(I .LE. SIZE))GOTO 23068 TOKEN(I) = 0 GOTO 23069 23068 CONTINUE TOKEN(SIZE) = 0 23069 CONTINUE LSTTOK = TOKEN(1) GETTOK=(1) RETURN 23059 CONTINUE IF (.NOT.(C .EQ. 10))GOTO 23070 LSTTOK = 10 GETTOK=(10) RETURN 23070 CONTINUE 23060 CONTINUE 23043 CONTINUE 23040 C=NGETCH(C, FD) GOTO 23039 23041 CONTINUE LSTTOK = 10 GETTOK=(-1) RETURN END SUBROUTINE INSTL(NAME, LINENO, TREE) LOGICAL*1 NAME(100), TEMP(40) INTEGER LINENO, TREE INTEGER COND, P, Q INTEGER BALLOC, STRCMP, LENGTH INTEGER BUF(15000) LOGICAL*1 CBUF(30000) EQUIVALENCE (BUF(1), CBUF(1)) INTEGER NEXTBF COMMON / CXREF / NEXTBF, BUF P = TREE Q = 0 23072 IF (.NOT.(P .NE. 0))GOTO 23074 CALL SCOPY(CBUF, (2*(BUF(P+4)-1)+1), TEMP, 1) COND = STRCMP(NAME, TEMP) IF (.NOT.(COND .EQ. 0))GOTO 23075 Q = BALLOC(2) BUF(Q+0) = LINENO BUF(Q+1) = 0 BUF(BUF(P+3)+1) = Q BUF(P+3) = Q RETURN 23075 CONTINUE IF (.NOT.(COND .LT. 0))GOTO 23077 Q = P + 0 GOTO 23078 23077 CONTINUE Q = P + 1 23078 CONTINUE 23076 CONTINUE 23073 P = BUF(Q) GOTO 23072 23074 CONTINUE P = BALLOC(5) BUF(P+0) = 0 BUF(P+1) = 0 IF (.NOT.(Q .EQ. 0))GOTO 23079 TREE = P GOTO 23080 23079 CONTINUE BUF(Q) = P 23080 CONTINUE Q = BALLOC(LENGTH(NAME) / 2 + 1) CALL SCOPY(NAME, 1, CBUF, (2*(Q-1)+1)) BUF(P+4) = Q Q = BALLOC(2) BUF(Q+0) = LINENO BUF(Q+1) = 0 BUF(P+2) = Q BUF(P+3) = Q RETURN END SUBROUTINE PENTRY(NAME, LIST) LOGICAL*1 NAME(100) INTEGER LIST INTEGER I, LEN INTEGER BUF(15000) LOGICAL*1 CBUF(30000) EQUIVALENCE (BUF(1), CBUF(1)) INTEGER NEXTBF COMMON / CXREF / NEXTBF, BUF CALL PUTSTR(NAME, -15 - 1, 2) LEN = 15 + 1 I = LIST 23081 IF (.NOT.(I .NE. 0))GOTO 23083 IF (.NOT.(LEN .GT. 80 - 5))GOTO 23084 CALL PUTCH(10,2) CALL PUTSTR(0, -15 - 1, 2) LEN = 15 + 1 23084 CONTINUE CALL PUTINT(BUF(I+0), 5, 2) LEN = LEN + 5 23082 I = BUF(I+1) GOTO 23081 23083 CONTINUE IF (.NOT.(LEN .LE. 80))GOTO 23086 CALL PUTCH(10,2) 23086 CONTINUE RETURN END SUBROUTINE TPRINT(TREE) INTEGER TREE INTEGER P, Q, SP LOGICAL*1 TEMP(40) INTEGER BUF(15000) LOGICAL*1 CBUF(30000) EQUIVALENCE (BUF(1), CBUF(1)) INTEGER NEXTBF COMMON / CXREF / NEXTBF, BUF SP = 0 P = TREE 23088 CONTINUE 23091 IF (.NOT.(P .NE. 0))GOTO 23092 IF (.NOT.(BUF(P+0) .NE. 0))GOTO 23093 Q = BUF(P+0) BUF(P+0) = SP SP = P P = Q GOTO 23094 23093 CONTINUE CALL SCOPY(CBUF, (2*(BUF(P+4)-1)+1), TEMP, 1) CALL PENTRY(TEMP, BUF(P+2)) P = BUF(P+1) 23094 CONTINUE GOTO 23091 23092 CONTINUE IF (.NOT.(SP .EQ. 0))GOTO 23095 RETURN 23095 CONTINUE CALL SCOPY(CBUF, (2*(BUF(SP+4)-1)+1), TEMP, 1) CALL PENTRY(TEMP, BUF(SP+2)) P = BUF(SP+1) SP = BUF(SP+0) 23089 GOTO 23088 23090 CONTINUE RETURN END