SUBROUTINE MAIN LOGICAL*1 ARG(512) INTEGER GETARG, OPEN, CTOI, GETVAL INTEGER I, FD, NF, J, VAL, ARGTYP 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(512), 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(512) INTEGER OUTP INTEGER OUTW INTEGER OUTWDS LOGICAL*1 OUTBUF CALL FINIT NF = 0 CALL QUERY (47Husage: format [+n] [-n] [-s] [-pon] [file] ...) 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 VAL = GETVAL(ARG, J, ARGTYP) CALL SET(OFFSET, VAL, ARGTYP, 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 NF = NF + 1 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) 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(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 STRCPY( TBUF, BUF) RETURN END SUBROUTINE BRK COMMON /COUT/ OUTP, OUTW, OUTWDS, OUTBUF(512) 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(512), 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, GETWRD, LENGTH, MAX0, OPEN 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(512), 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) I23032=( CT ) GOTO 23032 23034 CONTINUE CALL EVAL( BUF, DEFN) GOTO 23033 23035 CONTINUE CALL BRK FILL = 1 GOTO 23033 23036 CONTINUE CALL BRK FILL = 0 GOTO 23033 23037 CONTINUE CALL BRK GOTO 23033 23038 CONTINUE CALL SET( LSVAL, VAL, ARGTYP, 1, 1, 30000) GOTO 23033 23039 CONTINUE CALL BRK CALL SET( CEVAL, VAL, ARGTYP, 1, 0, 30000) GOTO 23033 23040 CONTINUE CUVAL = 0 CALL SET( ULVAL, VAL, ARGTYP, 0, 1, 30000) GOTO 23033 23041 CONTINUE CALL SET( BOVAL, VAL, ARGTYP, 0, 1, 30000) GOTO 23033 23042 CONTINUE CALL GETTL( BUF, EHEAD, EHLIM) CALL GETTL( BUF, OHEAD, OHLIM) GOTO 23033 23043 CONTINUE CALL GETTL( BUF, EFOOT, EFLIM) CALL GETTL( BUF, OFOOT, OFLIM) GOTO 23033 23044 CONTINUE CALL BRK IF (.NOT.( LINENO .GT. 0 ))GOTO 23045 CALL SPACE(30000) 23045 CONTINUE CALL SET( CURPAG, VAL, ARGTYP, CURPAG+1, -30000, 30000) NEWPAG = CURPAG GOTO 23033 23047 CONTINUE CALL SET( SPVAL, VAL, ARGTYP, 1, 0, 30000) CALL SPACE(SPVAL) GOTO 23033 23048 CONTINUE CALL BRK CALL SET( INVAL, VAL, ARGTYP, 0, 0, RMVAL-1) TIVAL = INVAL GOTO 23033 23049 CONTINUE CALL SET( RMVAL, VAL, ARGTYP, 65, TIVAL+1, 30000) GOTO 23033 23050 CONTINUE CALL BRK CALL SET( TIVAL, VAL, ARGTYP, 0, 0, RMVAL) GOTO 23033 23051 CONTINUE CALL SET( PLVAL, VAL, ARGTYP, 62, M1VAL+M2VAL+M3VAL+M4VAL+1, 30000 *) BOTTOM = PLVAL - M3VAL - M4VAL GOTO 23033 23052 CONTINUE CALL SET( OFFSET, VAL, ARGTYP, 0, 0, RMVAL-1) GOTO 23033 23053 CONTINUE CALL SET( M1VAL, VAL, ARGTYP, 3, 0, PLVAL-M2VAL-M3VAL-M4VAL-1) GOTO 23033 23054 CONTINUE CALL SET( M2VAL, VAL, ARGTYP, 2, 0, PLVAL-M1VAL-M3VAL-M4VAL-1) GOTO 23033 23055 CONTINUE CALL SET( M3VAL, VAL, ARGTYP, 2, 0, PLVAL-M1VAL-M2VAL-M4VAL-1) BOTTOM = PLVAL - M3VAL - M4VAL GOTO 23033 23056 CONTINUE CALL SET( M4VAL, VAL, ARGTYP, 3, 0, PLVAL-M1VAL-M2VAL-M3VAL-1) BOTTOM = PLVAL - M3VAL - M4VAL GOTO 23033 23057 CONTINUE CALL GETTL( BUF, EHEAD, EHLIM) GOTO 23033 23058 CONTINUE CALL GETTL( BUF, OHEAD, OHLIM) GOTO 23033 23059 CONTINUE CALL GETTL( BUF, EFOOT, EFLIM) GOTO 23033 23060 CONTINUE CALL GETTL( BUF, OFOOT, OFLIM) GOTO 23033 23061 CONTINUE CCHAR = ARGTYP IF (.NOT.( CCHAR .EQ. 0 .OR. CCHAR .EQ. 10 ))GOTO 23062 CCHAR = 46 23062 CONTINUE IF (.NOT.( (LINENO + VAL) .GT. BOTTOM .AND. LINENO .LE. BOTTOM ))G *OTO 23064 CALL SPACE(VAL) LINENO = 0 23064 CONTINUE GOTO 23033 23066 CONTINUE IF (.NOT.( (LINENO + VAL) .GT. BOTTOM .AND. LINENO .LE. BOTTOM ))G *OTO 23067 CALL SPACE(VAL) LINENO = 0 23067 CONTINUE GOTO 23033 23069 CONTINUE CALL SET( BSVAL, VAL, ARGTYP, 1, 0, 30000) GOTO 23033 23070 CONTINUE RJUST = 1 GOTO 23033 23071 CONTINUE RJUST = 0 GOTO 23033 23072 CONTINUE IF (.NOT.( GETWRD( BUF, I, NAME) .EQ. 0 ))GOTO 23073 RETURN 23073 CONTINUE IF (.NOT.( LEVEL + 1 .GT. 3 ))GOTO 23075 CALL ERROR(32H? SO commands nested too deeply.) 23075 CONTINUE INFILE(LEVEL+1) = OPEN( NAME, 1) IF (.NOT.( INFILE(LEVEL+1) .NE. -3 ))GOTO 23077 LEVEL = LEVEL + 1 23077 CONTINUE GOTO 23033 23079 CONTINUE ULVAL = 0 CALL SET( CUVAL, VAL, ARGTYP, 0, 1, 30000) GOTO 23033 23080 CONTINUE CALL DODEF( BUF, INFILE(LEVEL)) GOTO 23033 23081 CONTINUE IF (.NOT.( GETWRD( BUF, I, NAME) .EQ. 0 ))GOTO 23082 RETURN 23082 CONTINUE CALL FOLD(NAME) IF (.NOT.( NAME(1) .LT. 97 .OR. NAME(1) .GT. 122 ))GOTO 23084 CALL ERROR(31H? Invalid number register name.) 23084 CONTINUE VAL = GETVAL( BUF, I, ARGTYP) CALL SET( NR(NAME(1)-97+1), VAL, ARGTYP, 0, -30000, 30000) GOTO 23033 23086 CONTINUE IF (.NOT.( ARGTYP .EQ. 45 ))GOTO 23087 SPVAL = PLVAL GOTO 23088 23087 CONTINUE SPVAL = 0 23088 CONTINUE CALL SET( SPVAL, VAL, ARGTYP, 0, 1, BOTTOM) IF (.NOT.( SPVAL .GT. LINENO .AND. LINENO .EQ. 0 ))GOTO 23089 CALL PHEAD 23089 CONTINUE IF (.NOT.( SPVAL .GT. LINENO ))GOTO 23091 CALL SPACE(SPVAL - LINENO) 23091 CONTINUE GOTO 23033 23032 CONTINUE I23032=I23032+2 IF (I23032.LT.1.OR.I23032.GT.37)GOTO 23033 GOTO (23034,23033,23035,23036,23037,23038,23044,23047,23048,23049, *23050,23039,23040,23042,23043,23051,23052,23041,23053,23054,23055, *23056,23057,23058,23059,23060,23061,23066,23069,23070,23071,23072, *23079,23080,23033,23081,23086),I23032 23033 CONTINUE RETURN END INTEGER FUNCTION COMTYP( BUF, DEFN) LOGICAL*1 BUF(512), DEFN(200) LOGICAL*1 C1, C2, NAME(40) INTEGER I INTEGER LUDEF, GETWRD COMMON /CMAC/ MACTBL INTEGER MACTBL LOGICAL*1 ERRSTR(24) LOGICAL*1 ERRTRM(3) DATA ERRSTR(1)/63/,ERRSTR(2)/32/,ERRSTR(3)/66/,ERRSTR(4)/97/,ERRST *R(5)/100/,ERRSTR(6)/32/,ERRSTR(7)/70/,ERRSTR(8)/79/,ERRSTR(9)/82/, *ERRSTR(10)/77/,ERRSTR(11)/65/,ERRSTR(12)/84/,ERRSTR(13)/32/,ERRSTR *(14)/99/,ERRSTR(15)/111/,ERRSTR(16)/109/,ERRSTR(17)/109/,ERRSTR(18 *)/97/,ERRSTR(19)/110/,ERRSTR(20)/100/,ERRSTR(21)/32/,ERRSTR(22)/96 */,ERRSTR(23)/46/,ERRSTR(24)/0/ DATA ERRTRM(1)/39/,ERRTRM(2)/10/,ERRTRM(3)/0/ I = 2 I = GETWRD( BUF, I, NAME) IF (.NOT.( I .GT. 2 ))GOTO 23093 NAME(3) = 0 23093 CONTINUE IF (.NOT.( LUDEF( NAME, DEFN, MACTBL) .EQ. 1 ))GOTO 23095 COMTYP=(-1) RETURN 23095 CONTINUE C1 = BUF(2) C2 = BUF(3) COMTYP = 0 I23097=( C1 ) GOTO 23097 23099 CONTINUE IF (.NOT.( C2 .EQ. 100 ))GOTO 23100 COMTYP = 16 GOTO 23101 23100 CONTINUE IF (.NOT.( C2 .EQ. 112 ))GOTO 23102 COMTYP = 5 GOTO 23103 23102 CONTINUE IF (.NOT.( C2 .EQ. 114 ))GOTO 23104 COMTYP = 3 GOTO 23105 23104 CONTINUE IF (.NOT.( C2 .EQ. 115 ))GOTO 23106 COMTYP = 27 23106 CONTINUE 23105 CONTINUE 23103 CONTINUE 23101 CONTINUE GOTO 23098 23108 CONTINUE IF (.NOT.( C2 .EQ. 99 ))GOTO 23109 COMTYP = 25 GOTO 23110 23109 CONTINUE IF (.NOT.( C2 .EQ. 101 ))GOTO 23111 COMTYP = 10 GOTO 23112 23111 CONTINUE IF (.NOT.( C2 .EQ. 117 ))GOTO 23113 COMTYP = 31 23113 CONTINUE 23112 CONTINUE 23110 CONTINUE GOTO 23098 23115 CONTINUE IF (.NOT.( C2 .EQ. 101 ))GOTO 23116 COMTYP = 32 23116 CONTINUE GOTO 23098 23118 CONTINUE IF (.NOT.( C2 .EQ. 102 ))GOTO 23119 COMTYP = 23 GOTO 23120 23119 CONTINUE IF (.NOT.( C2 .EQ. 104 ))GOTO 23121 COMTYP = 21 GOTO 23122 23121 CONTINUE IF (.NOT.( C2 .EQ. 110 ))GOTO 23123 COMTYP = 33 23123 CONTINUE 23122 CONTINUE 23120 CONTINUE GOTO 23098 23125 CONTINUE IF (.NOT.( C2 .EQ. 105 ))GOTO 23126 COMTYP = 1 GOTO 23127 23126 CONTINUE IF (.NOT.( C2 .EQ. 111 ))GOTO 23128 COMTYP = 13 23128 CONTINUE 23127 CONTINUE GOTO 23098 23130 CONTINUE IF (.NOT.( C2 .EQ. 101 ))GOTO 23131 COMTYP = 12 23131 CONTINUE GOTO 23098 23133 CONTINUE IF (.NOT.( C2 .EQ. 110 ))GOTO 23134 COMTYP = 7 23134 CONTINUE GOTO 23098 23136 CONTINUE IF (.NOT.( C2 .EQ. 117 ))GOTO 23137 COMTYP = 28 23137 CONTINUE GOTO 23098 23139 CONTINUE IF (.NOT.( C2 .EQ. 115 ))GOTO 23140 COMTYP = 4 23140 CONTINUE GOTO 23098 23142 CONTINUE IF (.NOT.( C2 .EQ. 49 ))GOTO 23143 COMTYP = 17 GOTO 23144 23143 CONTINUE IF (.NOT.( C2 .EQ. 50 ))GOTO 23145 COMTYP = 18 GOTO 23146 23145 CONTINUE IF (.NOT.( C2 .EQ. 51 ))GOTO 23147 COMTYP = 19 GOTO 23148 23147 CONTINUE IF (.NOT.( C2 .EQ. 52 ))GOTO 23149 COMTYP = 20 23149 CONTINUE 23148 CONTINUE 23146 CONTINUE 23144 CONTINUE GOTO 23098 23151 CONTINUE IF (.NOT.( C2 .EQ. 101 ))GOTO 23152 COMTYP = 26 GOTO 23153 23152 CONTINUE IF (.NOT.( C2 .EQ. 102 ))GOTO 23154 COMTYP = 2 GOTO 23155 23154 CONTINUE IF (.NOT.( C2 .EQ. 106 ))GOTO 23156 COMTYP = 29 GOTO 23157 23156 CONTINUE IF (.NOT.( C2 .EQ. 114 ))GOTO 23158 COMTYP = 34 23158 CONTINUE 23157 CONTINUE 23155 CONTINUE 23153 CONTINUE GOTO 23098 23160 CONTINUE IF (.NOT.( C2 .EQ. 102 ))GOTO 23161 COMTYP = 24 GOTO 23162 23161 CONTINUE IF (.NOT.( C2 .EQ. 104 ))GOTO 23163 COMTYP = 22 23163 CONTINUE 23162 CONTINUE GOTO 23098 23165 CONTINUE IF (.NOT.( C2 .EQ. 108 ))GOTO 23166 COMTYP = 14 GOTO 23167 23166 CONTINUE IF (.NOT.( C2 .EQ. 111 ))GOTO 23168 COMTYP = 15 23168 CONTINUE 23167 CONTINUE GOTO 23098 23170 CONTINUE IF (.NOT.( C2 .EQ. 109 ))GOTO 23171 COMTYP = 8 23171 CONTINUE GOTO 23098 23173 CONTINUE IF (.NOT.( C2 .EQ. 111 ))GOTO 23174 COMTYP = 30 GOTO 23175 23174 CONTINUE IF (.NOT.( C2 .EQ. 112 ))GOTO 23176 COMTYP = 6 GOTO 23177 23176 CONTINUE IF (.NOT.( C2 .EQ. 116 ))GOTO 23178 COMTYP = 35 23178 CONTINUE 23177 CONTINUE 23175 CONTINUE GOTO 23098 23180 CONTINUE IF (.NOT.( C2 .EQ. 105 ))GOTO 23181 COMTYP = 9 23181 CONTINUE GOTO 23098 23183 CONTINUE IF (.NOT.( C2 .EQ. 108 ))GOTO 23184 COMTYP = 11 23184 CONTINUE GOTO 23098 23097 CONTINUE I23097=I23097-97 IF (I23097.LT.1.OR.I23097.GT.20)GOTO 23098 GOTO (23099,23108,23115,23118,23125,23098,23130,23133,23136,23098, *23139,23142,23151,23160,23165,23098,23170,23173,23180,23183),I2309 *7 23098 CONTINUE IF (.NOT.( COMTYP .EQ. 0 ))GOTO 23186 IF (.NOT.(C1 .NE. 35))GOTO 23188 CALL PUTLIN( ERRSTR, 3) CALL PUTCH( C1, 3) CALL PUTCH( C2, 3) CALL PUTLIN( ERRTRM, 3) 23188 CONTINUE 23186 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(512), 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 23190 CALL ERROR(35Hmissing name in command definition.) 23190 CONTINUE IF (.NOT.(I .GT. 2))GOTO 23192 NAME(3) = 0 23192 CONTINUE I = 1 23194 IF (.NOT.(NGETLN(BUF, FD) .NE. -1))GOTO 23195 IF (.NOT.(BUF(1) .EQ. CCHAR .AND. BUF(2) .EQ. 101 .AND. BUF(3) .EQ *. 110))GOTO 23196 GOTO 23195 23196 CONTINUE JUNK = ADDSTR(BUF, DEFN, I, 200) GOTO 23194 23195 CONTINUE IF (.NOT.(ADDSET(0, DEFN, I, 200) .EQ. 0))GOTO 23198 CALL ERROR(20Hdefinition too long.) 23198 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 23200 IF (.NOT.(BUF(I) .NE. 0 .AND. J .LT. SIZE))GOTO 23202 IF (.NOT.(BUF(I) .NE. 64))GOTO 23203 TBUF(J) = BUF(I) J = J + 1 GOTO 23204 23203 CONTINUE IF (.NOT.(BUF(I+1) .EQ. 64))GOTO 23205 TBUF(J) = 64 J = J + 1 I = I + 1 GOTO 23206 23205 CONTINUE IF (.NOT.(BUF(I+1) .EQ. 110 .AND. (BUF(I+2) .GE. 97 .AND. BUF(I+2) * .LE. 122)))GOTO 23207 J = J + ITOC(NR(BUF(I+2)-97+1), TBUF(J), SIZE - J - 1) I = I + 2 GOTO 23208 23207 CONTINUE TBUF(J) = BUF(I) J = J + 1 23208 CONTINUE 23206 CONTINUE 23204 CONTINUE 23201 I = I + 1 GOTO 23200 23202 CONTINUE TBUF(J) = 0 CALL SCOPY(TBUF, 1, BUF, 1) RETURN END SUBROUTINE DOROFF(FD) INTEGER FD LOGICAL*1 INBUF(512) 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(512), 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 23209 IF (.NOT.(LEVEL .GT. 0))GOTO 23211 23212 IF (.NOT.(NGETLN(INBUF, INFILE(LEVEL)) .NE. -1))GOTO 23213 IF (.NOT.(INBUF(1) .EQ. CCHAR))GOTO 23214 CALL COMAND(INBUF) GOTO 23215 23214 CONTINUE CALL TEXT(INBUF) 23215 CONTINUE GOTO 23212 23213 CONTINUE IF (.NOT.(LEVEL .GT. 1 .AND. INFILE(LEVEL) .GE. 0))GOTO 23216 CALL CLOSE(INFILE(LEVEL)) 23216 CONTINUE 23210 LEVEL = LEVEL - 1 GOTO 23209 23211 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(512), 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 23218 IF (.NOT.(BUF(I) .NE. 0 .AND. J .LT. SIZE))GOTO 23220 IF (.NOT.(BUF(I) .EQ. 9))GOTO 23221 23223 IF (.NOT.(J .LT. SIZE))GOTO 23224 TBUF(J) = 32 J = J + 1 IF (.NOT.(TABS(J) .EQ. 1 .OR. J .GT. 512))GOTO 23225 GOTO 23224 23225 CONTINUE GOTO 23223 23224 CONTINUE GOTO 23222 23221 CONTINUE TBUF(J) = BUF(I) J = J + 1 23222 CONTINUE 23219 I = I + 1 GOTO 23218 23220 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 23227 IF (.NOT.(J .LE. 10))GOTO 23229 ARGPTR(J) = 1 23228 J = J + 1 GOTO 23227 23229 CONTINUE BUF(1) = 0 I = 2 J = 1 23230 IF (.NOT.(J .LE. 10))GOTO 23232 CALL SKIPBL(BUF, I) IF (.NOT.(BUF(I) .EQ. 10 .OR. BUF(I) .EQ. 0))GOTO 23233 GOTO 23232 23233 CONTINUE ARGPTR(J) = I 23235 IF (.NOT.(BUF(I) .NE. 32 .AND. BUF(I) .NE. 9 .AND. BUF(I) .NE. 10 *.AND. BUF(I) .NE. 0))GOTO 23236 I = I + 1 GOTO 23235 23236 CONTINUE BUF(I) = 0 I = I + 1 23231 J = J + 1 GOTO 23230 23232 CONTINUE K = LENGTH(DEFN) 23237 IF (.NOT.(K .GT. 1))GOTO 23239 IF (.NOT.(DEFN(K-1) .NE. 36))GOTO 23240 CALL PUTBAK(DEFN(K)) GOTO 23241 23240 CONTINUE IF (.NOT.(DEFN(K) .LT. 48 .OR. DEFN(K) .GT. 57))GOTO 23242 CALL PUTBAK(DEFN(K)) GOTO 23243 23242 CONTINUE I = DEFN(K) - 48 + 1 I = ARGPTR(I) CALL PBSTR(BUF(I)) K = K - 1 23243 CONTINUE 23241 CONTINUE 23238 K = K - 1 GOTO 23237 23239 CONTINUE IF (.NOT.(K .GT. 0))GOTO 23244 CALL PUTBAK(DEFN(K)) 23244 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(512), 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(512) INTEGER OUTP INTEGER OUTW INTEGER OUTWDS LOGICAL*1 OUTBUF COMMON /CDEFIO/ BP, BUF(512) 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 23246 IF (.NOT.(I .LE. 512))GOTO 23248 IF (.NOT.(MOD(I, 8) .EQ. 1))GOTO 23249 TABS(I) = 1 GOTO 23250 23249 CONTINUE TABS(I) = 0 23250 CONTINUE 23247 I = I + 1 GOTO 23246 23248 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 23251 IF (.NOT.(I .LE. 26))GOTO 23253 NR(I) = 0 23252 I = I + 1 GOTO 23251 23253 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(512), 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 23254 IF (.NOT.(BUF(I) .NE. 32 .AND. BUF(I) .NE. 9 .AND. BUF(I) .NE. 10) *)GOTO 23255 I = I + 1 GOTO 23254 23255 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 23256 I = I + 1 23256 CONTINUE GETVAL = CTOI(BUF, I) RETURN END INTEGER FUNCTION GETWRB(IN, I, OUT) LOGICAL*1 IN(100), OUT(100) INTEGER I, J J = 1 23258 IF (.NOT.(IN(I) .NE. 0 .AND. IN(I) .NE. 32 .AND. IN(I) .NE. 9 .AND *. IN(I) .NE. 10))GOTO 23259 OUT(J) = IN(I) I = I + 1 J = J + 1 GOTO 23258 23259 CONTINUE 23260 IF (.NOT.(IN(I) .EQ. 32))GOTO 23261 OUT(J) = 32 I = I + 1 J = J + 1 GOTO 23260 23261 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 23262 IF (.NOT.(BUF(I) .EQ. DELIM))GOTO 23264 I = I + 1 23264 CONTINUE 23266 IF (.NOT.(BUF(I) .NE. DELIM .AND. BUF(I) .NE. 0 .AND. BUF(I) .NE. *10 .AND. J .LE. N))GOTO 23267 TEMP(J) = BUF(I) J = J + 1 I = I + 1 GOTO 23266 23267 CONTINUE 23262 CONTINUE TEMP(J) = 0 GFIELD = J - 1 23268 IF (.NOT.(BUF(I) .NE. DELIM .AND. BUF(I) .NE. 0 .AND. BUF(I) .NE. *10))GOTO 23269 I = I + 1 GOTO 23268 23269 CONTINUE RETURN END SUBROUTINE JCOPY(FROM, I, TO, J) LOGICAL*1 FROM(100), TO(100) INTEGER I, J, K1, K2 K1 = I K2 = J 23270 IF (.NOT.(FROM(K1) .NE. 0))GOTO 23271 TO(K2) = FROM(K1) K1 = K1 + 1 K2 = K2 + 1 GOTO 23270 23271 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 23272 CALL JCOPY(IN, 1, OUT, RIGHT-N) GOTO 23273 23272 CONTINUE IF (.NOT.(TYPE .EQ. 2))GOTO 23274 J = MAX0((RIGHT+LEFT-N)/2, LEFT) CALL JCOPY(IN, 1, OUT, J) GOTO 23275 23274 CONTINUE CALL JCOPY(IN, 1, OUT, LEFT) 23275 CONTINUE 23273 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(512), 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 23276 IF (.NOT.(BUF(I) .EQ. 32))GOTO 23278 23277 I = I + 1 GOTO 23276 23278 CONTINUE IF (.NOT.(BUF(I) .NE. 10))GOTO 23279 TIVAL = TIVAL + I - 1 23279 CONTINUE J = 1 23281 IF (.NOT.(BUF(I) .NE. 0))GOTO 23283 BUF(J) = BUF(I) I = I + 1 23282 J = J + 1 GOTO 23281 23283 CONTINUE BUF(J) = 0 RETURN END LOGICAL*1 FUNCTION NGETCH(C, FD) LOGICAL*1 C INTEGER FD LOGICAL*1 GETCH COMMON /CDEFIO/ BP, BUF(512) INTEGER BP LOGICAL*1 BUF IF (.NOT.(BP .GT. 0))GOTO 23284 C = BUF(BP) BP = BP - 1 GOTO 23285 23284 CONTINUE C = GETCH(C, FD) 23285 CONTINUE NGETCH = C RETURN END INTEGER FUNCTION NGETLN(LINE, F) LOGICAL*1 LINE(512), C, NGETCH INTEGER F NGETLN = 0 23286 IF (.NOT.(NGETCH(C, F) .NE. -1))GOTO 23288 IF (.NOT.(NGETLN .LT. 512 - 1))GOTO 23289 NGETLN = NGETLN + 1 LINE(NGETLN) = C 23289 CONTINUE IF (.NOT.(C .EQ. 10))GOTO 23291 GOTO 23288 23291 CONTINUE 23287 GOTO 23286 23288 CONTINUE LINE(NGETLN+1) = 0 IF (.NOT.(NGETLN .EQ. 0 .AND. C .EQ. -1))GOTO 23293 NGETLN = -1 23293 CONTINUE RETURN END SUBROUTINE PBSTR(IN) LOGICAL*1 IN(512) INTEGER LENGTH INTEGER I I = LENGTH(IN) 23295 IF (.NOT.(I .GT. 0))GOTO 23297 CALL PUTBAK(IN(I)) 23296 I = I - 1 GOTO 23295 23297 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 23298 IF (.NOT.(MOD(CURPAG, 2) .EQ. 1))GOTO 23300 CALL PUTTL(EFOOT, EFLIM, CURPAG) GOTO 23301 23300 CONTINUE CALL PUTTL(OFOOT, OFLIM, CURPAG) 23301 CONTINUE 23298 CONTINUE IF (.NOT.(PRINT .EQ. 1))GOTO 23302 CALL PUTCH(12,2) IF (.NOT.(STOPX .GT. 0))GOTO 23304 CALL PUTCH(10,2) 23304 CONTINUE 23302 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 23306 PRINT = 1 GOTO 23307 23306 CONTINUE PRINT = 0 23307 CONTINUE IF (.NOT.(STOPX .GT. 0 .AND. PRINT .EQ. 1))GOTO 23308 CALL PRMPT(STOPX) 23308 CONTINUE NEWPAG = NEWPAG + 1 IF (.NOT.(M1VAL .GT. 0))GOTO 23310 CALL SKIP(M1VAL-1) IF (.NOT.(MOD(CURPAG, 2) .EQ. 0))GOTO 23312 CALL PUTTL(EHEAD, EHLIM, CURPAG) GOTO 23313 23312 CONTINUE CALL PUTTL(OHEAD, OHLIM, CURPAG) 23313 CONTINUE 23310 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), BELLST(2) 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/ DATA BELLST / 7, 0 / TIN = OPEN(TRMIN, 3) IF (.NOT.(TIN .EQ. -3))GOTO 23314 RETURN 23314 CONTINUE IF (.NOT.(I .EQ. 1))GOTO 23316 JUNK = PROMPT(TELL, LINE, TIN) GOTO 23317 23316 CONTINUE JUNK = PROMPT(BELLST, LINE, TIN) 23317 CONTINUE CALL CLOSE(TIN) I = I + 1 RETURN END SUBROUTINE PUT(BUF) 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(512), 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 LOGICAL*1 BUF(512) DATA CUFLG /0/ IF (.NOT.( LINENO .EQ. 0 .OR. LINENO .GT. BOTTOM ))GOTO 23318 CALL PHEAD 23318 CONTINUE IF (.NOT.( PRINT .EQ. 1 ))GOTO 23320 I = 1 23322 IF (.NOT.(I .LE. OFFSET ))GOTO 23324 CALL PUTCH(32,2) 23323 I = I + 1 GOTO 23322 23324 CONTINUE I = 1 23325 IF (.NOT.(I .LE. TIVAL ))GOTO 23327 CALL PUTCH(32,2) 23326 I = I + 1 GOTO 23325 23327 CONTINUE I = 1 23328 IF (.NOT.(BUF(I) .NE. 0 .AND. BUF(I) .NE. 10 ))GOTO 23330 IF (.NOT.( BUF(I) .EQ. -10 ))GOTO 23331 CUFLG = 1 GOTO 23332 23331 CONTINUE IF (.NOT.( BUF(I) .EQ. -11 ))GOTO 23333 CUFLG = 0 GOTO 23334 23333 CONTINUE IF (.NOT.( CUFLG .EQ. 1 ))GOTO 23335 23337 IF (.NOT.(BUF(I) .NE. -11 .AND. BUF(I) .NE. 10 .AND. BUF(I) .NE. 0 *))GOTO 23339 CALL PUTCH(95, 2) CALL PUTCH(8, 2) CALL PUTCH(BUF(I), 2) 23338 I = I + 1 GOTO 23337 23339 CONTINUE I = I - 1 GOTO 23336 23335 CONTINUE CALL PUTCH( BUF(I), 2) 23336 CONTINUE 23334 CONTINUE 23332 CONTINUE 23329 I = I + 1 GOTO 23328 23330 CONTINUE CALL PUTCH(10, 2) 23320 CONTINUE TIVAL = INVAL CALL SKIP( MIN0( LSVAL-1, BOTTOM-LINENO)) LINENO = LINENO + LSVAL IF (.NOT.( LINENO .GT. BOTTOM ))GOTO 23340 CALL PFOOT 23340 CONTINUE RETURN END SUBROUTINE PUTBAK(C) LOGICAL*1 C COMMON /CDEFIO/ BP, BUF(512) INTEGER BP LOGICAL*1 BUF BP = BP + 1 IF (.NOT.(BP .GT. 512))GOTO 23342 CALL ERROR(32Htoo many characters pushed back.) 23342 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(512), 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 23344 RETURN 23344 CONTINUE LEFT = LIM(1) + 1 RIGHT = LIM(2) + 1 NC = ITOC(PAGENO, CHARS, 20) CALL GETNOW (NOW) CALL FMTDAT (CDATE, TBUF1, NOW, 1) NCD = LENGTH(CDATE) I = 1 DELIM = BUF(I) J = 1 23346 IF (.NOT.(J .LT. RIGHT))GOTO 23348 TTL(J) = 32 23347 J = J + 1 GOTO 23346 23348 CONTINUE N = 0 23349 CONTINUE N = N + 1 IF (.NOT.(GFIELD(BUF, I, RIGHT-LEFT, TBUF1, DELIM) .GT. 0))GOTO 23 *352 CALL SUBST(TBUF1, 35, TBUF2, CHARS, NC) CALL SUBST(TBUF2, 37, TBUF1, CDATE, NCD) CALL JUSTFY(TBUF1, LEFT, RIGHT, TJUST(N), TTL) 23352 CONTINUE 23350 IF (.NOT.(BUF(I) .EQ. 0 .OR. BUF(I) .EQ. 10 .OR. N .EQ. 3))GOTO 23 *349 23351 CONTINUE 23354 IF (.NOT.(RIGHT .GT. 1 ))GOTO 23356 IF (.NOT.( TTL(RIGHT-1) .NE. 32 ))GOTO 23357 GOTO 23356 23357 CONTINUE 23355 RIGHT = RIGHT - 1 GOTO 23354 23356 CONTINUE TTL(RIGHT) = 10 TTL(RIGHT+1) = 0 I = 1 23359 IF (.NOT.(I .LE. OFFSET))GOTO 23361 CALL PUTCH(32,2) 23360 I = I + 1 GOTO 23359 23361 CONTINUE CALL PUTLIN(TTL, 2) RETURN END SUBROUTINE PUTWRD(WRDBUF) LOGICAL*1 WRDBUF(512) INTEGER LENGTH, WIDTH INTEGER LAST, LLVAL, NEXTRA, W COMMON /COUT/ OUTP, OUTW, OUTWDS, OUTBUF(512) 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(512), 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. 512))GOTO 23362 LAST = LAST - OUTP NEXTRA = LLVAL - OUTW OUTP = OUTP + 1 23364 IF (.NOT.(OUTP .GT. 1))GOTO 23366 IF (.NOT.(OUTBUF(OUTP-1) .EQ. 32))GOTO 23367 NEXTRA = NEXTRA + 1 GOTO 23368 23367 CONTINUE GOTO 23366 23368 CONTINUE 23365 OUTP = OUTP - 1 GOTO 23364 23366 CONTINUE IF (.NOT.(RJUST .EQ. 1))GOTO 23369 CALL SPREAD(OUTBUF, OUTP, NEXTRA, OUTWDS) IF (.NOT.(NEXTRA .GT. 0 .AND. OUTWDS .GT. 1))GOTO 23371 OUTP = OUTP + NEXTRA 23371 CONTINUE 23369 CONTINUE CALL BRK 23362 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 23373 PARAM = DEFVAL GOTO 23374 23373 CONTINUE IF (.NOT.(ARGTYP .EQ. 43))GOTO 23375 PARAM = PARAM + VAL GOTO 23376 23375 CONTINUE IF (.NOT.(ARGTYP .EQ. 45))GOTO 23377 PARAM = PARAM - VAL GOTO 23378 23377 CONTINUE PARAM = VAL 23378 CONTINUE 23376 CONTINUE 23374 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 23379 I = 1 23381 IF (.NOT.(I .LE. N))GOTO 23383 CALL PUTCH(10,2) 23382 I = I + 1 GOTO 23381 23383 CONTINUE 23379 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 23384 RETURN 23384 CONTINUE IF (.NOT.(LINENO .EQ. 0))GOTO 23386 CALL PHEAD 23386 CONTINUE CALL SKIP(MIN0(N, BOTTOM+1-LINENO)) LINENO = LINENO + N IF (.NOT.(LINENO .GT. BOTTOM))GOTO 23388 CALL PFOOT 23388 CONTINUE RETURN END SUBROUTINE SPREAD(BUF, OUTP, NEXTRA, OUTWDS) LOGICAL*1 BUF(512) COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(512), 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 23390 RETURN 23390 CONTINUE DIR = 1 - DIR NE = NEXTRA NHOLES = OUTWDS - 1 IF (.NOT.(TIVAL .NE. INVAL .AND. NHOLES .GT. 1))GOTO 23392 NHOLES = NHOLES - 1 23392 CONTINUE I = OUTP - 1 J = MIN0(512-2, I+NE) 23394 IF (.NOT.(I .LT. J))GOTO 23395 BUF(J) = BUF(I) IF (.NOT.(BUF(I) .EQ. 32 .AND. BUF(I-1) .NE. 32))GOTO 23396 IF (.NOT.(DIR .EQ. 0))GOTO 23398 NB = (NE-1) / NHOLES + 1 GOTO 23399 23398 CONTINUE NB = NE / NHOLES 23399 CONTINUE NE = NE - NB NHOLES = NHOLES - 1 23400 IF (.NOT.(NB .GT. 0))GOTO 23402 J = J - 1 BUF(J) = 32 23401 NB = NB - 1 GOTO 23400 23402 CONTINUE 23396 CONTINUE I = I - 1 J = J - 1 GOTO 23394 23395 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 23403 IF (.NOT.(IN(I) .NE. 0))GOTO 23405 IF (.NOT.(IN(I) .EQ. CHAR))GOTO 23406 K = 1 23408 IF (.NOT.(K .LE. N))GOTO 23410 OUT(J) = SUBARA(K) J = J + 1 23409 K = K + 1 GOTO 23408 23410 CONTINUE GOTO 23407 23406 CONTINUE OUT(J) = IN(I) J = J + 1 23407 CONTINUE 23404 I = I + 1 GOTO 23403 23405 CONTINUE OUT(J) = 0 RETURN END SUBROUTINE TEXT(INBUF) INTEGER GETWRB, LENGTH INTEGER I, CUFLG COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, CUVAL, TABS(512), 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 LOGICAL*1 INBUF(512), WRDBUF(512) DATA CUFLG /0/ CALL DOESC( INBUF, WRDBUF, 512) CALL DOTABS( INBUF, WRDBUF, 512) IF (.NOT.( INBUF(1) .EQ. 32 .OR. INBUF(1) .EQ. 10 ))GOTO 23411 CALL LEADBL(INBUF) 23411 CONTINUE IF (.NOT.( ULVAL .GT. 0 ))GOTO 23413 CALL UNDERL( INBUF, WRDBUF, 512) ULVAL = ULVAL - 1 23413 CONTINUE IF (.NOT.( CUVAL .GT. 0 ))GOTO 23415 IF (.NOT.( CUFLG .EQ. 0 ))GOTO 23417 CALL STRCPY( INBUF, WRDBUF) INBUF(1) = -10 CALL SCOPY( WRDBUF, 1, INBUF, 2) CUFLG = 1 23417 CONTINUE CUVAL = CUVAL - 1 IF (.NOT.( CUFLG .EQ. 1 .AND. CUVAL .EQ. 0 ))GOTO 23419 I = LENGTH(INBUF) INBUF(I) = -11 INBUF(I+1) = 10 INBUF(I+2) = 0 CUFLG = 0 23419 CONTINUE 23415 CONTINUE IF (.NOT.( BOVAL .GT. 0 ))GOTO 23421 CALL BOLD( INBUF, WRDBUF, 512) BOVAL = BOVAL - 1 23421 CONTINUE IF (.NOT.( CEVAL .GT. 0 ))GOTO 23423 CALL CENTER(INBUF) CALL PUT(INBUF) CEVAL = CEVAL - 1 GOTO 23424 23423 CONTINUE IF (.NOT.( INBUF(1) .EQ. 10 ))GOTO 23425 CALL PUT(INBUF) GOTO 23426 23425 CONTINUE IF (.NOT.( FILL .EQ. 0 ))GOTO 23427 CALL PUT(INBUF) GOTO 23428 23427 CONTINUE I = LENGTH(INBUF) INBUF(I) = 32 IF (.NOT.( INBUF(I-1) .EQ. 46 ))GOTO 23429 I = I + 1 INBUF(I) = 32 23429 CONTINUE INBUF(I+1) = 0 I = 1 23431 IF (.NOT.(GETWRB( INBUF, I, WRDBUF) .GT. 0 ))GOTO 23433 CALL PUTWRD(WRDBUF) 23432 GOTO 23431 23433 CONTINUE 23428 CONTINUE 23426 CONTINUE 23424 CONTINUE RETURN END SUBROUTINE UNDERL( BUF, TBUF, SIZE) INTEGER I, J, SIZE, T, TYPE LOGICAL*1 BUF(100), TBUF(100) J = 1 I = 1 23434 IF (.NOT.( J .LT. SIZE - 1 ))GOTO 23435 T = TYPE(BUF(I)) 23436 IF (.NOT.( T .NE. 1 .AND. T .NE. 2 .AND. T .NE. 10 .AND. T .NE. 0 *))GOTO 23438 TBUF(J) = BUF(I) I = I + 1 J = J + 1 23437 T = TYPE(BUF(I)) GOTO 23436 23438 CONTINUE IF (.NOT.( BUF(I) .EQ. 0 .OR. BUF(I) .EQ. 10 ))GOTO 23439 GOTO 23435 23439 CONTINUE TBUF(J) = -10 J = J + 1 T = TYPE(BUF(I)) 23441 IF (.NOT.( T .EQ. 1 .OR. T .EQ. 2 .OR. T .EQ. 45 ))GOTO 23443 TBUF(J) = BUF(I) I = I + 1 J = J + 1 23442 T = TYPE(BUF(I)) GOTO 23441 23443 CONTINUE TBUF(J) = -11 J = J + 1 GOTO 23434 23435 CONTINUE TBUF(J) = 10 TBUF(J+1) = 0 CALL STRCPY( TBUF, BUF) RETURN END INTEGER FUNCTION WIDTH(BUF) LOGICAL*1 BUF(512) INTEGER I WIDTH = 0 I = 1 23444 IF (.NOT.(BUF(I) .NE. 0))GOTO 23446 IF (.NOT.(BUF(I) .EQ. 8))GOTO 23447 WIDTH = WIDTH - 1 GOTO 23448 23447 CONTINUE IF (.NOT.(BUF(I) .GE. 32 .AND. BUF(I) .LE. 126))GOTO 23449 WIDTH = WIDTH + 1 23449 CONTINUE 23448 CONTINUE 23445 I = I + 1 GOTO 23444 23446 CONTINUE RETURN END