SUBROUTINE MAIN LOGICAL*1 LIN(400), PSTR(11), CLOWER INTEGER CKGLOB, DOCMD, DOGLOB, DOREAD, GETARG, PROMPT, GETLST INTEGER I, STATUS, CLRBUF COMMON /CFILE/ SAVFIL(40) LOGICAL*1 SAVFIL COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY COMMON /CPAT/ PAT(132) LOGICAL*1 PAT COMMON /CBUF/ BUF(3008), LASTBF, FREE INTEGER BUF, LASTBF, FREE DATA PRINT /1/ DATA PSTR(1), PSTR(2), PSTR(3)/58, 32, 0/ CALL INITED CALL SETBUF PAT(1) = 0 SAVFIL(1) = 0 I=1 23000 IF(.NOT.(GETARG(I, LIN, 400) .NE. -1))GOTO 23002 IF(.NOT.(LIN(1) .EQ. 45))GOTO 23003 IF(.NOT.(LIN(2) .EQ. 0))GOTO 23005 PRINT = 0 GOTO 23006 23005 CONTINUE IF(.NOT.(CLOWER(LIN(2)) .EQ. 112))GOTO 23007 LIN(13) = 0 CALL SCOPY(LIN, 3, PSTR, 1) 23007 CONTINUE 23006 CONTINUE GOTO 23004 23003 CONTINUE CALL SCOPY (LIN, 1, SAVFIL, 1) IF(.NOT.(DOREAD (0, SAVFIL, 101) .EQ. -3))GOTO 23009 CALL REMARK (2H?.) 23009 CONTINUE 23004 CONTINUE 23001 I=I+1 GOTO 23000 23002 CONTINUE 23011 CONTINUE STATUS = PROMPT(PSTR, LIN, 1) IF(.NOT.(STATUS .EQ. -1))GOTO 23014 STATUS = CLRBUF(-1) GOTO 23013 23014 CONTINUE IF(.NOT.(STATUS .NE. -3))GOTO 23016 I = 1 CURSAV = CURLN IF(.NOT.(GETLST(LIN, I, STATUS) .EQ. 0))GOTO 23018 IF(.NOT.(CKGLOB(LIN, I, STATUS) .EQ. 0))GOTO 23020 STATUS = DOGLOB(LIN, I, CURSAV, STATUS) GOTO 23021 23020 CONTINUE IF(.NOT.(STATUS .NE. -3))GOTO 23022 STATUS = DOCMD(LIN, I, 0, STATUS) 23022 CONTINUE 23021 CONTINUE 23018 CONTINUE 23016 CONTINUE 23015 CONTINUE IF(.NOT.(STATUS .EQ. -3))GOTO 23024 CALL REMARK(2H?.) CURLN = CURSAV GOTO 23025 23024 CONTINUE IF(.NOT.(STATUS .EQ. -1))GOTO 23026 IF(.NOT.(CLRBUF(113) .EQ. 0))GOTO 23028 GOTO 23013 23028 CONTINUE 23026 CONTINUE 23025 CONTINUE 23012 GOTO 23011 23013 CONTINUE CALL ENDED RETURN END INTEGER FUNCTION APPEND(LINE, GLOB) INTEGER GETLIN, INJECT INTEGER LINE, GLOB COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY COMMON /CSCLIN/ LIN(400) LOGICAL*1 LIN IF(.NOT.(GLOB .EQ. 1))GOTO 23030 APPEND = -3 GOTO 23031 23030 CONTINUE CURLN = LINE APPEND = 1 23032 IF(.NOT.(APPEND .EQ. 1))GOTO 23034 IF(.NOT.(GETLIN(LIN, 1) .EQ. -1))GOTO 23035 APPEND = -1 GOTO 23036 23035 CONTINUE IF(.NOT.(LIN(1) .EQ. 46 .AND. LIN(2) .EQ. 10))GOTO 23037 APPEND = 0 GOTO 23038 23037 CONTINUE IF(.NOT.(INJECT(LIN) .EQ. -3))GOTO 23039 APPEND = -3 23039 CONTINUE 23038 CONTINUE 23036 CONTINUE 23033 GOTO 23032 23034 CONTINUE 23031 CONTINUE RETURN END INTEGER FUNCTION CKGLOB(LIN, I, STATUS) LOGICAL*1 LIN(400) INTEGER DEFALT, GETIND, GETTXT, MATCH, NEXTLN, OPTPAT INTEGER GFLAG, I, K, LINE, STATUS LOGICAL*1 CLOWER COMMON /CBUF/ BUF(3008), LASTBF, FREE INTEGER BUF, LASTBF, FREE COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY COMMON /CPAT/ PAT(132) LOGICAL*1 PAT COMMON /CTXT/ TXT(400) LOGICAL*1 TXT IF(.NOT.(CLOWER(LIN(I)) .NE. 103 .AND. CLOWER(LIN(I)) .NE. 120))GO *TO 23041 STATUS = -1 GOTO 23042 23041 CONTINUE IF(.NOT.(CLOWER(LIN(I)) .EQ. 103))GOTO 23043 GFLAG = 1 GOTO 23044 23043 CONTINUE GFLAG = 0 23044 CONTINUE I = I + 1 IF(.NOT.(OPTPAT(LIN, I) .EQ. -3 .OR. DEFALT(1, LASTLN, STATUS) .EQ *. -3))GOTO 23045 STATUS = -3 GOTO 23046 23045 CONTINUE I = I + 1 LINE = LINE1 23047 IF(.NOT.(LINE .LE. LINE2))GOTO 23049 K = GETTXT(LINE) IF(.NOT.(MATCH(TXT, PAT) .EQ. GFLAG))GOTO 23050 CALL SETB (K, 2, 1) GOTO 23051 23050 CONTINUE CALL SETB (K, 2, 0) 23051 CONTINUE 23048 LINE = LINE + 1 GOTO 23047 23049 CONTINUE LINE=NEXTLN(LINE2) 23052 IF(.NOT.(LINE.NE.LINE1))GOTO 23054 K = GETIND(LINE) CALL SETB (K, 2, 0) 23053 LINE=NEXTLN(LINE) GOTO 23052 23054 CONTINUE STATUS = 0 23046 CONTINUE 23042 CONTINUE CKGLOB = STATUS RETURN END INTEGER FUNCTION CKP(LIN, I, PFLAG, STATUS) LOGICAL*1 LIN(400), C INTEGER I, J, PFLAG, STATUS LOGICAL*1 CLOWER J = I C = CLOWER(LIN(J)) IF(.NOT.(C .EQ. 112 .OR. C .EQ. 108))GOTO 23055 J = J + 1 PFLAG = C GOTO 23056 23055 CONTINUE PFLAG = 0 23056 CONTINUE IF(.NOT.(LIN(J) .EQ. 10))GOTO 23057 STATUS = 0 GOTO 23058 23057 CONTINUE STATUS = -3 23058 CONTINUE CKP = STATUS RETURN END INTEGER FUNCTION CLRBUF(COMAND) LOGICAL*1 COMAND COMMON /CSCRAT/ SCR, SCREND(2) , SCRFIL(40) INTEGER SCR INTEGER SCREND LOGICAL*1 SCRFIL COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY IF(.NOT.(COMAND .EQ. 113 .AND. IFMOD .EQ. 1 .AND. NOTIFY .EQ. 0))G *OTO 23059 NOTIFY = 1 CALL REMARK(53HCHANGES SINCE LAST WRITE - RETYPE COMMAND TO CONFIR *M.) CLRBUF = -3 GOTO 23060 23059 CONTINUE CALL CLOSE(SCR) CALL REMOVE(SCRFIL) CLRBUF = 0 23060 CONTINUE RETURN END INTEGER FUNCTION CONCT (NBR, LIN) INTEGER NBR, I, GETTXT, JUNK LOGICAL*1 LIN(100) COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY COMMON /CTXT/ TXT(400) LOGICAL*1 TXT CONCT = 0 I=1 23061 IF(.NOT.(LIN(I).NE.0))GOTO 23063 IF(.NOT.(LIN(I) .EQ. 10))GOTO 23064 RETURN 23064 CONTINUE 23062 I=I+1 GOTO 23061 23063 CONTINUE IF(.NOT.(NBR+1 .GT. LASTLN))GOTO 23066 CONCT = -3 RETURN 23066 CONTINUE JUNK = GETTXT (NBR+1) CALL SCOPY (TXT, 1, LIN, I) CALL DELETE (NBR+1, NBR+1, JUNK) RETURN END INTEGER FUNCTION DEFALT(DEF1, DEF2, STATUS) INTEGER DEF1, DEF2, STATUS COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY IF(.NOT.(NLINES .EQ. 0))GOTO 23068 LINE1 = DEF1 LINE2 = DEF2 23068 CONTINUE IF(.NOT.(LINE1 .GT. LINE2 .OR. LINE1 .LE. 0))GOTO 23070 STATUS = -3 GOTO 23071 23070 CONTINUE STATUS = 0 23071 CONTINUE DEFALT = STATUS RETURN END INTEGER FUNCTION DELETE(FROM, TO, STATUS) INTEGER GETIND, NEXTLN, PREVLN INTEGER FROM, K1, K2, STATUS, TO, START, STOP COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY IF(.NOT.(FROM .LE. 0))GOTO 23072 STATUS = -3 GOTO 23073 23072 CONTINUE K1 = GETIND(PREVLN(FROM)) K2 = GETIND(NEXTLN(TO)) START = GETIND(FROM) STOP = GETIND(TO) LASTLN = LASTLN - (TO - FROM + 1) CURLN = PREVLN(FROM) CALL RELINK(K1, K2, K1, K2) CALL PTFNDX(START, STOP) STATUS = 0 23073 CONTINUE DELETE = STATUS RETURN END INTEGER FUNCTION DOCMD(LIN, I, GLOB, STATUS) LOGICAL*1 FILE(40), LIN(400), SUB(132) INTEGER APPEND, DELETE, DOPRNT, DOREAD, DOWRIT, LMOVE, SUBST INTEGER CKP, DEFALT, GETFN, GETONE, GETRHS, NEXTLN, OPTPAT, PREVLN LOGICAL*1 CLOWER, COMAND INTEGER GFLAG, GLOB, I, LINE3, PFLAG, STATUS, DOSPWN, BROWSE, DOLI *ST INTEGER DOJOIN INTEGER CLRBUF COMMON /CFILE/ SAVFIL(40) LOGICAL*1 SAVFIL COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY COMMON /CPAT/ PAT(132) LOGICAL*1 PAT PFLAG = 0 STATUS = -3 COMAND = CLOWER(LIN(I)) IF(.NOT.(COMAND .EQ. 97))GOTO 23074 IF(.NOT.(LIN(I + 1) .EQ. 10))GOTO 23076 STATUS = APPEND(LINE2, GLOB) 23076 CONTINUE GOTO 23075 23074 CONTINUE IF(.NOT.(COMAND .EQ. 99))GOTO 23078 IF(.NOT.(LIN(I + 1) .EQ. 10))GOTO 23080 IF(.NOT.(DEFALT(CURLN, CURLN, STATUS) .EQ. 0))GOTO 23082 IF(.NOT.(DELETE(LINE1, LINE2, STATUS) .EQ. 0))GOTO 23084 STATUS = APPEND(PREVLN(LINE1), GLOB) 23084 CONTINUE 23082 CONTINUE 23080 CONTINUE GOTO 23079 23078 CONTINUE IF(.NOT.(COMAND .EQ. 100))GOTO 23086 IF(.NOT.(CKP(LIN, I + 1, PFLAG, STATUS) .EQ. 0))GOTO 23088 IF(.NOT.(DEFALT(CURLN, CURLN, STATUS) .EQ. 0))GOTO 23090 IF(.NOT.(DELETE(LINE1, LINE2, STATUS) .EQ. 0))GOTO 23092 IF(.NOT.(NEXTLN(CURLN) .NE. 0))GOTO 23094 CURLN = NEXTLN(CURLN) 23094 CONTINUE 23092 CONTINUE 23090 CONTINUE 23088 CONTINUE GOTO 23087 23086 CONTINUE IF(.NOT.(COMAND .EQ. 105))GOTO 23096 IF(.NOT.(LIN(I + 1) .EQ. 10))GOTO 23098 STATUS = APPEND(PREVLN(LINE2), GLOB) 23098 CONTINUE GOTO 23097 23096 CONTINUE IF(.NOT.(COMAND .EQ. 106))GOTO 23100 IF(.NOT.(CKP(LIN, I+1, PFLAG, STATUS) .EQ. 0))GOTO 23102 IF(.NOT.(DEFALT(CURLN, NEXTLN(CURLN), STATUS) .EQ. 0))GOTO 23104 STATUS = DOJOIN(LINE1, LINE2) 23104 CONTINUE 23102 CONTINUE GOTO 23101 23100 CONTINUE IF(.NOT.(COMAND .EQ. 61))GOTO 23106 IF(.NOT.(CKP(LIN, I + 1, PFLAG, STATUS) .EQ. 0))GOTO 23108 CALL PUTDEC(LINE2, 1) CALL PUTC(10) 23108 CONTINUE GOTO 23107 23106 CONTINUE IF(.NOT.(COMAND .EQ. 109))GOTO 23110 I = I + 1 IF(.NOT.(GETONE(LIN, I, LINE3, STATUS) .EQ. -1))GOTO 23112 STATUS = -3 23112 CONTINUE IF(.NOT.(STATUS .EQ. 0))GOTO 23114 IF(.NOT.(CKP(LIN, I, PFLAG, STATUS) .EQ. 0))GOTO 23116 IF(.NOT.(DEFALT(CURLN, CURLN, STATUS) .EQ. 0))GOTO 23118 STATUS = LMOVE(LINE3) 23118 CONTINUE 23116 CONTINUE 23114 CONTINUE GOTO 23111 23110 CONTINUE IF(.NOT.(COMAND .EQ. 115))GOTO 23120 I = I + 1 IF(.NOT.(OPTPAT(LIN, I) .EQ. 0))GOTO 23122 IF(.NOT.(GETRHS(LIN, I, SUB, GFLAG) .EQ. 0))GOTO 23124 IF(.NOT.(CKP(LIN, I + 1, PFLAG, STATUS) .EQ. 0))GOTO 23126 IF(.NOT.(DEFALT(CURLN, CURLN, STATUS) .EQ. 0))GOTO 23128 STATUS = SUBST(SUB, GFLAG) 23128 CONTINUE 23126 CONTINUE 23124 CONTINUE 23122 CONTINUE GOTO 23121 23120 CONTINUE IF(.NOT.(COMAND .EQ. 64))GOTO 23130 I = I + 1 STATUS = DOSPWN(LIN, I) GOTO 23131 23130 CONTINUE IF(.NOT.(COMAND .EQ. 101))GOTO 23132 IF(.NOT.(NLINES .EQ. 0))GOTO 23134 IF(.NOT.(GETFN(LIN, I, FILE) .EQ. 0))GOTO 23136 IF(.NOT.(CLRBUF(113) .EQ. 0))GOTO 23138 CALL SCOPY(FILE, 1, SAVFIL, 1) CALL SETBUF STATUS = DOREAD(0, FILE, 101) GOTO 23139 23138 CONTINUE STATUS = 0 23139 CONTINUE 23136 CONTINUE 23134 CONTINUE GOTO 23133 23132 CONTINUE IF(.NOT.(COMAND .EQ. 102))GOTO 23140 IF(.NOT.(NLINES .EQ. 0))GOTO 23142 IF(.NOT.(GETFN(LIN, I, FILE) .EQ. 0))GOTO 23144 CALL SCOPY(FILE, 1, SAVFIL, 1) CALL PUTLIN(SAVFIL, 2) CALL PUTC(10) STATUS = 0 23144 CONTINUE 23142 CONTINUE GOTO 23141 23140 CONTINUE IF(.NOT.(COMAND .EQ. 114))GOTO 23146 IF(.NOT.(GETFN(LIN, I, FILE) .EQ. 0))GOTO 23148 STATUS = DOREAD(LINE2, FILE, 114) 23148 CONTINUE GOTO 23147 23146 CONTINUE IF(.NOT.(COMAND .EQ. 119))GOTO 23150 IF(.NOT.(GETFN(LIN, I, FILE) .EQ. 0))GOTO 23152 IF(.NOT.(DEFALT(1, LASTLN, STATUS) .EQ. 0))GOTO 23154 STATUS = DOWRIT(LINE1, LINE2, FILE) 23154 CONTINUE 23152 CONTINUE GOTO 23151 23150 CONTINUE IF(.NOT.(COMAND .EQ. 112))GOTO 23156 IF(.NOT.(LIN(I + 1) .EQ. 10))GOTO 23158 IF(.NOT.(DEFALT(CURLN, CURLN, STATUS) .EQ. 0))GOTO 23160 STATUS = DOPRNT(LINE1, LINE2) 23160 CONTINUE 23158 CONTINUE GOTO 23157 23156 CONTINUE IF(.NOT.(COMAND .EQ. 108))GOTO 23162 IF(.NOT.(LIN(I+1) .EQ. 10))GOTO 23164 IF(.NOT.(DEFALT(CURLN, CURLN, STATUS) .EQ. 0))GOTO 23166 STATUS = DOLIST(LINE1, LINE2) 23166 CONTINUE 23164 CONTINUE GOTO 23163 23162 CONTINUE IF(.NOT.(COMAND .EQ. 98))GOTO 23168 I = I + 1 IF(.NOT.(DEFALT(CURLN, CURLN, STATUS) .EQ. 0))GOTO 23170 STATUS = BROWSE(LINE2, LIN, I) 23170 CONTINUE GOTO 23169 23168 CONTINUE IF(.NOT.(COMAND .EQ. 35))GOTO 23172 STATUS = 0 GOTO 23173 23172 CONTINUE IF(.NOT.(LIN(I) .EQ. 10))GOTO 23174 IF(.NOT.(NLINES .EQ. 0))GOTO 23176 LINE2 = NEXTLN(CURLN) 23176 CONTINUE STATUS = DOPRNT(LINE2, LINE2) GOTO 23175 23174 CONTINUE IF(.NOT.(LIN(I) .EQ. 45))GOTO 23178 IF(.NOT.(NLINES .EQ. 0))GOTO 23180 LINE2 = PREVLN(CURLN) 23180 CONTINUE STATUS = DOPRNT(LINE2, LINE2) GOTO 23179 23178 CONTINUE IF(.NOT.(COMAND .EQ. 113))GOTO 23182 IF(.NOT.(LIN(I + 1) .EQ. 10 .AND. NLINES .EQ. 0 .AND. GLOB .EQ. 0) *)GOTO 23184 STATUS = -1 23184 CONTINUE 23182 CONTINUE 23179 CONTINUE 23175 CONTINUE 23173 CONTINUE 23169 CONTINUE 23163 CONTINUE 23157 CONTINUE 23151 CONTINUE 23147 CONTINUE 23141 CONTINUE 23133 CONTINUE 23131 CONTINUE 23121 CONTINUE 23111 CONTINUE 23107 CONTINUE 23101 CONTINUE 23097 CONTINUE 23087 CONTINUE 23079 CONTINUE 23075 CONTINUE IF(.NOT.(STATUS .EQ. 0))GOTO 23186 IF(.NOT.(PFLAG .EQ. 112))GOTO 23188 STATUS = DOPRNT(CURLN, CURLN) GOTO 23189 23188 CONTINUE IF(.NOT.(PFLAG .EQ. 108))GOTO 23190 STATUS = DOLIST(CURLN, CURLN) 23190 CONTINUE 23189 CONTINUE 23186 CONTINUE DOCMD = STATUS RETURN END INTEGER FUNCTION DOGLOB(LIN, I, STATUS) LOGICAL*1 LIN(400) INTEGER DOCMD, GETIND, GETLST, NEXTLN INTEGER VALUE(2) INTEGER COUNT, I, ISTART, K, LINE, STATUS, LAST COMMON /CBUF/ BUF(3008), LASTBF, FREE INTEGER BUF, LASTBF, FREE COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY LAST = LENGTH(LIN) 23192 IF(.NOT.(LIN(LAST - 1) .EQ. 64))GOTO 23194 LIN(LAST - 1) = 10 JUNK = GETLIN(LIN(LAST),1) 23193 LAST = LENGTH(LIN) GOTO 23192 23194 CONTINUE STATUS = 0 COUNT = 0 LINE = LINE1 ISTART = I 23195 CONTINUE K = GETIND(LINE) CALL GETB(K, 2, VALUE) IF(.NOT.(VALUE(1) .EQ. 1))GOTO 23198 CALL SETB(K, 2, 0) CURSAV = LINE I = ISTART 23200 CONTINUE CURLN = LINE IF(.NOT.(GETLST(LIN, I, STATUS) .EQ. 0))GOTO 23203 IF(.NOT.(DOCMD(LIN, I, 1, STATUS) .EQ. 0))GOTO 23205 COUNT = 0 23205 CONTINUE 23203 CONTINUE 23207 IF(.NOT.(LIN(I) .NE. 10))GOTO 23208 I = I + 1 GOTO 23207 23208 CONTINUE I = I + 1 IF(.NOT.(LIN(I) .EQ. 0))GOTO 23209 GOTO 23202 23209 CONTINUE 23201 GOTO 23200 23202 CONTINUE GOTO 23199 23198 CONTINUE LINE = NEXTLN(LINE) COUNT = COUNT + 1 23199 CONTINUE 23196 IF(.NOT.(COUNT .GT. LASTLN .OR. STATUS .NE. 0))GOTO 23195 23197 CONTINUE DOGLOB = STATUS RETURN END INTEGER FUNCTION DOPRNT(FROM, TO) INTEGER GETTXT INTEGER FROM, I, J, TO COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY COMMON /CTXT/ TXT(400) LOGICAL*1 TXT IF(.NOT.(FROM .LE. 0))GOTO 23211 DOPRNT = -3 GOTO 23212 23211 CONTINUE I = FROM 23213 IF(.NOT.(I .LE. TO))GOTO 23215 J = GETTXT(I) CALL PUTLIN(TXT, 2) 23214 I = I + 1 GOTO 23213 23215 CONTINUE CURLN = TO DOPRNT = 0 23212 CONTINUE RETURN END INTEGER FUNCTION DOREAD(LINE, FILE, COMAND) LOGICAL*1 FILE(40), COMAND INTEGER GETLIN, INJECT, OPEN, ACCESS INTEGER COUNT, FD, LINE COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY COMMON /CFILE/ SAVFIL(40) LOGICAL*1 SAVFIL COMMON /CSCLIN/ LIN(400) LOGICAL*1 LIN IF(.NOT.(COMAND .EQ. 101))GOTO 23216 ACCESS = 3 GOTO 23217 23216 CONTINUE ACCESS = 1 23217 CONTINUE CALL FINDIT(FILE, LIN) FD = OPEN(LIN, ACCESS) IF(.NOT.(FD .EQ. -3))GOTO 23218 DOREAD = -3 GOTO 23219 23218 CONTINUE CURLN = LINE DOREAD = 0 COUNT = 0 23220 IF(.NOT.(GETLIN(LIN, FD) .NE. -1))GOTO 23222 DOREAD = INJECT(LIN) IF(.NOT.(DOREAD .EQ. -3))GOTO 23223 GOTO 23222 23223 CONTINUE 23221 COUNT = COUNT + 1 GOTO 23220 23222 CONTINUE CALL CLOSE(FD) IF(.NOT.(PRINT .EQ. 1))GOTO 23225 CALL PUTDEC (COUNT, 1) CALL PUTC (10) 23225 CONTINUE IF(.NOT.(COMAND .EQ. 101))GOTO 23227 IFMOD = 0 NOTIFY = 0 23227 CONTINUE 23219 CONTINUE RETURN END INTEGER FUNCTION DOWRIT(FROM, TO, FILE) LOGICAL*1 FILE(400), LIN(40) INTEGER CREATE, GETTXT INTEGER FD, FROM, K, LINE, TO COMMON /CTXT/ TXT(400) LOGICAL*1 TXT COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY COMMON /CFILE/ SAVFIL(40) LOGICAL*1 SAVFIL CALL FINDIT(FILE, LIN) FD = CREATE(LIN, 2) IF(.NOT.(FD .EQ. -3))GOTO 23229 DOWRIT = -3 GOTO 23230 23229 CONTINUE LINE = FROM 23231 IF(.NOT.(LINE .LE. TO))GOTO 23233 K = GETTXT(LINE) CALL PUTLIN(TXT, FD) 23232 LINE = LINE + 1 GOTO 23231 23233 CONTINUE CALL CLOSE(FD) IF(.NOT.(PRINT .EQ. 1))GOTO 23234 CALL PUTDEC (TO-FROM+1, 1) CALL PUTC (10) 23234 CONTINUE DOWRIT = 0 IFMOD = 0 NOTIFY = 0 23230 CONTINUE RETURN END SUBROUTINE GETB (INDEX, TYPE, VALUE) INTEGER INDEX, TYPE INTEGER VALUE(2) COMMON /CBUF/ BUF(3008), LASTBF, FREE INTEGER BUF, LASTBF, FREE IF(.NOT.(TYPE .EQ. 0))GOTO 23236 VALUE(1) = IABS(BUF(INDEX)) GOTO 23237 23236 CONTINUE IF(.NOT.(TYPE .EQ. 1))GOTO 23238 VALUE(1) = BUF(INDEX+1) GOTO 23239 23238 CONTINUE IF(.NOT.(TYPE .EQ. 2))GOTO 23240 IF(.NOT.(BUF(INDEX) .LT. 0))GOTO 23242 VALUE(1) = 1 GOTO 23243 23242 CONTINUE VALUE(1) = 0 23243 CONTINUE GOTO 23241 23240 CONTINUE IF(.NOT.(TYPE .EQ. 3))GOTO 23244 VALUE(1) = BUF(INDEX+2) VALUE(2) = BUF(INDEX+3) 23244 CONTINUE 23241 CONTINUE 23239 CONTINUE 23237 CONTINUE RETURN END INTEGER FUNCTION GETFN(LIN, I, FILE) LOGICAL*1 LIN(400), FILE(400) INTEGER I, J, K COMMON /CFILE/ SAVFIL(40) LOGICAL*1 SAVFIL GETFN = -3 IF(.NOT.(LIN(I + 1) .EQ. 32))GOTO 23246 J = I + 2 CALL SKIPBL(LIN, J) K = 1 23248 IF(.NOT.(LIN(J) .NE. 10))GOTO 23250 FILE(K) = LIN(J) J = J + 1 23249 K = K + 1 GOTO 23248 23250 CONTINUE FILE(K) = 0 IF(.NOT.(K .GT. 1))GOTO 23251 GETFN = 0 23251 CONTINUE GOTO 23247 23246 CONTINUE IF(.NOT.(LIN(I + 1) .EQ. 10 .AND. SAVFIL(1) .NE. 0))GOTO 23253 CALL SCOPY(SAVFIL, 1, FILE, 1) GETFN = 0 23253 CONTINUE 23247 CONTINUE RETURN END INTEGER FUNCTION GETIND(LINE) INTEGER LINE, K, J INTEGER NEXTLN, PREVLN COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY DATA OLDNDX /-3/ DATA OLDLIN /-2/ IF(.NOT.(OLDNDX .NE. -3 .AND. LINE .EQ. NEXTLN(OLDLIN)))GOTO 23255 CALL GETB(OLDNDX, 1, K) GOTO 23256 23255 CONTINUE IF(.NOT.(OLDNDX .NE. -3 .AND. LINE .EQ. OLDLIN))GOTO 23257 K = OLDNDX GOTO 23258 23257 CONTINUE IF(.NOT.(OLDNDX .NE. -3 .AND. LINE .EQ. PREVLN(OLDLIN)))GOTO 23259 CALL GETB(OLDNDX, 0, K) GOTO 23260 23259 CONTINUE K = 1 IF(.NOT.(LINE .LT. LASTLN/2))GOTO 23261 J=0 23263 IF(.NOT.(J.LT.LINE))GOTO 23265 CALL GETB (K, 1, K) 23264 J=J+1 GOTO 23263 23265 CONTINUE GOTO 23262 23261 CONTINUE J=LASTLN 23266 IF(.NOT.(J.GE.LINE))GOTO 23268 CALL GETB(K, 0, K) 23267 J=J-1 GOTO 23266 23268 CONTINUE 23262 CONTINUE 23260 CONTINUE 23258 CONTINUE 23256 CONTINUE OLDLIN = LINE OLDNDX = K GETIND = K RETURN END INTEGER FUNCTION GETLST(LIN, I, STATUS) LOGICAL*1 LIN(400) INTEGER GETONE INTEGER I, NUM, STATUS COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY LINE2 = 0 NLINES = 0 23269 IF(.NOT.(GETONE(LIN, I, NUM, STATUS) .EQ. 0))GOTO 23271 LINE1 = LINE2 LINE2 = NUM NLINES = NLINES + 1 IF(.NOT.(LIN(I) .NE. 44 .AND. LIN(I) .NE. 59))GOTO 23272 GOTO 23271 23272 CONTINUE IF(.NOT.(LIN(I) .EQ. 59))GOTO 23274 CURLN = NUM 23274 CONTINUE I = I + 1 23270 GOTO 23269 23271 CONTINUE NLINES = MIN0(NLINES, 2) IF(.NOT.(NLINES .EQ. 0))GOTO 23276 LINE2 = CURLN 23276 CONTINUE IF(.NOT.(NLINES .LE. 1))GOTO 23278 LINE1 = LINE2 23278 CONTINUE IF(.NOT.(STATUS .NE. -3))GOTO 23280 STATUS = 0 23280 CONTINUE GETLST = STATUS RETURN END INTEGER FUNCTION GETNUM(LIN, I, PNUM, STATUS) LOGICAL*1 LIN(400) INTEGER CTOI, INDEX, OPTPAT, PTSCAN INTEGER I, PNUM, STATUS COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY COMMON /CPAT/ PAT(132) LOGICAL*1 PAT LOGICAL*1 DIGITS(11) DATA DIGITS(01)/48/ DATA DIGITS(02)/49/ DATA DIGITS(03)/50/ DATA DIGITS(04)/51/ DATA DIGITS(05)/52/ DATA DIGITS(06)/53/ DATA DIGITS(07)/54/ DATA DIGITS(08)/55/ DATA DIGITS(09)/56/ DATA DIGITS(10)/57/ DATA DIGITS(11)/0/ GETNUM = 0 IF(.NOT.(INDEX(DIGITS, LIN(I)) .GT. 0))GOTO 23282 PNUM = CTOI(LIN, I) I = I - 1 GOTO 23283 23282 CONTINUE IF(.NOT.(LIN(I) .EQ. 46))GOTO 23284 PNUM = CURLN GOTO 23285 23284 CONTINUE IF(.NOT.(LIN(I) .EQ. 36))GOTO 23286 PNUM = LASTLN GOTO 23287 23286 CONTINUE IF(.NOT.(LIN(I) .EQ. 47 .OR. LIN(I) .EQ. 92))GOTO 23288 IF(.NOT.(OPTPAT(LIN, I) .EQ. -3))GOTO 23290 GETNUM = -3 GOTO 23291 23290 CONTINUE IF(.NOT.(LIN(I) .EQ. 47))GOTO 23292 GETNUM = PTSCAN(43, PNUM) GOTO 23293 23292 CONTINUE GETNUM = PTSCAN(45, PNUM) 23293 CONTINUE 23291 CONTINUE GOTO 23289 23288 CONTINUE GETNUM = -1 23289 CONTINUE 23287 CONTINUE 23285 CONTINUE 23283 CONTINUE IF(.NOT.(GETNUM .EQ. 0))GOTO 23294 I = I + 1 23294 CONTINUE STATUS = GETNUM RETURN END INTEGER FUNCTION GETONE(LIN, I, NUM, STATUS) LOGICAL*1 LIN(400) INTEGER GETNUM INTEGER I, ISTART, MUL, NUM, PNUM, STATUS COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY ISTART = I NUM = 0 CALL SKIPBL(LIN, I) IF(.NOT.(GETNUM(LIN, I, NUM, STATUS) .EQ. 0))GOTO 23296 23298 CONTINUE CALL SKIPBL(LIN, I) IF(.NOT.(LIN(I) .NE. 43 .AND. LIN(I) .NE. 45))GOTO 23301 STATUS = -1 GOTO 23300 23301 CONTINUE IF(.NOT.(LIN(I) .EQ. 43))GOTO 23303 MUL = +1 GOTO 23304 23303 CONTINUE MUL = -1 23304 CONTINUE I = I + 1 CALL SKIPBL(LIN, I) IF(.NOT.(GETNUM(LIN, I, PNUM, STATUS) .EQ. 0))GOTO 23305 NUM = NUM + MUL * PNUM 23305 CONTINUE IF(.NOT.(STATUS .EQ. -1))GOTO 23307 STATUS = -3 23307 CONTINUE 23299 IF(.NOT.(STATUS .NE. 0))GOTO 23298 23300 CONTINUE 23296 CONTINUE IF(.NOT.(NUM .LT. 0 .OR. NUM .GT. LASTLN))GOTO 23309 STATUS = -3 23309 CONTINUE IF(.NOT.(STATUS .EQ. -3))GOTO 23311 GETONE = -3 GOTO 23312 23311 CONTINUE IF(.NOT.(I .LE. ISTART))GOTO 23313 GETONE = -1 GOTO 23314 23313 CONTINUE GETONE = 0 23314 CONTINUE 23312 CONTINUE STATUS = GETONE RETURN END INTEGER FUNCTION GETRHS(LIN, I, SUB, GFLAG) LOGICAL*1 LIN(400), SUB(132) INTEGER MAKSUB INTEGER GFLAG, I LOGICAL*1 CLOWER GETRHS = -3 IF(.NOT.(LIN(I) .EQ. 0))GOTO 23315 RETURN 23315 CONTINUE IF(.NOT.(LIN(I + 1) .EQ. 0))GOTO 23317 RETURN 23317 CONTINUE I = MAKSUB(LIN, I + 1, LIN(I), SUB) IF(.NOT.(I .EQ. -3))GOTO 23319 RETURN 23319 CONTINUE IF(.NOT.(CLOWER(LIN(I+1)) .EQ. 103))GOTO 23321 I = I + 1 GFLAG = 1 GOTO 23322 23321 CONTINUE GFLAG = 0 23322 CONTINUE GETRHS = 0 RETURN END INTEGER FUNCTION GETTXT(LINE) LOGICAL*1 NULL(1) INTEGER GETIND INTEGER LINE, LEN, J, K INTEGER LOC(2) COMMON /CBUF/ BUF(3008), LASTBF, FREE INTEGER BUF, LASTBF, FREE COMMON /CSCRAT/ SCR, SCREND(2) , SCRFIL(40) INTEGER SCR INTEGER SCREND LOGICAL*1 SCRFIL COMMON /CTXT/ TXT(400) LOGICAL*1 TXT DATA NULL/0/ K = GETIND(LINE) IF(.NOT.(LINE .NE. 0))GOTO 23323 CALL GETB (K, 3, LOC) CALL SEEK (LOC, SCR) CALL READF (TXT, DUMMY, SCR) GOTO 23324 23323 CONTINUE CALL SCOPY(NULL, 1, TXT, 1) 23324 CONTINUE GETTXT = K RETURN END INTEGER FUNCTION INJECT(LIN) LOGICAL*1 LIN(400) INTEGER GETIND, MAKLIN, NEXTLN INTEGER I, K1, K2, K3 COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY I = 1 23325 IF(.NOT.(LIN(I) .NE. 0))GOTO 23327 I = MAKLIN(LIN, I, K3) IF(.NOT.(I .EQ. -3))GOTO 23328 INJECT = -3 GOTO 23327 23328 CONTINUE K1 = GETIND(CURLN) K2 = GETIND(NEXTLN(CURLN)) CALL RELINK(K1, K3, K3, K2) CALL RELINK(K3, K2, K1, K3) CURLN = CURLN + 1 LASTLN = LASTLN + 1 INJECT = 0 23326 GOTO 23325 23327 CONTINUE RETURN END INTEGER FUNCTION LMOVE(LINE3) INTEGER GETIND, NEXTLN, PREVLN INTEGER K0, K1, K2, K3, K4, K5, LINE3, DELTA COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY IF(.NOT.(LINE1 .LE. 0 .OR. (LINE1 .LE. LINE3 .AND. LINE3 .LE. LINE *2)))GOTO 23330 LMOVE = -3 GOTO 23331 23330 CONTINUE K0 = GETIND(PREVLN(LINE1)) K3 = GETIND(NEXTLN(LINE2)) K1 = GETIND(LINE1) K2 = GETIND(LINE2) CALL RELINK(K0, K3, K0, K3) DELTA = LINE2 - LINE1 + 1 LASTLN = LASTLN - DELTA IF(.NOT.(LINE3 .GT. LINE1))GOTO 23332 CURLN = LINE3 LINE3 = LINE3 - DELTA GOTO 23333 23332 CONTINUE CURLN = LINE3 + DELTA 23333 CONTINUE K4 = GETIND(LINE3) K5 = GETIND(NEXTLN(LINE3)) CALL RELINK(K4, K1, K2, K5) CALL RELINK(K2, K5, K4, K1) LASTLN = LASTLN + DELTA LMOVE = 0 23331 CONTINUE RETURN END INTEGER FUNCTION MAKLIN(LIN, I, NEWIND) LOGICAL*1 LIN(400) INTEGER ADDSET, GTFNDX INTEGER I, J, JUNK, NEWIND, TXTEND COMMON /CBUF/ BUF(3008), LASTBF, FREE INTEGER BUF, LASTBF, FREE COMMON /CSCRAT/ SCR, SCREND(2) , SCRFIL(40) INTEGER SCR INTEGER SCREND LOGICAL*1 SCRFIL COMMON /CTXT/ TXT(400) LOGICAL*1 TXT COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY MAKLIN = -3 OLDNDX = -3 IF(.NOT.(GTFNDX(NEWIND) .EQ. -3))GOTO 23334 CALL REMARK (19HFile size exceeded.) RETURN 23334 CONTINUE TXTEND = 1 J = I 23336 IF(.NOT.(LIN(J) .NE. 0))GOTO 23338 JUNK = ADDSET(LIN(J), TXT, TXTEND, 400) J = J + 1 IF(.NOT.(LIN(J - 1) .EQ. 10))GOTO 23339 GOTO 23338 23339 CONTINUE 23337 GOTO 23336 23338 CONTINUE IF(.NOT.(ADDSET(0, TXT, TXTEND, 400) .EQ. 0))GOTO 23341 CALL PTFNDX(NEWIND, NEWIND) RETURN 23341 CONTINUE CALL SETB (NEWIND, 3, SCREND) CALL SEEK (SCREND, SCR) CALL PUTLIN (TXT, SCR) CALL MARKL (SCR, SCREND) CALL SETB (NEWIND, 2, 0) MAKLIN = J RETURN END INTEGER FUNCTION NEXTLN(LINE) INTEGER LINE COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY NEXTLN = LINE + 1 IF(.NOT.(NEXTLN .GT. LASTLN))GOTO 23343 NEXTLN = 0 23343 CONTINUE RETURN END INTEGER FUNCTION OPTPAT(LIN, I) LOGICAL*1 LIN(400) INTEGER MAKPAT INTEGER I COMMON /CPAT/ PAT(132) LOGICAL*1 PAT IF(.NOT.(LIN(I) .EQ. 0))GOTO 23345 I = -3 GOTO 23346 23345 CONTINUE IF(.NOT.(LIN(I + 1) .EQ. 0))GOTO 23347 I = -3 GOTO 23348 23347 CONTINUE IF(.NOT.(LIN(I + 1) .EQ. LIN(I)))GOTO 23349 I = I + 1 GOTO 23350 23349 CONTINUE I = MAKPAT(LIN, I + 1, LIN(I), PAT) 23350 CONTINUE 23348 CONTINUE 23346 CONTINUE IF(.NOT.(PAT(1) .EQ. 0))GOTO 23351 I = -3 23351 CONTINUE IF(.NOT.(I .EQ. -3))GOTO 23353 PAT(1) = 0 OPTPAT = -3 GOTO 23354 23353 CONTINUE OPTPAT = 0 23354 CONTINUE RETURN END INTEGER FUNCTION PREVLN(LINE) INTEGER LINE COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY PREVLN = LINE - 1 IF(.NOT.(PREVLN .LT. 0))GOTO 23355 PREVLN = LASTLN 23355 CONTINUE RETURN END INTEGER FUNCTION PTSCAN(WAY, NUM) INTEGER GETTXT, MATCH, NEXTLN, PREVLN INTEGER K, NUM, WAY COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY COMMON /CPAT/ PAT(132) LOGICAL*1 PAT COMMON /CTXT/ TXT(400) LOGICAL*1 TXT NUM = CURLN 23357 CONTINUE IF(.NOT.(WAY .EQ. 43))GOTO 23360 NUM = NEXTLN(NUM) GOTO 23361 23360 CONTINUE NUM = PREVLN(NUM) 23361 CONTINUE K = GETTXT(NUM) IF(.NOT.(MATCH(TXT, PAT) .EQ. 1))GOTO 23362 PTSCAN = 0 RETURN 23362 CONTINUE 23358 IF(.NOT.(NUM .EQ. CURLN))GOTO 23357 23359 CONTINUE PTSCAN = -3 RETURN END SUBROUTINE READF (BUFFER, COUNT, INT) INTEGER COUNT, INT, GETLIN, JUNK LOGICAL*1 BUFFER(100) JUNK = GETLIN (BUFFER, INT) RETURN END SUBROUTINE RELINK(A, X, Y, B) INTEGER A, B, X, Y COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY OLDNDX = -3 CALL SETB (X, 0, A) CALL SETB (Y, 1, B) IFMOD = 1 RETURN END SUBROUTINE SETB (INDEX, TYPE, VALUE) INTEGER INDEX, TYPE INTEGER VALUE(2) COMMON /CBUF/ BUF(3008), LASTBF, FREE INTEGER BUF, LASTBF, FREE IF(.NOT.(TYPE .EQ. 0))GOTO 23364 IF(.NOT.(BUF(INDEX) .LT. 0))GOTO 23366 BUF(INDEX) = -VALUE(1) GOTO 23367 23366 CONTINUE BUF(INDEX) = VALUE(1) 23367 CONTINUE GOTO 23365 23364 CONTINUE IF(.NOT.(TYPE .EQ. 1))GOTO 23368 BUF(INDEX+1) = VALUE(1) GOTO 23369 23368 CONTINUE IF(.NOT.(TYPE .EQ. 2))GOTO 23370 IF(.NOT.(VALUE(1) .EQ. 1))GOTO 23372 BUF(INDEX) = -IABS(BUF(INDEX)) GOTO 23373 23372 CONTINUE BUF(INDEX) = IABS(BUF(INDEX)) 23373 CONTINUE GOTO 23371 23370 CONTINUE IF(.NOT.(TYPE .EQ. 3))GOTO 23374 BUF(INDEX+2) = VALUE(1) BUF(INDEX+3) = VALUE(2) 23374 CONTINUE 23371 CONTINUE 23369 CONTINUE 23365 CONTINUE RETURN END SUBROUTINE SETBUF INTEGER CREATE INTEGER K, J COMMON /CBUF/ BUF(3008), LASTBF, FREE INTEGER BUF, LASTBF, FREE COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY COMMON /CSCRAT/ SCR, SCREND(2) , SCRFIL(40) INTEGER SCR INTEGER SCREND LOGICAL*1 SCRFIL LOGICAL*1 FIL(4) LOGICAL*1 NULL(1) DATA FIL(1)/101/ DATA FIL(2)/100/ DATA FIL(3)/115/ DATA FIL(4)/0/ DATA NULL(1) /0/ CALL SCRATF(FIL, SCRFIL) SCR = CREATE(SCRFIL, 3) IF(.NOT.(SCR .EQ. -3))GOTO 23376 CALL CANT(SCRFIL) 23376 CONTINUE CALL MARKL (SCR, SCREND) LASTBF = 1 FREE = 0 CALL MAKLIN(NULL, 1, K) CALL RELINK(K, K, K, K) CURLN = 0 LASTLN = 0 CURSAV = 0 IFMOD = 0 NOTIFY = 0 RETURN END INTEGER FUNCTION SUBST(SUB, GFLAG) LOGICAL*1 NEW(400), SUB(132) INTEGER ADDSET, AMATCH, GETTXT, INJECT, CONCT INTEGER GFLAG, J, JUNK, K, LASTM, LINE, M, STATUS, SUBBED COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY COMMON /CPAT/ PAT(132) LOGICAL*1 PAT COMMON /CTXT/ TXT(400) LOGICAL*1 TXT SUBST = -3 IF(.NOT.(LINE1 .LE. 0))GOTO 23378 RETURN 23378 CONTINUE LINE = LINE1 23380 IF(.NOT.(LINE .LE. LINE2))GOTO 23382 J = 1 SUBBED = 0 JUNK = GETTXT(LINE) LASTM = 0 K = 1 23383 IF(.NOT.(TXT(K) .NE. 0))GOTO 23385 IF(.NOT.(GFLAG .EQ. 1 .OR. SUBBED .EQ. 0))GOTO 23386 M = AMATCH(TXT, K, PAT) GOTO 23387 23386 CONTINUE M = 0 23387 CONTINUE IF(.NOT.(M .GT. 0 .AND. LASTM .NE. M))GOTO 23388 SUBBED = 1 CALL CATSUB(TXT, K, M, SUB, NEW, J, 400) LASTM = M 23388 CONTINUE IF(.NOT.(M .EQ. 0 .OR. M .EQ. K))GOTO 23390 JUNK = ADDSET(TXT(K), NEW, J, 400) K = K + 1 GOTO 23391 23390 CONTINUE K = M 23391 CONTINUE 23384 GOTO 23383 23385 CONTINUE IF(.NOT.(SUBBED .EQ. 1))GOTO 23392 IF(.NOT.(ADDSET(0, NEW, J, 400) .EQ. 0))GOTO 23394 SUBST = -3 GOTO 23382 23394 CONTINUE SUBST = CONCT(LINE, NEW) IF(.NOT.(SUBST .EQ. -3))GOTO 23396 GOTO 23382 23396 CONTINUE CALL DELETE(LINE, LINE, STATUS) SUBST = INJECT(NEW) IF(.NOT.(SUBST .EQ. -3))GOTO 23398 GOTO 23382 23398 CONTINUE SUBST = 0 23392 CONTINUE 23381 LINE = LINE + 1 GOTO 23380 23382 CONTINUE RETURN END INTEGER FUNCTION DOSPWN(LIN, I) LOGICAL*1 LIN(100), PROCES(40), ARGS(256), SH(3), DESC(7) INTEGER I, J, SSPAWN, INIT, K, INT, CREATE, LOCCOM COMMON / CTBUFS / EDTBUF(40, 3) LOGICAL*1 EDTBUF DATA INIT/1/ DATA SH/115, 104, 0/ IF(.NOT.(INIT .EQ. 1))GOTO 23400 CALL IMPATH(ARGS) IF(.NOT.(LOCCOM(SH, ARGS, PROCES) .NE. 60))GOTO 23402 CALL REMARK(26HCannot find sh image file.) DOSPWN = -3 RETURN 23402 CONTINUE K = 1 CALL STCOPY(SH, 1, ARGS, K) CALL CHCOPY(32, ARGS, K) J=1 23404 IF(.NOT.(J .LE. 3))GOTO 23406 CALL STCOPY(EDTBUF(1,J), 1, ARGS, K) ARGS(K) = 32 K = K + 1 23405 J=J+1 GOTO 23404 23406 CONTINUE ARGS(K) = 0 INIT = 0 23400 CONTINUE CALL SKIPBL(LIN, I) IF(.NOT.(LIN(I) .EQ. 10 .OR. LIN(I) .EQ. 0))GOTO 23407 DOSPWN = SSPAWN(PROCES, SH, DESC, 119) GOTO 23408 23407 CONTINUE INT = CREATE(EDTBUF(1,1), 2) IF(.NOT.(INT .EQ. -3))GOTO 23409 DOSPWN = -3 GOTO 23410 23409 CONTINUE CALL PUTLIN(LIN(I), INT) CALL CLOSE(INT) DOSPWN = SSPAWN(PROCES, ARGS, DESC, 119) 23410 CONTINUE 23408 CONTINUE RETURN END INTEGER FUNCTION BROWSE(LINE, LIN, I) LOGICAL*1 LIN(100), DIREC INTEGER LINE, I, SCREEN, CURSCR, CTOI, LIN1, LIN2 COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY DATA SCREEN, CURSCR/22, 22/ IF(.NOT.(LIN(I) .EQ. 10))GOTO 23411 DIREC = 43 SCREEN = CURSCR GOTO 23412 23411 CONTINUE IF(.NOT.(LIN(I) .EQ. 43 .OR. LIN(I) .EQ. 46 .OR. LIN(I) .EQ. 45))G *OTO 23413 DIREC = LIN(I) I = I + 1 GOTO 23414 23413 CONTINUE DIREC = 43 23414 CONTINUE SCREEN = CTOI(LIN, I) - 1 IF(.NOT.(SCREEN .LE. 0))GOTO 23415 SCREEN = CURSCR GOTO 23416 23415 CONTINUE CURSCR = SCREEN 23416 CONTINUE 23412 CONTINUE IF(.NOT.(DIREC .EQ. 43))GOTO 23417 LIN1 = LINE GOTO 23418 23417 CONTINUE IF(.NOT.(DIREC .EQ. 46))GOTO 23419 LIN1 = LINE - (SCREEN / 2) GOTO 23420 23419 CONTINUE LIN1 = LINE - SCREEN 23420 CONTINUE 23418 CONTINUE LIN2 = LIN1 + SCREEN LIN1 = MAX0(1, LIN1) LIN2 = MIN0(LIN2, LASTLN) BROWSE = DOPRNT(LIN1, LIN2) RETURN END SUBROUTINE INITED LOGICAL*1 NUM(2), EDT(4) INTEGER I, J, JUNK, ITOC COMMON / CTBUFS / EDTBUF(40, 3) LOGICAL*1 EDTBUF DATA EDT/101, 100, 116, 0/ J=1 23421 IF(.NOT.(J .LE. 3))GOTO 23423 I = J - 1 JUNK = ITOC(I, NUM, 2) EDT(3) = NUM(1) CALL SCRATF(EDT, EDTBUF(1,J)) 23422 J=J+1 GOTO 23421 23423 CONTINUE RETURN END SUBROUTINE ENDED INTEGER I COMMON / CTBUFS / EDTBUF(40, 3) LOGICAL*1 EDTBUF I=1 23424 IF(.NOT.(I .LE. 3))GOTO 23426 CALL REMOVE(EDTBUF(1,I)) 23425 I=I+1 GOTO 23424 23426 CONTINUE RETURN END INTEGER FUNCTION GTFNDX(NEWIND) COMMON /CBUF/ BUF(3008), LASTBF, FREE INTEGER BUF, LASTBF, FREE IF(.NOT.(FREE .NE. 0))GOTO 23427 NEWIND = FREE CALL GETB(FREE, 1, FREE) GOTO 23428 23427 CONTINUE IF(.NOT.(LASTBF + 4 .LE. 3008))GOTO 23429 NEWIND = LASTBF LASTBF = LASTBF + 4 GOTO 23430 23429 CONTINUE NEWIND = -3 23430 CONTINUE 23428 CONTINUE GTFNDX = NEWIND RETURN END SUBROUTINE PTFNDX(START, STOP) INTEGER START, STOP COMMON /CBUF/ BUF(3008), LASTBF, FREE INTEGER BUF, LASTBF, FREE CALL SETB(STOP, 1, FREE) FREE = START RETURN END SUBROUTINE FINDIT(IN, OUT) LOGICAL*1 IN(100), OUT(100) INTEGER I, N, CTOI COMMON / CTBUFS / EDTBUF(40, 3) LOGICAL*1 EDTBUF CALL SCOPY(IN, 1, OUT, 1) IF(.NOT.(IN(1) .EQ. 36))GOTO 23431 I = 2 N = CTOI(IN, I) + 1 IF(.NOT.(N .GT. 1 .AND. N .LE. 3))GOTO 23433 CALL SCOPY(EDTBUF(1,N), 1, OUT, 1) 23433 CONTINUE 23431 CONTINUE RETURN END INTEGER FUNCTION DOLIST(FROM, TO) INTEGER GETTXT INTEGER FROM, I, J, TO, K LOGICAL*1 C COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY COMMON /CTXT/ TXT(400) LOGICAL*1 TXT IF(.NOT.(FROM .LE. 0))GOTO 23435 DOLIST = -3 GOTO 23436 23435 CONTINUE I = FROM 23437 IF(.NOT.(I .LE. TO))GOTO 23439 J = GETTXT(I) K=1 23440 IF(.NOT.(TXT(K) .NE. 0))GOTO 23442 IF(.NOT.(TXT(K) .GE. 32 .OR. TXT(K) .EQ. 10))GOTO 23443 CALL PUTCH(TXT(K), 2) GOTO 23444 23443 CONTINUE CALL PUTCH(94, 2) C = TXT(K) + 64 CALL PUTCH(C, 2) 23444 CONTINUE 23441 K=K+1 GOTO 23440 23442 CONTINUE 23438 I = I + 1 GOTO 23437 23439 CONTINUE CURLN = TO DOLIST = 0 23436 CONTINUE RETURN END INTEGER FUNCTION DOJOIN(FROM, TO) INTEGER FROM, TO INTEGER STATUS, J, I, JUNK, K, SAVCLN INTEGER GETTXT, PREVLN, DELETE, INJECT COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NOTIFY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NOTIFY COMMON /CSCLIN/ LIN(400) LOGICAL*1 LIN COMMON /CTXT/ TXT(400) LOGICAL*1 TXT IF(.NOT.(FROM .LE. 0))GOTO 23445 STATUS = -3 GOTO 23446 23445 CONTINUE STATUS = 0 IF(.NOT.(FROM .LT. TO))GOTO 23447 J = 1 I=FROM 23449 IF(.NOT.(I .LE. TO))GOTO 23451 JUNK = GETTXT(I) K=1 23452 IF(.NOT.(TXT(K) .NE. 10 .AND. TXT(K) .NE. 0))GOTO 23454 IF(.NOT.(J .GE. 399))GOTO 23455 STATUS = -3 GOTO 23451 23455 CONTINUE LIN(J) = TXT(K) J = J + 1 23456 CONTINUE 23453 K=K+1 GOTO 23452 23454 CONTINUE 23450 I=I+1 GOTO 23449 23451 CONTINUE LIN(J) = 10 LIN(J+1) = 0 IF(.NOT.(STATUS .EQ. 0))GOTO 23457 SAVCLN = CURLN CURLN = PREVLN(CURLN) IF(.NOT.(DELETE(FROM, TO, STATUS) .EQ. 0))GOTO 23459 STATUS = INJECT(LIN) GOTO 23460 23459 CONTINUE CURLN = SAVCLN 23460 CONTINUE 23457 CONTINUE 23447 CONTINUE 23446 CONTINUE DOJOIN = STATUS RETURN END