#-h- findsym          572 asc 10-sep-80 07:54:50
 ## 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- find.r         13480 asc 10-sep-80 07:54:54
#-h- main             302 asc 10-sep-80 07:54:15
 #---------------------------------------------------------------------
 # include symbol definitions
 #        include symbols
          include findsym
 #---------------------------------------------------------------------
##	find -- main program
 
 
#	call initr4
#	call find
#	call endr4
#	end
# 
#-h- finds           1375 asc 10-sep-80 07:54:16
# subroutine find
 subroutine main

 character exp(MAXARG,NEXPR), pat(MAXPAT,NEXPR), lin(MAXLINE),
	   arg(MAXARG)
 integer i, getarg, except, andpat, count, elevel, itoc, getpat,
	 mcount, getlin, matchd, status, gmatch, index

 data except/NO/
 data andpat/NO/
 data count /NO/
 data elevel/0/

 for (i=1; getarg(i, arg, MAXARG) != EOF; i=i+1)
    if (arg(1) == QMARK & arg(2) == EOS)
	call finerr
    else if (arg(1) == MINUS)
	{
	call scopy(arg, 1, lin, 1)
	call fold(lin)
	if (index(lin, LETA) > 0)
	    andpat = YES
	if (index(lin, LETC) > 0)
	    count = YES
	if (index(lin, LETX) > 0)
	    except = YES
	}
    else if (elevel < NEXPR)
	{
	elevel = elevel + 1
	call scopy(arg, 1, exp(1, elevel), 1)
	}
    else
	{
	call putlin("Maximum number of expressions permitted is ", ERROUT)
	status = itoc(NEXPR, arg, MAXARG)
	call error(arg)
	}
 if (elevel == 0)
    call finerr
 for (i=1; i <= elevel; i=i+1)
    if (getpat(exp(1,i), pat(1,i)) == ERR)
	{
	call putlin("illegal pattern: ", ERROUT)
	call error(exp(1,i))
	}
 mcount = 0
 while (getlin(lin, STDIN) != EOF)
    {
    matchd = gmatch(lin, pat, elevel, andpat)
    if ((matchd == YES & except == NO) | (matchd == NO & except == YES))
	if (count == YES)
	    mcount = mcount + 1
	else
	    call putlin(lin, STDOUT)
    }
 if (count == YES)
    {
    call putdec(mcount, 1)
    call putc(NEWLINE)
    }

 return
 end
#-h- amatch          1345 asc 10-sep-80 07:54:18
 ## amatch  (non-recursive) - look for match starting at lin(from) 
    integer function amatch(lin, from, pat) 
    character lin(MAXLINE), pat(MAXPAT) 
    integer omatch, patsiz 
    integer from, i, j, offset, stack 
  
    stack = 0 
    offset = from      # next unexamined input character 
    for (j = 1; pat(j) != EOS; j = j + patsiz(pat, j)) 
       if (pat(j) == CLOSURE) {      # a closure entry 
          stack = j 
          j = j + CLOSIZE      # step over CLOSURE 
          for (i = offset; lin(i) != EOS; )   # match as many as 
             if (omatch(lin, i, pat, j) == NO)   # possible 
                break 
          pat(stack+COUNT) = i - offset 
          pat(stack+START) = offset 
          offset = i      # character that made us fail 
          } 
       else if (omatch(lin, offset, pat, j) == NO) {   # non-closure 
          for ( ; stack > 0; stack = pat(stack+PREVCL)) 
             if (pat(stack+COUNT) > 0) 
                break 
          if (stack <= 0) {      # stack is empty 
             amatch = 0      # return failure 
             return 
             } 
          pat(stack+COUNT) = pat(stack+COUNT) - 1 
          j = stack + CLOSIZE 
          offset = pat(stack+START) + pat(stack+COUNT) 
          } 
       # else omatch succeeded 
    amatch = offset 
    return      # success 
    end 
#-h- dodash           466 asc 10-sep-80 07:54:20
 ## dodash - expand array(i-1)-array(i+1) into set(j)... from valid 
    subroutine dodash(valid, array, i, set, j, maxset) 
    character esc 
    integer addset, index 
    integer i, j, junk, k, limit, maxset 
    character array(ARB), set(maxset), valid(ARB) 
  
    i = i + 1 
    j = j - 1 
    limit = index(valid, esc(array, i)) 
    for (k = index(valid, set(j)); k <= limit; k = k + 1) 
       junk = addset(valid(k), set, j, maxset) 
    return 
    end 
