SUBROUTINE MAIN LOGICAL*1 ARG(402) INTEGER GETARG, OPEN, CTOI, GETVAL INTEGER I, FD, NF, J, VAL, ARGTYP 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 FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER TABS LOGICAL*1 CCHAR LOGICAL*1 ULBLNK INTEGER OUTP INTEGER OUTW INTEGER OUTWDS LOGICAL*1 OUTBUF LOGICAL*1 ST001Z(48) LOGICAL*1 ST002Z(14) COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(402), OHEAD(402), EHLIM(2), OHLIM(2), EFOOT(402), O *FOOT(402), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, TABS(402), CCHAR, ULBLNK COMMON /COUT/ OUTP, OUTW, OUTWDS, OUTBUF(402) DATA ST001Z(1)/117/,ST001Z(2)/115/,ST001Z(3)/97/,ST001Z(4)/103/,ST *001Z(5)/101/,ST001Z(6)/58/,ST001Z(7)/32/,ST001Z(8)/32/,ST001Z(9)/1 *02/,ST001Z(10)/111/,ST001Z(11)/114/,ST001Z(12)/109/,ST001Z(13)/97/ *,ST001Z(14)/116/,ST001Z(15)/32/,ST001Z(16)/91/,ST001Z(17)/43/,ST00 *1Z(18)/110/,ST001Z(19)/93/,ST001Z(20)/32/,ST001Z(21)/91/,ST001Z(22 *)/45/,ST001Z(23)/110/,ST001Z(24)/93/,ST001Z(25)/32/,ST001Z(26)/91/ *,ST001Z(27)/45/,ST001Z(28)/115/,ST001Z(29)/93/,ST001Z(30)/32/,ST00 *1Z(31)/91/,ST001Z(32)/45/,ST001Z(33)/112/,ST001Z(34)/111/,ST001Z(3 *5)/110/,ST001Z(36)/93/,ST001Z(37)/32/,ST001Z(38)/91/,ST001Z(39)/10 *2/,ST001Z(40)/105/,ST001Z(41)/108/,ST001Z(42)/101/,ST001Z(43)/93/, *ST001Z(44)/32/,ST001Z(45)/46/,ST001Z(46)/46/,ST001Z(47)/46/,ST001Z *(48)/0/ DATA ST002Z(1)/58/,ST002Z(2)/32/,ST002Z(3)/32/,ST002Z(4)/99/,ST002 *Z(5)/97/,ST002Z(6)/110/,ST002Z(7)/39/,ST002Z(8)/116/,ST002Z(9)/32/ *,ST002Z(10)/111/,ST002Z(11)/112/,ST002Z(12)/101/,ST002Z(13)/110/,S *T002Z(14)/0/ CALL FINIT NF = 0 CALL QUERY (ST001Z) I = 1 23000 IF (.NOT.(GETARG(I, ARG, 402) .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 (ST002Z) 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 *))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 INTEGER OUTP INTEGER OUTW INTEGER OUTWDS LOGICAL*1 OUTBUF COMMON /COUT/ OUTP, OUTW, OUTWDS, OUTBUF(402) 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 INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER TABS LOGICAL*1 CCHAR LOGICAL*1 ULBLNK COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, TABS(402), CCHAR, ULBLNK TIVAL = MAX0((RMVAL+TIVAL-WIDTH(BUF))/2, 0) RETURN END SUBROUTINE COMAND(BUF) LOGICAL*1 BUF(402), NAME(402), DEFN(200) INTEGER COMTYP, GETVAL, GETWRD, LENGTH, MAX0, OPEN INTEGER ARGTYP, CT, SPVAL, VAL, I, J 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 FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER TABS LOGICAL*1 CCHAR LOGICAL*1 ULBLNK INTEGER INFILE INTEGER LEVEL INTEGER NR INTEGER I23032 LOGICAL*1 ST003Z(32) LOGICAL*1 ST004Z(31) COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(402), OHEAD(402), EHLIM(2), OHLIM(2), EFOOT(402), O *FOOT(402), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, TABS(402), CCHAR, ULBLNK COMMON /CFILES/ INFILE(3), LEVEL COMMON /CNR/ NR(26) DATA ST003Z(1)/63/,ST003Z(2)/32/,ST003Z(3)/83/,ST003Z(4)/79/,ST003 *Z(5)/32/,ST003Z(6)/99/,ST003Z(7)/111/,ST003Z(8)/109/,ST003Z(9)/109 */,ST003Z(10)/97/,ST003Z(11)/110/,ST003Z(12)/100/,ST003Z(13)/115/,S *T003Z(14)/32/,ST003Z(15)/110/,ST003Z(16)/101/,ST003Z(17)/115/,ST00 *3Z(18)/116/,ST003Z(19)/101/,ST003Z(20)/100/,ST003Z(21)/32/,ST003Z( *22)/116/,ST003Z(23)/111/,ST003Z(24)/111/,ST003Z(25)/32/,ST003Z(26) */100/,ST003Z(27)/101/,ST003Z(28)/101/,ST003Z(29)/112/,ST003Z(30)/1 *08/,ST003Z(31)/121/,ST003Z(32)/0/ DATA ST004Z(1)/63/,ST004Z(2)/32/,ST004Z(3)/73/,ST004Z(4)/110/,ST00 *4Z(5)/118/,ST004Z(6)/97/,ST004Z(7)/108/,ST004Z(8)/105/,ST004Z(9)/1 *00/,ST004Z(10)/32/,ST004Z(11)/110/,ST004Z(12)/117/,ST004Z(13)/109/ *,ST004Z(14)/98/,ST004Z(15)/101/,ST004Z(16)/114/,ST004Z(17)/32/,ST0 *04Z(18)/114/,ST004Z(19)/101/,ST004Z(20)/103/,ST004Z(21)/105/,ST004 *Z(22)/115/,ST004Z(23)/116/,ST004Z(24)/101/,ST004Z(25)/114/,ST004Z( *26)/32/,ST004Z(27)/110/,ST004Z(28)/97/,ST004Z(29)/109/,ST004Z(30)/ *101/,ST004Z(31)/0/ CT = COMTYP( BUF, DEFN) IF (.NOT.( CT .EQ. 0 ))GOTO 23028 RETURN 23028 CONTINUE CALL DOESC( BUF, NAME, 402) 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 ULBLNK = 32 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(ST003Z) 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 ULBLNK = 95 CALL SET( ULVAL, 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(ST004Z) 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(402), DEFN(200) LOGICAL*1 C1, C2, NAME(36) LOGICAL*1 CLOWER INTEGER I INTEGER LUDEF, GETWRD INTEGER MACTBL LOGICAL*1 ERRSTR(24) LOGICAL*1 ERRTRM(3) INTEGER I23097 COMMON /CMAC/ MACTBL 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 = CLOWER(BUF(2)) C2 = CLOWER(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(402) INTEGER FD LOGICAL*1 NAME(36), DEFN(200) INTEGER I, JUNK INTEGER GETWRD, ADDSTR, ADDSET, NGETLN INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER TABS LOGICAL*1 CCHAR LOGICAL*1 ULBLNK INTEGER MACTBL LOGICAL*1 ST005Z(35) LOGICAL*1 ST006Z(20) COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, TABS(402), CCHAR, ULBLNK COMMON /CMAC/ MACTBL DATA ST005Z(1)/109/,ST005Z(2)/105/,ST005Z(3)/115/,ST005Z(4)/115/,S *T005Z(5)/105/,ST005Z(6)/110/,ST005Z(7)/103/,ST005Z(8)/32/,ST005Z(9 *)/110/,ST005Z(10)/97/,ST005Z(11)/109/,ST005Z(12)/101/,ST005Z(13)/3 *2/,ST005Z(14)/105/,ST005Z(15)/110/,ST005Z(16)/32/,ST005Z(17)/99/,S *T005Z(18)/111/,ST005Z(19)/109/,ST005Z(20)/109/,ST005Z(21)/97/,ST00 *5Z(22)/110/,ST005Z(23)/100/,ST005Z(24)/32/,ST005Z(25)/100/,ST005Z( *26)/101/,ST005Z(27)/102/,ST005Z(28)/105/,ST005Z(29)/110/,ST005Z(30 *)/105/,ST005Z(31)/116/,ST005Z(32)/105/,ST005Z(33)/111/,ST005Z(34)/ *110/,ST005Z(35)/0/ DATA ST006Z(1)/100/,ST006Z(2)/101/,ST006Z(3)/102/,ST006Z(4)/105/,S *T006Z(5)/110/,ST006Z(6)/105/,ST006Z(7)/116/,ST006Z(8)/105/,ST006Z( *9)/111/,ST006Z(10)/110/,ST006Z(11)/32/,ST006Z(12)/116/,ST006Z(13)/ *111/,ST006Z(14)/111/,ST006Z(15)/32/,ST006Z(16)/108/,ST006Z(17)/111 */,ST006Z(18)/110/,ST006Z(19)/103/,ST006Z(20)/0/ I = 1 JUNK = GETWRD(BUF, I, NAME) I = GETWRD(BUF, I, NAME) IF (.NOT.(I .EQ. 0))GOTO 23190 CALL ERROR(ST005Z) 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(ST006Z) 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 INTEGER NR COMMON /CNR/ NR(26) 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(402) INTEGER NGETLN INTEGER INFILE INTEGER LEVEL INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER TABS LOGICAL*1 CCHAR LOGICAL*1 ULBLNK COMMON /CFILES/ INFILE(3), LEVEL COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, TABS(402), CCHAR, ULBLNK 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 INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER TABS LOGICAL*1 CCHAR LOGICAL*1 ULBLNK COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, TABS(402), CCHAR, ULBLNK 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. 402))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(402), 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 INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER TABS LOGICAL*1 CCHAR LOGICAL*1 ULBLNK 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 OUTP INTEGER OUTW INTEGER OUTWDS LOGICAL*1 OUTBUF INTEGER BP LOGICAL*1 BUF INTEGER NR INTEGER MACTBL INTEGER MEM( 5000) LOGICAL*1 CMEM(10000) COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, TABS(402), CCHAR, ULBLNK COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(402), OHEAD(402), EHLIM(2), OHLIM(2), EFOOT(402), O *FOOT(402), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T COMMON /COUT/ OUTP, OUTW, OUTWDS, OUTBUF(402) COMMON /CDEFIO/ BP, BUF(402) COMMON /CNR/ NR(26) COMMON /CMAC/ MACTBL COMMON /CDSMEM/ MEM EQUIVALENCE (CMEM(1),MEM(1)) 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 ULBLNK = 32 I = 1 23246 IF (.NOT.(I .LE. 402))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(402), TTL(402) INTEGER I, LIM(2) INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER TABS LOGICAL*1 CCHAR LOGICAL*1 ULBLNK COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, TABS(402), CCHAR, ULBLNK 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(402) 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(402) INTEGER MAX0 INTEGER I, J INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER TABS LOGICAL*1 CCHAR LOGICAL*1 ULBLNK COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, TABS(402), CCHAR, ULBLNK 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 = 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 INTEGER BP LOGICAL*1 BUF COMMON /CDEFIO/ BP, BUF(402) 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(402), C, NGETCH INTEGER F NGETLN = 0 23286 IF (.NOT.(NGETCH(C, F) .NE. -1))GOTO 23288 IF (.NOT.(NGETLN .LT. 402 - 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(402) 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 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 /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(402), OHEAD(402), EHLIM(2), OHLIM(2), EFOOT(402), O *FOOT(402), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T 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 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(402) INTEGER MOD COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(402), OHEAD(402), EHLIM(2), OHLIM(2), EFOOT(402), O *FOOT(402), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T 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(402), 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 INTEGER I 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 FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER TABS LOGICAL*1 CCHAR LOGICAL*1 ULBLNK LOGICAL*1 BUF(100) COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(402), OHEAD(402), EHLIM(2), OHLIM(2), EFOOT(402), O *FOOT(402), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, TABS(402), CCHAR, ULBLNK 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 CALL PUTLIN( BUF, 2) 23320 CONTINUE TIVAL = INVAL CALL SKIP( MIN0( LSVAL-1, BOTTOM-LINENO)) LINENO = LINENO + LSVAL IF (.NOT.( LINENO .GT. BOTTOM ))GOTO 23328 CALL PFOOT 23328 CONTINUE RETURN END SUBROUTINE PUTBAK(C) LOGICAL*1 C INTEGER BP LOGICAL*1 BUF LOGICAL*1 ST007Z(32) COMMON /CDEFIO/ BP, BUF(402) DATA ST007Z(1)/116/,ST007Z(2)/111/,ST007Z(3)/111/,ST007Z(4)/32/,ST *007Z(5)/109/,ST007Z(6)/97/,ST007Z(7)/110/,ST007Z(8)/121/,ST007Z(9) */32/,ST007Z(10)/99/,ST007Z(11)/104/,ST007Z(12)/97/,ST007Z(13)/114/ *,ST007Z(14)/97/,ST007Z(15)/99/,ST007Z(16)/116/,ST007Z(17)/101/,ST0 *07Z(18)/114/,ST007Z(19)/115/,ST007Z(20)/32/,ST007Z(21)/112/,ST007Z *(22)/117/,ST007Z(23)/115/,ST007Z(24)/104/,ST007Z(25)/101/,ST007Z(2 *6)/100/,ST007Z(27)/32/,ST007Z(28)/98/,ST007Z(29)/97/,ST007Z(30)/99 */,ST007Z(31)/107/,ST007Z(32)/0/ BP = BP + 1 IF (.NOT.(BP .GT. 402))GOTO 23330 CALL ERROR(ST007Z) 23330 CONTINUE BUF(BP) = C RETURN END SUBROUTINE PUTTL(BUF, LIM, PAGENO) LOGICAL*1 BUF(402), CHARS(20), DELIM, CDATE(20) INTEGER PAGENO, LIM(2) INTEGER NC, ITOC, I, J, N, LEFT, RIGHT, GFIELD, NCD, NOW (7) INTEGER LENGTH 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 FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER TABS LOGICAL*1 CCHAR LOGICAL*1 ULBLNK LOGICAL*1 TBUF1 LOGICAL*1 TBUF2 LOGICAL*1 TTL COMMON /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(402), OHEAD(402), EHLIM(2), OHLIM(2), EFOOT(402), O *FOOT(402), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, TABS(402), CCHAR, ULBLNK COMMON /CTEMP/ TBUF1(402), TBUF2(402), TTL(402) IF (.NOT.(PRINT .EQ. 0))GOTO 23332 RETURN 23332 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 23334 IF (.NOT.(J .LT. RIGHT))GOTO 23336 TTL(J) = 32 23335 J = J + 1 GOTO 23334 23336 CONTINUE N = 0 23337 CONTINUE N = N + 1 IF (.NOT.(GFIELD(BUF, I, RIGHT-LEFT, TBUF1, DELIM) .GT. 0))GOTO 23 *340 CALL SUBST(TBUF1, 35, TBUF2, CHARS, NC) CALL SUBST(TBUF2, 37, TBUF1, CDATE, NCD) CALL JUSTFY(TBUF1, LEFT, RIGHT, TJUST(N), TTL) 23340 CONTINUE 23338 IF (.NOT.(BUF(I) .EQ. 0 .OR. BUF(I) .EQ. 10 .OR. N .EQ. 3))GOTO 23 *337 23339 CONTINUE 23342 IF (.NOT.(RIGHT .GT. 1 ))GOTO 23344 IF (.NOT.( TTL(RIGHT-1) .NE. 32 ))GOTO 23345 GOTO 23344 23345 CONTINUE 23343 RIGHT = RIGHT - 1 GOTO 23342 23344 CONTINUE TTL(RIGHT) = 10 TTL(RIGHT+1) = 0 I = 1 23347 IF (.NOT.(I .LE. OFFSET))GOTO 23349 CALL PUTCH(32,2) 23348 I = I + 1 GOTO 23347 23349 CONTINUE CALL PUTLIN(TTL, 2) RETURN END SUBROUTINE PUTWRD(WRDBUF) LOGICAL*1 WRDBUF(402) INTEGER LENGTH, WIDTH INTEGER LAST, LLVAL, NEXTRA, W INTEGER OUTP INTEGER OUTW INTEGER OUTWDS LOGICAL*1 OUTBUF INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER TABS LOGICAL*1 CCHAR LOGICAL*1 ULBLNK COMMON /COUT/ OUTP, OUTW, OUTWDS, OUTBUF(402) COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, TABS(402), CCHAR, ULBLNK W = WIDTH(WRDBUF) LAST = LENGTH(WRDBUF) + OUTP LLVAL = RMVAL - TIVAL IF (.NOT.( (OUTW + W .GT. LLVAL .OR. LAST .GE. 402) .AND. OUTWDS . *GT. 0 ))GOTO 23350 LAST = LAST - OUTP NEXTRA = LLVAL - OUTW OUTP = OUTP + 1 23352 IF (.NOT.(OUTP .GT. 1))GOTO 23354 IF (.NOT.(OUTBUF(OUTP-1) .EQ. 32))GOTO 23355 NEXTRA = NEXTRA + 1 GOTO 23356 23355 CONTINUE GOTO 23354 23356 CONTINUE 23353 OUTP = OUTP - 1 GOTO 23352 23354 CONTINUE IF (.NOT.(RJUST .EQ. 1))GOTO 23357 CALL SPREAD(OUTBUF, OUTP, NEXTRA, OUTWDS) IF (.NOT.(NEXTRA .GT. 0 .AND. OUTWDS .GT. 1))GOTO 23359 OUTP = OUTP + NEXTRA 23359 CONTINUE 23357 CONTINUE CALL BRK 23350 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 23361 PARAM = DEFVAL GOTO 23362 23361 CONTINUE IF (.NOT.(ARGTYP .EQ. 43))GOTO 23363 PARAM = PARAM + VAL GOTO 23364 23363 CONTINUE IF (.NOT.(ARGTYP .EQ. 45))GOTO 23365 PARAM = PARAM - VAL GOTO 23366 23365 CONTINUE PARAM = VAL 23366 CONTINUE 23364 CONTINUE 23362 CONTINUE PARAM = MIN0(PARAM, MAXVAL) PARAM = MAX0(PARAM, MINVAL) RETURN END SUBROUTINE SKIP(N) INTEGER I, N 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 /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(402), OHEAD(402), EHLIM(2), OHLIM(2), EFOOT(402), O *FOOT(402), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T IF (.NOT.(PRINT .EQ. 1))GOTO 23367 I = 1 23369 IF (.NOT.(I .LE. N))GOTO 23371 CALL PUTCH(10,2) 23370 I = I + 1 GOTO 23369 23371 CONTINUE 23367 CONTINUE RETURN END SUBROUTINE SPACE(N) INTEGER MIN0 INTEGER N 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 /CPAGE/ CURPAG,NEWPAG,LINENO,PLVAL,M1VAL,M2VAL,M3VAL,M4VAL, * BOTTOM, EHEAD(402), OHEAD(402), EHLIM(2), OHLIM(2), EFOOT(402), O *FOOT(402), EFLIM(2), OFLIM(2), STOPX, FRSTPG, LASTPG, PRINT, OFFSE *T CALL BRK IF (.NOT.(LINENO .GT. BOTTOM))GOTO 23372 RETURN 23372 CONTINUE IF (.NOT.(LINENO .EQ. 0))GOTO 23374 CALL PHEAD 23374 CONTINUE CALL SKIP(MIN0(N, BOTTOM+1-LINENO)) LINENO = LINENO + N IF (.NOT.(LINENO .GT. BOTTOM))GOTO 23376 CALL PFOOT 23376 CONTINUE RETURN END SUBROUTINE SPREAD(BUF, OUTP, NEXTRA, OUTWDS) LOGICAL*1 BUF(402) INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER TABS LOGICAL*1 CCHAR LOGICAL*1 ULBLNK INTEGER MIN0 INTEGER DIR, I, J, NB, NE, NEXTRA, NHOLES, OUTP, OUTWDS COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, TABS(402), CCHAR, ULBLNK DATA DIR /0/ IF (.NOT.(NEXTRA .LE. 0 .OR. OUTWDS .LE. 1))GOTO 23378 RETURN 23378 CONTINUE DIR = 1 - DIR NE = NEXTRA NHOLES = OUTWDS - 1 IF (.NOT.(TIVAL .NE. INVAL .AND. NHOLES .GT. 1))GOTO 23380 NHOLES = NHOLES - 1 23380 CONTINUE I = OUTP - 1 J = MIN0(402-2, I+NE) 23382 IF (.NOT.(I .LT. J))GOTO 23383 BUF(J) = BUF(I) IF (.NOT.(BUF(I) .EQ. 32 .AND. BUF(I-1) .NE. 32))GOTO 23384 IF (.NOT.(DIR .EQ. 0))GOTO 23386 NB = (NE-1) / NHOLES + 1 GOTO 23387 23386 CONTINUE NB = NE / NHOLES 23387 CONTINUE NE = NE - NB NHOLES = NHOLES - 1 23388 IF (.NOT.(NB .GT. 0))GOTO 23390 J = J - 1 BUF(J) = 32 23389 NB = NB - 1 GOTO 23388 23390 CONTINUE 23384 CONTINUE I = I - 1 J = J - 1 GOTO 23382 23383 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 23391 IF (.NOT.(IN(I) .NE. 0))GOTO 23393 IF (.NOT.(IN(I) .EQ. CHAR))GOTO 23394 K = 1 23396 IF (.NOT.(K .LE. N))GOTO 23398 OUT(J) = SUBARA(K) J = J + 1 23397 K = K + 1 GOTO 23396 23398 CONTINUE GOTO 23395 23394 CONTINUE OUT(J) = IN(I) J = J + 1 23395 CONTINUE 23392 I = I + 1 GOTO 23391 23393 CONTINUE OUT(J) = 0 RETURN END SUBROUTINE TEXT(INBUF) INTEGER GETWRB, LENGTH INTEGER I INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER TABS LOGICAL*1 CCHAR LOGICAL*1 ULBLNK LOGICAL*1 INBUF(402), WRDBUF(402) COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, TABS(402), CCHAR, ULBLNK CALL DOESC( INBUF, WRDBUF, 402) CALL DOTABS( INBUF, WRDBUF, 402) IF (.NOT.( INBUF(1) .EQ. 32 .OR. INBUF(1) .EQ. 10 ))GOTO 23399 CALL LEADBL(INBUF) 23399 CONTINUE IF (.NOT.( ULVAL .GT. 0 ))GOTO 23401 CALL UNDERL( INBUF, WRDBUF, 402) ULVAL = ULVAL - 1 23401 CONTINUE IF (.NOT.( BOVAL .GT. 0 ))GOTO 23403 CALL BOLD( INBUF, WRDBUF, 402) BOVAL = BOVAL - 1 23403 CONTINUE IF (.NOT.( CEVAL .GT. 0 ))GOTO 23405 CALL CENTER(INBUF) CALL PUT(INBUF) CEVAL = CEVAL - 1 GOTO 23406 23405 CONTINUE IF (.NOT.( INBUF(1) .EQ. 10 ))GOTO 23407 CALL PUT(INBUF) GOTO 23408 23407 CONTINUE IF (.NOT.( FILL .EQ. 0 ))GOTO 23409 CALL PUT(INBUF) GOTO 23410 23409 CONTINUE I = LENGTH(INBUF) INBUF(I) = 32 IF (.NOT.( INBUF(I-1) .EQ. 46 ))GOTO 23411 I = I + 1 INBUF(I) = 32 23411 CONTINUE INBUF(I+1) = 0 I = 1 23413 IF (.NOT.(GETWRB( INBUF, I, WRDBUF) .GT. 0 ))GOTO 23415 CALL PUTWRD(WRDBUF) 23414 GOTO 23413 23415 CONTINUE 23410 CONTINUE 23408 CONTINUE 23406 CONTINUE RETURN END SUBROUTINE UNDERL( BUF, TBUF, SIZE) INTEGER I, J, SIZE LOGICAL*1 BUF(100), TBUF(100) INTEGER FILL INTEGER LSVAL INTEGER INVAL INTEGER RMVAL INTEGER TIVAL INTEGER CEVAL INTEGER ULVAL INTEGER BOVAL INTEGER TJUST INTEGER BSVAL INTEGER RJUST INTEGER TABS LOGICAL*1 CCHAR LOGICAL*1 ULBLNK COMMON /CPARAM/ FILL, LSVAL, INVAL, RMVAL, TIVAL, CEVAL, ULVAL, BO *VAL, TJUST(3), BSVAL, RJUST, TABS(402), CCHAR, ULBLNK J = 1 I = 1 23416 IF (.NOT.(BUF(I) .NE. 10 .AND. J .LT. SIZE - 1 ))GOTO 23418 IF (.NOT.( BUF(I) .NE. 32 .AND. BUF(I) .NE. 8 .AND. BUF(I) .NE. 95 * ))GOTO 23419 CALL CHCOPY( 95, TBUF, J) CALL CHCOPY( 8, TBUF, J) 23419 CONTINUE IF (.NOT.( BUF(I) .EQ. 32 ))GOTO 23421 CALL CHCOPY( ULBLNK, TBUF, J) GOTO 23422 23421 CONTINUE CALL CHCOPY( BUF(I), TBUF, J) 23422 CONTINUE 23417 I = I + 1 GOTO 23416 23418 CONTINUE TBUF(J) = 10 TBUF(J+1) = 0 CALL STRCPY( TBUF, BUF) RETURN END INTEGER FUNCTION WIDTH(BUF) LOGICAL*1 BUF(402) INTEGER I WIDTH = 0 I = 1 23423 IF (.NOT.(BUF(I) .NE. 0))GOTO 23425 IF (.NOT.(BUF(I) .EQ. 8))GOTO 23426 WIDTH = WIDTH - 1 GOTO 23427 23426 CONTINUE IF (.NOT.(BUF(I) .GE. 32 .AND. BUF(I) .LE. 126))GOTO 23428 WIDTH = WIDTH + 1 23428 CONTINUE 23427 CONTINUE 23424 I = I + 1 GOTO 23423 23425 CONTINUE RETURN END