Path: utzoo!attcan!uunet!lll-winken!lll-lcc!ames!pasteur!ucbvax!LBL.GOV!nagy%warner.hepnet
From: nagy%warner.hepnet@LBL.GOV (Frank J. Nagy, VAX Wizard & Guru)
Newsgroups: comp.os.vms
Subject: Lempel-Ziv file (de)compress from VAX SIG tapes (Part 2 of 3)
Message-ID: <880712062710.2760608d@LBL.Gov>
Date: 12 Jul 88 13:27:10 GMT
Sender: daemon@ucbvax.BERKELEY.EDU
Organization: The Internet
Lines: 2113

+-+-+-+ Beginning of part 2 +-+-+-+
Xextern long`009tot_outcount;`009`009/* Total output count`009`009*/
Xextern code_int`009hsize;`009`009`009/* Actual hash table size`009*/
X
X#ifdef XENIX_16
Xstatic count_int htab0[8192];
Xstatic count_int htab1[8192];
Xstatic count_int htab2[8192];
Xstatic count_int htab3[8192];
Xstatic count_int htab4[8192];
Xstatic count_int htab5[8192];
Xstatic count_int htab6[8192];
Xstatic count_int htab7[8192];
Xstatic count_int htab8[HSIZE - 65536];
Xstatic count_int *hashtab[9] = {
X    htab0, htab1, htab2, htab3, htab4, htab5, htab6, htab7, htab8
X};
X
Xstatic U_short code0[16384];
Xstatic U_short code1[16384];
Xstatic U_short code2[16384];
Xstatic U_short code3[16384];
Xstatic U_short code4[HSIZE - 65536];
Xstatic U_short *codetab[5] = {
X    code0, code1, code3, code3, code4
X}
X
X#define HASH(i)`009`009(hashtab[((unsigned) (i)) >> 13][(i) & 0x1FFF])
X#define CODE(i)`009`009(codetab[((unsigned) (i)) >> 14][(i) & 0x3FFF])
X
X#else
Xcount_int`009hashtab[HSIZE];
XU_short`009`009codetab[HSIZE];
X
X#define HASH(i)`009`009hashtab[i]
X#define CODE(i)`009`009codetab[i]
X#endif
X`012
X/*
X * compress a datastream
X *
X * Algorithm:  on large machines, for maxbits <= FBITS, use fast direct table
X * lookup on the prefix code / next character combination.  For smaller code
X * size, use open addressing modular division double hashing (no chaining), ala
X * Knuth vol. 3, sec. 6.4 Algorithm D, along with G. Knott's relatively-prime
X * secondary probe.  Do block compression with an adaptive reset, whereby the
X * code table is cleared when the compression ratio decreases, but after the
X * table fills.  The variable-length output codes are re-sized at this point,
X * and a special LZ_CLEAR code is generated for the decompressor.  For the
X * megamemory version, the sparse array is cleared indirectly through a
X * "shadow" output code history.  Late additions: for the hashing code,
X * construct the table according to file size for noticeable speed improvement
X * on small files.  Also detect and cache codes associated with the most
X * common character to bypass hash calculation on these codes (a characteristic
X * of highly-compressable raster images).  Please direct questions about this
X * implementation to ames!jaw.
X */
X
Xcompress(in)
XSTREAM`009`009*in;`009`009/* Input stream structure`009`009*/
X/*
X * Compress driver.  Global fsize is the size of the entire datastream
X * (from LZ_STX or LZ_SOH to the terminating LZ_ETX).  You must
X * force a reinitialization -- by calling outputcode() with a new header --
X * if size is changed.  If the "newer" output format is chosen (with
X * data streams delimited by LZ_SOH/LZ_STX, init_compress will be
X * called automatically.  Otherwise, you must call init_compress(TRUE)
X * before calling compress() for the first time.
X */
X{
X`009register long`009`009hash_code;`009/* What we look for`009*/
X`009register code_int`009i;`009`009/* Index into vectors`009*/
X`009register int`009`009c;`009`009/* Current input char`009*/
X`009register code_int`009code;`009`009/* Substring code`009*/
X`009register int`009`009displacement;`009/* For secondary hash`009*/
X`009register code_int`009hsize_reg;`009/* Size of hash table`009*/
X`009register int`009`009hshift;`009`009/* For xor hasher`009*/
X
X`009if ((code = GET(in)) == EOF)
X`009    return;
X`009in_count++;
X`009hsize_reg = hsize;
X`009/*
X`009 * Set hash code range bound
X`009 */
X`009hshift = 0;
X`009for (hash_code = (long) hsize; hash_code < 65536L; hash_code <<= 1)
X`009    hshift++;
X`009hshift = 8 - hshift;
X`009while ((c = GET(in)) != (unsigned) EOF) {
X`009    in_count++;
X`009    hash_code = (long) (((long) c << maxbits) + code);
X`009    i = (c << hshift) ^ code;`009`009/* XOR hashing`009`009*/
X`009    if (HASH(i) == hash_code) {`009`009/* Found at first slot?`009*/
X`009`009code = CODE(i);
X`009`009continue;
X`009    }
X`009    else if ((long) HASH(i) < 0)`009/* empty slot`009`009*/
X`009`009goto nomatch;
X`009    displacement = hsize_reg - i;`009/* secondary hash`009*/
X`009    if (i == 0)
X`009`009displacement = 1;
Xprobe:
X`009    if ((i -= displacement) < 0)`009/* Wrap around?`009`009*/
X`009`009i += hsize_reg;
X`009    if (HASH(i) == hash_code) {`009`009/* Found in hash table?`009*/
X`009`009code = CODE(i);`009`009`009/* Set new prefix code`009*/
X`009`009continue;`009`009`009/* Read next input char`009*/
X`009    }
X`009    else if ((long) HASH(i) > 0)`009/* If slot is occupied`009*/
X`009`009goto probe;`009`009`009/* Look somewhere else`009*/
Xnomatch:
X`009    /*
X`009     * Output the current prefix and designate a new prefix.
X`009     * If the input character was the "hog", save it in the
X`009     * look-ahead cache table.  Then, save in the hash table.
X`009     */
X`009    outputcode((code_int) code);`009/* No match, put prefix`009*/
X#if SIGNED_COMPARE_SLOW
X`009    if ((unsigned) next_code < (unsigned) maxmaxcode) {
X#else
X`009    if (next_code < maxmaxcode) {
X#endif
X`009`009CODE(i) = next_code++;`009`009/* code -> hashtable`009*/
X`009`009HASH(i) = hash_code;
X`009    }
X`009    else if (block_compress
X`009`009  && (count_int) in_count >= checkpoint) {
X`009`009clear();
X`009    }
X`009    code = c;`009`009`009`009/* Start new substring`009*/
X`009}
X`009/*
X`009 * At EOF, put out the final code.
X`009 */
X`009outputcode((code_int) code);
X}
X`012
Xclear()
X/*
X * Check the compression ratio to see whether it is going up
X * or staying the same.  If it is going down, the internal
X * statistics of the file have changed, so clear out our
X * tables and start over.  Inform the decompressor of the
X * change by sending out a LZ_CLEAR code.
X */
X{
X`009register long int`009rat;
X
X`009checkpoint = in_count + CHECK_GAP;
X#if DEBUG
X`009if (verbose > 2) {
X`009    divout("at clear() test",  in_count, out_count, "");
X`009    fprintf(stderr, ", ratio at entry: %ld.%02ld, gap %d\n",
X`009`009rat / 256L, ((rat & 255L) * 100L) / 256L, CHECK_GAP);
X`009}
X#endif
X`009if (in_count > 0x007FFFFL) {`009`009/* Shift will overflow`009*/
X`009    rat = out_count >> 8;
X`009    if (rat == 0)
X`009`009rat = 0x7FFFFFFFL;
X`009    else {
X`009`009rat = in_count / rat;
X`009    }
X`009}
X`009else {
X`009    rat = (in_count << 8) / out_count;
X`009}
X`009if (rat > ratio)
X`009    ratio = rat;
X`009else {
X#if DEBUG
X`009    if (verbose > 0) {
X`009`009fprintf(stderr, "Resetting compression, in %ld, out %ld\n",
X`009`009    in_count, out_count);
X`009`009fprintf(stderr, "Old ratio: %ld == (%ld.%02ld)",
X`009`009    ratio, ratio / 256L, ((ratio & 255L) * 100L) / 256L);
X`009`009fprintf(stderr, ", test ratio: %ld = (%ld.%02ld), gap %d\n",
X`009`009    rat, rat / 256L, ((rat & 255L) * 100L) / 256L, CHECK_GAP);
X`009    }
X#endif
X`009    outputcode((code_int) LZ_CLEAR);`009/* Calls init_compress`009*/
X`009}
X}
X`012
Xinit_compress(full_init)
Xflag`009`009full_init;`009/* TRUE for full initialization`009`009*/
X/*
X * Clear the tables.  Called by outputcode() on LZ_SOH, LZ_STX
X * (full_init TRUE) or on LZ_CLEAR (full_init FALSE).
X * init_compress() is not called on LZ_EOR.
X */
X{
X#ifdef XENIX_16
X`009register count_int`009*hp;
X`009register int`009`009n;
X`009register int`009`009j;
X`009register code_int`009k;
X
X`009k = hsize;
X`009for (j = 0; k > 0; k -= 8192) {
X`009    i = (k < 8192) ? k : 8192;
X`009    hp = hashtab[j++];
X`009    n = i >> 4;
X`009    switch (i & 15) {
X`009    case 15:`009*hp++ = -1;
X`009    case 14:`009*hp++ = -1;
X`009    case 13:`009*hp++ = -1;
X`009    case 12:`009*hp++ = -1;
X`009    case 11:`009*hp++ = -1;
X`009    case 10:`009*hp++ = -1;
X`009    case  9:`009*hp++ = -1;
X`009    case  8:`009*hp++ = -1;
X`009    case  7:`009*hp++ = -1;
X`009    case  6:`009*hp++ = -1;
X`009    case  5:`009*hp++ = -1;
X`009    case  4:`009*hp++ = -1;
X`009    case  3:`009*hp++ = -1;
X`009    case  2:`009*hp++ = -1;
X`009    case  1:`009*hp++ = -1;
X`009    }
X`009    while (--n >= 0) {
X`009`009*hp++ = -1; *hp++ = -1; *hp++ = -1; *hp++ = -1;
X`009`009*hp++ = -1; *hp++ = -1; *hp++ = -1; *hp++ = -1;
X`009`009*hp++ = -1; *hp++ = -1; *hp++ = -1; *hp++ = -1;
X`009`009*hp++ = -1; *hp++ = -1; *hp++ = -1; *hp++ = -1;
X`009   }
X`009}
X#else
X`009register count_int`009*hp;
X`009register code_int`009n;
X
X`009hp = &hashtab[0];
X`009n = hsize >> 4;`009`009`009/* divide by 16`009`009`009*/
X`009switch (hsize & 15) {
X`009case 15:`009*hp++ = -1;
X`009case 14:`009*hp++ = -1;
X`009case 13:`009*hp++ = -1;
X`009case 12:`009*hp++ = -1;
X`009case 11:`009*hp++ = -1;
X`009case 10:`009*hp++ = -1;
X`009case  9:`009*hp++ = -1;
X`009case  8:`009*hp++ = -1;
X`009case  7:`009*hp++ = -1;
X`009case  6:`009*hp++ = -1;
X`009case  5:`009*hp++ = -1;
X`009case  4:`009*hp++ = -1;
X`009case  3:`009*hp++ = -1;
X`009case  2:`009*hp++ = -1;
X`009case  1:`009*hp++ = -1;
X`009}
X`009while (--n >= 0) {
X`009    *hp++ = -1; *hp++ = -1; *hp++ = -1; *hp++ = -1;
X`009    *hp++ = -1; *hp++ = -1; *hp++ = -1; *hp++ = -1;
X`009    *hp++ = -1; *hp++ = -1; *hp++ = -1; *hp++ = -1;
X`009    *hp++ = -1; *hp++ = -1; *hp++ = -1; *hp++ = -1;
X`009}
X#endif
X`009if (full_init) {
X`009    tot_incount += in_count;
X`009    tot_outcount += out_count;
X`009    in_count = 0;
X`009    out_count = 0;
X`009    ratio = 0;
X`009}
X`009first_clear = FALSE;
X`009next_code = firstcode;
X}
$ GOSUB UNPACK_FILE
$ FILE_IS = "LZCMP3.C"
$ CHECKSUM_IS = 1949626030
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*
X * `009`009`009l z c m p 3 . c
X * Output a given code.
X */
X#include "lz.h"
X
Xextern STREAM`009outstream;
Xextern code_int`009next_code;
Xextern code_int`009maxmaxcode;`009`009/* Actual maximum output code`009*/
Xextern short`009maxbits;
Xextern count_int out_count;
X
Xstatic char_type buf[BITS];
Xstatic int`009offset;
Xstatic short`009n_bits = INIT_BITS;`009/* # of bits in compressed file`009*/
Xstatic short`009n_bits8 = INIT_BITS << 3;
Xstatic code_int`009maxcode = MAXCODE(INIT_BITS);
X
X#if !vax_asm
Xstatic readonly char_type lmask[9] = {
X    0xFF, 0xFE, 0xFC, 0xF8, 0xF0, 0xE0, 0xC0, 0x80, 0x00
X};
Xstatic readonly char_type rmask[9] = {
X    0x00, 0x01, 0x03, 0x07, 0x0F, 0x1F, 0x3F, 0x7F, 0xFF
X};
X#endif
X
X#if DEBUG
Xextern int`009col;
Xstatic int`009todump;
X#endif
X
Xoutputcode(code)
Xcode_int  code;
X/*
X * Output the given code.
X * Inputs:
X * `009code:`009A n_bits-bit integer.  If == -1, then EOF.  This assumes
X *`009`009that n_bits <= (long)wordsize - 1.
X * Note: if not in "export" mode, the following values are special:
X *`009LZ_CLEAR`009(also in export mode if block_compress TRUE)
X *`009`009`009(soft) clear out compress tables and reset the
X *`009`009`009number of bits per code to the minimum.
X *`009LZ_SOH, LZ_STX`009(hard) clear out compress tables and reset as above.
X *`009LZ_ETX, LZ_EOR`009force out the current output segment, analogous
X *`009`009`009to fflush.
X *`009`009`009
X * Outputs:
X * `009Outputs code to the file.  If the codespace has filled
X *`009(next_code >= (1 << n_bits), increase n_bits.
X *`009If LZ_CLEAR, LZ_SOH, or LZ_STX is seen, reset n_bits
X *`009to the initial value and call init_compress to reset
X *`009the lookup and cache tables.
X *
X * Assumptions:
X *`009Output chars are 8 bits long.  This is deeply hardwired
X *`009into the algorithm.  It is independent, however, of the
X *`009size of the input data.
X *
X * Algorithm:
X * `009Maintain a BITS character long buffer (so that 8 codes will
X *`009fit in it exactly).  Use the VAX insv instruction to insert each
X *`009code in turn.  When the buffer fills up empty it and start over.
X */
X{
X`009/*
X`009 * On the VAX (Unix), it is important to have the register declarations
X`009 * in exactly the order given, or the asm will break.
X`009 */
X`009register int`009r_off, bits;
X`009register char_type`009*bp;
X#if !vax_asm
X`009register code_int`009r_code;
X#endif
X
X`009r_off = offset;
X`009bits = n_bits;
X`009bp = buf;
X`009if (code >= 0) {
X`009    /*
X`009     * Not at EOF, add the code
X`009     */
X#if DEBUG
X`009    if (verbose > 3) {
X`009`009fprintf(stderr, "%c%5d %5d",
X`009`009    ((col += 12) >= 72) ? (col = 0, '\n') : ' ',
X`009`009    code, next_code);
X`009`009if (code >= LZ_CLEAR && code < firstcode) {
X`009`009    fprintf(stderr, " = %s", lz_names[code - LZ_CLEAR]);
X`009`009    col = 74;
X`009`009}
X`009    }
X#endif
X#if vax_asm
X`009    /*
X`009     * VAX DEPENDENT!! Implementation on other machines may be
X`009     * difficult.
X`009     *
X`009     * Translation: Insert BITS bits from the argument starting at
X`009     * offset bits from the beginning of buf.
X`009     */
X`009    0;`009`009`009`009`009/* C compiler bug ??`009*/
X`009    asm("insv`0094(ap),r11,r10,(r9)");
X#else
X`009    /*
X`009     * WARNING: byte/bit numbering on the vax is simulated
X`009     * by the following code
X`009     */
X`009    bp += (r_off >> 3);`009`009`009/* -> first output slot`009*/
X`009    r_off &= 7;
X`009    /*
X`009     * Since code is always >= 8 bits, only need to mask the first
X`009     * hunk on the left.
X`009     */
X`009    r_code = code;
X`009    *bp = (*bp & rmask[r_off]) | (r_code << r_off) & lmask[r_off];
X`009    bp++;
X`009    bits -= (8 - r_off);
X`009    r_code >>= 8 - r_off;
X`009    /*
X`009     * Get any 8 bit parts in the middle ( <= 1 for up to 16 bits).
X`009     */
X`009    if (bits >= 8) {
X`009`009*bp++ = r_code;
X`009`009r_code >>= 8;
X`009`009bits -= 8;
X`009    }
X`009    if (bits != 0)`009`009`009`009/* Last bits. */
X`009`009*bp = r_code;
X#endif
X`009    offset += n_bits;
X`009    if (offset == n_bits8) {
X`009`009out_count += n_bits;
X`009`009lz_putbuf(buf, n_bits, &outstream);
X#if DEBUG
X`009`009if (todump > 0) {
X`009`009    dumphex(buf, n_bits, stderr);
X`009`009    todump -= n_bits;
X`009`009}
X#endif
X`009`009offset = 0;
X`009    }
X`009    /*
X`009     * If the next entry is going to be too big for the code size,
X`009     * then increase it, if possible.  Note:
X`009     *     !export`009`009`009firstcode == LZ_FIRST
X`009     *`009   export && block_compress`009firstcode == LZ_CLEAR + 1
X`009     *`009   export && !block_compress`009firstcode == LZ_CLEAR
X`009     */
X`009    if (next_code > maxcode) {
X`009`009if (offset > 0) {
X`009`009    lz_putbuf(buf, n_bits, &outstream);
X`009`009    out_count += n_bits;
X`009`009    offset = 0;
X#if DEBUG
X`009`009    if (todump > 0) {
X`009`009`009dumphex(buf, n_bits, stderr);
X`009`009`009todump -= n_bits;
X`009`009    }
X#endif
X`009`009}
X`009`009n_bits++;`009`009`009/* Need more bits`009*/
X`009`009n_bits8 += (1 << 3);
X`009`009if (n_bits == maxbits)
X`009`009    maxcode = maxmaxcode;
X`009`009else
X`009`009    maxcode = MAXCODE(n_bits);
X#if DEBUG
X`009`009if (verbose > 2) {
X`009`009    fprintf(stderr,
X`009`009`009"%snext_code %d, change to %d bits max %d",
X`009`009`009(col > 0) ? "\n" : "", next_code,
X`009`009`009n_bits, maxcode);
X`009`009    col = 74;
X`009`009}
X#endif
X`009    }
X`009    if (code >= LZ_CLEAR && code < firstcode) {
X`009`009switch (code) {
X`009`009case LZ_SOH:
X`009`009case LZ_STX:
X`009`009case LZ_CLEAR:
X`009`009    if (offset > 0) {
X`009`009`009lz_putbuf(buf, n_bits, &outstream);
X`009`009`009out_count += n_bits;
X`009`009`009offset = 0;
X#if DEBUG
X`009`009`009if (todump > 0) {
X`009`009`009    dumphex(buf, n_bits, stderr);
X`009`009`009    todump -= n_bits;
X`009`009`009}
X#endif
X`009`009    }
X`009`009    n_bits = INIT_BITS;`009`009/* Reset codes`009`009*/
X`009`009    n_bits8 = INIT_BITS << 3;
X`009`009    maxcode = MAXCODE(INIT_BITS);
X`009`009    init_compress(code != LZ_CLEAR);
X#if DEBUG
X`009`009    if (verbose > 2) {
X`009`009`009fprintf(stderr,
X`009`009    "\n(%s) Change to %d bits, maxcode %d, next_code = %d",
X`009`009`009    lz_names[code - LZ_CLEAR],
X`009`009`009    n_bits, maxcode, next_code);
X`009`009`009col = 74;
X`009`009`009todump = 32;
X`009`009    }
X#endif
X`009`009    break;
X
X`009`009case LZ_EOR:
X`009`009case LZ_ETX:`009`009`009/* Just written out`009*/
X`009`009    break;
X
X`009`009default:
X`009`009    abort();`009`009`009/* Can't happen`009`009*/
X`009`009}
X`009    }
X`009}
X`009else {
X`009    /*
X`009     * At EOF, write the rest of the buffer.
X`009     */
X`009    if ((r_off = offset) > 0) {
X`009`009r_off += 7;
X`009`009r_off >>= 3;
X`009`009lz_putbuf(buf, r_off, &outstream);
X`009`009out_count += r_off;
X#if DEBUG
X`009`009if (todump > 0) {
X`009`009    dumphex(buf, r_off, stderr);
X`009`009    todump -= r_off;
X`009`009}
X#endif
X`009    }
X`009    offset = 0;
X`009    lz_flush(&outstream);`009`009/* Flush output buffer`009*/
X#if DEBUG
X`009    if (verbose > 3 || todump > 0) {
X`009`009fprintf(stderr, "\n*EOF*\n");
X`009`009col = 0;
X`009    }
X#endif
X`009}
X}
$ GOSUB UNPACK_FILE
$ FILE_IS = "LZDCM1.C"
$ CHECKSUM_IS = 828175667
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*
X *`009`009lzdcmp [-options] [infile [outfile]]
X */
X#ifdef`009DOCUMENTATION
X
Xtitle`009lzdcmp`009File Decompression
Xindex`009`009File decompression
X
Xsynopsis
X`009.s.nf
X`009lzdcmp [-options] [infile [outfile]]
X`009.s.f
Xdescription
X
X`009lzdcmp decompresses files compressed by lzcomp.  The
X`009documentation for lzcomp describes the process in
X`009greater detail.
X
X`009Options may be given in either case.
X`009.lm +8
X`009.p -8
X`009-B`009Output file is "binary", not text.  (Ignored
X`009in VMS private mode.)
X`009.p -8
X`009-X 3`009To read files compressed by an old Unix version
X`009that doesn't generate header records.
X`009.p -8
X`009-V val`009Verbose (print status messages and debugging
X`009information).  The value selects the amount of verbosity.
X
XAuthor
X
X`009This version by Martin Minow.  See lzcomp for more
X`009details.
X
X#endif
X
X/*
X * Compatible with compress.c, v3.0 84/11/27
X */
X
X/*)BUILD
X`009`009$(PROGRAM) = lzdcmp
X`009`009$(INCLUDE) = lz.h
X`009`009$(CPP) = 1
X`009`009$(FILES) = { lzdcm1.c lzdcm2.c lzdcm3.c lzio.c lzvio.c }
X*/
X
X#include`009"lz.h"
X
X/*
X * These global parameters are read from the compressed file.
X * The decompressor needs them.
X */
Xshort`009`009maxbits = BITS;`009`009/* settable max # bits/code`009*/
Xcode_int`009maxmaxcode = 1 << BITS;
X
X/*
X * Note, if export is zero or 1, the "true" value will be set from
X * the file header.  If it is 2, no header will be read.
X */
X#if VMS_V4
Xflag`009`009export = 0;`009`009/* Assume VMS private`009`009*/
X#else
Xflag`009`009export = 1;`009`009/* Assume Unix compatible`009*/
X#endif
Xflag`009`009binary = FALSE;`009`009/* Read text if false`009`009*/
Xflag`009`009block_compress = TRUE;`009/* TRUE if CLEAR enabled`009*/
Xflag`009`009noheader = FALSE;`009/* No magic header if TRUE`009*/
Xflag`009`009verbose = VERBOSE_DEFAULT; /* Non-zero for status/debug`009*/
Xflag`009`009background = FALSE;`009/* TRUE (Unix) if detached`009*/
Xflag`009`009is_compress = FALSE;`009/* For lzio.c (?)`009`009*/
Xchar`009`009*infilename = NULL;`009/* For error printouts`009`009*/
Xchar`009`009*outfilename = NULL;`009/* For openoutput and errors`009*/
Xint`009`009firstcode;`009`009/* First code after internals`009*/
Xstatic long`009start_time;`009`009/* Time we started (in msec)`009*/
Xextern long`009cputime();`009`009/* Returns process time in msec`009*/
Xjmp_buf`009`009failure;
XSTREAM`009`009instream;
XSTREAM`009`009outstream;
Xchar_type`009inbuffer[MAXIO];
Xchar_type`009outbuffer[MAXIO];
Xstatic STREAM`009mem_stream;
X#if VMS_V4
X#include <descrip.h>
X#ifndef FDLSTUFF
X#define FDLSTUFF char
X#endif
XFDLSTUFF`009*fdl_input;
XFDLSTUFF`009*fdl_output;
Xstatic struct dsc$descriptor fdl_descriptor;
X#endif
X`012
Xmain(argc, argv)
Xint`009`009argc;
Xchar`009`009*argv[];
X/*
X * Decompress mainline
X */
X{
X`009int`009`009result;
X
X#ifndef`009decus
X`009/*
X`009 * background is TRUE if running detached from the command terminal.
X`009 */
X`009background = (signal(SIGINT, SIG_IGN) == SIG_IGN) ? TRUE : FALSE;
X`009if (!background)
X`009    background = !isatty(fileno(stderr));
X`009if (!background) {
X`009    if (verbose > 0)
X`009`009signal(SIGINT, abort);
X`009    else {
X`009`009signal(SIGINT, interrupt);
X`009`009signal(SIGSEGV, address_error);
X`009    }
X`009}
X#endif
X`009if (setjmp(failure) == 0) {
X`009    setup(argc, argv);
X`009    openinput();
X`009    get_magic_header();`009`009`009/* Sets export, etc.`009*/
X`009    openoutput();
X`009    if (verbose > 0)
X`009`009start_time = cputime();
X`009    init_decompress();
X`009    result = decompress(&outstream);
X`009    if (!export
X`009     && result != LZ_ETX
X`009     && getcode() != (code_int) LZ_ETX) {
X`009`009fprintf(stderr, "Decompress didn't finish correctly.\n");
X`009`009goto fail;
X`009    }
X`009    lz_flush(&outstream);
X#if DEBUG
X`009    if ((verbose & 04) != 0)
X`009`009dump_tab(stdout);
X#endif
X`009    if (verbose > 0) {
X`009`009start_time = cputime() - start_time;
X`009`009fprintf(stderr,
X`009`009    "%ld.%02ld seconds (process time) for decompression.\n",
X`009`009    start_time / 1000L, (start_time % 1000L) / 10L);
X`009    }
X`009    exit(IO_SUCCESS);
X`009}
X`009else {
Xfail:`009    fprintf(stderr, "Error when decompressing \"%s\" to \"%s\"\n",
X`009`009(infilename  == NULL) ? 
X`009`009    "<input file unknown>" : infilename,
X`009`009(outfilename == NULL) ?
X`009`009    "<no output file>" : outfilename);
X`009    if (errno != 0)
X`009`009perror("lzdcmp fatal error");
X`009    exit(IO_ERROR);
X`009}
X}
X`012
Xstatic
Xget_magic_header()
X{
X`009int`009`009head1;
X`009int`009`009head2;
X`009int`009`009head3;
X
X`009head2 = 0;
X`009if (export != 2) {
X`009    if ((head1 = GET(&instream)) != HEAD1_MAGIC) {
X`009`009fprintf(stderr, "Incorrect first header byte 0x%X\n",
X`009`009    head1);
X`009`009FAIL("can't get header");
X`009    }
X`009    head2 = GET(&instream);
X`009    head3 = GET(&instream);
X`009    switch (head2) {
X`009    case HEAD2_MAGIC:
X`009`009export = 1;
X`009`009break;
X
X`009    case VMS_HEAD2_MAGIC:
X`009`009export = 0;
X`009`009break;
X
X`009    default:
X`009`009fprintf(stderr, "Incorrect second header byte 0x%X\n",
X`009`009    head2);
X`009`009FAIL("can't get header");
X`009    }
X`009    maxbits = head3 & BIT_MASK;
X`009    block_compress = ((head3 & BLOCK_MASK) != 0) ? TRUE : FALSE;
X#if DEBUG
X`009    if (verbose > 1) {
X`009`009fprintf(stderr, "%s: compressed with %d bits,",
X`009`009   infilename, maxbits);
X`009`009fprintf(stderr, " block compression %s.\n",
X`009`009    (block_compress != 0) ? "enabled" : "disabled");
X`009    }
X#endif
X`009}
X`009if (maxbits > BITS) {
X`009    fprintf(stderr, "%s: compressed with %d bits,",
X`009`009infilename, maxbits);
X`009    fprintf(stderr, " lzdcmp can only handle %d bits\n", BITS);
X`009    FAIL("too many bits");
X`009}
X`009maxmaxcode = 1 << maxbits;
X`009if (export == 0)
X`009    firstcode = GET(&instream) + 0x100;`009/* From compressed file`009*/
X`009else if (block_compress)
X`009    firstcode = LZ_CLEAR + 1;`009`009/* Default`009`009*/
X`009else
X`009    firstcode = 256;`009`009`009/* Backwards compatible`009*/
X#if VMS_V4
X`009if (!export) {
X`009    register code_int`009code;
X`009    char`009`009text[256];
X`009    /*
X`009     * Get the attribute record.
X`009     */
X`009    if ((code = getcode()) != LZ_SOH) {
X`009`009fprintf(stderr, "Expected header, read 0x%X\n", code);
X`009`009FAIL("can't get header (private)");
X`009    }
X`009    init_decompress();
X`009    code = mem_decompress(text, sizeof text);
X`009    text[code] = EOS;
X`009    if (strncmp(text, ATT_NAME, ATT_SIZE) != 0) {
X`009`009fprintf(stderr, "Expected \"%s\", read \"%.*s\"\n",
X`009`009    ATT_NAME, code, text);
X`009`009FAIL("can't get attribute block header");
X`009    }
X`009    code = atoi(text + ATT_SIZE);
X`009    fdl_descriptor.dsc$a_pointer = malloc(code);
X`009    fdl_descriptor.dsc$w_length = code;
X`009    if ((code = mem_decompress(fdl_descriptor.dsc$a_pointer, code))
X`009`009    != fdl_descriptor.dsc$w_length) {
X`009`009fprintf(stderr, "\nError reading fdl attributes block,");
X`009`009fprintf(stderr, " expected %d bytes, read %d bytes\n",
X`009`009    fdl_descriptor.dsc$w_length, code);
X`009`009FAIL("can't get attribute block data");
X`009    }
X`009    if (verbose > 1) {
X`009`009fprintf(stderr, "\nFDL information read from \"%s\"\n",
X`009`009    infilename);
X`009`009fdl_dump(&fdl_descriptor, stderr);
X`009    }
X`009    if ((code = getcode()) != LZ_STX) {
X`009`009fprintf(stderr, "\nExpecting start of text, got 0x%X\n", code);
X`009`009FAIL("no start of text");
X`009    }
X`009}
X#endif
X}
X`012
Xint
Xmem_decompress(buffer, size)
Xchar_type`009*buffer;
Xint`009`009size;
X/*
X * Decompress up to size bytes to buffer.  Return actual size.
X */
X{
X`009int`009`009result;
X
X`009mem_stream.bp = mem_stream.bstart = buffer;
X`009mem_stream.bend = buffer + size;
X`009mem_stream.bsize = size;
X`009mem_stream.func = lz_fail;
X`009if ((result = decompress(&mem_stream)) == LZ_EOR
X`009 || result == LZ_ETX)
X`009    return (mem_stream.bp - buffer);
X`009else {
X`009    fprintf(stderr, "Decompress to memory failed.\n");
X`009    FAIL("can't decompress to memory");
X`009}
X`009return (-1);`009`009`009`009/* Can't happen`009`009*/
X}
X`012
Xstatic readonly char *helptext[] = {
X`009"The following options are valid:",
X`009"-B\tBinary file (important on VMS/RSX, ignored on Unix)",
X`009"-M val\tSet the maximum number of code bits (unless header present)",
X`009"-V val\tPrint status information or debugging data.",
X`009"-X val\tSet export (compatibility) mode:",
X`009"-X 0\tVMS private mode",
X`009"-X 1\tCompatibility with Unix compress",
X`009"-X 2\tDo not read a header, disable \"block-compress\" mode",
X`009"\t(If a header is present, lzdcmp will properly configure itself,",
X`009"\toverriding the -X, -B and -M flag values.",
X`009NULL,
X};
X
Xstatic
Xsetup(argc, argv)
Xint`009`009argc;
Xchar`009`009*argv[];
X/*
X * Get parameters and open files.  Exit fatally on errors.
X */
X{
X`009register char`009*ap;
X`009register int`009c;
X`009char`009`009**hp;
X`009auto int`009i;
X`009int`009`009j;
X
X#ifdef`009vms
X`009argc = getredirection(argc, argv);
X#endif
X`009for (i = j = 1; i < argc; i++) {
X`009    ap = argv[i];
X`009    if (*ap++ != '-' || *ap == EOS)`009/* Filename?`009`009*/
X`009`009argv[j++] = argv[i];`009`009/* Just copy it`009`009*/
X`009    else {
X`009`009while ((c = *ap++) != EOS) {
X`009`009    if (islower(c))
X`009`009`009c = toupper(c);
X`009`009    switch (c) {
X`009`009    case 'B':
X`009`009`009binary = TRUE;
X`009`009`009break;
X
X`009`009    case 'M':
X`009`009`009maxbits = getvalue(ap, &i, argv);
X`009`009`009if (maxbits < MIN_BITS) {
X`009`009`009    fprintf(stderr, "Illegal -M value\n");
X`009`009`009    goto usage;
X`009`009`009}
X`009`009`009break;
X
X`009`009    case 'V':
X`009`009`009verbose = getvalue(ap, &i, argv);
X`009`009`009break;
X
X`009`009    case 'X':
X`009`009`009export = getvalue(ap, &i, argv);
X`009`009`009if (export < 0 || export > 3) {
X`009`009`009    fprintf(stderr, "Illegal -X value: %d\n", export);
X`009`009`009    goto usage;
X`009`009`009}
X`009`009`009block_compress = (export < 2);
X`009`009`009noheader = (export == 3);
X`009`009`009break;
X
X`009`009    default:
X`009`009`009fprintf(stderr, "Unknown option '%c' in \"%s\"\n",
X`009`009`009`009*ap, argv[i]);
Xusage:`009`009`009for (hp = helptext; *hp != NULL; hp++)
X`009`009`009    fprintf(stderr, "%s\n", *hp);
X`009`009`009FAIL("unknown option");
X`009`009    }`009`009`009`009/* Switch on options`009*/
X`009`009}`009`009`009`009/* Everything for -xxx`009*/
X`009    }`009`009`009`009`009/* If -option`009`009*/
X`009}`009`009`009`009`009/* For all argc's`009*/
X`009/*  infilename = NULL; */`009`009/* Set "stdin"  signal`009*/
X`009/* outfilename = NULL; */`009`009/* Set "stdout" signal`009*/
X`009switch (j) {`009`009`009`009/* Any file arguments?`009*/
X`009case 3:`009`009`009`009`009/* both files given`009*/
X`009    if (!streq(argv[2], "-"))`009`009/* But - means stdout`009*/
X`009`009outfilename = argv[2];
X`009case 2:`009`009`009`009`009/* Input file given`009*/
X`009    if (!streq(argv[1], "-")) {
X`009`009infilename = argv[1];
X`009    }
X`009    break;
X
X`009case 0:`009`009`009`009`009/* None!`009`009*/
X`009case 1:`009`009`009`009`009/* No file arguments`009*/
X`009    break;
X
X`009default:
X`009    fprintf(stderr, "Too many file arguments\n");
X`009    FAIL("too many files");
X`009}
X}
X`012
Xstatic int
Xgetvalue(ap, ip, argv)
Xregister char`009`009*ap;
Xint`009`009`009*ip;
Xchar`009`009`009*argv[];
X/*
X * Compile a "value".  We are currently scanning *ap, part of argv[*ip].
X * The following are possible:
X *`009-x123`009`009return (123) and set *ap to EOS so the caller
X *`009ap^`009`009cycles to the next argument.
X *
X *`009-x 123`009`009*ap == EOS and argv[*ip + 1][0] is a digit.
X *`009`009`009return (123) and increment *i to skip over the
X *`009`009`009next argument.
X *
X *`009-xy or -x y`009return(1), don't touch *ap or *ip.
X *
X * Note that the default for "flag option without value" is 1.  This
X * can only cause a problem for the -M option where the value is
X * mandatory.  However, the result of 1 is illegal as it is less
X * than INIT_BITS.
X */
X{
X`009register int`009result;
X`009register int`009i;
X
X`009i = *ip + 1;
X`009if (isdigit(*ap)) {
X`009    result = atoi(ap);
X`009    *ap = EOS;
X`009}
X`009else if (*ap == EOS
X`009      && argv[i] != NULL
X`009      && isdigit(argv[i][0])) {
X`009    result = atoi(argv[i]);
X`009    *ip = i;
X`009}
X`009else {
X`009    result = 1;
X`009}
X`009return (result);
X}
X`012
Xopeninput()
X{
X#ifdef`009decus
X`009if (infilename == NULL) {
X`009    infilename = malloc(257);
X`009    fgetname(stdin, infilename);
X`009    infilename = realloc(infilename, strlen(infilename) + 1);
X`009}
X`009if (freopen(infilename, "rn", stdin) == NULL) {
X`009    perror(infilename);
X`009    FAIL("can't open compressed input");
X`009}
X#else
X#ifdef vms
X#if VMS_V4
X`009if (!export) {
X`009    if (infilename == NULL) {
X`009`009infilename = malloc(256 + 1);
X`009`009fgetname(stdin, infilename);
X`009`009infilename = realloc(infilename, strlen(infilename) + 1);
X`009    }
X`009    if ((fdl_input = fdl_open(infilename, NULL)) == NULL) {
X`009`009fdl_message(NULL, infilename);
X`009`009FAIL("can't open compressed input (vms private)");
X`009    }
X`009}
X`009else
X#endif
X`009{
X`009    if (infilename == NULL) {
X`009`009infilename = malloc(256 + 1);
X`009`009fgetname(stdin, infilename);
X`009`009infilename = realloc(infilename, strlen(infilename) + 1);
X`009    }
X`009    else {
X`009`009if (freopen(infilename, "r", stdin) == NULL) {
X`009`009    perror(infilename);
X`009`009    FAIL("can't open compressed input (export)");
X`009`009}
X`009    }
X`009}
X#else
X`009if (infilename == NULL)
X`009    infilename = "<stdin>";
X`009else {
X`009    if (freopen(infilename, "r", stdin) == NULL) {
X`009`009perror(infilename);
X`009`009FAIL("can't open input");
X`009    }
X`009}
X#endif
X#endif
X`009instream.bp = instream.bend = NULL;
X`009instream.bstart = inbuffer;
X`009instream.bsize = sizeof inbuffer;
X`009instream.func = lz_fill;
X}
X`012
Xopenoutput()
X{
X#ifdef vms
X#if VMS_V4
X`009if (!export) {
X`009    fclose(stdout);
X`009    stdout = NULL;
X`009    if ((fdl_output =
X`009`009    fdl_create(&fdl_descriptor, outfilename)) == NULL) {
X`009`009fprintf(stderr, "Can't create output file\n");
X`009`009if ((fdl_status & 01) == 0)
X`009`009    fdl_message(NULL, outfilename);
X`009`009FAIL("can't create output (vms private)");
X`009    }
X`009    if (outfilename == NULL) {
X`009`009outfilename = malloc(256 + 1);
X`009`009fdl_getname(fdl_output, outfilename);
X`009`009outfilename = realloc(outfilename, strlen(outfilename) + 1);
X`009    }
X`009}
X`009else
X#endif
X`009{
X`009    /*
X`009     * Not VMS Version 4, or export mode.
X`009     */
X`009    if (outfilename == NULL) {
X`009`009outfilename = malloc(256 + 1);
X`009`009fgetname(stdout, outfilename);
X`009`009outfilename = realloc(outfilename, strlen(outfilename) + 1);
X`009`009if (!binary)
X`009`009    goto do_reopen;
X`009    }
X`009    else {
X`009`009if (binary) {
X`009`009    if (freopen(outfilename, "w", stdout) == NULL) {
X`009`009`009perror(outfilename);
X`009`009`009FAIL("can't create output (binary)");
X`009`009    }
X`009`009}
X`009`009else {
X`009`009    int`009`009i;
Xdo_reopen:
X`009`009    if ((i = creat(outfilename, 0, "rat=cr", "rfm=var")) == -1
X`009`009     || dup2(i, fileno(stdout)) == -1) {
X`009`009`009perror(outfilename);
X`009`009`009FAIL("can't create output (text)");
X`009`009    }
X`009`009}
X`009    }
X`009}
X#else
X#ifdef decus
X`009if (outfilename == NULL) {
X`009    outfilename = malloc(256 + 1);
X`009    fgetname(stdout, outfilename);
X`009    outfilename = realloc(outfilename, strlen(outfilename) + 1);
X`009    if (binary) {
X`009`009if (freopen(outfilename, "wn", stdout) == NULL) {
X`009`009    perror(outfilename);
X`009`009    FAIL("can't create (binary)");
X`009`009}
X`009    }
X`009}
X`009else {
X`009    if (freopen(outfilename, (binary) ? "wn" : "w", stdout) == NULL) {
X`009`009perror(outfilename);
X`009`009FAIL("can't create");
X`009    }
X`009}
X#else
X`009if (outfilename == NULL)
X`009    outfilename = "<stdout>";
X`009else {
X`009    if (freopen(outfilename, "w", stdout) == NULL) {
X`009`009perror(outfilename);
X`009`009FAIL("can't create");
X`009    }
X`009}
X#endif
X#endif
X`009outstream.bp = outstream.bstart = outbuffer;
X`009outstream.bend = outbuffer + sizeof outbuffer;
X`009outstream.bsize = sizeof outbuffer;
X`009outstream.func = lz_flush;
X}
$ GOSUB UNPACK_FILE
$ FILE_IS = "LZDCM2.C"
$ CHECKSUM_IS = 1161199679
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*
X *`009`009`009l z d c m 2 . c
X *
X * Actual decompression code
X */
X
X#include "lz.h"
X
X/*
X * These global parameters are read from the compressed file.
X * The decompressor needs them.
X */
Xextern short`009maxbits;`009`009/* settable max # bits/code`009*/
Xextern code_int`009maxmaxcode;`009`009/* 1 << maxbits`009`009`009*/
X
Xstatic flag`009first_clear = TRUE;
X
X/*
X * Big data storage stuff
X */
X
Xstatic char_type`009stack[MAXSTACK];
X#define`009STACK_TOP`009(&stack[MAXSTACK])
Xstatic U_short`009`009tab_prefix[1 << BITS];`009/* prefix code`009`009*/
Xstatic char_type  `009tab_suffix[1 << BITS];`009/* last char in string`009*/
Xcode_int`009`009next_code;
X
X#if DEBUG
X#define`009CHECK(what)`009`009`009`009`009`009\
X`009if (stp <= stack) {`009`009`009`009`009\
X`009    fprintf(stderr, "Stack overflow -- %s\n", what);`009\
X`009    abort();`009`009`009`009`009`009\
X`009}
X#else
X#define CHECK(what)
X#endif
X`012
Xint
Xdecompress(out)
XSTREAM`009`009*out;
X/*
X * Decompress instream (global) to out.  Returns "end" signal:
X *`009-1`009end of file
X *`009LZ_EOR`009end of record
X *`009LZ_ETX`009end of segment
X */
X{
X`009register char_type`009*stp;`009`009/* Stack pointer`009*/
X`009register code_int code, oldcode, incode;
X`009register int`009`009final;`009/* End of a sequence?`009*/
X`009extern code_int`009`009getcode();
X
X`009stp = STACK_TOP;
X`009final = oldcode = getcode();
X`009PUT((char) final, out);
X`009while ((code = getcode()) >= 0) {
Xtest:`009    if (code >= LZ_CLEAR && code < firstcode) {
X`009`009lz_putbuf(stp, STACK_TOP - stp, out);
X`009`009stp = STACK_TOP;
X`009`009switch (code) {
X`009`009case LZ_ETX:
X`009`009case LZ_EOR:
X`009`009    goto finish;
X
X`009`009case LZ_SOH:`009`009`009/* Unexpected`009`009*/
X`009`009case LZ_STX:`009`009`009/* Unexpected`009`009*/
X`009`009default:
X`009`009    fprintf(stderr, "\nUnexpected control 0x%X\n", code);
X`009`009    FAIL("Unexpected control");
X
X`009`009case LZ_CLEAR:
X`009`009    init_decompress();`009`009/* Before getcode() !! */
X`009`009    if ((code = getcode()) < 0
X`009`009      || (export && code == LZ_CLEAR))
X`009`009`009goto finish;
X`009`009    else {
X`009`009`009/*
X`009`009`009 * init_decompress has set next_code to firstcode,
X`009`009`009 * however, for magical reasons, we want to toss
X`009`009`009 * the next substring, so we set next_code so
X`009`009`009 * that the tab_... entry is effectively ignored.
X`009`009`009 * Note below that tab_prefix[next_code] is set
X`009`009`009 * to the character before the LZ_CLEAR and
X`009`009`009 * tab_suffix to the character after the LZ_CLEAR.
X`009`009`009 * But, these values have no relationship to one
X`009`009`009 * another, so, by decrementing next_code, they
X`009`009`009 * will be ignored.  (I think.)
X`009`009`009 */
X`009`009`009next_code--;
X`009`009`009goto test;
X`009`009    }
X`009`009}
X`009    }
X`009    incode = code;
X`009    /*
X`009     * Special case for KwKwK string.
X`009     */
X`009    if (code >= next_code) {
X`009`009CHECK("KwKwK");
X`009`009*--stp = final;
X`009`009code = oldcode;
X`009    }
X`009    /*
X`009     * Generate output characters in reverse order
X`009     */
X#ifdef interdata
X`009    while (((unsigned long) code) >= ((unsigned long) NBR_CHAR)) {
X#else
X`009    while (code >= NBR_CHAR) {
X#endif
X`009`009CHECK("generate output");
X`009`009*--stp = tab_suffix[code];
X`009`009code = tab_prefix[code];
X`009    }
X`009    CHECK("final char");
X`009    *--stp = final = tab_suffix[code];
X`009    /*
X`009     * And put them out in forward order
X`009     */
X`009    lz_putbuf(stp, STACK_TOP - stp, out);
X`009    stp = STACK_TOP;
X`009    /*
X`009     * Generate the new entry.
X`009     */
X`009    if ((code = next_code) < maxmaxcode) {
X`009`009tab_prefix[code] = (U_short) oldcode;
X`009`009tab_suffix[code] = final;
X`009`009next_code++;
X`009    } 
X`009    /*
X`009     * Remember previous code.
X`009     */
X`009    oldcode = incode;
X`009}
Xfinish:
X`009return (code);
X}
X`012
Xinit_decompress()
X/*
X * Called on cold start, or on LZ_SOH, LZ_STX, LZ_CLEAR.
X */
X{
X`009register char_type`009*cp;
X`009register U_short`009*up;
X`009register int`009`009code;
X
X`009if (first_clear) {
X`009    for (cp = &tab_suffix[0], code = 0; cp < &tab_suffix[NBR_CHAR];)
X`009`009*cp++ = code++;
X`009    first_clear = FALSE;
X`009}
X`009else {
X#if ((NBR_CHAR % 8) != 0)
X`009    << error, the following won't work >>
X#endif
X`009    for (up = &tab_prefix[0]; up < &tab_prefix[NBR_CHAR];) {
X`009`009*up++ = 0;
X`009`009*up++ = 0;
X`009`009*up++ = 0;
X`009`009*up++ = 0;
X`009`009*up++ = 0;
X`009`009*up++ = 0;
X`009`009*up++ = 0;
X`009`009*up++ = 0;
X`009    }
X`009}
X`009next_code = firstcode;
X}
X`012
X#if DEBUG
Xdump_tab(dumpfd)
XFILE`009`009*dumpfd;
X/*
X * dump string table
X */
X{
X`009register char_type`009*stp;`009/* Stack pointer`009`009*/
X`009register int`009`009i;
X`009register int`009`009ent;
X`009extern char`009`009*dumpchar();
X
X`009stp = STACK_TOP;
X`009fprintf(dumpfd, "%d %s in string table\n",
X`009    next_code, (next_code == 1) ? "entry" : "entries");
X`009for (i = 0; i < next_code; i++) {
X`009    fprintf(dumpfd, "%5d: %5d/'%s' ",
X`009`009i, tab_prefix[i], dumpchar(tab_suffix[i]));
X`009    for (ent = i;;) {
X`009`009*--stp = tab_suffix[ent];
X`009`009if (ent < firstcode)
X`009`009    break;
X`009`009ent = tab_prefix[ent];
X`009    }
X`009    dumptext(stp, STACK_TOP - stp, dumpfd);
X`009    stp = STACK_TOP;
X`009}
X}
X#endif
$ GOSUB UNPACK_FILE
$ FILE_IS = "LZDCM3.C"
$ CHECKSUM_IS = 1679715766
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*
X *`009`009`009l z d c m 3 . c
X *
X * Read codes from the input stream.
X */
X
X#include "lz.h"
X
X
X#if !vax_asm
Xstatic readonly char_type rmask[9] = {
X`0090x00, 0x01, 0x03, 0x07, 0x0F, 0x1F, 0x3F, 0x7F, 0xFF
X};
X#endif
X#if DEBUG
Xextern int`009col;
Xstatic int`009todump;
X#endif
X
X/*
X * getcode()
X *
X * Read one code from the standard input.  If EOF, return -1.
X * Inputs:
X * `009stdin (via GET)
X * Outputs:
X * `009code or -1 is returned.
X */
X
Xextern code_int`009`009next_code;
Xextern STREAM`009`009instream;
Xextern code_int`009`009maxmaxcode;
Xextern short`009`009maxbits;
Xstatic short`009`009n_bits = INIT_BITS;
Xstatic code_int`009`009maxcode = MAXCODE(INIT_BITS);
X
X/*
X * buf[] contains 8-bit data read from the input stream.  getcode()
X * treats buf[] as a vector of bits, repacking it into variable-bit codes.
X */
Xstatic char_type`009buf[BITS];
Xstatic int`009`009offset = 0;`009/* Offset into buf    IN BITS `009*/
Xstatic int`009`009size = 0;`009/* Actual size of buf IN BITS `009*/
X
Xcode_int
Xgetcode()
X{
X`009/*
X`009 * On the VAX (4.2 bsd), it is important to have the register
X`009 * declarations in exactly the order given, or the asm will break.
X`009 */
X`009register code_int `009code;
X`009register int`009`009r_off, bits;
X`009register char_type`009*bp;
X
X`009bp = buf;
X`009if (next_code > maxcode) {
X`009    n_bits++;
X`009    if (n_bits == maxbits)
X`009`009maxcode = maxmaxcode;
X`009    else {
X`009`009maxcode = MAXCODE(n_bits);
X`009    }
X`009    size = 0;
X#if DEBUG
X`009    if (verbose > 2) {
X`009`009fprintf(stderr, "\nChange to %d bits", n_bits);
X`009`009col = 74;
X`009    }
X#endif
X`009}
X`009if (offset >= size) {
X`009    size = lz_getbuf(buf, n_bits, &instream);
X#if DEBUG
X`009    if (verbose > 4 || todump > 0) {
X`009`009dumphex(buf, size, stderr);
X`009`009if (todump > 0)
X`009`009    todump -= size;
X`009    }
X#endif
X`009    if (size <= 0)
X`009`009return (-1);`009`009`009/* end of file`009`009*/
X`009    offset = 0;
X`009    /*
X`009     * Round size down to integral number of codes in the buffer.
X`009     * (Expressed as a number of bits).
X`009     */
X`009    size = (size << 3) - (n_bits - 1);
X`009}
X`009r_off = offset;
X`009bits = n_bits;
X#if vax_asm
X`009asm("extzv   r10,r9,(r8),r11");
X#else
X`009/*
X`009 * Get to the first byte.
X`009 */
X`009bp += (r_off >> 3);
X`009r_off &= 7;
X`009/*
X`009 * Get first part (low order bits)
X`009 */
X#if UCHAR
X`009code = (*bp++ >> r_off);
X#else
X`009/*
X`009 * Don't touch the 0xFF; it prevents sign extension.
X`009 */
X`009code = ((*bp++ >> r_off) & rmask[8 - r_off]) & 0xFF;
X#endif
X`009bits -= (8 - r_off);
X`009r_off = 8 - r_off;`009`009/* now, offset into code word`009*/
X`009/*
X`009 * Get any 8 bit parts in the middle (<=1 for up to 16 bits).
X`009 */
X`009if (bits >= 8) {
X#if UCHAR
X`009    code |= *bp++ << r_off;
X#else
X`009    code |= (*bp++ & 0xFF) << r_off;
X#endif
X`009    r_off += 8;
X`009    bits -= 8;
X`009}
X`009/* high order bits. */
X#if UCHAR
X`009code |= (*bp & rmask[bits]) << r_off;
X#else
X`009code |= (*bp & rmask[bits]) << r_off;
X#endif
X`009/*
X`009 * End of non-vax (Unix) specific code.
X`009 */
X#endif
X`009offset += n_bits;
X`009if (code >= LZ_CLEAR && code < firstcode) {
X`009    switch (code) {
X`009    case LZ_SOH:
X`009    case LZ_STX:
X`009    case LZ_CLEAR:
X`009`009size = 0;`009`009`009/* Force read next time`009*/
X`009`009n_bits = INIT_BITS;
X`009`009maxcode = MAXCODE(INIT_BITS);
X#if DEBUG
X`009`009if (verbose > 1) {
X`009`009    fprintf(stderr, "Read %s (%d)\n",
X`009`009`009lz_names[code - LZ_CLEAR], code);
X`009`009    todump = 32;
X`009`009}
X#endif
X`009`009break;
X`009    }
X`009}
X#if DEBUG
X`009if (verbose > 3) {
X`009    fprintf(stderr, "%c%5d %5d",
X`009`009((col += 12) >= 72) ? (col = 0, '\n') : ' ',
X`009`009code, next_code);
X`009    if (code >= LZ_CLEAR && code < firstcode) {
X`009`009fprintf(stderr, " = %s", lz_names[code - LZ_CLEAR]);
X`009        col = 74;
X`009    }
X`009}
X#endif
X`009return (code);
X}
X
$ GOSUB UNPACK_FILE
$ FILE_IS = "LZIO.C"
$ CHECKSUM_IS = 1214693144
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*
X *`009`009`009l z i o . c
X *
X * I/O buffer management.  All input/output I/O is done through these
X * routines (and the macros in lz.h).  The rules of the game are:
X *
X * input via GET() and getbuf().
X *`009GET returns an 8-bit byte, or -1 on eof/error.
X *`009getbuf() returns the number of things gotten, or -1 on eof/error.
X *`009No return on error: longjmp's to the main-line.
X *
X * output via PUT() and lz_putbuf().
X *`009No return on error: longjmp's to the main-line.
X * flush output by lz_flush() before closing files -- or you'll lose data.
X */
X
X#include`009"lz.h"
X#if VMS_V4
X#include`009<rmsdef.h>
X#ifndef FDLSTUFF
X#define FDLSTUFF char
X#endif
Xextern FDLSTUFF *fdl_input;
Xextern FDLSTUFF *fdl_output;
Xextern int`009fdl_status;
X#endif
X`012
Xint
Xlz_fill(s)
Xregister STREAM`009`009*s;
X{
X`009register int`009i;
X`009extern char`009*infilename;
X
X#if VMS_V4
X`009if (export && is_compress) {
X`009    i = fread((char *) s->bstart, 1, s->bsize, stdin);
X`009    if (ferror(stdin)) {
X`009`009perror(infilename);
X`009`009FAIL("export && is_compress fread error");
X`009    }
X`009}
X`009else {`009`009`009/* Decompress and export/private`009*/
X`009    i = fdl_read(s->bstart, s->bsize, fdl_input);
X`009    if (i < 0 && fdl_status != RMS$_EOF)
X`009`009fdl_message(fdl_input, "Read error");
X`009}
X#else
X#ifdef unix
X`009i = read(fileno(stdin), (char *) s->bstart, s->bsize);
X`009if (i < 0) {
X`009    perror(infilename);
X`009    FAIL("unix read error");
X`009}
X#else
X`009i = fread((char *) s->bstart, 1, s->bsize, stdin);
X`009if (ferror(stdin)) {
X`009    perror(infilename);
X`009    exit(IO_ERROR);
X`009}
X#endif
X#endif
X`009if (i <= 0)
X`009    return (EOF);
X`009else {
X`009    s->bp = s->bstart;
X`009    s->bend = &s->bstart[i];
X#if UCHAR
X`009    return (*s->bp++);
X#else
X`009    return (*s->bp++ & 0xFF);
X#endif
X`009}
X}
X`012
Xlz_flush(s)
Xregister STREAM`009*s;
X{
X`009register int`009count;
X`009extern char`009*outfilename;
X
X`009count = s->bp - s->bstart;
X#if DEBUG
X`009if (!is_compress && verbose > 4) {
X`009    fprintf(stderr, "lz_flush %d:  ", count);
X`009    dumptext(s->bstart, count, stderr);
X`009}
X#endif
X#if VMS_V4
X`009if (export) {
X`009    if (is_compress)
X`009`009fwrite((char *) s->bstart, count, 1, stdout);
X`009    else {
X`009`009register char *bp, *bend;
X
X`009`009for (bp = s->bstart, bend = bp + count; bp < bend; bp++)
X`009`009    putchar(*bp);
X`009    }
X`009    if (ferror(stdout)) {
X`009`009perror(outfilename);
X`009`009FAIL("VMS V4 fwrite/putchar error");
X`009    }
X`009}
X`009else {
X`009    if (fdl_write((char *) s->bstart, count, fdl_output) == -1) {
X`009`009fdl_message(fdl_output, "Write error");
X`009`009FAIL("VMS V4 fdl_write error");
X`009    }
X`009}
X#else
X#ifdef unix
X`009if (write(fileno(stdout), (char *) s->bstart, count) != count) {
X`009    perror(outfilename);
X`009    fprintf(stderr, "Can't write to \"%s\"\n", outfilename);
X`009    FAIL("Unix write error");
X`009}
X#else
X`009fwrite((char *) s->bstart, 1, count, stdout);
X`009if (ferror(stdout)) {
X`009    perror(outfilename);
X`009    FAIL("Other (decus) fwrite error");
X`009}
X#endif
X#endif
X`009s->bp = s->bstart;
X}
X`012
Xint
Xlz_getbuf(buffer, count, s)
Xchar_type`009`009*buffer;
Xint`009`009`009count;
Xregister STREAM`009`009*s;
X/*
X * Read a block of data -- be clever.  Return number gotten, or -1
X * on eof.
X */
X{
X`009register char_type`009*bp;`009`009/* -> buffer`009`009*/
X`009register char_type`009*ip;`009`009/* -> I/O buffer`009*/
X`009register char_type`009*ep;`009`009/* End of segment`009*/
X`009register int`009`009remaining;`009/* Size of segment`009*/
X`009int`009`009`009datum;
X
X`009if (count == 0)`009`009`009`009/* Shouldn't happen`009*/
X`009    return (0);
X`009bp = buffer;
X`009while (--count >= 0) {
X`009    if ((datum = GET(s)) == EOF)`009/* Maybe fill LZ buff`009*/
X`009`009break;
X`009    *bp++ = datum;
X`009    remaining = s->bend - (ip = s->bp);
X`009    if (remaining > count)
X`009`009remaining = count;
X`009    ep = &ip[remaining];
X`009    while (ip < ep)
X`009`009*bp++ = *ip++;
X`009    count -= remaining;
X`009    s->bp = ip;`009`009`009`009/* Refresh buffer`009*/
X`009}
X`009return ((bp == buffer) ? -1 : bp - buffer);
X}
X`012
Xint
Xlz_putbuf(bp, count, s)
Xregister char_type`009*bp;
Xint`009`009`009count;
Xregister STREAM`009`009*s;
X/*
X * Write a block of data -- be clever.
X */
X{
X`009register char_type`009*op;`009`009/* -> I/O buffer`009*/
X`009register char_type`009*ep;`009`009/* End of segment`009*/
X`009register int`009`009remaining;`009/* Size of segment`009*/
X
X`009while (--count >= 0) {
X`009    PUT(*bp++, s);`009`009`009/* Forces a buffer`009*/
X`009    remaining = s->bend - (op = s->bp);
X`009    if (remaining > count)
X`009`009remaining = count;
X`009    ep = &op[remaining];
X`009    while (op < ep)
X`009`009*op++ = *bp++;
X`009    count -= remaining;
X`009    s->bp = op;`009`009`009`009/* Refresh buffer`009*/
X`009}
X}
X`012
Xint
Xlz_eof(s)
XSTREAM`009`009*s;
X/*
X * Dummy routine for read from memory -- returns EOF.
X */
X{
X`009return (s, EOF);
X}
X
Xint
Xlz_fail(s)
XSTREAM`009`009*s;
X/*
X * Dummy routine for write to memory -- called if buffer fills.
X */
X{
X`009fprintf(stderr, "Memory buffer [%d bytes] filled -- fatal.\n",
X`009`009s->bsize);
X`009FAIL("lz_fail crash");
X}
X
Xint
Xlz_dummy(s)
XSTREAM`009`009*s;
X/*
X * Dummy routine for write to memory -- writes to the bit-bucket.
X */
X{
X`009s->bp = s->bstart;
X}
X`012
X#ifndef decus
X/*
X * Signal error handlers.
X */
X#ifdef vms
X#define unlink`009delete
X#endif
X
Xinterrupt()
X{
X`009if (outfilename != NULL && !streq(outfilename, "<stdout>"))
X`009    unlink(outfilename);
X`009exit(IO_ERROR);
X}
X
Xaddress_error()
X{
X`009if (!is_compress)
X`009    fprintf(stderr, "Decompress: corrupt input file\n");
X`009interrupt();
X}
X#endif
X`012
X/*
X * getredirection() is intended to aid in porting C programs
X * to VMS (Vax-11 C) which does not support '>' and '<'
X * I/O redirection.  With suitable modification, it may
X * useful for other portability problems as well.
X */
X
X#ifdef`009vms
X
Xint
Xgetredirection(argc, argv)
Xint`009`009argc;
Xchar`009`009**argv;
X/*
X * Process vms redirection arg's.  Exit if any error is seen.
X * If getredirection() processes an argument, it is erased
X * from the vector.  getredirection() returns a new argc value.
X *
X * Warning: do not try to simplify the code for vms.  The code
X * presupposes that getredirection() is called before any data is
X * read from stdin or written to stdout.
X *
X * Normal usage is as follows:
X *
X *`009main(argc, argv)
X *`009int`009`009argc;
X *`009char`009`009*argv[];
X *`009{
X *`009`009argc = getredirection(argc, argv);
X *`009}
X */
X{
X`009register char`009`009*ap;`009/* Argument pointer`009*/
X`009int`009`009`009i;`009/* argv[] index`009`009*/
X`009int`009`009`009j;`009/* Output index`009`009*/
X`009int`009`009`009file;`009/* File_descriptor `009*/
X
X`009for (j = i = 1; i < argc; i++) {   /* Do all arguments`009*/
X`009    switch (*(ap = argv[i])) {
X`009    case '<':`009`009`009/* <file`009`009*/
X`009`009if (freopen(++ap, "r", stdin) == NULL) {
X`009`009    perror(ap);`009`009/* Can't find file`009*/
X`009`009    exit(IO_ERROR);`009/* Is a fatal error`009*/
X`009`009}
X`009`009break;
X
X`009    case '>':`009`009`009/* >file or >>file`009*/
X`009`009if (*++ap == '>') {`009/* >>file`009`009*/
X`009`009    /*
X`009`009     * If the file exists, and is writable by us,
X`009`009     * call freopen to append to the file (using the
X`009`009     * file's current attributes).  Otherwise, create
X`009`009     * a new file with "vanilla" attributes as if
X`009`009     * the argument was given as ">filename".
X`009`009     * access(name, 2) is TRUE if we can write on
X`009`009     * the specified file.
X`009`009     */
X`009`009    if (access(++ap, 2) == 0) {
X`009`009`009if (freopen(ap, "a", stdout) != NULL)
X`009`009`009    break;`009/* Exit case statement`009*/
X`009`009`009perror(ap);`009/* Error, can't append`009*/
X`009`009`009exit(IO_ERROR);`009/* After access test`009*/
X`009`009    }`009`009`009/* If file accessable`009*/
X`009`009}
X`009`009/*
X`009`009 * On vms, we want to create the file using "standard"
X`009`009 * record attributes.  create(...) creates the file
X`009`009 * using the caller's default protection mask and
X`009`009 * "variable length, implied carriage return"
X`009`009 * attributes. dup2() associates the file with stdout.
X`009`009 */
X`009`009if (freopen(ap, "w", stdout, "rat=cr", "rfm=var") == NULL) {
X`009`009    perror(ap);`009`009/* Can't create file`009*/
X`009`009    exit(IO_ERROR);`009/* is a fatal error`009*/
X`009`009}`009`009`009/* If '>' creation`009*/
X`009`009break;`009`009`009/* Exit case test`009*/
X
X`009    default:
X`009`009argv[j++] = ap;`009`009/* Not a redirector`009*/
X`009`009break;`009`009`009/* Exit case test`009*/
X`009    }
X`009}`009`009`009`009/* For all arguments`009*/
X`009argv[j] = NULL;`009`009`009/* Terminate argv[]`009*/
X`009return (j);`009`009`009/* Return new argc`009*/
X}
X#endif
X`012
X#if 1 || DEBUG
X
Xint`009`009col;
X
Xreadonly char *lz_names[] = {
X    "LZ_CLEAR", "LZ_SOH", "LZ_STX", "LZ_EOR", "LZ_ETX", "???"
X};
X
Xdumphex(buffer, count, fd)
Xregister char_type`009*buffer;
Xregister int`009`009count;
XFILE`009`009`009*fd;
X{
X`009if (col > 0) {
X`009    putc('\n', fd);
X`009    col = 0;
X`009}
X`009fprintf(fd, "%2d:", count);
X`009while (--count >= 0) {
X`009    fprintf(fd, " %02x", *buffer++ & 0xFF);
X`009}
X`009fprintf(fd, "\n");
X}
X
Xdumptext(buffer, count, fd)
Xregister char_type`009*buffer;
Xint`009`009`009count;
XFILE`009`009`009*fd;
X{
X`009extern char`009*dumpchar();
X
X`009putc('"', fd);
X`009while (--count >= 0)
X`009    fputs(dumpchar((int) *buffer++), fd);
X`009fputs("\"\n", fd);
X}
X
Xchar *
Xdumpchar(c)
Xregister int`009c;
X/*
X * Make a character printable.  Returns a static pointer.
X */
X{
X`009static char`009dump_buffer[8];
X
X`009c &= 0xFF;
X`009if (isascii(c) && isprint(c)) {
X`009    dump_buffer[0] = c;
X`009    dump_buffer[1] = EOS;
X`009}
X`009else {
X`009    switch (c) {
X`009    case '\n':`009return ("\\n");
X`009    case '\t':`009return ("\\t");
X`009    case '\b':`009return ("\\b");
X`009    case '\f':`009return ("\\f");
X`009    case '\r':`009return ("\\r");
X`009    }
X`009    sprintf(dump_buffer, "<x%02X>", c);
X`009}
X`009return (dump_buffer);
X}
X#endif
X`012
X/*
X * Cputime returns the elapsed process time (where available) in msec.
X * Note: Unix doesn't seem to have a good way to determine ticks/sec.
X */
X
X#ifdef`009decus
X#include`009<timeb.h>
X
Xlong
Xcputime()
X{
X`009struct timeb`009`009buf;
X`009static struct timeb`009origin;
X`009long`009`009`009result;
X`009int`009`009`009msec;
X
X`009if (origin.time == 0)
X`009    ftime(&origin);
X`009ftime(&buf);
X`009result = (buf.time - origin.time) * 1000;
X`009msec = ((int) buf.msec) - ((int) origin.msec);
X`009return (result + ((long) msec));
X}
X#else
X#ifdef vms
X#include`009<types.h>
Xstruct tms {
X`009time_t`009tms_utime;
X`009time_t`009tms_stime;
X`009time_t`009tms_uchild;`009/* forgot the */
X`009time_t`009tms_uchildsys;`009/* real names */
X};
X#define HERTZ`009100.0`009`009`009`009/* 10 msec units`009*/
X#else
X#include`009<sys/types.h>
X#include`009<sys/times.h>
X#ifndef HERTZ
X#define HERTZ`00960.0`009`009`009`009/* Change for Europe`009*/
X#endif
X#endif
X
Xlong
Xcputime()
X{
X`009struct tms`009tms;
X`009double`009`009temp;
X`009long`009`009result;
X
X`009times(&tms);
X`009result = tms.tms_utime + tms.tms_stime;
X`009temp = result * 1000.0 / HERTZ;`009`009/* Time in msec.`009*/
X`009result = temp;
X`009return (result);
X}
X#endif
X
$ GOSUB UNPACK_FILE
$ FILE_IS = "LZVIO.C"
$ CHECKSUM_IS = 1412617984
$ COPY SYS$INPUT VMS_SHARE_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`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`009static int`009`009flags = (FDL$M_FDL_STRING | SIGNAL_ON_ERROR);
X`009extern FDLSTUFF`009`009*fdl_setup();
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_BIO; /* 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}
-+-+-+-+-+ End of part 2 +-+-+-+-+-