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