#-h- esc              505 asc 10-sep-80 07:54:22
## esc - map  array(i)  into escaped character if appropriate 
   character function esc(array, i) 
   character array(ARB) 
   integer i 
 
   if (array(i) != ESCAPE) 
      esc = array(i) 
   else if (array(i+1) == EOS)   # \*a not special at end 
      esc = ESCAPE 
   else { 
      i = i + 1 
     if (array(i) == LETN | array(i) == BIGN)
         esc = NEWLINE 
      else if (array(i) == LETT | array(i) == BIGT)
         esc = TAB 
      else 
         esc = array(i) 
      } 
   return 
   end 
#-h- filset          2780 asc 10-sep-80 07:54:23
## filset - expand set at  array(i)  into  set(j),  stop at  delim 
   subroutine filset(delim, array, i, set, j, maxset) 
   character esc 
   integer addset, index 
   integer i, j, junk, maxset 
   character array(ARB), delim, set(maxset) 
#   string digits '0123456789' 
   character digits(11) 
#   string lowalf 'abcdefghijklmnopqrstuvwxyz' 
   character lowalf(27) 
#   string upalf 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 
   character upalf(27) 
   data digits(1)/DIG0/, digits(2)/DIG1/, digits(3)/DIG2/ 
   data digits(4)/DIG3/, digits(5)/DIG4/, digits(6)/DIG5/ 
   data digits(7)/DIG6/, digits(8)/DIG7/, digits(9)/DIG8/ 
   data digits(10)/DIG9/, digits(11)/EOS/ 
   data lowalf(01)/LETA/ 
   data lowalf(02)/LETB/ 
   data lowalf(03)/LETC/ 
   data lowalf(04)/LETD/ 
   data lowalf(05)/LETE/ 
   data lowalf(06)/LETF/ 
   data lowalf(07)/LETG/ 
   data lowalf(08)/LETH/ 
   data lowalf(09)/LETI/ 
   data lowalf(10)/LETJ/ 
   data lowalf(11)/LETK/ 
   data lowalf(12)/LETL/ 
   data lowalf(13)/LETM/ 
   data lowalf(14)/LETN/ 
   data lowalf(15)/LETO/ 
   data lowalf(16)/LETP/ 
   data lowalf(17)/LETQ/ 
   data lowalf(18)/LETR/ 
   data lowalf(19)/LETS/ 
   data lowalf(20)/LETT/ 
   data lowalf(21)/LETU/ 
   data lowalf(22)/LETV/ 
   data lowalf(23)/LETW/ 
   data lowalf(24)/LETX/ 
   data lowalf(25)/LETY/ 
   data lowalf(26)/LETZ/ 
   data lowalf(27)/EOS/ 
   data upalf(01) /BIGA/ 
   data upalf(02) /BIGB/ 
   data upalf(03) /BIGC/ 
   data upalf(04) /BIGD/ 
   data upalf(05) /BIGE/ 
   data upalf(06) /BIGF/ 
   data upalf(07) /BIGG/ 
   data upalf(08) /BIGH/ 
   data upalf(09) /BIGI/ 
   data upalf(10) /BIGJ/ 
   data upalf(11) /BIGK/ 
   data upalf(12) /BIGL/ 
   data upalf(13) /BIGM/ 
   data upalf(14) /BIGN/ 
   data upalf(15) /BIGO/ 
   data upalf(16) /BIGP/ 
   data upalf(17) /BIGQ/ 
   data upalf(18) /BIGR/ 
   data upalf(19) /BIGS/ 
   data upalf(20) /BIGT/ 
   data upalf(21) /BIGU/ 
   data upalf(22) /BIGV/ 
   data upalf(23) /BIGW/ 
   data upalf(24) /BIGX/ 
   data upalf(25) /BIGY/ 
   data upalf(26) /BIGZ/ 
   data upalf(27) /EOS/ 
 
   for ( ; array(i) != delim & array(i) != EOS; i = i + 1) 
      if (array(i) == ESCAPE) 
         junk = addset(esc(array, i), set, j, maxset) 
      else if (array(i) != DASH) 
         junk = addset(array(i), set, j, maxset) 
      else if (j <= 1 | array(i+1) == EOS)   # literal - 
         junk = addset(DASH, set, j, maxset) 
      else if (index(digits, set(j-1)) > 0) 
         call dodash(digits, array, i, set, j, maxset) 
      else if (index(lowalf, set(j-1)) > 0) 
         call dodash(lowalf, array, i, set, j, maxset) 
      else if (index(upalf, set(j-1)) > 0) 
         call dodash(upalf, array, i, set, j, maxset) 
      else 
         junk = addset(DASH, set, j, maxset) 
   return 
   end 
