INTEGER FUNCTION AFETCH(BUF, I, OUT) INTEGER I, J LOGICAL*1 BUF(2048), OUT(2048) 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(2048) INTEGER SIZE(2), FSIZE(2) INTEGER I INTEGER AGTLIN, INDEXX 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 = INDEXX( 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(2048) 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(480), FILE(480), MODULE(480), BUF(2048) 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) = 1073241823 FSIZE(2) = 0 IF (.NOT.( AFETCH( NAME, I, MODULE) .LE. 0))GOTO 23032 SIZE(1) = 1073241823 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(4) INTEGER T LOGICAL*1 ST001Z(42) COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) DATA ST001Z(1)/105/,ST001Z(2)/110/,ST001Z(3)/32/,ST001Z(4)/100/,ST *001Z(5)/115/,ST001Z(6)/105/,ST001Z(7)/110/,ST001Z(8)/105/,ST001Z(9 *)/116/,ST001Z(10)/58/,ST001Z(11)/32/,ST001Z(12)/117/,ST001Z(13)/11 *0/,ST001Z(14)/114/,ST001Z(15)/101/,ST001Z(16)/97/,ST001Z(17)/115/, *ST001Z(18)/111/,ST001Z(19)/110/,ST001Z(20)/97/,ST001Z(21)/98/,ST00 *1Z(22)/108/,ST001Z(23)/121/,ST001Z(24)/32/,ST001Z(25)/115/,ST001Z( *26)/109/,ST001Z(27)/97/,ST001Z(28)/108/,ST001Z(29)/108/,ST001Z(30) */32/,ST001Z(31)/109/,ST001Z(32)/101/,ST001Z(33)/109/,ST001Z(34)/11 *1/,ST001Z(35)/114/,ST001Z(36)/121/,ST001Z(37)/32/,ST001Z(38)/115/, *ST001Z(39)/105/,ST001Z(40)/122/,ST001Z(41)/101/,ST001Z(42)/0/ IF (.NOT.( W .LT. 2 * 2 + 2 ))GOTO 23000 CALL ERROR( ST001Z ) 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(4) INTEGER P0, P, Q INTEGER N LOGICAL*1 ST002Z(46) COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) DATA ST002Z(1)/105/,ST002Z(2)/110/,ST002Z(3)/32/,ST002Z(4)/100/,ST *002Z(5)/115/,ST002Z(6)/102/,ST002Z(7)/114/,ST002Z(8)/101/,ST002Z(9 *)/101/,ST002Z(10)/58/,ST002Z(11)/32/,ST002Z(12)/32/,ST002Z(13)/97/ *,ST002Z(14)/116/,ST002Z(15)/116/,ST002Z(16)/101/,ST002Z(17)/109/,S *T002Z(18)/112/,ST002Z(19)/116/,ST002Z(20)/32/,ST002Z(21)/116/,ST00 *2Z(22)/111/,ST002Z(23)/32/,ST002Z(24)/102/,ST002Z(25)/114/,ST002Z( *26)/101/,ST002Z(27)/101/,ST002Z(28)/32/,ST002Z(29)/117/,ST002Z(30) */110/,ST002Z(31)/97/,ST002Z(32)/108/,ST002Z(33)/108/,ST002Z(34)/11 *1/,ST002Z(35)/99/,ST002Z(36)/97/,ST002Z(37)/116/,ST002Z(38)/101/,S *T002Z(39)/100/,ST002Z(40)/32/,ST002Z(41)/98/,ST002Z(42)/108/,ST002 *Z(43)/111/,ST002Z(44)/99/,ST002Z(45)/107/,ST002Z(46)/0/ 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( ST002Z ) 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(4) INTEGER P, Q, L INTEGER N, K COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) 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(4) INTEGER P, T, Q LOGICAL*1 ST003Z(27) LOGICAL*1 ST004Z(14) LOGICAL*1 ST005Z(17) LOGICAL*1 ST006Z(15) COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) DATA ST003Z(1)/42/,ST003Z(2)/42/,ST003Z(3)/32/,ST003Z(4)/68/,ST003 *Z(5)/89/,ST003Z(6)/78/,ST003Z(7)/65/,ST003Z(8)/77/,ST003Z(9)/73/,S *T003Z(10)/67/,ST003Z(11)/32/,ST003Z(12)/83/,ST003Z(13)/84/,ST003Z( *14)/79/,ST003Z(15)/82/,ST003Z(16)/65/,ST003Z(17)/71/,ST003Z(18)/69 */,ST003Z(19)/32/,ST003Z(20)/68/,ST003Z(21)/85/,ST003Z(22)/77/,ST00 *3Z(23)/80/,ST003Z(24)/32/,ST003Z(25)/42/,ST003Z(26)/42/,ST003Z(27) */0/ DATA ST004Z(1)/32/,ST004Z(2)/119/,ST004Z(3)/111/,ST004Z(4)/114/,ST *004Z(5)/100/,ST004Z(6)/115/,ST004Z(7)/32/,ST004Z(8)/105/,ST004Z(9) */110/,ST004Z(10)/32/,ST004Z(11)/117/,ST004Z(12)/115/,ST004Z(13)/10 *1/,ST004Z(14)/0/ DATA ST005Z(1)/32/,ST005Z(2)/119/,ST005Z(3)/111/,ST005Z(4)/114/,ST *005Z(5)/100/,ST005Z(6)/115/,ST005Z(7)/32/,ST005Z(8)/97/,ST005Z(9)/ *118/,ST005Z(10)/97/,ST005Z(11)/105/,ST005Z(12)/108/,ST005Z(13)/97/ *,ST005Z(14)/98/,ST005Z(15)/108/,ST005Z(16)/101/,ST005Z(17)/0/ DATA ST006Z(1)/42/,ST006Z(2)/42/,ST006Z(3)/32/,ST006Z(4)/69/,ST006 *Z(5)/78/,ST006Z(6)/68/,ST006Z(7)/32/,ST006Z(8)/68/,ST006Z(9)/85/,S *T006Z(10)/77/,ST006Z(11)/80/,ST006Z(12)/32/,ST006Z(13)/42/,ST006Z( *14)/42/,ST006Z(15)/0/ T = 2 CALL REMARK( ST003Z ) CALL PUTINT( 1, 5, 3) CALL PUTCH( 32, 3) CALL PUTINT( 2 + 1, 0, 3) CALL REMARK( ST004Z ) 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( ST005Z ) 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( ST006Z ) RETURN END SUBROUTINE DSDBIU( B, FORM) INTEGER B LOGICAL*1 FORM INTEGER MEM( 1) LOGICAL*1 C MEM(4) INTEGER L, S, LMAX, T, J LOGICAL*1 BLANKS(11) LOGICAL*1 ST007Z(14) COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) 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/ DATA ST007Z(1)/32/,ST007Z(2)/119/,ST007Z(3)/111/,ST007Z(4)/114/,ST *007Z(5)/100/,ST007Z(6)/115/,ST007Z(7)/32/,ST007Z(8)/105/,ST007Z(9) */110/,ST007Z(10)/32/,ST007Z(11)/117/,ST007Z(12)/115/,ST007Z(13)/10 *1/,ST007Z(14)/0/ CALL PUTINT( B, 5, 3) CALL PUTCH( 32, 3) CALL PUTINT( MEM( B + 0 ), 0, 3) CALL REMARK( ST007Z ) 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 = (4*(B-1)+1) J = 1 23037 IF (.NOT.(J .LE. 4 ))GOTO 23039 CALL PUTCH( CMEM(T), 3) T = T + 1 23038 J = J + 1 GOTO 23037 23039 CONTINUE L = L + 4 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(4) INTEGER ST INTEGER DSGET INTEGER I COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) 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(4) INTEGER I INTEGER BUCKET, NODE, WALKER COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) 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(2048) INTEGER INFO(2048) INTEGER MEM( 1) LOGICAL*1 C MEM(4) INTEGER BUCKET, WALKER INTEGER NODSIZ, I, J COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) 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 = (4*(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(2048) INTEGER NODE, PRED, ST INTEGER MEM( 1) LOGICAL*1 C MEM(4) INTEGER HASH, I, J, NODSIZ INTEGER EQUAL COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) 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 = (4*(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(2048) INTEGER ST INTEGER MEM( 1) LOGICAL*1 C MEM(4) INTEGER STLU INTEGER NODE, PRED COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) 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(2048) INTEGER INFO(2048) INTEGER ST INTEGER MEM( 1) LOGICAL*1 C MEM(4) INTEGER I, NODSIZ, KLUGE INTEGER STLU INTEGER NODE, PRED COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) 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(2048) INTEGER INFO(2048) INTEGER ST INTEGER MEM( 1) LOGICAL*1 C MEM(4) INTEGER I, NODSIZ, J INTEGER STLU, LENGTH INTEGER NODE, PRED INTEGER DSGET COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) NODSIZ = MEM(ST) IF (.NOT.( STLU( SYMBOL, NODE, PRED, ST) .EQ. 0 ))GOTO 23084 NODE = DSGET( 1 + NODSIZ + ( LENGTH(SYMBOL) + 4 ) / 4 ) 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 = (4*(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(2048) INTEGER MEM( 1) LOGICAL*1 C MEM(4) INTEGER I, K INTEGER LENGTH INTEGER J INTEGER DSGET COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) J = DSGET( ( LENGTH(STR) + 4 ) / 4 ) SDUPL = J IF (.NOT.( J .NE. 0 ))GOTO 23093 K = (4*(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(2048), DEFN(2048) INTEGER TABLE INTEGER LOOKUP, ENTER INTEGER TEXT INTEGER SDUPL LOGICAL*1 ST008Z(38) DATA ST008Z(1)/105/,ST008Z(2)/110/,ST008Z(3)/32/,ST008Z(4)/101/,ST *008Z(5)/110/,ST008Z(6)/116/,ST008Z(7)/100/,ST008Z(8)/101/,ST008Z(9 *)/102/,ST008Z(10)/58/,ST008Z(11)/32/,ST008Z(12)/110/,ST008Z(13)/11 *1/,ST008Z(14)/32/,ST008Z(15)/114/,ST008Z(16)/111/,ST008Z(17)/111/, *ST008Z(18)/109/,ST008Z(19)/32/,ST008Z(20)/102/,ST008Z(21)/111/,ST0 *08Z(22)/114/,ST008Z(23)/32/,ST008Z(24)/110/,ST008Z(25)/101/,ST008Z *(26)/119/,ST008Z(27)/32/,ST008Z(28)/100/,ST008Z(29)/101/,ST008Z(30 *)/102/,ST008Z(31)/105/,ST008Z(32)/110/,ST008Z(33)/105/,ST008Z(34)/ *116/,ST008Z(35)/105/,ST008Z(36)/111/,ST008Z(37)/110/,ST008Z(38)/0/ 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( ST008Z ) RETURN END INTEGER FUNCTION LUDEF( ID, DEFN, TABLE) LOGICAL*1 ID(2048), DEFN(2048) INTEGER TABLE INTEGER MEM( 1) LOGICAL*1 C MEM(4) INTEGER I, J INTEGER LOOKUP INTEGER LOCN COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) LUDEF = LOOKUP( ID, LOCN, TABLE) IF (.NOT.( LUDEF .EQ. 1 ))GOTO 23104 I = 1 J = (4*(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 SUBROUTINE RMDEF(SYMBOL, TABLE) LOGICAL*1 SYMBOL(2048) INTEGER TABLE INTEGER LOOKUP INTEGER TEXT IF (.NOT.(LOOKUP(SYMBOL, TEXT, TABLE) .EQ. 1))GOTO 23109 CALL DSFREE(TEXT) CALL DELETE(SYMBOL, TABLE) 23109 CONTINUE RETURN END INTEGER FUNCTION PHELP0( FD, BUF, NAME, SIZE) LOGICAL*1 BUF(2048), C, NAME(480) 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 REAL*8 PTRARA(PTRSIZ) LOGICAL*1 FILE(480) INTEGER PHELP0, OPEN, NOTE INTEGER SIZE LOGICAL*1 NAME,BUF COMMON/CHELP/SIZE,NAME(480),BUF(2048) 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( -1, 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 REAL*8 PTRARA(2048), OUTARA(2048) LOGICAL*1 KEY(2048) INTEGER SIZE LOGICAL*1 NAME,BUF LOGICAL*1 SUMMAR(2) LOGICAL*1 ALL(2) COMMON/CHELP/SIZE,NAME(480),BUF(2048) 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), -1) .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( -1, 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(2048) INTEGER FD INTEGER DOSUMM, I, JUNK, OUT INTEGER EQUAL, PHELP0, GETLIN, PTREQ REAL*8 OUTARA(2048) EXTERNAL PUTOUT INTEGER SIZE LOGICAL*1 NAME,BUF LOGICAL*1 SUMMAR(2) COMMON/CHELP/SIZE,NAME(480),BUF(2048) DATA SUMMAR(1)/37/,SUMMAR(2)/0/ DOSUMM = EQUAL( KEY, SUMMAR) I = 1 23022 IF (.NOT.(PTREQ( OUTARA(I), -1) .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(2048), BUF(2048) INTEGER FD INTEGER PLOG00 EXTERNAL PROMPT LOGPMT=(PLOG00(PSTR, BUF, FD, PROMPT)) RETURN END INTEGER FUNCTION LEDPMT(PSTR, BUF, FD) LOGICAL*1 PSTR(2048), BUF(2048) 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(2048), PSTR(2048), EXPSTR(25) LOGICAL*1 CLOWER INTEGER ACCESS, I, INT, JUNK, K, NOFILE INTEGER PLOG03, EDLINE, EQUAL, INDEXX, PMTRTN EXTERNAL PMTRTN INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER LOGICAL*1 TXT LOGICAL*1 NULL(1) LOGICAL*1 WHITES(4) COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG04/TXT(2048) 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 CALL PLOG23( PSTR, EXPSTR, 25) K = PMTRTN( EXPSTR, 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.( INDEXX( 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 = INDEXX( 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( EXPSTR, 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(2048) 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(2048) INTEGER CURSCR, I, LIN1, LIN2, LINE, SCREEN INTEGER CTOI, PLOG04 INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG01/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 = MAX( FRSTLN + 1, LIN1) LIN2 = MIN( 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 INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER LOGICAL*1 TXT COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG04/TXT(2048) 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(2048), SUB(132) INTEGER FINAL, GFLAG, I, JUNK, LINSTS, STATUS INTEGER PLOG08, PLOG11, PLOG12, LENGTH, PLOG16, PLOG22 LOGICAL*1 TXT INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER LOGICAL*1 BADLIN(22) LOGICAL*1 BADPAT(24) COMMON/CLOG04/TXT(2048) COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER 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( INDEXX, TYPE, VALUE) INTEGER INDEXX, TYPE INTEGER VALUE(2) INTEGER BUF,LASTBF COMMON/CLOG00/BUF(135),LASTBF IF (.NOT.( TYPE .EQ. 0 ))GOTO 23065 VALUE(1) = BUF(INDEXX) GOTO 23066 23065 CONTINUE IF (.NOT.( TYPE .EQ. 1 ))GOTO 23067 VALUE(1) = BUF( INDEXX + 1 ) GOTO 23068 23067 CONTINUE IF (.NOT.( TYPE .EQ. 3 ))GOTO 23069 VALUE(1) = BUF( INDEXX + 2 ) VALUE(2) = BUF( INDEXX + 3 ) GOTO 23070 23069 CONTINUE IF (.NOT.( TYPE .EQ. 4 ))GOTO 23071 VALUE(1) = BUF( INDEXX + 4 ) 23071 CONTINUE 23070 CONTINUE 23068 CONTINUE 23066 CONTINUE RETURN END INTEGER FUNCTION PLOG07(LIN) INTEGER LIN, K, J INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG01/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(2048) INTEGER PLOG10 INTEGER I, NUM, STATUS INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG01/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 = MIN( 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(2048) INTEGER CTOI, INDEXX, PLOG15, PLOG16, PLOG17, PLOG18 INTEGER I, PNUM, STATUS INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER LOGICAL*1 PAT LOGICAL*1 DIGITS(11) COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG02/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/ PLOG09 = 0 IF (.NOT.( INDEXX( 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(2048) INTEGER PLOG09 INTEGER I, ISTART, MUL, NUM, PNUM, STATUS INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG01/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(2048), SUB(132) INTEGER INDEXX, 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.( INDEXX( 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) INTEGER BUF,LASTBF INTEGER SCR,SCREND LOGICAL*1 SCRFIL LOGICAL*1 TXT INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER LOGICAL*1 NULL(1) COMMON/CLOG00/BUF(135),LASTBF COMMON/CLOG03/SCR,SCREND(2),SCRFIL(480) COMMON/CLOG04/TXT(2048) COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER 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) INTEGER BUF,LASTBF COMMON/CLOG00/BUF(135),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(2048) INTEGER PLOG13, NOTE INTEGER K1, NEWIND, JUNK INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER SCR,SCREND LOGICAL*1 SCRFIL COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG03/SCR,SCREND(2),SCRFIL(480) 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 INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG01/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(2048) INTEGER INDEXX, LENGTH, MAKPAT INTEGER I, J, TYPE LOGICAL*1 PAT COMMON/CLOG02/PAT(132) 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.( INDEXX( 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 INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG01/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 INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER LOGICAL*1 PAT LOGICAL*1 TXT COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG02/PAT(132) COMMON/CLOG04/TXT(2048) 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( INDEXX, TYPE, VALUE) INTEGER INDEXX, TYPE INTEGER VALUE(2) INTEGER BUF,LASTBF COMMON/CLOG00/BUF(135),LASTBF IF (.NOT.( TYPE .EQ. 0 ))GOTO 23167 BUF(INDEXX) = VALUE(1) GOTO 23168 23167 CONTINUE IF (.NOT.( TYPE .EQ. 1 ))GOTO 23169 BUF( INDEXX + 1 ) = VALUE(1) GOTO 23170 23169 CONTINUE IF (.NOT.( TYPE .EQ. 3 ))GOTO 23171 BUF( INDEXX + 2 ) = VALUE(1) BUF( INDEXX + 3 ) = VALUE(2) GOTO 23172 23171 CONTINUE IF (.NOT.( TYPE .EQ. 4 ))GOTO 23173 BUF( INDEXX + 4 ) = VALUE(1) 23173 CONTINUE 23172 CONTINUE 23170 CONTINUE 23168 CONTINUE RETURN END SUBROUTINE PLOG21 INTEGER CREATE INTEGER PLOG13, NOTE INTEGER JUNK, K INTEGER BUF,LASTBF INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER INTEGER SCR,SCREND LOGICAL*1 SCRFIL LOGICAL*1 FIL(4) COMMON/CLOG00/BUF(135),LASTBF COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG03/SCR,SCREND(2),SCRFIL(480) 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(2048), OLD(2048), SUB(132) INTEGER ADDSET, AMATCH INTEGER GFLAG, J, JUNK, K, LASTM, M, SUBBED INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER LOGICAL*1 PAT COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG02/PAT(132) 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, 2048) LASTM = M 23182 CONTINUE IF (.NOT.( M .EQ. 0 .OR. M .EQ. K ))GOTO 23184 JUNK = ADDSET( OLD(K), NEW, J, 2048) K = K + 1 GOTO 23185 23184 CONTINUE K = M 23185 CONTINUE 23178 GOTO 23177 23179 CONTINUE IF (.NOT.( ADDSET( 0, NEW, J, 2048) .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(480) LOGICAL*1 GETCH INTEGER CREATE, OPEN INTEGER ACCESS, OUT, JUNK INTEGER REMOVE INTEGER SCR,SCREND LOGICAL*1 SCRFIL COMMON/CLOG03/SCR,SCREND(2),SCRFIL(480) 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 SUBROUTINE PLOG23(IPSTR, OPSTR, SIZE) LOGICAL*1 IPSTR(2048), OPSTR(2048) INTEGER I, J, K, JUNK, SIZE INTEGER ITOC LOGICAL*1 TEMP(6) INTEGER LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER COMMON/CLOG01/LINE1,LINE2,NLINES,CURLN,FRSTLN,LASTLN,NUMBER I = 1 J = 1 23198 IF (.NOT.(IPSTR(I) .NE. 0))GOTO 23200 IF (.NOT.(IPSTR(I) .EQ. 33))GOTO 23201 JUNK = ITOC(NUMBER, TEMP, 6) K = 1 23203 IF (.NOT.(TEMP(K) .NE. 0))GOTO 23205 OPSTR(J) = TEMP(K) 23204 K = K + 1 J = MIN(J + 1, SIZE) GOTO 23203 23205 CONTINUE J = J - 1 GOTO 23202 23201 CONTINUE IF (.NOT.(IPSTR(I) .EQ. 64 .AND. IPSTR(I+1) .NE. 0))GOTO 23206 I = I + 1 23206 CONTINUE OPSTR(J) = IPSTR(I) 23202 CONTINUE 23199 I = I + 1 J = MIN(J + 1, SIZE) GOTO 23198 23200 CONTINUE OPSTR(J) = 0 RETURN END INTEGER FUNCTION IMINIT( MEMSIZ, AVETOK) INTEGER MEMSIZ, AVETOK INTEGER MEM( 1) LOGICAL*1 C MEM(4) INTEGER PTRSIZ INTEGER TABLE INTEGER DSGET COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) CALL DSINIT(MEMSIZ) PTRSIZ = 3 + ( MEMSIZ / ( 1 + AVETOK / 4 ) ) 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(2048) INTEGER MEM( 1) LOGICAL*1 C MEM(4) INTEGER I COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) 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(4) INTEGER IMCOMP INTEGER I, J, LV(20), P, PIVLIN, UV(20) COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) 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(2048) INTEGER MEM( 1) LOGICAL*1 C MEM(4) INTEGER TEXT INTEGER SDUPL INTEGER I COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) 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) = (4*(TEXT-1)+1) IMPUT = 0 23024 CONTINUE 23022 CONTINUE RETURN END SUBROUTINE IMEXCH( LP1, LP2, LINBUF) LOGICAL*1 LINBUF(2048) 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(2048) 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(4) INTEGER IMCOMP INTEGER LAST, OUT, CUR, NEXT COMMON/CDSMEM/MEM EQUIVALENCE (CMEM(1),MEM(1)) 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(4) COMMON/CDSMEM/MEM EQUIVALENCE (CMEM(1),MEM(1)) MEM (TABLE + 1) = TABLE + 3 - 1 RETURN END INTEGER FUNCTION LNEDIT( PSTR, LIN, ICHN) LOGICAL*1 OLDCMD INTEGER CMDNUM, I, ICHN, IMODE, J, JUNK, K, LEN, OCHN, OMODE, SAVM *OD INTEGER INDEXX, LENGTH, PROMPT, LE_RECOGF, LE_SCNBCK, SPAWN, LE_SP *NBCK, STMODE, ISATTY INTEGER LE_GTHIST, LE_RAWIO LOGICAL*1 LIN(2048), PID(9), PSTR(2048), TMP(480) LOGICAL*1 C LOGICAL*1 LE_LEDIT LOGICAL*1 BSBLBS(4), CRLF(3), CTRLR(5), CTRLU(5), CTRLZ(5) LOGICAL*1 RUBCMD(4), WRDRUB(6) LOGICAL*1 LE_NGETCH LOGICAL*1 BOL(2) LOGICAL*1 DSTR(3) LOGICAL*1 PTHTRM(4) LOGICAL*1 FILTRM(6) LOGICAL*1 FLDTRM(7) LOGICAL*1 ST001Z(11) LOGICAL*1 ST002Z(8) COMMON /COLDCM/ OLDCMD(2048) DATA BOL(1)/37/,BOL(2)/0/ DATA DSTR(1)/100/,DSTR(2)/32/,DSTR(3)/0/ DATA PTHTRM(1)/32/,PTHTRM(2)/47/,PTHTRM(3)/92/,PTHTRM(4)/0/ DATA FILTRM(1)/32/,FILTRM(2)/44/,FILTRM(3)/60/,FILTRM(4)/62/,FILTR *M(5)/64/,FILTRM(6)/0/ DATA FLDTRM(1)/32/,FLDTRM(2)/47/,FLDTRM(3)/92/,FLDTRM(4)/64/,FLDTR *M(5)/126/,FLDTRM(6)/62/,FLDTRM(7)/0/ DATA BSBLBS/8, 32, 8, 0/ DATA CRLF/13, 10, 0/ DATA CTRLR/94, 82, 13, 10, 0/ DATA CTRLU/94, 85, 13, 10, 0/ DATA CTRLZ/94, 90, 13, 10, 0/ DATA RUBCMD/5, 120, 26, 0/ DATA WRDRUB/32, 5, 66, 68, 26, 0/ DATA OCHN /-1/ DATA ST001Z(1)/94/,ST001Z(2)/68/,ST001Z(3)/105/,ST001Z(4)/114/,ST0 *01Z(5)/101/,ST001Z(6)/99/,ST001Z(7)/116/,ST001Z(8)/111/,ST001Z(9)/ *114/,ST001Z(10)/121/,ST001Z(11)/0/ DATA ST002Z(1)/94/,ST002Z(2)/65/,ST002Z(3)/112/,ST002Z(4)/112/,ST0 *02Z(5)/101/,ST002Z(6)/110/,ST002Z(7)/100/,ST002Z(8)/0/ IF (.NOT.( LE_RAWIO( ICHN, OCHN, SAVMOD) .EQ. 0 ))GOTO 23000 LNEDIT=( PROMPT( PSTR, LIN, ICHN)) RETURN 23000 CONTINUE I = 1 CALL PUTLIN( CRLF, OCHN) CALL PUTLIN( PSTR, OCHN) LIN(1) = 0 23002 CONTINUE C = LE_NGETCH( C, ICHN) IF (.NOT.( C .EQ. 26 ))GOTO 23005 CALL PUTLIN( CTRLZ, OCHN) LNEDIT = -1 LIN(1) = 0 RETURN 23005 CONTINUE IF (.NOT.( C .EQ. 13 ))GOTO 23007 GOTO 23004 23007 CONTINUE IF (.NOT.( C .EQ. 10 ))GOTO 23009 CALL PUTCH( 10, OCHN) GOTO 23010 23009 CONTINUE IF (.NOT.( C .EQ. 8 .OR. C .EQ. 127 ))GOTO 23011 IF (.NOT.( I .GT. 1 ))GOTO 23013 IF (.NOT.( LIN(I-1) .EQ. 9 ))GOTO 23015 CALL LE_PBSTR( RUBCMD) GOTO 23016 23015 CONTINUE CALL PUTLIN(BSBLBS, OCHN) I = I - 1 LIN(I) = 0 23016 CONTINUE GOTO 23014 23013 CONTINUE LIN(I) = 0 23014 CONTINUE GOTO 23012 23011 CONTINUE IF (.NOT.( C .EQ. 21 ))GOTO 23017 CALL PUTLIN( CTRLU, OCHN) CALL PUTLIN( PSTR, OCHN) I = 1 LIN(I) = 0 GOTO 23018 23017 CONTINUE IF (.NOT.( C .EQ. 18 ))GOTO 23019 CALL PUTLIN( CTRLR, OCHN) LIN(I) = 0 CALL PUTLIN( PSTR, OCHN) CALL PUTLIN( LIN, OCHN) GOTO 23020 23019 CONTINUE IF (.NOT.( C .EQ. 23 ))GOTO 23021 CALL LE_PBSTR( WRDRUB) GOTO 23022 23021 CONTINUE IF (.NOT.( C .EQ. 6 .OR. C .EQ. 27 ))GOTO 23023 LIN(I) = 0 J = LE_SCNBCK( LIN, I, 0, OCHN, FILTRM) CALL SCOPY( LIN, J, TMP, 1) LEN = LENGTH(TMP) IF (.NOT.( LE_RECOGF(TMP) .NE. -3 ))GOTO 23025 IF (.NOT.( TMP(LEN+1) .NE. 0 ))GOTO 23027 CALL SCOPY( TMP, LEN+1, LIN, I) CALL PUTLIN( LIN(I), OCHN) I = LENGTH(LIN) + 1 GOTO 23028 23027 CONTINUE J = LE_SCNBCK( LIN, I, 0, OCHN, FILTRM) K = 1 CALL STCOPY( DSTR, 1, TMP, K) CALL SCOPY( LIN, J, TMP, K) J = LE_SCNBCK( TMP(K), LENGTH(TMP(K))+1, 0, OCHN, PTHTRM) + K - 1 CALL LE_INSSTR( BOL, TMP, J) CALL PUTLIN( CRLF, OCHN) CALL LE_SPAWND( TMP) CALL PUTLIN( CRLF, OCHN) CALL PUTLIN( PSTR, OCHN) LIN(I) = 0 CALL PUTLIN( LIN, OCHN) 23028 CONTINUE GOTO 23026 23025 CONTINUE CALL PUTCH( 7, OCHN) 23026 CONTINUE GOTO 23024 23023 CONTINUE IF (.NOT.( C .EQ. 4 ))GOTO 23029 CALL PUTLIN( ST001Z, OCHN) CALL PUTLIN( CRLF, OCHN) CALL LE_SPAWND( DSTR) CALL PUTLIN( CRLF, OCHN) CALL PUTLIN( PSTR, OCHN) LIN(I) = 0 CALL PUTLIN( LIN, OCHN) GOTO 23030 23029 CONTINUE IF (.NOT.( C .EQ. 1 ))GOTO 23031 IF (.NOT.( LIN(1) .EQ. 33 ))GOTO 23033 I = LE_GTHIST( LIN, I) GOTO 23034 23033 CONTINUE I = 1 CALL STCOPY( OLDCMD, 1, LIN, I) 23034 CONTINUE CALL PUTLIN( ST002Z, OCHN) CALL PUTLIN( CRLF, OCHN) CALL PUTLIN( PSTR, OCHN) CALL PUTLIN( LIN, OCHN) GOTO 23032 23031 CONTINUE IF (.NOT.( C .EQ. 5 ))GOTO 23035 IF (.NOT.( (I .EQ. 1 .AND. LIN(I) .EQ. 0) .OR. LIN(1) .EQ. 33 ))GO *TO 23037 IF (.NOT.( LIN(1) .EQ. 33 ))GOTO 23039 I = LE_GTHIST( LIN, I) I = 1 CALL PUTLIN( CRLF, OCHN) CALL PUTLIN( PSTR, OCHN) GOTO 23040 23039 CONTINUE CALL STRCPY( OLDCMD, LIN) 23040 CONTINUE CALL PUTLIN( LIN, OCHN) CALL PUTCH( 13, OCHN) CALL PUTLIN( PSTR, OCHN) GOTO 23038 23037 CONTINUE IF (.NOT.( I .GT. 1 ))GOTO 23041 I = I - 1 CALL PUTCH( 8, OCHN) 23041 CONTINUE 23038 CONTINUE C = LE_LEDIT( PSTR, LIN, I, ICHN, OCHN) IF (.NOT.( LIN(I) .NE. 0 ))GOTO 23043 CALL PUTCH( LIN(I), OCHN) I = I + 1 23043 CONTINUE IF (.NOT.( C .EQ. 13 ))GOTO 23045 GOTO 23004 23045 CONTINUE GOTO 23036 23035 CONTINUE IF (.NOT.( C .EQ. 11 ))GOTO 23047 J = 1 23049 IF (.NOT.(J .LE. 8 ))GOTO 23051 CALL PUTCH( 10, OCHN) 23050 J = J + 1 GOTO 23049 23051 CONTINUE GOTO 23048 23047 CONTINUE IF (.NOT.( C .EQ. 12 ))GOTO 23052 J = 1 23054 IF (.NOT.(J .LE. 24 ))GOTO 23056 CALL PUTCH( 10, OCHN) 23055 J = J + 1 GOTO 23054 23056 CONTINUE GOTO 23053 23052 CONTINUE IF (.NOT.( C .LT. 32 .AND. C .NE. 9 ))GOTO 23057 CALL PUTCH( 7, OCHN) GOTO 23058 23057 CONTINUE LIN(I) = C I = I + 1 LIN(I) = 0 CALL PUTCH( C, OCHN) 23058 CONTINUE 23053 CONTINUE 23048 CONTINUE 23036 CONTINUE 23032 CONTINUE 23030 CONTINUE 23024 CONTINUE 23022 CONTINUE 23020 CONTINUE 23018 CONTINUE 23012 CONTINUE 23010 CONTINUE 23008 CONTINUE 23006 CONTINUE 23003 GOTO 23002 23004 CONTINUE CALL PUTCH( 13, OCHN) IF (.NOT.( LIN(1) .NE. 0 ))GOTO 23059 LIN(I) = 0 CALL STRCPY( LIN, OLDCMD) 23059 CONTINUE LIN(I) = 10 LIN(I+1) = 0 SAVMOD = STMODE( ICHN, SAVMOD) LNEDIT=(I) RETURN END INTEGER FUNCTION LE_ALPHAN(C) LOGICAL*1 C INTEGER TYPE IF (.NOT.( TYPE(C) .EQ. 1 .OR. TYPE(C) .EQ. 2 ))GOTO 23061 LE_ALPHAN = 1 GOTO 23062 23061 CONTINUE LE_ALPHAN = 0 23062 CONTINUE RETURN END SUBROUTINE LE_BCKUPC( OCHN, ERASE) LOGICAL*1 C INTEGER ERASE, I, OCHN INTEGER TABPOS INTEGER HASTAB INTEGER LC1 INTEGER NC INTEGER NMAXPC INTEGER NPC INTEGER OC INTEGER OMAXPC INTEGER OPC INTEGER PC1 INTEGER QP INTEGER TABS INTEGER UNDCUR LOGICAL*1 FL LOGICAL*1 NL LOGICAL*1 NPL LOGICAL*1 OL LOGICAL*1 OPL LOGICAL*1 OQ LOGICAL*1 TMPLIN LOGICAL*1 UNDLIN LOGICAL*1 BS(2), BSBLBS(4), RUBSTR(4) COMMON /CLEDIT/ HASTAB, LC1, NC, NMAXPC, NPC, OC, OMAXPC, OPC, PC1 *, QP, TABS(2048), UNDCUR, FL(2048), NL(2048), NPL(2048), OL(2048), * OPL(2048), OQ(2048), TMPLIN(2048), UNDLIN(2048) DATA BS /8, 0/ DATA BSBLBS /8, 32, 8, 0/ IF (.NOT.( ERASE .EQ. 1 ))GOTO 23063 CALL STRCPY( BSBLBS, RUBSTR) GOTO 23064 23063 CONTINUE CALL STRCPY( BS, RUBSTR) 23064 CONTINUE C = OPL(OPC-1) IF (.NOT.( C .EQ. 9 ))GOTO 23065 CALL LE_PUTSTQ( BS, OCHN) I = OPC 23067 IF (.NOT.(TABPOS( I, TABS) .EQ. 0 .AND. I .GT. 1 .AND. OPL(I-1) .E *Q. 9 ))GOTO 23069 CALL LE_PUTSTQ( BS, OCHN) 23068 I = I - 1 GOTO 23067 23069 CONTINUE GOTO 23066 23065 CONTINUE IF (.NOT.( C .EQ. 32 ))GOTO 23070 CALL LE_PUTSTQ( BS, OCHN) GOTO 23071 23070 CONTINUE CALL LE_PUTSTQ( RUBSTR, OCHN) 23071 CONTINUE 23066 CONTINUE RETURN END INTEGER FUNCTION LE_D2EOL( OCHN) INTEGER I, I1, I2, OCHN INTEGER HASTAB INTEGER LC1 INTEGER NC INTEGER NMAXPC INTEGER NPC INTEGER OC INTEGER OMAXPC INTEGER OPC INTEGER PC1 INTEGER QP INTEGER TABS INTEGER UNDCUR LOGICAL*1 FL LOGICAL*1 NL LOGICAL*1 NPL LOGICAL*1 OL LOGICAL*1 OPL LOGICAL*1 OQ LOGICAL*1 TMPLIN LOGICAL*1 UNDLIN COMMON /CLEDIT/ HASTAB, LC1, NC, NMAXPC, NPC, OC, OMAXPC, OPC, PC1 *, QP, TABS(2048), UNDCUR, FL(2048), NL(2048), NPL(2048), OL(2048), * OPL(2048), OQ(2048), TMPLIN(2048), UNDLIN(2048) I1 = OPC I2 = OMAXPC I = I1 23072 IF (.NOT.(I .LE. I2 ))GOTO 23074 CALL LE_PUTCHQ( 32, OCHN) 23073 I = I + 1 GOTO 23072 23074 CONTINUE LE_D2EOL = I2 - I1 + 1 RETURN END INTEGER FUNCTION LE_DNOISE( FIL) LOGICAL*1 FIL(2048) INTEGER I, ISDIR INTEGER EQUAL, LENGTH LOGICAL*1 DOT1(3) LOGICAL*1 DOTDIR(5) DATA DOT1(1)/46/,DOT1(2)/49/,DOT1(3)/0/ DATA DOTDIR(1)/46/,DOTDIR(2)/100/,DOTDIR(3)/105/,DOTDIR(4)/114/,DO *TDIR(5)/0/ I = LENGTH( FIL) IF (.NOT.( I .GT. 2 ))GOTO 23075 IF (.NOT.( EQUAL( FIL(I-1), DOT1) ))GOTO 23077 I = I - 2 FIL(I+1) = 0 23077 CONTINUE 23075 CONTINUE IF (.NOT.( FIL(I) .EQ. 46 .AND. I .NE. 1 ))GOTO 23079 FIL(I) = 0 I = I - 1 23079 CONTINUE ISDIR = 0 IF (.NOT.( I .GT. 3 ))GOTO 23081 IF (.NOT.( EQUAL( FIL(I-3), DOTDIR) ))GOTO 23083 I = I - 3 FIL(I) = 47 FIL(I+1) = 0 ISDIR = 1 23083 CONTINUE 23081 CONTINUE LE_DNOISE = ISDIR RETURN END INTEGER FUNCTION LE_DS( INPSTR, OUTSTR) LOGICAL*1 BUF(2048), NAME(480), DIREC(480) LOGICAL*1 PAT(2048), PATH(480), TMPNAM(480) LOGICAL*1 INPSTR(2048), OUTSTR(2048) INTEGER J, I, JUNK, GTFTOK, DIRFID, LE_DNOISE INTEGER LE_FGDRPR, LE_FOPEND, FOUND, LENGTH INTEGER DEPTH, PTR(10) INTEGER LEN, EQUAL, LE_LNGEST, PATLEN FOUND = 0 LEN = LENGTH(INPSTR) IF (.NOT.( LEN .EQ. 0 .OR. INPSTR(LEN) .EQ. 47 ))GOTO 23085 INPSTR(LEN+1) = 42 INPSTR(LEN+2) = 0 23085 CONTINUE CALL FOLD(INPSTR) CALL RESDEF( INPSTR, PATH) CALL EXPPTH(PATH, DEPTH, PTR, BUF) J = PTR(DEPTH) PAT(1) = 0 JUNK = GTFTOK(PATH, J, PAT) J = PTR(DEPTH) PATH(J) = 0 CALL DIRFIL(PATH, NAME, DIREC) IF (.NOT.( LE_FOPEND( NAME, DIRFID) .EQ. -3 ))GOTO 23087 LE_DS = 0 RETURN 23087 CONTINUE PATLEN = LENGTH(PAT) 23089 IF (.NOT.( LE_FGDRPR( DIRFID, NAME) .EQ. 0 ))GOTO 23090 CALL STRCPY( NAME, TMPNAM) TMPNAM(PATLEN+1) = 0 IF (.NOT.( EQUAL( TMPNAM, PAT) .EQ. 0 .AND. PAT(1) .NE. 42 ))GOTO *23091 GOTO 23089 23091 CONTINUE JUNK = LE_DNOISE( NAME) IF (.NOT.( FOUND .EQ. 0 ))GOTO 23093 CALL STRCPY( NAME, OUTSTR) FOUND = 1 23093 CONTINUE I = LE_LNGEST( NAME, OUTSTR) OUTSTR(I+1) = 0 GOTO 23089 23090 CONTINUE CALL LE_FCLOSD( DIRFID) LE_DS = FOUND RETURN END SUBROUTINE LE_FCLOSD( FD) INTEGER FD CALL CLOSE(FD) RETURN END INTEGER FUNCTION LE_FGDRPR( FD, FIL) LOGICAL*1 FIL(2048) LOGICAL*1 BUF(2048) INTEGER FD INTEGER COUNT, FDB, I, J, JUNK, LEN, N INTEGER GETFDB, GETS, ITOC, LENGTH INTEGER*4 VERS LOGICAL*1 TMP(4), LOW, HIGH EQUIVALENCE (TMP(1),VERS), (LOW,TMP(1)), (HIGH,TMP(2)) DATA J /0/ DATA N /0/ DATA VERS /0/ FDB = GETFDB(FD) IF (.NOT.( J .GE. N ))GOTO 23095 N = GETS( FDB, BUF, 2048) IF (.NOT.( N .EQ. -3 ))GOTO 23097 LE_FGDRPR = -3 FIL(1) = 0 RETURN 23097 CONTINUE COUNT = BUF(4) J = 5 I = 1 23099 IF (.NOT.(I .LE. COUNT ))GOTO 23101 FIL(I) = BUF(J) J = J + 1 23100 I = I + 1 GOTO 23099 23101 CONTINUE FIL(I) = 46 I = I + 1 IF (.NOT.( MOD( J, 2) .EQ. 0 ))GOTO 23102 J = J + 1 23102 CONTINUE LEN = I 23095 CONTINUE I = LEN LOW = BUF(J) HIGH = BUF(J+1) J = J + 8 JUNK = ITOC(VERS, FIL(I), 10) I = LENGTH(FIL) + 1 FIL(I) = 0 CALL FOLD(FIL) LE_FGDRPR = 0 RETURN END SUBROUTINE LE_FLUSHQ( OCHN) INTEGER OCHN INTEGER HASTAB INTEGER LC1 INTEGER NC INTEGER NMAXPC INTEGER NPC INTEGER OC INTEGER OMAXPC INTEGER OPC INTEGER PC1 INTEGER QP INTEGER TABS INTEGER UNDCUR LOGICAL*1 FL LOGICAL*1 NL LOGICAL*1 NPL LOGICAL*1 OL LOGICAL*1 OPL LOGICAL*1 OQ LOGICAL*1 TMPLIN LOGICAL*1 UNDLIN COMMON /CLEDIT/ HASTAB, LC1, NC, NMAXPC, NPC, OC, OMAXPC, OPC, PC1 *, QP, TABS(2048), UNDCUR, FL(2048), NL(2048), NPL(2048), OL(2048), * OPL(2048), OQ(2048), TMPLIN(2048), UNDLIN(2048) OQ(QP) = 0 CALL PUTLIN( OQ, OCHN) QP = 1 OQ(QP) = 0 RETURN END INTEGER FUNCTION LE_FOPEND( FIL, FD) LOGICAL*1 FIL(2048) INTEGER FD INTEGER OPEN FD = OPEN( FIL, 1) LE_FOPEND = FD RETURN END INTEGER FUNCTION LE_GTHIST( LIN, I) LOGICAL*1 LIN(2048) INTEGER I, J INTEGER EDLINE LIN(I) = 10 LIN( I + 1 ) = 0 J = EDLINE(LIN) IF (.NOT.( J .LT. 1 ))GOTO 23104 J = 1 23104 CONTINUE LIN(J) = 0 LE_GTHIST=(J) RETURN END SUBROUTINE LE_INSSTR( S1, S2, I) LOGICAL*1 S1(2048), S2(2048), T(2048) INTEGER I, J CALL SCOPY( S2, I, T, 1) J = I CALL STCOPY( S1, 1, S2, J) CALL STCOPY( T, 1, S2, J) RETURN END LOGICAL*1 FUNCTION LE_LEDIT( PSTR, LIN, CUR, ICHN, OCHN) INTEGER HASTAB INTEGER LC1 INTEGER NC INTEGER NMAXPC INTEGER NPC INTEGER OC INTEGER OMAXPC INTEGER OPC INTEGER PC1 INTEGER QP INTEGER TABS INTEGER UNDCUR LOGICAL*1 FL LOGICAL*1 NL LOGICAL*1 NPL LOGICAL*1 OL LOGICAL*1 OPL LOGICAL*1 OQ LOGICAL*1 TMPLIN LOGICAL*1 UNDLIN INTEGER CUR, ICHN, I, J, N, OCHN, STATUS INTEGER ADDSTR, INDEXX, LE_LL2PL, LENGTH, MAX, MIN INTEGER SAVCUR, LE_SCN4CH, LE_SCNBBW, LE_SCNBLW, LE_SCNEBW, LE_SCN *ELW, TYPE LOGICAL*1 C, LIN(2048), PSTR(2048), SAVLIN(2048) LOGICAL*1 CTRLR(5), DELSTR(4), FINSTR(3) LOGICAL*1 LE_NGETCH, LE_NGTNUM INTEGER I23109 INTEGER I23149 LOGICAL*1 ST003Z(3) LOGICAL*1 ST004Z(3) LOGICAL*1 ST005Z(2) LOGICAL*1 ST006Z(2) LOGICAL*1 ST007Z(2) LOGICAL*1 ST008Z(2) LOGICAL*1 ST009Z(3) INTEGER I23212 COMMON /CLEDIT/ HASTAB, LC1, NC, NMAXPC, NPC, OC, OMAXPC, OPC, PC1 *, QP, TABS(2048), UNDCUR, FL(2048), NL(2048), NPL(2048), OL(2048), * OPL(2048), OQ(2048), TMPLIN(2048), UNDLIN(2048) DATA CTRLR /94, 82, 13, 10, 0/ DATA DELSTR /100, 32, 0, 0/ DATA FINSTR /102, 32, 0/ DATA ST003Z(1)/100/,ST003Z(2)/32/,ST003Z(3)/0/ DATA ST004Z(1)/100/,ST004Z(2)/36/,ST004Z(3)/0/ DATA ST005Z(1)/36/,ST005Z(2)/0/ DATA ST006Z(1)/97/,ST006Z(2)/0/ DATA ST007Z(1)/37/,ST007Z(2)/0/ DATA ST008Z(1)/105/,ST008Z(2)/0/ DATA ST009Z(1)/99/,ST009Z(2)/36/,ST009Z(3)/0/ HASTAB = 0 CALL LE_LEINIT( PSTR, LIN, CUR, OCHN) CALL STRCPY( NL, SAVLIN) SAVCUR = NC CALL LE_SAVELN( NL, NC) CALL LE_UPDLIN( OCHN) 23106 CONTINUE N = 0 C = LE_NGTNUM(N, ICHN) I23109=(C) GOTO 23109 23111 CONTINUE CALL STRCPY( UNDLIN, NL) NC = UNDCUR CALL LE_SAVELN( OL, OC) GOTO 23110 23112 CONTINUE CALL STRCPY( SAVLIN, NL) NC = SAVCUR CALL LE_SAVELN( OL, OC) GOTO 23110 23113 CONTINUE IF (.NOT.( OL(OC) .NE. 0 ))GOTO 23114 CALL LE_PUTCHQ( OL(OC), OCHN) 23114 CONTINUE CALL LE_PUTSTF( CTRLR, OCHN) OL(1) = 0 OC = 1 CALL LE_PUTSTF( PSTR, OCHN) GOTO 23110 23116 CONTINUE IF (.NOT.( NC + N .GT. LENGTH(OL) + 1 ))GOTO 23117 N = LENGTH(OL) - NC + 1 23117 CONTINUE NC = NC + N GOTO 23110 23119 CONTINUE IF (.NOT.( N .GE. NC ))GOTO 23120 N = NC - 1 23120 CONTINUE NC = NC - N GOTO 23110 23122 CONTINUE NC = 1 GOTO 23110 23123 CONTINUE NC = LENGTH(OL) GOTO 23110 23124 CONTINUE NC = LE_SCNBLW( OL, OC, N) GOTO 23110 23125 CONTINUE NC = LE_SCNBBW( OL, OC, N) GOTO 23110 23126 CONTINUE NC = LE_SCNELW( OL, OC, N) GOTO 23110 23127 CONTINUE NC = LE_SCNEBW( OL, OC, N) GOTO 23110 23128 CONTINUE FINSTR(1) = C C = LE_NGETCH( C, ICHN) IF (.NOT.( (C .GE. 32 .OR. C .EQ. 9) .AND. OL(OC) .NE. 0 ))GOTO 23 *129 FINSTR(2) = C NC = LE_SCN4CH( OL, OC, C, N) 23129 CONTINUE GOTO 23110 23131 CONTINUE FINSTR(1) = C C = LE_NGETCH( C, ICHN) IF (.NOT.( (C .GE. 32 .OR. C .EQ. 9) .AND. LENGTH(OL) .GT. OC + 1 *))GOTO 23132 FINSTR(2) = C NC = LE_SCN4CH( OL, OC+1, C, N) - 1 23132 CONTINUE GOTO 23110 23134 CONTINUE FINSTR(1) = C C = LE_NGETCH( C, ICHN) I = INDEXX( OL, C) IF (.NOT.( (C .GE. 32 .OR. C .EQ. 9) .AND. I .GT. 0 .AND. I .LT. O *C ))GOTO 23135 FINSTR(2) = C N = -N NC = LE_SCN4CH( OL, OC, C, N) N = -N 23135 CONTINUE GOTO 23110 23137 CONTINUE FINSTR(1) = C C = LE_NGETCH( C, ICHN) I = INDEXX( OL, C) IF (.NOT.( (C .GE. 32 .OR. C .EQ. 9) .AND. I .GT. 0 .AND. I .LT. O *C - 1 ))GOTO 23138 FINSTR(2) = C N = -N NC = LE_SCN4CH( OL, OC-2, C, N) + 1 N = -N 23138 CONTINUE GOTO 23110 23140 CONTINUE CALL LE_PBCMD( 0, N, FINSTR) GOTO 23110 23141 CONTINUE IF (.NOT.( FINSTR(1) .EQ. 102 ))GOTO 23142 FINSTR(1) = 70 GOTO 23143 23142 CONTINUE IF (.NOT.( FINSTR(1) .EQ. 70 ))GOTO 23144 FINSTR(1) = 102 GOTO 23145 23144 CONTINUE IF (.NOT.( FINSTR(1) .EQ. 116 ))GOTO 23146 FINSTR(1) = 84 GOTO 23147 23146 CONTINUE FINSTR(1) = 116 23147 CONTINUE 23145 CONTINUE 23143 CONTINUE CALL LE_PBCMD( 0, N, FINSTR) GOTO 23110 23148 CONTINUE CALL LE_SAVELN( OL, OC) C = LE_NGTNUM( N, ICHN) I23149=(C) GOTO 23149 23151 CONTINUE NL(NC) = 0 GOTO 23150 23152 CONTINUE CALL SCOPY( OL, OC+1, NL, 1) NC = 1 GOTO 23150 23153 CONTINUE DELSTR(2) = C DELSTR(3) = 0 NL(1) = 0 NC = 1 GOTO 23150 23154 CONTINUE DELSTR(2) = C DELSTR(3) = 0 IF (.NOT.( OC + N .GT. LENGTH(OL) + 1 ))GOTO 23155 N = LENGTH(OL) - OC + 1 23155 CONTINUE CALL SCOPY( OL, OC+N, NL, OC) GOTO 23150 23157 CONTINUE DELSTR(2) = C DELSTR(3) = 0 IF (.NOT.( C .EQ. 119 ))GOTO 23158 I = LE_SCNBLW( OL, OC, N) GOTO 23159 23158 CONTINUE IF (.NOT.( C .EQ. 87 ))GOTO 23160 I = LE_SCNBBW( OL, OC, N) GOTO 23161 23160 CONTINUE IF (.NOT.( C .EQ. 101 ))GOTO 23162 I = LE_SCNELW( OL, OC, N) GOTO 23163 23162 CONTINUE I = LE_SCNEBW( OL, OC, N) 23163 CONTINUE 23161 CONTINUE 23159 CONTINUE IF (.NOT.( OL(I) .NE. 0 .AND. OL(I+1) .NE. 0 .AND. ( C .EQ. 101 .O *R. C .EQ. 69 ) ))GOTO 23164 I = I + 1 23164 CONTINUE IF (.NOT.( I .EQ. OC .AND. OL(I+1) .EQ. 0 ))GOTO 23166 I = I + 1 23166 CONTINUE CALL SCOPY( OL, I, NL, NC) GOTO 23150 23168 CONTINUE DELSTR(2) = C DELSTR(3) = 0 N = -N IF (.NOT.( C .EQ. 98 ))GOTO 23169 NC = LE_SCNBLW( OL, OC, N) GOTO 23170 23169 CONTINUE NC = LE_SCNBBW( OL, OC, N) 23170 CONTINUE N = -N IF (.NOT.( NC .EQ. OC .AND. (OL(OC) .EQ. 0 .OR. OL(OC+1) .EQ. 0) ) *)GOTO 23171 NL(NC) = 0 GOTO 23172 23171 CONTINUE CALL SCOPY( OL, OC, NL, NC) 23172 CONTINUE GOTO 23150 23173 CONTINUE DELSTR(2) = C C = LE_NGETCH( C, ICHN) DELSTR(3) = C IF (.NOT.( (C .GE. 32 .OR. C .EQ. 9) .AND. OL(OC) .NE. 0 ))GOTO 23 *174 I = LE_SCN4CH( OL, OC, C, N) IF (.NOT.( I .GT. OC ))GOTO 23176 CALL SCOPY( OL, I+1, NL, OC) 23176 CONTINUE 23174 CONTINUE GOTO 23150 23178 CONTINUE DELSTR(2) = C C = LE_NGETCH( C, ICHN) DELSTR(3) = C IF (.NOT.( (C .GE. 32 .OR. C .EQ. 9) .AND. LENGTH(OL) .GT. OC + 1 *))GOTO 23179 I = LE_SCN4CH( OL, OC+1, C, N) IF (.NOT.( I .GT. OC + 1 ))GOTO 23181 CALL SCOPY( OL, I, NL, OC) 23181 CONTINUE 23179 CONTINUE GOTO 23150 23183 CONTINUE DELSTR(2) = C C = LE_NGETCH( C, ICHN) DELSTR(3) = C I = INDEXX( OL, C) IF (.NOT.( (C .GE. 32 .OR. C .EQ. 9) .AND. I .GT. 0 .AND. I .LT. O *C ))GOTO 23184 N = - N I = LE_SCN4CH( OL, OC, C, N) N = -N CALL SCOPY( OL, OC, NL, I) 23184 CONTINUE GOTO 23150 23186 CONTINUE DELSTR(2) = C C = LE_NGETCH( C, ICHN) DELSTR(3) = C I = INDEXX( OL, C) IF (.NOT.( (C .GE. 32 .OR. C .EQ. 9) .AND. I .GT. 0 .AND. I .LT. O *C - 1 .AND. OC .GT. 2 ))GOTO 23187 N = -N NC = LE_SCN4CH( OL, OC-2, C, N) + 1 N = -N CALL SCOPY( OL, OC, NL, NC) 23187 CONTINUE GOTO 23150 23189 CONTINUE CALL LE_LERROR( 0, OCHN) GOTO 23150 23149 CONTINUE IF (I23149.EQ.32)GOTO 23154 IF (I23149.EQ.36)GOTO 23151 IF (I23149.EQ.37)GOTO 23152 IF (I23149.EQ.66)GOTO 23168 IF (I23149.EQ.69)GOTO 23157 IF (I23149.EQ.70)GOTO 23183 IF (I23149.EQ.84)GOTO 23186 IF (I23149.EQ.87)GOTO 23157 IF (I23149.EQ.98)GOTO 23168 IF (I23149.EQ.100)GOTO 23153 IF (I23149.EQ.101)GOTO 23157 IF (I23149.EQ.102)GOTO 23173 IF (I23149.EQ.116)GOTO 23178 IF (I23149.EQ.119)GOTO 23157 GOTO 23189 23150 CONTINUE GOTO 23110 23190 CONTINUE CALL LE_PBCMD( 0, N, DELSTR) GOTO 23110 23191 CONTINUE N = -N IF (.NOT.( C .EQ. 98 ))GOTO 23192 NC = LE_SCNBLW( OL, OC, N) GOTO 23193 23192 CONTINUE NC = LE_SCNBBW( OL, OC, N) 23193 CONTINUE N = -N GOTO 23110 23194 CONTINUE C = LE_NGETCH( C, ICHN) CALL LE_SAVELN( OL, OC) IF (.NOT.( C .GE. 32 .OR. C .EQ. 9 ))GOTO 23195 NL(NC) = C 23195 CONTINUE GOTO 23110 23197 CONTINUE CALL LE_PBCMD( 0, N, ST003Z) GOTO 23110 23198 CONTINUE CALL LE_SAVELN( OL, OC) IF (.NOT.( N .GE. OC ))GOTO 23199 N = OC - 1 23199 CONTINUE CALL STRCPY( NL, OL) NC = OC - N CALL SCOPY( OL, OC, NL, NC) GOTO 23110 23201 CONTINUE CALL LE_PBCMD( 0, N, ST004Z) GOTO 23110 23202 CONTINUE CALL LE_PBCMD( ST005Z, N, ST006Z) GOTO 23110 23203 CONTINUE CALL LE_PBCMD( ST007Z, N, ST008Z) GOTO 23110 23204 CONTINUE CALL LE_PBCMD( 0, N, ST009Z) GOTO 23110 23205 CONTINUE CALL LE_SAVELN( OL, OC) IF (.NOT.( OL(OC) .NE. 0 ))GOTO 23206 CALL LE_PUTCHF( OL(OC), OCHN) OC = OC + 1 23206 CONTINUE CALL LE_RAWTXT( OC, OC, N, ICHN, OCHN) GOTO 23110 23208 CONTINUE CALL LE_SAVELN( OL, OC) CALL LE_RAWTXT( OC, OC, N, ICHN, OCHN) GOTO 23110 23209 CONTINUE CALL LE_SAVELN( OL, OC) CALL LE_RAWTXT( OC, 0, N, ICHN, OCHN) GOTO 23110 23210 CONTINUE CALL LE_SAVELN( OL, OC) I = MIN( OC+N-1, LENGTH(OL)) C = NL(I) NL(I) = 36 CALL LE_UPDLIN( OCHN) NL(I) = C N = 1 CALL LE_RAWTXT( OC, I+1, N, ICHN, OCHN) GOTO 23110 23211 CONTINUE C = LE_NGTNUM( N, ICHN) CALL LE_SAVELN( OL, OC) I23212=(C) GOTO 23212 23214 CONTINUE CALL LE_RAWTXT( OC, LENGTH(OL)+1, N, ICHN, OCHN) GOTO 23213 23215 CONTINUE C = NL(OC) NL(OC) = 36 NC = 1 CALL LE_UPDLIN( OCHN) NL(OC) = C CALL LE_RAWTXT( NC, OC+1, N, ICHN, OCHN) GOTO 23213 23216 CONTINUE IF (.NOT.( C .EQ. 119 ))GOTO 23217 I = LE_SCNBLW( OL, OC, N) GOTO 23218 23217 CONTINUE IF (.NOT.( C .EQ. 87 ))GOTO 23219 I = LE_SCNBBW( OL, OC, N) GOTO 23220 23219 CONTINUE IF (.NOT.( C .EQ. 101 ))GOTO 23221 I = LE_SCNELW( OL, OC, N) GOTO 23222 23221 CONTINUE I = LE_SCNEBW( OL, OC, N) 23222 CONTINUE 23220 CONTINUE 23218 CONTINUE IF (.NOT.( I .GT. 1 .AND. OL(I+1) .NE. 0 .AND. (C .EQ. 119 .OR. C *.EQ. 87) ))GOTO 23223 I = I - 1 23223 CONTINUE C = NL(I) NL(I) = 36 CALL LE_UPDLIN( OCHN) NL(I) = C CALL LE_RAWTXT( OC, I+1, N, ICHN, OCHN) GOTO 23213 23225 CONTINUE CALL LE_LERROR( 0, OCHN) GOTO 23213 23212 CONTINUE IF (I23212.EQ.36)GOTO 23214 IF (I23212.EQ.37)GOTO 23215 IF (I23212.EQ.69)GOTO 23216 IF (I23212.EQ.87)GOTO 23216 IF (I23212.EQ.101)GOTO 23216 IF (I23212.EQ.119)GOTO 23216 GOTO 23225 23213 CONTINUE GOTO 23110 23226 CONTINUE GOTO 23108 23227 CONTINUE NC = LENGTH(NL) CALL LE_UPDLIN( OCHN) IF (.NOT.( C .EQ. 5 ))GOTO 23228 C = 13 23228 CONTINUE GOTO 23108 23230 CONTINUE CALL LE_LERROR( 0, OCHN) GOTO 23110 23109 CONTINUE IF (I23109.EQ.5)GOTO 23227 IF (I23109.EQ.8)GOTO 23119 IF (I23109.EQ.13)GOTO 23226 IF (I23109.EQ.18)GOTO 23113 IF (I23109.EQ.26)GOTO 23227 IF (I23109.EQ.32)GOTO 23116 IF (I23109.EQ.36)GOTO 23123 IF (I23109.EQ.37)GOTO 23122 IF (I23109.EQ.44)GOTO 23141 IF (I23109.EQ.46)GOTO 23190 IF (I23109.EQ.48)GOTO 23122 IF (I23109.EQ.59)GOTO 23140 IF (I23109.EQ.65)GOTO 23202 IF (I23109.EQ.66)GOTO 23191 IF (I23109.EQ.67)GOTO 23204 IF (I23109.EQ.68)GOTO 23201 IF (I23109.EQ.69)GOTO 23127 IF (I23109.EQ.70)GOTO 23134 IF (I23109.EQ.73)GOTO 23203 IF (I23109.EQ.82)GOTO 23209 IF (I23109.EQ.84)GOTO 23137 IF (I23109.EQ.85)GOTO 23112 IF (I23109.EQ.87)GOTO 23125 IF (I23109.EQ.88)GOTO 23198 IF (I23109.EQ.97)GOTO 23205 IF (I23109.EQ.98)GOTO 23191 IF (I23109.EQ.99)GOTO 23211 IF (I23109.EQ.100)GOTO 23148 IF (I23109.EQ.101)GOTO 23126 IF (I23109.EQ.102)GOTO 23128 IF (I23109.EQ.104)GOTO 23119 IF (I23109.EQ.105)GOTO 23208 IF (I23109.EQ.114)GOTO 23194 IF (I23109.EQ.115)GOTO 23210 IF (I23109.EQ.116)GOTO 23131 IF (I23109.EQ.117)GOTO 23111 IF (I23109.EQ.119)GOTO 23124 IF (I23109.EQ.120)GOTO 23197 GOTO 23230 23110 CONTINUE CALL LE_UPDLIN( OCHN) CALL STRCPY( NL, OL) OC = NC 23107 GOTO 23106 23108 CONTINUE NL(NC+1) = 0 CALL STRCPY( NL, LIN) CUR = NC LE_LEDIT = C RETURN END SUBROUTINE LE_LEINIT( PSTR, LIN, CURPOS, OCHN) LOGICAL*1 PSTR(2048), LIN(2048) INTEGER CUR, CURPOS, LEN, OCHN INTEGER LENGTH, LE_LL2PL, MAX INTEGER HASTAB INTEGER LC1 INTEGER NC INTEGER NMAXPC INTEGER NPC INTEGER OC INTEGER OMAXPC INTEGER OPC INTEGER PC1 INTEGER QP INTEGER TABS INTEGER UNDCUR LOGICAL*1 FL LOGICAL*1 NL LOGICAL*1 NPL LOGICAL*1 OL LOGICAL*1 OPL LOGICAL*1 OQ LOGICAL*1 TMPLIN LOGICAL*1 UNDLIN COMMON /CLEDIT/ HASTAB, LC1, NC, NMAXPC, NPC, OC, OMAXPC, OPC, PC1 *, QP, TABS(2048), UNDCUR, FL(2048), NL(2048), NPL(2048), OL(2048), * OPL(2048), OQ(2048), TMPLIN(2048), UNDLIN(2048) LEN = MAX( LENGTH( LIN), 1) CUR = CURPOS 23231 IF (.NOT.(CUR .GT. LEN ))GOTO 23233 CALL PUTCH( 8, OCHN) 23232 CUR = CUR - 1 GOTO 23231 23233 CONTINUE CALL SETTAB( 0, TABS) LC1 = 1 CALL STCOPY( PSTR, 1, FL, LC1) PC1 = LC1 - 1 PC1 = LE_LL2PL( FL, LC1-1, NPL, NPC) + 1 CALL SCOPY( LIN, 1, FL, LC1) NMAXPC = LE_LL2PL( FL, CUR+LC1-1, NPL, NPC) CALL STRCPY( NPL, OPL) OMAXPC = NMAXPC OPC = NPC CALL STRCPY( LIN, NL) CALL STRCPY( NL, OL) CALL STRCPY( NL, UNDLIN) NC = CUR OC = CUR UNDCUR = CUR QP = 1 OQ(QP) = 0 RETURN END SUBROUTINE LE_LERROR( ERRCOD, OCHN) INTEGER ERRCOD, OCHN CALL PUTCH( 7, OCHN) RETURN END INTEGER FUNCTION LE_LL2PL( LL, LC, PL, PC) LOGICAL*1 C, LL(2048), PL(2048) INTEGER I, LC, MAXPC, PC, SAVEPC INTEGER MAX, TABPOS INTEGER HASTAB INTEGER LC1 INTEGER NC INTEGER NMAXPC INTEGER NPC INTEGER OC INTEGER OMAXPC INTEGER OPC INTEGER PC1 INTEGER QP INTEGER TABS INTEGER UNDCUR LOGICAL*1 FL LOGICAL*1 NL LOGICAL*1 NPL LOGICAL*1 OL LOGICAL*1 OPL LOGICAL*1 OQ LOGICAL*1 TMPLIN LOGICAL*1 UNDLIN COMMON /CLEDIT/ HASTAB, LC1, NC, NMAXPC, NPC, OC, OMAXPC, OPC, PC1 *, QP, TABS(2048), UNDCUR, FL(2048), NL(2048), NPL(2048), OL(2048), * OPL(2048), OQ(2048), TMPLIN(2048), UNDLIN(2048) PC = 1 MAXPC = 1 SAVEPC = 1 I = 1 23234 IF (.NOT.(LL(I) .NE. 0 ))GOTO 23236 C = LL(I) IF (.NOT.( C .GE. 32 .AND. C .LT. 127 ))GOTO 23237 PL(PC) = C PC = PC + 1 GOTO 23238 23237 CONTINUE IF (.NOT.( C .EQ. 9 ))GOTO 23239 23241 CONTINUE PL(PC) = 9 PC = PC + 1 23242 IF (.NOT.( TABPOS( PC, TABS) .EQ. 1 ))GOTO 23241 23243 CONTINUE GOTO 23240 23239 CONTINUE PL(PC) = C PL(PC+1) = C PC = PC + 2 23240 CONTINUE 23238 CONTINUE MAXPC = MAX( MAXPC, PC) IF (.NOT.( I .EQ. LC ))GOTO 23244 SAVEPC = PC 23244 CONTINUE 23235 I = I + 1 GOTO 23234 23236 CONTINUE PL(MAXPC) = 0 IF (.NOT.( SAVEPC .GT. 1 ))GOTO 23246 PC = MAX( SAVEPC-1, PC1) GOTO 23247 23246 CONTINUE PC = MAX( MAXPC, PC1) 23247 CONTINUE MAXPC = MAX( MAXPC-1, PC1) LE_LL2PL = MAXPC RETURN END INTEGER FUNCTION LE_LNGEST( S1, S2) INTEGER I LOGICAL*1 S1(2048), S2(2048) I = 1 23248 IF (.NOT.(S1(I) .EQ. S2(I) .AND. S1(I) .NE. 0 .AND. S2(I) .NE. 0 ) *)GOTO 23250 23249 I = I + 1 GOTO 23248 23250 CONTINUE LE_LNGEST = I - 1 RETURN END INTEGER FUNCTION LE_MVCURQ( BCKLIN, FWDLIN, C1, C2, OCHN) LOGICAL*1 BCKLIN(2048), FWDLIN(2048) INTEGER C1, C2, I, OCHN INTEGER LE_PUTCHQ INTEGER HASTAB INTEGER LC1 INTEGER NC INTEGER NMAXPC INTEGER NPC INTEGER OC INTEGER OMAXPC INTEGER OPC INTEGER PC1 INTEGER QP INTEGER TABS INTEGER UNDCUR LOGICAL*1 FL LOGICAL*1 NL LOGICAL*1 NPL LOGICAL*1 OL LOGICAL*1 OPL LOGICAL*1 OQ LOGICAL*1 TMPLIN LOGICAL*1 UNDLIN COMMON /CLEDIT/ HASTAB, LC1, NC, NMAXPC, NPC, OC, OMAXPC, OPC, PC1 *, QP, TABS(2048), UNDCUR, FL(2048), NL(2048), NPL(2048), OL(2048), * OPL(2048), OQ(2048), TMPLIN(2048), UNDLIN(2048) IF (.NOT.( C1 .LE. C2 ))GOTO 23251 I = C1 23253 IF (.NOT.(I .LE. C2 ))GOTO 23255 IF (.NOT.( FWDLIN(I) .EQ. 0 ))GOTO 23256 I = I + LE_PUTCHQ( 32, OCHN) GOTO 23255 23256 CONTINUE I = I + LE_PUTCHQ( FWDLIN(I), OCHN) 23254 GOTO 23253 23255 CONTINUE I = I + LE_PUTCHQ( 8, OCHN) GOTO 23252 23251 CONTINUE IF (.NOT.( C1 - C2 .LT. C2 + 2 ))GOTO 23258 I = C1 23260 IF (.NOT.(I .GT. C2 ))GOTO 23262 23261 I = I + LE_PUTCHQ( 8, OCHN) GOTO 23260 23262 CONTINUE GOTO 23259 23258 CONTINUE CALL LE_PUTCHQ( 13, OCHN) I = 1 23263 IF (.NOT.(I .LT. PC1 ))GOTO 23265 CALL LE_PUTCHQ( FL(I), OCHN) 23264 I = I + 1 GOTO 23263 23265 CONTINUE 23266 IF (.NOT.( I .LE. C2 ))GOTO 23267 IF (.NOT.( FWDLIN(I) .EQ. 0 ))GOTO 23268 I = I + LE_PUTCHQ( 32, OCHN) GOTO 23267 23268 CONTINUE I = I + LE_PUTCHQ( FWDLIN(I), OCHN) GOTO 23266 23267 CONTINUE I = I + LE_PUTCHQ( 8, OCHN) 23259 CONTINUE 23252 CONTINUE LE_MVCURQ = I RETURN END LOGICAL*1 FUNCTION LE_NGTNUM(N, ICHN) LOGICAL*1 C, LE_NGETCH LOGICAL*1 NUMSTR(12) INTEGER I, N, ICHN INTEGER CTOI, TYPE C = LE_NGETCH( C, ICHN) IF (.NOT.( C .NE. 48 ))GOTO 23270 I = 1 23272 IF (.NOT.(TYPE(C) .EQ. 2 ))GOTO 23274 NUMSTR(I) = C C = LE_NGETCH( C, ICHN) 23273 I = I + 1 GOTO 23272 23274 CONTINUE 23270 CONTINUE IF (.NOT.( I .GT. 1 ))GOTO 23275 NUMSTR(I) = 0 I = 1 N = CTOI( NUMSTR, I) GOTO 23276 23275 CONTINUE IF (.NOT.( N .EQ. 0 ))GOTO 23277 N = 1 23277 CONTINUE 23276 CONTINUE LE_NGTNUM = C RETURN END SUBROUTINE LE_PBCMD( PREFIX, NUM, CMDSTR) LOGICAL*1 CMDSTR(2048), NUMSTR(11), PREFIX(2048) INTEGER JUNK, NUM INTEGER ITOC CALL LE_PBSTR( CMDSTR) JUNK = ITOC( NUM, NUMSTR, 11) CALL LE_PBSTR( NUMSTR) IF (.NOT.( PREFIX(1) .NE. 0 ))GOTO 23279 CALL LE_PBSTR( PREFIX) 23279 CONTINUE RETURN END SUBROUTINE LE_PUTCHF( C, OCHN) LOGICAL*1 C INTEGER OCHN CALL LE_PUTCHQ( C, OCHN) CALL LE_FLUSHQ( OCHN) RETURN END INTEGER FUNCTION LE_PUTCHQ( C, OCHN) LOGICAL*1 C INTEGER CNT, I, OCHN INTEGER MAX, TABPOS INTEGER HASTAB INTEGER LC1 INTEGER NC INTEGER NMAXPC INTEGER NPC INTEGER OC INTEGER OMAXPC INTEGER OPC INTEGER PC1 INTEGER QP INTEGER TABS INTEGER UNDCUR LOGICAL*1 FL LOGICAL*1 NL LOGICAL*1 NPL LOGICAL*1 OL LOGICAL*1 OPL LOGICAL*1 OQ LOGICAL*1 TMPLIN LOGICAL*1 UNDLIN COMMON /CLEDIT/ HASTAB, LC1, NC, NMAXPC, NPC, OC, OMAXPC, OPC, PC1 *, QP, TABS(2048), UNDCUR, FL(2048), NL(2048), NPL(2048), OL(2048), * OPL(2048), OQ(2048), TMPLIN(2048), UNDLIN(2048) I = OPC CNT = 1 IF (.NOT.( C .EQ. 9 ))GOTO 23281 OPL(OPC) = 9 OPC = OPC + 1 23283 IF (.NOT.(TABPOS( OPC, TABS) .EQ. 0 ))GOTO 23285 OPL(OPC) = 9 CNT = CNT + 1 23284 OPC = OPC + 1 GOTO 23283 23285 CONTINUE GOTO 23282 23281 CONTINUE IF (.NOT.( C .EQ. 13 ))GOTO 23286 OPC = 1 GOTO 23287 23286 CONTINUE IF (.NOT.( C .EQ. 8 ))GOTO 23288 OPC = MAX( OPC - 1, 1) GOTO 23289 23288 CONTINUE IF (.NOT.( C .GE. 32 ))GOTO 23290 OPL(OPC) = C OPC = OPC + 1 GOTO 23291 23290 CONTINUE IF (.NOT.( C .NE. 10 ))GOTO 23292 OPL(OPC) = C OPL(OPC+1) = C OPC = OPC + 2 CNT = 2 23292 CONTINUE 23291 CONTINUE 23289 CONTINUE 23287 CONTINUE 23282 CONTINUE IF (.NOT.( QP + CNT .GE. 2048 ))GOTO 23294 CALL LE_FLUSHQ( OCHN) 23294 CONTINUE IF (.NOT.( C .EQ. 9 .AND. HASTAB .EQ. 0 ))GOTO 23296 23298 IF (.NOT.(CNT .GT. 0 ))GOTO 23300 OQ(QP) = 32 QP = QP + 1 23299 CNT = CNT - 1 GOTO 23298 23300 CONTINUE GOTO 23297 23296 CONTINUE IF (.NOT.( C .GE. 32 .OR. C .EQ. 8 .OR. C .EQ. 13 .OR. C .EQ. 10 ) *)GOTO 23301 OQ(QP) = C QP = QP + 1 GOTO 23302 23301 CONTINUE OQ(QP) = 94 OQ(QP+1) = C + 64 QP = QP + 2 23302 CONTINUE 23297 CONTINUE LE_PUTCHQ = OPC - I RETURN END SUBROUTINE LE_PUTSTF( STR, OCHN) LOGICAL*1 STR(2048) INTEGER I, OCHN CALL LE_PUTSTQ( STR, OCHN) CALL LE_FLUSHQ( OCHN) RETURN END SUBROUTINE LE_PUTSTQ( STR, OCHN) LOGICAL*1 STR(2048) INTEGER I, OCHN I = 1 23303 IF (.NOT.(STR(I) .NE. 0 ))GOTO 23305 CALL LE_PUTCHQ( STR(I), OCHN) 23304 I = I + 1 GOTO 23303 23305 CONTINUE RETURN END INTEGER FUNCTION LE_RAWIO( IN, OUT, SAVMOD) INTEGER IN, OUT, SAVMOD INTEGER CREATE, STMODE, ISATTY, GTMODE LOGICAL*1 TTYSTR(3) DATA TTYSTR(1)/84/,TTYSTR(2)/84/,TTYSTR(3)/0/ IF (.NOT.( OUT .EQ. -1 ))GOTO 23306 OUT = CREATE( TTYSTR, 2) IF (.NOT.( OUT .NE. -3 ))GOTO 23308 IF (.NOT.( STMODE(OUT, 2) .NE. 2 ))GOTO 23310 CALL CLOSE(OUT) OUT = -3 23310 CONTINUE 23308 CONTINUE 23306 CONTINUE LE_RAWIO = 0 IF (.NOT.( ISATTY(IN) .EQ. 1 .AND. OUT .NE. -3 ))GOTO 23312 SAVMOD = GTMODE(IN) IF (.NOT.( STMODE( IN, 2) .EQ. 2 ))GOTO 23314 LE_RAWIO = 1 GOTO 23315 23314 CONTINUE SAVMOD = STMODE( IN, SAVMOD) 23315 CONTINUE 23312 CONTINUE RETURN END SUBROUTINE LE_RAWTXT( FSTCOL, LSTCOL, N, ICHN, OCHN) INTEGER END, I, ICHN, FSTCOL, LSTCOL, N, OCHN, OLEN, START INTEGER LENGTH, MAX, LE_WHITES LOGICAL*1 C, TAIL(2048) LOGICAL*1 GETCH INTEGER HASTAB INTEGER LC1 INTEGER NC INTEGER NMAXPC INTEGER NPC INTEGER OC INTEGER OMAXPC INTEGER OPC INTEGER PC1 INTEGER QP INTEGER TABS INTEGER UNDCUR LOGICAL*1 FL LOGICAL*1 NL LOGICAL*1 NPL LOGICAL*1 OL LOGICAL*1 OPL LOGICAL*1 OQ LOGICAL*1 TMPLIN LOGICAL*1 UNDLIN COMMON /CLEDIT/ HASTAB, LC1, NC, NMAXPC, NPC, OC, OMAXPC, OPC, PC1 *, QP, TABS(2048), UNDCUR, FL(2048), NL(2048), NPL(2048), OL(2048), * OPL(2048), OQ(2048), TMPLIN(2048), UNDLIN(2048) START = FSTCOL END = LSTCOL OLEN = LENGTH(OL) IF (.NOT.( END .NE. 0 ))GOTO 23316 CALL SCOPY( OL, END, TAIL, 1) GOTO 23317 23316 CONTINUE CALL STRCPY( OL, TAIL) 23317 CONTINUE I = START C = GETCH( C, ICHN) 23318 IF (.NOT.(C .NE. 26 .AND. C .NE. 27 ))GOTO 23320 IF (.NOT.( C .EQ. 5 ))GOTO 23321 CALL LE_PUTBAK( 5) GOTO 23320 23321 CONTINUE IF (.NOT.( C .EQ. 13 ))GOTO 23323 CALL LE_PUTBAK( 13) GOTO 23320 23323 CONTINUE IF (.NOT.( C .EQ. 127 .OR. C .EQ. 8 ))GOTO 23325 IF (.NOT.( I .GT. START ))GOTO 23327 I = I - 1 CALL LE_BCKUPC( OCHN, 0) CALL LE_FLUSHQ( OCHN) 23327 CONTINUE GOTO 23326 23325 CONTINUE IF (.NOT.( C .EQ. 23 ))GOTO 23329 23331 IF (.NOT.(I .GT. START .AND. LE_WHITES(NL(I-1)) .EQ. 1 ))GOTO 2333 *3 CALL LE_BCKUPC( OCHN, 0) 23332 I = I - 1 GOTO 23331 23333 CONTINUE 23334 IF (.NOT.(I .GT. START .AND. LE_WHITES(NL(I-1)) .EQ. 0 ))GOTO 2333 *6 CALL LE_BCKUPC( OCHN, 1) 23335 I = I - 1 GOTO 23334 23336 CONTINUE CALL LE_FLUSHQ( OCHN) GOTO 23330 23329 CONTINUE IF (.NOT.( C .GE. 32 .OR. C .EQ. 9 ))GOTO 23337 NL(I) = C OL(I) = C CALL LE_PUTCHF( C, OCHN) I = I + 1 NL(I) = 0 GOTO 23338 23337 CONTINUE CALL PUTCH( 7, OCHN) 23338 CONTINUE 23330 CONTINUE 23326 CONTINUE 23319 C = GETCH( C, ICHN) GOTO 23318 23320 CONTINUE NL(I) = 0 IF (.NOT.( I .GT. OLEN ))GOTO 23339 OL(I) = 0 23339 CONTINUE OC = I CALL SCOPY( NL, START, TMPLIN, 1) IF (.NOT.( (LENGTH(TMPLIN)*N + START) .LT. 2048 ))GOTO 23341 N = N - 1 23343 IF (.NOT.(N .GT. 0 ))GOTO 23345 CALL STCOPY( TMPLIN, 1, NL, I) 23344 N = N - 1 GOTO 23343 23345 CONTINUE 23341 CONTINUE NC = MAX( I - 1, START) IF (.NOT.( END .NE. 0 ))GOTO 23346 CALL STRCPY( TAIL, TMPLIN) GOTO 23347 23346 CONTINUE CALL SCOPY( TAIL, I, TMPLIN, 1) 23347 CONTINUE IF (.NOT.( (LENGTH(TMPLIN) + I) .LT. 2048 ))GOTO 23348 CALL STCOPY( TMPLIN, 1, NL, I) GOTO 23349 23348 CONTINUE CALL PUTCH( 7,2) 23349 CONTINUE NL(I) = 0 RETURN END INTEGER FUNCTION LE_RECOGF(STR) INTEGER I, J INTEGER LE_DS, LENGTH LOGICAL*1 OUTSTR(480), STR(2048) J = LENGTH(STR) I = J IF (.NOT.( I .GT. 0 ))GOTO 23350 23352 CONTINUE IF (.NOT.( STR(I) .EQ. 47 .OR. STR(I) .EQ. 92 ))GOTO 23355 GOTO 23354 23355 CONTINUE I = I - 1 23353 IF (.NOT.( I .EQ. 0 ))GOTO 23352 23354 CONTINUE 23350 CONTINUE IF (.NOT.( LE_DS( STR, OUTSTR) .EQ. 0 ))GOTO 23357 LE_RECOGF = -3 RETURN 23357 CONTINUE CALL SCOPY( OUTSTR, 1, STR, I+1) LE_RECOGF = 0 23358 CONTINUE RETURN END SUBROUTINE LE_SAVELN( LIN, CUR) LOGICAL*1 LIN(2048) INTEGER CUR INTEGER HASTAB INTEGER LC1 INTEGER NC INTEGER NMAXPC INTEGER NPC INTEGER OC INTEGER OMAXPC INTEGER OPC INTEGER PC1 INTEGER QP INTEGER TABS INTEGER UNDCUR LOGICAL*1 FL LOGICAL*1 NL LOGICAL*1 NPL LOGICAL*1 OL LOGICAL*1 OPL LOGICAL*1 OQ LOGICAL*1 TMPLIN LOGICAL*1 UNDLIN COMMON /CLEDIT/ HASTAB, LC1, NC, NMAXPC, NPC, OC, OMAXPC, OPC, PC1 *, QP, TABS(2048), UNDCUR, FL(2048), NL(2048), NPL(2048), OL(2048), * OPL(2048), OQ(2048), TMPLIN(2048), UNDLIN(2048) CALL STRCPY( LIN, UNDLIN) UNDCUR = CUR RETURN END INTEGER FUNCTION LE_SCN4CH( LIN, I, C, N) INTEGER I, J, K, N INTEGER INDEXX LOGICAL*1 C, LIN(2048) IF (.NOT.( N .GT. 0 ))GOTO 23359 J = I 23361 IF (.NOT.(INDEXX( LIN(J+1), C) .GT. 0 .AND. N .GT. 0 ))GOTO 23363 IF (.NOT.( LIN(J) .EQ. C ))GOTO 23364 J = J + 1 23364 CONTINUE 23366 IF (.NOT.(LIN(J) .NE. C .AND. LIN(J) .NE. 0 ))GOTO 23368 23367 J = J + 1 GOTO 23366 23368 CONTINUE 23362 N = N - 1 GOTO 23361 23363 CONTINUE GOTO 23360 23359 CONTINUE IF (.NOT.( N .LT. 0 ))GOTO 23369 K = INDEXX( LIN, C) J = I 23371 IF (.NOT.(K .LT. J .AND. N .LT. 0 ))GOTO 23373 IF (.NOT.( LIN(J) .EQ. C ))GOTO 23374 J = J - 1 23374 CONTINUE 23376 IF (.NOT.(LIN(J) .NE. C ))GOTO 23378 23377 J = J - 1 GOTO 23376 23378 CONTINUE 23372 N = N + 1 GOTO 23371 23373 CONTINUE 23369 CONTINUE 23360 CONTINUE LE_SCN4CH = J RETURN END INTEGER FUNCTION LE_SCNBBW( LIN, I, N) INTEGER I, J, N INTEGER LE_WHITES LOGICAL*1 LIN(2048) IF (.NOT.( N .GT. 0 ))GOTO 23379 J = I 23381 IF (.NOT.(LIN(J+1) .NE. 0 .AND. N .GT. 0 ))GOTO 23383 23384 IF (.NOT.(LE_WHITES(LIN(J)) .EQ. 0 .AND. LIN(J+1) .NE. 0 ))GOTO 23 *386 23385 J = J + 1 GOTO 23384 23386 CONTINUE 23387 IF (.NOT.(LE_WHITES(LIN(J)) .EQ. 1 .AND. LIN(J+1) .NE. 0 ))GOTO 23 *389 23388 J = J + 1 GOTO 23387 23389 CONTINUE 23382 N = N - 1 GOTO 23381 23383 CONTINUE GOTO 23380 23379 CONTINUE IF (.NOT.( N .LT. 0 ))GOTO 23390 J = I 23392 IF (.NOT.(J .GT. 1 .AND. N .LT. 0 ))GOTO 23394 IF (.NOT.( LE_WHITES(LIN(J-1)) .EQ. 1 ))GOTO 23395 J = J - 1 23395 CONTINUE 23397 IF (.NOT.(LE_WHITES(LIN(J)) .EQ. 1 .AND. J .GT. 1 ))GOTO 23399 23398 J = J - 1 GOTO 23397 23399 CONTINUE 23400 IF (.NOT.(J .GT. 1 ))GOTO 23402 IF (.NOT.( LE_WHITES( LIN(J-1)) .EQ. 1 ))GOTO 23403 GOTO 23402 23403 CONTINUE 23401 J = J - 1 GOTO 23400 23402 CONTINUE 23393 N = N + 1 GOTO 23392 23394 CONTINUE 23390 CONTINUE 23380 CONTINUE LE_SCNBBW=(J) RETURN END INTEGER FUNCTION LE_SCNBCK( STR, COL, RUBSTR, CHN, TRMARA) INTEGER I, CHN, COL INTEGER INDEXX LOGICAL*1 RUBSTR(2048), STR(2048), TRMARA(2048) IF (.NOT.( COL .GT. 1 ))GOTO 23405 I = COL - 1 23407 IF (.NOT.(INDEXX( TRMARA, STR(I)) .EQ. 0 .AND. I .GT. 1 ))GOTO 234 *09 IF (.NOT.( RUBSTR(1) .NE. 0 ))GOTO 23410 CALL PUTLIN( RUBSTR, CHN) 23410 CONTINUE 23408 I = I - 1 GOTO 23407 23409 CONTINUE IF (.NOT.( I .EQ. 1 .AND. INDEXX( TRMARA, STR(I)) .EQ. 0 ))GOTO 23 *412 IF (.NOT.( RUBSTR(1) .NE. 0 ))GOTO 23414 CALL PUTLIN( RUBSTR, CHN) 23414 CONTINUE GOTO 23413 23412 CONTINUE I = I + 1 23413 CONTINUE GOTO 23406 23405 CONTINUE I = 1 23406 CONTINUE LE_SCNBCK = I RETURN END INTEGER FUNCTION LE_SCNBLW( LIN, I, N) INTEGER I, J, N INTEGER LE_ALPHAN, LE_WHITES LOGICAL*1 LIN(2048) IF (.NOT.( N .GT. 0 ))GOTO 23416 J = I 23418 IF (.NOT.(LIN(J+1) .NE. 0 .AND. N .GT. 0 ))GOTO 23420 IF (.NOT.( LE_ALPHAN(LIN(J)) .EQ. 1 ))GOTO 23421 23423 IF (.NOT.(LE_ALPHAN(LIN(J)) .EQ. 1 .AND. LIN(J+1) .NE. 0 ))GOTO 23 *425 23424 J = J + 1 GOTO 23423 23425 CONTINUE GOTO 23422 23421 CONTINUE IF (.NOT.( LE_ALPHAN(LIN(J)) .EQ. 0 .AND. LE_WHITES(LIN(J)) .EQ. 0 * ))GOTO 23426 23428 IF (.NOT.(LE_ALPHAN(LIN(J)) .EQ. 0 .AND. LIN(J+1) .NE. 0 ))GOTO 23 *430 23429 J = J + 1 GOTO 23428 23430 CONTINUE 23426 CONTINUE 23422 CONTINUE 23431 IF (.NOT.(LE_WHITES(LIN(J)) .EQ. 1 .AND. LIN(J+1) .NE. 0 ))GOTO 23 *433 23432 J = J + 1 GOTO 23431 23433 CONTINUE 23419 N = N - 1 GOTO 23418 23420 CONTINUE GOTO 23417 23416 CONTINUE IF (.NOT.( N .LT. 0 ))GOTO 23434 J = I 23436 IF (.NOT.(J .GT. 1 .AND. N .LT. 0 ))GOTO 23438 J = J - 1 23439 IF (.NOT.(J .GT. 1 ))GOTO 23441 IF (.NOT.( LE_WHITES( LIN(J)) .EQ. 0 ))GOTO 23442 GOTO 23441 23442 CONTINUE 23440 J = J - 1 GOTO 23439 23441 CONTINUE IF (.NOT.( J .GT. 1 ))GOTO 23444 IF (.NOT.( LE_ALPHAN( LIN(J)) .EQ. 1 ))GOTO 23446 23448 IF (.NOT.(J .GT. 1 ))GOTO 23450 IF (.NOT.( LE_ALPHAN( LIN(J-1)) .EQ. 0 ))GOTO 23451 GOTO 23450 23451 CONTINUE 23449 J = J - 1 GOTO 23448 23450 CONTINUE 23446 CONTINUE 23444 CONTINUE IF (.NOT.( J .GT. 1 ))GOTO 23453 IF (.NOT.( LE_ALPHAN( LIN(J)) .EQ. 0 ))GOTO 23455 23457 IF (.NOT.(LE_ALPHAN(LIN(J-1)) .EQ. 0 .AND. LE_WHITES(LIN(J-1)) .EQ *. 0 ))GOTO 23459 IF (.NOT.( J .LE. 2 ))GOTO 23460 GOTO 23459 23460 CONTINUE 23458 J = J - 1 GOTO 23457 23459 CONTINUE 23455 CONTINUE 23453 CONTINUE 23437 N = N + 1 GOTO 23436 23438 CONTINUE 23434 CONTINUE 23417 CONTINUE LE_SCNBLW=(J) RETURN END INTEGER FUNCTION LE_SCNEBW( LIN, I, N) INTEGER I, J, N INTEGER LE_WHITES LOGICAL*1 LIN(2048) IF (.NOT.( N .GT. 0 ))GOTO 23462 J = I 23464 IF (.NOT.(LIN(J+1) .NE. 0 .AND. N .GT. 0 ))GOTO 23466 IF (.NOT.( LE_WHITES(LIN(J+1)) .EQ. 1 ))GOTO 23467 J = J + 1 23467 CONTINUE 23469 IF (.NOT.(LE_WHITES(LIN(J)) .EQ. 1 .AND. LIN(J+1) .NE. 0 ))GOTO 23 *471 23470 J = J + 1 GOTO 23469 23471 CONTINUE 23472 IF (.NOT.(LE_WHITES(LIN(J+1)) .EQ. 0 .AND. LIN(J+1) .NE. 0 ))GOTO *23474 23473 J = J + 1 GOTO 23472 23474 CONTINUE 23465 N = N - 1 GOTO 23464 23466 CONTINUE GOTO 23463 23462 CONTINUE IF (.NOT.( N .LT. 0 ))GOTO 23475 J = I 23475 CONTINUE 23463 CONTINUE LE_SCNEBW = J RETURN END INTEGER FUNCTION LE_SCNELW( LIN, I, N) INTEGER I, J, N INTEGER LE_ALPHAN, LE_WHITES LOGICAL*1 LIN(2048) IF (.NOT.( N .GT. 0 ))GOTO 23477 J = I 23479 IF (.NOT.(LIN(J+1) .NE. 0 .AND. N .GT. 0 ))GOTO 23481 IF (.NOT.( LIN(J) .NE. 0 .AND. LIN(J+1) .NE. 0 ))GOTO 23482 J = J + 1 23482 CONTINUE 23484 IF (.NOT.(LE_WHITES(LIN(J)) .EQ. 1 .AND. LIN(J+1) .NE. 0 ))GOTO 23 *486 23485 J = J + 1 GOTO 23484 23486 CONTINUE IF (.NOT.( LE_ALPHAN(LIN(J)) .EQ. 1 ))GOTO 23487 IF (.NOT.( LE_ALPHAN(LIN(J+1)) .EQ. 1 ))GOTO 23489 23491 IF (.NOT.(LE_ALPHAN(LIN(J+1)) .EQ. 1 ))GOTO 23493 23492 J = J + 1 GOTO 23491 23493 CONTINUE 23489 CONTINUE GOTO 23488 23487 CONTINUE IF (.NOT.( LE_ALPHAN(LIN(J+1)) .EQ. 0 .AND. LE_WHITES(LIN(J+1)) .E *Q. 0 ))GOTO 23494 23496 IF (.NOT.(LE_ALPHAN(LIN(J+1)) .EQ. 0 .AND. LIN(J+1) .NE. 0 ))GOTO *23498 23497 J = J + 1 GOTO 23496 23498 CONTINUE 23494 CONTINUE 23488 CONTINUE 23480 N = N - 1 GOTO 23479 23481 CONTINUE GOTO 23478 23477 CONTINUE IF (.NOT.( N .LT. 0 ))GOTO 23499 J = I 23499 CONTINUE 23478 CONTINUE LE_SCNELW = J RETURN END SUBROUTINE LE_SPAWND(ARGS) LOGICAL*1 ARGS(2048), IMAGE(480), PID(9) INTEGER LOCCOM, SPAWN INTEGER JUNK, INIT LOGICAL*1 D(2) LOGICAL*1 SPATH(15) LOGICAL*1 SUFFIX(7) DATA D(1)/100/,D(2)/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)/101/,SUFFIX(3)/120/,SUFFIX(4)/101/,SU *FFIX(5)/0/,SUFFIX(6)/10/,SUFFIX(7)/0/ DATA INIT /1/ IF (.NOT.( INIT .EQ. 1 ))GOTO 23501 INIT = 0 JUNK = LOCCOM( D, SPATH, SUFFIX, IMAGE) 23501 CONTINUE JUNK = SPAWN( IMAGE, ARGS, PID, 119) RETURN END INTEGER FUNCTION LE_SPNBCK( STR, COL, RUBSTR, CHN, SEPARA) INTEGER I, CHN, COL INTEGER INDEXX LOGICAL*1 RUBSTR(2048), STR(2048), SEPARA(2048) IF (.NOT.( COL .GT. 1 ))GOTO 23503 I = COL - 1 23505 IF (.NOT.(INDEXX( SEPARA, STR(I)) .GT. 0 .AND. I .GT. 1 ))GOTO 235 *07 IF (.NOT.( RUBSTR(1) .NE. 0 ))GOTO 23508 CALL PUTLIN( RUBSTR, CHN) 23508 CONTINUE 23506 I = I - 1 GOTO 23505 23507 CONTINUE IF (.NOT.( I .EQ. 1 ))GOTO 23510 IF (.NOT.( RUBSTR(1) .NE. 0 ))GOTO 23512 CALL PUTLIN( RUBSTR, CHN) 23512 CONTINUE GOTO 23511 23510 CONTINUE I = I + 1 23511 CONTINUE GOTO 23504 23503 CONTINUE I = 1 23504 CONTINUE LE_SPNBCK = I RETURN END SUBROUTINE LE_UPDLIN( OCHN) INTEGER OCHN INTEGER I, J, K INTEGER LE_D2EOL, INDEXX, LENGTH, LE_LL2PL, MAX, MIN, LE_MVCURQ, L *E_PUTCHQ INTEGER HASTAB INTEGER LC1 INTEGER NC INTEGER NMAXPC INTEGER NPC INTEGER OC INTEGER OMAXPC INTEGER OPC INTEGER PC1 INTEGER QP INTEGER TABS INTEGER UNDCUR LOGICAL*1 FL LOGICAL*1 NL LOGICAL*1 NPL LOGICAL*1 OL LOGICAL*1 OPL LOGICAL*1 OQ LOGICAL*1 TMPLIN LOGICAL*1 UNDLIN COMMON /CLEDIT/ HASTAB, LC1, NC, NMAXPC, NPC, OC, OMAXPC, OPC, PC1 *, QP, TABS(2048), UNDCUR, FL(2048), NL(2048), NPL(2048), OL(2048), * OPL(2048), OQ(2048), TMPLIN(2048), UNDLIN(2048) NC = MAX( MIN( NC, LENGTH(NL) ), 1) CALL SCOPY( OL, 1, FL, LC1) OMAXPC = LE_LL2PL( FL, OC+LC1-1, OPL, OPC) CALL SCOPY( NL, 1, FL, LC1) NMAXPC = LE_LL2PL( FL, NC+LC1-1, NPL, NPC) I = PC1 23514 IF (.NOT.(OPL(I) .EQ. NPL(I) ))GOTO 23516 IF (.NOT.( OPL(I) .EQ. 0 .OR. NPL(I) .EQ. 0 ))GOTO 23517 GOTO 23516 23517 CONTINUE 23515 I = I + 1 GOTO 23514 23516 CONTINUE IF (.NOT.( NPL(I) .NE. OPL(I) ))GOTO 23519 I = LE_MVCURQ( OPL, NPL, OPC, I, OCHN) IF (.NOT.( NMAXPC .EQ. OMAXPC .AND. INDEXX( OL, 9) .EQ. 0 ))GOTO 2 *3521 J = NMAXPC 23523 IF (.NOT.(J .GT. I ))GOTO 23525 IF (.NOT.( OPL(J) .NE. NPL(J) ))GOTO 23526 GOTO 23525 23526 CONTINUE 23524 J = J - 1 GOTO 23523 23525 CONTINUE GOTO 23522 23521 CONTINUE J = NMAXPC 23522 CONTINUE K = I 23528 IF (.NOT.(K .LE. J .AND. NPL(K) .NE. 0 ))GOTO 23530 K = K + LE_PUTCHQ( NPL(K), OCHN) 23529 GOTO 23528 23530 CONTINUE IF (.NOT.( NMAXPC .LT. OMAXPC ))GOTO 23531 K = K + LE_D2EOL( OCHN) 23531 CONTINUE NPC = LE_MVCURQ( NPL, NPL, K, NPC, OCHN) GOTO 23520 23519 CONTINUE NPC = LE_MVCURQ( NPL, NPL, OPC, NPC, OCHN) 23520 CONTINUE CALL LE_FLUSHQ( OCHN) RETURN END INTEGER FUNCTION LE_WHITES( C) LOGICAL*1 C IF (.NOT.( C .EQ. 9 .OR. C .EQ. 32 ))GOTO 23533 LE_WHITES=(1) RETURN 23533 CONTINUE LE_WHITES=(0) RETURN 23534 CONTINUE END LOGICAL*1 FUNCTION LE_NGETCH(C, FD) LOGICAL*1 GETCH LOGICAL*1 C INTEGER FD INTEGER PBP LOGICAL*1 PBBUF EXTERNAL LE_PBINIT COMMON / CLPB / PBP, PBBUF(512) IF (.NOT.(PBP .GT. 0))GOTO 23535 C = PBBUF(PBP) PBP = PBP - 1 GOTO 23536 23535 CONTINUE IF (.NOT.(FD .EQ. -3))GOTO 23537 C = -1 GOTO 23538 23537 CONTINUE C = GETCH(C, FD) 23538 CONTINUE 23536 CONTINUE LE_NGETCH = C RETURN END BLOCK DATA LE_PBINIT INTEGER PBP LOGICAL*1 PBBUF COMMON / CLPB / PBP, PBBUF(512) DATA PBP/0/ END SUBROUTINE LE_PBSTR(IN) LOGICAL*1 IN(2048) INTEGER LENGTH INTEGER I INTEGER PBP LOGICAL*1 PBBUF LOGICAL*1 ST00AZ(40) COMMON / CLPB / PBP, PBBUF(512) DATA ST00AZ(1)/112/,ST00AZ(2)/98/,ST00AZ(3)/115/,ST00AZ(4)/116/,ST *00AZ(5)/114/,ST00AZ(6)/32/,ST00AZ(7)/45/,ST00AZ(8)/32/,ST00AZ(9)/1 *16/,ST00AZ(10)/111/,ST00AZ(11)/111/,ST00AZ(12)/32/,ST00AZ(13)/109/ *,ST00AZ(14)/97/,ST00AZ(15)/110/,ST00AZ(16)/121/,ST00AZ(17)/32/,ST0 *0AZ(18)/99/,ST00AZ(19)/104/,ST00AZ(20)/97/,ST00AZ(21)/114/,ST00AZ( *22)/97/,ST00AZ(23)/99/,ST00AZ(24)/116/,ST00AZ(25)/101/,ST00AZ(26)/ *114/,ST00AZ(27)/115/,ST00AZ(28)/32/,ST00AZ(29)/112/,ST00AZ(30)/117 */,ST00AZ(31)/115/,ST00AZ(32)/104/,ST00AZ(33)/101/,ST00AZ(34)/100/, *ST00AZ(35)/32/,ST00AZ(36)/98/,ST00AZ(37)/97/,ST00AZ(38)/99/,ST00AZ *(39)/107/,ST00AZ(40)/0/ I = LENGTH(IN) 23539 IF (.NOT.(I .GT. 0))GOTO 23541 PBP = PBP + 1 IF (.NOT.(PBP .GT. 512))GOTO 23542 CALL ERROR(ST00AZ) 23542 CONTINUE PBBUF(PBP) = IN(I) 23540 I = I - 1 GOTO 23539 23541 CONTINUE RETURN END SUBROUTINE LE_PUTBAK(C) LOGICAL*1 C INTEGER PBP LOGICAL*1 PBBUF LOGICAL*1 ST00BZ(41) COMMON / CLPB / PBP, PBBUF(512) DATA ST00BZ(1)/112/,ST00BZ(2)/117/,ST00BZ(3)/116/,ST00BZ(4)/98/,ST *00BZ(5)/97/,ST00BZ(6)/107/,ST00BZ(7)/32/,ST00BZ(8)/45/,ST00BZ(9)/3 *2/,ST00BZ(10)/116/,ST00BZ(11)/111/,ST00BZ(12)/111/,ST00BZ(13)/32/, *ST00BZ(14)/109/,ST00BZ(15)/97/,ST00BZ(16)/110/,ST00BZ(17)/121/,ST0 *0BZ(18)/32/,ST00BZ(19)/99/,ST00BZ(20)/104/,ST00BZ(21)/97/,ST00BZ(2 *2)/114/,ST00BZ(23)/97/,ST00BZ(24)/99/,ST00BZ(25)/116/,ST00BZ(26)/1 *01/,ST00BZ(27)/114/,ST00BZ(28)/115/,ST00BZ(29)/32/,ST00BZ(30)/112/ *,ST00BZ(31)/117/,ST00BZ(32)/115/,ST00BZ(33)/104/,ST00BZ(34)/101/,S *T00BZ(35)/100/,ST00BZ(36)/32/,ST00BZ(37)/98/,ST00BZ(38)/97/,ST00BZ *(39)/99/,ST00BZ(40)/107/,ST00BZ(41)/0/ PBP = PBP + 1 IF (.NOT.(PBP .GT. 512))GOTO 23544 CALL ERROR(ST00BZ) 23544 CONTINUE PBBUF(PBP) = C 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(2048), STR(2048) 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(480) 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) LOGICAL*1 STR (2048) INTEGER I ALLDIG = 0 IF (.NOT.(STR (1) .EQ. 0))GOTO 23012 RETURN 23012 CONTINUE I = 1 23014 IF (.NOT.(STR (I) .NE. 0))GOTO 23016 IF (.NOT.(.NOT.(48.LE.STR (I).AND.STR (I).LE.57)))GOTO 23017 RETURN 23017 CONTINUE 23015 I = I + 1 GOTO 23014 23016 CONTINUE ALLDIG = 1 RETURN END SUBROUTINE BADARG(ARG) LOGICAL*1 ARG(2048) 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(2048) 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 SUBROUTINE CANT(FILE) LOGICAL*1 FILE(2048) LOGICAL*1 MSG1(26) LOGICAL*1 MSG2(3) DATA MSG1(1)/63/,MSG1(2)/32/,MSG1(3)/67/,MSG1(4)/97/,MSG1(5)/110/, *MSG1(6)/39/,MSG1(7)/116/,MSG1(8)/32/,MSG1(9)/111/,MSG1(10)/112/,MS *G1(11)/101/,MSG1(12)/110/,MSG1(13)/32/,MSG1(14)/102/,MSG1(15)/105/ *,MSG1(16)/108/,MSG1(17)/101/,MSG1(18)/32/,MSG1(19)/110/,MSG1(20)/9 *7/,MSG1(21)/109/,MSG1(22)/101/,MSG1(23)/100/,MSG1(24)/32/,MSG1(25) */96/,MSG1(26)/0/ DATA MSG2(1)/39/,MSG2(2)/10/,MSG2(3)/0/ CALL PUTLIN( MSG1, 3) CALL PUTLIN( FILE, 3) CALL PUTLIN( MSG2, 3) CALL ENDST(-3) END INTEGER FUNCTION CTOC(FROM, TO, LEN) INTEGER LEN LOGICAL*1 FROM(2048), 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(2048), 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(2048) INTEGER INDEXX 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 = INDEXX( 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 DISIZE(FILE, DI) LOGICAL*1 GETCH LOGICAL*1 C, FILE(2048) INTEGER OPEN INTEGER DI(2) INTEGER FD DI(1) = 0 DI(2) = 0 FD = OPEN( FILE, 1) IF (.NOT.( FD .EQ. -3 ))GOTO 23044 DISIZE=(-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 DISIZE=(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 = MAX( N, 1) CALL SCOPY( TEMP, I, BUF, 1) DITOC=( LENGTH(BUF) ) RETURN END SUBROUTINE ERROR (LINE) LOGICAL*1 LINE(2048) CALL REMARK (LINE) CALL ENDST(-3) END SUBROUTINE EXPPTH( PATH, DEPTH, PTR, BUF) LOGICAL*1 BUF(2048), PATH(2048) INTEGER DEPTH, I, PTR(10) 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(2048) 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(2048), OUT(2048) 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 = ABS(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 INDEXS( STR, SUB) LOGICAL*1 STR(2048), SUB(2048) INTEGER I, J, K I = 1 23109 IF (.NOT.(STR(I) .NE. 0 ))GOTO 23111 J = I K = 1 23112 CONTINUE IF (.NOT.( SUB(K) .EQ. 0 ))GOTO 23115 INDEXS=(I) RETURN 23115 CONTINUE IF (.NOT.( STR(J) .EQ. 0 ))GOTO 23117 INDEXS=(0) RETURN 23117 CONTINUE IF (.NOT.( STR(J) .NE. SUB(K) ))GOTO 23119 GOTO 23114 23119 CONTINUE 23118 CONTINUE 23116 CONTINUE J = J + 1 23113 K = K + 1 GOTO 23112 23114 CONTINUE 23110 I = I + 1 GOTO 23109 23111 CONTINUE INDEXS=(0) 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 = ABS(INT) STR(1) = 0 I = 1 23121 CONTINUE I = I + 1 D = MOD( INTVAL, 10) STR(I) = DIGITS( D + 1 ) INTVAL = INTVAL / 10 23122 IF (.NOT.( INTVAL .EQ. 0 .OR. I .GE. SIZE ))GOTO 23121 23123 CONTINUE IF (.NOT.( INT .LT. 0 .AND. I .LT. SIZE ))GOTO 23124 I = I + 1 STR(I) = 45 23124 CONTINUE ITOC = I - 1 J = 1 23126 IF (.NOT.(J .LT. I ))GOTO 23128 K = STR(I) STR(I) = STR(J) STR(J) = K I = I - 1 23127 J = J + 1 GOTO 23126 23128 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 PUTLNL(BUF, INT) LOGICAL*1 BUF(2048) INTEGER INT, I I=1 23129 IF (.NOT.(BUF(I) .NE. 0))GOTO 23131 CALL PUTCH(BUF(I), INT) 23130 I=I+1 GOTO 23129 23131 CONTINUE IF (.NOT.(I .GT. 1))GOTO 23132 IF (.NOT.(BUF(I-1) .NE. 10))GOTO 23134 CALL PUTCH(10, INT) 23134 CONTINUE GOTO 23133 23132 CONTINUE CALL PUTCH(10, INT) 23133 CONTINUE RETURN END SUBROUTINE PUTPTR( PTR, FD) REAL*8 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(2048) INTEGER FD INTEGER LENGTH INTEGER W LEN = LENGTH(STR) I = LEN + 1 23136 IF (.NOT.(I .LE. W ))GOTO 23138 CALL PUTCH( 32, FD) 23137 I = I + 1 GOTO 23136 23138 CONTINUE I = 1 23139 IF (.NOT.(I .LE. LEN ))GOTO 23141 CALL PUTCH( STR(I), FD) 23140 I = I + 1 GOTO 23139 23141 CONTINUE I = ( -W ) - LEN 23142 IF (.NOT.(I .GT. 0 ))GOTO 23144 CALL PUTCH( 32, FD) 23143 I = I - 1 GOTO 23142 23144 CONTINUE RETURN END SUBROUTINE QUERY(MSG) LOGICAL*1 MSG(2048) INTEGER GETARG LOGICAL*1 ARG1(3), ARG2(1) IF (.NOT.( GETARG( 1, ARG1, 3) .NE. -1 .AND. GETARG( 2, ARG2, 1) . *EQ. -1 ))GOTO 23145 IF (.NOT.( ARG1(1) .EQ. 63 .AND. ARG1(2) .EQ. 0 ))GOTO 23147 CALL ERROR(MSG) 23147 CONTINUE 23145 CONTINUE RETURN END INTEGER FUNCTION SDROP( FROM, TO, CHARS) LOGICAL*1 FROM(2048), TO(2048) INTEGER CHARS INTEGER LEN, START INTEGER CTOC, LENGTH, MIN LEN = LENGTH(FROM) IF (.NOT.( CHARS .LT. 0 ))GOTO 23149 SDROP=( CTOC( FROM, TO, LEN + CHARS + 1)) RETURN 23149 CONTINUE START = MIN( CHARS, LEN) SDROP=( CTOC( FROM( START + 1), TO, LEN + 1 )) RETURN 23150 CONTINUE END SUBROUTINE SHELL( V, N) INTEGER GAP, I, J, JG, K, N, V(2048) GAP = N / 2 23151 IF (.NOT.(GAP .GT. 0 ))GOTO 23153 I = GAP + 1 23154 IF (.NOT.(I .LE. N ))GOTO 23156 J = I - GAP 23157 IF (.NOT.(J .GT. 0 ))GOTO 23159 JG = J + GAP IF (.NOT.( V(J) .LE. V(JG) ))GOTO 23160 GOTO 23159 23160 CONTINUE K = V(J) V(J) = V(JG) V(JG) = K 23158 J = J - GAP GOTO 23157 23159 CONTINUE 23155 I = I + 1 GOTO 23154 23156 CONTINUE 23152 GAP = GAP / 2 GOTO 23151 23153 CONTINUE RETURN END SUBROUTINE SKIPBL( LIN, I) LOGICAL*1 LIN(2048) INTEGER I 23162 IF (.NOT.( LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 9 ))GOTO 23163 I = I + 1 GOTO 23162 23163 CONTINUE RETURN END INTEGER FUNCTION STAKE( FROM, TO, CHARS) LOGICAL*1 FROM(2048), TO(2048) INTEGER CHARS INTEGER LEN, START INTEGER CTOC, LENGTH, MAX LEN = LENGTH(FROM) IF (.NOT.( CHARS .LT. 0 ))GOTO 23164 START = MAX( LEN + CHARS, 0) STAKE=( CTOC( FROM( START + 1), TO, LEN + 1)) RETURN 23164 CONTINUE STAKE=( CTOC( FROM, TO, CHARS + 1)) RETURN 23165 CONTINUE END INTEGER FUNCTION STRIM(STR) LOGICAL*1 STR(2048) INTEGER I, LNB LNB = 0 I = 1 23166 IF (.NOT.(STR(I) .NE. 0 ))GOTO 23168 IF (.NOT.( STR(I) .NE. 32 .AND. STR(I) .NE. 9 ))GOTO 23169 LNB = I 23169 CONTINUE 23167 I = I + 1 GOTO 23166 23168 CONTINUE STR(LNB + 1) = 0 STRIM=(LNB) RETURN END SUBROUTINE TOOLDR(DIR, DTYPE) LOGICAL*1 DIR(480) INTEGER DTYPE LOGICAL*1 TEMP(480) LOGICAL*1 SUFFIX(7) DATA SUFFIX(1)/116/,SUFFIX(2)/111/,SUFFIX(3)/111/,SUFFIX(4)/108/,S *UFFIX(5)/115/,SUFFIX(6)/47/,SUFFIX(7)/0/ CALL HOMDIR(TEMP, 5) CALL CONCAT(TEMP, SUFFIX, TEMP) IF (.NOT.(DTYPE .EQ. 5))GOTO 23171 CALL STRCPY(TEMP, DIR) GOTO 23172 23171 CONTINUE CALL MKLOCL(TEMP, DIR) 23172 CONTINUE 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 23173 LM = LM + 12 LY = LY - 1 23173 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 23175 DSTIME=(1) RETURN 23175 CONTINUE IF (.NOT.(DATE(2) .EQ. 4))GOTO 23177 I = 30 23179 IF (.NOT.(I .GT. 0))GOTO 23181 IF (.NOT.(WKDAY(4, I, DATE(1)) .EQ. 1))GOTO 23182 GOTO 23181 23182 CONTINUE 23180 I = I - 1 GOTO 23179 23181 CONTINUE IF (.NOT.(DATE(3) .LT. I))GOTO 23184 DSTIME=(0) RETURN 23184 CONTINUE DSTIME=(1) RETURN 23185 CONTINUE GOTO 23178 23177 CONTINUE IF (.NOT.(DATE(2) .EQ. 10))GOTO 23186 I = 31 23188 IF (.NOT.(I .GT. 0))GOTO 23190 IF (.NOT.(WKDAY(10, I, DATE(1)) .EQ. 1))GOTO 23191 GOTO 23190 23191 CONTINUE 23189 I = I - 1 GOTO 23188 23190 CONTINUE IF (.NOT.(DATE(3) .LT. I))GOTO 23193 DSTIME=(1) RETURN 23193 CONTINUE DSTIME=(0) RETURN 23194 CONTINUE GOTO 23187 23186 CONTINUE DSTIME=(0) RETURN 23187 CONTINUE 23178 CONTINUE 23176 CONTINUE END SUBROUTINE INPACK( NXTCOL, RIGHTM, BUF, FD) INTEGER FD INTEGER NXTCOL, RIGHTM LOGICAL*1 BUF(2048) NXTCOL = 1 RETURN END SUBROUTINE DOPACK( WORD, NXTCOL, RIGHTM, BUF, FD) INTEGER FD INTEGER I, J, NXTCOL, NXTTAB, RIGHTM INTEGER LENGTH LOGICAL*1 BUF(2048), WORD(2048) 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(2048) IF (.NOT.( NXTCOL .GT. 1 ))GOTO 23008 CALL PUTLIN( BUF, FD) CALL PUTCH( 10, FD) NXTCOL = 1 23008 CONTINUE RETURN END INTEGER FUNCTION ADDINT( INT, INTARA, J, MAXSIZ) INTEGER INT, J, MAXSIZ, INTARA(MAXSIZ) IF (.NOT.( J .GT. MAXSIZ ))GOTO 23000 ADDINT=(0) RETURN 23000 CONTINUE INTARA(J) = INT J = J + 1 ADDINT=(1) RETURN END INTEGER FUNCTION AMATCH( LIN, FROM, PAT) LOGICAL*1 LIN(2048) 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, CTOI, ITOC INTEGER FROM, I, J, JUNK, K, MAXNEW, TO LOGICAL*1 C, LIN(2048), NEW(MAXNEW), SUB(132) INTEGER TAGLIM INTEGER NOREG LOGICAL*1 ST001Z(29) COMMON/CTAG/TAGLIM(20) COMMON/CNOREG/NOREG DATA ST001Z(1)/63/,ST001Z(2)/32/,ST001Z(3)/73/,ST001Z(4)/110/,ST00 *1Z(5)/32/,ST001Z(6)/67/,ST001Z(7)/97/,ST001Z(8)/116/,ST001Z(9)/83/ *,ST001Z(10)/117/,ST001Z(11)/98/,ST001Z(12)/58/,ST001Z(13)/32/,ST00 *1Z(14)/105/,ST001Z(15)/108/,ST001Z(16)/108/,ST001Z(17)/101/,ST001Z *(18)/103/,ST001Z(19)/97/,ST001Z(20)/108/,ST001Z(21)/32/,ST001Z(22) */115/,ST001Z(23)/101/,ST001Z(24)/99/,ST001Z(25)/116/,ST001Z(26)/10 *5/,ST001Z(27)/111/,ST001Z(28)/110/,ST001Z(29)/0/ 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 ERROR( ST001Z ) 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 IF (.NOT.( SUB(I) .EQ. (-5) ))GOTO 23036 K = K + ITOC( NOREG, NEW(K), MAXNEW - K + 1 ) I = I + 1 C = SUB(I) IF (.NOT.( C .EQ. 43 .OR. C .EQ. 45 ))GOTO 23038 I = I + 1 IF (.NOT.( SUB(I) .NE. 32 .AND. SUB(I) .NE. 9 ))GOTO 23040 JUNK = CTOI( SUB, I) IF (.NOT.( JUNK .EQ. 0 ))GOTO 23042 JUNK = 1 23042 CONTINUE GOTO 23041 23040 CONTINUE JUNK = 1 23041 CONTINUE IF (.NOT.( C .EQ. 43 ))GOTO 23044 NOREG = NOREG + JUNK GOTO 23045 23044 CONTINUE NOREG = NOREG - JUNK 23045 CONTINUE 23038 CONTINUE I = I - 1 GOTO 23037 23036 CONTINUE JUNK = ADDSET( SUB(I), NEW, K, MAXNEW) 23037 CONTINUE 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, INDEXX INTEGER I, J, JUNK, K, LIMIT, MAXSET LOGICAL*1 ARRAY(2048), SET(MAXSET), VALID(2048) I = I + 1 J = J - 1 LIMIT = INDEXX( VALID, ESC( ARRAY, I) ) K = INDEXX( VALID, SET(J) ) 23046 IF (.NOT.(K .LE. LIMIT ))GOTO 23048 JUNK = ADDSET( VALID(K), SET, J, MAXSET) 23047 K = K + 1 GOTO 23046 23048 CONTINUE RETURN END LOGICAL*1 FUNCTION ESC( ARRAY, I) LOGICAL*1 ARRAY(2048), C LOGICAL*1 CLOWER INTEGER I, J IF (.NOT.( ARRAY(I) .NE. 64 ))GOTO 23049 ESC = ARRAY(I) GOTO 23050 23049 CONTINUE IF (.NOT.( ARRAY( I + 1 ) .EQ. 0 ))GOTO 23051 ESC = 64 GOTO 23052 23051 CONTINUE I = I + 1 C = CLOWER( ARRAY(I) ) IF (.NOT.( C .EQ. 110 ))GOTO 23053 ESC = 10 GOTO 23054 23053 CONTINUE IF (.NOT.( C .EQ. 116 ))GOTO 23055 ESC = 9 GOTO 23056 23055 CONTINUE IF (.NOT.( C .EQ. 114 ))GOTO 23057 ESC = 13 GOTO 23058 23057 CONTINUE IF (.NOT.( C .EQ. 98 ))GOTO 23059 ESC = 8 GOTO 23060 23059 CONTINUE IF (.NOT.( C .EQ. 101 ))GOTO 23061 ESC = 0 GOTO 23062 23061 CONTINUE IF (.NOT.( C .EQ. 102 ))GOTO 23063 ESC = 12 GOTO 23064 23063 CONTINUE IF (.NOT.( C .EQ. 108 ))GOTO 23065 ESC = 10 GOTO 23066 23065 CONTINUE IF (.NOT.( C .GE. 48 .AND. C .LE. 55 ))GOTO 23067 ESC = 0 J=I 23069 IF (.NOT.(J .LT. I+3 .AND. ( ARRAY(J) .GE. 48 .AND. ARRAY(J) .LE. *55 ) ))GOTO 23071 ESC = 8 * ESC + ( ARRAY(J) - 48 ) 23070 J=J+1 GOTO 23069 23071 CONTINUE I = J - 1 GOTO 23068 23067 CONTINUE ESC = C 23068 CONTINUE 23066 CONTINUE 23064 CONTINUE 23062 CONTINUE 23060 CONTINUE 23058 CONTINUE 23056 CONTINUE 23054 CONTINUE 23052 CONTINUE 23050 CONTINUE RETURN END SUBROUTINE FILSET( DELIM, ARRAY, I, SET, J, MAXSET) LOGICAL*1 ESC INTEGER ADDSET, INDEXX INTEGER I, J, JUNK, MAXSET LOGICAL*1 ARRAY(2048), 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/ 23072 IF (.NOT.(ARRAY(I) .NE. DELIM .AND. ARRAY(I) .NE. 0 ))GOTO 23074 IF (.NOT.( ARRAY(I) .EQ. 64 ))GOTO 23075 JUNK = ADDSET( ESC( ARRAY, I), SET, J, MAXSET) GOTO 23076 23075 CONTINUE IF (.NOT.( ARRAY(I) .NE. 45 ))GOTO 23077 JUNK = ADDSET( ARRAY(I), SET, J, MAXSET) GOTO 23078 23077 CONTINUE IF (.NOT.( J .LE. 1 .OR. ARRAY( I + 1 ) .EQ. 0 ))GOTO 23079 JUNK = ADDSET( 45, SET, J, MAXSET) GOTO 23080 23079 CONTINUE IF (.NOT.( INDEXX( DIGITS, SET( J - 1 ) ) .GT. 0 ))GOTO 23081 CALL DODASH( DIGITS, ARRAY, I, SET, J, MAXSET) GOTO 23082 23081 CONTINUE IF (.NOT.( INDEXX( LOWALF, SET( J - 1 ) ) .GT. 0 ))GOTO 23083 CALL DODASH( LOWALF, ARRAY, I, SET, J, MAXSET) GOTO 23084 23083 CONTINUE IF (.NOT.( INDEXX( UPALF, SET( J - 1 ) ) .GT. 0 ))GOTO 23085 CALL DODASH( UPALF, ARRAY, I, SET, J, MAXSET) GOTO 23086 23085 CONTINUE JUNK = ADDSET( 45, SET, J, MAXSET) 23086 CONTINUE 23084 CONTINUE 23082 CONTINUE 23080 CONTINUE 23078 CONTINUE 23076 CONTINUE 23073 I = I + 1 GOTO 23072 23074 CONTINUE RETURN END INTEGER FUNCTION GETCCL( ARG, I, PAT, J) LOGICAL*1 ARG(2048), TPAT(132) INTEGER ADDINT INTEGER I, J, JSTART, JUNK, K, INT, PAT(132) I = I + 1 IF (.NOT.( ARG(I) .EQ. 33 ))GOTO 23087 JUNK = ADDINT( 110, PAT, J, 132) I = I + 1 GOTO 23088 23087 CONTINUE JUNK = ADDINT( 91, PAT, J, 132) 23088 CONTINUE JSTART = J JUNK = ADDINT( 0, PAT, J, 132) K = 1 CALL FILSET( 93, ARG, I, TPAT, K, 132) TPAT(K) = 0 K = 1 23089 IF (.NOT.(TPAT(K) .NE. 0 ))GOTO 23091 INT = TPAT(K) JUNK = ADDINT( INT, PAT, J, 132) 23090 K = K + 1 GOTO 23089 23091 CONTINUE PAT(JSTART) = J - JSTART - 1 IF (.NOT.( ARG(I) .EQ. 93 ))GOTO 23092 GETCCL=(0) RETURN 23092 CONTINUE GETCCL=(-3) RETURN 23093 CONTINUE END INTEGER FUNCTION GETPAT( ARG, PAT) LOGICAL*1 ARG(2048) INTEGER PAT(132) INTEGER MAKPAT GETPAT = MAKPAT( ARG, 1, 0, PAT) RETURN END INTEGER FUNCTION GETSUB( ARG, SUB) LOGICAL*1 ARG(2048), 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) 23094 IF (.NOT.(I .GT. OFFSET ))GOTO 23096 IF (.NOT.( C .EQ. PAT(I) ))GOTO 23097 LOCATE=(1) RETURN 23097 CONTINUE 23095 I = I - 1 GOTO 23094 23096 CONTINUE LOCATE=(0) RETURN END INTEGER FUNCTION MAKPAT( ARG, FROM, DELIM, PAT) LOGICAL*1 ESC LOGICAL*1 ARG(2048), DELIM INTEGER ADDINT, GETCCL, STCLOS INTEGER FROM, I, J, JUNK, LASTCL, LASTJ, LJ, PAT(132), INT INTEGER TAGCNT, TAGI, TAGSTK(10) J = 1 LASTJ = 1 LASTCL = 0 TAGI = 0 TAGCNT = 0 I = FROM 23099 IF (.NOT.(ARG(I) .NE. DELIM .AND. ARG(I) .NE. 0 ))GOTO 23101 LJ = J IF (.NOT.( ARG(I) .EQ. 63 ))GOTO 23102 JUNK = ADDINT( 63, PAT, J, 132) GOTO 23103 23102 CONTINUE IF (.NOT.( ARG(I) .EQ. 37 .AND. I .EQ. FROM ))GOTO 23104 JUNK = ADDINT( 37, PAT, J, 132) GOTO 23105 23104 CONTINUE IF (.NOT.( ARG(I) .EQ. 36 .AND. ARG( I + 1 ) .EQ. DELIM ))GOTO 231 *06 JUNK = ADDINT( 36, PAT, J, 132) GOTO 23107 23106 CONTINUE IF (.NOT.( ARG(I) .EQ. 91 ))GOTO 23108 IF (.NOT.( GETCCL( ARG, I, PAT, J) .EQ. -3 ))GOTO 23110 GOTO 23101 23110 CONTINUE GOTO 23109 23108 CONTINUE IF (.NOT.( ( ARG(I) .EQ. 42 .OR. ARG(I) .EQ. 43 ) .AND. I .GT. FRO *M ))GOTO 23112 LJ = LASTJ IF (.NOT.( PAT(LJ) .EQ. 37 .OR. PAT(LJ) .EQ. 36 .OR. PAT(LJ) .EQ. *42 .OR. PAT(LJ) .EQ. 43 ))GOTO 23114 GOTO 23101 23114 CONTINUE IF (.NOT.( ARG(I) .EQ. 43 ))GOTO 23116 LASTJ = J 23118 IF (.NOT.(LJ .LT. LASTJ ))GOTO 23120 JUNK = ADDINT( PAT(LJ), PAT, J, 132) 23119 LJ = LJ + 1 GOTO 23118 23120 CONTINUE 23116 CONTINUE LASTCL = STCLOS( PAT, J, LASTJ, LASTCL) GOTO 23113 23112 CONTINUE IF (.NOT.( ARG(I) .EQ. 123 ))GOTO 23121 IF (.NOT.( TAGI .GT. 10 .OR. TAGCNT .GT. 10 ))GOTO 23123 GOTO 23101 23123 CONTINUE TAGCNT = TAGCNT + 1 TAGI = TAGI + 1 TAGSTK(TAGI) = TAGCNT JUNK = ADDINT( 123, PAT, J, 132) JUNK = ADDINT( TAGCNT, PAT, J, 132) GOTO 23122 23121 CONTINUE IF (.NOT.( ARG(I) .EQ. 125 ))GOTO 23125 IF (.NOT.( TAGI .LE. 0 ))GOTO 23127 GOTO 23101 23127 CONTINUE N = TAGSTK(TAGI) TAGI = TAGI - 1 JUNK = ADDINT( 125, PAT, J, 132) JUNK = ADDINT( N, PAT, J, 132) GOTO 23126 23125 CONTINUE JUNK = ADDINT( 97, PAT, J, 132) INT = ESC(ARG, I) JUNK = ADDINT( INT, PAT, J, 132) 23126 CONTINUE 23122 CONTINUE 23113 CONTINUE 23109 CONTINUE 23107 CONTINUE 23105 CONTINUE 23103 CONTINUE LASTJ = LJ 23100 I = I + 1 GOTO 23099 23101 CONTINUE IF (.NOT.( ARG(I) .NE. DELIM ))GOTO 23129 MAKPAT=(-3) RETURN 23129 CONTINUE IF (.NOT.( ADDINT( 0, PAT, J, 132) .EQ. 0 ))GOTO 23131 MAKPAT=(-3) RETURN 23131 CONTINUE IF (.NOT.( TAGI .GT. 0 ))GOTO 23133 MAKPAT=(-3) RETURN 23133 CONTINUE MAKPAT=(I) RETURN 23134 CONTINUE 23132 CONTINUE 23130 CONTINUE END INTEGER FUNCTION MAKSUB( ARG, FROM, DELIM, SUB) LOGICAL*1 ESC LOGICAL*1 ARG(2048), DELIM, SUB(132) INTEGER ADDSET, CTOI, TYPE INTEGER FROM, I, J, JUNK J = 1 I = FROM 23135 IF (.NOT.(ARG(I) .NE. DELIM .AND. ARG(I) .NE. 0 ))GOTO 23137 IF (.NOT.( ARG(I) .EQ. 38 ))GOTO 23138 JUNK = ADDSET( (-3), SUB, J, 132) GOTO 23139 23138 CONTINUE IF (.NOT.( ARG(I) .EQ. 36 .AND. TYPE( ARG( I + 1 ) ) .EQ. 2 ))GOTO * 23140 I = I + 1 N = CTOI( ARG, I) JUNK = ADDSET( (-4), SUB, J, 132) JUNK = ADDSET( N, SUB, J, 132) I = I - 1 GOTO 23141 23140 CONTINUE IF (.NOT.( ARG(I) .EQ. 36 .AND. ( ARG(I+1) .EQ. 110 .OR. ARG(I+1) *.EQ. 78 ) ))GOTO 23142 I = I + 1 JUNK = ADDSET( (-5), SUB, J, 132) GOTO 23143 23142 CONTINUE JUNK = ADDSET( ESC( ARG, I), SUB, J, 132) 23143 CONTINUE 23141 CONTINUE 23139 CONTINUE 23136 I = I + 1 GOTO 23135 23137 CONTINUE IF (.NOT.( ARG(I) .NE. DELIM ))GOTO 23144 MAKSUB = -3 GOTO 23145 23144 CONTINUE IF (.NOT.( ADDSET( 0, SUB, J, 132) .EQ. 0 ))GOTO 23146 MAKSUB = -3 GOTO 23147 23146 CONTINUE MAKSUB = I 23147 CONTINUE 23145 CONTINUE RETURN END INTEGER FUNCTION MATCH( LIN, PAT) LOGICAL*1 LIN(2048) INTEGER AMATCH INTEGER I, PAT(132) I = 1 23148 IF (.NOT.(LIN(I) .NE. 0 ))GOTO 23150 IF (.NOT.( AMATCH( LIN, I, PAT) .GT. 0 ))GOTO 23151 MATCH=(1) RETURN 23151 CONTINUE 23149 I = I + 1 GOTO 23148 23150 CONTINUE MATCH=(0) RETURN END INTEGER FUNCTION OMATCH( LIN, I, PAT, J) LOGICAL*1 LIN(2048) INTEGER LOCATE INTEGER BUMP, I, J, PAT(132) INTEGER TAGLIM LOGICAL*1 ST002Z(25) COMMON/CTAG/TAGLIM(20) DATA ST002Z(1)/63/,ST002Z(2)/32/,ST002Z(3)/73/,ST002Z(4)/110/,ST00 *2Z(5)/32/,ST002Z(6)/111/,ST002Z(7)/109/,ST002Z(8)/97/,ST002Z(9)/11 *6/,ST002Z(10)/99/,ST002Z(11)/104/,ST002Z(12)/58/,ST002Z(13)/32/,ST *002Z(14)/99/,ST002Z(15)/97/,ST002Z(16)/110/,ST002Z(17)/116/,ST002Z *(18)/32/,ST002Z(19)/104/,ST002Z(20)/97/,ST002Z(21)/112/,ST002Z(22) */112/,ST002Z(23)/101/,ST002Z(24)/110/,ST002Z(25)/0/ OMATCH = 0 IF (.NOT.( LIN(I) .EQ. 0 ))GOTO 23153 RETURN 23153 CONTINUE BUMP = -1 IF (.NOT.( PAT(J) .EQ. 97 ))GOTO 23155 IF (.NOT.( LIN(I) .EQ. PAT( J + 1 ) ))GOTO 23157 BUMP = 1 23157 CONTINUE GOTO 23156 23155 CONTINUE IF (.NOT.( PAT(J) .EQ. 37 ))GOTO 23159 IF (.NOT.( I .EQ. 1 ))GOTO 23161 BUMP = 0 23161 CONTINUE GOTO 23160 23159 CONTINUE IF (.NOT.( PAT(J) .EQ. 63 ))GOTO 23163 IF (.NOT.( LIN(I) .NE. 10 ))GOTO 23165 BUMP = 1 23165 CONTINUE GOTO 23164 23163 CONTINUE IF (.NOT.( PAT(J) .EQ. 36 ))GOTO 23167 IF (.NOT.( LIN(I) .EQ. 10 ))GOTO 23169 BUMP = 0 23169 CONTINUE GOTO 23168 23167 CONTINUE IF (.NOT.( PAT(J) .EQ. 91 ))GOTO 23171 IF (.NOT.( LOCATE( LIN(I), PAT, J + 1 ) .EQ. 1 ))GOTO 23173 BUMP = 1 23173 CONTINUE GOTO 23172 23171 CONTINUE IF (.NOT.( PAT(J) .EQ. 110 ))GOTO 23175 IF (.NOT.( LIN(I) .NE. 10 .AND. LOCATE( LIN(I), PAT, J + 1 ) .EQ. *0 ))GOTO 23177 BUMP = 1 23177 CONTINUE GOTO 23176 23175 CONTINUE IF (.NOT.( PAT(J) .EQ. 123 ))GOTO 23179 N = PAT( J + 1 ) TAGLIM( 2 * N - 1 ) = I BUMP = 0 GOTO 23180 23179 CONTINUE IF (.NOT.( PAT(J) .EQ. 125 ))GOTO 23181 N = PAT( J + 1 ) TAGLIM( 2 * N ) = I BUMP = 0 GOTO 23182 23181 CONTINUE CALL ERROR( ST002Z ) 23182 CONTINUE 23180 CONTINUE 23176 CONTINUE 23172 CONTINUE 23168 CONTINUE 23164 CONTINUE 23160 CONTINUE 23156 CONTINUE IF (.NOT.( BUMP .GE. 0 ))GOTO 23183 I = I + BUMP OMATCH = 1 23183 CONTINUE RETURN END INTEGER FUNCTION PATSIZ( PAT, N) INTEGER N, PAT(132) LOGICAL*1 ST003Z(25) DATA ST003Z(1)/63/,ST003Z(2)/32/,ST003Z(3)/73/,ST003Z(4)/110/,ST00 *3Z(5)/32/,ST003Z(6)/112/,ST003Z(7)/97/,ST003Z(8)/116/,ST003Z(9)/11 *5/,ST003Z(10)/105/,ST003Z(11)/122/,ST003Z(12)/58/,ST003Z(13)/32/,S *T003Z(14)/99/,ST003Z(15)/97/,ST003Z(16)/110/,ST003Z(17)/116/,ST003 *Z(18)/32/,ST003Z(19)/104/,ST003Z(20)/97/,ST003Z(21)/112/,ST003Z(22 *)/112/,ST003Z(23)/101/,ST003Z(24)/110/,ST003Z(25)/0/ IF (.NOT.( PAT(N) .EQ. 97 .OR. PAT(N) .EQ. 123 .OR. PAT(N) .EQ. 12 *5 ))GOTO 23185 PATSIZ = 2 GOTO 23186 23185 CONTINUE IF (.NOT.( PAT(N) .EQ. 37 .OR. PAT(N) .EQ. 36 .OR. PAT(N) .EQ. 63 *))GOTO 23187 PATSIZ = 1 GOTO 23188 23187 CONTINUE IF (.NOT.( PAT(N) .EQ. 91 .OR. PAT(N) .EQ. 110 ))GOTO 23189 PATSIZ = PAT( N + 1 ) + 2 GOTO 23190 23189 CONTINUE IF (.NOT.( PAT(N) .EQ. 42 ))GOTO 23191 PATSIZ = 4 GOTO 23192 23191 CONTINUE CALL ERROR( ST003Z ) 23192 CONTINUE 23190 CONTINUE 23188 CONTINUE 23186 CONTINUE RETURN END INTEGER FUNCTION STCLOS( PAT, J, LASTJ, LASTCL) INTEGER ADDINT INTEGER J, JP, JT, JUNK, LASTCL, LASTJ, PAT(132) JP = J - 1 23193 IF (.NOT.(JP .GE. LASTJ ))GOTO 23195 JT = JP + 4 JUNK = ADDINT( PAT(JP), PAT, JT, 132) 23194 JP = JP - 1 GOTO 23193 23195 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 SUBROUTINE GNOREG(VALUE) INTEGER VALUE INTEGER NOREG COMMON/CNOREG/NOREG VALUE = NOREG RETURN END SUBROUTINE SNOREG(VALUE) INTEGER VALUE INTEGER NOREG COMMON/CNOREG/NOREG NOREG = VALUE 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) LOGICAL*1 ST001Z(41) COMMON/CPBACK/PBP, PBSIZE, PBBUF DATA ST001Z(1)/112/,ST001Z(2)/117/,ST001Z(3)/116/,ST001Z(4)/98/,ST *001Z(5)/97/,ST001Z(6)/107/,ST001Z(7)/32/,ST001Z(8)/45/,ST001Z(9)/3 *2/,ST001Z(10)/116/,ST001Z(11)/111/,ST001Z(12)/111/,ST001Z(13)/32/, *ST001Z(14)/109/,ST001Z(15)/97/,ST001Z(16)/110/,ST001Z(17)/121/,ST0 *01Z(18)/32/,ST001Z(19)/99/,ST001Z(20)/104/,ST001Z(21)/97/,ST001Z(2 *2)/114/,ST001Z(23)/97/,ST001Z(24)/99/,ST001Z(25)/116/,ST001Z(26)/1 *01/,ST001Z(27)/114/,ST001Z(28)/115/,ST001Z(29)/32/,ST001Z(30)/112/ *,ST001Z(31)/117/,ST001Z(32)/115/,ST001Z(33)/104/,ST001Z(34)/101/,S *T001Z(35)/100/,ST001Z(36)/32/,ST001Z(37)/98/,ST001Z(38)/97/,ST001Z *(39)/99/,ST001Z(40)/107/,ST001Z(41)/0/ PBP = PBP + 1 IF (.NOT.(PBP .GT. PBSIZE))GOTO 23004 CALL ERROR(ST001Z) 23004 CONTINUE PBBUF(PBP) = C RETURN END SUBROUTINE PBSTR(IN) LOGICAL*1 IN(2048) INTEGER LENGTH INTEGER I INTEGER PBP, PBSIZE LOGICAL*1 PBBUF(1) LOGICAL*1 ST002Z(40) COMMON/CPBACK/PBP, PBSIZE, PBBUF DATA ST002Z(1)/112/,ST002Z(2)/98/,ST002Z(3)/115/,ST002Z(4)/116/,ST *002Z(5)/114/,ST002Z(6)/32/,ST002Z(7)/45/,ST002Z(8)/32/,ST002Z(9)/1 *16/,ST002Z(10)/111/,ST002Z(11)/111/,ST002Z(12)/32/,ST002Z(13)/109/ *,ST002Z(14)/97/,ST002Z(15)/110/,ST002Z(16)/121/,ST002Z(17)/32/,ST0 *02Z(18)/99/,ST002Z(19)/104/,ST002Z(20)/97/,ST002Z(21)/114/,ST002Z( *22)/97/,ST002Z(23)/99/,ST002Z(24)/116/,ST002Z(25)/101/,ST002Z(26)/ *114/,ST002Z(27)/115/,ST002Z(28)/32/,ST002Z(29)/112/,ST002Z(30)/117 */,ST002Z(31)/115/,ST002Z(32)/104/,ST002Z(33)/101/,ST002Z(34)/100/, *ST002Z(35)/32/,ST002Z(36)/98/,ST002Z(37)/97/,ST002Z(38)/99/,ST002Z *(39)/107/,ST002Z(40)/0/ I = LENGTH(IN) 23006 IF (.NOT.(I .GT. 0))GOTO 23008 PBP = PBP + 1 IF (.NOT.(PBP .GT. PBSIZE))GOTO 23009 CALL ERROR(ST002Z) 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(2048), LIN(2048), TMP(2048) 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(10), J, JUNK, DESC INTEGER LENGTH, GTFTOK, OPENDR, GDRPRM, EQUAL, PRAW03 LOGICAL*1 INPSTR(2048), OUTSTR(2048), PATH(480), PAT(480), 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(2048), S2(2048) 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(2048), S2(2048) 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(3) DATA TTYSTR(1)/84/,TTYSTR(2)/84/,TTYSTR(3)/0/ IF (.NOT.(OUT .EQ. -1))GOTO 23027 OUT = CREATE(TTYSTR, 2) IF (.NOT.(OUT .NE. -3))GOTO 23029 IF (.NOT.(STMODE(OUT, 2) .NE. 2))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, 2) .EQ. 2))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(2048), OUTSTR(480) 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(2048), LIN(2048), TEMP(2048) 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(2048), LIN(2048), C, TMP(2048) LOGICAL*1 GETCH INTEGER IN, I, J, K, L, OUT, SAVMOD INTEGER PROMPT, PRAW08, PRAW10, LENGTH, PRAW05, INDEXX, 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. INDEXX(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.(INDEXX(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 INDEXX LOGICAL*1 RUBSTR(2048), STR(2048), TRMARA(2048) IF (.NOT.(COL .GT. 1))GOTO 23095 I = COL - 1 23097 IF (.NOT.(INDEXX(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. INDEXX(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(2048), IMAGE(480), PID(9) INTEGER LOCCOM, SPAWN 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)/101/,SUFFIX(3)/120/,SUFFIX(4)/101/,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 = SPAWN(IMAGE, ARGS, PID, 119) RETURN END INTEGER FUNCTION PRAW10(STR, COL, RUBSTR, CHN, SEPARA) INTEGER I, CHN, COL INTEGER INDEXX LOGICAL*1 RUBSTR(2048), STR(2048), SEPARA(2048) IF (.NOT.(COL .GT. 1))GOTO 23108 I = COL - 1 23110 IF (.NOT.(INDEXX(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(2048), 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(2048), OUT(2048) 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(2048) INTEGER ALLDIG, CTOI, GTWORD LOGICAL*1 N(4), BUF(2048) P = 0 I = 1 23020 IF (.NOT.(I .LE. 2048 ))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. 2048 ))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. 2048 ))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. 2048 ))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(2048) IF (.NOT.( COL .GT. 2048 ))GOTO 23044 TABPOS = 1 GOTO 23045 23044 CONTINUE TABPOS = TABS(COL) 23045 CONTINUE RETURN END SUBROUTINE TBINIT(SIZE) INTEGER SIZE INTEGER TABLE INTEGER MKTABL COMMON/CTB/TABLE CALL DSINIT(SIZE) TABLE = MKTABL(1) RETURN END SUBROUTINE TBINST( NAME, DEFN) LOGICAL*1 NAME(2048), DEFN(2048) INTEGER TABLE INTEGER LOOKUP, ENTER INTEGER TEXT INTEGER SDUPL LOGICAL*1 ST001Z(40) COMMON/CTB/TABLE DATA ST001Z(1)/63/,ST001Z(2)/32/,ST001Z(3)/73/,ST001Z(4)/110/,ST00 *1Z(5)/32/,ST001Z(6)/116/,ST001Z(7)/98/,ST001Z(8)/105/,ST001Z(9)/11 *0/,ST001Z(10)/115/,ST001Z(11)/116/,ST001Z(12)/58/,ST001Z(13)/32/,S *T001Z(14)/110/,ST001Z(15)/111/,ST001Z(16)/32/,ST001Z(17)/114/,ST00 *1Z(18)/111/,ST001Z(19)/111/,ST001Z(20)/109/,ST001Z(21)/32/,ST001Z( *22)/102/,ST001Z(23)/111/,ST001Z(24)/114/,ST001Z(25)/32/,ST001Z(26) */110/,ST001Z(27)/101/,ST001Z(28)/119/,ST001Z(29)/32/,ST001Z(30)/10 *0/,ST001Z(31)/101/,ST001Z(32)/102/,ST001Z(33)/105/,ST001Z(34)/110/ *,ST001Z(35)/105/,ST001Z(36)/116/,ST001Z(37)/105/,ST001Z(38)/111/,S *T001Z(39)/110/,ST001Z(40)/0/ 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( ST001Z ) RETURN END INTEGER FUNCTION TBLOOK( ID, DEFN) LOGICAL*1 ID(2048), DEFN(2048) INTEGER TABLE INTEGER MEM( 1) LOGICAL*1 C MEM(4) INTEGER I, J INTEGER LOOKUP INTEGER LOCN COMMON/CTB/TABLE COMMON/CDSMEM/ MEM EQUIVALENCE (C MEM(1), MEM(1)) TBLOOK = LOOKUP( ID, LOCN, TABLE) IF (.NOT.( TBLOOK .EQ. 1 ))GOTO 23006 I = 1 J = (4*(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