#-h- fbcom           1238 asc  3-oct-80 14:23:02
 ## /fbcom/ - common block for 'bf' tool
 #  Put on a file called 'fbcom'
 # Used only by 'fb', but very similar to variables used in 'find'
 
 common /fbcom/ andpat, count, except, elevel,
              pat(MAXPAT, NEXPR),
              atend, atbeg, seps(MAXPAT,2),
	      nbrsep, skping, prting, locatd(MAXARG),
	      mcount, seploc, bklth, lcount
 
 integer andpat		#flag for locating blocks which contain all args
 integer count		#flag for counting occurrences only
 integer except		#flag for locating blocks without indicated patterns
 integer elevel		#number of patterns to locate
 character pat		#patterns to locate
 integer atend		#flag for indicating end of block reached
 integer atbeg		#flag indicating beginning of block reached
 character seps		#block separator(s) (1=start,2=ending)
 integer nbrsep		#number of separators (1 or 2)
 integer seploc         #location of separator (BEFORE or AFTER block)
 integer mcount		#count of number of matches
 integer skping		#flag indicating lines should not be examined
 character locatd	#flag indicating which patterns have been located
 integer bklth          #max size of block to output
                        # init = HUGE
 integer lcount         #running line count of block
#-h- fbbuf            321 asc  3-oct-80 14:23:04
 ## fbbuf - common block for 'fb'  block buffer
 common /fbbuf/ fbbuf(MAXBUFLENGTH), endstk,
                fname(FILENAMESIZE), fb
 
 character fbbuf	#buffer which holds lines
 integer endstk		#pointer to end of stack; init=0
 character fname	#holds name of scratch file
 integer fb		#file ID of scratch file; init=ERR
#-h- findsym          572 asc  3-oct-80 14:23:05
 ## definitions for the FIND tool
 # put on a file named 'findsym'
 # Used by the find, ch, and tr tools
 
  define(ANY,QMARK) 
  define(BOL,PERCENT) 
  define(CCL,LBRACK) 
  define(CCLEND,RBRACK) 
  define(CHAR,LETA) 
  define(CLOSIZE,4) 
  define(CLOSURE,STAR) 
  define(CLOSURE1,PLUS)	# closure of one or more occurrences
			# i.e. (pat)+ == (pat)(pat)*
  define(COUNT,1) 
  define(EOL,DOLLAR) 
  define(MAXARG,128)
  define(MAXPAT,128) 
  define(NCCL,LETN) 
  define(PREVCL,2) 
  define(START,3) 
  define(NEXPR,10)	# maximum number of expressions allowed on cmd line
#-h- fb.r           10702 asc  3-oct-80 14:23:09
#-h- defns            305 asc  3-oct-80 14:16:07
 #        include ratdef
 
 include findsym
 
 define(MAXBUFLENGTH,5000)      #length of block buffer (characters)
 define(BEFORE,1)               #separator at beginning of block
 define(AFTER,0)                #separator at end of block
 define(HUGE,30000)		# just a large number
 define(mkuniq,scratf)
#-h- fbs              327 asc  3-oct-80 13:50:04
 subroutine main

 ## fb - find block of lines

 include fbcom
 
 call fbargs            #set initial values; parse args
 
 call dobk (STDIN)              #search blocks for patterns
 if (count == YES)              #print final count
        {
        call putdec(mcount, 1)
        call putc(NEWLINE)
        }
 
 return
 end
#-h- bmatch           291 asc  3-oct-80 13:50:05
 ## bmatch - locate patterns which appear in line of block
 subroutine bmatch (line)
 character line(ARB)
 integer match
 
 include fbcom
 
 for (i=1; i<=elevel; i=i+1)
        if (match(line, pat(1,i)) == YES)
                locatd(i) = YES         #mark arg that was matched
 return
 end
#-h- checkl           255 asc  3-oct-80 13:50:06
 ## checkl - check line for block separator
 subroutine checkl (line)
 character line(ARB)
 integer match
 
 include fbcom
 
 atbeg = match(line, seps(1,1))
 if (nbrsep == 1)
        atend = atbeg
 else
        atend = match(line, seps(1,2))
 return
 end
#-h- dobeg            390 asc  3-oct-80 13:50:07
## dobeg - process beginning of block (fb tool)
 
 subroutine dobeg (line)
 
 character line(ARB)
 integer stackl
 
 include fbcom
 
 call initbk            #clear stacks
 lcount = 0
 if (nbrsep > 1 | seploc == BEFORE)
        {
        call bmatch(line)
        if (stackl(line) == ERR)
                call error ("Block buffer overflow")
        }
 skping = NO
 prting = NO
 return
 end
