#
#
#
#    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

#
#  These routines serve as get, skip, mark, and point routines for
#  carriagecontrol NONE files. They may also be used for LIST
#  files which, in addition to the implied <cr> <lf> in each
#  physical record, have explicit carriagecontrol.
#
define(CR,13)
define(LF,10)
# vinit - init virtual io
subroutine vinit(f)
integer f, bofm(MARKSIZE), nc
byte tbuf(2)
include vio.cmn
 
call gftyp(f, cc)
vbp = 0
vsiz = -1
call markr(f, tmark)
if (cc == NONE) {
  call vmark(f, bofm)
  call vget(f, tbuf, 2, nc)
  if (nc ~= 0  &  nc ~= EOF)
    call vpoint(f, bofm)
  }
return
end
 
# vget - get virtual record
subroutine vget(f, buf, maxc, nc)
integer f, maxc, nc
byte buf(1)
include vio.cmn
 
if (vsiz == EOF)
  nc = EOF
else {
  nc = 0
  repeat {
    if (vbp > vsiz) {
      vbp = 0
      call markr(f, tmark)
RECORDIO       call get(f, vbuf, BUFSIZ, vsiz)
BLOCKIO        call bget(f, vbuf, BUFSIZ, vsiz)
      if (vsiz < 0) {
        if (vsiz ~= EOF  |  cc ~= NONE)
          nc = vsiz
        break
        }
      }
    if (cc == FORTRAN  &  vbp != 0) {
      nc = 1
      buf(nc) = ' '			# insert FORTRAN carriagecontrol
      }
    for (vbp = vbp+1; vbp <= vsiz; vbp = vbp+1) {
      if (vbuf(vbp) ~= LF) {
        if (nc < maxc) {
          nc = nc + 1
          buf(nc) = vbuf(vbp)
          next
          }
        else
          nc = maxc + 1
        }
      else {
        if (nc > 0  &  nc <= maxc)
          if (buf(nc) == CR)
            nc = nc - 1
        break 2
        }
      }
    } until (cc ~= NONE)
  }
if (nc > maxc)
  nc = RECORDTOOLONG
return
end

# vmark - mark virtual record
subroutine vmark(f, markb)
integer f, i
integer markb(MARKSIZE)
include vio.cmn
 
do i = 1, MARKSIZE-1
  markb(i) = tmark(i)
markb(MARKSIZE) = vbp
return
end

# vpoint - point to virtual record
subroutine vpoint(f, markb)
integer f, i
integer markb(MARKSIZE)
include vio.cmn

call pointr(f, markb)
vbp = markb(MARKSIZE)
do i = 1, MARKSIZE-1
  tmark(i) = markb(i)
RECORDIO call get(f, vbuf, BUFSIZ, vsiz)
BLOCKIO  call bget(f, vbuf, BUFSIZ, vsiz)
return
end
 
# vskip - skip virtual records
subroutine vskip(f, ntoskp, nskped)
integer f
integer*4 ntoskp, nskped
include vio.cmn
 
nskped = 0
if (vsiz ~= EOF) {
  for ( ; nskped < ntoskp; nskped = nskped+1) {
    repeat {
      if (vbp > vsiz) {
        vbp = 0
        call markr(f, tmark)
RECORDIO         call get(f, vbuf, BUFSIZ, vsiz)
BLOCKIO          call bget(f, vbuf, BUFSIZ, vsiz)
        if (vsiz < 0) {
          if (vsiz == EOF  &  cc == NONE)
            nskped = nskped+1
          break 2
          }
        }
      for (vbp = vbp+1; vbp <= vsiz; vbp=vbp+1)
        if (vbuf(vbp) == LF)
          break 2
      } until (cc ~= NONE)
    }
  }
return
end
 
# gftyp - get carriagecontrol type
subroutine gftyp(f, cc)
integer f, cc, rtyp, rsize, efbk, ffby, ier
 
call getcha(f, rtyp, rsize, cc, efbk, ffby, ier)
if ((cc  &  1) ~= 0)
  cc = FORTRAN
else if ((cc  &  2) ~= 0  |  rtyp == 1)  # treat fixed length records as LIST
  cc = LIST
else
  cc = NONE
return
end