#-h-  ch                         7686  local   01/09/81  00:44:48
#-h-  ch.doc                     3932  local   01/09/81  00:42:37
.bp 1
.in 0
.he 'CH (1)'4/7/78'CH (1)'
.fo **-#-**
.in 7
.fi
.ti -7
NAME
.br
ch - make changes in text files
.sp 1
.ti -7
SYNOPSIS
.br
ch [-ax] [expr ...] fromexpr [toexpr]
.sp 1
.ti -7
DESCRIPTION
.br
Ch
copies each line of the standard input to the standard output, globally
substituting the text pattern "toexpr" for "fromexpr" on each line that
satisfies matching criteria defined by the leading expressions "expr" and
the switches. (A text pattern is a subset of a "regular expression"--see
the "ed" writeup for a complete description.)  Three possible courses of
action are taken depending upon the number of text patterns(n) found in
the command line:
.sp
.in +5
.ti -5
n=1  The text pattern is assumed to be "fromexpr" with a null "toexpr";
it is equivalent to the ed command
.ti +10
g/fromexpr/s///g
.ti -5
n=2  The first text pattern is "fromexpr", the second is "toexpr"; it
is equivalent to the ed command
.ti +10
g/fromexpr/s//toexpr/g
.ti -5
n>=3 The (n-1)th pattern is "fromexpr", the nth is "toexpr" and patterns
1...n-2 are used to determine the lines upon which to perform the
substitution.  The default is that any line which matches any one of
the n-2 leading expressions are eligible for substitution.  If the -a
flag is specified, only lines which match all n-2 leading expressions in
any order are eligible.  If the -x flag is specified, all lines which
don't satisfy the above criteria are eligible. (See the writeup on find
for more information.)  In particular, if n=3,
.ti +10
ch expr from to
.br
is equivalent to the ed command
.ti +10
g/expr/s/from/to/g
.ti +10
ch -x expr from to
.br
is equivalent to the ed command
.ti +10
x/expr/s/from/to/g
.sp
.in -5
The substitution string "toexpr" may be a string of replacement
characters, null to effect a deletion, or it may include the special
"ditto" character "&" to put back the "fromexpr" string and thus
effect an insertion.  If a deletion is desired with the multiple
leading tag expressions, a "toexpr" of "" -i.e. quotes around an
empty string may be used.

A text pattern consists of the following elements:

.nf
c         literal character
?         any character except newline
%         beginning of line
$         end of line (null string before newline)
[...]     character class (any one of these characters)
[!...]    negated character class (all but these characters)
*         closure (zero or more occurrences of previous pattern)
{...}     'tagged' (marked) pattern
@c        escaped character (e.g., @%, @[, @*)

.fi
Any special meaning of characters in a text pattern is lost when
escaped, inside [...], or for:

.nf
%         not at beginning
$         not at end
*         at beginning

.fi
A character class consists of zero or more of the following
elements, surrounded by [ and ]:

.nf
c         literal character
a-b       range of characters (digits, lower or upper case)
!         negated character class if at beginning
@c        escaped character (@! @- @@ @])

.fi
Special meaning of characters in a character class is lost when
escaped or for

.nf
!         not at beginning
-         at beginning or end

.fi
An escape sequence consists of the character @ followed by a single
character:

.nf
@n        newline
@t        tab
@c        c (including @@)

.fi
For a complete description, see "Software Tools" pages 135-154.
Care should be taken when using the characters % $ [ ] { } ! * @ and
any shell characters
in the text pattern. It is often necessary to enclose the
entire substitution pattern in quotes.
.sp 1
.ti -7
FILES
.br
None
.sp 1
.ti -7
SEE ALSO
.br
sedit, find, tr, ed, the UNIX tool GRES
.sp 1
.ti -7
DIAGNOSTICS
.br
An error message is printed if the pattern given is illegal.
.sp 1
.ti -7
AUTHORS
.br
Original from Kernighan and Plauger's "Software Tools", with
modifications by Joe Sventek (Lawrence Berkeley Laboratory)
.sp 1
.ti -7
BUGS/DEFICIENCIES
.br
A minus sign(dash[-]) may not start an expression.
#-t-  ch.doc                     3932  local   01/09/81  00:42:37
#-h-  ch.r                       3490  local   12/10/80  15:14:16
 define(NEXPR,10)   # max nbr expressions allowed on command line
 #        include ratdef
 DRIVER(change)
 ## change - change 'string1'  into  'string2'
    character lin(MAXLINE), new(MAXLINE), pat(MAXPAT,NEXPR)
    character arg(MAXARG), from(MAXPAT), to(MAXPAT)
    integer addset, amatch, getarg, getlin, getpat, getsub
    integer i, junk, k, lastm, m , index
    integer except, andpat, narg, frarg, toarg, npat, itoc, status
    integer gmatch, tagbeg (10), tagend (10)
    string illpat "illegal pattern: "
    string maxexp "max nbr expressions allowed: "

 except = NO
 andpat = NO
 narg = 0
 call query("usage:  ch [-ax] [expressions] from [to].")
 for (i=1; getarg(i, arg, MAXARG) != EOF; i=i+1)
    if (arg(1) == MINUS)
        {
        call scopy(arg, 1, lin, 1)
        call fold(lin)
        if (index(lin, LETA) > 0)
            andpat = YES
        if (index(lin, LETX) > 0)
            except = YES
        call delarg(i)
        i = i - 1
        }
    else
        narg = narg + 1
 if (narg == 0)
    call cherr
 else if (narg == 1 | narg == 2)
    {
    frarg = 1
    toarg = 2
    npat = 1
    }
 else
    {
    toarg = narg
    frarg = narg - 1
    npat = narg - 2
    }
 if (npat > NEXPR)
    {
    call putlin(maxexp, ERROUT)
    i = itoc(NEXPR, arg, MAXARG)
    call error(arg)
    }
 junk = getarg(frarg, arg, MAXARG)
 if (getpat(arg, from) == ERR)
    call error("illegal fromexpr pattern.")
 if (getarg(toarg, arg, MAXARG) == EOF)
    arg(1) = EOS
 if (getsub(arg, to) == ERR)
    call error("illegal toexpr.")
 for (i=1; i <= npat; i=i+1)
    {
    junk = getarg(i, arg, MAXARG)
    if (getpat(arg, pat(1,i)) == ERR)
        {
        call putlin(illpat, ERROUT)
        call error(arg)
        }
    }
 while (getlin(lin, STDIN) != EOF)
    {
    status = gmatch(lin, pat, npat, andpat)
    if ((status == YES & except == NO) | (status == NO & except == YES))
        {
       k = 1
       lastm = 0
       for ( i =1; lin(i) != EOS; ) {
          m = amatch(lin, i, from, tagbeg, tagend)
          if (m > 0 & lastm != m) {   # replace matched text
             call catsub(lin, tagbeg, tagend, to, new, k, MAXLINE)
             lastm = m
             }
          if (m == 0 | m == i) {   # no match or null match
             junk = addset(lin(i), new, k, MAXLINE)
             i = i + 1
             }
          else            # skip matched text
             i = m
          }
       if (addset(EOS, new, k, MAXLINE) == NO) {
          k = MAXLINE
          junk = addset(EOS, new, k, MAXLINE)
          call remark('line truncated:.')
          call putlin(new, ERROUT)
          call putch(NEWLINE, ERROUT)
          }
       call putlin(new, STDOUT)
       }
    else
        call putlin(lin, STDOUT)
    }
 DRETURN
    end
 subroutine cherr

 call error("usage:  ch [-ax] [expressions] from [to].")

 return
 end
 ## getsub - get substitution pattern into sub
    integer function getsub(arg, sub)
    character arg(MAXARG), sub(MAXPAT)
    integer maksub

    getsub = maksub(arg, 1, EOS, sub)
    return
    end
 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
#-t-  ch.r                       3490  local   12/10/80  15:14:16
#-t-  ch                         7686  local   01/09/81  00:44:48
#-h-  comm                       4882  local   01/09/81  00:44:50
#-h-  comm.doc                   1205  local   01/09/81  00:44:19
.bp 1
.in 0
.he 'COMM (1)'1/11/79'COMM (1)'
.fo ''-#-'
.fi
NAME
.br
.in 7
comm - print lines common to two files
.sp 1
.in
SYNOPSIS
.br
.in 7
comm
[-123] file1 file2
.sp 1
.in
DESCRIPTION
.br
.in 7
Comm
reads
file1
and
file2,
which should be sorted, and produces a three column output:
lines only in
file1,
lines only in
file2,
and lines in both files.
The filename '-' means the standard input.
If there is only one file argument,
file2
refers to the standard input.

The optional arguments -1, -2, and -3 specify the printing of
only the corresponding column.
Thus
comm -3
prints only the lines common to both files, and
comm -12
prints lines which are in either file, but not in both.
The default is -123.
.sp 1
.in
FILES
.br
.in 7
None
.sp 1
.in
SEE ALSO
.br
.in 7
diff
.sp 1
.in
DIAGNOSTICS
.br
.in 7
A message is printed if an input file cannot be opened.
.sp 1
.in
AUTHORS
.br
.in 7
.sp 1
Debbie Scherrer (Lawrence Berkeley Laboratory)
.sp 1
.in
BUGS
.br
.in 7
The flags used by this tool are the reverse of those used by the
Unix 'comm'.  In Unix, the flags 1, 2, and 3
.bd
suppress
printing of the corresponding column.
Kernighan, on page 126 of 'Software Tools' suggests the
version used above.
#-t-  comm.doc                   1205  local   01/09/81  00:44:19
#-h-  comm.r                     3413  local   12/15/80  11:39:51
#-h-  comm                       1217  local   12/15/80  11:39:38
 #----------------------------------------------------------------
 # comm - print lines common to two files

 # include standard definitions
 # include ratdef
 #------------------------------------------------------------

define(LEADERING,15)

 DRIVER(comm)

   character buf(MAXLINE)
   integer getarg, open, index
   integer i, file(2), j, one, two, three

   one = YES    # default is all columns
   two = YES
   three = YES
   j = 0
   call query ("usage:  comm [-123] file1 file2.")
   for (i = 1; getarg(i, buf, MAXLINE) ^= EOF; i = i + 1) {
      if (j == 2)
         break
      if (buf(1) == MINUS & buf(2) ^= EOS) {
         if (index(buf, DIG1) == 0)
            one = NO
         if (index(buf, DIG2) == 0)
            two = NO
         if (index(buf, DIG3) == 0)
            three = NO
         }
      else if (buf(1) == MINUS) {
         j = j + 1
         file(j) = STDIN
         }
      else {
         j = j + 1
         file(j) = open(buf,READ)
         if (file(j) == ERR)
            call cant(buf)
         }
      }
   if (j == 0)
      call error ("usage:  comm [-123] file1 file2.")
   if (j == 1)
      file(2) = STDIN
   call common(file(1), file(2), one, two, three)
    DRETURN
   end
#-t-  comm                       1217  local   12/15/80  11:39:38
#-h-  coln                        334  local   12/15/80  11:39:38
# coln - print lin with leadering ldr if flag = YES; rm leading blanks
   subroutine coln(lin, ldr, flag)
   character lin(ARB)
   integer ldr, flag
   integer i

   if (flag == NO)
      return
   for (i = 1; i <= ldr; i = i + 1)
      call putc(BLANK)
   i = 1
   call skipbl(lin, i)
   call putlin(lin(i), STDOUT)
   return
   end
#-t-  coln                        334  local   12/15/80  11:39:38
#-h-  common                     1466  local   12/15/80  11:39:38
# common - print lines common to file1 & file2 according to flags 1..3
   subroutine common(file1, file2, one, two, three)
   integer file1, file2, one, two, three
   integer k, stat1, stat2, ldr1, ldr2, ldr3
   character buf1(MAXLINE), buf2(MAXLINE)
   integer getlin, strcmp

   ldr1 = 0     # compute leadering
   ldr2 = 0
   ldr3 = 0
   if (one == YES) {
      ldr2 = LEADERING
      ldr3 = LEADERING
      }
   if (two == YES)
      ldr3 = ldr3 + LEADERING
   stat1 = getlin(buf1,file1)
   stat2 = getlin(buf2,file2)
   repeat {
      if (stat1 == EOF | stat2 == EOF)
          break
      k = strcmp(buf1, buf2)     # compare lines
      if (k < 0) {               # line only in file1
         call coln(buf1, ldr1, one)
         stat1 = getlin(buf1, file1)
         }
      else if (k > 0) {          # line only in file2
         call coln(buf2, ldr2, two)
         stat2 = getlin(buf2, file2)
         }
      else {                     # line in both files
         call coln(buf1, ldr3, three)
         stat1 = getlin(buf1, file1)
         stat2 = getlin(buf2, file2)
         }
      }
   if (stat1 == EOF)      # end of file1, print rest of file2
      while (stat2 ^= EOF) {
         call coln(buf2, ldr2, two)
         stat2 = getlin(buf2, file2)
         }
   else if (stat2 == EOF) # end of file2, print rest of file1
      while (stat1 ^= EOF) {
         call coln(buf1, ldr1, one)
         stat1 = getlin(buf1, file1)
         }
   return
   end
#-t-  common                     1466  local   12/15/80  11:39:38
#-t-  comm.r                     3413  local   12/15/80  11:39:51
#-t-  comm                       4882  local   01/09/81  00:44:50
#-h-  cpress                     4063  local   01/09/81  00:44:51
#-h-  cpress.doc                  775  local   01/09/81  00:43:00
.bp 1
.in 0
.he 'CPRESS (1)'1/15/79'CPRESS (1)'
.fo ''-#-'
.fi
NAME
.br
.in 7
cpress - compress input files
.sp 1
.in
SYNOPSIS
.br
.in 7
cpress
[file ...]
.sp 1
.in
DESCRIPTION
.br
.in 7
Cpress
compresses runs of repeated characters in the input files.
The output file can eventually be expanded with the tool 'expand'.

If no input files are given, or the filename '-' appears, input will
be from the standard input.
.sp 1
.in
FILES
.br
.in 7
.sp 1
.in
SEE ALSO
.br
.in 7
expand
.sp 1
.in
DIAGNOSTICS
.br
.in 7
A message is printed if an input file cannot be opened; further processing
is terminated.
.sp 1
.in
AUTHORS
.br
.in 7
.sp 1
From Kernighan & Plauger's 'Software Tools', with modifications by
Debbie Scherrer (Lawrence Berkeley Laboratory)
.sp 1
.in
BUGS
.br
.in 7
#-t-  cpress.doc                  775  local   01/09/81  00:43:00
#-h-  cpress.r                   3024  local   12/15/80  13:17:58
#-h-  cpress                     1161  local   12/15/80  11:50:40
 ## cpress - compress input files
  # These definitions are used by both the cpress and expand tools
                                                                                
 #must have RCODE > MAXCHUNK or RCODE = 0
 define(MAXCHUNK,124)
 define(RCODE,125)
 define(THRESH,4)
 #        include ratdef
 DRIVER(cpress)
                                                                                
 character buf(MAXLINE)
 integer getarg, open
 integer i
 #must have RCODE > MAXCHUNK or RCODE = 0
 call query ('usage:  cpress [files].')
                                                                                
 for (i=1; ; i=i+1)
        {
        if (getarg(i,buf,MAXLINE) == EOF)
                {
                if (i != 1)
                        break
                int = STDIN
                }
        else if (buf(1) == MINUS & buf(2) == EOS)
                int = STDIN
        else
                {
                int = open(buf,READ)
                if (int == ERR)
                        call cant(buf)
                }
        call press (int)
        if (int != STDIN)
                call close(int)
        }
 DRETURN
 end
#-t-  cpress                     1161  local   12/15/80  11:50:40
#-h-  press                      1101  local   12/15/80  11:50:41
 ## press - compress file -int-
 subroutine press (int)
 character getch
 character buf(MAXCHUNK), c, lastc
 integer int, nrep, nsave
 #must have RCODE > MAXCHUNK or RCODE = 0
                                                                                
 nsave = 0
 for (lastc=getch(lastc,int); lastc != EOF; lastc = c)
        {
        for (nrep=1; getch(c,int) == 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
 return
 end
#-t-  press                      1101  local   12/15/80  11:50:41
#-h-  putbuf                      366  local   12/15/80  11:50:41
 ## 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
#-t-  putbuf                      366  local   12/15/80  11:50:41
#-t-  cpress.r                   3024  local   12/15/80  13:17:58
#-t-  cpress                     4063  local   01/09/81  00:44:51
#-h-  crt                        3486  local   01/07/81  00:10:41
#-h-  crt.doc                    1190  local   12/19/80  14:37:44
.bp  1
.in 0 
.he 'CRT'1/12/79'CRT'
.fo ''-#-' 
.fi 
NAME 
.br 
.in 7 
crt - copy files to terminal
.sp 1 
.in 
SYNOPSIS 
.br 
.in 7 
crt
[-n] [file ...]
.sp 1 
.in 
DESCRIPTION 
.br 
.in 7 
CRT
is similar to 'cat' except that it prints only n lines (default 22) at
a time.
After each set of lines are printed, crt will wait for instructions
from the user.
Hitting a carriage-return will cause the next n lines to appear, hitting
a 'q' (quit) will cause crt to skip over to the next input file (if
any), and hitting an end-of-file character will cause crt to stop
immediately.
 
If no files are specified, or if the filename '-' is given, lines
will be read from the standard input.
 
The flag -n may be given, where n specifies the number of lines desired
at a time.
 
Crt will stop at the end of each file (except the last), as well as
after each n lines.
.sp 1
.in 
FILES 
.br 
.in 7 
.sp 1 
.in 
SEE ALSO 
.br 
.in 7 
cat, pg (if implemented)
.sp 1 
.in 
DIAGNOSTICS 
.br 
.in 7 
A message is printed if an input file cannot be opened; further processing
is terminated.
.sp 1 
.in 
AUTHORS 
.br 
.in 7 
.sp 1 
Debbie Scherrer, Lawrence Berkeley Laboratory
.sp 1 
.in 
BUGS 
.br 
.in 7 
#-t-  crt.doc                    1190  local   12/19/80  14:37:44
#-h-  crt.r                      2130  local   12/19/80  14:37:45
 
 ##crt - prepare output for teletype-like device
 
 DRIVER(crt)
 
 
 integer getarg, ctoi, open, getlin, prtnl
 integer i, j, tt, nlines, input
 character buf(MAXLINE), terml(FILENAMESIZE)
 string tty TERMINAL_IN
 data nlines /22/
 data input /NO/
 
 
 
 call query ("usage:  crt [-n] [file].")
 tt = open(tty, READ)
 if (tt == ERR)
        call cant(tty)
 for (i=1; getarg(i,buf,MAXLINE)!=EOF; i=i+1)
        {
        if (buf(1) == MINUS & buf(2) == EOS)
                int = STDIN
        else if (buf(1) == MINUS)
                {
                j = 2
                nlines = max(ctoi(buf,j), 1)
                next
                }
        else
                {
                int = open(buf,READ)
                if (int == ERR)
                        call cant(buf)
                }
 
        input = YES
        if (prtnl(int, nlines, tt) == EOF)
                break
         if (int != STDIN)
                call close(int)
        }
 
 if (input == NO)
        call prtnl(STDIN, nlines, tt)
 return
 end
#-t- main             568 asc 07-may-80 15:11:03
 ## prtnl - print nl lines at a time from file int
 integer function prtnl(int, nl, tt)
 integer int, nl, tt, prompt
 integer getlin
 character buf(MAXLINE)
 data prompt /NO/
 
 prtnl = OK
 repeat
        {
        if (prompt == YES)
                {
                prtnl = getlin(buf,tt)
                if (prtnl == EOF)
                        {
                        prompt = NO
                        return
                        }
                if (buf(1) == LETQ | buf(1) == BIGQ)
                        {
                        prompt = NO
                                
                        return
                        }
                }
         for (j=1; j<=nl; j=j+1)
                {
                prompt = YES
                if (getlin(buf, int) == EOF)
                        return
                call putlin(buf, STDOUT)
                }
        }
 return
 end
#-t- prtnl            520 asc 07-may-80 15:11:05
#-t-  crt.r                      2130  local   12/19/80  14:37:45
#-t-  crt                        3486  local   01/07/81  00:10:41
#-h-  crypt                      2782  local   12/19/80  15:36:19
#-h-  crypt.doc                  1046  local   12/19/80  15:36:01
.bp 1
.in 0
.he 'CRYPT (1)'6/30/78'CRYPT (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
crypt - encrypt and decrypt standard input
.nf
.sp
.ti -3
SYNOPSIS
.br
crypt key
.fi
.sp
.ti -3
DESCRIPTION
.br
Crypt
encrypts characters on the standard input by using "key".
The file can eventually be decrypted by running it back through
crypt with the same key.
Multiple encryption (encrypting a file with first one key and then
another) is allowable.
.sp
The size of the encryption key is limited by the MAXKEY definition
in the source code.
.sp
.ti -3
FILES
.br
None
.sp
.ti -3
SEE ALSO
.br
.sp
.ti -3
DIAGNOSTICS
.br
None
.sp
.ti -3
AUTHORS
.br
From Kernighan & Plauger's 'Software Tools'.
.sp
.ti -3
BUGS/DEFICIENCIES
.br
On some systems, encryption results in control characters which
may cause erratic behavior.
For these systems, an optional version of the encryption routine
is provided which avoids encrypting control characters.
When using this optional version, multiple decriptions must be
done in the exact reverse order in which encryption was done.
#-t-  crypt.doc                  1046  local   12/19/80  15:36:01
#-h-  crypt.r                    1472  local   12/19/80  15:36:02
#-h-  crypt                      1052  local   12/19/80  15:28:17
# crypt - encrypt and decrypt
 # include ratdef
define(MAXKEY,MAXLINE)
 #  There are 2 versions of crypt here--the one from the book
 #  and a simpler one which does not encrypt control characters
 #  (since some systems have trouble reading/printing various
 #  control characters).  If you want the simpler, no-control-
 #  character version, do this:
 #           define(NOCONTROL,)
 DRIVER(crypt)
   character xor
   character c, key(MAXKEY), b
   character getc
   integer getarg
   integer i, keylen, junk

   call query ("usage:  crypt key.")
   keylen = getarg(1, key, MAXKEY)
   if (keylen == EOF)
      call error("usage: crypt key.")
   for (i=1; getc(c) != EOF; i=mod(i, keylen) +1)
        {
        ifnotdef(NOCONTROL,   call putc(xor(c, key(i))) )
                                 #leave control characters alone
        ifdef(NOCONTROL,
        if (c < BLANK)
                call putc(c)
        else
                {
                b = xor(c, key(i) & 31)
ifdef(VAX_VMS, if (b == 127) b = c)
                call putc(b)
                } )
        }
   DRETURN
   end
#-t-  crypt                      1052  local   12/19/80  15:28:17
#-h-  xor                         119  local   12/19/80  15:28:18
 # xor - exclusive-or of a and b
 character function xor(a,b)
 character a, b

 xor = (a & !b) | (!a & b)
 return
 end
#-t-  xor                         119  local   12/19/80  15:28:18
#-t-  crypt.r                    1472  local   12/19/80  15:36:02
#-t-  crypt                      2782  local   12/19/80  15:36:19
#-h-  date                        974  local   12/10/80  15:25:43
#-h-  date.doc                    429  local   12/10/80  15:25:26
.bp 1
.in 0
.he 'DATE (1)'1/11/79'DATE (1)'
.fo ''-#-'
.fi
NAME
.br
.in 7
date - print the date
.sp 1
.in
SYNOPSIS
.br
.in 7
.bd
date
.sp 1
.in
DESCRIPTION
.br
.in 7
The current date and time are printed.
.sp 1
.in
FILES
.br
.in 7
None
.sp 1
.in
SEE ALSO
.br
.in 7
The Unix command 'date'
.sp 1
.in
DIAGNOSTICS
.br
.in 7
None
.sp 1
.in
AUTHORS
.br
.in 7
.sp 1
Allen Akin, Georgia Institute of Technology
.sp 1
.in
BUGS
.br
.in 7
#-t-  date.doc                    429  local   12/10/80  15:25:26
#-h-  date.r                      281  local   12/10/80  15:25:27
 ## date - print current date & time
 DRIVER(date)
 character dat(MAXLINE), tim(MAXLINE)
 integer now (7)
 
 call getnow (now)
 call fmtdat (dat, tim, now, 0)
 call putlin(dat, STDOUT)
 call putch(BLANK, STDOUT)
 call putlin(tim, STDOUT)
 call putch(NEWLINE, STDOUT)
 DRETURN
 end
#-t-  date.r                      281  local   12/10/80  15:25:27
#-t-  date                        974  local   12/10/80  15:25:43
#-h-  dc                        21073  local   12/22/80  14:43:03
#-h-  dc.doc                     5107  local   12/19/80  15:44:26
.bp 1
.in 0
.he 'DC (1)'07/20/80'DC (1)'
.fo ''-#-''
.fi
.in 3
.ti -3
NAME
.br
dc - desk calculator
.sp 1
.ti -3
SYNOPSIS
.br
dc [files ...]
.sp 1
.ti -3
DESCRIPTION
.br
DC evaluates integer expressions from the source files,
one expression per input line.
If no input files are given, or the filename '-' is specified,
dc reads from the standard input.

Ordinarily dc operates on decimal integer arithmetic expressions,
but the user may specify an input base and output base other
than decimal.

Expressions may be simple arithmetic expressions or
replacement expressions.
The values of simple expressions are
written on standard output when they are evaluated.
Replacement expressions are used to hold temporary values, and are
not automatically printed.

A simple expression is a normal arithmetic expression using
numbers, variables, parentheses, and the following
operators, listed in order of precedence:
.in +5
.nf
+  -          unary plus and negation operators.  These may
                          only appear at the start of a simple
                          expression or after a "("

**            exponentiation

*   /   %     multiply, divide, modulo (remainder)

+   -         add, subtract

== !=         relations - equals, not equal to,
>  >=         greater than, greater than or equal to,
<  <=         less than, less than or equal to
                       (!=, ^=, ~= all treated as "not equal")

!             unary logical not (also ~ and ^)

|   &         logical or, and

.in -5
.fi
The logical operators ! | & and the relational operators result in
the values 1 for true and 0 for false.

A replacement expression is:
.sp
.ce
name = simple expression
.sp
where 'name' is a character string of (virtually) any length,
starting with a letter and consisting of only letters and digits.
(The characters a-f should not be considered letters when operating
in hexadecimal mode.)
Variables are automatically declared when they first appear to
the left of an "=" sign,
and they should not be used in a simple expression until they have
been declared.

Radix Control
.br
.in +5
Radix control is available in 2 ways:
.br
1) There are default radix values for both input and output which
may be changed by setting the predefined variables 'ibase'
(input base) and 'obase' (output base).  (Radix 10 is always
used to evaluate and/or print radix-defining expressions.)
For example,
.sp
.in +10
ibase = 2
.br
obase = 16
.in -10
.sp
would accept input in binary and print results in hexadecimal.

2)  The radix of individual numbers may be explicitly given by
following the number with an underscore character and then the
desired radix.
For example,
.sp
.ce
100_16
.sp
would specify the hex number 100 (256 in decimal).
.in -5
.sp
.ti -3
EXAMPLES
.br
.sp
.nf
.ti +15
10 + (-64 / 2**4)
.br
would print the answer "6"
.sp
.in +15
.nf
temp = 101_2
temp == 5
.fi
.in -15
would print the answer "1" (true)

.nf
.in +15
ibase = 16
obase = 2
1a + f
.in -15
.fi
would print the answer "101001"
.sp
.in +15
.nf
ibase = 16
numa = 100_10
numb = 100
numa + numb
.in -15
.fi
would print the answer "356"
.sp 1
.ne 2
.ti -3
FILES
.br
None
.sp 1
.ne 3
.ti -3
SEE ALSO
.br
macro, the UNIX M4 macro package
.br
The UNIX tools dc and bc
.sp 1
.ne 5
.ti -3
DIAGNOSTICS
.br
.in +3
.ti -3
arith evaluation stack overflow
.br
arithmetic expressions have been nested too deeply.
The size of the stack is set by the MAXSTACK definition
in the source code.

.ti -3
number error
.br
an input number has a number/character bigger than the current
radix
.sp
.ne 2
.ti -3
expression error
.br
invalid arithmetic expression
.in -3
.sp 1
.ti -3
AUTHOR
.br
Philip H. Scherrer (Stanford U.)
.sp 1
.ti -3
BUGS/DEFICIENCIES
.br
Dc only works with integers

The maximum value allowed depends on the host machine and is the
largest Fortran integer
#-t-  dc.doc                     5107  local   12/19/80  15:44:26
#-h-  cexp                        272  local   12/19/80  15:44:28
 ## common for exptoi
 # put on a file called 'cexp'
 # Used by macro and dc tools
 common/cexp/ top, tokst(MAXSTACK), kindst(MAXSTACK)
 integer top	# evaluation stack pointer
 integer tokst	# eval stack part 1: tokens
 integer kindst # eval stack part 2: kinds of tokens
#-t-  cexp                        272  local   12/19/80  15:44:28
#-h-  ctab                         60  local   12/22/80  14:33:37
 common /ctab/ idtab
 pointer idtab

DS_DECL (mem, MEMSIZE)
#-t-  ctab                         60  local   12/22/80  14:33:37
#-h-  dc.r                      16386  local   12/22/80  14:37:00
#-h-  dc                         1644  local   12/19/80  15:43:27
 ## dc - desk calculator
 # include ratdef
 define(MAXTOK,MAXLINE)
 define(OP,1)
 define(OPND,2)
 define(SEP,3)
 define(OPDONE,1)
 define(OPGO,2)
 define(OPLP,3)
 define(OPRP,4)
 define(OPOR,5)
 define(OPAND,6)
 define(OPNOT,7)
 define(OPEQ,8)
 define(OPNE,9)
 define(OPGT,10)
 define(OPGE,11)
 define(OPLT,12)
 define(OPLE,13)
 define(OPADD,14)
 define(OPSUB,15)
 define(OPMUL,16)
 define(OPDIV,17)
 define(OPNEG,18)
 define(OPMOD,19)
 define(OPEXP,20)
 define(OPPLUS,21)
 define(MAXOP,21)
 define(OPERR,-1)
 define(MAXSTACK,200)  # evaluation stack
 define(MEMSIZE,4000)

 DRIVER(dc)
 character name(FILENAMESIZE)
 integer getarg, open
 integer fd, i

 include ctab

 call query ("usage:  dc.")
 call dsinit (MEMSIZE)
 idtab = mktabl (1)
 fd = ERR
 for (i=1; getarg(i, name, FILENAMESIZE) != EOF; i=i+1)
        {
        if (name(1) == MINUS & name(2) == EOS)
                fd = STDIN
        else if (name(1) != MINUS)
                {
                fd = open(name, READ)
                if (fd == ERR)
                        call cant(name)
                }
        if (fd != ERR)
                {
                call dcexp (fd)
                if (fd != STDIN)
                        call close (fd)
                }
        }

 if (fd == ERR)
        call dcexp (STDIN)
 DRETURN
 end
#-t-  dc                         1644  local   12/19/80  15:43:27
#-h-  binop                      1413  local   12/19/80  15:43:27
 ## binop - evaluates top 3 items on eval stack
 subroutine binop

 integer l, r, result, op
 include cexp

 r = tokst(top)
 op = tokst(top-1)
 l = tokst(top-2)
 top = top - 2
 switch (op)
        {
        case OPOR: if (l != 0 | r != 0) result = 1
                   else result = 0
        case OPAND:if (l != 0 & r != 0) result = 1
                   else result = 0
        case OPNOT: if (r == 0) result = 1
                    else result = 0
        case OPEQ:  if (l == r) result = 1
                    else result = 0
        case OPNE:  if (l != r) result = 1
                    else result = 0
        case OPGT:  if (l > r) result = 1
                    else result = 0
        case OPGE:  if (l >= r) result = 1
                    else result = 0
        case OPLT:  if (l < r) result = 1
                    else result = 0
        case OPLE:  if (l <= r) result = 1
                    else result = 0
        case OPADD: result = l + r
        case OPSUB:  result = l - r
        case OPNEG:  result = (-r)
        case OPMUL:  result = l * r
        case OPDIV:  result = l / r
        case OPMOD:  result = mod(l,r)
        case OPEXP:  result = l**r
        case OPPLUS: result = (+r)
        }
 tokst(top) = result
 return
 end
#-t-  binop                      1413  local   12/19/80  15:43:27
#-h-  ctonum                      993  local   12/19/80  15:43:28
# ctonum - string to number with radix control
 integer function ctonum(buf,i,dradix)
 character buf(ARB), tmp(MAXLINE)
 integer ctoi
 integer i, j, c, n, val, radix, dradix, m
 string digits "0123456789abcdefABCDEF"

 if (buf(i) == MINUS)
        {
        i = i + 1
        m = -1
        }
 else m = 1
 for (n=0;;i=i+1)
        {       #collect digits
        c = index(digits,buf(i))
        if (c==0) break
        if (c > 16) c = c-6     # convert to lower case
        n = n+1
        tmp(n) = c-1            # save digit value
        }
 if (buf(i) == UNDERLINE)
        {       # get new radix, default radix is 10.
        radix = 0
        i = i+1
        radix = ctoi(buf,i)
        }
 else radix = dradix
 val = 0
 for (j=1; j<=n; j = j+1)
        {
        c = tmp(j)
        if (c >= radix)
                call remark("number error")
        val = val * radix + c
        }
 return ( m*val )
 end
#-t-  ctonum                      993  local   12/19/80  15:43:28
#-h-  dcexp                      2776  local   12/19/80  15:43:29
 ## dcexp - read file and process desk calculator expressions
 subroutine dcexp (fd)

 integer fd, junk, i, answer, save
 integer getlin, numtoc, exptoi, index, strcmp
 integer ibase, obase, ubase, radexp, eqloc
 character line(MAXLINE), name(MAXTOK)
 include ctab
 string errmsg ":  invalid expression"
 string ibname "ibase"
 string obname "obase"

 ibase = 10
 obase = 10
 call enter (ibname, ibase, idtab)
 call enter (obname, obase, idtab)
 while(getlin(line, fd) != EOF)
        {
        radexp = 0              # assume not radix expression
        call strip(line)        #remove blanks, tabs, NEWLINEs
        i = 1
        save = index(line, EQUALS)      #see if result should be stored
        if (save != 0)
                {
                if (line(save+1) == EQUALS)     #oops, found relational
                        save = 0
                else
                        {
                        eqloc = save
                        i = save + 1
                        line(eqloc) = EOS
                        call scopy(line, 1, name, 1)
                        if (strcmp(name,ibname) == 0 |
                            strcmp(name,obname) == 0)
                                radexp = 1
                        }
                }
        else
                {
                if (strcmp(line,ibname) == 0 |
                    strcmp(line,obname) == 0)
                        radexp = 1
                }
        ubase = ibase
        if (radexp == 1)
                ubase = 10
        answer = exptoi(line, i, ubase)
        if (line(i) != EOS)             #error
                {
                if (save != 0) line(eqloc) = EQUALS
                call putlin(line, ERROUT)
                call putlin(errmsg, ERROUT)
                call putch(NEWLINE, ERROUT)
                }
        else
                {
                ubase = obase
                if (radexp == 1 | save != 0)
                        ubase = 10
                junk = numtoc(answer, line, MAXLINE, ubase)
                if (save != 0)          #store answer
                        {
                        call enter (name, answer, idtab)
                        if (strcmp(ibname,name) == 0)
                                ibase = answer
                        if (strcmp(obname,name) == 0)
                                obase = answer
                        }
                else
                        {
                        call putlin(line, STDOUT)
                        call putch(NEWLINE, STDOUT)
                        }
                }
        }
 return
 end
#-t-  dcexp                      2776  local   12/19/80  15:43:29
#-h-  exptoi                     4016  local   12/19/80  15:43:30
 ## exptoi - evalutate arithmetic expression
 integer function exptoi (exp, ptr, radix)

 integer exptok, stackx
 character exp(ARB)
 integer ptr, radix
 integer k, tok, kind, preced(MAXOP)
 include cexp

 # precedence of respective operators
 data preced(1), preced(2), preced(3), preced(4), preced(5),
      preced(6), preced(7), preced(8), preced(9), preced(10),
      preced(11), preced(12), preced(13), preced(14), preced(15),
      preced(16), preced(17), preced(18),
      preced(19), preced(20), preced(21) / 0,  0,   # EOS, start_expr
        1,  1,          # (  )
        2,  2,          # |  &
        3,              # ! (or ^ or ~)
        4,4,4,4,4,4,    # == != > >= < <=
        5,  5,          # +  -
        6,  6,          # *  /
        8,  6,  7, 8      /# neg, mod, expon, plus


 k = ptr
 top = 1
 tokst(top) = OPGO
 kindst(top) = SEP

 while (exptok(exp, k, tok, kind, radix) == YES) #loop thru legal toks
        {
        if (kind == OPND)
                {
                if (kindst(top) == OPND)
                        return(0)
                }
        else if (kind == OP)
                {
                if (kindst(top) == OP)
                        return(0)
                else if (kindst(top) == SEP)
                        {       #check for unary +,- or !
                        if (tok != OPADD & tok != OPSUB & tok != OPNOT)
                                return(0)
                        if (stackx(0, OPND) == ERR)
                                return(0)
                        if (tok == OPADD)
                                tok = OPPLUS
                        else if (tok == OPSUB)
                                tok = OPNEG
                        }
                else    #kindst(top) == OPND
                        {
                        if (kindst(top-1) == OP)
                                {
                                while(preced(tokst(top-1)) >= preced(tok))
                                        call binop
                                }
                        }
                }
        else # (kind == SEP)
                {
                if (tok != OPLP)        #if tok == ( or tok == EOS
                        {
                        if (kindst(top) != OPND)
                                return(0)
                        while(preced(tokst(top-1)) > preced(tok))
                                {
                                if (kindst(top-1) == OP)
                                        call binop
                                else
                                        return(0)  # no right paren
                                }
                        if (preced(tokst(top-1)) == preced(tok))
                                {
                                if (tok == OPDONE)
                                        {
                                        ptr = k    #normal return
                                        return(tokst(top))
                                        }
                                else    #remove matching LPAREN
                                        {
                                        tok = tokst(top)
                                        kind = kindst(top)
                                        top = top -2
                                        }
                                }
                        else    #unbalanced parens
                                return(0)
                        }
                }
        # stack new tok, kind
        if (stackx(tok, kind) == ERR)
                return(0)
        }
 return(0)
 end
