========== smaller programs from chapter 3 ==========
define(INFILE1,1)
define(INFILE2,2)
define(NAMESIZE,50)
# compare  (simple version) - compare file 1 to file 2
   character line1(MAXLINE), line2(MAXLINE)
   integer equal, getlin
   integer lineno, m1, m2
   lineno = 0
   repeat {
      m1 = getlin(line1, INFILE1)
      m2 = getlin(line2, INFILE2)
      if (m1 == EOF | m2 == EOF)
         break
      lineno = lineno + 1
      if (equal(line1, line2) == NO)
         call difmsg(lineno, line1, line2)
      $@$
   if (m1 == EOF & m2 ~= EOF)
      call remark("eof on file 1.")
   else if (m2 == EOF & m1 ~= EOF)
      call remark("eof on file 2.")
   # else they match
   stop
   end
# difmsg - print line numbers and differing lines
   subroutine difmsg(lineno, line1, line2)
   character line1(ARB), line2(ARB)
   integer lineno
   call putdec(lineno, 5)
   call putc(NEWLINE)
   call putlin(line1, STDOUT)
   call putlin(line2, STDOUT)
   return
   end
define(NAMESIZE,50)
# compare - compare two files for equality
   character arg1(MAXLINE), arg2(MAXLINE)
   character line1(MAXLINE), line2(MAXLINE)
   integer equal, getarg, getlin, open
   integer infil1, infil2, lineno, m1, m2
   if (getarg(1, arg1, MAXLINE) == EOF
      | getarg(2, arg2, MAXLINE) == EOF)
      call error("usage: compare file1 file2.")
   infil1 = open(arg1, READ)
   if (infil1 == ERR)
      call cant(arg1)
   infil2 = open(arg2, READ)
   if (infil2 == ERR)
      call cant(arg2)
   lineno = 0
   repeat {
      m1 = getlin(line1, infil1)
      m2 = getlin(line2, infil2)
      if (m1 == EOF | m2 == EOF)
         break
      lineno = lineno + 1
      if (equal(line1, line2) == NO)
         call difmsg(lineno, line1, line2)
      $@$
   if (m1 == EOF & m2 ~= EOF)
      call remark("eof on file 1.")
   else if (m2 == EOF & m1 ~= EOF)
      call remark("eof on file 2.")
   stop
   end
#difmsg
   subroutine difmsg(lineno, line1, line2)
   integer line1(MAXLINE), line2(MAXLINE)
   integer lineno
   call putdec(lineno, 5)
   call putc(NEWLINE)
   call putlin(line1, STDOUT)
   call putlin(line2, STDOUT)
   return
   end
define(NFILES,5)
# include - replace  include file  by contents of file
   character line(MAXLINE), str(MAXLINE)
   integer equal, getlin, getwrd, open
   integer infile(NFILES), len, level, loc
#   string incl "include"
   integer incl(8)
   data incl(1) /LETI/
   data incl(2) /LETN/
   data incl(3) /LETC/
   data incl(4) /LETL/
   data incl(5) /LETU/
   data incl(6) /LETD/
   data incl(7) /LETE/
   data incl(8) /EOS/
   infile(1) = STDIN
   for (level = 1; level > 0; level = level - 1) {
      while (getlin(line, infile(level)) ~= EOF) {
         loc = 1
         len = getwrd(line, loc, str)
         if (equal(str, incl) == NO)
            call putlin(line, STDOUT)
         else {
            level = level + 1
            if (level > NFILES)
               call error("includes nested too deeply.")
            len = getwrd(line, loc, str)
            infile(level) = open(str, READ)
            if (infile(level) == ERR)
               call cant(str)
            $@$
         $@$
      if (level > 1)
         call close(infile(level))
      $@$
   stop
   end
# getwrd - get non-blank word from in(i) into  out, increment i
   integer function getwrd(in, i, out)
   character in(ARB), out(ARB)
   integer i, j
   while (in(i) == BLANK | in(i) == TAB)
      i = i + 1
   j = 1
   while (in(i) ~= EOS & in(i) ~= BLANK
      & in(i) ~= TAB & in(i) ~= NEWLINE) {
      out(j) = in(i)
      i = i + 1
      j = j + 1
      $@$
   out(j) = EOS
   getwrd = j - 1
   return
   end
define(NAMESIZE,50)
# concat - concatenate named files onto standard output
   character name(NAMESIZE)
   integer getarg, open
   integer fin, i
   for (i = 1; getarg(i, name, NAMESIZE) ~= EOF; i = i + 1) {
      fin = open(name, READ)
      if (fin == ERR)
         call cant(name)
      call fcopy(fin, STDOUT)
      call close(fin)
      $@$
   stop
   end
define(NAMESIZE,50)
define(MARGIN1,3)
define(MARGIN2,2)
define(MARGIN3,2)
define(MARGIN4,3)
define(BOTTOM,60)
define(PAGELEN,66)
# print - print files with headings
   character name(NAMESIZE)
   integer getarg, open
   integer fin, i
   for (i = 1; getarg(i, name, NAMESIZE) ~= EOF; i = i + 1) {
      fin = open(name, READ)
      if (fin == ERR)
         call cant(name)
      call fprint(name, fin)
      call close(fin)
      $@$
   stop
   end
# fprint - print file "name" from  fin
   subroutine fprint(name, fin)
   character line(MAXLINE), name(NAMESIZE)
   integer getlin, open
   integer fin, lineno, pageno
   pageno = 0
   lineno = 0
   while (getlin(line, fin) ~= EOF) {
      if (lineno == 0) {
         call skip(MARGIN1)
         pageno = pageno + 1
         call head(name, pageno)
         call skip(MARGIN2)
         lineno = MARGIN1 + MARGIN2 + 1
         $@$
      call putlin(line, STDOUT)
      lineno = lineno + 1
      if (lineno >= BOTTOM) {
         call skip(PAGELEN-lineno)
         lineno = 0
         $@$
      $@$
   if (lineno > 0)
      call skip(PAGELEN-lineno)
   return
   end
# skip - output  n  blank lines
   subroutine skip(n)
   integer i, n
   for (i = 1; i <= n; i = i + 1)
      call putc(NEWLINE)
   return
   end
# head - print top of page header
   subroutine head(name, pageno)
   character name(NAMESIZE)
   integer pageno
#   string page " Page  "
   integer page(7)
   data page(1) /BLANK/
   data page(2) /LETP/
   data page(3) /LETA/
   data page(4) /LETG/
   data page(5) /LETE/
   data page(6) /BLANK/
   data page(7) /EOS/
   call putlin(name, STDOUT)
   call putlin(page, STDOUT)
   call putdec(pageno, 1)
   call putc(NEWLINE)
   return
   end
define(NAMESIZE,50)
define(MARGIN1,3)
define(MARGIN2,2)
define(MARGIN3,2)
define(MARGIN4,3)
define(BOTTOM,60)
define(PAGELEN,66)
# print  (default input STDIN) - print files with headings
   character name(NAMESIZE)
   integer getarg, open
   integer fin, i
#   string null ""
   integer null(1)
   data null(1) /EOS/
   for (i = 1; getarg(i, name, NAMESIZE) ~= EOF; i = i + 1) {
      fin = open(name, READ)
      if (fin == ERR)
         call cant(name)
      call fprint(name, fin)
      call close(fin)
      $@$
   if (i == 1)      # no files specified
      call fprint(null, STDIN)
   stop
   end
# fprint - print file "name" from  fin
   subroutine fprint(name, fin)
   integer line(MAXLINE), name(NAMESIZE)
   integer getlin, open
   integer fin, lineno, pageno
   pageno = 0
   lineno = 0
   while (getlin(line, fin) ~= EOF) {
      if (lineno == 0) {
         call skip(MARGIN1)
         pageno = pageno + 1
         call head(name, pageno)
         call skip(MARGIN2)
         lineno = MARGIN1 + MARGIN2 + 1
         $@$
      call putlin(line, STDOUT)
      lineno = lineno + 1
      if (lineno >= BOTTOM) {
         call skip(PAGELEN-lineno)
         lineno = 0
         $@$
      $@$
   if (lineno > 0)
      call skip(PAGELEN-lineno)
   return
   end
# skip - output  n  blank lines
   subroutine skip(n)
   integer i, n
   for (i = 1; i <= n; i = i + 1)
      call putc(NEWLINE)
   return
   end
# head - print top of page header
   subroutine head(name, pageno)
   integer name(NAMESIZE)
   integer pageno
#   string page " Page  "
   integer page(7)
   data page(1) /BLANK/
   data page(2) /LETP/
   data page(3) /LETA/
   data page(4) /LETG/
   data page(5) /LETE/
   data page(6) /BLANK/
   data page(7) /EOS/
   call putlin(name, STDOUT)
   call putlin(page, STDOUT)
   call putdec(pageno, 1)
   call putc(NEWLINE)
   return
   end
define(NAMESIZE,50)
# makecopy - copy one file to another
   character iname(NAMESIZE), oname(NAMESIZE)
   integer create, getarg, open
   integer fin, fout
   if (getarg(1, iname, NAMESIZE) == EOF
      | getarg(2, oname, NAMESIZE) == EOF)
      call error("usage: makecopy input output.")
   fin = open(iname, READ)
   if (fin == ERR)
      call cant(iname)
   fout = create(oname, WRITE)
   if (fout == ERR)
      call cant(oname)
   call fcopy(fin, fout)
   call close(fin)
   call close(fout)
   stop
   end