%%s 0/0/0
%%d D 1.1 25-Mar-82 12:14:49 v1.1 1 0
%%c Version 1.1 is the Spring 1982 Distribution of the LBL/Hughes release
%%c of the Software Tools Virtual Operating System software and documentation.
%%T
%%I 1
#-h- flist            277  asc  25-mar-82 08:51:33  v1.1 (sw-tools v1.1)
  #------------------------------------------------------
  # flist - common block
  # should be put on a file named 'flist'
 
  common /flist/  flevel, ffiles(FILENAMESIZE, FLMAX)
    
    integer flevel	#pointer to current file
    character ffiles	#list of files to process
#-h- select           651  asc  25-mar-82 08:51:33  v1.1 (sw-tools v1.1)
 # 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
#-h- sortcom         1026  asc  25-mar-82 08:51:34  v1.1 (sw-tools v1.1)
 # sortcom common block - holds information about sort flags
 # put on a file called 'sortcom'
 # 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
#-h- sort.r         14166  asc  25-mar-82 08:51:46  v1.1 (sw-tools v1.1)
#-h- defns           1042  asc  25-mar-82 08:50:27  v1.1 (sw-tools v1.1)
 # definitions for sort tool
 # put on a file called 'defns'
 # used only by the sort tool
 
ifdef(LARGE_ADDRESS_SPACE)
  define(LOGPTR,40)
  define(MAXPTR,3000)
  define(MAXTEXT,72000)
elsedef
  define(LOGPTR,20)
  define(MAXPTR,750)
  define(MAXTEXT,18000)
enddef
# the following three lines define the number of scratch files
# NFILES is the maximum number of temp files permitted on the system, after
# reducing MAXOFILES (max number of open files) by the standard three.
# MAXTMPFILES is the maximum number of temp files before file opening and
# closing start to dominate the CPU usage of sort.  The ifelse subtracts
# this limit from the max permitted on the system.  If the result is negative,
# i.e. the first character of the arith is `-`, then TAPENO is defined as
# NFILES, else it is defined as MAXTMPFILES
 define(NFILES,arith(MAXOFILES,-,3))
 define(MAXTMPFILES,6)
 ifelse(substr(arith(NFILES,-,MAXTMPFILES),1,1),-,$(define(TAPENO,NFILES)$),
	$(define(TAPENO,MAXTMPFILES)$))
 define(CTRLD,4)
 define(FLMAX,25)
 define(EOI,ERR)
