SUBROUTINE ADDFIL(NAME, FD, ERRCT) LOGICAL*1 HEAD(400), NAME(100) INTEGER OPEN, FSIZE INTEGER ERRCT, FD, NFD, SIZE, TYPE COMMON / CARCH / FSTAT(25), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCOL *, FNAME(40, 25), OBUF(400) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL LOGICAL*1 FNAME LOGICAL*1 OBUF NFD = OPEN(NAME, 1) IF(.NOT.( NFD .EQ. -3 ))GOTO 23000 CALL PUTLIN(2H? , 3) CALL PUTLIN(NAME, 3) CALL REMARK(12H: can't add.) ERRCT = ERRCT + 1 RETURN 23000 CONTINUE CALL GETTYP(NFD, TYPE) CALL CLOSE(NFD) IF(.NOT.( ERRCT .EQ. 0 ))GOTO 23002 SIZE = FSIZE (NAME) CALL MAKHDR (NAME, HEAD, SIZE, TYPE) IF(.NOT.( VERBOS .EQ. 1 ))GOTO 23004 CALL PUTLIN (NAME, 2) CALL PUTCH (10, 2) 23004 CONTINUE NFD = OPEN(NAME,1) CALL PUTLIN(HEAD, FD) CALL ACOPY (NFD, FD, SIZE) CALL CLOSE(NFD) 23002 CONTINUE RETURN END SUBROUTINE MAIN LOGICAL*1 ANAME(40) INTEGER GETARG, OVRIDE LOGICAL*1 COMAND(3) COMMON / CARCH / FSTAT(25), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCOL *, FNAME(40, 25), OBUF(400) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL LOGICAL*1 FNAME LOGICAL*1 OBUF COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(20) INTEGER NEW LOGICAL*1 HDR LOGICAL*1 ASC LOGICAL*1 LOCAL LOGICAL*1 BIN LOGICAL*1 USER DATA ERRCNT /0/ DATA VERBOS /0/ DATA HDR /35, 45, 104, 45, 0/ DATA ASC /97, 115, 99, 0/ DATA LOCAL /108, 111, 99, 97, 108, 0/ DATA BIN /98, 105, 110, 0/ IF(.NOT.( GETARG(1, COMAND, 3) .EQ. -1 .OR. GETARG(2, ANAME, 40) . *EQ. -1 .OR. COMAND(1) .EQ. 63 .AND. COMAND(2) .EQ. 0))GOTO 23006 CALL HELP 23006 CONTINUE CALL FOLD(COMAND) PACKIT = 1 IF(.NOT.( COMAND(2) .EQ. 118 ))GOTO 23008 VERBOS = 1 GOTO 23009 23008 CONTINUE IF(.NOT.(COMAND(2) .EQ. 49))GOTO 23010 PACKIT = 0 23010 CONTINUE 23009 CONTINUE CALL INITAR CALL GETFNS IF(.NOT.( COMAND(1) .EQ. 117 ))GOTO 23012 CALL UPDATE(ANAME) GOTO 23013 23012 CONTINUE IF(.NOT.( COMAND(1) .EQ. 116 ))GOTO 23014 CALL TABLE(ANAME) GOTO 23015 23014 CONTINUE IF(.NOT.( COMAND(1) .EQ. 120 .OR. COMAND(1) .EQ. 112 ))GOTO 23016 CALL EXTRAC(ANAME, COMAND(1)) GOTO 23017 23016 CONTINUE IF(.NOT.( COMAND(1) .EQ. 100 ))GOTO 23018 CALL DELET(ANAME) GOTO 23019 23018 CONTINUE IF(.NOT.( COMAND(1) .EQ. 115 ))GOTO 23020 CALL RECOVR(ANAME) GOTO 23021 23020 CONTINUE CALL HELP 23021 CONTINUE 23019 CONTINUE 23017 CONTINUE 23015 CONTINUE 23013 CONTINUE RETURN END SUBROUTINE DELET (ANAME) LOGICAL*1 ANAME(40), IN(400), TFILE(40) INTEGER CREATE, OPEN INTEGER AFD, TFD COMMON / CARCH / FSTAT(25), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCOL *, FNAME(40, 25), OBUF(400) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL LOGICAL*1 FNAME LOGICAL*1 OBUF LOGICAL*1 TNAME(8) DATA TNAME(1)/97/,TNAME(2)/114/,TNAME(3)/99/,TNAME(4)/116/,TNAME(5 *)/101/,TNAME(6)/109/,TNAME(7)/112/,TNAME(8)/0/ IF(.NOT.( FCOUNT .LE. 0 ))GOTO 23022 CALL ERROR(22H? Delete by name only.) 23022 CONTINUE AFD = OPEN(ANAME, 1) IF(.NOT.( AFD .EQ. -3 ))GOTO 23024 CALL CANT(ANAME) 23024 CONTINUE CALL SCRATF(TNAME, TFILE) TFD = CREATE(TFILE, 2) IF(.NOT.( TFD .EQ. -3 ))GOTO 23026 CALL CANT(TFILE) 23026 CONTINUE CALL REPLAC(AFD, TFD, 100, ERRCNT) CALL NOTFND CALL CLOSE(AFD) CALL CLOSE(TFD) IF(.NOT.( ERRCNT .EQ. 0 ))GOTO 23028 CALL AMOVE(TFILE, ANAME) GOTO 23029 23028 CONTINUE CALL REMARK(37H? Fatal errors - archive not altered.) 23029 CONTINUE CALL REMOVE(TFILE) RETURN END SUBROUTINE EXTRAC(ANAME, CMD) LOGICAL*1 ANAME(40), ENAME(40), IN(400), CMD INTEGER CREATE, FILARG, GETHDR, OPEN, EQUAL INTEGER AFD, EFD, SIZE, TYPE COMMON / CARCH / FSTAT(25), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCOL *, FNAME(40, 25), OBUF(400) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL LOGICAL*1 FNAME LOGICAL*1 OBUF COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(20) INTEGER NEW LOGICAL*1 HDR LOGICAL*1 ASC LOGICAL*1 LOCAL LOGICAL*1 BIN LOGICAL*1 USER AFD = OPEN(ANAME, 1) IF(.NOT.( AFD .EQ. -3 ))GOTO 23030 CALL CANT(ANAME) 23030 CONTINUE IF(.NOT.( CMD .EQ. 112 ))GOTO 23032 EFD = 2 GOTO 23033 23032 CONTINUE EFD = -3 23033 CONTINUE 23034 IF(.NOT.( GETHDR(AFD, IN, ENAME, SIZE, TYPE) .NE. -1 ))GOTO 23035 IF(.NOT.( FILARG(ENAME) .EQ. 0 ))GOTO 23036 CALL ARSKIP(AFD, SIZE) GOTO 23037 23036 CONTINUE IF(.NOT.( EFD .NE. 2 ))GOTO 23038 EFD = CREATE(ENAME, 2) 23038 CONTINUE IF(.NOT.(EFD .EQ. -3))GOTO 23040 CALL PUTLIN(2H? , 3) CALL PUTLIN(ENAME, 3) CALL REMARK(15H: can't create.) ERRCNT = ERRCNT + 1 CALL ARSKIP(AFD, SIZE) GOTO 23041 23040 CONTINUE IF(.NOT.( VERBOS .EQ. 1 ))GOTO 23042 CALL PUTLIN(ENAME, 2) CALL PUTCH(10, 2) 23042 CONTINUE CALL ACOPY(AFD, EFD, SIZE) IF(.NOT.( EFD .NE. 2 ))GOTO 23044 CALL CLOSE(EFD) 23044 CONTINUE 23041 CONTINUE 23037 CONTINUE GOTO 23034 23035 CONTINUE CALL NOTFND RETURN END INTEGER FUNCTION FILARG(NAME) LOGICAL*1 NAME(100) INTEGER EQUAL INTEGER I COMMON / CARCH / FSTAT(25), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCOL *, FNAME(40, 25), OBUF(400) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL LOGICAL*1 FNAME LOGICAL*1 OBUF IF(.NOT.( FCOUNT .LE. 0 ))GOTO 23046 FILARG = 1 RETURN 23046 CONTINUE I = 1 23048 IF(.NOT.(I .LE. FCOUNT ))GOTO 23050 IF(.NOT.( EQUAL(NAME, FNAME(1, I) ) .EQ. 1))GOTO 23051 FSTAT(I) = 1 FILARG = 1 RETURN 23051 CONTINUE 23049 I = I + 1 GOTO 23048 23050 CONTINUE FILARG = 0 RETURN END INTEGER FUNCTION GETHDR(FD, BUF, NAME, SIZE, TYPE) LOGICAL*1 BUF(400), C, NAME(40), TEMP(40) INTEGER CTOI, EQUAL, GETLIN, GETWRD INTEGER FD, I, LEN, SIZE, TYPE COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(20) INTEGER NEW LOGICAL*1 HDR LOGICAL*1 ASC LOGICAL*1 LOCAL LOGICAL*1 BIN LOGICAL*1 USER IF(.NOT.( NEW ))GOTO 23053 GETHDR = -1 RETURN 23053 CONTINUE IF(.NOT.( GETLIN(BUF, FD) .EQ. -1 ))GOTO 23055 GETHDR = -1 RETURN 23055 CONTINUE CALL FOLD(BUF) I = 1 LEN = GETWRD(BUF, I, TEMP) IF(.NOT.( EQUAL(TEMP, HDR) .EQ. 0 ))GOTO 23057 CALL ERROR(31H? Archive not in proper format.) 23057 CONTINUE GETHDR = 1 LEN = GETWRD(BUF, I, NAME) SIZE = CTOI(BUF, I) LEN = GETWRD (BUF, I+1, TEMP) IF(.NOT.( LEN .LE. 0 .OR. EQUAL(TEMP,ASC) ))GOTO 23059 TYPE = 12 GOTO 23060 23059 CONTINUE IF(.NOT.( EQUAL(TEMP, LOCAL) ))GOTO 23061 TYPE = 6 GOTO 23062 23061 CONTINUE IF(.NOT.( EQUAL(TEMP, BIN) ))GOTO 23063 TYPE = 60 GOTO 23064 23063 CONTINUE TYPE = 12 23064 CONTINUE 23062 CONTINUE 23060 CONTINUE RETURN END SUBROUTINE HELP CALL ERROR(42H? Usage: ar {dpstux}[v/1] arcname [files].) RETURN END SUBROUTINE MAKHDR(NAME, HEAD, SIZE, TYPE) LOGICAL*1 HEAD(400), NAME(40), FILSIZ(20), TEMP(40) INTEGER ITOC, LENGTH, J, N INTEGER SIZE, I, TYPE COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(20) INTEGER NEW LOGICAL*1 HDR LOGICAL*1 ASC LOGICAL*1 LOCAL LOGICAL*1 BIN LOGICAL*1 USER COMMON / CARCH / FSTAT(25), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCOL *, FNAME(40, 25), OBUF(400) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL LOGICAL*1 FNAME LOGICAL*1 OBUF LOGICAL*1 TWOBLK(3) DATA TWOBLK(1)/32/,TWOBLK(2)/32/,TWOBLK(3)/0/ I = 1 CALL STCOPY(HDR, 1, HEAD, I) HEAD(I) = 32 I = I + 1 CALL STCOPY(NAME, 1, HEAD, I) IF(.NOT.( SIZE .EQ. -3 ))GOTO 23065 JUNK = 0 FILSIZ(1) = 0 ERRCNT = ERRCNT + 1 GOTO 23066 23065 CONTINUE JUNK = ITOC(SIZE, FILSIZ, 20) 23066 CONTINUE N = 20 - JUNK - LENGTH(NAME) J = 1 23067 CONTINUE HEAD(I) = 32 I = I + 1 J = J + 1 23068 IF(.NOT.(J .GT. N))GOTO 23067 23069 CONTINUE CALL STCOPY(FILSIZ, 1, HEAD, I) CALL STCOPY(TWOBLK, 1, HEAD, I) IF(.NOT.( TYPE .EQ. 12 ))GOTO 23070 CALL STCOPY(ASC, 1, HEAD, I) GOTO 23071 23070 CONTINUE IF(.NOT.( TYPE .EQ. 6 ))GOTO 23072 CALL STCOPY(LOCAL, 1, HEAD, I) GOTO 23073 23072 CONTINUE IF(.NOT.( TYPE .EQ. 60 ))GOTO 23074 CALL STCOPY(BIN, 1, HEAD, I) 23074 CONTINUE 23073 CONTINUE 23071 CONTINUE CALL STCOPY(TWOBLK, 1, HEAD, I) CALL GDATE (FILSIZ) CALL STCOPY(FILSIZ, 1, HEAD, I) HEAD(I) = 32 I = I + 1 CALL GTIME(FILSIZ) CALL STCOPY(FILSIZ, 1, HEAD, I) CALL STCOPY(TWOBLK, 1, HEAD, I) CALL STCOPY(USER, 1, HEAD, I) HEAD(I) = 10 HEAD(I+1) = 0 CALL FOLD(HEAD) RETURN END SUBROUTINE NOTFND INTEGER I COMMON / CARCH / FSTAT(25), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCOL *, FNAME(40, 25), OBUF(400) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL LOGICAL*1 FNAME LOGICAL*1 OBUF I = 1 23076 IF(.NOT.(I .LE. FCOUNT ))GOTO 23078 IF(.NOT.(FSTAT(I) .EQ. 0 ))GOTO 23079 CALL PUTLIN(2H? , 3) CALL PUTLIN(FNAME(1, I), 3) CALL REMARK(17H: not in archive.) ERRCNT = ERRCNT + 1 23079 CONTINUE 23077 I = I + 1 GOTO 23076 23078 CONTINUE RETURN END INTEGER FUNCTION NXTFL(NAME, AFD) LOGICAL*1 NAME(100), HOLDNM(40), BUF(400), TEMP(400) INTEGER CREATE, GETLIN, EQUAL INTEGER AFD, I COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(20) INTEGER NEW LOGICAL*1 HDR LOGICAL*1 ASC LOGICAL*1 LOCAL LOGICAL*1 BIN LOGICAL*1 USER DATA HOLDNM(1) /0/ I = AFD IF(.NOT.( HOLDNM(1) .EQ. 0 ))GOTO 23081 IF(.NOT.( GETLIN(BUF, AFD) .EQ. -1 ))GOTO 23083 NXTFL = -1 RETURN 23083 CONTINUE I = 1 LEN = GETWRD(BUF, I, TEMP) IF(.NOT.( EQUAL(TEMP, HDR) .EQ. 0 ))GOTO 23085 CALL ERROR (31H? Archive not in proper format.) 23085 CONTINUE LEN = GETWRD(BUF, I+LEN, HOLDNM) 23081 CONTINUE CALL SCOPY(HOLDNM, 1, NAME, 1) HOLDNM(1) = 0 INT = CREATE(NAME, 2) IF(.NOT.( INT .EQ. -3 ))GOTO 23087 CALL CANT(NAME) 23087 CONTINUE 23089 IF(.NOT.( GETLIN(BUF, AFD) .NE. -1 ))GOTO 23090 I = 1 LEN = GETWRD(BUF, I, TEMP) IF(.NOT.( EQUAL(TEMP, HDR) ))GOTO 23091 LEN = GETWRD(BUF, I+LEN, HOLDNM) GOTO 23090 23091 CONTINUE CALL PUTLIN(BUF, INT) GOTO 23089 23090 CONTINUE CALL CLOSE(INT) NXTFL = 0 RETURN END SUBROUTINE RECOVR (ANAME) INTEGER CREATE, OPEN, NXTFL INTEGER AFD, TFD LOGICAL*1 ANAME(100), TFILE(40), NAME(40) COMMON / CARCH / FSTAT(25), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCOL *, FNAME(40, 25), OBUF(400) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL LOGICAL*1 FNAME LOGICAL*1 OBUF LOGICAL*1 TNAME(8) DATA TNAME(1)/97/,TNAME(2)/114/,TNAME(3)/99/,TNAME(4)/116/,TNAME(5 *)/101/,TNAME(6)/109/,TNAME(7)/112/,TNAME(8)/0/ AFD = OPEN(ANAME, 1) IF(.NOT.( AFD .EQ. -3 ))GOTO 23093 CALL CANT(ANAME) 23093 CONTINUE CALL SCRATF (TNAME, TFILE) TFD = CREATE(TFILE, 2) IF(.NOT.( TFD .EQ. -3 ))GOTO 23095 CALL CANT(TFILE) 23095 CONTINUE 23097 IF(.NOT.( NXTFL(NAME, AFD) .NE. -1 ))GOTO 23098 CALL ADDFIL(NAME, TFD, ERRCNT) CALL REMOVE(NAME) GOTO 23097 23098 CONTINUE CALL CLOSE(AFD) CALL CLOSE(TFD) IF(.NOT.( ERRCNT .EQ. 0 ))GOTO 23099 CALL AMOVE(TFILE, ANAME) GOTO 23100 23099 CONTINUE CALL REMARK(37H? Fatal errors - archive not altered.) 23100 CONTINUE CALL REMOVE (TFILE) RETURN END SUBROUTINE REPLAC(AFD, TFD, CMD, ERRCT) LOGICAL*1 IN(400), UNAME(40) INTEGER FILARG, GETHDR INTEGER AFD, CMD, ERRCT, SIZE, TFD, TYPE COMMON / CARCH / FSTAT(25), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCOL *, FNAME(40, 25), OBUF(400) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL LOGICAL*1 FNAME LOGICAL*1 OBUF 23101 IF(.NOT.( GETHDR(AFD, IN, UNAME, SIZE, TYPE) .NE. -1 ))GOTO 23102 IF(.NOT.( FILARG(UNAME) .EQ. 1 ))GOTO 23103 IF(.NOT.( CMD .EQ. 117 ))GOTO 23105 CALL ADDFIL(UNAME, TFD, ERRCT) 23105 CONTINUE IF(.NOT.( VERBOS .EQ. 1 .AND. CMD .EQ. 100))GOTO 23107 CALL PUTLIN (UNAME, 2) CALL PUTCH (10, 2) 23107 CONTINUE CALL ARSKIP(AFD, SIZE) GOTO 23104 23103 CONTINUE CALL PUTLIN(IN, TFD) CALL ACOPY(AFD, TFD, SIZE) 23104 CONTINUE GOTO 23101 23102 CONTINUE RETURN END SUBROUTINE TABLE(ANAME) LOGICAL*1 ANAME(40), IN(400), LNAME(40) INTEGER FILARG, GETHDR, OPEN INTEGER AFD, SIZE, TYPE COMMON / CARCH / FSTAT(25), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCOL *, FNAME(40, 25), OBUF(400) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL LOGICAL*1 FNAME LOGICAL*1 OBUF AFD = OPEN(ANAME, 1) IF(.NOT.( AFD .EQ. -3 ))GOTO 23109 CALL CANT(ANAME) 23109 CONTINUE IF(.NOT.(PACKIT .EQ. 1))GOTO 23111 CALL INPACK(NXTCOL, 80, OBUF, 2) 23111 CONTINUE 23113 IF(.NOT.( GETHDR(AFD, IN, LNAME, SIZE, TYPE) .NE. -1 ))GOTO 23114 IF(.NOT.( FILARG(LNAME) .EQ. 1 ))GOTO 23115 CALL TPRINT(IN) 23115 CONTINUE CALL ARSKIP( AFD, SIZE) GOTO 23113 23114 CONTINUE IF(.NOT.(PACKIT .EQ. 1))GOTO 23117 CALL FLPACK(NXTCOL, 80, OBUF, 2) 23117 CONTINUE CALL NOTFND RETURN END SUBROUTINE TPRINT(BUF) INTEGER I, J LOGICAL*1 BUF(100), NAME(40) COMMON / CARCH / FSTAT(25), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCOL *, FNAME(40, 25), OBUF(400) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL LOGICAL*1 FNAME LOGICAL*1 OBUF I=1 23119 IF(.NOT.(BUF(I) .NE. 32 ))GOTO 23121 23120 I=I+1 GOTO 23119 23121 CONTINUE J = 1 I=I+1 23122 IF(.NOT.(BUF(I) .NE. 32 ))GOTO 23124 CALL CHCOPY(BUF(I), NAME, J) 23123 I=I+1 GOTO 23122 23124 CONTINUE NAME(J) = 0 IF(.NOT.(PACKIT .EQ. 1))GOTO 23125 CALL DOPACK(NAME, NXTCOL, 80, OBUF, 2) GOTO 23126 23125 CONTINUE CALL PUTLIN(NAME, 2) IF(.NOT.(VERBOS .EQ. 1))GOTO 23127 CALL PUTLIN(BUF(I), 2) GOTO 23128 23127 CONTINUE CALL PUTCH(10, 2) 23128 CONTINUE 23126 CONTINUE RETURN END SUBROUTINE UPDATE(ANAME) LOGICAL*1 ANAME(40), TFILE(40) INTEGER CREATE, GETARG, OPEN INTEGER AFD, I, TFD COMMON / CARCH / FSTAT(25), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCOL *, FNAME(40, 25), OBUF(400) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL LOGICAL*1 FNAME LOGICAL*1 OBUF COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(20) INTEGER NEW LOGICAL*1 HDR LOGICAL*1 ASC LOGICAL*1 LOCAL LOGICAL*1 BIN LOGICAL*1 USER LOGICAL*1 TNAME(8) DATA TNAME(1)/97/,TNAME(2)/114/,TNAME(3)/99/,TNAME(4)/116/,TNAME(5 *)/101/,TNAME(6)/109/,TNAME(7)/112/,TNAME(8)/0/ AFD = OPEN(ANAME, 1) IF(.NOT.( AFD .EQ. -3 ))GOTO 23129 AFD = CREATE(ANAME, 2) IF(.NOT.( AFD .EQ. -3 ))GOTO 23131 CALL CANT(ANAME) 23131 CONTINUE NEW = 1 GOTO 23130 23129 CONTINUE NEW = 0 23130 CONTINUE CALL CLOSE(1) CALL SCRATF(TNAME, TFILE) TFD = CREATE(TFILE, 2) IF(.NOT.( TFD .EQ. -3 ))GOTO 23133 CALL CANT(TFILE) 23133 CONTINUE CALL REPLAC(AFD, TFD, 117, ERRCNT) I = 1 23135 IF(.NOT.(I .LE. FCOUNT ))GOTO 23137 IF(.NOT.( FSTAT(I) .EQ. 0 ))GOTO 23138 CALL ADDFIL(FNAME(1, I), TFD, ERRCNT) FSTAT(I) = 1 23138 CONTINUE 23136 I = I + 1 GOTO 23135 23137 CONTINUE CALL CLOSE(AFD) CALL CLOSE(TFD) IF(.NOT.( ERRCNT .EQ. 0 ))GOTO 23140 CALL AMOVE(TFILE, ANAME) GOTO 23141 23140 CONTINUE CALL REMARK(37H? Fatal errors - archive not altered.) 23141 CONTINUE CALL REMOVE(TFILE) RETURN END SUBROUTINE ARSKIP(FD, N) LOGICAL*1 BUF(400) INTEGER FD, I, N, M INTEGER GETLIN I=1 23142 IF(.NOT.(I .LE. N))GOTO 23144 M = GETLIN(BUF, FD) IF(.NOT.(M .EQ. -1))GOTO 23145 GOTO 23144 23145 CONTINUE I = I + M 23143 GOTO 23142 23144 CONTINUE RETURN END SUBROUTINE INITAR INTEGER TTY COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(20) INTEGER NEW LOGICAL*1 HDR LOGICAL*1 ASC LOGICAL*1 LOCAL LOGICAL*1 BIN LOGICAL*1 USER COMMON / CARCH / FSTAT(25), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCOL *, FNAME(40, 25), OBUF(400) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL LOGICAL*1 FNAME LOGICAL*1 OBUF CALL MAILID(USER, FNAME(1,1)) IF(.NOT.(PACKIT .EQ. 1))GOTO 23147 PACKIT = TTY(2) 23147 CONTINUE IF(.NOT.(VERBOS .EQ. 1))GOTO 23149 PACKIT = 0 23149 CONTINUE RETURN END SUBROUTINE GETFNS LOGICAL*1 JUNK(2) INTEGER EQUAL, GETARG, GETLIN INTEGER I, J, USEIN COMMON / CARCH / FSTAT(25), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTCOL *, FNAME(40, 25), OBUF(400) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL LOGICAL*1 FNAME LOGICAL*1 OBUF DATA USEIN /0/ ERRCNT = 0 I = 1 23151 IF(.NOT.(I .LE. 25 ))GOTO 23153 IF(.NOT.( USEIN .EQ. 0 ))GOTO 23154 IF(.NOT.( GETARG(I+2, FNAME(1,I), 40) .EQ. -1 ))GOTO 23156 GOTO 23153 23156 CONTINUE IF(.NOT.( FNAME(1,I) .EQ. 45 .AND. FNAME(2,I) .EQ. 0 ))GOTO 23158 USEIN = 1 23158 CONTINUE 23154 CONTINUE IF(.NOT.( USEIN .EQ. 1 ))GOTO 23160 LEN = GETLIN(FNAME(1,I), 1) IF(.NOT.( LEN .EQ. -1 ))GOTO 23162 GOTO 23153 23162 CONTINUE FNAME(LEN,I) = 0 23160 CONTINUE CALL FOLD(FNAME(1,I)) 23152 I = I + 1 GOTO 23151 23153 CONTINUE FCOUNT = I - 1 IF(.NOT.( I .GT. 25 ))GOTO 23164 IF(.NOT.( GETARG(I+2, JUNK, 1) .NE. -1 ))GOTO 23166 CALL ERROR(20Htoo many file names.) 23166 CONTINUE 23164 CONTINUE I = 1 23168 IF(.NOT.(I .LE. FCOUNT ))GOTO 23170 FSTAT(I) = 0 23169 I = I + 1 GOTO 23168 23170 CONTINUE I = 1 23171 IF(.NOT.(I .LT. FCOUNT ))GOTO 23173 J = I + 1 23174 IF(.NOT.(J .LE. FCOUNT ))GOTO 23176 IF(.NOT.( EQUAL( FNAME(1, I), FNAME(1, J)) .EQ. 1 ))GOTO 23177 CALL PUTLIN(2H? , 3) CALL PUTLIN(FNAME(1, I), 3) CALL ERROR(22H: duplicate file name.) 23177 CONTINUE 23175 J = J + 1 GOTO 23174 23176 CONTINUE 23172 I = I + 1 GOTO 23171 23173 CONTINUE RETURN END