#
#
#
#    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.0
#
#         Date:    March 26, 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"

# bget - get logical record using multi-block reads
#	 caution - mxbuf, the buffer size, must be even!
  integer function bget(lun, buf, mxbuf, nc)
  integer buf(1)
  integer lun, mxbuf, nc, i, mxb
  include "blkio.cmn"
  data blkn/1/, blkptr/0/, nread/0/

10
  while (blkptr >= nread) {
    blkptr = blkptr - nread
    call dbkrd(lun, blkn, blkbuf, BLOCKINGFACTOR*256, nread)
    if (nread <= 0) {
      blkn = blkn - BLOCKINGFACTOR
      nc = EOF
      return (EOF)
      }
    }

  if (fixed) {
    nc = reclen
    if (nospan)
      if (blkptr/256 != (blkptr+nc/2+mod(nc, 2)-1)/256)
	blkptr = 256*(blkptr/256 + 1)
    }
  else {
    nc = blkbuf(blkptr)
    if (nc >= 0) {
      if (seq) {
	nc = nc - 2
	blkptr = blkptr + 2
	}
      else
	blkptr = blkptr + 1
      }
    else if (nospan) {
      blkptr = 256*(blkptr/256 + 1)
      goto 10
      }
    }
  if (nc > 0) {
    mxb = mxbuf/2
    do i = 1, nc/2 + mod(nc, 2) {
      if (blkptr >= nread) {
	blkptr = blkptr - nread
	call dbkrd(lun, blkn, blkbuf, BLOCKINGFACTOR*256, nread)
	if (nread <= 0) {
	  blkn = blkn - BLOCKINGFACTOR
	  nc = 2*(i - 1)
	  break
	  }
	}
      if (i <= mxb)
	buf(i) = blkbuf(blkptr)
      blkptr = blkptr+1
      }
    }
  if (nc > mxbuf) {
    nc = RECORDTOOLONG
    bget = RECORDTOOLONG
    }
  else if (nc < 0) {
    nc = FILECORRUPT
    bget = FILECORRUPT
    }
  else
    bget = SUCCESS
  return
  end

# skip - skip logical records using block i/o
  integer function skip(lun, ntoskp, nskped, ier)
  integer lun, ier,
    nw
  integer*4 ntoskp, nskped
  logical fkread
  include "blkio.cmn"

  skip = SUCCESS
  ier = 0
  fkread = .false.
  for (nskped = 0; nskped < ntoskp; nskped = nskped+1) {
10  while (blkptr >= nread) {
      blkptr = blkptr - nread
      if (fixed) {
	blkn = blkn + BLOCKINGFACTOR
	nread = BLOCKINGFACTOR*256
	if (blkn > efbk)
	  nread = max0(0, nread - (blkn - efbk)*256 + (ffby + 1)/2)
	fkread = .true.
	}
      else
	call dbkrd(lun, blkn, blkbuf, BLOCKINGFACTOR*256, nread)
      if (nread <= 0) {
	blkn = blkn - BLOCKINGFACTOR
	skip = EOF
	ier = EOF
	break 2
	}
      }
    if (fixed) {
      nw = reclen/2 + mod(reclen, 2)
      if (nospan)
	if (blkptr/256 != (blkptr+nw-1)/256)
	  blkptr = 256*(blkptr/256 + 1)
      blkptr = blkptr + nw
      }
    else if (blkbuf(blkptr) >= 0)
      blkptr = blkptr + blkbuf(blkptr)/2 + mod(blkbuf(blkptr), 2) + 1
    else if (nospan) {
      blkptr = 256*(blkptr/256 + 1)
      goto 10
11    continue
      }
    else {
      skip = FILECORRUPT
      ier = FILECORRUPT
      break
      }
    }
  if (fkread)
    if (nread != 0) {
      blkn = blkn - BLOCKINGFACTOR
      nread = 0
      }
  return
  end

# markr - mark logical record
  subroutine markr(lun, mrkbuf)
  integer lun, mrkbuf(2)
  include "blkio.cmn"

  if (nread <= 0)
    mrkbuf(1) = blkn
  else
    mrkbuf(1) = blkn - BLOCKINGFACTOR
  mrkbuf(2) = blkptr
  return
  end

# pointr - point to logical record
  subroutine pointr(lun, mrkbuf)
  integer lun, mrkbuf(2)
  include "blkio.cmn"

  if (mrkbuf(1) != blkn - BLOCKINGFACTOR  |  nread == 0) {
    blkn = mrkbuf(1)
    nread = 0
    }
  blkptr = mrkbuf(2)
  return
  end

# bopen - open file for block i/o
  subroutine bopen(lun, fnam, mode, ier)
  byte fnam(1), mode
  integer lun, ier, ier2, rtyp, ratt
  include "blkio.cmn"

  call dbkof(lun, mode, fnam, -1, EOS, ier)
  if (ier == 0) {
    call getcha(lun, rtyp, reclen, ratt, efbk, ffby, ier2)
    if (ier2 != 0)
      stop 'BOPEN -- Can''t get file characteristics!'
    fixed = rtyp == 1
    seq = rtyp == 3
    nospan = (ratt & 8) != 0
#$    if (nospan)
#$      stop 'BOPEN -- Can''t read nospanblocks file!'
    }
  return
  end

# bclose - close file
  subroutine bclose(lun, mode, ier)
  integer lun, ier
  byte mode
  include "blkio.cmn"

  call dbkcf(lun, mode, ier)
  blkptr = 0
  nread = 0
  blkn = 1
  return
  end