-h- lz.h	Sat Mar 26 16:57:17 1988	USER1:[MINOW.PERSONAL.SOURCE.LZ]LZ.H;95
/* #define DEBUG	TRUE	*/
/*
 * Header file for all lz compression/decompression routines.
 *
 * Machine/Operating system/compiler selection: (#ifdef'ed)
 * vax				Vax/Unix or Vax/VMS
 * pdp11			makes a small compressor
 * M_XENIX			"large-model" Z8000
 * interdata			Signed long compare is slow
 * unix				Defined on true Unix systems
 * decus			Decus C (no signal)
 * vms				Vax/VMS (VMS_V4 may be set automatically)
 * #define readonly		If the compiler doesn't support it correctly.
 * 
 * Compiler configuration (#if'ed):
 * #define vax_asm   TRUE/FALSE	TRUE on Vax (4bsd) if the compiler supports
 *				the asm() operator.  Check the generated code!
 * #define vms_asm   TRUE/FALSE	TRUE on Vax/VMS to use the run-time library
 *				insv and extv routines.
 * #define UCHAR     TRUE/FALSE	TRUE if compiler supports unsigned char
 * #define DEBUG     TRUE/FALSE	TRUE to compile in debug printouts
 *
 * Algorithm Tuning parameters:
 * #define USERMEM   <n>	Memory available to compress.
 *				If large enough, a faster algorithm is used.
 * #define SACREDMEM <n>	Don't use this part of USERMEM.
 * #define BITS      <n>	Maximum number of code bits.
 * #define MAXIO     <n>	Output buffer size (squeeze memory if needed)
 */

#include <stdio.h>
#include <ctype.h>
#include <setjmp.h>
#ifndef decus
# include <signal.h>
/*
 * Arguments to signal():
 */
extern int	abort();		/* Debugging interrupt trap	*/
extern int	interrupt();		/* Non-debugging interrupt trap	*/
extern int	address_error();	/* "Segment" violation		*/
#endif

#ifndef	TRUE
# define FALSE		0
# define TRUE		1
#endif
#ifndef	EOS
# define EOS		'\0'
#endif
#define	streq(a, b)	(strcmp((a), (b)) == 0)
#define min(a,b)	((a) > (b)) ? (b) : (a))

/*
 * Set USERMEM to the maximum amount of physical user memory available
 * in bytes.  USERMEM is used to determine the maximum BITS that can be used
 * for compression.
 *
 * SACREDMEM is the amount of physical memory saved for others; compress
 * will hog the rest.
 */

#ifndef SACREDMEM
# define SACREDMEM	0
#endif

/*
 * Set machine-specific parameters
 */

#ifdef vax
# ifdef unix
#  define vax_asm	TRUE		/* If asm() supported on vax	*/
# endif
# ifdef vms
#  define vms_asm	TRUE
# endif
#endif
#ifndef	vax_asm
# define vax_asm	FALSE
#endif
#ifndef vms_asm
# define vms_asm	FALSE
#endif

#ifdef pdp11
# define BITS	12	/* max bits/code for 16-bit machine		*/
# define USERMEM 0	/* Force no user memory				*/
# define UCHAR	FALSE	/* TRUE if compiler supports unsigned char	*/
# define MAXIO 512	/* Buffer size for PDP-11 I/O buffers		*/
#endif

/*
 * Set default values for some parameters.
 */

#ifndef DEBUG
# define DEBUG	FALSE
#endif

#ifdef interdata
# define SIGNED_COMPARE_SLOW TRUE
#endif
#ifndef SIGNED_COMPARE_SLOW
# define SIGNED_COMPARE_SLOW FALSE
#endif

#ifndef USERMEM
# define USERMEM 750000	/* default user memory				*/
#endif

#ifndef	UCHAR
# define UCHAR	TRUE	/* Compiler supports unsigned char		*/
#endif

#ifndef MAXIO
# define MAXIO	2048	/* I/O buffer size				*/
#endif

/*
 * Set derived tuning parameters.
 */

#ifndef USERMEM
# define USERMEM	 0
#endif
#if USERMEM >=			(433484 + SACREDMEM)
# define PBITS		16
#else
# if USERMEM >=			(229600 + SACREDMEM)
#  define PBITS		15
# else
#  if USERMEM >=		(127536 + SACREDMEM)
#   define PBITS	14
#   else
#    if USERMEM >=		( 73464 + SACREDMEM)
#     define PBITS	13
#    else			/* Smaller systems			*/
#     define PBITS	12
#    endif
#   endif
# endif
#endif

#ifndef BITS
# define BITS PBITS
#endif

#ifdef M_XENIX
# if BITS >= 16
#  define XENIX_16		/* Enable special vector access macros	*/
# else
#  if BITS > 13
#   undef BITS
#   define BITS 13		/* Code only handles BITS = 12, 13, 16	*/
#  endif
# endif
#endif

/*
 * HSIZE is the size of the hash lookup table.  It is set to
 * 1 << BITS + fudge factor, rounded up to a prime number.
 * If it is too big, the "clear the hash" routine will take
 * too long.  The same numbers are replicated in the getsize()
 * routine's data table.
 */

#if BITS == 16
# define HSIZE	69001		/* 95% occupancy			*/
#endif
#if BITS == 15
# define HSIZE	35023		/* 94% occupancy			*/
#endif
#if BITS == 14
# define HSIZE	18013		/* 91% occupancy			*/
#endif
#if BITS == 13
# define HSIZE	 9001		/* 91% occupancy			*/
#endif
#if BITS <= 12
# define HSIZE	 5003		/* 80% occupancy			*/
#endif

/*
 * typedef's -- somewhat machine specific.
 */

/*
 * a code_int must be able to hold 2**BITS values of type int, and also -1
 */
#if BITS > 15
typedef long int	code_int;
#else
typedef int		code_int;
#endif

/*
 * A count_int must hold ((2**BITS)-1) + (255<<BITS)) and -1.
 *
 * count_int's also hold counters.
 *
 * count_short's hold small counters (for the interdata)
 *
 * Some implementations don't support unsigned char (Decus C, for example)
 * Decus C is also brain damaged with regards to unsigned shorts.
 */
#if SIGNED_COMPARE_SLOW
typedef unsigned long int count_int;
typedef unsigned short int count_short;
#else
typedef long int	count_int;
#endif

#if UCHAR
typedef	unsigned char	char_type;
#else
typedef char		char_type;
#endif

#ifdef decus
typedef unsigned	U_short;
#define	readonly			/* Dummy out readonly modifier	*/
#else
typedef unsigned short	U_short;
#endif

#ifdef unix
#define	readonly
#endif

typedef short		flag;		/* Boolean flag or parameter	*/

/*
 * The following define the "magic cookie" header
 */
#define	HEAD1_MAGIC	0x1F
#define HEAD2_MAGIC	0x9D
#define	VMS_HEAD2_MAGIC	0x9E		/* vms-private output format	*/

/*
 * Defines for third byte of header
 */
#define BIT_MASK	0x1F		/* Gets NBITS in the code	*/
#define BLOCK_MASK	0x80		/* Gets block_compress flag	*/
#define	DIFF_MASK	0x40		/* Gets differential cmprs flag	*/
/*
 * Mask0x20 is free.  I think 0x20 should mean that there is
 * a fourth header byte (for expansion).
 */

/*
 * This is for backwards compatibilty with an old version of Unix compress.
 */
#ifdef COMPATIBLE			/* Compatible, but wrong!	*/
# define MAXCODE(n_bits)	(1 << (n_bits) - 1)
#else
# define MAXCODE(n_bits)	((1 << (n_bits)) - 1)
#endif

#define INIT_BITS 9			/* initial number of bits/code */

/*
 * One code could conceivably represent (1<<BITS) characters, but
 * to get a code of length N requires an input string of at least
 * N*(N-1)/2 characters.  With 5000 chars in the stack, an input
 * file would have to contain a 25Mb string of a single character.
 * This seems unlikely.
 */
#define MAXSTACK    8000		/* size of lzdcmp output stack	*/

#ifndef CHECK_GAP
# define CHECK_GAP 	10000		/* ratio check interval		*/
#endif

#ifndef __LINE__
# define NO__LINE__
#endif
#ifndef __FILE__
# define NO__LINE__
#endif
#if DEBUG
# define VERBOSE_DEFAULT    1
# ifndef NO__LINE__
#  define FAIL(why, status)				\
	fprintf(stderr, "\nfatal: %s (%s at %d)\n",	\
	    why, __FILE__, __LINE__); 			\
	longjmp(failure, status);
# else
#  define FAIL(why, status)				\
	fprintf(stderr, "\nfatal: %s\n", why); 		\
	longjmp(failure, status);
# endif
#else
# define VERBOSE_DEFAULT    0
# define FAIL(why, status)	longjmp(failure, status);
#endif