#-h- getccl           643 asc 10-sep-80 07:54:26
 ## getccl - expand char class at arg(i) into pat(j) 
    integer function getccl(arg, i, pat, j) 
    character arg(MAXARG), pat(MAXPAT) 
    integer addset 
    integer i, j, jstart, junk 
  
    i = i + 1      # skip over [ 
    if (arg(i) == NOT) { 
       junk = addset(NCCL, pat, j, MAXPAT) 
       i = i + 1 
       } 
    else 
       junk = addset(CCL, pat, j, MAXPAT) 
    jstart = j 
    junk = addset(0, pat, j, MAXPAT)      # leave room for count 
    call filset(CCLEND, arg, i, pat, j, MAXPAT) 
    pat(jstart) = j - jstart - 1 
    if (arg(i) == CCLEND) 
       getccl = OK 
    else 
       getccl = ERR 
    return 
    end 
#-h- getpat           204 asc 10-sep-80 07:54:27
 ## getpat - convert argument into pattern 
    integer function getpat(arg, pat) 
    integer arg(MAXARG), pat(MAXPAT) 
    integer makpat 
  
    getpat = makpat(arg, 1, EOS, pat) 
    return 
    end 
#-h- locate           392 asc 10-sep-80 07:54:28
 ## locate - look for c in char class at pat(offset) 
    integer function locate(c, pat, offset) 
    character c, pat(MAXPAT) 
    integer i, offset 
    # size of class is at pat(offset), characters follow 
  
    for (i = offset + pat(offset); i > offset; i = i - 1) 
       if (c == pat(i)) { 
          locate = YES 
          return 
          } 
    locate = NO 
    return 
    end 
#-h- makpat          1748 asc 10-sep-80 07:54:30
 ## makpat - make pattern from arg(from), terminate at delim 
    integer function makpat(arg, from, delim, pat) 
    character esc 
    character arg(MAXARG), delim, pat(MAXPAT) 
    integer addset, getccl, stclos 
    integer from, i, j, junk, lastcl, lastj, lj 
  
    j = 1      # pat index 
    lastj = 1 
    lastcl = 0 
    for (i = from; arg(i) != delim & arg(i) != EOS; i = i + 1) { 
       lj = j 
       if (arg(i) == ANY) 
          junk = addset(ANY, pat, j, MAXPAT) 
       else if (arg(i) == BOL & i == from) 
          junk = addset(BOL, pat, j, MAXPAT) 
       else if (arg(i) == EOL & arg(i + 1) == delim) 
          junk = addset(EOL, pat, j, MAXPAT) 
       else if (arg(i) == CCL) { 
          if (getccl(arg, i, pat, j) == ERR) 
             break 
          } 
	else if ((arg(i) == CLOSURE | arg(i) == CLOSURE1) & i > from)
	    {
	    lj = lastj
	    if (pat(lj) == BOL | pat(lj) == EOL | pat(lj) == CLOSURE |
		pat(lj) == CLOSURE1)
		break		# error
	    if (arg(i) == CLOSURE1)	# duplicate last pattern
		for (lastj = j; lj < lastj; lj = lj + 1)
		    junk = addset(pat(lj), pat, j, MAXPAT)
	    lastcl = stclos(pat, j, lastj, lastcl)
	    }
#       else if (arg(i) == CLOSURE & i > from) { 
#          lj = lastj 
#          if (pat(lj)==BOL | pat(lj)==EOL | pat(lj)==CLOSURE) 
#             break 
#          lastcl = stclos(pat, j, lastj, lastcl) 
#          } 
       else { 
          junk = addset(CHAR, pat, j, MAXPAT) 
          junk = addset(esc(arg, i), pat, j, MAXPAT) 
          } 
       lastj = lj 
       } 
    if (arg(i) != delim)   # terminated early 
       makpat = ERR 
    else if (addset(EOS, pat, j, MAXPAT) == NO)   # no room 
       makpat = ERR 
    else 
       makpat = i 
    return 
    end 
