From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX"  7-AUG-1989 07:51
To:	MRGATE::"ARISIA::EVERHART"
Subj:	VBTOA and VATOB

Message-Id:  <8908071129.AA02991@crdgw1.ge.com>
Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Sat,  5 AUG 89 13:22:19 PDT
Received: from Venus.YCC.Yale.Edu (YALE-ENG-VENUS.ARPA) by KL.SRI.COM with TCP; Sat, 5 Aug 89 12:58:45 PDT
Date: Sat, 5 Aug 89 15:13 EDT
From: "Jerry Leichter - LEICHTER-JERRY@CS.YALE.EDU"
 <LEICHTER@Venus.YCC.Yale.Edu>
Subject: VBTOA and VATOB
To: dittman@skbat.csc.ti.COM, INFO-VAX@KL.SRI.COM
X-Vms-To: IN%"dittman@skbat.csc.ti.COM"

Here are the promised VBTOA and VATOB programs, which "ASCII'ize" files on
VMS and preserve file attributes.  They also use (more or less) standard
RMS defaulting rules for determining the input and output files.  (The only
place you'll see a disagreement with correct RMS parsing is if the input
file is specified using a search list.)

LIMITATION:  These programs do NOT properly preserve the attributes of indexed
files.  I didn't happen to need that feature, so I was lazy and didn't read
and send the key attributes.  Should you need to send an indexed file using
this programs, wrap it in a BACKUP saveset first.

These programs are INCOMPATIBLE with the Unix atob/btoa programs.  vatob will
not recognize a btoa output file, and conversely atob will not recognize a
vbtoa output file.

Enjoy!
							-- Jerry
----------------vatob.c------------------
/* vatob: version 4.0
 * stream filter to change printable ascii from "vbtoa" back into 8 bit bytes
 * if bad chars, or Csums do not match: exit(IO_ERROR)
 *
 * Usage:
 *
 *	vatob infile [outfile]
 *
 * The default file type of infile is .85; for outfile, .Z (with VMS-standard
 * defaulting for other fields from infile).
 *
 *  Paul Rutter		Joe Orost	Jerry Leichter
 *  philabs!per		petsd!joe	leichter@yale
 */

/*)BUILD
*/

#include	stdio
#include	ssdef
#include	rms
#include	rmsdef
#include	ctype
#include	stsdef

#define	IO_SUCCESS	(SS$_NORMAL | STS$M_INHIB_MSG)
#define	IO_ERROR	SS$_ABORT
#define FALSE		0
#define TRUE		1
#define EOS		0

extern char	*fparse();

#define streq(s0,s1)  (strcmp(s0,s1) == 0)

#define DE(c) ((c) - '!')

#define PNEXT(w,bytes)						\
		((bufc < sizeof(buffer))			\
		 ? (bufc += bytes,*bufp++ = w)			\
		 : flush(w,bytes))

#define		BLOCKING		10
#define		BUFFER_SIZE		(512*BLOCKING)

FILE	*inf;

int 	rms_status;

unsigned int	*bufp;			/* Buffer pointer		*/
int		bufc;			/* Buffer count			*/
int		word;			/* A longword being built	*/
int		wbyte;			/* Next byte of word to use	*/
struct	FAB	outfab;
struct	RAB	outrab;
struct	XABDAT	xabdat;
struct	XABFHC	xabfhc;

char   		buffer[BUFFER_SIZE];

int	csum1;				/* File checksum		*/
int	csum2;				/* And another checksum		*/
int	ctot;				/* Total bytes written to file	*/

