SUBROUTINE MAIN LOGICAL*1 ANAME(36) INTEGER GETARG, OVRIDE LOGICAL*1 COMAND(3) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL INTEGER FILPTR LOGICAL*1 FNAME LOGICAL*1 OBUF INTEGER NEW LOGICAL*1 HDR LOGICAL*1 ASC LOGICAL*1 LOCAL LOGICAL*1 BIN LOGICAL*1 USER LOGICAL*1 USESTR(44) COMMON / CARCH / FSTAT(1000), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTC *OL, FILPTR(1000), FNAME(10000), OBUF(402) COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(40) 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)/9 *7/,USESTR(10)/114/,USESTR(11)/32/,USESTR(12)/123/,USESTR(13)/100/, *USESTR(14)/112/,USESTR(15)/115/,USESTR(16)/116/,USESTR(17)/117/,US *ESTR(18)/120/,USESTR(19)/125/,USESTR(20)/91/,USESTR(21)/118/,USEST *R(22)/47/,USESTR(23)/49/,USESTR(24)/93/,USESTR(25)/32/,USESTR(26)/ *97/,USESTR(27)/114/,USESTR(28)/99/,USESTR(29)/110/,USESTR(30)/97/, *USESTR(31)/109/,USESTR(32)/101/,USESTR(33)/32/,USESTR(34)/91/,USES *TR(35)/102/,USESTR(36)/105/,USESTR(37)/108/,USESTR(38)/101/,USESTR *(39)/93/,USESTR(40)/32/,USESTR(41)/46/,USESTR(42)/46/,USESTR(43)/4 *6/,USESTR(44)/0/ 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/ CALL QUERY(USESTR) IF (.NOT.( GETARG(1, COMAND, 3) .EQ. -1 .OR. GETARG(2, ANAME, 36) *.EQ. -1))GOTO 23000 CALL HELP(USESTR) 23000 CONTINUE CALL FOLD(COMAND) PACKIT = 1 IF (.NOT.( COMAND(2) .EQ. 118 ))GOTO 23002 VERBOS = 1 GOTO 23003 23002 CONTINUE IF (.NOT.(COMAND(2) .EQ. 49))GOTO 23004 PACKIT = 0 23004 CONTINUE 23003 CONTINUE CALL INITAR CALL GETFNS IF (.NOT.( COMAND(1) .EQ. 117 ))GOTO 23006 CALL UPDATE(ANAME) GOTO 23007 23006 CONTINUE IF (.NOT.( COMAND(1) .EQ. 116 ))GOTO 23008 CALL TABLE(ANAME) GOTO 23009 23008 CONTINUE IF (.NOT.( COMAND(1) .EQ. 120 .OR. COMAND(1) .EQ. 112 ))GOTO 23010 CALL EXTRAC(ANAME, COMAND(1)) GOTO 23011 23010 CONTINUE IF (.NOT.( COMAND(1) .EQ. 100 ))GOTO 23012 CALL DELET(ANAME) GOTO 23013 23012 CONTINUE IF (.NOT.( COMAND(1) .EQ. 115 ))GOTO 23014 CALL RECOVR(ANAME) GOTO 23015 23014 CONTINUE CALL HELP(USESTR) 23015 CONTINUE 23013 CONTINUE 23011 CONTINUE 23009 CONTINUE 23007 CONTINUE RETURN END SUBROUTINE ADDFIL(NAME, FD, ERRCT) LOGICAL*1 HEAD(402), NAME(100) INTEGER OPEN INTEGER ERRCT, FD, NFD, SIZE(2), TYPE INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL INTEGER FILPTR LOGICAL*1 FNAME LOGICAL*1 OBUF LOGICAL*1 ST001Z(3) LOGICAL*1 ST002Z(12) COMMON / CARCH / FSTAT(1000), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTC *OL, FILPTR(1000), FNAME(10000), OBUF(402) DATA ST001Z(1)/63/,ST001Z(2)/32/,ST001Z(3)/0/ DATA ST002Z(1)/58/,ST002Z(2)/32/,ST002Z(3)/99/,ST002Z(4)/97/,ST002 *Z(5)/110/,ST002Z(6)/39/,ST002Z(7)/116/,ST002Z(8)/32/,ST002Z(9)/97/ *,ST002Z(10)/100/,ST002Z(11)/100/,ST002Z(12)/0/ NFD = OPEN(NAME, 1) IF (.NOT.( NFD .EQ. -3 ))GOTO 23016 CALL PUTLIN(ST001Z, 3) CALL PUTLIN(NAME, 3) CALL REMARK(ST002Z) ERRCT = ERRCT + 1 RETURN 23016 CONTINUE CALL GETTYP(NFD, TYPE) CALL CLOSE(NFD) IF (.NOT.( ERRCT .EQ. 0 ))GOTO 23018 CALL ARSIZE(NAME, SIZE) CALL MAKHDR (NAME, HEAD, SIZE, TYPE) IF (.NOT.( VERBOS .EQ. 1 ))GOTO 23020 CALL PUTLIN (NAME, 2) CALL PUTCH (10, 2) 23020 CONTINUE NFD = OPEN(NAME,1) CALL PUTLIN(HEAD, FD) CALL ARCOPY (NFD, FD, SIZE) CALL CLOSE(NFD) 23018 CONTINUE RETURN END SUBROUTINE ARCOPY(FDI, FDO, SIZE) INTEGER FDI, FDO INTEGER SIZE(2), INCS(2), TSIZE(2) LOGICAL*1 LIN(402) INTEGER GETLIN TSIZE(1) = SIZE(1) TSIZE(2) = SIZE(2) INCS(1) = 0 23022 IF (.NOT.(.NOT.(TSIZE(1) .LE. 0 .AND. TSIZE(2) .LE. 0)))GOTO 23023 INCS(2) = GETLIN( LIN, FDI) IF (.NOT.( INCS(2) .EQ. -1 ))GOTO 23024 GOTO 23023 23024 CONTINUE IF (.NOT.( FDO .NE. -3 ))GOTO 23026 CALL PUTLIN( LIN, FDO) 23026 CONTINUE TSIZE(1) = TSIZE(1) - INCS(1) TSIZE(2) = TSIZE(2) - INCS(2) IF (.NOT.( TSIZE(2) .LT. 0))GOTO 23028 TSIZE(1) = TSIZE(1) - 1 TSIZE(2) = TSIZE(2) + 10000 23028 CONTINUE GOTO 23022 23023 CONTINUE RETURN END SUBROUTINE ARSIZE(FILE, SIZE) LOGICAL*1 FILE(36), C LOGICAL*1 GETCH INTEGER SIZE(2) INTEGER INT INTEGER OPEN INT = OPEN(FILE, 1) IF (.NOT.(INT .EQ. -3))GOTO 23030 SIZE(2) = -3 GOTO 23031 23030 CONTINUE SIZE(1) = 0 SIZE(2) = 0 23032 IF (.NOT.(GETCH(C, INT) .NE. -1))GOTO 23033 SIZE(2) = SIZE(2) + 1 IF (.NOT.(SIZE(2) .GE. 10000))GOTO 23034 SIZE(1) = SIZE(1) + 1 SIZE(2) = 0 23034 CONTINUE GOTO 23032 23033 CONTINUE CALL CLOSE(INT) 23031 CONTINUE RETURN END SUBROUTINE DELET (ANAME) LOGICAL*1 ANAME(36), IN(402), TFILE(36) INTEGER CREATE, OPEN, REMOVE INTEGER AFD, TFD, JUNK INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL INTEGER FILPTR LOGICAL*1 FNAME LOGICAL*1 OBUF LOGICAL*1 TNAME(8) LOGICAL*1 ST003Z(22) LOGICAL*1 ST004Z(37) COMMON / CARCH / FSTAT(1000), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTC *OL, FILPTR(1000), FNAME(10000), OBUF(402) 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/ DATA ST003Z(1)/63/,ST003Z(2)/32/,ST003Z(3)/68/,ST003Z(4)/101/,ST00 *3Z(5)/108/,ST003Z(6)/101/,ST003Z(7)/116/,ST003Z(8)/101/,ST003Z(9)/ *32/,ST003Z(10)/98/,ST003Z(11)/121/,ST003Z(12)/32/,ST003Z(13)/110/, *ST003Z(14)/97/,ST003Z(15)/109/,ST003Z(16)/101/,ST003Z(17)/32/,ST00 *3Z(18)/111/,ST003Z(19)/110/,ST003Z(20)/108/,ST003Z(21)/121/,ST003Z *(22)/0/ DATA ST004Z(1)/63/,ST004Z(2)/32/,ST004Z(3)/70/,ST004Z(4)/97/,ST004 *Z(5)/116/,ST004Z(6)/97/,ST004Z(7)/108/,ST004Z(8)/32/,ST004Z(9)/101 */,ST004Z(10)/114/,ST004Z(11)/114/,ST004Z(12)/111/,ST004Z(13)/114/, *ST004Z(14)/115/,ST004Z(15)/32/,ST004Z(16)/45/,ST004Z(17)/32/,ST004 *Z(18)/97/,ST004Z(19)/114/,ST004Z(20)/99/,ST004Z(21)/104/,ST004Z(22 *)/105/,ST004Z(23)/118/,ST004Z(24)/101/,ST004Z(25)/32/,ST004Z(26)/1 *10/,ST004Z(27)/111/,ST004Z(28)/116/,ST004Z(29)/32/,ST004Z(30)/97/, *ST004Z(31)/108/,ST004Z(32)/116/,ST004Z(33)/101/,ST004Z(34)/114/,ST *004Z(35)/101/,ST004Z(36)/100/,ST004Z(37)/0/ IF (.NOT.( FCOUNT .LE. 0 ))GOTO 23036 CALL ERROR(ST003Z) 23036 CONTINUE AFD = OPEN(ANAME, 1) IF (.NOT.( AFD .EQ. -3 ))GOTO 23038 CALL CANT(ANAME) 23038 CONTINUE CALL SCRATF(TNAME, TFILE) TFD = CREATE(TFILE, 2) IF (.NOT.( TFD .EQ. -3 ))GOTO 23040 CALL CANT(TFILE) 23040 CONTINUE CALL REPLAC(AFD, TFD, 100, ERRCNT) CALL NOTFND CALL CLOSE(AFD) CALL CLOSE(TFD) IF (.NOT.( ERRCNT .EQ. 0 ))GOTO 23042 CALL FMOVE(TFILE, ANAME) GOTO 23043 23042 CONTINUE CALL REMARK(ST004Z) 23043 CONTINUE JUNK = REMOVE(TFILE) RETURN END SUBROUTINE EXTRAC(ANAME, CMD) LOGICAL*1 ANAME(36), ENAME(36), IN(402), CMD INTEGER CREATE, FILARG, GETHDR, OPEN, EQUAL INTEGER AFD, EFD, SIZE(2), TYPE INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL INTEGER FILPTR LOGICAL*1 FNAME LOGICAL*1 OBUF INTEGER NEW LOGICAL*1 HDR LOGICAL*1 ASC LOGICAL*1 LOCAL LOGICAL*1 BIN LOGICAL*1 USER LOGICAL*1 ST005Z(3) LOGICAL*1 ST006Z(15) COMMON / CARCH / FSTAT(1000), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTC *OL, FILPTR(1000), FNAME(10000), OBUF(402) COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(40) DATA ST005Z(1)/63/,ST005Z(2)/32/,ST005Z(3)/0/ DATA ST006Z(1)/58/,ST006Z(2)/32/,ST006Z(3)/99/,ST006Z(4)/97/,ST006 *Z(5)/110/,ST006Z(6)/39/,ST006Z(7)/116/,ST006Z(8)/32/,ST006Z(9)/99/ *,ST006Z(10)/114/,ST006Z(11)/101/,ST006Z(12)/97/,ST006Z(13)/116/,ST *006Z(14)/101/,ST006Z(15)/0/ AFD = OPEN(ANAME, 1) IF (.NOT.( AFD .EQ. -3 ))GOTO 23044 CALL CANT(ANAME) 23044 CONTINUE IF (.NOT.( CMD .EQ. 112 ))GOTO 23046 EFD = 2 GOTO 23047 23046 CONTINUE EFD = -3 23047 CONTINUE 23048 IF (.NOT.( GETHDR(AFD, IN, ENAME, SIZE, TYPE) .NE. -1 ))GOTO 23049 IF (.NOT.( FILARG(ENAME) .EQ. 0 ))GOTO 23050 CALL ARCOPY(AFD,-3, SIZE) GOTO 23051 23050 CONTINUE IF (.NOT.( EFD .NE. 2 ))GOTO 23052 EFD = CREATE(ENAME, 2) 23052 CONTINUE IF (.NOT.(EFD .EQ. -3))GOTO 23054 CALL PUTLIN(ST005Z, 3) CALL PUTLIN(ENAME, 3) CALL REMARK(ST006Z) ERRCNT = ERRCNT + 1 CALL ARCOPY(AFD,-3, SIZE) GOTO 23055 23054 CONTINUE IF (.NOT.( VERBOS .EQ. 1 ))GOTO 23056 CALL PUTLIN(ENAME, 2) CALL PUTCH(10, 2) 23056 CONTINUE CALL ARCOPY(AFD, EFD, SIZE) IF (.NOT.( EFD .NE. 2 ))GOTO 23058 CALL CLOSE(EFD) 23058 CONTINUE 23055 CONTINUE 23051 CONTINUE GOTO 23048 23049 CONTINUE CALL NOTFND RETURN END INTEGER FUNCTION FILARG(NAME) LOGICAL*1 NAME(100), TEMP(36) INTEGER EQUAL INTEGER I, J INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL INTEGER FILPTR LOGICAL*1 FNAME LOGICAL*1 OBUF COMMON / CARCH / FSTAT(1000), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTC *OL, FILPTR(1000), FNAME(10000), OBUF(402) IF (.NOT.( FCOUNT .LE. 0 ))GOTO 23060 FILARG=(1) RETURN 23060 CONTINUE I = 1 23062 IF (.NOT.(I .LE. FCOUNT ))GOTO 23064 J = FILPTR(I) CALL SCOPY(FNAME, J, TEMP, 1) IF (.NOT.( EQUAL(NAME, TEMP ) .EQ. 1))GOTO 23065 FSTAT(I) = 1 FILARG=(1) RETURN 23065 CONTINUE 23063 I = I + 1 GOTO 23062 23064 CONTINUE FILARG=(0) RETURN END SUBROUTINE FMOVE(IN, OUT) LOGICAL*1 IN(100), OUT(100) INTEGER AMOVE LOGICAL*1 STR1(18) LOGICAL*1 STR2(5) DATA STR1(1)/63/,STR1(2)/32/,STR1(3)/69/,STR1(4)/114/,STR1(5)/114/ *,STR1(6)/111/,STR1(7)/114/,STR1(8)/32/,STR1(9)/114/,STR1(10)/101/, *STR1(11)/110/,STR1(12)/97/,STR1(13)/109/,STR1(14)/105/,STR1(15)/11 *0/,STR1(16)/103/,STR1(17)/32/,STR1(18)/0/ DATA STR2(1)/32/,STR2(2)/116/,STR2(3)/111/,STR2(4)/32/,STR2(5)/0/ IF (.NOT.(AMOVE(IN, OUT) .EQ. -3))GOTO 23067 CALL PUTLIN(STR1, 3) CALL PUTLIN(IN, 3) CALL PUTLIN(STR2, 3) CALL REMARK(OUT) 23067 CONTINUE RETURN END SUBROUTINE GETFNS LOGICAL*1 FILE(36) INTEGER EQUAL, GETARG, GETLIN, LENGTH INTEGER I, J, K, USEIN INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL INTEGER FILPTR LOGICAL*1 FNAME LOGICAL*1 OBUF LOGICAL*1 TEMP LOGICAL*1 ST007Z(20) LOGICAL*1 ST008Z(3) LOGICAL*1 ST009Z(22) COMMON / CARCH / FSTAT(1000), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTC *OL, FILPTR(1000), FNAME(10000), OBUF(402) COMMON / CARTMP / TEMP(402) DATA USEIN /0/ DATA ST007Z(1)/116/,ST007Z(2)/111/,ST007Z(3)/111/,ST007Z(4)/32/,ST *007Z(5)/109/,ST007Z(6)/97/,ST007Z(7)/110/,ST007Z(8)/121/,ST007Z(9) */32/,ST007Z(10)/102/,ST007Z(11)/105/,ST007Z(12)/108/,ST007Z(13)/10 *1/,ST007Z(14)/32/,ST007Z(15)/110/,ST007Z(16)/97/,ST007Z(17)/109/,S *T007Z(18)/101/,ST007Z(19)/115/,ST007Z(20)/0/ DATA ST008Z(1)/63/,ST008Z(2)/32/,ST008Z(3)/0/ DATA ST009Z(1)/58/,ST009Z(2)/32/,ST009Z(3)/100/,ST009Z(4)/117/,ST0 *09Z(5)/112/,ST009Z(6)/108/,ST009Z(7)/105/,ST009Z(8)/99/,ST009Z(9)/ *97/,ST009Z(10)/116/,ST009Z(11)/101/,ST009Z(12)/32/,ST009Z(13)/102/ *,ST009Z(14)/105/,ST009Z(15)/108/,ST009Z(16)/101/,ST009Z(17)/32/,ST *009Z(18)/110/,ST009Z(19)/97/,ST009Z(20)/109/,ST009Z(21)/101/,ST009 *Z(22)/0/ ERRCNT = 0 J = 1 I = 1 23069 IF (.NOT.(I .LE. 1000 ))GOTO 23071 IF (.NOT.( USEIN .EQ. 0 ))GOTO 23072 IF (.NOT.( GETARG(I+2, TEMP, 36) .EQ. -1 ))GOTO 23074 GOTO 23071 23074 CONTINUE IF (.NOT.( TEMP(1) .EQ. 45 .AND. TEMP(2) .EQ. 0 ))GOTO 23076 USEIN = 1 23076 CONTINUE 23072 CONTINUE IF (.NOT.( USEIN .EQ. 1 ))GOTO 23078 LEN = GETLIN(TEMP, 1) IF (.NOT.( LEN .EQ. -1 ))GOTO 23080 GOTO 23071 23080 CONTINUE TEMP(LEN) = 0 23078 CONTINUE CALL FOLD(TEMP) LEN = LENGTH(TEMP) + 1 IF (.NOT.((J + LEN) .GT. 10000))GOTO 23082 GOTO 23071 23082 CONTINUE FILPTR(I) = J CALL STCOPY(TEMP, 1, FNAME, J) J = J + 1 23070 I = I + 1 GOTO 23069 23071 CONTINUE FCOUNT = I - 1 IF (.NOT.( GETARG(I+2, FILE, 36) .NE. -1 ))GOTO 23084 CALL ERROR(ST007Z) 23084 CONTINUE I = 1 23086 IF (.NOT.(I .LE. FCOUNT ))GOTO 23088 FSTAT(I) = 0 23087 I = I + 1 GOTO 23086 23088 CONTINUE I = 1 23089 IF (.NOT.(I .LT. FCOUNT ))GOTO 23091 K = FILPTR(I) CALL SCOPY(FNAME, K, FILE, 1) J = I + 1 23092 IF (.NOT.(J .LE. FCOUNT ))GOTO 23094 K = FILPTR(J) CALL SCOPY(FNAME, K, TEMP, 1) IF (.NOT.(EQUAL(FILE, TEMP) .EQ. 1))GOTO 23095 CALL PUTLIN(ST008Z, 3) CALL PUTLIN(FILE, 3) CALL ERROR(ST009Z) 23095 CONTINUE 23093 J = J + 1 GOTO 23092 23094 CONTINUE 23090 I = I + 1 GOTO 23089 23091 CONTINUE RETURN END INTEGER FUNCTION GETHDR(FD, BUF, NAME, SIZE, TYPE) LOGICAL*1 BUF(402), C, NAME(36), TEMP(36) INTEGER CTOI, EQUAL, GETLIN, GETWRD, ISHDR INTEGER FD, I, LEN, SIZE(2), TYPE, J INTEGER NEW LOGICAL*1 HDR LOGICAL*1 ASC LOGICAL*1 LOCAL LOGICAL*1 BIN LOGICAL*1 USER LOGICAL*1 ST00AZ(31) COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(40) DATA ST00AZ(1)/63/,ST00AZ(2)/32/,ST00AZ(3)/65/,ST00AZ(4)/114/,ST00 *AZ(5)/99/,ST00AZ(6)/104/,ST00AZ(7)/105/,ST00AZ(8)/118/,ST00AZ(9)/1 *01/,ST00AZ(10)/32/,ST00AZ(11)/110/,ST00AZ(12)/111/,ST00AZ(13)/116/ *,ST00AZ(14)/32/,ST00AZ(15)/105/,ST00AZ(16)/110/,ST00AZ(17)/32/,ST0 *0AZ(18)/112/,ST00AZ(19)/114/,ST00AZ(20)/111/,ST00AZ(21)/112/,ST00A *Z(22)/101/,ST00AZ(23)/114/,ST00AZ(24)/32/,ST00AZ(25)/102/,ST00AZ(2 *6)/111/,ST00AZ(27)/114/,ST00AZ(28)/109/,ST00AZ(29)/97/,ST00AZ(30)/ *116/,ST00AZ(31)/0/ IF (.NOT.( NEW ))GOTO 23097 GETHDR = -1 RETURN 23097 CONTINUE IF (.NOT.( GETLIN(BUF, FD) .EQ. -1 ))GOTO 23099 GETHDR = -1 RETURN 23099 CONTINUE CALL FOLD(BUF) IF (.NOT.(ISHDR(BUF, I) .EQ. 0))GOTO 23101 CALL ERROR(ST00AZ) 23101 CONTINUE GETHDR = 1 LEN = GETWRD(BUF, I, NAME) CALL CTODI(BUF, I, SIZE) LEN = GETWRD (BUF, I, TEMP) CALL FOLD(TEMP) IF (.NOT.( LEN .LE. 0 .OR. EQUAL(TEMP,ASC) ))GOTO 23103 TYPE = 12 GOTO 23104 23103 CONTINUE IF (.NOT.( EQUAL(TEMP, LOCAL) ))GOTO 23105 TYPE = 6 GOTO 23106 23105 CONTINUE IF (.NOT.( EQUAL(TEMP, BIN) ))GOTO 23107 TYPE = 60 GOTO 23108 23107 CONTINUE TYPE = 12 23108 CONTINUE 23106 CONTINUE 23104 CONTINUE RETURN END SUBROUTINE HELP(MSG) LOGICAL*1 MSG(100) LOGICAL*1 QSTR(3) DATA QSTR(1)/63/,QSTR(2)/32/,QSTR(3)/0/ CALL PUTLIN(QSTR, 3) CALL ERROR(MSG) RETURN END SUBROUTINE INITAR INTEGER ISATTY INTEGER NEW LOGICAL*1 HDR LOGICAL*1 ASC LOGICAL*1 LOCAL LOGICAL*1 BIN LOGICAL*1 USER INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL INTEGER FILPTR LOGICAL*1 FNAME LOGICAL*1 OBUF COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(40) COMMON / CARCH / FSTAT(1000), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTC *OL, FILPTR(1000), FNAME(10000), OBUF(402) CALL MAILID(USER) IF (.NOT.(PACKIT .EQ. 1))GOTO 23109 PACKIT = ISATTY(2) 23109 CONTINUE IF (.NOT.(VERBOS .EQ. 1))GOTO 23111 PACKIT = 0 23111 CONTINUE RETURN END INTEGER FUNCTION ISHDR(BUF, I) LOGICAL*1 BUF(100) INTEGER I INTEGER NEW LOGICAL*1 HDR LOGICAL*1 ASC LOGICAL*1 LOCAL LOGICAL*1 BIN LOGICAL*1 USER COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(40) ISHDR = 1 I=1 23113 IF (.NOT.(HDR(I) .NE. 0))GOTO 23115 IF (.NOT.(BUF(I) .NE. HDR(I)))GOTO 23116 ISHDR = 0 GOTO 23115 23116 CONTINUE 23114 I=I+1 GOTO 23113 23115 CONTINUE IF (.NOT.(ISHDR .EQ. 1))GOTO 23118 IF (.NOT.(BUF(I) .NE. 32))GOTO 23120 ISHDR = 0 23120 CONTINUE 23118 CONTINUE RETURN END SUBROUTINE MAKHDR(NAME, HEAD, SIZE, TYPE) LOGICAL*1 HEAD(402), NAME(36), FILSIZ(20), DATE(10), TIME(10) INTEGER DITOC, LENGTH INTEGER SIZE(2), I, TYPE, NOW(7) INTEGER NEW LOGICAL*1 HDR LOGICAL*1 ASC LOGICAL*1 LOCAL LOGICAL*1 BIN LOGICAL*1 USER INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL INTEGER FILPTR LOGICAL*1 FNAME LOGICAL*1 OBUF LOGICAL*1 TWOBLK(3) COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(40) COMMON / CARCH / FSTAT(1000), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTC *OL, FILPTR(1000), FNAME(10000), OBUF(402) DATA TWOBLK(1)/32/,TWOBLK(2)/32/,TWOBLK(3)/0/ I = 1 CALL STCOPY(HDR, 1, HEAD, I) CALL CHCOPY(32, HEAD, I) CALL STCOPY(NAME, 1, HEAD, I) IF (.NOT.( SIZE(2) .EQ. -3 ))GOTO 23122 FILSIZ(1) = 0 ERRCNT = ERRCNT + 1 GOTO 23123 23122 CONTINUE JUNK = DITOC(SIZE, FILSIZ, 20) 23123 CONTINUE N = 20 - LENGTH(FILSIZ) - LENGTH(NAME) J=1 23124 IF (.NOT.(J .LT. N))GOTO 23126 CALL CHCOPY(32, HEAD, I) 23125 J=J+1 GOTO 23124 23126 CONTINUE CALL CHCOPY(32, HEAD, I) CALL STCOPY(FILSIZ, 1, HEAD, I) CALL STCOPY(TWOBLK, 1, HEAD, I) IF (.NOT.( TYPE .EQ. 12 ))GOTO 23127 CALL STCOPY(ASC, 1, HEAD, I) GOTO 23128 23127 CONTINUE IF (.NOT.( TYPE .EQ. 6 ))GOTO 23129 CALL STCOPY(LOCAL, 1, HEAD, I) GOTO 23130 23129 CONTINUE IF (.NOT.( TYPE .EQ. 60 ))GOTO 23131 CALL STCOPY(BIN, 1, HEAD, I) 23131 CONTINUE 23130 CONTINUE 23128 CONTINUE CALL STCOPY(TWOBLK, 1, HEAD, I) CALL GETNOW(NOW) CALL FMTDAT(DATE, TIME, NOW, 1) CALL STCOPY(DATE, 1, HEAD, I) CALL CHCOPY(32, HEAD, I) CALL STCOPY(TIME, 1, HEAD, I) CALL STCOPY(TWOBLK, 1, HEAD, I) CALL STCOPY(USER, 1, HEAD, I) CALL CHCOPY(10, HEAD, I) CALL FOLD(HEAD) RETURN END SUBROUTINE NOTFND INTEGER I, J LOGICAL*1 TEMP(36) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL INTEGER FILPTR LOGICAL*1 FNAME LOGICAL*1 OBUF LOGICAL*1 ST00BZ(3) LOGICAL*1 ST00CZ(17) COMMON / CARCH / FSTAT(1000), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTC *OL, FILPTR(1000), FNAME(10000), OBUF(402) DATA ST00BZ(1)/63/,ST00BZ(2)/32/,ST00BZ(3)/0/ DATA ST00CZ(1)/58/,ST00CZ(2)/32/,ST00CZ(3)/110/,ST00CZ(4)/111/,ST0 *0CZ(5)/116/,ST00CZ(6)/32/,ST00CZ(7)/105/,ST00CZ(8)/110/,ST00CZ(9)/ *32/,ST00CZ(10)/97/,ST00CZ(11)/114/,ST00CZ(12)/99/,ST00CZ(13)/104/, *ST00CZ(14)/105/,ST00CZ(15)/118/,ST00CZ(16)/101/,ST00CZ(17)/0/ I = 1 23133 IF (.NOT.(I .LE. FCOUNT ))GOTO 23135 IF (.NOT.(FSTAT(I) .EQ. 0 ))GOTO 23136 J = FILPTR(I) CALL SCOPY(FNAME, J, TEMP, 1) CALL PUTLIN(ST00BZ, 3) CALL PUTLIN(TEMP, 3) CALL REMARK(ST00CZ) ERRCNT = ERRCNT + 1 23136 CONTINUE 23134 I = I + 1 GOTO 23133 23135 CONTINUE RETURN END INTEGER FUNCTION NXTFL(NAME, AFD) LOGICAL*1 NAME(100), HOLDNM(36), BUF(402) INTEGER CREATE, GETLIN, EQUAL, ISHDR INTEGER AFD, I INTEGER NEW LOGICAL*1 HDR LOGICAL*1 ASC LOGICAL*1 LOCAL LOGICAL*1 BIN LOGICAL*1 USER LOGICAL*1 ST00DZ(31) COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(40) DATA HOLDNM(1) /0/ DATA ST00DZ(1)/63/,ST00DZ(2)/32/,ST00DZ(3)/65/,ST00DZ(4)/114/,ST00 *DZ(5)/99/,ST00DZ(6)/104/,ST00DZ(7)/105/,ST00DZ(8)/118/,ST00DZ(9)/1 *01/,ST00DZ(10)/32/,ST00DZ(11)/110/,ST00DZ(12)/111/,ST00DZ(13)/116/ *,ST00DZ(14)/32/,ST00DZ(15)/105/,ST00DZ(16)/110/,ST00DZ(17)/32/,ST0 *0DZ(18)/112/,ST00DZ(19)/114/,ST00DZ(20)/111/,ST00DZ(21)/112/,ST00D *Z(22)/101/,ST00DZ(23)/114/,ST00DZ(24)/32/,ST00DZ(25)/102/,ST00DZ(2 *6)/111/,ST00DZ(27)/114/,ST00DZ(28)/109/,ST00DZ(29)/97/,ST00DZ(30)/ *116/,ST00DZ(31)/0/ I = AFD IF (.NOT.( HOLDNM(1) .EQ. 0 ))GOTO 23138 IF (.NOT.( GETLIN(BUF, AFD) .EQ. -1 ))GOTO 23140 NXTFL = -1 RETURN 23140 CONTINUE IF (.NOT.(ISHDR(BUF, I) .EQ. 0))GOTO 23142 CALL ERROR (ST00DZ) 23142 CONTINUE LEN = GETWRD(BUF, I, HOLDNM) 23138 CONTINUE CALL SCOPY(HOLDNM, 1, NAME, 1) HOLDNM(1) = 0 INT = CREATE(NAME, 2) IF (.NOT.( INT .EQ. -3 ))GOTO 23144 CALL CANT(NAME) 23144 CONTINUE 23146 IF (.NOT.( GETLIN(BUF, AFD) .NE. -1 ))GOTO 23147 IF (.NOT.(ISHDR(BUF, I) .EQ. 1))GOTO 23148 LEN = GETWRD(BUF, I, HOLDNM) GOTO 23147 23148 CONTINUE CALL PUTLIN(BUF, INT) GOTO 23146 23147 CONTINUE CALL CLOSE(INT) NXTFL = 0 RETURN END SUBROUTINE RECOVR (ANAME) INTEGER CREATE, OPEN, NXTFL, REMOVE INTEGER AFD, TFD, JUNK LOGICAL*1 ANAME(100), TFILE(36), NAME(36) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL INTEGER FILPTR LOGICAL*1 FNAME LOGICAL*1 OBUF LOGICAL*1 TNAME(8) LOGICAL*1 ST00EZ(37) COMMON / CARCH / FSTAT(1000), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTC *OL, FILPTR(1000), FNAME(10000), OBUF(402) 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/ DATA ST00EZ(1)/63/,ST00EZ(2)/32/,ST00EZ(3)/70/,ST00EZ(4)/97/,ST00E *Z(5)/116/,ST00EZ(6)/97/,ST00EZ(7)/108/,ST00EZ(8)/32/,ST00EZ(9)/101 */,ST00EZ(10)/114/,ST00EZ(11)/114/,ST00EZ(12)/111/,ST00EZ(13)/114/, *ST00EZ(14)/115/,ST00EZ(15)/32/,ST00EZ(16)/45/,ST00EZ(17)/32/,ST00E *Z(18)/97/,ST00EZ(19)/114/,ST00EZ(20)/99/,ST00EZ(21)/104/,ST00EZ(22 *)/105/,ST00EZ(23)/118/,ST00EZ(24)/101/,ST00EZ(25)/32/,ST00EZ(26)/1 *10/,ST00EZ(27)/111/,ST00EZ(28)/116/,ST00EZ(29)/32/,ST00EZ(30)/97/, *ST00EZ(31)/108/,ST00EZ(32)/116/,ST00EZ(33)/101/,ST00EZ(34)/114/,ST *00EZ(35)/101/,ST00EZ(36)/100/,ST00EZ(37)/0/ AFD = OPEN(ANAME, 1) IF (.NOT.( AFD .EQ. -3 ))GOTO 23150 CALL CANT(ANAME) 23150 CONTINUE CALL SCRATF (TNAME, TFILE) TFD = CREATE(TFILE, 2) IF (.NOT.( TFD .EQ. -3 ))GOTO 23152 CALL CANT(TFILE) 23152 CONTINUE 23154 IF (.NOT.( NXTFL(NAME, AFD) .NE. -1 ))GOTO 23155 CALL ADDFIL(NAME, TFD, ERRCNT) JUNK = REMOVE(NAME) GOTO 23154 23155 CONTINUE CALL CLOSE(AFD) CALL CLOSE(TFD) IF (.NOT.( ERRCNT .EQ. 0 ))GOTO 23156 CALL FMOVE(TFILE, ANAME) GOTO 23157 23156 CONTINUE CALL REMARK(ST00EZ) 23157 CONTINUE JUNK = REMOVE (TFILE) RETURN END SUBROUTINE REPLAC(AFD, TFD, CMD, ERRCT) LOGICAL*1 IN(402), UNAME(36) INTEGER FILARG, GETHDR INTEGER AFD, CMD, ERRCT, SIZE(2), TFD, TYPE INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL INTEGER FILPTR LOGICAL*1 FNAME LOGICAL*1 OBUF COMMON / CARCH / FSTAT(1000), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTC *OL, FILPTR(1000), FNAME(10000), OBUF(402) 23158 IF (.NOT.( GETHDR(AFD, IN, UNAME, SIZE, TYPE) .NE. -1 ))GOTO 23159 IF (.NOT.( FILARG(UNAME) .EQ. 1 ))GOTO 23160 IF (.NOT.( CMD .EQ. 117 ))GOTO 23162 CALL ADDFIL(UNAME, TFD, ERRCT) 23162 CONTINUE IF (.NOT.( VERBOS .EQ. 1 .AND. CMD .EQ. 100))GOTO 23164 CALL PUTLIN (UNAME, 2) CALL PUTCH (10, 2) 23164 CONTINUE CALL ARCOPY(AFD,-3, SIZE) GOTO 23161 23160 CONTINUE CALL PUTLIN(IN, TFD) CALL ARCOPY(AFD, TFD, SIZE) 23161 CONTINUE GOTO 23158 23159 CONTINUE RETURN END SUBROUTINE TABLE(ANAME) LOGICAL*1 ANAME(36), IN(402), LNAME(36) INTEGER FILARG, GETHDR, OPEN INTEGER AFD, SIZE(2), TYPE INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL INTEGER FILPTR LOGICAL*1 FNAME LOGICAL*1 OBUF COMMON / CARCH / FSTAT(1000), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTC *OL, FILPTR(1000), FNAME(10000), OBUF(402) AFD = OPEN(ANAME, 1) IF (.NOT.( AFD .EQ. -3 ))GOTO 23166 CALL CANT(ANAME) 23166 CONTINUE IF (.NOT.(PACKIT .EQ. 1))GOTO 23168 CALL INPACK(NXTCOL, 80, OBUF, 2) 23168 CONTINUE 23170 IF (.NOT.( GETHDR(AFD, IN, LNAME, SIZE, TYPE) .NE. -1 ))GOTO 23171 IF (.NOT.( FILARG(LNAME) .EQ. 1 ))GOTO 23172 CALL TPRINT(IN) 23172 CONTINUE CALL ARCOPY( AFD,-3, SIZE) GOTO 23170 23171 CONTINUE IF (.NOT.(PACKIT .EQ. 1))GOTO 23174 CALL FLPACK(NXTCOL, 80, OBUF, 2) 23174 CONTINUE CALL NOTFND RETURN END SUBROUTINE TPRINT(BUF) INTEGER I, J LOGICAL*1 BUF(100), NAME(36) INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL INTEGER FILPTR LOGICAL*1 FNAME LOGICAL*1 OBUF COMMON / CARCH / FSTAT(1000), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTC *OL, FILPTR(1000), FNAME(10000), OBUF(402) I=1 23176 IF (.NOT.(BUF(I) .NE. 32 ))GOTO 23178 23177 I=I+1 GOTO 23176 23178 CONTINUE J = 1 I=I+1 23179 IF (.NOT.(BUF(I) .NE. 32 ))GOTO 23181 CALL CHCOPY(BUF(I), NAME, J) 23180 I=I+1 GOTO 23179 23181 CONTINUE NAME(J) = 0 IF (.NOT.(PACKIT .EQ. 1))GOTO 23182 CALL DOPACK(NAME, NXTCOL, 80, OBUF, 2) GOTO 23183 23182 CONTINUE CALL PUTLIN(NAME, 2) IF (.NOT.(VERBOS .EQ. 1))GOTO 23184 CALL PUTLIN(BUF(I), 2) GOTO 23185 23184 CONTINUE CALL PUTCH(10, 2) 23185 CONTINUE 23183 CONTINUE RETURN END SUBROUTINE UPDATE(ANAME) LOGICAL*1 ANAME(36), TFILE(36) INTEGER CREATE, GETARG, OPEN, REMOVE INTEGER AFD, I, TFD, J, JUNK INTEGER FSTAT INTEGER FCOUNT INTEGER ERRCNT INTEGER VERBOS INTEGER PACKIT INTEGER NXTCOL INTEGER FILPTR LOGICAL*1 FNAME LOGICAL*1 OBUF INTEGER NEW LOGICAL*1 HDR LOGICAL*1 ASC LOGICAL*1 LOCAL LOGICAL*1 BIN LOGICAL*1 USER LOGICAL*1 TEMP LOGICAL*1 TNAME(8) LOGICAL*1 ST00FZ(37) COMMON / CARCH / FSTAT(1000), FCOUNT, ERRCNT, VERBOS, PACKIT, NXTC *OL, FILPTR(1000), FNAME(10000), OBUF(402) COMMON /HDR/ NEW, HDR(5), ASC(4), LOCAL(6), BIN(4), USER(40) COMMON / CARTMP / TEMP(402) 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/ DATA ST00FZ(1)/63/,ST00FZ(2)/32/,ST00FZ(3)/70/,ST00FZ(4)/97/,ST00F *Z(5)/116/,ST00FZ(6)/97/,ST00FZ(7)/108/,ST00FZ(8)/32/,ST00FZ(9)/101 */,ST00FZ(10)/114/,ST00FZ(11)/114/,ST00FZ(12)/111/,ST00FZ(13)/114/, *ST00FZ(14)/115/,ST00FZ(15)/32/,ST00FZ(16)/45/,ST00FZ(17)/32/,ST00F *Z(18)/97/,ST00FZ(19)/114/,ST00FZ(20)/99/,ST00FZ(21)/104/,ST00FZ(22 *)/105/,ST00FZ(23)/118/,ST00FZ(24)/101/,ST00FZ(25)/32/,ST00FZ(26)/1 *10/,ST00FZ(27)/111/,ST00FZ(28)/116/,ST00FZ(29)/32/,ST00FZ(30)/97/, *ST00FZ(31)/108/,ST00FZ(32)/116/,ST00FZ(33)/101/,ST00FZ(34)/114/,ST *00FZ(35)/101/,ST00FZ(36)/100/,ST00FZ(37)/0/ AFD = OPEN(ANAME, 1) IF (.NOT.( AFD .EQ. -3 ))GOTO 23186 AFD = CREATE(ANAME, 2) IF (.NOT.( AFD .EQ. -3 ))GOTO 23188 CALL CANT(ANAME) 23188 CONTINUE NEW = 1 GOTO 23187 23186 CONTINUE NEW = 0 23187 CONTINUE CALL CLOSE(1) CALL SCRATF(TNAME, TFILE) TFD = CREATE(TFILE, 2) IF (.NOT.( TFD .EQ. -3 ))GOTO 23190 CALL CANT(TFILE) 23190 CONTINUE CALL REPLAC(AFD, TFD, 117, ERRCNT) I = 1 23192 IF (.NOT.(I .LE. FCOUNT ))GOTO 23194 IF (.NOT.( FSTAT(I) .EQ. 0 ))GOTO 23195 J = FILPTR(I) CALL SCOPY(FNAME, J, TEMP, 1) CALL ADDFIL(TEMP, TFD, ERRCNT) FSTAT(I) = 1 23195 CONTINUE 23193 I = I + 1 GOTO 23192 23194 CONTINUE CALL CLOSE(AFD) CALL CLOSE(TFD) IF (.NOT.( ERRCNT .EQ. 0 ))GOTO 23197 CALL FMOVE(TFILE, ANAME) GOTO 23198 23197 CONTINUE CALL REMARK(ST00FZ) 23198 CONTINUE JUNK = REMOVE(TFILE) RETURN END