SUBROUTINE MAIN LOGICAL*1 ARG(512) INTEGER GETARG, OPEN, CTOI INTEGER I, FD, NF, J COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(512), OHEAD(512), EHLIM(2), OHLIM(2), EFOOT(512), O *FOOT(512), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM LOGICAL*1 EHEAD LOGICAL*1 OHEAD INTEGER EHLIM INTEGER OHLIM LOGICAL*1 EFOOT LOGICAL*1 OFOOT INTEGER EFLIM INTEGER OFLIM INTEGER STOPX INTEGER FRSTPG INTEGER LASTPG INTEGER PRINT INTEGER OFFSET COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(400), CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER CUVAL INTEGER TABS LOGICAL*1 CCHAR COMMON /COUT/ OUTP, OUTW, OUTWDS, OUTBUF(400) INTEGER OUTP INTEGER OUTW INTEGER OUTWDS LOGICAL*1 OUTBUF CALL FINIT NF = 0 CALL QUERY (44Husage: format [-s] [+n] [-n] [-pon] [files].) I = 1 23000 IF (.NOT.(GETARG(I, ARG, 512) .NE. -1))GOTO 23002 IF (.NOT.(ARG(1) .EQ. 45 .AND. (ARG(2) .EQ. 115 .OR. ARG(2) .EQ. 8 *3)))GOTO 23003 STOPX = 1 GOTO 23004 23003 CONTINUE IF (.NOT.(ARG(1) .EQ. 45 .AND. (ARG(2) .EQ. 112 .OR. ARG(2) .EQ. 8 *0) .AND. (ARG(3) .EQ. 111 .OR. ARG(3) .EQ. 79)))GOTO 23005 J = 4 CALL SET(OFFSET, CTOI(ARG, J), ARG(4), 0, 0, RMVAL-1) GOTO 23006 23005 CONTINUE IF (.NOT.(ARG(1) .EQ. 43))GOTO 23007 J = 2 FRSTPG = CTOI(ARG, J) GOTO 23008 23007 CONTINUE IF (.NOT.(ARG(1) .EQ. 45 .AND. ARG(2) .NE. 0))GOTO 23009 J = 2 LASTPG = CTOI(ARG, J) GOTO 23010 23009 CONTINUE IF (.NOT.(ARG(1) .EQ. 45))GOTO 23011 FD = 1 GOTO 23012 23011 CONTINUE FD = OPEN(ARG, 1) 23012 CONTINUE IF (.NOT.(FD .EQ. -3))GOTO 23013 CALL PUTLIN (ARG, 3) CALL REMARK (14H: can't open.) GOTO 23001 23013 CONTINUE CALL DOROFF(FD) NF = NF + 1 IF (.NOT.(FD .NE. 1))GOTO 23015 CALL CLOSE(FD) 23015 CONTINUE 23010 CONTINUE 23008 CONTINUE 23006 CONTINUE 23004 CONTINUE 23001 I = I + 1 GOTO 23000 23002 CONTINUE IF (.NOT.(NF .EQ. 0))GOTO 23017 CALL DOROFF(1) 23017 CONTINUE CALL BRK IF (.NOT.(PLVAL .LE. 100 .AND. (LINENO .GT. 0 .OR. OUTP .GT. 0)))G *OTO 23019 CALL SPACE(30000) 23019 CONTINUE CALL PUTCH(12,2) CALL PUTCH(10,2) RETURN END SUBROUTINE BOLD(BUF, TBUF, SIZE) INTEGER I, J, SIZE LOGICAL*1 BUF(100), TBUF(100) J = 1 I = 1 23021 IF (.NOT.(BUF(I) .NE. 10 .AND. J .LT. SIZE-1))GOTO 23023 TBUF(J) = BUF(I) J = J + 1 IF (.NOT.(BUF(I) .NE. 32 .AND. BUF(I) .NE. 9 .AND. BUF(I) .NE. 8 . *AND. BUF(I) .NE. -10 .AND. BUF(I) .NE. -11))GOTO 23024 TBUF(J) = 8 TBUF(J+1) = TBUF(J-1) TBUF(J+2) = 8 TBUF(J+3) = TBUF(J+1) J = J + 4 23024 CONTINUE 23022 I = I + 1 GOTO 23021 23023 CONTINUE TBUF(J) = 10 TBUF(J+1) = 0 CALL SCOPY(TBUF, 1, BUF, 1) RETURN END SUBROUTINE BRK COMMON /COUT/ OUTP, OUTW, OUTWDS, OUTBUF(400) INTEGER OUTP INTEGER OUTW INTEGER OUTWDS LOGICAL*1 OUTBUF IF (.NOT.(OUTP .GT. 0))GOTO 23026 OUTBUF(OUTP) = 10 OUTBUF(OUTP+1) = 0 CALL PUT(OUTBUF) 23026 CONTINUE OUTP = 0 OUTW = 0 OUTWDS = 0 RETURN END SUBROUTINE CENTER(BUF) LOGICAL*1 BUF(100) INTEGER MAX0, WIDTH COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(400), CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER CUVAL INTEGER TABS LOGICAL*1 CCHAR TIVAL = MAX0((RMVAL+TIVAL-WIDTH(BUF))/2, 0) RETURN END SUBROUTINE COMAND(BUF) LOGICAL*1 BUF(512), NAME(512), DEFN(200) INTEGER COMTYP, GETVAL, MAX0, GETWRD, OPEN, LENGTH INTEGER ARGTYP, CT, SPVAL, VAL, I, J COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(512), OHEAD(512), EHLIM(2), OHLIM(2), EFOOT(512), O *FOOT(512), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM LOGICAL*1 EHEAD LOGICAL*1 OHEAD INTEGER EHLIM INTEGER OHLIM LOGICAL*1 EFOOT LOGICAL*1 OFOOT INTEGER EFLIM INTEGER OFLIM INTEGER STOPX INTEGER FRSTPG INTEGER LASTPG INTEGER PRINT INTEGER OFFSET COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(400), CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER CUVAL INTEGER TABS LOGICAL*1 CCHAR COMMON /CFILES/ INFILE(3), LEVEL INTEGER INFILE INTEGER LEVEL COMMON /CNR/ NR(26) INTEGER NR CT = COMTYP(BUF, DEFN) IF (.NOT.(CT .EQ. 0))GOTO 23028 RETURN 23028 CONTINUE CALL DOESC(BUF, NAME, 512) I = 1 23030 IF (.NOT.(BUF(I) .NE. 32 .AND. BUF(I) .NE. 9 .AND. BUF(I) .NE. 10) *)GOTO 23031 I = I + 1 GOTO 23030 23031 CONTINUE VAL = GETVAL(BUF, I, ARGTYP) IF (.NOT.(CT .EQ. -1))GOTO 23032 CALL EVAL(BUF, DEFN) GOTO 23033 23032 CONTINUE IF (.NOT.(CT .EQ. 1))GOTO 23034 CALL BRK FILL = 1 GOTO 23035 23034 CONTINUE IF (.NOT.(CT .EQ. 2))GOTO 23036 CALL BRK FILL = 0 GOTO 23037 23036 CONTINUE IF (.NOT.(CT .EQ. 3))GOTO 23038 CALL BRK GOTO 23039 23038 CONTINUE IF (.NOT.(CT .EQ. 4))GOTO 23040 CALL SET(LSVAL, VAL, ARGTYP, 1, 1, 30000) GOTO 23041 23040 CONTINUE IF (.NOT.(CT .EQ. 10))GOTO 23042 CALL BRK CALL SET(CEVAL, VAL, ARGTYP, 1, 0, 30000) GOTO 23043 23042 CONTINUE IF (.NOT.(CT .EQ. 11))GOTO 23044 CUVAL = 0 CALL SET(ULVAL, VAL, ARGTYP, 0, 1, 30000) GOTO 23045 23044 CONTINUE IF (.NOT.(CT .EQ. 16))GOTO 23046 CALL SET(BOVAL, VAL, ARGTYP, 0, 1, 30000) GOTO 23047 23046 CONTINUE IF (.NOT.(CT .EQ. 12))GOTO 23048 CALL GETTL(BUF, EHEAD, EHLIM) CALL GETTL(BUF, OHEAD, OHLIM) GOTO 23049 23048 CONTINUE IF (.NOT.(CT .EQ. 13))GOTO 23050 CALL GETTL(BUF, EFOOT, EFLIM) CALL GETTL(BUF, OFOOT, OFLIM) GOTO 23051 23050 CONTINUE IF (.NOT.(CT .EQ. 5))GOTO 23052 CALL BRK IF (.NOT.(LINENO .GT. 0))GOTO 23054 CALL SPACE(30000) 23054 CONTINUE CALL SET(CURPAG, VAL, ARGTYP, CURPAG+1, -30000, 30000) NEWPAG = CURPAG GOTO 23053 23052 CONTINUE IF (.NOT.(CT .EQ. 6))GOTO 23056 CALL SET(SPVAL, VAL, ARGTYP, 1, 0, 30000) CALL SPACE(SPVAL) GOTO 23057 23056 CONTINUE IF (.NOT.(CT .EQ. 7))GOTO 23058 CALL BRK CALL SET(INVAL, VAL, ARGTYP, 0, 0, RMVAL-1) TIVAL = INVAL GOTO 23059 23058 CONTINUE IF (.NOT.(CT .EQ. 8))GOTO 23060 CALL SET(RMVAL, VAL, ARGTYP, 65, TIVAL+1, 30000) GOTO 23061 23060 CONTINUE IF (.NOT.(CT .EQ. 9))GOTO 23062 CALL BRK CALL SET(TIVAL, VAL, ARGTYP, 0, 0, RMVAL) GOTO 23063 23062 CONTINUE IF (.NOT.(CT .EQ. 14))GOTO 23064 CALL SET(PLVAL, VAL, ARGTYP, 62, M1VAL+M2VAL+M3VAL+M4VAL+1, 30000) BOTTOM = PLVAL - M3VAL - M4VAL GOTO 23065 23064 CONTINUE IF (.NOT.(CT .EQ. 15))GOTO 23066 CALL SET(OFFSET, VAL, ARGTYP, 0, 0, RMVAL-1) GOTO 23067 23066 CONTINUE IF (.NOT.(CT .EQ. 17))GOTO 23068 CALL SET(M1VAL, VAL, ARGTYP, 3, 0, PLVAL-M2VAL-M3VAL-M4VAL-1) GOTO 23069 23068 CONTINUE IF (.NOT.(CT .EQ. 18))GOTO 23070 CALL SET(M2VAL, VAL, ARGTYP, 2, 0, PLVAL-M1VAL-M3VAL-M4VAL-1) GOTO 23071 23070 CONTINUE IF (.NOT.(CT .EQ. 19))GOTO 23072 CALL SET(M3VAL, VAL, ARGTYP, 2, 0, PLVAL-M1VAL-M2VAL-M4VAL-1) BOTTOM = PLVAL - M3VAL - M4VAL GOTO 23073 23072 CONTINUE IF (.NOT.(CT .EQ. 20))GOTO 23074 CALL SET(M4VAL, VAL, ARGTYP, 3, 0, PLVAL-M1VAL-M2VAL-M3VAL-1) BOTTOM = PLVAL - M3VAL - M4VAL GOTO 23075 23074 CONTINUE IF (.NOT.(CT .EQ. 21))GOTO 23076 CALL GETTL(BUF, EHEAD, EHLIM) GOTO 23077 23076 CONTINUE IF (.NOT.(CT .EQ. 22))GOTO 23078 CALL GETTL(BUF, OHEAD, OHLIM) GOTO 23079 23078 CONTINUE IF (.NOT.(CT .EQ. 23))GOTO 23080 CALL GETTL(BUF, EFOOT, EFLIM) GOTO 23081 23080 CONTINUE IF (.NOT.(CT .EQ. 24))GOTO 23082 CALL GETTL(BUF, OFOOT, OFLIM) GOTO 23083 23082 CONTINUE IF (.NOT.(CT .EQ. 25))GOTO 23084 CCHAR = ARGTYP IF (.NOT.(CCHAR .EQ. 0 .OR. CCHAR .EQ. 10))GOTO 23086 CCHAR = 46 23086 CONTINUE IF (.NOT.((LINENO + VAL) .GT. BOTTOM .AND. LINENO .LE. BOTTOM))GOT *O 23088 CALL SPACE(VAL) LINENO = 0 23088 CONTINUE GOTO 23085 23084 CONTINUE IF (.NOT.(CT .EQ. 26))GOTO 23090 IF (.NOT.((LINENO + VAL) .GT. BOTTOM .AND. LINENO .LE. BOTTOM))GOT *O 23092 CALL SPACE(VAL) LINENO = 0 23092 CONTINUE GOTO 23091 23090 CONTINUE IF (.NOT.(CT .EQ. 27))GOTO 23094 CALL SET(BSVAL, VAL, ARGTYP, 1, 0, 30000) GOTO 23095 23094 CONTINUE IF (.NOT.(CT .EQ. 28))GOTO 23096 RJUST = 1 GOTO 23097 23096 CONTINUE IF (.NOT.(CT .EQ. 29))GOTO 23098 RJUST = 0 GOTO 23099 23098 CONTINUE IF (.NOT.(CT .EQ. 30))GOTO 23100 IF (.NOT.(GETWRD(BUF, I, NAME) .EQ. 0))GOTO 23102 RETURN 23102 CONTINUE IF (.NOT.(LEVEL + 1 .GT. 3))GOTO 23104 CALL ERROR(30Hso commands nested too deeply.) 23104 CONTINUE INFILE(LEVEL+1) = OPEN(NAME, 1) IF (.NOT.(INFILE(LEVEL+1) .NE. -3))GOTO 23106 LEVEL = LEVEL + 1 23106 CONTINUE GOTO 23101 23100 CONTINUE IF (.NOT.(CT .EQ. 31))GOTO 23108 ULVAL = 0 CALL SET(CUVAL, VAL, ARGTYP, 0, 1, 30000) GOTO 23109 23108 CONTINUE IF (.NOT.(CT .EQ. 32))GOTO 23110 CALL DODEF(BUF, INFILE(LEVEL)) GOTO 23111 23110 CONTINUE IF (.NOT.(CT .EQ. 34))GOTO 23112 IF (.NOT.(GETWRD(BUF, I, NAME) .EQ. 0))GOTO 23114 RETURN 23114 CONTINUE CALL FOLD(NAME) IF (.NOT.(NAME(1) .LT. 97 .OR. NAME(1) .GT. 122))GOTO 23116 CALL ERROR(29Hinvalid number register name.) 23116 CONTINUE VAL = GETVAL(BUF, I, ARGTYP) CALL SET(NR(NAME(1)-97+1), VAL, ARGTYP, 0, -30000, 30000) GOTO 23113 23112 CONTINUE IF (.NOT.(CT .EQ. 35))GOTO 23118 IF (.NOT.(ARGTYP .EQ. 45))GOTO 23120 SPVAL = PLVAL GOTO 23121 23120 CONTINUE SPVAL = 0 23121 CONTINUE CALL SET(SPVAL, VAL, ARGTYP, 0, 1, BOTTOM) IF (.NOT.(SPVAL .GT. LINENO .AND. LINENO .EQ. 0))GOTO 23122 CALL PHEAD 23122 CONTINUE IF (.NOT.(SPVAL .GT. LINENO))GOTO 23124 CALL SPACE(SPVAL - LINENO) 23124 CONTINUE 23118 CONTINUE 23113 CONTINUE 23111 CONTINUE 23109 CONTINUE 23101 CONTINUE 23099 CONTINUE 23097 CONTINUE 23095 CONTINUE 23091 CONTINUE 23085 CONTINUE 23083 CONTINUE 23081 CONTINUE 23079 CONTINUE 23077 CONTINUE 23075 CONTINUE 23073 CONTINUE 23071 CONTINUE 23069 CONTINUE 23067 CONTINUE 23065 CONTINUE 23063 CONTINUE 23061 CONTINUE 23059 CONTINUE 23057 CONTINUE 23053 CONTINUE 23051 CONTINUE 23049 CONTINUE 23047 CONTINUE 23045 CONTINUE 23043 CONTINUE 23041 CONTINUE 23039 CONTINUE 23037 CONTINUE 23035 CONTINUE 23033 CONTINUE RETURN END INTEGER FUNCTION COMTYP(BUF, DEFN) LOGICAL*1 BUF(512), DEFN(200) LOGICAL*1 NAME(40) INTEGER I INTEGER LUDEF, GETWRD COMMON /CMAC/ MACTBL INTEGER MACTBL I = 2 I = GETWRD(BUF, I, NAME) IF (.NOT.(I .GT. 2))GOTO 23126 NAME(3) = 0 23126 CONTINUE IF (.NOT.(LUDEF(NAME, DEFN, MACTBL) .EQ. 1))GOTO 23128 COMTYP = -1 GOTO 23129 23128 CONTINUE IF (.NOT.(BUF(2) .EQ. 102 .AND. BUF(3) .EQ. 105))GOTO 23130 COMTYP = 1 GOTO 23131 23130 CONTINUE IF (.NOT.(BUF(2) .EQ. 110 .AND. BUF(3) .EQ. 102))GOTO 23132 COMTYP = 2 GOTO 23133 23132 CONTINUE IF (.NOT.(BUF(2) .EQ. 98 .AND. BUF(3) .EQ. 114))GOTO 23134 COMTYP = 3 GOTO 23135 23134 CONTINUE IF (.NOT.(BUF(2) .EQ. 108 .AND. BUF(3) .EQ. 115))GOTO 23136 COMTYP = 4 GOTO 23137 23136 CONTINUE IF (.NOT.(BUF(2) .EQ. 98 .AND. BUF(3) .EQ. 112))GOTO 23138 COMTYP = 5 GOTO 23139 23138 CONTINUE IF (.NOT.(BUF(2) .EQ. 115 .AND. BUF(3) .EQ. 112))GOTO 23140 COMTYP = 6 GOTO 23141 23140 CONTINUE IF (.NOT.(BUF(2) .EQ. 105 .AND. BUF(3) .EQ. 110))GOTO 23142 COMTYP = 7 GOTO 23143 23142 CONTINUE IF (.NOT.(BUF(2) .EQ. 114 .AND. BUF(3) .EQ. 109))GOTO 23144 COMTYP = 8 GOTO 23145 23144 CONTINUE IF (.NOT.(BUF(2) .EQ. 116 .AND. BUF(3) .EQ. 105))GOTO 23146 COMTYP = 9 GOTO 23147 23146 CONTINUE IF (.NOT.(BUF(2) .EQ. 99 .AND. BUF(3) .EQ. 101))GOTO 23148 COMTYP = 10 GOTO 23149 23148 CONTINUE IF (.NOT.(BUF(2) .EQ. 117 .AND. BUF(3) .EQ. 108))GOTO 23150 COMTYP = 11 GOTO 23151 23150 CONTINUE IF (.NOT.(BUF(2) .EQ. 104 .AND. BUF(3) .EQ. 101))GOTO 23152 COMTYP = 12 GOTO 23153 23152 CONTINUE IF (.NOT.(BUF(2) .EQ. 102 .AND. BUF(3) .EQ. 111))GOTO 23154 COMTYP = 13 GOTO 23155 23154 CONTINUE IF (.NOT.(BUF(2) .EQ. 112 .AND. BUF(3) .EQ. 108))GOTO 23156 COMTYP = 14 GOTO 23157 23156 CONTINUE IF (.NOT.(BUF(2) .EQ. 112 .AND. BUF(3) .EQ. 111))GOTO 23158 COMTYP = 15 GOTO 23159 23158 CONTINUE IF (.NOT.(BUF(2) .EQ. 98 .AND. BUF(3) .EQ. 100))GOTO 23160 COMTYP = 16 GOTO 23161 23160 CONTINUE IF (.NOT.(BUF(2) .EQ. 109 .AND. BUF(3) .EQ. 49))GOTO 23162 COMTYP = 17 GOTO 23163 23162 CONTINUE IF (.NOT.(BUF(2) .EQ. 109 .AND. BUF(3) .EQ. 50))GOTO 23164 COMTYP = 18 GOTO 23165 23164 CONTINUE IF (.NOT.(BUF(2) .EQ. 109 .AND. BUF(3) .EQ. 51))GOTO 23166 COMTYP = 19 GOTO 23167 23166 CONTINUE IF (.NOT.(BUF(2) .EQ. 109 .AND. BUF(3) .EQ. 52))GOTO 23168 COMTYP = 20 GOTO 23169 23168 CONTINUE IF (.NOT.(BUF(2) .EQ. 101 .AND. BUF(3) .EQ. 104))GOTO 23170 COMTYP = 21 GOTO 23171 23170 CONTINUE IF (.NOT.(BUF(2) .EQ. 111 .AND. BUF(3) .EQ. 104))GOTO 23172 COMTYP = 22 GOTO 23173 23172 CONTINUE IF (.NOT.(BUF(2) .EQ. 101 .AND. BUF(3) .EQ. 102))GOTO 23174 COMTYP = 23 GOTO 23175 23174 CONTINUE IF (.NOT.(BUF(2) .EQ. 111 .AND. BUF(3) .EQ. 102))GOTO 23176 COMTYP = 24 GOTO 23177 23176 CONTINUE IF (.NOT.(BUF(2) .EQ. 99 .AND. BUF(3) .EQ. 99))GOTO 23178 COMTYP = 25 GOTO 23179 23178 CONTINUE IF (.NOT.(BUF(2) .EQ. 110 .AND. BUF(3) .EQ. 101))GOTO 23180 COMTYP = 26 GOTO 23181 23180 CONTINUE IF (.NOT.(BUF(2) .EQ. 98 .AND. BUF(3) .EQ. 115))GOTO 23182 COMTYP = 27 GOTO 23183 23182 CONTINUE IF (.NOT.(BUF(2) .EQ. 106 .AND. BUF(3) .EQ. 117))GOTO 23184 COMTYP = 28 GOTO 23185 23184 CONTINUE IF (.NOT.(BUF(2) .EQ. 110 .AND. BUF(3) .EQ. 106))GOTO 23186 COMTYP = 29 GOTO 23187 23186 CONTINUE IF (.NOT.(BUF(2) .EQ. 115 .AND. BUF(3) .EQ. 111))GOTO 23188 COMTYP = 30 GOTO 23189 23188 CONTINUE IF (.NOT.(BUF(2) .EQ. 100 .AND. BUF(3) .EQ. 101))GOTO 23190 COMTYP = 32 GOTO 23191 23190 CONTINUE IF (.NOT.(BUF(2) .EQ. 101 .AND. BUF(3) .EQ. 110))GOTO 23192 COMTYP = 33 GOTO 23193 23192 CONTINUE IF (.NOT.(BUF(2) .EQ. 110 .AND. BUF(3) .EQ. 114))GOTO 23194 COMTYP = 34 GOTO 23195 23194 CONTINUE IF (.NOT.(BUF(2) .EQ. 115 .AND. BUF(3) .EQ. 116))GOTO 23196 COMTYP = 35 GOTO 23197 23196 CONTINUE COMTYP = 0 23197 CONTINUE 23195 CONTINUE 23193 CONTINUE 23191 CONTINUE 23189 CONTINUE 23187 CONTINUE 23185 CONTINUE 23183 CONTINUE 23181 CONTINUE 23179 CONTINUE 23177 CONTINUE 23175 CONTINUE 23173 CONTINUE 23171 CONTINUE 23169 CONTINUE 23167 CONTINUE 23165 CONTINUE 23163 CONTINUE 23161 CONTINUE 23159 CONTINUE 23157 CONTINUE 23155 CONTINUE 23153 CONTINUE 23151 CONTINUE 23149 CONTINUE 23147 CONTINUE 23145 CONTINUE 23143 CONTINUE 23141 CONTINUE 23139 CONTINUE 23137 CONTINUE 23135 CONTINUE 23133 CONTINUE 23131 CONTINUE 23129 CONTINUE RETURN END SUBROUTINE DODEF(BUF, FD) LOGICAL*1 BUF(512) INTEGER FD LOGICAL*1 NAME(40), DEFN(200) INTEGER I, JUNK INTEGER GETWRD, ADDSTR, ADDSET, NGETLN COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(400), CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER CUVAL INTEGER TABS LOGICAL*1 CCHAR COMMON /CMAC/ MACTBL INTEGER MACTBL I = 1 JUNK = GETWRD(BUF, I, NAME) I = GETWRD(BUF, I, NAME) IF (.NOT.(I .EQ. 0))GOTO 23198 CALL ERROR(35Hmissing name in command definition.) 23198 CONTINUE IF (.NOT.(I .GT. 2))GOTO 23200 NAME(3) = 0 23200 CONTINUE I = 1 23202 IF (.NOT.(NGETLN(BUF, FD) .NE. -1))GOTO 23203 IF (.NOT.(BUF(1) .EQ. CCHAR .AND. BUF(2) .EQ. 101 .AND. BUF(3) .EQ *. 110))GOTO 23204 GOTO 23203 23204 CONTINUE JUNK = ADDSTR(BUF, DEFN, I, 200) GOTO 23202 23203 CONTINUE IF (.NOT.(ADDSET(0, DEFN, I, 200) .EQ. 0))GOTO 23206 CALL ERROR(20Hdefinition too long.) 23206 CONTINUE CALL ENTDEF(NAME, DEFN, MACTBL) RETURN END SUBROUTINE DOESC(BUF, TBUF, SIZE) LOGICAL*1 BUF(100), TBUF(100) INTEGER SIZE INTEGER I, J INTEGER ITOC COMMON /CNR/ NR(26) INTEGER NR J = 1 I = 1 23208 IF (.NOT.(BUF(I) .NE. 0 .AND. J .LT. SIZE))GOTO 23210 IF (.NOT.(BUF(I) .NE. 64))GOTO 23211 TBUF(J) = BUF(I) J = J + 1 GOTO 23212 23211 CONTINUE IF (.NOT.(BUF(I+1) .EQ. 64))GOTO 23213 TBUF(J) = 64 J = J + 1 I = I + 1 GOTO 23214 23213 CONTINUE IF (.NOT.(BUF(I+1) .EQ. 110 .AND. (BUF(I+2) .GE. 97 .AND. BUF(I+2) * .LE. 122)))GOTO 23215 J = J + ITOC(NR(BUF(I+2)-97+1), TBUF(J), SIZE - J - 1) I = I + 2 GOTO 23216 23215 CONTINUE TBUF(J) = BUF(I) J = J + 1 23216 CONTINUE 23214 CONTINUE 23212 CONTINUE 23209 I = I + 1 GOTO 23208 23210 CONTINUE TBUF(J) = 0 CALL SCOPY(TBUF, 1, BUF, 1) RETURN END SUBROUTINE DOROFF(FD) INTEGER FD LOGICAL*1 INBUF(400) INTEGER NGETLN COMMON /CFILES/ INFILE(3), LEVEL INTEGER INFILE INTEGER LEVEL COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(400), CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER CUVAL INTEGER TABS LOGICAL*1 CCHAR INFILE(1) = FD LEVEL = 1 23217 IF (.NOT.(LEVEL .GT. 0))GOTO 23219 23220 IF (.NOT.(NGETLN(INBUF, INFILE(LEVEL)) .NE. -1))GOTO 23221 IF (.NOT.(INBUF(1) .EQ. CCHAR))GOTO 23222 CALL COMAND(INBUF) GOTO 23223 23222 CONTINUE CALL TEXT(INBUF) 23223 CONTINUE GOTO 23220 23221 CONTINUE IF (.NOT.(LEVEL .GT. 1 .AND. INFILE(LEVEL) .GE. 0))GOTO 23224 CALL CLOSE(INFILE(LEVEL)) 23224 CONTINUE 23218 LEVEL = LEVEL - 1 GOTO 23217 23219 CONTINUE RETURN END SUBROUTINE DOTABS(BUF, TBUF, SIZE) LOGICAL*1 BUF(100), TBUF(100) INTEGER SIZE INTEGER I, J COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(400), CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER CUVAL INTEGER TABS LOGICAL*1 CCHAR J = 1 I = 1 23226 IF (.NOT.(BUF(I) .NE. 0 .AND. J .LT. SIZE))GOTO 23228 IF (.NOT.(BUF(I) .EQ. 9))GOTO 23229 23231 IF (.NOT.(J .LT. SIZE))GOTO 23232 TBUF(J) = 32 J = J + 1 IF (.NOT.(TABS(J) .EQ. 1 .OR. J .GT. 400))GOTO 23233 GOTO 23232 23233 CONTINUE GOTO 23231 23232 CONTINUE GOTO 23230 23229 CONTINUE TBUF(J) = BUF(I) J = J + 1 23230 CONTINUE 23227 I = I + 1 GOTO 23226 23228 CONTINUE TBUF(J) = 0 CALL SCOPY(TBUF, 1, BUF, 1) RETURN END SUBROUTINE EVAL(BUF, DEFN) LOGICAL*1 BUF(512), DEFN(200) INTEGER I, J, K, ARGPTR(10) INTEGER LENGTH J = 1 23235 IF (.NOT.(J .LE. 10))GOTO 23237 ARGPTR(J) = 1 23236 J = J + 1 GOTO 23235 23237 CONTINUE BUF(1) = 0 I = 2 J = 1 23238 IF (.NOT.(J .LE. 10))GOTO 23240 CALL SKIPBL(BUF, I) IF (.NOT.(BUF(I) .EQ. 10 .OR. BUF(I) .EQ. 0))GOTO 23241 GOTO 23240 23241 CONTINUE ARGPTR(J) = I 23243 IF (.NOT.(BUF(I) .NE. 32 .AND. BUF(I) .NE. 9 .AND. BUF(I) .NE. 10 *.AND. BUF(I) .NE. 0))GOTO 23244 I = I + 1 GOTO 23243 23244 CONTINUE BUF(I) = 0 I = I + 1 23239 J = J + 1 GOTO 23238 23240 CONTINUE K = LENGTH(DEFN) 23245 IF (.NOT.(K .GT. 1))GOTO 23247 IF (.NOT.(DEFN(K-1) .NE. 36))GOTO 23248 CALL PUTBAK(DEFN(K)) GOTO 23249 23248 CONTINUE IF (.NOT.(DEFN(K) .LT. 48 .OR. DEFN(K) .GT. 57))GOTO 23250 CALL PUTBAK(DEFN(K)) GOTO 23251 23250 CONTINUE I = DEFN(K) - 48 + 1 I = ARGPTR(I) CALL PBSTR(BUF(I)) K = K - 1 23251 CONTINUE 23249 CONTINUE 23246 K = K - 1 GOTO 23245 23247 CONTINUE IF (.NOT.(K .GT. 0))GOTO 23252 CALL PUTBAK(DEFN(K)) 23252 CONTINUE RETURN END SUBROUTINE FINIT INTEGER I INTEGER MOD INTEGER MKTABL COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(400), CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER CUVAL INTEGER TABS LOGICAL*1 CCHAR COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(512), OHEAD(512), EHLIM(2), OHLIM(2), EFOOT(512), O *FOOT(512), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM LOGICAL*1 EHEAD LOGICAL*1 OHEAD INTEGER EHLIM INTEGER OHLIM LOGICAL*1 EFOOT LOGICAL*1 OFOOT INTEGER EFLIM INTEGER OFLIM INTEGER STOPX INTEGER FRSTPG INTEGER LASTPG INTEGER PRINT INTEGER OFFSET COMMON /COUT/ OUTP, OUTW, OUTWDS, OUTBUF(400) INTEGER OUTP INTEGER OUTW INTEGER OUTWDS LOGICAL*1 OUTBUF COMMON /CDEFIO/ BP, BUF(400) INTEGER BP LOGICAL*1 BUF COMMON /CNR/ NR(26) INTEGER NR COMMON /CMAC/ MACTBL INTEGER MACTBL INTEGER MEM( 5000) LOGICAL*1 CMEM(10000) EQUIVALENCE (CMEM(1),MEM(1)) COMMON/CDSMEM/MEM INVAL = 0 RMVAL = 65 TIVAL = 0 LSVAL = 1 FILL = 1 CEVAL = 0 ULVAL = 0 BOVAL = 0 CCHAR = 46 TJUST(1) = 1 TJUST(2) = 2 TJUST(3) = 3 BSVAL = 0 RJUST = 1 CUVAL = 0 I = 1 23254 IF (.NOT.(I .LE. 400))GOTO 23256 IF (.NOT.(MOD(I, 8) .EQ. 1))GOTO 23257 TABS(I) = 1 GOTO 23258 23257 CONTINUE TABS(I) = 0 23258 CONTINUE 23255 I = I + 1 GOTO 23254 23256 CONTINUE LINENO = 0 CURPAG = 0 NEWPAG = 1 PLVAL = 62 M1VAL = 3 M2VAL = 2 M3VAL = 2 M4VAL = 3 BOTTOM = PLVAL - M3VAL - M4VAL EHEAD(1) = 10 EHEAD(2) = 0 OHEAD(1) = 10 OHEAD(2) = 0 EFOOT(1) = 10 EFOOT(2) = 0 OFOOT(1) = 10 OFOOT(2) = 0 EHLIM(1) = INVAL EHLIM(2) = RMVAL OHLIM(1) = INVAL OHLIM(2) = RMVAL EFLIM(1) = INVAL EFLIM(2) = RMVAL OFLIM(1) = INVAL OFLIM(2) = RMVAL STOPX = 0 FRSTPG = 0 LASTPG = 30000 PRINT = 1 OFFSET = 0 OUTP = 0 OUTW = 0 OUTWDS = 0 CALL DSINIT (5000) MACTBL = MKTABL (1) BP = 0 I = 1 23259 IF (.NOT.(I .LE. 26))GOTO 23261 NR(I) = 0 23260 I = I + 1 GOTO 23259 23261 CONTINUE RETURN END SUBROUTINE GETTL(BUF, TTL, LIM) LOGICAL*1 BUF(512), TTL(512) INTEGER I, LIM(2) COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(400), CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER CUVAL INTEGER TABS LOGICAL*1 CCHAR I = 1 23262 IF (.NOT.(BUF(I) .NE. 32 .AND. BUF(I) .NE. 9 .AND. BUF(I) .NE. 10) *)GOTO 23263 I = I + 1 GOTO 23262 23263 CONTINUE CALL SKIPBL(BUF, I) CALL SCOPY(BUF, I, TTL, 1) LIM(1) = INVAL LIM(2) = RMVAL RETURN END INTEGER FUNCTION GETVAL(BUF, I, ARGTYP) LOGICAL*1 BUF(512) INTEGER I, ARGTYP INTEGER CTOI CALL SKIPBL(BUF, I) ARGTYP = BUF(I) IF (.NOT.(ARGTYP .EQ. 43 .OR. ARGTYP .EQ. 45))GOTO 23264 I = I + 1 23264 CONTINUE GETVAL = CTOI(BUF, I) RETURN END INTEGER FUNCTION GETWRB(IN, I, OUT) LOGICAL*1 IN(100), OUT(100) INTEGER I, J J = 1 23266 IF (.NOT.(IN(I) .NE. 0 .AND. IN(I) .NE. 32 .AND. IN(I) .NE. 9 .AND *. IN(I) .NE. 10))GOTO 23267 OUT(J) = IN(I) I = I + 1 J = J + 1 GOTO 23266 23267 CONTINUE 23268 IF (.NOT.(IN(I) .EQ. 32))GOTO 23269 OUT(J) = 32 I = I + 1 J = J + 1 GOTO 23268 23269 CONTINUE OUT(J) = 0 GETWRB = J - 1 RETURN END INTEGER FUNCTION GFIELD(BUF, I, N, TEMP, DELIM) LOGICAL*1 BUF(100), TEMP(100), DELIM INTEGER I, J, N J = 1 IF (.NOT.(N .GT. 0))GOTO 23270 IF (.NOT.(BUF(I) .EQ. DELIM))GOTO 23272 I = I + 1 23272 CONTINUE 23274 IF (.NOT.(BUF(I) .NE. DELIM .AND. BUF(I) .NE. 0 .AND. BUF(I) .NE. *10 .AND. J .LE. N))GOTO 23275 TEMP(J) = BUF(I) J = J + 1 I = I + 1 GOTO 23274 23275 CONTINUE 23270 CONTINUE TEMP(J) = 0 GFIELD = J - 1 23276 IF (.NOT.(BUF(I) .NE. DELIM .AND. BUF(I) .NE. 0 .AND. BUF(I) .NE. *10))GOTO 23277 I = I + 1 GOTO 23276 23277 CONTINUE RETURN END SUBROUTINE JCOPY(FROM, I, TO, J) LOGICAL*1 FROM(100), TO(100) INTEGER I, J, K1, K2 K1 = I K2 = J 23278 IF (.NOT.(FROM(K1) .NE. 0))GOTO 23279 TO(K2) = FROM(K1) K1 = K1 + 1 K2 = K2 + 1 GOTO 23278 23279 CONTINUE RETURN END SUBROUTINE JUSTFY(IN, LEFT, RIGHT, TYPE, OUT) LOGICAL*1 IN(100), OUT(100) INTEGER LEFT, RIGHT, TYPE, MAX0, J, N, WIDTH N = WIDTH(IN) IF (.NOT.(TYPE .EQ. 3))GOTO 23280 CALL JCOPY(IN, 1, OUT, RIGHT-N) GOTO 23281 23280 CONTINUE IF (.NOT.(TYPE .EQ. 2))GOTO 23282 J = MAX0((RIGHT+LEFT-N)/2, LEFT) CALL JCOPY(IN, 1, OUT, J) GOTO 23283 23282 CONTINUE CALL JCOPY(IN, 1, OUT, LEFT) 23283 CONTINUE 23281 CONTINUE RETURN END SUBROUTINE LEADBL(BUF) LOGICAL*1 BUF(512) INTEGER MAX0 INTEGER I, J COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(400), CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER CUVAL INTEGER TABS LOGICAL*1 CCHAR CALL BRK I = 1 23284 IF (.NOT.(BUF(I) .EQ. 32))GOTO 23286 23285 I = I + 1 GOTO 23284 23286 CONTINUE IF (.NOT.(BUF(I) .NE. 10))GOTO 23287 TIVAL = TIVAL + I - 1 23287 CONTINUE J = 1 23289 IF (.NOT.(BUF(I) .NE. 0))GOTO 23291 BUF(J) = BUF(I) I = I + 1 23290 J = J + 1 GOTO 23289 23291 CONTINUE BUF(J) = 0 RETURN END LOGICAL*1 FUNCTION NGETCH(C, FD) LOGICAL*1 C INTEGER FD LOGICAL*1 GETCH COMMON /CDEFIO/ BP, BUF(400) INTEGER BP LOGICAL*1 BUF IF (.NOT.(BP .GT. 0))GOTO 23292 C = BUF(BP) BP = BP - 1 GOTO 23293 23292 CONTINUE C = GETCH(C, FD) 23293 CONTINUE NGETCH = C RETURN END INTEGER FUNCTION NGETLN(LINE, F) LOGICAL*1 LINE(512), C, NGETCH INTEGER F NGETLN = 0 23294 IF (.NOT.(NGETCH(C, F) .NE. -1))GOTO 23296 IF (.NOT.(NGETLN .LT. 512 - 1))GOTO 23297 NGETLN = NGETLN + 1 LINE(NGETLN) = C 23297 CONTINUE IF (.NOT.(C .EQ. 10))GOTO 23299 GOTO 23296 23299 CONTINUE 23295 GOTO 23294 23296 CONTINUE LINE(NGETLN+1) = 0 IF (.NOT.(NGETLN .EQ. 0 .AND. C .EQ. -1))GOTO 23301 NGETLN = -1 23301 CONTINUE RETURN END SUBROUTINE PBSTR(IN) LOGICAL*1 IN(512) INTEGER LENGTH INTEGER I I = LENGTH(IN) 23303 IF (.NOT.(I .GT. 0))GOTO 23305 CALL PUTBAK(IN(I)) 23304 I = I - 1 GOTO 23303 23305 CONTINUE RETURN END SUBROUTINE PFOOT INTEGER MOD COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(512), OHEAD(512), EHLIM(2), OHLIM(2), EFOOT(512), O *FOOT(512), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM LOGICAL*1 EHEAD LOGICAL*1 OHEAD INTEGER EHLIM INTEGER OHLIM LOGICAL*1 EFOOT LOGICAL*1 OFOOT INTEGER EFLIM INTEGER OFLIM INTEGER STOPX INTEGER FRSTPG INTEGER LASTPG INTEGER PRINT INTEGER OFFSET CALL SKIP(M3VAL) IF (.NOT.(M4VAL .GT. 0))GOTO 23306 IF (.NOT.(MOD(CURPAG, 2) .EQ. 1))GOTO 23308 CALL PUTTL(EFOOT, EFLIM, CURPAG) GOTO 23309 23308 CONTINUE CALL PUTTL(OFOOT, OFLIM, CURPAG) 23309 CONTINUE 23306 CONTINUE RETURN END SUBROUTINE PHEAD COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(512), OHEAD(512), EHLIM(2), OHLIM(2), EFOOT(512), O *FOOT(512), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM LOGICAL*1 EHEAD LOGICAL*1 OHEAD INTEGER EHLIM INTEGER OHLIM LOGICAL*1 EFOOT LOGICAL*1 OFOOT INTEGER EFLIM INTEGER OFLIM INTEGER STOPX INTEGER FRSTPG INTEGER LASTPG INTEGER PRINT INTEGER OFFSET INTEGER C(512) INTEGER MOD CURPAG = NEWPAG IF (.NOT.(CURPAG .GE. FRSTPG .AND. CURPAG .LE. LASTPG))GOTO 23310 PRINT = 1 GOTO 23311 23310 CONTINUE PRINT = 0 23311 CONTINUE IF (.NOT.(STOPX .GT. 0 .AND. PRINT .EQ. 1))GOTO 23312 CALL PRMPT(STOPX) 23312 CONTINUE NEWPAG = NEWPAG + 1 IF (.NOT.(STOPX .EQ. 0 .AND. PRINT .EQ. 1))GOTO 23314 CALL PUTCH(12,2) 23314 CONTINUE IF (.NOT.(M1VAL .GT. 0))GOTO 23316 CALL SKIP(M1VAL-1) IF (.NOT.(MOD(CURPAG, 2) .EQ. 0))GOTO 23318 CALL PUTTL(EHEAD, EHLIM, CURPAG) GOTO 23319 23318 CONTINUE CALL PUTTL(OHEAD, OHLIM, CURPAG) 23319 CONTINUE 23316 CONTINUE CALL SKIP(M2VAL) LINENO = M1VAL + M2VAL + 1 RETURN END SUBROUTINE PRMPT(I) INTEGER I INTEGER OPEN, GETLIN, PROMPT INTEGER TIN, TOUT, JUNK LOGICAL*1 LINE(512) LOGICAL*1 TELL(28) LOGICAL*1 TRMIN(4) DATA TELL(1)/84/,TELL(2)/121/,TELL(3)/112/,TELL(4)/101/,TELL(5)/32 */,TELL(6)/114/,TELL(7)/101/,TELL(8)/116/,TELL(9)/117/,TELL(10)/114 */,TELL(11)/110/,TELL(12)/32/,TELL(13)/116/,TELL(14)/111/,TELL(15)/ *32/,TELL(16)/98/,TELL(17)/101/,TELL(18)/103/,TELL(19)/105/,TELL(20 *)/110/,TELL(21)/32/,TELL(22)/97/,TELL(23)/32/,TELL(24)/112/,TELL(2 *5)/97/,TELL(26)/103/,TELL(27)/101/,TELL(28)/0/ DATA TRMIN(1)/84/,TRMIN(2)/73/,TRMIN(3)/58/,TRMIN(4)/0/ TIN = OPEN(TRMIN, 1) IF (.NOT.(TIN .EQ. -3))GOTO 23320 RETURN 23320 CONTINUE IF (.NOT.(I .EQ. 1))GOTO 23322 JUNK = PROMPT(TELL, LINE, TIN) GOTO 23323 23322 CONTINUE JUNK = GETLIN(LINE, TIN) 23323 CONTINUE CALL CLOSE(TIN) I = I + 1 RETURN END SUBROUTINE PUT(BUF) LOGICAL*1 BUF(512) INTEGER MIN0, WIDTH INTEGER I, J, K, W, C, CUFLG COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(512), OHEAD(512), EHLIM(2), OHLIM(2), EFOOT(512), O *FOOT(512), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM LOGICAL*1 EHEAD LOGICAL*1 OHEAD INTEGER EHLIM INTEGER OHLIM LOGICAL*1 EFOOT LOGICAL*1 OFOOT INTEGER EFLIM INTEGER OFLIM INTEGER STOPX INTEGER FRSTPG INTEGER LASTPG INTEGER PRINT INTEGER OFFSET COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(400), CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER CUVAL INTEGER TABS LOGICAL*1 CCHAR DATA CUFLG /0/ IF (.NOT.(LINENO .EQ. 0 .OR. LINENO .GT. BOTTOM))GOTO 23324 CALL PHEAD 23324 CONTINUE IF (.NOT.(PRINT .EQ. 1))GOTO 23326 I = 1 23328 IF (.NOT.(I .LE. OFFSET))GOTO 23330 CALL PUTCH(32,2) 23329 I = I + 1 GOTO 23328 23330 CONTINUE I = 1 23331 IF (.NOT.(I .LE. TIVAL))GOTO 23333 CALL PUTCH(32,2) 23332 I = I + 1 GOTO 23331 23333 CONTINUE I = 1 23334 IF (.NOT.(BUF(I) .NE. 0 .AND. BUF(I) .NE. 10))GOTO 23336 IF (.NOT.(BUF(I) .EQ. -10))GOTO 23337 CUFLG = 1 GOTO 23338 23337 CONTINUE IF (.NOT.(BUF(I) .EQ. -11))GOTO 23339 CUFLG = 0 GOTO 23340 23339 CONTINUE IF (.NOT.(CUFLG .EQ. 1))GOTO 23341 J = I 23343 IF (.NOT.(BUF(I) .NE. -11 .AND. BUF(I) .NE. 10 .AND. BUF(I) .NE. 0 *))GOTO 23345 23344 I = I + 1 GOTO 23343 23345 CONTINUE C = BUF(I) BUF(I) = 0 W = WIDTH(BUF(J)) K = 1 23346 IF (.NOT.(K .LE. W))GOTO 23348 CALL PUTCH(95, 2) 23347 K = K + 1 GOTO 23346 23348 CONTINUE K = 1 23349 IF (.NOT.(K .LE. W))GOTO 23351 CALL PUTCH(8, 2) 23350 K = K + 1 GOTO 23349 23351 CONTINUE 23352 IF (.NOT.(J .LT. I))GOTO 23354 CALL PUTCH(BUF(J), 2) 23353 J = J + 1 GOTO 23352 23354 CONTINUE BUF(I) = C I = I - 1 GOTO 23342 23341 CONTINUE CALL PUTCH(BUF(I), 2) 23342 CONTINUE 23340 CONTINUE 23338 CONTINUE 23335 I = I + 1 GOTO 23334 23336 CONTINUE CALL PUTCH(10, 2) 23326 CONTINUE TIVAL = INVAL CALL SKIP(MIN0(LSVAL-1, BOTTOM-LINENO)) LINENO = LINENO + LSVAL IF (.NOT.(LINENO .GT. BOTTOM))GOTO 23355 CALL PFOOT 23355 CONTINUE RETURN END SUBROUTINE PUTBAK(C) LOGICAL*1 C COMMON /CDEFIO/ BP, BUF(400) INTEGER BP LOGICAL*1 BUF BP = BP + 1 IF (.NOT.(BP .GT. 400))GOTO 23357 CALL ERROR(32Htoo many characters pushed back.) 23357 CONTINUE BUF(BP) = C RETURN END SUBROUTINE PUTTL(BUF, LIM, PAGENO) LOGICAL*1 BUF(512), CHARS(20), DELIM, CDATE(20) INTEGER PAGENO, LIM(2) INTEGER NC, ITOC, I, J, N, LEFT, RIGHT, GFIELD, NCD, NOW (7) INTEGER LENGTH COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(512), OHEAD(512), EHLIM(2), OHLIM(2), EFOOT(512), O *FOOT(512), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM LOGICAL*1 EHEAD LOGICAL*1 OHEAD INTEGER EHLIM INTEGER OHLIM LOGICAL*1 EFOOT LOGICAL*1 OFOOT INTEGER EFLIM INTEGER OFLIM INTEGER STOPX INTEGER FRSTPG INTEGER LASTPG INTEGER PRINT INTEGER OFFSET COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(400), CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER CUVAL INTEGER TABS LOGICAL*1 CCHAR COMMON /CTEMP/ TBUF1(512), TBUF2(512), TTL(512) LOGICAL*1 TBUF1 LOGICAL*1 TBUF2 LOGICAL*1 TTL IF (.NOT.(PRINT .EQ. 0))GOTO 23359 RETURN 23359 CONTINUE LEFT = LIM(1) + 1 RIGHT = LIM(2) + 1 NC = ITOC(PAGENO, CHARS, 20) CALL GETNOW (NOW) CALL FMTDAT (CDATE, TBUF1, NOW, 0) NCD = LENGTH(CDATE) I = 1 DELIM = BUF(I) J = 1 23361 IF (.NOT.(J .LT. RIGHT))GOTO 23363 TTL(J) = 32 23362 J = J + 1 GOTO 23361 23363 CONTINUE N = 0 23364 CONTINUE N = N + 1 IF (.NOT.(GFIELD(BUF, I, RIGHT-LEFT, TBUF1, DELIM) .GT. 0))GOTO 23 *367 CALL SUBST(TBUF1, 35, TBUF2, CHARS, NC) CALL SUBST(TBUF2, 37, TBUF1, CDATE, NCD) CALL JUSTFY(TBUF1, LEFT, RIGHT, TJUST(N), TTL) 23367 CONTINUE 23365 IF (.NOT.(BUF(I) .EQ. 0 .OR. BUF(I) .EQ. 10 .OR. N .EQ. 3))GOTO 23 *364 23366 CONTINUE 23369 IF (.NOT.(TTL(RIGHT-1) .EQ. 32))GOTO 23370 RIGHT = RIGHT - 1 GOTO 23369 23370 CONTINUE TTL(RIGHT) = 10 TTL(RIGHT+1) = 0 I = 1 23371 IF (.NOT.(I .LE. OFFSET))GOTO 23373 CALL PUTCH(32,2) 23372 I = I + 1 GOTO 23371 23373 CONTINUE CALL PUTLIN(TTL, 2) RETURN END SUBROUTINE PUTWRD(WRDBUF) LOGICAL*1 WRDBUF(400) INTEGER LENGTH, WIDTH INTEGER LAST, LLVAL, NEXTRA, W COMMON /COUT/ OUTP, OUTW, OUTWDS, OUTBUF(400) INTEGER OUTP INTEGER OUTW INTEGER OUTWDS LOGICAL*1 OUTBUF COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(400), CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER CUVAL INTEGER TABS LOGICAL*1 CCHAR W = WIDTH(WRDBUF) LAST = LENGTH(WRDBUF) + OUTP LLVAL = RMVAL - TIVAL IF (.NOT.(OUTW + W .GT. LLVAL .OR. LAST .GE. 400))GOTO 23374 LAST = LAST - OUTP NEXTRA = LLVAL - OUTW OUTP = OUTP + 1 23376 IF (.NOT.(OUTP .GT. 1))GOTO 23378 IF (.NOT.(OUTBUF(OUTP-1) .EQ. 32))GOTO 23379 NEXTRA = NEXTRA + 1 GOTO 23380 23379 CONTINUE GOTO 23378 23380 CONTINUE 23377 OUTP = OUTP - 1 GOTO 23376 23378 CONTINUE IF (.NOT.(RJUST .EQ. 1))GOTO 23381 CALL SPREAD(OUTBUF, OUTP, NEXTRA, OUTWDS) IF (.NOT.(NEXTRA .GT. 0 .AND. OUTWDS .GT. 1))GOTO 23383 OUTP = OUTP + NEXTRA 23383 CONTINUE 23381 CONTINUE CALL BRK 23374 CONTINUE CALL SCOPY(WRDBUF, 1, OUTBUF, OUTP+1) OUTP = LAST OUTW = OUTW + W OUTWDS = OUTWDS + 1 RETURN END SUBROUTINE SET(PARAM, VAL, ARGTYP, DEFVAL, MINVAL, MAXVAL) INTEGER MAX0, MIN0 INTEGER ARGTYP, DEFVAL, MAXVAL, MINVAL, PARAM, VAL IF (.NOT.(ARGTYP .EQ. 10))GOTO 23385 PARAM = DEFVAL GOTO 23386 23385 CONTINUE IF (.NOT.(ARGTYP .EQ. 43))GOTO 23387 PARAM = PARAM + VAL GOTO 23388 23387 CONTINUE IF (.NOT.(ARGTYP .EQ. 45))GOTO 23389 PARAM = PARAM - VAL GOTO 23390 23389 CONTINUE PARAM = VAL 23390 CONTINUE 23388 CONTINUE 23386 CONTINUE PARAM = MIN0(PARAM, MAXVAL) PARAM = MAX0(PARAM, MINVAL) RETURN END SUBROUTINE SKIP(N) INTEGER I, N COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(512), OHEAD(512), EHLIM(2), OHLIM(2), EFOOT(512), O *FOOT(512), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM LOGICAL*1 EHEAD LOGICAL*1 OHEAD INTEGER EHLIM INTEGER OHLIM LOGICAL*1 EFOOT LOGICAL*1 OFOOT INTEGER EFLIM INTEGER OFLIM INTEGER STOPX INTEGER FRSTPG INTEGER LASTPG INTEGER PRINT INTEGER OFFSET IF (.NOT.(PRINT .EQ. 1))GOTO 23391 I = 1 23393 IF (.NOT.(I .LE. N))GOTO 23395 CALL PUTCH(10,2) 23394 I = I + 1 GOTO 23393 23395 CONTINUE 23391 CONTINUE RETURN END SUBROUTINE SPACE(N) INTEGER MIN0 INTEGER N COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(512), OHEAD(512), EHLIM(2), OHLIM(2), EFOOT(512), O *FOOT(512), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM LOGICAL*1 EHEAD LOGICAL*1 OHEAD INTEGER EHLIM INTEGER OHLIM LOGICAL*1 EFOOT LOGICAL*1 OFOOT INTEGER EFLIM INTEGER OFLIM INTEGER STOPX INTEGER FRSTPG INTEGER LASTPG INTEGER PRINT INTEGER OFFSET CALL BRK IF (.NOT.(LINENO .GT. BOTTOM))GOTO 23396 RETURN 23396 CONTINUE IF (.NOT.(LINENO .EQ. 0))GOTO 23398 CALL PHEAD 23398 CONTINUE CALL SKIP(MIN0(N, BOTTOM+1-LINENO)) LINENO = LINENO + N IF (.NOT.(LINENO .GT. BOTTOM))GOTO 23400 CALL PFOOT 23400 CONTINUE RETURN END SUBROUTINE SPREAD(BUF, OUTP, NEXTRA, OUTWDS) LOGICAL*1 BUF(400) COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(400), CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER CUVAL INTEGER TABS LOGICAL*1 CCHAR INTEGER MIN0 INTEGER DIR, I, J, NB, NE, NEXTRA, NHOLES, OUTP, OUTWDS DATA DIR /0/ IF (.NOT.(NEXTRA .LE. 0 .OR. OUTWDS .LE. 1))GOTO 23402 RETURN 23402 CONTINUE DIR = 1 - DIR NE = NEXTRA NHOLES = OUTWDS - 1 IF (.NOT.(TIVAL .NE. INVAL .AND. NHOLES .GT. 1))GOTO 23404 NHOLES = NHOLES - 1 23404 CONTINUE I = OUTP - 1 J = MIN0(400-2, I+NE) 23406 IF (.NOT.(I .LT. J))GOTO 23407 BUF(J) = BUF(I) IF (.NOT.(BUF(I) .EQ. 32 .AND. BUF(I-1) .NE. 32))GOTO 23408 IF (.NOT.(DIR .EQ. 0))GOTO 23410 NB = (NE-1) / NHOLES + 1 GOTO 23411 23410 CONTINUE NB = NE / NHOLES 23411 CONTINUE NE = NE - NB NHOLES = NHOLES - 1 23412 IF (.NOT.(NB .GT. 0))GOTO 23414 J = J - 1 BUF(J) = 32 23413 NB = NB - 1 GOTO 23412 23414 CONTINUE 23408 CONTINUE I = I - 1 J = J - 1 GOTO 23406 23407 CONTINUE RETURN END SUBROUTINE SUBST(IN, CHAR, OUT, SUBARA, N) LOGICAL*1 IN(100), CHAR, OUT(100), SUBARA(100) INTEGER I, J, K, N J = 1 I = 1 23415 IF (.NOT.(IN(I) .NE. 0))GOTO 23417 IF (.NOT.(IN(I) .EQ. CHAR))GOTO 23418 K = 1 23420 IF (.NOT.(K .LE. N))GOTO 23422 OUT(J) = SUBARA(K) J = J + 1 23421 K = K + 1 GOTO 23420 23422 CONTINUE GOTO 23419 23418 CONTINUE OUT(J) = IN(I) J = J + 1 23419 CONTINUE 23416 I = I + 1 GOTO 23415 23417 CONTINUE OUT(J) = 0 RETURN END SUBROUTINE TEXT(INBUF) LOGICAL*1 INBUF(400), WRDBUF(400) INTEGER GETWRB, LENGTH INTEGER I, CUFLG COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(400), CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER CUVAL INTEGER TABS LOGICAL*1 CCHAR DATA CUFLG /0/ CALL DOESC(INBUF, WRDBUF, 400) CALL DOTABS(INBUF, WRDBUF, 400) IF (.NOT.(INBUF(1) .EQ. 32 .OR. INBUF(1) .EQ. 10))GOTO 23423 CALL LEADBL(INBUF) 23423 CONTINUE IF (.NOT.(ULVAL .GT. 0))GOTO 23425 CALL UNDERL(INBUF, WRDBUF, 400) ULVAL = ULVAL - 1 23425 CONTINUE IF (.NOT.(CUVAL .GT. 0))GOTO 23427 IF (.NOT.(CUFLG .EQ. 0))GOTO 23429 CALL SCOPY(INBUF, 1, WRDBUF, 1) INBUF(1) = -10 CALL SCOPY(WRDBUF, 1, INBUF, 2) CUFLG = 1 23429 CONTINUE CUVAL = CUVAL - 1 IF (.NOT.(CUFLG .EQ. 1 .AND. CUVAL .EQ. 0))GOTO 23431 I = LENGTH(INBUF) INBUF(I) = -11 INBUF(I+1) = 10 INBUF(I+2) = 0 CUFLG = 0 23431 CONTINUE 23427 CONTINUE IF (.NOT.(BOVAL .GT. 0))GOTO 23433 CALL BOLD(INBUF, WRDBUF, 400) BOVAL = BOVAL - 1 23433 CONTINUE IF (.NOT.(CEVAL .GT. 0))GOTO 23435 CALL CENTER(INBUF) CALL PUT(INBUF) CEVAL = CEVAL - 1 GOTO 23436 23435 CONTINUE IF (.NOT.(INBUF(1) .EQ. 10))GOTO 23437 CALL PUT(INBUF) GOTO 23438 23437 CONTINUE IF (.NOT.(FILL .EQ. 0))GOTO 23439 CALL PUT(INBUF) GOTO 23440 23439 CONTINUE I = LENGTH(INBUF) INBUF(I) = 32 IF (.NOT.(INBUF(I-1) .EQ. 46))GOTO 23441 I = I + 1 INBUF(I) = 32 23441 CONTINUE INBUF(I+1) = 0 I = 1 23443 IF (.NOT.(GETWRB(INBUF, I, WRDBUF) .GT. 0))GOTO 23445 CALL PUTWRD(WRDBUF) 23444 GOTO 23443 23445 CONTINUE 23440 CONTINUE 23438 CONTINUE 23436 CONTINUE RETURN END SUBROUTINE UNDERL(BUF, TBUF, SIZE) INTEGER I, J, SIZE LOGICAL*1 BUF(100), TBUF(100) J = 1 I = 1 23446 IF (.NOT.(BUF(I) .NE. 10 .AND. J .LT. SIZE-1))GOTO 23448 IF (.NOT.(BUF(I) .NE. 32 .AND. BUF(I) .NE. 9 .AND. BUF(I) .NE. 8 . *AND. BUF(I) .NE. 95))GOTO 23449 CALL CHCOPY(95, TBUF, J) CALL CHCOPY(8, TBUF, J) 23449 CONTINUE CALL CHCOPY(BUF(I), TBUF, J) 23447 I = I + 1 GOTO 23446 23448 CONTINUE TBUF(J) = 10 TBUF(J+1) = 0 CALL SCOPY(TBUF, 1, BUF, 1) RETURN END INTEGER FUNCTION WIDTH(BUF) LOGICAL*1 BUF(512) INTEGER I WIDTH = 0 I = 1 23451 IF (.NOT.(BUF(I) .NE. 0))GOTO 23453 IF (.NOT.(BUF(I) .EQ. 8))GOTO 23454 WIDTH = WIDTH - 1 GOTO 23455 23454 CONTINUE IF (.NOT.(BUF(I) .GE. 32 .AND. BUF(I) .LE. 126))GOTO 23456 WIDTH = WIDTH + 1 23456 CONTINUE 23455 CONTINUE 23452 I = I + 1 GOTO 23451 23453 CONTINUE RETURN END INTEGER FUNCTION ADDSTR(S, STR, J, MAXSIZ) LOGICAL*1 S(100), STR(100) INTEGER J, MAXSIZ, I INTEGER LENGTH IF (.NOT.((LENGTH(S) + J) .GT. MAXSIZ))GOTO 23458 ADDSTR=(0) RETURN 23458 CONTINUE I=1 23460 IF (.NOT.(S(I) .NE. 0))GOTO 23462 CALL CHCOPY(S(I), STR, J) 23461 I=I+1 GOTO 23460 23462 CONTINUE ADDSTR=(1) RETURN END