SUBROUTINE MAIN LOGICAL*1 LIN(402) LOGICAL*1 CLOWER INTEGER CKGLOB, CLRBUF, DOCMD, DOGLOB, DOREAD, GETARG INTEGER GETLST, PROMPT INTEGER I, LEN, STATUS, CLEARD LOGICAL*1 SAVFIL INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN INTEGER PAT INTEGER BUF, LASTBF, FREE INTEGER LEVEL INTEGER VRBS INTEGER DESC LOGICAL*1 PSTR(11) LOGICAL*1 ST001Z(45) LOGICAL*1 ST002Z(2) LOGICAL*1 ST003Z(2) COMMON /CFILE/ SAVFIL(36) COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CPAT/ PAT(132) COMMON /CBUF/ BUF(2048), LASTBF, FREE COMMON / CSTACK / LEVEL, VRBS(2), DESC(2) DATA PSTR(1)/58/,PSTR(2)/32/,PSTR(3)/0/ DATA PRINT / 1 / 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 *01/,ST001Z(10)/100/,ST001Z(11)/32/,ST001Z(12)/91/,ST001Z(13)/45/,S *T001Z(14)/93/,ST001Z(15)/32/,ST001Z(16)/91/,ST001Z(17)/45/,ST001Z( *18)/112/,ST001Z(19)/91/,ST001Z(20)/115/,ST001Z(21)/116/,ST001Z(22) */114/,ST001Z(23)/105/,ST001Z(24)/110/,ST001Z(25)/103/,ST001Z(26)/9 *3/,ST001Z(27)/93/,ST001Z(28)/32/,ST001Z(29)/91/,ST001Z(30)/45/,ST0 *01Z(31)/110/,ST001Z(32)/93/,ST001Z(33)/32/,ST001Z(34)/91/,ST001Z(3 *5)/45/,ST001Z(36)/118/,ST001Z(37)/93/,ST001Z(38)/32/,ST001Z(39)/91 */,ST001Z(40)/102/,ST001Z(41)/105/,ST001Z(42)/108/,ST001Z(43)/101/, *ST001Z(44)/93/,ST001Z(45)/0/ DATA ST002Z(1)/63/,ST002Z(2)/0/ DATA ST003Z(1)/63/,ST003Z(2)/0/ CALL QUERY( ST001Z ) CALL INITED CALL SETBUF NUMBER = 0 AUTOIN = 0 PAT(1) = 0 SAVFIL(1) = 0 I = 1 23000 IF (.NOT.(GETARG( I, LIN, 402) .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. 110 ))GOTO 23007 NUMBER = 1 GOTO 23008 23007 CONTINUE IF (.NOT.( CLOWER( LIN(2) ) .EQ. 112 ))GOTO 23009 LIN(13) = 0 CALL SCOPY( LIN, 3, PSTR, 1) GOTO 23010 23009 CONTINUE IF (.NOT.(CLOWER( LIN(2) ) .EQ. 118 ))GOTO 23011 VRBS(1) = 1 23011 CONTINUE 23010 CONTINUE 23008 CONTINUE 23006 CONTINUE GOTO 23004 23003 CONTINUE CALL STRCPY( LIN, SAVFIL) IF (.NOT.( DOREAD( 0, SAVFIL, 101) .EQ. -3 ))GOTO 23013 CALL REMARK( ST002Z ) 23013 CONTINUE 23004 CONTINUE 23001 I = I + 1 GOTO 23000 23002 CONTINUE CLEARD = 0 LEVEL=1 23015 IF (.NOT.(LEVEL .GT. 0))GOTO 23017 23018 CONTINUE STATUS = PROMPT( PSTR, LIN, DESC(LEVEL)) IF (.NOT.(STATUS .EQ. -1))GOTO 23021 GOTO 23020 23021 CONTINUE IF (.NOT.( STATUS .NE. -3 ))GOTO 23023 IF (.NOT.(VRBS(LEVEL) .EQ. 1))GOTO 23025 CALL PUTLIN(LIN, 3) 23025 CONTINUE I = 1 CURSAV = CURLN IF (.NOT.( GETLST( LIN, I, STATUS) .EQ. 0 ))GOTO 23027 IF (.NOT.( CKGLOB( LIN, I, STATUS) .EQ. 0 ))GOTO 23029 STATUS = DOGLOB( LIN, I, STATUS) GOTO 23030 23029 CONTINUE IF (.NOT.( STATUS .NE. -3 .AND. STATUS .NE. -10 ))GOTO 23031 STATUS = DOCMD( LIN, I, 0, STATUS) 23031 CONTINUE 23030 CONTINUE 23027 CONTINUE 23023 CONTINUE IF (.NOT.( STATUS .EQ. -3 ))GOTO 23033 CALL REMARK( ST003Z ) CURLN = CURSAV GOTO 23034 23033 CONTINUE IF (.NOT.( STATUS .EQ. -1 ))GOTO 23035 IF (.NOT.(LEVEL .GT. 1))GOTO 23037 GOTO 23020 23037 CONTINUE IF (.NOT.( CLRBUF(113) .EQ. 0 ))GOTO 23039 CLEARD = 1 GOTO 23020 23039 CONTINUE 23038 CONTINUE 23035 CONTINUE 23034 CONTINUE 23019 GOTO 23018 23020 CONTINUE IF (.NOT.(LEVEL .GT. 1))GOTO 23041 CALL CLOSE(DESC(LEVEL)) 23041 CONTINUE 23016 LEVEL = LEVEL - 1 GOTO 23015 23017 CONTINUE IF (.NOT.(CLEARD .EQ. 0))GOTO 23043 STATUS = CLRBUF(-1) 23043 CONTINUE CALL ENDED RETURN END INTEGER FUNCTION APPEND( LINE, GLOB) INTEGER INJECT, INPLIN INTEGER GLOB, LINE INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN LOGICAL*1 LIN INTEGER LEVEL INTEGER VRBS INTEGER DESC COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CSCLIN/ LIN(402) COMMON / CSTACK / LEVEL, VRBS(2), DESC(2) IF (.NOT.( GLOB .EQ. 1 ))GOTO 23045 APPEND=(-3) RETURN 23045 CONTINUE CURLN = LINE 23047 CONTINUE IF (.NOT.( INPLIN( LIN, DESC(LEVEL), CURLN + 1 ) .EQ. -1 ))GOTO 23 *050 APPEND=(-1) RETURN 23050 CONTINUE IF (.NOT.( LIN(1) .EQ. 46 .AND. LIN(2) .EQ. 10 ))GOTO 23052 APPEND=(0) RETURN 23052 CONTINUE IF (.NOT.( INJECT(LIN) .EQ. -3 ))GOTO 23054 APPEND=(-3) RETURN 23054 CONTINUE 23053 CONTINUE 23051 CONTINUE 23048 GOTO 23047 23049 CONTINUE END INTEGER FUNCTION BROWSE( LINE, LIN, I) LOGICAL*1 DIREC, LIN(100) INTEGER CURSCR, I, LIN1, LIN2, LINE, SCREEN INTEGER CTOI, DOPRNT INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN DATA SCREEN, CURSCR / 22, 22 / IF (.NOT.( LIN(I) .EQ. 10 ))GOTO 23056 DIREC = 43 SCREEN = CURSCR GOTO 23057 23056 CONTINUE IF (.NOT.( LIN(I) .EQ. 43 .OR. LIN(I) .EQ. 46 .OR. LIN(I) .EQ. 45 *))GOTO 23058 DIREC = LIN(I) I = I + 1 GOTO 23059 23058 CONTINUE DIREC = 43 23059 CONTINUE SCREEN = CTOI( LIN, I) - 1 IF (.NOT.( SCREEN .LE. 0 ))GOTO 23060 SCREEN = CURSCR GOTO 23061 23060 CONTINUE CURSCR = SCREEN 23061 CONTINUE 23057 CONTINUE IF (.NOT.( DIREC .EQ. 43 ))GOTO 23062 LIN1 = LINE GOTO 23063 23062 CONTINUE IF (.NOT.( DIREC .EQ. 46 ))GOTO 23064 LIN1 = LINE - ( SCREEN / 2 ) GOTO 23065 23064 CONTINUE LIN1 = LINE - SCREEN 23065 CONTINUE 23063 CONTINUE LIN2 = LIN1 + SCREEN LIN1 = MAX0( 1, LIN1) LIN2 = MIN0( LIN2, LASTLN) BROWSE = DOPRNT( LIN1, LIN2, 112) RETURN END INTEGER FUNCTION CKGLOB( LIN, I, STATUS) LOGICAL*1 LIN(402) INTEGER DEFALT, GETIND, GETTXT, MATCH, NEXTLN, OPTPAT INTEGER GFLAG, I, K, LINE, STATUS LOGICAL*1 CLOWER INTEGER BUF, LASTBF, FREE INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN INTEGER PAT LOGICAL*1 TXT COMMON /CBUF/ BUF(2048), LASTBF, FREE COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CPAT/ PAT(132) COMMON /CTXT/ TXT(402) IF (.NOT.( CLOWER( LIN(I) ) .NE. 103 .AND. CLOWER( LIN(I) ) .NE. 1 *20 ))GOTO 23066 STATUS = -1 GOTO 23067 23066 CONTINUE IF (.NOT.( CLOWER( LIN(I) ) .EQ. 103 ))GOTO 23068 GFLAG = 1 GOTO 23069 23068 CONTINUE GFLAG = 0 23069 CONTINUE I = I + 1 IF (.NOT.( OPTPAT( LIN, I) .EQ. -3 .OR. DEFALT( 1, LASTLN, STATUS) * .EQ. -3 ))GOTO 23070 STATUS = -3 GOTO 23071 23070 CONTINUE I = I + 1 LINE = LINE1 23072 IF (.NOT.(LINE .LE. LINE2 ))GOTO 23074 K = GETTXT(LINE) IF (.NOT.( MATCH( TXT, PAT) .EQ. GFLAG ))GOTO 23075 CALL SETB( K, 3, 1) GOTO 23076 23075 CONTINUE CALL SETB( K, 3, 0) 23076 CONTINUE 23073 LINE = LINE + 1 GOTO 23072 23074 CONTINUE LINE = NEXTLN(LINE2) 23077 IF (.NOT.(LINE .NE. LINE1 ))GOTO 23079 K = GETIND(LINE) CALL SETB( K, 3, 0) 23078 LINE = NEXTLN(LINE) GOTO 23077 23079 CONTINUE STATUS = 0 23071 CONTINUE 23067 CONTINUE CKGLOB=(STATUS) RETURN END INTEGER FUNCTION CKP( LIN, I, PFLAG, STATUS) LOGICAL*1 C, LIN(402) INTEGER I, J, PFLAG, STATUS LOGICAL*1 CLOWER J = I C = CLOWER( LIN(J) ) IF (.NOT.( C .EQ. 112 .OR. C .EQ. 108 ))GOTO 23080 J = J + 1 PFLAG = C GOTO 23081 23080 CONTINUE PFLAG = 0 23081 CONTINUE IF (.NOT.( LIN(J) .EQ. 10 ))GOTO 23082 STATUS = 0 GOTO 23083 23082 CONTINUE STATUS = -3 23083 CONTINUE CKP=(STATUS) RETURN END INTEGER FUNCTION CLRBUF(COMAND) LOGICAL*1 COMAND INTEGER JUNK INTEGER ISATTY, PROMPT, REMOVE INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN LOGICAL*1 LIN INTEGER SCR INTEGER SCREND LOGICAL*1 SCRFIL INTEGER VIRUNT INTEGER*4 VIREND LOGICAL*1 VPFILE LOGICAL*1 PSTR(29) COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CSCLIN/ LIN(402) COMMON /CSCRAT/ SCR, SCREND(2) , SCRFIL(36) COMMON / CVFILE / VIRUNT, VIREND, VPFILE(36) 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)/63/,PSTR(14)/32/,PSTR(15)/40/,PS *TR(16)/121/,PSTR(17)/32/,PSTR(18)/109/,PSTR(19)/101/,PSTR(20)/97/, *PSTR(21)/110/,PSTR(22)/115/,PSTR(23)/32/,PSTR(24)/89/,PSTR(25)/69/ *,PSTR(26)/83/,PSTR(27)/41/,PSTR(28)/32/,PSTR(29)/0/ IF (.NOT.( COMAND .NE. -1 .AND. IFMOD .EQ. 1 .AND. ISATTY(1) .EQ. *1 ))GOTO 23084 JUNK = PROMPT( PSTR, LIN, 1) IF (.NOT.( LIN(1) .NE. 121 .AND. LIN(1) .NE. 89 ))GOTO 23086 CLRBUF=(-3) RETURN 23086 CONTINUE 23084 CONTINUE CALL CLOSE(SCR) JUNK = REMOVE(SCRFIL) IF (.NOT.(VIRUNT .NE. -3))GOTO 23088 CALL CLOSE(VIRUNT) JUNK = REMOVE(VPFILE) CALL VIRINT 23088 CONTINUE CLRBUF=(0) RETURN END INTEGER FUNCTION CONCT( NBR, LIN) INTEGER I, JUNK, NBR INTEGER GETTXT LOGICAL*1 LIN(100) INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN LOGICAL*1 TXT COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CTXT/ TXT(402) I = 1 23090 IF (.NOT.(LIN(I) .NE. 0 ))GOTO 23092 IF (.NOT.( LIN(I) .EQ. 10 ))GOTO 23093 CONCT=(0) RETURN 23093 CONTINUE 23091 I = I + 1 GOTO 23090 23092 CONTINUE IF (.NOT.( NBR + 1 .GT. LASTLN ))GOTO 23095 CONCT=(-3) RETURN 23095 CONTINUE JUNK = GETTXT( NBR + 1 ) CALL SCOPY( TXT, 1, LIN, I) CALL DELETE( NBR + 1, NBR + 1, JUNK) CONCT=(0) RETURN END INTEGER FUNCTION DEFALT( DEF1, DEF2, STATUS) INTEGER DEF1, DEF2, STATUS INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN IF (.NOT.( NLINES .EQ. 0 ))GOTO 23097 LINE1 = DEF1 LINE2 = DEF2 23097 CONTINUE IF (.NOT.( LINE1 .GT. LINE2 .OR. LINE1 .LE. 0 ))GOTO 23099 STATUS = -3 GOTO 23100 23099 CONTINUE STATUS = 0 23100 CONTINUE DEFALT=(STATUS) RETURN END INTEGER FUNCTION DELETE( FROM, TO, STATUS) INTEGER GETIND, NEXTLN, PREVLN INTEGER FROM, K1, K2, STATUS, TO INTEGER DELCNT INTEGER FSTDEL INTEGER LSTDEL INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN COMMON /CDEL/ DELCNT, FSTDEL, LSTDEL COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN IF (.NOT.( FROM .LE. 0 ))GOTO 23101 STATUS = -3 GOTO 23102 23101 CONTINUE IF (.NOT.( DELCNT .NE. 0 ))GOTO 23103 CALL PTFNDX( FSTDEL, LSTDEL) 23103 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 23102 CONTINUE DELETE=(STATUS) RETURN END INTEGER FUNCTION DOCMD( LIN, I, GLOB, STATUS) LOGICAL*1 FILE(402), LIN(402), SUB(132) LOGICAL*1 CLOWER, COMAND INTEGER APPEND, DELETE, DOPRNT, DOREAD, DOWRIT, LMOVE, SUBST, UNDE *L INTEGER CKP, DEFALT, GETFN, GETONE, GETRHS, NEXTLN, OPTPAT, PREVLN INTEGER TYPSET, DOJOIN, DONREG, DOPIP, DOSET INTEGER GFLAG, GLOB, I, LINE3, PFLAG, STATUS, KOPY, DOSPWN, BROWSE INTEGER CLRBUF, DOSTAK LOGICAL*1 SAVFIL INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN INTEGER PAT INTEGER I23109 COMMON /CFILE/ SAVFIL(36) COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CPAT/ PAT(132) PFLAG = 0 STATUS = -3 COMAND = CLOWER( LIN(I)) I = I + 1 IF (.NOT.( COMAND .EQ. 115 ))GOTO 23105 IF (.NOT.( LIN(I) .EQ. 101 .OR. LIN(I) .EQ. 69 ))GOTO 23107 STATUS = DOSET( LIN, I) DOCMD=(STATUS) RETURN 23107 CONTINUE 23105 CONTINUE I23109=(COMAND) GOTO 23109 23111 CONTINUE IF (.NOT.( LIN(I) .EQ. 10 ))GOTO 23112 STATUS = APPEND( LINE2, GLOB) 23112 CONTINUE GOTO 23110 23114 CONTINUE IF (.NOT.( LIN(I) .EQ. 10 ))GOTO 23115 IF (.NOT.( DEFALT( CURLN, CURLN, STATUS) .EQ. 0 ))GOTO 23117 IF (.NOT.( DELETE( LINE1, LINE2, STATUS) .EQ. 0 ))GOTO 23119 STATUS = APPEND( PREVLN(LINE1), GLOB) 23119 CONTINUE 23117 CONTINUE 23115 CONTINUE GOTO 23110 23121 CONTINUE IF (.NOT.( CKP( LIN, I, PFLAG, STATUS) .EQ. 0 ))GOTO 23122 IF (.NOT.( DEFALT( CURLN, CURLN, STATUS) .EQ. 0 ))GOTO 23124 IF (.NOT.( DELETE( LINE1, LINE2, STATUS) .EQ. 0 ))GOTO 23126 IF (.NOT.( NEXTLN(CURLN) .NE. 0 ))GOTO 23128 CURLN = NEXTLN(CURLN) 23128 CONTINUE 23126 CONTINUE 23124 CONTINUE 23122 CONTINUE GOTO 23110 23130 CONTINUE CALL DOHELP STATUS = 0 GOTO 23110 23131 CONTINUE IF (.NOT.( LIN(I) .EQ. 10 ))GOTO 23132 STATUS = APPEND( PREVLN(LINE2), GLOB) 23132 CONTINUE GOTO 23110 23134 CONTINUE IF (.NOT.( CKP( LIN, I, PFLAG, STATUS) .EQ. 0 ))GOTO 23135 IF (.NOT.( DEFALT( CURLN, NEXTLN(CURLN), STATUS) .EQ. 0 ))GOTO 231 *37 STATUS = DOJOIN( LINE1, LINE2) 23137 CONTINUE 23135 CONTINUE GOTO 23110 23139 CONTINUE IF (.NOT.( CKP(LIN, I, PFLAG, STATUS) .EQ. 0 ))GOTO 23140 CALL PUTINT( LINE2, 1,2) CALL PUTCH(10,2) 23140 CONTINUE GOTO 23110 23142 CONTINUE STATUS = DONREG( LIN, I) GOTO 23110 23143 CONTINUE IF (.NOT.( GETONE( LIN, I, LINE3, STATUS) .EQ. -1 ))GOTO 23144 STATUS = -3 23144 CONTINUE IF (.NOT.( STATUS .EQ. 0 ))GOTO 23146 IF (.NOT.( CKP( LIN, I, PFLAG, STATUS) .EQ. 0 ))GOTO 23148 IF (.NOT.( DEFALT( CURLN, CURLN, STATUS) .EQ. 0 ))GOTO 23150 STATUS = LMOVE(LINE3) 23150 CONTINUE 23148 CONTINUE 23146 CONTINUE GOTO 23110 23152 CONTINUE IF (.NOT.( GETONE( LIN, I, LINE3, STATUS) .EQ. -1 ))GOTO 23153 STATUS = -3 23153 CONTINUE IF (.NOT.( STATUS .EQ. 0 ))GOTO 23155 IF (.NOT.( CKP( LIN, I, PFLAG, STATUS) .EQ. 0 ))GOTO 23157 IF (.NOT.( DEFALT( CURLN, CURLN, STATUS) .EQ. 0 ))GOTO 23159 STATUS = KOPY(LINE3) 23159 CONTINUE 23157 CONTINUE 23155 CONTINUE GOTO 23110 23161 CONTINUE IF (.NOT.( OPTPAT( LIN, I) .EQ. 0 ))GOTO 23162 IF (.NOT.( GETRHS( LIN, I, SUB, GFLAG) .EQ. 0 ))GOTO 23164 IF (.NOT.( CKP( LIN, I + 1, PFLAG, STATUS) .EQ. 0 ))GOTO 23166 IF (.NOT.( DEFALT( CURLN, CURLN, STATUS) .EQ. 0 ))GOTO 23168 STATUS = SUBST( SUB, GFLAG) 23168 CONTINUE 23166 CONTINUE 23164 CONTINUE 23162 CONTINUE GOTO 23110 23170 CONTINUE STATUS = DOSPWN( LIN, I) GOTO 23110 23171 CONTINUE IF (.NOT.( NLINES .EQ. 0 ))GOTO 23172 IF (.NOT.( GETFN( LIN, I, FILE) .EQ. 0 ))GOTO 23174 IF (.NOT.( CLRBUF(101) .EQ. 0 ))GOTO 23176 CALL STRCPY( FILE, SAVFIL) CALL SETBUF STATUS = DOREAD( 0, FILE, 101) GOTO 23177 23176 CONTINUE STATUS = 0 23177 CONTINUE 23174 CONTINUE 23172 CONTINUE GOTO 23110 23178 CONTINUE IF (.NOT.( NLINES .EQ. 0 ))GOTO 23179 IF (.NOT.( GETFN( LIN, I, FILE) .EQ. 0 ))GOTO 23181 CALL STRCPY( FILE, SAVFIL) CALL PUTLIN(SAVFIL, 2) CALL PUTCH(10,2) STATUS = 0 23181 CONTINUE 23179 CONTINUE GOTO 23110 23183 CONTINUE IF (.NOT.( GETFN( LIN, I, FILE) .EQ. 0 ))GOTO 23184 STATUS = DOREAD( LINE2, FILE, 114) 23184 CONTINUE GOTO 23110 23186 CONTINUE IF (.NOT.( GETFN( LIN, I, FILE) .EQ. 0 ))GOTO 23187 IF (.NOT.( DEFALT( 1, LASTLN, STATUS) .EQ. 0 ))GOTO 23189 STATUS = DOWRIT( LINE1, LINE2, FILE) 23189 CONTINUE 23187 CONTINUE GOTO 23110 23191 CONTINUE IF (.NOT.( LIN(I) .EQ. 10 ))GOTO 23192 IF (.NOT.( DEFALT( CURLN, CURLN, STATUS) .EQ. 0 ))GOTO 23194 STATUS = DOPRNT( LINE1, LINE2, COMAND) 23194 CONTINUE 23192 CONTINUE GOTO 23110 23196 CONTINUE IF (.NOT.( DEFALT( CURLN, CURLN, STATUS) .EQ. 0 ))GOTO 23197 STATUS = BROWSE( LINE2, LIN, I) 23197 CONTINUE GOTO 23110 23199 CONTINUE STATUS = 0 GOTO 23110 23200 CONTINUE IF (.NOT.( NLINES .EQ. 0 ))GOTO 23201 LINE2 = PREVLN(CURLN) 23201 CONTINUE STATUS = DOPRNT( LINE2, LINE2, 112) GOTO 23110 23203 CONTINUE IF (.NOT.( LIN(I) .EQ. 10 .AND. NLINES .EQ. 0 .AND. GLOB .EQ. 0 )) *GOTO 23204 STATUS = -1 23204 CONTINUE GOTO 23110 23206 CONTINUE STATUS = TYPSET( LIN, I) GOTO 23110 23207 CONTINUE IF (.NOT.( LIN(I) .EQ. 10 ))GOTO 23208 STATUS = UNDEL( LINE2, GLOB) 23208 CONTINUE GOTO 23110 23210 CONTINUE CALL PERCEN STATUS = 0 GOTO 23110 23211 CONTINUE IF (.NOT.(DEFALT(1, LASTLN, STATUS) .EQ. 0))GOTO 23212 STATUS = DOPIP( LINE1, LINE2, LIN, I) 23212 CONTINUE GOTO 23110 23214 CONTINUE STATUS = DOSTAK(LIN, I) GOTO 23110 23215 CONTINUE IF (.NOT.( NLINES .EQ. 0 ))GOTO 23216 LINE2 = NEXTLN(CURLN) 23216 CONTINUE STATUS = DOPRNT( LINE2, LINE2, 112) GOTO 23110 23109 CONTINUE IF (I23109.EQ.10)GOTO 23215 IF (I23109.EQ.35)GOTO 23199 IF (I23109.EQ.37)GOTO 23210 IF (I23109.EQ.45)GOTO 23200 IF (I23109.EQ.60)GOTO 23214 IF (I23109.EQ.61)GOTO 23139 IF (I23109.EQ.94)GOTO 23170 IF (I23109.EQ.97)GOTO 23111 IF (I23109.EQ.98)GOTO 23196 IF (I23109.EQ.99)GOTO 23114 IF (I23109.EQ.100)GOTO 23121 IF (I23109.EQ.101)GOTO 23171 IF (I23109.EQ.102)GOTO 23178 IF (I23109.EQ.104)GOTO 23130 IF (I23109.EQ.105)GOTO 23131 IF (I23109.EQ.106)GOTO 23134 IF (I23109.EQ.107)GOTO 23152 IF (I23109.EQ.108)GOTO 23191 IF (I23109.EQ.109)GOTO 23143 IF (I23109.EQ.110)GOTO 23142 IF (I23109.EQ.112)GOTO 23191 IF (I23109.EQ.113)GOTO 23203 IF (I23109.EQ.114)GOTO 23183 IF (I23109.EQ.115)GOTO 23161 IF (I23109.EQ.116)GOTO 23206 IF (I23109.EQ.117)GOTO 23207 IF (I23109.EQ.119)GOTO 23186 IF (I23109.EQ.124)GOTO 23211 23110 CONTINUE IF (.NOT.( STATUS .EQ. 0 ))GOTO 23218 IF (.NOT.( PFLAG .EQ. 112 .OR. PFLAG .EQ. 108 ))GOTO 23220 STATUS = DOPRNT( CURLN, CURLN, PFLAG) 23220 CONTINUE 23218 CONTINUE DOCMD=(STATUS) RETURN END INTEGER FUNCTION DOGLOB( LIN, I, STATUS) LOGICAL*1 LIN(402) INTEGER DOCMD, GETIND, GETLST, NEXTLN, PROMPT INTEGER VALUE(2) INTEGER COUNT, I, ISTART, K, LINE, STATUS, LAST INTEGER BUF, LASTBF, FREE INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN INTEGER LEVEL INTEGER VRBS INTEGER DESC LOGICAL*1 GPSTR(3) COMMON /CBUF/ BUF(2048), LASTBF, FREE COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON / CSTACK / LEVEL, VRBS(2), DESC(2) DATA GPSTR(1)/103/,GPSTR(2)/95/,GPSTR(3)/0/ LAST = LENGTH(LIN) 23222 IF (.NOT.(LIN( LAST - 1 ) .EQ. 64 ))GOTO 23224 LIN( LAST - 1 ) = 10 JUNK = PROMPT( GPSTR, LIN(LAST), DESC(LEVEL)) 23223 LAST = LENGTH(LIN) GOTO 23222 23224 CONTINUE STATUS = 0 COUNT = 0 LINE = LINE1 ISTART = I 23225 CONTINUE K = GETIND(LINE) CALL GETB( K, 3, VALUE) IF (.NOT.( VALUE(1) .EQ. 1 ))GOTO 23228 CALL SETB( K, 3, 0) CURSAV = LINE I = ISTART 23230 CONTINUE CURLN = LINE IF (.NOT.( GETLST( LIN, I, STATUS) .EQ. 0 ))GOTO 23233 IF (.NOT.( DOCMD( LIN, I, 1, STATUS) .EQ. 0 ))GOTO 23235 COUNT = 0 23235 CONTINUE 23233 CONTINUE 23237 IF (.NOT.( LIN(I) .NE. 10 ))GOTO 23238 I = I + 1 GOTO 23237 23238 CONTINUE I = I + 1 IF (.NOT.( LIN(I) .EQ. 0 ))GOTO 23239 GOTO 23232 23239 CONTINUE 23231 GOTO 23230 23232 CONTINUE GOTO 23229 23228 CONTINUE LINE = NEXTLN(LINE) COUNT = COUNT + 1 23229 CONTINUE 23226 IF (.NOT.( COUNT .GT. LASTLN .OR. STATUS .NE. 0 ))GOTO 23225 23227 CONTINUE DOGLOB=(STATUS) RETURN END SUBROUTINE DOHELP INTEGER OPEN INTEGER FD LOGICAL*1 HLPFIL(12) LOGICAL*1 ST004Z(28) DATA HLPFIL(1)/126/,HLPFIL(2)/98/,HLPFIL(3)/105/,HLPFIL(4)/110/,HL *PFIL(5)/47/,HLPFIL(6)/101/,HLPFIL(7)/100/,HLPFIL(8)/46/,HLPFIL(9)/ *104/,HLPFIL(10)/108/,HLPFIL(11)/112/,HLPFIL(12)/0/ DATA ST004Z(1)/83/,ST004Z(2)/111/,ST004Z(3)/114/,ST004Z(4)/114/,ST *004Z(5)/121/,ST004Z(6)/44/,ST004Z(7)/32/,ST004Z(8)/110/,ST004Z(9)/ *111/,ST004Z(10)/32/,ST004Z(11)/104/,ST004Z(12)/101/,ST004Z(13)/108 */,ST004Z(14)/112/,ST004Z(15)/32/,ST004Z(16)/105/,ST004Z(17)/115/,S *T004Z(18)/32/,ST004Z(19)/97/,ST004Z(20)/118/,ST004Z(21)/97/,ST004Z *(22)/105/,ST004Z(23)/108/,ST004Z(24)/97/,ST004Z(25)/98/,ST004Z(26) */108/,ST004Z(27)/101/,ST004Z(28)/0/ FD = OPEN( HLPFIL, 1) IF (.NOT.( FD .NE. -3 ))GOTO 23241 CALL FCOPY( FD, 2) CALL CLOSE(FD) GOTO 23242 23241 CONTINUE CALL REMARK( ST004Z ) 23242 CONTINUE RETURN END INTEGER FUNCTION DOJOIN( FROM, TO) INTEGER FROM, TO INTEGER I, J, JUNK, K, SAVCLN, STATUS INTEGER DELETE, GETTXT, INJEXT, PREVLN INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN LOGICAL*1 LIN LOGICAL*1 TXT COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CSCLIN/ LIN(402) COMMON /CTXT/ TXT(402) IF (.NOT.( FROM .LE. 0 ))GOTO 23243 STATUS = -3 GOTO 23244 23243 CONTINUE STATUS = 0 IF (.NOT.( FROM .LT. TO ))GOTO 23245 J = 1 I = FROM 23247 IF (.NOT.(I .LE. TO ))GOTO 23249 JUNK = GETTXT(I) IF (.NOT.( 1 .LT. J .AND. J .LT. 400 ))GOTO 23250 IF (.NOT.( LIN( J - 1 ) .NE. 32 .AND. LIN( J - 1 ) .NE. 9 ))GOTO 2 *3252 IF (.NOT.( TXT(1) .NE. 32 .AND. TXT(1) .NE. 9 ))GOTO 23254 LIN(J) = 32 J = J + 1 23254 CONTINUE 23252 CONTINUE 23250 CONTINUE K = 1 23256 IF (.NOT.(TXT(K) .NE. 10 .AND. TXT(K) .NE. 0 ))GOTO 23258 IF (.NOT.( J .GE. 400 ))GOTO 23259 STATUS = -3 GOTO 23249 23259 CONTINUE LIN(J) = TXT(K) J = J + 1 23260 CONTINUE 23257 K = K + 1 GOTO 23256 23258 CONTINUE 23248 I = I + 1 GOTO 23247 23249 CONTINUE LIN(J) = 10 LIN( J + 1 ) = 0 IF (.NOT.( STATUS .EQ. 0 ))GOTO 23261 SAVCLN = CURLN CURLN = PREVLN(CURLN) IF (.NOT.( DELETE( FROM, TO, STATUS) .EQ. 0 ))GOTO 23263 STATUS = INJECT(LIN) GOTO 23264 23263 CONTINUE CURLN = SAVCLN 23264 CONTINUE 23261 CONTINUE 23245 CONTINUE 23244 CONTINUE DOJOIN=(STATUS) RETURN END INTEGER FUNCTION DONREG( LIN, I) LOGICAL*1 LIN(100), OP INTEGER DIF, I, J, PFLAG, STATUS, NOREG INTEGER CTOI, INDEXC LOGICAL*1 LEGAL(4) DATA LEGAL(1)/61/,LEGAL(2)/43/,LEGAL(3)/45/,LEGAL(4)/0/ STATUS = 0 PFLAG = 0 CALL GNOREG(NOREG) IF (.NOT.( LIN(I) .EQ. 10 ))GOTO 23265 PFLAG = 1 GOTO 23266 23265 CONTINUE OP = LIN(I) IF (.NOT.( INDEXC( LEGAL, OP) .EQ. 0 ))GOTO 23267 STATUS = -3 GOTO 23268 23267 CONTINUE J = I + 1 DIF = CTOI( LIN, J) IF (.NOT.( DIF .EQ. 0 .AND. OP .NE. 61 ))GOTO 23269 DIF = 1 23269 CONTINUE IF (.NOT.( OP .EQ. 43 ))GOTO 23271 NOREG = NOREG + DIF GOTO 23272 23271 CONTINUE IF (.NOT.( OP .EQ. 61 ))GOTO 23273 NOREG = DIF GOTO 23274 23273 CONTINUE NOREG = NOREG - DIF 23274 CONTINUE 23272 CONTINUE CALL SNOREG(NOREG) IF (.NOT.( LIN(J) .EQ. 112 .OR. LIN(J) .EQ. 80 ))GOTO 23275 PFLAG = 1 23275 CONTINUE 23268 CONTINUE 23266 CONTINUE IF (.NOT.( STATUS .EQ. 0 .AND. PFLAG .EQ. 1 ))GOTO 23277 CALL PUTINT( NOREG, 1,2) CALL PUTCH(10,2) 23277 CONTINUE DONREG=(STATUS) RETURN END INTEGER FUNCTION DOPIP( L1, L2, LIN, I) INTEGER DOSPWN, DOWRIT, GETWRD, LENGTH, REMOVE INTEGER I, J, K, LEN, MODTMP, PRTTMP, STATUS, L1, L2, JUNK LOGICAL*1 LIN(100) INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN LOGICAL*1 ARGARA LOGICAL*1 FILARA LOGICAL*1 BLKLES(3) LOGICAL*1 SEED(4) LOGICAL*1 ST005Z(28) COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON / CSPWN / ARGARA(256), FILARA(36) DATA BLKLES(1)/32/,BLKLES(2)/60/,BLKLES(3)/0/ DATA SEED(1)/112/,SEED(2)/105/,SEED(3)/112/,SEED(4)/0/ DATA ST005Z(1)/63/,ST005Z(2)/32/,ST005Z(3)/67/,ST005Z(4)/97/,ST005 *Z(5)/110/,ST005Z(6)/39/,ST005Z(7)/116/,ST005Z(8)/32/,ST005Z(9)/99/ *,ST005Z(10)/114/,ST005Z(11)/101/,ST005Z(12)/97/,ST005Z(13)/116/,ST *005Z(14)/101/,ST005Z(15)/32/,ST005Z(16)/115/,ST005Z(17)/99/,ST005Z *(18)/114/,ST005Z(19)/97/,ST005Z(20)/116/,ST005Z(21)/99/,ST005Z(22) */104/,ST005Z(23)/32/,ST005Z(24)/102/,ST005Z(25)/105/,ST005Z(26)/10 *8/,ST005Z(27)/101/,ST005Z(28)/0/ MODTMP = IFMOD PRTTMP = PRINT PRINT = 0 CALL SCRATF( SEED, FILARA) IF (.NOT.( DOWRIT( L1, L2, FILARA) .NE. -3 ))GOTO 23279 J = I LEN = GETWRD( LIN, J, ARGARA) K = J J = LEN + 1 CALL STCOPY( BLKLES, 1, ARGARA, J) CALL STCOPY( FILARA, 1, ARGARA, J) CALL STCOPY( LIN, K, ARGARA, J) J = 1 STATUS = DOSPWN( ARGARA, J) GOTO 23280 23279 CONTINUE CALL REMARK( ST005Z ) STATUS = -3 23280 CONTINUE JUNK = REMOVE(FILARA) IFMOD = MODTMP PRINT = PRTTMP DOPIP=(STATUS) RETURN END INTEGER FUNCTION DOPRNT( FROM, TO, COMAND) INTEGER GETTXT INTEGER FROM, I, J, K, TO LOGICAL*1 C, COMAND INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN LOGICAL*1 TXT COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CTXT/ TXT(402) IF (.NOT.( FROM .LE. 0 ))GOTO 23281 DOPRNT=(-3) RETURN 23281 CONTINUE I = FROM 23283 IF (.NOT.(I .LE. TO ))GOTO 23285 J = GETTXT(I) CALL PTLNUM( I, 2) IF (.NOT.( COMAND .EQ. 112 ))GOTO 23286 CALL PUTLIN( TXT, 2) GOTO 23287 23286 CONTINUE K = 1 23288 IF (.NOT.(TXT(K) .NE. 0 ))GOTO 23290 IF (.NOT.( TXT(K) .GE. 32 ))GOTO 23291 CALL PUTCH( TXT(K), 2) GOTO 23292 23291 CONTINUE IF (.NOT.( TXT(K) .EQ. 10 ))GOTO 23293 CALL PUTCH( 36, 2) CALL PUTCH( 10, 2) GOTO 23294 23293 CONTINUE CALL PUTCH( 94, 2) C = TXT(K) + 64 CALL PUTCH( C, 2) 23294 CONTINUE 23292 CONTINUE 23289 K = K + 1 GOTO 23288 23290 CONTINUE 23287 CONTINUE 23284 I = I + 1 GOTO 23283 23285 CONTINUE CURLN = TO DOPRNT=(0) RETURN 23282 CONTINUE END INTEGER FUNCTION DOREAD( LINE, FILE, COMAND) LOGICAL*1 COMAND, FILE(402) INTEGER FD INTEGER OPEN INTEGER ACCESS, GETLIN, INJECT, REMOVE INTEGER COUNT, LINE, JUNK INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN LOGICAL*1 SAVFIL LOGICAL*1 LIN INTEGER LEVEL INTEGER VRBS INTEGER DESC COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CFILE/ SAVFIL(36) COMMON /CSCLIN/ LIN(402) COMMON / CSTACK / LEVEL, VRBS(2), DESC(2) IF (.NOT.( COMAND .EQ. 101 ))GOTO 23295 ACCESS = 3 GOTO 23296 23295 CONTINUE ACCESS = 1 23296 CONTINUE CALL FINDIT( FILE, LIN) FD = OPEN( LIN, ACCESS) IF (.NOT.( FD .EQ. -3 ))GOTO 23297 DOREAD=(-3) RETURN 23297 CONTINUE CURLN = LINE DOREAD = 0 COUNT = 0 23299 IF (.NOT.(GETLIN( LIN, FD) .NE. -1 ))GOTO 23301 DOREAD = INJECT(LIN) IF (.NOT.( DOREAD .EQ. -3 ))GOTO 23302 GOTO 23301 23302 CONTINUE 23300 COUNT = COUNT + 1 GOTO 23299 23301 CONTINUE CALL CLOSE(FD) IF (.NOT.((PRINT .EQ. 1 .AND. LEVEL .EQ. 1) .OR. VRBS(LEVEL) .EQ. *1))GOTO 23304 CALL PUTINT( COUNT, 1,2) CALL PUTCH(10,2) 23304 CONTINUE IF (.NOT.( COMAND .EQ. 101 ))GOTO 23306 IFMOD = 0 IF (.NOT.( COUNT .EQ. 0 ))GOTO 23308 JUNK = REMOVE(FILE) 23308 CONTINUE 23306 CONTINUE 23298 CONTINUE RETURN END INTEGER FUNCTION DOSET( LIN, NDX) LOGICAL*1 CMDWRD(36), LIN(100) INTEGER I, J, JUNK, NDX, SET INTEGER GETWRD, INDEXS INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN I = NDX + 1 IF (.NOT.( LIN(I) .EQ. 116 .OR. LIN(I) .EQ. 84 ))GOTO 23310 I = I + 1 23310 CONTINUE JUNK = GETWRD( LIN, I, CMDWRD) CALL FOLD(CMDWRD) IF (.NOT.( CMDWRD(1) .EQ. 110 .AND. CMDWRD(2) .EQ. 111 ))GOTO 2331 *2 SET = 0 J = 3 GOTO 23313 23312 CONTINUE SET = 1 J = 1 23313 CONTINUE IF (.NOT.( CMDWRD(J) .EQ. 97 ))GOTO 23314 AUTOIN = SET GOTO 23315 23314 CONTINUE IF (.NOT.( CMDWRD(J) .EQ. 110 ))GOTO 23316 NUMBER = SET GOTO 23317 23316 CONTINUE DOSET=(-3) RETURN 23317 CONTINUE 23315 CONTINUE DOSET=(0) RETURN END INTEGER FUNCTION DOSPWN(LIN, I) LOGICAL*1 LIN(100), PROCES(36), ARGS(256), DESC(7) INTEGER I, J, SSPAWN, INIT, K, INT, CREATE, LOCCOM LOGICAL*1 EDTBUF LOGICAL*1 SH(3) LOGICAL*1 SUFFIX(7) LOGICAL*1 SPATH(18) LOGICAL*1 ST006Z(30) COMMON / CTBUFS / EDTBUF(36, 3) DATA SH(1)/115/,SH(2)/104/,SH(3)/0/ DATA SUFFIX(1)/46/,SUFFIX(2)/116/,SUFFIX(3)/115/,SUFFIX(4)/107/,SU *FFIX(5)/0/,SUFFIX(6)/10/,SUFFIX(7)/0/ DATA SPATH(1)/0/,SPATH(2)/126/,SPATH(3)/47/,SPATH(4)/0/,SPATH(5)/1 *26/,SPATH(6)/117/,SPATH(7)/115/,SPATH(8)/114/,SPATH(9)/47/,SPATH(1 *0)/0/,SPATH(11)/126/,SPATH(12)/98/,SPATH(13)/105/,SPATH(14)/110/,S *PATH(15)/47/,SPATH(16)/0/,SPATH(17)/10/,SPATH(18)/0/ DATA INIT / 1 / DATA ST006Z(1)/63/,ST006Z(2)/32/,ST006Z(3)/67/,ST006Z(4)/97/,ST006 *Z(5)/110/,ST006Z(6)/110/,ST006Z(7)/111/,ST006Z(8)/116/,ST006Z(9)/3 *2/,ST006Z(10)/102/,ST006Z(11)/105/,ST006Z(12)/110/,ST006Z(13)/100/ *,ST006Z(14)/32/,ST006Z(15)/96/,ST006Z(16)/115/,ST006Z(17)/104/,ST0 *06Z(18)/39/,ST006Z(19)/32/,ST006Z(20)/105/,ST006Z(21)/109/,ST006Z( *22)/97/,ST006Z(23)/103/,ST006Z(24)/101/,ST006Z(25)/32/,ST006Z(26)/ *102/,ST006Z(27)/105/,ST006Z(28)/108/,ST006Z(29)/101/,ST006Z(30)/0/ IF (.NOT.( INIT .EQ. 1 ))GOTO 23318 IF (.NOT.( LOCCOM( SH, SPATH, SUFFIX, PROCES) .NE. 60 ))GOTO 23320 CALL REMARK( ST006Z ) DOSPWN=(-3) RETURN 23320 CONTINUE K = 1 CALL STCOPY( SH, 1, ARGS, K) CALL CHCOPY( 32, ARGS, K) J = 1 23322 IF (.NOT.(J .LE. 3 ))GOTO 23324 CALL STCOPY( EDTBUF( 1, J), 1, ARGS, K) ARGS(K) = 32 K = K + 1 23323 J = J + 1 GOTO 23322 23324 CONTINUE ARGS(K) = 0 INIT = 0 23318 CONTINUE CALL SKIPBL( LIN, I) IF (.NOT.(LIN(I) .EQ. 10 .OR. LIN(I) .EQ. 0))GOTO 23325 STATUS = SSPAWN(PROCES, SH, DESC, 119) GOTO 23326 23325 CONTINUE INT = CREATE (EDTBUF(1,1), 2) IF (.NOT.(INT .EQ. -3))GOTO 23327 STATUS = -3 GOTO 23328 23327 CONTINUE J=I 23329 IF (.NOT.(LIN(J) .NE. 0))GOTO 23331 CALL PUTCH(LIN(J), INT) 23330 J=J+1 GOTO 23329 23331 CONTINUE CALL CLOSE(INT) STATUS = SSPAWN(PROCES, ARGS, DESC, 119) 23328 CONTINUE 23326 CONTINUE IF (.NOT.(STATUS .NE. 0))GOTO 23332 STATUS = -3 23332 CONTINUE DOSPWN=(STATUS) RETURN END INTEGER FUNCTION DOSTAK(LINE, I) LOGICAL*1 LINE(100), FILE(36) INTEGER I INTEGER GETWRD, LOCCOM, INDEXC INTEGER UNIT INTEGER OPEN INTEGER LEVEL INTEGER VRBS INTEGER DESC LOGICAL*1 LIN LOGICAL*1 SUFFIX(6) LOGICAL*1 SPATH(18) COMMON / CSTACK / LEVEL, VRBS(2), DESC(2) COMMON /CSCLIN/ LIN(402) DATA SUFFIX(1)/46/,SUFFIX(2)/101/,SUFFIX(3)/100/,SUFFIX(4)/0/,SUFF *IX(5)/10/,SUFFIX(6)/0/ DATA SPATH(1)/0/,SPATH(2)/126/,SPATH(3)/47/,SPATH(4)/0/,SPATH(5)/1 *26/,SPATH(6)/117/,SPATH(7)/115/,SPATH(8)/114/,SPATH(9)/47/,SPATH(1 *0)/0/,SPATH(11)/126/,SPATH(12)/98/,SPATH(13)/105/,SPATH(14)/110/,S *PATH(15)/47/,SPATH(16)/0/,SPATH(17)/10/,SPATH(18)/0/ IF (.NOT.(LEVEL .GE. 2))GOTO 23334 DOSTAK=(-3) RETURN 23334 CONTINUE IF (.NOT.(GETWRD(LINE, I, LIN) .EQ. 0))GOTO 23336 DOSTAK=(-3) RETURN 23336 CONTINUE CALL FINDIT(LIN, FILE) IF (.NOT.(LOCCOM(FILE, SPATH, SUFFIX, FILE) .NE. 12))GOTO 23338 DOSTAK=(-3) RETURN 23338 CONTINUE UNIT = OPEN(FILE, 1) LEVEL = LEVEL + 1 DESC(LEVEL) = UNIT VRBS(LEVEL) = 0 IF (.NOT.(GETWRD(LINE, I, FILE) .GT. 0))GOTO 23340 CALL FOLD(FILE) IF (.NOT.(INDEXC(FILE, 118) .GT. 0))GOTO 23342 VRBS(LEVEL) = 1 23342 CONTINUE 23340 CONTINUE 23339 CONTINUE 23337 CONTINUE 23335 CONTINUE DOSTAK=(0) RETURN END INTEGER FUNCTION DOWRIT( FROM, TO, FILE) LOGICAL*1 FILE(402), LIN(36) INTEGER FD INTEGER CREATE, GETTXT INTEGER FROM, K, LINE, TO, ACCESS LOGICAL*1 TXT INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN LOGICAL*1 SAVFIL INTEGER LEVEL INTEGER VRBS INTEGER DESC LOGICAL*1 ST007Z(34) LOGICAL*1 ST008Z(2) COMMON /CTXT/ TXT(402) COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CFILE/ SAVFIL(36) COMMON / CSTACK / LEVEL, VRBS(2), DESC(2) DATA ST007Z(1)/63/,ST007Z(2)/32/,ST007Z(3)/67/,ST007Z(4)/97/,ST007 *Z(5)/110/,ST007Z(6)/39/,ST007Z(7)/116/,ST007Z(8)/32/,ST007Z(9)/119 */,ST007Z(10)/114/,ST007Z(11)/105/,ST007Z(12)/116/,ST007Z(13)/101/, *ST007Z(14)/32/,ST007Z(15)/111/,ST007Z(16)/117/,ST007Z(17)/116/,ST0 *07Z(18)/112/,ST007Z(19)/117/,ST007Z(20)/116/,ST007Z(21)/32/,ST007Z *(22)/102/,ST007Z(23)/105/,ST007Z(24)/108/,ST007Z(25)/101/,ST007Z(2 *6)/32/,ST007Z(27)/110/,ST007Z(28)/97/,ST007Z(29)/109/,ST007Z(30)/1 *01/,ST007Z(31)/100/,ST007Z(32)/32/,ST007Z(33)/96/,ST007Z(34)/0/ DATA ST008Z(1)/39/,ST008Z(2)/0/ ACCESS = 2 K = 1 IF (.NOT.(FILE(1) .EQ. 62))GOTO 23344 K = 2 IF (.NOT.(FILE(2) .EQ. 62))GOTO 23346 K = 3 ACCESS = 4 23346 CONTINUE 23344 CONTINUE CALL SCOPY(FILE, K, TXT, 1) CALL FINDIT( TXT, LIN) FD = CREATE( LIN, ACCESS) IF (.NOT.( FD .EQ. -3 ))GOTO 23348 CALL PUTLIN( ST007Z, 3) CALL PUTLIN( FILE, 3) CALL REMARK( ST008Z ) DOWRIT=(-3) RETURN 23348 CONTINUE LINE = FROM 23350 IF (.NOT.(LINE .LE. TO ))GOTO 23352 K = GETTXT(LINE) CALL PUTLIN( TXT, FD) 23351 LINE = LINE + 1 GOTO 23350 23352 CONTINUE CALL CLOSE(FD) IF (.NOT.((PRINT .EQ. 1 .AND. LEVEL .EQ. 1) .OR. VRBS(LEVEL) .EQ. *1))GOTO 23353 CALL PUTINT( TO - FROM + 1, 1,2) CALL PUTCH(10,2) 23353 CONTINUE IFMOD = 0 DOWRIT=(0) RETURN 23349 CONTINUE END SUBROUTINE ENDED INTEGER I, JUNK INTEGER REMOVE LOGICAL*1 EDTBUF COMMON / CTBUFS / EDTBUF(36, 3) I = 1 23355 IF (.NOT.(I .LE. 3 ))GOTO 23357 JUNK = REMOVE( EDTBUF( 1, I) ) 23356 I = I + 1 GOTO 23355 23357 CONTINUE RETURN END SUBROUTINE FINDIT( IN, OUT) LOGICAL*1 IN(100), OUT(100) INTEGER I, N INTEGER CTOI LOGICAL*1 EDTBUF COMMON / CTBUFS / EDTBUF(36, 3) CALL STRCPY( IN, OUT) IF (.NOT.( IN(1) .EQ. 36 ))GOTO 23358 I = 2 N = CTOI( IN, I) + 1 IF (.NOT.( 1 .LT. N .AND. N .LE. 3 ))GOTO 23360 CALL STRCPY( EDTBUF( 1, N), OUT) 23360 CONTINUE 23358 CONTINUE RETURN END SUBROUTINE GETB( VIRNDX, TYPE, VALUE) INTEGER VIRNDX, TYPE, NDX INTEGER VALUE(2) INTEGER XINDEX INTEGER VIRPHY INTEGER BUF, LASTBF, FREE COMMON /CBUF/ BUF(2048), LASTBF, FREE XINDEX = VIRPHY(VIRNDX, NDX) IF (.NOT.( TYPE .EQ. 0 ))GOTO 23362 VALUE(1) = IABS( BUF( NDX + 0 ) ) GOTO 23363 23362 CONTINUE IF (.NOT.( TYPE .EQ. 1 ))GOTO 23364 VALUE(1) = BUF( NDX + 1 ) GOTO 23365 23364 CONTINUE IF (.NOT.( TYPE .EQ. 3 ))GOTO 23366 IF (.NOT.( BUF( NDX + 0 ) .LT. 0 ))GOTO 23368 VALUE(1) = 1 GOTO 23369 23368 CONTINUE VALUE(1) = 0 23369 CONTINUE GOTO 23367 23366 CONTINUE IF (.NOT.( TYPE .EQ. 2 ))GOTO 23370 VALUE(1) = BUF( NDX + 2 ) VALUE(2) = BUF( NDX + 3 ) 23370 CONTINUE 23367 CONTINUE 23365 CONTINUE 23363 CONTINUE RETURN END INTEGER FUNCTION GETFN( LIN, I, FILE) LOGICAL*1 FILE(402), LIN(402) INTEGER I, J, K LOGICAL*1 SAVFIL COMMON /CFILE/ SAVFIL(36) GETFN = -3 IF (.NOT.( LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 9 ))GOTO 23372 J = I + 1 CALL SKIPBL( LIN, J) K = 1 23374 IF (.NOT.(LIN(J) .NE. 10 ))GOTO 23376 FILE(K) = LIN(J) J = J + 1 23375 K = K + 1 GOTO 23374 23376 CONTINUE FILE(K) = 0 IF (.NOT.( K .GT. 1 ))GOTO 23377 GETFN = 0 23377 CONTINUE GOTO 23373 23372 CONTINUE IF (.NOT.( LIN(I) .EQ. 10 .AND. SAVFIL(1) .NE. 0 ))GOTO 23379 CALL STRCPY( SAVFIL, FILE) GETFN = 0 23379 CONTINUE 23373 CONTINUE RETURN END INTEGER FUNCTION GETIND(LINE) INTEGER J, K, LINE INTEGER NEXTLN, PREVLN INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN DATA OLDNDX / -3 / DATA OLDLIN / -2 / IF (.NOT.( OLDNDX .NE. -3 .AND. LINE .EQ. NEXTLN(OLDLIN) .AND. LIN *E .NE. 0 ))GOTO 23381 CALL GETB( OLDNDX, 1, K) GOTO 23382 23381 CONTINUE IF (.NOT.( OLDNDX .NE. -3 .AND. LINE .EQ. OLDLIN ))GOTO 23383 K = OLDNDX GOTO 23384 23383 CONTINUE IF (.NOT.( OLDNDX .NE. -3 .AND. LINE .EQ. PREVLN(OLDLIN) ))GOTO 23 *385 CALL GETB( OLDNDX, 0, K) GOTO 23386 23385 CONTINUE K = 1 IF (.NOT.( LINE .LT. LASTLN / 2 ))GOTO 23387 J = 0 23389 IF (.NOT.(J .LT. LINE ))GOTO 23391 CALL GETB( K, 1, K) 23390 J = J + 1 GOTO 23389 23391 CONTINUE GOTO 23388 23387 CONTINUE J = LASTLN 23392 IF (.NOT.(J .GE. LINE ))GOTO 23394 CALL GETB( K, 0, K) 23393 J = J - 1 GOTO 23392 23394 CONTINUE 23388 CONTINUE 23386 CONTINUE 23384 CONTINUE 23382 CONTINUE OLDLIN = LINE OLDNDX = K GETIND = K RETURN END INTEGER FUNCTION GETLST( LIN, I, STATUS) LOGICAL*1 LIN(402) INTEGER GETONE INTEGER I, NUM, STATUS INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN LINE2 = 0 NLINES = 0 23395 IF (.NOT.(GETONE( LIN, I, NUM, STATUS) .EQ. 0 ))GOTO 23397 LINE1 = LINE2 LINE2 = NUM NLINES = NLINES + 1 IF (.NOT.( LIN(I) .NE. 44 .AND. LIN(I) .NE. 59 ))GOTO 23398 GOTO 23397 23398 CONTINUE IF (.NOT.( LIN(I) .EQ. 59 ))GOTO 23400 CURLN = NUM 23400 CONTINUE I = I + 1 23396 GOTO 23395 23397 CONTINUE NLINES = MIN0( NLINES, 2) IF (.NOT.( NLINES .EQ. 0 ))GOTO 23402 LINE2 = CURLN 23402 CONTINUE IF (.NOT.( NLINES .LE. 1 ))GOTO 23404 LINE1 = LINE2 23404 CONTINUE IF (.NOT.( STATUS .NE. -3 ))GOTO 23406 STATUS = 0 23406 CONTINUE GETLST=(STATUS) RETURN END INTEGER FUNCTION GETNUM( LIN, I, PNUM, STATUS) LOGICAL*1 LIN(402) INTEGER CTOI, INDEXC, LENGTH, OPTPAT, PTSCAN INTEGER I, J, PNUM, STATUS INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN INTEGER PAT LOGICAL*1 DIGITS(11) LOGICAL*1 PNL(3) COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CPAT/ PAT(132) DATA DIGITS(1)/48/,DIGITS(2)/49/,DIGITS(3)/50/,DIGITS(4)/51/,DIGIT *S(5)/52/,DIGITS(6)/53/,DIGITS(7)/54/,DIGITS(8)/55/,DIGITS(9)/56/,D *IGITS(10)/57/,DIGITS(11)/0/ DATA PNL(1)/112/,PNL(2)/10/,PNL(3)/0/ GETNUM = 0 IF (.NOT.( INDEXC( DIGITS, LIN(I) ) .GT. 0 ))GOTO 23408 PNUM = CTOI( LIN, I) I = I - 1 GOTO 23409 23408 CONTINUE IF (.NOT.( LIN(I) .EQ. 46 ))GOTO 23410 PNUM = CURLN GOTO 23411 23410 CONTINUE IF (.NOT.( LIN(I) .EQ. 36 ))GOTO 23412 PNUM = LASTLN GOTO 23413 23412 CONTINUE IF (.NOT.( LIN(I) .EQ. 45 ))GOTO 23414 PNUM = CURLN - 1 GOTO 23415 23414 CONTINUE IF (.NOT.( LIN(I) .EQ. 43 ))GOTO 23416 PNUM = CURLN + 1 GOTO 23417 23416 CONTINUE IF (.NOT.( LIN(I) .EQ. 47 .OR. LIN(I) .EQ. 92 ))GOTO 23418 IF (.NOT.( INDEXC( LIN( I + 1 ), LIN(I) ) .EQ. 0 ))GOTO 23420 J = LENGTH(LIN) CALL CHCOPY( LIN(I), LIN, J) CALL STCOPY( PNL, 1, LIN, J) 23420 CONTINUE IF (.NOT.( OPTPAT( LIN, I) .EQ. -3 ))GOTO 23422 GETNUM = -3 GOTO 23423 23422 CONTINUE IF (.NOT.( LIN(I) .EQ. 47 ))GOTO 23424 GETNUM = PTSCAN( 43, PNUM) GOTO 23425 23424 CONTINUE GETNUM = PTSCAN( 45, PNUM) 23425 CONTINUE 23423 CONTINUE GOTO 23419 23418 CONTINUE GETNUM = -1 23419 CONTINUE 23417 CONTINUE 23415 CONTINUE 23413 CONTINUE 23411 CONTINUE 23409 CONTINUE IF (.NOT.( GETNUM .EQ. 0 ))GOTO 23426 I = I + 1 23426 CONTINUE STATUS = GETNUM RETURN END INTEGER FUNCTION GETONE( LIN, I, NUM, STATUS) LOGICAL*1 LIN(402) INTEGER GETNUM INTEGER I, ISTART, MUL, NUM, PNUM, STATUS INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN ISTART = I NUM = 0 CALL SKIPBL( LIN, I) IF (.NOT.( GETNUM( LIN, I, NUM, STATUS) .EQ. 0 ))GOTO 23428 23430 CONTINUE CALL SKIPBL( LIN, I) IF (.NOT.( LIN(I) .NE. 43 .AND. LIN(I) .NE. 45 ))GOTO 23433 STATUS = -1 GOTO 23432 23433 CONTINUE IF (.NOT.( LIN(I) .EQ. 43 ))GOTO 23435 MUL = +1 GOTO 23436 23435 CONTINUE MUL = -1 23436 CONTINUE I = I + 1 CALL SKIPBL( LIN, I) IF (.NOT.( GETNUM( LIN, I, PNUM, STATUS) .EQ. 0 ))GOTO 23437 NUM = NUM + MUL * PNUM 23437 CONTINUE IF (.NOT.( STATUS .EQ. -1 ))GOTO 23439 STATUS = -3 23439 CONTINUE 23431 IF (.NOT.( STATUS .NE. 0 ))GOTO 23430 23432 CONTINUE 23428 CONTINUE IF (.NOT.( NUM .LT. 0 .OR. NUM .GT. LASTLN ))GOTO 23441 STATUS = -3 23441 CONTINUE IF (.NOT.( STATUS .EQ. -3 ))GOTO 23443 GETONE = -3 GOTO 23444 23443 CONTINUE IF (.NOT.( I .LE. ISTART ))GOTO 23445 GETONE = -1 GOTO 23446 23445 CONTINUE GETONE = 0 23446 CONTINUE 23444 CONTINUE STATUS = GETONE RETURN END INTEGER FUNCTION GETRHS( LIN, I, SUB, GFLAG) LOGICAL*1 LIN(402), SUB(132) INTEGER INDEXC, LENGTH, MAKSUB 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 23447 RETURN 23447 CONTINUE IF (.NOT.( LIN( I + 1 ) .EQ. 0 ))GOTO 23449 RETURN 23449 CONTINUE IF (.NOT.( INDEXC( LIN( I + 1 ), LIN(I) ) .EQ. 0 ))GOTO 23451 J = LENGTH(LIN) CALL CHCOPY( LIN(I), LIN, J) CALL STCOPY( PNL, 1, LIN, J) 23451 CONTINUE I = MAKSUB( LIN, I + 1, LIN(I), SUB) IF (.NOT.( I .EQ. -3 ))GOTO 23453 RETURN 23453 CONTINUE IF (.NOT.( CLOWER( LIN( I + 1 ) ) .EQ. 103 ))GOTO 23455 I = I + 1 GFLAG = 1 GOTO 23456 23455 CONTINUE GFLAG = 0 23456 CONTINUE GETRHS=(0) RETURN END INTEGER FUNCTION GETTXT(LINE) INTEGER GETIND INTEGER J INTEGER LOC(2) INTEGER LINE INTEGER BUF, LASTBF, FREE LOGICAL*1 TXT INTEGER SCR INTEGER SCREND LOGICAL*1 SCRFIL LOGICAL*1 NULL(1) COMMON /CBUF/ BUF(2048), LASTBF, FREE COMMON /CTXT/ TXT(402) COMMON /CSCRAT/ SCR, SCREND(2) , SCRFIL(36) DATA NULL(1)/0/ J = GETIND(LINE) IF (.NOT.( LINE .NE. 0 ))GOTO 23457 CALL GETB( J, 2, LOC) CALL SEEK( LOC, SCR) CALL READFL( TXT, DUMMY, SCR) GOTO 23458 23457 CONTINUE CALL STRCPY( NULL, TXT) 23458 CONTINUE GETTXT=(J) RETURN END INTEGER FUNCTION GTFNDX(NEWIND) INTEGER BUF, LASTBF, FREE COMMON /CBUF/ BUF(2048), LASTBF, FREE IF (.NOT.( FREE .NE. 0 ))GOTO 23459 NEWIND = FREE CALL GETB( FREE, 1, FREE) GOTO 23460 23459 CONTINUE IF (.NOT.( LASTBF + 4 .LE. 32008 ))GOTO 23461 NEWIND = LASTBF LASTBF = LASTBF + 4 GOTO 23462 23461 CONTINUE NEWIND = -3 23462 CONTINUE 23460 CONTINUE GTFNDX=(NEWIND) RETURN END SUBROUTINE INITED LOGICAL*1 NUM(2) INTEGER I, J, JUNK INTEGER ITOC LOGICAL*1 EDTBUF INTEGER LEVEL INTEGER VRBS INTEGER DESC LOGICAL*1 EDT(4) COMMON / CTBUFS / EDTBUF(36, 3) COMMON / CSTACK / LEVEL, VRBS(2), DESC(2) DATA EDT(1)/101/,EDT(2)/100/,EDT(3)/116/,EDT(4)/0/ J = 1 23463 IF (.NOT.(J .LE. 3 ))GOTO 23465 I = J - 1 JUNK = ITOC( I, NUM, 2) EDT(3) = NUM(1) CALL SCRATF( EDT, EDTBUF( 1, J) ) 23464 J = J + 1 GOTO 23463 23465 CONTINUE CALL SNOREG(0) LEVEL = 1 VRBS(1) = 0 DESC(1) = 1 CALL VIRINT RETURN END INTEGER FUNCTION INJECT(LIN) LOGICAL*1 LIN(402) INTEGER GETIND, MAKLIN, NEXTLN INTEGER I, K1, K2, K3 INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN I = 1 23466 IF (.NOT.(LIN(I) .NE. 0 ))GOTO 23468 I = MAKLIN( LIN, I, K3) IF (.NOT.( I .EQ. -3 ))GOTO 23469 INJECT=(-3) RETURN 23469 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 23467 GOTO 23466 23468 CONTINUE INJECT=(0) RETURN END INTEGER FUNCTION INPLIN( LIN, CHN, NUM) LOGICAL*1 LIN(100), PSTR(9) INTEGER CHN, I, N, NUM INTEGER ITOC, PROMPT INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN LOGICAL*1 TAIL(3) COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN DATA TAIL(1)/61/,TAIL(2)/62/,TAIL(3)/0/ IF (.NOT.( NUMBER .EQ. 1 ))GOTO 23471 N = ITOC( NUM, PSTR, 7) I = 6 23473 IF (.NOT.(I .GT. 0 ))GOTO 23475 IF (.NOT.(N .GT. 0))GOTO 23476 PSTR(I) = PSTR(N) GOTO 23477 23476 CONTINUE PSTR(I) = 32 23477 CONTINUE 23474 I = I - 1 N = N - 1 GOTO 23473 23475 CONTINUE CALL SCOPY( TAIL, 1, PSTR, 7) GOTO 23472 23471 CONTINUE PSTR(1) = 0 23472 CONTINUE INPLIN = PROMPT( PSTR, LIN, CHN) RETURN END INTEGER FUNCTION KOPY(LINE3) INTEGER JUNK, LINE3, NLINE, OFFSET INTEGER GETTXT, INJECT INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN LOGICAL*1 TXT COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CTXT/ TXT(402) IF (.NOT.( LINE1 .LE. 0 ))GOTO 23478 KOPY = -3 GOTO 23479 23478 CONTINUE KOPY = 0 CURLN = LINE3 NLINE = LINE1 23480 IF (.NOT.(NLINE .LE. LINE2 ))GOTO 23482 IF (.NOT.( NLINE .GT. LINE3 ))GOTO 23483 OFFSET = NLINE - LINE1 GOTO 23484 23483 CONTINUE OFFSET = 0 23484 CONTINUE JUNK = GETTXT( NLINE + OFFSET ) KOPY = INJECT(TXT) IF (.NOT.( KOPY .EQ. -3 ))GOTO 23485 GOTO 23482 23485 CONTINUE 23481 NLINE = NLINE + 1 GOTO 23480 23482 CONTINUE 23479 CONTINUE RETURN END INTEGER FUNCTION LMOVE(LINE3) INTEGER GETIND, NEXTLN, PREVLN INTEGER DELTA, K0, K1, K2, K3, K4, K5, LINE3 INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN IF (.NOT.( LINE1 .LE. 0 .OR. ( LINE1 .LE. LINE3 .AND. LINE3 .LE. L *INE2 ) ))GOTO 23487 LMOVE = -3 GOTO 23488 23487 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 23489 CURLN = LINE3 LINE3 = LINE3 - DELTA GOTO 23490 23489 CONTINUE CURLN = LINE3 + DELTA 23490 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 23488 CONTINUE RETURN END INTEGER FUNCTION MAKLIN( LIN, I, NEWIND) LOGICAL*1 LIN(402) INTEGER ADDSET, GTFNDX, NOTE INTEGER I, J, JUNK, NEWIND, NEWPTR INTEGER BUF, LASTBF, FREE LOGICAL*1 TXT INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN INTEGER TXTEND INTEGER SCR INTEGER SCREND LOGICAL*1 SCRFIL LOGICAL*1 ST009Z(39) COMMON /CBUF/ BUF(2048), LASTBF, FREE COMMON /CTXT/ TXT(402) COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CSCRAT/ SCR, SCREND(2) , SCRFIL(36) DATA ST009Z(1)/63/,ST009Z(2)/32/,ST009Z(3)/76/,ST009Z(4)/105/,ST00 *9Z(5)/110/,ST009Z(6)/101/,ST009Z(7)/32/,ST009Z(8)/100/,ST009Z(9)/1 *01/,ST009Z(10)/115/,ST009Z(11)/99/,ST009Z(12)/114/,ST009Z(13)/105/ *,ST009Z(14)/112/,ST009Z(15)/116/,ST009Z(16)/111/,ST009Z(17)/114/,S *T009Z(18)/32/,ST009Z(19)/115/,ST009Z(20)/112/,ST009Z(21)/97/,ST009 *Z(22)/99/,ST009Z(23)/101/,ST009Z(24)/32/,ST009Z(25)/108/,ST009Z(26 *)/105/,ST009Z(27)/109/,ST009Z(28)/105/,ST009Z(29)/116/,ST009Z(30)/ *32/,ST009Z(31)/101/,ST009Z(32)/120/,ST009Z(33)/99/,ST009Z(34)/101/ *,ST009Z(35)/101/,ST009Z(36)/100/,ST009Z(37)/101/,ST009Z(38)/100/,S *T009Z(39)/0/ MAKLIN = -3 OLDNDX = -3 IF (.NOT.( GTFNDX(NEWIND) .EQ. -3 ))GOTO 23491 CALL REMARK( ST009Z ) RETURN 23491 CONTINUE TXTEND = 1 J = I 23493 IF (.NOT.(LIN(J) .NE. 0 ))GOTO 23495 JUNK = ADDSET( LIN(J), TXT, TXTEND, 402) J = J + 1 IF (.NOT.( LIN( J - 1 ) .EQ. 10 ))GOTO 23496 GOTO 23495 23496 CONTINUE 23494 GOTO 23493 23495 CONTINUE IF (.NOT.( ADDSET( 0, TXT, TXTEND, 402) .EQ. 0 ))GOTO 23498 CALL PTFNDX( NEWIND, NEWIND) RETURN 23498 CONTINUE CALL SETB( NEWIND, 2, SCREND) CALL SEEK( SCREND, SCR) CALL PUTLIN( TXT, SCR) JUNK = NOTE(SCREND, SCR) CALL SETB( NEWIND, 3, 0) MAKLIN=(J) RETURN END SUBROUTINE MAPPHY(I) INTEGER I, N, J, PND, JUNK INTEGER NOTE INTEGER CREATE INTEGER VIRIND INTEGER PHYIND INTEGER*4 DSKADR INTEGER VIRUNT INTEGER*4 VIREND LOGICAL*1 VPFILE INTEGER LRUP INTEGER MRUP INTEGER PFNP LOGICAL*1 VPF(4) LOGICAL*1 ST00AZ(24) COMMON / CVIRT / VIRIND(126), PHYIND(126), DSKADR(126) COMMON / CVFILE / VIRUNT, VIREND, VPFILE(36) COMMON / CLRU / LRUP(8), MRUP(8), PFNP(8) DATA VPF(1)/118/,VPF(2)/112/,VPF(3)/102/,VPF(4)/0/ DATA ST00AZ(1)/67/,ST00AZ(2)/97/,ST00AZ(3)/110/,ST00AZ(4)/110/,ST0 *0AZ(5)/111/,ST00AZ(6)/116/,ST00AZ(7)/32/,ST00AZ(8)/111/,ST00AZ(9)/ *112/,ST00AZ(10)/101/,ST00AZ(11)/110/,ST00AZ(12)/32/,ST00AZ(13)/112 */,ST00AZ(14)/97/,ST00AZ(15)/103/,ST00AZ(16)/105/,ST00AZ(17)/110/,S *T00AZ(18)/103/,ST00AZ(19)/32/,ST00AZ(20)/102/,ST00AZ(21)/105/,ST00 *AZ(22)/108/,ST00AZ(23)/101/,ST00AZ(24)/0/ IF (.NOT.(VIRUNT .EQ. -3))GOTO 23500 CALL SCRATF(VPF, VPFILE) VIRUNT = CREATE(VPFILE, -3) IF (.NOT.(VIRUNT .EQ. -3))GOTO 23502 CALL ERROR(ST00AZ) 23502 CONTINUE JUNK = NOTE(VIREND, VIRUNT) 23500 CONTINUE N = LRUP(1) J = PFNP(N) PND = IABS(PHYIND(J)) CALL PAGOUT(J) PHYIND(I) = PND CALL PAGIN(I) PFNP(N) = I CALL MRUSET(N) RETURN END SUBROUTINE MRUSET(N) INTEGER N, I, J INTEGER LRUP INTEGER MRUP INTEGER PFNP COMMON / CLRU / LRUP(8), MRUP(8), PFNP(8) IF (.NOT.(N .NE. 1))GOTO 23504 J = LRUP(N) I = MRUP(N) MRUP(J) = I LRUP(I) = J I = MRUP(1) MRUP(1) = N LRUP(I) = N LRUP(N) = 1 MRUP(N) = I 23504 CONTINUE RETURN END INTEGER FUNCTION NEXTLN(LINE) INTEGER LINE INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN NEXTLN = LINE + 1 IF (.NOT.( NEXTLN .GT. LASTLN ))GOTO 23506 NEXTLN = 0 23506 CONTINUE RETURN END INTEGER FUNCTION OPTPAT( LIN, I) LOGICAL*1 LIN(402) INTEGER MAKPAT INTEGER I INTEGER PAT COMMON /CPAT/ PAT(132) IF (.NOT.( LIN(I) .EQ. 0 ))GOTO 23508 I = -3 GOTO 23509 23508 CONTINUE IF (.NOT.( LIN( I + 1 ) .EQ. 0 ))GOTO 23510 I = -3 GOTO 23511 23510 CONTINUE IF (.NOT.( LIN( I + 1 ) .EQ. LIN(I) ))GOTO 23512 I = I + 1 GOTO 23513 23512 CONTINUE I = MAKPAT( LIN, I + 1, LIN(I), PAT) 23513 CONTINUE 23511 CONTINUE 23509 CONTINUE IF (.NOT.( PAT(1) .EQ. 0 ))GOTO 23514 I = -3 23514 CONTINUE IF (.NOT.( I .EQ. -3 ))GOTO 23516 PAT(1) = 0 OPTPAT = -3 GOTO 23517 23516 CONTINUE OPTPAT = 0 23517 CONTINUE RETURN END SUBROUTINE PAGIN(I) INTEGER I, N, JUNK INTEGER READF, PTREQ INTEGER VIRIND INTEGER PHYIND INTEGER*4 DSKADR INTEGER VIRUNT INTEGER*4 VIREND LOGICAL*1 VPFILE INTEGER BUF, LASTBF, FREE COMMON / CVIRT / VIRIND(126), PHYIND(126), DSKADR(126) COMMON / CVFILE / VIRUNT, VIREND, VPFILE(36) COMMON /CBUF/ BUF(2048), LASTBF, FREE N = PHYIND(I) IF (.NOT.(PTREQ(DSKADR(I), 0) .EQ. 1))GOTO 23518 JUNK = N + 256 23520 IF (.NOT.(N .LT. JUNK))GOTO 23522 BUF(N) = 0 23521 N=N+1 GOTO 23520 23522 CONTINUE GOTO 23519 23518 CONTINUE CALL SEEK(DSKADR(I), VIRUNT) JUNK = READF(BUF(N), 512, VIRUNT) 23519 CONTINUE RETURN END SUBROUTINE PAGOUT(J) INTEGER J, N, JUNK, RESET INTEGER WRITEF, PTREQ, NOTE INTEGER VIRIND INTEGER PHYIND INTEGER*4 DSKADR INTEGER VIRUNT INTEGER*4 VIREND LOGICAL*1 VPFILE INTEGER BUF, LASTBF, FREE COMMON / CVIRT / VIRIND(126), PHYIND(126), DSKADR(126) COMMON / CVFILE / VIRUNT, VIREND, VPFILE(36) COMMON /CBUF/ BUF(2048), LASTBF, FREE IF (.NOT.(PHYIND(J) .LT. 0))GOTO 23523 N = IABS(PHYIND(J)) IF (.NOT.(PTREQ(DSKADR(J), 0) .EQ. 1))GOTO 23525 CALL PTRCPY(VIREND, DSKADR(J)) RESET = 1 GOTO 23526 23525 CONTINUE RESET = 0 23526 CONTINUE CALL SEEK(DSKADR(J), VIRUNT) JUNK = WRITEF(BUF(N), 512, VIRUNT) IF (.NOT.(RESET .EQ. 1))GOTO 23527 JUNK = NOTE(VIREND, VIRUNT) 23527 CONTINUE 23523 CONTINUE PHYIND(J) = 0 RETURN END SUBROUTINE PDIRTY(I) INTEGER I, N INTEGER VIRIND INTEGER PHYIND INTEGER*4 DSKADR INTEGER LRUP INTEGER MRUP INTEGER PFNP COMMON / CVIRT / VIRIND(126), PHYIND(126), DSKADR(126) COMMON / CLRU / LRUP(8), MRUP(8), PFNP(8) PHYIND(I) = -IABS(PHYIND(I)) N=1 23529 IF (.NOT.(N .LE. 8))GOTO 23531 IF (.NOT.(PFNP(N) .EQ. I))GOTO 23532 GOTO 23531 23532 CONTINUE 23530 N=N+1 GOTO 23529 23531 CONTINUE CALL MRUSET(N) RETURN END SUBROUTINE PERCEN INTEGER BUF, LASTBF, FREE INTEGER CHRPER, LINPER LOGICAL*1 ST00BZ(34) COMMON /CBUF/ BUF(2048), LASTBF, FREE DATA ST00BZ(1)/32/,ST00BZ(2)/112/,ST00BZ(3)/101/,ST00BZ(4)/114/,ST *00BZ(5)/99/,ST00BZ(6)/101/,ST00BZ(7)/110/,ST00BZ(8)/116/,ST00BZ(9) */32/,ST00BZ(10)/111/,ST00BZ(11)/102/,ST00BZ(12)/32/,ST00BZ(13)/108 */,ST00BZ(14)/105/,ST00BZ(15)/110/,ST00BZ(16)/101/,ST00BZ(17)/32/,S *T00BZ(18)/100/,ST00BZ(19)/101/,ST00BZ(20)/115/,ST00BZ(21)/99/,ST00 *BZ(22)/114/,ST00BZ(23)/105/,ST00BZ(24)/112/,ST00BZ(25)/116/,ST00BZ *(26)/111/,ST00BZ(27)/114/,ST00BZ(28)/115/,ST00BZ(29)/32/,ST00BZ(30 *)/117/,ST00BZ(31)/115/,ST00BZ(32)/101/,ST00BZ(33)/100/,ST00BZ(34)/ *0/ LINPER = LASTBF / 320 CALL PUTINT( LINPER, 2,2) CALL PUTLIN( ST00BZ, 2) CALL PUTCH(10,2) RETURN END INTEGER FUNCTION PREVLN(LINE) INTEGER LINE INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN PREVLN = LINE - 1 IF (.NOT.( PREVLN .LT. 0 ))GOTO 23534 PREVLN = LASTLN 23534 CONTINUE RETURN END SUBROUTINE PTFNDX( START, STOP) INTEGER START, STOP INTEGER BUF, LASTBF, FREE COMMON /CBUF/ BUF(2048), LASTBF, FREE CALL SETB( STOP, 1, FREE) FREE = START RETURN END SUBROUTINE PTLNUM( NUM, FD) INTEGER FD INTEGER NUM INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN LOGICAL*1 TAIL(3) COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN DATA TAIL(1)/61/,TAIL(2)/62/,TAIL(3)/0/ IF (.NOT.( NUMBER .EQ. 1 ))GOTO 23536 CALL PUTINT( NUM, 6, FD) CALL PUTLIN( TAIL, FD) 23536 CONTINUE RETURN END INTEGER FUNCTION PTSCAN( WAY, NUM) INTEGER GETTXT, MATCH, NEXTLN, PREVLN INTEGER K, NUM, WAY INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN INTEGER PAT LOGICAL*1 TXT COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CPAT/ PAT(132) COMMON /CTXT/ TXT(402) NUM = CURLN 23538 CONTINUE IF (.NOT.( WAY .EQ. 43 ))GOTO 23541 NUM = NEXTLN(NUM) GOTO 23542 23541 CONTINUE NUM = PREVLN(NUM) 23542 CONTINUE K = GETTXT(NUM) IF (.NOT.( MATCH( TXT, PAT) .EQ. 1 ))GOTO 23543 PTSCAN=(0) RETURN 23543 CONTINUE 23539 IF (.NOT.( NUM .EQ. CURLN ))GOTO 23538 23540 CONTINUE PTSCAN=(-3) RETURN END SUBROUTINE READFL( BUFFER, COUNT, INT) INTEGER COUNT, INT, JUNK INTEGER GETLIN LOGICAL*1 BUFFER(100) JUNK = GETLIN( BUFFER, INT) RETURN END SUBROUTINE RELINK( A, X, Y, B) INTEGER A, B, X, Y INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN OLDNDX = -3 CALL SETB( X, 0, A) CALL SETB( Y, 1, B) IFMOD = 1 RETURN END SUBROUTINE SETB( VIRNDX, TYPE, VALUE) INTEGER VIRNDX, TYPE, NDX INTEGER VALUE(2) INTEGER XINDEX INTEGER VIRPHY INTEGER BUF, LASTBF, FREE COMMON /CBUF/ BUF(2048), LASTBF, FREE XINDEX = VIRPHY(VIRNDX, NDX) IF (.NOT.( TYPE .EQ. 0 ))GOTO 23545 IF (.NOT.( BUF( NDX + 0 ) .LT. 0 ))GOTO 23547 BUF( NDX + 0 ) = -VALUE(1) GOTO 23548 23547 CONTINUE BUF( NDX + 0 ) = VALUE(1) 23548 CONTINUE GOTO 23546 23545 CONTINUE IF (.NOT.( TYPE .EQ. 1 ))GOTO 23549 BUF( NDX + 1 ) = VALUE(1) GOTO 23550 23549 CONTINUE IF (.NOT.( TYPE .EQ. 3 ))GOTO 23551 IF (.NOT.( VALUE(1) .EQ. 1 ))GOTO 23553 BUF( NDX + 0 ) = -IABS( BUF( NDX + 0 ) ) GOTO 23554 23553 CONTINUE BUF( NDX + 0 ) = IABS( BUF( NDX + 0 ) ) 23554 CONTINUE GOTO 23552 23551 CONTINUE IF (.NOT.( TYPE .EQ. 2 ))GOTO 23555 BUF( NDX + 2 ) = VALUE(1) BUF( NDX + 3 ) = VALUE(2) 23555 CONTINUE 23552 CONTINUE 23550 CONTINUE 23546 CONTINUE CALL PDIRTY(XINDEX) RETURN END SUBROUTINE SETBUF INTEGER K, JUNK INTEGER NOTE INTEGER BUF, LASTBF, FREE INTEGER DELCNT INTEGER FSTDEL INTEGER LSTDEL INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN INTEGER CREATE INTEGER SCR INTEGER SCREND LOGICAL*1 SCRFIL LOGICAL*1 FIL(4) LOGICAL*1 NULL(1) COMMON /CBUF/ BUF(2048), LASTBF, FREE COMMON /CDEL/ DELCNT, FSTDEL, LSTDEL COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CSCRAT/ SCR, SCREND(2) , SCRFIL(36) DATA FIL(1)/101/,FIL(2)/100/,FIL(3)/115/,FIL(4)/0/ DATA NULL(1)/0/ CALL SCRATF( FIL, SCRFIL) SCR = CREATE( SCRFIL, 3) IF (.NOT.( SCR .EQ. -3 ))GOTO 23557 CALL CANT(SCRFIL) 23557 CONTINUE JUNK = NOTE(SCREND, SCR) 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(402), SUB(132) INTEGER ADDSET, AMATCH, CONCT, GETTXT, INJEXT INTEGER GFLAG, J, JUNK, K, LASTM, LINE, M, STATUS, SUBBED INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN INTEGER PAT LOGICAL*1 TXT COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN COMMON /CPAT/ PAT(132) COMMON /CTXT/ TXT(402) SUBST = -3 IF (.NOT.( LINE1 .LE. 0 ))GOTO 23559 RETURN 23559 CONTINUE LINE = LINE1 23561 IF (.NOT.(LINE .LE. LINE2 ))GOTO 23563 J = 1 SUBBED = 0 JUNK = GETTXT(LINE) LASTM = 0 K = 1 23564 IF (.NOT.(TXT(K) .NE. 0 ))GOTO 23566 IF (.NOT.( GFLAG .EQ. 1 .OR. SUBBED .EQ. 0 ))GOTO 23567 M = AMATCH( TXT, K, PAT) GOTO 23568 23567 CONTINUE M = 0 23568 CONTINUE IF (.NOT.( M .GT. 0 .AND. LASTM .NE. M ))GOTO 23569 SUBBED = 1 CALL CATSUB( TXT, K, M, SUB, NEW, J, 402) LASTM = M 23569 CONTINUE IF (.NOT.( M .EQ. 0 .OR. M .EQ. K ))GOTO 23571 JUNK = ADDSET( TXT(K), NEW, J, 402) K = K + 1 GOTO 23572 23571 CONTINUE K = M 23572 CONTINUE 23565 GOTO 23564 23566 CONTINUE IF (.NOT.( SUBBED .EQ. 1 ))GOTO 23573 IF (.NOT.( ADDSET( 0, NEW, J, 402) .EQ. 0 ))GOTO 23575 SUBST = -3 GOTO 23563 23575 CONTINUE SUBST = CONCT( LINE, NEW) IF (.NOT.( SUBST .EQ. -3 ))GOTO 23577 GOTO 23563 23577 CONTINUE CALL DELETE( LINE, LINE, STATUS) SUBST = INJECT(NEW) IF (.NOT.( SUBST .EQ. -3 ))GOTO 23579 GOTO 23563 23579 CONTINUE SUBST = 0 23573 CONTINUE 23562 LINE = LINE + 1 GOTO 23561 23563 CONTINUE RETURN END INTEGER FUNCTION TYPSET( LIN, I) INTEGER DOSPWN, DOWRIT, REMOVE INTEGER I, J, MODTMP, PRTTMP, STATUS, JUNK LOGICAL*1 LIN(100) LOGICAL*1 ARGARA LOGICAL*1 FILARA INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN LOGICAL*1 FMTSTR(8) LOGICAL*1 SEED(4) LOGICAL*1 ST00CZ(28) COMMON / CSPWN / ARGARA(256), FILARA(36) COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN DATA FMTSTR(1)/102/,FMTSTR(2)/111/,FMTSTR(3)/114/,FMTSTR(4)/109/,F *MTSTR(5)/97/,FMTSTR(6)/116/,FMTSTR(7)/32/,FMTSTR(8)/0/ DATA SEED(1)/102/,SEED(2)/109/,SEED(3)/116/,SEED(4)/0/ DATA ST00CZ(1)/63/,ST00CZ(2)/32/,ST00CZ(3)/67/,ST00CZ(4)/97/,ST00C *Z(5)/110/,ST00CZ(6)/39/,ST00CZ(7)/116/,ST00CZ(8)/32/,ST00CZ(9)/99/ *,ST00CZ(10)/114/,ST00CZ(11)/101/,ST00CZ(12)/97/,ST00CZ(13)/116/,ST *00CZ(14)/101/,ST00CZ(15)/32/,ST00CZ(16)/115/,ST00CZ(17)/99/,ST00CZ *(18)/114/,ST00CZ(19)/97/,ST00CZ(20)/116/,ST00CZ(21)/99/,ST00CZ(22) */104/,ST00CZ(23)/32/,ST00CZ(24)/102/,ST00CZ(25)/105/,ST00CZ(26)/10 *8/,ST00CZ(27)/101/,ST00CZ(28)/0/ MODTMP = IFMOD PRTTMP = PRINT PRINT = 0 CALL SCRATF( SEED, FILARA) IF (.NOT.( DOWRIT( 1, LASTLN, FILARA) .NE. -3 ))GOTO 23581 J = 1 CALL STCOPY( FMTSTR, 1, ARGARA, J) CALL STCOPY( LIN, I, ARGARA, J) IF (.NOT.( ARGARA( J - 1 ) .EQ. 10 ))GOTO 23583 J = J - 1 23583 CONTINUE CALL CHCOPY( 32, ARGARA, J) CALL STCOPY( FILARA, 1, ARGARA, J) J = 1 STATUS = DOSPWN( ARGARA, J) GOTO 23582 23581 CONTINUE CALL REMARK( ST00CZ ) STATUS = -3 23582 CONTINUE JUNK = REMOVE(FILARA) IFMOD = MODTMP PRINT = PRTTMP RETURN END INTEGER FUNCTION UNDEL( LINE, GLOB) INTEGER GETIND, NEXTLN, PREVLN INTEGER GLOB, LINE INTEGER K1, K2, STATUS INTEGER DELCNT INTEGER FSTDEL INTEGER LSTDEL INTEGER LINE1 INTEGER LINE2 INTEGER NLINES INTEGER CURLN INTEGER LASTLN INTEGER PRINT INTEGER CURSAV INTEGER OLDLIN INTEGER OLDNDX INTEGER IFMOD INTEGER NUMBER INTEGER AUTOIN COMMON /CDEL/ DELCNT, FSTDEL, LSTDEL COMMON /CLINES/ LINE1, LINE2, NLINES, CURLN, LASTLN, PRINT, CURSAV *, OLDLIN, OLDNDX, IFMOD, NUMBER, AUTOIN IF (.NOT.( DELCNT .EQ. 0 .OR. GLOB .EQ. 1 ))GOTO 23585 UNDEL=(-3) RETURN 23585 CONTINUE CURLN = LINE K1 = GETIND(CURLN) K2 = GETIND( NEXTLN(CURLN) ) IF (.NOT.( CURLN .EQ. LASTLN ))GOTO 23587 CURLN = CURLN + DELCNT GOTO 23588 23587 CONTINUE CURLN = NEXTLN(CURLN) 23588 CONTINUE LASTLN = LASTLN + DELCNT CALL RELINK( K1, FSTDEL, LSTDEL, K2) CALL RELINK( LSTDEL, K2, K1, FSTDEL) DELCNT = 0 UNDEL=(0) RETURN 23586 CONTINUE END SUBROUTINE VIRINT INTEGER I, J INTEGER VIRIND INTEGER PHYIND INTEGER*4 DSKADR INTEGER VIRUNT INTEGER*4 VIREND LOGICAL*1 VPFILE INTEGER LRUP INTEGER MRUP INTEGER PFNP COMMON / CVIRT / VIRIND(126), PHYIND(126), DSKADR(126) COMMON / CVFILE / VIRUNT, VIREND, VPFILE(36) COMMON / CLRU / LRUP(8), MRUP(8), PFNP(8) I=1 J=1 23589 IF (.NOT.(I .LE. 126))GOTO 23591 VIRIND(I) = J CALL PTRCPY(0,DSKADR(I)) IF (.NOT.(I .LE. 8))GOTO 23592 PHYIND(I) = J GOTO 23593 23592 CONTINUE PHYIND(I) = 0 23593 CONTINUE 23590 I=I+1 J=J+256 GOTO 23589 23591 CONTINUE VIRUNT = -3 I=1 23594 IF (.NOT.(I .LE. 8))GOTO 23596 LRUP(I) = I - 1 MRUP(I) = I + 1 PFNP(I) = I 23595 I=I+1 GOTO 23594 23596 CONTINUE LRUP(1) = 8 MRUP(8) = 1 RETURN END INTEGER FUNCTION VIRPHY(VIRTND, PHYSND) INTEGER VIRTND, PHYSND, I INTEGER VIRIND INTEGER PHYIND INTEGER*4 DSKADR COMMON / CVIRT / VIRIND(126), PHYIND(126), DSKADR(126) I = ((VIRTND - 1) / 256) + 1 IF (.NOT.(PHYIND(I) .EQ. 0))GOTO 23597 CALL MAPPHY(I) 23597 CONTINUE PHYSND = IABS(PHYIND(I)) + (VIRTND - VIRIND(I)) VIRPHY=(I) RETURN END