      SUBROUTINE MAIN
      LOGICAL*1 ANAME(40), RBUF(512)
      INTEGER VERBOS, N, I, COMPL
      INTEGER GETARG, OPEN, GETLIN, INDEXC
      COMMON / CRAR / ARCINT, NMODS, FSTAT(256), FILPTR(256), SIZE(2, 25
     *6), SIZ(2), LPTR(256), FNAME(2560), FILE(40), BUF(512)
      INTEGER ARCINT
      INTEGER NMODS
      INTEGER FSTAT
      INTEGER SIZE
      INTEGER SIZ
      INTEGER*4 LPTR
      LOGICAL*1 FNAME
      LOGICAL*1 FILE
      LOGICAL*1 BUF
      LOGICAL*1 USESTR(27)
      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
     *14/,USESTR(10)/97/,USESTR(11)/114/,USESTR(12)/32/,USESTR(13)/91/,U
     *SESTR(14)/45/,USESTR(15)/99/,USESTR(16)/118/,USESTR(17)/93/,USESTR
     *(18)/32/,USESTR(19)/97/,USESTR(20)/114/,USESTR(21)/99/,USESTR(22)/
     *104/,USESTR(23)/105/,USESTR(24)/118/,USESTR(25)/101/,USESTR(26)/46
     */,USESTR(27)/0/
      CALL QUERY(USESTR)
      ANAME(1) = 0
      VERBOS = 0
      COMPL = 1
      I=1
23000 IF (.NOT.(GETARG(I, RBUF, 40) .NE. -1))GOTO 23002
      IF (.NOT.(RBUF(1) .EQ. 45))GOTO 23003
      CALL FOLD(RBUF)
      IF (.NOT.(INDEXC(RBUF, 118) .GT. 0))GOTO 23005
      VERBOS = 1
23005 CONTINUE
      IF (.NOT.(INDEXC(RBUF, 99) .GT. 0))GOTO 23007
      COMPL = 0
23007 CONTINUE
      GOTO 23004
23003 CONTINUE
      CALL STRCPY(RBUF, ANAME)
23004 CONTINUE
23001 I=I+1
      GOTO 23000
23002 CONTINUE
      IF (.NOT.(ANAME(1) .EQ. 0))GOTO 23009
      CALL ERROR(USESTR)
23009 CONTINUE
      ARCINT = OPEN(ANAME, 1)
      IF (.NOT.(INT .EQ. -3))GOTO 23011
      CALL CANT(ANAME)
23011 CONTINUE
      CALL RAINIT
      N=GETLIN(RBUF, 1)
23013 IF (.NOT.(N .NE. -1))GOTO 23015
      RBUF(N) = 0
      CALL FOLD(RBUF)
      CALL PUTMOD(RBUF, VERBOS)
23014 N=GETLIN(RBUF, 1)
      GOTO 23013
23015 CONTINUE
      IF (.NOT.(COMPL .EQ. 1))GOTO 23016
      N=1
23018 IF (.NOT.(N .LE. NMODS))GOTO 23020
      IF (.NOT.(FSTAT(N) .EQ. 0))GOTO 23021
      I = FILPTR(N)
      CALL SCOPY(FNAME, I, RBUF, 1)
      CALL PUTMOD(RBUF, VERBOS)
23021 CONTINUE
23019 N=N+1
      GOTO 23018
23020 CONTINUE
23016 CONTINUE
      RETURN
      END
      SUBROUTINE ARCOPY(FDI, FDO, SIZE)
      INTEGER FDI, FDO
      INTEGER SIZE(2), HI, LO
      LOGICAL*1 C
      LOGICAL*1 GETCH
      HI = SIZE(1)
      LO = SIZE(2)
      IF (.NOT.(LO .EQ. 0 .AND. HI .GT. 0))GOTO 23023
      LO = 10000
      HI = HI - 1
23023 CONTINUE
23025 IF (.NOT.(LO .GT. 0))GOTO 23026
      IF (.NOT.(GETCH(C, FDI) .EQ. -1))GOTO 23027
      GOTO 23026
23027 CONTINUE
      IF (.NOT.(FDO .NE. -3))GOTO 23029
      CALL PUTCH(C, FDO)
23029 CONTINUE
      LO = LO - 1
      IF (.NOT.(LO .EQ. 0 .AND. HI .GT. 0))GOTO 23031
      LO = 10000
      HI = HI - 1
23031 CONTINUE
      GOTO 23025
23026 CONTINUE
      RETURN
      END
      INTEGER FUNCTION GETHDR(FD, BUF, NAME, SIZE, TYPE)
      LOGICAL*1 BUF(512), C, NAME(40), TEMP(40)
      INTEGER CTOI, EQUAL, GETLIN, GETWRD, ISHDR
      INTEGER FD, I, LEN, SIZE(2), TYPE, J
      LOGICAL*1 ASC(4)
      LOGICAL*1 LOCAL(6)
      LOGICAL*1 BIN(4)
      DATA ASC(1)/97/,ASC(2)/115/,ASC(3)/99/,ASC(4)/0/
      DATA LOCAL(1)/108/,LOCAL(2)/111/,LOCAL(3)/99/,LOCAL(4)/97/,LOCAL(5
     *)/108/,LOCAL(6)/0/
      DATA BIN(1)/98/,BIN(2)/105/,BIN(3)/110/,BIN(4)/0/
      IF (.NOT.( GETLIN(BUF, FD) .EQ. -1 ))GOTO 23033
      GETHDR = -1
      RETURN