main(argc,argv) 
int	argc;
char	**argv;
{	int c;
	int i;
	int rsz;			/* Remaining bytes at end	*/
	char buf[512];
	int otot, osum1, osum2;
	char	*infnm = NULL;
	char	*outfnm = NULL;

	for (i = 1; i < argc; i++)
	{	if (infnm == NULL)
			infnm = argv[i];
		else if (outfnm == NULL)
			outfnm = argv[i];
		else	usage();
	}

	if (infnm == NULL)
		usage();

	infnm = fparse(infnm,".85");
	if (infnm == NULL)
		fatal("Ill-formed input file name");

	outfnm = fparse(outfnm,".Z",infnm,NULL,"ofp");
	if (outfnm == NULL)
		fatal("Ill-formed output file name");

	if (NULL == (inf = fopen(infnm,"r")))
	{	perror("Can't open input file");
		exit(IO_ERROR);
	}

	/*
	 * Search for header line
	 */
	for (;;)
	{	if (fgets(buf,sizeof(buf),inf) == NULL)
			fatal("No header found");
		if (streq(buf,"vbtoa Begin\n"))
			break;
	}

  	openout(outfnm);

	bufp = buffer;
	bufc = word = wbyte = ctot = csum1 = csum2 = 0;

	for (;;)
	{	c = getc(inf);
		if (c == '\n')
			continue;
		else if (c == 'x')
			break;
		else if (c == EOF)
			fatal("Unexpected EOF");
      		else	send85(c,4);
	}

	if (wbyte != 0)
		fatal("Mis-aligned x op");
	c = getc(inf);
	if (c < '0' || c > '3')
		fatal("Meaningless count after x op");
	rsz = c - '0';
	i = 5;
	while (i--)
	{	while((c = getc(inf)) == '\n')
			;
		if (c == 'x')
			fatal("Illegal x op");
		else if (c == EOF)
			fatal("Unexpected EOF");
		else if (c == 'z')
			i = 0;
      		send85(c,(i != 0) ? 4 : rsz);
	}

	if (wbyte != 0)
		fatal("Not aligned at end");

	if(fscanf(inf,"\nvbtoa End B %d C1 %d C2 %d\n",
	    &otot,&osum1,&osum2) != 3)
		fatal("No or ill-formed trailer");

	if ((otot != ctot) || (osum1 != csum1) || (osum2 != csum2))
		fatal("Checksum mismatch");

	closef();
	exit(IO_SUCCESS);
}

/*
 * Send a character out to the word being built, and then to the buffer.
 * bytes is the number of valid bytes in the resulting word; it is used
 * 4 except when building up the final word of output, when it can be
 * anything from 0 to 3.  It is the increment used in determining the
 * size of the buffer to write.
 */
send85(c,bytes) 
unsigned	c;
int		bytes;
{	unsigned c1;

	if (c == 'z')
	{	if (wbyte != 0)
			fatal("Unaligned z op");
		goto put_word;
	}
	else	
	{	c1 = DE(c);
		if (c1 >= 85)
		{	fprintf(stderr,"Garbage character %d in input",c);
			return;
		}
		word = 85 * word + c1;
		wbyte++;
		if (wbyte >= 5)
		{
	put_word:	csum1 = 65531 * csum1 + word;
			csum2 = 65539 * csum2 ^ word;
			PNEXT(word,bytes);
			ctot += bytes;
			wbyte = 0;
			word = 0;
		}
	}
}

/*
 * Open the output file.  The FAB and RAB are set up using the data from the
 * input file.
 */
openout(to)
char	*to;
{
	if (getbuf(&outfab,sizeof(outfab)) != sizeof(outfab)
	 || getbuf(&outrab,sizeof(outrab)) != sizeof(outrab)
	 || getbuf(&xabdat,sizeof(xabdat)) != sizeof(xabdat)
	 || getbuf(&xabfhc,sizeof(xabfhc)) != sizeof(xabfhc))
	{	fprintf(stderr,
			"Ill-formed file, no leading fab/rab records\n");
		exit(SS$_ABORT);
	}

	outfab.fab$b_fac = FAB$M_PUT | FAB$M_BIO;
	outfab.fab$w_ifi = 0;
	outfab.fab$b_fns = strlen(to);
	outfab.fab$l_fna = to;
	outfab.fab$l_xab = &xabdat;

	xabdat.xab$l_nxt = &xabfhc;

	outrab.rab$l_bkt = 0;			/* Use next block	*/
	outrab.rab$l_fab = &outfab;
	outrab.rab$w_usz = BUFFER_SIZE;
	outrab.rab$w_rsz = BUFFER_SIZE;
	outrab.rab$l_rbf = &buffer;
	outrab.rab$l_ubf = &buffer;

	xabfhc.xab$l_nxt = 0;

	rms_status = sys$create(&outfab,0,0);
	if (rms_status != RMS$_NORMAL)
		exit(rms_status);

	rms_status = sys$connect(&outrab,0,0);
	if (rms_status != RMS$_NORMAL)
		exit(rms_status);
}                                   

