========== smaller programs from chapter 2 ==========
# entab - replace blanks by tabs and blanks
   character getc
   character c
   integer tabpos
   integer col, i, newcol, tabs(MAXLINE)
   call settab(tabs)
   col = 1
   repeat {
      newcol = col
      while (getc(c) == BLANK) {   # collect blanks
         newcol = newcol + 1
         if (tabpos(newcol, tabs) == YES) {
            call putc(TAB)
            col = newcol
            $@$
         $@$
      for ( ; col < newcol; col = col + 1)
         call putc(BLANK)      # output leftover blanks
      if (c == EOF)
         break
      call putc(c)
      if (c == NEWLINE)
         col = 1
      else
         col = col + 1
      $@$
   stop
   end
# tabpos - return YES if col is a tab stop
   integer function tabpos(col, tabs)
   integer col, i, tabs(MAXLINE)
   if (col > MAXLINE)
      tabpos = YES
   else
      tabpos = tabs(col)
   return
   end
# settab - set initial tab stops
   subroutine settab(tabs)
   integer mod
   integer i, tabs(MAXLINE)
   for (i = 1; i <= MAXLINE; i = i + 1)
      if (mod(i, 8) == 1)
         tabs(i) = YES
      else
         tabs(i) = NO
   return
   end
define(NOSKIP,PLUS)
define(SKIP,STAR)
# overstrike - convert backspaces into multiple lines
   character getc
   character c
   integer max
   integer col, newcol
   col = 1
   repeat {
      newcol = col
      while (getc(c) == BACKSPACE)   # eat up backspaces
         newcol = max(newcol-1, 1)
      if (newcol < col) {         # start overstrike line
         call putc(NEWLINE)
         call putc(NOSKIP)
         for (col = 1; col < newcol; col = col + 1)
            call putc(BLANK)
         $@$
      else if (col == 1 & c ~= EOF)   # start normal line
         call putc(SKIP)
                     # else middle of line
      if (c == EOF)
         break
      call putc(c)            # normal character
      if (c == NEWLINE)
         col = 1
      else
         col = col + 1
      $@$
   stop
   end
define(RCODE,STAR)
define(MAXCHUNK,10)
define(THRESH,5)
# compress - compress standard input
   character getc
   character buf(MAXCHUNK), c, lastc
   integer nrep, nsave
   # must have RCODE > MAXCHUNK or RCODE = 0
   nsave = 0
   for (lastc = getc(lastc); lastc ~= EOF; lastc = c) {
      for (nrep = 1; getc(c) == lastc; nrep = nrep + 1)
         if (nrep >= MAXCHUNK)   # count repetitions
            break
      if (nrep < THRESH)         # append short string
         for ( ; nrep > 0; nrep = nrep - 1) {
            nsave = nsave + 1
            buf(nsave) = lastc
            if (nsave >= MAXCHUNK)
               call putbuf(buf, nsave)
            $@$
      else {
         call putbuf(buf, nsave)
         call putc(RCODE)
         call putc(lastc)
         call putc(nrep)
         $@$
      $@$
   call putbuf(buf, nsave)   # put last chunk
   stop
   end
# putbuf - output buf(1) ... buf(nsave), clear nsave
   subroutine putbuf(buf, nsave)
   character buf(MAXCHUNK)
   integer i, nsave
   if (nsave > 0) {
      call putc(nsave)
      for (i = 1; i <= nsave; i = i + 1)
         call putc(buf(i))
      $@$
   nsave = 0
   return
   end
define(RCODE,STAR)
# expand - uncompress standard input
   character getc
   character c, code
   while (getc(code) ~= EOF)
      if (code == RCODE) {   # expand repetition
         if (getc(c) == EOF)
            break
         if (getc(code) == EOF)
            break
         for ( ; code > 0; code = code - 1)
            call putc(c)
         $@$
      else {            # expand chunk
         for ( ; code > 0; code = code - 1) {
            if (getc(c) == EOF)
               break
            call putc(c)
            $@$
         if (c == EOF)
            break
         $@$
   stop
   end
define(MAXKEY,50)
# crypt - encrypt and decrypt
   character getc, xor
   character c, key(MAXKEY)
   integer getarg, mod
   integer i, keylen
   keylen = getarg(1, key, MAXKEY)
   if (keylen == EOF)
      call error("usage: crypt key.")
   for (i = 1; getc(c) ~= EOF; i = mod(i, keylen) + 1)
      call putc(xor(c, key(i)))
   stop
   end
# xor - exclusive-or of  a  and  b
   character function xor(a, b)
   character and, not, or
   character a, b
   xor = or(and(a, not(b)), and(not(a), b))
   return
   end
