From: "Larry D Bohan, Jr" <LBohan@dbc.spam_less..com>
Subject: Re: faster gunzip
Date: 04 May 2000 00:00:00 GMT
Message-ID: <lPERORUnx4EysVkXpICGTSIuV3TI@4ax.com>
Content-Transfer-Encoding: 7bit
References: <8esfrh$rc9@gap.cco.caltech.edu>
Content-Type: text/plain; charset=us-ascii
X-Complaints-To: abuse@verio.net
X-Trace: ord-read.news.verio.net 957477939 199.217.9.201 (Thu, 04 May 2000 22:05:39 GMT)
Organization: Verio
MIME-Version: 1.0
NNTP-Posting-Date: Thu, 04 May 2000 22:05:39 GMT
Newsgroups: comp.os.vms

On 4 May 2000 18:34:25 GMT, mathog@seqaxp.bio.caltech.edu (David
Mathog) wrote:

>gunzip 1.2-4 on our OpenVMS 7.2-1 DS10 is very much slower than gunzip on 
>a DS10 running Linux/Alpha.  A big part of that is because on Linux you
>don't really get the data onto disk unless you force it there - instead it 
>is cached into the free memory on the system.  We've hashed over the pluses 
>and minuses of that method before and I don't want to start another thread
>on  it here.

this was posted on C.O.V. a few weeks/months ago.

if the speed of gnuzip is really irritating, you might perhaps 
try to apply the techniques seen here.  I was saving this example 
for the day I ran into something similarly irritating.  

the perceived difference in speed btw this example 
and a regular $COPY is impressive.  Even while already 
using other techniques to speed up $COPY (large extents,
disls w/ lotsa of contiguous free space, etc)

It would be interesting if this  BUFOBJ implementation 
could be made optionally available for  $COPY, $CONVERT, etc. 
(i imagine (hyper)SORT  and  BACKUP already have 
 similar optimizations)

or for that matter, the C run-time library.


/*
 * FAST_IO_COPY.C - disk file copy Fast I/O example.
 * This program requires OpenVMS V7.0 (VAX or Alpha).
 * The DEC C V5.2 (or newer) compiler is preferred.
 */
#include atrdef
#include descrip
#include fibdef 
#include iodef 
#include iosadef 
#include lib$routines 
#include rms 
#include ssdef 
#include starlet 
#include stdio 
#include stdlib 
#include string 

#include "fatdef.h"  

#define NBYTES_PER_BLOCK 512
#define MAX_BUFFERS 16
#define MAX_BLOCKS_PER_XFER 127
#define MAX_BYTES_PER_XFER (NBYTES_PER_BLOCK*MAX_BLOCKS_PER_XFER)
#define MAX_BYTES_PER_BUFFER (NBYTES_PER_BLOCK+MAX_BYTES_PER_XFER)

#pragma extern_model save
#pragma extern_model common_block shr
#pragma nostandard
extern volatile _align (page) char
buffer[MAX_BUFFERS][MAX_BYTES_PER_BUFFER];
#pragma standard
extern volatile fandle ifan[MAX_BUFFERS];
extern volatile fandle ofan[MAX_BUFFERS];
extern volatile int iohan[MAX_BUFFERS][2];
extern struct FAB ifab;
extern struct NAM inam;
extern char iexpand[NAM$C_MAXRSS+1];
extern char iresult[NAM$C_MAXRSS+1];
extern struct FAB ofab;
extern struct NAM onam;
extern char oexpand[NAM$C_MAXRSS+1];
extern char oresult[NAM$C_MAXRSS+1];
extern struct XABFHC xabfhc;
extern struct XABSUM xabsum;
extern struct XABALL xaball[255];
extern struct XABKEY xabkey[255];
extern char knm[255][32];
extern volatile int ivbn;
extern volatile int iefn;
extern volatile int nreads_outstanding;
extern volatile int nwrites_outstanding;
extern volatile int max_reads_outstanding;
extern volatile int max_writes_outstanding;
extern volatile int nbuffers;
extern volatile int nblocks_per_xfer;
extern volatile int nbytes_per_xfer;
extern volatile int nbytes_per_buffer;
#pragma extern_model restore