/*
 * Fill a buffer with bytes bytes of information.
 *
 * This function is a hack that re-directs where PNEXT will write.  It saves
 * and restores the variables that drive the usual interface:  bufp, bufc,
 * word, and wbyte.  The values of csum1, and csum2 are trashed; ctot will
 * contain the same value as is returned by the function.
 *
 * bytes must be a multiple of 4, and less than sizeof(buffer) (to ensure
 * that an even number of words can be taken from the input, and that
 * PNEXT will never attempt to call flush(), which would write junk to the
 * output file).
 *
 * The actual number of bytes transfered to the output buffer is returned.
 */
getbuf(p,bytes)
char		*p;
unsigned	bytes;
{	unsigned int	*bufp_s	= bufp;
	int		bufc_s	= bufc;
	int		word_s	= word;
	int		wbyte_s	= wbyte;
	unsigned	c;

	if ((bytes & 3) != 0 || bytes >= sizeof(buffer))
		fatal("getbuf - bad bytes value");
	bufp = p;
	ctot = word = wbyte = bufc = 0;

	while (ctot < bytes && !feof(inf))
	{	while((c = getc(inf)) == '\n')
			;
		if (c == 'x')
			fatal("getbuf - found x op");
      		send85(c,4);
	}

	bufp	= bufp_s;
	bufc	= bufc_s;
	word	= word_s;
	wbyte	= wbyte_s;
	return(ctot);
}

/*
 * Flush the output buffer and then write a new word of information to it.
 * When bytes < 4, the remaining bytes in w are written immediately.  (When
 * called with bytes = 0, the effect is just to flush any buffered data out.)
 */
flush(w,bytes)
unsigned	w;
int		bytes;
{
	if ((outrab.rab$w_rsz = bufc) != 0)
	{	rms_status = sys$write(&outrab,0,0);
		if (rms_status != RMS$_NORMAL)
			exit(rms_status);
	}

	bufc = 0;
	bufp = buffer;
	if (bytes < 4)
	{	if ((outrab.rab$w_rsz = bytes) != 0)
		{	*bufp = w;
			rms_status = sys$write(&outrab,0,0);
			if (rms_status != RMS$_NORMAL)
				exit(rms_status);
		}
	}
	else	PNEXT(w,bytes);
};

/*
 * Close up the files.
 */
closef()
{
	flush(0,0);			/* Flush anything remaining	*/
	rms_status = sys$close(&outfab,0,0);
	if (rms_status != RMS$_NORMAL)
		exit(rms_status);

	fclose(inf);
}

/*
 * Report a fatal error and abort.
 */
fatal(s)
char s[];
{
	fprintf(stderr,"Fatal error:  %s\n",s);
	exit(IO_ERROR);
}

usage()
{	fprintf(stderr,"usage:  patob infile [outfile]");
	exit(IO_ERROR);
}

/***************************************************************************/
/*
 *		F P A R S E . C
 *
 * C-callable equivalent of the DCL F$PARSE lexical function.
 */

/*)LIBRARY
*/

#ifdef DOCUMENTATION

title	fparse	Parse VMS file specification a la DCL's F$PARSE
index		Parse VMS file specification a la DCL's F$PARSE

synopsis

	char *
	fparse(file_name,default_name,related_name,fields,options)
	char *file_name;			/* Optional	*/
	char *default_name;			/* Optional	*/
	char *related_name;			/* Optional	*/
	char *fields;				/* Optional	*/
	char *options;				/* Optional	*/

	extern noshare int fparse_dev;
	extern noshare int fparse_sdc;
	extern noshare int fparse_sts;
	extern noshare int fparse_stv;
	extern noshare int fparse_fnb;

