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