SUBROUTINE MAIN LOGICAL*1 NAME(15), ARG(36) INTEGER FD, FFLAG, NFILES, BIAS, I, J INTEGER OPEN, GETARG, CTOI LOGICAL*1 USESTR(40) 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)/1 *20/,USESTR(10)/114/,USESTR(11)/101/,USESTR(12)/102/,USESTR(13)/32/ *,USESTR(14)/91/,USESTR(15)/45/,USESTR(16)/98/,USESTR(17)/60/,USEST *R(18)/98/,USESTR(19)/105/,USESTR(20)/97/,USESTR(21)/115/,USESTR(22 *)/62/,USESTR(23)/93/,USESTR(24)/32/,USESTR(25)/91/,USESTR(26)/45/, *USESTR(27)/102/,USESTR(28)/93/,USESTR(29)/32/,USESTR(30)/91/,USEST *R(31)/102/,USESTR(32)/105/,USESTR(33)/108/,USESTR(34)/101/,USESTR( *35)/93/,USESTR(36)/32/,USESTR(37)/46/,USESTR(38)/46/,USESTR(39)/46 */,USESTR(40)/0/ DATA FFLAG/0/, NFILES/0/, BIAS/0/ CALL QUERY(USESTR) I = 1 23000 IF (.NOT.(GETARG(I, ARG, 36) .NE. -1))GOTO 23002 IF (.NOT.(ARG(1) .EQ. 45 .AND. (ARG(2) .EQ. 102 .OR. ARG(2) .EQ. 7 *0)))GOTO 23003 FFLAG = 1 GOTO 23004 23003 CONTINUE IF (.NOT.(ARG(1) .EQ. 45 .AND. (ARG(2) .EQ. 98 .OR. ARG(2) .EQ. 66 *)))GOTO 23005 J = 3 BIAS = CTOI(ARG, J) IF (.NOT.(BIAS .LT. 0))GOTO 23007 BIAS = 0 23007 CONTINUE GOTO 23006 23005 CONTINUE IF (.NOT.((ARG(1) .EQ. 45 .AND. ARG(2) .NE. 0) ))GOTO 23009 CALL ERROR (USESTR) GOTO 23010 23009 CONTINUE IF (.NOT.(ARG(1) .EQ. 45))GOTO 23011 FD = 1 GOTO 23012 23011 CONTINUE FD = OPEN(ARG, 1) 23012 CONTINUE IF (.NOT.(FD .EQ. -3))GOTO 23013 CALL CANT(ARG) 23013 CONTINUE CALL PUTLIN(ARG, 2) CALL PUTCH(58,2) CALL PUTCH(10,2) CALL DOXREF(FD, FFLAG, BIAS) NFILES = NFILES + 1 23010 CONTINUE 23006 CONTINUE 23004 CONTINUE 23001 I = I + 1 GOTO 23000 23002 CONTINUE IF (.NOT.(NFILES .EQ. 0))GOTO 23015 CALL DOXREF(1, FFLAG, BIAS) 23015 CONTINUE RETURN END INTEGER FUNCTION BALLOC(N) INTEGER N INTEGER BUF(15000) LOGICAL*1 CBUF(30000) INTEGER NEXTBF LOGICAL*1 ST001Z(15) COMMON / CXREF / NEXTBF, BUF EQUIVALENCE (BUF(1), CBUF(1)) DATA ST001Z(1)/111/,ST001Z(2)/117/,ST001Z(3)/116/,ST001Z(4)/32/,ST *001Z(5)/111/,ST001Z(6)/102/,ST001Z(7)/32/,ST001Z(8)/115/,ST001Z(9) */116/,ST001Z(10)/111/,ST001Z(11)/114/,ST001Z(12)/97/,ST001Z(13)/10 *3/,ST001Z(14)/101/,ST001Z(15)/0/ NEXTBF = NEXTBF + N IF (.NOT.(NEXTBF .GT. 15000))GOTO 23017 CALL ERROR(ST001Z) 23017 CONTINUE BALLOC=(NEXTBF - N) RETURN END SUBROUTINE DOXREF(FD, FFLAG, BIAS) INTEGER FD, FFLAG, BIAS INTEGER T, ROOT LOGICAL*1 GETTOK LOGICAL*1 TOKEN(15) INTEGER BUF(15000) LOGICAL*1 CBUF(30000) INTEGER NEXTBF COMMON / CXREF / NEXTBF, BUF EQUIVALENCE (BUF(1), CBUF(1)) ROOT = 0 NEXTBF = 1 LINENO = BIAS + 1 23019 CONTINUE T = GETTOK(TOKEN, 15, FD) IF (.NOT.(T .EQ. -1))GOTO 23022 GOTO 23021 23022 CONTINUE IF (.NOT.(T .EQ. 1))GOTO 23024 IF (.NOT.(FFLAG .EQ. 1))GOTO 23026 CALL FOLD(TOKEN) 23026 CONTINUE CALL INSTL(TOKEN, LINENO, ROOT) GOTO 23025 23024 CONTINUE IF (.NOT.(T .EQ. 10))GOTO 23028 LINENO = LINENO + 1 23028 CONTINUE 23025 CONTINUE 23020 GOTO 23019 23021 CONTINUE CALL TPRINT(ROOT) RETURN END LOGICAL*1 FUNCTION GETTOK(TOKEN, SIZE, FD) LOGICAL*1 TOKEN(100) INTEGER SIZE, FD LOGICAL*1 GETCH, TYPE INTEGER I LOGICAL*1 C, PEEK DATA PEEK /0/ IF (.NOT.(PEEK .EQ. 0))GOTO 23030 C = GETCH(C, FD) GOTO 23031 23030 CONTINUE C = PEEK PEEK = 0 23031 CONTINUE 23032 IF (.NOT.(C .NE. -1))GOTO 23034 GETTOK = TYPE(C) IF (.NOT.(GETTOK .EQ. 1))GOTO 23035 TOKEN(1) = C I = 2 23037 IF (.NOT.(GETCH(C, FD) .NE. -1))GOTO 23039 IF (.NOT.(TYPE(C) .EQ. 1 .OR. TYPE(C) .EQ. 2 .OR. C .EQ. 95))GOTO *23040 IF (.NOT.(I .LT. SIZE))GOTO 23042 TOKEN(I) = C 23042 CONTINUE GOTO 23041 23040 CONTINUE GOTO 23039 23041 CONTINUE 23038 I = I + 1 GOTO 23037 23039 CONTINUE PEEK = C IF (.NOT.(I .LE. SIZE))GOTO 23044 TOKEN(I) = 0 GOTO 23045 23044 CONTINUE TOKEN(SIZE) = 0 23045 CONTINUE GETTOK=(1) RETURN 23035 CONTINUE IF (.NOT.(GETTOK .EQ. 10))GOTO 23046 PEEK = 0 GETTOK=(10) RETURN 23046 CONTINUE 23036 CONTINUE 23033 C = GETCH(C, FD) GOTO 23032 23034 CONTINUE PEEK = 0 GETTOK=(-1) RETURN END SUBROUTINE INSTL(NAME, LINENO, TREE) LOGICAL*1 NAME(100), TEMP(36) INTEGER LINENO, TREE INTEGER COND, P, Q INTEGER BALLOC, STRCMP, LENGTH INTEGER BUF(15000) LOGICAL*1 CBUF(30000) INTEGER NEXTBF COMMON / CXREF / NEXTBF, BUF EQUIVALENCE (BUF(1), CBUF(1)) P = TREE Q = 0 23048 IF (.NOT.(P .NE. 0))GOTO 23050 CALL SCOPY(CBUF, (2*(BUF(P+4)-1)+1), TEMP, 1) COND = STRCMP(NAME, TEMP) IF (.NOT.(COND .EQ. 0))GOTO 23051 Q = BALLOC(2) BUF(Q+0) = LINENO BUF(Q+1) = 0 BUF(BUF(P+3)+1) = Q BUF(P+3) = Q RETURN 23051 CONTINUE IF (.NOT.(COND .LT. 0))GOTO 23053 Q = P + 0 GOTO 23054 23053 CONTINUE Q = P + 1 23054 CONTINUE 23052 CONTINUE 23049 P = BUF(Q) GOTO 23048 23050 CONTINUE P = BALLOC(5) BUF(P+0) = 0 BUF(P+1) = 0 IF (.NOT.(Q .EQ. 0))GOTO 23055 TREE = P GOTO 23056 23055 CONTINUE BUF(Q) = P 23056 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) INTEGER NEXTBF COMMON / CXREF / NEXTBF, BUF EQUIVALENCE (BUF(1), CBUF(1)) CALL PUTSTR(NAME, -15 - 1, 2) LEN = 15 + 1 I = LIST 23057 IF (.NOT.(I .NE. 0))GOTO 23059 IF (.NOT.(LEN .GT. 80 - 5))GOTO 23060 CALL PUTCH(10,2) CALL PUTSTR(0, -15 - 1, 2) LEN = 15 + 1 23060 CONTINUE CALL PUTINT(BUF(I+0), 5, 2) LEN = LEN + 5 23058 I = BUF(I+1) GOTO 23057 23059 CONTINUE IF (.NOT.(LEN .LE. 80))GOTO 23062 CALL PUTCH(10,2) 23062 CONTINUE RETURN END SUBROUTINE TPRINT(TREE) INTEGER TREE INTEGER P, Q, SP LOGICAL*1 TEMP(36) INTEGER BUF(15000) LOGICAL*1 CBUF(30000) INTEGER NEXTBF COMMON / CXREF / NEXTBF, BUF EQUIVALENCE (BUF(1), CBUF(1)) SP = 0 P = TREE 23064 CONTINUE 23067 IF (.NOT.(P .NE. 0))GOTO 23068 IF (.NOT.(BUF(P+0) .NE. 0))GOTO 23069 Q = BUF(P+0) BUF(P+0) = SP SP = P P = Q GOTO 23070 23069 CONTINUE CALL SCOPY(CBUF, (2*(BUF(P+4)-1)+1), TEMP, 1) CALL PENTRY(TEMP, BUF(P+2)) P = BUF(P+1) 23070 CONTINUE GOTO 23067 23068 CONTINUE IF (.NOT.(SP .EQ. 0))GOTO 23071 RETURN 23071 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) 23065 GOTO 23064 23066 CONTINUE RETURN END