SUBROUTINE MAIN COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10) *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO *C, BKLTH, LCOUNT, LOCATD(10) INTEGER ANDPAT INTEGER COUNT INTEGER EXCEPT INTEGER ELEVEL INTEGER CASIND INTEGER PAT INTEGER ATEND INTEGER ATBEG INTEGER SEPS INTEGER NBRSEP INTEGER SEPLOC INTEGER MCOUNT INTEGER SKPING LOGICAL*1 LOCATD INTEGER BKLTH INTEGER LCOUNT CALL QUERY(58Husage: fb [-acix] [-ln] [-sexpr [-sexpr]] expr [exp *r] ...) CALL FBARGS CALL DOBK (1) IF (.NOT.(COUNT .EQ. 1))GOTO 23000 CALL PUTINT(MCOUNT, 1,2) CALL PUTCH(10,2) 23000 CONTINUE RETURN END SUBROUTINE BMATCH (LINE) LOGICAL*1 LINE(100) INTEGER MATCH COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10) *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO *C, BKLTH, LCOUNT, LOCATD(10) INTEGER ANDPAT INTEGER COUNT INTEGER EXCEPT INTEGER ELEVEL INTEGER CASIND INTEGER PAT INTEGER ATEND INTEGER ATBEG INTEGER SEPS INTEGER NBRSEP INTEGER SEPLOC INTEGER MCOUNT INTEGER SKPING LOGICAL*1 LOCATD INTEGER BKLTH INTEGER LCOUNT COMMON / FBTEMP / TMPBUF(512) LOGICAL*1 TMPBUF CALL STRCPY(LINE, TMPBUF) IF (.NOT.(CASIND .EQ. 1))GOTO 23002 CALL FOLD(TMPBUF) 23002 CONTINUE I=1 23004 IF (.NOT.(I.LE.ELEVEL))GOTO 23006 IF (.NOT.(MATCH(TMPBUF, PAT(1,I)) .EQ. 1))GOTO 23007 LOCATD(I) = 1 23007 CONTINUE 23005 I=I+1 GOTO 23004 23006 CONTINUE RETURN END SUBROUTINE CHECKL (LINE) LOGICAL*1 LINE(100) INTEGER MATCH COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10) *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO *C, BKLTH, LCOUNT, LOCATD(10) INTEGER ANDPAT INTEGER COUNT INTEGER EXCEPT INTEGER ELEVEL INTEGER CASIND INTEGER PAT INTEGER ATEND INTEGER ATBEG INTEGER SEPS INTEGER NBRSEP INTEGER SEPLOC INTEGER MCOUNT INTEGER SKPING LOGICAL*1 LOCATD INTEGER BKLTH INTEGER LCOUNT COMMON / FBTEMP / TMPBUF(512) LOGICAL*1 TMPBUF CALL STRCPY(LINE, TMPBUF) IF (.NOT.(CASIND .EQ. 1))GOTO 23009 CALL FOLD(TMPBUF) 23009 CONTINUE ATBEG = MATCH(TMPBUF, SEPS(1,1)) IF (.NOT.(NBRSEP .EQ. 1))GOTO 23011 ATEND = ATBEG GOTO 23012 23011 CONTINUE ATEND = MATCH(TMPBUF, SEPS(1,2)) 23012 CONTINUE RETURN END SUBROUTINE DOBEG (LINE) LOGICAL*1 LINE(100) INTEGER STACKL COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10) *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO *C, BKLTH, LCOUNT, LOCATD(10) INTEGER ANDPAT INTEGER COUNT INTEGER EXCEPT INTEGER ELEVEL INTEGER CASIND INTEGER PAT INTEGER ATEND INTEGER ATBEG INTEGER SEPS INTEGER NBRSEP INTEGER SEPLOC INTEGER MCOUNT INTEGER SKPING LOGICAL*1 LOCATD INTEGER BKLTH INTEGER LCOUNT CALL INITBK LCOUNT = 0 IF (.NOT.(NBRSEP .GT. 1 .OR. SEPLOC .EQ. 1))GOTO 23013 CALL BMATCH(LINE) IF (.NOT.(STACKL(LINE) .EQ. -3))GOTO 23015 CALL ERROR (21HBlock buffer overflow) 23015 CONTINUE 23013 CONTINUE SKPING = 0 PRTING = 0 RETURN END SUBROUTINE DOBK (FD) INTEGER GETLIN, REMOVE INTEGER FD, PRT, FIRST, JUNK LOGICAL*1 LINE(512) COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10) *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO *C, BKLTH, LCOUNT, LOCATD(10) INTEGER ANDPAT INTEGER COUNT INTEGER EXCEPT INTEGER ELEVEL INTEGER CASIND INTEGER PAT INTEGER ATEND INTEGER ATBEG INTEGER SEPS INTEGER NBRSEP INTEGER SEPLOC INTEGER MCOUNT INTEGER SKPING LOGICAL*1 LOCATD INTEGER BKLTH INTEGER LCOUNT COMMON /FBBUF/ FBBUF(5000), ENDSTK, FNAME(40), FB LOGICAL*1 FBBUF INTEGER ENDSTK LOGICAL*1 FNAME INTEGER FB CALL INITBK FIRST = 1 23017 IF (.NOT.(GETLIN(LINE, FD) .NE. -1))GOTO 23018 CALL CHECKL (LINE) IF (.NOT.(FIRST .EQ. 1 .AND. ATEND .EQ. 1 .AND. NBRSEP .EQ. 1))GOT *O 23019 SEPLOC = 1 23019 CONTINUE FIRST = 0 IF (.NOT.(ATEND .EQ. 1))GOTO 23021 CALL DOEND(LINE) 23021 CONTINUE IF (.NOT.(ATBEG .EQ. 1))GOTO 23023 CALL DOBEG(LINE) GOTO 23017 23023 CONTINUE IF (.NOT.(SKPING .EQ. 1))GOTO 23025 GOTO 23017 23025 CONTINUE CALL DOLIN (LINE) 23026 CONTINUE GOTO 23017 23018 CONTINUE IF (.NOT.(SKPING .EQ. 0))GOTO 23027 CALL DOEND(LINE) 23027 CONTINUE IF (.NOT.(FB .NE. -3))GOTO 23029 CALL CLOSE(FB) JUNK = REMOVE(FNAME) FB = -3 23029 CONTINUE RETURN END SUBROUTINE DOEND (LINE) LOGICAL*1 LINE(100) INTEGER STACKL INTEGER PRT COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10) *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO *C, BKLTH, LCOUNT, LOCATD(10) INTEGER ANDPAT INTEGER COUNT INTEGER EXCEPT INTEGER ELEVEL INTEGER CASIND INTEGER PAT INTEGER ATEND INTEGER ATBEG INTEGER SEPS INTEGER NBRSEP INTEGER SEPLOC INTEGER MCOUNT INTEGER SKPING LOGICAL*1 LOCATD INTEGER BKLTH INTEGER LCOUNT IF (.NOT.(PRTING .EQ. 1))GOTO 23031 IF (.NOT.( (NBRSEP .GT. 1 .OR. SEPLOC .EQ. 0) .AND. COUNT .EQ. 0)) *GOTO 23033 CALL OUTLIN(LINE) 23033 CONTINUE IF (.NOT.(BKLTH .NE. 30000))GOTO 23035 LCOUNT=LCOUNT+1 23037 IF (.NOT.(LCOUNT.LE.BKLTH))GOTO 23039 CALL PUTCH(10, 2) 23038 LCOUNT=LCOUNT+1 GOTO 23037 23039 CONTINUE 23035 CONTINUE GOTO 23032 23031 CONTINUE IF (.NOT.(SKPING .EQ. 0))GOTO 23040 IF (.NOT.(NBRSEP .GT. 1 .OR. SEPLOC .EQ. 0))GOTO 23042 CALL BMATCH (LINE) IF (.NOT.(STACKL(LINE) .EQ.-3))GOTO 23044 CALL ERROR (21HBlock buffer overflow) 23044 CONTINUE 23042 CONTINUE CALL TALLY (PRT) IF (.NOT.(PRT .EQ. 1))GOTO 23046 CALL PRINTB IF (.NOT.(BKLTH .NE. 30000))GOTO 23048 LCOUNT=LCOUNT+1 23050 IF (.NOT.(LCOUNT.LE.BKLTH))GOTO 23052 CALL PUTCH(10,2) 23051 LCOUNT=LCOUNT+1 GOTO 23050 23052 CONTINUE 23048 CONTINUE 23046 CONTINUE 23040 CONTINUE 23032 CONTINUE SKPING = 1 PRTING = 0 RETURN END SUBROUTINE DOLIN (LINE) LOGICAL*1 LINE(100) INTEGER PRT INTEGER STACKL COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10) *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO *C, BKLTH, LCOUNT, LOCATD(10) INTEGER ANDPAT INTEGER COUNT INTEGER EXCEPT INTEGER ELEVEL INTEGER CASIND INTEGER PAT INTEGER ATEND INTEGER ATBEG INTEGER SEPS INTEGER NBRSEP INTEGER SEPLOC INTEGER MCOUNT INTEGER SKPING LOGICAL*1 LOCATD INTEGER BKLTH INTEGER LCOUNT IF (.NOT.(SKPING .EQ. 1))GOTO 23053 RETURN 23053 CONTINUE IF (.NOT.(PRTING .EQ. 1))GOTO 23055 IF (.NOT.(COUNT .EQ. 0))GOTO 23057 CALL OUTLIN(LINE) 23057 CONTINUE GOTO 23056 23055 CONTINUE CALL BMATCH (LINE) IF (.NOT.(STACKL(LINE) .EQ. -3))GOTO 23059 CALL ERROR (21HBlock buffer overflow) 23059 CONTINUE CALL TALLY(PRT) IF (.NOT.(PRT .EQ. 1 .AND. EXCEPT .EQ. 0))GOTO 23061 CALL PRINTB PRTING = 1 GOTO 23062 23061 CONTINUE IF (.NOT.(PRT .EQ. 0 .AND. EXCEPT .EQ. 1))GOTO 23063 SKPING = 1 23063 CONTINUE 23062 CONTINUE 23056 CONTINUE RETURN END SUBROUTINE FBARGS LOGICAL*1 ARG(512) INTEGER GETARG, ITOC, GETPAT, STATUS, INDEXC, CTOI INTEGER I, J COMMON /FBBUF/ FBBUF(5000), ENDSTK, FNAME(40), FB LOGICAL*1 FBBUF INTEGER ENDSTK LOGICAL*1 FNAME INTEGER FB COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10) *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO *C, BKLTH, LCOUNT, LOCATD(10) INTEGER ANDPAT INTEGER COUNT INTEGER EXCEPT INTEGER ELEVEL INTEGER CASIND INTEGER PAT INTEGER ATEND INTEGER ATBEG INTEGER SEPS INTEGER NBRSEP INTEGER SEPLOC INTEGER MCOUNT INTEGER SKPING LOGICAL*1 LOCATD INTEGER BKLTH INTEGER LCOUNT LOGICAL*1 ILPAT(18) LOGICAL*1 MAXEXP(30) LOGICAL*1 DSEP(5) DATA ILPAT(1)/105/,ILPAT(2)/108/,ILPAT(3)/108/,ILPAT(4)/101/,ILPAT *(5)/103/,ILPAT(6)/97/,ILPAT(7)/108/,ILPAT(8)/32/,ILPAT(9)/112/,ILP *AT(10)/97/,ILPAT(11)/116/,ILPAT(12)/116/,ILPAT(13)/101/,ILPAT(14)/ *114/,ILPAT(15)/110/,ILPAT(16)/58/,ILPAT(17)/32/,ILPAT(18)/0/ DATA MAXEXP(1)/109/,MAXEXP(2)/97/,MAXEXP(3)/120/,MAXEXP(4)/32/,MAX *EXP(5)/110/,MAXEXP(6)/98/,MAXEXP(7)/114/,MAXEXP(8)/32/,MAXEXP(9)/1 *01/,MAXEXP(10)/120/,MAXEXP(11)/112/,MAXEXP(12)/114/,MAXEXP(13)/101 */,MAXEXP(14)/115/,MAXEXP(15)/115/,MAXEXP(16)/105/,MAXEXP(17)/111/, *MAXEXP(18)/110/,MAXEXP(19)/115/,MAXEXP(20)/32/,MAXEXP(21)/97/,MAXE *XP(22)/108/,MAXEXP(23)/108/,MAXEXP(24)/111/,MAXEXP(25)/119/,MAXEXP *(26)/101/,MAXEXP(27)/100/,MAXEXP(28)/58/,MAXEXP(29)/32/,MAXEXP(30) */0/ DATA DSEP(1)/37/,DSEP(2)/32/,DSEP(3)/42/,DSEP(4)/36/,DSEP(5)/0/ DATA EXCEPT/0/ DATA ANDPAT/0/ DATA COUNT /0/ DATA MCOUNT /0/ DATA ELEVEL/0/ DATA CASIND/0/ DATA SKPING /0/ DATA NBRSEP /0/ DATA SEPLOC /0/ DATA ENDSTK /0/ DATA FB /-3/ DATA BKLTH /30000/ DATA LCOUNT /0/ I=1 23065 IF (.NOT.(GETARG(I, ARG, 128) .NE. -1))GOTO 23067 IF (.NOT.(ARG(1) .EQ. 45 .AND. (ARG(2) .EQ. 115 .OR. ARG(2) .EQ. 8 *3)))GOTO 23068 NBRSEP = NBRSEP + 1 IF (.NOT.(NBRSEP .GT. 2))GOTO 23070 CALL ERROR (40Honly start and ending separators allowed) 23070 CONTINUE IF (.NOT.(CASIND .EQ. 1))GOTO 23072 CALL FOLD(ARG) 23072 CONTINUE IF (.NOT.(GETPAT(ARG(3), SEPS(1, NBRSEP)) .EQ. -3))GOTO 23074 CALL PUTLIN(ILPAT, 3) CALL ERROR (ARG(3)) 23074 CONTINUE GOTO 23069 23068 CONTINUE IF (.NOT.(ARG(1) .EQ. 45))GOTO 23076 CALL FOLD(ARG) IF (.NOT.(INDEXC(ARG, 97) .GT. 0))GOTO 23078 ANDPAT = 1 23078 CONTINUE IF (.NOT.(INDEXC(ARG, 99) .GT. 0))GOTO 23080 COUNT = 1 23080 CONTINUE IF (.NOT.(INDEXC(ARG, 105) .GT. 0))GOTO 23082 CASIND = 1 23082 CONTINUE IF (.NOT.(INDEXC(ARG, 120) .GT. 0))GOTO 23084 EXCEPT = 1 23084 CONTINUE J = INDEXC(ARG, 108) IF (.NOT.(J .GT. 0))GOTO 23086 J = J + 1 BKLTH = CTOI(ARG, J) IF (.NOT.(BKLTH .LE. 0))GOTO 23088 CALL ERROR(58Husage: fb [-acix] [-ln] [-sexpr [-sexpr]] expr [exp *r] ...) 23088 CONTINUE 23086 CONTINUE GOTO 23077 23076 CONTINUE IF (.NOT.(ELEVEL .LT. 10))GOTO 23090 ELEVEL = ELEVEL + 1 IF (.NOT.(CASIND .EQ. 1))GOTO 23092 CALL FOLD(ARG) 23092 CONTINUE IF (.NOT.(GETPAT(ARG(1), PAT(1,ELEVEL)) .EQ. -3))GOTO 23094 CALL PUTLIN(ILPAT, 3) CALL ERROR (ARG) 23094 CONTINUE GOTO 23091 23090 CONTINUE CALL PUTLIN(MAXEXP, 3) STATUS = ITOC(10, ARG, 128) CALL ERROR(ARG) 23091 CONTINUE 23077 CONTINUE 23069 CONTINUE 23066 I=I+1 GOTO 23065 23067 CONTINUE IF (.NOT.(ELEVEL .EQ. 0))GOTO 23096 CALL ERROR(58Husage: fb [-acix] [-ln] [-sexpr [-sexpr]] expr [exp *r] ...) 23096 CONTINUE IF (.NOT.(NBRSEP .EQ. 0))GOTO 23098 IF (.NOT.(GETPAT(DSEP, SEPS(1,1)) .EQ. -3))GOTO 23100 CALL ERROR (25Hillegal default separator) 23100 CONTINUE NBRSEP = 1 23098 CONTINUE IF (.NOT.(NBRSEP .GT. 1))GOTO 23102 SKPING = 1 23102 CONTINUE RETURN END SUBROUTINE INITBK INTEGER JUNK INTEGER REMOVE COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10) *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO *C, BKLTH, LCOUNT, LOCATD(10) INTEGER ANDPAT INTEGER COUNT INTEGER EXCEPT INTEGER ELEVEL INTEGER CASIND INTEGER PAT INTEGER ATEND INTEGER ATBEG INTEGER SEPS INTEGER NBRSEP INTEGER SEPLOC INTEGER MCOUNT INTEGER SKPING LOGICAL*1 LOCATD INTEGER BKLTH INTEGER LCOUNT COMMON /FBBUF/ FBBUF(5000), ENDSTK, FNAME(40), FB LOGICAL*1 FBBUF INTEGER ENDSTK LOGICAL*1 FNAME INTEGER FB I=1 23104 IF (.NOT.(I.LE.ELEVEL))GOTO 23106 LOCATD(I) = 0 23105 I=I+1 GOTO 23104 23106 CONTINUE ENDSTK = 0 IF (.NOT.(FB .NE. -3))GOTO 23107 CALL CLOSE(FB) JUNK = REMOVE(FNAME) FB = -3 23107 CONTINUE RETURN END SUBROUTINE OUTLIN(LINE) LOGICAL*1 LINE(100) COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10) *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO *C, BKLTH, LCOUNT, LOCATD(10) INTEGER ANDPAT INTEGER COUNT INTEGER EXCEPT INTEGER ELEVEL INTEGER CASIND INTEGER PAT INTEGER ATEND INTEGER ATBEG INTEGER SEPS INTEGER NBRSEP INTEGER SEPLOC INTEGER MCOUNT INTEGER SKPING LOGICAL*1 LOCATD INTEGER BKLTH INTEGER LCOUNT LCOUNT = LCOUNT + 1 IF (.NOT.(LCOUNT .LE. BKLTH))GOTO 23109 CALL PUTLIN(LINE, 2) 23109 CONTINUE RETURN END SUBROUTINE PRINTB INTEGER I, JUNK LOGICAL*1 C LOGICAL*1 GETCH INTEGER OPEN, REMOVE COMMON /FBBUF/ FBBUF(5000), ENDSTK, FNAME(40), FB LOGICAL*1 FBBUF INTEGER ENDSTK LOGICAL*1 FNAME INTEGER FB COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10) *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO *C, BKLTH, LCOUNT, LOCATD(10) INTEGER ANDPAT INTEGER COUNT INTEGER EXCEPT INTEGER ELEVEL INTEGER CASIND INTEGER PAT INTEGER ATEND INTEGER ATBEG INTEGER SEPS INTEGER NBRSEP INTEGER SEPLOC INTEGER MCOUNT INTEGER SKPING LOGICAL*1 LOCATD INTEGER BKLTH INTEGER LCOUNT IF (.NOT.(ENDSTK .EQ. 0 .AND. FB .EQ. -3))GOTO 23111 RETURN 23111 CONTINUE IF (.NOT.(COUNT .EQ. 1))GOTO 23113 MCOUNT = MCOUNT + 1 RETURN 23113 CONTINUE IF (.NOT.(FB .NE. -3))GOTO 23115 CALL CLOSE(FB) FB = OPEN(FNAME, 1) IF (.NOT.(FB .EQ. -3))GOTO 23117 CALL ERROR (31Hproblems reopening scratch file) 23117 CONTINUE 23119 IF (.NOT.(GETCH(C, FB) .NE. -1))GOTO 23120 CALL PUTCH(C, 2) GOTO 23119 23120 CONTINUE CALL CLOSE(FB) JUNK = REMOVE (FNAME) FB = -3 23115 CONTINUE I=1 23121 IF (.NOT.(I.LE.ENDSTK))GOTO 23123 CALL PUTCH(FBBUF(I), 2) 23122 I=I+1 GOTO 23121 23123 CONTINUE RETURN END INTEGER FUNCTION STACKL (LINE) LOGICAL*1 LINE(512) INTEGER LENGTH, CREATE INTEGER LEN COMMON /FBBUF/ FBBUF(5000), ENDSTK, FNAME(40), FB LOGICAL*1 FBBUF INTEGER ENDSTK LOGICAL*1 FNAME INTEGER FB COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10) *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO *C, BKLTH, LCOUNT, LOCATD(10) INTEGER ANDPAT INTEGER COUNT INTEGER EXCEPT INTEGER ELEVEL INTEGER CASIND INTEGER PAT INTEGER ATEND INTEGER ATBEG INTEGER SEPS INTEGER NBRSEP INTEGER SEPLOC INTEGER MCOUNT INTEGER SKPING LOGICAL*1 LOCATD INTEGER BKLTH INTEGER LCOUNT LOGICAL*1 FBTEMP(4) DATA FBTEMP(1)/102/,FBTEMP(2)/98/,FBTEMP(3)/116/,FBTEMP(4)/0/ STACKL = 0 IF (.NOT.(COUNT .EQ. 1))GOTO 23124 RETURN 23124 CONTINUE LCOUNT = LCOUNT + 1 IF (.NOT.(LCOUNT .GT. BKLTH))GOTO 23126 RETURN 23126 CONTINUE LEN = LENGTH(LINE) IF (.NOT.( (LEN+ENDSTK+1) .GT. 5000))GOTO 23128 IF (.NOT.(FB .EQ. -3))GOTO 23130 CALL SCRATF(FBTEMP, FNAME) FB = CREATE(FNAME, 2) IF (.NOT.(FB .EQ. -3))GOTO 23132 CALL REMARK (29Hproblems opening scratch file) CALL CANT (FNAME) 23132 CONTINUE 23130 CONTINUE I=1 23134 IF (.NOT.(I.LE.ENDSTK))GOTO 23136 CALL PUTCH(FBBUF(I), FB) 23135 I=I+1 GOTO 23134 23136 CONTINUE CALL PUTLIN(LINE, FB) ENDSTK = 0 RETURN 23128 CONTINUE CALL SCOPY(LINE, 1, FBBUF, ENDSTK+1) ENDSTK = ENDSTK + LEN RETURN END SUBROUTINE TALLY (PRT) INTEGER PRT COMMON /FBCOM/ ANDPAT, COUNT, EXCEPT, ELEVEL, CASIND, PAT(132, 10) *, ATEND, ATBEG, SEPS(132,2), NBRSEP, SKPING, PRTING, MCOUNT, SEPLO *C, BKLTH, LCOUNT, LOCATD(10) INTEGER ANDPAT INTEGER COUNT INTEGER EXCEPT INTEGER ELEVEL INTEGER CASIND INTEGER PAT INTEGER ATEND INTEGER ATBEG INTEGER SEPS INTEGER NBRSEP INTEGER SEPLOC INTEGER MCOUNT INTEGER SKPING LOGICAL*1 LOCATD INTEGER BKLTH INTEGER LCOUNT PRT = ANDPAT I=1 23137 IF (.NOT.(I.LE.ELEVEL))GOTO 23139 IF (.NOT.(ANDPAT .EQ. 0 .AND. LOCATD(I) .EQ. 1))GOTO 23140 PRT = 1 GOTO 23139 23140 CONTINUE IF (.NOT.(ANDPAT .EQ. 1 .AND. LOCATD(I) .EQ. 0))GOTO 23142 PRT = 0 GOTO 23139 23142 CONTINUE 23141 CONTINUE 23138 I=I+1 GOTO 23137 23139 CONTINUE IF (.NOT.(EXCEPT .EQ. 1))GOTO 23144 IF (.NOT.(PRT .EQ. 0))GOTO 23146 PRT = 1 GOTO 23147 23146 CONTINUE PRT = 0 23147 CONTINUE 23144 CONTINUE RETURN END