#-t-  exptoi                     4016  local   12/19/80  15:43:30
#-h-  exptok                     3810  local   12/19/80  15:43:31
 ## exptok - get expression token for evaluation
 integer function exptok(exp, k, tok, kind, radix)
 character exp(ARB), defn(MAXTOK), name(MAXTOK)
 integer k      #index, updated unless EOS
 integer tok    #return value, token found
 integer kind   #return value, kind of token
 integer radix  #default radix for numbers
 integer ctonum, lookup
 character type
 character c, cn
 include ctab
 string digits "0123456789abcdefABCDEF"
 include cexp

 c = type(exp(k))
 if (radix > 10)
        {
        if (index(digits,exp(k)) > 0) c = DIGIT
        }
 if (c == DIGIT)
        {
        tok = ctonum(exp, k, radix)
        kind = OPND
        return(YES)
        }
 else if (c == LETTER)
        {               #found stored variable name
        call movnam(exp, k, name, 1)
        k = k + length(name)
        if (lookup (name, tok, idtab) == YES)
                {
                kind = OPND
                return(YES)
                }
        else
                return(NO)
        }
 else           #c is symbol
        {
        cn = exp(k+1)
        kind = OP
        switch(c)
                {
                case TILDE:  if (cn == EQUALS)
                                {
                                tok = OPNE
                                k = k + 1
                                }
                         else tok = OPNOT
                case CARET:  if (cn == EQUALS)
                                {
                                tok = OPNE
                                k = k + 1
                                }
                         else tok = OPNOT
                case BANG:  if (cn == EQUALS)
                                {
                                tok = OPNE
                                k = k + 1
                                }
                         else tok = OPNOT
                case LESS:  if (cn == EQUALS)
                                {
                                tok = OPLE
                                k = k + 1
                                }
                         else tok = OPLT
                case GREATER:  if (cn == EQUALS)
                                {
                                tok = OPGE
                                k = k + 1
                                }
                         else tok = OPGT
                case EQUALS:  if (cn == EQUALS)
                                {
                                tok = OPEQ
                                k = k + 1
                                }
                         else tok = OPERR
                case BAR:  tok = OPOR
                case AMPER: tok  = OPAND
                case PLUS:  tok = OPADD
                case MINUS: tok = OPSUB
                case STAR:  if (cn == STAR)
                                {
                                tok = OPEXP
                                k = k + 1
                                }
                            else tok = OPMUL
                case SLASH: tok = OPDIV
                case PERCENT: tok = OPMOD
                case LPAREN: {
                             kind = SEP
                             tok = OPLP
                             }
                case RPAREN: {
                             kind = SEP
                             tok = OPRP
                             }
                case EOS:    {
                             kind = SEP
                             tok = OPDONE
                             }
                default:     tok = OPERR
                }

 if (tok == OPERR)
        return(NO)
 if (tok != OPDONE)
        k = k + 1
 return(YES)
 }
 end
#-t-  exptok                     3810  local   12/19/80  15:43:31
#-h-  movnam                      451  local   12/19/80  15:43:32
 ## movnam - move in(i) to out(j) until non-alphanumeric found
 subroutine movnam (in, i, out, j)
 character in(ARB), out(ARB)
 integer i, j, k1, k2
 character type
 character c

 k1 = i
 k2 = j
 for(c=type(in(k1)); c == LETTER | c == DIGIT; c=type(in(k1)))
        {
        out(k2) = in(k1)
        k1 = k1 + 1
        k2 = k2 + 1
        }
 out(k2) = EOS
 return
 end
#-t-  movnam                      451  local   12/19/80  15:43:32
#-h-  numtoc                      817  local   12/19/80  15:43:33
 ## numtoc - convert integer int to char string in str
 integer function numtoc(int, str, size, radix)
 integer mod
 integer radix
 integer d, i, int, intval, j, k, size
 character str(ARB)
 string digits "0123456789ABCDEF"

 intval = abs(int)
 str(1) = EOS
 i = 1
 repeat
        {       # generate digits
        i = i+1
        d = mod(intval,radix)
        str(i) = digits(d+1)
        intval = intval / radix
        } until (intval == 0 | i >= size)
 if (int < 0 & i < size)
        {       # then sign
        i = i+1
        str(i) = MINUS
        }
 numtoc = i - 1
 for (j = 1; j < i; j = j+1)
        {       # reverse digits
        k = str(i)
        str(i) = str(j)
        str(j) = k
        i = i-1
        }
 return
 end
#-t-  numtoc                      817  local   12/19/80  15:43:33
#-h-  stackx                      480  local   12/19/80  15:43:33
 ## stackx - put next expression on arith evaluation stack
 integer function stackx(tok, kind)
 integer tok, kind

 include cexp

 if (top >= MAXSTACK)
        {
        call remark ("arith evaluation stack overflow.")
        return (ERR)
        }
 top = top + 1
 tokst(top) = tok
 kindst(top) = kind
 return(OK)
 end
#-t-  stackx                      480  local   12/19/80  15:43:33
#-h-  strip                       572  local   12/19/80  15:43:33
 ## strip - string blanks, tabs, and NEWLINES from line

 subroutine strip (line)

 character line(ARB)
 integer i

 for (i=1; line(i) != EOS; )
        {
        if (line(i) == BLANK | line(i) == TAB | line(i) == NEWLINE)
                call scopy(line, i+1, line, i)
        else
                i = i + 1
        }
 return
 end
#-t-  strip                       572  local   12/19/80  15:43:33
#-t-  dc.r                      16386  local   12/22/80  14:37:00
#-t-  dc                        21073  local   12/22/80  14:43:03
#-h-  detab                      4459  local   12/22/80  15:36:59
#-h-  detab.doc                   817  local   12/22/80  15:32:50
.bp 1
.in 0
.he 'DETAB (1)'8/20/79'DETAB (1)'
.fo ''-#-'
.fi
NAME
.br
.in 7
detab - convert tabs to spaces
.sp 1
.in
SYNOPSIS
.br
.in 7
detab [<t1>...] [+<n>] [file...]
.sp 1
.in
DESCRIPTION
.br
.in 7
Detab converts tab characters (control-i) to equivalent strings
of blanks.
Tab stops are indicated by <t1>...
(default 8, 16, ...),
while +<n> indicates tab stops
every <n> columns.
Thus the command

.ti +3
detab 5 21 +5

supplies blanks for tabs terminating at column positions 5, 21, 26, etc.
If no files are specified, the standard input is read.
An isolated minus sign also indicates the standard input.
.sp 1
.in
SEE ALSO
.br
.in 7
entab
.sp 1
.in
AUTHORS
.br
.in 7
.sp 1
Original from Kernighan & Plauger's 'Software Tools', with modifications
by Dennis Hall and Debbie Scherrer (Lawrence Berkeley Laboratory)
#-t-  detab.doc                   817  local   12/22/80  15:32:50
#-h-  detab.r                    3378  local   12/22/80  15:32:50
#-h-  detab                       840  local   12/22/80  15:32:29
 ## detab - driver for detab tool
 DRIVER(detab)
    character buf(MAXLINE)
    integer open, getarg, length, alldig
    integer tabs(MAXLINE), int, i, k, l


    call settab(tabs)   # set initial tab stops
    int = ERR
    call query ("usage:  detab [<t1> <t2> etc] [+<n>] [files].")

     for (i=1; getarg(i, buf, MAXLINE) != EOF; i=i+1)
        {
        if (buf(1) == PLUS | alldig(buf) == YES)        #ignore flags
                next
        if (buf(1) == MINUS & buf(2) == EOS)    #read from standard input
                int = STDIN
        else
                int = open(buf, READ)
        if (int == ERR)
                call cant(buf)
        call dotab (tabs, int)
        if (int != STDIN)
                call close(int)
        }

    if (int == ERR)     #no files read
        call dotab(tabs, STDIN)
    return
    end
#-t-  detab                       840  local   12/22/80  15:32:29
#-h-  alldig                      281  local   12/22/80  15:32:30
 ## alldig - return YES if str is all digits
 integer function alldig (str)

 integer type, i
 character str(ARB)

 alldig = NO
 if (str(1) == EOS)
        return
 for (i=1; str(i) != EOS; i=i+1)
        if (type(str(i)) != DIGIT)
                return
 alldig = YES
 return
 end
#-t-  alldig                      281  local   12/22/80  15:32:30
#-h-  dotab                       583  local   12/22/80  15:32:30
 ## dotab - convert tabs to equivalent number of blanks
 subroutine dotab (tabs, int)
 integer int
 character getch
 character c
 integer tabs(ARB)
 integer tabpos
 integer col

    col = 1
    while (getch(c, int) != EOF)
       if (c == TAB)
          repeat {
             call putc(BLANK)
             col = col + 1
             if (tabpos(col, tabs) == YES)
                break
             }
       else if (c == NEWLINE) {
          call putc(NEWLINE)
          col = 1
          }
       else {
          call putc(c)
          col = col + 1
          }
    return
    end
#-t-  dotab                       583  local   12/22/80  15:32:30
#-h-  settab                      799  local   12/22/80  15:32:30
 # settab - set initial tab stops
    subroutine settab(tabs)
    integer alldig
    integer tabs(MAXLINE), m, p, k, i, j, l
    integer getarg, ctoi
    character n(4)

   p = 0
   for (i=1; i<=MAXLINE; i=i+1)
       tabs(i) = NO
   for (j=1; getarg(j,n,4)!=EOF; j=j+1)
       {
       k=1
       if (n(1) == PLUS)
          k = k + 1
       if (alldig(n(k)) == NO)
                next
       l = ctoi(n,k)
       if (l<=0 | l>MAXLINE)
          next
       if (n(1)!=PLUS)
          {
          p = l
          tabs(p) = YES
          }
       else
          {
          if (p==0)
             p = l  + 1
          for (m=p; m<=MAXLINE; m=m+l)
             tabs(m) = YES
          }
      }
   if (p==0)
      {
      for (i=9; i<=MAXLINE; i=i+8)
          tabs(i) = YES
      }
   return
   end
#-t-  settab                      799  local   12/22/80  15:32:30
#-h-  tabpos                      215  local   12/22/80  15:32:30
 # 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
#-t-  tabpos                      215  local   12/22/80  15:32:30
#-t-  detab.r                    3378  local   12/22/80  15:32:50
#-t-  detab                      4459  local   12/22/80  15:36:59
#-h-  diff                      27229  local   01/07/81  00:29:50
#-h-  diff.doc                   3386  local   01/07/81  00:29:10
.bp 1
.in 0
.he 'DIFF (1)'3/20/80'DIFF (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
diff - isolate differences between files
.nf
.sp
.ti -3
SYNOPSIS
.br
diff [-{c|d|r|s|v}] <old_file> [<new_file>]
.fi
.sp
.ti -3
DESCRIPTION
.br
'Diff' compares the contents of two files
and reports on the differences between them.
The default behavior is to describe the insert, delete, and change
operations that must be performed on <old_file> to convert its
contents into those of <new_file>.
[Editor's note:  the default output is evidently only useful
at Georgia Tech.  The tool should generally be called by 'diff -s'
to produce an editor script, or 'diff -cv' to produce
output similar to that generated by the tool 'cmp'.]
.sp
The second file name argument is optional.
If omitted, the standard input is read for the text of the <new_file>.
.sp
The options currently available are:
.in +10
.rm -5
.sp
.ti -5
-c   Perform a simple line-by-line comparison.
'Diff' will compare successive lines of the input files;
if any corresponding lines differ,
or if one file is shorter than the other,
'diff' prints the message
"different" and exits.
If the files are the same, 'diff' produces no output.
When the "-v" option (see below) is specified,
'diff' prints the lines that differ along with their line
number in the input file, and notifies the user if
one file is shorter than the other.
.sp
.ti -5
-d   List the "differences" between the two files, by highlighting
the insertions, deletions, and changes that will convert <old_file>
into <new_file>.  This is the default option.
If the "verbose" option "-v" (see below) is specified, unchanged
text will also be listed.
.sp
.ti -5
-r   Insert text formatter requests to mark the <new_file>
with revision bars and deletion asterisks.
This option is particularly useful for maintenance of large documents,
like Software Tools reference manuals.
(At present, only GT's version of 'format' can produce revision bars.)
.sp
.ti -5
-s   Output a "script" of commands for the text editor 'ed' that will
convert <old_file> into <new_file>.
This is handy for preparing updates to large programs or data files,
since generally the volume of changes required will be much smaller
than the new text in its entirety.
.sp
.ti -5
-v   Make output "verbose."
This option applies to the "-c" and "-d" options discussed above.
If not selected, 'diff' produces "concise" output;
if selected, 'diff' produces more verbiage.
.sp
.in -10
.rm +5
'Diff' is based on the algorithm found in
Heckel, P., "A Technique for Isolating Differences Between Files",
.ul
Comm. ACM
21, 4 (April 1978), 264-268.
.sp
Examples:
.sp
.nf
diff myfile1 myfile2
diff rf.r nrf.r | pg
diff -c afile maybe_the_same_file
diff -v rf.r nrf.r | sp
diff -r old_manual.fmt new_manual.fmt | fmt
diff -s old new >>update_old_to_new
.fi
.sp
.ne 2
.ti -3
DIAGNOSTICS
.br
"<file>:  can't open" if either <new_file> or <old_file> is not readable.
.br
"Usage: diff . . ." for illegal options.
.br
.in -3
.fi
.sp
.ne 4
.ti -3
AUTHORS
.br
Allen Akin and friends, Georgia Institute of Technology
.sp
.ne 2
.ti -3
BUGS/DEFICIENCIES
.br
The algorithm used has one quirk: a line or a block of lines which
is not unique within a file will be labeled as an insertion (deletion)
if its immediately adjacent neighbors both above and below are labeled
as insertions (deletions).
.sp
Fails on very large files (> 10000 lines).
#-t-  diff.doc                   3386  local   01/07/81  00:29:10
#-h-  cdiff                      1096  local   12/03/80  16:26:16
   sym_pointer _
      Old_count (MAX_FILE_SIZE),
      New_count (MAX_FILE_SIZE),
      Old_xref (MAX_FILE_SIZE),
      New_xref (MAX_FILE_SIZE),
      Old_lno (MAX_UNIQUE_LINES),
      Bucket (HASH_TABLE_SIZE),
      Sym_store (MAX_UNIQUE_LINES2)
   file_mark _
      Text_loc (2, MAX_UNIQUE_LINES)

   common /c1/ Old_count      # separate common because of size limitations
   common /c2/ New_count      # on some machines...
   common /c3/ Old_xref
   common /c4/ New_xref
   common /c5/ Old_lno
   common /c6/ Bucket
   common /c7/ Sym_store
   common /c8/ Text_loc

   sym_pointer _
      Next_sym,
      Next_inx,
      New_size,
      Old_size
   filedes _
      Old_file,
      New_file,
      Text_file,
      Old_copy,
      New_copy
   integer _
      Option,
      Verbose
   character _
      Text_file_name (FILENAMESIZE),
      Old_copy_name (FILENAMESIZE),
      New_copy_name (FILENAMESIZE)

   common /diffcom/ Next_sym, Next_inx, Old_file, New_file, Text_file,
      New_size, Old_size, Old_copy, New_copy, Option, Verbose,
      Text_file_name, Old_copy_name, New_copy_name
#-t-  cdiff                      1096  local   12/03/80  16:26:16
#-h-  diff.r                    22351  local   12/03/80  16:26:18
#-h-  diff         1238  local  09/23/80  17:53:21
# diff --- isolate differences between two files

define (MAX_UNIQUE_LINES,6000)   # no. of unique lines in all files
define (MAX_UNIQUE_LINES2,arith(MAX_UNIQUE_LINES,*,2))
define (NULL_POINTER,0)
define (HASH_TABLE_SIZE,6073)    # must be prime, as large as possible
define (MAX_FILE_SIZE,6000)      # no. of lines in largest input file

define (sym_pointer,integer)     # large enough to index MAX_UNIQUE_LINES2
define (hash_index,integer)      # large enough to index HASH_TABLE_SIZE
define (file_mark,integer)       # large enough to hold a file position

define (DIFFERENCES,1)           # -d => list differences
define (REVISION,2)              # -r => revision bar requests for 'fmt'
define (SCRIPT,3)                # -s => update script for 'ed'
define (COMPARISON,4)            # -c => simple line-by-line compare

define (ON,)
define (OFF,#)
define (DEBUG,OFF)               # turn debugging output on/off
define (TUNING,OFF)              # turn algorithm tuning output on/off

   DRIVER (diff)

   include cdiff

   call initialize
   if (Option == COMPARISON)
      call simple_compare
   else {
      call load
      call pair
      call grow
      call label
      call report
      call cleanup
      }

   DRETURN
   end
#-t-  diff         1238  local  09/23/80  17:53:21
#-h-  cleanup          380  local  09/23/80  17:53:21
# cleanup --- close input files, remove temporaries, and shut down

   subroutine cleanup

   include cdiff

   call close (Old_file)

   if (New_file ~= STDIN)
      call close (New_file)

   call close (Old_copy)
   call remove (Old_copy_name)

   call close (New_copy)
   call remove (New_copy_name)

   call close (Text_file)
   call remove (Text_file_name)

   return
   end
#-t-  cleanup          380  local  09/23/80  17:53:21
#-h-  enter         1355  local  09/23/80  17:53:22
# enter --- enter a line in the symbol table, return its index

   sym_pointer function enter (line)
   character line (ARB)

   include cdiff

   hash_index h
   hash_index hash

   sym_pointer i, p

   character text (MAXLINE)

   integer junk
   integer equal, getlin

   h = hash (line)
   p = Bucket (h)

   while (p ~= NULL_POINTER) {
      i = Sym_store (p + 1)      # grab index field of entry structure
      call seek (Text_loc (1, i), Text_file)
      junk = getlin (text, Text_file)
      if (equal (line, text) == YES)
         return (i)              # we got it; return its useful index
      p = Sym_store (p)          # try next item in the chain
      DEBUG call remark ("probing in lookup:.")
      DEBUG call remark ("ptr =.")
      DEBUG call putint (p, 0, ERROUT)
      DEBUG call putch (NEWLINE, ERROUT)
      DEBUG call remark ("line =.")
      DEBUG call putlin (line, ERROUT)
      }

   if (Next_inx >= MAX_UNIQUE_LINES)
      call error ("too many unique lines; symbol table overflow.")
   i = Next_inx
   Next_inx = Next_inx + 1
   h = hash (line)
   Sym_store (Next_sym) = Bucket (h)   # link in new entry
   Sym_store (Next_sym + 1) = i
   Bucket (h) = Next_sym
   Next_sym = Next_sym + 2
   call seek (END_OF_FILE, Text_file)
   call note (Text_loc (1, i), Text_file)
   call putlin (line, Text_file)

   return (i)
   end
#-t-  enter         1355  local  09/23/80  17:53:22
#-h-  gen_listing         3526  local  09/23/80  17:53:23
# gen_listing --- generate a full listing of changes to a file

   subroutine gen_listing

   include cdiff

   sym_pointer oi, ni

   integer junk
   integer getlin

   character line (MAXLINE)

   string n_bar "n|"
   string c_i_blank "ci "
   string c_i_five_blanks "ci     "
   string o_bar "o|"
   string c_d "cd"
   string five_blanks_bar "     |"
   string blank_d " d"
   string blank_i_blank " i "
   string blank_i_five_blanks " i     "

   oi = 2
   ni = 2

   repeat

      if (Old_count (oi) == 0 & New_count (ni) == 0) {
         if (Verbose == YES)
            call putch (NEWLINE, STDOUT)
         while (Old_count (oi) == 0 & New_count (ni) == 0) {
            junk = getlin (line, Old_copy)
            if (Verbose == YES) {
               call putint (oi - 1, 7, STDOUT)
               call putint (ni - 1, 5, STDOUT)
               call putlin (line, STDOUT)
               }
            junk = getlin (line, New_copy)
            oi = oi + 1
            ni = ni + 1
            }
         }

      else if (Old_count (oi) ~= 1 & New_count (ni) == 1) {
         call putch (NEWLINE, STDOUT)
         for (; New_count (ni) == 1; ni = ni + 1) {
            junk = getlin (line, New_copy)
            if (Verbose == YES) {
               call putlin (blank_i_five_blanks, STDOUT)
               call putint (ni - 1, 5, STDOUT)
               call putch (BAR, STDOUT)
               }
            else {
               call putlin (blank_i_blank, STDOUT)
               call putint (ni - 1, 4, STDOUT)
               call putlin (n_bar, STDOUT)
               }
            call putlin (line, STDOUT)
            }
         }

      else if (Old_count (oi) == 1 & New_count (ni) ~= 1) {
         call putch (NEWLINE, STDOUT)
         for (; Old_count (oi) == 1; oi = oi + 1) {
            junk = getlin (line, Old_copy)
            if (Verbose == YES) {
               call putlin (blank_d, STDOUT)
               call putint (oi - 1, 5, STDOUT)
               call putlin (five_blanks_bar, STDOUT)
               }
            else {
               call putlin (blank_d, STDOUT)
               call putint (oi - 1, 5, STDOUT)
               call putlin (o_bar, STDOUT)
               }
            call putlin (line, STDOUT)
            }
         }

      else if (Old_count (oi) == 1 & New_count (ni) == 1) {
         call putch (NEWLINE, STDOUT)
         for (; Old_count (oi) == 1; oi = oi + 1) {
            junk = getlin (line, Old_copy)
            if (Verbose == YES) {
               call putlin (c_d, STDOUT)
               call putint (oi - 1, 5, STDOUT)
               call putlin (five_blanks_bar, STDOUT)
               }
            else {
               call putlin (c_d, STDOUT)
               call putint (oi - 1, 5, STDOUT)
               call putlin (o_bar, STDOUT)
               }
            call putlin (line, STDOUT)
            }
         call putch (NEWLINE, STDOUT)
         for (; New_count (ni) == 1; ni = ni + 1) {
            junk = getlin (line, New_copy)
            if (Verbose == YES) {
               call putlin (c_i_five_blanks, STDOUT)
               call putint (ni - 1, 5, STDOUT)
               call putch (BAR, STDOUT)
               }
            else {
               call putlin (c_i_blank, STDOUT)
               call putint (ni - 1, 4, STDOUT)
               call putlin (n_bar, STDOUT)
               }
            call putlin (line, STDOUT)
            }
         }

      else if (Old_count (oi) == 2 & New_count (ni) == 2)
         break

   return
   end
#-t-  gen_listing         3526  local  09/23/80  17:53:23
#-h-  gen_revision         1842  local  09/23/80  17:53:24
# gen_revision --- generate 'fmt' input text with revision bar requests

   subroutine gen_revision

   include cdiff

   sym_pointer oi, ni

   integer junk
   integer getlin

   character line (MAXLINE)

   string start_revision_bar  "[cc]mc |"
   string stop_revision_bar   "[cc]mc"
   string start_deletion_star "[cc]mc *"
   string stop_deletion_star  "[cc]mc"

   oi = 2
   ni = 2

   repeat

      if (Old_count (oi) == 0 & New_count (ni) == 0) {
         oi = oi + 1
         ni = ni + 1
         junk = getlin (line, New_copy)
         call putlin (line, STDOUT)
         }

      else if (Old_count (oi) ~= 1 & New_count (ni) == 1) {
         call putlin (start_revision_bar, STDOUT)
         call putch (NEWLINE, STDOUT)
         for (; New_count (ni) == 1; ni = ni + 1) {
            junk = getlin (line, New_copy)
            call putlin (line, STDOUT)
            }
         call putlin (stop_revision_bar, STDOUT)
         call putch (NEWLINE, STDOUT)
         }

      else if (Old_count (oi) == 1 & New_count (ni) ~= 1) {
         call putlin (start_deletion_star, STDOUT)
         call putch (NEWLINE, STDOUT)
         call putlin (stop_deletion_star, STDOUT)
         call putch (NEWLINE, STDOUT)
         for (; Old_count (oi) == 1; oi = oi + 1)
            ;
         }

      else if (Old_count (oi) == 1 & New_count (ni) == 1) {
         for (; Old_count (oi) == 1; oi = oi + 1)
            ;
         call putlin (start_revision_bar, STDOUT)
         call putch (NEWLINE, STDOUT)
         for (; New_count (ni) == 1; ni = ni + 1) {
            junk = getlin (line, New_copy)
            call putlin (line, STDOUT)
            }
         call putlin (stop_revision_bar, STDOUT)
         call putch (NEWLINE, STDOUT)
         }

      else if (Old_count (oi) == 2 & New_count (ni) == 2)
         break

   return
   end
#-t-  gen_revision         1842  local  09/23/80  17:53:24
#-h-  gen_script         2295  local  09/23/80  17:53:26
# gen_script --- produce editor script to convert old file into new

   subroutine gen_script

   include cdiff

   sym_pointer oi, ni, offset, length

   integer junk
   integer getlin

   character line (MAXLINE)

   oi = 2
   ni = 2
   offset = 0

   repeat

      if (Old_count (oi) == 0 & New_count (ni) == 0) {
         oi = oi + 1
         ni = ni + 1
         junk = getlin (line, New_copy)
         }

      else if (Old_count (oi) ~= 1 & New_count (ni) == 1) {
         call putint (oi - 2 + offset, 0, STDOUT)
         call putch (LETA, STDOUT)
         call putch (NEWLINE, STDOUT)
         length = 0
         for (; New_count (ni) == 1; ni = ni + 1) {
            length = length + 1
            junk = getlin (line, New_copy)
            call putlin (line, STDOUT)
            }
         call putch (PERIOD, STDOUT)
         call putch (NEWLINE, STDOUT)
         offset = offset + length
         }

      else if (Old_count (oi) == 1 & New_count (ni) ~= 1) {
         length = 0
         for (; Old_count (oi) == 1; oi = oi + 1)
            length = length + 1
         call putint (oi - 1 - length + offset, 0, STDOUT)
         call putch (COMMA, STDOUT)
         call putint (oi - 2 + offset, STDOUT)
         call putch (LETD, STDOUT)
         call putch (NEWLINE, STDOUT)
         offset = offset - length
         }

      else if (Old_count (oi) == 1 & New_count (ni) == 1) {
         length = 0
         for (; Old_count (oi) == 1; oi = oi + 1)
            length = length + 1
         call putint (oi - 1 - length + offset, 0, STDOUT)
         call putch (COMMA, STDOUT)
         call putint (oi - 2 + offset, 0, STDOUT)
         call putch (LETC, STDOUT)
         call putch (NEWLINE, STDOUT)
         offset = offset - length
         length = 0
         for (; New_count (ni) == 1; ni = ni + 1) {
            length = length + 1
            junk = getlin (line, New_copy)
            call putlin (line, STDOUT)
            }
         call putch (PERIOD, STDOUT)
         call putch (NEWLINE, STDOUT)
         offset = offset + length
         }

      else if (Old_count (oi) == 2 & New_count (ni) == 2)
         break

   call putch (LETW, STDOUT)
   call putch (NEWLINE, STDOUT)
   # DON'T output a 'q' command -- prevents concatentation of scripts
   return
   end
#-t-  gen_script         2295  local  09/23/80  17:53:26
#-h-  grow          751  local  09/23/80  17:53:28
# grow --- grow unchanged blocks around unique line pairs

   subroutine grow

   include cdiff

   sym_pointer i, nx

   for (i = 1; i < New_size; i = i + 1) {
      nx = New_xref (i)
      if (nx > 0)       # is this line paired with an old line?
         if (New_xref (i + 1) < 0
          & New_xref (i + 1) == Old_xref (nx + 1)) {
            Old_xref (nx + 1) = i + 1
            New_xref (i + 1) = nx + 1
            }
      }

   for (i = New_size; i > 1; i = i - 1) {
      nx = New_xref (i)
      if (nx > 0)       # is this line paired?
         if (New_xref (i - 1) < 0
          & New_xref (i - 1) == Old_xref (nx - 1)) {
            Old_xref (nx - 1) = i - 1
            New_xref (i - 1) = nx - 1
            }
      }

   return
   end
#-t-  grow          751  local  09/23/80  17:53:28
#-h-  hash          267  local  09/23/80  17:53:28
# hash --- hash a line into a hash_index

   hash_index function hash (line)
   character line (ARB)

   integer i

   hash = 0
   for (i = 1; line (i) ~= EOS; i = i + 1)
      hash = hash + line (i)
   hash = mod (iabs (hash), HASH_TABLE_SIZE) + 1

   return
   end
#-t-  hash          267  local  09/23/80  17:53:28
#-h-  initialize         2173  local  09/23/80  17:53:29
# initialize --- set up everything needed for a file comparison

   subroutine initialize

   include cdiff

   filedes open, create

   integer argno, i
   integer equal, getarg

   character arg (FILENAMESIZE)

   string tf1 "df1"      # text of unique lines
   string tf2 "df2"      # copy of "old" file
   string tf3 "df3"      # copy of "new" file
 
   call query ("usage:  diff [-{c|d|r|s|v}] old_file [new_file].")

   Option = DIFFERENCES    # the default
   Verbose = NO

   argno = 1      # where we expect to find file names
   if (getarg (1, arg, FILENAMESIZE) ~= EOF)
   if (arg (1) == MINUS) {
      call lower (arg)
      for (i = 2; arg (i) ~= EOS; i = i + 1)
         if (arg (i) == LETC)
            Option = COMPARISON
         else if (arg (i) == LETD)
            Option = DIFFERENCES
         else if (arg (i) == LETR)
            Option = REVISION
         else if (arg (i) == LETS)
            Option = SCRIPT
         else if (arg (i) == LETV)
            Verbose = YES
         else
            call usage
      argno = 2
      }

   if (getarg (argno, arg, FILENAMESIZE) == EOF) {   # no files, use STDIN
      # Old_file = STDIN1
      # New_file = STDIN2
      call usage     # GT implementation has multiple standard ports...
      }
   else {
      Old_file = open (arg, READ)
      if (Old_file == ERR)
         call cant (arg)
      argno = argno + 1
      if (getarg (argno, arg, FILENAMESIZE) == EOF)
         New_file = STDIN     # STDIN1, to be precise
      else {
         New_file = open (arg, READ)
         if (New_file == ERR)
            call cant (arg)
         argno = argno + 1
         }
      }

   if (getarg (argno, arg, FILENAMESIZE) ~= EOF)
      call usage

   Next_inx = 1
   Next_sym = 1
   call mkuniq (tf1, Text_file_name)
   Text_file = create (Text_file_name, READWRITE)
   if (Text_file == ERR)
      call error ("can't open temporary file.")

   call mkuniq (tf2, Old_copy_name)
   Old_copy = create (Old_copy_name, READWRITE)
   if (Old_copy == ERR)
      call error ("can't open temporary file.")

   call mkuniq (tf3, New_copy_name)
   New_copy = create (New_copy_name, READWRITE)
   if (New_copy == ERR)
      call error ("can't open temporary file.")

   return
   end
#-t-  initialize         2173  local  09/23/80  17:53:29
#-h-  label         1884  local  09/23/80  17:53:30
# label --- label lines as "inserted," "deleted," or "unchanged"

   subroutine label

   include cdiff

   sym_pointer oi, ni, ox, nx

DEBUG call remark ("input new xref:.")
DEBUG do ni = 1, New_size; {
DEBUG    call putch (BLANK, ERROUT)
DEBUG    call putint (New_xref (ni), 0, ERROUT)
DEBUG    }
DEBUG call putch (NEWLINE, ERROUT)
DEBUG call remark ("input old xref:.")
DEBUG do oi = 1, Old_size; {
DEBUG    call putch (BLANK, ERROUT)
DEBUG    call putint (Old_xref (oi), 0, ERROUT)
DEBUG    }
DEBUG call putch (NEWLINE, ERROUT)

   oi = 2
   ni = 2

   repeat {

      ox = Old_xref (oi)
      nx = New_xref (ni)

      if (oi >= Old_size & ni >= New_size)
         break

      else if (oi < Old_size & ox < 0) { # deletion from old file
         Old_count (oi) = 1
         oi = oi + 1
         }

      else if (ni < New_size & nx < 0) { # insertion in new file
         New_count (ni) = 1
         ni = ni + 1
         }

      else if (ox == ni & nx == oi) {    # unchanged line
         Old_count (oi) = 0
         oi = oi + 1
         New_count (ni) = 0
         ni = ni + 1
         }

      else if (oi <= Old_size & ni <= New_size) {  # out-of-order block
         New_count (ni) = 1
         ni = ni + 1
         Old_count (nx) = 1
         Old_count (oi) = 1
         oi = oi + 1
         New_count (ox) = 1
         }

      else {
         call remark ("oi, ox, ni, nx:.")
         call putint (oi, 10, ERROUT)
         call putint (ox, 10, ERROUT)
         call putint (ni, 10, ERROUT)
         call putint (nx, 10, ERROUT)
         call putch (NEWLINE, ERROUT)
         call error ("in label:  can't happen.")
         }

      }

   Old_count (1) = 2             # mark the null lines specially,
   Old_count (Old_size) = 2      #    so people won't have to deal
   New_count (1) = 2             #    with file sizes
   New_count (New_size) = 2

   return
   end
#-t-  label         1884  local  09/23/80  17:53:30
#-h-  load         2085  local  09/23/80  17:53:31
# load --- load symbol table, set up cross-reference structures

   subroutine load

   include cdiff

   sym_pointer lno, i
   sym_pointer enter

   hash_index h

   character line (MAXLINE)

   integer getlin, length

TUNING sym_pointer p
TUNING integer used, chain_len, max_chain_len, min_chain_len

   do h = 1, HASH_TABLE_SIZE
      Bucket (h) = NULL_POINTER

   do lno = 1, MAX_UNIQUE_LINES; {
      Old_count (lno) = 0
      New_count (lno) = 0
      }

  # Load the "old" file:
   for (lno = 2; getlin (line, Old_file) ~= EOF; lno = lno + 1) {
      if (lno > MAX_FILE_SIZE)
         call error ("old file too large to handle.")
      call putlin (line, Old_copy)
      i = enter (line)
      Old_count (i) = Old_count (i) + 1
      Old_lno (i) = lno
      Old_xref (lno) = -i
      }
   Old_size = lno    # includes null line at end

  # Load the "new" file:
   for (lno = 2; getlin (line, New_file) ~= EOF; lno = lno + 1) {
      if (lno > MAX_FILE_SIZE)
         call error ("new file too large to handle.")
      call putlin (line, New_copy)
      i = enter (line)
      New_count (i) = New_count (i) + 1
      New_xref (lno) = -i
      }
   New_size = lno    # also allows for null line at end

TUNING call print (STDOUT2, "Old_size = *i, New_size = *i*n"s,
TUNING    Old_size, New_size)
TUNING call print (STDOUT2, "*i unique lines*n"s, Next_inx - 1)
TUNING used = 0
TUNING max_chain_len = 0
TUNING min_chain_len = MAX_UNIQUE_LINES
TUNING do h = 1, HASH_TABLE_SIZE; {
TUNING    p = Bucket (h)
TUNING    if (p ~= NULL_POINTER)
TUNING       used += 1
TUNING    chain_len = 0
TUNING    while (p ~= NULL_POINTER) {
TUNING       chain_len += 1
TUNING       p = Sym_store (p)
TUNING       }
TUNING    max_chain_len = max0 (chain_len, max_chain_len)
TUNING    min_chain_len = min0 (chain_len, min_chain_len)
TUNING    }
TUNING call print (STDOUT2, "chain lengths:  min = *i, avg = *i, max = *i*n"s,
TUNING    min_chain_len, (Next_inx - 1) / used, max_chain_len)
TUNING call print (STDOUT2, "hash buckets *i% full*n"s,
TUNING    (100 * used) / HASH_TABLE_SIZE)

   return
   end
#-t-  load         2085  local  09/23/80  17:53:31
#-h-  pair          536  local  09/23/80  17:53:32
# pair --- pair up unique lines in both files

   subroutine pair

   include cdiff

   sym_pointer i, j, k

   for (i = 2; i < New_size; i = i + 1) {
      j = -New_xref (i)
      if (Old_count (j) == 1 & New_count (j) == 1) { # unique pair
         New_xref (i) = Old_lno (j)
         k = Old_lno (j)
         Old_xref (k) = i
         }
      }

   New_xref (1) = 1                 # match null lines at BOF
   Old_xref (1) = 1
   New_xref (New_size) = Old_size   # ... and at EOF
   Old_xref (Old_size) = New_size

   return
   end
#-t-  pair          536  local  09/23/80  17:53:32
#-h-  report          723  local  09/23/80  17:53:33
# report --- report differences between files in desired format

   subroutine report

   include cdiff

DEBUG sym_pointer i

DEBUG call print (ERROUT, "New mark: "s)
DEBUG do i = 1, New_size
DEBUG    call print (ERROUT, "  *i"s, New_count (i))
DEBUG call print (ERROUT, "*nOld mark: "s)
DEBUG do i = 1, Old_size
DEBUG    call print (ERROUT, "  *i"s, Old_count (i))
DEBUG call putch (NEWLINE, ERROUT)

   call seek (BEGINNING_OF_FILE, Old_copy)
   call seek (BEGINNING_OF_FILE, New_copy)

   if (Option == DIFFERENCES)
      call gen_listing
   else if (Option == REVISION)
      call gen_revision
   else if (Option == SCRIPT)
      call gen_script
   else
      call error ("in report:  can't happen.")

   return
   end
#-t-  report          723  local  09/23/80  17:53:33
#-h-  simple_compare         1474  local  09/23/80  17:53:33
# simple_compare --- do a line-by-line comparison of the input files

   subroutine simple_compare

   include cdiff

   character line1 (MAXLINE), line2 (MAXLINE)

   integer lineno, m1, m2
   integer equal, getlin

   string different "different"
   string eof_on_old_file "eof on old file"
   string eof_on_new_file "eof on new file"

   lineno = 0
   repeat {
      m1 = getlin (line1, Old_file)
      m2 = getlin (line2, New_file)
      if (m1 == EOF | m2 == EOF)
         break
      lineno = lineno + 1
      if (equal (line1, line2) == NO)
         if (Verbose == YES) {
            call putch (NEWLINE, STDOUT)
            call putint (lineno, 5, STDOUT)
            call putch (NEWLINE, STDOUT)
            call putlin (line1, STDOUT)
            call putlin (line2, STDOUT)
            }
         else {
            call putlin (different, STDOUT)
            call putch (NEWLINE, STDOUT)
            return
            }
      }

   if (m1 == EOF & m2 ~= EOF)
      if (Verbose == YES) {
         call putlin (eof_on_old_file, STDOUT)
         call putch (NEWLINE, STDOUT)
         }
      else {
         call putlin (different, STDOUT)
         call putch (NEWLINE, STDOUT)
         }
   if (m1 ~= EOF & m2 == EOF)
      if (Verbose == YES) {
         call putlin (eof_on_new_file, STDOUT)
         call putch (NEWLINE, STDOUT)
         }
      else {
         call putlin (different, STDOUT)
         call putch (NEWLINE, STDOUT)
         }

   return
   end
#-t-  simple_compare         1474  local  09/23/80  17:53:33
#-h-  usage          139  local  09/23/80  17:53:34
# usage --- print usage message, then die

   subroutine usage

   call error ("usage:  diff [-{c|d|r|s|v}] old_file [new_file].")

   end
#-t-  usage          139  local  09/23/80  17:53:34
#-t-  diff.r                    22351  local   12/03/80  16:26:18
#-t-  diff                      27229  local   01/07/81  00:29:50
#-h-  entab                      5075  local   12/22/80  15:57:35
#-h-  entab.doc                   874  local   12/22/80  15:54:42
.bp 1
.in 0
.he 'ENTAB (1)'8-20-79'ENTAB (1)'
.fo ''-#-'
.fi
NAME
.br
.in 7
entab - convert spaces to tabs and spaces
.sp 1
.in
SYNOPSIS
.br
.in 7
entab [<t1> ...] [+<n>] [file ...]
.sp 1
.in
DESCRIPTION
.br
.in 7
Entab replaces strings of blanks with equivalent tabs (control-i)
and blanks.
It can be used to read files and produce typewriter-like
text, reducing file size.
Tab stops are indicated by <t1> ... (default 8, 16, ...),
while +<n> indicates tab stops every <n> columns.
Thus the command

.ti +3
entab 5 21 +5

would insert tab stops at columns 5, 21, 26, etc.
If no files are specified, the standard input is read.
An isolated minus sign also indicates the standard input.
.sp 1
.in
SEE ALSO
.br
.in 7
detab
.sp 1
.in
AUTHORS
.br
.in 7
.sp 1
Original from Kernighan & Plauger's 'Software Tools', with modifications
by Dennis Hall (Lawrence Berkeley Laboratory)
#-t-  entab.doc                   874  local   12/22/80  15:54:42
#-h-  entab.r                    3937  local   12/22/80  15:54:42
#-h-  entab                      1015  local   12/22/80  15:54:23
 ## entab - replace blanks by tabs and blanks
 DRIVER(entab)
 character getch
 integer nxtfil
 character c
 integer tabpos, int, argct
 integer col, i, newcol, tabs(MAXLINE)

 call query ("usage:  entab [<t1> <t2> etc] [+<n>] [files].")
 call settab(tabs)
 col = 1
 argct = 1
 while (nxtfil(argct,int) != EOF)
    {
    repeat
        {
        newcol = col
        while (getch(c,int) == BLANK)
                {
                newcol = newcol + 1
                if(tabpos(newcol,tabs) == YES)
                        {
                        call putc(TAB)
                        col = newcol
                        }
                }
        for (;col < newcol; col = col + 1)
                call putc(BLANK)
        if(c == EOF)
                {
                if (int != STDIN)
                        call close(int)
                break
                }
        call putc(c)
        if(c == NEWLINE)
                col = 1
        else
                col = col + 1
        }
    }
 DRETURN
 end
#-t-  entab                      1015  local   12/22/80  15:54:23
#-h-  alldig                      281  local   12/22/80  15:54:23
 ## alldig - return YES if str is all digits
 integer function alldig (str)

 integer type, i
 character str(ARB)

 alldig = NO
 if (str(1) == EOS)
        return
 for (i=1; str(i) != EOS; i=i+1)
        if (type(str(i)) != DIGIT)
                return
 alldig = YES
 return
 end
#-t-  alldig                      281  local   12/22/80  15:54:23
#-h-  nxtfil                      967  local   12/22/80  15:54:23
 ## nxtfil - get next file from argument list
 integer function nxtfil(argct,int)
 integer getarg, open, alldig
 integer argct, int
 integer flag                   #own
 character abuf(FILENAMESIZE)
 data flag /0/                  # flag for one time through


 int = STDIN
 for ( ; ; argct = argct + 1)
        {
        nxtfil = getarg(argct,abuf,FILENAMESIZE)
        if (nxtfil == EOF)
                break
        if (abuf(1) == PLUS | alldig(abuf) == YES)
                next
        flag = flag + 1
        if (abuf(1) == MINUS & abuf(2) == EOS)
                {
                int = STDIN
                break
                }
        else
                {
                int = open(abuf,READ)
                if (int != ERR)
                        break
                else
                        call cant(abuf)
                }
        }
 if (flag == 0)
        {
        flag = 1
        nxtfil = EOS
        }
 argct = argct + 1
 return
 end
#-t-  nxtfil                      967  local   12/22/80  15:54:23
#-h-  settab                      799  local   12/22/80  15:54:23
 # settab - set initial tab stops
    subroutine settab(tabs)
    integer alldig
    integer tabs(MAXLINE), m, p, k, i, j, l
    integer getarg, ctoi
    character n(4)

   p = 0
   for (i=1; i<=MAXLINE; i=i+1)
       tabs(i) = NO
   for (j=1; getarg(j,n,4)!=EOF; j=j+1)
       {
       k=1
       if (n(1) == PLUS)
          k = k + 1
       if (alldig(n(k)) == NO)
                next
       l = ctoi(n,k)
       if (l<=0 | l>MAXLINE)
          next
       if (n(1)!=PLUS)
          {
          p = l
          tabs(p) = YES
          }
       else
          {
          if (p==0)
             p = l  + 1
          for (m=p; m<=MAXLINE; m=m+l)
             tabs(m) = YES
          }
      }
   if (p==0)
      {
      for (i=9; i<=MAXLINE; i=i+8)
          tabs(i) = YES
      }
   return
   end
#-t-  settab                      799  local   12/22/80  15:54:23
#-h-  tabpos                      215  local   12/22/80  15:54:24
 # 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
#-t-  tabpos                      215  local   12/22/80  15:54:24
#-t-  entab.r                    3937  local   12/22/80  15:54:42
#-t-  entab                      5075  local   12/22/80  15:57:35
#-h-  expand                     2769  local   12/15/80  13:18:32
#-h-  expand.doc                  700  local   12/15/80  13:15:10
.bp 1
.in 0
.he 'EXPAND (1)'1.15.79'EXPAND (1)'
.fo ''-#-'
.fi
NAME
.br
.in 7
expand - uncompress input files
.sp 1
.in
SYNOPSIS
.br
.in 7
.bd
expand
[file ...]
.sp 1
.in
DESCRIPTION
.br
.in 7
.bd
Expand
expands files previously compressed by 'cpress'.
If no input files are given, or if the filename '-' appears,
input will be read from the standard input.
.sp 1
.in
FILES
.br
.in 7
.sp 1
.in
SEE ALSO
.br
.in 7
cpress
.sp 1
.in
DIAGNOSTICS
.br
.in 7
A message is printed if an input file cannot be opened; further
processing is terminated.
.sp 1
.in
AUTHORS
.br
.in 7
.sp 1
Original from Kernighan & Plauger's 'Software Tools', with minor
modifications by Debbie Scherrer.
.sp 1
.in
BUGS
.br
.in 7
#-t-  expand.doc                  700  local   12/15/80  13:15:10
#-h-  expand.r                   1805  local   12/15/80  13:15:11
#-h-  expand                      752  local   12/15/80  13:09:13
 ## expand - uncompress input files

 # ratdef  for compress and expand tools
 #must have RCODE > MAXCHUNK or RCODE = 0
 define(MAXCHUNK,124)
 define(RCODE,125)
 define(THRESH,4)
 #        include ratdef
 DRIVER(expand)

 character buf(MAXLINE)
 integer getarg, open
 integer i

 call query ("usage:  expand [files].")
 for (i=1; getarg(i, buf, MAXLINE) != EOF; i=i+1)
        {
        if (buf(1) == MINUS & buf(2) == EOS)
                int = STDIN
        else
                {
                int = open(buf,READ)
                if (int == ERR)
                        call cant(buf)
                }
        call xpd (int)
        if (int != STDIN)
                call close(int)
        }

 if (i == 1)
        call xpd(STDIN)
 DRETURN
 end
#-t-  expand                      752  local   12/15/80  13:09:13
#-h-  xpd                         789  local   12/15/80  13:09:13
 ## xpd - uncompress file -int-
 subroutine xpd (int)

 character getch
 character c, code

 while(getch(code,int) != EOF)
        if (code == RCODE)      #expand repetition
                {
                if (getch(c,int) == EOF)
                        break
                if (getch(code,int) == EOF)
                        break
                for (; code >0; code = code - 1)
                        call putc(c)
                }
        else
                {
                for (; code > 0; code = code - 1)
                        {
                        if (getch(c,int) == EOF)
                                break
                        call putc(c)
                        }
                if (c == EOF)
                        break
                }
 return
 end
#-t-  xpd                         789  local   12/15/80  13:09:13
#-t-  expand.r                   1805  local   12/15/80  13:15:11
#-t-  expand                     2769  local   12/15/80  13:18:32
#-h-  fb                        17055  local   12/22/80  16:11:53
#-h-  fb.doc                     2956  local   12/22/80  16:05:08
.bp 1
.in 0
.he 'FB (1)'5/28/80'FB (1)'
.fo ''-#-''
.fi
.in 7
.ti -7
NAME
.br
fb - search blocks of lines for text patterns
.sp 1
.ti -7
SYNOPSIS
.br
.bd
fb
[-acx] [-ln] [-sexpr [-sexpr]] expr [expr ...]
.sp 1
.ti -7
DESCRIPTION
.br
"Fb"
(find block) searches blocks or groups of lines in a file for
text patterns.
It is similar to 'find' except that if a pattern is found,
the entire block of lines is copied to standard output,
rather than simply the line in which the pattern occurred.
Thus it is useful for searching mailing lists, bibliographies,
and similar files where several lines are grouped together to
form cohesive units.

The search patterns may be any regular expression as described
in the 'ed' and 'find' writeups.

"Fb"
assumes the blocks of lines are separated by an empty line or a
line containing only blanks.
When "fb" is called without any options, standard input is read
and each line is checked to see if it matches any of the regular
expressions given as arguments.
If any matches are found,
the entire block is printed on standard output.

Other options include:

.in +10
.ti -8
-a      Only print the block if ALL the arguments are found within it

.ti -8
-x      Only print the block if none of the arguments are
found within it

.ti -8
-c      Only print a COUNT of the number of blocks found which
match/don't match the expressions

.ti -8
-sexpr  Use 'expr' as the block separator (instead of a blank or
empty line).  "Expr" can be a regular expression just as
the search arguments can.

If two "-sexpr" arguments are given, the first one is considered
to be the pattern which starts a block (e.g. -ssubroutine) and
the second is considered the pattern which ends a block
(e.g. -send).

.ti -8
-ln     prints only the first 'n' lines of the block;
if the block contains less than 'n' lines, the block is padded
out with blank lines.
.in -10

.fi
Care should be taken when using the characters % $ [ ] ! * @ and
any shell characters
in the text pattern. It is often necessary to enclose the
entire substitution pattern in quotes.
.sp 1
.ti -7
FILES
.br
A scratch file ("fbt") is used if the internal line buffer
becomes full.
.sp 1
.ti -7
SEE ALSO
.br
find, ed
.br
For a complete description of regular expressions, see
"Software Tools" pages 135-154.
.sp 1
.ti -7
DIAGNOSTICS
.br
Error messages are given if:
.br
.in +3
a)  One of the patterns given is illegal
.br
b)  Too many separators are given (2 are allowed)
.br
c)  The maximum number of expressions is exceeded (9 are allowed)
.br
d)  There are problems opening the scratch file (when the block line
buffer fills up).