/*
 * Note -- for compatibility with Unix compress,
 * NBR_CHAR and LZ_CLEAR must equal 256.
 * Also, (1 << (MIN_BITS - 1) should equal or exceed NBR_CHR
 */
#define	NBR_CHAR      256		/* Number of input codes	*/
#define MIN_BITS	9		/* Smallest code is 9 bits	*/
#if ((1 << BITS) < NBR_CHAR) || (BITS < MIN_BITS)
    << Can't compile: not enough bits for the input character set size >>
#endif
#define	LZ_CLEAR	(NBR_CHAR)	/* Clear code			*/
#define	LZ_SOH		(LZ_CLEAR + 1)	/* Start of header block	*/
#define	LZ_STX		(LZ_SOH   + 1)	/* Start of text block		*/
#define	LZ_EOR		(LZ_STX   + 1)	/* End of text record		*/
#define	LZ_ETX		(LZ_EOR   + 1)	/* End of header/text block	*/
#define	LZ_FIRST	(LZ_ETX   + 1)	/* First user (data) code	*/

#ifdef	vms
#include		errno
#include		ssdef
#include		stsdef
#include		rms
#include		descrip
#ifndef	EXIT_SUCCESS
#define	EXIT_SUCCESS	(SS$_NORMAL | STS$M_INHIB_MSG)
#define	EXIT_FAILURE	(SS$_ABORT)
#endif
#define VMS_V4		L_cuserid >= 16		/* Enable new stuff	*/
#else
#define VMS_V4		0			/* Disable new stuff	*/
extern int		errno;
#ifdef decus
#define	errno		$$ferr
#endif
#endif

/*
 * Define exit() codes.
 */

#ifndef	EXIT_SUCCESS
#ifdef decus
#define	EXIT_SUCCESS	IO_SUCCESS
#define	EXIT_FAILURE	IO_ERROR
#else
#define	EXIT_SUCCESS	0			/* Normal exit		*/
#define	EXIT_FAILURE	1			/* Error exit		*/
#endif
#endif
#if EXIT_FAILURE == 0
  << error, EXIT_FAILURE must be non-zero for longjmp to work >>
#endif
#ifdef vms
#define	ERROR_EXIT	(errno)
#else
#define	ERROR_EXIT	EXIT_FAILURE
#endif

/*
 * Parameter values are converted to internal values (to simplify
 * processing of VMS DCL)
 */
#define EXPORT_VMS		0x0001
#define EXPORT_UNIX		0x0002
#define EXPORT_BLOCK		0x0004
#define	EXPORT_HEADER		0x0008
#define EXPORT_ENDMARKER	0x0010

#define	METHOD_LZ		0x0001

#define MODE_TEXT		0x0001
#define	MODE_BINARY		0x0002
#define	MODE_FIXED		0x0004
#define	MODE_DELTA		0x0008

#define	SHOW_STATISTICS		0x0001
#define	SHOW_PROGRESS		0x0002
#define	SHOW_FDL		0x0004
#define	SHOW_DEBUG		0x0008
#define SHOW_SERIOUS_DEBUG	0x0010
#define SHOW_IO_DEBUG		0x0020


/*
 * All I/O is done by way of "streams".  To establish a stream,
 * set the parameters appropriately and off you go.  The following
 * functions are provided:
 *	lz_fill(stream)		fills the buffer from stdin
 *	lz_flush(stream)	writes the buffer to stdout
 *	lz_eof(stream)		returns EOF (for fill from memory)
 *	lz_fail(stream)		abort (for writing to memory).
 *	lz_dummy(stream)	throw an output stream away.
 * Note: if VMS_V4 is enabled and the private (non-export) format
 * chosen, lz_fill and lz_flush access the files appropriately.
 * Stream elements are initialized as follows:
 *	Input:	bp = NULL;	bend = NULL;
 *	Output:	bp = bstart;	bend = bstart + bsize;
 */

typedef struct STREAM {
    char_type	*bp;		/* Next character to get/put		*/
    char_type	*bend;		/* -> end of stream buffer		*/
    char_type	*bstart;	/* Start of stream buffer		*/
    short	bsize;		/* Stream buffer size			*/
    int		(*func)();	/* Read/write a buffer function		*/
} STREAM;

/*
 * Note also that the compress routine uses putbuf(buf, count, outstream)
 * and the decompress routine uses getbuf(buf, count, instream) to (quickly)
 * transfer multiple bytes.
 */
#if UCHAR
#define	GET(s)		\
	(((s)->bp < (s)->bend) ? *(s)->bp++        : (*(s)->func)(s))
#else
#define	GET(s)		\
	(((s)->bp < (s)->bend) ? *(s)->bp++ & 0xFF : (*(s)->func)(s))
#endif
#define	PUT(c, s)	\
	((((s)->bp >= (s)->bend) ? (*(s)->func)(s) : 0), *(s)->bp++ = (c))

extern int lz_fill();
extern int lz_flush();
extern int lz_eof();
extern int lz_fail();
extern int lz_dummy();

#if DEBUG
extern readonly char *lz_names[];		/* "LZ_CLEAR" etc.	*/
#endif

/*
 * Options and globals.
 */
#if VMS_V4
#include devdef

#define	ATT_NAME	"vms$attributes "
#define	ATT_SIZE	15			/* strlen(ATT_NAME)	*/

typedef struct FDLSTUFF {
	struct	RAB	rab;		/* Record access buffer		*/
	struct	FAB	fab;		/* File access buffer		*/
	struct	NAM	nam;		/* File name buffer		*/
	struct	XABFHC	xabfhc;		/* Attributes (file header blk)	*/
	struct	XABSUM	xabsum;		/* Attributes (isam summary)	*/
	char		starname[NAM$C_MAXRSS + 1]; /* Wild file name	*/
	char		filename[NAM$C_MAXRSS + 1]; /* Open file name	*/
} FDLSTUFF;

extern int	fdl_status;	/* Error code from fdl library		*/
#endif

extern flag	export;		/* -x, /EXPORT=(...)			*/
extern flag	method;		/* LZ, of course			*/
extern flag	show;		/* -v  /SHOW=(...) Verbose logging	*/
extern flag	mode;		/* Binary and friends			*/
extern short	maxbits;	/* -b /BITS=<n>				*/
extern readonly flag is_compress; /* TRUE if compress, FALSE if decomp.	*/
extern char	*infilename;	/* For error printouts			*/
extern char	*outfilename;	/* For more error printouts		*/
extern short	n_bits;		/* Current # of bits in compressed file	*/
extern int	firstcode;	/* First value past signals		*/
extern jmp_buf	failure;	/* For longjmp() return			*/

-h- lzcomp.cld	Sat Mar 26 16:57:17 1988	USER1:[MINOW.PERSONAL.SOURCE.LZ]LZCOMP.CLD;35
!
! Command language description for COMPRESS
!

MODULE lz_dcl_table

DEFINE VERB		COMPRESS

PARAMETER P1,				! Input file
	LABEL=INPUT
	PROMPT="Input file",
	VALUE (REQUIRED, TYPE=$FILE)

PARAMETER P2,				! Output file
	LABEL=OUTPUT
	PROMPT="Output file",
	VALUE (REQUIRED, TYPE=$FILE)

QUALIFIER BITS,				! /BITS=<value>
	NONNEGATABLE,
	PLACEMENT=GLOBAL,
	VALUE(TYPE=$NUMBER)

QUALIFIER EXPORT,			! /EXPORT=(VMS UNIX BLOCK ENDMARKER)
	NONNEGATABLE,
	PLACEMENT=GLOBAL,
	VALUE(TYPE=EXPORT_KEYWORDS, LIST),
	DISALLOW (VMS AND UNIX)
	DISALLOW (BLOCK AND NEG HEADER)
	DISALLOW (ENDMARKER AND NEG BLOCK)
	DISALLOW (BLOCK AND NEG HEADER)
	DISALLOW (VMS AND NEG BLOCK)
	DISALLOW (VMS AND NEG HEADER)
	DISALLOW (VMS AND NEG ENDMARKER)

QUALIFIER METHOD,			! /METHOD=LZ
	NONNEGATABLE,
	PLACEMENT=GLOBAL,
	VALUE(TYPE=METHOD_KEYWORDS)

QUALIFIER SHOW,				! /SHOW=(PROGRESS, STATISTICS, DEBUG)
	NEGATABLE,
	PLACEMENT=GLOBAL,
	VALUE(TYPE=SHOW_KEYWORDS, LIST)

QUALIFIER MODE,				! /MODE=(DELTA)
	NONNEGATABLE,
	PLACEMENT=GLOBAL,
	VALUE(TYPE=MODE_KEYWORDS, LIST),

