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 3 of 3) Message-ID: <880712063213.2760600f@LBL.Gov> Date: 12 Jul 88 13:32:13 GMT Sender: daemon@ucbvax.BERKELEY.EDU Organization: The Internet Lines: 1198 +-+-+-+ Beginning of part 3 +-+-+-+ X`009if ((r->fab.fab$l_dev & DEV$M_REC) != 0) { X`009 fail(r, "Record only device"); X`009 fdl_close(r); X`009 return (NULL); X`009} X`009r->rab.rab$l_rop = RAB$M_BIO;`009`009/* Block I/O only`009*/ X`009if ((fdl_status = sys$connect(&r->rab)) != RMS$_NORMAL) X`009 return (fail(r, "connecting after open", NULL)); X`009if (fdl_descriptor != NULL) { X`009 /* X`009 * Now, get the file attributes X`009 */ X`009 fdl_descriptor->dsc$w_length = 4096; X`009 fdl_descriptor->dsc$b_dtype = DSC$K_DTYPE_VT; X`009 fdl_descriptor->dsc$b_class = DSC$K_CLASS_D; X`009 fdl_descriptor->dsc$a_pointer = malloc(4096); X`009 fab_add = &r->fab; X`009 rab_add = &r->rab; X`009 if ((fdl_status = fdl$generate( X`009`009 &flags, X`009`009 &fab_add, X`009`009 &rab_add, X`009`009 0, 0, X`009`009 fdl_descriptor, X`009`009 &badblk, X`009`009 &retlen)) != SS$_NORMAL) { X`009`009fdl_free(fdl_descriptor); X`009`009sys$close(&r->fab); X`009`009return(fail(r, "getting fdl info", NULL)); X`009 } X`009 /* X`009 * Success, null-terminate fdl info and squeeze the block. X`009 */ X`009 fdl_descriptor->dsc$a_pointer[retlen] = EOS; X`009 fdl_descriptor->dsc$a_pointer X`009`009= realloc(fdl_descriptor->dsc$a_pointer, retlen + 1); X`009 fdl_descriptor->dsc$w_length = retlen; X`009} X`009return (r); X} X`012 XFDLSTUFF * Xfdl_create(fdl_descriptor, override_filename) Xstruct`009dsc$descriptor`009*fdl_descriptor;`009/* Result descriptor`009*/ Xchar`009`009`009*override_filename;`009/* What to open`009`009*/ X/* X * Create the file, Returns NULL on failure, else a pointer to RMS stuff. X * Which is equivalently a pointer to the RAB. (Note that the RAB points X * in turn to the FAB.) The file is open for writing using fdl_write. X * X * Uses the filename in the descriptor block, or the override filename X * if supplied (non-NULL and not == ""); X * X * If fdl_descriptor is NULL, the override_filename is opened normally. X */ X{ X`009register FDLSTUFF`009*r; X`009int`009`009`009retlen; X`009int`009`009`009badblk; X`009static int`009`009flags = (FDL$M_FDL_STRING | SIGNAL_ON_ERROR); X`009struct`009dsc$descriptor`009newname; X`009struct`009dsc$descriptor`009*newname_ptr; X`009int`009`009`009fid_block[3]; X`009char`009`009`009created_name[NAM$C_MAXRSS + 1]; X`009struct`009dsc$descriptor`009created_name_des = { X`009`009`009`009 NAM$C_MAXRSS, X`009`009`009`009 DSC$K_DTYPE_T, X`009`009`009`009 DSC$K_CLASS_S, X`009`009`009`009 &created_name[0] X`009`009`009`009}; X`009extern FDLSTUFF`009`009*fdl_setup(); X X`009if (fdl_descriptor == NULL) { X`009 if ((r = fdl_setup(override_filename)) == NULL) X`009`009return (NULL); X`009 r->fab.fab$b_fac = FAB$M_PUT | FAB$M_BIO; /* Block I/O only`009*/ X`009 r->fab.fab$l_fop |= (FAB$M_NAM | FAB$M_SQO | FAB$M_BIO); X`009 r->fab.fab$b_org = FAB$C_SEQ;`009/* Sequential only`009*/ X`009 r->fab.fab$b_rfm = FAB$C_UDF;`009/* Undefined format`009*/ X`009 if ((fdl_status = sys$create(&r->fab)) & 01 == 0) X`009`009return (fail(r, "creating (sys$create)")); X`009 goto exit; X`009} X`009if (override_filename == NULL || override_filename[0] == '\0') X`009 newname_ptr = NULL; X`009else { X`009 newname_ptr = &newname; X`009 newname.dsc$w_length = strlen(override_filename); X`009 newname.dsc$b_dtype = DSC$K_DTYPE_T; X`009 newname.dsc$b_class = DSC$K_CLASS_S; X`009 newname.dsc$a_pointer = override_filename; X`009} X`009if ((fdl_status = fdl$create(fdl_descriptor, X`009`009newname_ptr,`009`009/* New file name if any`009`009*/ X`009`0090,`009`009`009/* Default filename`009`009*/ X`009`009&created_name_des,`009/* Resultant filename`009`009*/ X`009`009&fid_block[0],`009`009/* File ID block`009`009*/ X`009`009&flags,`009`009`009/* FDL flag bits`009`009*/ X`009`0090,`009`009`009/* Statement number`009`009*/ X`009`009&retlen,`009`009/* Created name length`009`009*/ X`009`0090, 0)`009`009`009/* Create status, stv`009`009*/ X`009`009) & 01 == 0) { X`009 return(fail(NULL, "creating (fdl$create)", NULL)); X`009} X`009created_name[retlen] = '\0'; X`009if ((r = fdl_setup(created_name)) == NULL) X`009 return (NULL); X`009/* X`009 * Now, open the file for output. X`009 */ X`009r->fab.fab$b_fac = FAB$M_PUT | FAB$M_BIO; /* Block I/O only`009*/ X`009if ((fdl_status = sys$open(&r->fab)) != RMS$_NORMAL) { X`009 return (fail(r, "opening created file", NULL)); X`009} Xexit:`009if ((r->fab.fab$l_dev & DEV$M_REC) != 0) { X`009 fail(r, "Record only device"); X`009 fdl_close(r); X`009 return (NULL); X`009} X`009r->rab.rab$l_rop = RAB$M_BIO;`009`009/* Block I/O only`009*/ X`009if ((fdl_status = sys$connect(&r->rab)) != RMS$_NORMAL) X`009 return (fail(r, "connecting after create", NULL)); X`009return (r); X} X`012 Xstatic FDLSTUFF * Xfdl_setup(filename) Xchar`009`009*filename; X/* X * Initializes rms blocks and parses file name. Returns the X * FDL data block on success, NULL on error. X */ X{ X`009register FDLSTUFF`009*r; X X`009if ((r = (char *)malloc(sizeof (FDLSTUFF))) == NULL) X`009 return (NULL); X`009r->fab = cc$rms_fab;`009`009`009/* Preset fab,`009`009*/ X`009r->nam = cc$rms_nam;`009`009`009/* name block`009`009*/ X`009r->rab = cc$rms_rab;`009`009`009/* and record block`009*/ X`009r->xab = cc$rms_xabfhc;`009`009`009/* file header block`009*/ X`009r->fab.fab$l_nam = &r->nam;`009`009/* fab -> name block`009*/ X`009r->fab.fab$l_xab = &r->xab;`009`009/* fab -> file header`009*/ X`009r->fab.fab$l_fna = filename;`009`009/* Argument filename`009*/ X`009r->fab.fab$b_fns = strlen(filename);`009/* ... size`009`009*/ X`009r->rab.rab$l_fab = &r->fab;`009`009/* rab -> fab`009`009*/ X`009`009`009`009`009`009/* Stuff the name block`009*/ X`009r->nam.nam$l_esa = r->starname;`009`009/* Expanded filename`009*/ X`009r->nam.nam$b_ess = NAM$C_MAXRSS + 1;`009/* ... size`009`009*/ X`009r->nam.nam$b_rss = NAM$C_MAXRSS + 1;`009/* ... max size`009`009*/ X`009if ((fdl_status = sys$parse(&r->fab)) != RMS$_NORMAL) { X`009 return (fail(r, "parsing", filename)); X`009} X`009((char *)r->nam.nam$l_esa)[r->nam.nam$b_esl] = EOS; X`009r->fab.fab$l_fna = r->nam.nam$l_esa;`009/* File name`009`009*/ X`009r->fab.fab$b_fns = r->nam.nam$b_esl;`009/* Length`009`009*/ X`009r->fab.fab$l_fop |= FAB$M_NAM;`009`009/* Use name block`009*/ X`009return (r); X} X`012 Xfdl_free(fdl_descriptor) Xstruct`009dsc$descriptor`009*fdl_descriptor; X/* X * Release the descriptor X */ X{ X`009if (fdl_descriptor->dsc$a_pointer != NULL) { X`009 free(fdl_descriptor->dsc$a_pointer); X`009 fdl_descriptor->dsc$a_pointer = NULL; X`009} X} X Xfdl_close(r) Xregister FDLSTUFF`009*r; X{ X`009if ((fdl_status = sys$close(&r->fab)) != RMS$_NORMAL) X`009 return(fail(r, "close", NULL)); X`009free(r); X} X`012 Xint Xfdl_read(buffer, buffer_length, r) Xchar`009`009*buffer;`009`009/* Record`009`009`009*/ Xint`009`009buffer_length;`009`009/* Record length`009`009*/ Xregister FDLSTUFF *r;`009`009`009/* Record info.`009`009`009*/ X/* X * Read the next record from the file. Returns number of bytes read or X * -1 on any error. fdl_status has the status. X */ X{ X`009r->rab.rab$l_ubf = buffer; X`009r->rab.rab$w_usz = buffer_length; X`009r->rab.rab$l_bkt = 0; X`009if ((fdl_status = sys$read(&r->rab)) != RMS$_NORMAL) { X#if TESTING_FDLIO X`009 if (fdl_status != RMS$_EOF) { X`009`009fdl_message(r, "error return from sys$read"); X`009`009sleep(1); X`009 } X#endif X`009 return (-1); X`009} X`009return (r->rab.rab$w_rsz); X} X`012 Xint Xfdl_write(buffer, buffer_length, r) Xchar`009`009*buffer;`009`009/* Record`009`009`009*/ Xint`009`009buffer_length;`009`009/* Record length`009`009*/ Xregister FDLSTUFF *r;`009`009`009/* Record info.`009`009`009*/ X/* X * Write the next record to the file. Returns number of bytes written or X * -1 on any error. fdl_status has the status. X */ X{ X`009r->rab.rab$l_rbf = buffer; X`009r->rab.rab$w_rsz = buffer_length; X`009r->rab.rab$l_bkt = 0; X`009if ((fdl_status = sys$write(&r->rab)) != RMS$_NORMAL) { X#if TESTING_FDLIO X`009 fdl_message(r, "error return from sys$write"); X`009 sleep(1); X#endif X`009 return (-1); X`009} X`009return (r->rab.rab$w_rsz); X} X`012 Xfdl_getname(r, buffer) XFDLSTUFF`009*r;`009`009`009/* File pointer`009`009`009*/ Xchar`009`009*buffer;`009`009/* Where to put it`009`009*/ X/* X * Return current file name X */ X{ X`009strcpy(buffer, r->fab.fab$l_fna); X`009return (buffer); X} X Xlong Xfdl_fsize(r) XFDLSTUFF`009*r;`009`009`009/* File pointer`009`009`009*/ X/* X * Return current file size X */ X{ X`009return (((long) r->xab.xab$l_ebk * 512) + r->xab.xab$w_ffb); X} X Xfdl_message(r, why) XFDLSTUFF`009*r; Xchar`009`009*why; X/* X * Print error message X */ X{ X`009extern char`009*vms_etext(); X X`009if (why == NULL) { X`009 fprintf(stderr, "\n%s\n\n", vms_etext(fdl_status)); X`009} X`009else { X`009 fprintf(stderr, "\n%s%s%s: %s\n\n", X`009`009why, X`009`009(why[0] == EOS) ? "" : " ", X`009`009(r == NULL) ? "" : r->fab.fab$l_fna, X`009`009vms_etext(fdl_status)); X`009} X} X Xstatic char`009`009errname[257];`009/* Error text stored here`009*/ Xstatic $DESCRIPTOR(err, errname);`009/* descriptor for error text`009*/ X Xstatic char * Xvms_etext(errorcode) Xint`009`009errorcode; X{ X`009char`009`009*bp; X`009short`009`009errlen;`009`009/* Actual text length`009`009*/ X X`009lib$sys_getmsg(&errorcode, &errlen, &err, &15); X`009/* X`009 * Trim trailing junk. X`009 */ X`009for (bp = &errname[errlen]; --bp >= errname;) { X`009 if (isgraph(*bp) && *bp != ' ') X`009`009break; X`009} X`009bp[1] = EOS; X`009return(errname); X} X Xstatic Xmessage(r, why, name) XFDLSTUFF`009*r;`009`009`009/* Buffer`009`009`009*/ Xchar`009`009*why;`009`009`009/* A little commentary`009`009*/ Xchar`009`009*name;`009`009`009/* File name`009`009`009*/ X/* X * Print error message X */ X{ X`009fprintf(stderr, "\nRMS error %x when %s %s\n", X`009 fdl_status, why, (name == NULL) ? "" : name); X`009fprintf(stderr, "\"%s\"\n", vms_etext(fdl_status)); X} X`012 Xfdl_dump(fdl_descriptor, fd) Xstruct`009dsc$descriptor`009*fdl_descriptor; XFILE`009`009`009*fd; X/* X * Dump the descriptor to fd. X */ X{ X`009register char`009*tp, *end; X X`009tp = fdl_descriptor->dsc$a_pointer; X`009end = tp + fdl_descriptor->dsc$w_length; X`009while (tp < end) { X`009 if (*tp == '"') { X`009`009do { X`009`009 putc(*tp++, fd); X`009`009} while (*tp != '"'); X`009 } X`009 putc(*tp, fd); X`009 if (*tp++ == ';') X`009`009putc('\n', fd); X`009} X} X X`012 X#if`009TESTING_FDLIO X/* X * Test program for rms io X */ X#includeX Xchar`009`009`009line[133]; Xchar`009`009`009filename[133]; Xchar`009`009`009buffer[2048]; X Xmain(argc, argv) Xint`009`009argc; Xchar`009`009*argv[]; X{ X`009FDLSTUFF`009*old; X`009FDLSTUFF`009*new; X`009int`009`009size, total, nrecords; X`009struct`009dsc$descriptor`009fdl_info;`009/* Result descriptor`009*/ X X`009for (;;) { X`009 fprintf(stderr, "Old file name: "); X`009 fflush(stdout); X`009 if (gets(line) == NULL) X`009`009break; X`009 if (line[0] == EOS) X`009`009continue; X`009 if ((old = fdl_open(line, &fdl_info)) == NULL) { X`009`009fprintf(stderr, "open failed\n"); X`009`009continue; X`009 } X`009 fprintf(stderr, "New file name: "); X`009 if (gets(line) == NULL) X`009`009break; X`009 if ((new = fdl_create(&fdl_info, line)) == NULL) { X`009`009fprintf(stderr, "create failed\n"); X`009`009fdl_free(&fdl_info); X`009`009continue; X`009 } X`009 fdl_getname(old, buffer); X`009 fprintf(stderr, "Fdl for \"%s\", size %ld\n", X`009`009buffer, fdl_fsize(old)); X`009 fdl_dump(&fdl_info, stderr); X`009 total = nrecords = 0; X`009 while ((size = fdl_read(buffer, sizeof buffer, old)) > 0) { X`009`009fdl_write(buffer, size, new); X`009`009nrecords++; X`009`009total += size; X`009 } X`009 fdl_close(old); X`009 fdl_close(new); X`009 fprintf(stderr, "copied %d records, %d bytes total\n", X`009`009nrecords, total); X`009 fdl_free(&fdl_info); X`009} X} X X#endif X#endif X $ GOSUB UNPACK_FILE $ FILE_IS = "LZVIOISAM.C" $ CHECKSUM_IS = 660140431 $ 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`009struct`009XABSUM`009xabsum;`009`009/* Summary attributes block`009*/ X`009char`009`009starname[NAM$C_MAXRSS + 1]; /* Wild file name`009*/ X`009char`009`009filename[NAM$C_MAXRSS + 1]; /* Open file name`009*/ X} FDLSTUFF; X Xint`009`009fdl_status;`009`009/* Set to last rms call status`009*/ X Xstatic FDLSTUFF * Xfail(r, why, name) XFDLSTUFF`009*r;`009`009`009/* Buffer`009`009`009*/ Xchar`009`009*why;`009`009`009/* A little commentary`009`009*/ Xchar`009`009*name;`009`009`009/* Argument to perror`009`009*/ X/* X * Problem exit routine X */ X{ X#if TESTING_FDLIO X`009if (name == NULL && r != NULL) X`009 name = r->fab.fab$l_fna; X`009message(r, why, name); X#endif X`009if (r != NULL) X`009 free(r); X`009return (NULL); X} X`012 XFDLSTUFF * Xfdl_open(filename, fdl_descriptor) Xchar`009`009`009*filename;`009`009/* What to open`009`009*/ Xstruct`009dsc$descriptor`009*fdl_descriptor;`009/* Result descriptor`009*/ X/* X * Open the file. Returns NULL on failure, else a pointer to RMS stuff. X * Which is equivalently a pointer to the RAB. (Note that the RAB points X * in turn to the FAB.) X * X * Return the file's fdl descriptor in the user-supplied (uninitialized) X * descriptor. X */ X{ X`009register FDLSTUFF`009*r; X`009int`009`009`009retlen; X`009int`009`009`009badblk; X`009struct FAB`009`009*fab_add; X`009struct RAB`009`009*rab_add; X`009struct XABALL`009`009*xaball; X`009struct XABKEY`009`009*xabkey,*this_xab; X`009static int`009`009flags = (FDL$M_FDL_STRING | SIGNAL_ON_ERROR); X`009extern FDLSTUFF`009`009*fdl_setup(); X`009int`009`009`009i; X X`009if ((r = fdl_setup(filename)) == NULL) X`009 return (NULL); X`009/* X`009 * Now open the file. X`009 */ X`009r->fab.fab$b_fac = FAB$M_GET | FAB$M_BRO; /* Block I/O only`009*/ X`009if ((fdl_status = sys$open(&r->fab)) != RMS$_NORMAL) { X`009 return (fail(r, "opening file", NULL)); X`009} X`009if ((r->fab.fab$l_dev & DEV$M_REC) != 0) { X`009 fail(r, "Record only device"); X`009 fdl_close(r); X`009 return (NULL); X`009} X X`009/* now, we know how many keys (if any) there are in the file, lets X`009 add that many xabkeys */ X`009this_xab = &r->xabsum; X`009for (i=0; i < r->xabsum.xab$b_nok; i++) X`009 { X `009 if ((xabkey = (char *)malloc(sizeof (struct XABKEY) + 32)) == NULL) X`009`009return (NULL); X`009 this_xab->xab$l_nxt = xabkey; X`009 *xabkey = cc$rms_xabkey; X`009 xabkey->xab$b_ref = i; X`009 xabkey->xab$l_knm = xabkey + sizeof(struct XABKEY); X`009 this_xab = xabkey; X`009 xabkey = 0; X`009 } X X`009/* we know how many allocation areas (if any) there are in the X`009 file, lets add that many xaballs and then do a $display */ X`009for (i=0; i < r->xabsum.xab$b_noa; i++) X`009 { X`009 if ((xaball = (char *)malloc(sizeof (struct XABALL))) == NULL) X`009`009return (NULL); X`009 this_xab->xab$l_nxt = xaball; X`009 *xaball = cc$rms_xaball; X`009 xaball->xab$b_aid = i; X`009 this_xab = xaball; X`009 xaball = 0; X`009 } X X`009if ((fdl_status = sys$display(&r->fab)) != RMS$_NORMAL) X`009 return (fail(r, "displaying after adding xabkeys", NULL)); X X`009r->rab.rab$l_rop = RAB$M_BIO;`009`009/* Block I/O only`009*/ X`009if ((fdl_status = sys$connect(&r->rab)) != RMS$_NORMAL) X`009 return (fail(r, "connecting after open", NULL)); X X`009if (fdl_descriptor != NULL) { X`009 /* X`009 * Now, get the file attributes X`009 */ X`009 fdl_descriptor->dsc$w_length = 4096; X`009 fdl_descriptor->dsc$b_dtype = DSC$K_DTYPE_VT; X`009 fdl_descriptor->dsc$b_class = DSC$K_CLASS_D; X`009 fdl_descriptor->dsc$a_pointer = malloc(4096); X`009 fab_add = &r->fab; X`009 rab_add = &r->rab; X`009 if ((fdl_status = fdl$generate( X`009`009 &flags, X`009`009 &fab_add, X`009`009 &rab_add, X`009`009 0, 0, X`009`009 fdl_descriptor, X`009`009 &badblk, X`009`009 &retlen)) != SS$_NORMAL) { X`009`009fdl_free(fdl_descriptor); X`009`009sys$close(&r->fab); X`009`009return(fail(r, "getting fdl info", NULL)); X`009 } X`009 /* X`009 * Success, null-terminate fdl info and squeeze the block. X`009 */ X`009 fdl_descriptor->dsc$a_pointer[retlen] = EOS; X`009 fdl_descriptor->dsc$a_pointer X`009`009= realloc(fdl_descriptor->dsc$a_pointer, retlen + 1); X`009 fdl_descriptor->dsc$w_length = retlen; X`009} X`009return (r); X} X`012 XFDLSTUFF * Xfdl_create(fdl_descriptor, override_filename) Xstruct`009dsc$descriptor`009*fdl_descriptor;`009/* Result descriptor`009*/ Xchar`009`009`009*override_filename;`009/* What to open`009`009*/ X/* X * Create the file, Returns NULL on failure, else a pointer to RMS stuff. X * Which is equivalently a pointer to the RAB. (Note that the RAB points X * in turn to the FAB.) The file is open for writing using fdl_write. X * X * Uses the filename in the descriptor block, or the override filename X * if supplied (non-NULL and not == ""); X * X * If fdl_descriptor is NULL, the override_filename is opened normally. X */ X{ X`009register FDLSTUFF`009*r; X`009int`009`009`009retlen; X`009int`009`009`009badblk; X`009static int`009`009flags = (FDL$M_FDL_STRING | SIGNAL_ON_ERROR); X`009struct`009dsc$descriptor`009newname; X`009struct`009dsc$descriptor`009*newname_ptr; X`009int`009`009`009fid_block[3]; X`009char`009`009`009created_name[NAM$C_MAXRSS + 1]; X`009struct`009dsc$descriptor`009created_name_des = { X`009`009`009`009 NAM$C_MAXRSS, X`009`009`009`009 DSC$K_DTYPE_T, X`009`009`009`009 DSC$K_CLASS_S, X`009`009`009`009 &created_name[0] X`009`009`009`009}; X`009extern FDLSTUFF`009`009*fdl_setup(); X X`009if (fdl_descriptor == NULL) { X`009 if ((r = fdl_setup(override_filename)) == NULL) X`009`009return (NULL); X`009 r->fab.fab$b_fac = FAB$M_PUT | FAB$M_BIO; /* Block I/O only`009*/ X`009 r->fab.fab$l_fop |= (FAB$M_NAM | FAB$M_SQO | FAB$M_BIO); X`009 r->fab.fab$b_org = FAB$C_SEQ;`009/* Sequential only`009*/ X`009 r->fab.fab$b_rfm = FAB$C_UDF;`009/* Undefined format`009*/ X`009 if ((fdl_status = sys$create(&r->fab)) & 01 == 0) X`009`009return (fail(r, "creating (sys$create)")); X`009 goto exit; X`009} X`009if (override_filename == NULL || override_filename[0] == '\0') X`009 newname_ptr = NULL; X`009else { X`009 newname_ptr = &newname; X`009 newname.dsc$w_length = strlen(override_filename); X`009 newname.dsc$b_dtype = DSC$K_DTYPE_T; X`009 newname.dsc$b_class = DSC$K_CLASS_S; X`009 newname.dsc$a_pointer = override_filename; X`009} X`009if ((fdl_status = fdl$create(fdl_descriptor, X`009`009newname_ptr,`009`009/* New file name if any`009`009*/ X`009`0090,`009`009`009/* Default filename`009`009*/ X`009`009&created_name_des,`009/* Resultant filename`009`009*/ X`009`009&fid_block[0],`009`009/* File ID block`009`009*/ X`009`009&flags,`009`009`009/* FDL flag bits`009`009*/ X`009`0090,`009`009`009/* Statement number`009`009*/ X`009`009&retlen,`009`009/* Created name length`009`009*/ X`009`0090, 0)`009`009`009/* Create status, stv`009`009*/ X`009`009) & 01 == 0) { X`009 return(fail(NULL, "creating (fdl$create)", NULL)); X`009} X`009created_name[retlen] = '\0'; X`009if ((r = fdl_setup(created_name)) == NULL) X`009 return (NULL); X`009/* X`009 * Now, open the file for output. X`009 */ X`009r->fab.fab$b_fac = FAB$M_PUT | FAB$M_BIO; /* Block I/O only`009*/ X`009if ((fdl_status = sys$open(&r->fab)) != RMS$_NORMAL) { X`009 return (fail(r, "opening created file", NULL)); X`009} Xexit:`009if ((r->fab.fab$l_dev & DEV$M_REC) != 0) { X`009 fail(r, "Record only device"); X`009 fdl_close(r); X`009 return (NULL); X`009} X`009r->rab.rab$l_rop = RAB$M_BIO;`009`009/* Block I/O only`009*/ X`009if ((fdl_status = sys$connect(&r->rab)) != RMS$_NORMAL) X`009 return (fail(r, "connecting after create", NULL)); X`009return (r); X} X`012 Xstatic FDLSTUFF * Xfdl_setup(filename) Xchar`009`009*filename; X/* X * Initializes rms blocks and parses file name. Returns the X * FDL data block on success, NULL on error. X */ X{ X`009register FDLSTUFF`009*r; X X`009if ((r = (char *)malloc(sizeof (FDLSTUFF))) == NULL) X`009 return (NULL); X`009r->fab = cc$rms_fab;`009`009`009/* Preset fab,`009`009*/ X`009r->nam = cc$rms_nam;`009`009`009/* name block`009`009*/ X`009r->rab = cc$rms_rab;`009`009`009/* and record block`009*/ X`009r->xab = cc$rms_xabfhc;`009`009`009/* file header block`009*/ X`009r->xabsum = cc$rms_xabsum;`009`009/* summary block`009*/ X`009r->fab.fab$l_nam = &r->nam;`009`009/* fab -> name block`009*/ X`009r->fab.fab$l_xab = &r->xab;`009`009/* fab -> file header`009*/ X`009r->xab.xab$l_nxt = &r->xabsum;`009`009/* xabfhc -> xabsum`009*/ X`009r->fab.fab$l_fna = filename;`009`009/* Argument filename`009*/ X`009r->fab.fab$b_fns = strlen(filename);`009/* ... size`009`009*/ X`009r->rab.rab$l_fab = &r->fab;`009`009/* rab -> fab`009`009*/ X`009`009`009`009`009`009/* Stuff the name block`009*/ X`009r->nam.nam$l_esa = r->starname;`009`009/* Expanded filename`009*/ X`009r->nam.nam$b_ess = NAM$C_MAXRSS ;`009/* ... size`009`009*/ X`009r->nam.nam$l_rsa = r->filename;`009`009/* Resultant filename`009*/ X`009r->nam.nam$b_rss = NAM$C_MAXRSS ;`009/* ... max size`009`009*/ X`009if ((fdl_status = sys$parse(&r->fab)) != RMS$_NORMAL) { X`009 return (fail(r, "parsing", filename)); X`009} X`009((char *)r->nam.nam$l_esa)[r->nam.nam$b_esl] = EOS; X`009r->fab.fab$l_fna = r->nam.nam$l_esa;`009/* File name`009`009*/ X`009r->fab.fab$b_fns = r->nam.nam$b_esl;`009/* Length`009`009*/ X`009r->fab.fab$l_fop |= FAB$M_NAM;`009`009/* Use name block`009*/ X`009return (r); X} X`012 Xfdl_free(fdl_descriptor) Xstruct`009dsc$descriptor`009*fdl_descriptor; X/* X * Release the descriptor X */ X{ X`009if (fdl_descriptor->dsc$a_pointer != NULL) { X`009 free(fdl_descriptor->dsc$a_pointer); X`009 fdl_descriptor->dsc$a_pointer = NULL; X`009} X} X Xfdl_close(r) Xregister FDLSTUFF`009*r; X{ X`009if ((fdl_status = sys$close(&r->fab)) != RMS$_NORMAL) X`009 return(fail(r, "close", NULL)); X`009free(r); X} X`012 Xint Xfdl_read(buffer, buffer_length, r) Xchar`009`009*buffer;`009`009/* Record`009`009`009*/ Xint`009`009buffer_length;`009`009/* Record length`009`009*/ Xregister FDLSTUFF *r;`009`009`009/* Record info.`009`009`009*/ X/* X * Read the next record from the file. Returns number of bytes read or X * -1 on any error. fdl_status has the status. X */ X{ X`009r->rab.rab$l_ubf = buffer; X`009r->rab.rab$w_usz = buffer_length; X`009r->rab.rab$l_bkt = 0; X`009if ((fdl_status = sys$read(&r->rab)) != RMS$_NORMAL) { X#if TESTING_FDLIO X`009 if (fdl_status != RMS$_EOF) { X`009`009fdl_message(r, "error return from sys$read"); X`009`009sleep(1); X`009 } X#endif X`009 return (-1); X`009} X`009return (r->rab.rab$w_rsz); X} X`012 Xint Xfdl_write(buffer, buffer_length, r) Xchar`009`009*buffer;`009`009/* Record`009`009`009*/ Xint`009`009buffer_length;`009`009/* Record length`009`009*/ Xregister FDLSTUFF *r;`009`009`009/* Record info.`009`009`009*/ X/* X * Write the next record to the file. Returns number of bytes written or X * -1 on any error. fdl_status has the status. X */ X{ X`009r->rab.rab$l_rbf = buffer; X`009r->rab.rab$w_rsz = buffer_length; X`009r->rab.rab$l_bkt = 0; X`009if ((fdl_status = sys$write(&r->rab)) != RMS$_NORMAL) { X#if TESTING_FDLIO X`009 fdl_message(r, "error return from sys$write"); X`009 sleep(1); X#endif X`009 return (-1); X`009} X`009return (r->rab.rab$w_rsz); X} X`012 Xfdl_getname(r, buffer) XFDLSTUFF`009*r;`009`009`009/* File pointer`009`009`009*/ Xchar`009`009*buffer;`009`009/* Where to put it`009`009*/ X/* X * Return current file name X */ X{ X`009strcpy(buffer, r->fab.fab$l_fna); X`009return (buffer); X} X Xlong Xfdl_fsize(r) XFDLSTUFF`009*r;`009`009`009/* File pointer`009`009`009*/ X/* X * Return current file size X */ X{ X`009return (((long) r->xab.xab$l_ebk * 512) + r->xab.xab$w_ffb); X} X Xfdl_message(r, why) XFDLSTUFF`009*r; Xchar`009`009*why; X/* X * Print error message X */ X{ X`009extern char`009*vms_etext(); X X`009if (why == NULL) { X`009 fprintf(stderr, "\n%s\n\n", vms_etext(fdl_status)); X`009} X`009else { X`009 fprintf(stderr, "\n%s%s%s: %s\n\n", X`009`009why, X`009`009(why[0] == EOS) ? "" : " ", X`009`009(r == NULL) ? "" : r->fab.fab$l_fna, X`009`009vms_etext(fdl_status)); X`009} X} X Xstatic char`009`009errname[257];`009/* Error text stored here`009*/ Xstatic $DESCRIPTOR(err, errname);`009/* descriptor for error text`009*/ X Xstatic char * Xvms_etext(errorcode) Xint`009`009errorcode; X{ X`009char`009`009*bp; X`009short`009`009errlen;`009`009/* Actual text length`009`009*/ X X`009lib$sys_getmsg(&errorcode, &errlen, &err, &15); X`009/* X`009 * Trim trailing junk. X`009 */ X`009for (bp = &errname[errlen]; --bp >= errname;) { X`009 if (isgraph(*bp) && *bp != ' ') X`009`009break; X`009} X`009bp[1] = EOS; X`009return(errname); X} X Xstatic Xmessage(r, why, name) XFDLSTUFF`009*r;`009`009`009/* Buffer`009`009`009*/ Xchar`009`009*why;`009`009`009/* A little commentary`009`009*/ Xchar`009`009*name;`009`009`009/* File name`009`009`009*/ X/* X * Print error message X */ X{ X`009fprintf(stderr, "\nRMS error %x when %s %s\n", X`009 fdl_status, why, (name == NULL) ? "" : name); X`009fprintf(stderr, "\"%s\"\n", vms_etext(fdl_status)); X} X`012 Xfdl_dump(fdl_descriptor, fd) Xstruct`009dsc$descriptor`009*fdl_descriptor; XFILE`009`009`009*fd; X/* X * Dump the descriptor to fd. X */ X{ X`009register char`009*tp, *end; X X`009tp = fdl_descriptor->dsc$a_pointer; X`009end = tp + fdl_descriptor->dsc$w_length; X`009while (tp < end) { X`009 if (*tp == '"') { X`009`009do { X`009`009 putc(*tp++, fd); X`009`009} while (*tp != '"'); X`009 } X`009 putc(*tp, fd); X`009 if (*tp++ == ';') X`009`009putc('\n', fd); X`009} X} X X`012 X#if`009TESTING_FDLIO X/* X * Test program for rms io X */ X#include X Xchar`009`009`009line[133]; Xchar`009`009`009filename[133]; Xchar`009`009`009buffer[2048]; X Xmain(argc, argv) Xint`009`009argc; Xchar`009`009*argv[]; X{ X`009FDLSTUFF`009*old; X`009FDLSTUFF`009*new; X`009int`009`009size, total, nrecords; X`009struct`009dsc$descriptor`009fdl_info;`009/* Result descriptor`009*/ X X`009for (;;) { X`009 fprintf(stderr, "Old file name: "); X`009 fflush(stdout); X`009 if (gets(line) == NULL) X`009`009break; X`009 if (line[0] == EOS) X`009`009continue; X`009 if ((old = fdl_open(line, &fdl_info)) == NULL) { X`009`009fprintf(stderr, "open failed\n"); X`009`009continue; X`009 } X`009 fprintf(stderr, "New file name: "); X`009 if (gets(line) == NULL) X`009`009break; X`009 if ((new = fdl_create(&fdl_info, line)) == NULL) { X`009`009fprintf(stderr, "create failed\n"); X`009`009fdl_free(&fdl_info); X`009`009continue; X`009 } X`009 fdl_getname(old, buffer); X`009 fprintf(stderr, "Fdl for \"%s\", size %ld\n", X`009`009buffer, fdl_fsize(old)); X`009 fdl_dump(&fdl_info, stderr); X`009 total = nrecords = 0; X`009 while ((size = fdl_read(buffer, sizeof buffer, old)) > 0) { X`009`009fdl_write(buffer, size, new); X`009`009nrecords++; X`009`009total += size; X`009 } X`009 fdl_close(old); X`009 fdl_close(new); X`009 fprintf(stderr, "copied %d records, %d bytes total\n", X`009`009nrecords, total); X`009 fdl_free(&fdl_info); X`009} X} X X#endif X#endif X $ GOSUB UNPACK_FILE $ FILE_IS = "MAKEFILE.TXT" $ CHECKSUM_IS = 711590732 $ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY X# Unix makefile for lzcomp, lzdcmp X# X# The redefinition of strchr() and strrchr() are needed for X# Ultrix-32, Unix 4.2 bsd (and maybe some other Unices). X# XBSDDEFINE = -Dstrchr=index -Dstrrchr=rindex X# X# On certain systems, such as Unix System III, you may need to define X# $(LINTFLAGS) in the make command line to set system-specific lint flags. X# X XCFLAGS = -O $(BSDDEFINES) X Xall`009: lzcomp lzdcmp X X# X# ** compile lzcomp X# XLZCOMP_SRCS = lzcmp1.c lzcmp2.c lzcmp3.c lzio.c XLZCOMP_OBJS = lzcmp1.o lzcmp2.o lzcmp3.o lzio.o Xlzcomp: $(LZCOMP_OBJS) X`009$(CC) $(CFLAGS) $(LZCOMP_OBJS) -o lzcomp X X# X# ** compile lzdcmp X# XLZDCMP_SRCS = lzdcm1.c lzdcm2.c lzdcm3.c lzio.c XLZDCMP_OBJS = lzdcm1.o lzdcm2.o lzdcm3.o lzio.o Xlzdcmp: $(LZDCMP_OBJS) X`009$(CC) $(CFLAGS) $(LZDCMP_OBJS) -o lzdcmp X X# X# ** Lint the code X# Xlint:`009$(LZCOMP_SRCS) $(LZDCMP_SRCS) X`009lint $(LINTFLAGS) $(DEFINES) $(LZCOMP_SRCS) X`009lint $(LINTFLAGS) $(DEFINES) $(LZDCMP_SRCS) X X# X# ** Remove unneeded files X# Xclean: X`009rm -f $(OBJS) lzcomp lzdcmp X X# X# ** Rebuild the archive files X# ** Uses the Decus C archive utility. X# Xarchive: X`009cp Makefile makefile.txt X`009archc lzcmp1.c lzcmp2.c lzcmp3.c >lz1.arc X`009archc lzdcm1.c lzdcm2.c lzdcm3.c >lz2.arc X`009archc lz.h lzio.c lzvio.c makefile.txt >lz3.arc X X# X# Object module dependencies X# X Xlzcmp1.o`009:`009lzcmp1.c lz.h X Xlzcmp2.o`009:`009lzcmp2.c lz.h X Xlzcmp3.o`009:`009lzcmp3.c lz.h X Xlzio.o`009`009:`009lzio.c lz.h X Xlzdcm1.o`009:`009lzdcm1.c lz.h X Xlzdcm2.o`009:`009lzdcm2.c lz.h X Xlzdcm3.o`009:`009lzdcm3.c lz.h X X $ GOSUB UNPACK_FILE $ FILE_IS = "README.TXT" $ CHECKSUM_IS = 5852823 $ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY XThis is a rewrite of the Unix compress utility. It is *not* Xswitch-compatible with Unix compress, however it is (almost) Xfile-compatible (when compiled on Unix, or when "export" mode Xis selected on VMS Version 4). X XThe advantages of this version are as follows: X X1. Compress and decompress are separate programs, simplifying the X problems of the small system implementor. Both run on an X unmapped PDP-11 (with a maximum of 12 bits). X X The command interface is just X X`009lzcomp input compressed_output X`009lzdcmp compressed_input output X X Input files are not deleted. X X2. The compression algorithm and I/O design is intended to simplify X embedding the programs (as subroutines) in some other task. X (for example, in a database package.) X X3. On non-Unix systems, the I/O design should be significantly X faster. It should be slightly faster on Unix. X XThe only disadvantage is that, as noted, it is not command (option) Xcompatible with Unix compress. Also, some periferal functionality X(such as the deletion of input files and the output file naming Xconventions) have not been implemented. X XOn Unix (i.e., in "export" mode), the compressed data file is Xidentical to the Unix file, *except* that lzcomp writes two XCLEAR codes in a row to signal end-of-file (and lzdcmp treats Xtwo CLEAR codes in a row as signalling end-of-file). X Xlzcomp and lzdcmp have been added to the Decus C distribution. X XMartin Minow Xdecvax!minow, Xminow%rex.dec@decwrl.arpa X $ GOSUB UNPACK_FILE $ FILE_IS = "RULES.MMS" $ CHECKSUM_IS = 174682289 $ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY X! X! This MMS file has rules and definitions used in DESCRIP.MMS for LZW X! X! Redefined rules... X! X.SUFFIXES X.SUFFIXES .OLB .OPT .LIS .LST .H .OBJ .C .MSG .C~ .H~ .MSG~ X X.C.LIS X`009$(CC) $(CLIST) $(MMS$SOURCE) X.MAR.LIS X`009$(MACRO) $(MLIST) $(MMS$SOURCE) X.MSG.LIS X`009MESSAGE $(MSGLIST) $(MMS$SOURCE) X.OBJ.OLB X`009$(LIBR) $(LIBRFLAGS) $(MMS$TARGET) $(MMS$SOURCE) X`009DELETE $(MMS$SOURCE);* X.C.OLB X`009$(CC) $(CFLAGS) $(MMS$SOURCE) X`009 mms_object = "$(MMS$SOURCE)" - ".C" + ".OBJ" X`009$(LIBR) $(LIBRFLAGS) $(MMS$TARGET) 'mms_object' X`009DELETE 'mms_object';* X.MSG.OLB X`009MESSAGE $(MSGFLAGS) $(MMS$SOURCE) X`009 mms_object = "$(MMS$SOURCE)" - ".MSG" + ".OBJ" X`009$(LIBR) $(LIBRFLAGS) $(MMS$TARGET) 'mms_object' X`009DELETE 'mms_object';* X! X! Macros X! X.IFDEF`009LIST XCFLAGS = /LIST /SHOW=SYMBOLS /OBJECT=$(MMS$TARGET_NAME) XMFLAGS = /LIST /CROSS_REFERENCE /OBJECT=$(MMS$TARGET_NAME) XMSGFLAGS = /LIST /OBJECT=$(MMS$TARGET_NAME) X.ENDIF X X.IFDEF`009DEBUG XCFLAGS = /DEBUG /NOOPTIMIZE /OBJECT=$(MMS$TARGET_NAME) XMFLAGS = /DEBUG /OBJECT=$(MMS$TARGET_NAME) XLINKFLAGS = /DEBUG /EXECUTABLE=$(MMS$TARGET_NAME) X.ELSE XLINKFLAGS = /NOTRACEBACK /EXECUTABLE=$(MMS$TARGET_NAME) X.ENDIF X XCODE_WHERE = INTERSPERSED X XCLIST = /LIST=$(MMS$TARGET_NAME) /SHOW=SYMBOLS /NOOBJECT X XMLIST = /LIST=$(MMS$TARGET_NAME) /CROSS_REFERENCE /NOOBJECT XMSGLIST = /LIST=$(MMS$TARGET_NAME) /NOOBJECT $ GOSUB UNPACK_FILE $ EXIT -+-+-+-+-+ End of part 3 +-+-+-+-+-