23033 CONTINUE
      CALL FOLD(BUF)
      IF (.NOT.(ISHDR(BUF, I) .EQ. 0))GOTO 23035
      CALL ERROR(31H? Archive not in proper format.)
23035 CONTINUE
      GETHDR = 1
      LEN = GETWRD(BUF, I, NAME)
      CALL CTODI(BUF, I, SIZE)
      LEN = GETWRD (BUF, I, TEMP)
      IF (.NOT.( LEN .LE. 0 .OR. EQUAL(TEMP,ASC) ))GOTO 23037
      TYPE = 12
      GOTO 23038
23037 CONTINUE
      IF (.NOT.( EQUAL(TEMP, LOCAL) ))GOTO 23039
      TYPE = 6
      GOTO 23040
23039 CONTINUE
      IF (.NOT.( EQUAL(TEMP, BIN) ))GOTO 23041
      TYPE = 60
      GOTO 23042
23041 CONTINUE
      TYPE = 12
23042 CONTINUE
23040 CONTINUE
23038 CONTINUE
      RETURN
      END
      INTEGER FUNCTION ISHDR(BUF, I)
      LOGICAL*1 BUF(100)
      INTEGER I
      LOGICAL*1 HDR(5)
      DATA HDR(1)/35/,HDR(2)/45/,HDR(3)/104/,HDR(4)/45/,HDR(5)/0/
      ISHDR = 1
      I=1
23043 IF (.NOT.(HDR(I) .NE. 0))GOTO 23045
      IF (.NOT.(BUF(I) .NE. HDR(I)))GOTO 23046
      ISHDR = 0
      GOTO 23045
23046 CONTINUE
23044 I=I+1
      GOTO 23043
23045 CONTINUE
      IF (.NOT.(ISHDR .EQ. 1))GOTO 23048
      IF (.NOT.(BUF(I) .NE. 32))GOTO 23050
      ISHDR = 0
23050 CONTINUE
23048 CONTINUE
      RETURN
      END
      SUBROUTINE PUTMOD(NAME, VERBOS)
      LOGICAL*1 NAME(40)
      INTEGER VERBOS, I, J, JUNK
      INTEGER EQUAL, GETLIN
      COMMON / CRAR / ARCINT, NMODS, FSTAT(256), FILPTR(256), SIZE(2, 25
     *6), SIZ(2), LPTR(256), FNAME(2560), FILE(40), BUF(512)
      INTEGER ARCINT
      INTEGER NMODS
      INTEGER FSTAT
      INTEGER SIZE
      INTEGER SIZ
      INTEGER*4 LPTR
      LOGICAL*1 FNAME
      LOGICAL*1 FILE
      LOGICAL*1 BUF
      I=1
23052 IF (.NOT.(I .LE. NMODS))GOTO 23054
      J = FILPTR(I)
      CALL SCOPY(FNAME, J, FILE, 1)
      IF (.NOT.(EQUAL(FILE, NAME) .EQ. 1))GOTO 23055
      IF (.NOT.(FSTAT(I) .EQ. 1))GOTO 23057
      CALL PUTLIN(NAME, 3)
      CALL ERROR(18H - already output.)
23057 CONTINUE
      CALL SEEK(LPTR(I), ARCINT)
      JUNK = GETLIN(BUF, ARCINT)
      CALL PUTLIN(BUF, 2)
      SIZ(1) = SIZE(1, I)
      SIZ(2) = SIZE(2, I)
      CALL ARCOPY(ARCINT, 2, SIZ)
      FSTAT(I) = 1
      IF (.NOT.(VERBOS .EQ. 1))GOTO 23059
      CALL REMARK(NAME)
23059 CONTINUE
      GOTO 23054
23055 CONTINUE
23053 I=I+1
      GOTO 23052
23054 CONTINUE
      RETURN
      END
      SUBROUTINE RAINIT
      INTEGER I, TYPE, JUNK
      INTEGER GETHDR, LENGTH, NOTE
      COMMON / CRAR / ARCINT, NMODS, FSTAT(256), FILPTR(256), SIZE(2, 25
     *6), SIZ(2), LPTR(256), FNAME(2560), FILE(40), BUF(512)
      INTEGER ARCINT
      INTEGER NMODS
      INTEGER FSTAT
      INTEGER SIZE
      INTEGER SIZ
      INTEGER*4 LPTR
      LOGICAL*1 FNAME
      LOGICAL*1 FILE
      LOGICAL*1 BUF
      I = 1
      NMODS = 1
23061 IF (.NOT.(NMODS .LE. 256))GOTO 23063
      JUNK = NOTE(LPTR(NMODS), ARCINT)
      IF (.NOT.(GETHDR(ARCINT, BUF, FILE, SIZ, TYPE) .EQ. -1))GOTO 23064
      GOTO 23063
23064 CONTINUE
      FSTAT(NMODS) = 0
      SIZE(1, NMODS) = SIZ(1)
      SIZE(2, NMODS) = SIZ(2)
      FILPTR(NMODS) = I
      IF (.NOT.((I + LENGTH(FILE) + 1) .GT. 2560))GOTO 23066
      CALL ERROR(30HOut of space for module names.)
23066 CONTINUE
      CALL STCOPY(FILE, 1, FNAME, I)
      I = I + 1
      CALL ARCOPY(ARCINT,-3, SIZ)
23062 NMODS = NMODS + 1
      GOTO 23061
23063 CONTINUE
      IF (.NOT.(NMODS .GT. 256))GOTO 23068
      CALL ERROR(28HToo many modules in archive.)
      GOTO 23069
23068 CONTINUE
      NMODS = NMODS - 1
23069 CONTINUE
      RETURN
      END