DEFINE TYPE EXPORT_KEYWORDS
	KEYWORD VMS, DEFAULT
	KEYWORD UNIX,
	KEYWORD BLOCK, NEGATABLE
	KEYWORD HEADER, NEGATABLE
	KEYWORD ENDMARKER, NEGATABLE

DEFINE TYPE METHOD_KEYWORDS
	KEYWORD	LZW, DEFAULT

DEFINE TYPE MODE_KEYWORDS
	KEYWORD BINARY
	KEYWORD DELTA

DEFINE TYPE SHOW_KEYWORDS
	KEYWORD PROGRESS, NEGATABLE
	KEYWORD STATISTICS, NEGATABLE
	KEYWORD FDL, NEGATABLE
	KEYWORD DEBUG, NEGATABLE
	KEYWORD DEBUG_SERIOUS, NEGATABLE
	KEYWORD DEBUG_IO, NEGATABLE
	KEYWORD ALL			! Actually, all but debug
-h- lzdcmp.cld	Sat Mar 26 16:57:17 1988	USER1:[MINOW.PERSONAL.SOURCE.LZ]LZDCMP.CLD;6
!
! Command language description for DECOMPRESS
!

MODULE lz_dcl_table

DEFINE VERB		DECOMPRESS

PARAMETER P1,				! Input file
	LABEL=INPUT
	PROMPT="Input file",
	VALUE (REQUIRED, TYPE=$FILE)

PARAMETER P2,				! Output file
	LABEL=OUTPUT
	PROMPT="Output file",
	VALUE (TYPE=$FILE)

QUALIFIER BITS,				! /BITS=<value>
	NONNEGATABLE,
	PLACEMENT=GLOBAL,
	VALUE(TYPE=$NUMBER)

QUALIFIER EXPORT,			! /EXPORT=(VMS UNIX BLOCK ENDMARKER)
	NONNEGATABLE,			! Only /EXPORT=(UNIX, NOHEADER)
	PLACEMENT=GLOBAL,		! is meaningful.
	VALUE(TYPE=EXPORT_KEYWORDS, LIST),
	DISALLOW (VMS AND UNIX)
	DISALLOW (BLOCK AND NEG HEADER)
	DISALLOW (VMS AND NEG BLOCK)
	DISALLOW (VMS AND NEG HEADER)
	DISALLOW (VMS AND NEG ENDMARKER)

QUALIFIER METHOD,			! /METHOD=LZ
	NONNEGATABLE,
	PLACEMENT=GLOBAL,
	VALUE(TYPE=METHOD_KEYWORDS)

QUALIFIER SHOW,				! /SHOW=(PROGRESS, STATISTICS, DEBUG)
	NEGATABLE,
	PLACEMENT=GLOBAL,
	VALUE(TYPE=SHOW_KEYWORDS, LIST)

QUALIFIER MODE,				! /MODE=(TEXT | BINARY | FIXED | DELTA)
	NONNEGATABLE,
	PLACEMENT=GLOBAL,
	VALUE(TYPE=MODE_KEYWORDS, LIST),
	DISALLOW ANY2(TEXT, BINARY, FIXED)

DEFINE TYPE EXPORT_KEYWORDS
	KEYWORD VMS, DEFAULT
	KEYWORD UNIX,
	KEYWORD BLOCK, NEGATABLE
	KEYWORD HEADER, NEGATABLE
	KEYWORD ENDMARKER, NEGATABLE

DEFINE TYPE METHOD_KEYWORDS
	KEYWORD	LZ, DEFAULT

DEFINE TYPE MODE_KEYWORDS
	KEYWORD	TEXT, DEFAULT
	KEYWORD BINARY,
	KEYWORD FIXED,
	KEYWORD DELTA

DEFINE TYPE SHOW_KEYWORDS
	KEYWORD PROGRESS, NEGATABLE
	KEYWORD STATISTICS, NEGATABLE
	KEYWORD FDL, NEGATABLE
	KEYWORD DEBUG, NEGATABLE
	KEYWORD DEBUG_SERIOUS, NEGATABLE
	KEYWORD DEBUG_IO, NEGATABLE
	KEYWORD ALL			! Actually, all but debug
-h- lzdcl.c	Sat Mar 26 16:57:17 1988	USER1:[MINOW.PERSONAL.SOURCE.LZ]LZDCL.C;25
/*
 * DCL parser for lz... stuff (swings both ways!)
 */
#include "lz.h"
#include climsgdef
#define	DYNAMIC_STRING(name)			\
    struct dsc$descriptor_d name = {		\
	0, DSC$K_DTYPE_T, DSC$K_CLASS_D, NULL	\
    }

typedef struct {
	char		*key;		/* Option name			*/
	flag		bit;		/* Sets this bit		*/
} KEYWORD;

static char		errname[257];	/* Error text stored here	*/
static $DESCRIPTOR(err, errname);	/* descriptor for error text	*/

extern char	*vms_etext();

static DYNAMIC_STRING(command_line);
static DYNAMIC_STRING(cli_command);
static DYNAMIC_STRING(cli_prompt);
static DYNAMIC_STRING(result);		/* cli_getvalue result datum	*/
static $DESCRIPTOR(prompt_compress, "Compress: ");
static $DESCRIPTOR(prompt_decompress, "Decompress: ");

globalref int		*lz_dcl_table;	/* Different table for cmp/dcmp	*/
extern int		lib$get_input();
char			*cli_savevalue();

/*
 * Note: these tables are inclusive (for both lzcomp and lzdcmp).
 * The code thus must accept "missing" element errors.
 */

KEYWORD	key_export[] = {
 { "VMS",		EXPORT_VMS		},
 { "UNIX",		EXPORT_UNIX		},
 { "BLOCK",		EXPORT_BLOCK		},
 { "HEADER",		EXPORT_HEADER		},
 { "ENDMARKER",		EXPORT_ENDMARKER	},
 { NULL,		0x0000			}
};

KEYWORD key_method[] = {
 { "LZW",		METHOD_LZ		},
 { NULL,		0x0000			}
};

KEYWORD key_mode[] = {
 { "TEXT",		MODE_TEXT		},
 { "BINARY",		MODE_BINARY		},
 { "FIXED",		MODE_FIXED		},
 { "DELTA",		MODE_DELTA		},
 { NULL,		0x0000			}
};

KEYWORD key_show[] = {
 { "ALL",		SHOW_PROGRESS | SHOW_STATISTICS	 | SHOW_FDL },
 { "PROGRESS",		SHOW_PROGRESS		},
 { "STATISTICS",	SHOW_STATISTICS		},
 { "FDL",		SHOW_FDL		},
 { "DEBUG",		SHOW_DEBUG		},
 { "DEBUG_SERIOUS",	SHOW_SERIOUS_DEBUG	},
 { "DEBUG_IO",		SHOW_IO_DEBUG		},
 { NULL,		0x0000			}
};

int
lzdcl(argc, argv)
int		argc;
char		*argv[];
{
	register int		i;
	register int		status;
	struct dsc$descriptor_s	temp;
	extern int		ignore_dcl_error();

#if 0
	for (i = 1; i < argc; i++) {
	    printf("%2d: %s\n", i, argv[i]);
	}
#endif
	descriptor(&temp, (is_compress) ? "COMPRESS " : "DECOMPRESS ");
	if (argc <= 1) {
	    status = lib$get_foreign(	/* Read the command line	*/
		&command_line,
		(is_compress) ? &prompt_compress : &prompt_decompress);
	    if (status == RMS$_EOF)
		exit(status);
	    else if (status != SS$_NORMAL)
		lib$stop(status);
	    str$concat(&cli_prompt, &temp, &command_line);
	}
	else {
	    for (i = 1; i < argc; i++) {
		str$append(&cli_command, &temp);
		descriptor(&temp, argv[i]);
		str$append(&cli_command, &temp);
		descriptor(&temp, " ");
	    }
	}
#if 0
	printf("command: \"%.*s\"\n",
	    cli_command.dsc$w_length, cli_command.dsc$a_pointer);
#endif
	VAXC$ESTABLISH(ignore_dcl_error);
	status = cli$dcl_parse(		/* Parse the DCL		*/
		&cli_command,		/* Input from lib$get_foreign	*/
		&lz_dcl_table,		/* Parsing table		*/
		&lib$get_input,	    	/* Gets a required parameter	*/
		&lib$get_input,	    	/* Gets a continuation prompt	*/
		&cli_prompt);
#if 0
	printf("cli$dcl_parse returns %s\n", vms_etext(status));
#endif
	if ((status & STS$M_SUCCESS) != 0) {
	    /*
	     * Process all arguments
	     */
	    infilename = cli_savevalue("INPUT");
	    if (cli_present("OUTPUT") == CLI$_PRESENT)
		outfilename = cli_savevalue("OUTPUT");
	    if (cli_present("BITS") == CLI$_PRESENT) {
		register int		i;
		register int		c;

		cli_getvalue("BITS");
		for (maxbits = 0, i = 0; i < result.dsc$w_length; i++) {
		    c = result.dsc$a_pointer[i];
		    if (!isdigit(c))
			goto nogood_bits;
		    maxbits = (maxbits * 10) + (c - '0');
		}
		if (maxbits < MIN_BITS) {
nogood_bits:	    fprintf(stderr, "Illegal bits value \"%.*s\"\n",
			result.dsc$w_length, result.dsc$a_pointer);
		    lib$signal(CLI$_IVVALU);
		}
	    }
	    cli_list("METHOD", &method, key_method);
	    cli_list("EXPORT", &export, key_export);
	    if ((export & EXPORT_UNIX) != 0)
		export &= ~EXPORT_VMS;
	    cli_list("MODE",   &mode,   key_mode);
	    cli_list("SHOW",   &show,   key_show);
	    status = SS$_NORMAL;
	}
	str$free1_dx(&command_line);
	str$free1_dx(&cli_command);
	str$free1_dx(&cli_prompt);
	str$free1_dx(&result);
	return (status);
}

