SUBROUTINE MAIN LOGICAL*1 IARG(40) LOGICAL*1 INBUF(400) INTEGER I, INT INTEGER GETARG, OPEN, GETLIN COMMON /FLIST/ FLEVEL, FFILES(40, 10) INTEGER FLEVEL LOGICAL*1 FFILES COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHLIM(2), OHLIM(2), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LS *TPAG, PRINT, OFFSET, EHEAD(512), OHEAD(512), EFOOT(512), OFOOT(512 *) INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM INTEGER EHLIM INTEGER FRSTPG INTEGER LSTPAG INTEGER PRINT INTEGER OFFSET INTEGER OHLIM INTEGER EFLIM INTEGER OFLIM INTEGER STOPX LOGICAL*1 EHEAD LOGICAL*1 OHEAD LOGICAL*1 EFOOT LOGICAL*1 OFOOT COMMON /COUT/ OUTP, OUTW, OUTWDS, PREP, OUTBUF(400) INTEGER OUTP INTEGER OUTW INTEGER PREP INTEGER OUTWDS LOGICAL*1 OUTBUF COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST LOGICAL*1 CCHAR DATA FLEVEL/0/ CALL QUERY(51Husage: roff [+] [-] [-s] [-po] [file] ...) CALL ROFINT I=1 23000 IF (.NOT.(GETARG(I, IARG, 40) .NE. -1))GOTO 23002 IF (.NOT.((IARG(1) .EQ. 45 .OR. IARG(1) .EQ. 43) .AND. IARG(2) .NE *. 0))GOTO 23003 CALL ROFCMD(IARG) GOTO 23004 23003 CONTINUE CALL FSTACK(IARG) 23004 CONTINUE 23001 I=I+1 GOTO 23000 23002 CONTINUE IF (.NOT.(FLEVEL .LE. 0))GOTO 23005 FLEVEL = 1 FFILES(1,1) = 45 23005 CONTINUE I=1 23007 IF (.NOT.(I.LE. FLEVEL))GOTO 23009 IF (.NOT.(FFILES(1,I) .EQ. 45))GOTO 23010 INT = 1 GOTO 23011 23010 CONTINUE INT = OPEN (FFILES(1,I), 1) 23011 CONTINUE IF (.NOT.(INT .EQ. -3))GOTO 23012 CALL CANT(FFILES(1,I)) 23012 CONTINUE 23014 IF (.NOT.(GETLIN(INBUF, INT) .NE. -1))GOTO 23015 IF (.NOT.(INBUF(1) .EQ. CCHAR))GOTO 23016 CALL COMAND(INBUF) GOTO 23017 23016 CONTINUE CALL TEXT(INBUF) 23017 CONTINUE GOTO 23014 23015 CONTINUE IF (.NOT.(INT .NE. 1))GOTO 23018 CALL CLOSE(INT) 23018 CONTINUE 23008 I=I+1 GOTO 23007 23009 CONTINUE IF (.NOT.(LINENO .GT. 0 .OR. OUTP .GT. 0))GOTO 23020 CALL SPACE(1000) 23020 CONTINUE CALL PUTCH(10,2) RETURN END SUBROUTINE BOLD(BUF, TBUF, SIZE) INTEGER I, J, SIZE LOGICAL*1 BUF(SIZE), TBUF(SIZE) J = 1 I = 1 23022 IF (.NOT.(BUF(I) .NE. 10 .AND. J .LT. SIZE-1))GOTO 23024 TBUF(J) = BUF(I) J = J + 1 IF (.NOT.(BUF(I) .NE. 32 .AND. BUF(I) .NE. 9 .AND. BUF(I) .NE. 8)) *GOTO 23025 TBUF(J) = 8 TBUF(J+1) = TBUF(J-1) TBUF(J+2) = 8 TBUF(J+3) = TBUF(J+1) J = J + 4 23025 CONTINUE 23023 I = I + 1 GOTO 23022 23024 CONTINUE TBUF(J) = 10 TBUF(J+1) = 0 CALL SCOPY(TBUF, 1, BUF, 1) RETURN END SUBROUTINE BRK COMMON /COUT/ OUTP, OUTW, OUTWDS, PREP, OUTBUF(400) INTEGER OUTP INTEGER OUTW INTEGER PREP INTEGER OUTWDS LOGICAL*1 OUTBUF IF (.NOT.(OUTP .GT. 0))GOTO 23027 OUTBUF(OUTP) = 10 OUTBUF(OUTP+1) = 0 CALL PUT(OUTBUF) 23027 CONTINUE OUTP = 0 OUTW = 0 OUTWDS = 0 PREP = 0 RETURN END SUBROUTINE CENTER(BUF) LOGICAL*1 BUF(100) INTEGER WIDTH COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST LOGICAL*1 CCHAR TIVAL = MAX0((RMVAL+TIVAL-WIDTH(BUF))/2, 0) RETURN END SUBROUTINE COMAND(BUF) LOGICAL*1 BUF(512), ARGTYP INTEGER COMTYP, GETVAL INTEGER CT, SPVAL, VAL COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHLIM(2), OHLIM(2), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LS *TPAG, PRINT, OFFSET, EHEAD(512), OHEAD(512), EFOOT(512), OFOOT(512 *) INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM INTEGER EHLIM INTEGER FRSTPG INTEGER LSTPAG INTEGER PRINT INTEGER OFFSET INTEGER OHLIM INTEGER EFLIM INTEGER OFLIM INTEGER STOPX LOGICAL*1 EHEAD LOGICAL*1 OHEAD LOGICAL*1 EFOOT LOGICAL*1 OFOOT COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST LOGICAL*1 CCHAR CT = COMTYP(BUF) IF (.NOT.(CT .EQ. 0))GOTO 23029 RETURN 23029 CONTINUE VAL = GETVAL(BUF, ARGTYP) IF (.NOT.(CT .EQ. 1))GOTO 23031 CALL BRK FILL = 1 GOTO 23032 23031 CONTINUE IF (.NOT.(CT .EQ. 2))GOTO 23033 CALL BRK FILL = 0 GOTO 23034 23033 CONTINUE IF (.NOT.(CT .EQ. 3))GOTO 23035 CALL BRK GOTO 23036 23035 CONTINUE IF (.NOT.(CT .EQ. 4))GOTO 23037 CALL SET(LSVAL, VAL, ARGTYP, 1, 1, 1000) GOTO 23038 23037 CONTINUE IF (.NOT.(CT .EQ. 10))GOTO 23039 CALL BRK CALL SET(CEVAL, VAL, ARGTYP, 1, 0, 1000) GOTO 23040 23039 CONTINUE IF (.NOT.(CT .EQ. 11))GOTO 23041 CALL SET(ULVAL, VAL, ARGTYP, 1, 0, 1000) GOTO 23042 23041 CONTINUE IF (.NOT.(CT .EQ. 16))GOTO 23043 CALL SET(BOVAL, VAL, ARGTYP, 0, 1, 1000) GOTO 23044 23043 CONTINUE IF (.NOT.(CT .EQ. 12))GOTO 23045 CALL GETTL(BUF, EHEAD, EHLIM) CALL GETTL(BUF, OHEAD, OHLIM) GOTO 23046 23045 CONTINUE IF (.NOT.(CT .EQ. 13))GOTO 23047 CALL GETTL(BUF, EFOOT, EFLIM) CALL GETTL(BUF, OFOOT, OFLIM) GOTO 23048 23047 CONTINUE IF (.NOT.(CT .EQ. 5))GOTO 23049 CALL BRK IF (.NOT.(LINENO .GT. 0))GOTO 23051 CALL SPACE(1000) 23051 CONTINUE CALL SET(CURPAG, VAL, ARGTYP, CURPAG+1, -1000, 1000) NEWPAG = CURPAG GOTO 23050 23049 CONTINUE IF (.NOT.(CT .EQ. 6))GOTO 23053 CALL SET(SPVAL, VAL, ARGTYP, 1, 0, 1000) CALL SPACE(SPVAL) GOTO 23054 23053 CONTINUE IF (.NOT.(CT .EQ. 7))GOTO 23055 CALL BRK CALL SET(INVAL, VAL, ARGTYP, 0, 0, RMVAL-1) TIVAL = INVAL GOTO 23056 23055 CONTINUE IF (.NOT.(CT .EQ. 8))GOTO 23057 CALL SET(RMVAL, VAL, ARGTYP, 65, TIVAL+1, 1000) GOTO 23058 23057 CONTINUE IF (.NOT.(CT .EQ. 9))GOTO 23059 CALL BRK CALL SET(TIVAL, VAL, ARGTYP, 0, 0, RMVAL) GOTO 23060 23059 CONTINUE IF (.NOT.(CT .EQ. 14))GOTO 23061 CALL SET(PLVAL, VAL, ARGTYP, 66, M1VAL+M2VAL+M3VAL+M4VAL+1, 1000) BOTTOM = PLVAL - M3VAL - M4VAL GOTO 23062 23061 CONTINUE IF (.NOT.(CT .EQ. 15))GOTO 23063 CALL SET (OFFSET, VAL, ARGTYP, 0, 0, RMVAL-1) GOTO 23064 23063 CONTINUE IF (.NOT.(CT .EQ. 17))GOTO 23065 CALL SET (M1VAL, VAL, ARGTYP, 3, 0, PLVAL-M2VAL-M3VAL-M4VAL-1) GOTO 23066 23065 CONTINUE IF (.NOT.(CT .EQ. 18))GOTO 23067 CALL SET (M2VAL, VAL, ARGTYP, 2, 0, PLVAL-M1VAL-M3VAL-M4VAL-1) GOTO 23068 23067 CONTINUE IF (.NOT.(CT .EQ. 19))GOTO 23069 CALL SET (M3VAL, VAL, ARGTYP, 2, 0, PLVAL-M1VAL-M2VAL-M4VAL-1) BOTTOM = PLVAL - M3VAL - M4VAL GOTO 23070 23069 CONTINUE IF (.NOT.(CT .EQ. 20))GOTO 23071 CALL SET (M4VAL, VAL, ARGTYP, 3, 0, PLVAL-M1VAL-M2VAL-M3VAL-1) BOTTOM = PLVAL - M3VAL - M4VAL GOTO 23072 23071 CONTINUE IF (.NOT.(CT .EQ. 21))GOTO 23073 CALL GETTL(BUF,EHEAD, EHLIM) GOTO 23074 23073 CONTINUE IF (.NOT.(CT .EQ. 22))GOTO 23075 CALL GETTL(BUF,OHEAD, OHLIM) GOTO 23076 23075 CONTINUE IF (.NOT.(CT .EQ. 23))GOTO 23077 CALL GETTL(BUF,EFOOT, EFLIM) GOTO 23078 23077 CONTINUE IF (.NOT.(CT .EQ. 24))GOTO 23079 CALL GETTL(BUF,OFOOT, OFLIM) GOTO 23080 23079 CONTINUE IF (.NOT.(CT .EQ. 25))GOTO 23081 CCHAR = ARGTYP GOTO 23082 23081 CONTINUE IF (.NOT.(CT .EQ. 26))GOTO 23083 IF (.NOT.((LINENO + VAL) .GT. BOTTOM .AND. LINENO .LE. BOTTOM))GOT *O 23085 CALL SPACE(VAL) LINENO = 0 23085 CONTINUE GOTO 23084 23083 CONTINUE IF (.NOT.(CT .EQ. 27))GOTO 23087 CALL SET(BSVAL, VAL, ARGTYP, 1, 0, 1000) GOTO 23088 23087 CONTINUE IF (.NOT.(CT .EQ. 28))GOTO 23089 RJUST = 1 GOTO 23090 23089 CONTINUE IF (.NOT.(CT .EQ. 29))GOTO 23091 RJUST = 0 23091 CONTINUE 23090 CONTINUE 23088 CONTINUE 23084 CONTINUE 23082 CONTINUE 23080 CONTINUE 23078 CONTINUE 23076 CONTINUE 23074 CONTINUE 23072 CONTINUE 23070 CONTINUE 23068 CONTINUE 23066 CONTINUE 23064 CONTINUE 23062 CONTINUE 23060 CONTINUE 23058 CONTINUE 23056 CONTINUE 23054 CONTINUE 23050 CONTINUE 23048 CONTINUE 23046 CONTINUE 23044 CONTINUE 23042 CONTINUE 23040 CONTINUE 23038 CONTINUE 23036 CONTINUE 23034 CONTINUE 23032 CONTINUE RETURN END INTEGER FUNCTION COMTYP(BUF) LOGICAL*1 BUF(512), C1, C2, CLOWER C1 = CLOWER(BUF(2)) C2 = CLOWER(BUF(3)) IF (.NOT.(C1 .EQ. 102 .AND. C2 .EQ. 105))GOTO 23093 COMTYP = 1 GOTO 23094 23093 CONTINUE IF (.NOT.(C1 .EQ. 110 .AND. C2 .EQ. 102))GOTO 23095 COMTYP = 2 GOTO 23096 23095 CONTINUE IF (.NOT.(C1 .EQ. 98 .AND. C2 .EQ. 114))GOTO 23097 COMTYP = 3 GOTO 23098 23097 CONTINUE IF (.NOT.(C1 .EQ. 108 .AND. C2 .EQ. 115))GOTO 23099 COMTYP = 4 GOTO 23100 23099 CONTINUE IF (.NOT.(C1 .EQ. 98 .AND. C2 .EQ. 112))GOTO 23101 COMTYP = 5 GOTO 23102 23101 CONTINUE IF (.NOT.(C1 .EQ. 115 .AND. C2 .EQ. 112))GOTO 23103 COMTYP = 6 GOTO 23104 23103 CONTINUE IF (.NOT.(C1 .EQ. 105 .AND. C2 .EQ. 110))GOTO 23105 COMTYP = 7 GOTO 23106 23105 CONTINUE IF (.NOT.(C1 .EQ. 114 .AND. C2 .EQ. 109))GOTO 23107 COMTYP = 8 GOTO 23108 23107 CONTINUE IF (.NOT.(C1 .EQ. 116 .AND. C2 .EQ. 105))GOTO 23109 COMTYP = 9 GOTO 23110 23109 CONTINUE IF (.NOT.(C1 .EQ. 99 .AND. C2 .EQ. 101))GOTO 23111 COMTYP = 10 GOTO 23112 23111 CONTINUE IF (.NOT.(C1 .EQ. 117 .AND. C2 .EQ. 108))GOTO 23113 COMTYP = 11 GOTO 23114 23113 CONTINUE IF (.NOT.(C1 .EQ. 104 .AND. C2 .EQ. 101))GOTO 23115 COMTYP = 12 GOTO 23116 23115 CONTINUE IF (.NOT.(C1 .EQ. 102 .AND. C2 .EQ. 111))GOTO 23117 COMTYP = 13 GOTO 23118 23117 CONTINUE IF (.NOT.(C1 .EQ. 112 .AND. C2 .EQ. 108))GOTO 23119 COMTYP = 14 GOTO 23120 23119 CONTINUE IF (.NOT.(C1 .EQ. 112 .AND. C2 .EQ. 111))GOTO 23121 COMTYP = 15 GOTO 23122 23121 CONTINUE IF (.NOT.(C1 .EQ. 98 .AND. C2 .EQ. 100))GOTO 23123 COMTYP = 16 GOTO 23124 23123 CONTINUE IF (.NOT.(C1 .EQ. 109 .AND. C2 .EQ. 49))GOTO 23125 COMTYP = 17 GOTO 23126 23125 CONTINUE IF (.NOT.(C1 .EQ. 109 .AND. C2 .EQ. 50))GOTO 23127 COMTYP = 18 GOTO 23128 23127 CONTINUE IF (.NOT.(C1 .EQ. 109 .AND. C2 .EQ. 51))GOTO 23129 COMTYP = 19 GOTO 23130 23129 CONTINUE IF (.NOT.(C1 .EQ. 109 .AND. C2 .EQ. 52))GOTO 23131 COMTYP = 20 GOTO 23132 23131 CONTINUE IF (.NOT.(C1 .EQ. 101 .AND. C2 .EQ. 104))GOTO 23133 COMTYP = 21 GOTO 23134 23133 CONTINUE IF (.NOT.(C1 .EQ. 111 .AND. C2 .EQ. 104))GOTO 23135 COMTYP = 22 GOTO 23136 23135 CONTINUE IF (.NOT.(C1 .EQ. 101 .AND. C2 .EQ. 102))GOTO 23137 COMTYP = 23 GOTO 23138 23137 CONTINUE IF (.NOT.(C1 .EQ. 111 .AND. C2 .EQ. 102))GOTO 23139 COMTYP = 24 GOTO 23140 23139 CONTINUE IF (.NOT.(C1 .EQ. 99 .AND. C2 .EQ. 99))GOTO 23141 COMTYP = 25 GOTO 23142 23141 CONTINUE IF (.NOT.(C1 .EQ. 110 .AND. C2 .EQ. 101))GOTO 23143 COMTYP = 26 GOTO 23144 23143 CONTINUE IF (.NOT.(C1 .EQ. 98 .AND. C2 .EQ. 115))GOTO 23145 COMTYP = 27 GOTO 23146 23145 CONTINUE IF (.NOT.(C1 .EQ. 106 .AND. C2 .EQ. 117))GOTO 23147 COMTYP = 28 GOTO 23148 23147 CONTINUE IF (.NOT.(C1 .EQ. 110 .AND. C2 .EQ. 106))GOTO 23149 COMTYP = 29 GOTO 23150 23149 CONTINUE COMTYP = 0 23150 CONTINUE 23148 CONTINUE 23146 CONTINUE 23144 CONTINUE 23142 CONTINUE 23140 CONTINUE 23138 CONTINUE 23136 CONTINUE 23134 CONTINUE 23132 CONTINUE 23130 CONTINUE 23128 CONTINUE 23126 CONTINUE 23124 CONTINUE 23122 CONTINUE 23120 CONTINUE 23118 CONTINUE 23116 CONTINUE 23114 CONTINUE 23112 CONTINUE 23110 CONTINUE 23108 CONTINUE 23106 CONTINUE 23104 CONTINUE 23102 CONTINUE 23100 CONTINUE 23098 CONTINUE 23096 CONTINUE 23094 CONTINUE RETURN END INTEGER FUNCTION EVEN(I) INTEGER I,MOD IF (.NOT.(MOD(I,2) .EQ. 0))GOTO 23151 EVEN = 1 GOTO 23152 23151 CONTINUE EVEN = 0 23152 CONTINUE RETURN END SUBROUTINE FSTACK (IARG) INTEGER I LOGICAL*1 IARG(40) COMMON /FLIST/ FLEVEL, FFILES(40, 10) INTEGER FLEVEL LOGICAL*1 FFILES IF (.NOT.(FLEVEL .LT. 10))GOTO 23153 FLEVEL = FLEVEL + 1 I=1 23155 IF (.NOT.(I.LE.40))GOTO 23157 FFILES(I,FLEVEL) = IARG(I) 23156 I=I+1 GOTO 23155 23157 CONTINUE 23153 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, CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST LOGICAL*1 CCHAR I = 1 23158 IF (.NOT.(BUF(I) .NE. 32 .AND. BUF(I) .NE. 9 .AND. BUF(I) .NE. 10) *)GOTO 23159 I = I + 1 GOTO 23158 23159 CONTINUE CALL SKIPBL(BUF, I) CALL SCOPY(BUF, I, TTL, 1) LIM(1) = INVAL LIM(2) = RMVAL RETURN END INTEGER FUNCTION GETVAL(BUF, ARGTYP) LOGICAL*1 BUF(512), ARGTYP INTEGER CTOI INTEGER I I = 1 23160 IF (.NOT.(BUF(I) .NE. 32 .AND. BUF(I) .NE. 9 .AND. BUF(I) .NE. 10) *)GOTO 23161 I = I + 1 GOTO 23160 23161 CONTINUE CALL SKIPBL(BUF, I) ARGTYP = BUF(I) IF (.NOT.(ARGTYP .EQ. 43 .OR. ARGTYP .EQ. 45))GOTO 23162 I = I + 1 23162 CONTINUE GETVAL = CTOI(BUF, I) RETURN END INTEGER FUNCTION GETWRB(IN,I,OUT) LOGICAL*1 IN(100),OUT(100) INTEGER I, J 23164 IF (.NOT.(IN(I) .EQ. 32 .OR. IN(I) .EQ. 9))GOTO 23165 I = I + 1 GOTO 23164 23165 CONTINUE J = 1 23166 IF (.NOT.(IN(I) .NE. 0 .AND. IN(I) .NE. 32 .AND. IN(I) .NE. 9 .AND *. IN(I) .NE. 10))GOTO 23167 OUT(J) = IN(I) I = I + 1 J = J + 1 GOTO 23166 23167 CONTINUE 23168 CONTINUE 23171 IF (.NOT.(IN(I) .EQ. 32))GOTO 23172 OUT(J) = 32 I = I + 1 J = J + 1 GOTO 23171 23172 CONTINUE 23173 IF (.NOT.(IN(I) .EQ. 46 .OR. IN(I) .EQ. 44 .OR. IN(I) .EQ. 58 .OR. * IN(I) .EQ. 125 .OR. IN(I) .EQ. 93 .OR. IN(I) .EQ. 41 .OR. IN(I) . *EQ. 59 .OR. IN(I) .EQ. 8))GOTO 23174 OUT(J) = IN(I) I = I + 1 J = J + 1 GOTO 23173 23174 CONTINUE 23169 IF (.NOT.(IN(I) .NE. 32))GOTO 23168 23170 CONTINUE IF (.NOT.(OUT(J-1) .EQ. 32))GOTO 23175 J = J - 1 23175 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 23177 IF (.NOT.(BUF(I) .EQ. DELIM))GOTO 23179 I = I + 1 23179 CONTINUE 23181 IF (.NOT.(BUF(I) .NE. DELIM .AND. BUF(I) .NE. 0 .AND. BUF(I) .NE. *10 .AND. J .LE. N))GOTO 23182 TEMP(J) = BUF(I) J = J + 1 I = I + 1 GOTO 23181 23182 CONTINUE 23177 CONTINUE TEMP(J) = 0 GFIELD = J - 1 23183 IF (.NOT.(BUF(I) .NE. DELIM .AND. BUF(I) .NE. 0 .AND. BUF(I) .NE. *10))GOTO 23184 I = I + 1 GOTO 23183 23184 CONTINUE RETURN END SUBROUTINE JCOPY(FROM,I,TO,J) LOGICAL*1 FROM(100),TO(100) INTEGER I,J,K1,K2 K1 = I K2 = J 23185 IF (.NOT.(FROM(K1) .NE. 0))GOTO 23186 TO(K2) = FROM(K1) K1 = K1 + 1 K2 = K2 + 1 GOTO 23185 23186 CONTINUE RETURN END SUBROUTINE JUSTFY(IN,LEFT,RIGHT,TYPE,OUT) LOGICAL*1 IN(100), OUT(100) INTEGER LEFT, RIGHT, TYPE, J, N, WIDTH N = WIDTH(IN) IF (.NOT.(TYPE .EQ. 3))GOTO 23187 CALL JCOPY(IN,1,OUT,RIGHT-N) GOTO 23188 23187 CONTINUE IF (.NOT.(TYPE .EQ. 2))GOTO 23189 J = MAX0((RIGHT+LEFT-N)/2,LEFT) CALL JCOPY(IN,1,OUT,J) GOTO 23190 23189 CONTINUE CALL JCOPY(IN,1,OUT,LEFT) 23190 CONTINUE 23188 CONTINUE RETURN END SUBROUTINE LEADBL(BUF) LOGICAL*1 BUF(512) INTEGER I, J COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST LOGICAL*1 CCHAR CALL BRK I = 1 23191 IF (.NOT.(BUF(I) .EQ. 32))GOTO 23193 23192 I = I + 1 GOTO 23191 23193 CONTINUE IF (.NOT.(BUF(I) .NE. 10))GOTO 23194 TIVAL = I - 1 23194 CONTINUE J = 1 23196 IF (.NOT.(BUF(I) .NE. 0))GOTO 23198 BUF(J) = BUF(I) I = I + 1 23197 J = J + 1 GOTO 23196 23198 CONTINUE BUF(J) = 0 RETURN END SUBROUTINE PFOOT COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHLIM(2), OHLIM(2), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LS *TPAG, PRINT, OFFSET, EHEAD(512), OHEAD(512), EFOOT(512), OFOOT(512 *) INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM INTEGER EHLIM INTEGER FRSTPG INTEGER LSTPAG INTEGER PRINT INTEGER OFFSET INTEGER OHLIM INTEGER EFLIM INTEGER OFLIM INTEGER STOPX LOGICAL*1 EHEAD LOGICAL*1 OHEAD LOGICAL*1 EFOOT LOGICAL*1 OFOOT INTEGER EVEN CALL SKIP(M3VAL) IF (.NOT.(EVEN(CURPAG) .EQ. 1))GOTO 23199 CALL PUTTL(EFOOT,EFLIM,CURPAG) GOTO 23200 23199 CONTINUE CALL PUTTL(OFOOT,OFLIM,CURPAG) 23200 CONTINUE IF (.NOT.(PRINT .EQ. 1))GOTO 23201 CALL PUTCH(12,2) 23201 CONTINUE RETURN END SUBROUTINE PHEAD COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHLIM(2), OHLIM(2), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LS *TPAG, PRINT, OFFSET, EHEAD(512), OHEAD(512), EFOOT(512), OFOOT(512 *) INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM INTEGER EHLIM INTEGER FRSTPG INTEGER LSTPAG INTEGER PRINT INTEGER OFFSET INTEGER OHLIM INTEGER EFLIM INTEGER OFLIM INTEGER STOPX LOGICAL*1 EHEAD LOGICAL*1 OHEAD LOGICAL*1 EFOOT LOGICAL*1 OFOOT COMMON /RSCRAT/ TBUF1(512), TBUF2(512), TTL(512) LOGICAL*1 TBUF1 LOGICAL*1 TBUF2 LOGICAL*1 TTL INTEGER EVEN, FIRST, PROMPT, JUNK LOGICAL*1 PSTR(40) LOGICAL*1 NULL(1) DATA PSTR(1)/80/,PSTR(2)/111/,PSTR(3)/115/,PSTR(4)/105/,PSTR(5)/11 *6/,PSTR(6)/105/,PSTR(7)/111/,PSTR(8)/110/,PSTR(9)/32/,PSTR(10)/112 */,PSTR(11)/97/,PSTR(12)/112/,PSTR(13)/101/,PSTR(14)/114/,PSTR(15)/ *44/,PSTR(16)/32/,PSTR(17)/116/,PSTR(18)/104/,PSTR(19)/101/,PSTR(20 *)/110/,PSTR(21)/32/,PSTR(22)/104/,PSTR(23)/105/,PSTR(24)/116/,PSTR *(25)/32/,PSTR(26)/67/,PSTR(27)/82/,PSTR(28)/32/,PSTR(29)/116/,PSTR *(30)/111/,PSTR(31)/32/,PSTR(32)/99/,PSTR(33)/111/,PSTR(34)/110/,PS *TR(35)/116/,PSTR(36)/105/,PSTR(37)/110/,PSTR(38)/117/,PSTR(39)/101 */,PSTR(40)/0/ DATA NULL(1)/0/ DATA FIRST /1/ CURPAG = NEWPAG IF (.NOT.(CURPAG .GE. FRSTPG .AND. CURPAG .LE. LSTPAG))GOTO 23203 PRINT = 1 GOTO 23204 23203 CONTINUE PRINT = 0 23204 CONTINUE IF (.NOT.(PRINT .EQ. 1))GOTO 23205 IF (.NOT.(FIRST .EQ. 1))GOTO 23207 IF (.NOT.(STOPX .NE. 0))GOTO 23209 JUNK = PROMPT(PSTR, TBUF1, STOPX) 23209 CONTINUE FIRST = 0 IF (.NOT.(ISATTY(2) .NE. 1))GOTO 23211 CALL PUTCH(12,2) 23211 CONTINUE GOTO 23208 23207 CONTINUE IF (.NOT.(STOPX .NE. 0))GOTO 23213 JUNK = PROMPT (NULL, TBUF1, STOPX) 23213 CONTINUE 23208 CONTINUE 23205 CONTINUE NEWPAG = NEWPAG + 1 CALL SKIP(M1VAL-1) LINENO = MAX0(M1VAL-1, 0) IF (.NOT.(EVEN(CURPAG) .EQ. 1))GOTO 23215 CALL PUTTL(EHEAD,EHLIM,CURPAG) GOTO 23216 23215 CONTINUE CALL PUTTL(OHEAD,OHLIM,CURPAG) 23216 CONTINUE CALL SKIP(M2VAL) LINENO = LINENO + MAX0(M2VAL, 0) RETURN END SUBROUTINE PUT(BUF) LOGICAL*1 BUF(512) INTEGER I COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHLIM(2), OHLIM(2), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LS *TPAG, PRINT, OFFSET, EHEAD(512), OHEAD(512), EFOOT(512), OFOOT(512 *) INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM INTEGER EHLIM INTEGER FRSTPG INTEGER LSTPAG INTEGER PRINT INTEGER OFFSET INTEGER OHLIM INTEGER EFLIM INTEGER OFLIM INTEGER STOPX LOGICAL*1 EHEAD LOGICAL*1 OHEAD LOGICAL*1 EFOOT LOGICAL*1 OFOOT COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST LOGICAL*1 CCHAR IF (.NOT.(LINENO .EQ. 0 .OR. LINENO .GT. BOTTOM))GOTO 23217 CALL PHEAD 23217 CONTINUE IF (.NOT.(PRINT .EQ. 1))GOTO 23219 I=1 23221 IF (.NOT.(I.LE.OFFSET))GOTO 23223 CALL PUTCH(32,2) 23222 I=I+1 GOTO 23221 23223 CONTINUE 23219 CONTINUE I = 1 23224 IF (.NOT.(I .LE. TIVAL))GOTO 23226 IF (.NOT.(PRINT .EQ. 1))GOTO 23227 CALL PUTCH(32,2) 23227 CONTINUE 23225 I = I + 1 GOTO 23224 23226 CONTINUE TIVAL = INVAL IF (.NOT.(PRINT .EQ. 1))GOTO 23229 CALL PUTLIN(BUF, 2) 23229 CONTINUE CALL SKIP(MIN0(LSVAL-1, BOTTOM-LINENO)) LINENO = LINENO + LSVAL IF (.NOT.(LINENO .GT. BOTTOM))GOTO 23231 CALL PFOOT 23231 CONTINUE RETURN END SUBROUTINE PUTTL(BUF, LIM, PAGENO) LOGICAL*1 BUF(512), CHARS(10), DELIM, DATBUF(10) INTEGER PAGENO, LIM(2), FIRST INTEGER NC, ITOC, I, J, N, LEFT, RIGHT, GFIELD COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHLIM(2), OHLIM(2), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LS *TPAG, PRINT, OFFSET, EHEAD(512), OHEAD(512), EFOOT(512), OFOOT(512 *) INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM INTEGER EHLIM INTEGER FRSTPG INTEGER LSTPAG INTEGER PRINT INTEGER OFFSET INTEGER OHLIM INTEGER EFLIM INTEGER OFLIM INTEGER STOPX LOGICAL*1 EHEAD LOGICAL*1 OHEAD LOGICAL*1 EFOOT LOGICAL*1 OFOOT COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST LOGICAL*1 CCHAR COMMON /RSCRAT/ TBUF1(512), TBUF2(512), TTL(512) LOGICAL*1 TBUF1 LOGICAL*1 TBUF2 LOGICAL*1 TTL DATA FIRST /1/ IF (.NOT.(PRINT .EQ. 1 .AND. BUF(1) .NE. 0))GOTO 23233 IF (.NOT.(FIRST .EQ. 1))GOTO 23235 CALL DATE(DATBUF) DATBUF(10) = 0 FIRST = 0 23235 CONTINUE LINENO = LINENO + 1 LEFT = LIM(1) + 1 RIGHT = LIM(2) + 1 NC = ITOC(PAGENO, CHARS, 10) I = 1 DELIM = BUF(I) J=1 23237 IF (.NOT.(J.LT.RIGHT))GOTO 23239 TTL(J) = 32 23238 J=J+1 GOTO 23237 23239 CONTINUE N = 0 23240 CONTINUE N = N + 1 IF (.NOT.(GFIELD(BUF,I,RIGHT-LEFT,TBUF1,DELIM) .GT. 0))GOTO 23243 CALL SBST (TBUF1,35,TBUF2,CHARS,NC) CALL SBST (TBUF2,37,TBUF1,DATBUF,9) CALL JUSTFY(TBUF1,LEFT,RIGHT,TJUST(N),TTL) 23243 CONTINUE 23241 IF (.NOT.(BUF(I) .EQ. 0 .OR. BUF(I) .EQ. 10 .OR. N .EQ. 3))GOTO 23 *240 23242 CONTINUE TTL(RIGHT) = 10 TTL(RIGHT+1) = 0 I=1 23245 IF (.NOT.(I.LE.OFFSET))GOTO 23247 CALL PUTCH(32,2) 23246 I=I+1 GOTO 23245 23247 CONTINUE I=1 23248 IF (.NOT.(TTL(I) .NE. 0))GOTO 23250 CALL PUTCH(TTL(I),2) 23249 I=I+1 GOTO 23248 23250 CONTINUE 23233 CONTINUE RETURN END SUBROUTINE PUTWRD(WRDBUF, BS) LOGICAL*1 WRDBUF(400) INTEGER LENGTH, WIDTH INTEGER LAST, LLVAL, NEXTRA, W INTEGER BS, NB, I, J, WWIDTH COMMON /COUT/ OUTP, OUTW, OUTWDS, PREP, OUTBUF(400) INTEGER OUTP INTEGER OUTW INTEGER PREP INTEGER OUTWDS LOGICAL*1 OUTBUF COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST LOGICAL*1 CCHAR COMMON /RSCRAT/ TBUF1(512), TBUF2(512), TTL(512) LOGICAL*1 TBUF1 LOGICAL*1 TBUF2 LOGICAL*1 TTL PREP = OUTP IF (.NOT.(OUTP .NE. 0 .AND. BS .GT. 0))GOTO 23251 NB = 0 GOTO 23252 23251 CONTINUE NB = 1 23252 CONTINUE W = WIDTH(WRDBUF) LAST = LENGTH(WRDBUF) + OUTP + NB LLVAL = RMVAL - TIVAL WWIDTH = OUTW + W + NB - 1 IF (.NOT.(PREP .GT. 0 .AND. (WWIDTH .GT. LLVAL .OR. LAST .GE. 400) *))GOTO 23253 LAST = LAST - PREP IF (.NOT.(NB .EQ. 0))GOTO 23255 I = PREP + 1 J = 1 23257 IF (.NOT.(I .LT. OUTP))GOTO 23258 TBUF1(J) = OUTBUF(I) I = I + 1 J = J + 1 GOTO 23257 23258 CONTINUE CALL SCOPY(WRDBUF, 1, TBUF1, J) CALL SCOPY(TBUF1, 1, WRDBUF, 1) OUTWDS = OUTWDS - 1 23255 CONTINUE OUTP = PREP W = WIDTH(WRDBUF) NEXTRA = LLVAL - WWIDTH + W + 1 NB = 1 IF (.NOT.(OUTBUF(OUTP-2) .EQ. 46 .AND. OUTBUF(OUTP-1) .EQ. 32))GOT *O 23259 OUTP = OUTP - 1 NEXTRA = NEXTRA + 1 23259 CONTINUE IF (.NOT.(RJUST .EQ. 1))GOTO 23261 CALL SPREAD(OUTBUF, OUTP, NEXTRA, OUTWDS) IF (.NOT.(NEXTRA .GT. 0 .AND. OUTWDS .GT. 1))GOTO 23263 OUTP = OUTP + NEXTRA 23263 CONTINUE 23261 CONTINUE CALL BRK 23253 CONTINUE CALL SCOPY(WRDBUF, 1, OUTBUF, OUTP+NB) OUTP = LAST OUTBUF(OUTP) = 32 OUTW = OUTW + W + NB OUTWDS = OUTWDS + NB RETURN END SUBROUTINE ROFCMD (IARG) INTEGER OPEN, CTOI, I, VAL, ISATTY LOGICAL*1 IARG(100), ARGTYP COMMON /FLIST/ FLEVEL, FFILES(40, 10) INTEGER FLEVEL LOGICAL*1 FFILES COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHLIM(2), OHLIM(2), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LS *TPAG, PRINT, OFFSET, EHEAD(512), OHEAD(512), EFOOT(512), OFOOT(512 *) INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM INTEGER EHLIM INTEGER FRSTPG INTEGER LSTPAG INTEGER PRINT INTEGER OFFSET INTEGER OHLIM INTEGER EFLIM INTEGER OFLIM INTEGER STOPX LOGICAL*1 EHEAD LOGICAL*1 OHEAD LOGICAL*1 EFOOT LOGICAL*1 OFOOT COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST LOGICAL*1 CCHAR LOGICAL*1 TERML(4) DATA TERML(1)/84/,TERML(2)/73/,TERML(3)/58/,TERML(4)/0/ IF (.NOT.(IARG(1) .EQ. 45 .AND. (IARG(2) .EQ. 115 .OR. IARG(2) .EQ *. 83)))GOTO 23265 IF (.NOT.(ISATTY(2) .EQ. 1))GOTO 23267 STOPX = OPEN(TERML, 1) IF (.NOT.(STOPX .EQ. -3))GOTO 23269 CALL REMARK (27HCan't open user's terminal.) STOPX = 0 23269 CONTINUE 23267 CONTINUE GOTO 23266 23265 CONTINUE IF (.NOT.(IARG(1) .EQ. 45 .AND. (IARG(2) .EQ. 112 .OR. IARG(2) .EQ *. 80) .AND. (IARG(3) .EQ. 111 .OR. IARG(3) .EQ. 79)))GOTO 23271 I = 4 VAL = CTOI (IARG, I) ARGTYP = IARG(4) CALL SET (OFFSET, VAL, ARGTYP, 0, 0, RMVAL-1) GOTO 23272 23271 CONTINUE IF (.NOT.(IARG(1) .EQ. 43))GOTO 23273 I = 2 FRSTPG = CTOI (IARG, I) GOTO 23274 23273 CONTINUE IF (.NOT.(IARG(1) .EQ. 45))GOTO 23275 I = 2 LSTPAG = CTOI (IARG, I) GOTO 23276 23275 CONTINUE CALL REMARK (25Hignoring invalid argument ) 23276 CONTINUE 23274 CONTINUE 23272 CONTINUE 23266 CONTINUE RETURN END SUBROUTINE ROFINT COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST LOGICAL*1 CCHAR COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHLIM(2), OHLIM(2), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LS *TPAG, PRINT, OFFSET, EHEAD(512), OHEAD(512), EFOOT(512), OFOOT(512 *) INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM INTEGER EHLIM INTEGER FRSTPG INTEGER LSTPAG INTEGER PRINT INTEGER OFFSET INTEGER OHLIM INTEGER EFLIM INTEGER OFLIM INTEGER STOPX LOGICAL*1 EHEAD LOGICAL*1 OHEAD LOGICAL*1 EFOOT LOGICAL*1 OFOOT COMMON /COUT/ OUTP, OUTW, OUTWDS, PREP, OUTBUF(400) INTEGER OUTP INTEGER OUTW INTEGER PREP INTEGER OUTWDS LOGICAL*1 OUTBUF 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 LINENO = 0 CURPAG = 0 NEWPAG = 1 PLVAL = 66 M1VAL = 3 M2VAL = 2 M3VAL = 2 M4VAL = 3 BOTTOM = PLVAL - M3VAL - M4VAL EHEAD(1) = 0 OHEAD(1) = 0 EFOOT(1) = 0 OFOOT(1) = 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 PRINT = 1 FRSTPG = 0 LSTPAG = 1000 STOPX = 0 OFFSET = 0 OUTP = 0 OUTW = 0 OUTWDS = 0 PREP = 0 RETURN END SUBROUTINE SBST (IN,CHAR,OUT,SUBARA,N) LOGICAL*1 IN(100), CHAR, OUT(100), SUBARA(100) INTEGER I, J, K, N I = 1 J = 1 23277 IF (.NOT.(IN(I) .NE. 0))GOTO 23278 IF (.NOT.(IN(I) .EQ. CHAR))GOTO 23279 K=1 23281 IF (.NOT.(K.LE.N))GOTO 23283 OUT(J) = SUBARA(K) J = J + 1 23282 K=K+1 GOTO 23281 23283 CONTINUE GOTO 23280 23279 CONTINUE OUT(J) = IN(I) J = J + 1 23280 CONTINUE I = I + 1 GOTO 23277 23278 CONTINUE OUT(J) = 0 RETURN END SUBROUTINE SET(PARAM, VAL, ARGTYP, DEFVAL, MINVAL, MAXVAL) LOGICAL*1 ARGTYP INTEGER DEFVAL, MAXVAL, MINVAL, PARAM, VAL IF (.NOT.(ARGTYP .EQ. 10))GOTO 23284 PARAM = DEFVAL GOTO 23285 23284 CONTINUE IF (.NOT.(ARGTYP .EQ. 43))GOTO 23286 PARAM = PARAM + VAL GOTO 23287 23286 CONTINUE IF (.NOT.(ARGTYP .EQ. 45))GOTO 23288 PARAM = PARAM - VAL GOTO 23289 23288 CONTINUE PARAM = VAL 23289 CONTINUE 23287 CONTINUE 23285 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, EHLIM(2), OHLIM(2), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LS *TPAG, PRINT, OFFSET, EHEAD(512), OHEAD(512), EFOOT(512), OFOOT(512 *) INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM INTEGER EHLIM INTEGER FRSTPG INTEGER LSTPAG INTEGER PRINT INTEGER OFFSET INTEGER OHLIM INTEGER EFLIM INTEGER OFLIM INTEGER STOPX LOGICAL*1 EHEAD LOGICAL*1 OHEAD LOGICAL*1 EFOOT LOGICAL*1 OFOOT I = 1 23290 IF (.NOT.(I .LE. N))GOTO 23292 IF (.NOT.(PRINT .EQ. 1))GOTO 23293 CALL PUTCH(10,2) 23293 CONTINUE 23291 I = I + 1 GOTO 23290 23292 CONTINUE RETURN END SUBROUTINE SPACE(N) INTEGER N COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHLIM(2), OHLIM(2), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LS *TPAG, PRINT, OFFSET, EHEAD(512), OHEAD(512), EFOOT(512), OFOOT(512 *) INTEGER CURPAG INTEGER NEWPAG INTEGER LINENO INTEGER PLVAL INTEGER M1VAL INTEGER M2VAL INTEGER M3VAL INTEGER M4VAL INTEGER BOTTOM INTEGER EHLIM INTEGER FRSTPG INTEGER LSTPAG INTEGER PRINT INTEGER OFFSET INTEGER OHLIM INTEGER EFLIM INTEGER OFLIM INTEGER STOPX LOGICAL*1 EHEAD LOGICAL*1 OHEAD LOGICAL*1 EFOOT LOGICAL*1 OFOOT CALL BRK IF (.NOT.(LINENO .GT. BOTTOM))GOTO 23295 RETURN 23295 CONTINUE IF (.NOT.(LINENO .EQ. 0))GOTO 23297 CALL PHEAD 23297 CONTINUE CALL SKIP(MIN0(N, BOTTOM+1-LINENO)) LINENO = LINENO + N IF (.NOT.(LINENO .GT. BOTTOM))GOTO 23299 CALL PFOOT 23299 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, CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST LOGICAL*1 CCHAR INTEGER DIR, I, J, NB, NE, NEXTRA, NHOLES, OUTP, OUTWDS DATA DIR /0/ IF (.NOT.(NEXTRA .LE. 0 .OR. OUTWDS .LE. 1))GOTO 23301 RETURN 23301 CONTINUE DIR = 1 - DIR NE = NEXTRA NHOLES = OUTWDS - 1 IF (.NOT.(TIVAL .NE. INVAL .AND. NHOLES .GT. 1))GOTO 23303 NHOLES = NHOLES - 1 23303 CONTINUE I = OUTP - 1 J = MIN0(400-2, I+NE) 23305 IF (.NOT.(I .LT. J))GOTO 23306 BUF(J) = BUF(I) IF (.NOT.(BUF(I) .EQ. 32 .AND. BUF(I-1) .NE. 32))GOTO 23307 IF (.NOT.(DIR .EQ. 0))GOTO 23309 NB = (NE-1) / NHOLES + 1 GOTO 23310 23309 CONTINUE NB = NE / NHOLES 23310 CONTINUE NE = NE - NB NHOLES = NHOLES - 1 23311 IF (.NOT.(NB .GT. 0))GOTO 23313 J = J - 1 BUF(J) = 32 23312 NB = NB - 1 GOTO 23311 23313 CONTINUE 23307 CONTINUE I = I - 1 J = J - 1 GOTO 23305 23306 CONTINUE RETURN END SUBROUTINE TEXT(INBUF) LOGICAL*1 INBUF(400), WRDBUF(400) INTEGER GETWRB INTEGER I, BS, J COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CCHAR INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST LOGICAL*1 CCHAR IF (.NOT.(INBUF(1) .EQ. 32 .OR. INBUF(1) .EQ. 10))GOTO 23314 CALL LEADBL(INBUF) 23314 CONTINUE IF (.NOT.(ULVAL .GT. 0))GOTO 23316 CALL UNDERL(INBUF, WRDBUF, 400) ULVAL = ULVAL - 1 23316 CONTINUE IF (.NOT.(BOVAL .GT. 0))GOTO 23318 CALL BOLD(INBUF, WRDBUF, 400) BOVAL = BOVAL - 1 23318 CONTINUE IF (.NOT.(CEVAL .GT. 0))GOTO 23320 CALL CENTER(INBUF) CALL PUT(INBUF) CEVAL = CEVAL - 1 GOTO 23321 23320 CONTINUE IF (.NOT.(INBUF(1) .EQ. 10))GOTO 23322 CALL PUT(INBUF) GOTO 23323 23322 CONTINUE IF (.NOT.(FILL .EQ. 0))GOTO 23324 CALL PUT(INBUF) GOTO 23325 23324 CONTINUE J = 0 I = 1 23326 IF (.NOT.(GETWRB(INBUF, I, WRDBUF) .GT. 0))GOTO 23328 J = J + 1 IF (.NOT.(BSVAL .GT. 0 .AND. J .EQ. 1))GOTO 23329 BS = 1 BSVAL = BSVAL - 1 GOTO 23330 23329 CONTINUE BS = 0 23330 CONTINUE CALL PUTWRD(WRDBUF, BS) 23327 GOTO 23326 23328 CONTINUE 23325 CONTINUE 23323 CONTINUE 23321 CONTINUE RETURN END SUBROUTINE UNDERL(BUF, TBUF, SIZE) INTEGER I, J, SIZE LOGICAL*1 BUF(SIZE), TBUF(SIZE) J = 1 I = 1 23331 IF (.NOT.(BUF(I) .NE. 10 .AND. J .LT. SIZE-1))GOTO 23333 IF (.NOT.(BUF(I) .NE. 32 .AND. BUF(I) .NE. 9 .AND. BUF(I) .NE. 8)) *GOTO 23334 TBUF(J) = 95 TBUF(J+1) = 8 J = J + 2 23334 CONTINUE TBUF(J) = BUF(I) J = J + 1 23332 I = I + 1 GOTO 23331 23333 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 23336 IF (.NOT.(BUF(I) .NE. 0))GOTO 23338 IF (.NOT.(BUF(I) .EQ. 8))GOTO 23339 WIDTH = WIDTH - 1 GOTO 23340 23339 CONTINUE IF (.NOT.(BUF(I) .NE. 10))GOTO 23341 WIDTH = WIDTH + 1 23341 CONTINUE 23340 CONTINUE 23337 I = I + 1 GOTO 23336 23338 CONTINUE RETURN END