      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
