INTEGER FUNCTION AFETCH(BUF, I, OUT) INTEGER I, J LOGICAL*1 BUF(100), OUT(100) J = 1 23000 IF (.NOT.(BUF(I) .NE. 0 ))GOTO 23002 IF (.NOT.( BUF(I) .EQ. 96 ))GOTO 23003 GOTO 23002 23003 CONTINUE OUT(J) = BUF(I) 23004 CONTINUE 23001 I = I + 1 J = J + 1 GOTO 23000 23002 CONTINUE IF (.NOT.( BUF(I) .NE. 0 ))GOTO 23005 I = I + 1 23005 CONTINUE OUT(J) = 0 CALL FOLD(OUT) AFETCH=( J - 1 ) RETURN END LOGICAL*1 FUNCTION AGETCH(C, FD, SIZE) LOGICAL*1 C INTEGER FD INTEGER SIZE(2) LOGICAL*1 GETCH IF (.NOT.( SIZE(1) .LE. 0 .AND. SIZE(2) .LE. 0 ))GOTO 23007 C = -1 GOTO 23008 23007 CONTINUE IF (.NOT.( GETCH( C, FD) .EQ. -1 ))GOTO 23009 SIZE(1) = 0 SIZE(2) = 0 GOTO 23010 23009 CONTINUE SIZE(2) = SIZE(2) - 1 IF (.NOT.( SIZE(2) .LT. 0 ))GOTO 23011 SIZE(1) = SIZE(1) - 1 SIZE(2) = SIZE(2) + 10000 23011 CONTINUE 23010 CONTINUE 23008 CONTINUE AGETCH=(C) RETURN END INTEGER FUNCTION AGETHD(FD, BUF, SIZE, FSIZE) INTEGER FD LOGICAL*1 BUF(512) INTEGER SIZE(2), FSIZE(2) INTEGER I INTEGER AGTLIN, INDEXC LOGICAL*1 HDR(6) DATA HDR(1)/35/,HDR(2)/45/,HDR(3)/104/,HDR(4)/45/,HDR(5)/32/,HDR(6 *)/0/ IF (.NOT.( AGTLIN( BUF, FD, FSIZE) .EQ. -1 ))GOTO 23013 AGETHD=(-1) RETURN 23013 CONTINUE I = 1 23015 IF (.NOT.(HDR(I) .NE. 0 ))GOTO 23017 IF (.NOT.( BUF(I) .NE. HDR(I) ))GOTO 23018 GOTO 23017 23018 CONTINUE 23016 I = I + 1 GOTO 23015 23017 CONTINUE IF (.NOT.( HDR(I) .NE. 0 ))GOTO 23020 AGETHD=(-3) RETURN 23020 CONTINUE CALL SKIPBL( BUF, I) CALL SCOPY( BUF, I, BUF, 1) I = INDEXC( BUF, 32) BUF(I) = 0 CALL FOLD(BUF) I = I + 1 CALL CTODI( BUF, I, SIZE) AGETHD=(0) RETURN END INTEGER FUNCTION AGTLIN(BUF, FD, SIZE) LOGICAL*1 BUF(512) INTEGER FD INTEGER SIZE(2), N INTEGER GETLIN IF (.NOT.( SIZE(1) .LE. 0 .AND. SIZE(2) .LE. 0 ))GOTO 23022 AGTLIN=(-1) RETURN 23022 CONTINUE N = GETLIN( BUF, FD) IF (.NOT.( N .EQ. -1 ))GOTO 23024 SIZE(1) = 0 SIZE(2) = 0 GOTO 23025 23024 CONTINUE SIZE(2) = SIZE(2) - N IF (.NOT.( SIZE(2) .LT. 0 ))GOTO 23026 SIZE(1) = SIZE(1) - 1 SIZE(2) = SIZE(2) + 10000 23026 CONTINUE 23025 CONTINUE AGTLIN=(N) RETURN END INTEGER FUNCTION AOPEN( NAME, FD, SIZE) LOGICAL*1 NAME(40), FILE(40), MODULE(40), BUF(512) INTEGER I, FSIZE(2), SIZE(2) INTEGER AFETCH, AGETHD, EQUAL INTEGER FD INTEGER OPEN I = 1 IF (.NOT.( AFETCH( NAME, I, FILE) .LE. 0 ))GOTO 23028 AOPEN=(-3) RETURN 23028 CONTINUE FD = OPEN( FILE, 1) IF (.NOT.( FD .EQ. -3 ))GOTO 23030 AOPEN=(-3) RETURN 23030 CONTINUE FSIZE(1) = 32767 FSIZE(2) = 0 IF (.NOT.( AFETCH( NAME, I, MODULE) .LE. 0))GOTO 23032 SIZE(1) = 32767 SIZE(2) = 0 AOPEN=(FD) RETURN 23032 CONTINUE 23034 IF (.NOT.( AGETHD( FD, BUF, SIZE, FSIZE) .EQ. 0 ))GOTO 23035 IF (.NOT.( EQUAL( BUF, MODULE) .EQ. 1 ))GOTO 23036 IF (.NOT.( AFETCH( NAME, I, MODULE) .LE. 0 ))GOTO 23038 AOPEN=(FD) RETURN 23038 CONTINUE FSIZE(1) = SIZE(1) FSIZE(2) = SIZE(2) GOTO 23037 23036 CONTINUE CALL ASKIP( FD, SIZE, FSIZE) 23037 CONTINUE GOTO 23034 23035 CONTINUE CALL CLOSE(FD) AOPEN=(-3) RETURN END SUBROUTINE ASKIP( FD, SIZE, FSIZE) INTEGER FD INTEGER SIZE(2), FSIZE(2) LOGICAL*1 C LOGICAL*1 AGETCH 23040 IF (.NOT.( .NOT.( SIZE(1) .LE. 0 .AND. SIZE(2) .LE. 0 ) ))GOTO 230 *41 IF (.NOT.( AGETCH( C, FD, FSIZE) .EQ. -1 ))GOTO 23042 GOTO 23041 23042 CONTINUE SIZE(2) = SIZE(2) - 1 IF (.NOT.( SIZE(2) .LT. 0 ))GOTO 23044 SIZE(1) = SIZE(1) - 1 SIZE(2) = SIZE(2) + 10000 23044 CONTINUE GOTO 23040 23041 CONTINUE RETURN END SUBROUTINE DSINIT(W) INTEGER W INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER T IF (.NOT.( W .LT. 2 * 2 + 2 ))GOTO 23000 CALL ERROR( 42Hin dsinit: unreasonably small memory size. ) 23000 CONTINUE T = 2 MEM( T + 0 ) = 0 MEM( T + 1 ) = 2 + 2 T = 2 + 2 MEM( T + 0 ) = W - 2 - 1 MEM( T + 1 ) = 0 MEM( 1 ) = W RETURN END SUBROUTINE DSFREE(BLOCK) INTEGER BLOCK INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER P0, P, Q INTEGER N P0 = BLOCK - 2 N = MEM( P0 + 0 ) Q = 2 23002 CONTINUE P = MEM( Q + 1 ) IF (.NOT.( P .EQ. 0 .OR. P .GT. P0 ))GOTO 23005 GOTO 23004 23005 CONTINUE Q = P 23003 GOTO 23002 23004 CONTINUE IF (.NOT.( Q + MEM( Q + 0 ) .GT. P0 ))GOTO 23007 CALL REMARK( 46Hin dsfree: attempt to free unallocated block. ) RETURN 23007 CONTINUE IF (.NOT.( P0 + N .EQ. P .AND. P .NE. 0 ))GOTO 23009 N = N + MEM( P + 0 ) MEM( P0 + 1 ) = MEM( P + 1 ) GOTO 23010 23009 CONTINUE MEM( P0 + 1 ) = P 23010 CONTINUE IF (.NOT.( Q + MEM( Q + 0 ) .EQ. P0 ))GOTO 23011 MEM( Q + 0 ) = MEM( Q + 0 ) + N MEM( Q + 1 ) = MEM( P0 + 1 ) GOTO 23012 23011 CONTINUE MEM( Q + 1 ) = P0 MEM( P0 + 0 ) = N 23012 CONTINUE RETURN END INTEGER FUNCTION DSGET(W) INTEGER W INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER P, Q, L INTEGER N, K N = W + 2 Q = 2 23013 CONTINUE P = MEM( Q + 1 ) IF (.NOT.( P .EQ. 0 ))GOTO 23016 DSGET=(P) RETURN 23016 CONTINUE IF (.NOT.( MEM( P + 0 ) .GE. N ))GOTO 23018 GOTO 23015 23018 CONTINUE Q = P 23014 GOTO 23013 23015 CONTINUE K = MEM( P + 0 ) - N IF (.NOT.( K .GE. 8 ))GOTO 23020 MEM( P + 0 ) = K L = P + K MEM( L + 0 ) = N GOTO 23021 23020 CONTINUE MEM( Q + 1 ) = MEM( P + 1 ) L = P 23021 CONTINUE DSGET=( L + 2 ) RETURN END SUBROUTINE DSDUMP(FORM) LOGICAL*1 FORM INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER P, T, Q T = 2 CALL REMARK( 27H** DYNAMIC STORAGE DUMP **. ) CALL PUTINT( 1, 5, 3) CALL PUTCH( 32, 3) CALL PUTINT( 2 + 1, 0, 3) CALL REMARK( 14H words in use. ) P = MEM( T + 1 ) 23022 IF (.NOT.( P .NE. 0 ))GOTO 23023 CALL PUTINT( P, 5, 3) CALL PUTCH( 32, 3) CALL PUTINT( MEM( P + 0 ), 0, 3) CALL REMARK( 17H words available. ) Q = P + MEM( P + 0 ) 23024 IF (.NOT.( Q .NE. MEM( P + 1 ) .AND. Q .LT. MEM( 1 ) ))GOTO 23025 CALL DSDBIU( Q, FORM) GOTO 23024 23025 CONTINUE P = MEM( P + 1 ) GOTO 23022 23023 CONTINUE CALL REMARK( 15H** END DUMP **. ) RETURN END SUBROUTINE DSDBIU( B, FORM) INTEGER B LOGICAL*1 FORM INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER L, S, LMAX, T, J LOGICAL*1 BLANKS(11) DATA BLANKS(1)/32/,BLANKS(2)/32/,BLANKS(3)/32/,BLANKS(4)/32/,BLANK *S(5)/32/,BLANKS(6)/32/,BLANKS(7)/32/,BLANKS(8)/32/,BLANKS(9)/32/,B *LANKS(10)/32/,BLANKS(11)/0/ CALL PUTINT( B, 5, 3) CALL PUTCH( 32, 3) CALL PUTINT( MEM( B + 0 ), 0, 3) CALL REMARK( 14H words in use. ) L = 0 S = B + MEM( B + 0 ) IF (.NOT.( FORM .EQ. 2 ))GOTO 23026 LMAX = 5 GOTO 23027 23026 CONTINUE LMAX = 50 23027 CONTINUE B = B + 2 23028 IF (.NOT.(B .LT. S ))GOTO 23030 IF (.NOT.( L .EQ. 0 ))GOTO 23031 CALL PUTLIN( BLANKS, 3) 23031 CONTINUE IF (.NOT.( FORM .EQ. 2 ))GOTO 23033 CALL PUTINT( MEM(B), 10, 3) L = L + 1 GOTO 23034 23033 CONTINUE IF (.NOT.( FORM .EQ. 1 ))GOTO 23035 T = (2*(B-1)+1) J = 1 23037 IF (.NOT.(J .LE. 2 ))GOTO 23039 CALL PUTCH( CMEM(T), 3) T = T + 1 23038 J = J + 1 GOTO 23037 23039 CONTINUE L = L + 2 23035 CONTINUE 23034 CONTINUE IF (.NOT.( L .GE. LMAX ))GOTO 23040 L = 0 CALL PUTCH( 10, 3) 23040 CONTINUE 23029 B = B + 1 GOTO 23028 23030 CONTINUE IF (.NOT.( L .NE. 0 ))GOTO 23042 CALL PUTCH( 10, 3) 23042 CONTINUE RETURN END INTEGER FUNCTION MKTABL(NODSIZ) INTEGER NODSIZ INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER ST INTEGER DSGET INTEGER I ST = DSGET( 29 + 3 ) MKTABL = ST IF (.NOT.( ST .NE. 0 ))GOTO 23044 MEM(ST) = NODSIZ I = 1 23046 IF (.NOT.(I .LE. 29 ))GOTO 23048 ST = ST + 1 MEM(ST) = 0 23047 I = I + 1 GOTO 23046 23048 CONTINUE 23044 CONTINUE RETURN END SUBROUTINE RMTABL(ST) INTEGER ST INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER I INTEGER BUCKET, NODE, WALKER BUCKET = ST I = 1 23049 IF (.NOT.(I .LE. 29 ))GOTO 23051 BUCKET = BUCKET + 1 WALKER = MEM(BUCKET) 23052 IF (.NOT.( WALKER .NE. 0 ))GOTO 23053 NODE = WALKER WALKER = MEM( NODE + 0 ) CALL DSFREE(NODE) GOTO 23052 23053 CONTINUE 23050 I = I + 1 GOTO 23049 23051 CONTINUE CALL DSFREE(ST) RETURN END INTEGER FUNCTION SCTABL(TABLE, SYM, INFO, POSN) INTEGER POSN, TABLE LOGICAL*1 SYM(100) INTEGER INFO(100) INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER BUCKET, WALKER INTEGER NODSIZ, I, J IF (.NOT.( POSN .EQ. 0 ))GOTO 23054 POSN = TABLE + 30 MEM(POSN) = 1 MEM( POSN + 1 ) = MEM( TABLE + 1 ) 23054 CONTINUE BUCKET = MEM(POSN) WALKER = MEM( POSN + 1 ) NODSIZ = MEM(TABLE) 23056 CONTINUE IF (.NOT.( WALKER .NE. 0 ))GOTO 23059 I = WALKER + 1 + NODSIZ I = (2*(I-1)+1) J = 1 23061 IF (.NOT.( CMEM(I) .NE. 0 ))GOTO 23062 SYM(J) = CMEM(I) I = I + 1 J = J + 1 GOTO 23061 23062 CONTINUE SYM(J) = 0 J = WALKER + 1 I = 1 23063 IF (.NOT.(I .LE. NODSIZ ))GOTO 23065 INFO(I) = MEM(J) J = J + 1 23064 I = I + 1 GOTO 23063 23065 CONTINUE MEM(POSN) = BUCKET MEM( POSN + 1 ) = MEM( WALKER + 0 ) SCTABL=(1) RETURN 23059 CONTINUE BUCKET = BUCKET + 1 IF (.NOT.( BUCKET .GT. 29 ))GOTO 23066 GOTO 23058 23066 CONTINUE J = TABLE + BUCKET WALKER = MEM(J) 23060 CONTINUE 23057 GOTO 23056 23058 CONTINUE POSN = 0 SCTABL=(-1) RETURN END INTEGER FUNCTION STLU( SYMBOL, NODE, PRED, ST) LOGICAL*1 SYMBOL(100) INTEGER NODE, PRED, ST INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER HASH, I, J, NODSIZ INTEGER EQUAL NODSIZ = MEM(ST) HASH = 0 I = 1 23068 IF (.NOT.(SYMBOL(I) .NE. 0 ))GOTO 23070 HASH = HASH + SYMBOL(I) 23069 I = I + 1 GOTO 23068 23070 CONTINUE HASH = MOD( HASH, 29 ) + 1 PRED = ST + HASH NODE = MEM(PRED) 23071 IF (.NOT.( NODE .NE. 0 ))GOTO 23072 I = 1 J = NODE + 1 + NODSIZ J = (2*(J-1)+1) 23073 IF (.NOT.( SYMBOL(I) .EQ. CMEM(J) ))GOTO 23074 IF (.NOT.( SYMBOL(I) .EQ. 0 ))GOTO 23075 STLU=(1) RETURN 23075 CONTINUE I = I + 1 J = J + 1 GOTO 23073 23074 CONTINUE PRED = NODE NODE = MEM( PRED + 0 ) GOTO 23071 23072 CONTINUE STLU=(0) RETURN END SUBROUTINE DELETE( SYMBOL, ST) LOGICAL*1 SYMBOL(100) INTEGER ST INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER STLU INTEGER NODE, PRED IF (.NOT.( STLU( SYMBOL, NODE, PRED, ST) .EQ. 1 ))GOTO 23077 MEM( PRED + 0 ) = MEM( NODE + 0 ) CALL DSFREE(NODE) 23077 CONTINUE RETURN END INTEGER FUNCTION LOOKUP(SYMBOL, INFO, ST) LOGICAL*1 SYMBOL(100) INTEGER INFO(100) INTEGER ST INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER I, NODSIZ, KLUGE INTEGER STLU INTEGER NODE, PRED IF (.NOT.( STLU( SYMBOL, NODE, PRED, ST) .EQ. 0 ))GOTO 23079 LOOKUP=(0) RETURN 23079 CONTINUE NODSIZ = MEM(ST) KLUGE = NODE + 1 I = 1 23081 IF (.NOT.(I .LE. NODSIZ ))GOTO 23083 INFO(I) = MEM(KLUGE) KLUGE = KLUGE + 1 23082 I = I + 1 GOTO 23081 23083 CONTINUE LOOKUP=(1) RETURN END INTEGER FUNCTION ENTER(SYMBOL, INFO, ST) LOGICAL*1 SYMBOL(100) INTEGER INFO(100) INTEGER ST INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER I, NODSIZ, J INTEGER STLU, LENGTH INTEGER NODE, PRED INTEGER DSGET NODSIZ = MEM(ST) IF (.NOT.( STLU( SYMBOL, NODE, PRED, ST) .EQ. 0 ))GOTO 23084 NODE = DSGET( 1 + NODSIZ + ( LENGTH(SYMBOL) + 2 ) / 2 ) IF (.NOT.( NODE .EQ. 0 ))GOTO 23086 ENTER=(-3) RETURN 23086 CONTINUE MEM( NODE + 0 ) = 0 MEM( PRED + 0 ) = NODE I = 1 J = NODE + 1 + NODSIZ J = (2*(J-1)+1) 23088 IF (.NOT.( SYMBOL(I) .NE. 0 ))GOTO 23089 CMEM(J) = SYMBOL(I) I = I + 1 J = J + 1 GOTO 23088 23089 CONTINUE CMEM(J) = 0 23084 CONTINUE J = NODE + 1 I = 1 23090 IF (.NOT.(I .LE. NODSIZ ))GOTO 23092 MEM(J) = INFO(I) J = J + 1 23091 I = I + 1 GOTO 23090 23092 CONTINUE ENTER=(0) RETURN END INTEGER FUNCTION SDUPL(STR) LOGICAL*1 STR(100) INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER I, K INTEGER LENGTH INTEGER J INTEGER DSGET J = DSGET( ( LENGTH(STR) + 2 ) / 2 ) SDUPL = J IF (.NOT.( J .NE. 0 ))GOTO 23093 K = (2*(J-1)+1) I = 1 23095 IF (.NOT.(STR(I) .NE. 0 ))GOTO 23097 CMEM(K) = STR(I) K = K + 1 23096 I = I + 1 GOTO 23095 23097 CONTINUE CMEM(K) = 0 23093 CONTINUE RETURN END SUBROUTINE ENTDEF( NAME, DEFN, TABLE) LOGICAL*1 NAME(100), DEFN(100) INTEGER TABLE INTEGER LOOKUP, ENTER INTEGER TEXT INTEGER SDUPL IF (.NOT.( LOOKUP( NAME, TEXT, TABLE) .EQ. 1 ))GOTO 23098 CALL DSFREE(TEXT) 23098 CONTINUE TEXT = SDUPL(DEFN) IF (.NOT.( TEXT .NE. 0 ))GOTO 23100 IF (.NOT.( ENTER( NAME, TEXT, TABLE) .EQ. 0 ))GOTO 23102 RETURN 23102 CONTINUE CALL DSFREE(TEXT) 23103 CONTINUE 23100 CONTINUE CALL REMARK( 38Hin entdef: no room for new definition. ) RETURN END INTEGER FUNCTION LUDEF( ID, DEFN, TABLE) LOGICAL*1 ID(100), DEFN(100) INTEGER TABLE INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER I, J INTEGER LOOKUP INTEGER LOCN LUDEF = LOOKUP( ID, LOCN, TABLE) IF (.NOT.( LUDEF .EQ. 1 ))GOTO 23104 I = 1 J = (2*(LOCN-1)+1) 23106 IF (.NOT.(CMEM(J) .NE. 0 ))GOTO 23108 DEFN(I) = CMEM(J) I = I + 1 23107 J = J + 1 GOTO 23106 23108 CONTINUE DEFN(I) = 0 GOTO 23105 23104 CONTINUE DEFN(1) = 0 23105 CONTINUE RETURN END INTEGER FUNCTION PHELP0( FD, BUF, NAME, SIZE) LOGICAL*1 BUF(512), C, NAME(40) INTEGER CTOI, EQUAL, GETLIN, GETWRD INTEGER FD, I, LEN, SIZE LOGICAL*1 HDR(5) DATA HDR(1)/35/,HDR(2)/45/,HDR(3)/104/,HDR(4)/45/,HDR(5)/0/ IF (.NOT.( GETLIN( BUF, FD) .EQ. -1 ))GOTO 23000 PHELP0=(-1) RETURN 23000 CONTINUE I = 1 LEN = GETWRD( BUF, I, NAME) IF (.NOT.( EQUAL( NAME, HDR) .EQ. 0 ))GOTO 23002 PHELP0=(-3) RETURN 23002 CONTINUE LEN = GETWRD( BUF, I, NAME) SIZE = CTOI( BUF, I) CALL FOLD(NAME) PHELP0=(1) RETURN END INTEGER FUNCTION INIHLP( FILE, PTRARA, PTRSIZ, FD) INTEGER FD INTEGER I, PTRSIZ, JUNK INTEGER*4 PTRARA(PTRSIZ) LOGICAL*1 FILE(40) INTEGER PHELP0, OPEN, NOTE COMMON/CHELP/SIZE,NAME(40),BUF(512) INTEGER SIZE LOGICAL*1 NAME,BUF CALL CLOSE(FD) FD = OPEN( FILE, 1) IF (.NOT.( FD .NE. -3 ))GOTO 23004 I = 1 23006 IF (.NOT.(I .LT. PTRSIZ ))GOTO 23008 JUNK = NOTE ( PTRARA(I), FD ) IF (.NOT.( PHELP0( FD, BUF, NAME, SIZE) .NE. 1 ))GOTO 23009 GOTO 23008 23009 CONTINUE CALL FSKIP( FD, SIZE) 23007 I = I + 1 GOTO 23006 23008 CONTINUE CALL PTRCPY( 0, PTRARA(I) ) INIHLP=(0) RETURN 23004 CONTINUE INIHLP=(-3) RETURN 23005 CONTINUE END INTEGER FUNCTION MRKHLP( FD, PTRARA, KEY, OUTARA) INTEGER FD INTEGER J, I, JUNK, DOALL INTEGER EQUAL, PHELP0, PTREQ INTEGER*4 PTRARA(100), OUTARA(100) LOGICAL*1 KEY(100) COMMON/CHELP/SIZE,NAME(40),BUF(512) INTEGER SIZE LOGICAL*1 NAME,BUF LOGICAL*1 SUMMAR(2) LOGICAL*1 ALL(2) DATA SUMMAR(1)/37/,SUMMAR(2)/0/ DATA ALL(1)/63/,ALL(2)/0/ IF (.NOT.( EQUAL( KEY, SUMMAR) .EQ. 1 .OR. EQUAL( KEY, ALL) .EQ. 1 * ))GOTO 23011 DOALL = 1 GOTO 23012 23011 CONTINUE DOALL = 0 23012 CONTINUE J = 1 I = 1 23013 IF (.NOT.(PTREQ( PTRARA(I), 0) .EQ. 0 ))GOTO 23015 CALL SEEK( PTRARA(I), FD) JUNK = PHELP0( FD, BUF, NAME, SIZE) IF (.NOT.( DOALL .EQ. 1 .OR. EQUAL( NAME, KEY) .EQ. 1 ))GOTO 23016 CALL PTRCPY( PTRARA(I), OUTARA(J) ) J = J + 1 23016 CONTINUE IF (.NOT.( J .GT. 1 .AND. DOALL .EQ. 0 ))GOTO 23018 GOTO 23015 23018 CONTINUE 23014 I = I + 1 GOTO 23013 23015 CONTINUE CALL PTRCPY( 0, OUTARA(J) ) IF (.NOT.( J .GT. 1 ))GOTO 23020 MRKHLP=(0) RETURN 23020 CONTINUE MRKHLP=(-3) RETURN 23021 CONTINUE END SUBROUTINE PUTHLP( FD, OUTARA, KEY, OUT, PUTOUT) LOGICAL*1 KEY(100) INTEGER FD INTEGER DOSUMM, I, JUNK, OUT INTEGER EQUAL, PHELP0, GETLIN, PTREQ INTEGER*4 OUTARA(100) EXTERNAL PUTOUT COMMON/CHELP/SIZE,NAME(40),BUF(512) INTEGER SIZE LOGICAL*1 NAME,BUF LOGICAL*1 SUMMAR(2) DATA SUMMAR(1)/37/,SUMMAR(2)/0/ DOSUMM = EQUAL( KEY, SUMMAR) I = 1 23022 IF (.NOT.(PTREQ( OUTARA(I), 0) .EQ. 0 ))GOTO 23024 CALL SEEK( OUTARA(I), FD) JUNK = PHELP0( FD, BUF, NAME, SIZE) IF (.NOT.( DOSUMM .EQ. 1 ))GOTO 23025 JUNK = GETLIN( BUF, FD) CALL PUTOUT( BUF, OUT) GOTO 23026 23025 CONTINUE SIZE = SIZE - GETLIN( BUF, FD) JUNK = GETLIN( BUF, FD) 23027 IF (.NOT.(SIZE .GT. 0 ))GOTO 23029 CALL PUTOUT( BUF, OUT) SIZE = SIZE - JUNK 23028 JUNK = GETLIN( BUF, FD) GOTO 23027 23029 CONTINUE 23026 CONTINUE 23023 I = I + 1 GOTO 23022 23024 CONTINUE RETURN END INTEGER FUNCTION LOGPMT(PSTR, BUF, FD) LOGICAL*1 PSTR(100), BUF(100) INTEGER FD INTEGER PLOG00 EXTERNAL PROMPT LOGPMT=(PLOG00(PSTR, BUF, FD, PROMPT)) RETURN END INTEGER FUNCTION LEDPMT(PSTR, BUF, FD) LOGICAL*1 PSTR(100), BUF(100) INTEGER FD INTEGER PLOG00 EXTERNAL LNEDIT LEDPMT=(PLOG00(PSTR, BUF, FD, LNEDIT)) RETURN END INTEGER FUNCTION PLOG00( PSTR, LIN, INT, PMTRTN) LOGICAL*1 C, LIN(100), PSTR(100) LOGICAL*1 CLOWER INTEGER ACCESS, I, INT, JUNK, K, NOFILE INTEGER PLOG03, EDLINE, EQUAL, INDEXC, PMTRTN EXTERNAL PMTRTN COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER LOGICAL*1 NULL(1) LOGICAL*1 WHITES(4) DATA NULL(1)/0/ DATA WHITES(1)/32/,WHITES(2)/9/,WHITES(3)/10/,WHITES(4)/0/ DATA NOFILE / 1 / IF (.NOT.( NOFILE .EQ. 1 ))GOTO 23000 NOFILE = 0 CALL PLOG21 23000 CONTINUE 23002 CONTINUE K = PMTRTN( PSTR, LIN, INT) IF (.NOT.( K .EQ. -1 ))GOTO 23005 CALL STRCPY( NULL, LIN) GOTO 23006 23005 CONTINUE IF (.NOT.( LIN(1) .EQ. 33 ))GOTO 23007 C = CLOWER( LIN(2) ) IF (.NOT.( C .EQ. 104 .OR. C .EQ. 98 ))GOTO 23009 I = 3 23011 IF (.NOT.(((65.LE. LIN(I) .AND. LIN(I) .LE.90).OR.(97.LE. LIN(I) . *AND. LIN(I) .LE.122)) ))GOTO 23013 23012 I = I + 1 GOTO 23011 23013 CONTINUE JUNK = PLOG03( LASTLN, LIN, I) K = -3 GOTO 23010 23009 CONTINUE IF (.NOT.( C .EQ. 119 ))GOTO 23014 I = 3 23016 IF (.NOT.(LIN(I) .NE. 0 ))GOTO 23018 IF (.NOT.( INDEXC( WHITES, LIN(I) ) .GT. 0 ))GOTO 23019 GOTO 23018 23019 CONTINUE 23017 I = I + 1 GOTO 23016 23018 CONTINUE CALL SKIPBL( LIN, I) ACCESS = 2 IF (.NOT.( LIN(I) .EQ. 62 ))GOTO 23021 I = I + 1 IF (.NOT.( LIN(I) .EQ. 62 ))GOTO 23023 I = I + 1 ACCESS = 4 23023 CONTINUE 23021 CONTINUE CALL SCOPY( LIN, I, LIN, 1) I = INDEXC( LIN, 10) IF (.NOT.( I .GT. 0 ))GOTO 23025 LIN(I) = 0 23025 CONTINUE K = -1 GOTO 23015 23014 CONTINUE IF (.NOT.( C .EQ. 113 ))GOTO 23027 CALL STRCPY( NULL, LIN) K = -1 GOTO 23028 23027 CONTINUE K = EDLINE(LIN) CALL PUTLIN( PSTR, 3) CALL PUTLIN( LIN, 3) 23028 CONTINUE 23015 CONTINUE 23010 CONTINUE GOTO 23008 23007 CONTINUE IF (.NOT.( LIN(1) .EQ. 64 .AND. LIN(2) .EQ. 33 ))GOTO 23029 CALL SCOPY( LIN, 2, LIN, 1) K = K - 1 23029 CONTINUE 23008 CONTINUE 23006 CONTINUE 23003 IF (.NOT.( K .NE. -3 ))GOTO 23002 23004 CONTINUE IF (.NOT.( K .NE. -1 ))GOTO 23031 CALL PLOG01(LIN) GOTO 23032 23031 CONTINUE CALL LOGEND( LIN, ACCESS) NOFILE = 1 23032 CONTINUE PLOG00=(K) RETURN END SUBROUTINE PLOG01(LIN) LOGICAL*1 LIN(100) INTEGER JUNK INTEGER PLOG14 IF (.NOT.( LIN(1) .NE. 10 ))GOTO 23033 JUNK = PLOG14(LIN) 23033 CONTINUE RETURN END INTEGER FUNCTION PLOG03( LINE, LIN, I) LOGICAL*1 DIREC, LIN(100) INTEGER CURSCR, I, LIN1, LIN2, LINE, SCREEN INTEGER CTOI, PLOG04 COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER DATA SCREEN, CURSCR / 22, 22 / CALL SKIPBL( LIN, I) IF (.NOT.( LIN(I) .EQ. 10 ))GOTO 23035 SCREEN = CURSCR GOTO 23036 23035 CONTINUE SCREEN = CTOI( LIN, I) - 1 IF (.NOT.( SCREEN .LE. 0 ))GOTO 23037 SCREEN = CURSCR GOTO 23038 23037 CONTINUE CURSCR = SCREEN 23038 CONTINUE 23036 CONTINUE LIN1 = LINE - SCREEN LIN2 = LINE LIN1 = MAX0( FRSTLN + 1, LIN1) LIN2 = MIN0( LIN2, LASTLN) PLOG03 = PLOG04( LIN1, LIN2, LIN(I) ) RETURN END INTEGER FUNCTION PLOG04( FROM, TO, CH) INTEGER PLOG12 INTEGER FROM, I, J, TO, K, NUM, XPAND LOGICAL*1 C, CH COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG04/TXT(512) LOGICAL*1 TXT XPAND = 0 IF (.NOT.( CH .EQ. 108 .OR. CH .EQ. 76 ))GOTO 23039 XPAND = 1 23039 CONTINUE I = FROM 23041 IF (.NOT.(I .LE. TO ))GOTO 23043 J = PLOG12(I) CALL PLOG06( J, 4, NUM) CALL PUTINT( NUM, 3, 2) CALL PUTCH( 32, 2) K = 1 23044 IF (.NOT.(TXT(K) .NE. 0 ))GOTO 23046 IF (.NOT.( TXT(K) .GE. 32 .OR. TXT(K) .EQ. 10 ))GOTO 23047 CALL PUTCH( TXT(K), 2) GOTO 23048 23047 CONTINUE IF (.NOT.( XPAND .EQ. 0 ))GOTO 23049 CALL PUTCH( TXT(K), 2) GOTO 23050 23049 CONTINUE CALL PUTCH( 94, 2) C = TXT(K) + 64 CALL PUTCH( C, 2) 23050 CONTINUE 23048 CONTINUE 23045 K = K + 1 GOTO 23044 23046 CONTINUE 23042 I = I + 1 GOTO 23041 23043 CONTINUE CURLN = TO PLOG04 = 0 RETURN END INTEGER FUNCTION EDLINE(LIN) LOGICAL*1 LIN(100), SUB(132) INTEGER FINAL, GFLAG, I, JUNK, LINSTS, STATUS INTEGER PLOG08, PLOG11, PLOG12, LENGTH, PLOG16, PLOG22 COMMON/CLOG04/TXT(512) LOGICAL*1 TXT COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER LOGICAL*1 BADLIN(22) LOGICAL*1 BADPAT(24) DATA BADLIN(1)/35/,BADLIN(2)/32/,BADLIN(3)/105/,BADLIN(4)/110/,BAD *LIN(5)/118/,BADLIN(6)/97/,BADLIN(7)/108/,BADLIN(8)/105/,BADLIN(9)/ *100/,BADLIN(10)/32/,BADLIN(11)/108/,BADLIN(12)/105/,BADLIN(13)/110 */,BADLIN(14)/32/,BADLIN(15)/110/,BADLIN(16)/117/,BADLIN(17)/109/,B *ADLIN(18)/98/,BADLIN(19)/101/,BADLIN(20)/114/,BADLIN(21)/10/,BADLI *N(22)/0/ DATA BADPAT(1)/35/,BADPAT(2)/32/,BADPAT(3)/105/,BADPAT(4)/110/,BAD *PAT(5)/118/,BADPAT(6)/97/,BADPAT(7)/108/,BADPAT(8)/105/,BADPAT(9)/ *100/,BADPAT(10)/32/,BADPAT(11)/115/,BADPAT(12)/117/,BADPAT(13)/98/ *,BADPAT(14)/115/,BADPAT(15)/116/,BADPAT(16)/105/,BADPAT(17)/116/,B *ADPAT(18)/117/,BADPAT(19)/116/,BADPAT(20)/105/,BADPAT(21)/111/,BAD *PAT(22)/110/,BADPAT(23)/10/,BADPAT(24)/0/ I = 2 STATUS = 0 IF (.NOT.( PLOG08( LIN, I, LINSTS) .EQ. 0 ))GOTO 23051 IF (.NOT.( LINE2 .EQ. FRSTLN ))GOTO 23053 LINSTS = -3 GOTO 23054 23053 CONTINUE IF (.NOT.( LIN(I) .EQ. 115 .OR. LIN(I) .EQ. 83 ))GOTO 23055 STATUS = -3 I = I + 1 IF (.NOT.( PLOG16( LIN, I, 1 ) .EQ. 0 ))GOTO 23057 IF (.NOT.( PLOG11( LIN, I, SUB, GFLAG) .EQ. 0 ))GOTO 23059 JUNK = PLOG12(LINE2) STATUS = PLOG22( TXT, LIN, SUB, GFLAG) 23059 CONTINUE 23057 CONTINUE GOTO 23056 23055 CONTINUE JUNK = PLOG12(LINE2) CALL STRCPY( TXT, LIN) 23056 CONTINUE 23054 CONTINUE 23051 CONTINUE IF (.NOT.( LINSTS .EQ. -3 ))GOTO 23061 FINAL = -3 CALL STRCPY( BADLIN, LIN) GOTO 23062 23061 CONTINUE IF (.NOT.( STATUS .EQ. -3 ))GOTO 23063 FINAL = -3 CALL STRCPY( BADPAT, LIN) GOTO 23064 23063 CONTINUE FINAL = LENGTH(LIN) 23064 CONTINUE 23062 CONTINUE CURLN = LASTLN EDLINE=(FINAL) RETURN END SUBROUTINE PLOG06( INDEXC, TYPE, VALUE) INTEGER INDEXC, TYPE INTEGER VALUE(2) COMMON/CLOG00/BUF(135),LASTBF INTEGER BUF,LASTBF IF (.NOT.( TYPE .EQ. 0 ))GOTO 23065 VALUE(1) = BUF(INDEXC) GOTO 23066 23065 CONTINUE IF (.NOT.( TYPE .EQ. 1 ))GOTO 23067 VALUE(1) = BUF( INDEXC + 1 ) GOTO 23068 23067 CONTINUE IF (.NOT.( TYPE .EQ. 3 ))GOTO 23069 VALUE(1) = BUF( INDEXC + 2 ) VALUE(2) = BUF( INDEXC + 3 ) GOTO 23070 23069 CONTINUE IF (.NOT.( TYPE .EQ. 4 ))GOTO 23071 VALUE(1) = BUF( INDEXC + 4 ) 23071 CONTINUE 23070 CONTINUE 23068 CONTINUE 23066 CONTINUE RETURN END INTEGER FUNCTION PLOG07(LIN) INTEGER LIN, K, J COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER K = 1 J = FRSTLN 23073 IF (.NOT.(J .LT. LIN ))GOTO 23075 CALL PLOG06( K, 1, K) 23074 J = J + 1 GOTO 23073 23075 CONTINUE PLOG07=(K) RETURN END INTEGER FUNCTION PLOG08( LIN, I, STATUS) LOGICAL*1 LIN(512) INTEGER PLOG10 INTEGER I, NUM, STATUS COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER LINE2 = 0 NLINES = 0 23076 IF (.NOT.(PLOG10( LIN, I, NUM, STATUS) .EQ. 0 ))GOTO 23078 LINE1 = LINE2 LINE2 = NUM NLINES = NLINES + 1 IF (.NOT.( LIN(I) .NE. 44 .AND. LIN(I) .NE. 59 ))GOTO 23079 GOTO 23078 23079 CONTINUE IF (.NOT.( LIN(I) .EQ. 59 ))GOTO 23081 CURLN = NUM 23081 CONTINUE I = I + 1 23077 GOTO 23076 23078 CONTINUE NLINES = MIN0( NLINES, 2) IF (.NOT.( NLINES .EQ. 0 ))GOTO 23083 LINE2 = CURLN 23083 CONTINUE IF (.NOT.( NLINES .LE. 1 ))GOTO 23085 LINE1 = LINE2 23085 CONTINUE IF (.NOT.( STATUS .NE. -3 ))GOTO 23087 STATUS = 0 23087 CONTINUE PLOG08 = STATUS RETURN END INTEGER FUNCTION PLOG09( LIN, I, PNUM, STATUS) LOGICAL*1 LIN(512) INTEGER CTOI, INDEXC, PLOG15, PLOG16, PLOG17, PLOG18 INTEGER I, PNUM, STATUS COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG02/PAT(132) LOGICAL*1 PAT LOGICAL*1 DIGITS(11) 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/ PLOG09 = 0 IF (.NOT.( INDEXC( DIGITS, LIN(I) ) .GT. 0 ))GOTO 23089 PNUM = CTOI( LIN, I) I = I - 1 GOTO 23090 23089 CONTINUE IF (.NOT.( LIN(I) .EQ. 46 ))GOTO 23091 PNUM = CURLN GOTO 23092 23091 CONTINUE IF (.NOT.( LIN(I) .EQ. 36 ))GOTO 23093 PNUM = LASTLN GOTO 23094 23093 CONTINUE IF (.NOT.( LIN(I) .EQ. 45 ))GOTO 23095 PNUM = PLOG17(CURLN) GOTO 23096 23095 CONTINUE IF (.NOT.( LIN(I) .EQ. 43 ))GOTO 23097 PNUM = PLOG15(CURLN) GOTO 23098 23097 CONTINUE IF (.NOT.( LIN(I) .EQ. 47 .OR. LIN(I) .EQ. 92 ))GOTO 23099 IF (.NOT.( PLOG16( LIN, I, 0 ) .EQ. -3 ))GOTO 23101 PLOG09 = -3 GOTO 23102 23101 CONTINUE IF (.NOT.( LIN(I) .EQ. 47 ))GOTO 23103 PLOG09 = PLOG18( 43, PNUM) GOTO 23104 23103 CONTINUE PLOG09 = PLOG18( 45, PNUM) 23104 CONTINUE 23102 CONTINUE GOTO 23100 23099 CONTINUE PLOG09 = -1 23100 CONTINUE 23098 CONTINUE 23096 CONTINUE 23094 CONTINUE 23092 CONTINUE 23090 CONTINUE IF (.NOT.( PLOG09 .EQ. 0 ))GOTO 23105 I = I + 1 23105 CONTINUE STATUS = PLOG09 RETURN END INTEGER FUNCTION PLOG10( LIN, I, NUM, STATUS) LOGICAL*1 LIN(512) INTEGER PLOG09 INTEGER I, ISTART, MUL, NUM, PNUM, STATUS COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER ISTART = I NUM = FRSTLN CALL SKIPBL( LIN, I) IF (.NOT.( PLOG09( LIN, I, NUM, STATUS) .EQ. 0 ))GOTO 23107 23109 CONTINUE CALL SKIPBL( LIN, I) IF (.NOT.( LIN(I) .NE. 43 .AND. LIN(I) .NE. 45 ))GOTO 23112 STATUS = -1 GOTO 23111 23112 CONTINUE IF (.NOT.( LIN(I) .EQ. 43 ))GOTO 23114 MUL = +1 GOTO 23115 23114 CONTINUE MUL = -1 23115 CONTINUE I = I + 1 CALL SKIPBL( LIN, I) IF (.NOT.( PLOG09( LIN, I, PNUM, STATUS) .EQ. 0 ))GOTO 23116 NUM = NUM + MUL * PNUM 23116 CONTINUE IF (.NOT.( STATUS .EQ. -1 ))GOTO 23118 STATUS = -3 23118 CONTINUE 23110 IF (.NOT.( STATUS .NE. 0 ))GOTO 23109 23111 CONTINUE 23107 CONTINUE IF (.NOT.( NUM .LT. FRSTLN .OR. NUM .GT. LASTLN ))GOTO 23120 STATUS = -3 23120 CONTINUE IF (.NOT.( STATUS .EQ. -3 ))GOTO 23122 PLOG10 = -3 GOTO 23123 23122 CONTINUE IF (.NOT.( I .LE. ISTART ))GOTO 23124 PLOG10 = -1 GOTO 23125 23124 CONTINUE PLOG10 = 0 23125 CONTINUE 23123 CONTINUE STATUS = PLOG10 RETURN END INTEGER FUNCTION PLOG11( LIN, I, SUB, GFLAG) LOGICAL*1 LIN(512), SUB(132) INTEGER INDEXC, LENGTH, MAKSUB INTEGER GFLAG, I, J LOGICAL*1 CLOWER PLOG11 = -3 IF (.NOT.( LIN(I) .EQ. 0 ))GOTO 23126 RETURN 23126 CONTINUE IF (.NOT.( LIN( I + 1 ) .EQ. 0 ))GOTO 23128 RETURN 23128 CONTINUE IF (.NOT.( INDEXC( LIN( I + 1 ), LIN(I) ) .EQ. 0 ))GOTO 23130 J = LENGTH(LIN) CALL CHCOPY( LIN(I), LIN, J) CALL CHCOPY( 10, LIN, J) 23130 CONTINUE I = MAKSUB( LIN, I + 1, LIN(I), SUB) IF (.NOT.( I .EQ. -3 ))GOTO 23132 RETURN 23132 CONTINUE I = I + 1 IF (.NOT.( CLOWER( LIN(I) ) .EQ. 103 ))GOTO 23134 I = I + 1 GFLAG = 1 GOTO 23135 23134 CONTINUE GFLAG = 0 23135 CONTINUE PLOG11 = 0 RETURN END INTEGER FUNCTION PLOG12(LIN) INTEGER PLOG07, GETLIN INTEGER LIN, LEN, J, K, JUNK INTEGER LOC(2) COMMON/CLOG00/BUF(135),LASTBF INTEGER BUF,LASTBF COMMON/CLOG03/SCR,SCREND(2),SCRFIL(40) INTEGER SCR,SCREND LOGICAL*1 SCRFIL COMMON/CLOG04/TXT(512) LOGICAL*1 TXT COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER LOGICAL*1 NULL(1) DATA NULL(1)/0/ IF (.NOT.( LIN .GT. FRSTLN .AND. LIN .LE. LASTLN ))GOTO 23136 K = PLOG07(LIN) CALL PLOG06( K, 3, LOC) CALL SEEK( LOC, SCR) JUNK = GETLIN( TXT, SCR) GOTO 23137 23136 CONTINUE K = 1 CALL STRCPY( NULL, TXT) 23137 CONTINUE PLOG12 = K RETURN END INTEGER FUNCTION PLOG13(NEWIND) COMMON/CLOG00/BUF(135),LASTBF INTEGER BUF,LASTBF IF (.NOT.( LASTBF + 5 .LT. 135 ))GOTO 23138 NEWIND = LASTBF LASTBF = LASTBF + 5 GOTO 23139 23138 CONTINUE NEWIND = -3 23139 CONTINUE PLOG13 = NEWIND RETURN END INTEGER FUNCTION PLOG14(LIN) LOGICAL*1 LIN(512) INTEGER PLOG13, NOTE INTEGER K1, NEWIND, JUNK COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG03/SCR,SCREND(2),SCRFIL(40) INTEGER SCR,SCREND LOGICAL*1 SCRFIL IF (.NOT.( PLOG13(NEWIND) .EQ. -3 ))GOTO 23140 CALL PLOG06( 1, 1, NEWIND) CALL PLOG06( NEWIND, 1, K1) CALL PLOG19( 1, K1, 1, K1) FRSTLN = FRSTLN + 1 23140 CONTINUE CALL PLOG20( NEWIND, 3, SCREND) CALL SEEK( SCREND, SCR) CALL PUTLIN( LIN, SCR) JUNK = NOTE ( SCREND, SCR) CALL PLOG20( NEWIND, 4, NUMBER) NUMBER = NUMBER + 1 CALL PLOG06( 1, 0, K1) CALL PLOG19( K1, NEWIND, NEWIND, 1) CALL PLOG19( NEWIND, 1, K1, NEWIND) LASTLN = LASTLN + 1 CURLN = LASTLN PLOG14 = 0 RETURN END INTEGER FUNCTION PLOG15(LIN) INTEGER LIN COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER PLOG15 = LIN + 1 IF (.NOT.( PLOG15 .GT. LASTLN ))GOTO 23142 PLOG15 = FRSTLN 23142 CONTINUE RETURN END INTEGER FUNCTION PLOG16( LIN, I, TYPE) LOGICAL*1 LIN(512) INTEGER INDEXC, LENGTH, MAKPAT INTEGER I, J, TYPE COMMON/CLOG02/PAT(132) LOGICAL*1 PAT IF (.NOT.( LIN(I) .EQ. 0 ))GOTO 23144 I = -3 GOTO 23145 23144 CONTINUE IF (.NOT.( LIN( I + 1 ) .EQ. 0 ))GOTO 23146 I = -3 GOTO 23147 23146 CONTINUE IF (.NOT.( TYPE .EQ. 0 ))GOTO 23148 IF (.NOT.( INDEXC( LIN( I + 1 ), LIN(I) ) .EQ. 0 ))GOTO 23150 J = LENGTH(LIN) CALL CHCOPY( LIN(I), LIN, J) CALL CHCOPY( 10, LIN, J) 23150 CONTINUE 23148 CONTINUE IF (.NOT.( LIN( I + 1 ) .EQ. LIN(I) ))GOTO 23152 I = I + 1 GOTO 23153 23152 CONTINUE I = MAKPAT( LIN, I + 1, LIN(I), PAT) 23153 CONTINUE 23147 CONTINUE 23145 CONTINUE IF (.NOT.( PAT(1) .EQ. 0 ))GOTO 23154 I = -3 23154 CONTINUE IF (.NOT.( I .EQ. -3 ))GOTO 23156 PAT(1) = 0 PLOG16 = -3 GOTO 23157 23156 CONTINUE PLOG16 = 0 23157 CONTINUE RETURN END INTEGER FUNCTION PLOG17(LIN) INTEGER LIN COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER PLOG17 = LIN - 1 IF (.NOT.( PLOG17 .LT. FRSTLN ))GOTO 23158 PLOG17 = LASTLN 23158 CONTINUE RETURN END INTEGER FUNCTION PLOG18( WAY, NUM) INTEGER K, NUM, WAY INTEGER PLOG12, MATCH, PLOG15, PLOG17 COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG02/PAT(132) LOGICAL*1 PAT COMMON/CLOG04/TXT(512) LOGICAL*1 TXT NUM = CURLN 23160 CONTINUE IF (.NOT.( WAY .EQ. 43 ))GOTO 23163 NUM = PLOG15(NUM) GOTO 23164 23163 CONTINUE NUM = PLOG17(NUM) 23164 CONTINUE K = PLOG12(NUM) IF (.NOT.( MATCH( TXT, PAT) .EQ. 1 ))GOTO 23165 PLOG18=(0) RETURN 23165 CONTINUE 23161 IF (.NOT.( NUM .EQ. CURLN ))GOTO 23160 23162 CONTINUE PLOG18=(-3) RETURN END SUBROUTINE PLOG19( A, X, Y, B) INTEGER A, B, X, Y CALL PLOG20( X, 0, A) CALL PLOG20( Y, 1, B) RETURN END SUBROUTINE PLOG20( INDEXC, TYPE, VALUE) INTEGER INDEXC, TYPE INTEGER VALUE(2) COMMON/CLOG00/BUF(135),LASTBF INTEGER BUF,LASTBF IF (.NOT.( TYPE .EQ. 0 ))GOTO 23167 BUF(INDEXC) = VALUE(1) GOTO 23168 23167 CONTINUE IF (.NOT.( TYPE .EQ. 1 ))GOTO 23169 BUF( INDEXC + 1 ) = VALUE(1) GOTO 23170 23169 CONTINUE IF (.NOT.( TYPE .EQ. 3 ))GOTO 23171 BUF( INDEXC + 2 ) = VALUE(1) BUF( INDEXC + 3 ) = VALUE(2) GOTO 23172 23171 CONTINUE IF (.NOT.( TYPE .EQ. 4 ))GOTO 23173 BUF( INDEXC + 4 ) = VALUE(1) 23173 CONTINUE 23172 CONTINUE 23170 CONTINUE 23168 CONTINUE RETURN END SUBROUTINE PLOG21 INTEGER CREATE INTEGER PLOG13, NOTE INTEGER JUNK, K COMMON/CLOG00/BUF(135),LASTBF INTEGER BUF,LASTBF COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG03/SCR,SCREND(2),SCRFIL(40) INTEGER SCR,SCREND LOGICAL*1 SCRFIL LOGICAL*1 FIL(4) DATA FIL(1)/108/,FIL(2)/111/,FIL(3)/103/,FIL(4)/0/ CALL SCRATF( FIL, SCRFIL) SCR = CREATE( SCRFIL, 3) IF (.NOT.( SCR .EQ. -3 ))GOTO 23175 CALL CANT(SCRFIL) 23175 CONTINUE JUNK = NOTE ( SCREND, SCR) LASTBF = 1 JUNK = PLOG13(K) CALL PLOG19( K, K, K, K) FRSTLN = 0 CURLN = 0 LASTLN = 0 NUMBER = 1 RETURN END INTEGER FUNCTION PLOG22( OLD, NEW, SUB, GFLAG) LOGICAL*1 NEW(512), OLD(512), SUB(132) INTEGER ADDSET, AMATCH INTEGER GFLAG, J, JUNK, K, LASTM, M, SUBBED COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG02/PAT(132) LOGICAL*1 PAT J = 1 SUBBED = 0 LASTM = 0 K = 1 23177 IF (.NOT.(OLD(K) .NE. 0 ))GOTO 23179 IF (.NOT.( GFLAG .EQ. 1 .OR. SUBBED .EQ. 0 ))GOTO 23180 M = AMATCH( OLD, K, PAT) GOTO 23181 23180 CONTINUE M = 0 23181 CONTINUE IF (.NOT.( M .GT. 0 .AND. LASTM .NE. M ))GOTO 23182 SUBBED = 1 CALL CATSUB( OLD, K, M, SUB, NEW, J, 512) LASTM = M 23182 CONTINUE IF (.NOT.( M .EQ. 0 .OR. M .EQ. K ))GOTO 23184 JUNK = ADDSET( OLD(K), NEW, J, 512) K = K + 1 GOTO 23185 23184 CONTINUE K = M 23185 CONTINUE 23178 GOTO 23177 23179 CONTINUE IF (.NOT.( ADDSET( 0, NEW, J, 512) .EQ. 0 ))GOTO 23186 PLOG22 = -3 GOTO 23187 23186 CONTINUE IF (.NOT.( SUBBED .EQ. 0 ))GOTO 23188 PLOG22 = -3 GOTO 23189 23188 CONTINUE PLOG22 = 0 23189 CONTINUE 23187 CONTINUE RETURN END SUBROUTINE LOGEND( FIL, ACCESS) LOGICAL*1 C, FIL(40) LOGICAL*1 GETCH INTEGER CREATE, OPEN INTEGER ACCESS, OUT, JUNK INTEGER REMOVE COMMON/CLOG03/SCR,SCREND(2),SCRFIL(40) INTEGER SCR,SCREND LOGICAL*1 SCRFIL CALL CLOSE(SCR) IF (.NOT.( FIL(1) .NE. 0 ))GOTO 23190 SCR = OPEN( SCRFIL, 1) IF (.NOT.( SCR .NE. -3 ))GOTO 23192 OUT = CREATE( FIL, ACCESS) IF (.NOT.( OUT .NE. -3 ))GOTO 23194 23196 IF (.NOT.( GETCH( C, SCR) .NE. -1 ))GOTO 23197 CALL PUTCH( C, OUT) GOTO 23196 23197 CONTINUE CALL CLOSE(OUT) 23194 CONTINUE CALL CLOSE(SCR) 23192 CONTINUE 23190 CONTINUE JUNK = REMOVE(SCRFIL) RETURN END INTEGER FUNCTION IMINIT( MEMSIZ, AVETOK) INTEGER MEMSIZ, AVETOK INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER PTRSIZ INTEGER TABLE INTEGER DSGET CALL DSINIT(MEMSIZ) PTRSIZ = 3 + ( MEMSIZ / ( 1 + AVETOK / 2 ) ) TABLE = DSGET(PTRSIZ) IF (.NOT.( TABLE .NE. 0 ))GOTO 23000 MEM( TABLE + 0 ) = TABLE + 3 - 1 MEM( TABLE + 1 ) = TABLE + 3 - 1 MEM( TABLE + 2 ) = TABLE + PTRSIZ - 1 23000 CONTINUE IMINIT=(TABLE) RETURN END INTEGER FUNCTION IMGET( TABLE, BUF) INTEGER TABLE LOGICAL*1 BUF(100) INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER I IF (.NOT.( MEM( TABLE + 1 ) .LT. MEM( TABLE + 0 ) ))GOTO 23002 I = MEM( TABLE + 1 ) + 1 MEM( TABLE + 1 ) = I CALL SCOPY( CMEM, MEM(I), BUF, 1) IMGET=(0) RETURN 23002 CONTINUE IMGET=(-1) RETURN 23003 CONTINUE END SUBROUTINE IMSORT(TABLE) INTEGER TABLE INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER IMCOMP INTEGER I, J, LV(20), P, PIVLIN, UV(20) LV(1) = TABLE + 3 UV(1) = MEM( TABLE + 0 ) P = 1 23004 IF (.NOT.( P .GT. 0 ))GOTO 23005 IF (.NOT.( LV(P) .GE. UV(P) ))GOTO 23006 P = P - 1 GOTO 23007 23006 CONTINUE I = LV(P) - 1 J = UV(P) PIVLIN = MEM(J) 23008 IF (.NOT.( I .LT. J ))GOTO 23009 I = I + 1 23010 IF (.NOT.(IMCOMP( MEM(I), PIVLIN, CMEM) .LT. 0 ))GOTO 23012 23011 I = I + 1 GOTO 23010 23012 CONTINUE J = J - 1 23013 IF (.NOT.(J .GT. I ))GOTO 23015 IF (.NOT.( IMCOMP( MEM(J), PIVLIN, CMEM) .LE. 0 ))GOTO 23016 GOTO 23015 23016 CONTINUE 23014 J = J - 1 GOTO 23013 23015 CONTINUE IF (.NOT.( I .LT. J ))GOTO 23018 CALL IMEXCH( MEM(I), MEM(J), CMEM) 23018 CONTINUE GOTO 23008 23009 CONTINUE J = UV(P) CALL IMEXCH( MEM(I), MEM(J), CMEM) IF (.NOT.( I - LV(P) .LT. UV(P) - I ))GOTO 23020 LV( P + 1 ) = LV(P) UV( P + 1 ) = I - 1 LV(P) = I + 1 GOTO 23021 23020 CONTINUE LV( P + 1 ) = I + 1 UV( P + 1 ) = UV(P) UV(P) = I - 1 23021 CONTINUE P = P + 1 23007 CONTINUE GOTO 23004 23005 CONTINUE RETURN END INTEGER FUNCTION IMPUT( TABLE, BUF) INTEGER TABLE LOGICAL*1 BUF(100) INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER TEXT INTEGER SDUPL INTEGER I IMPUT = -3 IF (.NOT.( MEM( TABLE + 0 ) .LT. MEM( TABLE + 2 ) ))GOTO 23022 TEXT = SDUPL(BUF) IF (.NOT.( TEXT .NE. 0 ))GOTO 23024 I = MEM( TABLE + 0 ) + 1 MEM( TABLE + 0 ) = I MEM(I) = (2*(TEXT-1)+1) IMPUT = 0 23024 CONTINUE 23022 CONTINUE RETURN END SUBROUTINE IMEXCH( LP1, LP2, LINBUF) LOGICAL*1 LINBUF(100) INTEGER K, LP1, LP2 K = LP1 LP1 = LP2 LP2 = K RETURN END INTEGER FUNCTION IMCOMP( I, J, LIN) INTEGER I, J, K, L LOGICAL*1 LIN(100) K = I L = J 23026 IF (.NOT.( LIN(K) .EQ. LIN(L) ))GOTO 23027 IF (.NOT.( LIN(K) .EQ. 0 ))GOTO 23028 IMCOMP=(0) RETURN 23028 CONTINUE K = K + 1 L = L + 1 GOTO 23026 23027 CONTINUE IF (.NOT.( LIN(K) .LT. LIN(L) ))GOTO 23030 IMCOMP=(-1) RETURN 23030 CONTINUE IMCOMP=(1) RETURN 23031 CONTINUE END SUBROUTINE IMUNIQ(TABLE) INTEGER TABLE INTEGER MEM( 1) LOGICAL*1 CMEM(2) EQUIVALENCE (CMEM(1),MEM(1)) COMMON/CDSMEM/MEM INTEGER IMCOMP INTEGER LAST, OUT, CUR, NEXT LAST = MEM(TABLE + 0) OUT = TABLE + 3 CUR = TABLE + 3 23032 IF (.NOT.(CUR .LE. LAST))GOTO 23034 NEXT = CUR + 1 23035 IF (.NOT.(NEXT .LE. LAST))GOTO 23037 IF (.NOT.(IMCOMP(MEM(CUR), MEM(NEXT), CMEM) .NE. 0))GOTO 23038 GOTO 23037 23038 CONTINUE 23036 NEXT = NEXT + 1 GOTO 23035 23037 CONTINUE MEM(OUT) = MEM(CUR) OUT = OUT + 1 23033 CUR = NEXT GOTO 23032 23034 CONTINUE MEM(TABLE + 0) = OUT - 1 RETURN END SUBROUTINE IMRSET(TABLE) INTEGER TABLE INTEGER MEM(1) LOGICAL*1 CMEM(2) EQUIVALENCE (CMEM(1),MEM(1)) COMMON/CDSMEM/MEM MEM (TABLE + 1) = TABLE + 3 - 1 RETURN END SUBROUTINE ACOPY( IFD, OFD, SIZE) LOGICAL*1 GETCH LOGICAL*1 C INTEGER IFD, OFD INTEGER I, SIZE I = 1 23000 IF (.NOT.(I .LE. SIZE ))GOTO 23002 IF (.NOT.( GETCH( C, IFD) .NE. -1 ))GOTO 23003 CALL PUTCH( C, OFD) 23003 CONTINUE 23001 I = I + 1 GOTO 23000 23002 CONTINUE RETURN END INTEGER FUNCTION ADDSET( C, STR, J, MAXSIZ) INTEGER J, MAXSIZ LOGICAL*1 C, STR(MAXSIZ) IF (.NOT.( J .GT. MAXSIZ ))GOTO 23005 ADDSET=(0) RETURN 23005 CONTINUE STR(J) = C J = J + 1 ADDSET=(1) RETURN 23006 CONTINUE END INTEGER FUNCTION ADDSTR(S, STR, J, MAXSIZ) LOGICAL*1 S(100), STR(100) INTEGER J, MAXSIZ, I INTEGER LENGTH IF (.NOT.((LENGTH(S) + J) .GT. MAXSIZ))GOTO 23007 ADDSTR=(0) RETURN 23007 CONTINUE I=1 23009 IF (.NOT.(S(I) .NE. 0))GOTO 23011 CALL CHCOPY(S(I), STR, J) 23010 I=I+1 GOTO 23009 23011 CONTINUE ADDSTR=(1) RETURN END SUBROUTINE ADRFIL(FILE) LOGICAL*1 FILE(40) LOGICAL*1 ADDR(8) DATA ADDR(1)/97/,ADDR(2)/100/,ADDR(3)/100/,ADDR(4)/114/,ADDR(5)/10 *1/,ADDR(6)/115/,ADDR(7)/115/,ADDR(8)/0/ CALL GETDIR( 5, 6, FILE) CALL CONCAT( FILE, ADDR, FILE) RETURN END INTEGER FUNCTION ALLDIG(STR) INTEGER I INTEGER TYPE LOGICAL*1 STR(100) IF (.NOT.( STR(1) .EQ. 0 ))GOTO 23012 ALLDIG=(0) RETURN 23012 CONTINUE I = 1 23014 IF (.NOT.(STR(I) .NE. 0 ))GOTO 23016 IF (.NOT.( TYPE( STR(I) ) .NE. 2 ))GOTO 23017 ALLDIG=(0) RETURN 23017 CONTINUE 23015 I = I + 1 GOTO 23014 23016 CONTINUE ALLDIG=(1) RETURN END SUBROUTINE BADARG(ARG) LOGICAL*1 ARG(100) LOGICAL*1 MSG1(30) LOGICAL*1 MSG2(3) DATA MSG1(1)/63/,MSG1(2)/32/,MSG1(3)/73/,MSG1(4)/103/,MSG1(5)/110/ *,MSG1(6)/111/,MSG1(7)/114/,MSG1(8)/105/,MSG1(9)/110/,MSG1(10)/103/ *,MSG1(11)/32/,MSG1(12)/105/,MSG1(13)/110/,MSG1(14)/118/,MSG1(15)/9 *7/,MSG1(16)/108/,MSG1(17)/105/,MSG1(18)/100/,MSG1(19)/32/,MSG1(20) */97/,MSG1(21)/114/,MSG1(22)/103/,MSG1(23)/117/,MSG1(24)/109/,MSG1( *25)/101/,MSG1(26)/110/,MSG1(27)/116/,MSG1(28)/32/,MSG1(29)/96/,MSG *1(30)/0/ DATA MSG2(1)/39/,MSG2(2)/10/,MSG2(3)/0/ CALL PUTLIN( MSG1, 3) CALL PUTLIN( ARG, 3) CALL PUTLIN( MSG2, 3) RETURN END SUBROUTINE BUBBLE( V, N) INTEGER I, J, K, N, V(100) I = N 23019 IF (.NOT.(I .GT. 1 ))GOTO 23021 J = 1 23022 IF (.NOT.(J .LT. I ))GOTO 23024 IF (.NOT.( V(J) .GT. V( J + 1 ) ))GOTO 23025 K = V(J) V(J) = V( J + 1 ) V( J + 1 ) = K 23025 CONTINUE 23023 J = J + 1 GOTO 23022 23024 CONTINUE 23020 I = I - 1 GOTO 23019 23021 CONTINUE RETURN END INTEGER FUNCTION CTOC(FROM, TO, LEN) INTEGER LEN LOGICAL*1 FROM(100), TO(LEN) INTEGER I I = 1 23027 IF (.NOT.(I .LT. LEN .AND. FROM(I) .NE. 0 ))GOTO 23029 TO(I) = FROM(I) 23028 I = I + 1 GOTO 23027 23029 CONTINUE TO(I) = 0 CTOC=( I - 1 ) RETURN END SUBROUTINE CTODI( BUF, I, DI) LOGICAL*1 BUF(100), HI(10), LO(6), TEMP(20) INTEGER DI(2), I, J, LEN INTEGER CTOI, GETWRD LEN = GETWRD( BUF, I, TEMP) IF (.NOT.( LEN .LE. 4 ))GOTO 23030 HI(1) = 0 CALL STRCPY( TEMP, LO) GOTO 23031 23030 CONTINUE LEN = LEN - 4 J = 1 23032 IF (.NOT.(J .LE. LEN ))GOTO 23034 HI(J) = TEMP(J) 23033 J = J + 1 GOTO 23032 23034 CONTINUE HI(J) = 0 CALL SCOPY( TEMP, J, LO, 1) 23031 CONTINUE J = 1 DI(1) = CTOI( HI, J) J = 1 DI(2) = CTOI( LO, J) RETURN END INTEGER FUNCTION CTOI( IN, I) LOGICAL*1 IN(100) INTEGER INDEXC INTEGER D, I, SIGN LOGICAL*1 DIGITS(11) 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/ 23035 IF (.NOT.( IN(I) .EQ. 32 .OR. IN(I) .EQ. 9 ))GOTO 23036 I = I + 1 GOTO 23035 23036 CONTINUE SIGN = 1 IF (.NOT.( IN(I) .EQ. 45 ))GOTO 23037 SIGN = -1 I = I + 1 23037 CONTINUE CTOI = 0 23039 IF (.NOT.(IN(I) .NE. 0 ))GOTO 23041 D = INDEXC( DIGITS, IN(I) ) IF (.NOT.( D .EQ. 0 ))GOTO 23042 GOTO 23041 23042 CONTINUE CTOI = 10 * CTOI + D - 1 23040 I = I + 1 GOTO 23039 23041 CONTINUE CTOI=( SIGN * CTOI ) RETURN END INTEGER FUNCTION DSIZE(FILE, DI) LOGICAL*1 GETCH LOGICAL*1 C, FILE(100) INTEGER OPEN INTEGER DI(2) INTEGER FD DI(1) = 0 DI(2) = 0 FD = OPEN( FILE, 1) IF (.NOT.( FD .EQ. -3 ))GOTO 23044 DSIZE=(-3) RETURN 23044 CONTINUE 23046 IF (.NOT.(GETCH( C, FD) .NE. -1 ))GOTO 23047 DI(2) = DI(2) + 1 IF (.NOT.(DI(2) .GE. 10000))GOTO 23048 DI(1) = DI(1) + 1 DI(2) = 0 23048 CONTINUE GOTO 23046 23047 CONTINUE CALL CLOSE(FD) 23045 CONTINUE DSIZE=(0) RETURN END INTEGER FUNCTION DITOC( DI, BUF, SIZE) INTEGER DI(2), I, J, N, SIZE INTEGER ITOC LOGICAL*1 BUF(SIZE), LO(5), TEMP(20) N = ITOC( DI(2), LO, 5) IF (.NOT.( DI(1) .GT. 0 ))GOTO 23050 I = ITOC( DI(1), TEMP, 20) + 1 J = N + 1 23052 IF (.NOT.(J .LE. 4 ))GOTO 23054 CALL CHCOPY( 48, TEMP, I) 23053 J = J + 1 GOTO 23052 23054 CONTINUE GOTO 23051 23050 CONTINUE TEMP(1) = 0 23051 CONTINUE CALL CONCAT( TEMP, LO, TEMP) N = LENGTH(TEMP) + 1 - SIZE I = MAX0( N, 1) CALL SCOPY( TEMP, I, BUF, 1) DITOC=( LENGTH(BUF) ) RETURN END SUBROUTINE ERROR (LINE) LOGICAL*1 LINE(100) CALL REMARK (LINE) CALL ENDST(-3) END SUBROUTINE EXPPTH( PATH, DEPTH, PTR, BUF) LOGICAL*1 BUF(100), PATH(100) INTEGER DEPTH, I, PTR(5) INTEGER GTFTOK DEPTH = 0 I = 1 23055 CONTINUE DEPTH = DEPTH + 1 PTR(DEPTH) = I 23056 IF (.NOT.( GTFTOK( PATH, I, BUF) .EQ. 0 ))GOTO 23055 23057 CONTINUE DEPTH = DEPTH - 1 RETURN END SUBROUTINE FCOPY( IN, OUT) LOGICAL*1 C LOGICAL*1 GETCH INTEGER IN, OUT 23058 IF (.NOT.( GETCH( C, IN) .NE. -1 ))GOTO 23059 CALL PUTCH( C, OUT) GOTO 23058 23059 CONTINUE RETURN END SUBROUTINE FMTDAT( DATE, TIME, NOW, FORM) LOGICAL*1 DATE(10), TIME(9), TEMP(3) INTEGER NOW(7), FORM INTEGER I, J, K INTEGER ITOC LOGICAL*1 MONTHS(37) DATA MONTHS(1)/74/,MONTHS(2)/97/,MONTHS(3)/110/,MONTHS(4)/70/,MONT *HS(5)/101/,MONTHS(6)/98/,MONTHS(7)/77/,MONTHS(8)/97/,MONTHS(9)/114 */,MONTHS(10)/65/,MONTHS(11)/112/,MONTHS(12)/114/,MONTHS(13)/77/,MO *NTHS(14)/97/,MONTHS(15)/121/,MONTHS(16)/74/,MONTHS(17)/117/,MONTHS *(18)/110/,MONTHS(19)/74/,MONTHS(20)/117/,MONTHS(21)/108/,MONTHS(22 *)/65/,MONTHS(23)/117/,MONTHS(24)/103/,MONTHS(25)/83/,MONTHS(26)/10 *1/,MONTHS(27)/112/,MONTHS(28)/79/,MONTHS(29)/99/,MONTHS(30)/116/,M *ONTHS(31)/78/,MONTHS(32)/111/,MONTHS(33)/118/,MONTHS(34)/68/,MONTH *S(35)/101/,MONTHS(36)/99/,MONTHS(37)/0/ K = 1 IF (.NOT.( FORM .EQ. 2 ))GOTO 23060 IF (.NOT.( ITOC( NOW(2), TEMP, 3) .EQ. 1 ))GOTO 23062 CALL CHCOPY( 48, DATE, K) 23062 CONTINUE CALL STCOPY( TEMP, 1, DATE, K) CALL CHCOPY( 47, DATE, K) IF (.NOT.( ITOC( NOW(3), TEMP, 3) .EQ. 1 ))GOTO 23064 CALL CHCOPY( 48, DATE, K) 23064 CONTINUE CALL STCOPY( TEMP, 1, DATE, K) CALL CHCOPY( 47, DATE, K) IF (.NOT.( ITOC( MOD( NOW(1), 100), TEMP, 3) .EQ. 1 ))GOTO 23066 CALL CHCOPY( 48, DATE, K) 23066 CONTINUE CALL STCOPY( TEMP, 1, DATE, K) GOTO 23061 23060 CONTINUE IF (.NOT.( ITOC( NOW(3), TEMP, 3) .EQ. 1 ))GOTO 23068 CALL CHCOPY( 48, DATE, K) 23068 CONTINUE CALL STCOPY( TEMP, 1, DATE, K) CALL CHCOPY( 45, DATE, K) J = 3 * ( NOW(2) - 1 ) + 1 23070 IF (.NOT.(K .LE. 6 ))GOTO 23072 CALL CHCOPY( MONTHS(J), DATE, K) 23071 J = J + 1 GOTO 23070 23072 CONTINUE CALL CHCOPY( 45, DATE, K) IF (.NOT.( ITOC( MOD( NOW(1), 100), TEMP, 3) .EQ. 1 ))GOTO 23073 CALL CHCOPY( 48, DATE, K) 23073 CONTINUE CALL STCOPY( TEMP, 1, DATE, K) 23061 CONTINUE K = 1 IF (.NOT.( ITOC( NOW(4), TEMP, 3) .EQ. 1 ))GOTO 23075 CALL CHCOPY( 48, TIME, K) 23075 CONTINUE CALL STCOPY( TEMP, 1, TIME, K) CALL CHCOPY( 58, TIME, K) IF (.NOT.( ITOC( NOW(5), TEMP, 3) .EQ. 1 ))GOTO 23077 CALL CHCOPY( 48, TIME, K) 23077 CONTINUE CALL STCOPY( TEMP, 1, TIME, K) CALL CHCOPY( 58, TIME, K) IF (.NOT.( ITOC( NOW(6), TEMP, 3) .EQ. 1 ))GOTO 23079 CALL CHCOPY( 48, TIME, K) 23079 CONTINUE CALL STCOPY( TEMP, 1, TIME, K) RETURN END INTEGER FUNCTION FSIZE(FILE) LOGICAL*1 GETCH LOGICAL*1 C, FILE(100) INTEGER OPEN INTEGER FD FD = OPEN( FILE, 1) IF (.NOT.( FD .EQ. -3 ))GOTO 23081 FSIZE = -3 GOTO 23082 23081 CONTINUE FSIZE = 0 23083 IF (.NOT.(GETCH( C, FD) .NE. -1 ))GOTO 23085 23084 FSIZE = FSIZE + 1 GOTO 23083 23085 CONTINUE CALL CLOSE(FD) 23082 CONTINUE RETURN END SUBROUTINE FSKIP( FD, N) LOGICAL*1 GETCH LOGICAL*1 C INTEGER FD INTEGER I, N I = 1 23086 IF (.NOT.(I .LE. N ))GOTO 23088 IF (.NOT.( GETCH( C, FD) .EQ. -1 ))GOTO 23089 GOTO 23088 23089 CONTINUE 23087 I = I + 1 GOTO 23086 23088 CONTINUE RETURN END INTEGER FUNCTION GETWRD( IN, I, OUT) LOGICAL*1 IN(100), OUT(100) INTEGER I, J 23091 IF (.NOT.( IN(I) .EQ. 32 .OR. IN(I) .EQ. 9 ))GOTO 23092 I = I + 1 GOTO 23091 23092 CONTINUE J = 1 23093 IF (.NOT.( IN(I) .NE. 0 .AND. IN(I) .NE. 32 .AND. IN(I) .NE. 9 .AN *D. IN(I) .NE. 10 ))GOTO 23094 OUT(J) = IN(I) I = I + 1 J = J + 1 GOTO 23093 23094 CONTINUE OUT(J) = 0 GETWRD = J - 1 RETURN END INTEGER FUNCTION GITOCF(INT, STR, SIZE, BASE, WIDTH, FC) INTEGER MOD INTEGER INT, SIZE, BASE, WIDTH LOGICAL*1 STR(SIZE), FC INTEGER INTVAL, B, I, D, J LOGICAL*1 K LOGICAL*1 DIGITS(37) 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)/97/,DIGITS(12)/98/,DIGITS(13)/99/,DIGITS( *14)/100/,DIGITS(15)/101/,DIGITS(16)/102/,DIGITS(17)/103/,DIGITS(18 *)/104/,DIGITS(19)/105/,DIGITS(20)/106/,DIGITS(21)/107/,DIGITS(22)/ *108/,DIGITS(23)/109/,DIGITS(24)/110/,DIGITS(25)/111/,DIGITS(26)/11 *2/,DIGITS(27)/113/,DIGITS(28)/114/,DIGITS(29)/115/,DIGITS(30)/116/ *,DIGITS(31)/117/,DIGITS(32)/118/,DIGITS(33)/119/,DIGITS(34)/120/,D *IGITS(35)/121/,DIGITS(36)/122/,DIGITS(37)/0/ INTVAL = IABS(INT) B = BASE IF (.NOT.(B .LT. 2 .OR. B .GT. 36))GOTO 23095 B = 10 23095 CONTINUE STR(1) = 0 I = 1 23097 CONTINUE I = I + 1 D = MOD(INTVAL, B) + 1 STR(I) = DIGITS(D) INTVAL = INTVAL / B 23098 IF (.NOT.(INTVAL .EQ. 0 .OR. I .GE. SIZE))GOTO 23097 23099 CONTINUE IF (.NOT.(INT .LT. 0 .AND. I .LT. SIZE))GOTO 23100 I = I + 1 STR(I) = 45 23100 CONTINUE 23102 IF (.NOT.(I .LE. WIDTH))GOTO 23103 IF (.NOT.(I .GE. SIZE))GOTO 23104 GOTO 23103 23104 CONTINUE I = I + 1 STR(I) = FC 23105 CONTINUE GOTO 23102 23103 CONTINUE GITOCF = I - 1 J = 1 23106 IF (.NOT.(J .LT. I))GOTO 23108 K = STR(I) STR(I) = STR(J) STR(J) = K I = I - 1 23107 J = J + 1 GOTO 23106 23108 CONTINUE RETURN END INTEGER FUNCTION ITOC( INT, STR, SIZE) INTEGER MOD INTEGER D, I, INT, INTVAL, J, K, SIZE LOGICAL*1 STR(SIZE) LOGICAL*1 DIGITS(11) 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/ INTVAL = IABS(INT) STR(1) = 0 I = 1 23109 CONTINUE I = I + 1 D = MOD( INTVAL, 10) STR(I) = DIGITS( D + 1 ) INTVAL = INTVAL / 10 23110 IF (.NOT.( INTVAL .EQ. 0 .OR. I .GE. SIZE ))GOTO 23109 23111 CONTINUE IF (.NOT.( INT .LT. 0 .AND. I .LT. SIZE ))GOTO 23112 I = I + 1 STR(I) = 45 23112 CONTINUE ITOC = I - 1 J = 1 23114 IF (.NOT.(J .LT. I ))GOTO 23116 K = STR(I) STR(I) = STR(J) STR(J) = K I = I - 1 23115 J = J + 1 GOTO 23114 23116 CONTINUE RETURN END SUBROUTINE PUTINT( N, W, FD) LOGICAL*1 CHARS(20) INTEGER FD INTEGER ITOC INTEGER JUNK, N, W JUNK = ITOC( N, CHARS, 20) CALL PUTSTR( CHARS, W, FD) RETURN END SUBROUTINE PUTPTR( PTR, FD) INTEGER*4 PTR INTEGER FD INTEGER JUNK INTEGER PTRTOC LOGICAL*1 TEMP(20) JUNK = PTRTOC( PTR, TEMP, 20) CALL PUTLIN( TEMP, FD) RETURN END SUBROUTINE PUTSTR( STR, W, FD) LOGICAL*1 STR(100) INTEGER FD INTEGER LENGTH INTEGER W LEN = LENGTH(STR) I = LEN + 1 23117 IF (.NOT.(I .LE. W ))GOTO 23119 CALL PUTCH( 32, FD) 23118 I = I + 1 GOTO 23117 23119 CONTINUE I = 1 23120 IF (.NOT.(I .LE. LEN ))GOTO 23122 CALL PUTCH( STR(I), FD) 23121 I = I + 1 GOTO 23120 23122 CONTINUE I = ( -W ) - LEN 23123 IF (.NOT.(I .GT. 0 ))GOTO 23125 CALL PUTCH( 32, FD) 23124 I = I - 1 GOTO 23123 23125 CONTINUE RETURN END SUBROUTINE QUERY(MSG) LOGICAL*1 MSG(100) INTEGER GETARG LOGICAL*1 ARG1(3), ARG2(1) IF (.NOT.( GETARG( 1, ARG1, 3) .NE. -1 .AND. GETARG( 2, ARG2, 1) . *EQ. -1 ))GOTO 23126 IF (.NOT.( ARG1(1) .EQ. 63 .AND. ARG1(2) .EQ. 0 ))GOTO 23128 CALL ERROR(MSG) 23128 CONTINUE 23126 CONTINUE RETURN END INTEGER FUNCTION SDROP( FROM, TO, CHARS) LOGICAL*1 FROM(100), TO(100) INTEGER CHARS INTEGER LEN, START INTEGER CTOC, LENGTH, MIN0 LEN = LENGTH(FROM) IF (.NOT.( CHARS .LT. 0 ))GOTO 23130 SDROP=( CTOC( FROM, TO, LEN + CHARS + 1)) RETURN 23130 CONTINUE START = MIN0( CHARS, LEN) SDROP=( CTOC( FROM( START + 1), TO, LEN + 1 )) RETURN 23131 CONTINUE END SUBROUTINE SHELL( V, N) INTEGER GAP, I, J, JG, K, N, V(100) GAP = N / 2 23132 IF (.NOT.(GAP .GT. 0 ))GOTO 23134 I = GAP + 1 23135 IF (.NOT.(I .LE. N ))GOTO 23137 J = I - GAP 23138 IF (.NOT.(J .GT. 0 ))GOTO 23140 JG = J + GAP IF (.NOT.( V(J) .LE. V(JG) ))GOTO 23141 GOTO 23140 23141 CONTINUE K = V(J) V(J) = V(JG) V(JG) = K 23139 J = J - GAP GOTO 23138 23140 CONTINUE 23136 I = I + 1 GOTO 23135 23137 CONTINUE 23133 GAP = GAP / 2 GOTO 23132 23134 CONTINUE RETURN END SUBROUTINE SKIPBL( LIN, I) LOGICAL*1 LIN(100) INTEGER I 23143 IF (.NOT.( LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 9 ))GOTO 23144 I = I + 1 GOTO 23143 23144 CONTINUE RETURN END INTEGER FUNCTION STAKE( FROM, TO, CHARS) LOGICAL*1 FROM(100), TO(100) INTEGER CHARS INTEGER LEN, START INTEGER CTOC, LENGTH, MAX0 LEN = LENGTH(FROM) IF (.NOT.( CHARS .LT. 0 ))GOTO 23145 START = MAX0( LEN + CHARS, 0) STAKE=( CTOC( FROM( START + 1), TO, LEN + 1)) RETURN 23145 CONTINUE STAKE=( CTOC( FROM, RO, CHARS + 1)) RETURN 23146 CONTINUE END INTEGER FUNCTION STRIM(STR) LOGICAL*1 STR(100) INTEGER I, LNB LNB = 0 I = 1 23147 IF (.NOT.(STR(I) .NE. 0 ))GOTO 23149 IF (.NOT.( STR(I) .NE. 32 .AND. STR(I) .NE. 9 ))GOTO 23150 LNB = I 23150 CONTINUE 23148 I = I + 1 GOTO 23147 23149 CONTINUE STR(LNB + 1) = 0 STRIM=(LNB) RETURN END SUBROUTINE TOOLDR(DIR, DTYPE) LOGICAL*1 DIR(40) INTEGER DTYPE CALL HOMDIR(DIR, DTYPE) RETURN END INTEGER FUNCTION WKDAY( MONTH, DAY, YEAR) INTEGER MONTH, DAY, YEAR INTEGER LM, LD, LY LM = MONTH - 2 LD = DAY LY = MOD( YEAR, 100) IF (.NOT.( LM .LE. 0 ))GOTO 23152 LM = LM + 12 LY = LY - 1 23152 CONTINUE WKDAY = MOD( LD + ( 26 * LM - 2 ) / 10 + LY + LY / 4 - 34, 7) + 1 RETURN END INTEGER FUNCTION DSTIME(DATE) INTEGER DATE(7), I INTEGER WKDAY IF (.NOT.(DATE(2) .GT. 4 .AND. DATE(2) .LT. 10))GOTO 23154 DSTIME=(1) RETURN 23154 CONTINUE IF (.NOT.(DATE(2) .EQ. 4))GOTO 23156 I = 30 23158 IF (.NOT.(I .GT. 0))GOTO 23160 IF (.NOT.(WKDAY(4, I, DATE(1)) .EQ. 1))GOTO 23161 GOTO 23160 23161 CONTINUE 23159 I = I - 1 GOTO 23158 23160 CONTINUE IF (.NOT.(DATE(3) .LT. I))GOTO 23163 DSTIME=(0) RETURN 23163 CONTINUE DSTIME=(1) RETURN 23164 CONTINUE GOTO 23157 23156 CONTINUE IF (.NOT.(DATE(2) .EQ. 10))GOTO 23165 I = 31 23167 IF (.NOT.(I .GT. 0))GOTO 23169 IF (.NOT.(WKDAY(10, I, DATE(1)) .EQ. 1))GOTO 23170 GOTO 23169 23170 CONTINUE 23168 I = I - 1 GOTO 23167 23169 CONTINUE IF (.NOT.(DATE(3) .LT. I))GOTO 23172 DSTIME=(1) RETURN 23172 CONTINUE DSTIME=(0) RETURN 23173 CONTINUE GOTO 23166 23165 CONTINUE DSTIME=(0) RETURN 23166 CONTINUE 23157 CONTINUE 23155 CONTINUE END SUBROUTINE INPACK( NXTCOL, RIGHTM, BUF, FD) INTEGER FD INTEGER NXTCOL, RIGHTM LOGICAL*1 BUF(100) NXTCOL = 1 RETURN END SUBROUTINE DOPACK( WORD, NXTCOL, RIGHTM, BUF, FD) INTEGER FD INTEGER I, J, NXTCOL, NXTTAB, RIGHTM INTEGER LENGTH LOGICAL*1 BUF(100), WORD(100) IF (.NOT.( NXTCOL .EQ. 1 ))GOTO 23000 CALL STCOPY( WORD, 1, BUF, NXTCOL) GOTO 23001 23000 CONTINUE I = LENGTH(BUF) + 1 NXTTAB = ( ( ( NXTCOL - 1 ) / 16 + 1 ) * 16 ) + 1 J = NXTTAB + LENGTH(WORD) - 1 IF (.NOT.( J .GT. RIGHTM ))GOTO 23002 CALL FLPACK( NXTCOL, RIGHTM, BUF, FD) I = 1 NXTTAB = NXTCOL J = LENGTH(WORD) 23002 CONTINUE IF (.NOT.( ( NXTTAB - NXTCOL ) .GT. 8 ))GOTO 23004 CALL CHCOPY( 9, BUF, I) 23004 CONTINUE IF (.NOT.( ( NXTTAB - NXTCOL ) .GT. 0 ))GOTO 23006 CALL CHCOPY( 9, BUF, I) 23006 CONTINUE CALL SCOPY( WORD, 1, BUF, I) NXTCOL = J + 1 23001 CONTINUE RETURN END SUBROUTINE FLPACK( NXTCOL, RIGHTM, BUF, FD) INTEGER FD INTEGER NXTCOL, RIGHTM LOGICAL*1 BUF(100) IF (.NOT.( NXTCOL .GT. 1 ))GOTO 23008 CALL PUTLIN( BUF, FD) CALL PUTCH( 10, FD) NXTCOL = 1 23008 CONTINUE RETURN END INTEGER FUNCTION ADDINT( C, STR, J, MAXSIZ) INTEGER J, MAXSIZ, STR(MAXSIZ) LOGICAL*1 C IF (.NOT.( J .GT. MAXSIZ ))GOTO 23000 ADDINT=(0) RETURN 23000 CONTINUE STR(J) = C J = J + 1 ADDINT=(1) RETURN END INTEGER FUNCTION AMATCH( LIN, FROM, PAT) LOGICAL*1 LIN(512) INTEGER OMATCH, PATSIZ INTEGER FROM, I, J, OFFSET, PAT(132), STACK STACK = 0 OFFSET = FROM J = 1 23002 IF (.NOT.(PAT(J) .NE. 0 ))GOTO 23004 IF (.NOT.( PAT(J) .EQ. 42 ))GOTO 23005 STACK = J J = J + 4 I = OFFSET 23007 IF (.NOT.(LIN(I) .NE. 0 ))GOTO 23009 IF (.NOT.( OMATCH( LIN, I, PAT, J) .EQ. 0 ))GOTO 23010 GOTO 23009 23010 CONTINUE 23008 GOTO 23007 23009 CONTINUE PAT( STACK + 1 ) = I - OFFSET PAT( STACK + 3 ) = OFFSET OFFSET = I GOTO 23006 23005 CONTINUE IF (.NOT.( OMATCH( LIN, OFFSET, PAT, J) .EQ. 0 ))GOTO 23012 23014 IF (.NOT.(STACK .GT. 0 ))GOTO 23016 IF (.NOT.( PAT( STACK + 1 ) .GT. 0 ))GOTO 23017 GOTO 23016 23017 CONTINUE 23015 STACK = PAT( STACK + 2 ) GOTO 23014 23016 CONTINUE IF (.NOT.( STACK .LE. 0 ))GOTO 23019 AMATCH=(0) RETURN 23019 CONTINUE PAT( STACK + 1 ) = PAT( STACK + 1 ) - 1 J = STACK + 4 OFFSET = PAT( STACK + 3 ) + PAT( STACK + 1 ) 23012 CONTINUE 23006 CONTINUE 23003 J = J + PATSIZ( PAT, J) GOTO 23002 23004 CONTINUE AMATCH=(OFFSET) 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(132) COMMON/CTAG/TAGLIM(20) INTEGER TAGLIM I = 1 23021 IF (.NOT.(SUB(I) .NE. 0 ))GOTO 23023 IF (.NOT.( SUB(I) .EQ. (-3) ))GOTO 23024 J = FROM 23026 IF (.NOT.(J .LT. TO ))GOTO 23028 JUNK = ADDSET( LIN(J), NEW, K, MAXNEW) 23027 J = J + 1 GOTO 23026 23028 CONTINUE GOTO 23025 23024 CONTINUE IF (.NOT.( SUB(I) .EQ. (-4) ))GOTO 23029 I = I + 1 N = SUB(I) IF (.NOT.( N .LE. 0 .OR. N .GT. 10 ))GOTO 23031 CALL REMARK( 29H? In CatSub: illegal section. ) GOTO 23022 23031 CONTINUE J = TAGLIM( 2 * N - 1 ) 23033 IF (.NOT.(J .LT. TAGLIM( 2 * N ) ))GOTO 23035 JUNK = ADDSET( LIN(J), NEW, K, MAXNEW) 23034 J = J + 1 GOTO 23033 23035 CONTINUE GOTO 23030 23029 CONTINUE JUNK = ADDSET( SUB(I), NEW, K, MAXNEW) 23030 CONTINUE 23025 CONTINUE 23022 I = I + 1 GOTO 23021 23023 CONTINUE RETURN END SUBROUTINE DODASH( VALID, ARRAY, I, SET, J, MAXSET) LOGICAL*1 ESC INTEGER ADDSET, INDEXC INTEGER I, J, JUNK, K, LIMIT, MAXSET LOGICAL*1 ARRAY(100), SET(MAXSET), VALID(100) I = I + 1 J = J - 1 LIMIT = INDEXC( VALID, ESC( ARRAY, I) ) K = INDEXC( VALID, SET(J) ) 23036 IF (.NOT.(K .LE. LIMIT ))GOTO 23038 JUNK = ADDSET( VALID(K), SET, J, MAXSET) 23037 K = K + 1 GOTO 23036 23038 CONTINUE RETURN END LOGICAL*1 FUNCTION ESC( ARRAY, I) LOGICAL*1 ARRAY(100), C LOGICAL*1 CLOWER INTEGER I, J IF (.NOT.( ARRAY(I) .NE. 64 ))GOTO 23039 ESC = ARRAY(I) GOTO 23040 23039 CONTINUE IF (.NOT.( ARRAY( I + 1 ) .EQ. 0 ))GOTO 23041 ESC = 64 GOTO 23042 23041 CONTINUE I = I + 1 C = CLOWER( ARRAY(I) ) IF (.NOT.( C .EQ. 110 ))GOTO 23043 ESC = 10 GOTO 23044 23043 CONTINUE IF (.NOT.( C .EQ. 116 ))GOTO 23045 ESC = 9 GOTO 23046 23045 CONTINUE IF (.NOT.( C .EQ. 114 ))GOTO 23047 ESC = 13 GOTO 23048 23047 CONTINUE IF (.NOT.( C .EQ. 98 ))GOTO 23049 ESC = 8 GOTO 23050 23049 CONTINUE IF (.NOT.( C .EQ. 101 ))GOTO 23051 ESC = 0 GOTO 23052 23051 CONTINUE IF (.NOT.( C .EQ. 102 ))GOTO 23053 ESC = 12 GOTO 23054 23053 CONTINUE IF (.NOT.( C .EQ. 108 ))GOTO 23055 ESC = 10 GOTO 23056 23055 CONTINUE IF (.NOT.( C .GE. 48 .AND. C .LE. 55 ))GOTO 23057 ESC = 0 J=I 23059 IF (.NOT.(J .LT. I+3 .AND. ( ARRAY(J) .GE. 48 .AND. ARRAY(J) .LE. *55 ) ))GOTO 23061 ESC = 8 * ESC + ( ARRAY(J) - 48 ) 23060 J=J+1 GOTO 23059 23061 CONTINUE I = J - 1 GOTO 23058 23057 CONTINUE ESC = C 23058 CONTINUE 23056 CONTINUE 23054 CONTINUE 23052 CONTINUE 23050 CONTINUE 23048 CONTINUE 23046 CONTINUE 23044 CONTINUE 23042 CONTINUE 23040 CONTINUE RETURN END SUBROUTINE FILSET( DELIM, ARRAY, I, SET, J, MAXSET) LOGICAL*1 ESC INTEGER ADDSET, INDEXC INTEGER I, J, JUNK, MAXSET LOGICAL*1 ARRAY(100), DELIM, SET(MAXSET) LOGICAL*1 DIGITS(11) LOGICAL*1 LOWALF(27) LOGICAL*1 UPALF(27) 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 LOWALF(1)/97/,LOWALF(2)/98/,LOWALF(3)/99/,LOWALF(4)/100/,LOWA *LF(5)/101/,LOWALF(6)/102/,LOWALF(7)/103/,LOWALF(8)/104/,LOWALF(9)/ *105/,LOWALF(10)/106/,LOWALF(11)/107/,LOWALF(12)/108/,LOWALF(13)/10 *9/,LOWALF(14)/110/,LOWALF(15)/111/,LOWALF(16)/112/,LOWALF(17)/113/ *,LOWALF(18)/114/,LOWALF(19)/115/,LOWALF(20)/116/,LOWALF(21)/117/,L *OWALF(22)/118/,LOWALF(23)/119/,LOWALF(24)/120/,LOWALF(25)/121/,LOW *ALF(26)/122/,LOWALF(27)/0/ DATA UPALF(1)/65/,UPALF(2)/66/,UPALF(3)/67/,UPALF(4)/68/,UPALF(5)/ *69/,UPALF(6)/70/,UPALF(7)/71/,UPALF(8)/72/,UPALF(9)/73/,UPALF(10)/ *74/,UPALF(11)/75/,UPALF(12)/76/,UPALF(13)/77/,UPALF(14)/78/,UPALF( *15)/79/,UPALF(16)/80/,UPALF(17)/81/,UPALF(18)/82/,UPALF(19)/83/,UP *ALF(20)/84/,UPALF(21)/85/,UPALF(22)/86/,UPALF(23)/87/,UPALF(24)/88 */,UPALF(25)/89/,UPALF(26)/90/,UPALF(27)/0/ 23062 IF (.NOT.(ARRAY(I) .NE. DELIM .AND. ARRAY(I) .NE. 0 ))GOTO 23064 IF (.NOT.( ARRAY(I) .EQ. 64 ))GOTO 23065 JUNK = ADDSET( ESC( ARRAY, I), SET, J, MAXSET) GOTO 23066 23065 CONTINUE IF (.NOT.( ARRAY(I) .NE. 45 ))GOTO 23067 JUNK = ADDSET( ARRAY(I), SET, J, MAXSET) GOTO 23068 23067 CONTINUE IF (.NOT.( J .LE. 1 .OR. ARRAY( I + 1 ) .EQ. 0 ))GOTO 23069 JUNK = ADDSET( 45, SET, J, MAXSET) GOTO 23070 23069 CONTINUE IF (.NOT.( INDEXC( DIGITS, SET( J - 1 ) ) .GT. 0 ))GOTO 23071 CALL DODASH( DIGITS, ARRAY, I, SET, J, MAXSET) GOTO 23072 23071 CONTINUE IF (.NOT.( INDEXC( LOWALF, SET( J - 1 ) ) .GT. 0 ))GOTO 23073 CALL DODASH( LOWALF, ARRAY, I, SET, J, MAXSET) GOTO 23074 23073 CONTINUE IF (.NOT.( INDEXC( UPALF, SET( J - 1 ) ) .GT. 0 ))GOTO 23075 CALL DODASH( UPALF, ARRAY, I, SET, J, MAXSET) GOTO 23076 23075 CONTINUE JUNK = ADDSET( 45, SET, J, MAXSET) 23076 CONTINUE 23074 CONTINUE 23072 CONTINUE 23070 CONTINUE 23068 CONTINUE 23066 CONTINUE 23063 I = I + 1 GOTO 23062 23064 CONTINUE RETURN END INTEGER FUNCTION GETCCL( ARG, I, PAT, J) LOGICAL*1 ARG(128), TPAT(132) INTEGER ADDINT INTEGER I, J, JSTART, JUNK, K, PAT(132) I = I + 1 IF (.NOT.( ARG(I) .EQ. 33 ))GOTO 23077 JUNK = ADDINT( 110, PAT, J, 132) I = I + 1 GOTO 23078 23077 CONTINUE JUNK = ADDINT( 91, PAT, J, 132) 23078 CONTINUE JSTART = J JUNK = ADDINT( 0, PAT, J, 132) K = 1 CALL FILSET( 93, ARG, I, TPAT, K, 132) TPAT(K) = 0 K = 1 23079 IF (.NOT.(TPAT(K) .NE. 0 ))GOTO 23081 JUNK = ADDINT( TPAT(K), PAT, J, 132) 23080 K = K + 1 GOTO 23079 23081 CONTINUE PAT(JSTART) = J - JSTART - 1 IF (.NOT.( ARG(I) .EQ. 93 ))GOTO 23082 GETCCL=(0) RETURN 23082 CONTINUE GETCCL=(-3) RETURN 23083 CONTINUE END INTEGER FUNCTION GETPAT( ARG, PAT) LOGICAL*1 ARG(128) INTEGER PAT(132) INTEGER MAKPAT GETPAT = MAKPAT( ARG, 1, 0, PAT) RETURN END INTEGER FUNCTION GETSUB( ARG, SUB) LOGICAL*1 ARG(128), SUB(132) INTEGER MAKSUB GETSUB = MAKSUB( ARG, 1, 0, SUB) RETURN END INTEGER FUNCTION LOCATE( C, PAT, OFFSET) LOGICAL*1 C INTEGER I, OFFSET, PAT(132) I = OFFSET + PAT(OFFSET) 23084 IF (.NOT.(I .GT. OFFSET ))GOTO 23086 IF (.NOT.( C .EQ. PAT(I) ))GOTO 23087 LOCATE=(1) RETURN 23087 CONTINUE 23085 I = I - 1 GOTO 23084 23086 CONTINUE LOCATE=(0) RETURN END INTEGER FUNCTION MAKPAT( ARG, FROM, DELIM, PAT) LOGICAL*1 ESC LOGICAL*1 ARG(128), DELIM INTEGER ADDINT, GETCCL, STCLOS INTEGER FROM, I, J, JUNK, LASTCL, LASTJ, LJ, PAT(132) INTEGER TAGCNT, TAGI, TAGSTK(10) J = 1 LASTJ = 1 LASTCL = 0 TAGI = 0 TAGCNT = 0 I = FROM 23089 IF (.NOT.(ARG(I) .NE. DELIM .AND. ARG(I) .NE. 0 ))GOTO 23091 LJ = J IF (.NOT.( ARG(I) .EQ. 63 ))GOTO 23092 JUNK = ADDINT( 63, PAT, J, 132) GOTO 23093 23092 CONTINUE IF (.NOT.( ARG(I) .EQ. 37 .AND. I .EQ. FROM ))GOTO 23094 JUNK = ADDINT( 37, PAT, J, 132) GOTO 23095 23094 CONTINUE IF (.NOT.( ARG(I) .EQ. 36 .AND. ARG( I + 1 ) .EQ. DELIM ))GOTO 230 *96 JUNK = ADDINT( 36, PAT, J, 132) GOTO 23097 23096 CONTINUE IF (.NOT.( ARG(I) .EQ. 91 ))GOTO 23098 IF (.NOT.( GETCCL( ARG, I, PAT, J) .EQ. -3 ))GOTO 23100 GOTO 23091 23100 CONTINUE GOTO 23099 23098 CONTINUE IF (.NOT.( ( ARG(I) .EQ. 42 .OR. ARG(I) .EQ. 43 ) .AND. I .GT. FRO *M ))GOTO 23102 LJ = LASTJ IF (.NOT.( PAT(LJ) .EQ. 37 .OR. PAT(LJ) .EQ. 36 .OR. PAT(LJ) .EQ. *42 .OR. PAT(LJ) .EQ. 43 ))GOTO 23104 GOTO 23091 23104 CONTINUE IF (.NOT.( ARG(I) .EQ. 43 ))GOTO 23106 LASTJ = J 23108 IF (.NOT.(LJ .LT. LASTJ ))GOTO 23110 JUNK = ADDINT( PAT(LJ), PAT, J, 132) 23109 LJ = LJ + 1 GOTO 23108 23110 CONTINUE 23106 CONTINUE LASTCL = STCLOS( PAT, J, LASTJ, LASTCL) GOTO 23103 23102 CONTINUE IF (.NOT.( ARG(I) .EQ. 123 ))GOTO 23111 IF (.NOT.( TAGI .GT. 10 .OR. TAGCNT .GT. 10 ))GOTO 23113 GOTO 23091 23113 CONTINUE TAGCNT = TAGCNT + 1 TAGI = TAGI + 1 TAGSTK(TAGI) = TAGCNT JUNK = ADDINT( 123, PAT, J, 132) JUNK = ADDINT( TAGCNT, PAT, J, 132) GOTO 23112 23111 CONTINUE IF (.NOT.( ARG(I) .EQ. 125 ))GOTO 23115 IF (.NOT.( TAGI .LE. 0 ))GOTO 23117 GOTO 23091 23117 CONTINUE N = TAGSTK(TAGI) TAGI = TAGI - 1 JUNK = ADDINT( 125, PAT, J, 132) JUNK = ADDINT( N, PAT, J, 132) GOTO 23116 23115 CONTINUE JUNK = ADDINT( 97, PAT, J, 132) JUNK = ADDINT( ESC( ARG, I), PAT, J, 132) 23116 CONTINUE 23112 CONTINUE 23103 CONTINUE 23099 CONTINUE 23097 CONTINUE 23095 CONTINUE 23093 CONTINUE LASTJ = LJ 23090 I = I + 1 GOTO 23089 23091 CONTINUE IF (.NOT.( ARG(I) .NE. DELIM ))GOTO 23119 MAKPAT=(-3) RETURN 23119 CONTINUE IF (.NOT.( ADDINT( 0, PAT, J, 132) .EQ. 0 ))GOTO 23121 MAKPAT=(-3) RETURN 23121 CONTINUE IF (.NOT.( TAGI .GT. 0 ))GOTO 23123 MAKPAT=(-3) RETURN 23123 CONTINUE MAKPAT=(I) RETURN 23124 CONTINUE 23122 CONTINUE 23120 CONTINUE END INTEGER FUNCTION MAKSUB( ARG, FROM, DELIM, SUB) LOGICAL*1 ESC LOGICAL*1 ARG(128), DELIM, SUB(132) INTEGER ADDSET, TYPE, CTOI INTEGER FROM, I, J, JUNK J = 1 I = FROM 23125 IF (.NOT.(ARG(I) .NE. DELIM .AND. ARG(I) .NE. 0 ))GOTO 23127 IF (.NOT.( ARG(I) .EQ. 38 ))GOTO 23128 JUNK = ADDSET( (-3), SUB, J, 132) GOTO 23129 23128 CONTINUE IF (.NOT.( ARG(I) .EQ. 36 .AND. TYPE( ARG( I + 1 ) ) .EQ. 2 ))GOTO * 23130 I = I + 1 N = CTOI( ARG, I) JUNK = ADDSET( (-4), SUB, J, 132) JUNK = ADDSET( N, SUB, J, 132) I = I - 1 GOTO 23131 23130 CONTINUE JUNK = ADDSET( ESC( ARG, I), SUB, J, 132) 23131 CONTINUE 23129 CONTINUE 23126 I = I + 1 GOTO 23125 23127 CONTINUE IF (.NOT.( ARG(I) .NE. DELIM ))GOTO 23132 MAKSUB=(-3) RETURN 23132 CONTINUE IF (.NOT.( ADDSET( 0, SUB, J, 132) .EQ. 0 ))GOTO 23134 MAKSUB=(-3) RETURN 23134 CONTINUE MAKSUB=(I) RETURN 23135 CONTINUE 23133 CONTINUE END INTEGER FUNCTION MATCH( LIN, PAT) LOGICAL*1 LIN(512) INTEGER AMATCH INTEGER I, PAT(132) I = 1 23136 IF (.NOT.(LIN(I) .NE. 0 ))GOTO 23138 IF (.NOT.( AMATCH( LIN, I, PAT) .GT. 0 ))GOTO 23139 MATCH=(1) RETURN 23139 CONTINUE 23137 I = I + 1 GOTO 23136 23138 CONTINUE MATCH=(0) RETURN END INTEGER FUNCTION OMATCH( LIN, I, PAT, J) LOGICAL*1 LIN(512) INTEGER LOCATE INTEGER BUMP, I, J, PAT(132) COMMON/CTAG/TAGLIM(20) INTEGER TAGLIM OMATCH = 0 IF (.NOT.( LIN(I) .EQ. 0 ))GOTO 23141 RETURN 23141 CONTINUE BUMP = -1 IF (.NOT.( PAT(J) .EQ. 97 ))GOTO 23143 IF (.NOT.( LIN(I) .EQ. PAT( J + 1 ) ))GOTO 23145 BUMP = 1 23145 CONTINUE GOTO 23144 23143 CONTINUE IF (.NOT.( PAT(J) .EQ. 37 ))GOTO 23147 IF (.NOT.( I .EQ. 1 ))GOTO 23149 BUMP = 0 23149 CONTINUE GOTO 23148 23147 CONTINUE IF (.NOT.( PAT(J) .EQ. 63 ))GOTO 23151 IF (.NOT.( LIN(I) .NE. 10 ))GOTO 23153 BUMP = 1 23153 CONTINUE GOTO 23152 23151 CONTINUE IF (.NOT.( PAT(J) .EQ. 36 ))GOTO 23155 IF (.NOT.( LIN(I) .EQ. 10 ))GOTO 23157 BUMP = 0 23157 CONTINUE GOTO 23156 23155 CONTINUE IF (.NOT.( PAT(J) .EQ. 91 ))GOTO 23159 IF (.NOT.( LOCATE( LIN(I), PAT, J + 1 ) .EQ. 1 ))GOTO 23161 BUMP = 1 23161 CONTINUE GOTO 23160 23159 CONTINUE IF (.NOT.( PAT(J) .EQ. 110 ))GOTO 23163 IF (.NOT.( LIN(I) .NE. 10 .AND. LOCATE( LIN(I), PAT, J + 1 ) .EQ. *0 ))GOTO 23165 BUMP = 1 23165 CONTINUE GOTO 23164 23163 CONTINUE IF (.NOT.( PAT(J) .EQ. 123 ))GOTO 23167 N = PAT( J + 1 ) TAGLIM( 2 * N - 1 ) = I BUMP = 0 GOTO 23168 23167 CONTINUE IF (.NOT.( PAT(J) .EQ. 125 ))GOTO 23169 N = PAT( J + 1 ) TAGLIM( 2 * N ) = I BUMP = 0 GOTO 23170 23169 CONTINUE CALL ERROR( 25H? In omatch: cant happen. ) 23170 CONTINUE 23168 CONTINUE 23164 CONTINUE 23160 CONTINUE 23156 CONTINUE 23152 CONTINUE 23148 CONTINUE 23144 CONTINUE IF (.NOT.( BUMP .GE. 0 ))GOTO 23171 I = I + BUMP OMATCH = 1 23171 CONTINUE RETURN END INTEGER FUNCTION PATSIZ( PAT, N) INTEGER N, PAT(132) IF (.NOT.( PAT(N) .EQ. 97 .OR. PAT(N) .EQ. 123 .OR. PAT(N) .EQ. 12 *5 ))GOTO 23173 PATSIZ = 2 GOTO 23174 23173 CONTINUE IF (.NOT.( PAT(N) .EQ. 37 .OR. PAT(N) .EQ. 36 .OR. PAT(N) .EQ. 63 *))GOTO 23175 PATSIZ = 1 GOTO 23176 23175 CONTINUE IF (.NOT.( PAT(N) .EQ. 91 .OR. PAT(N) .EQ. 110 ))GOTO 23177 PATSIZ = PAT( N + 1 ) + 2 GOTO 23178 23177 CONTINUE IF (.NOT.( PAT(N) .EQ. 42 ))GOTO 23179 PATSIZ = 4 GOTO 23180 23179 CONTINUE CALL ERROR( 25H? In patsiz: cant happen. ) 23180 CONTINUE 23178 CONTINUE 23176 CONTINUE 23174 CONTINUE RETURN END INTEGER FUNCTION STCLOS( PAT, J, LASTJ, LASTCL) INTEGER ADDINT INTEGER J, JP, JT, JUNK, LASTCL, LASTJ, PAT(132) JP = J - 1 23181 IF (.NOT.(JP .GE. LASTJ ))GOTO 23183 JT = JP + 4 JUNK = ADDINT( PAT(JP), PAT, JT, 132) 23182 JP = JP - 1 GOTO 23181 23183 CONTINUE J = J + 4 STCLOS = LASTJ JUNK = ADDINT( 42, PAT, LASTJ, 132) JUNK = ADDINT( 0, PAT, LASTJ, 132) JUNK = ADDINT( LASTCL, PAT, LASTJ, 132) JUNK = ADDINT( 0, PAT, LASTJ, 132) RETURN END LOGICAL*1 FUNCTION NGETCH(C, FD) LOGICAL*1 GETCH LOGICAL*1 C INTEGER FD INTEGER PBP, PBSIZE LOGICAL*1 PBBUF(1) COMMON/CPBACK/PBP, PBSIZE, PBBUF IF (.NOT.(PBP .GT. 0))GOTO 23000 C = PBBUF(PBP) PBP = PBP - 1 GOTO 23001 23000 CONTINUE IF (.NOT.(FD .EQ. -3))GOTO 23002 C = -1 GOTO 23003 23002 CONTINUE C = GETCH(C, FD) 23003 CONTINUE 23001 CONTINUE NGETCH = C RETURN END SUBROUTINE PBINIT(SIZE) INTEGER SIZE INTEGER PBP, PBSIZE LOGICAL*1 PBBUF(1) COMMON/CPBACK/PBP, PBSIZE, PBBUF PBP = 0 PBSIZE = SIZE RETURN END SUBROUTINE PUTBAK(C) LOGICAL*1 C INTEGER PBP, PBSIZE LOGICAL*1 PBBUF(1) COMMON/CPBACK/PBP, PBSIZE, PBBUF PBP = PBP + 1 IF (.NOT.(PBP .GT. PBSIZE))GOTO 23004 CALL ERROR(41Hputbak - too many characters pushed back.) 23004 CONTINUE PBBUF(PBP) = C RETURN END SUBROUTINE PBSTR(IN) LOGICAL*1 IN(100) INTEGER LENGTH INTEGER I INTEGER PBP, PBSIZE LOGICAL*1 PBBUF(1) COMMON/CPBACK/PBP, PBSIZE, PBBUF I = LENGTH(IN) 23006 IF (.NOT.(I .GT. 0))GOTO 23008 PBP = PBP + 1 IF (.NOT.(PBP .GT. PBSIZE))GOTO 23009 CALL ERROR(40Hpbstr - too many characters pushed back.) 23009 CONTINUE PBBUF(PBP) = IN(I) 23007 I = I - 1 GOTO 23006 23008 CONTINUE RETURN END INTEGER FUNCTION RAWPMT(PSTR, LIN, IN) LOGICAL*1 PSTR(100), LIN(512), TMP(512) INTEGER IN, N INTEGER PRAW07 LOGICAL*1 ALTPST(3) DATA ALTPST(1)/32/,ALTPST(2)/95/,ALTPST(3)/0/ ALTPST(1) = PSTR(1) N = PRAW07(PSTR, LIN, IN) IF (.NOT.(N .EQ. -1 .OR. N .EQ. 1))GOTO 23000 RAWPMT=(N) RETURN 23000 CONTINUE 23002 IF (.NOT.(LIN(N) .EQ. 10 .AND. LIN(N-1) .EQ. 64))GOTO 23003 LIN(N-1) = 32 IF (.NOT.(PRAW07(ALTPST, TMP, IN) .EQ. -1))GOTO 23004 RAWPMT=(-1) RETURN 23004 CONTINUE CALL STCOPY(TMP, 1, LIN, N) N = N - 1 GOTO 23002 23003 CONTINUE RAWPMT=(N) RETURN END INTEGER FUNCTION PRAW01(INPSTR, OUTSTR) INTEGER FOUND, LEN, DEPTH, PTR(5), J, JUNK, DESC INTEGER LENGTH, GTFTOK, OPENDR, GDRPRM, EQUAL, PRAW03 LOGICAL*1 INPSTR(100), OUTSTR(100), PATH(40), PAT(40), C LOGICAL*1 STAR(2) DATA STAR(1)/42/,STAR(2)/0/ FOUND = 0 LEN = LENGTH(INPSTR) IF (.NOT.(LEN .EQ. 0 .OR. INPSTR(LEN) .EQ. 47))GOTO 23006 CALL CONCAT(INPSTR, STAR, PAT) GOTO 23007 23006 CONTINUE CALL STRCPY(INPSTR, PAT) 23007 CONTINUE CALL MKPATH(PAT, PATH) CALL FOLD(PATH) CALL EXPPTH(PATH, DEPTH, PTR, PAT) J = PTR(DEPTH) PAT(1) = 0 JUNK = GTFTOK(PATH, J, PAT) J = PTR(DEPTH) PATH(J) = 0 IF (.NOT.(OPENDR(PATH, DESC) .EQ. -3))GOTO 23008 PRAW01=(FOUND) RETURN 23008 CONTINUE LEN = LENGTH(PAT) + 1 23010 IF (.NOT.(GDRPRM(DESC, PATH) .NE. -1))GOTO 23011 C = PATH(LEN) PATH(LEN) = 0 IF (.NOT.(EQUAL(PATH, PAT) .EQ. 0 .AND. PAT(1) .NE. 42))GOTO 23012 GOTO 23010 23012 CONTINUE PATH(LEN) = C IF (.NOT.(FOUND .EQ. 0))GOTO 23014 CALL STRCPY(PATH, OUTSTR) 23014 CONTINUE FOUND = FOUND + 1 J = PRAW03(PATH, OUTSTR) + 1 OUTSTR(J) = 0 GOTO 23010 23011 CONTINUE CALL CLOSDR(DESC) PRAW01=(FOUND) RETURN END SUBROUTINE PRAW02(S1, S2, I) LOGICAL*1 S1(100), S2(100) INTEGER I, J, K, L INTEGER LENGTH K = LENGTH(S2) + 1 J=K+LENGTH(S1) 23016 IF (.NOT.(K .GE. I))GOTO 23018 S2(J) = S2(K) J = J - 1 23017 K=K-1 GOTO 23016 23018 CONTINUE L = 1 K=I 23019 IF (.NOT.(K .LE. J))GOTO 23021 S2(K) = S1(L) L = L + 1 23020 K=K+1 GOTO 23019 23021 CONTINUE RETURN END INTEGER FUNCTION PRAW03(S1, S2) INTEGER I LOGICAL*1 S1(100), S2(100) I=1 23022 IF (.NOT.(S1(I) .EQ. S2(I)))GOTO 23024 IF (.NOT.(S1(I) .EQ. 0 .OR. S2(I) .EQ. 0))GOTO 23025 GOTO 23024 23025 CONTINUE 23023 I=I+1 GOTO 23022 23024 CONTINUE PRAW03=(I-1) RETURN END INTEGER FUNCTION PRAW04(IN, OUT, SAVMOD) INTEGER IN, OUT, SAVMOD INTEGER CREATE, STMODE, ISATTY, GTMODE LOGICAL*1 TTYSTR(4) DATA TTYSTR(1)/84/,TTYSTR(2)/73/,TTYSTR(3)/58/,TTYSTR(4)/0/ IF (.NOT.(OUT .EQ. -1))GOTO 23027 OUT = CREATE(TTYSTR, 2) IF (.NOT.(OUT .NE. -3))GOTO 23029 IF (.NOT.(STMODE(OUT, 1) .NE. 1))GOTO 23031 CALL CLOSE(OUT) OUT = -3 23031 CONTINUE 23029 CONTINUE 23027 CONTINUE PRAW04 = 0 IF (.NOT.(ISATTY(IN) .EQ. 1 .AND. OUT .NE. -3))GOTO 23033 SAVMOD = GTMODE(IN) IF (.NOT.(STMODE(IN, 1) .EQ. 1))GOTO 23035 PRAW04 = 1 GOTO 23036 23035 CONTINUE SAVMOD = STMODE(IN, SAVMOD) 23036 CONTINUE 23033 CONTINUE RETURN END INTEGER FUNCTION PRAW05(STR) INTEGER I INTEGER PRAW01, LENGTH LOGICAL*1 STR(100), OUTSTR(40) I = LENGTH(STR) IF (.NOT.(I .GT. 0))GOTO 23037 23039 CONTINUE IF (.NOT.(STR(I) .EQ. 47 .OR. STR(I) .EQ. 92))GOTO 23042 GOTO 23041 23042 CONTINUE I = I - 1 23040 IF (.NOT.(I .EQ. 0))GOTO 23039 23041 CONTINUE 23037 CONTINUE PRAW05 = PRAW01(STR, OUTSTR) IF (.NOT.(PRAW05 .NE. 0))GOTO 23044 CALL SCOPY(OUTSTR, 1, STR, I+1) 23044 CONTINUE RETURN END SUBROUTINE PRAW06(PSTR, LIN, INT, TEMP, IFEXPD) LOGICAL*1 PSTR(100), LIN(100), TEMP(100) INTEGER INT, IFEXPD, I, J LOGICAL*1 CRLF(3) DATA CRLF(1)/13/,CRLF(2)/10/,CRLF(3)/0/ I = 1 23046 IF (.NOT.(PSTR(I) .NE. 0))GOTO 23047 J=1 23048 IF (.NOT.(PSTR(I) .NE. 10 .AND. PSTR(I) .NE. 0))GOTO 23050 TEMP(J) = PSTR(I) I = I + 1 23049 J=J+1 GOTO 23048 23050 CONTINUE IF (.NOT.(PSTR(I) .EQ. 10))GOTO 23051 CALL SCOPY(CRLF, 1, TEMP, J) I = I + 1 GOTO 23052 23051 CONTINUE TEMP(J) = 0 23052 CONTINUE CALL PUTLIN(TEMP, INT) GOTO 23046 23047 CONTINUE J = 1 I=1 23053 IF (.NOT.(LIN(I) .NE. 0))GOTO 23055 IF (.NOT.(LIN(I) .LT. 32))GOTO 23056 CALL CHCOPY(94, TEMP, J) IF (.NOT.(IFEXPD .EQ. 1))GOTO 23058 CALL CHCOPY(LIN(I)+64, TEMP, J) 23058 CONTINUE GOTO 23057 23056 CONTINUE CALL CHCOPY(LIN(I), TEMP, J) 23057 CONTINUE 23054 I=I+1 GOTO 23053 23055 CONTINUE TEMP(J) = 0 CALL PUTLIN(TEMP, INT) RETURN END INTEGER FUNCTION PRAW07(PSTR, LIN, IN) LOGICAL*1 PSTR(100), LIN(512), C, TMP(512) LOGICAL*1 GETCH INTEGER IN, I, J, K, L, OUT, SAVMOD INTEGER PROMPT, PRAW08, PRAW10, LENGTH, PRAW05, INDEXC, PRAW04, ST *MODE LOGICAL*1 BOL(2) LOGICAL*1 DSTR(4) LOGICAL*1 BSBLBS(4) LOGICAL*1 CRLF(3) LOGICAL*1 CTRLD(17) LOGICAL*1 CTRLR(15) LOGICAL*1 CTRLU(13) LOGICAL*1 CTRLV(15) LOGICAL*1 CTRLZ(4) LOGICAL*1 FLDTRM(8) LOGICAL*1 FILTRM(5) LOGICAL*1 PTHTRM(4) LOGICAL*1 VALCTL(3) DATA BOL(1)/37/,BOL(2)/0/ DATA DSTR(1)/102/,DSTR(2)/100/,DSTR(3)/32/,DSTR(4)/0/ DATA BSBLBS(1)/8/,BSBLBS(2)/32/,BSBLBS(3)/8/,BSBLBS(4)/0/ DATA CRLF(1)/13/,CRLF(2)/10/,CRLF(3)/0/ DATA CTRLD(1)/94/,CTRLD(2)/68/,CTRLD(3)/105/,CTRLD(4)/114/,CTRLD(5 *)/101/,CTRLD(6)/99/,CTRLD(7)/116/,CTRLD(8)/111/,CTRLD(9)/114/,CTRL *D(10)/121/,CTRLD(11)/32/,CTRLD(12)/108/,CTRLD(13)/105/,CTRLD(14)/1 *15/,CTRLD(15)/116/,CTRLD(16)/13/,CTRLD(17)/0/ DATA CTRLR(1)/94/,CTRLR(2)/82/,CTRLR(3)/101/,CTRLR(4)/116/,CTRLR(5 *)/121/,CTRLR(6)/112/,CTRLR(7)/101/,CTRLR(8)/32/,CTRLR(9)/108/,CTRL *R(10)/105/,CTRLR(11)/110/,CTRLR(12)/101/,CTRLR(13)/13/,CTRLR(14)/1 *0/,CTRLR(15)/0/ DATA CTRLU(1)/94/,CTRLU(2)/85/,CTRLU(3)/110/,CTRLU(4)/100/,CTRLU(5 *)/111/,CTRLU(6)/32/,CTRLU(7)/108/,CTRLU(8)/105/,CTRLU(9)/110/,CTRL *U(10)/101/,CTRLU(11)/13/,CTRLU(12)/10/,CTRLU(13)/0/ DATA CTRLV(1)/94/,CTRLV(2)/86/,CTRLV(3)/101/,CTRLV(4)/114/,CTRLV(5 *)/105/,CTRLV(6)/102/,CTRLV(7)/121/,CTRLV(8)/32/,CTRLV(9)/108/,CTRL *V(10)/105/,CTRLV(11)/110/,CTRLV(12)/101/,CTRLV(13)/13/,CTRLV(14)/1 *0/,CTRLV(15)/0/ DATA CTRLZ(1)/94/,CTRLZ(2)/90/,CTRLZ(3)/13/,CTRLZ(4)/0/ DATA FLDTRM(1)/32/,FLDTRM(2)/9/,FLDTRM(3)/47/,FLDTRM(4)/92/,FLDTRM *(5)/64/,FLDTRM(6)/60/,FLDTRM(7)/62/,FLDTRM(8)/0/ DATA FILTRM(1)/32/,FILTRM(2)/60/,FILTRM(3)/62/,FILTRM(4)/64/,FILTR *M(5)/0/ DATA PTHTRM(1)/32/,PTHTRM(2)/47/,PTHTRM(3)/92/,PTHTRM(4)/0/ DATA VALCTL(1)/12/,VALCTL(2)/9/,VALCTL(3)/0/ DATA OUT /-1/ IF (.NOT.(PRAW04(IN, OUT, SAVMOD) .EQ. 0))GOTO 23060 PRAW07=(PROMPT(PSTR, LIN, IN)) RETURN 23060 CONTINUE I = 1 CALL PUTLIN(CRLF, OUT) CALL PRAW06(PSTR, 0, OUT, TMP, 0) LIN(1) = 0 23062 CONTINUE C = GETCH(C, IN) IF (.NOT.(C .EQ. 26))GOTO 23065 CALL PUTLIN(CTRLZ, OUT) LIN(1) = 0 PRAW07=(-1) RETURN 23065 CONTINUE IF (.NOT.(C .EQ. 13))GOTO 23067 GOTO 23064 23067 CONTINUE IF (.NOT.(C .EQ. 8 .OR. C .EQ. 127))GOTO 23069 IF (.NOT.(I .GT. 1))GOTO 23071 CALL PUTLIN(BSBLBS, OUT) I = I - 1 LIN(I) = 0 GOTO 23072 23071 CONTINUE LIN(I) = 0 23072 CONTINUE GOTO 23070 23069 CONTINUE IF (.NOT.(C .EQ. 21))GOTO 23073 CALL PUTLIN(CTRLU, OUT) CALL PRAW06(PSTR, 0, OUT, TMP, 0) I = 1 LIN(I) = 0 GOTO 23074 23073 CONTINUE IF (.NOT.(C .EQ. 18))GOTO 23075 CALL PUTLIN(CTRLR, OUT) CALL PRAW06(PSTR, LIN, OUT, TMP, 0) GOTO 23076 23075 CONTINUE IF (.NOT.(C .EQ. 22))GOTO 23077 CALL PUTLIN(CTRLV, OUT) CALL PRAW06(PSTR, LIN, OUT, TMP, 1) CALL PUTLIN(CRLF, OUT) CALL PRAW06(PSTR, LIN, OUT, TMP, 0) GOTO 23078 23077 CONTINUE IF (.NOT.(C .EQ. 23))GOTO 23079 I = PRAW10(LIN, I, BSBLBS, OUT, FLDTRM) I = PRAW08(LIN, I, BSBLBS, OUT, FLDTRM) LIN(I) = 0 GOTO 23080 23079 CONTINUE IF (.NOT.(C .EQ. 4))GOTO 23081 CALL PUTLIN(CTRLD, OUT) CALL PRAW09(DSTR) CALL PUTLIN(CRLF, OUT) CALL PRAW06(PSTR, LIN, OUT, TMP, 0) GOTO 23082 23081 CONTINUE IF (.NOT.(C .EQ. 6))GOTO 23083 LIN(I) = 0 J = PRAW08(LIN, I, 0, OUT, FILTRM) CALL SCOPY(LIN, J, TMP, 1) K = LENGTH(TMP) + 1 L = PRAW05(TMP) IF (.NOT.(L .NE. 0))GOTO 23085 IF (.NOT.(TMP(K) .NE. 0 .OR. L .EQ. 1))GOTO 23087 IF (.NOT.(TMP(K) .NE. 0))GOTO 23089 CALL SCOPY(TMP, K, LIN, I) GOTO 23090 23089 CONTINUE LIN(I) = 32 LIN(I+1) = 0 23090 CONTINUE CALL PUTLIN(LIN(I), OUT) I = LENGTH(LIN) + 1 GOTO 23088 23087 CONTINUE K = 1 CALL STCOPY(DSTR, 1, TMP, K) CALL SCOPY(LIN, J, TMP, K) J = PRAW08(TMP(K), LENGTH(TMP(K))+1, 0, OUT, PTHTRM) + K - 1 CALL PRAW02(BOL, TMP, J) CALL PUTLIN(CRLF, OUT) CALL PUTCH(35, OUT) CALL PUTLIN(TMP, OUT) CALL PUTCH(13, OUT) CALL PRAW09(TMP) CALL PUTLIN(CRLF, OUT) CALL PRAW06(PSTR, LIN, OUT, TMP, 0) 23088 CONTINUE GOTO 23086 23085 CONTINUE CALL PUTCH(7, OUT) 23086 CONTINUE GOTO 23084 23083 CONTINUE IF (.NOT.(C .LT. 32 .AND. INDEXC(VALCTL, C) .EQ. 0))GOTO 23091 CALL PUTCH(7, OUT) GOTO 23092 23091 CONTINUE LIN(I) = C I = I + 1 LIN(I) = 0 IF (.NOT.(INDEXC(VALCTL, C) .EQ. 0))GOTO 23093 CALL PUTCH(C, OUT) GOTO 23094 23093 CONTINUE CALL PUTCH(94, OUT) 23094 CONTINUE 23092 CONTINUE 23084 CONTINUE 23082 CONTINUE 23080 CONTINUE 23078 CONTINUE 23076 CONTINUE 23074 CONTINUE 23070 CONTINUE 23068 CONTINUE 23066 CONTINUE 23063 GOTO 23062 23064 CONTINUE CALL PUTCH(13, OUT) LIN(I) = 10 LIN(I+1) = 0 SAVMOD = STMODE(IN, SAVMOD) PRAW07=(I) RETURN END INTEGER FUNCTION PRAW08(STR, COL, RUBSTR, CHN, TRMARA) INTEGER I, CHN, COL INTEGER INDEXC LOGICAL*1 RUBSTR(100), STR(100), TRMARA(100) IF (.NOT.(COL .GT. 1))GOTO 23095 I = COL - 1 23097 IF (.NOT.(INDEXC(TRMARA, STR(I)) .EQ. 0 .AND. I .GT. 1))GOTO 23099 IF (.NOT.(RUBSTR(1) .NE. 0))GOTO 23100 CALL PUTLIN(RUBSTR, CHN) 23100 CONTINUE 23098 I=I-1 GOTO 23097 23099 CONTINUE IF (.NOT.(I .EQ. 1 .AND. INDEXC(TRMARA, STR(I)) .EQ. 0))GOTO 23102 IF (.NOT.(RUBSTR(1) .NE. 0))GOTO 23104 CALL PUTLIN(RUBSTR, CHN) 23104 CONTINUE GOTO 23103 23102 CONTINUE I = I + 1 23103 CONTINUE GOTO 23096 23095 CONTINUE I = 1 23096 CONTINUE PRAW08=(I) RETURN END SUBROUTINE PRAW09(ARGS) LOGICAL*1 ARGS(100), IMAGE(40), PID(7) INTEGER LOCCOM, SSPAWN INTEGER JUNK, INIT LOGICAL*1 D(3) LOGICAL*1 SPATH(15) LOGICAL*1 SUFFIX(7) DATA D(1)/102/,D(2)/100/,D(3)/0/ DATA SPATH(1)/0/,SPATH(2)/126/,SPATH(3)/117/,SPATH(4)/115/,SPATH(5 *)/114/,SPATH(6)/47/,SPATH(7)/0/,SPATH(8)/126/,SPATH(9)/98/,SPATH(1 *0)/105/,SPATH(11)/110/,SPATH(12)/47/,SPATH(13)/0/,SPATH(14)/10/,SP *ATH(15)/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 INIT /1/ IF (.NOT.(INIT .EQ. 1))GOTO 23106 INIT = 0 JUNK = LOCCOM(D, SPATH, SUFFIX, IMAGE) 23106 CONTINUE JUNK = SSPAWN(IMAGE, ARGS, PID, 119) RETURN END INTEGER FUNCTION PRAW10(STR, COL, RUBSTR, CHN, SEPARA) INTEGER I, CHN, COL INTEGER INDEXC LOGICAL*1 RUBSTR(100), STR(100), SEPARA(100) IF (.NOT.(COL .GT. 1))GOTO 23108 I = COL - 1 23110 IF (.NOT.(INDEXC(SEPARA, STR(I)) .GT. 0 .AND. I .GT. 1))GOTO 23112 IF (.NOT.(RUBSTR(1) .NE. 0))GOTO 23113 CALL PUTLIN(RUBSTR, CHN) 23113 CONTINUE 23111 I=I-1 GOTO 23110 23112 CONTINUE IF (.NOT.(I .EQ. 1))GOTO 23115 IF (.NOT.(RUBSTR(1) .NE. 0))GOTO 23117 CALL PUTLIN(RUBSTR, CHN) 23117 CONTINUE GOTO 23116 23115 CONTINUE I = I + 1 23116 CONTINUE GOTO 23109 23108 CONTINUE I = 1 23109 CONTINUE PRAW10=(I) RETURN END SUBROUTINE ARGTAB(BUF) LOGICAL*1 BUF(512), N(4) INTEGER I, J, K INTEGER GETARG, ALLDIG I = 1 J = 1 23000 IF (.NOT.(GETARG( J, N, 4) .NE. -1 ))GOTO 23002 K = 1 IF (.NOT.( N(1) .EQ. 43 ))GOTO 23003 K = K + 1 23003 CONTINUE IF (.NOT.( ALLDIG( N(K) ) .EQ. 1 ))GOTO 23005 IF (.NOT.( I .GT. 1 ))GOTO 23007 CALL CHCOPY( 32, BUF, I) 23007 CONTINUE CALL STCOPY( N, 1, BUF, I) 23005 CONTINUE 23001 J = J + 1 GOTO 23000 23002 CONTINUE RETURN END INTEGER FUNCTION GTWORD( IN, I, OUT, SIZE) LOGICAL*1 IN(100), OUT(100) INTEGER I, SIZE, J, OVERFL 23009 IF (.NOT.( IN(I) .EQ. 32 .OR. IN(I) .EQ. 9 ))GOTO 23010 I = I + 1 GOTO 23009 23010 CONTINUE OVERFL = 1 J = 1 23011 IF (.NOT.(J .LE. SIZE ))GOTO 23013 IF (.NOT.( IN(I) .EQ. 0 .OR. IN(I) .EQ. 32 .OR. IN(I) .EQ. 9 .OR. *IN(I) .EQ. 10 ))GOTO 23014 OVERFL = 0 GOTO 23013 23014 CONTINUE OUT(J) = IN(I) I = I + 1 23015 CONTINUE 23012 J = J + 1 GOTO 23011 23013 CONTINUE OUT(J) = 0 IF (.NOT.( OVERFL .EQ. 1 ))GOTO 23016 23018 IF (.NOT.( IN(I) .NE. 0 .AND. IN(I) .NE. 32 .AND. IN(I) .NE. 9 .AN *D. IN(I) .NE. 10 ))GOTO 23019 I = I + 1 GOTO 23018 23019 CONTINUE 23016 CONTINUE GTWORD=( J - 1 ) RETURN END SUBROUTINE SETTAB( BUF, TABS) INTEGER I, J, K, L, M, P, PTR, TABS(512) INTEGER ALLDIG, CTOI, GTWORD LOGICAL*1 N(4), BUF(512) P = 0 I = 1 23020 IF (.NOT.(I .LE. 512 ))GOTO 23022 TABS(I) = 0 23021 I = I + 1 GOTO 23020 23022 CONTINUE PTR = 1 J = 1 23023 IF (.NOT.(GTWORD( BUF, PTR, N, 4) .GT. 0 ))GOTO 23025 K = 1 IF (.NOT.( N(1) .EQ. 43 ))GOTO 23026 K = K + 1 23026 CONTINUE IF (.NOT.( ALLDIG( N(K) ) .EQ. 0 ))GOTO 23028 GOTO 23024 23028 CONTINUE L = CTOI( N, K) IF (.NOT.( L .LE. 0 .OR. L .GT. 512 ))GOTO 23030 GOTO 23024 23030 CONTINUE IF (.NOT.( N(1) .NE. 43 ))GOTO 23032 P = L TABS(P) = 1 GOTO 23033 23032 CONTINUE IF (.NOT.( P .EQ. 0 ))GOTO 23034 P = L + 1 23034 CONTINUE M = P 23036 IF (.NOT.(M .LE. 512 ))GOTO 23038 TABS(M) = 1 23037 M = M + L GOTO 23036 23038 CONTINUE 23033 CONTINUE 23024 J = J + 1 GOTO 23023 23025 CONTINUE IF (.NOT.( P .EQ. 0 ))GOTO 23039 I = 9 23041 IF (.NOT.(I .LE. 512 ))GOTO 23043 TABS(I) = 1 23042 I = I + 8 GOTO 23041 23043 CONTINUE 23039 CONTINUE RETURN END INTEGER FUNCTION TABPOS( COL, TABS) INTEGER COL, I, TABS(512) IF (.NOT.( COL .GT. 512 ))GOTO 23044 TABPOS = 1 GOTO 23045 23044 CONTINUE TABPOS = TABS(COL) 23045 CONTINUE RETURN END SUBROUTINE TBINIT(SIZE) INTEGER SIZE COMMON/CTB/TABLE INTEGER TABLE INTEGER MKTABL CALL DSINIT(SIZE) TABLE = MKTABL(1) RETURN END SUBROUTINE TBINST( NAME, DEFN) LOGICAL*1 NAME(100), DEFN(100) COMMON/CTB/TABLE INTEGER TABLE INTEGER LOOKUP, ENTER INTEGER TEXT INTEGER SDUPL IF (.NOT.( LOOKUP( NAME, TEXT, TABLE) .EQ. 1 ))GOTO 23000 CALL DSFREE(TEXT) 23000 CONTINUE TEXT = SDUPL(DEFN) IF (.NOT.( TEXT .NE. 0 ))GOTO 23002 IF (.NOT.( ENTER( NAME, TEXT, TABLE) .EQ. 0 ))GOTO 23004 RETURN 23004 CONTINUE CALL DSFREE(TEXT) 23005 CONTINUE 23002 CONTINUE CALL REMARK( 40H? In tbinst: no room for new definition. ) RETURN END INTEGER FUNCTION TBLOOK( ID, DEFN) LOGICAL*1 ID(100), DEFN(100) COMMON/CTB/TABLE INTEGER TABLE INTEGER MEM( 1) LOGICAL*1 C MEM(2) EQUIVALENCE (C MEM(1), MEM(1)) COMMON/CDSMEM/ MEM INTEGER I, J INTEGER LOOKUP INTEGER LOCN TBLOOK = LOOKUP( ID, LOCN, TABLE) IF (.NOT.( TBLOOK .EQ. 1 ))GOTO 23006 I = 1 J = (2*(LOCN-1)+1) 23008 IF (.NOT.(CMEM(J) .NE. 0 ))GOTO 23010 DEFN(I) = CMEM(J) I = I + 1 23009 J = J + 1 GOTO 23008 23010 CONTINUE DEFN(I) = 0 GOTO 23007 23006 CONTINUE DEFN(1) = 0 23007 CONTINUE RETURN END