description

	fparse() provides a simple interface to the SYS$PARSE() service.  Its
	interface is based on the DCL F$PARSE() lexical function.

	All strings are null-terminated.  Parameters can be omitted by passing
	NULL; trailing parameters may be omitted completely.

	Fields are:

	    "node"		node name
	    "device"		device name
	    "directory"		directory name
	    "name"		file name
	    "type"		file type
	    "version"		file version number

	Options to control the parse:

	    "noconceal"		Don't conceal device name
	    "pwd"		Leave actual DECnet password in place
	    "synchk"		No I/O - check syntax only
	    "ofp"		Do an output file parse

	Any number of field names and options may be specified in any order,
	separated by commas.  Only the first one or two characters of field
	and option names are checked (enough to identify the name uniquely).
	All field and options names must be given in lower case only.

	If the fields parameter is NULL or omitted, all fields are returned,
	except that the node name is included only if it appears explicitly.
	(This is the underlying behavior of SYS$PARSE.)

	The value returned is the address of the null-terminated expanded
	specification.  fparse calls malloc() to reserve space for the string;
	you should free it with free() when you are done with it.

	NULL is returned on either an RMS parse error, or an erroneous field
	parameter name or option.

	The RMS status is is available in symbol fparse_sts; for a bad field
	or option, it will contain SS$_BADPARAM.  If malloc() returns NULL,
	so does fparse(), but in this case fparse_sts will contain contain
	RMS$_NORMAL.  Other values returned as a result of the parse are
	available as follows:

	FAB$L_DEV	fparse_dev
	FAB$L_SDC	fparse_sdc
	FAB$L_STS	fparse_sts
	FAB$L_STV	fparse_stv
	NAM$L_FNB	fparse_fnb

	Wild-card context for the fab used is always discarded by fparse();
	it cannot be used to set up the control blocks for a call to $SEARCH.
	Certain additional RMS fields - FAB$W_DID, for example - are not
	available.

examples

	In determining the actual file specifications to use on a command
	line such as LINK/EXE=exefile objfile, the default type for "objfile"
	is .OBJ.  The default file name for "exefile" is the file name of
	"objfile", and the default type is .EXE.

	If the (char *) variable "objfile" points to the object file name from
	the command line, and the (char *) "exefile" points to the exe file
	from the command line.  Then to expand these into file names for calls
	to open() or fopen():

		objfile = fparse(objfile,".OBJ");
		exefile = fparse(exefile,".EXE",objfile,NULL,"ofp");

	(The "ofp" option was specified to avoid copying anything but the
	name and type from the object file - the exe file should go, for
	example, to the current default directory, not the object file's
	directory.)

	To find only the device and directory of the object file:

		dir = fparse(objfile,".OBJ",NULL,"device,directory");

	This could as well have been written:

		dir = fparse(objfile,".OBJ",NULL,"de,di");

bugs

	Since the various fparse_... fields are statically allocated, the
	code is not reentrant.

authors

	Bob Messenger; re-written by Jerry Leichter

#endif

/*
 * Revision History
 *	1.0 ??-???-85	 BM	Invention
 *	2.0  6-Nov-86	JSL	Extensive re-write; added options, ability
 *				to specify multiple fields at once.  Clean
 *				up fab context before returning.  Now returns
 *				NULL, not an empty string, on errors, and
 *				makes the various RMS values accessible.
 */

/* #include stdio
   #include rms
   #include ssdef
*/
#include varargs

#define EOS	'\0'

static char *copyn();
extern char *malloc();

noshare int fparse_dev;
noshare int fparse_sdc;
noshare int fparse_sts;
noshare int fparse_stv;
noshare int fparse_fnb;