cli_list(what, flag_word, keytable)
char			*what;
flag			*flag_word;
KEYWORD			*keytable;
{
	register int		key_status;
	register int		status;
	register KEYWORD	*kp;

	switch(cli_present(what)) {
	case CLI$_NEGATED:
#if 0
	    printf("found %s (negated)\n", what);
#endif
	    *flag_word = 0;
	    break;

	case CLI$_PRESENT:
	    for (kp = keytable; kp->key != NULL; kp++) {
		key_status = cli_present(kp->key);
		switch (key_status) {
		case CLI$_PRESENT:
		    *flag_word |= kp->bit;
#if 0
		    printf("found %s %s\n", what, kp->key);
#endif
		    break;

		case CLI$_NEGATED:
		    *flag_word &= ~kp->bit;
#if 0
		    printf("found %s %s (negated)\n", what, kp->key);
#endif
		    break;
		}
	    }
	    break;

	default:
	    break;
	}
}

int
cli_present(what)
char		*what;
/*
 * TRUE if the argument is present in the command line
 */
{
	struct dsc$descriptor_s	parm;

	descriptor(&parm, what);
	return(cli$present(&parm));
}

descriptor(descr, what)
register struct dsc$descriptor_s	*descr;
char					*what;
/*
 * Turn a C string into a (static) descriptor.
 */
{
	descr->dsc$w_length = strlen(what);
	descr->dsc$b_class = DSC$K_CLASS_S;
	descr->dsc$b_dtype = DSC$K_DTYPE_T;
	descr->dsc$a_pointer = what;
}

int
cli_getvalue(what)
char		*what;
/*
 * Get the value (storing it in result).  Return the status.
 * Note the following (successful) statuses:
 *	CLI$_COMMA		Another entry (in the list) may be read
 *	SS$_NORMAL		The last -- or only -- value.
 * A non-successful status is signaled.
 */
{
	struct dsc$descriptor_s	parm;
	int			status;

	descriptor(&parm, what);
	if (((status = cli$get_value(&parm, &result)) & STS$M_SUCCESS) == 0)
	    lib$signal(status);
	return (status);
}


char *
cli_savevalue(what)
char		*what;
/*
 * Find the value and store it as a C string in malloc'ed memory.
 * Return NULL on errors (which should not happen).
 */
{
	register char		*string;

	if ((cli_getvalue(what) & STS$M_SUCCESS) == 0)
	    return (NULL);
	else {
	    string = malloc(result.dsc$w_length + 1);
	    strncpy(string, result.dsc$a_pointer, result.dsc$w_length);
	    return (string);
	}
}

dumpoptions()
/*
 * Debug: dump all option values.
 */
{
	fprintf(stderr, "(Debug) Option dump, bits = %d\n", maxbits);
	fprintf(stderr, "Input file: %s\n",
	    (infilename == NULL) ? "<unspecified>" : infilename);
	fprintf(stderr, "Output filename: %s\n",
	    (outfilename == NULL) ? "<unspecified>" : outfilename);
	option_dump("METHOD", method, key_method);
	option_dump("EXPORT", export, key_export);
	option_dump("MODE",   mode,   key_mode);
	option_dump("SHOW",   show,   key_show);
}

option_dump(what, flag_word, keytable)
char			*what;
flag			flag_word;
KEYWORD			*keytable;
{
	register KEYWORD	*kp;
	register int		first;

	for (first = TRUE, kp = keytable; kp->key != NULL; kp++) {
	    if ((flag_word & kp->bit) == kp->bit) {
		if (first) {
		    fprintf(stderr, " %s=(%s", what, kp->key);
		    first = FALSE;
		}
		else {
		    fprintf(stderr, ", %s", kp->key);
		}
	    }
	}
	if (first)
	    fprintf(stderr, " %s -- no options specified.\n", what);
	else {
	    fprintf(stderr, ")\n");
	}
}

#if 0
/*
 * This is in lzvio.c, too.
 */
char *
vms_etext(errorcode)
int		errorcode;
{
	char		*bp;
	short		errlen;		/* Actual text length		*/

	lib$sys_getmsg(&errorcode, &errlen, &err, &15);
	/*
	 * Trim trailing junk.
	 */
	for (bp = &errname[errlen]; --bp >= errname;) {
	    if (isgraph(*bp) && *bp != ' ')
		break;
	}
	bp[1] = EOS;
	return(errname);
}
#endif

#define	CODE(v)	((v) & STS$M_CODE)

ignore_dcl_error(signal_arg, mech_arg)
long int	signal_arg[];
long int	mech_arg[];
/*
 * VMS exception handler.  Needs extension to handle "all" errors.
 */
{
	switch (CODE(signal_arg[1])) {
	case CODE(SS$_UNWIND):			/* Currently unwinding	*/
	    return;

	case CODE(SS$_CONTROLC):		/* CTRL/C trap		*/
	case CODE(SS$_ACCVIO):
	case CODE(SS$_ROPRAND):
	    lib$stop(signal_arg[1]);
	    break;

	default:
	    sys$putmsg(signal_arg);
	    break;
	}
	return;
}
-h- lzio.c	Sat Mar 26 16:57:17 1988	USER1:[MINOW.PERSONAL.SOURCE.LZ]LZIO.C;26
/*
 *			l z i o . c
 *
 * I/O buffer management.  All input/output I/O is done through these
 * routines (and the macros in lz.h).  The rules of the game are:
 *
 * input via GET() and getbuf().
 *	GET returns an 8-bit byte, or -1 on eof/error.
 *	getbuf() returns the number of things gotten, or -1 on eof/error.
 *	No return on error: longjmp's to the main-line.
 *
 * output via PUT() and lz_putbuf().
 *	No return on error: longjmp's to the main-line.
 * flush output by lz_flush() before closing files -- or you'll lose data.
 */

/*LINTLIBRARY*/

#include	"lz.h"
#if VMS_V4
#include	<rmsdef.h>
#ifndef FDLSTUFF
#define FDLSTUFF char
#endif
extern FDLSTUFF *fdl_input;
extern FDLSTUFF *fdl_output;
extern int	fdl_status;
#endif

int
lz_fill(s)
register STREAM		*s;
{
	register int	i;
	extern char	*infilename;

#if VMS_V4
	if ((export & EXPORT_VMS) == 0) {
	    i = fread((char *) s->bstart, 1, s->bsize, stdin);
	    if (ferror(stdin)) {
		perror(infilename);
		FAIL("compress (export) read error", ERROR_EXIT);
	    }
	}
	else {			/* Decompress and export/private	*/
	    i = fdl_read(s->bstart, s->bsize, fdl_input);
	    if (i < 0
	     && fdl_status != RMS$_EOF)
		fdl_message(fdl_input, "Read error");
	}
#else
#ifdef unix
	i = read(fileno(stdin), (char *) s->bstart, s->bsize);
	if (i < 0) {
	    perror(infilename);
	    FAIL("read error", ERROR_EXIT);
	}
#else
	i = fread((char *) s->bstart, 1, s->bsize, stdin);
	if (ferror(stdin)) {
	    perror(infilename);
	    FAIL("read error", ERROR_EXIT);
	}
#endif
#endif
	if (i <= 0)
	    return (EOF);
	else {
	    s->bp = s->bstart;
	    s->bend = &s->bstart[i];
#if UCHAR
	    return (*s->bp++);
#else
	    return (*s->bp++ & 0xFF);
#endif
	}
}

