#
#
#
#    LIST File Listing Utility
#    =========================
#
#         Author:  William Wood
#
#         Address: Computer Center
#                  Institute For Cancer Research
#                  7701 Burholme Ave.
#                  Philadelphia, Pa. 19111
#                  (215) 728 2760
#
#         Version: 2.0
#
#         Date:    December 1, 1980
#
#
#
#      *******************************************************
#      *                                                     *
#      *      THIS SOFTWARE WAS DEVELOPED WITH SUPPORT       *
#      *      FROM THE NATIONAL INSTITUTES OF HEALTH:        *
#      *         NIH CA06927                                 *
#      *         NIH CA22780                                 *
#      *                                                     *
#      *      DIRECT INQUIRIES TO:                           *
#      *            COMPUTER CENTER                          *
#      *            THE INSTITUTE FOR CANCER RESEARCH        *
#      *            7701 BURHOLME AVENUE                     *
#      *            PHILADELPHIA, PENNSYLVANIA   19111       *
#      *                                                     *
#      *      NO WARRANTY OR REPRESENTATION, EXPRESS OR      *
#      *      IMPLIED, IS MADE WITH RESPECT TO THE           *
#      *      CORRECTNESS, COMPLETENESS, OR USEFULNESS       *
#      *      OF THIS SOFTWARE, NOR THAT USE OF THIS         *
#      *      SOFTWARE MIGHT NOT INFRINGE PRIVATELY          *
#      *      OWNED RIGHTS.                                  *
#      *                                                     *
#      *      NO LIABILITY IS ASSUMED WITH RESPECT TO        *
#      *      THE USE OF, OR FOR DAMAGES RESULTING FROM      *
#      *      THE USE OF THIS SOFTWARE                       *
#      *                                                     *
#      *******************************************************
#      *                                                     *
#      *      THIS SOFTWARE WAS DESIGNED FOR USE ON A        *
#      *      PDP-11/70 OPERATING UNDER IAS V3.0 USING       *
#      *      THE FORTRAN-IV PLUS COMPILER.                  *
#      *                                                     *
#      *******************************************************
#
#
#
include symbols.rat

# getnum - evaluate one line number expression   
integer function getnum(f, lin, i, buf, blen, num, bsfail)
byte lin(1), buf(1), c
integer f, i, blen
biginteger num, pnum
logical bsfail
integer getn
include clist.cmn
include term.cmn
 
getnum = YES
num = 0
c = lin(i)
if (c == '+'  |  c == '-')
  num = dot
repeat {
   if (getn(f, lin, i, pnum, buf, blen, bsfail) == YES)
      num = num + pnum
   else if (c == '+')
      num = num + (scrsiz+1)/2
   else if (c == '-')
      num = num - (scrsiz+1)/2
   else {
      getnum = NO
      break
      }
   c = lin(i)
   } until (c ~= '+' & c ~= '-')
return
end
 
# getn - convert one term to line number    
integer function getn(f, lin, i, pnum, buf, blen, bsfail)
byte lin(1), buf(1), delim
integer f, i, j, blen, mul
biginteger pnum
logical bsfail
integer optpat, scan
biginteger ptscan, backsc
include clist.cmn
include term.cmn
 
getn = YES
mul = +1
if (lin(i) == '-') {
  mul = -1
  i = i+1
  }
else if (lin(i) == '+')
  i = i+1
if (lin(i) == EOS)
   getn = NO
else if (lin(i) == CURLINE) {
   pnum = dot
   i = i+1
   }
else if (lin(i) == OLDDOT) {
   pnum = odot
   i = i+1
   }
else if (lin(i) == LASTLINE) {
   dot = fmax+1
   call posit(f, dot)
   pnum = dot - 1
   i = i+1
   }
else if (lin(i) == TOPSCRVAR) {
   pnum = topscr
   i = i+1
   }
else if (lin(i) == SCRSIZVAR) {
   pnum = scrsiz
   i = i+1
   }
else if (lin(i) == SAVELINE) {
   pnum = savdot
   i = i+1
   }
else if (lin(i) == SEARCHCHAR  |  lin(i) == BACKSEARCH) {
   delim = lin(i)
   if (optpat(lin, i, delim) == ERROR) {	# build the pattern
      getn = ERROR
      call err(lin, i-1, 'Current search string is null.')
      lin(i) = ERROR
      }
   else {
      if (delim == SEARCHCHAR) {
         pnum = ptscan(f, buf, blen, fmax)
         if (pnum == EOF)
            pnum = dot
         }
      else {
         pnum = backsc(f, buf, blen)
         if (pnum == EOF) {
            bsfail = .true.
            pnum = 1
            }
         }
      }
   }
else {
   j = scan(lin, '1234567890', i)
   if (i ~= j) {
      decode (j-i, 20, lin(i), err=10) pnum
%
20       format(i<j-i>)
%
      i = j
      }
   else {
      getn = NO
      }
   }
 
pnum = pnum*mul
return
 
10 continue
getn = ERROR
call err(lin, i, 'Number too large.')
return
end
 
