SUBROUTINE MAIN LOGICAL*1 NAME(15), ARG(40) INTEGER FD, FFLAG, NFILES INTEGER OPEN, GETARG DATA FFLAG/0/, NFILES/0/ I = 1 23000 IF(.NOT.(GETARG(I, ARG, 40) .NE. -1))GOTO 23002 IF(.NOT.(ARG(1) .EQ. 45 .AND. (ARG(2) .EQ. 102 .OR. ARG(2) .EQ. 70 *)))GOTO 23003 FFLAG = 1 GOTO 23004 23003 CONTINUE IF(.NOT.((ARG(1) .EQ. 45 .AND. ARG(2) .NE. 0) .OR. (ARG(1) .EQ. 63 * .AND. ARG(2) .EQ. 0) ))GOTO 23005 CALL ERROR (26Husage: xref [-f] [files].) GOTO 23006 23005 CONTINUE IF(.NOT.(ARG(1) .EQ. 45))GOTO 23007 FD = 1 GOTO 23008 23007 CONTINUE FD = OPEN(ARG, 1) 23008 CONTINUE IF(.NOT.(FD .EQ. -3))GOTO 23009 CALL CANT(ARG) 23009 CONTINUE CALL PUTLIN(ARG, 2) CALL PUTC(58) CALL PUTC(10) CALL DOXREF(FD, FFLAG) NFILES = NFILES + 1 23006 CONTINUE 23004 CONTINUE 23001 I = I + 1 GOTO 23000 23002 CONTINUE IF(.NOT.(NFILES .EQ. 0))GOTO 23011 CALL DOXREF(1, FFLAG) 23011 CONTINUE RETURN END INTEGER FUNCTION BALLOC(N) INTEGER N COMMON /CXREF/ BUF(15000), NEXTBF INTEGER BUF INTEGER NEXTBF NEXTBF = NEXTBF + N IF(.NOT.(NEXTBF .GT. 15000))GOTO 23013 CALL ERROR(15Hout of storage.) 23013 CONTINUE BALLOC=(NEXTBF - N) RETURN END SUBROUTINE DOXREF(FD, FFLAG) INTEGER FD, FFLAG INTEGER T, ROOT INTEGER GETTOK LOGICAL*1 TOKEN(15) COMMON /CXREF/ BUF(15000), NEXTBF INTEGER BUF INTEGER NEXTBF ROOT = 0 NEXTBF = 1 LINENO = 1 23015 CONTINUE T = GETTOK(TOKEN, 15, FD) IF(.NOT.(T .EQ. -1))GOTO 23018 GOTO 23017 23018 CONTINUE IF(.NOT.(T .EQ. 1))GOTO 23020 IF(.NOT.(FFLAG .EQ. 1))GOTO 23022 CALL FOLD(TOKEN) 23022 CONTINUE CALL INSTL(TOKEN, LINENO, ROOT) GOTO 23021 23020 CONTINUE IF(.NOT.(T .EQ. 10))GOTO 23024 LINENO = LINENO + 1 23024 CONTINUE 23021 CONTINUE 23016 GOTO 23015 23017 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 23026 C = GETCH(C, FD) GOTO 23027 23026 CONTINUE C = PEEK PEEK = 0 23027 CONTINUE 23028 IF(.NOT.(C .NE. -1))GOTO 23030 GETTOK = TYPE(C) IF(.NOT.(GETTOK .EQ. 1))GOTO 23031 TOKEN(1) = C I = 2 23033 IF(.NOT.(GETCH(C, FD) .NE. -1))GOTO 23035 IF(.NOT.(TYPE(C) .EQ. 1 .OR. TYPE(C) .EQ. 2))GOTO 23036 IF(.NOT.(I .LT. SIZE))GOTO 23038 TOKEN(I) = C 23038 CONTINUE GOTO 23037 23036 CONTINUE GOTO 23035 23037 CONTINUE 23034 I = I + 1 GOTO 23033 23035 CONTINUE PEEK = C IF(.NOT.(I .LE. SIZE))GOTO 23040 TOKEN(I) = 0 GOTO 23041 23040 CONTINUE TOKEN(SIZE) = 0 23041 CONTINUE GETTOK=(1) RETURN 23031 CONTINUE IF(.NOT.(GETTOK .EQ. 10))GOTO 23042 PEEK = 0 GETTOK=(10) RETURN 23042 CONTINUE 23032 CONTINUE 23029 C = GETCH(C, FD) GOTO 23028 23030 CONTINUE PEEK = 0 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 COMMON /CXREF/ BUF(15000), NEXTBF INTEGER BUF INTEGER NEXTBF P = TREE Q = 0 23044 IF(.NOT.(P .NE. 0))GOTO 23046 CALL ICOPYS (BUF, P+4, TEMP, 1) COND = STRCMP(NAME, TEMP) IF(.NOT.(COND .EQ. 0))GOTO 23047 Q = BALLOC(2) BUF(Q+0) = LINENO BUF(Q+1) = 0 BUF(BUF(P+3)+1) = Q BUF(P+3) = Q RETURN 23047 CONTINUE IF(.NOT.(COND .LT. 0))GOTO 23049 Q = P + 0 GOTO 23050 23049 CONTINUE Q = P + 1 23050 CONTINUE 23048 CONTINUE 23045 P = BUF(Q) GOTO 23044 23046 CONTINUE P = BALLOC(5+LENGTH(NAME)+1) BUF(P+0) = 0 BUF(P+1) = 0 CALL SCOPYI(NAME, 1, BUF, P+4) IF(.NOT.(Q .EQ. 0))GOTO 23051 TREE = P GOTO 23052 23051 CONTINUE BUF(Q) = P 23052 CONTINUE 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 COMMON /CXREF/ BUF(15000), NEXTBF INTEGER BUF INTEGER NEXTBF CALL PUTSTR(NAME, -15 - 1, 2) LEN = 15 + 1 I = LIST 23053 IF(.NOT.(I .NE. 0))GOTO 23055 IF(.NOT.(LEN .GT. 80 - 5))GOTO 23056 CALL PUTC(10) CALL PUTSTR(0, -15 - 1, 2) LEN = 15 + 1 23056 CONTINUE CALL PUTINT(BUF(I+0), 5, 2) LEN = LEN + 5 23054 I = BUF(I+1) GOTO 23053 23055 CONTINUE IF(.NOT.(LEN .LE. 80))GOTO 23058 CALL PUTC(10) 23058 CONTINUE RETURN END SUBROUTINE TPRINT(TREE) INTEGER TREE INTEGER P, Q, SP LOGICAL*1 TEMP(40) COMMON /CXREF/ BUF(15000), NEXTBF INTEGER BUF INTEGER NEXTBF SP = 0 P = TREE 23060 CONTINUE 23063 IF(.NOT.(P .NE. 0))GOTO 23064 IF(.NOT.(BUF(P+0) .NE. 0))GOTO 23065 Q = BUF(P+0) BUF(P+0) = SP SP = P P = Q GOTO 23066 23065 CONTINUE CALL ICOPYS (BUF, P+4, TEMP, 1) CALL PENTRY(TEMP, BUF(P+2)) P = BUF(P+1) 23066 CONTINUE GOTO 23063 23064 CONTINUE IF(.NOT.(SP .EQ. 0))GOTO 23067 RETURN 23067 CONTINUE CALL ICOPYS (BUF, SP+4, TEMP, 1) CALL PENTRY(TEMP, BUF(SP+2)) P = BUF(SP+1) SP = BUF(SP+0) 23061 GOTO 23060 23062 CONTINUE RETURN END SUBROUTINE ICOPYS(FROM, I, TO, J) INTEGER FROM(100) LOGICAL*1 TO(100) INTEGER I, J, K1, K2 K2 = J K1 = I 23069 IF(.NOT.(FROM(K1) .NE. 0))GOTO 23071 TO(K2) = FROM(K1) K2 = K2 + 1 23070 K1 = K1 + 1 GOTO 23069 23071 CONTINUE TO(K2) = 0 RETURN END SUBROUTINE SCOPYI(FROM, I, TO, J) LOGICAL*1 FROM(100) INTEGER TO(100) INTEGER I, J, K1, K2 K2 = J K1 = I 23072 IF(.NOT.(FROM(K1) .NE. 0))GOTO 23074 TO(K2) = FROM(K1) K2 = K2 + 1 23073 K1 = K1 + 1 GOTO 23072 23074 CONTINUE TO(K2) = 0 RETURN END