void read_completion_ast(iosa *piosa)
{
  register int status = piosa->iosa$l_status;
  register int nbytes = piosa->iosa$ih_count;
  register int ibuf   = piosa->iosa$q_context_q[0];

  if (nreads_outstanding > max_reads_outstanding)
    max_reads_outstanding = nreads_outstanding;

  nreads_outstanding--;

  if ((status != SS$_ENDOFFILE) && !(status & 1))
  {
    int msgvec[2] = {1,0};
    msgvec[1] = status;
    printf("Could not perform input from VBN %0d to buffer #%0d.\n",
        piosa->iosa$q_context_q[1], ibuf);
    sys$putmsg(msgvec,0,0,0);
    goto read_return;
  }

  if (nbytes)
  {
    ifab.fab$l_ctx++;

    status = sys$io_perform(ofan[ibuf], ofab.fab$l_stv,
        &buffer[ibuf][0], &buffer[ibuf][NBYTES_PER_BLOCK],
        nbytes, piosa->iosa$q_context_q[1]);
    if (!(status & 1))
    {
      int msgvec[2] = {1,0};
      msgvec[1] = status;
      printf(
        "Could not start output (%0d bytes) to VBN %0d from buffer
#%0d.\n",
        nbytes, piosa->iosa$q_context_q[1], ibuf);
      sys$putmsg(msgvec,0,0,0);
      goto read_return;
    }
    nwrites_outstanding++;
  }

read_return:
  if ((nreads_outstanding == 0) && (nwrites_outstanding == 0))
    sys$setef(iefn);
  return;
} /* read_completion_ast */

void write_completion_ast(iosa *piosa)
{
  register int status = piosa->iosa$l_status;
  register int nbytes = piosa->iosa$ih_count;
  register int ibuf   = piosa->iosa$q_context_q[0];

  if (nwrites_outstanding > max_writes_outstanding)
    max_writes_outstanding = nwrites_outstanding;

  nwrites_outstanding--;

  if (!(status & 1))
  {
    int msgvec[2] = {1,0};
    msgvec[1] = status;
    printf(
        "Could not perform output (%0d bytes) to VBN %0d from buffer
#%0d.\n",
        nbytes, piosa->iosa$q_context_q[1], ibuf);
    sys$putmsg(msgvec,0,0,0);
    goto write_return;
  }
  ofab.fab$l_ctx++;

  if (ivbn <= ifab.fab$l_alq)
  {
    piosa->iosa$ih_count = nbytes_per_xfer;
    piosa->iosa$q_context_q[1] = ivbn;
    status = sys$io_perform(ifan[ibuf], ifab.fab$l_stv,
        &buffer[ibuf][0], &buffer[ibuf][NBYTES_PER_BLOCK],
        nbytes_per_xfer, ivbn);
    if (!(status & 1))
    {
      int msgvec[2] = {1,0};
      msgvec[1] = status;
      printf(
        "Could not start input from VBN %0d to buffer #%0d.\n",
        ivbn, ibuf);
      sys$putmsg(msgvec,0,0,0);
      goto write_return;
    }
    ivbn += nblocks_per_xfer;
    nreads_outstanding++;
  }

write_return:
  if ((nreads_outstanding == 0) && (nwrites_outstanding == 0))
    sys$setef(iefn);
  return;
} /* write_completion_ast */