#-h- dobk            1009 asc  3-oct-80 13:50:08
 ## dobk - find patterns in block of text
 subroutine dobk (fd)
 
 integer getlin
 integer fd, prt, first
 character line(MAXLINE)
 
 include fbcom
 include fbbuf
 
 call initbk                    #clear stacks
 first = YES
 while(getlin(line, fd) != EOF)
        {
        call checkl (line)      #check line for block separator
                        #check if sep really at start of block
        if (first == YES & atend == YES & nbrsep == 1)
                seploc = BEFORE
        first = NO
        if (atend == YES)
                call doend(line)
        if (atbeg == YES)
                {
                call dobeg(line)
                next
                }
        if (skping == YES)
                next
        else call dolin (line)
        }
 
                        #EOF reached
 if (skping == NO)
        call doend(line)
 
 if (fb != ERR)         #make sure scratch file is removed
        {
        call close(fb)
        call remove(fname)
        fb = ERR
        }
 return
 end
 
#-h- doend           1065 asc  3-oct-80 13:50:10
 ## doend - process end of block (fb tool)
 
 subroutine doend (line)
 
 character line(ARB)
 integer stackl
 integer prt
 include fbcom
 
 if (prting == YES)
        {
        if ( (nbrsep > 1 | seploc == AFTER) & count == NO)
                call outlin(line)
        if (bklth != HUGE)      #finish off rest of block
                for(lcount=lcount+1; lcount<=bklth; lcount=lcount+1)
                        call putch(NEWLINE, STDOUT)
        }
 else if (skping == NO)
        {
        if (nbrsep > 1 | seploc == AFTER)
                {
                call bmatch (line)
                if (stackl(line) ==ERR)
                        call error ("Block buffer overflow")
                }
        call tally (prt)
        if (prt == YES)
                {
                call printb
                if (bklth != HUGE)
                        for (lcount=lcount+1; lcount<=bklth;
                             lcount=lcount+1)
                                call putch(NEWLINE,STDOUT)
                }
        }
 skping = YES
 prting = NO
 
 return
 end
#-h- dolin            794 asc  3-oct-80 13:50:12
 ## dolin - process line for 'fb' tool
 
 subroutine dolin (line)
 
 character line(ARB)
 integer prt
 integer stackl
 
 include fbcom
 
 if (skping == YES)
        return
 if (prting == YES)
        {
        if (count == NO)
                call outlin(line)
        }
 else                   #check line for match
        {
        call bmatch (line)
        if (stackl(line) == ERR)
                call error ("Block buffer overflow")
        call tally(prt)
                #block may definitely be printed
        if (prt == YES & except == NO)
                {
                call printb
                prting = YES
                }
                  #block may definitely be skipped
        else if (prt == NO & except == YES)
                skping = YES
        }
 
 return
 end
#-h- fbargs          2400 asc  3-oct-80 13:50:13
 
 ## fbargs - parse arguments for 'fb' tool
 
 subroutine fbargs
 character arg(MAXLINE), dsep(5)
 integer getarg, itoc, getpat, status, index, ctoi
 integer i, j
 
 include fbbuf
 include fbcom
 string ilpat "illegal pattern: "
 string maxexp "max nbr expressions allowed: "
 data except/NO/
 data andpat/NO/
 data count /NO/
 data mcount /0/
 data elevel/0/
 data skping /NO/
 data nbrsep /0/
 data seploc /AFTER/
 data endstk /0/
 data fb /ERR/
 data bklth /HUGE/
 data lcount /0/

                #default separator (% *$)
 data dsep(1), dsep(2), dsep(3), dsep(4), dsep(5) /BOL,
      BLANK, CLOSURE, EOL, EOS/
 
                #loop thru args, picking up flags and patterns
 for (i=1; getarg(i, arg, MAXARG) != EOF; i=i+1)
    {
    if (arg(1) == QMARK & arg(2) == EOS)
        call fberr
    else if (arg(1) == MINUS & (arg(2) == LETS | arg(2) == BIGS))
        {
        nbrsep = nbrsep + 1
        if (nbrsep > 2)
                call error ("only start and ending separators allowed")
        if (getpat(arg(3), seps(1, nbrsep)) == ERR)
                {
                call putlin(ilpat, ERROUT)
                call error (arg(3))
                }
        }
    else if (arg(1) == MINUS)
        {
        call fold(arg)
        if (index(arg, LETA) > 0)
            andpat = YES
        if (index(arg, LETC) > 0)
            count = YES
        if (index(arg, LETX) > 0)
            except = YES
        j = index(arg, LETL)
        if (j > 0)               #setting block length
                {
                j = j + 1
                bklth = ctoi(arg, j)
                if (bklth <= 0)
                        call fberr
                }
        }
    else if (elevel < NEXPR)
        {
        elevel = elevel + 1
        if (getpat(arg(1), pat(1,elevel)) == ERR)
                {
                call putlin(ilpat, ERROUT)
                call error (arg)
                }
        }
    else
        {
        call putlin(maxexp, ERROUT)
        status = itoc(NEXPR, arg, MAXARG)
        call error(arg)
        }
    }
                #check for errors
 if (elevel == 0)
    call fberr
 
 if (nbrsep == 0)       #set default separator
        {
        if (getpat(dsep, seps(1,1)) == ERR)
                call error ("illegal default separator")
        nbrsep = 1
        }
 
 if (nbrsep > 1)        #skip till beginning of first block
        skping = YES
 return
 end