#-h- match            331 asc 10-sep-80 07:54:32
 ## match - find match anywhere on line 
    integer function match(lin, pat) 
    character lin(MAXLINE), pat(MAXPAT) 
    integer amatch 
    integer i 
  
    for (i = 1; lin(i) != EOS; i = i + 1) 
       if (amatch(lin, i, pat) > 0) { 
          match = YES 
          return 
          } 
    match = NO 
    return 
    end 
#-h- omatch          1001 asc 10-sep-80 07:54:33
 ## omatch - try to match a single pattern at pat(j) 
    integer function omatch(lin, i, pat, j) 
    character lin(MAXLINE), pat(MAXPAT) 
    integer locate 
    integer bump, i, j 
  
    omatch = NO 
    if (lin(i) == EOS) 
       return 
    bump = -1 
    if (pat(j) == CHAR) { 
       if (lin(i) == pat(j + 1)) 
          bump = 1 
       } 
    else if (pat(j) == BOL) { 
       if (i == 1) 
          bump = 0 
       } 
    else if (pat(j) == ANY) { 
       if (lin(i) != NEWLINE) 
          bump = 1 
       } 
    else if (pat(j) == EOL) { 
       if (lin(i) == NEWLINE) 
          bump = 0 
       } 
    else if (pat(j) == CCL) { 
       if (locate(lin(i), pat, j + 1) == YES) 
          bump = 1 
       } 
    else if (pat(j) == NCCL) { 
       if (lin(i) != NEWLINE & locate(lin(i), pat, j + 1) == NO) 
          bump = 1 
       } 
    else 
       call error('in omatch: cant happen.') 
    if (bump >= 0) { 
       i = i + bump 
       omatch = YES 
       } 
    return 
    end 
#-h- patsiz           489 asc 10-sep-80 07:54:34
 ## patsiz - returns size of pattern entry at pat(n) 
    integer function patsiz(pat, n) 
    character pat(MAXPAT) 
    integer n 
  
    if (pat(n) == CHAR) 
       patsiz = 2 
    else if (pat(n) == BOL | pat(n) == EOL | pat(n) == ANY) 
       patsiz = 1 
    else if (pat(n) == CCL | pat(n) == NCCL) 
       patsiz = pat(n + 1) + 2 
    else if (pat(n) == CLOSURE)      # optional 
       patsiz = CLOSIZE 
    else 
       call error('in patsiz: cant happen.') 
    return 
    end 
#-h- stclos           641 asc 10-sep-80 07:54:35
 ## stclos - insert closure entry at pat(j) 
    integer function stclos(pat, j, lastj, lastcl) 
    character pat(MAXPAT) 
    integer addset 
    integer j, jp, jt, junk, lastcl, lastj 
  
    for (jp = j - 1; jp >= lastj; jp = jp - 1) {   # make a hole 
       jt = jp + CLOSIZE 
       junk = addset(pat(jp), pat, jt, MAXPAT) 
       } 
    j = j + CLOSIZE 
    stclos = lastj 
    junk = addset(CLOSURE, pat, lastj, MAXPAT)   # put closure in it 
    junk = addset(0, pat, lastj, MAXPAT)      # COUNT 
    junk = addset(lastcl, pat, lastj, MAXPAT)   # PREVCL 
    junk = addset(0, pat, lastj, MAXPAT)      # START 
    return 
    end 
#-h- gmatch           377 asc 10-sep-80 07:54:37
 integer function gmatch(lin, pat, elevel, andpat)

 integer elevel, andpat, match, i, status
 character lin(ARB), pat(MAXPAT, NEXPR)

 gmatch = andpat
 for (i=1; i <= elevel; i=i+1)
    {
    status = match(lin, pat(1,i))
    if (andpat == NO & status == YES)
	{
	gmatch = YES
	break
	}
    else if (andpat == YES & status == NO)
	{
	gmatch = NO
	break
	}
    }

 return
 end
#-h- finerr            97 asc 10-sep-80 07:54:38
 subroutine finerr

 call error("usage:  find [-acx] expression [expression ...]")

 return
 end