.in -3
If the following messages show up, something is dreadfully wrong:
.in +3
a)  "Illegal default separator"
.br
b)  "Block buffer overflow"
.in -3
.sp 1
.ti -7
AUTHORS
.br
Debbie Scherrer (Lawrence Berkeley Laboratory)
.sp 1
.ti -7
BUGS
.br
An expression may not start with a minus sign (-).

Regular expressions can not span line boundaries.
#-t-  fb.doc                     2956  local   12/22/80  16:05:08
#-h-  fbcom                      1236  local   12/22/80  16:05:09
 ## /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
#-t-  fbcom                      1236  local   12/22/80  16:05:09
#-h-  fbbuf                       320  local   12/22/80  16:05:09
 ## 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
#-t-  fbbuf                       320  local   12/22/80  16:05:09
#-h-  fb.r                      12015  local   12/22/80  16:05:09
#-h-  fb                          873  local   12/22/80  16:00:56
 ## fb - find block of lines

 #        include ratdef

 #note--the following 3 symbols should be defined the same as
 #      those in the pattern-matching library routines
 define(BOL,PERCENT)            #beginning of line
 define(CLOSURE,STAR)           #flag for closure
 define(EOL,DOLLAR)             #end of line

 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(NEXPR,10)               #nbr expressions allowed on cmd line

 DRIVER(fb)

 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)
        }

 DRETURN
 end
#-t-  fb                          873  local   12/22/80  16:00:56
#-h-  bmatch                      289  local   12/22/80  16:00:56
 ## 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
#-t-  bmatch                      289  local   12/22/80  16:00:56
#-h-  checkl                      253  local   12/22/80  16:00:56
 ## 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
#-t-  checkl                      253  local   12/22/80  16:00:56
#-h-  dobeg                       386  local   12/22/80  16:00:56
## 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
#-t-  dobeg                       386  local   12/22/80  16:00:56
#-h-  dobk                       1002  local   12/22/80  16:00:57
 ## 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
#-t-  dobk                       1002  local   12/22/80  16:00:57
#-h-  doend                      1061  local   12/22/80  16:00:57
 ## 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
#-t-  doend                      1061  local   12/22/80  16:00:57
#-h-  dolin                       789  local   12/22/80  16:00:57
 ## 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