# optpat - make pattern if specified at lin(i)   
integer function optpat(lin, i, delim)
byte lin(1), delim
integer i, j, pbeg
logical bol
byte cupper
include pat.cmn
data slen/0/
 
i = i+1
if (lin(i) == EOS)
   ;
else if (lin(i) == delim)	# repeated delimiter
   i = i + 1			# leave existing pattern alone
else {
   bol = .false.		# search all of input for search string
   pbeg = i
   for (j = 1; lin(i) ~= delim  &  lin(i) ~= EOS; i = i+1) {
      if (i == pbeg  &  lin(i) == BOLSRCH) {   # search only beginning of line?
         bol = .true.
         next
         }
      if (lin(i) == ESCCHAR) {
         i = i+1
         if (lin(i) == EOS)
            break
         }
      else if (lin(i) == CONTROLCHAR) {
         i = i+1
         if (lin(i) == EOS)
            break
         else
            lin(i) = cupper(lin(i)) - 64
         }
      srchst(j) = lin(i)
      j = j+1
      }
   slen = j - 1
   if (bol)
      slimit = slen		# only search beginning of line
   else
      slimit = BUFSIZ		# search all of line
   if (lin(i) == delim)
      i = i+1
#
#  now set up the shift table, which contains the amount to shift
#  the pattern along the input when a given character in the input
#  doesn't match the pattern.
#
   do j = -128, 127
      shftab(j) = slen
   for (j = 1; j < slen; j = j+1)
      shftab(srchst(j)) = slen - j
   }
if (slen == 0)
   optpat = ERROR
else
   optpat = YES
return
end
 
# ptscan - scan for next occurrence of pattern   
biginteger function ptscan(f, buf, blen, mxsrch)
byte buf(1)
integer f, blen
biginteger mxsrch, tfmax
integer getinp, search
include clist.cmn
include pat.cmn
 
tfmax = fmax
fmax = mxsrch
ptscan = EOF
call posit(f, dot)
while (getinp(f, buf, blen) ~= EOF)
   if (search(buf, min0(blen, slimit), srchst, slen, shftab) == 0)
      dot = dot+1
   else {
      ptscan = dot
      break
      }
fmax = tfmax
return
end
 
# backsc - search backwards for pattern
biginteger function backsc(f, buf, blen)
byte buf(1)
integer f, blen
biginteger mx, sdot, num
biginteger ptscan
include clist.cmn
 
backsc = EOF
mx = dot - 1
sdot = ((mx - 1)/100)*100 + 1
while (mx > 0) {			# search backwards in 100-line chunks
   dot = sdot
   num = EOF
   repeat {
      backsc = num
      num = ptscan(f, buf, blen, mx)
      dot = dot + 1
      } until (num == EOF)
   if (backsc ~= EOF)
      break
   mx = sdot - 1
   sdot = sdot - 100
   }
if (backsc == EOF)
   dot = 1
else
   dot = backsc
return
end
 
# replac - replace occurrences of "char" in "lin" with "text"
integer function replac(char, text, lin, size, i)
integer size, i, textl, linl
integer length, chscan
byte char(1), text(1), lin(1), temp(2*MAXLINE)	# length(lin(i)) <= 2*MAXLINE!
 
replac = YES
linl = length(lin)
textl = length(text)
while (chscan(lin, i, char) == YES) {
  if (textl+linl > size) {
    replac = NO
    break
    }
  linl = linl+textl-1
  call scopy(lin, i+1, temp, 1)
  call scopy(text, 1, lin, i)
  i = i+textl
  call scopy(temp, 1, lin, i)
  }
if (replac == YES)
  i = 1
return
end
 
# chscan - scan "lin" for "char", ignoring occurrences within file names
#          and search patterns
integer function chscan(lin, i, char)
integer i
byte lin(1), char, delim
byte cupper
 
chscan = NO
for ( ; lin(i) ~= EOS; i = i+1)
  if (cupper(lin(i)) == char) {
    chscan = YES
    break
    }
  else if (lin(i) == REDIRECT)
    break
  else if (lin(i) == SEARCHCHAR  |  lin(i) == BACKSEARCH) {
    delim = lin(i)
    for (i = i+1; lin(i) ~= delim; i = i+1) {
      if (lin(i) == ESCCHAR)
        i = i+1
      if (lin(i) == EOS)
        break 2
      }
    }
return
end
 
#  search has been recoded in macro for speed; see SEARCH.MAC
#$# search - find a pattern in a line
#$   integer function search(text, n, pattrn, m, shftab)
#$   byte text(1), pattrn(1), shftab(-128:127)
#$   integer n, m, j, i
#$ 
#$   search = 0
#$   if (m ~= 0) {
#$      j = m
#$      while (j <= n) {
#$         do i = m,1,-1
#$            if (text(j-m+i) ~= pattrn(i)) {
#$               j = j + shftab(text(j))
#$               next 2
#$               }
#$         search = j-m+1
#$         return
#$         }
#$      }
#$   return
#$   end