From:	CSBVAX::MRGATE!ijah400%ivax.decnet@gold.bacs.indiana.edu@SMTP 16-AUG-1988 22:15
To:	ARISIA::EVERHART
Subj:	lzcomp/lzdcmp part 4 of 6.


Date: 16 Aug 88 15:22:00 EST
From: "IVAX::IJAH400" <ijah400%ivax.decnet@gold.bacs.indiana.edu>
Subject: lzcomp/lzdcmp part 4 of 6.
To: "everhart%arisia.decnet" <everhart%arisia.decnet@ge-crd.arpa>

$Part4:
$ File_is="LZVIOISAM.C"
$ Check_Sum_is=304432837
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X/*
X *`009`009`009l z v i o . c
X * For VMS V4 only.
X */
X
X/*
X * Problems:
X *`009If you open a second input file (getting rms attributes)
X *`009it aborts with an internal "fatal" error (15820C LIB-F-FATERRLIB)
X */
X
X/*
X * Make TESTING_FDLIO non-zero to enable test code.
X *
X * Edit History
X */
X#ifndef`009TESTING_FDLIO
X#define`009TESTING_FDLIO`0090
X#endif
X
X/*
X * RMS/FDL record level i/o routines for Vax-11 C V4 or greater only.
X * Rather crude.
X *
X * The following are provided:
X *
X *`009#define`009FDLSTUFF`009char
X *`009#include descrip
X *
X *`009FDLSTUFF *
X *`009fdl_open(filename, fdl_descriptor)
X *`009char`009`009`009*filename;
X *`009struct`009dsc$descriptor`009*fdl_descriptor;
X *`009`009Initializes internal buffers and opens this existing
X *`009`009file for input.  The filename may not contain wildcards.
X *`009`009On (successful) return, fdl_descriptor will point to
X *`009`009an initialized fdl specification.  The description
X *`009`009string will be in malloc'ed memory.  The caller does not
X *`009`009initialize the fdl_descriptor.  Returns NULL on error.
X *`009`009(Note an error will be returned if the file is not
X *`009`009block-oriented.)
X *
X *`009`009When you don't need the fdl_descriptor information
X *`009`009any more, free it by calling
X *`009`009    fdl_free(fdl_descriptor);
X *`009`009if fdl_descriptor is NULL on entry, the file is opened
X *`009`009normally (fdl information is not collected).
X *
X *`009FDLSTUFF *
X *`009fdl_create(fdl_descriptor, override_filename)
X *`009struct`009dsc$descriptor`009*fdl_descriptor;
X *`009char`009`009`009*override_filename;
X *`009`009Creates a file using the fdl specification.
X *`009`009If override_filename is not NULL and not equal to "",
X *`009`009it will override the filename specified in the fdl.
X *`009`009fdl_write() is used to write data to the file.
X *`009`009Returns NULL on error.
X *
X *`009`009if fdl_descriptor is NULL, the file is created using
X *`009`009the name in override_filename (which must be present).
X *`009`009The file is created in "undefined" record format.
X *
X *`009fdl_free(fdl_descriptor)
X *`009struct`009dsc$descriptor`009*fdl_descriptor;
X *`009`009Releases the fdl descriptor block.
X *
X *`009int
X *`009fdl_read(buffer, buffer_length, r)
X *`009char`009`009*buffer;
X *`009int`009`009buffer_length;
X *`009FDLSTUFF`009*r;
X *`009`009Read buffer_length bytes from the file (using SYS$READ).
X *`009`009No expansion or interpretation.  buffer_length had
X *`009`009better be even or you're asking for trouble.  Returns
X *`009`009the actual number of bytes read.  The file has been
X *`009`009opened by fdl_open.
X *
X *`009int
X *`009fdl_write(buffer, buffer_length, r)
X *`009char`009`009*buffer;
X *`009int`009`009buffer_length;
X *`009FDLSTUFF`009*r;
X *`009`009Write buffer_length bytes to the file (using SYS$WRITE).
X *`009`009No expansion or interpretation.  buffer_length had
X *`009`009better be even or you're asking for trouble.  Returns
X *`009`009the actual number of bytes written.  The file was opened
X *`009`009by fdl_create();
X *
X *`009fdl_getname(r, buffer)
X *`009FDLSTUFF`009*r;
X *`009char`009`009*buffer;
X *`009`009Copies the currently open file's name to the caller's
X *`009`009data buffer buffer.
X *
X *`009long
X *`009fdl_fsize(r)
X *`009`009Returns the size in bytes of the opened file.
X *
X *`009fdl_dump(fdl_descriptor, fd)
X *`009struct`009dsc$descriptor`009*fdl_descriptor;
X *`009FILE`009`009`009*fd;
X *`009`009Writes the fdl info to the indicated file with
X *`009`009line breaks in appropriate places.
X *
X *`009fdl_message(r, why)
X *`009FDLSTUFF`009*r;
X *`009char`009`009*why;
X *`009`009All system-level routines set a global value, fdl_status.
X *`009`009fdl_message() prints the error message text corresponding
X *`009`009to the current value of fdl_status.  The message printed
X *`009`009has the format:
X *`009`009`009why current_filename: error_message.
X *`009`009If why is NULL, only the error_message is printed.
X */
X`012
X#include "lz.h"
X#if VMS_V4
X#include rms
X#include ssdef
X#include descrip
X#include devdef
X#ifndef`009FDL$M_FDL_SIGNAL
X#define FDL$M_FDL_SIGNAL`0091`009/* Signal errors if set`009`009*/
X#endif
X#ifndef`009FDL$M_FDL_STRING
X#define FDL$M_FDL_STRING`0092`009/* Use string for fdl text`009*/
X#endif
X#if TESTING_FDLIO
X#define`009SIGNAL_ON_ERROR`009FDL$M_FDL_SIGNAL
X#else
X#define`009SIGNAL_ON_ERROR`0090
X#endif
X
X#define`009TRUE`0091
X#define`009FALSE`0090
X#define`009EOS`0090
X
Xtypedef struct FDLSTUFF {
X`009struct`009RAB`009rab;`009`009/* Record access buffer`009`009*/
X`009struct`009FAB`009fab;`009`009/* File access buffer`009`009*/
X`009struct`009NAM`009nam;`009`009/* File name buffer`009`009*/
X`009struct`009XABFHC`009xab;`009`009/* Extended attributes block`009*/
X`009struct`009XABSUM`009xabsum;`009`009/* Summary attributes block`009*/
X`009char`009`009starname[NAM$C_MAXRSS + 1]; /* Wild file name`009*/
X`009char`009`009filename[NAM$C_MAXRSS + 1]; /* Open file name`009*/
X} FDLSTUFF;
X
Xint`009`009fdl_status;`009`009/* Set to last rms call status`009*/
X
Xstatic FDLSTUFF *
Xfail(r, why, name)
XFDLSTUFF`009*r;`009`009`009/* Buffer`009`009`009*/
Xchar`009`009*why;`009`009`009/* A little commentary`009`009*/
Xchar`009`009*name;`009`009`009/* Argument to perror`009`009*/
X/*
X * Problem exit routine
X */
X{
X#if TESTING_FDLIO
X`009if (name == NULL && r != NULL)
X`009    name = r->fab.fab$l_fna;
X`009message(r, why, name);
X#endif
X`009if (r != NULL)
X`009    free(r);
X`009return (NULL);
X}
X`012
XFDLSTUFF *
Xfdl_open(filename,  fdl_descriptor)
Xchar`009`009`009*filename;`009`009/* What to open`009`009*/
Xstruct`009dsc$descriptor`009*fdl_descriptor;`009/* Result descriptor`009*/
X/*
X * Open the file.  Returns NULL on failure, else a pointer to RMS stuff.
X * Which is equivalently a pointer to the RAB. (Note that the RAB points
X * in turn to the FAB.)
X *
X * Return the file's fdl descriptor in the user-supplied (uninitialized)
X * descriptor.
X */
X{
X`009register FDLSTUFF`009*r;
X`009int`009`009`009retlen;
X`009int`009`009`009badblk;
X`009struct FAB`009`009*fab_add;
X`009struct RAB`009`009*rab_add;
X`009struct XABALL`009`009*xaball;
X`009struct XABKEY`009`009*xabkey,*this_xab;
X`009static int`009`009flags = (FDL$M_FDL_STRING | SIGNAL_ON_ERROR);
X`009extern FDLSTUFF`009`009*fdl_setup();
X`009int`009`009`009i;
X        static readonly $DESCRIPTOR(null_dx,"\0");`009/*[IU-2]*/
X
X`009if ((r = fdl_setup(filename)) == NULL)
X`009    return (NULL);
X`009/*
X`009 * Now open the file.
X`009 */
X`009r->fab.fab$b_fac = FAB$M_GET | FAB$M_BRO; /* Block I/O only`009*/
X`009if ((fdl_status = sys$open(&r->fab)) != RMS$_NORMAL) {
X`009    return (fail(r, "opening file", NULL));
X`009}
X`009if ((r->fab.fab$l_dev & DEV$M_REC) != 0) {
X`009    fail(r, "Record only device");
X`009    fdl_close(r);
X`009    return (NULL);
X`009}
X
X`009/* now, we know how many keys (if any) there are in the file, lets
X`009   add that many xabkeys */
X`009this_xab = &r->xabsum;
X`009for (i=0; i < r->xabsum.xab$b_nok; i++)
X`009    {
X `009    if ((xabkey = (char *)malloc(sizeof (struct XABKEY) + 32)) == NULL)
X`009`009return (NULL);
X`009    this_xab->xab$l_nxt = xabkey;
X`009    *xabkey = cc$rms_xabkey;
X`009    xabkey->xab$b_ref = i;
X`009    xabkey->xab$l_knm = xabkey + sizeof(struct XABKEY);
X`009    this_xab = xabkey;
X`009    xabkey = 0;
X`009    }
X
X`009/* we know how many allocation areas (if any) there are in the
X`009   file, lets add that many xaballs and then do a $display */
X`009for (i=0; i < r->xabsum.xab$b_noa; i++)
X`009    {
X`009    if ((xaball = (char *)malloc(sizeof (struct XABALL))) == NULL)
X`009`009return (NULL);
X`009    this_xab->xab$l_nxt = xaball;
X`009    *xaball = cc$rms_xaball;
X`009    xaball->xab$b_aid = i;
X`009    this_xab = xaball;
X`009    xaball = 0;
X`009    }
X
X`009if ((fdl_status = sys$display(&r->fab)) != RMS$_NORMAL)
X`009    return (fail(r, "displaying after adding xabkeys", NULL));
X
X`009r->rab.rab$l_rop = RAB$M_BIO;`009`009/* Block I/O only`009*/
X`009if ((fdl_status = sys$connect(&r->rab)) != RMS$_NORMAL)
X`009    return (fail(r, "connecting after open", NULL));
X
X`009if (fdl_descriptor != NULL) {
X`009    /*
X`009     * Now, get the file attributes
X`009     */
X/*[IU-2]    fdl_descriptor->dsc$w_length = 4096;`009*/
X            fdl_descriptor->dsc$w_length = 0;
X            fdl_descriptor->dsc$b_dtype = DSC$K_DTYPE_VT;
X            fdl_descriptor->dsc$b_class = DSC$K_CLASS_D;
X/*[IU-2]    fdl_descriptor->dsc$a_pointer = malloc(4096);`009*/
X            fdl_descriptor->dsc$a_pointer = NULL;
X`009    fab_add = &r->fab;
X`009    rab_add = &r->rab;
X`009    if ((fdl_status = fdl$generate(
X`009`009    &flags,
X`009`009    &fab_add,
X`009`009    &rab_add,
X`009`009    0, 0,
X`009`009    fdl_descriptor,
X`009`009    &badblk,
X`009`009    &retlen)) != SS$_NORMAL) {
X`009`009fdl_free(fdl_descriptor);
X`009`009sys$close(&r->fab);
X`009`009return(fail(r, "getting fdl info", NULL));
X`009    }
X`009    /*
X`009     * Success, null-terminate fdl info and squeeze the block.
X`009     */
X/*[IU-2]    fdl_descriptor->dsc$a_pointer[retlen] = EOS;
X`009    fdl_descriptor->dsc$a_pointer
X`009`009= realloc(fdl_descriptor->dsc$a_pointer, retlen + 1);
X`009    fdl_descriptor->dsc$w_length = retlen;
X[IU-2]*/
X`009    STR$APPEND(fdl_descriptor,&null_dx);`009/*[IU-2]*/
X`009    fdl_descriptor->dsc$w_length--;`009`009/*[IU-2]*/
X`009}
X`009return (r);
X}
X`012
XFDLSTUFF *
Xfdl_create(fdl_descriptor, override_filename)
Xstruct`009dsc$descriptor`009*fdl_descriptor;`009/* Result descriptor`009*/
Xchar`009`009`009*override_filename;`009/* What to open`009`009*/
X/*
X * Create the file, Returns NULL on failure, else a pointer to RMS stuff.
X * Which is equivalently a pointer to the RAB. (Note that the RAB points
X * in turn to the FAB.)  The file is open for writing using fdl_write.
X *
X * Uses the filename in the descriptor block, or the override filename
X * if supplied (non-NULL and not == "");
X *
X * If fdl_descriptor is NULL, the override_filename is opened normally.
X */
X{
X`009register FDLSTUFF`009*r;
X`009int`009`009`009retlen;
X`009int`009`009`009badblk;
X`009static int`009`009flags = (FDL$M_FDL_STRING | SIGNAL_ON_ERROR);
X`009struct`009dsc$descriptor`009newname;
X`009struct`009dsc$descriptor`009*newname_ptr;
X`009int`009`009`009fid_block[3];
X`009char`009`009`009created_name[NAM$C_MAXRSS + 1];
X`009struct`009dsc$descriptor`009created_name_des = {
X`009`009`009`009    NAM$C_MAXRSS,
X`009`009`009`009    DSC$K_DTYPE_T,
X`009`009`009`009    DSC$K_CLASS_S,
X`009`009`009`009    &created_name[0]
X`009`009`009`009};
X`009extern FDLSTUFF`009`009*fdl_setup();
X
X`009if (fdl_descriptor == NULL) {
X`009    if ((r = fdl_setup(override_filename)) == NULL)
X`009`009return (NULL);
X`009    r->fab.fab$b_fac = FAB$M_PUT | FAB$M_BIO; /* Block I/O only`009*/
X`009    r->fab.fab$l_fop |= (FAB$M_NAM | FAB$M_SQO | FAB$M_BIO);
X`009    r->fab.fab$b_org = FAB$C_SEQ;`009/* Sequential only`009*/
X`009    r->fab.fab$b_rfm = FAB$C_UDF;`009/* Undefined format`009*/
X`009    if ((fdl_status = sys$create(&r->fab)) & 01 == 0)
X`009`009return (fail(r, "creating (sys$create)"));
X`009    goto exit;
X`009}
X`009if (override_filename == NULL || override_filename[0] == '\0')
X`009    newname_ptr = NULL;
X`009else {
X`009    newname_ptr = &newname;
X`009    newname.dsc$w_length = strlen(override_filename);
X`009    newname.dsc$b_dtype = DSC$K_DTYPE_T;
X`009    newname.dsc$b_class = DSC$K_CLASS_S;
X`009    newname.dsc$a_pointer = override_filename;
X`009}
X`009if ((fdl_status = fdl$create(fdl_descriptor,
X`009`009newname_ptr,`009`009/* New file name if any`009`009*/
X`009`0090,`009`009`009/* Default filename`009`009*/
X`009`009&created_name_des,`009/* Resultant filename`009`009*/
X`009`009&fid_block[0],`009`009/* File ID block`009`009*/
X`009`009&flags,`009`009`009/* FDL flag bits`009`009*/
X`009`0090,`009`009`009/* Statement number`009`009*/
X`009`009&retlen,`009`009/* Created name length`009`009*/
X`009`0090, 0)`009`009`009/* Create status, stv`009`009*/
X`009`009) & 01 == 0) {
X`009    return(fail(NULL, "creating (fdl$create)", NULL));
X`009}
X`009created_name[retlen] = '\0';
X`009if ((r = fdl_setup(created_name)) == NULL)
X`009    return (NULL);
X`009/*
X`009 * Now, open the file for output.
X`009 */
X`009r->fab.fab$b_fac = FAB$M_PUT | FAB$M_BIO; /* Block I/O only`009*/
X`009if ((fdl_status = sys$open(&r->fab)) != RMS$_NORMAL) {
X`009    return (fail(r, "opening created file", NULL));
X`009}
Xexit:`009if ((r->fab.fab$l_dev & DEV$M_REC) != 0) {
X`009    fail(r, "Record only device");
X`009    fdl_close(r);
X`009    return (NULL);
X`009}
X`009r->rab.rab$l_rop = RAB$M_BIO;`009`009/* Block I/O only`009*/
X`009if ((fdl_status = sys$connect(&r->rab)) != RMS$_NORMAL)
X`009    return (fail(r, "connecting after create", NULL));
X`009return (r);
X}
X`012
Xstatic FDLSTUFF *
Xfdl_setup(filename)
Xchar`009`009*filename;
X/*
X * Initializes rms blocks and parses file name.  Returns the
X * FDL data block on success, NULL on error.
X */
X{
X`009register FDLSTUFF`009*r;
X
X`009if ((r = (char *)malloc(sizeof (FDLSTUFF))) == NULL)
X`009    return (NULL);
X`009r->fab = cc$rms_fab;`009`009`009/* Preset fab,`009`009*/
X`009r->nam = cc$rms_nam;`009`009`009/*   name block`009`009*/
X`009r->rab = cc$rms_rab;`009`009`009/*   and record block`009*/
X`009r->xab = cc$rms_xabfhc;`009`009`009/*   file header block`009*/
X`009r->xabsum = cc$rms_xabsum;`009`009/*   summary block`009*/
X`009r->fab.fab$l_nam = &r->nam;`009`009/* fab -> name block`009*/
X`009r->fab.fab$l_xab = &r->xab;`009`009/* fab -> file header`009*/
X`009r->xab.xab$l_nxt = &r->xabsum;`009`009/* xabfhc -> xabsum`009*/
X`009r->fab.fab$l_fna = filename;`009`009/* Argument filename`009*/
X`009r->fab.fab$b_fns = strlen(filename);`009/* ... size`009`009*/
X`009r->rab.rab$l_fab = &r->fab;`009`009/* rab -> fab`009`009*/
X`009`009`009`009`009`009/* Stuff the name block`009*/
X`009r->nam.nam$l_esa = r->starname;`009`009/* Expanded filename`009*/
X`009r->nam.nam$b_ess = NAM$C_MAXRSS ;`009/* ... size`009`009*/
X`009r->nam.nam$l_rsa = r->filename;`009`009/* Resultant filename`009*/
X`009r->nam.nam$b_rss = NAM$C_MAXRSS ;`009/* ... max size`009`009*/
X`009if ((fdl_status = sys$parse(&r->fab)) != RMS$_NORMAL) {
X`009    return (fail(r, "parsing", filename));
X`009}
X`009((char *)r->nam.nam$l_esa)[r->nam.nam$b_esl] = EOS;
X`009r->fab.fab$l_fna = r->nam.nam$l_esa;`009/* File name`009`009*/
X`009r->fab.fab$b_fns = r->nam.nam$b_esl;`009/* Length`009`009*/
X`009r->fab.fab$l_fop |= FAB$M_NAM;`009`009/* Use name block`009*/
X`009return (r);
X}
X`012
Xfdl_free(fdl_descriptor)
Xstruct`009dsc$descriptor`009*fdl_descriptor;
X/*
X * Release the descriptor
X */
X{
X`009int status;`009`009`009`009`009/*[IU-2]*/
X
X`009if (fdl_descriptor->dsc$a_pointer != NULL) {
X/*[IU-2]    free(fdl_descriptor->dsc$a_pointer);`009*/
X/*[IU-2]    fdl_descriptor->dsc$a_pointer = NULL;`009*/
X`009    fdl_descriptor->dsc$w_length++;`009`009/*[IU-2]*/
X`009    if (((status = STR$FREE1_DX(fdl_descriptor)) & 1) != 1) /*[IU-2]*/
X`009 `009exit(status);`009`009`009`009/*[IU-2]*/
X`009}
X}
X
Xfdl_close(r)
Xregister FDLSTUFF`009*r;
X{
X`009if ((fdl_status = sys$close(&r->fab)) != RMS$_NORMAL)
X`009    return(fail(r, "close", NULL));
X`009free(r);
X}
X`012
Xint
Xfdl_read(buffer, buffer_length, r)
Xchar`009`009*buffer;`009`009/* Record`009`009`009*/
Xint`009`009buffer_length;`009`009/* Record length`009`009*/
Xregister FDLSTUFF *r;`009`009`009/* Record info.`009`009`009*/
X/*
X * Read the next record from the file.  Returns number of bytes read or
X * -1 on any error. fdl_status has the status.
X */
X{
X`009r->rab.rab$l_ubf = buffer;
X`009r->rab.rab$w_usz = buffer_length;
X`009r->rab.rab$l_bkt = 0;
X`009if ((fdl_status = sys$read(&r->rab)) != RMS$_NORMAL) {
X#if TESTING_FDLIO
X`009    if (fdl_status != RMS$_EOF) {
X`009`009fdl_message(r, "error return from sys$read");
X`009`009sleep(1);
X`009    }
X#endif
X`009    return (-1);
X`009}
X`009return (r->rab.rab$w_rsz);
X}
X`012
Xint
Xfdl_write(buffer, buffer_length, r)
Xchar`009`009*buffer;`009`009/* Record`009`009`009*/
Xint`009`009buffer_length;`009`009/* Record length`009`009*/
Xregister FDLSTUFF *r;`009`009`009/* Record info.`009`009`009*/
X/*
X * Write the next record to the file.  Returns number of bytes written or
X * -1 on any error. fdl_status has the status.
X */
X{
X`009r->rab.rab$l_rbf = buffer;
X`009r->rab.rab$w_rsz = buffer_length;
X`009r->rab.rab$l_bkt = 0;
X`009if ((fdl_status = sys$write(&r->rab)) != RMS$_NORMAL) {
X#if TESTING_FDLIO
X`009    fdl_message(r, "error return from sys$write");
X`009    sleep(1);
X#endif
X`009    return (-1);
X`009}
X`009return (r->rab.rab$w_rsz);
X}
X`012
Xfdl_getname(r, buffer)
XFDLSTUFF`009*r;`009`009`009/* File pointer`009`009`009*/
Xchar`009`009*buffer;`009`009/* Where to put it`009`009*/
X/*
X * Return current file name
X */
X{
X`009strcpy(buffer, r->fab.fab$l_fna);
X`009return (buffer);
X}
X
Xlong
Xfdl_fsize(r)
XFDLSTUFF`009*r;`009`009`009/* File pointer`009`009`009*/
X/*
X * Return current file size
X */
X{
X`009return (((long) r->xab.xab$l_ebk * 512) + r->xab.xab$w_ffb);
X}
X
Xfdl_message(r, why)
XFDLSTUFF`009*r;
Xchar`009`009*why;
X/*
X * Print error message
X */
X{
X`009extern char`009*vms_etext();
X
X`009if (why == NULL) {
X`009    fprintf(stderr, "\n%s\n\n", vms_etext(fdl_status));
X`009}
X`009else {
X`009    fprintf(stderr, "\n%s%s%s: %s\n\n",
X`009`009why,
X`009`009(why[0] == EOS) ? "" : " ",
X`009`009(r == NULL) ? "" : r->fab.fab$l_fna,
X`009`009vms_etext(fdl_status));
X`009}
X}
X
Xstatic char`009`009errname[257];`009/* Error text stored here`009*/
Xstatic $DESCRIPTOR(err, errname);`009/* descriptor for error text`009*/
X
Xstatic char *
Xvms_etext(errorcode)
Xint`009`009errorcode;
X{
X`009char`009`009*bp;
X`009short`009`009errlen;`009`009/* Actual text length`009`009*/
X
X`009lib$sys_getmsg(&errorcode, &errlen, &err, &15);
X`009/*
X`009 * Trim trailing junk.
X`009 */
X`009for (bp = &errname[errlen]; --bp >= errname;) {
X`009    if (isgraph(*bp) && *bp != ' ')
X`009`009break;
X`009}
X`009bp[1] = EOS;
X`009return(errname);
X}
X
Xstatic
Xmessage(r, why, name)
XFDLSTUFF`009*r;`009`009`009/* Buffer`009`009`009*/
Xchar`009`009*why;`009`009`009/* A little commentary`009`009*/
Xchar`009`009*name;`009`009`009/* File name`009`009`009*/
X/*
X * Print error message
X */
X{
X`009fprintf(stderr, "\nRMS error %x when %s %s\n",
X`009    fdl_status, why, (name == NULL) ? "" : name);
X`009fprintf(stderr, "\"%s\"\n", vms_etext(fdl_status));
X}
X`012
Xfdl_dump(fdl_descriptor, fd)
Xstruct`009dsc$descriptor`009*fdl_descriptor;
XFILE`009`009`009*fd;
X/*
X * Dump the descriptor to fd.
X */
X{
X`009register char`009*tp, *end;
X
X`009tp = fdl_descriptor->dsc$a_pointer;
X`009end = tp + fdl_descriptor->dsc$w_length;
X`009while (tp < end) {
X`009    if (*tp == '"') {
X`009`009do {
X`009`009    putc(*tp++, fd);
X`009`009} while (*tp != '"');
X`009    }
X`009    putc(*tp, fd);
X`009    if (*tp++ == ';')
X`009`009putc('\n', fd);
X`009}
X}
X
X`012
X#if`009TESTING_FDLIO
X/*
X * Test program for rms io
X */
X#include <stdio.h>
X
Xchar`009`009`009line[133];
Xchar`009`009`009filename[133];
Xchar`009`009`009buffer[2048];
X
Xmain(argc, argv)
Xint`009`009argc;
Xchar`009`009*argv[];
X{
X`009FDLSTUFF`009*old;
X`009FDLSTUFF`009*new;
X`009int`009`009size, total, nrecords;
X`009struct`009dsc$descriptor`009fdl_info;`009/* Result descriptor`009*/
X
X`009for (;;) {
X`009    fprintf(stderr, "Old file name: ");
X`009    fflush(stdout);
X`009    if (gets(line) == NULL)
X`009`009break;
X`009    if (line[0] == EOS)
X`009`009continue;
X`009    if ((old = fdl_open(line, &fdl_info)) == NULL) {
X`009`009fprintf(stderr, "open failed\n");
X`009`009continue;
X`009    }
X`009    fprintf(stderr, "New file name: ");
X`009    if (gets(line) == NULL)
X`009`009break;
X`009    if ((new = fdl_create(&fdl_info, line)) == NULL) {
X`009`009fprintf(stderr, "create failed\n");
X`009`009fdl_free(&fdl_info);
X`009`009continue;
X`009    }
X`009    fdl_getname(old, buffer);
X`009    fprintf(stderr, "Fdl for \"%s\", size %ld\n",
X`009`009buffer, fdl_fsize(old));
X`009    fdl_dump(&fdl_info, stderr);
X`009    total = nrecords = 0;
X`009    while ((size = fdl_read(buffer, sizeof buffer, old)) > 0) {
X`009`009fdl_write(buffer, size, new);
X`009`009nrecords++;
X`009`009total += size;
X`009    }
X`009    fdl_close(old);
X`009    fdl_close(new);
X`009    fprintf(stderr, "copied %d records, %d bytes total\n",
X`009`009nrecords, total);
X`009    fdl_free(&fdl_info);
X`009}
X}
X
X#endif
X#endif
$ GoSub Convert_File
$ Goto Part5

