SUBROUTINE MAIN LOGICAL*1 LIN(512), 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CPAT/ PAT(128) 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 QUERY(40Husage: ed [-] [-p[string]] [-n] [file].) CALL INITED CALL SETBUF NUMBER = 0 PAT(1) = 0 SAVFIL(1) = 0 I=1 23000 IF (.NOT.(GETARG(I, LIN, 512) .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) GOTO 23008 23007 CONTINUE IF (.NOT.(CLOWER(LIN(2)) .EQ. 110))GOTO 23009 NUMBER = 1 23009 CONTINUE 23008 CONTINUE 23006 CONTINUE GOTO 23004 23003 CONTINUE CALL SCOPY (LIN, 1, SAVFIL, 1) IF (.NOT.(DOREAD (0, SAVFIL, 101) .EQ. -3))GOTO 23011 CALL REMARK (2H?.) 23011 CONTINUE 23004 CONTINUE 23001 I=I+1 GOTO 23000 23002 CONTINUE 23013 CONTINUE STATUS = PROMPT(PSTR, LIN, 1) IF (.NOT.(STATUS .EQ. -1))GOTO 23016 STATUS = CLRBUF(-1) GOTO 23015 23016 CONTINUE IF (.NOT.(STATUS .NE. -3))GOTO 23018 I = 1 CURSAV = CURLN IF (.NOT.(GETLST(LIN, I, STATUS) .EQ. 0))GOTO 23020 IF (.NOT.(CKGLOB(LIN, I, STATUS) .EQ. 0))GOTO 23022 STATUS = DOGLOB(LIN, I, STATUS) GOTO 23023 23022 CONTINUE IF (.NOT.(STATUS .NE. -3))GOTO 23024 STATUS = DOCMD(LIN, I, 0, STATUS) 23024 CONTINUE 23023 CONTINUE 23020 CONTINUE 23018 CONTINUE 23017 CONTINUE IF (.NOT.(STATUS .EQ. -3))GOTO 23026 CALL REMARK(2H?.) CURLN = CURSAV GOTO 23027 23026 CONTINUE IF (.NOT.(STATUS .EQ. -1))GOTO 23028 IF (.NOT.(CLRBUF(113) .EQ. 0))GOTO 23030 GOTO 23015 23030 CONTINUE 23028 CONTINUE 23027 CONTINUE 23014 GOTO 23013 23015 CONTINUE CALL ENDED RETURN END INTEGER FUNCTION APPEND(LINE, GLOB) INTEGER INPLIN, INJECT INTEGER LINE, GLOB COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CSCLIN/ LIN(512) LOGICAL*1 LIN IF (.NOT.(GLOB .EQ. 1))GOTO 23032 APPEND = -3 GOTO 23033 23032 CONTINUE CURLN = LINE APPEND = 1 23034 IF (.NOT.(APPEND .EQ. 1))GOTO 23036 IF (.NOT.(INPLIN(LIN, 1, CURLN+1) .EQ. -1))GOTO 23037 APPEND = -1 GOTO 23038 23037 CONTINUE IF (.NOT.(LIN(1) .EQ. 46 .AND. LIN(2) .EQ. 10))GOTO 23039 APPEND = 0 GOTO 23040 23039 CONTINUE IF (.NOT.(INJECT(LIN) .EQ. -3))GOTO 23041 APPEND = -3 23041 CONTINUE 23040 CONTINUE 23038 CONTINUE 23035 GOTO 23034 23036 CONTINUE 23033 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER DATA SCREEN, CURSCR/22, 22/ IF (.NOT.(LIN(I) .EQ. 10))GOTO 23043 DIREC = 43 SCREEN = CURSCR GOTO 23044 23043 CONTINUE IF (.NOT.(LIN(I) .EQ. 43 .OR. LIN(I) .EQ. 46 .OR. LIN(I) .EQ. 45)) *GOTO 23045 DIREC = LIN(I) I = I + 1 GOTO 23046 23045 CONTINUE DIREC = 43 23046 CONTINUE SCREEN = CTOI(LIN, I) - 1 IF (.NOT.(SCREEN .LE. 0))GOTO 23047 SCREEN = CURSCR GOTO 23048 23047 CONTINUE CURSCR = SCREEN 23048 CONTINUE 23044 CONTINUE IF (.NOT.(DIREC .EQ. 43))GOTO 23049 LIN1 = LINE GOTO 23050 23049 CONTINUE IF (.NOT.(DIREC .EQ. 46))GOTO 23051 LIN1 = LINE - (SCREEN / 2) GOTO 23052 23051 CONTINUE LIN1 = LINE - SCREEN 23052 CONTINUE 23050 CONTINUE LIN2 = LIN1 + SCREEN LIN1 = MAX0(1, LIN1) LIN2 = MIN0(LIN2, LASTLN) BROWSE = DOPRNT(LIN1, LIN2) RETURN END SUBROUTINE CATSUB(LIN, FROM, TO, SUB, NEW, K, MAXNEW) INTEGER ADDSET , ITOC, CTOI INTEGER FROM, I, J, JUNK, K, MAXNEW, TO LOGICAL*1 LIN(512), NEW(MAXNEW), SUB(128) , C COMMON/CTAG/TAGLIM(20) INTEGER TAGLIM COMMON / CNOREG / NOREG INTEGER NOREG I = 1 23053 IF (.NOT.(SUB(I) .NE. 0))GOTO 23055 IF (.NOT.(SUB(I) .EQ. (-3)))GOTO 23056 J = FROM 23058 IF (.NOT.(J .LT. TO))GOTO 23060 JUNK = ADDSET(LIN(J), NEW, K, MAXNEW) 23059 J = J + 1 GOTO 23058 23060 CONTINUE GOTO 23057 23056 CONTINUE IF (.NOT.(SUB(I) .EQ. (-4)))GOTO 23061 I = I + 1 N = SUB(I) IF (.NOT.(N .LE. 0 .OR. N .GT. 10))GOTO 23063 CALL ERROR(24HCATSUB: illegal section.) 23063 CONTINUE J = TAGLIM(2*N-1) 23065 IF (.NOT.(J .LT. TAGLIM(2*N)))GOTO 23067 JUNK = ADDSET(LIN(J), NEW, K, MAXNEW) 23066 J = J+1 GOTO 23065 23067 CONTINUE GOTO 23062 23061 CONTINUE IF (.NOT.(SUB(I) .EQ. (-5)))GOTO 23068 K = K + ITOC(NOREG, NEW(K), MAXNEW - K + 1) I = I + 1 C = SUB(I) IF (.NOT.(C .EQ. 43 .OR. C .EQ. 45))GOTO 23070 I = I + 1 IF (.NOT.(SUB(I) .NE. 32 .AND. SUB(I) .NE. 9))GOTO 23072 JUNK = CTOI(SUB, I) IF (.NOT.(JUNK .EQ. 0))GOTO 23074 JUNK = 1 23074 CONTINUE GOTO 23073 23072 CONTINUE JUNK = 1 23073 CONTINUE IF (.NOT.(C .EQ. 43))GOTO 23076 NOREG = NOREG + JUNK GOTO 23077 23076 CONTINUE NOREG = NOREG - JUNK 23077 CONTINUE 23070 CONTINUE I = I - 1 GOTO 23069 23068 CONTINUE JUNK = ADDSET(SUB(I), NEW, K, MAXNEW) 23069 CONTINUE 23062 CONTINUE 23057 CONTINUE 23054 I = I + 1 GOTO 23053 23055 CONTINUE RETURN END INTEGER FUNCTION CKGLOB(LIN, I, STATUS) LOGICAL*1 LIN(512) 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CPAT/ PAT(128) LOGICAL*1 PAT COMMON /CTXT/ TXT(512) LOGICAL*1 TXT IF (.NOT.(CLOWER(LIN(I)) .NE. 103 .AND. CLOWER(LIN(I)) .NE. 120))G *OTO 23078 STATUS = -1 GOTO 23079 23078 CONTINUE IF (.NOT.(CLOWER(LIN(I)) .EQ. 103))GOTO 23080 GFLAG = 1 GOTO 23081 23080 CONTINUE GFLAG = 0 23081 CONTINUE I = I + 1 IF (.NOT.(OPTPAT(LIN, I) .EQ. -3 .OR. DEFALT(1, LASTLN, STATUS) .E *Q. -3))GOTO 23082 STATUS = -3 GOTO 23083 23082 CONTINUE I = I + 1 LINE = LINE1 23084 IF (.NOT.(LINE .LE. LINE2))GOTO 23086 K = GETTXT(LINE) IF (.NOT.(MATCH(TXT, PAT) .EQ. GFLAG))GOTO 23087 CALL SETB (K, 2, 1) GOTO 23088 23087 CONTINUE CALL SETB (K, 2, 0) 23088 CONTINUE 23085 LINE = LINE + 1 GOTO 23084 23086 CONTINUE LINE=NEXTLN(LINE2) 23089 IF (.NOT.(LINE.NE.LINE1))GOTO 23091 K = GETIND(LINE) CALL SETB (K, 2, 0) 23090 LINE=NEXTLN(LINE) GOTO 23089 23091 CONTINUE STATUS = 0 23083 CONTINUE 23079 CONTINUE CKGLOB = STATUS RETURN END INTEGER FUNCTION CKP(LIN, I, PFLAG, STATUS) LOGICAL*1 LIN(512), 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 23092 J = J + 1 PFLAG = C GOTO 23093 23092 CONTINUE PFLAG = 0 23093 CONTINUE IF (.NOT.(LIN(J) .EQ. 10))GOTO 23094 STATUS = 0 GOTO 23095 23094 CONTINUE STATUS = -3 23095 CONTINUE CKP = STATUS RETURN END INTEGER FUNCTION CLRBUF(COMAND) LOGICAL*1 COMAND INTEGER JUNK, PROMPT, ISATTY 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CSCLIN/ LIN(512) LOGICAL*1 LIN LOGICAL*1 PSTR(30) DATA PSTR(1)/65/,PSTR(2)/114/,PSTR(3)/101/,PSTR(4)/32/,PSTR(5)/121 */,PSTR(6)/111/,PSTR(7)/117/,PSTR(8)/32/,PSTR(9)/83/,PSTR(10)/85/,P *STR(11)/82/,PSTR(12)/69/,PSTR(13)/32/,PSTR(14)/40/,PSTR(15)/121/,P *STR(16)/32/,PSTR(17)/109/,PSTR(18)/101/,PSTR(19)/97/,PSTR(20)/110/ *,PSTR(21)/115/,PSTR(22)/32/,PSTR(23)/89/,PSTR(24)/69/,PSTR(25)/83/ *,PSTR(26)/41/,PSTR(27)/63/,PSTR(28)/32/,PSTR(29)/0/ IF (.NOT.(COMAND .EQ. 113 .AND. ISATTY(1) .EQ. 1 .AND. IFMOD .EQ. *1))GOTO 23096 PSTR(29) = 7 PSTR(30) = 0 JUNK = PROMPT(PSTR, LIN, 1) IF (.NOT.(LIN(1) .NE. 121 .AND. LIN(1) .NE. 89))GOTO 23098 CLRBUF=(-3) RETURN 23098 CONTINUE 23096 CONTINUE CALL CLOSE(SCR) CALL REMOVE(SCRFIL) CLRBUF=(0) 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CTXT/ TXT(512) LOGICAL*1 TXT CONCT = 0 I=1 23100 IF (.NOT.(LIN(I).NE.0))GOTO 23102 IF (.NOT.(LIN(I) .EQ. 10))GOTO 23103 RETURN 23103 CONTINUE 23101 I=I+1 GOTO 23100 23102 CONTINUE IF (.NOT.(NBR+1 .GT. LASTLN))GOTO 23105 CONCT = -3 RETURN 23105 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER IF (.NOT.(NLINES .EQ. 0))GOTO 23107 LINE1 = DEF1 LINE2 = DEF2 23107 CONTINUE IF (.NOT.(LINE1 .GT. LINE2 .OR. LINE1 .LE. 0))GOTO 23109 STATUS = -3 GOTO 23110 23109 CONTINUE STATUS = 0 23110 CONTINUE DEFALT = STATUS RETURN END INTEGER FUNCTION DELETE(FROM, TO, STATUS) INTEGER GETIND, NEXTLN, PREVLN INTEGER FROM, K1, K2, STATUS, TO COMMON / CDEL / DELCNT, FSTDEL, LSTDEL INTEGER DELCNT INTEGER FSTDEL INTEGER LSTDEL COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER IF (.NOT.(FROM .LE. 0))GOTO 23111 STATUS = -3 GOTO 23112 23111 CONTINUE IF (.NOT.(DELCNT .NE. 0))GOTO 23113 CALL PTFNDX(FSTDEL, LSTDEL) 23113 CONTINUE FSTDEL = GETIND(FROM) LSTDEL = GETIND(TO) K1 = GETIND(PREVLN(FROM)) K2 = GETIND(NEXTLN(TO)) DELCNT = TO - FROM + 1 LASTLN = LASTLN - DELCNT CURLN = PREVLN(FROM) CALL RELINK(K1, K2, K1, K2) STATUS = 0 23112 CONTINUE DELETE = STATUS RETURN END INTEGER FUNCTION DOCMD(LIN, I, GLOB, STATUS) LOGICAL*1 FILE(40), LIN(512), SUB(128) INTEGER APPEND, DELETE, DOPRNT, DOREAD, DOWRIT, LMOVE, SUBST, UNDE *L 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, DONREG, TYPSET, KOPY INTEGER CLRBUF COMMON /CFILE/ SAVFIL(40) LOGICAL*1 SAVFIL COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CPAT/ PAT(128) LOGICAL*1 PAT PFLAG = 0 STATUS = -3 COMAND = CLOWER(LIN(I)) I = I + 1 IF (.NOT.(COMAND .EQ. 97))GOTO 23115 IF (.NOT.(LIN(I) .EQ. 10))GOTO 23117 STATUS = APPEND(LINE2, GLOB) 23117 CONTINUE GOTO 23116 23115 CONTINUE IF (.NOT.(COMAND .EQ. 99))GOTO 23119 IF (.NOT.(LIN(I) .EQ. 10))GOTO 23121 IF (.NOT.(DEFALT(CURLN, CURLN, STATUS) .EQ. 0))GOTO 23123 IF (.NOT.(DELETE(LINE1, LINE2, STATUS) .EQ. 0))GOTO 23125 STATUS = APPEND(PREVLN(LINE1), GLOB) 23125 CONTINUE 23123 CONTINUE 23121 CONTINUE GOTO 23120 23119 CONTINUE IF (.NOT.(COMAND .EQ. 100))GOTO 23127 IF (.NOT.(CKP(LIN, I, PFLAG, STATUS) .EQ. 0))GOTO 23129 IF (.NOT.(DEFALT(CURLN, CURLN, STATUS) .EQ. 0))GOTO 23131 IF (.NOT.(DELETE(LINE1, LINE2, STATUS) .EQ. 0))GOTO 23133 IF (.NOT.(NEXTLN(CURLN) .NE. 0))GOTO 23135 CURLN = NEXTLN(CURLN) 23135 CONTINUE 23133 CONTINUE 23131 CONTINUE 23129 CONTINUE GOTO 23128 23127 CONTINUE IF (.NOT.(COMAND .EQ. 105))GOTO 23137 IF (.NOT.(LIN(I) .EQ. 10))GOTO 23139 STATUS = APPEND(PREVLN(LINE2), GLOB) 23139 CONTINUE GOTO 23138 23137 CONTINUE IF (.NOT.(COMAND .EQ. 106))GOTO 23141 IF (.NOT.(CKP(LIN, I, PFLAG, STATUS) .EQ. 0))GOTO 23143 IF (.NOT.(DEFALT(CURLN, NEXTLN(CURLN), STATUS) .EQ. 0))GOTO 23145 STATUS = DOJOIN(LINE1, LINE2) 23145 CONTINUE 23143 CONTINUE GOTO 23142 23141 CONTINUE IF (.NOT.(COMAND .EQ. 61))GOTO 23147 IF (.NOT.(CKP(LIN, I, PFLAG, STATUS) .EQ. 0))GOTO 23149 CALL PUTINT(LINE2, 1,2) CALL PUTCH(10,2) 23149 CONTINUE GOTO 23148 23147 CONTINUE IF (.NOT.(COMAND .EQ. 110))GOTO 23151 STATUS = DONREG(LIN, I) GOTO 23152 23151 CONTINUE IF (.NOT.(COMAND .EQ. 109))GOTO 23153 IF (.NOT.(GETONE(LIN, I, LINE3, STATUS) .EQ. -1))GOTO 23155 STATUS = -3 23155 CONTINUE IF (.NOT.(STATUS .EQ. 0))GOTO 23157 IF (.NOT.(CKP(LIN, I, PFLAG, STATUS) .EQ. 0))GOTO 23159 IF (.NOT.(DEFALT(CURLN, CURLN, STATUS) .EQ. 0))GOTO 23161 STATUS = LMOVE(LINE3) 23161 CONTINUE 23159 CONTINUE 23157 CONTINUE GOTO 23154 23153 CONTINUE IF (.NOT.(COMAND .EQ. 107))GOTO 23163 IF (.NOT.(GETONE(LIN, I, LINE3, STATUS) .EQ. -1))GOTO 23165 STATUS = -3 23165 CONTINUE IF (.NOT.(STATUS .EQ. 0))GOTO 23167 IF (.NOT.(CKP(LIN, I, PFLAG, STATUS) .EQ. 0))GOTO 23169 IF (.NOT.(DEFALT(CURLN, CURLN, STATUS) .EQ. 0))GOTO 23171 STATUS = KOPY(LINE3) 23171 CONTINUE 23169 CONTINUE 23167 CONTINUE GOTO 23164 23163 CONTINUE IF (.NOT.(COMAND .EQ. 115))GOTO 23173 IF (.NOT.(OPTPAT(LIN, I) .EQ. 0))GOTO 23175 IF (.NOT.(GETRHS(LIN, I, SUB, GFLAG) .EQ. 0))GOTO 23177 IF (.NOT.(CKP(LIN, I + 1, PFLAG, STATUS) .EQ. 0))GOTO 23179 IF (.NOT.(DEFALT(CURLN, CURLN, STATUS) .EQ. 0))GOTO 23181 STATUS = SUBST(SUB, GFLAG) 23181 CONTINUE 23179 CONTINUE 23177 CONTINUE 23175 CONTINUE GOTO 23174 23173 CONTINUE IF (.NOT.(COMAND .EQ. 94))GOTO 23183 STATUS = DOSPWN(LIN, I) GOTO 23184 23183 CONTINUE IF (.NOT.(COMAND .EQ. 101))GOTO 23185 IF (.NOT.(NLINES .EQ. 0))GOTO 23187 IF (.NOT.(GETFN(LIN, I, FILE) .EQ. 0))GOTO 23189 IF (.NOT.(CLRBUF(113) .EQ. 0))GOTO 23191 CALL SCOPY(FILE, 1, SAVFIL, 1) CALL SETBUF STATUS = DOREAD(0, FILE, 101) GOTO 23192 23191 CONTINUE STATUS = 0 23192 CONTINUE 23189 CONTINUE 23187 CONTINUE GOTO 23186 23185 CONTINUE IF (.NOT.(COMAND .EQ. 102))GOTO 23193 IF (.NOT.(NLINES .EQ. 0))GOTO 23195 IF (.NOT.(GETFN(LIN, I, FILE) .EQ. 0))GOTO 23197 CALL SCOPY(FILE, 1, SAVFIL, 1) CALL PUTLIN(SAVFIL, 2) CALL PUTCH(10,2) STATUS = 0 23197 CONTINUE 23195 CONTINUE GOTO 23194 23193 CONTINUE IF (.NOT.(COMAND .EQ. 114))GOTO 23199 IF (.NOT.(GETFN(LIN, I, FILE) .EQ. 0))GOTO 23201 STATUS = DOREAD(LINE2, FILE, 114) 23201 CONTINUE GOTO 23200 23199 CONTINUE IF (.NOT.(COMAND .EQ. 119))GOTO 23203 IF (.NOT.(GETFN(LIN, I, FILE) .EQ. 0))GOTO 23205 IF (.NOT.(DEFALT(1, LASTLN, STATUS) .EQ. 0))GOTO 23207 STATUS = DOWRIT(LINE1, LINE2, FILE) 23207 CONTINUE 23205 CONTINUE GOTO 23204 23203 CONTINUE IF (.NOT.(COMAND .EQ. 112))GOTO 23209 IF (.NOT.(LIN(I) .EQ. 10))GOTO 23211 IF (.NOT.(DEFALT(CURLN, CURLN, STATUS) .EQ. 0))GOTO 23213 STATUS = DOPRNT(LINE1, LINE2) 23213 CONTINUE 23211 CONTINUE GOTO 23210 23209 CONTINUE IF (.NOT.(COMAND .EQ. 108))GOTO 23215 IF (.NOT.(LIN(I) .EQ. 10))GOTO 23217 IF (.NOT.(DEFALT(CURLN, CURLN, STATUS) .EQ. 0))GOTO 23219 STATUS = DOLIST(LINE1, LINE2) 23219 CONTINUE 23217 CONTINUE GOTO 23216 23215 CONTINUE IF (.NOT.(COMAND .EQ. 98))GOTO 23221 IF (.NOT.(DEFALT(CURLN, CURLN, STATUS) .EQ. 0))GOTO 23223 STATUS = BROWSE(LINE2, LIN, I) 23223 CONTINUE GOTO 23222 23221 CONTINUE IF (.NOT.(COMAND .EQ. 35))GOTO 23225 STATUS = 0 GOTO 23226 23225 CONTINUE IF (.NOT.(COMAND .EQ. 10))GOTO 23227 IF (.NOT.(NLINES .EQ. 0))GOTO 23229 LINE2 = NEXTLN(CURLN) 23229 CONTINUE STATUS = DOPRNT(LINE2, LINE2) GOTO 23228 23227 CONTINUE IF (.NOT.(COMAND .EQ. 45))GOTO 23231 IF (.NOT.(NLINES .EQ. 0))GOTO 23233 LINE2 = PREVLN(CURLN) 23233 CONTINUE STATUS = DOPRNT(LINE2, LINE2) GOTO 23232 23231 CONTINUE IF (.NOT.(COMAND .EQ. 113))GOTO 23235 IF (.NOT.(LIN(I) .EQ. 10 .AND. NLINES .EQ. 0 .AND. GLOB .EQ. 0))GO *TO 23237 STATUS = -1 23237 CONTINUE GOTO 23236 23235 CONTINUE IF (.NOT.(COMAND .EQ. 116))GOTO 23239 STATUS = TYPSET(LIN, I) GOTO 23240 23239 CONTINUE IF (.NOT.(COMAND .EQ. 117))GOTO 23241 IF (.NOT.(LIN(I) .EQ. 10))GOTO 23243 STATUS = UNDEL(LINE2, GLOB) 23243 CONTINUE 23241 CONTINUE 23240 CONTINUE 23236 CONTINUE 23232 CONTINUE 23228 CONTINUE 23226 CONTINUE 23222 CONTINUE 23216 CONTINUE 23210 CONTINUE 23204 CONTINUE 23200 CONTINUE 23194 CONTINUE 23186 CONTINUE 23184 CONTINUE 23174 CONTINUE 23164 CONTINUE 23154 CONTINUE 23152 CONTINUE 23148 CONTINUE 23142 CONTINUE 23138 CONTINUE 23128 CONTINUE 23120 CONTINUE 23116 CONTINUE IF (.NOT.(STATUS .EQ. 0))GOTO 23245 IF (.NOT.(PFLAG .EQ. 112))GOTO 23247 STATUS = DOPRNT(CURLN, CURLN) GOTO 23248 23247 CONTINUE IF (.NOT.(PFLAG .EQ. 108))GOTO 23249 STATUS = DOLIST(CURLN, CURLN) 23249 CONTINUE 23248 CONTINUE 23245 CONTINUE DOCMD = STATUS RETURN END INTEGER FUNCTION DOGLOB(LIN, I, STATUS) LOGICAL*1 LIN(512) INTEGER DOCMD, GETIND, GETLST, NEXTLN, PROMPT 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER LOGICAL*1 GPSTR(3) DATA GPSTR(1)/103/,GPSTR(2)/95/,GPSTR(3)/0/ LAST = LENGTH(LIN) 23251 IF (.NOT.(LIN(LAST - 1) .EQ. 64))GOTO 23253 LIN(LAST - 1) = 10 JUNK = PROMPT(GPSTR, LIN(LAST),1) 23252 LAST = LENGTH(LIN) GOTO 23251 23253 CONTINUE STATUS = 0 COUNT = 0 LINE = LINE1 ISTART = I 23254 CONTINUE K = GETIND(LINE) CALL GETB(K, 2, VALUE) IF (.NOT.(VALUE(1) .EQ. 1))GOTO 23257 CALL SETB(K, 2, 0) CURSAV = LINE I = ISTART 23259 CONTINUE CURLN = LINE IF (.NOT.(GETLST(LIN, I, STATUS) .EQ. 0))GOTO 23262 IF (.NOT.(DOCMD(LIN, I, 1, STATUS) .EQ. 0))GOTO 23264 COUNT = 0 23264 CONTINUE 23262 CONTINUE 23266 IF (.NOT.(LIN(I) .NE. 10))GOTO 23267 I = I + 1 GOTO 23266 23267 CONTINUE I = I + 1 IF (.NOT.(LIN(I) .EQ. 0))GOTO 23268 GOTO 23261 23268 CONTINUE 23260 GOTO 23259 23261 CONTINUE GOTO 23258 23257 CONTINUE LINE = NEXTLN(LINE) COUNT = COUNT + 1 23258 CONTINUE 23255 IF (.NOT.(COUNT .GT. LASTLN .OR. STATUS .NE. 0))GOTO 23254 23256 CONTINUE DOGLOB = STATUS 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CSCLIN/ LIN(512) LOGICAL*1 LIN COMMON /CTXT/ TXT(512) LOGICAL*1 TXT IF (.NOT.(FROM .LE. 0))GOTO 23270 STATUS = -3 GOTO 23271 23270 CONTINUE STATUS = 0 IF (.NOT.(FROM .LT. TO))GOTO 23272 J = 1 I=FROM 23274 IF (.NOT.(I .LE. TO))GOTO 23276 JUNK = GETTXT(I) K=1 23277 IF (.NOT.(TXT(K) .NE. 10 .AND. TXT(K) .NE. 0))GOTO 23279 IF (.NOT.(J .GE. 511))GOTO 23280 STATUS = -3 GOTO 23276 23280 CONTINUE LIN(J) = TXT(K) J = J + 1 23281 CONTINUE 23278 K=K+1 GOTO 23277 23279 CONTINUE 23275 I=I+1 GOTO 23274 23276 CONTINUE LIN(J) = 10 LIN(J+1) = 0 IF (.NOT.(STATUS .EQ. 0))GOTO 23282 SAVCLN = CURLN CURLN = PREVLN(CURLN) IF (.NOT.(DELETE(FROM, TO, STATUS) .EQ. 0))GOTO 23284 STATUS = INJECT(LIN) GOTO 23285 23284 CONTINUE CURLN = SAVCLN 23285 CONTINUE 23282 CONTINUE 23272 CONTINUE 23271 CONTINUE DOJOIN = STATUS 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CTXT/ TXT(512) LOGICAL*1 TXT IF (.NOT.(FROM .LE. 0))GOTO 23286 DOLIST = -3 GOTO 23287 23286 CONTINUE I = FROM 23288 IF (.NOT.(I .LE. TO))GOTO 23290 J = GETTXT(I) CALL PTLNUM(I, 2) K=1 23291 IF (.NOT.(TXT(K) .NE. 0))GOTO 23293 IF (.NOT.(TXT(K) .GE. 32 .OR. TXT(K) .EQ. 10))GOTO 23294 CALL PUTCH(TXT(K), 2) GOTO 23295 23294 CONTINUE CALL PUTCH(94, 2) C = TXT(K) + 64 CALL PUTCH(C, 2) 23295 CONTINUE 23292 K=K+1 GOTO 23291 23293 CONTINUE 23289 I = I + 1 GOTO 23288 23290 CONTINUE CURLN = TO DOLIST = 0 23287 CONTINUE RETURN END INTEGER FUNCTION DONREG(LIN, I) LOGICAL*1 LIN(100), OP INTEGER I, J, STATUS, PFLAG, DIF INTEGER INDEX, CTOI COMMON / CNOREG / NOREG INTEGER NOREG LOGICAL*1 LEGAL(4) DATA LEGAL(1)/61/,LEGAL(2)/43/,LEGAL(3)/45/,LEGAL(4)/0/ STATUS = 0 PFLAG = 0 IF (.NOT.(LIN(I) .EQ. 10))GOTO 23296 PFLAG = 1 GOTO 23297 23296 CONTINUE OP = LIN(I) IF (.NOT.(INDEX(LEGAL, OP) .EQ. 0))GOTO 23298 STATUS = -3 GOTO 23299 23298 CONTINUE J = I + 1 DIF = CTOI(LIN, J) IF (.NOT.(DIF .EQ. 0 .AND. OP .NE. 61))GOTO 23300 DIF = 1 23300 CONTINUE IF (.NOT.(OP .EQ. 43))GOTO 23302 NOREG = NOREG + DIF GOTO 23303 23302 CONTINUE IF (.NOT.(OP .EQ. 61))GOTO 23304 NOREG = DIF GOTO 23305 23304 CONTINUE NOREG = NOREG - DIF 23305 CONTINUE 23303 CONTINUE IF (.NOT.(LIN(J) .EQ. 112 .OR. LIN(J) .EQ. 80))GOTO 23306 PFLAG = 1 23306 CONTINUE 23299 CONTINUE 23297 CONTINUE IF (.NOT.(STATUS .EQ. 0 .AND. PFLAG .EQ. 1))GOTO 23308 CALL PUTINT(NOREG, 1,2) CALL PUTCH(10,2) 23308 CONTINUE DONREG=(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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CTXT/ TXT(512) LOGICAL*1 TXT IF (.NOT.(FROM .LE. 0))GOTO 23310 DOPRNT = -3 GOTO 23311 23310 CONTINUE I = FROM 23312 IF (.NOT.(I .LE. TO))GOTO 23314 J = GETTXT(I) CALL PTLNUM(I, 2) CALL PUTLIN(TXT, 2) 23313 I = I + 1 GOTO 23312 23314 CONTINUE CURLN = TO DOPRNT = 0 23311 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CFILE/ SAVFIL(40) LOGICAL*1 SAVFIL COMMON /CSCLIN/ LIN(512) LOGICAL*1 LIN IF (.NOT.(COMAND .EQ. 101))GOTO 23315 ACCESS = 3 GOTO 23316 23315 CONTINUE ACCESS = 1 23316 CONTINUE CALL FINDIT(FILE, LIN) FD = OPEN(LIN, ACCESS) IF (.NOT.(FD .EQ. -3))GOTO 23317 DOREAD = -3 GOTO 23318 23317 CONTINUE CURLN = LINE DOREAD = 0 COUNT = 0 23319 IF (.NOT.(GETLIN(LIN, FD) .NE. -1))GOTO 23321 DOREAD = INJECT(LIN) IF (.NOT.(DOREAD .EQ. -3))GOTO 23322 GOTO 23321 23322 CONTINUE 23320 COUNT = COUNT + 1 GOTO 23319 23321 CONTINUE CALL CLOSE(FD) IF (.NOT.(PRINT .EQ. 1))GOTO 23324 CALL PUTINT(COUNT, 1,2) CALL PUTCH(10,2) 23324 CONTINUE IF (.NOT.(COMAND .EQ. 101))GOTO 23326 IFMOD = 0 23326 CONTINUE 23318 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, STATUS COMMON / CTBUFS / EDTBUF(40, 4) LOGICAL*1 EDTBUF LOGICAL*1 SUFFIX(7) DATA SUFFIX(1)/46/,SUFFIX(2)/116/,SUFFIX(3)/115/,SUFFIX(4)/107/,SU *FFIX(5)/0/,SUFFIX(6)/10/,SUFFIX(7)/0/ DATA INIT/1/ DATA SH/115, 104, 0/ IF (.NOT.(INIT .EQ. 1))GOTO 23328 CALL IMPATH(ARGS) IF (.NOT.(LOCCOM(SH, ARGS, SUFFIX, PROCES) .NE. 60))GOTO 23330 CALL REMARK(26HCannot find sh image file.) DOSPWN = -3 RETURN 23330 CONTINUE K = 1 CALL STCOPY(SH, 1, ARGS, K) CALL CHCOPY(32, ARGS, K) J=1 23332 IF (.NOT.(J .LE. 4))GOTO 23334 CALL STCOPY(EDTBUF(1,J), 1, ARGS, K) ARGS(K) = 32 K = K + 1 23333 J=J+1 GOTO 23332 23334 CONTINUE ARGS(K) = 0 INIT = 0 23328 CONTINUE CALL SKIPBL(LIN, I) IF (.NOT.(LIN(I) .EQ. 10 .OR. LIN(I) .EQ. 0))GOTO 23335 STATUS = SSPAWN(PROCES, SH, DESC, 119) GOTO 23336 23335 CONTINUE INT = CREATE(EDTBUF(1,1), 2) IF (.NOT.(INT .EQ. -3))GOTO 23337 STATUS = -3 GOTO 23338 23337 CONTINUE CALL PUTLIN(LIN(I), INT) CALL CLOSE(INT) STATUS = SSPAWN(PROCES, ARGS, DESC, 119) 23338 CONTINUE 23336 CONTINUE IF (.NOT.(STATUS .NE. -3))GOTO 23339 STATUS = 0 23339 CONTINUE DOSPWN=(STATUS) RETURN END INTEGER FUNCTION DOWRIT(FROM, TO, FILE) LOGICAL*1 FILE(512), LIN(40) INTEGER CREATE, GETTXT INTEGER FD, FROM, K, LINE, TO COMMON /CTXT/ TXT(512) LOGICAL*1 TXT COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CFILE/ SAVFIL(40) LOGICAL*1 SAVFIL CALL FINDIT(FILE, LIN) FD = CREATE(LIN, 2) IF (.NOT.(FD .EQ. -3))GOTO 23341 DOWRIT = -3 GOTO 23342 23341 CONTINUE LINE = FROM 23343 IF (.NOT.(LINE .LE. TO))GOTO 23345 K = GETTXT(LINE) CALL PUTLIN(TXT, FD) 23344 LINE = LINE + 1 GOTO 23343 23345 CONTINUE CALL CLOSE(FD) IF (.NOT.(PRINT .EQ. 1))GOTO 23346 CALL PUTINT(TO-FROM+1, 1,2) CALL PUTCH(10,2) 23346 CONTINUE DOWRIT = 0 IFMOD = 0 23342 CONTINUE RETURN END SUBROUTINE ENDED INTEGER I COMMON / CTBUFS / EDTBUF(40, 4) LOGICAL*1 EDTBUF I=1 23348 IF (.NOT.(I .LE. 4))GOTO 23350 CALL REMOVE(EDTBUF(1,I)) 23349 I=I+1 GOTO 23348 23350 CONTINUE RETURN END SUBROUTINE FINDIT(IN, OUT) LOGICAL*1 IN(100), OUT(100) INTEGER I, N, CTOI COMMON / CTBUFS / EDTBUF(40, 4) LOGICAL*1 EDTBUF CALL SCOPY(IN, 1, OUT, 1) IF (.NOT.(IN(1) .EQ. 36))GOTO 23351 I = 2 N = CTOI(IN, I) + 1 IF (.NOT.(N .GT. 1 .AND. N .LE. 4))GOTO 23353 CALL SCOPY(EDTBUF(1,N), 1, OUT, 1) 23353 CONTINUE 23351 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 23355 VALUE(1) = IABS(BUF(INDEX)) GOTO 23356 23355 CONTINUE IF (.NOT.(TYPE .EQ. 1))GOTO 23357 VALUE(1) = BUF(INDEX+1) GOTO 23358 23357 CONTINUE IF (.NOT.(TYPE .EQ. 2))GOTO 23359 IF (.NOT.(BUF(INDEX) .LT. 0))GOTO 23361 VALUE(1) = 1 GOTO 23362 23361 CONTINUE VALUE(1) = 0 23362 CONTINUE GOTO 23360 23359 CONTINUE IF (.NOT.(TYPE .EQ. 3))GOTO 23363 VALUE(1) = BUF(INDEX+2) VALUE(2) = BUF(INDEX+3) 23363 CONTINUE 23360 CONTINUE 23358 CONTINUE 23356 CONTINUE RETURN END INTEGER FUNCTION GETFN(LIN, I, FILE) LOGICAL*1 LIN(512), FILE(512) INTEGER I, J, K COMMON /CFILE/ SAVFIL(40) LOGICAL*1 SAVFIL GETFN = -3 IF (.NOT.(LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 9))GOTO 23365 J = I + 1 CALL SKIPBL(LIN, J) K = 1 23367 IF (.NOT.(LIN(J) .NE. 10))GOTO 23369 FILE(K) = LIN(J) J = J + 1 23368 K = K + 1 GOTO 23367 23369 CONTINUE FILE(K) = 0 IF (.NOT.(K .GT. 1))GOTO 23370 GETFN = 0 23370 CONTINUE GOTO 23366 23365 CONTINUE IF (.NOT.(LIN(I) .EQ. 10 .AND. SAVFIL(1) .NE. 0))GOTO 23372 CALL SCOPY(SAVFIL, 1, FILE, 1) GETFN = 0 23372 CONTINUE 23366 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER DATA OLDNDX /-3/ DATA OLDLIN /-2/ IF (.NOT.(OLDNDX .NE. -3 .AND. LINE .EQ. NEXTLN(OLDLIN)))GOTO 2337 *4 CALL GETB(OLDNDX, 1, K) GOTO 23375 23374 CONTINUE IF (.NOT.(OLDNDX .NE. -3 .AND. LINE .EQ. OLDLIN))GOTO 23376 K = OLDNDX GOTO 23377 23376 CONTINUE IF (.NOT.(OLDNDX .NE. -3 .AND. LINE .EQ. PREVLN(OLDLIN)))GOTO 2337 *8 CALL GETB(OLDNDX, 0, K) GOTO 23379 23378 CONTINUE K = 1 IF (.NOT.(LINE .LT. LASTLN/2))GOTO 23380 J=0 23382 IF (.NOT.(J.LT.LINE))GOTO 23384 CALL GETB (K, 1, K) 23383 J=J+1 GOTO 23382 23384 CONTINUE GOTO 23381 23380 CONTINUE J=LASTLN 23385 IF (.NOT.(J.GE.LINE))GOTO 23387 CALL GETB(K, 0, K) 23386 J=J-1 GOTO 23385 23387 CONTINUE 23381 CONTINUE 23379 CONTINUE 23377 CONTINUE 23375 CONTINUE OLDLIN = LINE OLDNDX = K GETIND = K RETURN END INTEGER FUNCTION GETLST(LIN, I, STATUS) LOGICAL*1 LIN(512) INTEGER GETONE INTEGER I, NUM, STATUS COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER LINE2 = 0 NLINES = 0 23388 IF (.NOT.(GETONE(LIN, I, NUM, STATUS) .EQ. 0))GOTO 23390 LINE1 = LINE2 LINE2 = NUM NLINES = NLINES + 1 IF (.NOT.(LIN(I) .NE. 44 .AND. LIN(I) .NE. 59))GOTO 23391 GOTO 23390 23391 CONTINUE IF (.NOT.(LIN(I) .EQ. 59))GOTO 23393 CURLN = NUM 23393 CONTINUE I = I + 1 23389 GOTO 23388 23390 CONTINUE NLINES = MIN0(NLINES, 2) IF (.NOT.(NLINES .EQ. 0))GOTO 23395 LINE2 = CURLN 23395 CONTINUE IF (.NOT.(NLINES .LE. 1))GOTO 23397 LINE1 = LINE2 23397 CONTINUE IF (.NOT.(STATUS .NE. -3))GOTO 23399 STATUS = 0 23399 CONTINUE GETLST = STATUS RETURN END INTEGER FUNCTION GETNUM(LIN, I, PNUM, STATUS) LOGICAL*1 LIN(512) INTEGER CTOI, INDEX, OPTPAT, PTSCAN INTEGER I, PNUM, STATUS COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CPAT/ PAT(128) 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 23401 PNUM = CTOI(LIN, I) I = I - 1 GOTO 23402 23401 CONTINUE IF (.NOT.(LIN(I) .EQ. 46))GOTO 23403 PNUM = CURLN GOTO 23404 23403 CONTINUE IF (.NOT.(LIN(I) .EQ. 36))GOTO 23405 PNUM = LASTLN GOTO 23406 23405 CONTINUE IF (.NOT.(LIN(I) .EQ. 45))GOTO 23407 PNUM = CURLN - 1 GOTO 23408 23407 CONTINUE IF (.NOT.(LIN(I) .EQ. 43))GOTO 23409 PNUM = CURLN + 1 GOTO 23410 23409 CONTINUE IF (.NOT.(LIN(I) .EQ. 47 .OR. LIN(I) .EQ. 92))GOTO 23411 IF (.NOT.(OPTPAT(LIN, I) .EQ. -3))GOTO 23413 GETNUM = -3 GOTO 23414 23413 CONTINUE IF (.NOT.(LIN(I) .EQ. 47))GOTO 23415 GETNUM = PTSCAN(43, PNUM) GOTO 23416 23415 CONTINUE GETNUM = PTSCAN(45, PNUM) 23416 CONTINUE 23414 CONTINUE GOTO 23412 23411 CONTINUE GETNUM = -1 23412 CONTINUE 23410 CONTINUE 23408 CONTINUE 23406 CONTINUE 23404 CONTINUE 23402 CONTINUE IF (.NOT.(GETNUM .EQ. 0))GOTO 23417 I = I + 1 23417 CONTINUE STATUS = GETNUM RETURN END INTEGER FUNCTION GETONE(LIN, I, NUM, STATUS) LOGICAL*1 LIN(512) INTEGER GETNUM INTEGER I, ISTART, MUL, NUM, PNUM, STATUS COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER ISTART = I NUM = 0 CALL SKIPBL(LIN, I) IF (.NOT.(GETNUM(LIN, I, NUM, STATUS) .EQ. 0))GOTO 23419 23421 CONTINUE CALL SKIPBL(LIN, I) IF (.NOT.(LIN(I) .NE. 43 .AND. LIN(I) .NE. 45))GOTO 23424 STATUS = -1 GOTO 23423 23424 CONTINUE IF (.NOT.(LIN(I) .EQ. 43))GOTO 23426 MUL = +1 GOTO 23427 23426 CONTINUE MUL = -1 23427 CONTINUE I = I + 1 CALL SKIPBL(LIN, I) IF (.NOT.(GETNUM(LIN, I, PNUM, STATUS) .EQ. 0))GOTO 23428 NUM = NUM + MUL * PNUM 23428 CONTINUE IF (.NOT.(STATUS .EQ. -1))GOTO 23430 STATUS = -3 23430 CONTINUE 23422 IF (.NOT.(STATUS .NE. 0))GOTO 23421 23423 CONTINUE 23419 CONTINUE IF (.NOT.(NUM .LT. 0 .OR. NUM .GT. LASTLN))GOTO 23432 STATUS = -3 23432 CONTINUE IF (.NOT.(STATUS .EQ. -3))GOTO 23434 GETONE = -3 GOTO 23435 23434 CONTINUE IF (.NOT.(I .LE. ISTART))GOTO 23436 GETONE = -1 GOTO 23437 23436 CONTINUE GETONE = 0 23437 CONTINUE 23435 CONTINUE STATUS = GETONE RETURN END INTEGER FUNCTION GETRHS(LIN, I, SUB, GFLAG) LOGICAL*1 LIN(512), SUB(128) INTEGER MAKSUB, LENGTH, INDEX INTEGER GFLAG, I, J LOGICAL*1 CLOWER LOGICAL*1 PNL(3) DATA PNL(1)/112/,PNL(2)/10/,PNL(3)/0/ GETRHS = -3 IF (.NOT.(LIN(I) .EQ. 0))GOTO 23438 RETURN 23438 CONTINUE IF (.NOT.(LIN(I + 1) .EQ. 0))GOTO 23440 RETURN 23440 CONTINUE IF (.NOT.(INDEX(LIN(I+1), LIN(I)) .EQ. 0))GOTO 23442 J = LENGTH(LIN) CALL CHCOPY(LIN(I), LIN, J) CALL STCOPY(PNL, 1, LIN, J) 23442 CONTINUE I = MAKSUB(LIN, I + 1, LIN(I), SUB) IF (.NOT.(I .EQ. -3))GOTO 23444 RETURN 23444 CONTINUE IF (.NOT.(CLOWER(LIN(I+1)) .EQ. 103))GOTO 23446 I = I + 1 GFLAG = 1 GOTO 23447 23446 CONTINUE GFLAG = 0 23447 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(512) LOGICAL*1 TXT DATA NULL/0/ K = GETIND(LINE) IF (.NOT.(LINE .NE. 0))GOTO 23448 CALL GETB (K, 3, LOC) CALL SEEK (LOC, SCR) CALL READF (TXT, DUMMY, SCR) GOTO 23449 23448 CONTINUE CALL SCOPY(NULL, 1, TXT, 1) 23449 CONTINUE GETTXT = K RETURN END INTEGER FUNCTION GTFNDX(NEWIND) COMMON /CBUF/ BUF(3008), LASTBF, FREE INTEGER BUF, LASTBF, FREE IF (.NOT.(FREE .NE. 0))GOTO 23450 NEWIND = FREE CALL GETB(FREE, 1, FREE) GOTO 23451 23450 CONTINUE IF (.NOT.(LASTBF + 4 .LE. 3008))GOTO 23452 NEWIND = LASTBF LASTBF = LASTBF + 4 GOTO 23453 23452 CONTINUE NEWIND = -3 23453 CONTINUE 23451 CONTINUE GTFNDX = NEWIND RETURN END SUBROUTINE INITED LOGICAL*1 NUM(2), EDT(4) INTEGER I, J, JUNK, ITOC COMMON / CTBUFS / EDTBUF(40, 4) LOGICAL*1 EDTBUF COMMON / CNOREG / NOREG INTEGER NOREG DATA EDT/101, 100, 116, 0/ J=1 23454 IF (.NOT.(J .LE. 4))GOTO 23456 I = J - 1 JUNK = ITOC(I, NUM, 2) EDT(3) = NUM(1) CALL SCRATF(EDT, EDTBUF(1,J)) 23455 J=J+1 GOTO 23454 23456 CONTINUE NOREG = 0 RETURN END INTEGER FUNCTION INJECT(LIN) LOGICAL*1 LIN(512) INTEGER GETIND, MAKLIN, NEXTLN INTEGER I, K1, K2, K3 COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER I = 1 23457 IF (.NOT.(LIN(I) .NE. 0))GOTO 23459 I = MAKLIN(LIN, I, K3) IF (.NOT.(I .EQ. -3))GOTO 23460 INJECT = -3 GOTO 23459 23460 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 23458 GOTO 23457 23459 CONTINUE RETURN END INTEGER FUNCTION INPLIN(LIN, CHN, NUM) LOGICAL*1 LIN(100), PSTR(9) INTEGER CHN, I, N, NUM INTEGER PROMPT, ITOC COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER LOGICAL*1 TAIL(3) DATA TAIL(1)/61/,TAIL(2)/62/,TAIL(3)/0/ IF (.NOT.(NUMBER .EQ. 1))GOTO 23462 N = ITOC(NUM, PSTR, 7) I=6 23464 IF (.NOT.(N .GT. 0))GOTO 23466 PSTR(I) = PSTR(N) N = N - 1 23465 I=I-1 GOTO 23464 23466 CONTINUE 23467 IF (.NOT.(I .GT. 0))GOTO 23469 PSTR(I) = 32 23468 I=I-1 GOTO 23467 23469 CONTINUE CALL SCOPY(TAIL, 1, PSTR, 7) GOTO 23463 23462 CONTINUE PSTR(1) = 0 23463 CONTINUE INPLIN = PROMPT(PSTR, LIN, CHN) RETURN END INTEGER FUNCTION KOPY(LINE3) INTEGER LINE3, NLINE, JUNK, LSTLIN INTEGER GETTXT, INJECT COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CTXT/ TXT(512) LOGICAL*1 TXT IF (.NOT.(LINE1 .LE. 0 .OR. (LINE1 .LE. LINE3 .AND. LINE3 .LE. LIN *E2)))GOTO 23470 KOPY = -3 GOTO 23471 23470 CONTINUE KOPY = 0 CURLN = LINE3 LSTLIN = LINE2 NLINE = LINE1 23472 IF (.NOT.(NLINE .LE. LSTLIN))GOTO 23474 JUNK = GETTXT(NLINE) KOPY = INJECT(TXT) IF (.NOT.(LINE3 .LT. LINE1))GOTO 23475 NLINE = NLINE + 1 LSTLIN = LSTLIN + 1 23475 CONTINUE IF (.NOT.(KOPY .EQ. -3))GOTO 23477 GOTO 23474 23477 CONTINUE 23473 NLINE = NLINE + 1 GOTO 23472 23474 CONTINUE 23471 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER IF (.NOT.(LINE1 .LE. 0 .OR. (LINE1 .LE. LINE3 .AND. LINE3 .LE. LIN *E2)))GOTO 23479 LMOVE = -3 GOTO 23480 23479 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 23481 CURLN = LINE3 LINE3 = LINE3 - DELTA GOTO 23482 23481 CONTINUE CURLN = LINE3 + DELTA 23482 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 23480 CONTINUE RETURN END INTEGER FUNCTION MAKLIN(LIN, I, NEWIND) LOGICAL*1 LIN(512) 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(512) LOGICAL*1 TXT COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER MAKLIN = -3 OLDNDX = -3 IF (.NOT.(GTFNDX(NEWIND) .EQ. -3))GOTO 23483 CALL REMARK (19HFile size exceeded.) RETURN 23483 CONTINUE TXTEND = 1 J = I 23485 IF (.NOT.(LIN(J) .NE. 0))GOTO 23487 JUNK = ADDSET(LIN(J), TXT, TXTEND, 512) J = J + 1 IF (.NOT.(LIN(J - 1) .EQ. 10))GOTO 23488 GOTO 23487 23488 CONTINUE 23486 GOTO 23485 23487 CONTINUE IF (.NOT.(ADDSET(0, TXT, TXTEND, 512) .EQ. 0))GOTO 23490 CALL PTFNDX(NEWIND, NEWIND) RETURN 23490 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 MAKSUB(ARG, FROM, DELIM, SUB) LOGICAL*1 ESC LOGICAL*1 ARG(128), DELIM, SUB(128) INTEGER ADDSET, TYPE, CTOI INTEGER FROM, I, J, JUNK J = 1 I = FROM 23492 IF (.NOT.(ARG(I) .NE. DELIM .AND. ARG(I) .NE. 0))GOTO 23494 IF (.NOT.(ARG(I) .EQ. 38))GOTO 23495 JUNK = ADDSET((-3), SUB, J, 128) GOTO 23496 23495 CONTINUE IF (.NOT.(ARG(I) .EQ. 36 .AND. TYPE(ARG(I+1)) .EQ. 2))GOTO 23497 I = I + 1 N = CTOI(ARG, I) JUNK = ADDSET((-4), SUB, J, 128) JUNK = ADDSET(N, SUB, J, 128) I = I - 1 GOTO 23498 23497 CONTINUE IF (.NOT.(ARG(I) .EQ. 36 .AND. (ARG(I+1) .EQ. 110 .OR. ARG(I+1) .E *Q. 78)))GOTO 23499 I = I + 1 JUNK = ADDSET((-5), SUB, J, 128) GOTO 23500 23499 CONTINUE JUNK = ADDSET(ESC(ARG, I), SUB, J, 128) 23500 CONTINUE 23498 CONTINUE 23496 CONTINUE 23493 I = I + 1 GOTO 23492 23494 CONTINUE IF (.NOT.(ARG(I) .NE. DELIM))GOTO 23501 MAKSUB = -3 GOTO 23502 23501 CONTINUE IF (.NOT.(ADDSET(0, SUB, J, 128) .EQ. 0))GOTO 23503 MAKSUB = -3 GOTO 23504 23503 CONTINUE MAKSUB = I 23504 CONTINUE 23502 CONTINUE RETURN END INTEGER FUNCTION NEXTLN(LINE) INTEGER LINE COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER NEXTLN = LINE + 1 IF (.NOT.(NEXTLN .GT. LASTLN))GOTO 23505 NEXTLN = 0 23505 CONTINUE RETURN END INTEGER FUNCTION OPTPAT(LIN, I) LOGICAL*1 LIN(512) INTEGER MAKPAT INTEGER I COMMON /CPAT/ PAT(128) LOGICAL*1 PAT IF (.NOT.(LIN(I) .EQ. 0))GOTO 23507 I = -3 GOTO 23508 23507 CONTINUE IF (.NOT.(LIN(I + 1) .EQ. 0))GOTO 23509 I = -3 GOTO 23510 23509 CONTINUE IF (.NOT.(LIN(I + 1) .EQ. LIN(I)))GOTO 23511 I = I + 1 GOTO 23512 23511 CONTINUE I = MAKPAT(LIN, I + 1, LIN(I), PAT) 23512 CONTINUE 23510 CONTINUE 23508 CONTINUE IF (.NOT.(PAT(1) .EQ. 0))GOTO 23513 I = -3 23513 CONTINUE IF (.NOT.(I .EQ. -3))GOTO 23515 PAT(1) = 0 OPTPAT = -3 GOTO 23516 23515 CONTINUE OPTPAT = 0 23516 CONTINUE RETURN END INTEGER FUNCTION PREVLN(LINE) INTEGER LINE COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER PREVLN = LINE - 1 IF (.NOT.(PREVLN .LT. 0))GOTO 23517 PREVLN = LASTLN 23517 CONTINUE 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 PTLNUM(NUM, UNIT) INTEGER NUM, UNIT COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER LOGICAL*1 TAIL(3) DATA TAIL(1)/61/,TAIL(2)/62/,TAIL(3)/0/ IF (.NOT.(NUMBER .EQ. 1))GOTO 23519 CALL PUTINT(NUM, 6, UNIT) CALL PUTLIN(TAIL, UNIT) 23519 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CPAT/ PAT(128) LOGICAL*1 PAT COMMON /CTXT/ TXT(512) LOGICAL*1 TXT NUM = CURLN 23521 CONTINUE IF (.NOT.(WAY .EQ. 43))GOTO 23524 NUM = NEXTLN(NUM) GOTO 23525 23524 CONTINUE NUM = PREVLN(NUM) 23525 CONTINUE K = GETTXT(NUM) IF (.NOT.(MATCH(TXT, PAT) .EQ. 1))GOTO 23526 PTSCAN = 0 RETURN 23526 CONTINUE 23522 IF (.NOT.(NUM .EQ. CURLN))GOTO 23521 23523 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER 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 23528 IF (.NOT.(BUF(INDEX) .LT. 0))GOTO 23530 BUF(INDEX) = -VALUE(1) GOTO 23531 23530 CONTINUE BUF(INDEX) = VALUE(1) 23531 CONTINUE GOTO 23529 23528 CONTINUE IF (.NOT.(TYPE .EQ. 1))GOTO 23532 BUF(INDEX+1) = VALUE(1) GOTO 23533 23532 CONTINUE IF (.NOT.(TYPE .EQ. 2))GOTO 23534 IF (.NOT.(VALUE(1) .EQ. 1))GOTO 23536 BUF(INDEX) = -IABS(BUF(INDEX)) GOTO 23537 23536 CONTINUE BUF(INDEX) = IABS(BUF(INDEX)) 23537 CONTINUE GOTO 23535 23534 CONTINUE IF (.NOT.(TYPE .EQ. 3))GOTO 23538 BUF(INDEX+2) = VALUE(1) BUF(INDEX+3) = VALUE(2) 23538 CONTINUE 23535 CONTINUE 23533 CONTINUE 23529 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CSCRAT/ SCR, SCREND(2) , SCRFIL(40) INTEGER SCR INTEGER SCREND LOGICAL*1 SCRFIL COMMON / CDEL / DELCNT, FSTDEL, LSTDEL INTEGER DELCNT INTEGER FSTDEL INTEGER LSTDEL 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 23540 CALL CANT(SCRFIL) 23540 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 DELCNT = 0 IFMOD = 0 RETURN END INTEGER FUNCTION SUBST(SUB, GFLAG) LOGICAL*1 NEW(512), SUB(128) 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, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER COMMON /CPAT/ PAT(128) LOGICAL*1 PAT COMMON /CTXT/ TXT(512) LOGICAL*1 TXT SUBST = -3 IF (.NOT.(LINE1 .LE. 0))GOTO 23542 RETURN 23542 CONTINUE LINE = LINE1 23544 IF (.NOT.(LINE .LE. LINE2))GOTO 23546 J = 1 SUBBED = 0 JUNK = GETTXT(LINE) LASTM = 0 K = 1 23547 IF (.NOT.(TXT(K) .NE. 0))GOTO 23549 IF (.NOT.(GFLAG .EQ. 1 .OR. SUBBED .EQ. 0))GOTO 23550 M = AMATCH(TXT, K, PAT) GOTO 23551 23550 CONTINUE M = 0 23551 CONTINUE IF (.NOT.(M .GT. 0 .AND. LASTM .NE. M))GOTO 23552 SUBBED = 1 CALL CATSUB(TXT, K, M, SUB, NEW, J, 512) LASTM = M 23552 CONTINUE IF (.NOT.(M .EQ. 0 .OR. M .EQ. K))GOTO 23554 JUNK = ADDSET(TXT(K), NEW, J, 512) K = K + 1 GOTO 23555 23554 CONTINUE K = M 23555 CONTINUE 23548 GOTO 23547 23549 CONTINUE IF (.NOT.(SUBBED .EQ. 1))GOTO 23556 IF (.NOT.(ADDSET(0, NEW, J, 512) .EQ. 0))GOTO 23558 SUBST = -3 GOTO 23546 23558 CONTINUE SUBST = CONCT(LINE, NEW) IF (.NOT.(SUBST .EQ. -3))GOTO 23560 GOTO 23546 23560 CONTINUE CALL DELETE(LINE, LINE, STATUS) SUBST = INJECT(NEW) IF (.NOT.(SUBST .EQ. -3))GOTO 23562 GOTO 23546 23562 CONTINUE SUBST = 0 23556 CONTINUE 23545 LINE = LINE + 1 GOTO 23544 23546 CONTINUE RETURN END INTEGER FUNCTION TYPSET(LIN, I) LOGICAL*1 LIN(100), TEMP(81) INTEGER DOWRIT, DOSPWN INTEGER I, J, MODTMP, PRTTMP, STATUS COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER LOGICAL*1 SCRFIL(3) LOGICAL*1 ROFFST(9) DATA SCRFIL(1)/36/,SCRFIL(2)/51/,SCRFIL(3)/0/ DATA ROFFST(1)/114/,ROFFST(2)/111/,ROFFST(3)/102/,ROFFST(4)/102/,R *OFFST(5)/32/,ROFFST(6)/36/,ROFFST(7)/51/,ROFFST(8)/32/,ROFFST(9)/0 */ MODTMP = IFMOD PRTTMP = PRINT PRINT = 0 IF (.NOT.(DOWRIT(1, LASTLN, SCRFIL) .NE. -3))GOTO 23564 J = 1 CALL STCOPY(ROFFST, 1, TEMP, J) 23566 IF (.NOT.(LIN(I) .NE. 10 .AND. LIN(I) .NE. 0))GOTO 23568 CALL CHCOPY(LIN(I), TEMP, J) 23567 I=I+1 GOTO 23566 23568 CONTINUE J = 1 STATUS = DOSPWN(TEMP, J) GOTO 23565 23564 CONTINUE CALL REMARK(29H? Cannot create scratch file.) STATUS = -3 23565 CONTINUE IFMOD = MODTMP PRINT = PRTTMP TYPSET=(STATUS) RETURN END INTEGER FUNCTION UNDEL(LINE, GLOB) INTEGER GETIND, NEXTLN, PREVLN INTEGER GLOB, LINE, K1, K2, STATUS COMMON / CDEL / DELCNT, FSTDEL, LSTDEL INTEGER DELCNT INTEGER FSTDEL INTEGER LSTDEL COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER IF (.NOT.(DELCNT .EQ. 0 .OR. GLOB .EQ. 1))GOTO 23569 STATUS = -3 GOTO 23570 23569 CONTINUE CURLN = LINE K1 = GETIND(CURLN) K2 = GETIND(NEXTLN(CURLN)) IF (.NOT.(CURLN .EQ. LASTLN))GOTO 23571 CURLN = CURLN + DELCNT GOTO 23572 23571 CONTINUE CURLN = NEXTLN(CURLN) 23572 CONTINUE LASTLN = LASTLN + DELCNT CALL RELINK(K1, FSTDEL, LSTDEL, K2) CALL RELINK(LSTDEL, K2, K1, FSTDEL) DELCNT = 0 STATUS = 0 23570 CONTINUE UNDEL=(STATUS) RETURN END