========== find program from chapter 5 ==========
define(MAXARG,128)
define(MAXPAT,128)
define(COUNT,1)
define(PREVCL,2)
define(START,3)
define(CLOSIZE,4)
define(NOT,BANG)
define(BOL,PERCENT)
define(ANY,QMARK)
define(EOL,DOLLAR)
define(CLOSURE,STAR)
define(CCL,LBRACK)
define(CCLEND,RBRACK)
define(NCCL,LETN)
define(CHAR,LETA)
define(ESCAPE,ATSIGN)
# 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
# amatch with no metacharacters
   integer function amatch(lin, from, pat)
   character lin(MAXLINE), pat(MAXPAT)
   integer from, i, j
   i = from
   for (j = 1; pat(j) ~= EOS; j = j + 1) {
      if (lin(i) ~= pat(j)) {
         amatch = 0
         return      # with no match
         $@$
      i = i + 1
      $@$
   amatch = i
   return            # successfully
   end
# amatch with some metacharacters
   integer function amatch(lin, from, pat)
   character lin(MAXLINE), pat(MAXPAT)
   integer omatch, patsiz
   integer from, i, j
   i = from
   for (j = 1; pat(j) ~= EOS; j = j + patsiz(pat, j))
      if (omatch(lin, i, pat, j) == NO) {
         amatch = 0
         return      # with no match
         $@$
   amatch = i
   return            # successfully
   end
# find - find patterns in text
   character arg(MAXARG), lin(MAXLINE), pat(MAXPAT)
   integer getarg, getlin, getpat, match
   if (getarg(1, arg, MAXARG) == EOF)
      call error("usage: find pattern.")
   if (getpat(arg, pat) == ERR)
      call error("illegal pattern.")
   while (getlin(lin, STDIN) ~= EOF)
      if (match(lin, pat) == YES)
         call putlin(lin, STDOUT)
   stop
   end
# 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
# 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
# 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
# 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 & 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
# 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
# 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: can't happen.")
   if (bump >= 0) {
      i = i + bump
      omatch = YES
      $@$
   return
   end
# 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: can't happen.")
   return
   end
# 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