int fast_io_copy(int argc, char *argv[])
#pragma nostandard
main_program
#pragma standard
{
  register iosa *piosa = 0;
  register int status = 0;
  register int ibuf = 0;
  volatile char *inadr[2] = {0,0};
  char *retadr[2] = {0,0};
  unsigned short int iosb[4];
  struct atrdef atrlst[2];
  struct fibdef fib;
  struct dsc$descriptor_s fibdsc;
  FAT fat;

/*
 * Require input and output file specifications.
 */
  if (argc < 3)
  {
    printf("Usage: %s <input-file> <output-file>\n", argv[0]);
    return 1;
  }

/*
 * Allow additional arguments to change either
 * the buffer count or the transfer size in blocks.
 */
  nbuffers = MAX_BUFFERS;
  nblocks_per_xfer = MAX_BLOCKS_PER_XFER;

  for (ibuf=3; ibuf<argc; ibuf++)
  {
    if (!strncmp(argv[ibuf], "-nbuffers", 9))
    {
      ibuf++;
      if (ibuf < argc)
      {
        nbuffers = atoi(argv[ibuf]);
        if ((nbuffers == 0) || (nbuffers > MAX_BUFFERS))
          nbuffers = MAX_BUFFERS;
        else if (nbuffers < 0)
          nbuffers = 1;
      }
    }
    else if (!strncmp(argv[ibuf], "-nblocks", 8))
    {
      ibuf++;
      if (ibuf < argc)
      {
        nblocks_per_xfer = atoi(argv[ibuf]);
        if ((nblocks_per_xfer == 0) || (nblocks_per_xfer >
MAX_BLOCKS_PER_XFER))
          nblocks_per_xfer = MAX_BLOCKS_PER_XFER;
        else if (nblocks_per_xfer < 0)
          nblocks_per_xfer = 1;
      }
    }
    else
    {
      printf("Unrecognized argument #%0d: \"%s\".\n", ibuf,
argv[ibuf]);
    }
  }

  nbytes_per_xfer = NBYTES_PER_BLOCK * nblocks_per_xfer;
  nbytes_per_buffer = NBYTES_PER_BLOCK + nbytes_per_xfer;

  printf("Using %0d buffers, with %0d blocks (%0d bytes) per
transfer.\n",
        nbuffers, nblocks_per_xfer, nbytes_per_xfer);

  for (ibuf=0; ibuf<nbuffers; ibuf++)
  {
    inadr[0] = &buffer[ibuf][0];
    inadr[1] = &buffer[ibuf][nbytes_per_buffer-1];

    status = sys$create_bufobj(inadr, retadr, 0, 0, iohan[ibuf]);
    if (!(status & 1))
    {
      printf("Could not create buffer object #%0d.\n", ibuf);
      return status;
    }

    status = sys$io_setup(IO$_READVBLK,
        iohan[ibuf], iohan[ibuf], &read_completion_ast, 0,
&ifan[ibuf]);
    if (!(status & 1))
    {
      printf("Could not set up input for buffer #%0d.\n", ibuf);
      return status;
    }

    status = sys$io_setup(IO$_WRITEVBLK,
        iohan[ibuf], iohan[ibuf], &write_completion_ast, 0,
&ofan[ibuf]);
    if (!(status & 1))
    {
      printf("Could not set up output for buffer #%0d.\n", ibuf);
      return status;
    }
  }

/*
 * Fill in two RMS extended attribute blocks.
 */
  bzero((char*)&xabfhc, sizeof(xabfhc));
  xabfhc.xab$b_cod = XAB$C_FHC;
  xabfhc.xab$b_bln = XAB$C_FHCLEN;
  xabfhc.xab$l_nxt = (char*)&xabsum;

  bzero((char*)&xabsum, sizeof(xabsum));
  xabsum.xab$b_cod = XAB$C_SUM;
  xabsum.xab$b_bln = XAB$C_SUMLEN;

/*
 * Fill in the input file RMS blocks.
 */
  bzero((char*)&ifab, sizeof(ifab));
  ifab.fab$b_bid = FAB$C_BID;
  ifab.fab$b_bln = FAB$C_BLN;
  ifab.fab$l_nam = &inam;
  ifab.fab$l_fop = FAB$M_NAM | FAB$M_UPI;
  ifab.fab$l_fna = argv[1];
  ifab.fab$b_fns = strlen(argv[1]);
  ifab.fab$l_dna = 0;
  ifab.fab$b_dns = 0;
  ifab.fab$b_fac = FAB$M_GET;
  ifab.fab$b_shr = FAB$M_SHRGET;

  bzero((char*)&inam, sizeof(inam));
  inam.nam$b_bid = NAM$C_BID;
  inam.nam$b_bln = NAM$C_BLN;
  inam.nam$l_esa = iexpand;
  inam.nam$b_ess = NAM$C_MAXRSS;
  inam.nam$l_rsa = iresult;
  inam.nam$b_rss = NAM$C_MAXRSS;

/*
 * Fill in the output file RMS blocks.
 */
  bzero((char*)&ofab, sizeof(ofab));
  ofab.fab$b_bid = FAB$C_BID;
  ofab.fab$b_bln = FAB$C_BLN;
  ofab.fab$l_nam = &onam;
  ofab.fab$l_fop = FAB$M_CBT | FAB$M_MXV | FAB$M_OFP;
  ofab.fab$l_fna = argv[2];
  ofab.fab$b_fns = strlen(argv[2]);
  ofab.fab$l_dna = 0;
  ofab.fab$b_dns = 0;
  ofab.fab$b_fac = FAB$M_BIO | FAB$M_PUT | FAB$M_TRN;
  ofab.fab$b_shr = FAB$M_NIL;
  ofab.fab$l_alq = ifab.fab$l_alq;
  ofab.fab$w_deq = ifab.fab$w_deq;
  ofab.fab$b_org = ifab.fab$b_org;
  ofab.fab$b_rat = ifab.fab$b_rat;
  ofab.fab$b_rfm = ifab.fab$b_rfm;
  ofab.fab$w_mrs = ifab.fab$w_mrs;
  ofab.fab$l_mrn = ifab.fab$l_mrn;
  ofab.fab$b_bks = ifab.fab$b_bks;
  ofab.fab$b_fsz = ifab.fab$b_fsz;
  ofab.fab$w_gbc = ifab.fab$w_gbc;

  bzero((char*)&onam, sizeof(onam));
  onam.nam$b_bid = NAM$C_BID;
  onam.nam$b_bln = NAM$C_BLN;
  onam.nam$l_esa = oexpand;
  onam.nam$b_ess = NAM$C_MAXRSS;
  onam.nam$l_rsa = oresult;
  onam.nam$b_rss = NAM$C_MAXRSS;
  onam.nam$l_rlf = &inam;

/*
 * Fill in the invariant data for truncating output files.
 */
  atrlst[0].atr$w_size = ATR$S_RECATTR;
  atrlst[0].atr$w_type = ATR$C_RECATTR;
#if __ALPHA
  atrlst[0].atr$l_addr = &fat;
#else
  atrlst[0].atr$l_addr = (unsigned int)&fat;
#endif

  atrlst[1].atr$w_size = 0;
  atrlst[1].atr$w_type = 0;
  atrlst[1].atr$l_addr = 0;

  fibdsc.dsc$w_length  = FIB$C_LENGTH;
  fibdsc.dsc$b_dtype   = DSC$K_DTYPE_T;
  fibdsc.dsc$b_class   = DSC$K_CLASS_S;
  fibdsc.dsc$a_pointer = (char*)&fib;

/*
 * Get an event flag.
 */
  lib$get_ef(&iefn);
  if (iefn < 0) iefn = 32;

/*
 * Parse the input file specification.
 */
  status = sys$parse(&ifab);
  if (!(status & 1))
  {
    unsigned int msgvec[3];
    msgvec[0] = 2;
    msgvec[1] = ifab.fab$l_sts;
    msgvec[2] = ifab.fab$l_stv;
    printf("Could not parse input file specification \"%s\".\n",
argv[1]);
    sys$putmsg(msgvec,0,0,0);
    return status;
  }

/*
 * Search for the next input file.
 */
  iexpand[inam.nam$b_esl] = '\0';
  printf("Search: %s\n", iexpand);
  while ((status = sys$search(&ifab)) & 1)
  {
    iresult[inam.nam$b_rsl] = '\0';
    printf("Reading %s\n", iresult);

/*
 * Open the input file (with implicit display).
 */
    xabsum.xab$l_nxt = 0;
    ifab.fab$l_xab = (char*)&xabfhc;
    ifab.fab$l_ctx = 0;
    ifab.fab$l_fop = FAB$M_NAM | FAB$M_UPI;
    status = sys$open(&ifab);
    if (!(status & 1))
    {
      unsigned int msgvec[3];
      msgvec[0] = 2;
      msgvec[1] = ifab.fab$l_sts;
      msgvec[2] = ifab.fab$l_stv;
      printf("Could not open input file.\n");
      sys$putmsg(msgvec,0,0,0);
      continue;
    }

/*
 * Get all available information on file allocation and areas.
 */
    ifab.fab$l_xab = xabsum.xab$l_nxt = (char*)&xaball[0];
    for (ibuf=0; (ibuf<xabsum.xab$b_noa) || (ibuf == 0); ibuf++)
    {
      bzero((char*)&xaball[ibuf], sizeof(xaball[ibuf]));
      xaball[ibuf].xab$b_cod = XAB$C_ALL;
      xaball[ibuf].xab$b_bln = XAB$C_ALLLEN;
      xaball[ibuf].xab$b_aid = ibuf;
      xaball[ibuf].xab$l_nxt = (char*)&xaball[ibuf+1];
    }
    if (xabsum.xab$b_noa)
      xaball[xabsum.xab$b_noa-1].xab$l_nxt = 0;
    else
      xaball[0].xab$l_nxt = 0;

/*
 * If there are any indexes, get all of the information about them.
 */
    if (xabsum.xab$b_nok)
    {
      if (xabsum.xab$b_noa)
        xaball[xabsum.xab$b_noa-1].xab$l_nxt = (char*)&xabkey[0];
      else
        xaball[0].xab$l_nxt = (char*)&xabkey[0];

      for (ibuf=0; ibuf<xabsum.xab$b_nok; ibuf++)
      {
        bzero((char*)&xabkey[ibuf], sizeof(xabkey[ibuf]));
        xabkey[ibuf].xab$b_cod = XAB$C_KEY;
        xabkey[ibuf].xab$b_bln = XAB$C_KEYLEN;
        xabkey[ibuf].xab$b_ref = ibuf;
        xabkey[ibuf].xab$l_knm = knm[ibuf];
        xabkey[ibuf].xab$l_nxt = (char*)&xabkey[ibuf+1];
      }
      xabkey[xabsum.xab$b_nok-1].xab$l_nxt = 0;
    }

/*
 * Display the additional information about allocation, areas,
indexes.
 */
    status = sys$display(&ifab);
    if (!(status & 1))
    {
      unsigned int msgvec[3];
      msgvec[0] = 2;
      msgvec[1] = ifab.fab$l_sts;
      msgvec[2] = ifab.fab$l_stv;
      printf("Could not display input file information.\n");
      sys$putmsg(msgvec,0,0,0);
      sys$close(&ifab);
      continue;
    }

/*
 * Close the input file.
 */
    ifab.fab$l_xab = 0;
    status = sys$close(&ifab);
    if (!(status & 1))
    {
      unsigned int msgvec[3];
      msgvec[0] = 2;
      msgvec[1] = ifab.fab$l_sts;
      msgvec[2] = ifab.fab$l_stv;
      printf("Could not close input file.\n");
      sys$putmsg(msgvec,0,0,0);
      continue;
    }

/*
 * Show area and index information, if any.
 */
    for (ibuf=0; ibuf<xabsum.xab$b_noa; ibuf++)
      printf("Area %03u; %0u blocks; %0u-block buckets.\n",
        xaball[ibuf].xab$b_aid,
        xaball[ibuf].xab$l_alq,
        xaball[ibuf].xab$b_bkz);

    for (ibuf=0; ibuf<xabsum.xab$b_nok; ibuf++)
      printf("Key  %03u; LAN %03u; IAN %03u; \"%.*s\".\n",
        ibuf, xabkey[ibuf].xab$b_lan, xabkey[ibuf].xab$b_ian, 32,
knm[ibuf]);

/*
 * Re-open the input file, UFO this time (accessed on user-mode
channel).
 */
    ifab.fab$l_fop |= FAB$M_UFO;
    status = sys$open(&ifab);
    if (!(status & 1))
    {
      unsigned int msgvec[3];
      msgvec[0] = 2;
      msgvec[1] = ifab.fab$l_sts;
      msgvec[2] = ifab.fab$l_stv;
      printf("Could not access input file on channel.\n");
      sys$putmsg(msgvec,0,0,0);
      continue;
    }

/*
 * Create the output file, using the RMS extended attribute blocks.
 */
    ofab.fab$l_xab = (char*)&xabfhc;
    ofab.fab$l_ctx = 0;
    ofab.fab$l_fop = FAB$M_CBT | FAB$M_MXV | FAB$M_OFP;
    ofab.fab$l_alq = ifab.fab$l_alq;
    ofab.fab$b_org = ifab.fab$b_org;
    ofab.fab$b_rat = ifab.fab$b_rat;
    ofab.fab$b_rfm = ifab.fab$b_rfm;
    ofab.fab$w_mrs = ifab.fab$w_mrs;
    status = sys$create(&ofab);
    if (!(status & 1))
    {
      unsigned int msgvec[3];
      msgvec[0] = 2;
      msgvec[1] = ofab.fab$l_sts;
      msgvec[2] = ofab.fab$l_stv;
      printf("Could not create output file.\n");
      sys$putmsg(msgvec,0,0,0);
      sys$close(&ifab);
      continue;
    }

/*
 * If the total allocation of the output file is less than that of the
 * input file, extend it to match the input file.  This can happen for
 * non-sequential files when the total blocks specifically allocated
to
 * each area do not result in a large enough file.
 */
    ofab.fab$l_xab = 0;
    if (ofab.fab$l_alq < ifab.fab$l_alq)
    {
      printf("Extending output file allocation from %0u to %0u
blocks.\n",
        ofab.fab$l_alq, ifab.fab$l_alq);
      ofab.fab$l_alq = ifab.fab$l_alq - ofab.fab$l_alq;
      status = sys$extend(&ofab);
      if (!(status & 1))
      {
        unsigned int msgvec[3];
        msgvec[0] = 2;
        msgvec[1] = ofab.fab$l_sts;
        msgvec[2] = ofab.fab$l_stv;
        printf("Could not extend output file.\n");
        sys$putmsg(msgvec,0,0,0);
        sys$close(&ifab);
        sys$close(&ofab);
        continue;
      }
    }

/*
 * Close the output file.
 */
    status = sys$close(&ofab);
    if (!(status & 1))
    {
      unsigned int msgvec[3];
      msgvec[0] = 2;
      msgvec[1] = ofab.fab$l_sts;
      msgvec[2] = ofab.fab$l_stv;
      printf("Could not close output file.\n");
      sys$putmsg(msgvec,0,0,0);
      sys$close(&ifab);
      continue;
    }

    oresult[onam.nam$b_rsl] = '\0';
    printf("Writing %s\n", oresult);

/*
 * Re-open the output file by NAM block and
 * UFO this time (accessed on user-mode channel).
 */
    ofab.fab$l_fop |= FAB$M_NAM | FAB$M_UFO;
    status = sys$open(&ofab);
    if (!(status & 1))
    {
      unsigned int msgvec[3];
      msgvec[0] = 2;
      msgvec[1] = ofab.fab$l_sts;
      msgvec[2] = ofab.fab$l_stv;
      printf("Could not access output file on channel.\n");
      sys$putmsg(msgvec,0,0,0);
      sys$close(&ifab);
      continue;
    }

/*
 * Set the completion event flag.  Clear outstanding I/O counts.
 */
    sys$setef(iefn);
    nreads_outstanding = 0;
    nwrites_outstanding = 0;
    max_reads_outstanding = 0;
    max_writes_outstanding = 0;

/*
 * Start as many as <nbuffers> read requests.
 */
    for (       ibuf=0, ivbn=1;
                ((ibuf<nbuffers) && (ivbn <= ifab.fab$l_alq));
                ibuf++)
    {
      sys$setast(0);
      if (ivbn == 1)
      {
        sys$clref(iefn);
        lib$init_timer(0);
      }

      piosa = (iosa*)&buffer[ibuf][0];
      piosa->iosa$l_status = 1;
      piosa->iosa$ih_count = nbytes_per_xfer;
      piosa->iosa$q_context_q[0] = ibuf;
      piosa->iosa$q_context_q[1] = ivbn;

      status = sys$io_perform(ifan[ibuf], ifab.fab$l_stv,
        &buffer[ibuf][0], &buffer[ibuf][NBYTES_PER_BLOCK],
        nbytes_per_xfer, ivbn);
      if (!(status & 1))
      {
        sys$setast(1);
        printf("Could not start input from VBN %0d to buffer #%0d.\n",
                ivbn, ibuf);
        return status;
      }
      ivbn += nblocks_per_xfer;
      nreads_outstanding++;
      sys$setast(1);
    }

/*
 * Wait for the disk reads and writes to complete.
 */
    sys$waitfr(iefn);
    lib$show_timer(0);
    printf("     Total Fast I/O Reads: %0d; Writes: %0d.\n",
        ifab.fab$l_ctx, ofab.fab$l_ctx);
    printf("Maximum Outstanding Reads: %0d; Writes: %0d.\n",
        max_reads_outstanding, max_writes_outstanding);

/*
 * Deassign the input channel.
 */
    status = sys$dassgn(ifab.fab$l_stv);
    if (!(status & 1))
    {
      printf("Could not deassign input channel.\n");
      return status;
    }

/*
 * Completely re-initialize the file information block.  The file ID
and
 * directory ID fields must be zeroed, or the XQP will attempt to
truncate
 * and modify the attributes of the *original* or *previous* file,
*not*
 * the file that is currently accessed on the channel.
 */
    bzero((char*)&fib, sizeof(fib));
    fib.fib$l_acctl = FIB$M_WRITETHRU;
    fib.fib$w_exctl = FIB$M_TRUNC;
    fib.fib$l_exsz  = 0;
    fib.fib$l_exvbn = xabfhc.xab$l_ebk;
    if (xabfhc.xab$w_ffb) fib.fib$l_exvbn++;
    fib.fib$w_verlimit = 0;
    fib.fib$l_acl_status = 0;

/*
 * Copy the file header characteristics to the file attributes.
 */
    fat.fat$b_rtype    = xabfhc.xab$b_rfo;
    fat.fat$b_rattrib  = xabfhc.xab$b_atr;
    fat.fat$w_rsize    = xabfhc.xab$w_lrl;
    fat.fat$w_hiblkl   = xabfhc.xab$w_hbk0; /* ignored */
    fat.fat$w_hiblkh   = xabfhc.xab$w_hbk2; /* ignored */
    fat.fat$w_efblkl   = xabfhc.xab$w_ebk0;
    fat.fat$w_efblkh   = xabfhc.xab$w_ebk2;
    fat.fat$w_ffbyte   = xabfhc.xab$w_ffb;
    fat.fat$b_bktsize  = xabfhc.xab$b_bkz;
    fat.fat$b_vfcsize  = xabfhc.xab$b_hsz;
    fat.fat$w_maxrec   = xabfhc.xab$w_mrz;
    fat.fat$w_defext   = xabfhc.xab$w_dxq;
    fat.fat$w_gbc      = xabfhc.xab$w_gbc;
    fat.fat$w_versions = xabfhc.xab$w_verlimit;

/*
 * Modify and truncate the file.
 */
    status = sys$qiow(iefn, ofab.fab$l_stv, IO$_MODIFY, iosb, 0, 0,
                &fibdsc, 0, 0, 0, &atrlst, 0);
    if (status & 1) status = iosb[0];
    if (status & 1)
    {
      printf("Output file truncated at VBN %0u by %0u blocks.\n",
                fib.fib$l_exvbn, fib.fib$l_exsz);
      printf("New end-of-file block is %0u, first free byte is
%0u.\n",
                xabfhc.xab$l_ebk, xabfhc.xab$w_ffb);
    }
    else
    {
      printf("Could not truncate output file to EBK %0u, FFB %0u.\n",
                xabfhc.xab$l_ebk, xabfhc.xab$w_ffb);
    }

/*
 * Deassign the output channel.
 */
    status = sys$dassgn(ofab.fab$l_stv);
    if (!(status & 1))
    {
      printf("Could not deassign output channel.\n");
      return status;
    }
  } /* input file search loop */

  if ((status != RMS$_NMF) && !(status & 1))
  {
    unsigned int msgvec[3];
    msgvec[0] = 2;
    msgvec[1] = ifab.fab$l_sts;
    msgvec[2] = ifab.fab$l_stv;
    printf("Could not search for input file.\n");
    sys$putmsg(msgvec,0,0,0);
  }

/*
 * Clean up after <nbuffers> buffer objects.
 * This apparently gets done at image exit anyway.
 */
  for (ibuf=0; ibuf<nbuffers; ibuf++)
  {
    status = sys$io_cleanup(ifan[ibuf]);
    if (!(status & 1))
    {
      printf("Could not clean up input for buffer #%0d.\n", ibuf);
      return status;
    }

    status = sys$io_cleanup(ofan[ibuf]);
    if (!(status & 1))
    {
      printf("Could not clean up output for buffer #%0d.\n", ibuf);
      return status;
    }

    status = sys$delete_bufobj(iohan[ibuf]);
    if (!(status & 1))
    {
      printf("Could not delete buffer object #%0d.\n", ibuf);
      return status;
    }
  }
  return status;
} /* fast_io_copy() */