char *
fparse(va_alist)
va_dcl
{	char		*file;
	char		*defaultn;
	char		*related;
	char		*fields;
	char		*options;
	struct FAB	fab;
	struct NAM	nam;
	struct NAM 	rnam;
	char		*result;
	int		len;
	char		expand_buf[NAM$C_MAXRSS];
	int		nargs;
	va_list		va;
	int		fbits;
#define NODE	 1
#define DEV	 2
#define DIR	 4
#define	NAME	 8
#define TYPE	16
#define	VER	32
#define ALL	(NODE|DEV|DIR|NAME|TYPE|VER)

	/*
	 * Pick up the arguments, forcing all missing ones to NULL
	 */
	va_count(nargs);
	va_start(va);
	file		= (nargs > 0) ? va_arg(va,char *) : NULL;
	defaultn	= (nargs > 1) ? va_arg(va,char *) : NULL;
	related		= (nargs > 2) ? va_arg(va,char *) : NULL;
	fields		= (nargs > 3) ? va_arg(va,char *) : NULL;
	options		= (nargs > 4) ? va_arg(va,char *) : NULL;
	va_end(va);

	/*
	 * Initialize all the blocks for RMS
	 */
	fab = cc$rms_fab;
	fab.fab$l_nam = &nam;
	fab.fab$l_fna = file;
	fab.fab$b_fns = (file == NULL) ? 0 : strlen(file);
	fab.fab$l_dna = defaultn;
	fab.fab$b_dns = (defaultn == NULL) ? 0 : strlen(defaultn);

	nam = cc$rms_nam;
	nam.nam$l_esa = expand_buf;
	nam.nam$b_ess = NAM$C_MAXRSS;
	nam.nam$l_rlf = &rnam;

	rnam = cc$rms_nam;
	rnam.nam$l_rsa = related;
	rnam.nam$b_rsl = (related == NULL) ? 0 : strlen(related);

	fparse_sts = SS$_BADPARAM;		/* Assume failure	*/
	/*
	 * Figure out what fields the user wants returned
	 */
	if (fields == NULL || *fields == EOS)
		fbits = ALL;
	else
	{	fbits = 0;
		while (*fields != EOS)
		{	switch (*fields)
			{
		case 'n':				/* node or name	*/
				if (*++fields == 'o')	/* node		*/
					fbits |= NODE;
				else if (*fields == 'a')/* name		*/
					fbits |= NAME;
				else	return(NULL);	/* n?		*/
				break;
		case 'd':			/* device or directory	*/
				if (*++fields == 'e')	/* device	*/
					fbits |= DEV;
				else if (*fields == 'i')/* directory	*/
					fbits |= DIR;
				else	return(NULL);	/* d?		*/
				break;
		case 't':				/* type		*/
				fbits |= TYPE;
				break;
		case 'v':				/* version	*/
				fbits |= VER;
				break;
		default:				/* Unknown	*/
				return(NULL);
			}
			while (*fields != ',' && *fields != EOS)
				fields++;
			if (*fields != EOS)
				fields++;
		}
	}

	/*
	 * Scan options and set the appropriate RMS bits.
	 */
	if (options != NULL)
	{	while (*options != EOS)
		{	switch(*options)
			{
		case 'n':				/* noconceal	*/
				nam.nam$b_nop |= NAM$M_NOCONCEAL;
				break;

		case 'o':				/* ofp		*/
				fab.fab$l_fop |= FAB$M_OFP;
				break;

		case 'p':				/* pwd		*/
				nam.nam$b_nop |= NAM$M_PWD;
				break;

		case 's':				/* synchk	*/
				nam.nam$b_nop |= NAM$M_SYNCHK;
				break;

		default:				/* unknown	*/
				return(NULL);
			}
			while (*options != ',' && *options != EOS)
				options++;
			if (*options != EOS)
				options++;
		}
	}

	/*
	 * call SYS$PARSE to parse the file name
	 */
	fparse_sts = SYS$PARSE(&fab);
	fparse_dev = fab.fab$l_dev;
	fparse_sdc = fab.fab$l_sdc;
	fparse_stv = fab.fab$l_stv;
	fparse_fnb = nam.nam$l_fnb;
	if (fparse_sts != RMS$_NORMAL)
		return(NULL);

	/*
	 * Calculate the total length of the string we will be returning.
	 * In the process, zero out the lengths of the fields we are not
	 * returning to simplify the later copy code.
	 */
	len = 0;
	if (fbits & NODE)
		len += nam.nam$b_node;
	else	nam.nam$b_node = 0;

	if (fbits & DEV)
		len += nam.nam$b_dev;
	else	nam.nam$b_dev = 0;

	if (fbits & DIR)
		len += nam.nam$b_dir;
	else	nam.nam$b_dir = 0;

	if (fbits & NAME)
		len += nam.nam$b_name;
	else	nam.nam$b_name = 0;

	if (fbits & TYPE)
		len += nam.nam$b_type;
	else	nam.nam$b_type = 0;

	if (fbits & VER)
		len += nam.nam$b_ver;
	else	nam.nam$b_ver = 0;

	/*
	 * Construct the expanded file name
	 */
	if ((result = malloc(len + 1)) != NULL)
	{	char	*p;

		p = copyn(result,nam.nam$l_node,nam.nam$b_node);
		p = copyn(p,nam.nam$l_dev,nam.nam$b_dev);
		p = copyn(p,nam.nam$l_dir,nam.nam$b_dir);
		p = copyn(p,nam.nam$l_name,nam.nam$b_name);
		p = copyn(p,nam.nam$l_type,nam.nam$b_type);
		p = copyn(p,nam.nam$l_ver,nam.nam$b_ver);
		*p++ = EOS;
	}

	/*
	 * Release any space reserved by RMS for wild-card expansion
	 */
	nam.nam$b_nop = NAM$M_SYNCHK;
	fab.fab$b_dns = 0;
	nam.nam$l_rlf = NULL;
	SYS$PARSE(&fab);

	return(result);
}