lz_flush(s)
register STREAM	*s;
{
	register int	count;
	extern char	*outfilename;

	count = s->bp - s->bstart;
#if DEBUG
	if (!is_compress
	 && (show & SHOW_IO_DEBUG) != 0) {
	    fprintf(stderr, "lz_flush %d:  ", count);
	    dumptext(s->bstart, count, stderr);
	}
#endif
#if VMS_V4
	if ((export & EXPORT_VMS) == 0) {
	    if (is_compress)
		fwrite((char *) s->bstart, count, 1, stdout);
	    else {
		register char *bp, *bend;

		for (bp = s->bstart, bend = bp + count; bp < bend; bp++)
		    putchar(*bp);
	    }
	    if (ferror(stdout)) {
		perror(outfilename);
		FAIL("write error", ERROR_EXIT);
	    }
	}
	else {
	    if (fdl_write((char *) s->bstart, count, fdl_output) == -1) {
		fdl_message(fdl_output, "Write error");
		FAIL("write (fdl) error", ERROR_EXIT);
	    }
	}
#else
#ifdef unix
	if (write(fileno(stdout), (char *) s->bstart, count) != count) {
	    perror(outfilename);
	    FAIL("write error", ERROR_EXIT);
	}
#else
	fwrite((char *) s->bstart, 1, count, stdout);
	if (ferror(stdout)) {
	    perror(outfilename);
	    FAIL("write error", ERROR_EXIT);
	}
#endif
#endif
	s->bp = s->bstart;
}

int
lz_getbuf(buffer, count, s)
char_type		*buffer;
int			count;
register STREAM		*s;
/*
 * Read a block of data -- be clever.  Return number gotten, or -1
 * on eof.
 */
{
	register char_type	*bp;		/* -> buffer		*/
	register char_type	*ip;		/* -> I/O buffer	*/
	register char_type	*ep;		/* End of segment	*/
	register int		remaining;	/* Size of segment	*/
	int			datum;

	if (count == 0)				/* Shouldn't happen	*/
	    return (0);
	bp = buffer;
	while (--count >= 0) {
	    if ((datum = GET(s)) == EOF)	/* Maybe fill LZ buff	*/
		break;
	    *bp++ = datum;
	    remaining = s->bend - (ip = s->bp);
	    if (remaining > count)
		remaining = count;
	    ep = &ip[remaining];
	    while (ip < ep)
		*bp++ = *ip++;
	    count -= remaining;
	    s->bp = ip;				/* Refresh buffer	*/
	}
	return ((bp == buffer) ? -1 : bp - buffer);
}

int
lz_putbuf(bp, count, s)
register char_type	*bp;
int			count;
register STREAM		*s;
/*
 * Write a block of data -- be clever.
 */
{
	register char_type	*op;		/* -> I/O buffer	*/
	register char_type	*ep;		/* End of segment	*/
	register int		remaining;	/* Size of segment	*/

	while (--count >= 0) {
	    PUT(*bp++, s);			/* Forces a buffer	*/
	    remaining = s->bend - (op = s->bp);
	    if (remaining > count)
		remaining = count;
	    ep = &op[remaining];
	    while (op < ep)
		*op++ = *bp++;
	    count -= remaining;
	    s->bp = op;				/* Refresh buffer	*/
	}
}

/*ARGUSED*/
int
lz_eof(s)
STREAM		*s;
/*
 * Dummy routine for read from memory -- returns EOF.
 */
{
#ifdef decus
	return (s, EOF);
#else
	return (EOF);
#endif
}

int
lz_fail(s)
STREAM		*s;
/*
 * Dummy routine for write to memory -- called if buffer fills.
 */
{
	fprintf(stderr, "Memory buffer [%d bytes] filled -- fatal.\n",
		s->bsize);
	FAIL("crash (lz_fail)", EXIT_FAILURE);
}

int
lz_dummy(s)
STREAM		*s;
/*
 * Dummy routine for write to memory -- writes to the bit-bucket.
 */
{
	s->bp = s->bstart;
}

#ifndef decus
/*
 * Signal error handlers.
 */
#ifdef vms
#define unlink	delete
#endif

interrupt()
{
	if (outfilename != NULL
	 && !streq(outfilename, "<stdout>"))
	    unlink(outfilename);
	exit(EXIT_FAILURE);
}

address_error()
{
	if (!is_compress)
	    fprintf(stderr, "Decompress: corrupt input file\n");
	else {
	    fprintf(stderr, "fatal address error\n");
	}
#ifdef vms
	lib$signal(SS$_ACCVIO);
#else
	interrupt();
#endif
}
#endif

/*
 * getredirection() is intended to aid in porting C programs
 * to VMS (Vax-11 C) which does not support '>' and '<'
 * I/O redirection.  With suitable modification, it may
 * useful for other portability problems as well.
 */

#ifdef	vms

int
getredirection(argc, argv)
int		argc;
char		**argv;
/*
 * Process vms redirection arg's.  Exit if any error is seen.
 * If getredirection() processes an argument, it is erased
 * from the vector.  getredirection() returns a new argc value.
 *
 * Warning: do not try to simplify the code for vms.  The code
 * presupposes that getredirection() is called before any data is
 * read from stdin or written to stdout.
 *
 * Normal usage is as follows:
 *
 *	main(argc, argv)
 *	int		argc;
 *	char		*argv[];
 *	{
 *		argc = getredirection(argc, argv);
 *	}
 */
{
	register char		*ap;	/* Argument pointer	*/
	int			i;	/* argv[] index		*/
	int			j;	/* Output index		*/
	int			file;	/* File_descriptor 	*/

	for (j = i = 1; i < argc; i++) {   /* Do all arguments	*/
	    switch (*(ap = argv[i])) {
	    case '<':			/* <file		*/
		if (freopen(++ap, "r", stdin) == NULL) {
		    perror(ap);		/* Can't find file	*/
		    exit(ERROR_EXIT);	/* Is a fatal error	*/
		}
		break;

	    case '>':			/* >file or >>file	*/
		if (*++ap == '>') {	/* >>file		*/
		    /*
		     * If the file exists, and is writable by us,
		     * call freopen to append to the file (using the
		     * file's current attributes).  Otherwise, create
		     * a new file with "vanilla" attributes as if
		     * the argument was given as ">filename".
		     * access(name, 2) is TRUE if we can write on
		     * the specified file.
		     */
		    if (access(++ap, 2) == 0) {
			if (freopen(ap, "a", stdout) != NULL)
			    break;	/* Exit case statement	*/
			perror(ap);	/* Error, can't append	*/
			exit(ERROR_EXIT); /* After access test	*/
		    }			/* If file accessable	*/
		}
		/*
		 * On vms, we want to create the file using "standard"
		 * record attributes.  create(...) creates the file
		 * using the caller's default protection mask and
		 * "variable length, implied carriage return"
		 * attributes. dup2() associates the file with stdout.
		 */
		if ((file = creat(ap, 0, "rat=cr", "rfm=var")) == -1
		 || dup2(file, fileno(stdout)) == -1) {
		    perror(ap);		/* Can't create file	*/
		    exit(ERROR_EXIT);	/* is a fatal error	*/
		}			/* If '>' creation	*/
		break;			/* Exit case test	*/

	    default:
		argv[j++] = ap;		/* Not a redirector	*/
		break;			/* Exit case test	*/
	    }
	}				/* For all arguments	*/
	argv[j] = NULL;			/* Terminate argv[]	*/
	return (j);			/* Return new argc	*/
}
#endif

#if 1 || DEBUG

int		col;

readonly char *lz_names[] = {
    "LZ_CLEAR", "LZ_SOH", "LZ_STX", "LZ_EOR", "LZ_ETX", "???"
};

dumphex(buffer, count, fd)
register char_type	*buffer;
register int		count;
FILE			*fd;
{
	if (col > 0) {
	    putc('\n', fd);
	    col = 0;
	}
	fprintf(fd, "%2d:", count);
	while (--count >= 0) {
	    fprintf(fd, " %02x", (int) (*buffer++ & 0xFF));
	}
	fprintf(fd, "\n");
}

dumptext(buffer, count, fd)
register char_type	*buffer;
int			count;
FILE			*fd;
{
	extern char	*dumpchar();

	putc('"', fd);
	while (--count >= 0)
	    fputs(dumpchar((int) *buffer++), fd);
	fputs("\"\n", fd);
}

char *
dumpchar(c)
register int	c;
/*
 * Make a character printable.  Returns a static pointer.
 */
{
	static char	dump_buffer[8];

	c &= 0xFF;
	if (isascii(c) && isprint(c)) {
	    dump_buffer[0] = c;
	    dump_buffer[1] = EOS;
	}
	else {
	    switch (c) {
	    case '\n':	return ("<LF>");
	    case '\t':	return ("<TAB>");
	    case '\b':	return ("<BS>");
	    case '\f':	return ("<FF>");
	    case '\r':	return ("<CR>");
	    }
	    sprintf(dump_buffer, "<x%02x>", c);
	}
	return (dump_buffer);
}
#endif