#-h- fberr            149 asc  3-oct-80 13:50:16
 ## fberr - report error in calling 'fb' tool
 subroutine fberr
 
 call error ('usage:  fb [-axc] [-ln] [-spat] [-spat] pat [pat ...]')
 return
 end
#-h- initbk           279 asc  3-oct-80 13:50:17
 ## initbk - initialize buffers for 'fb' tool
 subroutine initbk
 
 include fbcom
 include fbbuf
 
 for (i=1; i<=elevel; i=i+1)
        locatd(i) = NO
 endstk = 0
 if (fb != ERR)
        {
        call close(fb)
        call remove(fname)
        fb = ERR
        }
 return
 end
#-h- outlin           214 asc  3-oct-80 13:50:18
 ## outlin - output line from block, if user wants to see it
 subroutine outlin(line)
 character line(ARB)
 include fbcom
 
 lcount = lcount + 1
 if (lcount <= bklth)
        call putlin(line, STDOUT)
 return
 end
#-h- printb           762 asc  3-oct-80 13:50:19
 ## printb - print (or count) block of lines
 subroutine printb
 integer i
 character c
 character getch
 integer open
 
 include fbbuf
 include fbcom
 
 if (endstk == 0 & fb == ERR)           #nothing on stack
        return
 if (count == YES)
        {
        mcount = mcount + 1
        return
        }
 if (fb != ERR)         #copy scratch file to output
        {
        call close(fb)
        fb = open(fname, READ)  #start at beginning
        if (fb == ERR)
                call error ('problems reopening scratch file')
        while(getch(c, fb) != EOF)
                call putch(c, STDOUT)
        call close(fb)
        call remove (fname)
        fb = ERR
        }
 for (i=1; i<=endstk; i=i+1)
        call putch(fbbuf(i), STDOUT)
 return
 end
#-h- stackl          1069 asc  3-oct-80 13:50:20
 ## stackl - put line on bottom of stack (if user wants to see it)
 
 integer function stackl (line)
 character line(MAXLINE)
 integer length, create
 integer len
 
 include fbbuf
 include fbcom
 
  string fbtemp "fbt"
 
 stackl = OK
 if (count == YES)      #no need to stack if just counting
        return
 lcount = lcount + 1
 if (lcount > bklth)    #user doesn't want to see this much
        return
 len = length(line)
 if ( (len+endstk+1) > MAXBUFLENGTH)    #store buffer on scratch file
        {
        if (fb == ERR)
                {
                call mkuniq(fbtemp, fname)
                fb = create(fname, WRITE)
                if (fb == ERR)
                        {
                        call remark ('problems opening scratch file')
                        call cant (fname)
                        }
                }
        for (i=1; i<=endstk; i=i+1)
                call putch(fbbuf(i), fb)
        call putlin(line, fb)
        endstk = 0
        return
        }
 call scopy(line, 1, fbbuf, endstk+1)
 endstk = endstk + len 
 return
 end
#-h- tally            658 asc  3-oct-80 13:50:21
 ## tally - tally results of block search
 subroutine tally (prt)
 integer prt    #returned as YES if block should be printed; else NO
 
 include fbcom
 
 prt = andpat
 for (i=1; i<=elevel; i=i+1)
        {
        if (andpat == NO & locatd(i) == YES)
                {
                prt = YES
                break
                }
        else if (andpat == YES & locatd(i) == NO)
                {
                prt = NO
                break
                }
        }
 
 if (except == YES)             #opposite for exceptions
        {
        if (prt == NO)
                prt = YES
        else
                prt = NO
        }
 return
 end