#
#
#
#    LIST File Listing Utility
#    =========================
#
#         Author:  William P. Wood, Jr.
#
#         Address: Computer Center
#                  Institute For Cancer Research
#                  7701 Burholme Ave.
#                  Philadelphia, Pa. 19111
#                  (215) 728 2760
#
#         Version: 3.1
#
#         Date:    December 2, 1982
#
#
#
#      *******************************************************
#      *                                                     *
#      *      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                       *
#      *                                                     *
#      *******************************************************
#
#
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.
#

# vinit - init virtual io
  subroutine vinit(f)
  integer f, nc
  integer*2 bofm(MARKSIZE)
  byte tbuf(2)
  include "vio.cmn"

  call gcctyp(f, cc)
  vbp = 0
  vsiz = -1
  badbuf = .false.
  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
  integer function vget(f, buf, maxc, nc)
  integer f, maxc, nc
RECORDIO integer get
BLOCKIO  integer bget
  byte buf(1)
  include "vio.cmn"

  if (vsiz == EOF)
    nc = EOF
  else {
    nc = 0
    repeat {
      if (vbp > vsiz) {
	if (badbuf) {
	  call reaerr(0, BUFFEROVERFLOW, 0)
	  badbuf = .false.
	  }
	vbp = 0
	call markr(f, tmark)
RECORDIO       getsta = get(f, vbuf, BUFSIZ, vsiz)
BLOCKIO        getsta = bget(f, vbuf, BUFSIZ, vsiz)
	if (vsiz < 0)
	  if (vsiz == RECORDTOOLONG) {
	    vsiz = BUFSIZ
	    badbuf = .true.
	    }
	  else {
	    if (vsiz != EOF  |  cc != NONE)
	      nc = vsiz
	    break
	    }
	}
      if (cc == FORTRAN  &  vbp != 0) {
	nc = 1
	if (maxc >= 1)
	  buf(1) = ' '			# 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(getsta)
  end

# vmark - mark virtual record
  subroutine vmark(f, markb)
  integer f, i
  integer*2 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*2 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)
  if (vsiz == RECORDTOOLONG) {
    vsiz = BUFSIZ
    badbuf = .true.
    }
  else
    badbuf = .false.
  return
  end

# vskip - skip virtual records
  integer function vskip(f, ntoskp, nskped, ier)
  integer f, ier
RECORDIO integer get
BLOCKIO  integer bget
  integer*4 ntoskp, nskped
  include "vio.cmn"

  nskped = 0
  if (vsiz != EOF) {
    for ( ; nskped < ntoskp; nskped = nskped+1) {
      repeat {
	if (vbp > vsiz) {
	  if (badbuf) {
	    call reaerr(0, BUFFEROVERFLOW, nskped)
	    badbuf = .false.
	    }
	  vbp = 0
	  call markr(f, tmark)
RECORDIO         getsta = get(f, vbuf, BUFSIZ, vsiz)
BLOCKIO          getsta = bget(f, vbuf, BUFSIZ, vsiz)
	  if (vsiz < 0)
	    if (vsiz == RECORDTOOLONG) {
	      vsiz = BUFSIZ
	      badbuf = .true.
	      }
	    else {
	      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)
      }
    }
  ier = 0
  if (vsiz < 0)
    ier = vsiz
  return(getsta)
  end

# gcctyp - get carriagecontrol for unit f
  subroutine gcctyp(f, cc)

_ifdef(VAX)

  _undef(character)
  integer f, cc
  character*20 rtype, crc, org
  logical ismbx		# tests if unit f is a mailbox
 
  inquire(unit=f, recordtype=rtype, carriagecontrol=crc,
      organization=org)
  if (crc == 'LIST'  |  crc == 'UNKNOWN'  |  rtype == 'FIXED' |
      org != 'SEQUENTIAL'  |  ismbx(f))
    cc = LIST
  else if (crc == 'FORTRAN')
    cc = FORTRAN
  else
    cc = NONE
  return

_elsedef

  integer f, cc, rtype, rsize, efbk, ffby, ier
 
  call getcha(f, rtype, rsize, cc, efbk, ffby, ier)
  if ((cc  &  2) != 0 | rtype == 1)  # treat fixed length records as LIST
    cc = LIST
  else if ((cc  &  1) != 0)
    cc = FORTRAN
  else
    cc = NONE
  return

_enddef

  end