/*
 * Cputime returns the elapsed process time (where available) in msec.
 * Note: Unix doesn't seem to have a good way to determine ticks/sec.
 */

#ifdef	decus
#include	<timeb.h>

long
cputime()
{
	struct timeb		buf;
	static struct timeb	origin;
	long			result;
	int			msec;

	if (origin.time == 0)
	    ftime(&origin);
	ftime(&buf);
	result = (buf.time - origin.time) * 1000;
	msec = ((int) buf.millitm) - ((int) origin.millitm);
	return (result + ((long) msec));
}
#else
#ifdef vms
#include	<types.h>
struct tms {
	time_t	tms_utime;
	time_t	tms_stime;
	time_t	tms_uchild;	/* forgot the */
	time_t	tms_uchildsys;	/* real names */
};
#define HERTZ	100.0				/* 10 msec units	*/
#else
#include	<sys/types.h>
#include	<sys/times.h>
#ifndef HERTZ
#define HERTZ	60.0				/* Change for Europe	*/
#endif
#endif

long
cputime()
{
	struct tms	tms;
	double		temp;
	long		result;

	times(&tms);
	result = tms.tms_utime + tms.tms_stime;
	temp = result * 1000.0 / HERTZ;		/* Time in msec.	*/
	result = temp;
	return (result);
}
#endif

-h- lzvio.c	Sat Mar 26 16:57:17 1988	USER1:[MINOW.PERSONAL.SOURCE.LZ]LZVIO.C;97
/*
 *			l z v i o . c
 * For VMS V4 only.
 */

/*
 * Problems:
 *	If you open a second input file (getting rms attributes)
 *	it aborts with an internal "fatal" error (15820C LIB-F-FATERRLIB)
 */
 
/*
 * Make TESTING_FDLIO non-zero to enable test code.
 *
 * Edit History
 * 26-Dec-85	MM	Create files with "large" allocation quantity
 *			to improve processing speed.
 * 18-Apr-86	Hein	Don't set xrb_lrl if the file isn't sequential.
 *  2-Jun-87	MM	fdl$generate needs a dynamic string
 */
#ifndef	TESTING_FDLIO
#define	TESTING_FDLIO	0
#endif

/*
 * RMS/FDL record level i/o routines for Vax-11 C V4 or greater only.
 * Rather crude.
 *
 * The following are provided:
 *
 *	#define	FDLSTUFF	char
 *	#include descrip
 *
 *	FDLSTUFF *
 *	fdl_open(filename, fdl_descriptor)
 *	char			*filename;
 *	struct	dsc$descriptor	*fdl_descriptor;
 *		Initializes internal buffers and opens this existing
 *		file for input.  The filename may not contain wildcards.
 *		On (successful) return, fdl_descriptor will point to
 *		an initialized fdl specification.  The description
 *		string will be in malloc'ed memory.  The caller does not
 *		initialize the fdl_descriptor.  Returns NULL on error.
 *		(Note an error will be returned if the file is not
 *		block-oriented.)
 *
 *		When you don't need the fdl_descriptor information
 *		any more, free it by calling
 *		    fdl_free(fdl_descriptor);
 *		if fdl_descriptor is NULL on entry, the file is opened
 *		normally (fdl information is not collected).
 *
 *	FDLSTUFF *
 *	fdl_create(fdl_descriptor, override_filename, xab_lrl)
 *	struct	dsc$descriptor	*fdl_descriptor;
 *	char			*override_filename;
 *	int			xab_lrl;
 *		Creates a file using the fdl specification.
 *		If override_filename is not NULL and not equal to "",
 *		it will override the filename specified in the fdl.
 *		fdl_write() is used to write data to the file.
 *		Returns NULL on error.
 *
 *		if fdl_descriptor is NULL, the file is created using
 *		the name in override_filename (which must be present).
 *		The file is created in "undefined" record format.
 *
 *		xab_lrl initializes the XAB$W_LRL field.
 *
 *	fdl_free(fdl_descriptor)
 *	struct	dsc$descriptor	*fdl_descriptor;
 *		Releases the fdl descriptor block.
 *
 *	int
 *	fdl_read(buffer, buffer_length, r)
 *	char		*buffer;
 *	int		buffer_length;
 *	FDLSTUFF	*r;
 *		Read buffer_length bytes from the file (using SYS$READ).
 *		No expansion or interpretation.  buffer_length had
 *		better be even or you're asking for trouble.  Returns
 *		the actual number of bytes read.  The file has been
 *		opened by fdl_open.
 *
 *	int
 *	fdl_write(buffer, buffer_length, r)
 *	char		*buffer;
 *	int		buffer_length;
 *	FDLSTUFF	*r;
 *		Write buffer_length bytes to the file (using SYS$WRITE).
 *		No expansion or interpretation.  buffer_length had
 *		better be even or you're asking for trouble.  Returns
 *		the actual number of bytes written.  The file was opened
 *		by fdl_create();
 *
 *	fdl_getname(r, buffer)
 *	FDLSTUFF	*r;
 *	char		*buffer;
 *		Copies the currently open file's name to the caller's
 *		data buffer buffer.
 *
 *	long
 *	fdl_fsize(r)
 *		Returns the size in bytes of the opened file.
 *
 *	fdl_dump(fdl_descriptor, fd)
 *	struct	dsc$descriptor	*fdl_descriptor;
 *	FILE			*fd;
 *		Writes the fdl info to the indicated file with
 *		line breaks in appropriate places.
 *
 *	fdl_message(r, why)
 *	FDLSTUFF	*r;
 *	char		*why;
 *		All system-level routines set a global value, fdl_status.
 *		fdl_message() prints the error message text corresponding
 *		to the current value of fdl_status.  The message printed
 *		has the format:
 *			why current_filename: error_message.
 *		If why is NULL, only the error_message is printed.
 */

#include "lz.h"
#if VMS_V4
#ifndef	FDL$M_FDL_SIGNAL
#define FDL$M_FDL_SIGNAL	1	/* Signal errors if set		*/
#endif
#ifndef	FDL$M_FDL_STRING
#define FDL$M_FDL_STRING	2	/* Use string for fdl text	*/
#endif
#if TESTING_FDLIO
#define	SIGNAL_ON_ERROR	FDL$M_FDL_SIGNAL
#else
#define	SIGNAL_ON_ERROR	0
#endif
#define MSG(what, code)	\
	fprintf(stderr, "Unexpected error at %s, code %X:\n\"%s\"\n", \
	what, code, vms_etext(code));

int		fdl_status;		/* Set to last rms call status	*/

static char *
vms_etext(errorcode)
int		errorcode;
{
	char		*bp;
	short		errlen;		/* Actual text length		*/
	static char	errname[257];	/* Error text stored here	*/
	static $DESCRIPTOR(err, errname); /* descriptor for error text	*/


	lib$sys_getmsg(&errorcode, &errlen, &err, &15);
	/*
	 * Trim trailing junk.
	 */
	for (bp = &errname[errlen]; --bp >= errname;) {
	    if (isgraph(*bp) && *bp != ' ')
		break;
	}
	bp[1] = EOS;
	return(errname);
}

static FDLSTUFF *
fail(r, why, name)
FDLSTUFF	*r;			/* Buffer			*/
char		*why;			/* A little commentary		*/
char		*name;			/* Argument to perror		*/
/*
 * Problem exit routine
 */
{
	if (name == NULL
	 && r != NULL)
	    name = r->fab.fab$l_fna;
	if (name == NULL)
	    name = "<unknown file name>";
	if ($VMS_STATUS_SUCCESS(fdl_status)) {
	    fprintf(stderr, "%s: restriction -- %s\n", name, why);
	    fdl_status = SS$_ABORT;	/* Force an error status	*/
	}
	else {
	    message(r, why, name);
	}
	freefdlstuff(r);
	return (NULL);
}