#-h- main            2013  asc  25-mar-82 08:50:28  v1.1 (sw-tools v1.1)
 DRIVER(sort)

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

 include select
 include sortcom

 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
    if (assign(file(1,i), unit(i), READ) == 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)
    if (assign(file(1,i), unit(i), WRITE) == ERR)
	call cant(file(1,i))
    if (assign(file(1,j), unit(j), READ) == 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
 DRETURN
 end
#-h- cleans           190  asc  25-mar-82 08:50:29  v1.1 (sw-tools v1.1)
 subroutine cleans

 integer i, junk
 integer remove

 include select

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

 return
 end
#-h- compar          1912  asc  25-mar-82 08:50:30  v1.1 (sw-tools v1.1)
  #----------------------------------------------------------------- 
  
 ## compar - compare lin(lp1) with lin(lp2) 
    integer function compar(lp1, lp2, lin) 
  
    character lin(ARB) 
    integer i, j, lp1, lp2 
    integer type, ct
    character c1,c2
    character clower
    include sortcom 
  
    i = lp1 
    j = lp2 
  
  if (blanks == YES)      # ignore leading blanks 
       { 
       while (lin(i) == ' ')  i = i + 1 
       while (lin(j) == ' ')  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== ' ' | ct == EOS)  break 
            i = i + 1 
            } 
         repeat 
            { 
            ct = type (lin(j)) 
            if (ct == LETTER | ct == DIGIT | ct == ' ' | 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 
#-h- eor              147  asc  25-mar-82 08:50:30  v1.1 (sw-tools v1.1)
 integer function eor(buffer)

 character buffer(ARB)

 if (buffer(1) == CTRLD & buffer(2) == '@n')
    eor = YES
 else
    eor = NO

 return
 end
#-h- exchan           289  asc  25-mar-82 08:50:31  v1.1 (sw-tools v1.1)
  #-------------------------------------------------------------------- 
  
 ## 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 
  
#-h- fsetup           425  asc  25-mar-82 08:50:31  v1.1 (sw-tools v1.1)
 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) = 's'
    n = itoc(i, temp(2), 3)
    call scratf(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
#-h- fstack           362  asc  25-mar-82 08:50:31  v1.1 (sw-tools v1.1)
   #------------------------------------------------------------
   ## fstack - generate stack of input files
 
   subroutine fstack (iarg)
 
   integer i
   character iarg(FILENAMESIZE)
 
   include flist
 
   if (flevel < FLMAX)
     {
     flevel = flevel + 1
     for (i=1; i<=FILENAMESIZE; i=i+1)
         ffiles(i,flevel) = iarg(i)
     }
   return
   end
#-h- gsrtln           743  asc  25-mar-82 08:50:32  v1.1 (sw-tools v1.1)
 integer function gsrtln(buf)

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

 include flist

 string minust "-"

 data init/0/

 if (init == 0)
    {
    level = 0
    if (flevel == 0)
	{
	flevel = 1
        call scopy(minust, 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) == '-')
	    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
#-h- makrun           470  asc  25-mar-82 08:50:33  v1.1 (sw-tools v1.1)
 integer function makrun(nlines)

 integer nlines, lbp, len, gsrtln

 include sortcom

 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
#-h- mrgrun          1034  asc  25-mar-82 08:50:33  v1.1 (sw-tools v1.1)
 #	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 sortcom

 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
#-h- puteor           100  asc  25-mar-82 08:50:35  v1.1 (sw-tools v1.1)
 subroutine puteor(int)

 integer int

 call putch(CTRLD, int)
 call putch('@n', int)

 return
 end
#-h- putrun           236  asc  25-mar-82 08:50:36  v1.1 (sw-tools v1.1)
 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
#-h- quick           1427  asc  25-mar-82 08:50:38  v1.1 (sw-tools v1.1)
  #-------------------------------------------------------------------- 
  
 ## 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 
#-h- redout           193  asc  25-mar-82 08:50:40  v1.1 (sw-tools v1.1)
 subroutine redout

 integer assign

 include sortcom

 if (ifout == YES)
    if (assign(ofile, STDOUT, WRITE) == ERR)
	call remark("Cannot redirect standard output to +o file.")

 return
 end
#-h- reheap           656  asc  25-mar-82 08:50:42  v1.1 (sw-tools v1.1)
  #-------------------------------------------------------------------- 
  
 ## 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 
#-h- srtint          1062  asc  25-mar-82 08:50:44  v1.1 (sw-tools v1.1)
 subroutine srtint

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

 include select
 include sortcom
 include flist

 call query("usage:  sort [-bdfimr] [+ofile] [+sn] [file] ...")
 flevel = 0
 blanks = NO
 dict = NO
 fold = NO
 noprt = NO
 merg = NO
 revers = NO
 subf = NO
 cofset = 0
 ifout = NO
 for (i=1; getarg(i, temp, FILENAMESIZE) != EOF; i=i+1)
    {
    for (j=1; temp(j) != EOS; j=j+1)
        temp(j) = clower(temp(j))
    if (temp(1) == '-' & temp(2) != EOS)
	{
	if (index(temp, 'b') > 0)
	    blanks = YES
	if (index(temp, 'd') > 0)
	    dict = YES
	if (index(temp, 'f') > 0)
	    fold = YES
	if (index(temp, 'i') > 0)
	    noprt = YES
	if (index(temp, 'm') > 0)
	    merg = YES
	if (index(temp, 'r') > 0)
	    revers = YES
	}
    else if (temp(1) == '+' & clower(temp(2)) == 's')
	{
	subf = YES
	n = 3
	cofset = ctoi(temp, n) - 1
	if (cofset < 0)
	    cofset = 0
	}
    else if (temp(1) == '+' & clower(temp(2)) == 'o')
	{
	ifout = YES
	call scopy(temp, 3, ofile, 1)
	}
    else
	call fstack(temp)
    }
 return
 end
#-h- stape            346  asc  25-mar-82 08:50:48  v1.1 (sw-tools v1.1)
 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
#-h- sum              132  asc  25-mar-82 08:50:49  v1.1 (sw-tools v1.1)
 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
#-h- sort.fmt        3743  asc  25-mar-82 08:51:57  v1.1 (sw-tools v1.1)
.so ~bin/manhdr
.hd Sort (1) 14-Apr-78
sort and/or merge text files 
.sy
sort [-bdfimr] [+ofile] [+sn] [file] ... 
.ds
Sort sorts lines of all the named files together and writes the result 
on the standard output.  The name '-' means the standard input.  The 
standard input is also used if no input file names are given. 
Thus sort may be used as a filter. 
  
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 -3
+o Cause final output to be placed on `file'.  This permits one of the input
files to be the output file.  This switch is necessary since using the
redirection `>file' will cause `file' to be unreadable when `sort' is
generating the initial runs.

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

.in -4 
.fl
A series of scratch files are generated and subsequently deleted. 
Presently the files are named "STn" where "n" is a sequence number. 
.sa
The Unix command "sort" in the Unix User's Manual. 
.di
A message is printed if a file cannot be located. 
.au
Original design from Kernighan and Plauger's "Software Tools",  
with modifications by Debbie Scherrer.  The external merge phase 
of sort was completely rewritten by Joe Sventek.
.bu
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 sortsym should be redefined and sort built
again.

Eventually all the Unix "sort" flags should be implemented. 
These include: 
.ti +5 
sort [-mubdfinrtx] [+pos] [-pos] [-o file] [file] ... 
  
The additional flags are: 
  
.ti +5 
n  An initial numeric string, consisting of optional minus sign, digits 
and optionally included decimal point, is sorted by arithmetic value. 
  
.ti +5 
.ti +5 
tx Tab character between fields is x. 
  
.ti +5 
+pos -pos 
Selected parts of the line, specified by +pos and -pos, may be used as 
sort keys.  Pos has the form m.n optionally followed by one or more 
of the flags bdfinr, where m specifies a number of fields to skip, n a 
number of characters to skip further into the next field, and the 
flags specify a special ordering rule for the key.  A missing .n is taken 
to be 0.  +pos denotes the beginning of the key; -pos denotes the first 
position after the key (end of line by default).  Later keys are 
compared only when all earlier keys compare equal.  Note:  The first 
field of a line is numbered zero. 
  
When no tab character has been specified, a field consists of nonblanks 
and any preceding blanks.  Under the -b flag, leading blanks are 
excluded from a field.  When a tab character has been specified, 
fields are strings separated by tab characters. 
  
Lines that otherwise compare equal are ordered with all bytes significant. 
  
.ti +5 
-o The next argument is the name of an output file to use instead of the 
standard output.  This file may be the same as one of the inputs, except 
under the merge flag -m. 
{Note--it is not clear why this flag is needed.] 
  
.ti +5 
-u Suppress all but one in each set of contiguous equal lines.  Ignored 
bytes and bytes outside keys do not participate in this comparison. 
%%E 1