/*
 * copyn n >= 0 characters from in to out; return (out + n), i.e., the next
 * free character after the characters copied.
 */
static char *
copyn(out,in,n)
char	*out;
char	*in;
int	n;
{
	while (n-- > 0)
		*out++ = *in++;
	return(out);
}
----------------vbtoa.c------------------
/* vbtoa: version 4.0 (modified for VMS)
 * stream filter to change 8 bit bytes into printable ascii
 * computes the number of bytes, and three kinds of simple checksums
 * incoming bytes are collected into 32-bit words, then printed in base 85
 *  exp(85,5) > exp(2,32)
 * the ASCII characters used are between '!' and 'u'
 * 'z' encodes 32-bit zero; 'x' is used to mark the end of encoded data; it
 * is followed a number from 0 to 3, and an encoded word with that many
 * valid (low-order) bytes in it.
 *
 * Usage:
 *
 *	pbtoa input [output]
 *
 * The default input file type is .Z.  The output defaults are picked up from
 * the input, with default file type .85.
 *
 *  Paul Rutter		Joe Orost	Jerry Leichter
 *  philabs!per		petsd!joe	leichter@yale
 *
 * WARNING: this version is not compatible with the Unix version - it uses
 * a VMS-specific header containing file-structure information.
 */

/*)BUILD
*/

#include	stdio
#include	ssdef
#include	rms
#include	rmsdef
#include	ctype
#include	stsdef
#define	IO_SUCCESS	(SS$_NORMAL | STS$M_INHIB_MSG)
#define	IO_ERROR	SS$_ABORT
#define FALSE		0
#define TRUE		1
#define EOS		0

#define MAXPERLINE 78

#define EN(c)	(unsigned)((c) + '!')
#define NEXT	((bufc >= sizeof(*bufp))			\
		 ? (bufc -= sizeof(*bufp),*bufp++)		\
		 : fillbuf())

#define		BLOCKING		10
#define		BUFFER_SIZE		(512*BLOCKING)

extern char	*fparse();

FILE	*outf;

int 	rms_status;

/*
 * Masks for keeping only the significant bytes of the last word.  (Actually,
 * only the first 4 entries are used for anything.)
 */
int	mask[] =
{	0x00000000, 0x000000FF, 0x0000FFFF, 0x00FFFFFF, 0xFFFFFFFF	};

unsigned int	*bufp;			/* Buffer pointer		*/
int		bufc = 0;		/* Buffer count			*/
int		eof_in = FALSE;		/* EOF on input			*/
int		rsz;			/* Remaining bytes at EOF	*/
int		rvl;			/* Those bytes			*/
struct	FAB	infab;
struct	RAB	inrab;
struct	XABDAT	xabdat;
struct	XABFHC	xabfhc;
char   		buffer[BUFFER_SIZE + sizeof(*bufp)];

int	csum1;				/* Input file checksum		*/
int	csum2;				/* Another one			*/

int	ctot;				/* Number of bytes in input	*/
int	ccount = 0;			/* Bytes on current output line	*/

main(argc,argv) 
char	**argv;
int	argc;
{	int	c;
	long	n;
	char	*infnm = NULL;
	char	*outfnm = NULL;

	for (n = 1; n < argc; n++)
	{	if (infnm == NULL)
			infnm = argv[n];
		else if (outfnm == NULL)
			outfnm = argv[n];
		else	usage();
	}

	if (infnm == NULL)
		usage();

	infnm = fparse(infnm,".Z");
	if (infnm == NULL)
		fatal("Ill-formed input file name");

	outfnm = fparse(outfnm,".85",infnm,NULL,"ofp");
	if (outfnm == NULL)
		fatal("Ill-formed output file name");

	bufp = &buffer;
  	openf(infnm,outfnm);

	ctot = csum1 = csum2 = 0;
	c = NEXT;
	while (!eof_in)
	{	wordout(c);
		c = NEXT;
	}
	putc('x',outf);
	putc('0' + rsz,outf);
	wordout(c & mask[rsz]);
	ctot = ctot - 4 + rsz;

	closef();
	exit(IO_SUCCESS);
}

/*
 * Write an encoded word of output
 */