FDLSTUFF *
fdl_open(filename,  fdl_descriptor)
char			*filename;		/* What to open		*/
struct	dsc$descriptor	*fdl_descriptor;	/* Result descriptor	*/
/*
 * Open the file.  Returns NULL on failure, else a pointer to RMS stuff.
 * Which is equivalently a pointer to the RAB. (Note that the RAB points
 * in turn to the FAB.)
 *
 * Return the file's fdl descriptor in the user-supplied (uninitialized)
 * descriptor.
 */
{
	register FDLSTUFF	*r;
	extern FDLSTUFF		*fdl_setup();

	if ((r = fdl_setup(filename)) == NULL)
	    return (NULL);
	/*
	 * Now open the file.
	 */
	r->fab.fab$b_fac = FAB$M_GET | FAB$M_BRO;
	if ((fdl_status = sys$open(&r->fab)) != RMS$_NORMAL) {
	    return (fail(r, "opening file", NULL));
	}
	if ((r->fab.fab$l_dev & DEV$M_REC) != 0) {
	    fail(r, "can't read from record only device", NULL);
	    fdl_close(r);
	    return (NULL);
	}
	if (r->fab.fab$b_org == FAB$C_IDX) {
	    /*
	     * (Much) more hacking for indexed-sequential
	     * to get all the key and allocation blocks.
	     */
	    int			i, nall, nkey;
	    char		**chain;	/* Links xab's together	*/
	    struct myxabkey {
		struct XABKEY	xabkey;		/* The xab		*/
		char		keyname[32];	/* Optional key name	*/
	    }			*key;
	    struct XABALL	*all;

	    nall = r->xabsum.xab$b_noa;	/* Allocation control blocks	*/
	    nkey = r->xabsum.xab$b_nok;	/* Isam keys			*/
	    fdl_close(r);		/* Close it to try again	*/
	    if ((r = fdl_setup(filename)) == NULL)
		return (NULL);
	    chain = &r->xabsum.xab$l_nxt;	/* Start xab block list	*/
	    for (i = 0; i < nkey; i++) {
		key = malloc(sizeof (struct myxabkey));
		key->xabkey = cc$rms_xabkey;
		key->xabkey.xab$b_ref = i;	/* Set key ref number	*/
	 	key->xabkey.xab$l_knm = &key->keyname[0];
		*chain = key;
		chain = &key->xabkey.xab$l_nxt;
	    }
	    for (i = 0; i < nall; i++) {
		all = malloc(sizeof (struct XABALL));
		*all = cc$rms_xaball;
		all->xab$b_aid = i;		/* Allo area ref number	*/
		*chain = all;
		chain = &all->xab$l_nxt;
	    }
	    r->fab.fab$b_fac = FAB$M_GET | FAB$M_BRO;
	    if ((fdl_status = sys$open(&r->fab)) != RMS$_NORMAL) {
		MSG("fab status", r->fab.fab$l_sts);
		MSG("fab stv   ", r->fab.fab$l_stv);
		return (fail(r, "reopening ISAM file", NULL));
	    }
	}
	r->rab.rab$l_rop = RAB$M_BIO;		/* Block I/O only	*/
	if ((fdl_status = sys$connect(&r->rab)) != RMS$_NORMAL)
	    return (fail(r, "connecting after open", NULL));
	if (fdl_descriptor != NULL) {
	    struct FAB		*fab_add;
	    struct RAB		*rab_add;
	    static int		flags = (FDL$M_FDL_STRING | SIGNAL_ON_ERROR);
	    auto int		badblk;
	    auto int		retlen;
	    /*
	     * Now, get the file attributes
	     */
	    fdl_descriptor->dsc$w_length = 0;
	    fdl_descriptor->dsc$b_dtype = DSC$K_DTYPE_T;
	    fdl_descriptor->dsc$b_class = DSC$K_CLASS_D;
	    fdl_descriptor->dsc$a_pointer = NULL;
	    fab_add = &r->fab;
	    rab_add = &r->rab;
	    if ((fdl_status = fdl$generate(
		    &flags,
		    &fab_add,
		    &rab_add,
		    0L,			/* file_dst (unused)		*/
		    0L,			/* file_resnam (unused)		*/
		    fdl_descriptor,
		    &badblk,
		    &retlen)) != SS$_NORMAL) {
		fdl_free(fdl_descriptor);
		sys$close(&r->fab);
		return(fail(r, "getting fdl info", NULL));
	    }
	}
	return (r);
}

FDLSTUFF *
fdl_create(fdl_descriptor, override_filename, xab_lrl)
struct	dsc$descriptor	*fdl_descriptor;	/* Result descriptor	*/
char			*override_filename;	/* What to open		*/
int			xab_lrl;		/* Longest record len	*/
/*
 * Create the file, Returns NULL on failure, else a pointer to RMS stuff.
 * Which is equivalently a pointer to the RAB. (Note that the RAB points
 * in turn to the FAB.)  The file is open for writing using fdl_write.
 *
 * Uses the filename in the descriptor block, or the override filename
 * if supplied (non-NULL and not == "");
 *
 * If fdl_descriptor is NULL, the override_filename is opened normally.
 *
 * If xab_lrl is non-zero, it sets the file-header "longest record"
 * field.
 */
{
	register FDLSTUFF	*r;
	int			retlen;
	int			badblk;
	static int		flags = (FDL$M_FDL_STRING | SIGNAL_ON_ERROR);
	struct	dsc$descriptor	newname;
	struct	dsc$descriptor	*newname_ptr;
	int			fid_block[3];
	auto int		rms_status, rms_stv;
	char			created_name[NAM$C_MAXRSS + 1];
	struct	dsc$descriptor	created_name_des = {
				    NAM$C_MAXRSS,
				    DSC$K_DTYPE_T, 
				    DSC$K_CLASS_S,
				    &created_name[0]
				};
	extern FDLSTUFF		*fdl_setup();

	if (fdl_descriptor == NULL) {
	    /*
	     * Normal file open.
	     */
	    if ((r = fdl_setup(override_filename)) == NULL)
		return (NULL);
	    r->fab.fab$l_alq = 256;		/* Allocation quantity	*/
	    r->fab.fab$b_fac = FAB$M_PUT | FAB$M_BIO; /* Block I/O only	*/
	    r->fab.fab$l_fop |=
		(FAB$M_TEF | FAB$M_NAM | FAB$M_SQO | FAB$M_BIO);
	    r->fab.fab$b_org = FAB$C_SEQ;	/* Sequential only	*/
	    r->fab.fab$b_rfm = FAB$C_UDF;	/* Undefined format	*/
	    r->xabfhc.xab$w_lrl = xab_lrl;	/* Set record length	*/
	    fdl_status = sys$create(&r->fab);
	    if (!$VMS_STATUS_SUCCESS(fdl_status))
		return (fail(r, "creating file", NULL));
	    goto exit;				/* Normal exit		*/
	}
	if (override_filename == NULL || override_filename[0] == '\0')
	    newname_ptr = NULL;
	else {
	    newname_ptr = &newname;
	    newname.dsc$w_length = strlen(override_filename);
	    newname.dsc$b_dtype = DSC$K_DTYPE_T;
	    newname.dsc$b_class = DSC$K_CLASS_S;
	    newname.dsc$a_pointer = override_filename;
	}
	
	fdl_status = fdl$create(fdl_descriptor,
		newname_ptr,		/* New file name if any		*/
		0,			/* Default filename		*/
		&created_name_des,	/* Resultant filename		*/
		&fid_block[0],		/* File ID block		*/
		&flags,			/* FDL flag bits		*/
		0,			/* Statement number		*/
		&retlen,		/* Created name length		*/
		&rms_status,		/* FAB$L_STS code		*/
		&rms_stv		/* FAB$L_STV			*/
	);
	if (!$VMS_STATUS_SUCCESS(fdl_status)) {
	    MSG("FAB$L_STS", rms_status);
	    MSG("FAB$L_STV", rms_stv);
	    return(fail(NULL, "creating file", NULL));
	}
	created_name[retlen] = '\0';
	if ((r = fdl_setup(created_name)) == NULL)
	    return (NULL);
	/*
	 * Now, open the file for output.
	 */
	r->fab.fab$b_fac =
	    (xab_lrl == 0) ? FAB$M_PUT | FAB$M_BIO
			   : FAB$M_PUT | FAB$M_BRO;
	if ((fdl_status = sys$open(&r->fab)) != RMS$_NORMAL) {
	    return (fail(r, "opening created file", NULL));
	}
exit:	if ((r->fab.fab$l_dev & DEV$M_REC) != 0) {
	    fail(r, "Can't write record only device", NULL);
	    fdl_close(r);
	    return (NULL);
	}
	/*
	 * We do a bit of a hack to force "longest record length"
	 */
	if (xab_lrl != 0
	 && r->fab.fab$b_org == FAB$C_SEQ) {	/* Seq. files only	*/
	    char		*tempbuf;
	    extern char		outbuffer[MAXIO];

	    if (xab_lrl <= MAXIO)
		tempbuf = &outbuffer[0];
	    else if ((tempbuf = malloc(xab_lrl)) == NULL)
		return (fail(r, "allocating memory for longest record", NULL));
	    r->rab.rab$l_rop = 0;		/* PUT I/O 		*/
	    if ((fdl_status = sys$connect(&r->rab)) != RMS$_NORMAL)
		return (fail(r, "connect after create to set length", NULL));
	    r->rab.rab$l_rbf = tempbuf;
	    r->rab.rab$w_rsz = xab_lrl;
	    if ((fdl_status = sys$put(&r->rab)) != RMS$_NORMAL) {
		if (tempbuf != &outbuffer[0])
		    free(tempbuf);
		return (fail(r, "putting longest record", NULL));
	    }
	    if (tempbuf != &outbuffer[0])
		free(tempbuf);
	    if ((fdl_status = sys$disconnect(&r->rab)) != RMS$_NORMAL)
		return (fail(r, "disconnecting after setting length", NULL));
	}
	r->rab.rab$l_rop = RAB$M_BIO;	/* Block I/O only	*/
	if ((fdl_status = sys$connect(&r->rab)) != RMS$_NORMAL)
	    return (fail(r, "connecting after create", NULL));
	return (r);
}

