SUBROUTINE MAIN LOGICAL*1 LINE(400) INTEGER GETARG, OPEN, TTY INTEGER I, NFILES LOGICAL*1 FNAMES(40, 10) COMMON /CFORM/ OUTTY, CHAR1, CHAR2, PSTR(400) INTEGER OUTTY LOGICAL*1 CHAR1 LOGICAL*1 CHAR2 LOGICAL*1 PSTR COMMON /CDEFIO/ BP, BUF(300) INTEGER BP LOGICAL*1 BUF DATA CHAR1 /60/ DATA CHAR2 /62/ DATA BP /0/ IF(.NOT.(TTY(1) .EQ. 1))GOTO 23000 CALL GTTY(LINE) OUTTY = OPEN(LINE, 2) IF(.NOT.(OUTTY .EQ. -3))GOTO 23002 CALL CANT(LINE) 23002 CONTINUE 23000 CONTINUE CALL TBINIT NFILES = 0 I=1 23004 IF(.NOT.(GETARG(I, LINE, 400) .NE. -1))GOTO 23006 IF(.NOT.(LINE(1) .EQ. 63 .AND. LINE(2) .EQ. 0))GOTO 23007 CALL ERROR (21Husage: form file ...) GOTO 23008 23007 CONTINUE IF(.NOT.(LINE(1) .EQ. 45 .AND. LINE(2) .NE. 0))GOTO 23009 CHAR1 = LINE(2) GOTO 23010 23009 CONTINUE IF(.NOT.(LINE(1) .EQ. 43))GOTO 23011 CHAR2 = LINE(2) GOTO 23012 23011 CONTINUE NFILES = NFILES + 1 IF(.NOT.(NFILES .GT. 10))GOTO 23013 CALL ERROR (19Htoo many file names) 23013 CONTINUE CALL SCOPY(LINE, 1, FNAMES(1, NFILES), 1) 23012 CONTINUE 23010 CONTINUE 23008 CONTINUE 23005 I=I+1 GOTO 23004 23006 CONTINUE I=1 23015 IF(.NOT.(I.LE.NFILES))GOTO 23017 INT = OPEN(FNAMES(1,I), 1) IF(.NOT.(INT .EQ. -3))GOTO 23018 CALL CANT(LINE) 23018 CONTINUE CALL FORML(INT) CALL CLOSE(INT) 23016 I=I+1 GOTO 23015 23017 CONTINUE IF(.NOT.(I .EQ. 1))GOTO 23020 CALL ERROR (21Husage: form file ...) 23020 CONTINUE RETURN END SUBROUTINE FORML(INT) INTEGER INT, TOG INTEGER FTOK, GUSER, LOOKUP LOGICAL*1 TOKEN(400), DEFN(5000) COMMON /CFORM/ OUTTY, CHAR1, CHAR2, PSTR(400) INTEGER OUTTY LOGICAL*1 CHAR1 LOGICAL*1 CHAR2 LOGICAL*1 PSTR TOG = 0 23022 IF(.NOT.(FTOK(TOKEN, INT, TOG) .NE. -1))GOTO 23023 IF(.NOT.(TOG .EQ. 1))GOTO 23024 IF(.NOT.(TOKEN(1) .EQ. CHAR2))GOTO 23026 TOG = 0 GOTO 23022 23026 CONTINUE IF(.NOT.(LOOKUP(TOKEN, DEFN) .EQ. 0))GOTO 23028 CALL PUSER(TOKEN) IF(.NOT.(GUSER(DEFN) .EQ. -1))GOTO 23030 GOTO 23023 23030 CONTINUE CALL INSTAL(TOKEN, DEFN) 23028 CONTINUE CALL PUTLIN(DEFN, 2) GOTO 23022 23024 CONTINUE IF(.NOT.(TOKEN(1) .EQ. CHAR1))GOTO 23032 TOG = 1 GOTO 23022 23032 CONTINUE 23025 CONTINUE CALL PUTLIN(TOKEN, 2) GOTO 23022 23023 CONTINUE RETURN END SUBROUTINE PUSER(PR) LOGICAL*1 PR(100) INTEGER INDEX INTEGER I, ISTART COMMON /CFORM/ OUTTY, CHAR1, CHAR2, PSTR(400) INTEGER OUTTY LOGICAL*1 CHAR1 LOGICAL*1 CHAR2 LOGICAL*1 PSTR ISTART = 1 23034 CONTINUE I = INDEX(PR(ISTART), 10) IF(.NOT.(I .EQ. 0))GOTO 23037 GOTO 23036 23037 CONTINUE I=ISTART + I - 1 23039 IF(.NOT.(ISTART .LE. I))GOTO 23041 CALL PUTCH(PR(ISTART), OUTTY) 23040 ISTART = ISTART + 1 GOTO 23039 23041 CONTINUE 23035 GOTO 23034 23036 CONTINUE CALL SCOPY(PR, ISTART, PSTR, 1) I = LENGTH(PSTR) PSTR(I+1) = 32 PSTR(I+2) =0 RETURN END INTEGER FUNCTION FTOK(TOKEN, INT, PRFLAG) LOGICAL*1 TOKEN(100) INTEGER INT, PRFLAG LOGICAL*1 NGETCH COMMON /CFORM/ OUTTY, CHAR1, CHAR2, PSTR(400) INTEGER OUTTY LOGICAL*1 CHAR1 LOGICAL*1 CHAR2 LOGICAL*1 PSTR I=1 23042 IF(.NOT.(I.LT. 5000))GOTO 23044 FTOK = NGETCH(TOKEN(I), INT) IF(.NOT.(FTOK .EQ. -1 .OR. (PRFLAG .EQ. 0 .AND. FTOK .EQ. 10) .OR. * (I .EQ. 1 .AND. FTOK .EQ. CHAR1) .OR. (I .EQ. 1 .AND. FTOK .EQ. C *HAR2) ))GOTO 23045 GOTO 23044 23045 CONTINUE IF(.NOT.(FTOK .EQ. CHAR1 .OR. FTOK .EQ. CHAR2))GOTO 23047 CALL PUTBAK(FTOK) I = I - 1 GOTO 23044 23047 CONTINUE 23043 I=I+1 GOTO 23042 23044 CONTINUE IF(.NOT.(I .GE.5000))GOTO 23049 CALL ERROR (15Htoken too long.) 23049 CONTINUE TOKEN(I+1) = 0 RETURN END INTEGER FUNCTION GUSER(REPL) LOGICAL*1 REPL(100) INTEGER GETLIN, PROMPT INTEGER LTH COMMON /CFORM/ OUTTY, CHAR1, CHAR2, PSTR(400) INTEGER OUTTY LOGICAL*1 CHAR1 LOGICAL*1 CHAR2 LOGICAL*1 PSTR LTH = 0 23051 CONTINUE IF(.NOT.(LTH .EQ. 0))GOTO 23054 I = PROMPT(PSTR, REPL(LTH+1), 1) GOTO 23055 23054 CONTINUE I = GETLIN(REPL(LTH+1), 1) 23055 CONTINUE IF(.NOT.(I .EQ. -1))GOTO 23056 GOTO 23053 23056 CONTINUE LTH = LTH + I IF(.NOT.(LTH .GE. 5000))GOTO 23058 CALL REMARK (19Htruncating response) GOTO 23053 23058 CONTINUE IF(.NOT.(REPL(LTH) .EQ. 10 .AND. REPL(LTH-1) .NE. 64))GOTO 23060 GOTO 23053 23060 CONTINUE LTH = LTH - 1 REPL(LTH) = 10 23052 GOTO 23051 23053 CONTINUE IF(.NOT.(REPL(LTH) .EQ. 10))GOTO 23062 LTH = LTH - 1 23062 CONTINUE REPL(LTH+1) = 0 IF(.NOT.(I .EQ. -1))GOTO 23064 GUSER = -1 GOTO 23065 23064 CONTINUE GUSER = LTH 23065 CONTINUE RETURN END