#-t-  dolin                       789  local   12/22/80  16:00:57
#-h-  fbargs                     2397  local   12/22/80  16:00:58
 ## 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/

 call query ('usage:  fb [-axc] [-ln] [-spat] [-spat] pat [pats].')

                #loop thru args, picking up flags and patterns
 for (i=1; getarg(i, arg, MAXARG) != EOF; i=i+1)
    {
    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
#-t-  fbargs                     2397  local   12/22/80  16:00:58
#-h-  fberr                       148  local   12/22/80  16:01:14
 ## fberr - report error in calling 'fb' tool
 subroutine fberr

 call error ('usage:  fb [-axc] [-ln] [-spat] [-spat] pat [pat ...]')
 return
 end
#-t-  fberr                       148  local   12/22/80  16:01:14
#-h-  initbk                      277  local   12/22/80  16:01:14
 ## 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
#-t-  initbk                      277  local   12/22/80  16:01:14
#-h-  outlin                      213  local   12/22/80  16:01:14
 ## 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
#-t-  outlin                      213  local   12/22/80  16:01:14
#-h-  printb                      760  local   12/22/80  16:01:15
 ## 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
#-t-  printb                      760  local   12/22/80  16:01:15
#-h-  stackl                     1064  local   12/22/80  16:01:15
 ## 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
#-t-  stackl                     1064  local   12/22/80  16:01:15
#-h-  tally                       655  local   12/22/80  16:01:16
 ## 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
#-t-  tally                       655  local   12/22/80  16:01:16
#-t-  fb.r                      12015  local   12/22/80  16:05:09
#-t-  fb                        17055  local   12/22/80  16:11:53
#-h-  field                      7633  local   12/22/80  16:23:16
#-h-  field.doc                  2209  local   12/22/80  16:16:35
.bp 1
.in 0
.he 'FIELD (1)'7/10/80'FIELD (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
field - manipulate fields of data
.nf
.sp
.ti -3
SYNOPSIS
.br
field [-t[c] | fieldlist] outputformat [file ...]
.fi
.sp
.ti -3
DESCRIPTION
.br
.fi
Field
is used to manipulate data kept in formatted fields.
It selects data from certain fields of the input files
and copies it to certain places in the standard output.

The 'fieldlist' parameter is used to describe the interesting
columns on the input file.
Fields are specified by naming the columns in which they
occur (e.g. 5-10) or the columns in which they start and
an indication of their length (e.g. 3+2, meaning a field
which starts in column 3 and spans 2 columns).
When specifying more than one field, separate the specs
with commas (e.g. 5-10,16,72+8)
Fields may overlap, and need not be in ascending numerical order
(e.g. 1-25,10,3 is OK).

If input fields do not fall in certain columns, but rather are
separated by some character (such as a blank or a comma),
describe the fields by using the '-tc' flag, replacing 'c'
with the appropriate
separator (a tab character is the default).

Once fields have been described with either the '-tc' flag
or a fieldlist, they can be arranged on output by
the 'outputformat' argument.
This argument is actually a picture of what the output line
should look like.
Fields from input are referred to as $1, $2, $3, etc., referring
to the first, second, third, etc. fields that were specified.
(Up to 9 fields are allowed, plus the argument $0 which
refers to the whole line.)
These $n symbols are placed in the output format wherever
that field should appear, surrounded by whatever characters
desired.
For example, an outputformat of:
.ce
           "$2 somewords $1"
would produce an output line such as:
.ce
            field2 somewords field1

If no input files are specified, or if the filename '-' is
found, field will read from the standard input.
.sp
.ti -3
DIAGNOSTICS
.br
illegal field specification
.in +5
The fieldlist specification was in error, probably because
it contained letters or some other
illegal characters
.in -5
.sp
.ti -3
SEE ALSO
.br
sedit
.sp
.ti -3
AUTHORS
.br
David Hanson and friends (U. of Arizona)
#-t-  field.doc                  2209  local   12/22/80  16:16:35
#-h-  field.r                    5160  local   12/22/80  16:16:35
#-h-  field                      2138  local   12/22/80  16:15:56
# field - rearrange fields in a file

 # include ratdef
define(MAXFIELDS,10)
define(ARGFLAG,-1)       # or define(ARGFLAG,255)

 DRIVER(field)
   character buf(MAXLINE), tabc
   integer from(MAXFIELDS), to(MAXFIELDS)
   character ofmt(MAXLINE)
   integer i, j, k, n, nflds, len, fd, tflag, files
   integer getarg, getlin, open, doflds, getfmt
   data tabc /TAB/, tflag /YES/, nflds /MAXFIELDS/

   call query("usage: field [-t[c] | fieldslist] outputformat [files].")
   i = 1        # assume no field specification is given
   if (getarg(1, buf, MAXLINE) == EOF)
      call usage
   if (buf(1) == MINUS & buf(2) == LETT) {  # tab fields are specified
      if (buf(3) ^= EOS)
         tabc = buf(3)
      i = 2
      }
   else if (buf(1) >= DIG0 & buf(1) <= DIG9) {  # fields are specified
      nflds = doflds(buf, from, to, MAXFIELDS)
      if (nflds == ERR)
                call error ("illegal field specification.")
      tflag = NO
      i = 2
      }
   if (getarg(i, buf, MAXLINE) == EOF)
      call usage                #error, no output format specified
   junk = getfmt(buf, ofmt)
   files = NO
   for (i=i+1; ; i=i+1)
      {
      if (getarg(i, buf, MAXLINE) == EOF)     #done?
          {
          if (files == YES)             #yes, done
               break
          fd = STDIN              #not done, read from STDIN
          }
      else if (buf(1) == MINUS & buf(2) == EOS)
         fd = STDIN
      else
         fd = open(buf, READ)
      files = YES
      if (fd == ERR)
         call cant(buf)
      len = getlin(buf, fd)
      while (len ^= EOF) {
         if (tflag == YES)
            call dotabs(buf, tabc, from, to, nflds)
         for (j = 1; ofmt(j) ^= EOS; j = j + 1)
            if (ofmt(j) == ARGFLAG) {
               n = ofmt(j+1)
               for (k = from(n); k <= to(n) & k < len; k = k + 1)
                   call putch(buf(k), STDOUT)
               j = j + 1
               }
            else
               call putch(ofmt(j), STDOUT)
         call putch(NEWLINE, STDOUT)
         len = getlin(buf, fd)
         }
      if (fd ^= STDIN)
         call close(fd)
      }
    DRETURN
   end
#-t-  field                      2138  local   12/22/80  16:15:56
#-h-  doflds                     1025  local   12/22/80  16:15:56
# doflds - get field specifications from buf into from and to
   integer function doflds(buf, from, to, maxsiz)
   character buf(ARB)
   integer from(ARB), to(ARB), maxsiz
   integer i, n
   integer ctoi

   n = 1
   from(1) = 1
   to(1) = HUGE
   for (i = 1; buf(i) ^= EOS; ) {
      n = n + 1
      if (n > maxsiz)
         return(ERR)
      from(n) = ctoi(buf, i)
      to(n) = from(n)
      call skipbl(buf, i)
      if (buf(i) == MINUS) {            # form is n-m
         i = i + 1
         to(n) = ctoi(buf, i)
         call skipbl(buf, i)
         }
      else if (buf(i) == PLUS) {        # form is n+m
         i = i + 1
         to(n) = from(n) + ctoi(buf, i) - 1
         call skipbl(buf, i)
         }
      if (from(n) < 1 |
          from(n) > to(n) |
         (buf(i) ^= COMMA & buf(i) ^= EOS))
           return(ERR)
      if (buf(i) == COMMA)
         i = i + 1
      }
   for (i = n + 1; i <= maxsiz; i = i + 1) {    # clear other fields
      from(i) = HUGE
      to(i) = HUGE
      }
   return(n)
   end
#-t-  doflds                     1025  local   12/22/80  16:15:56
#-h-  dotabs                      642  local   12/22/80  16:15:56
# dotabs - break buf into fields defined by tab character c
   subroutine dotabs(buf, c, from, to, maxsiz)
   character buf(ARB), c
   integer from(ARB), to(ARB), maxsiz
   integer i, j, n

   n = 1
   from(n) = 1
   to(n) = HUGE
   j = 1
   for (i = 1; buf(i) ^= EOS & n < maxsiz; i = i + 1)
      if (buf(i) == c) {
         n = n + 1
         from(n) = j
         to(n) = i - 1
         j = i + 1
         }
      if (n < maxsiz)
        {
        n = n + 1
        from(n) = j
        to(n) = HUGE
        }
   for ( ; n < maxsiz; n = n + 1) {     # clear other fields
      from(n+1) = HUGE
      to(n+1) = HUGE
      }
   return
   end
#-t-  dotabs                      642  local   12/22/80  16:15:56
#-h-  getfmt                      552  local   12/22/80  16:15:57
# getfmt - convert output format in buf to internal form in fmt
   subroutine getfmt(buf, fmt)
   character buf(ARB)
   character fmt(ARB)
   integer i, j
   character esc
   integer addset

   j = 1
   for (i = 1; buf(i) ^= EOS; i = i + 1)
      {
      if (buf(i) == DOLLAR & buf(i+1) >= DIG0 & buf(i+1) <= DIG9) {
        junk = addset(ARGFLAG, fmt, j, MAXLINE)
        junk = addset(buf(i+1) - DIG0 + 1, fmt, j, MAXLINE)
         i = i + 1
         }
      else
        junk = addset(esc(buf,i), fmt, j, MAXLINE)
      }
 fmt(j) = EOS
 return
 end
#-t-  getfmt                      552  local   12/22/80  16:15:57
#-h-  usage                       143  local   12/22/80  16:15:57
# usage - print usage message and die
   subroutine usage

 call error("usage: field [-t[c] | fieldslist] outputformat [files].")
 return
 end
#-t-  usage                       143  local   12/22/80  16:15:57
#-t-  field.r                    5160  local   12/22/80  16:16:35
#-t-  field                      7633  local   12/22/80  16:23:16
#-h-  find                       5778  local   12/22/80  16:29:45
#-h-  find.doc                   2893  local   12/22/80  16:25:51
.bp 1
.in 0
.he 'FIND (1)'03/03/78'FIND (1)
.fo ''-#-''
.fi
.in 7
.ti -7
NAME
.br
find - search a file for text patterns
.sp 1
.ti -7
SYNOPSIS
.br
.bd
find
[-acx] expr [expr ...]
.sp 1
.ti -7
DESCRIPTION
.br
.bd
find
searches the standard input file for lines matching the text patterns
"expr" (up to 9 patterns may be specified) according to the matching
criterion specified by the switches.  (A text pattern is a subset of a
"regular expression"--see the writeup on "ed" for a complete description
of regular expressions.)  Unless the -c option is specified, each matching
line is copied to the standard output.

By default, any line which matches any one of the expressions is considered
a matching line.  If the -a flag is specified, only lines which match all
expressions in any order are considered to match.  If the -x flag is
specified, all lines which don't satisfy the above criteria are considered
matching lines.  And finally, if the -c option is specified, matching
lines are counted instead of being copied to the standard output, and the
final count is written to the standard output.

A text pattern consists of the following elements:

.nf
c         literal character
?         any character except newline
%         beginning of line
$         end of line (null string before newline)
[...]     character class (any one of these characters)
[!...]    negated character class (all but these characters)
*         closure (zero or more occurrences of previous pattern)
@c        escaped character (e.g., @%, @[, @*)

.fi
Any special meaning of characters in a text pattern is lost when
escaped, inside [...], or for:

.nf
%         not at beginning
$         not at end
*         at beginning

.fi
A character class consists of zero or more of the following
elements, surrounded by [ and ]:

.nf
c         literal character, including [
a-b       range of characters (digits, lower or upper case)
!         negated character class if at beginning
@c        escaped character (@! @- @@ @])

.fi
Special meaning of characters in a character class is lost when
escaped or for

.nf
!         not at beginning
-         at beginning or end

.fi
An escape sequence consists of the character @ followed by a single
character:

.nf
@n        newline
@t        tab
@c        c (including @@)

.fi
For a complete description, see "Software Tools" pages 135-154.
Care should be taken when using the characters % $ [ ] ! * @ and
any shell characters
in the text pattern. It is often necessary to enclose the
entire substitution pattern in quotes.
.sp 1
.ti -7
FILES
.br
None
.sp 1
.ti -7
SEE ALSO
.br
tr, ed, ch and the UNIX grep command.
.sp 1
.ti -7
DIAGNOSTICS
.br
An error message is printed if one of the patterns given is illegal.
.sp 1
.ti -7
AUTHORS
.br
Originally from Kernighan & Plauger's "Software Tools", with major
modifications by Joe Sventek (Lawrence Berkeley Laboratory)
#-t-  find.doc                   2893  local   12/22/80  16:25:51
#-h-  find.r                     2621  local   12/22/80  16:25:51
#-h-  find                       1696  local   12/22/80  16:25:29
##      find -- main program

 define(NEXPR,10)  # max nbr expressions allowed on cmd line

 DRIVER(find)

 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

 string illpat "illegal pattern: "
 string maxexp "max nbr expressions allowed is: "
 data except/NO/
 data andpat/NO/
 data count /NO/
 data elevel/0/

 call query("usage:  find [-acx] expression [expressions].")
 for (i=1; getarg(i, arg, MAXARG) != EOF; i=i+1)
    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(maxexp, 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(illpat, 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)
    }

 DRETURN
 end
#-t-  find                       1696  local   12/22/80  16:25:29
#-h-  finerr                       97  local   12/22/80  16:25:29
 subroutine finerr

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

 return
 end
#-t-  finerr                       97  local   12/22/80  16:25:29
#-h-  gmatch                      432  local   12/22/80  16:25:29
 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
#-t-  gmatch                      432  local   12/22/80  16:25:29
#-t-  find.r                     2621  local   12/22/80  16:25:51
#-t-  find                       5778  local   12/22/80  16:29:45
#-h-  kwic                       2760  local   01/06/81  23:57:44
#-h-  kwic.doc                   1025  local   01/06/81  23:10:13
.bp 1
.in 0 
.he 'KWIC (1)'1/15/79'KWIC (1)'
.fo ''-#-' 
.fi 
NAME 
.br 
.in 7 
kwic - make keyword in context index
.sp 1 
.in 
SYNOPSIS 
.br 
.in 7 
kwic [file ...]
.sp 1 
.in 
DESCRIPTION 
.br 
.in 7 
Kwic
rotates lines from the input files so that each word in the sentence
appears at the beginning of a line, with a special character marking
the original position of the end of the line.
The output from kwic is typically sorted with 'sort' and then
unrotated with 'unrot' to produce a keyword-in-context index.
 
If no input files are given, or if the filename '-' appears, lines
will be read from standard input.
.sp 1
.in 
FILES 
.br 
.in 7 
.sp 1 
.in 
SEE ALSO 
.br 
.in 7 
unrot; sort
.sp 1 
.in 
DIAGNOSTICS 
.br 
.in 7 
A message is printed if an input file cannot be opened; further
processing is terminated.
.sp 1 
.in 
AUTHORS 
.br 
.in 7 
.sp 1 
Original from Kernighan and Plauger's 'Software Tools', with 
minor modifications
by Debbie Scherrer, Lawrence Berkeley Laboratory.
.sp 1 
.in 
BUGS 
.br 
.in 7 
#-t-  kwic.doc                   1025  local   01/06/81  23:10:13
#-h-  kwic.r                     1471  local   01/06/81  23:10:14
 ## definitions for kwic and unrot tools
 
 define(FOLD,DOLLAR)	#character to indicate beginning of folded line
 define(MAXOUT,80)	#width of index
 #---------------------------------------------------------------------
 
 ## kwic - make keyword in context index
 DRIVER(kwic)
 
 character buf(MAXLINE)
 integer getarg, open, getlin
 integer i, int
 
 call query ("usage:  kwic [file].")
 for (i=1; getarg(i,buf,MAXLINE)!=EOF; i=i+1)
	{
	if (buf(1) == MINUS & buf(2) == EOS)
		int = STDIN
	else
		{
		int = open(buf,READ)
		if (int == ERR)
			call cant(buf)
		}
	while(getlin(buf,int) != EOF)
		call putrot(buf, STDOUT)
	if (int != STDIN)
		call close(int)
	}
 
 if (i==1)		#Read from standard input
	while (getlin(buf,STDIN) != EOF)
		call putrot(buf, STDOUT)
 DRETURN
 end
 ## putrot - create lines with keyword at front
 subroutine putrot (buf, outfil)
 
 character type
 character buf(ARB), t
 integer i, outfil
 
 for (i=1; buf(i) != NEWLINE; i=i+1)
	{
	t = type(buf(i))
	if (t == LETTER | t == DIGIT)	#alpha
		{
		call rotate(buf, i, outfil)	#token starts at 'i'
		t = type(buf(i+1))
		for (; t==LETTER | t==DIGIT; t=type(buf(i+1)))
			i = i + 1
		}
	}
 
 return
 end
 ## rotate - output rotated line
 subroutine rotate(buf, n, outfil)
 
 character buf(ARB)
 integer i, n, outfil
 
 for (i=n; buf(i) != NEWLINE; i=i+1)
	call putch(buf(i), outfil)
 call putch(FOLD, outfil)
 for (i=1; i<n; i=i+1)
	call putch(buf(i), outfil)
 call putch(NEWLINE, outfil)
 return
 end
#-t-  kwic.r                     1471  local   01/06/81  23:10:14
#-t-  kwic                       2760  local   01/06/81  23:57:44
#-h-  lam                        4379  local   12/24/80  12:34:28
#-h-  lam.doc                    1859  local   12/24/80  12:32:09
.bp 1
.in 0
.he 'LAM (1)'7/30/79'LAM (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
lam - laminate files
.nf
.sp
.ti -3
SYNOPSIS
.br
lam -string | files...
.fi
.sp
.ti -3
DESCRIPTION
.br
Lam laminates the named files to the standard output.
That is, the first output line is the result of concatenating
the first lines of each file, and so on.
If the files are different lengths, null lines are used for the missing
lines in the shorter files.
.sp
The "-string" arguments are used to place strings in each output
line.  Each "string" is placed in the output lines at the point
it appears in the argument list.  For example,
.sp
.in +3
.nf
lam -file1: foo1 "-, file2:" foo2
.in -3
.sp
.fi
results in output lines that look like
.sp
.in +3
.nf
file1: a line from foo1, file2: a line from foo2
.in -3
.sp
.fi
The escape sequences described in find (and change)
are valid in "string"
arguments.  Thus
.sp
.in +3
.nf
lam foo1 -@n foo2
.in -3
.sp
.fi
results in the lines from foo1 and foo2 being interleaved.
.sp
Files and string specifications may appear in any order in the
argument list.
.sp
If no file arguments are given,
or if the file "-" is specified,
lam reads the standard input.
.fi
.sp
.ti -3
FILES
.br
None
.sp
.ne 2
.ti -3
SEE ALSO
.br
comm, tail, field
.fi
.sp
.ne 2
.ti -3
DIAGNOSTICS
.br
too many arguments
.br
.in +3
The maximum number of command line arguments allowed has been exceeded.
It is set by the MAXARGS definition in the source code.
.in -3
.sp
too many strings
.br
.in +3
The max number of characters in a string has been exceeded.
It is set by the MAXBUF definition in the source code.
.in -3
.sp
output buffer exceeded
.in +3
The size of the output line buffer has been exceeded.
It is set by the MAXOBUF definition in the source code.
.in -3
.sp
.ne 2
.ti -3
AUTHORS
.br
David Hanson and friends (U. of Arizona)
.sp
.ti -3
BUGS/DEFICIENCES
#-t-  lam.doc                    1859  local   12/24/80  12:32:09
#-h-  lam.r                      2256  local   12/24/80  12:29:09
# lam - laminate named files
 DRIVER(lam)

 # include ratdef
define(MAXARGS,12)      # max nbr args (files and strings) allowed
define(MAXBUF,200)	# buffer to hold strings
define(MAXOBUF,500)	# output buffer

   character lin(MAXLINE), buf(MAXBUF), obuf(MAXOBUF)
   integer bp, obp, i, j, junk, nfiles, len, fd(MAXARGS)
   integer open, getarg, getlin, esc, addset

   bp = 1
   nfiles = 0
   call query ("usage:  lam [-<string> | file].")
   for (i = 1; getarg(i, lin, MAXLINE) ^= EOF; i = i + 1) {
      if (i > MAXARGS)
         call error("too many arguments.")
      if (lin(1) == MINUS & lin(2) ^= EOS) {	# -string
         fd(i) = -bp
         for (j = 2; lin(j) ^= EOS; j = j + 1)
            junk = addset(esc(lin, j), buf, bp, MAXBUF)
         if (addset(EOS, buf, bp, MAXBUF) == NO)
            call error("too many strings.")
         }
      else {
         nfiles = nfiles + 1
         if (lin(1) == MINUS)
            fd(i) = STDIN
         else
            fd(i) = open(lin, READ)
         if (fd(i) == ERR)
            call cant(lin)
         }
      }

   if (nfiles == 0) {
      nfiles = 1
      fd(i) = STDIN
      }
   else
      i = i - 1
   n = i
 for (obp = 1; nfiles > 0; obp = 1)
   {
   for (i = 1; i <= n; i = i + 1)
      {
      if (fd(i) < 0 )           # do string
         {
         for (j = -fd(i); buf(j) ^= EOS; j = j + 1)
            {
            if ( addset(buf(j), obuf, obp, MAXOBUF) == NO)
                  call error ('output buffer exceeded.')
            }
         }
      else if (fd(i) ^= EOF)
         {
         len = getlin(lin, fd(i))
         if (len == EOF)
            {
            nfiles = nfiles - 1
            if (fd(i) ^= STDIN)
               call close(fd(i))
            fd(i) = EOF
            }
         else
            {
            for (j = 1; j < len; j = j + 1)
               {
               if ( addset(lin(j), obuf, obp, MAXOBUF) == NO)
                    call error ('output buffer exceeded.')
               }
            }
         }
      }       # end of second 'for' loop
   if (nfiles > 0)
      {
      for (j = 1; j < obp; j = j + 1)
         call putch(obuf(j), STDOUT)
      call putch(NEWLINE, STDOUT)
      }
   }           # end of main 'for' loop.
  DRETURN
end
#-t-  lam.r                      2256  local   12/24/80  12:29:09
#-t-  lam                        4379  local   12/24/80  12:34:28
#-h-  ll                         2397  local   12/24/80  12:41:59
#-h-  ll.doc                      608  local   12/24/80  12:39:45
.bp 1
.in 0
.he 'LL (1)'9/15/78'LL (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
ll - print line lengths
.nf
.sp
.ti -3
SYNOPSIS
.br
ll files...
.fi
.sp
.ti -3
DESCRIPTION
.br
Ll prints the lengths of the shortest and longest lines
in the named files.  The name "-" may be used
to refer to the standard input.  If no files
are given, ll reads the standard input.

NEWLINE characters are not counted as part of the length of a
line.
.fi
.sp
.ti -3
FILES
.br
None
.sp
.ne 2
.ti -3
DIAGNOSTICS
.br
A message is issued if a named file could not be opened.
.sp
.ti -3
AUTHORS
.br
David Hanson and friends (U. of Arizona)
#-t-  ll.doc                      608  local   12/24/80  12:39:45
#-h-  ll.r                       1525  local   12/24/80  12:39:45
#-h-  ll                          734  local   12/24/80  12:39:33
# ll - prints length of shortest and longest lines
 DRIVER(ll)
   character arg(MAXLINE)
   integer open, getarg
   integer fd, i

   call query ("usage:  ll [file].")
   for (i = 1; getarg(i, arg, MAXNAME) ^= EOF; i = i + 1) {
      if (arg(1) == MINUS & arg(2) == EOS)
         fd = STDIN
      else
         fd = open(arg, READ)
      if (fd == ERR)
         call cant(arg)
      else {
         call doll(fd)
         if (fd != STDIN)
                {
                call putc(BLANK)
                call putlin(arg, STDOUT)
                call close(fd)
                }
         call putc(NEWLINE)
         }
      }
   if (i == 1) {        # no args, do STDIN
      call doll(STDIN)
      call putc(NEWLINE)
      }
   end
#-t-  ll                          734  local   12/24/80  12:39:33
#-h-  doll                        527  local   12/24/80  12:39:34
# doll - determine longest and shortest lines in fd
   subroutine doll(fd)
   integer fd
   character getch
   character c
   integer len, minl, maxl

   minl = HUGE
   maxl = 0
   len = 0
   while (getch(c, fd) ^= EOF)
      if (c == NEWLINE) {
         if (len > maxl)
            maxl = len
         if (len < minl)
            minl = len
         len = 0
         }
      else
         len = len + 1
   if (minl == HUGE)
      minl = 0
   call putdec(minl, 5)
   call putc(BLANK)
   call putdec(maxl, 5)
    DRETURN
   end
#-t-  doll                        527  local   12/24/80  12:39:34
#-t-  ll.r                       1525  local   12/24/80  12:39:45
#-t-  ll                         2397  local   12/24/80  12:41:59
#-h-  macro                     35447  local   01/07/81  00:30:00
#-h-  macro.doc                  6491  local   01/07/81  00:29:21
.bp 1
.in 0
.he 'MACRO (1)'10/1/79'MACRO (1)'
.in 3
.ti -3
NAME
.br
macro - general-purpose macro processor
.sp
.ti -3
SYNOPSIS
.br
macro [-0] [files...]
.sp
.ti -3
DESCRIPTION
.br
Macro is a general-purpose macro processor.
Macro reads the files and writes onto the standard output
a new file with the macro definitions deleted and the macro
references expanded.
If no files are given, or the file "-" is specified, the standard
input is read.
.sp
Macros permit the definition of
symbolic constants so that subsequent
occurrences of the constant are replaced by the defining
string of characters.
The general form of a macro definition is
.sp
.ce
define(name,replacement text)
.sp
All subsequent occurrences of "name" in the file will be replaced
by "replacement text".
The placement of blanks in definitions is significant;
they should only appear in the replacement
text where desired.
Upper and lower case letters are also significant.
The replacement text may be more than one
line long.
However, when an entire macro definition is followed
immediately by a newline,
the newline is discarded.  This prevents extraneous blank lines
from appearing in the output.
.sp
Nesting of definitions is allowed, as is recursion.
.sp
An elementary example of a macro is:
.sp
.ce
define(EOF,-1)
.sp
Thereafter, all occurrences of "EOF" in the file would be replaced
by "-1".
.sp
Macros with arguments may also be specified.
Any occurrence in
the replacement text of "$n", where n is between 1 and 9,
will be replaced by the nth argument when the macro is actually
called.
For example,
.sp
.ti +10
define(copen,$3 = open($1,$2)
.ti +18
if ($3 == ERR)
.ti +21
call cant($1)
)
.sp
would define a macro that, when called
by
.sp
.ce
copen(name, READ, fd)
.sp
would expand into
.in +10
.nf
fd = open(name,READ)
if (fd == ERR)
.ti +3
call cant(name)
.sp
.fi
.in -10
If a macro definition refers to an argument that wasn't supplied,
the "$n" will be ignored.
"$0" refers to the name of the macro itself.
If a character other
than a digit follows "$",
the "$" is taken literally.
.sp
Macros can be nested, and any macros encountered during argument
collection are expanded immediately, unless they are surrounded
by brackets "[]".
That is, input surrounded by brackets is
left absolutely alone, except that one level of [ and ] is
stripped off.
Thus it is possible to write the macro "d" as
.sp
.ce
define(d,[define($1,$2)])
.sp
The replacement text for "d", protected by the brackets is
literally "define($1,$2)" so one could say
.sp
.ce
d(a,bc)
.sp
to define "a" as "bc".
Brackets must also be used when it is desired to redefine
a macro, e.g.
.sp
.in +25
define(x,y)
.br
define(x,z)
.sp
.in -25
would define "y" in the second line, instead of redefining "x".
To avoid redefining "y", the operation must be expressed as
.sp
.in +25
define(x,y)
.br
define([x],z)
.sp
.in -25
Normally, brackets appearing outside any macro calls
("level 0" brackets) are
.ul
not
removed, unless the -0 option is specified.
.sp 2
The following built-in macros are provided:
.sp
define(a,b)
.br
.in +5
defines a to be b and returns the null string.
.in -5
.sp
ifelse(a,b,c,d)
.br
.in +5
returns c if a is identical to b and d otherwise.
.in -5
.sp
incr(a)
.br
.in +5
interprets a as an integer and returns a+1.
.in -5
.sp
substr(a,b,c)
.br
.in +5
returns a substring of "a" starting at character number
b and extending for c characters.
.in -5
.sp
len(a)
.br
.in +5
returns the length of a.
.in -5
.sp
includ(a)
.br
.in +5
returns the contents of file a.
.in -5
.sp
expr(a)
.br
.in +5
returns the result of evaluating infix expression a.
Operators in increasing order of precedence are
as follows.  Parentheses may be used as usual.
.br
.sp
.in +5
.nf
| &             logical OR and AND
!               unary logical NOT
== ^= <= < > >= arithmetic comparison (!= and ~= are
.ti +16
equivalent to ^=)
+ -             addition and subtraction
* / %           multiplication, division, modulo (remainder)
**              exponentiation
+ -             unary plus and negation
.fi
.sp
.in -5
Logical operators return 0 or 1 (false or true).
.in -5
.sp
.ti -3
FILES
.br
None
.sp
.ti -3
SEE ALSO
.br
Kernighan and Plauger's "Software Tools", pages. 251-283
.br
ratfor
.sp
.ti -3
DIAGNOSTICS
.br
arith evaluation stack overflow
.in +5
The max level of nested arithmetic expressions has been exceeded.
The size is set by the MAXSTACK definition in the source code.
.sp
.in -5
arg stack overflow
.br
.in +5
The maximum number of total arguments has been exceeded;
the size is set by the ARGSIZE definition in the source code.
.in -5
.sp
call stack overflow
.br
.in +5
The maximum level of nesting of definitions has been exceeded.
The size is set by the CALLSIZE definition in the source code.
.in -5
.sp
EOF in string
.br
.in +5
An end-of-file has been encountered before a bracketed string has
been terminated.
.in -5
.sp
evaluation stack overflow
.br
.in +5
The total number of characters permitted for
name, definition, and arguments
has been exceeded.
Set by the EVALSIZE definition in the source code.
.in -5
.sp
unexpected EOF
.br
.in +5
An end-of-file was reached before the macro definition was terminated.
.in -5
.sp
filename: can't open
.br
.in +5
The indicated file could not be opened.
.in -5
.sp
filename: can't includ
.br
.in +5
The indicated file could not be included via the includ builtin.
.in -5
.sp
includs nested too deeply
.br
.in +5
Includ builtins were nested deeper than the system would
allow.
The number is determined by the MAXOFILES definition in the
general symbols definition file.
.in -5
.sp
expression: invalid infix expression
.br
.in +5
There is a syntax error in the indicated infix expression as
passed to the expr builtin.
.in -5
.sp
too many characters pushed back
.br
.in +5
A macro expansion is too large to be rescanned.
The size is set by the BUFSIZE definition in the source code.
.in -5
.sp
name: too many definitions
.br
.in +5
The table space for macro definitions has been exhausted; this
occurred upon the definition of the indicated macro.
.in -5
.sp
token too long
.br
.in +5
A name or symbol in the input was longer than the token buffer.
Size is determined by the MAXTOK definition in the source code.
.in -5
.sp
.ti -3
AUTHORS
.br
Original by Kernighan and Plauger, with enhancements by
David Hanson and friends (U. of Arizona) and Philip
Scherrer (Stanford U.)
.sp
.ti -3
BUGS/DEFICIENCIES
.br
This macro processor is incompatible with the one included
in the ratfor preprocessor.
#-t-  macro.doc                  6491  local   01/07/81  00:29:21
#-h-  cdefio                      255  local   12/19/80  16:13:11
 ## common block to hold pushed-back input characters
 #  put on a file called 'cdefio'
 #  used by ratfor, macro, roff

 common /cdefio/ bp, buf(BUFSIZE)
   integer bp      # next available character; init = 0
   character buf   # pushed-back characters
#-t-  cdefio                      255  local   12/19/80  16:13:11
#-h-  cexp                        272  local   12/19/80  16:13:11
 ## common for exptoi
 # put on a file called 'cexp'
 # Used by macro and dc tools
 common/cexp/ top, tokst(MAXSTACK), kindst(MAXSTACK)
 integer top	# evaluation stack pointer
 integer tokst	# eval stack part 1: tokens
 integer kindst # eval stack part 2: kinds of tokens
#-t-  cexp                        272  local   12/19/80  16:13:11
#-h-  cfiles                      243  local   12/19/80  16:13:12
 ## common block used to hold list of input files
 #  put on a file called 'cfiles'
 #  used by macro, roff

 common /cfiles/ infile(NFILES), level
   integer infile	# stack of file descriptors
   integer level	# current file is infile(level)
#-t-  cfiles                      243  local   12/19/80  16:13:12
#-h-  ctab                        129  local   12/19/80  16:13:12
 # common block for macro symbol table
 # place on file 'ctab'

 common /ctab/ mactbl
   pointer mactbl

 DS_DECL (mem, MEMSIZE)
#-t-  ctab                        129  local   12/19/80  16:13:12
#-h-  cmacro                      314  local   12/19/80  16:13:12
 ## common block to hold macro evaluation stack
 #  put on a file called 'cmacro'
 #  used by ratfor and by the macro tool

 common /cmacro/ cp, ep, evalst(EVALSIZE)
   integer cp         # current call stack pointer
   integer ep         # next free position in evalst
   character evalst      # evaluation stack
#-t-  cmacro                      314  local   12/19/80  16:13:12
#-h-  macro.r                   26819  local   12/19/80  16:13:13
#-h-  macro                      1893  local   12/19/80  16:11:39
# macro - expand macros in named files or standard input
 # include ratdef
define(MAXDEF,2500)     #max chars in a definition
define(MAXTOK,200)      #max chars in a token (word)
define(CALLSIZE,20)
define(ARGSIZE,100)
define(ARGFLAG,DOLLAR)
define(NFILES,arith(MAXOFILES,-,4))
define(DEFTYPE,-10)
define(IFTYPE,-11)
define(INCTYPE,-12)
define(SUBTYPE,-13)
define(EXPTYPE,-14)
define(ICLTYPE,-15)
define(LENTYPE,-16)
define(EVALSIZE,2500)
define(BUFSIZE,2500)
define(MEMSIZE,4000)

 #### definitions for arithmetic evaluation
 define(OP,1)
 define(OPND,2)
 define(SEP,3)
 define(OPDONE,1)
 define(OPGO,2)
 define(OPLP,3)
 define(OPRP,4)
 define(OPOR,5)
 define(OPAND,6)
 define(OPNOT,7)
 define(OPEQ,8)
 define(OPNE,9)
 define(OPGT,10)
 define(OPGE,11)
 define(OPLT,12)
 define(OPLE,13)
 define(OPADD,14)
 define(OPSUB,15)
 define(OPMUL,16)
 define(OPDIV,17)
 define(OPNEG,18)
 define(OPMOD,19)
 define(OPEXP,20)
 define(OPPLUS,21)
 define(MAXOP,21)
 define(OPERR,-1)
 define(MAXSTACK,30)  # evaluation stack

 DRIVER(macro)
   character arg(MAXLINE)
   integer open, getarg
   integer fd, i, nfiles, qflag
   data qflag /NO/   # default is no quoting at level 0

   call query ("usage:  macro [-0] [files].")
   call minit
   for (i = 1; getarg(i, arg, MAXNAME) ^= EOF; i = i + 1)
      if (arg(1) == MINUS & arg(2) == DIG0)
         qflag = YES
      else if (arg(1) == MINUS & arg(2) ^= EOS)
         call error("usage: macro [-0] [files].")
      else {
         nfiles = nfiles + 1
         if (arg(1) == MINUS)
            fd = STDIN
         else
            fd = open(arg, READ)
         if (fd == ERR) {
            call putlin(arg, ERROUT)
            call error(": can't open.")
            }
         call domacr(fd, qflag)
         if (fd ^= STDIN)
            call close(fd)
         }
   if (nfiles == 0)     # no args, do STDIN
      call domacr(STDIN, qflag)
  DRETURN
   end
#-t-  macro                      1893  local   12/19/80  16:11:39
#-h-  binop                      1253  local   12/19/80  16:11:40
 ## binop - evaluates top 3 items on eval stack
 subroutine binop

 integer l, r, result, op
 include cexp

 r = tokst(top)
 op = tokst(top-1)
 l = tokst(top-2)
 top = top - 2
 switch (op)
        {
        case OPOR: if (l != 0 | r != 0) result = 1
                   else result = 0
        case OPAND:if (l != 0 & r != 0) result = 1
                   else result = 0
        case OPNOT: if (r == 0) result = 1
                    else result = 0
        case OPEQ:  if (l == r) result = 1
                    else result = 0
        case OPNE:  if (l != r) result = 1
                    else result = 0
        case OPGT:  if (l > r) result = 1
                    else result = 0
        case OPGE:  if (l >= r) result = 1
                    else result = 0
        case OPLT:  if (l < r) result = 1
                    else result = 0
        case OPLE:  if (l <= r) result = 1
                    else result = 0
        case OPADD: result = l + r
        case OPSUB:  result = l - r
        case OPNEG:  result = (-r)
        case OPMUL:  result = l * r
        case OPDIV:  result = l / r
        case OPMOD:  result = mod(l,r)
        case OPEXP:  result = l**r
        case OPPLUS: result = (+r)
        }
 tokst(top) = result
 return
 end
#-t-  binop                      1253  local   12/19/80  16:11:40
#-h-  ctonum                      816  local   12/19/80  16:11:41
# ctonum - string to number with radix control
 integer function ctonum(buf,i,dradix)
 character buf(ARB), tmp(MAXLINE)
 integer ctoi
 integer i, j, c, n, val, radix, dradix
 string digits "0123456789abcdefABCDEF"

 for (n=0;;i=i+1)
        {       #collect digits
        c = index(digits,buf(i))
        if (c==0) break
        if (c > 16) c = c-6     # convert to lower case
        n = n+1
        tmp(n) = c-1            # save digit value
        }
 if (buf(i) == UNDERLINE)
        {       # get new radix, radix radix is 10.
        radix = 0
        i = i+1
        radix = ctoi(buf,i)
        }
 else radix = dradix
 val = 0
 for (j=1; j<=n; j = j+1)
        {
        c = tmp(j)
        if (c >= radix)
                call remark("number error")
        val = val * radix + c
        }
 return(val)
 end
#-t-  ctonum                      816  local   12/19/80  16:11:41
#-h-  dodef                       350  local   12/19/80  16:11:41
# dodef - install definition in table
   subroutine dodef(argstk, i, j)
   integer a2, a3, argstk(ARGSIZE), i, j, c
   character ngetc
   include cmacro

   if (j - i > 2) {
      a2 = argstk(i+2)
      a3 = argstk(i+3)
      call entdef(evalst(a2), evalst(a3))   # subarrays
      }
   if (ngetc(c) ^= NEWLINE)
      call putbak(c)
   return
   end
#-t-  dodef                       350  local   12/19/80  16:11:41
#-h-  doexpr                      361  local   12/19/80  16:11:42
# doexpr - evaluate infix expression
   subroutine doexpr(argstk, i, j)
   integer exptoi
   integer argstk(ARGSIZE), i, j, k
   include cmacro

   k = argstk(i+2)
   call pbnum(exptoi(evalst, k, 10))
   if (evalst(k) ^= EOS) {
      k = argstk(i+2)
      call putlin(evalst(k), ERROUT)
      call remark(": invalid infix expression.")
      }
   return
   end
#-t-  doexpr                      361  local   12/19/80  16:11:42
#-h-  doif                        408  local   12/19/80  16:11:42
# doif - select one of two arguments
   subroutine doif(argstk, i, j)
   integer equal
   integer a2, a3, a4, a5, argstk(ARGSIZE), i, j
   include cmacro

   if (j - i < 5)
      return
   a2 = argstk(i+2)
   a3 = argstk(i+3)
   a4 = argstk(i+4)
   a5 = argstk(i+5)
   if (equal(evalst(a2), evalst(a3)) == YES)   # subarrays
      call pbstr(evalst(a4))
   else
      call pbstr(evalst(a5))
   return
   end
#-t-  doif                        408  local   12/19/80  16:11:42
#-h-  doincl                      454  local   12/19/80  16:11:42
# doincl - include named file
   subroutine doincl(argstk, i, j)
   integer argstk(ARGSIZE), i, j
   integer k, open
   include cfiles
   include cmacro

   if (level + 1 > NFILES)
      call error("includs nested too deeply.")
   k = argstk(i+2)
   infile(level+1) = open(evalst(k), READ)
   if (infile(level+1) == ERR) {
      call putlin(evalst(k), ERROUT)
      call remark(": can't includ.")
      }
   else
      level = level + 1
   return
   end
#-t-  doincl                      454  local   12/19/80  16:11:42
#-h-  doincr                      321  local   12/19/80  16:11:43
# doincr - increment argument by 1
   subroutine doincr(argstk, i, j)
   integer ctoi, index
   integer argstk(ARGSIZE), i, j, k, m
   include cmacro

   k = argstk(i+2)
   m = index(evalst(k), MINUS)
   if (m == 0)
        call pbnum(ctoi(evalst,k) + 1)
   else
        call pbnum(1-ctoi(evalst,k + m))
   return
   end
#-t-  doincr                      321  local   12/19/80  16:11:43
#-h-  dolen                       212  local   12/19/80  16:11:44
# dolen - return length of argument
   subroutine dolen(argstk, i, j)
   integer length
   integer argstk(ARGSIZE), i, j, k
   include cmacro

   k = argstk(i+2)
   call pbnum(length(evalst(k)))
   return
   end
#-t-  dolen                       212  local   12/19/80  16:11:44
#-h-  domacr                     2621  local   12/19/80  16:11:45
# domacr - expand macros with arguments; read from fd, qflag YES do []
   subroutine domacr(fd, qflag)
   integer fd, qflag
   character gettok
   character defn(MAXDEF), t, token(MAXTOK)
   integer ludef, push
   integer ap, argstk(ARGSIZE), callst(CALLSIZE), nlb, plev(CALLSIZE)
   include cmacro
   include cdefio
   include cfiles
   string balp "()"

   cp = 0
   ap = 1
   ep = 1
   bp = 0
   level = 1
   infile(1) = fd
   for (t=gettok(token, MAXTOK); t ^= EOF; t=gettok(token, MAXTOK)) {
      if (t == ALPHA) {
         if (ludef(token, defn) == NO)
            call puttok(token)
         else {            # defined; put it in eval stack
            cp = cp + 1
            if (cp > CALLSIZE)
               call error("call stack overflow.")
            callst(cp) = ap
            ap = push(ep, argstk, ap)
            call puttok(defn)   # stack definition
            call putchr(EOS)
            ap = push(ep, argstk, ap)
            call puttok(token)   # stack name
            call putchr(EOS)
            ap = push(ep, argstk, ap)
            t = gettok(token, MAXTOK)   # peek at next
            call pbstr(token)
            if (t ^= LPAREN)   # add ( ) if not present
               call pbstr(balp)
            plev(cp) = 0
            }
         }
      else if (t == LBRACK & (cp > 0 | qflag == YES)) {
         nlb = 1               # strip one level of [ ]
         repeat {
            t = gettok(token, MAXTOK)
            if (t == LBRACK)
               nlb = nlb + 1
            else if (t == RBRACK) {
               nlb = nlb - 1
               if (nlb == 0)
                  break
               }
            else if (t == EOF)
               call error("EOF in string.")
            call puttok(token)
            }
         }
      else if (cp == 0)         # not in a macro at all
         call puttok(token)
      else if (t == LPAREN) {
         if (plev(cp) > 0)
            call puttok(token)
         plev(cp) = plev(cp) + 1
         }
      else if (t == RPAREN) {
         plev(cp) = plev(cp) - 1
         if (plev(cp) > 0)
            call puttok(token)
         else {            # end of argument list
            call putchr(EOS)
            call eval(argstk, callst(cp), ap-1)
            ap = callst(cp)   # pop eval stack
            ep = argstk(ap)
            cp = cp - 1
            }
         }
      else if (t == COMMA & plev(cp) == 1) {   # new arg
         call putchr(EOS)
         ap = push(ep, argstk, ap)
         }
      else
         call puttok(token)      # just stack it
      }
   if (cp ^= 0)
      call error("unexpected EOF.")
   return
   end
#-t-  domacr                     2621  local   12/19/80  16:11:45
#-h-  dosub                       667  local   12/19/80  16:11:45
# dosub - select substring
   subroutine dosub(argstk, i, j)
   integer ctoi, length, max, min
   integer ap, argstk(ARGSIZE), fc, i, j, k, nc
   include cmacro

   if (j - i < 3)
      return
   if (j - i < 4)
      nc = MAXTOK
   else {
      k = argstk(i+4)
      nc = ctoi(evalst, k)      # number of characters
      }
   k = argstk(i+3)         # origin
   ap = argstk(i+2)         # target string
   fc = ap + ctoi(evalst, k) - 1   # first char of substring
   if (fc >= ap & fc < ap + length(evalst(ap))) {   # subarrays
      k = fc + min(nc, length(evalst(fc))) - 1
      for ( ; k >= fc; k = k - 1)
         call putbak(evalst(k))
      }
   return
   end
#-t-  dosub                       667  local   12/19/80  16:11:45
#-h-  entdef                      543  local   12/19/80  16:11:46
# entdef - enter name and definition in macro table

   subroutine entdef (name, defn)
   character name (ARB), defn (ARB)

   include ctab

   integer i
   integer length, lookup

   pointer locn
   pointer dsget

   if (lookup (name, locn, mactbl) == YES)
      call dsfree (locn)      # clobber old definition, if any

   locn = dsget (length (defn) + 1)
   call enter (name, locn, mactbl)
   i = 1
   while (defn (i) != EOS) {
      mem (locn) = defn (i)
      locn = locn + 1
      i = i + 1
      }
   mem (locn) = EOS

   return
   end
#-t-  entdef                      543  local   12/19/80  16:11:46
#-h-  eval                       1305  local   12/19/80  16:11:46
# eval - expand args i through j: evaluate builtin or push back defn
   subroutine eval(argstk, i, j)
   integer index, length
   integer argno, argstk(ARGSIZE), i, j, k, m, n, t, td
   include cmacro
   string digits "0123456789"

   t = argstk(i)
   td = evalst(t)
   if (td == DEFTYPE)
      call dodef(argstk, i, j)
   else if (td == INCTYPE)
      call doincr(argstk, i, j)
   else if (td == SUBTYPE)
      call dosub(argstk, i, j)
   else if (td == IFTYPE)
      call doif(argstk, i, j)
   else if (td == EXPTYPE)
      call doexpr(argstk, i, j)
   else if (td == ICLTYPE)
      call doincl(argstk, i, j)
   else if (td == LENTYPE)
      call dolen(argstk, i, j)
   else {
      for (k = t+length(evalst(t))-1; k > t; k = k - 1)
         if (evalst(k-1) ^= ARGFLAG)
            call putbak(evalst(k))
         else {
            argno = index(digits, evalst(k)) - 1
            if (argno < 0)
               call putbak(evalst(k))
            else if (argno < j-i) {
               n = i + argno + 1
               m = argstk(n)
               call pbstr(evalst(m))
               k = k - 1   # skip over $
               }
            else
               k = k - 1   # skip over $
            }
      if (k == t)         # do last character
         call putbak(evalst(k))
      }
   return
   end
#-t-  eval                       1305  local   12/19/80  16:11:46
#-h-  exptoi                     3616  local   12/19/80  16:11:47
 ## exptoi - evalutate arithmetic expression
 integer function exptoi (exp, ptr, radix)

 integer exptok, stackx
 character exp(ARB)
 integer ptr, radix
 integer k, tok, kind, preced(MAXOP)
 include cexp

 # precedence of respective operators
 data preced(1), preced(2), preced(3), preced(4), preced(5),
      preced(6), preced(7), preced(8), preced(9), preced(10),
      preced(11), preced(12), preced(13), preced(14), preced(15),
      preced(16), preced(17), preced(18),
      preced(19), preced(20), preced(21) / 0,  0,   # EOS, start_expr
        1,  1,          # (  )
        2,  2,          # |  &
        3,              # ! (or ^ or ~)
        4,4,4,4,4,4,    # == != > >= < <=
        5,  5,          # +  -
        6,  6,          # *  /
        8,  6,  7, 8      /# neg, mod, expon, plus


 k = ptr
 top = 1
 tokst(top) = OPGO
 kindst(top) = SEP

 while (exptok(exp, k, tok, kind, radix) == YES) #loop thru legal toks
        {
        if (kind == OPND)
                {
                if (kindst(top) == OPND)
                        return(0)
                }
        else if (kind == OP)
                {
                if (kindst(top) == OP)
                        return(0)
                else if (kindst(top) == SEP)
                        {       #check for unary +,- or !
                        if (tok != OPADD & tok != OPSUB & tok != OPNOT)
                                return(0)
                        if (stackx(0, OPND) == ERR)
                                return(0)
                        if (tok == OPADD)
                                tok = OPPLUS
                        else if (tok == OPSUB)
                                tok = OPNEG
                        }
                else    #kindst(top) == OPND
                        {
                        if (kindst(top-1) == OP)
                                {
                                while(preced(tokst(top-1)) >= preced(tok))
                                        call binop
                                }
                        }
                }
        else # (kind == SEP)
                {
                if (tok != OPLP)        #if tok == ( or tok == EOS
                        {
                        if (kindst(top) != OPND)
                                return(0)
                        while(preced(tokst(top-1)) > preced(tok))
                                {
                                if (kindst(top-1) == OP)
                                        call binop
                                else
                                        return(0)  # no right paren
                                }
                        if (preced(tokst(top-1)) == preced(tok))
                                {
                                if (tok == OPDONE)
                                        {
                                        ptr = k    #normal return
                                        return(tokst(top))
                                        }
                                else    #remove matching LPAREN
                                        {
                                        tok = tokst(top)
                                        kind = kindst(top)
                                        top = top -2
                                        }
                                }
                        else    #unbalanced parens
                                return(0)
                        }
                }
        # stack new tok, kind
        if (stackx(tok, kind) == ERR)
                return(0)
        }
 return(0)
 end
#-t-  exptoi                     3616  local   12/19/80  16:11:47
#-h-  exptok                     3672  local   12/19/80  16:11:48
 ## exptok - get expression token for evaluation
 integer function exptok(exp, k, tok, kind, radix)
 character exp(ARB), defn(MAXTOK), name(MAXTOK)
 integer k      #index, updated unless EOS
 integer tok    #return value, token found
 integer kind   #return value, kind of token
 integer radix  #default radix for numbers
 integer ctonum, ludef
 character type
 character c, cn
 string digits "0123456789abcdefABCDEF"
 include cexp

 c = type(exp(k))
 if (radix > 10)
        {
        if (index(digits,exp(k)) > 0) c = DIGIT
        }
 if (c == DIGIT)
        {
        tok = ctonum(exp, k, radix)
        kind = OPND
        return(YES)
        }
 else if (c == LETTER)
        {               #found stored variable name
        call movnam(exp, k, name, 1)
        k = k + length(name)
        if (ludef(name, defn) == YES)
                {
                i = 1
                tok = ctonum(defn, i, radix)
                kind = OPND
                return(YES)
                }
        else
                return(NO)
        }
 else           #c is symbol
        {
        cn = exp(k+1)
        kind = OP
        switch(c)
                {
                case TILDE:  if (cn == EQUALS)
                                {
                                tok = OPNE
                                k = k + 1
                                }
                         else tok = OPNOT
                case CARET:  if (cn == EQUALS)
                                {
                                tok = OPNE
                                k = k + 1
                                }
                         else tok = OPNOT
                case BANG:  if (cn == EQUALS)
                                {
                                tok = OPNE
                                k = k + 1
                                }
                         else tok = OPNOT
                case LESS:  if (cn == EQUALS)
                                {
                                tok = OPLE
                                k = k + 1
                                }
                         else tok = OPLT
                case GREATER:  if (cn == EQUALS)
                                {
                                tok = OPGE
                                k = k + 1
                                }
                         else tok = OPGT
                case EQUALS:  if (cn == EQUALS)
                                {
                                tok = OPEQ
                                k = k + 1
                                }
                         else tok = OPERR
                case BAR:  tok = OPOR
                case AMPER: tok  = OPAND
                case PLUS:  tok = OPADD
                case MINUS: tok = OPSUB
                case STAR:  if (cn == STAR)
                                {
                                tok = OPEXP
                                k = k + 1
                                }
                            else tok = OPMUL
                case SLASH: tok = OPDIV
                case PERCENT: tok = OPMOD
                case LPAREN: {
                             kind = SEP
                             tok = OPLP
                             }
                case RPAREN: {
                             kind = SEP
                             tok = OPRP
                             }
                case EOS:    {
                             kind = SEP
                             tok = OPDONE
                             }
                default:     tok = OPERR
                }

 if (tok == OPERR)
        return(NO)
 if (tok != OPDONE)
        k = k + 1
 return(YES)
 }
 end
#-t-  exptok                     3672  local   12/19/80  16:11:48
#-h-  gettok                      641  local   12/19/80  16:12:03
# gettok - get alphanumeric string or single non-alpha for define
   character function gettok(token, toksiz)
   character ngetc, type
   integer i, toksiz
   character token(toksiz)

   gettok = type(ngetc(token(1)))
   if (gettok ^= LETTER) {
      token(2) = EOS
      return
      }
   for (i = 2; i < toksiz; i = i + 1) {   # alphanumeric token
      gettok = type(ngetc(token(i)))
      if (gettok ^= LETTER & gettok ^= DIGIT & gettok ^= PERIOD &
          gettok ^= UNDERLINE)
         break
      }
   if (i >= toksiz)
      call error("token too long.")
   call putbak(token(i))
   gettok = ALPHA
   token(i) = EOS
   return
   end
#-t-  gettok                      641  local   12/19/80  16:12:03
#-h-  ludef                       456  local   12/19/80  16:12:03
# ludef - look up a macro name, return its definition (if found)

   integer function ludef (name, defn)
   character name (ARB), defn (ARB)

   include ctab

   integer i
   integer lookup

   pointer locn

   if (lookup (name, locn, mactbl) == NO) {
      defn (1) = EOS
      return (NO)
      }

   i = 1
   while (mem (locn) != EOS) {
      defn (i) = mem (locn)
      locn = locn + 1
      i = i + 1
      }
   defn (i) = EOS

   return (YES)
   end
#-t-  ludef                       456  local   12/19/80  16:12:03
#-h-  minit                      1451  local   12/19/80  16:12:03
# minit - initialize symbol table with built-in macros
   subroutine minit

   include ctab

   pointer mktabl

   integer deftyp(2)
   integer inctyp(2)
   integer subtyp(2)
   integer iftyp(2)
   integer exptyp(2)
   integer icltyp(2)
   integer lentyp(2)
   string defnam "define"
   string incnam "incr"
   string subnam "substr"
   string ifnam "ifelse"
   string expnam "expr"
   string iclnam "includ"
   string lennam "len"
   data deftyp(1) /DEFTYPE/, deftyp(2) /EOS/
   data inctyp(1) /INCTYPE/, inctyp(2) /EOS/
   data subtyp(1) /SUBTYPE/, subtyp(2) /EOS/
   data iftyp(1) /IFTYPE/, iftyp(2) /EOS/
   data exptyp(1) /EXPTYPE/, exptyp(2) /EOS/
   data icltyp(1) /ICLTYPE/, icltyp(2) /EOS/
   data lentyp(1) /LENTYPE/, lentyp(2) /EOS/

   call dsinit (MEMSIZE)
   mactbl = mktabl (1)
                        #install both upper and lower cases
   call entdef(defnam, deftyp)
   call upper(defnam)
   call entdef(defnam, deftyp)
   call entdef(incnam, inctyp)
   call upper(incnam)
   call entdef(incnam, inctyp)
   call entdef(subnam, subtyp)
   call upper(subnam)
   call entdef(subnam, subtyp)
   call entdef(ifnam, iftyp)
   call upper(ifnam)
   call entdef(ifnam, iftyp)
   call entdef(expnam, exptyp)
   call upper(expnam)
   call entdef(expnam, exptyp)
   call entdef(iclnam, icltyp)
   call upper(iclnam)
   call entdef(iclnam, icltyp)
   call entdef(lennam, lentyp)
   call upper(lennam)
   call entdef(lennam, lentyp)
 return
   end
#-t-  minit                      1451  local   12/19/80  16:12:03
#-h-  movnam                      371  local   12/19/80  16:12:04
 ## movnam - move in(i) to out(j) until non-alphanumeric found
 subroutine movnam (in, i, out, j)
 character in(ARB), out(ARB)
 integer i, j, k1, k2
 character type
 character c

 k1 = i
 k2 = j
 for(c=type(in(k1)); c == LETTER | c == DIGIT; c=type(in(k1)))
        {
        out(k2) = in(k1)
        k1 = k1 + 1
        k2 = k2 + 1
        }
 out(k2) = EOS
 return
 end
#-t-  movnam                      371  local   12/19/80  16:12:04
#-h-  ngetc                       479  local   12/19/80  16:12:05
# ngetc - get a (possibly pushed back) character
   character function ngetc(c)
   character getch
   character c
   include cdefio
   include cfiles

   if (bp > 0)
      c = buf(bp)
   else {
      bp = 1
      for (; level > 0; level = level - 1) {
         if (getch(c, infile(level)) ^= EOF)
            break
         if (level > 1)
            call close(infile(level))
         }
      buf(bp) = c
      }
   if (c ^= EOF)
      bp = bp - 1
   ngetc = c
   return
   end
#-t-  ngetc                       479  local   12/19/80  16:12:05
#-h-  pbnum                       206  local   12/19/80  16:12:05
# pbnum - convert number to string, push back on input
   subroutine pbnum(n)
   integer itoc
   character buf(MAXCHARS)
   integer junk

  junk = itoc(n, buf, MAXCHARS)
   call pbstr(buf)
   return
   end
#-t-  pbnum                       206  local   12/19/80  16:12:05
#-h-  pbstr                       203  local   12/19/80  16:12:05
# pbstr - push string back onto input
   subroutine pbstr(in)
   character in(MAXLINE)
   integer length
   integer i

   for (i = length(in); i > 0; i = i - 1)
      call putbak(in(i))
   return
   end
#-t-  pbstr                       203  local   12/19/80  16:12:05
#-h-  push                        243  local   12/19/80  16:12:06
# push - push ep onto argstk, return new pointer ap
   integer function push(ep, argstk, ap)
   integer ap, argstk(ARGSIZE), ep

   if (ap > ARGSIZE)
      call error("arg stack overflow.")
   argstk(ap) = ep
   push = ap + 1
   return
   end
#-t-  push                        243  local   12/19/80  16:12:06
#-h-  putbak                      221  local   12/19/80  16:12:06
# putbak - push character back onto input
   subroutine putbak(c)
   character c
   include cdefio

   bp = bp + 1
   if (bp > BUFSIZE)
      call error("too many characters pushed back.")
   buf(bp) = c
   return
   end
#-t-  putbak                      221  local   12/19/80  16:12:06
#-h-  putchr                      304  local   12/19/80  16:12:06
# putchr - put single char on output or into evaluation stack
   subroutine putchr(c)
   character c
   include cmacro

   if (cp == 0)
      call putc(c)
   else {
      if (ep > EVALSIZE)
         call error("evaluation stack overflow.")
      evalst(ep) = c
      ep = ep + 1
      }
   return
   end
#-t-  putchr                      304  local   12/19/80  16:12:06
#-h-  stackx                      320  local   12/19/80  16:12:07
 ## stackx - put next expression on arith evaluation stack
 integer function stackx(tok, kind)
 integer tok, kind

 include cexp

 if (top >= MAXSTACK)
        {
        call remark ("arith evaluation stack overflow.")
        return (ERR)
        }
 top = top + 1
 tokst(top) = tok
 kindst(top) = kind
 return(OK)
 end
#-t-  stackx                      320  local   12/19/80  16:12:07
#-t-  macro.r                   26819  local   12/19/80  16:13:13
#-t-  macro                     35447  local   01/07/81  00:30:00
#-h-  mcol                       9625  local   12/24/80  13:30:14
#-h-  mcol.doc                   2351  local   12/24/80  12:44:42
.bp 1
.in 0
.he 'MCOL (1)'10/1/78'MCOL (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
mcol - multicolumn formatting
.nf
.sp
.ti -3
SYNOPSIS
.br
mcol [-cn] [-ln] [-wn] [-gn] [-dn] [file ...]
.fi
.sp
.ti -3
DESCRIPTION
.br
Mcol reads the named files and formats them into multicolumn
output on the standard output.
If the filename "-" is given, or no files are specified, the
standard input is read.

The options are as follows.
.sp
.in +5
.ti -5
-cn  Format the output into "n" columns.  Default is 2.
.sp
.ti -5
-ln  Set the output page size to "n".  Mcol produces its output
in pages, but does not place separators between the pages on
the assumption that some subsequent processor will do that.
(The default page length is 55.)
.sp
.ti -5
-wn  Set the column width to "n" characters.  Lines longer than "n"
characters are truncated.
(The default column width is 60.)
.sp
.ti -5
-gn  Set the "gutter" width to "n".  The gutter is the white space
between columns.
(The default gutter width is 8.)
.sp
.ti -5
-dn  Assume output is to be printed on a display terminal.  The
column size is set to "n" characters and the page size is set to
24 lines.  The number of columns and gutter width are computed
to maximize the amount of information on a single screen.
If "n" is omitted, 10 is used, which is useful for displaying
lists of file names.
.sp
.in -5
.fi
.sp
.ti -3
FILES
.br
None
.sp
.ti -3
SEE ALSO
.br
.sp
.ne 2
.ti -3
DIAGNOSTICS
.br
.nf
invalid column count
invalid page size
invalid column width
invalid gutter width
.br
.fi
.in +3
The value of one of the option flags is invalid or exceeds
the limitations of mcol.
.sp
.ti -3
ignoring invalid flag
.br
A command argument option flag was given which mcol didn't recognize.
.in -3
.sp
insufficient buffer space
.br
.in +3
Mcol could not buffer an entire page.  This is usually the result
of options that specify a large page size or many columns.
The buffer size is set by the MAXBUF definition in the source code.
.in -3
.sp
too many lines
.in +3
.br
The number of lines per page times the number of columns
exceeded mcol's line buffer space.
The maximum number of lines allowed is set by the MAXPTR definition
in the source code.
.in -3
.fi
.sp
.ne 2
.ti -3
BUGS/DEFICIENCIES
.br
.sp
.ti -3
AUTHORS
.br
Original by David Hanson and friends (U. of Arizona), with
modifications by Debbie Scherrer (LBL).
#-t-  mcol.doc                   2351  local   12/24/80  12:44:42
#-h-  cmcol                       378  local   12/24/80  12:44:43
 ## common block to hold line buffers for mcol tool
 #  put on a file called 'cmcol'
 #  used only by the mcol tool

   common /ccol/ col, nextbf, linbuf(MAXBUF), linptr(MAXPTR)
      integer col	# current column number on formatted page
      integer nextbf	# next available slot in linbuf
      character linbuf	# holds a formatted page
      integer linptr	# points to lines
#-t-  cmcol                       378  local   12/24/80  12:44:43
#-h-  mcol.r                     6500  local   12/24/80  12:44:43
#-h-  mcol                       1293  local   12/24/80  12:43:58
# mcol - format standard input into multiple columns

 # include ratdef
 define(COLUMNS,2)	# defaults
 define(PAGESIZE,55)
 define(GUTTER,8)
 define(LINESIZE,60)
 define(MAXBUF,7000)	# size limits
 define(MAXPTR,1200)

 DRIVER(mcol)
   integer pagsiz, linsiz, ncols, gutsiz, lineno, nlines, i, j, fd
   integer readln, ctoi, getarg, mod, max, open
   character arg(MAXLINE)
   include cmcol

   for (i = 1; i <= MAXPTR; i = i + 1)	# clear pointer array
      linptr(i) = 0
   col = 0
   nextbf = 1
   pagsiz = PAGESIZE		# set defaults
   linsiz = LINESIZE
   ncols = COLUMNS
   gutsiz = GUTTER
   fd = ERR
   call query ("usage: mcol [-cn] [-ln] [-wn] [-gn] [-dn] [file].")
   for (i = 1; getarg(i, arg, MAXLINE) ^= EOF; i = i + 1) {
      if (arg(1) == MINUS & arg(2) ^= EOS)
          call colarg (arg, pagsiz, ncols, gutsiz, linsiz)
      else if (arg(1) == MINUS & arg(2) == EOS)
          call docol (pagsiz, ncols, gutsiz, linsiz, STDIN)
       else
             {
             fd = open(arg, READ)
             if (fd == ERR)
              		call cant(arg)
             call docol(pagsiz, ncols, gutsiz, linsiz, fd)
             call close (fd)
             }
         }
   if (fd == ERR)        #read STDIN
         call docol (pagsiz, ncols, gutsiz, linsiz, STDIN)
    DRETURN
   end
#-t-  mcol                       1293  local   12/24/80  12:43:58
#-h-  colarg                     1154  local   12/24/80  12:43:59
 ## colarg - process flags for mcol tool
 subroutine colarg (arg, pagsiz, ncols, gutsiz, linsiz)
 integer pagsiz, ncols, gutsiz, linsiz, j
 integer ctoi
 character arg(ARB)

 j = 3
 j = ctoi(arg, j)
 if (arg(2) == LETC | arg(2) == BIGC)
	{
	 ncols = j
	 if (ncols <= 0)
		call error ("invalid column count.")
	}
 else if (arg(2) == LETL | arg(2) == BIGL)
	{
 	pagsiz = j
	if (pagsiz <= 0)
		call error ("invalid page size.")
	}
  else if ( (arg(2) == LETW | arg(2) == BIGW) |
            (arg(2) == LETS | arg(2) == LETS) )  #UofA convention
	{
 	linsiz = j
	if (linsiz <= 0)
		call error ("invalid column width.")
	}
 else if (arg(2) == LETG | arg(2) == BIGG)
	{
 	gutsiz = j
	if (gutsiz < 0)
		call error ("invalid gutter width.")
	}
 else if (arg(2) == LETD | arg(2) == BIGD)
	{
 	pagsiz = 23		# display defaults
 	linsiz = 10
 	ncols = 7
 	gutsiz = 1
 	if (j > 0)   # set column width and number of columns
		{
 		linsiz = j
 		ncols = max(1, 81/(linsiz+1))
 		if (ncols > 1)
			{
 			gutsiz = (79 - (linsiz+1)*ncols)/(ncols - 1)+1
 			if (gutsiz <= 0)
 				ncols = ncols - 1
 			}
 		}
	}
 else
 	call remark ("ignoring invalid flag.")
 return
 end
#-t-  colarg                     1154  local   12/24/80  12:43:59
#-h-  colerr                      148  local   12/24/80  12:43:59
 ## colerr - print error in mcol usage and stop
 subroutine colerr

 call error ("usage: mcol [-cn] [-ln] [-wn] [-gn] [-dn] [file] .")
 return
 end
#-t-  colerr                      148  local   12/24/80  12:43:59
#-h-  docol                       691  local   12/24/80  12:43:59
 ## docol - process file for mcol
 subroutine docol (pagsiz, ncols, gutsiz, linsiz, fd)
 integer pagsiz, ncols, gutsiz, linsiz, fd, nlines, lineno, i
 integer readln
 include cmcol

 nlines = pagsiz*ncols	# total number of lines/page
 if (nlines > MAXPTR)
        call error ("too many lines.")
 for (lineno = 1; readln(i, linsiz, fd) ^= EOF; lineno = lineno + 1)
      {
      call inject(i, lineno)
      if (lineno >= nlines) {
         call outbuf(pagsiz, linsiz, gutsiz)
         lineno = 0
         }
      }
   if (lineno > 1) {
      pagsiz = lineno/ncols
      if (mod(lineno, ncols) ^= 0)
         pagsiz = pagsiz + 1
      call outbuf(pagsiz, linsiz, gutsiz)
      }
 return
 end
#-t-  docol                       691  local   12/24/80  12:43:59
#-h-  inject                      235  local   12/24/80  12:44:00
# inject - insert pointer ptr into linptr array
   subroutine inject(ptr, lineno)
   integer ptr, lineno
   include cmcol

   if (lineno > MAXPTR)
      call error("insufficient buffer space.")
   linptr(lineno) = ptr
   return
   end
#-t-  inject                      235  local   12/24/80  12:44:00
#-h-  outbuf                      520  local   12/24/80  12:44:00
# outbuf - dump current buffer to formatted page
   subroutine outbuf(pagsiz, linsiz, gutsiz)
   integer pagsiz, linsiz, gutsiz
   integer i, j
   include cmcol

   for (i = 1; linptr(i) ^= 0; i = i + 1) {
      call outlin(linbuf(linptr(i)))
      linptr(i) = 0
      for (j = i + pagsiz; linptr(j) ^= 0; j = j + pagsiz) {
         call outtab((linsiz + gutsiz)*((j - 1)/pagsiz))
         call outlin(linbuf(linptr(j)))
         linptr(j) = 0
         }
      call outch(NEWLINE)
      }
   nextbf = 1
   return
   end
#-t-  outbuf                      520  local   12/24/80  12:44:00
#-h-  outch                       189  local   12/24/80  12:44:01
# outch - output c to formatted page
   subroutine outch(c)
   character c
   include cmcol

   call putc(c)
   if (c == NEWLINE)
      col = 0
   else
      col = col + 1
   return
   end
#-t-  outch                       189  local   12/24/80  12:44:01
#-h-  outlin                      185  local   12/24/80  12:44:01
# outlin - output str to formatted page
   subroutine outlin(str)
   character str(ARB)
   integer i

   for (i = 1; str(i) ^= EOS; i = i + 1)
      call outch(str(i))
   return
   end
#-t-  outlin                      185  local   12/24/80  12:44:01
#-h-  outtab                      160  local   12/24/80  12:44:01
# outtab - tab to column n on formatted page
   subroutine outtab(n)
   integer n
   include cmcol

   while (col < n)
      call outch(BLANK)
   return
   end
#-t-  outtab                      160  local   12/24/80  12:44:01
#-h-  readln                      605  local   12/24/80  12:44:02
# readln - read next line (<= linsiz) into linbuf; return location p
   integer function readln(p, linsiz, fd)
   integer p, linsiz, fd
   integer i
   character getch
   character c
   include cmcol

   p = nextbf
   for (i = 1; getch(c, fd) ^= EOF; i = i + 1) {
      if (c == NEWLINE)
         break
      if (i <= linsiz) {
         if (nextbf >= MAXBUF)
            call error("insufficient buffer space.")
         linbuf(nextbf) = c
         nextbf = nextbf + 1
         }
      }
   if (c == EOF & i == 1)
      return (EOF)
   linbuf(nextbf) = EOS
   nextbf = nextbf + 1
   return (i - 1)
   end
#-t-  readln                      605  local   12/24/80  12:44:02
#-t-  mcol.r                     6500  local   12/24/80  12:44:43
#-t-  mcol                       9625  local   12/24/80  13:30:14
#-h-  mv                         1642  local   12/24/80  12:56:23
#-h-  mv.doc                      711  local   12/24/80  12:53:25
.bp 1
.in 0
.he 'MV (1)'7/16/79'MV (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
mv - move (rename) a file
.nf
.sp
.ti -3
SYNOPSIS
.br
mv file1 file2
.fi
.sp
.ti -3
DESCRIPTION
.br
Mv changes the name of "file1" to "file2".
If "file2" already exists, it is overwritten.
Mv usually performs a "rename" operation, but in cases
where this fails, it copies "file1" to "file2"
and then deletes "file1".
.fi
.sp
.ti -3
FILES
.br
None
.sp
.ne 2
.ti -3
SEE ALSO
.br
rm
.fi
.sp
.ti -3
AUTHORS
.br
David Hanson and friends (U. of Arizona)
.sp
.ne 2
.ti -3
BUGS/DEFICIENCIES
.br
Results may be strange if the terminal is specified as
either file.
.sp
If mv must copy "file1", it does so assuming that
"file1" is a character file.
#-t-  mv.doc                      711  local   12/24/80  12:53:25
#-h-  mv.r                        667  local   12/24/80  12:53:25
# mv - move file1 to file2, copying if necessary.
 DRIVER(mv)
   character file1(MAXNAME), file2(MAXNAME)
   integer fd1, fd2
   integer amove, open, create, getarg, getch

   if (getarg(1, file1, MAXNAME) == EOF |
       getarg(2, file2, MAXNAME) == EOF)
          call error("usage: mv file1 file2.")
   if (amove(file1, file2) == ERR) {	# must copy
      fd1 = open(file1, READ)
      if (fd1 == ERR)
         call cant(file1)
      fd2 = create(file2, WRITE)
      if (fd2 == ERR)
         call cant(file2)
      while (getch(c, fd1) ^= EOF)
         call putch(c, fd2)
      call close(fd1)
      call close(fd2)
      call remove(file1)
      }
 DRETURN
   end
#-t-  mv.r                        667  local   12/24/80  12:53:25
#-t-  mv                         1642  local   12/24/80  12:56:23
#-h-  os                         2496  local   01/07/81  00:30:07
#-h-  os.doc                      910  local   01/07/81  00:29:33
.bp 1
.in 0 
.he 'OS (1)'1/16/79'OS (1)'
.fo ''-#-' 
.fi 
NAME 
.br 
.in 7 
os - overstrike - convert backspaces into multiple lines
.sp 1 
.in 
SYNOPSIS 
.br 
.in 7 
os
[file ...]
.sp 1 
.in 
DESCRIPTION 
.br 
.in 7 
Os
(overstrike) looks for backspaces in the files specified and 
generates a sequence of print lines with carriage control codes
to reproduce the effect of the backspaces.
 
If no files are given, or the filename '-' appears, input is
taken from the standard input.
.sp 1
.in 
FILES 
.br 
.in 7 
.sp 1 
.in 
SEE ALSO 
.br 
.in 7 
detab, lpr (if one is implemented)
.sp 1 
.in 
DIAGNOSTICS 
.br 
.in 7 
A message is printed if an input file cannot be opened; further
processing is terminated.
.sp 1 
.in 
AUTHORS 
.br 
.in 7 
.sp 1 
Original from Kernighan & Plauger's 'Software Tools', with 
minor modifications by Debbie Scherrer, Lawrence Berkeley Laboratory.
.sp 1 
.in 
BUGS 
.br 
.in 7 
#-t-  os.doc                      910  local   01/07/81  00:29:33
#-h-  os.r                       1322  local   01/05/81  23:23:52
 ## definitions for overstrike tool
 # put on a file named 'oversym'
 # Used only by overstrike
 
 define(NOSKIP,PLUS)		#suppress carriage-return/line feed
 define(SKIP,BLANK)
 #---------------------------------------------------------------------
 ## os - convert backspaces into multiple lines
 DRIVER(os)
 
 character buf(MAXLINE)
 integer getarg, open
 integer i, fd
 
 call query ("usage:  os [file].")
 for (i=1; getarg(i, buf, MAXLINE) != EOF; i=i+1)
	{
	if (buf(1) == MINUS & buf(2) == EOS)
		fd = STDIN
	else
		{
		fd = open(buf,READ)
		if (fd == ERR)
			call cant(buf)
		}
	call overs (fd)
	if (fd != STDIN)
		call close(fd)
	}
 if (i == 1)
	call overs (STDIN)
 
 DRETURN
 end
 ## overs - convert backspaces into multiple lines from file -int-
 subroutine overs(int)
 character getch
 character c
 integer col, newcol, int
 
 col = 1
 repeat
	{
	newcol = col
	while (getch(c,int) == 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
	}
 return
 end
#-t-  os.r                       1322  local   01/05/81  23:23:52
#-t-  os                         2496  local   01/07/81  00:30:07
#-h-  pl                         7494  local   12/24/80  13:02:07
#-h-  pl.doc                     1752  local   12/24/80  12:58:33
.bp 1
.in 0
.he 'PL (1)'9/18/79'PL (1)
.sp 2
.in +3
.fi
.ti -3
NAME
.br
pl - print specified lines/pages in a file
.nf
.sp
.ti -3
SYNOPSIS
.br
pl [-pn] numbers [file ...]
.fi
.sp
.ti -3
DESCRIPTION
.br
Pl
prints the specified lines from each of the named files
on the standard output.  If no files are given, or if
the name "-" is specified, pl reads the standard input.
.sp
The "numbers" argument is a list of line numbers
separated by commas, e.g.
.sp
.in +3
.nf
pl 4,5,26,55 foo bazrat
.in -3
.sp
.fi
prints lines 4, 5, 26, and 55 in file "foo" and
"bazrat".  The line
numbers may be given in any order.
Repeated numbers cause the specified lines to be
printed once for each occurrence of the line number.
Line number ranges can also be given, e.g. 4-15.
.sp
The "-p" option causes pl to print pages instead of lines,
and the numbers refer to page numbers.  If an integer follows
the "-p", it is taken as the page size; the default is 23.
Repeated numbers cause the specified pages to be printed
once for each occurrence of the page number.
.fi
.sp
.ne 2
.ti -3
DIAGNOSTICS
.br
bad page size
.in +5
Invalid page size specified after '-p' flag
.in -5
bad number
.in +5
Invalid number given as argument
.in -5
bad range
.in +5
Invalid range given as argument
.in -5
too many numbers
.in +5
Number of lines/pages specified overflowed the buffer.
Maximum number of lines is determined by the MAXLINES definition
in the source code.
.in -5
ignoring invalid argument
.in +5
An invalid flag was specified.   Processing continues.
.in -5
.fi
.sp
.ti -3
AUTHORS
.br
David Hanson and friends (U. of Arizona)
.sp
.ti -3
BUGS/DEFICIENCIES
.br
There is a limit to the size of pages which can be buffered.
This is set by the MAXBUF definition in the source code.
#-t-  pl.doc                     1752  local   12/24/80  12:58:33
#-h-  pl.r                       5478  local   12/24/80  12:58:33
#-h-  pl                         1226  local   12/24/80  12:58:11
# pl - print specified lines or pages of given files

 # include ratdef
 define(MAXBUF,3000)
 define(MAXLINES,200)
 define(EOL,-1)
 define(PAGESIZE,23)	# default page size

 DRIVER(pl)
   character arg(MAXLINE)
   integer getarg, open, ctoi, addset
   integer fd, i, j, l, u, lp, list(MAXLINES), pagsiz, pflag, junk

   pflag = NO
   i = 1
   pagsiz = 1
   list(1) = EOL
   call query ("usage:  pl [-pn] numbers [file].")
 for (i=1; getarg(i, arg, MAXLINE) != EOF; i=i+1)
   {
   if (arg(1) == MINUS & arg(2) != EOS)        # pick up flags
	{
	call doflag(arg, pflag, pagsiz)
	next
	}
    if (list(1) == EOL)	      # need some numbers
    	lp = gnum (arg, list)     # break out numbers
     else
	{
      if (arg(1) == MINUS & arg(2) == EOS)
         fd = STDIN
      else
         fd = open(arg, READ)
      if (fd == ERR)
         call cant(arg)
      if (list(1) == EOL)     # need some numbers
		call error ("usage:  pl [-pn] numbers [file].")
      call plines(fd, list, pagsiz)
      if (fd ^= STDIN)
         call close(fd)
      }
    }

   if (list(1) == EOL)
	call error ("usage:  pl [-pn] numbers [file].")
   if (fd == ERR)
           # no files specified
      call plines(STDIN, list, pagsiz)
    DRETURN
   end
#-t-  pl                         1226  local   12/24/80  12:58:11
#-h-  doflag                      462  local   12/24/80  12:58:11
 ## doflag - process flags for pl tool
 subroutine doflag (arg, pflag, pagsiz)
 character arg(ARB)
 integer pflag, pagsiz
 integer ctoi

 if (arg(2) == LETP | arg(2) == BIGP)	  # print pages
      {
      pflag = YES
      j = 3
      pagsiz = ctoi(arg, j)
      if (pagsiz < 0 | arg(j) ^= EOS)
         call error("bad page size.")
      if (pagsiz == 0)
         pagsiz = PAGESIZE	#default
      }
else
	call remark ("ignoring invalid argument.")
 return
 end
#-t-  doflag                      462  local   12/24/80  12:58:11
#-h-  get                         492  local   12/24/80  12:58:12
# get - get next n lines from fd into buf
   integer function get(n, buf, fd)
   integer n, fd
   character buf(MAXBUF)
   integer i
   character getch, c

   i = 1
   for (m = n; m > 0; m = m - 1) {
      while (getch(c, fd) ^= EOF) {
         if (i < MAXBUF) {
            buf(i) = c
            i = i + 1
            }
         if (c == NEWLINE)
            break
         }
      if (c == EOF)
         break
      }
   buf(i) = EOS
   if (c == EOF)
      return(EOF)
   return(n)
   end
#-t-  get                         492  local   12/24/80  12:58:12
#-h-  gnum                        883  local   12/24/80  12:58:12
 ## gnum - get numbers for pl tool
 integer function gnum (arg, list)
 integer list(ARB), lp, j
 character arg(ARB)
 integer ctoi

 lp = 0
 for (j=1; arg(j) ^= EOS;  )
	{
	lp = lp + 1
        if (lp > MAXLINES)
		call error ("too many numbers.")
	list(lp) = ctoi(arg, j)
	if (list(lp) <= 0)
		call error ("bad number.")
      if (arg(j) == MINUS) {	# have l-u specification
         j = j + 1
         u = ctoi(arg, j)
         l = list(lp)
         if ( u < l)
            call error("bad range.")
         for (l = l + 1; l <= u; l = l + 1)
	    {
            lp = lp + 1
	    if (lp > MAXLINES)
		call error ("too many numbers.")
	    list(lp) = l
	    }
         }
      while (arg(j) == COMMA | arg(j) == BLANK | arg(j) == TAB)
         j = j + 1
      }
 if (lp+1 > MAXLINES)
	call error ("too many numbers.")
 list(lp+1) = EOL
   call shell (list, lp)
 gnum = lp
 return
 end
#-t-  gnum                        883  local   12/24/80  12:58:12
#-h-  plines                      590  local   12/24/80  12:58:12
# plines - print pages from fd as specified in sorted list.
   subroutine plines(fd, list, pagsiz)
   integer fd, list(MAXLINES), pagsiz
   integer i, j, n, get, skip, len, junk
   character buf(MAXBUF)

   n = 0
   for (i = 1; list(i) ^= EOL; ) {
      if (skip(pagsiz*(list(i) - n - 1), fd) == EOF)
         return
      len = get(pagsiz, buf, fd)
      for (j = i; list(j) == list(i); i = i + 1)
         call putlin(buf, STDOUT)
      if (len == EOF)
         return
      n = list(j)
      }
   if (fd == STDIN)	# must flush standard input
      junk = skip(HUGE, fd)
   return
   end
#-t-  plines                      590  local   12/24/80  12:58:12
#-h-  shell                       576  local   12/24/80  12:58:12
 ## shell - Shell sort v(1)...v(n) increasing
 subroutine shell (v, n)
 integer gap, i, j, jg, k, n, v(ARB)

 for (gap=n/2; gap>0; gap=gap/2)
        for (i=gap+1; i<=n; i=i+1)
                for (j=i-gap; j>0; j=j-gap)
                        {
                        jg = j + gap
                        if (v(j) <= v(jg))      #compare
                                break
                        k = v(j)                #exchange
                        v(j) = v(jg)            #
                        v(jg) = k               #
                        }
 return
 end
#-t-  shell                       576  local   12/24/80  12:58:12
#-h-  skip                        325  local   12/24/80  12:58:13
# skip - skip n lines on fd
   integer function skip(n, fd)
   integer n, fd
   integer m
   character getch, c

   for (m = n; m > 0; m = m - 1) {
      while (getch(c, fd) ^= EOF)
         if (c == NEWLINE)
            break
      if (c == EOF)
         break
      }
   if (c == EOF)
      return(EOF)
   return(n)
   end
#-t-  skip                        325  local   12/24/80  12:58:13
#-t-  pl.r                       5478  local   12/24/80  12:58:33
#-t-  pl                         7494  local   12/24/80  13:02:07
#-h-  pr                         5772  local   01/07/81  00:18:00
#-h-  pr.doc                     1207  local   12/24/80  13:04:17
.bp 1
.in 0
.he 'PR (1)'1/15/77'PR (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
print - paginate files to standard output
.nf
.sp
.ti -3
SYNOPSIS
.br
pr [-ln] [file ...]
.fi
.sp
.ti -3
DESCRIPTION
.br
Pr
paginates the named files to standard output.
Each file is printed as a sequence of pages.  Each page
is 66 lines
long, including a 6-line header and 3-line footer.
The header includes the file name, possibly the date, and
the page number.

If the file '-' is specified, or no file names are given,
the standard input is read.

Option flags include:
.in +11
.ti -5
-ln   Sets the page length to 'n'.
Default page length is 66.
.in -11
.sp
.fi
.ne 2
.ti -3
SEE ALSO
.br
os, detab, mcol, format, cat
.sp
.ti -3
DIAGNOSTICS
.br
ignoring invalid argument
.in +3
An option flag was specified which pr did not understand

.in -3
A message is printed if an input file could not be opened
.sp
.ti -3
AUTHORS
.br
Original from the Kernighan-Plauger 'Software Tools' book,
with modifications by David Hanson and friends (U. of Arizona)
and Debbie Scherrer (LBL)
.sp
.ti -3
BUGS/DEFICIENCES
.br
The header and trailer spacing can be modified by adjusting the
MARGIN1, MARGIN2, and
BMARGIN definitions in the source code.
#-t-  pr.doc                     1207  local   12/24/80  13:04:17
#-h-  cprint                      746  local   12/24/80  13:04:17
 ## common block to hold info for pr tool
 #  put on a file called 'cprint'
 #  used only by the pr tool

 common /cprint/  mar1, mar2, bmar, dohead, dotail, plen
        integer mar1    #distance between top of page and header
                        #(default = 3)
        integer mar2    #distance between header and text
                        #(default = 2)
        integer bmar    #distance between text and bottom of page
                        #(default = 6)
        integer dohead  #flag to cause/suppress printing of header
                        # (default = YES)
        integer dotail  #flag to cause/suppress printing of bottom
                        #margin  (default = YES)
        integer plen    #page length (default = 66)
#-t-  cprint                      746  local   12/24/80  13:04:17
#-h-  pr.r                       3472  local   12/24/80  13:21:34
#-h-  print                      1441  local   12/24/80  13:03:50

  # include ratdef
 define(MARGIN1,3)
 define(MARGIN2,2)
 define(BMARGIN,3)
 define(PAGELEN,66)

 ## print - print files with headings
 DRIVER(print)
    character name(FILENAMESIZE)
    integer getarg, open, ctoi
    integer fd, i, j
    include cprint
    string null ""

    mar1 = MARGIN1		#set defaults
    mar2 = MARGIN2
    bmar = BMARGIN
    dohead = YES
    plen = PAGELEN
    fd = ERR
    call query ("usage:  pr [-ln] [file].")
    for (i = 1; getarg(i, name, FILENAMESIZE) ^= EOF; i = i + 1)
	{
       if (name(1) == MINUS & name(2) != EOS)
                {                  #it is anticipated that more
                                   #options may be added in the future
		if (name(2) == LETL | name(2) == BIGL) #set page length
			{
                         j = 3
                         plen = ctoi(name, j)
                         if ((plen-mar1-mar2-bmar-2) <= 0)
                              call error ("page too small.")
			}
		else
			call remark ("ignoring invalid argument.")
		}
        else if (name(1) == MINUS & name(2) == EOS)
	        {
		fd = STDIN
		call fprint (null, STDIN)
		}
	else
		{
       		fd = open(name, READ)
       		if (fd == ERR)
          		call cant(name)
       		call fprint(name, fd)
       		call close(fd)
                }
       }
    if (fd ==ERR)    # no input file specified
       call fprint(null, STDIN)
   DRETURN
    end
#-t-  print                      1441  local   12/24/80  13:03:50
#-h-  fprint                      785  local   12/24/80  13:03:50
 # fprint - print file "name" from  fd
    subroutine fprint(name, fd)
    integer line(MAXLINE), name(ARB)
    integer getlin
    integer fd, lineno, pageno

    include cprint

    pageno = 0
    lineno = 0
    while (getlin(line, fd) ^= EOF) {
       if (lineno == 0)
          {
          pageno = pageno + 1
          if (dohead == YES)
		{
          	call skip(mar1)
          	call head(name, pageno)
          	call skip(mar2)
                lineno = mar1 + mar2 + 1
                }
          }
       call putlin(line, STDOUT)
       lineno = lineno + 1
       if (lineno + bmar >= plen)
          {
          call skip(bmar)
          lineno = 0
          }
       }
    if (lineno > 0)
       {
       call skip(plen-lineno)
        call skip(bmar)
	}
    return
    end
#-t-  fprint                      785  local   12/24/80  13:03:50
#-h-  head                        266  local   12/24/80  13:03:51
 # head - print top of page header
    subroutine head(name, pageno)
    integer name(ARB)
    character cdate(9), ctime(9)
    integer now(7)
    integer pageno
    string blanks "   "
    string page " Page  "

    call putlin(name, STDOUT)
    call putlin (blanks, STDOUT)
    call getnow (now)
    call fmtdat (cdate, ctime, now, 0)
    call putlin (cdate, STDOUT)
    call putch (BLANK, STDOUT)
    call putlin (ctime, STDOUT)
    call putlin (blanks, STDOUT)
    call putlin(page, STDOUT)
    call putdec(pageno, 1)
    call putc(NEWLINE)
    return
    end
#-t-  head                        266  local   12/24/80  13:03:51
#-h-  skip                        154  local   12/24/80  13:03:51
 # skip - output  n  blank lines
    subroutine skip(n)
    integer i, n

    for (i = 1; i <= n; i = i + 1)
       call putc(NEWLINE)
    return
    end
#-t-  skip                        154  local   12/24/80  13:03:51
#-t-  pr.r                       3472  local   12/24/80  13:21:34
#-t-  pr                         5772  local   01/07/81  00:18:00
#-h-  rev                        1869  local   12/24/80  13:54:00
#-h-  rev.doc                     431  local   12/24/80  13:32:26
.bp 1
.in 0
.he 'REV (1)'7/11/79'REV (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
rev - reverse lines
.nf
.sp
.ti -3
SYNOPSIS
.br
rev [files ...]
.fi
.sp
.ti -3
DESCRIPTION
.br
Rev copies the named files to the standard output,
reversing the order of the characters in every
line.

If no files are given, or the filename '-' is specified,
rev reads from the standard input.
.sp
.ti -3
AUTHORS
.br
David Hanson and friends (U. of Arizona)
#-t-  rev.doc                     431  local   12/24/80  13:32:26
#-h-  rev.r                      1174  local   12/24/80  13:32:26
#-h-  rev                         622  local   12/24/80  13:32:13
# rev - reverse lines
 DRIVER(rev)
  character lin(MAXLINE)
  integer i, fd
  integer getarg, open

  call query ("usage:  rev [files].")
 fd = ERR
 for (i=1; getarg(i, lin, FILENAMESIZE) != EOF; i=i+1)
        {
        if (lin(1) == MINUS & lin(2) == EOS)
                fd = STDIN
        else
                {
                fd = open(lin, READ)
                if (fd == ERR)
                        call cant(lin)
                }
        call revl(fd)
        if (fd != STDIN)
                call close(fd)
        }

 if (fd == ERR)         #no files given, read STDIN
        call revl(STDIN)
  DRETURN
 end
#-t-  rev                         622  local   12/24/80  13:32:13
#-h-  revl                        288  local   12/24/80  13:32:14
 ## revl - reverse lines in file 'fd'
 subroutine revl(fd)
 integer fd, i
 integer getlin
 character lin(MAXLINE)


  for (i = getlin(lin, fd); i ^= EOF; i = getlin(lin, fd)) {
     for (i = i - 1; i > 0; i = i - 1)
        call putc(lin(i))
     call putc(NEWLINE)
     }
  return
  end
#-t-  revl                        288  local   12/24/80  13:32:14
#-t-  rev.r                      1174  local   12/24/80  13:32:26
#-t-  rev                        1869  local   12/24/80  13:54:00
#-h-  rm                         4068  local   12/24/80  13:48:22
#-h-  rm.doc                     1350  local   12/24/80  13:39:03
.bp 1
.in 0
.he 'RM (1)'7/9/80'RM (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
rm - remove (delete) files
.nf
.sp
.ti -3
SYNOPSIS
.br
rm [-v] [-a] [files ....]
.fi
.sp
.ti -3
DESCRIPTION
.br
Rm removes (deletes) the named files.  The -v option ("verbose")
causes rm to print the name of each file as it is removed.

The -a option ("ask") causes rm to print the message
.sp
.in +3
.nf
name ?
.in -3
.sp
.fi
for each file "name" that is to be removed and read one line
from the user's terminal.  If the line begins with "y", the file
is removed.
If the line begins with 'q', no further files in the list
are removed.
If the line begins with "g", the file is removed,
along with all subsequent files in the list,
and the -a option is turned off.
If the line begins with
anything else, the file is not removed.

If the filename '-' is specified as an argument,
the names of files to be removed
will be read from standard input, one per line.
.fi
.sp
.ne 2
.ti -3
DIAGNOSTICS
.br
name: can't remove
.br
.in +3
The named file did not exist or could not be removed.
.in -3
.sp
.ti -3
AUTHORS
.br
David Hanson and friends (U. of Arizona), with changes by
Debbie Scherrer (LBL)
.sp
.ti -3
BUGS/DEFICIENCIES
.br
Watch out for the 'g' response when using the -a flag and a
list of files from standard input--it'll cause all subsequent
files in the list to be removed.
#-t-  rm.doc                     1350  local   12/24/80  13:39:03
#-h-  rm.r                       2454  local   12/24/80  13:44:20
#-h-  rm                         1283  local   12/24/80  13:38:39
# rm - remove (delete) files
 DRIVER(rm)
   character arg(MAXLINE)
   integer i, j, vflag, aflag, ttyin, ttyout, len
   integer getarg, open, getlin, kill
   string trmin TERMINAL_IN
   string trmout TERMINAL_OUT

   vflag = NO
   aflag = NO
   call query ("usage:  rm [-v] [-a] [files].")
   for (i = 1; getarg(i, arg, MAXLINE) ^= EOF; i = i + 1)
      {
      if (arg(1) == MINUS & (arg(2) == LETV | arg(2) == BIGV))
         vflag = YES
      else if (arg(1) == MINUS & (arg(2) == LETA | arg(2) == BIGA))
        {
         aflag = YES
        ttyin = open(trmin, READ)    #open users terminal for prompting
        ttyout = open(trmout, WRITE)
        if (ttyin == ERR | ttyout == ERR)
                call error ("can't open users terminal.")
        }
      else if (arg(1) == MINUS & arg(2) == EOS)
        {
        for (len=getlin(arg,STDIN); len!=EOF; len=getlin(arg,STDIN))
                {
                arg(len) = EOS       # remove NEWLINE char
                if ( kill (arg, aflag, vflag, ttyin, ttyout) == EOF)
                        break
                }
        }
      else
        if ( kill (arg, aflag, vflag, ttyin, ttyout) == EOF)
                 break
         }

    DRETURN
   end
#-t-  rm                         1283  local   12/24/80  13:38:39
#-h-  kill                        975  local   12/24/80  13:38:39
 ## kill - remove file; asking permission if requested
 integer function kill (name, aflag, vflag, ttyin, ttyout)
 character name(ARB), line(MAXLINE)
 integer aflag, vflag, ttyin, ttyout
 integer getlin, remove

 if (aflag == YES) {
        call putlin(name, ttyout)
        call putch(BLANK, ttyout)
        call putch(QMARK, ttyout)
        call putch(BLANK, ttyout)
        call flush (ttyout)
        if (getlin(line, ttyin) == EOF)
                return(EOF)
       if (line(1) == LETG | line(1) == BIGG)
               aflag = NO
       else if (line(1) == LETQ | line(1) == BIGQ)    # quit
               return(EOF)
       else if ((line(1) ^= LETY) & (line(1) ^= BIGY))
               return(OK)
      }
  if (remove(name) == ERR) {
            call putlin(name, ERROUT)
            call remark(": can't remove.")
            }
   else if (vflag == YES) {
            call putlin(name, ERROUT)
            call putch(NEWLINE, ERROUT)
            }
 return(OK)
 end
#-t-  kill                        975  local   12/24/80  13:38:39
#-t-  rm.r                       2454  local   12/24/80  13:44:20
#-t-  rm                         4068  local   12/24/80  13:48:22
#-h-  sedit                     25362  local   12/24/80  14:40:08
#-h-  sedit.doc                  4994  local   12/24/80  14:07:05
.bp 1
.in 0
.he 'SEDIT (1)'11/30/79'SEDIT (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
sedit - stream editor
.nf
.sp
.ti -3
SYNOPSIS
.br
sedit [-n] {[-e script | -f sfile]... | script} [file]...
.fi
.sp
.ti -3
DESCRIPTION
.br
Sedit
copies the named input
files
to the standard output, performing
editing as directed by sedit commands in "script" or
in "sfile".
The -e
flag indicates that the next argument is
to be interpreted as an sedit command (see below).
The -f
flag indicates that the next argument is the name of a file
in which
sedit commands appear one per line.
The
-e and -f
arguments may be intermixed in any order.
The order of command
execution
is the order in which commands are read.
If no
-e or -f
flags are given, the first argument is used as an sedit command.
Normally, sedit writes each line of input to the output after editing;
the -n option suppresses this action.  As a result, the only output
is that resulting from sedit commands.
.sp
When the first argument not in the scope of a flag is encountered,
it and all succeeding arguments are taken as input files.
If no files are given, or if the name "-" is specified, the
standard input is read.
.sp
Sedit commands
have the general form
.sp
.in +3
.nf
line1 [, line2] command arguments
.in -3
.sp
.fi
A line number (line1 or line2) is either a decimal number
that refers to a specific input line (input lines
are counted cumulatively across files), a "$" that
refers to the last line of input,
or a /pattern/ where pattern is a regular expression (as in edit).
Line number 0 may be used to specify commands that should be
executed before any input is read.
.sp
A command with no line numbers
is applied to every line of input.
A command with one line number
is applied to every line of input that matches the line number.
A command with two line numbers
is applied to every line of input beginning with the first line
that matches line1 through the next line that
matches line2.  Thereafter, the process is repeated, looking again
for a line that matches line1.
.sp
Sedit accepts the following commands.  Each command may be
used with 0, 1, or 2 line numbers.
The a, c, and i commands may not appear in command line scripts.
.sp
.nf
.cc +
a
<text>
.
+cc .
.fi
.in +3
Append.  The <text> is placed on the output after each selected
line.  The <text> does not change the line number nor is it subject
to subsequent sedit commands.
.in -3
.sp
.ne 5
.nf
.cc +
c
<text>
.
+cc .
.fi
.in +3
Change.  The selected lines are deleted and
<text> is placed on the output in their place.
The <text> does not change the line number nor is it subject
to subsequent sedit commands.
.in -3
.sp
d
.in +3
Delete.  The selected lines are deleted.
.in -3
.sp
.nf
.cc +
i
<text>
.
+cc .
.fi
.in +3
Insert.  The <text> is placed on the output before each selected
line.  The <text> does not change the line number nor is it subject
to subsequent sedit commands.
.in -3
.sp
p
.in +3
Print.  The selected lines are printed on the standard output.
.in -3
.sp
r file
.in +3
Read file.  The contents of "file" are placed on the output after
each selected line exactly as if the contents
were given as <text> in an
a command.  The new lines
do not change the line number nor are they subject
to subsequent sedit commands.
.in -3
.sp
s/pat/new/gp
.in +3
Substitute.  The leftmost
occurrences of pat in the selected lines is changed to new.
If g is specified, all occurrences are changed.  If p is
specified, the resulting line is printed.
.in -3
.sp
w file
.in +3
Write file.  The selected lines are appended to "file".  Files
mentioned in w commands are created before processing begins.
The limit on the number of w commands depends on the number
of files that can be opened at the same time.
.in -3
.sp
=
.in +3
Print line number.  The current line number is printed
on the output as a line.
.in -3
.sp
Text appended by a, c, or r commands is placed on the output in
the same order as the execution of the commands.
Similar comments apply to text inserted by i commands.
.sp
Sedit
can accomodate commands totaling approximately 5000 characters
(including <text> arguments), and lines up to 120 characters in length.
.fi
.sp
.ne 2
.ti -3
SEE ALSO
.br
edit, change, find, tr
.fi
.sp
.ne 2
.ti -3
DIAGNOSTICS
.br
In addition to the usual error messages resulting from file access
failure, sedit issues the following messages preceeding by the
offending command line.
.sp
bad line numbers
.in +3
indicates that the line number expressions are invalid.
.in -3
.sp
invalid command
.in +3
indicates that the command preceeding the message is illegal.
This message is issued for a, i, or c commands if they appear
in command string scripts.
.in -3
.sp
too many commands
.in +3
indicates exhaustion of space to hold commands.
The size of the command buffer is determined by the MAXBUF definition
in the source code.
.in -3
.sp
.ti -3
AUTHOR
.br
Chris Fraser (U. of Arizona)
.sp
.ti -3
BUGS/DEFICIENCIES
.br
The '$' indicator for end-of-file doesn't always work.
#-t-  sedit.doc                  4994  local   12/24/80  14:07:05
#-h-  csedit                      672  local   12/24/80  14:07:07
 ## common block for csedit tool
 #  put on a file called 'csedit'
 #  (used only by csedit)

 common /csedit/ aq, iq, buf(MAXBUF), lastbf, nlines, line1, line2,
   pat(MAXPAT), prevc, nflag
   integer aq		# end of append queue
   integer iq		# end of insert queue
   character buf	# buf for commands
   integer lastbf	# next available character in buf
   integer nlines	# number of line number expressions
   integer line1	# line number 1 or index to pattern
   integer line2	# line number 2 or index to pattern
   character pat	# current pattern during compilation
   integer prevc	# index of previous command
   integer nflag	# YES to print result of "p" commands only
#-t-  csedit                      672  local   12/24/80  14:07:07
#-h-  sedit.r                   19300  local   12/24/80  14:07:08
#-h-  sedit                      4141  local   12/24/80  14:06:02
# sedit - stream editor

 # include ratdef

define(NLINES,0)        # number of line numbers
define(NEXT,1)          # index of next command
define(LINE1,2)         # line number 1 or index of pattern
define(LINE2,3)         # line number 2 or index of pattern
define(COMMAND,4)       # command
define(LIST,5)          # next command on insert/append list
define(TEXT,6)          # text for insert/append or file name for read
define(APPENDCOM,LETA)  # append command
define(CHANGECOM,LETC)  # change command
define(DELETECOM,LETD)  # delete command
define(INSERTCOM,LETI)  # insert command
define(PRINTCOM,LETP)   # print command
define(READCOM,LETR)    # read command
define(SUBSTCOM,LETS)   # substitute command
  define(SUBSTGFLAG,COMMAND+1) # YES for global replacement
  define(SUBSTPFLAG,COMMAND+2) # YES for print
  define(SUBSTPAT,COMMAND+3)   # index of pattern
  define(SUBSTNEW,COMMAND+4)   # index of replacement
define(WRITECOM,LETW)   # write command
  define(WRITEFD,COMMAND+1)    # file descriptor for opened file or 0
define(EQUALCOM,EQUALS) # print line number command

define(INSERTLIST,1)    # location of list of inserts
  define(APPENDLIST,LIST+1)    # location of list of appends
define(COMMANDLIST,1)   # location of command list
  define(FIRSTFREE,APPENDLIST+TEXT)    # first free location in buf

define(MAXBUF,5000)     # size of command buffer
define(LASTLINE,DOLLAR)
define(OK,YES)          # to be compatible with addset/addstr
define(GLOBAL,LETG)     # for getrhs
define(PRINT,LETP)      # for ckp


DRIVER(sedit)
   character arg(MAXLINE), linbuf(MAXLINE)
   integer i, j, nfiles, fd
   integer length, getarg, open, getlin
   include csedit

   call query ( _
     "usage: sedit [-n] [[-e script | -f sfiles] | script] [files].")
   prevc = COMMANDLIST  # initialize lists
   buf(COMMANDLIST+NEXT) = 0
   lastbf = FIRSTFREE
   nflag = NO
   nfiles = 0
   i = 1
   if (getarg (i, arg, MAXLINE) == EOF)
      call usage
   if (arg(1) == MINUS & arg(2) == LETN) {
      nflag = YES
      i = i + 1
      }
   for (; getarg(i, arg, MAXLINE) ^= EOF; i = i + 2)
      if (arg(1) == MINUS & arg(2) == LETF) {           # -f filename
         if (getarg(i + 1, arg, MAXLINE) == EOF)
            call usage
         fd = open(arg, READ)
         if (fd == ERR)
            call cant(arg)
         while (getlin(arg, fd) ^= EOF)
            call compil(arg, fd)
         call close(fd)
         }
      else if (arg(1) == MINUS & arg(2) == LETE) {      # -e script
         if (getarg(i + 1, arg, MAXLINE) == EOF)
             call usage
         j = length(arg)
         arg(j+1) = NEWLINE
         arg(j+2) = EOS
         call compil(arg, NO)
         }
      else      # no flags
         break
   if (lastbf == FIRSTFREE) {   # use argument as script
      if (getarg(i, arg, MAXLINE) == EOF)
          call usage
      j = length(arg)
      arg(j+1) = NEWLINE
      arg(j+2) = EOS
      call compil(arg, NO)
      i = i + 1
      }
   linbuf(1) = EOS
   lineno = 0
   call docmds(linbuf, 0)       # do line 0 commands
   for (; getarg(i, arg, MAXLINE) ^= EOF; i = i + 1) {
      if (arg(1) == MINUS & arg(2) == EOS)
         fd = STDIN
      else
         fd = open(arg, READ)
      if (fd == ERR)
         call cant(arg)
      call sed(linbuf, lineno, fd)
      if (fd ^= STDIN)
         call close(fd)
      nfiles = nfiles + 1
      }
   if (nfiles == 0)
      call sed(linbuf, lineno, STDIN)
   if (linbuf(1) ^= EOS) {      # set last line number and do last line
      lineno = lineno + 1
      for (i = buf(COMMANDLIST+NEXT); i > 0; i = buf(i+NEXT)) {
         if (buf(i+LINE1) == -HUGE)
            buf(i+LINE1) = -lineno
         if (buf(i+LINE2) == -HUGE)
            buf(i+LINE2) = -lineno
         if (buf(i+COMMAND) == CHANGECOM) #clean unsatisfied c commands
            {
            if (buf(i+NLINES) == 2)
               buf(i+NLINES) = 1    # insures changed text is output
            if (buf(i+NLINES) == 3 & (buf(i+LINE2) > 0 |
               -buf(i+LINE2) >= lineno))
               buf(i+LINE2) = -lineno
            }
         }
      call docmds(linbuf, lineno)
      }
   DRETURN
   end
#-t-  sedit                      4141  local   12/24/80  14:06:02
#-h-  addstr                      338  local   12/24/80  14:06:04
# addstr - add s to str(j) if it fits, increment j
   integer function addstr(s, str, j, maxsiz)
   character s(ARB), str(ARB)
   integer j, maxsiz
   integer i, addset

   for (i = 1; s(i) ^= EOS; i = i + 1)
      if (addset(s(i), str, j, maxsiz) == NO) {
         addstr = NO
         return
         }
   addstr = YES
   return
   end
#-t-  addstr                      338  local   12/24/80  14:06:04
#-h-  ckp                         375  local   12/24/80  14:06:04
# ckp - check for "p" after command
   integer function ckp(lin, i, pflag, status)
   character lin(MAXLINE)
   integer i, j, pflag, status
   character clower

   j = i
   if (clower(lin(j)) == PRINT) {
      j = j + 1
      pflag = YES
      }
   else
      pflag = NO
   if (lin(j) == NEWLINE)
      status = OK
   else
      status = ERR
   ckp = status
   return
   end
#-t-  ckp                         375  local   12/24/80  14:06:04
#-h-  compil                     3024  local   12/24/80  14:06:04
# compil - "compile" command in lin(i) from file fd, increment i
   subroutine compil(lin, fd)
   character lin(MAXLINE)
   integer fd
   character file(MAXNAME), sub(MAXPAT)
   integer i, gflag, pflag, status, fdw
   integer addset, addstr, create, getrhs, getfn, ckp, optpat, dotext,
      getlst, length
   character clower
   include csedit

   status = ERR
   i = 1
   if (getlst(lin, i, status) == ERR) {
      call putlin(lin, ERROUT)
      call error("bad line numbers.")
      }
   call skipbl(lin, i)
   buf(prevc+NEXT) = lastbf     # link in new command
   prevc = lastbf
   status = addset(nlines, buf, lastbf, MAXBUF)
   status = addset(0, buf, lastbf, MAXBUF)
   status = addset(line1, buf, lastbf, MAXBUF)
   status = addset(line2, buf, lastbf, MAXBUF)
                                    #fold commands to lower case
   status = addset(clower(lin(i)), buf, lastbf, MAXBUF)
   if (clower(lin(i)) == APPENDCOM & lin(i+1) == NEWLINE & fd ^= NO) {
      status = addset(0, buf, lastbf, MAXBUF)
      status = dotext(fd)
      }
   else if (clower(lin(i)) == CHANGECOM & lin(i+1) == NEWLINE & fd ^= NO) {
      status = addset(0, buf, lastbf, MAXBUF)
      status = dotext(fd)
      }
   else if (clower(lin(i)) == DELETECOM & lin(i+1) == NEWLINE)
      status = OK
   else if (clower(lin(i)) == INSERTCOM & lin(i+1) == NEWLINE & fd ^= NO) {
      status = addset(0, buf, lastbf, MAXBUF)
      status = dotext(fd)
      }
   else if (clower(lin(i)) == PRINTCOM & lin(i+1) == NEWLINE)
      status = OK
   else if (clower(lin(i)) == READCOM) {
      status = addset(0, buf, lastbf, MAXBUF)
      status = getfn(lin, i, file)
      if (status == OK) {
         status = addstr(file, buf, lastbf, MAXBUF)
         status = addset(EOS, buf, lastbf, MAXBUF)
         }
      }
   else if (clower(lin(i)) == SUBSTCOM) {
      i = i + 1
      if (optpat(lin, i) == OK)
         andif (getrhs(lin, i, sub, gflag) == OK)
            status = ckp(lin, i + 1, pflag, status)
      if (status == OK) {
         status = addset(gflag, buf, lastbf, MAXBUF)
         status = addset(pflag, buf, lastbf, MAXBUF)
         status = addset(lastbf + 2, buf, lastbf, MAXBUF)
         status = addset(lastbf + length(pat) + 2, buf, lastbf, MAXBUF)
         status = addstr(pat, buf, lastbf, MAXBUF)
         status = addset(EOS, buf, lastbf, MAXBUF)
         status = addstr(sub, buf, lastbf, MAXBUF)
         status = addset(EOS, buf, lastbf, MAXBUF)
         }
      }
   else if (clower(lin(i)) == WRITECOM) {
      status = getfn(lin, i, file)
      if (status == OK) {
         fdw = create(file, WRITE)
         if (fdw == ERR)
            call cant(file)
         }
      status = addset(fdw, buf, lastbf, MAXBUF)
      }
   else if (clower(lin(i)) == EQUALCOM & lin(i+1) == NEWLINE)
      status = OK
   else
      status = ERR
   if (status ^= OK) {
      call putlin(lin, ERROUT)
      if (lastbf > MAXBUF)
         call error("too many commands.")
      else
         call error("invalid command.")
      }
   return
   end
#-t-  compil                     3024  local   12/24/80  14:06:04
#-h-  docmds                     2289  local   12/24/80  14:06:06
# docmds-execute commands in buf on linbuf, which contains line lineno
   subroutine docmds(linbuf, lineno)
   character linbuf(MAXLINE)
   integer lineno
   integer i, n
   integer match
   include csedit

   aq = APPENDLIST      # initialize append and insert queues
   buf(aq+LIST) = 0
   iq = INSERTLIST
   buf(iq+LIST) = 0
   for (i = buf(COMMANDLIST+NEXT); i ^= 0; i = buf(i+NEXT)) {
      nlines = buf(i+NLINES)
      line1 = buf(i+LINE1)
      line2 = buf(i+LINE2)
     if (nlines == 0)
         call docom(i, linbuf, lineno)
      else if (nlines == 1) {
         if (-line1 == lineno)
            call docom(i, linbuf, lineno)
         else if (line1 > 0)
                 andif (match(linbuf, buf(line1)) > 0)
                    call docom(i, linbuf, lineno)
         }
      else if (nlines == 2) {   # 2 line numbers, searching for line1
         if (-line1 == lineno) {
            buf(i+NLINES) = 3   # found it, change state
            call docom(i, linbuf, lineno)
            }
         else if (line1 > 0)
                 andif (match(linbuf, buf(line1)) > 0) {
                    buf(i+NLINES) = 3
                    call docom(i, linbuf, lineno)
                    }
         }
      else if (nlines == 3) {   # 2 line numbers, searching for line2
         if (line2 <= 0) {
            if (lineno >= -line2)
               buf(i+NLINES) = 2        # found it, change state
            if (lineno <= -line2)
               call docom(i, linbuf, lineno)
            }
         else if (line2 > 0) {
            if (match(linbuf, buf(line2)) > 0)
               buf(i+NLINES) = 2
            call docom(i, linbuf, lineno)
            }
         }
      else
         call error("in docmds: can't happen.")
      if (linbuf(1) == EOS & lineno > 0)
         break
      }
                                           # output inserts
   for (i = buf(INSERTLIST+LIST); i > 0; i = buf(i+LIST))
      call putlin(buf(i+TEXT), STDOUT)
   if (nflag == NO)
      call putlin(linbuf, STDOUT)
                                      # output appends
   for (i = buf(APPENDLIST+LIST); i > 0; i = buf(i+LIST))
      if (buf(i+COMMAND) == READCOM)
         call fcopy(buf(i+TEXT), STDOUT)        # do r command
      else
         call putlin(buf(i+TEXT), STDOUT)
   return
   end
#-t-  docmds                     2289  local   12/24/80  14:06:06
#-h-  docom                      1253  local   12/24/80  14:06:06
# docom - execute a single command at buf(i) on linbuf and lineno
   subroutine docom(i, linbuf, lineno)
   character linbuf(MAXLINE)
   integer i, lineno
   character cmd
   integer k1, k2, junk
   include csedit

   cmd = buf(i+COMMAND)
   if (cmd == APPENDCOM) {
      buf(aq+LIST) = i
      aq = i
      buf(i+LIST) = 0
      }
   else if (cmd == CHANGECOM) {
      linbuf(1) = EOS
      if (buf(i+NLINES) <= 2) {
         buf(aq+LIST) = i
         aq = i
         buf(i+LIST) = 0
         }
      }
   else if (cmd == DELETECOM)
      linbuf(1) = EOS
   else if (cmd == INSERTCOM) {
      buf(iq+LIST) = i
      iq = i
      buf(i+LIST) = 0
      }
   else if (cmd == PRINTCOM)
      call putlin(linbuf, STDOUT)
   else if (cmd == READCOM) {
      buf(aq+LIST) = i
      aq = i
      buf(i+LIST) = 0
      }
   else if (cmd == SUBSTCOM) {
      k1 = buf(i+SUBSTPAT)
      k2 = buf(i+SUBSTNEW)
      call subst(linbuf, buf(k1), buf(k2),
                buf(i+SUBSTGFLAG), buf(i+SUBSTPFLAG))
      }
   else if (cmd == WRITECOM) {
      if (buf(i+WRITEFD) ^= 0)
         call putlin(linbuf, buf(i+WRITEFD))
      }
   else if (cmd == EQUALCOM) {
      call putdec(lineno, 1)
      call putc(NEWLINE)
      }
   # else ignore command
   return
   end
#-t-  docom                      1253  local   12/24/80  14:06:06
#-h-  dotext                      382  local   12/24/80  14:06:07
# dotext - append text in file fd onto buf
   integer function dotext(fd)
   integer fd
   integer getlin, addset, addstr
   character lin(MAXLINE)
   include csedit

   while (getlin(lin, fd) ^= EOF) {
      if (lin(1) == PERIOD & lin(2) == NEWLINE)
         break
      junk = addstr(lin, buf, lastbf, MAXBUF)
      }
   dotext = addset(EOS, buf, lastbf, MAXBUF)
   return
   end
#-t-  dotext                      382  local   12/24/80  14:06:07
#-h-  fcopy                       339  local   12/24/80  14:06:07
# fcopy - copy file name to opened file fdo
   subroutine fcopy(name, fdo)
   character name(ARB)
   integer fdo
   integer fdi
   integer open
   character c
   character getch

   fdi = open(name, READ)
   if (fdi == ERR)
      call cant(name)
   while (getch(c, fdi) ^= EOF)
      call putch(c, fdo)
   call close(fdi)
   return
   end
#-t-  fcopy                       339  local   12/24/80  14:06:07
#-h-  getfn                       460  local   12/24/80  14:06:07
# getfn - get file name from lin(i)...
   integer function getfn(lin, i, file)
   character lin(MAXLINE), file(MAXLINE)
   integer i, j, k

   getfn = ERR
   if (lin(i + 1) == BLANK | lin(i + 1) == TAB) {
      j = i + 2      # get new file name
      call skipbl(lin, j)
      for (k = 1; lin(j) ^= NEWLINE; k = k + 1) {
         file(k) = lin(j)
         j = j + 1
         }
      file(k) = EOS
      if (k > 1)
         getfn = OK
      }
   return
   end
#-t-  getfn                       460  local   12/24/80  14:06:07
#-h-  getlst                      504  local   12/24/80  14:06:08
# getlst - get a list of line numbers starting at lin(i), increment i
   integer function getlst(lin, i, status)
   character lin(MAXLINE)
   integer i
   integer status    # ignored
   integer num
   integer getone
   include csedit

   nlines = 0
   if (getone(lin, i, num) == EOF)
      return(OK)
   line1 = num
   nlines = nlines + 1
   if (lin(i) ^= COMMA)
      return(OK)
   i = i + 1
   if (getone(lin, i, num) ^= OK)
      return(ERR)
   line2 = num
   nlines = nlines + 1
   return(OK)
   end
#-t-  getlst                      504  local   12/24/80  14:06:08
#-h-  getone                     1025  local   12/24/80  14:06:08
# getone - evaluate one line number expression, increment i
   integer function getone(lin, i, num)
   character lin(MAXLINE)
   integer i, istart, num
   integer addstr, addset, ctoi, optpat
   include csedit

   getone = OK
   call skipbl(lin, i)
   istart = i
   if (lin(i) >= DIG0 & lin(i) <= DIG9) {
      num = ctoi(lin, i)
      i = i - 1   # move back; to be advanced at the end
      if (num < 0)
         getone = ERR
      num = -num
      }
   else if (lin(i) == LASTLINE)
      num = -HUGE
   else if (lin(i) == SLASH) {
      if (optpat(lin, i) == ERR)   # build the pattern
         getone = ERR
      else if (lin(i) == SLASH) {
         num = lastbf
         junk = addstr(pat, buf, lastbf, MAXBUF)
         if (addset(EOS, buf, lastbf, MAXBUF) == NO)
            getone = ERR
         }
      }
   else
      getone = EOF
   if (getone == OK)
      i = i + 1   # point at next character to be examined
   call skipbl(lin, i)
   if (i <= istart)
      getone = EOF
   else
      getone = OK
   return
   end
#-t-  getone                     1025  local   12/24/80  14:06:08
#-h-  getrhs                      493  local   12/24/80  14:06:09
# getrhs - get substitution string for "s" command
   integer function getrhs(lin, i, sub, gflag)
   character lin(MAXLINE), sub(MAXPAT)
   integer maksub
   character clower
   integer gflag, i

   getrhs = ERR
   if (lin(i) == EOS)
      return
   if (lin(i + 1) == EOS)
      return
   i = maksub(lin, i + 1, lin(i), sub)
   if (i == ERR)
      return
   if (clower(lin(i + 1)) == GLOBAL) {
      i = i + 1
      gflag = YES
      }
   else
      gflag = NO
   getrhs = OK
   return
   end
#-t-  getrhs                      493  local   12/24/80  14:06:09
#-h-  optpat                      545  local   12/24/80  14:06:09
# optpat - make pattern if specified at lin(i)
   integer function optpat(lin, i)
   character lin(MAXLINE)
   integer makpat
   integer i
   include csedit

   if (lin(i) == EOS)
      i = ERR
   else if (lin(i + 1) == EOS)
      i = ERR
   else if (lin(i + 1) == lin(i))   # repeated delimiter
      i = i + 1         # leave existing pattern alone
   else
      i = makpat(lin, i + 1, lin(i), pat)
   if (pat(1) == EOS)
      i = ERR
   if (i == ERR) {
      pat(1) = EOS
      optpat = ERR
      }
   else
      optpat = OK
   return
   end
#-t-  optpat                      545  local   12/24/80  14:06:09
#-h-  sed                         818  local   12/24/80  14:06:10
# sed-execute all commands for file fd, use linbuf and increment lineno
   subroutine sed(linbuf, lineno, fd)
   character linbuf(MAXLINE)
   integer lineno, fd
   character buf1(MAXLINE), buf2(MAXLINE)
   integer getlin
   include csedit

   if (getlin(buf1, fd) == EOF)
      return
   if (lineno > 0) {    # do previous last line
      lineno = lineno + 1
      call docmds(linbuf, lineno)
      }
   repeat {
      if (getlin(buf2, fd) == EOF) {    # buf1 contains last line
         call scopy(buf1, 1, linbuf, 1)
         break
         }
      lineno = lineno + 1
      call docmds(buf1, lineno)
      if (getlin(buf1, fd) == EOF) {    # buf2 contains last line
         call scopy(buf2, 1, linbuf, 1)
         break
         }
      lineno = lineno + 1
      call docmds(buf2, lineno)
      }
   return
   end
#-t-  sed                         818  local   12/24/80  14:06:10
#-h-  subst                      1052  local   12/24/80  14:06:11
# subst - substitute sub for occurrences of pat in txt
   subroutine subst(txt, pat, sub, gflag, pflag)
   character txt(MAXLINE), pat(ARB), sub(ARB)
   integer gflag, pflag
   character new(MAXLINE)
   integer addset, amatch
   integer j, junk, k, lastm, m, subbed, tagbeg (10), tagend (10)

   j = 1
   subbed = NO
   lastm = 0
   for (k = 1; txt(k) ^= EOS; ) {
      if (gflag == YES | subbed == NO)
         m = amatch(txt, k, pat, tagbeg, tagend)
      else
         m = 0
      if (m > 0 & lastm ^= m) {   # replace matched text
         subbed = YES
         call catsub(txt, tagbeg, tagend, sub, new, j, MAXLINE)
         lastm = m
         }
      if (m == 0 | m == k) {   # no match or null match
         junk = addset(txt(k), new, j, MAXLINE)
         k = k + 1
         }
      else            # skip matched text
         k = m
      }
   if (subbed == YES) {
      if (addset(EOS, new, j, MAXLINE) == NO)
         return
      call scopy(new, 1, txt, 1)
      if (pflag == YES)
         call putlin(txt, STDOUT)
      }
   return
   end
#-t-  subst                      1052  local   12/24/80  14:06:11
#-h-  usage                       150  local   12/24/80  14:06:11
# usage - print usage message
  subroutine usage

  call error(_
   "usage: sedit [-n] [[-e script | -f sfiles] | script] [files].")
   return
   end
#-t-  usage                       150  local   12/24/80  14:06:11
#-t-  sedit.r                   19300  local   12/24/80  14:07:08
#-t-  sedit                     25362  local   12/24/80  14:40:08
#-h-  show                       2679  local   12/15/80  11:08:52
#-h-  show.doc                    861  local   12/14/80  23:49:43
.bp 1
.in 0
.he 'SHOW (1)'7/1/79'SHOW (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
show - show all characters in a file
.nf
.sp
.ti -3
SYNOPSIS
.br
show [files ...]
.fi
.sp
.ti -3
DESCRIPTION
.br
Show copies the named files to the standard output,
replacing control characters by "^c", where c is the ascii
character used to enter the control character when
depressing the "control" key on most terminals.
More precisely, c is the ascii character whose
value is 100 (octal) plus the value of the control
character.
.sp
Control characters are those ascii characters with
values between 0 and 31, inclusive.  Newline characters
are displayed as usual, however.
.sp
If no filenames are given, or the name '-' is specified,
show will read from the standard input.
.fi
.sp
.ne 2
.ti -3
SEE ALSO
.br
cat, page
.sp
.ti -3
AUTHORS
.br
David Hanson and friends (U. of Arizona)
#-t-  show.doc                    861  local   12/14/80  23:49:43
#-h-  show.r                     1554  local   12/14/80  23:49:44
#-h-  show                        898  local   12/14/80  23:49:24
## show - show what's in a file, displaying control characters
DRIVER(show)

 character buf(MAXLINE)
 integer getarg, open
 integer i, files
 data files /NO/

 call query ("usage:  show [file].")
 for (i=1; getarg(i, buf, MAXLINE) != EOF; i=i+1)
        {
        if (buf(1) == MINUS & buf(2) == EOS) #read from STDIN
                int = STDIN
        else if (buf(1) == MINUS)               #process flags
                {
                call remark ('ignoring invalid argument.')
                next
                }
        else
                {
                int = open(buf, READ)
                if (int == ERR)
                        call cant(buf)
                }
        call showc (int)
        files = YES
        if (int != STDIN)
                call close(int)
        }

 if (files == NO)
        call showc (STDIN)      #no files specified; read from STDIN
 DRETURN
 end
#-t-  show                        898  local   12/14/80  23:49:24
#-h-  showc                       392  local   12/14/80  23:49:25
## showc - display all characters in file 'int'
#  This routine assumes all characters are ASCII--it won't
#  work if you have subverted this convention
 subroutine showc (int)
   character c, getch
   integer int

   while (getch(c, int) ^= EOF) {
      if (c ^= NEWLINE & c < BLANK) {
         call putc(CARET)
         c = c + ATSIGN
         }
      call putc(c)
      }
   return
   end
#-t-  showc                       392  local   12/14/80  23:49:25
#-t-  show.r                     1554  local   12/14/80  23:49:44
#-t-  show                       2679  local   12/15/80  11:08:52
#-h-  sort                      20068  local   01/07/81  00:18:05
#-h-  sort.doc                   2027  local   12/24/80  14:57:46
.bp 1
.in 0
.he 'SORT (1)'04/15/78'SORT (1)
.fo ''-#-''
.fi
.in 7
.ti -7
.br
NAME
.br
sort - sort and/or merge text files

.ti -7
SYNOPSIS
.br
sort [-bdfimr] [+sn] [file] ...

.ti -7
DESCRIPTION
.br
Sort sorts lines of all the named files together and writes the result
on the standard output.
If no files are given or the filename '-' appears, standard input
is read.

The sort key is an entire line.
Default ordering is alphabetic by characters as they are represented
in ASCII format.
The ordering is affected by the
following flags, one or more of which may appear.

.in +4
.ti -3
-b Leading blanks  are not included in keys.

.ti -3
-d 'Dictionary' order: only letters, digits and blanks are significant
in comparisons.

.ti -3
-f Fold all letters to a single case.

.ti -3
-i Ignore all nonprinting nonblank characters.

.ti -3
-m Merge only, the input files are already sorted.

.ti -3
-r Reverse the sense of the sort

.ti -4
+sn Sort according to the subfield starting on column n

.in -4

.ti -7
FILES
.br
A series of scratch files are generated and subsequently deleted.
Presently the files are named "Sn" where "n" is a sequence number.

.ti -7
SEE ALSO
.br
tsort
.br
The Unix command "sort" in the Unix User's Manual.
.br

.ti -7
DIAGNOSTICS
.br
file:  can't open
.br
.in +5
This message is printed if either an input file or a scratch
file cannot be opened; execution ceases.
.in -5
.sp
too many arguments
.in +5
Printed if too many files are specified on the command line.
The limit is determined by the FLMAX definition in the source code.
.in -5

.ti -7
AUTHORS
.br
Original design from Kernighan and Plauger's "Software Tools",
with modifications by
Joe Sventek (Lawrence Berkeley Laboratory).

.ti -7
BUGS
.br
The merge phase is performed with a polyphase merge/sort algorithm,
which requires an end-of-run delimiter on the scratch files.
The one chosen is
a bare ^D (ASCII code 4) on a line.  If this is in conflict with your
data files, the symbol CTRLD in the sort symbol definitions
should be redefined.
#-t-  sort.doc                   2027  local   12/24/80  14:57:46
#-h-  csort                      1022  local   12/24/80  14:44:52
 # csort common block - holds information about sort flags
 # put on a file called 'csort'
 # used only by the sorter

 common / csort / linptr(MAXPTR),
		  blanks, dict, fold, noprt, merg, revers, subf, cofset,
		  ifout, ofile(FILENAMESIZE),
		  linbuf(MAXTEXT)

 integer linptr		# pointers to beginning of line in linbuf
 integer blanks		# whether to skip leading blanks in compar; init=NO
 integer dict		# whether to sort in dictionary order     ; init=NO
 integer fold		# whether to fold all characters to lcase ; init=NO
 integer noprt		# whether to ignore non-printing characs  ; init=NO
 integer merg		# whether is a merge only		  ; init=NO
 integer revers		# whether to reverse comparisons	  ; init=NO
 integer subf		# whether sort is on a subfield		  ; init=NO
 integer cofset		# starting column of subfield		  ; init=0
 integer ifout		# if output file specified in command line; init=NO
 character ofile	# file name of +ooutfile specified	  ; init=EOS
 character linbuf	# buffer to hold lines for internal sort
#-t-  csort                      1022  local   12/24/80  14:44:52
#-h-  flist                       282  local   12/24/80  14:44:52
 ## common block used to hold list of files from command line
 #  Put on a file called 'flist'
 # Used by the tools:  sort, format, lpr (VMS version), ls(VMS version)

 #flist - common block

  common /flist/  flevel, ffiles(FILENAMESIZE, FLMAX)
  integer flevel
  character ffiles
#-t-  flist                       282  local   12/24/80  14:44:52
#-h-  select                      650  local   12/24/80  14:44:52
 # select common block - used by sorter
 # put on a file called 'select'
 # used only by the sorter

 common / select / tape, a(TAPENO), d(TAPENO), level, unit(TAPENO), t(TAPENO),
		   file(FILENAMESIZE, TAPENO)

 integer tape	# current tape to write run to; init tape=1
 integer a	# number of runs to date; init a(i)=1 for i=1...TAPENO-1
		#			       a(TAPENO)=0
 integer d	# number of runs to add to tape; init d(i)=1 for i=1...TAPENO-1
		#				      d(TAPENO)=0
 integer level	# Fibonacci level; init level=1
 integer unit	# rat4 unit for tape
 integer t	# array for mapping actual units to virtual units
 character file	# names of temporary files
#-t-  select                      650  local   12/24/80  14:44:52
#-h-  sort.r                    15476  local   12/24/80  14:56:02
#-h-  sort                       2995  local   12/24/80  14:43:54
 # include ratdef
 # definitions for sort tool
 # used only by the sort tool

 define(LOGPTR,20)
 define(MAXPTR,750)
 define(MAXTEXT,20000)
 define(TAPENO,6)
 define(CTRLD,4)
 define(FLMAX,25)
 define(EOI,ERR)

 DRIVER(sort)
 #  (dummy routine necessary for proper returning from main
 #  sort driver)
 call sorts
 DRETURN
 end

 subroutine sorts

 integer nlines, sum, i, n, getlin, eor, open, outfil, ieof, j
 integer status, makrun, sunit, nruns
 character buf(MAXLINE)

 include select
 include csort

 call srtint

 status = OK
 nruns = 0
 repeat
    {
    if (status == OK)           # haven't reached EOI yet
        {
        status = makrun(nlines)                 # make a run
        nruns = nruns + 1       # update number of runs
        if (merg == NO)
            call quick(linptr, nlines, linbuf)  # sort run
        if (nruns == 1)
            if (status == EOI)                  # internal sort only
                {
 #              call redout             # redirect STDOUT if necessary
                call putrun(linptr, nlines, linbuf, STDOUT)
                return
                }
            else
                call fsetup                     # set up temporary files
        }
    else
        nlines = 0
    if (sum(d, TAPENO-1) > 0 | nlines > 0)
        {
        call stape
        if (a(tape) > 1)
            call puteor(unit(tape))
        call putrun(linptr, nlines, linbuf, unit(tape))
        }
    }
 until (sum(d, TAPENO-1) == 0 & status == EOI)

 #      open files for merge

 for (i=1; i < TAPENO; i=i+1)
    {
    t(i) = i
    call close(unit(i))         #change from WRITE to READ access
    unit(i) = open(file(1,i), READ)
    if (unit(i) == ERR)
        call cant(file(1,i))
    }
 unit(TAPENO) = open(file(1,TAPENO), WRITE)
 if (unit(TAPENO) == ERR)
    call cant(file(1,TAPENO))
 t(TAPENO) = TAPENO

 #      now merge runs

 repeat
    {
    outfil = t(TAPENO)
    if (level == 1)
        {
        sunit = unit(outfil)            # save scratch unit
 #      call redout                     # redirect STDOUT if necessary
        unit(outfil) = STDOUT           # copy sorted file directly to STDOUT
        }
    repeat
        {
        call mrgrun(ieof)
        if (ieof == 0)
            call puteor(unit(outfil))
        }
    until(ieof > 0)             # one of the units terminated on EOF
    if (level == 1)
        {
        unit(outfil) = sunit    # restore scratch unit
        break                   # stop loop, sorted file already on STDOUT
        }
    i = t(ieof)
    j = t(TAPENO)
    call close(unit(i))         #change file accesses
    unit(i) = open(file(1,i), WRITE)
    if (unit(i) == ERR)
        call cant(file(1,i))
    call close(unit(j))
    unit(j) = open(file(1,j), READ)
    if (unit(j) == ERR)
        call cant(file(1,j))
    t(TAPENO) = i
    t(ieof) = j
    level = level - 1
    }
 until (level == 0)             # sorted results on t(ieof)

 #      eliminate temporary files

 call cleans
 return
 end
#-t-  sort                       2995  local   12/24/80  14:43:54
#-h-  cleans                      194  local   12/24/80  14:43:55
 subroutine cleans

 integer i

 include select

 for (i=1; i <= TAPENO; i=i+1)
    if (unit(i) > 0)
        {
        call close(unit(i))
        call remove(file(1,i))
        }

 return
 end
#-t-  cleans                      194  local   12/24/80  14:43:55
#-h-  compar                     1812  local   12/24/80  14:43:56
 ## compar - compare lin(lp1) with lin(lp2)
    integer function compar(lp1, lp2, lin)

    character lin(ARB)
    integer i, j, lp1, lp2
    character type
    character ct
    character c1,c2
    character clower
    include csort

    i = lp1
    j = lp2

  if (blanks == YES)      # ignore leading blanks
       {
       while (lin(i) == BLANK)  i = i + 1
       while (lin(j) == BLANK)  j = j + 1
       }
 else if (subf == YES)
    {
    while (lin(i) != EOS) i = i + 1
    while (lin(j) != EOS) j = j + 1
    if (i > lp1 + cofset)
        i = lp1 + cofset
    if (j > lp2 + cofset)
        j = lp2 + cofset
    }

  repeat
     {
     if (lin(i) == EOS)
         {
         compar = 0
         return
         }
     if (noprt == YES)     #ignore non-printing characters
         {
         while ((lin(i) > 0 & lin(i) < 32) |
                lin(i) == 127)  i = i + 1
         while ((lin(j) > 0 & lin(j) < 32) |
                lin(j) == 127)  j = j + 1
         }
     if (dict == YES)      #dictionary order--only letters & digits & blanks
         {
         repeat
            {
            ct = type (lin(i))
            if (ct == LETTER | ct == DIGIT | ct== BLANK | ct == EOS)  break
            i = i + 1
            }
         repeat
            {
            ct = type (lin(j))
            if (ct == LETTER | ct == DIGIT | ct == BLANK | ct == EOS)  break
            j = j + 1
            }
         }
     if (fold == YES)
          {
          c1 = clower (lin(i))
          c2 = clower(lin(j))
          }
      else
          {
          c1 = lin(i)
          c2 = lin(j)
          }

       if (c1 != c2)  break
       i = i + 1
       j = j + 1
       }
    if (c1 < c2 )
       compar = -1
    else
       compar = +1
    if (revers == YES)
        compar = -compar
    return
    end
#-t-  compar                     1812  local   12/24/80  14:43:56
#-h-  eor                         100  local   12/24/80  14:50:50
 integer function eor(buffer)

 character buffer(ARB)

 if (buffer(1) == CTRLD & buffer(2) == NEWLINE)
    eor = YES
 else
    eor = NO

 return
 end
#-t-  eor                         100  local   12/24/80  14:50:50
#-h-  exchan                      199  local   12/24/80  14:43:56
 ## exchan - exchange linbuf(lp1) with linbuf(lp2)
    subroutine exchan(lp1, lp2, linbuf)
    character linbuf(ARB)
    integer k, lp1, lp2

    k = lp1
    lp1 = lp2
    lp2 = k
    return
    end
#-t-  exchan                      199  local   12/24/80  14:43:56
#-h-  fsetup                      468  local   12/24/80  14:43:56
 subroutine fsetup

 character temp(4)
 integer i, n, itoc, open

 include select

 tape = 1
 level = 1
 for (i=1; i <= TAPENO; i=i+1)
    {
    a(i) = 1
    d(i) = 1
    temp(1) = LETS
    n = itoc(i, temp(2), 3)
    call mkuniq(temp, file(1,i))
    if (i < TAPENO)
        {
        unit(i) = open(file(1,i), WRITE)
        if (unit(i) == ERR)
            call cant(file(1,i))
        }
    else
        unit(i) = 0
    }
 d(TAPENO) = 0
 a(TAPENO) = 0

 return
 end
#-t-  fsetup                      468  local   12/24/80  14:43:56
#-h-  fstack                      349  local   12/24/80  14:43:57
   ## fstack - generate stack of input files

   subroutine fstack (iarg)

   integer i
   character iarg(FILENAMESIZE)

   include flist

   if (flevel >= FLMAX)
        call error ("too many arguments.")
     flevel = flevel + 1
     for (i=1; iarg(i) != EOS; i=i+1)
         ffiles(i,flevel) = iarg(i)
    ffiles(i,flevel) = EOS
   return
   end
#-t-  fstack                      349  local   12/24/80  14:43:57
#-h-  gsrtln                      869  local   12/24/80  14:43:57
 integer function gsrtln(buf)

 character buf(MAXLINE)
 integer getlin, init, level, fopen, open, infile

 include flist

 data init/0/

 if (init == 0)
    {
    level = 0
    if (flevel == 0)
        {
        flevel = 1
        call scopy('-', 1, ffiles(1,1), 1)
        }
    init = 1
    fopen = NO
    }
 if (fopen == NO & level == flevel)
    gsrtln = EOI
 else
    {
    if (fopen == NO)
        {
        fopen = YES
        level = level + 1
        if (ffiles(1, level) == MINUS)
            infile = STDIN
        else
            {
            infile = open(ffiles(1, level), READ)
            if (infile == ERR)
                call cant(ffiles(1, level))
            }
        }
    gsrtln = getlin(buf, infile)
    if (gsrtln == EOF)
        {
        fopen = NO
        if (infile != STDIN)
            call close(infile)
        }
    }

 return
 end
#-t-  gsrtln                      869  local   12/24/80  14:43:57
#-h-  makrun                      544  local   12/24/80  14:43:57
 integer function makrun(nlines)

 integer nlines, lbp, len, gsrtln

 include csort

 nlines = 0
 lbp = 1
 repeat
    {
    len = gsrtln(linbuf(lbp))
    if (len == EOI)
        break
    if (len == EOF & merg == YES)
        break
    if (len != EOF)
        {
        nlines = nlines + 1
        linptr(nlines) = lbp
        lbp = lbp + len + 1             # "1" is room for EOS
        if (lbp >= MAXTEXT - MAXLINE | nlines >= MAXPTR)
            break
        }
    }
 if (len == EOI)
    makrun = EOI
 else
    makrun = OK

 return
 end
#-t-  makrun                      544  local   12/24/80  14:43:57
#-h-  mrgrun                     1170  local   12/24/80  14:43:58
 #      merges one run from unit(t(i)),...,unit(t(TAPENO-1)) onto
 #      unit(t(TAPENO))
 #      returns a value of 0 if all files terminate on EOR
 #      returns index of file which terminated on EOF (1...TAPENO-1)

 subroutine mrgrun(ieof)

 integer outfil, lbp, nf, i, k, n, getlin, eor, ieof

 include select
 include csort

 outfil = t(TAPENO)
 lbp = 1
 nf = 0
 ieof = 0
 for (i=1; i < TAPENO; i=i+1)
    {
    k = t(i)
    n = getlin(linbuf(lbp), unit(k))
    if (n != EOF & eor(linbuf(lbp)) != YES)
        {
        nf = nf + 1
        linptr(nf) = lbp
        }
    else if (n == EOF)
        ieof = i
    lbp = lbp + MAXLINE
    }

 call quick(linptr, nf, linbuf)                 # now have initial heap

 while (nf > 0)
    {
    lbp = linptr(1)
    call putlin(linbuf(lbp), unit(outfil))      # write top line of heap
    i = lbp / MAXLINE + 1                       # compute index of file
    k = t(i)
    n = getlin(linbuf(lbp), unit(k))
    if (n == EOF | eor(linbuf(lbp)) == YES)
        {
        linptr(1) = linptr(nf)
        nf = nf - 1
        if (n == EOF)
            ieof = i
        }
    call reheap(linptr, nf, linbuf)
    }

 return
 end
#-t-  mrgrun                     1170  local   12/24/80  14:43:58
#-h-  puteor                      103  local   12/24/80  14:43:59
 subroutine puteor(int)

 integer int

 call putch(CTRLD, int)
 call putch(NEWLINE, int)

 return
 end
#-t-  puteor                      103  local   12/24/80  14:43:59
#-h-  putrun                      236  local   12/24/80  14:43:59
 subroutine putrun(linptr, nlines, linbuf, outfil)

 character linbuf(MAXTEXT)
 integer i, j, linptr(MAXPTR), nlines, outfil

 for (i=1; i <= nlines; i=i+1)
    {
    j = linptr(i)
    call putlin(linbuf(j), outfil)
    }

 return
 end
#-t-  putrun                      236  local   12/24/80  14:43:59
#-h-  quick                      1309  local   12/24/80  14:44:00
 ## quick - quicksort for character lines
    subroutine quick(linptr, nlines, linbuf)
    character linbuf(ARB)
    integer compar
    integer i, j, linptr(ARB), lv(LOGPTR), nlines, p, pivlin, uv(LOGPTR)

    lv(1) = 1
    uv(1) = nlines
    p = 1
    while (p > 0)
       if (lv(p) >= uv(p))      # only one element in this subset
          p = p - 1      # pop stack
       else {
          i = lv(p) - 1
          j = uv(p)
          pivlin = linptr(j)   # pivot line
          while (i < j) {
             for (i=i+1; compar(linptr(i), pivlin, linbuf) < 0; i=i+1)
                ;
             for (j = j - 1; j > i; j = j - 1)
                if (compar(linptr(j), pivlin, linbuf) <= 0)
                   break
             if (i < j)      # out of order pair
                call exchan(linptr(i), linptr(j), linbuf)
             }
          j = uv(p)         # move pivot to position i
          call exchan(linptr(i), linptr(j), linbuf)
          if (i-lv(p) < uv(p)-i) {   # stack so shorter done first
             lv(p+1) = lv(p)
             uv(p+1) = i - 1
             lv(p) = i + 1
             }
          else {
             lv(p+1) = i + 1
             uv(p+1) = uv(p)
             uv(p) = i - 1
             }
          p = p + 1         # push onto stack
          }
    return
    end
#-t-  quick                      1309  local   12/24/80  14:44:00
#-h-  redout                      222  local   12/24/80  14:44:00
 # subroutine redout
 #
 # integer assign
 #
 # include csort
 #
 # if (ifout == YES)
 #    if (assign(ofile, STDOUT, WRITE) == ERR)
 #      call remark("Cannot redirect standard output to +o file.")
 #
 # return
 # end
#-t-  redout                      222  local   12/24/80  14:44:00
#-h-  reheap                      562  local   12/24/80  14:44:01
 ## reheap - propagate linbuf(linptr(1)) to proper place in heap
    subroutine reheap(linptr, nf, linbuf)
    character linbuf(MAXTEXT)
    integer compar
    integer i, j, nf, linptr(ARB)

    for (i = 1; 2 * i <= nf; i = j) {
       j = 2 * i
       if (j < nf)      # find smaller child
          if (compar(linptr(j), linptr(j+1), linbuf) > 0)
             j = j + 1
       if (compar(linptr(i), linptr(j), linbuf) <= 0)
          break      # proper position found
       call exchan(linptr(i), linptr(j), linbuf)   # percolate
       }
    return
    end
#-t-  reheap                      562  local   12/24/80  14:44:01
#-h-  srtint                     1331  local   12/24/80  14:44:01
 subroutine srtint

 character temp(FILENAMESIZE), clower
 integer i, n, getarg, index, ctoi

 include select
 include csort
 include flist

 flevel = 0
 blanks = NO
 dict = NO
 fold = NO
 noprt = NO
 merg = NO
 revers = NO
 subf = NO
 cofset = 0
 # ifout = NO
 call query ("usage:  sort [-bdfimr] [+sn] [files].")
 for (i=1; getarg(i, temp, FILENAMESIZE) != EOF; i=i+1)
    {
    if (temp(1) == MINUS & temp(2) != EOS)
        {
        if (index(temp, LETB) != 0 | index(temp, BIGB) != 0)
            blanks = YES
        if (index(temp, LETD) != 0 | index(temp, BIGD) != 0)
            dict = YES
        if (index(temp, LETF) != 0 | index(temp, BIGF) != 0)
            fold = YES
        if (index(temp, LETI) != 0 | index(temp, BIGI) != 0)
            noprt = YES
        if (index(temp, LETM) != 0 | index(temp, BIGM) != 0)
            merg = YES
        if (index(temp, LETR) != 0 | index(temp, BIGR) != 0)
            revers = YES
        }
   else if (temp(1) == PLUS & clower(temp(2)) == LETS)
        {
        subf = YES
        n = 3
        cofset = ctoi(temp, n) - 1
        if (cofset < 0)
            cofset = 0
        }
 #    else if (temp(1) == PLUS & clower(temp(2)) == LETO)
 #      {
 #      ifout = YES
 #      call scopy(temp, 3, ofile, 1)
 #      }
    else
        call fstack(temp)
    }
 return
 end
#-t-  srtint                     1331  local   12/24/80  14:44:01
#-h-  stape                       418  local   12/24/80  14:44:01
 subroutine stape

 integer i, z

 include select

 if (d(tape) < d(tape+1))
    tape = tape + 1
 else
    {
    if (d(tape) == 0)           # bump one Fibonacci level
        {
        level = level + 1
        z = a(1)
        for (i=1; i < TAPENO; i=i+1)
            {
            d(i) = z + a(i+1) - a(i)
            a(i) = z + a(i+1)
            }
        }
    tape = 1
    }
 d(tape) = d(tape) - 1
 return
 end
#-t-  stape                       418  local   12/24/80  14:44:01
#-h-  sum                         132  local   12/24/80  14:44:02
 integer function sum(array, n)

 integer array(ARB), n, i

 sum = 0
 for (i=1; i<=n; i=i+1)
    sum = sum + array(i)

 return
 end
#-t-  sum                         132  local   12/24/80  14:44:02
#-t-  sort.r                    15476  local   12/24/80  14:56:02
#-t-  sort                      20068  local   01/07/81  00:18:05
#-h-  spell                     10426  local   01/09/81  00:45:15
#-h-  spell.doc                   830  local   01/09/81  00:43:12
.bp 1
.rm 70
.in 0 
.he 'SPELL'1/11/79'SPELL'
.fo ''-#-' 
.fi 
NAME 
.br 
.in 7 
spell - find spelling errors
.sp 1 
.in 
SYNOPSIS 
.br 
.in 7 
spell [file] ...
.sp 1 
.in 
DESCRIPTION 
.br 
.in 7 
Spell
copies the named files (or standard input if none are specified) to
standard output while looking up each word in a dictionary.  If any
spelling errors are found in a particular line, an additional line
will be printed immediately following the line with asterisks (*)
beneath the offending words.
.sp 1
.in 
FILES 
.br 
.in 7 
dict - a dictionary file
.br
dictdx - an index into the dictionary file, created the first
time spell is called
.sp 1 
.in 
SEE ALSO 
.br 
.in 7 
.br
.sp 1 
.in 
DIAGNOSTICS
.br 
.in 7 
.sp 1 
.in 
AUTHORS 
.br 
.in 7 
.sp 1 
Joe Sventek, Lawrence Berkeley Laboratory
.sp 1 
.in 
BUGS 
.br 
.in 7 
#-t-  spell.doc                   830  local   01/09/81  00:43:12
#-h-  cspell                      483  local   12/05/80  17:09:35
 common / cspell / nlines, dunit, freep, freec, strptr(MAX_DIR_ENTRIES),
		   linptr(2, MAX_DIR_ENTRIES), charay(MAX_CHARS)

 integer nlines		# number of entries read from index
 integer dunit		# rat4 unit for dictionary file
 integer freep		# next free loc in strptr
 integer freec		# next free loc in charay
 integer strptr		# index into charay for the key for the n'th entry
 integer linptr		# values to load into seek to locate record
 character charay	# key strings stored here
#-t-  cspell                      483  local   12/05/80  17:09:35
#-h-  spell.r                    8717  local   12/05/80  17:09:36
#-h-  defns                       263  local   12/05/80  16:51:17
 define(MAX_DIR_ENTRIES,6000)
 define(MAX_CHARS,60000)
 define(DICTIONARY_FILE,"dict")
 define(DICTIONARY_INDEX,"dictdx")
			#definitions for indexing
 define(DEFAULT_WIDTH,25)
 define(DEFAULT_DIF,10)
 define(DEFAULT_JUSTFY,LEFT)
 define(LEFT,0)
 define(RIGHT,1)
#-t-  defns                       263  local   12/05/80  16:51:17
#-h-  spell                       530  local   12/05/80  16:51:17

DRIVER(spell)

 integer i, status, unit
 integer getarg, equal, open
 character file(FILENAMESIZE)

 string minust "-"

 call query ("spell [files].")
 call lodidx
 i = 1
 repeat
    {
    status = getarg(i, file, FILENAMESIZE)
    if (status == EOF)
	if (i > 1)
	    break
	else
	    unit = STDIN
    else if (equal(file, minust) == YES)
	unit = STDIN
    else
	{
	unit = open(file, READ)
	if (unit == ERR)
	    call cant(file)
	}
    call dospel(unit)
    if (unit != STDIN)
	call close(unit)
    i = i + 1
    }

DRETURN
 end
#-t-  spell                       530  local   12/05/80  16:51:17
#-h-  inject                      436  local   12/05/80  16:51:18
 ## inject - inject key and address info into table
 integer function inject (key, addr)
 character key(ARB)
 integer addr(2), i
 integer length
 
 include cspell
 
 i = 1
 if (freep > MAX_DIR_ENTRIES |
     (length(key) + freec + 1) > MAX_CHARS)
	return(ERR)
 strptr(freep) = freec
 call stcopy (key, 1, charay, freec)
 linptr (1, freep) = addr(1)
 linptr (2, freep) = addr(2)
 freep = freep + 1
 nlines = nlines + 1
 return (OK)
 end
#-t-  inject                      436  local   12/05/80  16:51:18
#-h-  lodidx                     1040  local   12/05/80  16:51:18
# load dictionary index file
 subroutine lodidx

 character buf(MAXLINE), key(30)
#character file(FILENAMESIZE)
 integer i, addr(2)
 integer open, getlin, getwrd, ctoi, inject
 integer dx

 include cspell

 string dictdx  DICTIONARY_INDEX
 string dict DICTIONARY_FILE

 freep = 1		#initialize
 freec = 1
 nlines = 0
 
			#open dictionary file
 #call getdir(BINDIRECTORY, LOCAL, file)
 #call concat(file, dict, file)
 #dunit = open(file, READ)
  dunit = open(dict, READ)
  if (dunit == ERR)
    call cant(dict)
 
			#attempt to open dictionary index file
 #call getdir(BINDIRECTORY, LOCAL, file)
 #call concat(file, dictdx, file)
 #dx = open(file, READ)
  dx = open(dictdx, READ)
  if (dx == ERR)		#create dictionary index if not there
	call dodx (dictdx)
  else				# read dictionary index file
	{
	while (getlin (buf, dx) != EOF)
		{
		i = 1
		junk = getwrd (buf, i, key)
		addr(1) = ctoi(buf, i)
		addr(2) = ctoi(buf, i)
		if (inject(key, addr) == ERR)
			call error ("dictionary index too large.")
		}
	}
 
  call close(dx)

 return
 end
#-t-  lodidx                     1040  local   12/05/80  16:51:18
#-h-  binsrc                      493  local   12/05/80  16:51:18
 integer function binsrc(word)

 character word(ARB)
 integer first, last, i, m
 integer strcmp

 include cspell

 m = strptr(nlines)
 if (strcmp(word, charay(m)) > 0)
    return(nlines)
 m = strptr(1)
 if (strcmp(word, charay(m)) < 0)
    return(1)
 first = 1
 last = nlines
 while ((last - first) > 1)
    {
    i = (first + last) / 2
    m = strptr(i)
    switch (strcmp(word, charay(m)))
	{
	case	-1:	last = i
	case	0:	{last = i; first = i}
	case	1:	first = i
	}
    }
 return(first)
 end
#-t-  binsrc                      493  local   12/05/80  16:51:18
#-h-  findwd                      642  local   12/05/80  16:51:18
 integer function findwd(word)

 character word(ARB)
 integer i, junk, n, addr(2)
 integer getlin, binsrc, strcmp, equal, wdlook
 character buf(MAXLINE)

 include cspell

 if (wdlook(word) == YES)		# seen this mis-spelled word before
    return(NO)
 i = binsrc(word)
 addr(1) = linptr(1, i)
 addr(2) = linptr(2, i)
 call seek(addr, dunit)
 for (n=getlin(buf,dunit); n != EOF; n=getlin(buf,dunit))
    {
    buf(n) = EOS
    if (strcmp(word, buf) <= 0)
	break
    }
 if (n == EOF)
    buf(1) = EOS
 if (equal(word, buf) == NO)
    {
    call wdstal(word)			# install mis-spelled word
    findwd = NO
    }
 else
    findwd = YES

 return
 end
#-t-  findwd                      642  local   12/05/80  16:51:18
#-h-  alphan                      149  local   12/05/80  16:51:19
 integer function alphan(c)

 character c, t
 character type

 t = type(c)
 if (t == LETTER | t == DIGIT)
    return(YES)
 else
    return(NO)

 end
#-t-  alphan                      149  local   12/05/80  16:51:19
#-h-  gtword                      345  local   12/05/80  16:51:19
 integer function gtword(buf, i, word, start)

 integer i, start, j
 character buf(ARB), word(ARB)
 integer alphan, length

 while (alphan(buf(i)) == NO)
    if (buf(i) == EOS)
	break
    else
	i = i + 1
 start = i
 for (j=1; alphan(buf(i)) == YES; j=j+1)
    {
    word(j) = buf(i)
    i = i + 1
    }
 word(j) = EOS
 return(length(word))
 end
#-t-  gtword                      345  local   12/05/80  16:51:19
#-h-  wdlook                      235  local   12/05/80  16:51:19
 integer function wdlook(word)

 character word(ARB)
 integer i, j
 integer equal

 include cspell

 for (i=nlines+1; i < freep; i=i+1)
    {
    j = strptr(i)
    if (equal(word, charay(j)) == YES)
	return(YES)
    }
 return(NO)
 end
#-t-  wdlook                      235  local   12/05/80  16:51:19
#-h-  wdstal                      404  local   12/05/80  16:51:19
 subroutine wdstal(word)

 character word(ARB)
 integer i
 integer length

 include cspell

 if (freep <= MAX_DIR_ENTRIES)
    {
    i = freec + length(word)
    if (i <= MAX_CHARS)			# word will fit
	{
	strptr(freep) = freec		# fill in pointer
	freep = freep + 1		# bump pointer
	call stcopy(word, 1, charay, freec)	# copy word, bumping freec
	freec = freec + 1		# point past EOS
	}
    }

 return
 end
#-t-  wdstal                      404  local   12/05/80  16:51:19
#-h-  dospel                      711  local   12/05/80  16:51:19
 subroutine dospel(unit)

 integer i, m, n, iferr, j, start, unit
 integer getlin, findwd, gtword
 character buf(MAXLINE), word(MAXLINE), errbuf(MAXLINE)

 include cspell

 for (n=getlin(buf,unit); n != EOF; n=getlin(buf,unit))
    {
    call putlin(buf, STDOUT)
    for (j=1; buf(j) != EOS; j=j+1)
	if (buf(j) == TAB)
	    errbuf(j) = TAB
	else if (buf(j) == NEWLINE)
	    errbuf(j) = NEWLINE
	else
	    errbuf(j) = BLANK
	errbuf(j) = EOS
    i = 1
    iferr = NO
    while (gtword(buf, i, word, start) > 0)
	{
	call fold(word)
	if (findwd(word) == NO)
	    {
	    iferr = YES
	    for (j=start; j < i; j=j+1)
		errbuf(j) = STAR
	    }
	}
    if (iferr == YES)
	call putlin(errbuf, STDOUT)
    }

 return
 end
#-t-  dospel                      711  local   12/05/80  16:51:19
#-h-  doline                      154  local   12/05/80  16:51:20
 integer function doline(n, dif)

 integer n, dif


 if (dif == 1)
    return(YES)
 else if (mod(n, dif) == 1)
    return(YES)
 else
    return(NO)

 end
#-t-  doline                      154  local   12/05/80  16:51:20
#-h-  outlin                      493  local   12/05/80  16:51:20
 subroutine outlin (word, addr, justfy, out)

 character word(ARB)
 filedes out
 integer justfy
 integer addr(2), j
 integer length

 if (justfy == RIGHT)
    for (j=length(word) + 1; j <= width; j=j+1)
	call putch(BLANK, out)
 call putlin(word, out)
 if (justfy == LEFT)
    for (j=length(word) + 1; j <= width; j=j+1)
	call putch(BLANK, out)
 call putch(BLANK, out)
 call putint (addr(1), 1, out)
 call putch(BLANK, out)
 call putint(addr(2), 1, out)
 call putch(NEWLINE, out)

 return
 end
#-t-  outlin                      493  local   12/05/80  16:51:20
#-h-  dodx                        974  local   12/05/80  16:51:20
 ## dodx - create dictionary index file for 'spell' tool
 subroutine dodx (name)
 character name(ARB), buf(MAXLINE), key(30), oldkey(30)
 integer n, i, addr(2), oaddr(2)
 integer create, getlin, doline, getwrd, inject
 filedes dx
 
 include cspell
 
 dx = create (name, WRITE)
 if (dx == ERR)
 	call cant (name)
  n = 0
  oldkey(1) = EOS
  oaddr(1) = 0
  oaddr(1) = 0
  repeat
     {
     call note(addr, dunit)
     if (getlin(buf, dunit) == EOF)
 	break
     n = n + 1
     i = 1
     junk = getwrd (buf, i, key)
     if (doline (n, DEFAULT_DIF) == YES)
 	{
        call outlin(key, addr, DEFAULT_JUSTIFY, dx)
 	if (inject(key, addr) == ERR)
 		call error ("dictionary index too large.")
 	}
    call scopy (key, 1, oldkey, 1)
    oaddr(1) = addr(1)
    oaddr(2) = addr(2)
     }
  
  if (doline(n, DEFAULT_DIF) == NO)
 	{
 	call outlin (oldkey, oaddr, DEFAULT_JUSTFY, dx)
 	if (inject(oldkey, oaddr) == ERR)
 		call error ("dictionary index too large.")
 	}
 return
 end
#-t-  dodx                        974  local   12/05/80  16:51:20
#-t-  spell.r                    8717  local   12/05/80  17:09:36
#-t-  spell                     10426  local   01/09/81  00:45:15
#-h-  split                      6846  local   12/22/80  15:30:10
#-h-  split.doc                  1983  local   12/22/80  15:21:05
.bp 1
.in 0
.he 'SPLIT (1)'10/30/78'SPLIT (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
split - split a file
.nf
.sp
.ti -3
SYNOPSIS
.br
split -n | +from [-to] file [name]
.fi
.sp
.ti -3
DESCRIPTION
.br
Split splits a file into a number of small files.
Depending on the arguments, "file" is split into n-line pieces
or according to specified patterns.  If "file" is omitted or
is "-", split reads the standard input.
.sp
Normally, split outputs the pieces of "file" into files
named "xaa", "xab", "xac", ..., "xzz".  This convention
permits upto 676 files.  If "file" requires more than
676 files to be split, the rest of "file" is placed in "xzz".
If the "name" argument is given, it is used as the prefix
for the output file names.  For each output file,
the 2-character sequence (e.g. "aa", "ab", etc.) is appended
to "name" and the result is used as the output file.
Note that "file" must be given in order to specify "name".
.sp
To split "file" into n-line pieces, use
.sp
.in +3
.nf
split -n file [name]
.in -3
.sp
.fi
If n is omitted, 100 is assumed.
.sp
The command
.sp
.in +3
.nf
split +from file [name]
.in -3
.sp
.fi
splits "file" into pieces that begin with the pattern "from".
The command
.sp
.in +3
.nf
split +from -to file [name]
.in -3
.sp
.fi
splits "file" into pieces that begin with the pattern "from"
and end with the "to".  Note that in this case, portions
of "file" may not appear in the output files.
For example, the command
.sp
.in +3
.nf
split +subroutine -end foo
.in -3
.sp
.fi
might be used to extract the subroutines from foo.
.sp
The "from" and "to" patterns may be any regular expression
pattern as described in edit.
.fi
.sp
.ne 2
.ti -3
SEE ALSO
.br
change, edit, find, lam
.fi
.sp
.ne 2
.ti -3
DIAGNOSTICS
.br
bad argument
.br
.in +3
The value of "n" is invalid.
.in -3
.sp
illegal from pattern
.br
illegal to pattern
.br
.in +3
The specification for the indicated pattern is invalid.
.in -3
.sp
.ti -3
AUTHORS
.br
David Hanson and friends (U. of Arizona)
#-t-  split.doc                  1983  local   12/22/80  15:21:05
#-h-  split.r                    4599  local   12/22/80  15:21:05
#-h-  split                      2924  local   12/22/80  15:20:41
# split - split file into n-line pieces or at specified patterns

 #    include ratdef
define(NLINES,100)      # default lines/file
define(MAXFILES,676)    # maximum number of files; 676 = aa...zz
define(NAMESIZE,FILENAMESIZE)

DRIVER(split)
   character line(MAXLINE), prefix(NAMESIZE), from(MAXPAT), to(MAXPAT)
   integer getarg, open, maknam, getlin, ctoi, getpat, copyp, copyl
   integer fn, fin, fout, nl, i, ccase
   string x "x"

   nl = NLINES
   call scopy(x, 1, prefix, 1)
   fin = STDIN
   ccase = 1
   i = 1
   call query (usage:  split [-n | +from [-to]] [file [out]].")
   if (getarg(i, line, MAXLINE) ^= EOF)
      {
      if (line(1) == MINUS & line(2) ^= EOS) {
         i = 2
         nl = ctoi(line, i)
         if (nl <= 0 | line(i) ^= EOS) {
            call remark("bad argument.")
            call error("usage: split [-n | +from [-to]] [file [name]].")
            }
         i = 2
         }
      else if (line(1) == PLUS) {
         ccase = 2
         if (getpat(line(2), from) == ERR)
            call error("illegal from pattern.")
         i = 2
         if (getarg(i, line, MAXLINE) ^= EOF)
            if (line(1) == MINUS & line(2) ^= EOS) {
               ccase = 3
               if (getpat(line(2), to) == ERR)
                  call error("illegal to pattern.")
               i = 3
               }
         }
   if (getarg(i, line, MAXLINE) ^= EOF) {
      if (line(1) == MINUS & line(2) == EOS)
         fin = STDIN
      else
         fin = open(line, READ)
      if (fin == ERR)
         call cant(line)
      }
     }
   if (getarg(i+1, line, MAXLINE) ^= EOF)
      call scopy(line, 1, prefix, 1)
   if (ccase == 1) {    # split [-n] [file [name]]
      for (fn = 1; getlin(line, fin) ^= EOF; fn = fn + 1) {
         fout = maknam(prefix, fn - 1)
         call putlin(line, fout)
         if (fn >= MAXFILES)    # copy everything if last file
            call fcopy(fin, fout)
        else if (copyl(fin, fout, nl-1) == EOF)
            break
         call close(fout)
         }
      }
   else if (ccase == 2) {       # split +from [file [name]]
      nl = copyp(fin, -1, line, from)
      for (fn = 1; nl ^= EOF; fn = fn + 1) {
         fout = maknam(prefix, fn - 1)
         call putlin(line, fout)
         if (fn >= MAXFILES)
            call fcopy(fin, fout)
         nl = copyp(fin, fout, line, from)
         call close(fout)
         }
      }
   else if (ccase == 3) {       # split +from -to [file [name]]
      for (fn = 1; copyp(fin, -1, line, from) ^= EOF; fn = fn + 1) {
         fout = maknam(prefix, fn - 1)
         call putlin(line, fout)
         if (fn >= MAXFILES)
            call fcopy(fin, fout)
         else
            if (copyp(fin, fout, line, to) ^= EOF)
               call putlin(line, fout)
         call close(fout)
         }
      }
   else
      call error("split: can't happen.")
   if (fin ^= STDIN)
      call close(fin)
   DRETURN
   end
#-t-  split                      2924  local   12/22/80  15:20:41
#-h-  copyl                       305  local   12/22/80  15:20:43
# copyl - copy n lines from fdi to fdo
   integer function copyl(fdi, fdo, n)
   integer fdi, fdo, n, i
   character line(MAXLINE)
   integer getlin

   for (i = 1; i <= n; i = i + 1)
      if (getlin(line, fdi) == EOF)
        return(EOF)
      else
         call putlin(line, fdo)
   return(i-1)
   end
#-t-  copyl                       305  local   12/22/80  15:20:43
#-h-  copyp                       418  local   12/22/80  15:20:43
# copyp - copy lines from fdi to fdo until line matching pat is found
   integer function copyp(fdi, fdo, buf, pat)
   integer fdi, fdo
   character buf(MAXLINE), pat(MAXPAT)
   integer n, match, getlin

   for (n = 0; getlin(buf, fdi) ^= EOF; n = n + 1)
      if (match(buf, pat) == YES)
         return (n)
      else if (fdo >= 0)        # fdo < 0 causes skips
         call putlin(buf, fdo)
   return (EOF)
   end
#-t-  copyp                       418  local   12/22/80  15:20:43
#-h-  maknam                      424  local   12/22/80  15:20:43
# maknam - create file n using prefix
   integer function maknam(prefix, n)
   character prefix(ARB)
   integer n
   character name(NAMESIZE)
   integer length, mod, create

   call scopy(prefix, 1, name, 1)
   i = length(name)
   name(i+1) = n/26 + LETA      # add aa, ab, etc.
   name(i+2) = mod(n, 26) + LETA
   name(i+3) = EOS
   maknam = create(name, WRITE)
   if (maknam == ERR)
      call cant(name)
   return
   end
#-t-  maknam                      424  local   12/22/80  15:20:43
#-t-  split.r                    4599  local   12/22/80  15:21:05
#-t-  split                      6846  local   12/22/80  15:30:10
#-h-  tail                       3088  local   12/22/80  15:02:39
#-h-  tail.doc                    804  local   12/22/80  14:58:35
.bp 1
.in 0
.he 'TAIL (1)'8/26/79'TAIL (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
tail - print last lines of a file
.nf
.sp
.ti -3
SYNOPSIS
.br
tail [-n] [file....]
.fi
.sp
.ti -3
DESCRIPTION
.br
Tail
prints the last "n" lines of the indicated file.
If 'n' is omitted, the last 23 lines are printed.

If "file" is omitted or is "-", tail reads the standard input.
.sp
.ti -3
SEE ALSO
.br
split
.sp
.ti -3
AUTHORS
.br
David Hanson and friends (U. of Arizona)
.sp
.ti -3
BUGS/DEFICIENCIES
.br
An internal buffer of MAXBUF characters is kept.
If the value of "n" would require buffering more characters than
the buffer can hold,
tail
prints the last MAXBUF characters of the file.
In this case, the first line of output may not be an entire line.
MAXBUF is a definition in the source code which may be adjusted.
#-t-  tail.doc                    804  local   12/22/80  14:58:35
#-h-  tail.r                     2020  local   12/22/80  14:58:35
#-h-  tail                       1054  local   12/22/80  14:58:17
# tail - print tail portion of a file

define(MAXBUF,3000)     # line buffer size
define(DEFAULT,23)      # default if no argument

DRIVER(tail)
   character arg(MAXLINE)
   integer n, i, fd
   integer ctoi, getarg, open

   call query ("usage:  tail [-n] [files].")
   n = DEFAULT
   for (i=1; getarg(i, arg, MAXLINE) != EOF; i=i+1)
        {
        if (arg(1) == MINUS & arg(2) != EOS)
                {
                j = 2
                n = ctoi(arg, j)
                if (n <= 0)
                        call error ("invalid size.")
                }
        else if (arg(1) == MINUS & arg(2) == EOS)
                {
                fd = STDIN
                call ptail (n, fd)
                }
        else
                {
                fd = open(arg, READ)
                if (fd == ERR)
                        call cant(arg)
                call ptail (n, fd)
                call close(fd)
                }
        }

   if (fd == ERR)               #no files specified, read STDIN
        call ptail (n, STDIN)
   DRETURN
   end
#-t-  tail                       1054  local   12/22/80  14:58:17
#-h-  ptail                       702  local   12/22/80  14:58:18
 ## ptail - print last 'n' lines of file 'fd'
 subroutine ptail (nlins, fd)
 integer n, fd, nlins
 character buf(MAXBUF)
 character getch
 integer head, tail, i

   head = 1
   tail = 1
   n = nlins
   while (getch(buf(tail), fd) ^= EOF) {
      tail = mod(tail, MAXBUF) + 1
      if (tail == head)
         head = mod(head, MAXBUF) + 1
      }
   for (i = tail; i ^= head; ) {
      i = i - 1
      if (i == 0)
         i = MAXBUF
      if (buf(i) == NEWLINE) {
         n = n - 1
         if (n < 0) {
            i = mod(i, MAXBUF) + 1
            break
            }
         }
      }
   for (head = i; head ^= tail; head = mod(head, MAXBUF) + 1)
      call putch(buf(head), STDOUT)

 return
 end
#-t-  ptail                       702  local   12/22/80  14:58:18
#-t-  tail.r                     2020  local   12/22/80  14:58:35
#-t-  tail                       3088  local   12/22/80  15:02:39
#-h-  tee                        1725  local   12/24/80  15:54:41
#-h-  tee.doc                     743  local   12/24/80  15:08:31
.bp 1
.in 0
.he 'TEE (1)'9/1/78'TEE (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
tee - copy input to output and named files
.nf
.sp
.ti -3
SYNOPSIS
.br
tee files...
.fi
.sp
.ti -3
DESCRIPTION
.br
Tee copies its standard input to the standard output and
makes copies in the named files.  It is useful for
making copies of or
seeing what is being transmitted through a pipeline,
viz.,
.sp
.in +3
.nf
prog1 | tee file tty: | prog2
.in -3
.sp
.fi
causes the output of prog1 to be saved in "file", displayed
on the terminal, and input to prog2.
.fi
.sp
.ne 2
.ti -3
SEE ALSO
.br
cat, page
.fi
.sp
.ne 2
.ti -3
DIAGNOSTICS
.br
A message is issued if one of the named files cannot be
created.
.sp
.ti -3
AUTHORS
.br
David Hanson and friends (U. of Arizona)
#-t-  tee.doc                     743  local   12/24/80  15:08:31
#-h-  tee.r                       718  local   12/24/80  15:08:32
# tee - copy standard input to named files and to standard output

 # include ratdef
define(MAXFILES,16)
define(MAXNAME,FILENAMESIZE)

DRIVER(tee)
   character c, getc, name(MAXNAME)
   integer getarg, create, fdo(MAXFILES), i, nfiles

   call query ("usage:  tee files.")
   for (i = 1; getarg(i, name, MAXNAME) ^= EOF; i = i + 1) {
      if (i > MAXFILES)
         call error("too many files.")
      fdo(i) = create(name, WRITE)
      if (fdo(i) == ERR)
         call cant(name)
      }
   nfiles = i - 1
   while (getc(c) ^= EOF) {
      for (i = 1; i <= nfiles; i = i + 1)
         call putch(c, fdo(i))
      call putc(c)
      }
   for (i = 1; i <= nfiles; i = i + 1)
      call close(fdo(i))
   DRETURN
   end
#-t-  tee.r                       718  local   12/24/80  15:08:32
#-t-  tee                        1725  local   12/24/80  15:54:41
#-h-  tr                         5251  local   12/24/80  15:54:42
#-h-  tr.doc                     2484  local   12/24/80  15:16:20
.bp 1
.in 0
.he 'TR (1)'07/06/78'TR (1)'
.fo ''-#-''
.fi
.in 7
.ti -7
NAME
.br
tr - character transliteration
.sp 1
.ti -7
SYNOPSIS
.br
tr <infile >outfile from [to]
.sp 1
.ti -7
DESCRIPTION
.br
"TR" copies the standard input to the standard output with
substitution or deletion of selected characters.  Input
characters found in "FROM" are mapped into the corresponding
characters of "TO".
Ranges of characters may be specified by separating
the extremes by a dash.
For example, a-z stands for the string of characters whose ascii
codes run from character a through character z.

If the number of characters
in "FROM" is the same as in "TO", a one to one corresponding
translation will be performed on all occurrences of the characters
in "FROM".
If the number of characters in "FROM" is more than in "TO", the
implication is that the last character in the "TO" string is
to be replicated as often as necessary to make a string as long
as the "FROM" string, and that this replicated character should
be collapsed into only one.  If the "TO" string is missing or
empty, "TR" will take this condition as a request to delete
all occurrences of characters in the "FROM" string.
.sp 1
"TR" differs from the tool "CH" since it deals only with
single characters or ranges of characters, while "CH" deals
with character strings.  For example  tr xy yx  would change
all x's into y's and all y's into x's, whereas ch xy yx
change all the patterns "xy" into "yx".
.sp 1
One of the most common functions of "TR" is to translate
upper case letters to lower case, and vice versa.  Thus,

.ce
tr A-Z a-z

would map all upper case letters to lower
case.
Users of systems which cannot pass
both upper and lower case characters on a command line
should remember to include the appropriate escape flags.
.sp 1
.ti -7
FILES
.br
None
.sp 1
.ti -7
SEE ALSO
.br
.nf
find, ch, edit, sedit
The "Software Tools" book, p. 51-61.
The "UNIX Programmer's Manual", p. TR(I).
.fi
.sp 1
.ti -7
DIAGNOSTICS
.br
"usage: translit from to."
.br
.in +5
The command line passed to transit is in error.
.br
.in -5
"from: too large."
.br
.in +5
The string for "from" is too large.  Current limit is 100 characters
including E0S.
.br
.in -5
"to: too large."
.br
.in +5
The string for "to" is too large.  Current limit is 100 characters
including EOS.
.sp 1
.in -5
.ti -7
AUTHORS
.br
Original code from Kernighan and Plauger's "Software Tools",
with minor modifications by Debbie Scherrer.
.sp 1
.ti -7
BUGS/DEFICIENCIES
.br
#-t-  tr.doc                     2484  local   12/24/80  15:16:20
#-h-  tr.r                       2503  local   12/24/80  15:11:51
#-h-  tr                         1429  local   12/24/80  15:11:35
 ## tr - transliterate characters on a file

  #  include ratdef
  define(MAXSET,100)

 DRIVER(tr)

    character getc
    character arg(MAXLINE), c, from(MAXSET), to(MAXSET)
    integer getarg, length, makset, xindex
    integer allbut, collap, i, lastto

    call query ("usage:  tr from to.")
    if (getarg(1, arg, MAXLINE) == EOF)
       call error('usage: tr from to.')
    else if (arg(1) == NOT) {
       allbut = YES
       if (makset(arg, 2, from, MAXSET) == NO)
          call error('from: too large.')
       }
    else {
       allbut = NO
       if (makset(arg, 1, from, MAXSET) == NO)
          call error('from: too large.')
       }
    if (getarg(2, arg, MAXLINE) == EOF)
       to(1) = EOS
    else if (makset(arg, 1, to, MAXSET) == NO)
          call error('to: too large.')

    lastto = length(to)
    if (length(from) > lastto | allbut == YES)
       collap = YES
    else
       collap = NO
    repeat {
       i = xindex(from, getc(c), allbut, lastto)
       if (collap == YES & i >= lastto & lastto > 0) {  # collapse
          call putc(to(lastto))
          repeat
             i = xindex(from, getc(c), allbut, lastto)
             until (i < lastto)
          }
       if (c == EOF)
          break
       if (i > 0 & lastto > 0)   # translate
          call putc(to(i))
       else if (i == 0)      # copy
          call putc(c)
                   # else delete
       }

 #***
    DRETURN
    end
#-t-  tr                         1429  local   12/24/80  15:11:35
#-h-  makset                      300  local   12/24/80  15:11:35
 ## makset - make set from  array(k)  in  set
    integer function makset(array, k, set, size)
    integer addset
    integer i, j, k, size
    character array(ARB), set(size)

    i = k
    j = 1
    call filset(EOS, array, i, set, j, size)
    makset = addset(EOS, set, j, size)
    return
    end
#-t-  makset                      300  local   12/24/80  15:11:35
#-h-  xindex                      378  local   12/24/80  15:11:36
 ## xindex - invert condition returned by index
    integer function xindex(array, c, allbut, lastto)
    character array(ARB), c
    integer index
    integer allbut, lastto

    if (c == EOF)
       xindex = 0
    else if (allbut == NO)
       xindex = index(array, c)
    else if (index(array, c) > 0)
       xindex = 0
    else
       xindex = lastto + 1
    return
    end
#-t-  xindex                      378  local   12/24/80  15:11:36
#-t-  tr.r                       2503  local   12/24/80  15:11:51
#-t-  tr                         5251  local   12/24/80  15:54:42
#-h-  tsort                      8649  local   12/24/80  15:54:43
#-h-  tsort.doc                  1736  local   12/24/80  15:21:57
.bp 1
.in 0
.he 'TSORT (1)'10/1/78'TSORT (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
tsort - topologically sort symbols
.nf
.sp
.ti -3
SYNOPSIS
.br
tsort [files ...]
.fi
.sp
.ti -3
DESCRIPTION
.br
Tsort
topologically sorts the symbols in the named files.
If no files are specified, or the filename '-' is given,
tsort reads the standard input.

A symbol is considered any string of characters delimited
by blanks or tabs.

Each line of the input is assumed to be of the form
.sp
.in +3
.nf
a b c ...
.in -3
.sp
.fi
which states that
a
precedes
b, a
precedes
c,
and so on.
Note that there is nothing implied about the ordering of
b
and
c.
A line consisting of a single symbol simply "declares"
that symbol without specifying any ordering relations about it.
The output is a topologically sorted
list of symbols, one per line.
.sp
.fi
For example, suppose you have trouble getting up in the morning
because you can't quite remember what actions have to be
performed in which order.
However, you do know that the first action in the following
list precedes all others on the line:

.in +5
.nf
set_alarm   turn_off_alarm
wake_up    get_out_of_bed    turn_off_alarm
set_alarm     wake_up
.in -5
.fi

Using tsort to sort the above list would produce the following
set of actions for getting out of bed:

.in +5
.nf
set_alarm
wake_up
turn_off_alarm
get_out_of_bed
.fi
.in -5
.sp
.ne 2
.ti -3
DIAGNOSTICS
.br
circular
.br
.in +3
The input specifies a graph that contains at least one cycle.
.in -3
.sp
out of storage
.br
.in +3
The input is too large.
The size of tsort's buffer is determined by the MAXBUF
definition in the source code.
.in -3
.sp
.ne 2
.ti -3
SEE ALSO
.br
sort
.ne 3
.sp
.ti -3
AUTHORS
.br
David Hanson and friends (U. of Arizona)
#-t-  tsort.doc                  1736  local   12/24/80  15:21:57
#-h-  ctsort                      308  local   12/24/80  15:21:57
 ## common block for tsort tool
 #  put on a file caled "ctsort"
 #  used only by tsort

 common /ctsort/ hash(128), nxtsym, nxtfre, buf(MAXBUF)
   integer hash		# hash table headers
   integer nxtsym	# next symbol structure
   integer nxtfre	# next free word at bottom of buf
   integer buf		# free storage
#-t-  ctsort                      308  local   12/24/80  15:21:57
#-h-  tsort.r                    6209  local   12/24/80  15:21:58
#-h-  tsort                      1315  local   12/24/80  15:15:35
 ## tsort - symbolic topological sort on symbols

 # include ratdef
define(MAXBUF,5000)     # storage array
define(MAXSYMBOL,120)   # maximum symbol size
# symbol table entries
define(NEXT,0)          # pointer to next entry
define(SYMBOL,1)        # pointer to symbol structure
define(CHARS,2)         # characters in symbol
# node structure
define(LINK,0)          # pointer to next node
define(SUCC,1)          # pointer to successor symbol structure
define(NODESIZE,2)      # size of node structure
# symbol structure
define(NAME,0)          # symbol structure; pointer to name
define(COUNT,1)         # successor count
define(TOP,2)           # beginning of successor list
define(SYMSIZE,3)       # size of symbol structure

DRIVER(tsort)

 integer getarg, open
 integer i, fd
 character arg(FILENAMESIZE)

   call query ("usage:  tsort [files].")
 for (i=1; getarg(i, arg, FILENAMESIZE) != EOF; i=i+1)
        {
        if (arg(1) == MINUS & arg(2) == EOS)
                fd = STDIN
        else
                {
                fd = open(arg, READ)
                if (fd == ERR)
                        call cant(arg)
                }
        call tpsort (fd)
        if (fd != STDIN)
                call close(fd)
        }
 if (i == 1)            #read STDIN
        call tpsort (STDIN)
 DRETURN
 end
#-t-  tsort                      1315  local   12/24/80  15:15:35
#-h-  entprc                      270  local   12/24/80  15:15:35
# entprc - enter the relation a < b
   subroutine entprc(a, b)
   integer a, b
   integer p
   integer nalloc
   include ctsort

   buf(b+COUNT) = buf(b+COUNT) + 1
   p = nalloc(NODESIZE)
   buf(p+LINK) = buf(a+TOP)
   buf(p+SUCC) = b
   buf(a+TOP) = p
   return
   end
#-t-  entprc                      270  local   12/24/80  15:15:35
#-h-  icopys                      325  local   12/24/80  15:15:35
 ## icopys - copy integer string at from(i) to char string at to(j)
    subroutine icopys(from, i, to, j)
    integer from(ARB)
    character to(ARB)
    integer i, j, k1, k2

    k2 = j
    for (k1 = i; from(k1) != EOS; k1 = k1 + 1) {
       to(k2) = from(k1)
       k2 = k2 + 1
       }
    to(k2) = EOS
    return
    end
#-t-  icopys                      325  local   12/24/80  15:15:35
#-h-  looks                       672  local   12/24/80  15:15:36
 ## looks - lookup symbol s, insert if necessary
   integer function looks(s)
   character s(MAXSYMBOL), lin(MAXSYMBOL)
   integer i
   integer length, nalloc, equal, symalc
   include ctsort

   for (i = hash(s(1)+1); i > 0; i = buf(i+NEXT))
      {
      call icopys (buf, i+CHARS, lin, 1)  # convert from int to char
      if (equal(s, lin) == YES)                 # got it
         return (buf(i+SYMBOL))
     }
   i = nalloc(CHARS + 1 + length(s) + 1)        # must make new entry
   buf(i+NEXT) = hash(s(1)+1)   # add onto proper hash chain
   hash(s(1)+1) = i
   buf(i+SYMBOL) = symalc(i+CHARS)
   call scopyi(s, 1, buf, i + CHARS)
   return (buf(i+SYMBOL))
   end
#-t-  looks                       672  local   12/24/80  15:15:36
#-h-  nalloc                      222  local   12/24/80  15:15:36
# nalloc - allocate n words in top part of buf
   integer function nalloc(n)
   integer n
   include ctsort

   nxtfre = nxtfre - n
   if (nxtfre < nxtsym)
      call error("out of storage.")
   return (nxtfre + 1)
   end
#-t-  nalloc                      222  local   12/24/80  15:15:36
#-h-  scopyi                      322  local   12/24/80  15:15:37
 ## scopyi - copy char string at from(i) to integer string to(j)
    subroutine scopyi(from, i, to, j)
    character from(ARB)
    integer to(ARB)
    integer i, j, k1, k2

    k2 = j
    for (k1 = i; from(k1) != EOS; k1 = k1 + 1) {
       to(k2) = from(k1)
       k2 = k2 + 1
       }
    to(k2) = EOS
    return
    end
#-t-  scopyi                      322  local   12/24/80  15:15:37
#-h-  symalc                      308  local   12/24/80  15:15:37
# symalc - allocate a symbol structure for symbol s
   integer function symalc(s)
   integer s
   integer p
   include ctsort

   p = nxtsym
   nxtsym = nxtsym + SYMSIZE
   if (nxtsym > nxtfre)
      call error("out of storage.")
   buf(p+NAME) = s
   buf(p+COUNT) = 0
   buf(p+TOP) = 0
   return (p)
   end
#-t-  symalc                      308  local   12/24/80  15:15:37
#-h-  tpsort                     1516  local   12/24/80  15:15:37
 ## tpsort - topological sort file 'fd'
 subroutine tpsort (fd)
   character linbuf(MAXLINE), symbuf(MAXSYMBOL)
   integer i, j, f, r, n, fd
   integer getwrd, getlin, looks
   include ctsort

   nxtsym = 1   # initialize
   nxtfre = MAXBUF
   for (i = 1; i <= 128; i = i + 1)
      hash(i) = 0
   while (getlin(linbuf, fd) ^= EOF) {
      i = 1
      if (getwrd(linbuf, i, symbuf) <= 0)       # ignore blank lines
         next
      j = looks(symbuf)
      while (getwrd(linbuf, i, symbuf) > 0)
         call entprc(j, looks(symbuf))          # insert a relation
      }
   f = 0        # build list of symbols with 0 counts
   for (i = 1; i < nxtsym & f == 0; i = i + SYMSIZE)    # find first 0
      if (buf(i+COUNT) == 0)
         f = i
   for (r = f; i < nxtsym; i = i + SYMSIZE)     # find rest of 0 counts
      if (buf(i+COUNT) == 0) {
         buf(r+COUNT) = i
         r = i
         }
   n = nxtsym   # will be 0 if non-circular
   for (; f > 0; f = buf(f+COUNT)) {    # print in topological order
#      call putlin(buf(buf(f+NAME)), STDOUT)
       call icopys (buf, buf(f+NAME), linbuf, 1)
       call putlin(linbuf, STDOUT)
      call putch(NEWLINE, STDOUT)
      for (i = buf(f+TOP); i > 0; i = buf(i+LINK)) {
         j = buf(i+SUCC)
         buf(j+COUNT) = buf(j+COUNT) - 1
         if (buf(j+COUNT) == 0) {       # add more onto list
            buf(r+COUNT) = j
            r = j
            }
         }
      n = n - SYMSIZE
      }
   if (n > 1)
      call error("circular.")
   return
   end
#-t-  tpsort                     1516  local   12/24/80  15:15:37
#-h-  usage                        71  local   12/24/80  15:15:38
 subroutine usage

 call error ("usage:  tsort [files].")
 return
 end
#-t-  usage                        71  local   12/24/80  15:15:38
#-t-  tsort.r                    6209  local   12/24/80  15:21:58
#-t-  tsort                      8649  local   12/24/80  15:54:43
#-h-  uniq                       3263  local   01/09/81  00:45:20
#-h-  uniq.doc                    869  local   01/09/81  00:43:48
.bp 1
.in 0
.he 'UNIQ (1)'1/11/79'UNIQ (1)'
.fo ''-#-'
.fi
NAME
.br
.in 7
uniq - strip adjacent repeated lines from a file
.sp 1
.in
SYNOPSIS
.br
.in 7
uniq [-c] [file ...]
.sp 1
.in
DESCRIPTION
.br
.in 7
Uniq
reads the input file(s), comparing adjacent lines.
Second and succeeding copies of repeated lines are removed; the
remainder is written to standard output.

If the '-c' flag is given,
each line is preceded by a count of the number of occurrences of
that line.
.sp 1
.in
FILES
.br
.in 7
.sp 1
.in
SEE ALSO
.br
.in 7
The tool 'comm'; the Unix command 'uniq'
.sp 1
.in
DIAGNOSTICS
.br
.in 7
A message is printed if an input file cannot be opened and
processing is terminated.
.sp 1
.in
AUTHORS
.br
.in 7
.sp 1
Originally from Kernighan and Plauger's 'Software Tools', with
modifications by Debbie Scherrer (Lawrence Berkeley Laboratory)
.sp 1
.in
BUGS
.br
.in 7
#-t-  uniq.doc                    869  local   01/09/81  00:43:48
#-h-  uniq.r                     2130  local   12/24/80  15:22:15
#-h-  uniq                        834  local   12/24/80  15:21:40
 ## uniq -strip adjacent duplicate lines
 DRIVER(uniq)
 character buf(MAXLINE)
 integer open, getarg
 integer i, int, count

 data count /NO/

 call query ("usage:  uniq [-c] [file].")
 for (i=1; getarg(i, buf, MAXLINE) != EOF; i=i+1)
        {
        if (buf(1) == MINUS & (buf(2) == LETC | buf(2) == BIGC))
                {
                count = YES
                next
                }
        else if (buf(1) == MINUS & buf(2) == EOS)
                int = STDIN
        else
                {
                int = open(buf,READ)
                if (int == ERR)
                        call cant(buf)
                }
        call unik (int, count)
        if (int != STDIN)
                call close(int)
        }

 if (i == 1 | (i == 2 & count == YES))  #read from STDIN
        call unik (STDIN, count)
 DRETURN
 end
#-t-  uniq                        834  local   12/24/80  15:21:40
#-h-  unik                       1032  local   12/24/80  15:21:41
 ## unik   - locate duplicate lines in file int
 subroutine unik (int, count)
 integer equal, getlin
 integer t, count, k
 character buf1(MAXLINE), buf2(MAXLINE)

 t = getlin(buf1, int)
 while (t != EOF)
        {
        k = 1
        for (t=getlin(buf2,int); t!= EOF; t=getlin(buf2,int))
                {
                if (equal(buf1, buf2) == NO)
                        break
                k = k + 1
                }
        if (count == YES)
                {
                call putdec(k, 5)
                call putc(BLANK)
                }
        call putlin(buf1, STDOUT)
        if (t == EOF)
                break
        k = 1
        for (t=getlin(buf1,int); t!= EOF; t=getlin(buf1,int))
                {
                if (equal(buf1,buf2) == NO)
                        break
                k = k + 1
                }
        if (count == YES)
                {
                call putdec(k, 5)
                call putc(BLANK)
                }
        call putlin(buf2, STDOUT)
        }
 return
 end
#-t-  unik                       1032  local   12/24/80  15:21:41
#-t-  uniq.r                     2130  local   12/24/80  15:22:15
#-t-  uniq                       3263  local   01/09/81  00:45:20
#-h-  unrot                      4499  local   01/06/81  23:27:09
#-h-  unrot.doc                   890  local   01/06/81  23:25:46
.bp 1
.in 0 
.he 'UNROT (1)'1/15/79'UNROT (1)'
.fo ''-#-' 
.fi 
NAME 
.br 
.in 7 
unrot - unrotate lines rotated by kwic
.sp 1 
.in 
SYNOPSIS 
.br 
.in 7 
unrot [-n] [file ...]
.sp 1 
.in 
DESCRIPTION 
.br 
.in 7 
Unrot
processes the rotated output of 'kwic' to generate a keyword-in-context
index.
 
The -n flag may be used to specify the width of the output lines.
The default is 80.
 
If no input files are given, or the filename '-' appears, lines will
be read from standard input.
.sp 1
.in 
FILES 
.br 
.in 7 
.sp 1 
.in 
SEE ALSO 
.br 
.in 7 
kwic; sort
.sp 1 
.in 
DIAGNOSTICS 
.br 
.in 7 
A message is printed if an input file cannot be opened; further processing
is terminated.
.sp 1 
.in 
AUTHORS 
.br 
.in 7 
.sp 1 
Original from Kernighan and Plauger's 'Software Tools', with 
minor modifications
by Debbie Scherrer, Lawrence Berkeley Laboratory.
.sp 1 
.in 
BUGS 
.br 
.in 7 
#-t-  unrot.doc                   890  local   01/06/81  23:25:46
#-h-  unrot.r                    3345  local   01/06/81  23:25:47
 ## definitions for kwic and unrot tools
 
 define(FOLD,DOLLAR)    #character to indicate beginning of folded line
 define(MAXOUT,80)      #width of index
 #---------------------------------------------------------------------
 ## unrot - unrotate lines rotated by kwic
 DRIVER(unrot)
 
 character buf(MAXLINE)
 integer work
 integer getarg, open, ctoi
 integer i, int, width, j, n
 
 data width /MAXOUT/
 data work /NO/
  
 call query ("usage:  unrot [-n] [file].")
 for (i=1; getarg(i,buf,MAXLINE)!=EOF; i=i+1)
        {
        if (buf(1) == MINUS & buf(2) != EOS)
                {
                j = 2
                n = ctoi(buf,j)
                if (n > 0)
                        width = n
                next
                }
        else if (buf(1) == MINUS)
                int = STDIN
        else
                {
                int = open(buf, READ)
                if (int == ERR)
                        call cant(buf)
                }
        call nrot (int, width)
        work = YES
        if (int != STDIN)
                call close(int)
        }
 
 if (work == NO)
        call nrot (STDIN, width)
 DRETURN
 end
 ## nrot - unrotate lines from file -int-
 subroutine nrot(int, width)
 character inbuf(MAXLINE), outbuf(MAXLINE)
 integer getlin, index
 integer int, i, j, width, middle
 
 middle = max(width/2, 1)
 while (getlin(inbuf, int) != EOF)
        {
        for (i=1; i<width; i=i+1)               #blank line
                outbuf(i) = BLANK
        j = middle
        for (i=1; inbuf(i)!=FOLD & inbuf(i)!=NEWLINE; i=i+1)
                {
                j = j + 1                       #copy up to FOLD
                if (i>1 & inbuf(i-1) == BLANK)
                        if (nextj(+1,inbuf,i,j) >= width - 1)
                                j = 1
                        if (j >= width - 1)
                                j = 1
                outbuf(j) = inbuf(i)
                }
        if (inbuf(i) == FOLD)                   #copy second half
                {
                j = middle                      #working backwards
                for (i=index(inbuf,NEWLINE)-1; i>0; i=i-1)
                        {
                        if (inbuf(i) == FOLD)
                                break
                        j = j -1
                        if (inbuf(i+1) == BLANK)
                                if (nextj(-1,inbuf,i,j) <= 0)
                                        j = width - 2
                        if (j <= 0)
                                j = width - 2
                        outbuf(j) = inbuf(i)
                        }
                }
        for (i=width-2; i > 0; i=i-1)
                if (outbuf(i) != BLANK)         #delete trailing blanks
                        break
        outbuf(i+1) = NEWLINE                   #terminate line properly
        outbuf(i+2) = EOS
        call putlin(outbuf, STDOUT)
        }
 
 return
 end
        ## nextj - see if enough space for another word
        integer function nextj(incmnt,buf,i,j)
        character buf(ARB)
        integer incmnt, i, j, k
 
        nextj = j
        for (k=i; k>0; k = k + incmnt)
                {
                if (buf(k) == BLANK | buf(k) == FOLD | buf(k) == NEWLINE)
                        break
                nextj = nextj + incmnt
                }
        return
        end
#-t-  unrot.r                    3345  local   01/06/81  23:25:47
#-t-  unrot                      4499  local   01/06/81  23:27:09
#-h-  wc                         4132  local   12/24/80  15:54:46
#-h-  wc.doc                      913  local   12/24/80  15:29:23
.bp 1
.in 0
.he 'WC (1)'2/15/79'WC (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
wc - count lines, words, and characters in files
.nf
.sp
.ti -3
SYNOPSIS
.br
wc [-lwc] files...
.fi
.sp
.ti -3
DESCRIPTION
.br
Wc prints the number of lines, words, and characters in the named
files.
The filename "-" specifies the standard input.
A total is also printed.  A "word" is any sequence of characters
delimited by white space.
.sp
The options -l, -w, and -c specify, respectively, that only the line,
word, or character count be printed.  For example,
.sp
.in +3
.nf
wc -lc foo
.in -3
.sp
.fi
prints the number of lines and characters in "foo".
.sp
If no files are given, wc reads its standard input and the total
count is suppressed.
.fi
.sp
.ne 2
.ti -3
DIAGNOSTICS
.br
name: can't open
.in +5
Printed when an input file can't be opened; processing ceases
.in -5
.sp
.ti -3
AUTHORS
.br
David Hanson and friends (U. of Arizona)
#-t-  wc.doc                      913  local   12/24/80  15:29:23
#-h-  wc.r                       2955  local   12/24/80  15:29:23
#-h-  wc                         1684  local   12/24/80  15:26:47
# wc - count lines, words, and characters in named files or STDIN
DRIVER(wc)
   character arg(MAXLINE)
   integer open, getarg
   integer fd, i, j, words, lines, chars, nfiles
   integer nl, nw, nc, tl, tw, tc
   string total "total"
   data words /YES/, lines /YES/, chars /YES/   # -lwc is default
   data tl /0/, tw /0/, tc /0/

   call query ("usage:  wc [-lwc] [files].")
   for (i = 1; getarg(i, arg, MAXNAME) ^= EOF; i = i + 1)
      if (arg(1) == MINUS & arg(2) ^= EOS) {
         lines = NO
         words = NO
         chars = NO
         for (j = 2; arg(j) ^= EOS; j = j + 1)
            if (arg(j) == LETL | arg(j) == BIGL)
               lines = YES
            else if (arg(j) == LETW | arg(j) == BIGW)
               words = YES
            else if (arg(j) == LETC | arg(j) == BIGC)
               chars = YES
            else
               call error("usage: wc [-lwc] files.")
         }
      else {
         nfiles = nfiles + 1
         if (arg(1) == MINUS)
            fd = STDIN
         else
            fd = open(arg, READ)
         if (fd == ERR) {
            call putlin(arg, ERROUT)
            call remark(": can't open.")
            }
         else {
            call dowc(fd, nl, nw, nc)
            call printc(arg, nl, nw, nc, lines, words, chars)
            tl = tl + nl
            tw = tw + nw
            tc = tc + nc
            if (fd ^= STDIN)
               call close(fd)
            }
         }
   if (nfiles == 0) {   # no args, do STDIN
      call dowc(STDIN, nl, nw, nc)
      call printc(EOS, nl, nw, nc, lines, words, chars)
      }
   else if (nfiles > 1)
      call printc(total, tl, tw, tc, lines, words, chars)
   DRETURN
   end
#-t-  wc                         1684  local   12/24/80  15:26:47
#-h-  dowc                        484  local   12/24/80  15:26:47
# dowc - count lines, words, and characters in fd
   subroutine dowc(fd, nl, nw, nc)
   integer fd, nl, nw, nc
   character getch
   character c
   integer inword

   nl = 0
   nw = 0
   nc = 0
   inword = NO
   while (getch(c, fd) ^= EOF) {
      nc = nc + 1
      if (c == NEWLINE)
         nl = nl + 1
      if (c == BLANK | c == NEWLINE | c == TAB)
         inword = NO
      else if (inword == NO) {
         inword = YES
         nw = nw + 1
         }
      }
   return
   end
#-t-  dowc                        484  local   12/24/80  15:26:47
#-h-  printc                      391  local   12/24/80  15:26:48
# printc - print count statistics for arg
   subroutine printc(arg, nl, nw, nc, lines, words, chars)
   character arg(ARB)
   integer nl, nw, nc, lines, words, chars
   if (lines == YES)
      call putdec(nl, 8)
   if (words == YES)
      call putdec(nw, 8)
   if (chars == YES)
      call putdec(nc, 8)
   call putc(BLANK)
   call putlin(arg, STDOUT)
   call putc(NEWLINE)
   return
   end
#-t-  printc                      391  local   12/24/80  15:26:48
#-t-  wc.r                       2955  local   12/24/80  15:29:23
#-t-  wc                         4132  local   12/24/80  15:54:46
#-h-  xref                       9439  local   12/24/80  15:54:47
#-h-  xref.doc                   1297  local   12/24/80  15:47:57
.bp 1
.in 0
.he 'XREF (1)'1/1/79'XREF (1)'
.sp 2
.in +3
.fi
.ti -3
NAME
.br
xref - make a cross reference of symbols
.nf
.sp
.ti -3
SYNOPSIS
.br
xref [-f] [files ...]
.fi
.sp
.ti -3
DESCRIPTION
.br
Xref
produces a cross-reference
list of the symbols in each of the named files
on the standard output.
Each symbol is listed followed by the numbers of the lines
in which it appears.
If no files are given,
or the file "-" is specified, xref reads the standard input.
.sp
A symbol is defined as a string of letters, digits, underlines,
or periods that begins with a letter.
Symbols exceeding an internal limit are truncated.
This limit is determined by the MAXTOK definition in
the source code, and is currently set to 15.
.sp
Normally, xref treats upper- and lower-case letters as different
characters.  The -f option causes all letters to be folded to
lower-case.
.fi
.sp
.ne 2
.ti -3
DIAGNOSTICS
.br
out of storage
.br
.in +3
The file contains too many symbols or references to fit
within the current limitations of xref.
The size of the buffer is determined by the MAXBUF definition
in the source code.
.in -3
.fi
.sp
.ti -3
AUTHORS
.br
David Hanson and friends (U. of Arizona)
.sp
.ne 2
.ti -3
BUGS/DEFICIENCIES
.br
There should be a means of suppressing "junk" symbols such
as "the", "a", etc.
#-t-  xref.doc                   1297  local   12/24/80  15:47:57
#-h-  cxref                       236  local   12/24/80  15:47:58
 ## common block for xref tool
 #  put on a file called "cxref"
 #  (Used only by 'xref')

 common /cxref/ buf(MAXBUF), nextbf
   integer buf	        # holds trees and linked lists
   integer nextbf	# next free element in buf, init = 1
#-t-  cxref                       236  local   12/24/80  15:47:58
#-h-  xref.r                     7510  local   12/24/80  15:47:58
#-h-  xref                       1524  local   12/24/80  15:30:41
# xref - make cross reference list of named files

 # include ratdef

# layout of tree nodes
define(LLINK,0)   # pointer to left subtree
define(RLINK,1)   # pointer to right subtree
define(LNLIST,2)  # pointer to list of references
define(LAST,3)    # pointer to last reference entered
define(ENTRY,4)   # name (string)
define(TNODESIZE,5)# size of node = TNODESIZE + length(name) + 1

# layout of linked list nodes
define(LINENUM,0) # line number
define(LINK,1)    # pointer to next line number
define(LNODESIZE,2)

define(MAXBUF,15000)
define(LINESIZE,80) # length of output lines (see pentry)
define(MAXTOK,15) # maximum token size (see pentry)
define(MAXNUM,5)  # size of line number entry (see pentry)

DRIVER(xref)

   character name(MAXTOK), arg(MAXNAME)
   integer fd, fflag, nfiles
   integer open, getarg
   data fflag/NO/, nfiles/0/

   call query ("usage:  xref [-f] [files].")
   for (i = 1; getarg(i, arg, MAXNAME) ^= EOF; i = i + 1)
      if (arg(1) == MINUS & (arg(2) == LETF | arg(2) == BIGF))
         fflag = YES
      else if (arg(1) == MINUS & arg(2) ^= EOS)
         call error ("usage:  xref [-f] [files].")
      else {
         if (arg(1) == MINUS)
            fd = STDIN
         else
            fd = open(arg, READ)
         if (fd == ERR)
            call cant(arg)
         call putlin(arg, STDOUT)
         call putc(COLON)
         call putc(NEWLINE)
         call doxref(fd, fflag)
         nfiles = nfiles + 1
         }
   if (nfiles == 0)
      call doxref(STDIN, fflag)
   DRETURN
   end
#-t-  xref                       1524  local   12/24/80  15:30:41
#-h-  balloc                      236  local   12/24/80  15:30:42
# balloc - allocate n words in storage array buf; return index
   integer function balloc(n)
   integer n
   include cxref

   nextbf = nextbf + n
   if (nextbf > MAXBUF)
      call error("out of storage.")
   return(nextbf - n)
   end
#-t-  balloc                      236  local   12/24/80  15:30:42
#-h-  doxref                      567  local   12/24/80  15:30:43
# doxref-generate cross reference list for file fd; fold if fflag = YES
   subroutine doxref(fd, fflag)
   integer fd, fflag
   integer t, root
   integer gettok
   character token(MAXTOK)
   include cxref

   root = 0
   nextbf = 1
   lineno = 1
   repeat {
      t = gettok(token, MAXTOK, fd)
      if (t == EOF)
         break
      if (t == LETTER) {
         if (fflag == YES)
            call fold(token)
         call instl(token, lineno, root)
         }
      else if (t == NEWLINE)
         lineno = lineno + 1
      }
   call tprint(root)
   return
   end
#-t-  doxref                      567  local   12/24/80  15:30:43
#-h-  gettok                     1006  local   12/24/80  15:30:43
# gettok - get text token from file fd
   character function gettok(token, size, fd)
   character token(ARB)
   integer size, fd
   character getch, type
   integer i
   character c, peek
   data peek /0/

   if (peek == 0)    # check for lookahead
      c = getch(c, fd)
   else {
      c = peek
      peek = 0
      }
   for (; c ^= EOF; c = getch(c, fd)) {
      gettok = type(c)
      if (gettok == LETTER) {   # start of name
         token(1) = c
         for (i = 2; getch(c, fd) ^= EOF; i = i + 1)
            if (type(c) == LETTER | type(c) == DIGIT) {
               if (i < size)
                  token(i) = c
               }
            else
               break
         peek = c   # went one too far
         if (i <= size)
            token(i) = EOS
         else
            token(size) = EOS
         return(LETTER)
         }
      else if (gettok == NEWLINE) {  # newline must be returned
         peek = 0
         return(NEWLINE)
         }
      }
   peek = 0
   return(EOF)
   end
#-t-  gettok                     1006  local   12/24/80  15:30:43
#-h-  icopys                      325  local   12/24/80  15:30:44
 ## icopys - copy integer string at from(i) to char string at to(j)
    subroutine icopys(from, i, to, j)
    integer from(ARB)
    character to(ARB)
    integer i, j, k1, k2

    k2 = j
    for (k1 = i; from(k1) != EOS; k1 = k1 + 1) {
       to(k2) = from(k1)
       k2 = k2 + 1
       }
    to(k2) = EOS
    return
    end
#-t-  icopys                      325  local   12/24/80  15:30:44
#-h-  instl                      1076  local   12/24/80  15:30:44
# instl - install name in tree with reference on lineno; update tree
   subroutine instl(name, lineno, tree)
   character name(ARB), temp(MAXNAME)
   integer lineno, tree
   integer cond, p, q
   integer balloc, strcmp, length
   include cxref

   p = tree
   for (q = 0; p ^= 0; p = buf(q)) {
      call icopys (buf, p+ENTRY, temp, 1)  #convert from int to char
      cond = strcmp(name, temp)
      if (cond == 0) {
         q = balloc(LNODESIZE)   # add a new element onto list
         buf(q+LINENUM) = lineno
         buf(q+LINK) = 0
         buf(buf(p+LAST)+LINK) = q
         buf(p+LAST) = q
         return
         }
      else if (cond < 0)
         q = p + LLINK
      else
         q = p + RLINK
      }
   p = balloc(TNODESIZE+length(name)+1) # allocate and fill in new node
   buf(p+LLINK) = 0
   buf(p+RLINK) = 0
   call scopyi(name, 1, buf, p+ENTRY)
   if (q == 0)
      tree = p
   else
      buf(q) = p
   q = balloc(LNODESIZE)   # insert first reference
   buf(q+LINENUM) = lineno
   buf(q+LINK) = 0
   buf(p+LNLIST) = q
   buf(p+LAST) = q
   return
   end
#-t-  instl                      1076  local   12/24/80  15:30:44
#-h-  pentry                      558  local   12/24/80  15:30:45
# pentry - print name and list of references
   subroutine pentry(name, list)
   character name(ARB)
   integer list
   integer i, len
   include cxref

   call putstr(name, -MAXTOK - 1, STDOUT)
   len = MAXTOK + 1
   for (i = list; i ^= 0; i = buf(i+LINK)) {
      if (len > LINESIZE - MAXNUM) {
         call putc(NEWLINE)
         call putstr(EOS, -MAXTOK - 1, STDOUT)
         len = MAXTOK + 1
         }
      call putint(buf(i+LINENUM), MAXNUM, STDOUT)
      len = len + MAXNUM
      }
   if (len <= LINESIZE)
      call putc(NEWLINE)
   return
   end
#-t-  pentry                      558  local   12/24/80  15:30:45
#-h-  scopyi                      322  local   12/24/80  15:30:45
 ## scopyi - copy char string at from(i) to integer string to(j)
    subroutine scopyi(from, i, to, j)
    character from(ARB)
    integer to(ARB)
    integer i, j, k1, k2

    k2 = j
    for (k1 = i; from(k1) != EOS; k1 = k1 + 1) {
       to(k2) = from(k1)
       k2 = k2 + 1
       }
    to(k2) = EOS
    return
    end
#-t-  scopyi                      322  local   12/24/80  15:30:45
#-h-  tprint                      707  local   12/24/80  15:30:45
# tprint - destructively print tree, left subtree first
   subroutine tprint(tree)
   integer tree
   integer p, q, sp
   character temp(MAXNAME)
   include cxref

   sp = 0
   p = tree
   repeat {
      while (p ^= 0)
         if (buf(p+LLINK) ^= 0) {
            q = buf(p+LLINK)
            buf(p+LLINK) = sp
            sp = p
            p = q
            }
         else {
            call icopys (buf, p+ENTRY, temp, 1)
            call pentry(temp, buf(p+LNLIST))
            p = buf(p+RLINK)
            }
      if (sp == 0)
         return
      call icopys (buf, sp+ENTRY, temp, 1)
      call pentry(temp, buf(sp+LNLIST))
      p = buf(sp+RLINK)
      sp = buf(sp+LLINK)
      }
   return
   end
#-t-  tprint                      707  local   12/24/80  15:30:45
#-t-  xref.r                     7510  local   12/24/80  15:47:58
#-t-  xref                       9439  local   12/24/80  15:54:47
                                                                                                                                                                                                                                                                                        