wordout(word) 
unsigned	word;
{
	csum1 = 65531 * csum1 + word;
	csum2 = 65539 * csum2 ^ word;
	ctot += 4;

	if (word == 0)
	{	charout('z');
	}
	else
	{	charout(EN((word / (long)(85 * 85 * 85 * 85))));
		word %= (long)(85 * 85 * 85 * 85);
		charout(EN(word / (85 * 85 * 85)));
		word %= (85 * 85 * 85);
		charout(EN(word / (85 * 85)));
		word %= (85 * 85);
		charout(EN(word / 85));
		word %= 85;
		charout(EN(word));
	}
}

/*
 * Write out a single character, perhaps terminating the line
 */
charout(c)
int	c;
{
	putc(c,outf);
	ccount++;
	if (ccount == MAXPERLINE)
	{	putc('\n',outf);
		ccount = 0;
	}
}

openf(from,to)
char	*from;
char	*to;
{
	infab = cc$rms_fab;
	inrab = cc$rms_rab;
	xabdat = cc$rms_xabdat;
	xabfhc = cc$rms_xabfhc;
	infab.fab$l_fna = from;
	infab.fab$b_fns = strlen(from);
	infab.fab$b_fac = FAB$M_GET | FAB$M_BIO;
	infab.fab$l_xab = &xabdat;

	xabdat.xab$l_nxt = &xabfhc;
	xabfhc.xab$l_nxt = 0;

	inrab.rab$l_rop = FAB$M_BIO;
	inrab.rab$l_fab = &infab;
	inrab.rab$l_bkt = 0;			/* Use next block	*/
	inrab.rab$w_usz = BUFFER_SIZE;
	inrab.rab$w_rsz = BUFFER_SIZE;
	inrab.rab$l_rbf = &buffer;
	inrab.rab$l_ubf = &buffer;

	rms_status = sys$open(&infab,0,0);
	if (rms_status != RMS$_NORMAL)
		exit(rms_status);
	if (infab.fab$b_org != FAB$C_SEQ && infab.fab$b_org != FAB$C_REL)
		fatal("Unsupported file organization");

	rms_status = sys$connect(&inrab,0,0);
	if (rms_status != RMS$_NORMAL)
		exit(rms_status);

	if (NULL == (outf = fopen(to,"w")))
	{	perror();
		exit(rms_status);
	}
	fprintf(outf,"vbtoa Begin\n");
	putbuf(&infab,sizeof(infab));
	putbuf(&inrab,sizeof(inrab));
	putbuf(&xabdat,sizeof(xabdat));
	putbuf(&xabfhc,sizeof(xabfhc));

}                                   

/*
 * Fill the input buffer.  Sets bufp, bufc, rvl, eof_in; returns the next
 * word.  (On EOF, rvl is returned; only the bottom rsz bytes are meaningful).
 */
fillbuf()
{
	rsz = bufc;
	rvl = *bufp;
	rms_status = sys$read(&inrab,0,0);
	if (rms_status == RMS$_EOF)
	{	eof_in = 1;
		return(rvl);
	}		
	if (rms_status != RMS$_NORMAL)
		exit(rms_status);
	bufp = inrab.rab$l_rbf;
	bufc = 	inrab.rab$w_rsz - sizeof(*bufp);
	return(*bufp++);
}

/*
 * Close up the files.
 */
closef( )
{
	rms_status = sys$close(&infab,0,0);
	if (rms_status != RMS$_NORMAL)
		exit(rms_status);

	fprintf(outf,"\nvbtoa End B %d C1 %d C2 %d\n",
		ctot,csum1,csum2);
	fclose(outf);
}

/*
 * Send out a bunch of stuff from a buffer.  The buffer size must be a
 * multiple of the 4.  Note that ctot, csum1, and csum2 are implicitly
 * update, hence probably trashed.
 */
putbuf(p,c)
unsigned *p;
int c;
{
	if (c & 3)
	{	fprintf(stderr,"putbuf - buffer size %d\n",c);
		exit(IO_ERROR);
	}
	while(c)
	{	wordout(*p++);
		c -= sizeof(*p);
	}
}

/*
 * Report a fatal error and abort.
 */
fatal(s)
char s[];
{
	fprintf(stderr,"Fatal error:  %s\n",s);
	exit(IO_ERROR);
}

usage()
{	fprintf(stderr,"usage:  pbtoa infile [outfile]");
	exit(IO_ERROR);
}
<<<***Copy the definitions of fparse() and copyn() from vatob.c here.***>>>