static FDLSTUFF *
fdl_setup(filename)
char		*filename;
/*
 * Initializes rms blocks and parses file name.  Returns the
 * FDL data block on success, NULL on error.
 */
{
	register FDLSTUFF	*r;

	if ((r = (char *)malloc(sizeof (FDLSTUFF))) == NULL)
	    return (NULL);
	r->fab = cc$rms_fab;			/* Preset fab,		*/
	r->nam = cc$rms_nam;			/*   name block		*/
	r->rab = cc$rms_rab;			/*   and record block	*/
	r->xabfhc = cc$rms_xabfhc;		/*   file header block	*/
	r->xabsum = cc$rms_xabsum;		/*   isam summary block	*/
	r->fab.fab$l_nam = &r->nam;		/* fab -> name block	*/
	r->fab.fab$l_xab = &r->xabfhc;		/* fab -> file header	*/
	r->fab.fab$l_fna = filename;		/* Argument filename	*/
	r->fab.fab$b_fns = strlen(filename);	/* ... size		*/
	r->rab.rab$l_fab = &r->fab;		/* rab -> fab		*/
						/* Stuff the name block	*/
	r->nam.nam$l_esa = r->starname;		/* Expanded filename	*/
	r->nam.nam$b_ess = NAM$C_MAXRSS;	/* ... size		*/
	r->nam.nam$b_rss = NAM$C_MAXRSS;	/* ... max size		*/
	r->xabfhc.xab$l_nxt = &r->xabsum;	/* And build xab chain	*/
	if ((fdl_status = sys$parse(&r->fab)) != RMS$_NORMAL) {
	    return (fail(r, "parsing", filename));
	}
	((char *)r->nam.nam$l_esa)[r->nam.nam$b_esl] = EOS;
	r->fab.fab$l_fna = r->nam.nam$l_esa;	/* File name		*/
	r->fab.fab$b_fns = r->nam.nam$b_esl;	/* Length		*/
	r->fab.fab$l_fop |= FAB$M_NAM;		/* Use name block	*/
	return (r);
}

fdl_free(fdl_descriptor)
struct	dsc$descriptor	*fdl_descriptor;
/*
 * Release the descriptor
 */
{
	register int status;

	if ((status = str$free1_dx(fdl_descriptor)) != SS$_NORMAL) {
	    fprintf(stderr, "LZ fatal internal error \"%s\"\n", status);
	    lib$signal(status);
	}
}

fdl_close(r)
register FDLSTUFF	*r;
{
	if ((fdl_status = sys$close(&r->fab)) != RMS$_NORMAL)
	    return(fail(r, "closing", NULL));
	freefdlstuff(r);
}

static
freefdlstuff(r)
register FDLSTUFF	*r;
/*
 * Free fdl block and all XAB blocks.
 */
{
	register struct XABSUM	*xthis;
	register struct XABSUM	*xnext;

	if (r == NULL)
	    return;
	for (xnext = r->xabsum.xab$l_nxt; xnext != NULL;) {
	    xthis = xnext;
	    xnext = xnext->xab$l_nxt;
	    free(xthis);
	}
	free(r);
}

int
fdl_read(buffer, buffer_length, r)
char		*buffer;		/* Record			*/
int		buffer_length;		/* Record length		*/
register FDLSTUFF *r;			/* Record info.			*/
/*
 * Read the next record from the file.  Returns number of bytes read or
 * -1 on any error. fdl_status has the status.
 */
{
	r->rab.rab$l_ubf = buffer;
	r->rab.rab$w_usz = buffer_length;
	r->rab.rab$l_bkt = 0;
	if ((fdl_status = sys$read(&r->rab)) != RMS$_NORMAL) {
#if TESTING_FDLIO
	    if (fdl_status != RMS$_EOF) {
		fdl_message(r, "error return from sys$read");
		sleep(1);
	    }
#endif
	    return (-1);
	}
	return (r->rab.rab$w_rsz);
}

int
fdl_write(buffer, buffer_length, r)
char		*buffer;		/* Record			*/
int		buffer_length;		/* Record length		*/
register FDLSTUFF *r;			/* Record info.			*/
/*
 * Write the next record to the file.  Returns number of bytes written or
 * -1 on any error. fdl_status has the status.
 */
{
	r->rab.rab$l_rbf = buffer;
	r->rab.rab$w_rsz = buffer_length;
	r->rab.rab$l_bkt = 0;
	if ((fdl_status = sys$write(&r->rab)) != RMS$_NORMAL) {
#if 1 || TESTING_FDLIO
	    fdl_message(r, "error return from sys$write");
	    fprintf(stderr, "writing %d bytes\n", buffer_length);
	    sleep(1);
#endif
	    return (-1);
	}
	return (r->rab.rab$w_rsz);
}

fdl_getname(r, buffer)
FDLSTUFF	*r;			/* File pointer			*/
char		*buffer;		/* Where to put it		*/
/*
 * Return current file name
 */
{
	strcpy(buffer, r->fab.fab$l_fna);
	return (buffer);
}

long
fdl_fsize(r)
FDLSTUFF	*r;			/* File pointer			*/
/*
 * Return current file size
 */
{
	return (((long) r->xabfhc.xab$l_ebk * 512) + r->xabfhc.xab$w_ffb);
}

fdl_message(r, why)
FDLSTUFF	*r;
char		*why;
/*
 * Print error message
 */
{
	extern char	*vms_etext();

	if (why == NULL) {
	    fprintf(stderr, "\n%s\n\n", vms_etext(fdl_status));
	}
	else {
	    fprintf(stderr, "\n%s%s%s:\n  %s\n\n",
		why,
		(why[0] == EOS) ? "" : " ",
		(r == NULL) ? "" : r->fab.fab$l_fna,
		vms_etext(fdl_status));
	}
}


static
message(r, why, name)
FDLSTUFF	*r;			/* Buffer			*/
char		*why;			/* A little commentary		*/
char		*name;			/* File name			*/
/*
 * Print error message
 */
{
	fprintf(stderr, "\nRMS error when %s %s\n",
	    why, (name == NULL) ? "" : name);
	fprintf(stderr, "\"%s\"\n", vms_etext(fdl_status));
}

fdl_dump(fdl_descriptor, fd)
struct	dsc$descriptor	*fdl_descriptor;
FILE			*fd;
/*
 * Dump the descriptor to fd.
 */
{
	register char	*tp, *end;

	tp = fdl_descriptor->dsc$a_pointer;
	end = tp + fdl_descriptor->dsc$w_length;
	while (tp < end) {
	    if (*tp == '"') {
		do {
		    putc(*tp++, fd);
		} while (*tp != '"');
	    }
	    putc(*tp, fd);
	    if (*tp++ == ';')
		putc('\n', fd);
	}
}


#if	TESTING_FDLIO
/*
 * Test program for rms io
 */
#include <stdio.h>

char			line[133];
char			filename[133];
char			buffer[2048];

main(argc, argv)
int		argc;
char		*argv[];
{
	FDLSTUFF	*old;
	FDLSTUFF	*new;
	int		size, total, nrecords;
	struct	dsc$descriptor	fdl_info;	/* Result descriptor	*/

	for (;;) {
	    fprintf(stderr, "Old file name: ");
	    fflush(stdout);
	    if (gets(line) == NULL)
		break;
	    if (line[0] == EOS)
		continue;
	    if ((old = fdl_open(line, &fdl_info)) == NULL) {
		fprintf(stderr, "open failed\n");
		continue;
	    }
	    fprintf(stderr, "New file name: ");
	    if (gets(line) == NULL)
		break;
	    if ((new = fdl_create(&fdl_info, line, 0)) == NULL) {
		fprintf(stderr, "create failed\n");
		fdl_free(&fdl_info);
		continue;
	    }
	    fdl_getname(old, buffer);
	    fprintf(stderr, "Fdl for \"%s\", size %ld\n",
		buffer, fdl_fsize(old));
	    fdl_dump(&fdl_info, stderr);
	    total = nrecords = 0;
	    while ((size = fdl_read(buffer, sizeof buffer, old)) > 0) {
		fdl_write(buffer, size, new);
		nrecords++;
		total += size;
	    }
	    fdl_close(old);
	    fdl_close(new);
	    fprintf(stderr, "copied %d records, %d bytes total\n",
		nrecords, total);
	    fdl_free(&fdl_info);
	}
}

#endif
#endif