SUBROUTINE MAIN COMMON /TCS/ ANSTRY(100), FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANC *S, MAXVER, SEEKPT(2) INTEGER ANSTRY, FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANCS, MAXVER, * SEEKPT INTEGER BMATCH, CLOWER, GETARG, GETLIN, OPEN INTEGER LINGET, CREATE LOGICAL*1 INBUF(512) LOGICAL*1 WANTED(40) LOGICAL*1 ARG(40) LOGICAL*1 OUTFIL(40) INTEGER ARGNUM, FDOUT, I INTEGER ARRAY(16) LOGICAL*1 USAGE(49) DATA USAGE(1)/117/,USAGE(2)/115/,USAGE(3)/97/,USAGE(4)/103/,USAGE( *5)/101/,USAGE(6)/58/,USAGE(7)/32/,USAGE(8)/32/,USAGE(9)/103/,USAGE *(10)/101/,USAGE(11)/116/,USAGE(12)/32/,USAGE(13)/91/,USAGE(14)/45/ *,USAGE(15)/104/,USAGE(16)/93/,USAGE(17)/91/,USAGE(18)/45/,USAGE(19 *)/114/,USAGE(20)/77/,USAGE(21)/46/,USAGE(22)/78/,USAGE(23)/93/,USA *GE(24)/32/,USAGE(25)/104/,USAGE(26)/105/,USAGE(27)/115/,USAGE(28)/ *116/,USAGE(29)/111/,USAGE(30)/114/,USAGE(31)/121/,USAGE(32)/102/,U *SAGE(33)/105/,USAGE(34)/108/,USAGE(35)/101/,USAGE(36)/32/,USAGE(37 *)/91/,USAGE(38)/114/,USAGE(39)/101/,USAGE(40)/115/,USAGE(41)/117/, *USAGE(42)/108/,USAGE(43)/116/,USAGE(44)/102/,USAGE(45)/105/,USAGE( *46)/108/,USAGE(47)/101/,USAGE(48)/93/,USAGE(49)/0/ CALL QUERY(USAGE) IF (.NOT.(GETARG(1, ARG, 40) .EQ. -1))GOTO 23000 CALL ERROR(USAGE) 23000 CONTINUE ARGNUM = 2 IF (.NOT.(ARG(1) .EQ. 45))GOTO 23002 ARGNUM = 3 IF (.NOT.(CLOWER(ARG(2)) .EQ. 104))GOTO 23004 IF (.NOT.(GETARG(2, ARG, 40) .EQ. -1))GOTO 23006 CALL ERROR(USAGE) 23006 CONTINUE FDHIS = OPEN(ARG, 1) IF (.NOT.(FDHIS .EQ. -3))GOTO 23008 CALL CANT(ARG) 23008 CONTINUE 23010 IF (.NOT.(GETLIN(INBUF, FDHIS) .NE. -1))GOTO 23011 IF (.NOT.(BMATCH(INBUF, 1, 4H%%d ) .NE. 0))GOTO 23012 CALL PUTCH(10, 2) CALL PUTLIN(14H*** Version # , 2) CALL PARSE(INBUF, 5, ARRAY, 32) CALL APUTLN(INBUF, ARRAY(2), 2) CALL PUTCH(32, 2) CALL APUTLN(INBUF, ARRAY(3), 2) CALL PUTCH(32, 2) CALL APUTLN(INBUF, ARRAY(4), 2) CALL PUTCH(32, 2) CALL APUTLN(INBUF, ARRAY(5), 2) CALL PUTCH(10, 2) 23012 CONTINUE IF (.NOT.(BMATCH(INBUF, 1, 4H%%c ) .NE. 0))GOTO 23014 CALL APUTLN(INBUF, 5, 2) 23014 CONTINUE GOTO 23010 23011 CONTINUE CALL CLOSE(FDHIS) RETURN 23004 CONTINUE IF (.NOT.(CLOWER(ARG(2)) .EQ. 114))GOTO 23016 CALL SCOPY(ARG, 3, WANTED, 1) IF (.NOT.(GETARG(2, ARG, 40) .EQ. -1))GOTO 23018 CALL ERROR(USAGE) 23018 CONTINUE GOTO 23017 23016 CONTINUE CALL ERROR(18HIllegal keyletter.) 23017 CONTINUE 23005 CONTINUE 23002 CONTINUE IF (.NOT.(GETARG(ARGNUM, OUTFIL, 40) .NE. -1))GOTO 23020 FDOUT = CREATE(OUTFIL, 2) IF (.NOT.(FDOUT .EQ. -3))GOTO 23022 CALL CANT(OUTFIL) 23022 CONTINUE GOTO 23021 23020 CONTINUE FDOUT = 2 23021 CONTINUE CALL SETGET(ARG, WANTED) CALL RSTGET() 23024 IF (.NOT.(LINGET(INBUF, 0) .NE. -1))GOTO 23025 CALL PUTLIN(INBUF, FDOUT) GOTO 23024 23025 CONTINUE CALL CLOSE(FDHIS) END SUBROUTINE PARSE(INBUF, FROM, OUTARA, DELIM) LOGICAL*1 INBUF(512) INTEGER FROM INTEGER OUTARA(16) LOGICAL*1 DELIM INTEGER PTR PTR = FROM 23026 IF (.NOT.(INBUF(PTR) .EQ. DELIM))GOTO 23027 PTR = PTR+1 GOTO 23026 23027 CONTINUE I=1 23028 IF (.NOT.(INBUF(PTR) .NE. 10))GOTO 23030 OUTARA(I) = PTR 23031 IF (.NOT.((INBUF(PTR) .NE. DELIM) .AND. (INBUF(PTR) .NE. 10)))GOTO * 23032 PTR = PTR+1 GOTO 23031 23032 CONTINUE 23033 IF (.NOT.((INBUF(PTR) .EQ. DELIM) .AND. (INBUF(PTR) .NE. 10)))GOTO * 23034 INBUF(PTR) = 0 PTR = PTR+1 GOTO 23033 23034 CONTINUE 23029 I=I+1 GOTO 23028 23030 CONTINUE INBUF(PTR) = 0 OUTARA(I) = 0 RETURN END INTEGER FUNCTION BMATCH(LIN, FROM, PAT) LOGICAL*1 LIN (512), PAT(512) INTEGER FROM, I, J I = FROM J=1 23035 IF (.NOT.(PAT(J) .NE. 0))GOTO 23037 IF (.NOT.(LIN(I).NE.PAT(J)))GOTO 23038 BMATCH = 0 RETURN 23038 CONTINUE I = I + 1 23036 J = J + 1 GOTO 23035 23037 CONTINUE BMATCH = I RETURN END INTEGER FUNCTION BMCH2(LIN, FROM, PAT) LOGICAL*1 LIN (512), PAT(512) INTEGER FROM INTEGER EQUAL LOGICAL*1 TEMP(512) CALL SCOPY(LIN, FROM, TEMP, 1) BMCH2=(EQUAL(TEMP, PAT)) RETURN END INTEGER FUNCTION CTOI2(BUF, FIXED) LOGICAL*1 BUF INTEGER FIXED INTEGER CTOI INTEGER PTR PTR = FIXED CTOI2=(CTOI(BUF, PTR)) RETURN END SUBROUTINE SETGET (FILNAM, WANTED) LOGICAL*1 FILNAM(40) LOGICAL*1 WANTED(40) COMMON /TCS/ ANSTRY(100), FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANC *S, MAXVER, SEEKPT(2) INTEGER ANSTRY, FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANCS, MAXVER, * SEEKPT INTEGER BMATCH, BMCH2, CLOSE, CTOI2, GETLIN, OPEN, NOTE INTEGER JUNK LOGICAL*1 INBUF(512) INTEGER ARRAY(16) INTEGER I INTEGER THREAD, IPREV, ITHIS FDHIS = OPEN(FILNAM, 1) IF (.NOT.(FDHIS .EQ. -3))GOTO 23040 CALL ERROR(31HCannot locate TCS history file.) 23040 CONTINUE I=1 23042 IF (.NOT.(I.LE.100))GOTO 23044 ANSTRY(I) = 0 23043 I=I+1 GOTO 23042 23044 CONTINUE THREAD = -1 23045 CONTINUE I = GETLIN(INBUF, FDHIS) IF (.NOT.(I .EQ. -1))GOTO 23048 CALL ERROR(36HUnexpected EOF on history-info scan.) 23048 CONTINUE IF (.NOT.(BMATCH(INBUF, 1, 3H%%T) .NE. 0))GOTO 23050 CALL ERROR(37HNonexistant revision level requested.) 23050 CONTINUE IF (.NOT.(BMATCH(INBUF, 1, 4H%%d ) .NE. 0))GOTO 23052 CALL PARSE(INBUF, 5, ARRAY, 32) ITHIS = CTOI2(INBUF, ARRAY(6)) IPREV = CTOI2(INBUF, ARRAY(7)) IF (.NOT.(THREAD .LT. 0))GOTO 23054 MAXVER = ITHIS THREAD = 0 23054 CONTINUE IF (.NOT.(THREAD .EQ. 0))GOTO 23056 IF (.NOT.((WANTED(1) .EQ. 0) .OR. (BMCH2(INBUF, ARRAY(2), WANTED) *.EQ. 1)))GOTO 23058 ANSTRY(ITHIS) = 1 THREAD = IPREV IF (.NOT.(WANTED(1) .EQ. 0))GOTO 23060 CALL PUTLIN(10HVersion # , 3) CALL APUTLN(INBUF, ARRAY(2), 3) CALL PUTCH(10, 3) 23060 CONTINUE IF (.NOT.(THREAD .EQ. 0))GOTO 23062 GOTO 23047 23062 CONTINUE GOTO 23059 23058 CONTINUE GOTO 23046 23059 CONTINUE GOTO 23057 23056 CONTINUE IF (.NOT.(ITHIS .EQ. THREAD))GOTO 23064 ANSTRY(ITHIS) = 1 THREAD = IPREV IF (.NOT.(THREAD .EQ. 0))GOTO 23066 GOTO 23047 23066 CONTINUE 23064 CONTINUE 23057 CONTINUE 23052 CONTINUE 23046 GOTO 23045 23047 CONTINUE JUNK = NOTE(SEEKPT, FDHIS) RETURN END SUBROUTINE RSTGET() COMMON /TCS/ ANSTRY(100), FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANC *S, MAXVER, SEEKPT(2) INTEGER ANSTRY, FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANCS, MAXVER, * SEEKPT CALL SEEK(SEEKPT, FDHIS) INSERT = 0 RETURN END INTEGER FUNCTION LINGET(INBUF, PSTHRU) LOGICAL*1 INBUF(512) INTEGER PSTHRU COMMON /TCS/ ANSTRY(100), FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANC *S, MAXVER, SEEKPT(2) INTEGER ANSTRY, FDHIS, FDREV, FDSCR, FLAG, INSERT, MYANCS, MAXVER, * SEEKPT INTEGER BMATCH, CTOI2, GETLIN INTEGER CURNST, I 23068 CONTINUE I = GETLIN(INBUF, FDHIS) IF (.NOT.(I .EQ. -1))GOTO 23071 CALL ERROR(36HUnexpected EOF on history-data scan.) 23071 CONTINUE IF (.NOT.(BMATCH(INBUF, 1, 4H%%E ) .NE. 0))GOTO 23073 IF (.NOT.(CTOI2(INBUF, 5) .EQ. 1))GOTO 23075 GOTO 23070 23075 CONTINUE IF (.NOT.(INSERT .EQ. 0))GOTO 23077 IF (.NOT.(CTOI2(INBUF, 5) .EQ. CURNST))GOTO 23079 INSERT = 1 23079 CONTINUE 23077 CONTINUE GOTO 23074 23073 CONTINUE IF (.NOT.(BMATCH(INBUF, 1, 4H%%I ) .NE. 0))GOTO 23081 IF (.NOT.(ANSTRY(CTOI2(INBUF, 5)) .EQ. 1))GOTO 23083 INSERT = 1 GOTO 23084 23083 CONTINUE IF (.NOT.(INSERT .EQ. 1))GOTO 23085 CURNST = CTOI2(INBUF, 5) INSERT = 0 23085 CONTINUE 23084 CONTINUE GOTO 23082 23081 CONTINUE IF (.NOT.(BMATCH(INBUF, 1, 4H%%D ) .NE. 0))GOTO 23087 IF (.NOT.(ANSTRY(CTOI2(INBUF, 5)) .EQ. 1))GOTO 23089 IF (.NOT.(INSERT .EQ. 1))GOTO 23091 CURNST = CTOI2(INBUF, 5) INSERT = 0 23091 CONTINUE 23089 CONTINUE GOTO 23088 23087 CONTINUE IF (.NOT.(INSERT .EQ. 1))GOTO 23093 LINGET=(I) RETURN 23093 CONTINUE 23088 CONTINUE 23082 CONTINUE 23074 CONTINUE 23069 GOTO 23068 23070 CONTINUE LINGET=(-1) RETURN END SUBROUTINE APUTLN(STR, OFF, OUTFD) LOGICAL*1 STR(512) INTEGER OFF, OUTFD LOGICAL*1 TMPLIN(512) INTEGER I, J I = OFF-1 J = 1 23095 CONTINUE I = I+1 TMPLIN(J) = STR(I) J = J+1 23096 IF (.NOT.((STR(I) .EQ. 0) .OR. (STR(I) .EQ. 10)))GOTO 23095 23097 CONTINUE TMPLIN(J) = 0 CALL PUTLIN(TMPLIN, OUTFD) RETURN END