summaryrefslogtreecommitdiff
path: root/vms/vms_im.c
diff options
context:
space:
mode:
Diffstat (limited to 'vms/vms_im.c')
-rw-r--r--vms/vms_im.c926
1 files changed, 926 insertions, 0 deletions
diff --git a/vms/vms_im.c b/vms/vms_im.c
new file mode 100644
index 0000000..001088b
--- /dev/null
+++ b/vms/vms_im.c
@@ -0,0 +1,926 @@
+/*
+ Copyright (c) 1990-2007 Info-ZIP. All rights reserved.
+
+ See the accompanying file LICENSE, version 2007-Mar-4 or later
+ (the contents of which are also included in zip.h) for terms of use.
+ If, for some reason, all these files are missing, the Info-ZIP license
+ also may be found at: ftp://ftp.info-zip.org/pub/infozip/license.html
+*/
+/*
+ * vms_im.c (zip) by Igor Mandrichenko Version 2.2-2
+ *
+ * Revision history:
+ * ...
+ * 2.1-1 16-feb-1993 I.Mandrichenko
+ * Get file size from XABFHC and check bytes rest in file before
+ * reading.
+ * 2.1-2 2-mar-1993 I.Mandrichenko
+ * Make code more standard
+ * 2.2 21-jun-1993 I.Mandrichenko
+ * Free all allocated space, use more static storage.
+ * Use memcompress() from bits.c (deflation) for block compression.
+ * To revert to old compression method #define OLD_COMPRESS
+ * 2.2-2 28-sep-1995 C.Spieler
+ * Reorganized code for easier maintance of the two incompatible
+ * flavours (IM style and PK style) VMS attribute support.
+ * Generic functions (common to both flavours) are now collected
+ * in a `wrapper' source file that includes one of the VMS attribute
+ * handlers.
+ * 3.0 23-Oct-2004 Steven Schweda
+ * Changed to maintain compatibility with VMS_PK.C. Note that
+ * reading with sys$read() prevents getting any data past EOF,
+ * regardless of appearances. Moved the VMS_PK_EXTRA test into
+ * here from VMS.C to allow more general automatic dependency
+ * generation.
+ * 17-Feb-2005 Steven Schweda
+ * Added support for ODS5 extended names.
+ */
+
+#ifdef VMS /* For VMS only ! */
+
+#ifndef VMS_PK_EXTRA
+
+#define OLD_COMPRESS /*To use old compression method define it.*/
+
+#ifdef VMS_ZIP
+#undef VMS_ZIP /* do NOT include PK style Zip definitions */
+#endif
+
+#include "vms.h"
+
+#ifndef __LIB$ROUTINES_LOADED
+#include <lib$routines.h>
+#endif
+
+#ifndef UTIL
+
+#define RET_ERROR 1
+#define RET_SUCCESS 0
+#define RET_EOF 0
+
+#define Kbyte 1024
+
+typedef struct XAB *xabptr;
+
+/*
+ * Block sizes
+ */
+
+#define EXTL0 ((FABL + EXTHL)+ \
+ (XFHCL + EXTHL)+ \
+ (XPROL + EXTHL)+ \
+ (XDATL + EXTHL)+ \
+ (XRDTL + EXTHL))
+
+#ifdef OLD_COMPRESS
+#define PAD sizeof(uch)
+#else
+#define PAD 10*sizeof(ush) /* Two extra bytes for compr. header */
+#endif
+
+#define PAD0 (5*PAD) /* Reserve space for the case when
+ * compression fails */
+static int _compress(uch *from, uch *to, int size);
+#ifdef DEBUG
+static void dump_rms_block(uch *p);
+#endif /* DEBUG */
+
+/********************************
+ * Function set_extra_field *
+ ********************************/
+/*
+ | 2004-11-11 SMS.
+ | Changed to use separate storage for ->extra and ->cextra. Zip64
+ | processing may move (reallocate) one and not the other.
+ */
+
+static uch *_compress_block(register struct IZ_block *to,
+ uch *from, int size, char *sig);
+static int get_vms_version(char *verbuf, int len);
+
+int set_extra_field(z, z_utim)
+ struct zlist far *z;
+ iztimes *z_utim;
+/*
+ * Get file VMS file attributes and store them into extent fields.
+ * Store VMS version also.
+ * On error leave z intact.
+ */
+{
+ int status;
+ uch *xtra;
+ uch *cxtra;
+ uch *scan;
+ extent extra_l;
+ static struct FAB fab;
+ static struct NAM_STRUCT nam;
+ static struct XABSUM xabsum;
+ static struct XABFHC xabfhc;
+ static struct XABDAT xabdat;
+ static struct XABPRO xabpro;
+ static struct XABRDT xabrdt;
+ xabptr x = (xabptr)NULL, xab_chain = (xabptr)NULL, last_xab = (xabptr)NULL;
+ int nk, na;
+ int i;
+ int rc=RET_ERROR;
+ char verbuf[80];
+ int verlen = 0;
+
+ if (!vms_native)
+ {
+#ifdef USE_EF_UT_TIME
+ /*
+ * A `portable' zipfile entry is created. Create an "UT" extra block
+ * containing UNIX style modification time stamp in UTC, which helps
+ * maintaining the `real' "last modified" time when the archive is
+ * transfered across time zone boundaries.
+ */
+# ifdef IZ_CHECK_TZ
+ if (!zp_tz_is_valid)
+ return ZE_OK; /* skip silently if no valid TZ info */
+# endif
+ if ((xtra = (uch *) malloc( EB_HEADSIZE+ EB_UT_LEN( 1))) == NULL)
+ return ZE_MEM;
+
+ if ((cxtra = (uch *) malloc( EB_HEADSIZE+ EB_UT_LEN( 1))) == NULL)
+ return ZE_MEM;
+
+ /* Fill xtra[] with data. */
+ xtra[ 0] = 'U';
+ xtra[ 1] = 'T';
+ xtra[ 2] = EB_UT_LEN(1); /* length of data part of e.f. */
+ xtra[ 3] = 0;
+ xtra[ 4] = EB_UT_FL_MTIME;
+ xtra[ 5] = (uch) (z_utim->mtime);
+ xtra[ 6] = (uch) (z_utim->mtime >> 8);
+ xtra[ 7] = (uch) (z_utim->mtime >> 16);
+ xtra[ 8] = (uch) (z_utim->mtime >> 24);
+
+ /* Copy xtra[] data into cxtra[]. */
+ memcpy( cxtra, xtra, (EB_HEADSIZE+ EB_UT_LEN( 1)));
+
+ /* Set sizes and pointers. */
+ z->cext = z->ext = (EB_HEADSIZE+ EB_UT_LEN( 1));
+ z->extra = (char *) xtra;
+ z->cextra = (char *) cxtra;
+
+#endif /* USE_EF_UT_TIME */
+
+ return RET_SUCCESS;
+ }
+
+ /*
+ * Initialize RMS control blocks and link them
+ */
+
+ fab = cc$rms_fab;
+ nam = CC_RMS_NAM;
+ xabsum = cc$rms_xabsum;
+ xabdat = cc$rms_xabdat;
+ xabfhc = cc$rms_xabfhc;
+ xabpro = cc$rms_xabpro;
+ xabrdt = cc$rms_xabrdt;
+
+ fab.FAB_NAM = &nam;
+ fab.fab$l_xab = (char*)&xabsum;
+ /*
+ * Open the file and read summary information.
+ */
+
+#ifdef NAML$C_MAXRSS
+
+ fab.fab$l_dna = (char *) -1; /* Using NAML for default name. */
+ fab.fab$l_fna = (char *) -1; /* Using NAML for file name. */
+
+#endif /* def NAML$C_MAXRSS */
+
+ FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNA = z->name;
+ FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNS = strlen( z->name);
+
+#ifdef NAML$M_OPEN_SPECIAL
+ /* 2007-02-28 SMS.
+ * If processing symlinks as symlinks ("-y"), then $OPEN the
+ * link, not the target file.
+ *
+ * (nam.naml$v_open_special gets us the symlink itself instead of
+ * its target. fab.fab$v_bio is necessary to allow sys$open() to
+ * work. Without it, you get status %x0001860c, "%RMS-F-ORG,
+ * invalid file organization value".)
+ */
+ if (linkput)
+ {
+ nam.naml$v_open_special = 1;
+ fab.fab$v_bio = 1;
+ }
+#endif /* def NAML$M_OPEN_SPECIAL */
+
+ status = sys$open(&fab);
+ if (ERR(status))
+ {
+#ifdef DEBUG
+ printf("set_extra_field: sys$open for file %s:\n error status = %d\n",
+ z->name, status);
+#endif
+ goto err_exit;
+ }
+
+ nk = xabsum.xab$b_nok;
+ na = xabsum.xab$b_noa;
+#ifdef DEBUG
+ printf("%d keys, %d alls\n", nk, na);
+#endif
+
+ /*
+ * Allocate XABKEY and XABALL blocks and link them
+ */
+
+ xabfhc.xab$l_nxt = (char*)&xabdat;
+ xabdat.xab$l_nxt = (char*)&xabpro;
+ xabpro.xab$l_nxt = (char*)&xabrdt;
+ xabrdt.xab$l_nxt = NULL;
+
+ xab_chain = (xabptr)(&xabfhc);
+ last_xab = (xabptr)(&xabrdt);
+
+#define INIT(ptr,size,type,init) \
+ if ( (ptr = (type *)malloc(size)) == NULL ) \
+ { \
+ printf( "set_extra_field: Insufficient memory.\n" ); \
+ goto err_exit; \
+ } \
+ *(ptr) = (init);
+ /*
+ * Allocate and initialize all needed XABKEYs and XABALLs
+ */
+ for (i = 0; i < nk; i++)
+ {
+ struct XABKEY *k;
+ INIT(k, XKEYL, struct XABKEY, cc$rms_xabkey);
+ k->xab$b_ref = i;
+ if (last_xab != NULL)
+ last_xab->xab$l_nxt = (char*)k;
+ last_xab = (xabptr)k;
+ }
+ for (i = 0; i < na; i++)
+ {
+ struct XABALL *a;
+ INIT(a, XALLL, struct XABALL, cc$rms_xaball);
+ a->xab$b_aid = i;
+ if (last_xab != NULL)
+ last_xab->xab$l_nxt = (char*)a;
+ last_xab = (xabptr)a;
+ }
+
+ fab.fab$l_xab = (char*)xab_chain;
+#ifdef DEBUG
+ printf("Dump of XAB chain before $DISPLAY:\n");
+ for (x = xab_chain; x != NULL; x = x->xab$l_nxt)
+ dump_rms_block((uch *)x);
+#endif
+ /*
+ * Get information on the file structure etc.
+ */
+ status = sys$display(&fab, 0, 0);
+ if (ERR(status))
+ {
+#ifdef DEBUG
+ printf("set_extra_field: sys$display for file %s:\n error status = %d\n",
+ z->name, status);
+#endif
+ goto err_exit;
+ }
+
+#ifdef DEBUG
+ printf("\nDump of XAB chain after $DISPLAY:\n");
+ for (x = xab_chain; x != NULL; x = x->xab$l_nxt)
+ dump_rms_block((uch *)x);
+#endif
+
+ fab.fab$l_xab = NULL; /* Keep XABs */
+ status = sys$close(&fab);
+ if (ERR(status))
+ {
+#ifdef DEBUG
+ printf("set_extra_field: sys$close for file %s:\n error status = %d\n",
+ z->name, status);
+#endif
+ goto err_exit;
+ }
+
+ extra_l = EXTL0 + nk * (XKEYL + EXTHL) + na * (XALLL + EXTHL);
+#ifndef OLD_COMPRESS
+ extra_l += PAD0 + (nk+na) * PAD;
+#endif
+
+ if ( (verlen = get_vms_version(verbuf, sizeof(verbuf))) > 0 )
+ {
+ extra_l += verlen + EXTHL;
+#ifndef OLD_COMPRESS
+ extra_l += PAD;
+#endif
+ }
+
+ if ((scan = xtra = (uch *) malloc( extra_l)) == (uch*)NULL)
+ {
+#ifdef DEBUG
+ printf(
+ "set_extra_field: Insufficient memory to allocate extra L buffer\n");
+#endif
+ goto err_exit;
+ }
+
+ if ((cxtra = (uch *) malloc( extra_l)) == (uch*)NULL)
+ {
+#ifdef DEBUG
+ printf(
+ "set_extra_field: Insufficient memory to allocate extra C buffer\n");
+#endif
+ goto err_exit;
+ }
+
+ if (verlen > 0)
+ scan = _compress_block((struct IZ_block *)scan, (uch *)verbuf,
+ verlen, VERSIG);
+
+ /*
+ * Zero all unusable fields to improve compression
+ */
+ fab.fab$b_fns = fab.fab$b_shr = fab.fab$b_dns = fab.fab$b_fac = 0;
+ fab.fab$w_ifi = 0;
+ fab.fab$l_stv = fab.fab$l_sts = fab.fab$l_ctx = 0;
+ fab.fab$l_dna = NULL;
+ fab.fab$l_fna = NULL;
+ fab.fab$l_nam = NULL;
+#ifdef NAML$C_MAXRSS
+ fab.fab$l_naml = NULL;
+#endif /* def NAML$C_MAXRSS */
+ fab.fab$l_xab = NULL;
+
+#ifdef DEBUG
+ dump_rms_block( (uch *)&fab );
+#endif
+ scan = _compress_block((struct IZ_block *)scan, (uch *)&fab, FABL, FABSIG);
+ for (x = xab_chain; x != NULL;)
+ {
+ int bln;
+ char *sig;
+ xabptr next;
+
+ next = (xabptr)(x->xab$l_nxt);
+ x->xab$l_nxt = 0;
+
+ switch (x->xab$b_cod)
+ {
+ case XAB$C_ALL:
+ bln = XALLL;
+ sig = XALLSIG;
+ break;
+ case XAB$C_KEY:
+ bln = XKEYL;
+ sig = XKEYSIG;
+ break;
+ case XAB$C_PRO:
+ bln = XPROL;
+ sig = XPROSIG;
+ break;
+ case XAB$C_FHC:
+ bln = XFHCL;
+ sig = XFHCSIG;
+ break;
+ case XAB$C_DAT:
+ bln = XDATL;
+ sig = XDATSIG;
+ break;
+ case XAB$C_RDT:
+ bln = XRDTL;
+ sig = XRDTSIG;
+ break;
+ default:
+ bln = 0;
+ sig = 0L;
+ break;
+ }
+ if (bln > 0)
+ scan = _compress_block((struct IZ_block *)scan, (uch *)x,
+ bln, sig);
+ x = next;
+ }
+
+ /* Copy xtra[] data into cxtra[]. */
+ memcpy( cxtra, xtra, (scan- xtra));
+
+ /* Set sizes and pointers. */
+ z->cext = z->ext = scan- xtra;
+ z->extra = (char*) xtra;
+ z->cextra = (char*) cxtra;
+
+ rc = RET_SUCCESS;
+
+err_exit:
+ /*
+ * Give up all allocated blocks
+ */
+ for (x = (struct XAB *)xab_chain; x != NULL; )
+ {
+ struct XAB *next;
+ next = (xabptr)(x->xab$l_nxt);
+ if (x->xab$b_cod == XAB$C_ALL || x->xab$b_cod == XAB$C_KEY)
+ free(x);
+ x = next;
+ }
+ return rc;
+}
+
+static int get_vms_version(verbuf, len)
+char *verbuf;
+int len;
+{
+ int i = SYI$_VERSION;
+ int verlen = 0;
+ struct dsc$descriptor version;
+ char *m;
+
+ version.dsc$a_pointer = verbuf;
+ version.dsc$w_length = len - 1;
+ version.dsc$b_dtype = DSC$K_DTYPE_B;
+ version.dsc$b_class = DSC$K_CLASS_S;
+
+ if (ERR(lib$getsyi(&i, 0, &version, &verlen, 0, 0)) || verlen == 0)
+ return 0;
+
+ /* Cut out trailing spaces "V5.4-3 " -> "V5.4-3" */
+ for (m = verbuf + verlen, i = verlen - 1; i > 0 && verbuf[i] == ' '; --i)
+ --m;
+ *m = 0;
+
+ /* Cut out release number "V5.4-3" -> "V5.4" */
+ if ((m = strrchr(verbuf, '-')) != NULL)
+ *m = 0;
+ return strlen(verbuf) + 1; /* Transmit ending 0 too */
+}
+
+#define CTXSIG ((ulg)('CtXx'))
+
+typedef struct user_context
+{
+ ulg sig;
+ struct FAB *fab;
+ struct NAM_STRUCT *nam;
+ struct RAB *rab;
+ uzoff_t size;
+ uzoff_t rest;
+ int status;
+} Ctx, *Ctxptr;
+
+Ctx init_ctx =
+{
+ CTXSIG,
+ NULL,
+ NULL,
+ NULL,
+ 0L,
+ 0L,
+ 0
+};
+
+#define CTXL sizeof(Ctx)
+#define CHECK_RAB(_r) ( (_r) != NULL && \
+ (_r) -> rab$b_bid == RAB$C_BID && \
+ (_r) -> rab$b_bln == RAB$C_BLN && \
+ (_r) -> rab$l_ctx != 0 && \
+ (_r) -> rab$l_fab != NULL )
+
+
+#define BLOCK_BYTES 512
+
+/**************************
+ * Function vms_open *
+ **************************/
+struct RAB *vms_open(name)
+ char *name;
+{
+ struct FAB *fab;
+ struct NAM_STRUCT *nam;
+ struct RAB *rab;
+ struct XABFHC *fhc;
+ Ctxptr ctx;
+
+ if ((fab = (struct FAB *) malloc(FABL)) == NULL)
+ return NULL;
+
+ if ((nam =
+ (struct NAM_STRUCT *) malloc( sizeof( struct NAM_STRUCT))) == NULL)
+ {
+ free(fab);
+ return NULL;
+ }
+
+ if ((rab = (struct RAB *) malloc(RABL)) == NULL)
+ {
+ free(fab);
+ free(nam);
+ return NULL;
+ }
+
+ if ((fhc = (struct XABFHC *) malloc(XFHCL)) == (struct XABFHC *)NULL)
+ {
+ free(fab);
+ free(nam);
+ free(rab);
+ return (struct RAB *)NULL;
+ }
+ if ((ctx = (Ctxptr) malloc(CTXL)) == (Ctxptr)NULL)
+ {
+ free(fab);
+ free(nam);
+ free(rab);
+ free(fhc);
+ return (struct RAB *)NULL;
+ }
+ *fab = cc$rms_fab;
+ *nam = CC_RMS_NAM;
+ *rab = cc$rms_rab;
+ *fhc = cc$rms_xabfhc;
+
+ fab->FAB_NAM = nam;
+
+#ifdef NAML$C_MAXRSS
+
+ fab->fab$l_dna = (char *) -1; /* Using NAML for default name. */
+ fab->fab$l_fna = (char *) -1; /* Using NAML for file name. */
+
+#endif /* def NAML$C_MAXRSS */
+
+ FAB_OR_NAML( fab, nam)->FAB_OR_NAML_FNA = name;
+ FAB_OR_NAML( fab, nam)->FAB_OR_NAML_FNS = strlen( name);
+
+ fab->fab$b_fac = FAB$M_GET | FAB$M_BIO;
+ fab->fab$l_xab = (char*)fhc;
+
+#ifdef NAML$M_OPEN_SPECIAL
+ /* 2007-02-28 SMS.
+ * If processing symlinks as symlinks ("-y"), then $OPEN the
+ * link, not the target file. (Note that here the required
+ * fab->fab$v_bio flag was set above.)
+ */
+ if (linkput)
+ {
+ nam->naml$v_open_special = 1;
+ }
+#endif /* def NAML$M_OPEN_SPECIAL */
+
+ if (ERR(sys$open(fab)))
+ {
+ sys$close(fab);
+ free(fab);
+ free(nam);
+ free(rab);
+ free(fhc);
+ free(ctx);
+ return (struct RAB *)NULL;
+ }
+
+ rab->rab$l_fab = fab;
+ rab->rab$l_rop = RAB$M_BIO;
+
+ if (ERR(sys$connect(rab)))
+ {
+ sys$close(fab);
+ free(fab);
+ free(nam);
+ free(rab);
+ free(ctx);
+ return (struct RAB *)NULL;
+ }
+
+ *ctx = init_ctx;
+ ctx->fab = fab;
+ ctx->nam = nam;
+ ctx->rab = rab;
+
+ if (fhc->xab$l_ebk == 0)
+ {
+ /* Only known size is all allocated blocks.
+ (This occurs with a zero-length file, for example.)
+ */
+ ctx->size =
+ ctx->rest = ((uzoff_t) fhc->xab$l_hbk)* BLOCK_BYTES;
+ }
+ else
+ {
+ /* Store normal (used) size in ->size.
+ If only one -V, store normal (used) size in ->rest.
+ If -VV, store allocated-blocks size in ->rest.
+ */
+ ctx->size =
+ (((uzoff_t) fhc->xab$l_ebk)- 1)* BLOCK_BYTES+ fhc->xab$w_ffb;
+ if (vms_native < 2)
+ ctx->rest = ctx->size;
+ else
+ ctx->rest = ((uzoff_t) fhc->xab$l_hbk)* BLOCK_BYTES;
+ }
+
+ free(fhc);
+ fab->fab$l_xab = NULL;
+ rab->rab$l_ctx = (unsigned) ctx;
+ return rab;
+}
+
+/**************************
+ * Function vms_close *
+ **************************/
+int vms_close(rab)
+ struct RAB *rab;
+{
+ struct FAB *fab;
+ struct NAM_STRUCT *nam;
+ Ctxptr ctx;
+
+ if (!CHECK_RAB(rab))
+ return RET_ERROR;
+ fab = (ctx = (Ctxptr)(rab->rab$l_ctx))->fab;
+ nam = (ctx = (Ctxptr)(rab->rab$l_ctx))->nam;
+ sys$close(fab);
+
+ free(fab);
+ free(nam);
+ free(rab);
+ free(ctx);
+
+ return RET_SUCCESS;
+}
+
+/**************************
+ * Function vms_rewind *
+ **************************/
+int vms_rewind(rab)
+ struct RAB *rab;
+{
+ Ctxptr ctx;
+
+ int status;
+ if (!CHECK_RAB(rab))
+ return RET_ERROR;
+
+ ctx = (Ctxptr) (rab->rab$l_ctx);
+ if (ERR(status = sys$rewind(rab)))
+ {
+ ctx->status = status;
+ return RET_ERROR;
+ }
+
+ ctx->status = 0;
+ ctx->rest = ctx->size;
+
+ return RET_SUCCESS;
+}
+
+
+#define KByte (2* BLOCK_BYTES)
+#define MAX_READ_BYTES (32* KByte)
+
+/**************************
+ * Function vms_read *
+ **************************/
+size_t vms_read(rab, buf, size)
+struct RAB *rab;
+char *buf;
+size_t size;
+/*
+ * size must be greater or equal to 512 !
+ */
+{
+ int status;
+ Ctxptr ctx;
+
+ ctx = (Ctxptr)rab->rab$l_ctx;
+
+ if (!CHECK_RAB(rab))
+ return 0;
+
+ if (ctx -> rest == 0)
+ return 0; /* Eof */
+
+ /* If request is smaller than a whole block, fail.
+ This really should never happen. (assert()?)
+ */
+ if (size < BLOCK_BYTES)
+ return 0;
+
+ /* 2004-09-27 SMS.
+ Code here now resembles low-level QIO code in VMS_PK.C, but I
+ doubt that sys$read() will actually get past the official EOF.
+ */
+
+ /* Adjust request size as appropriate. */
+ if (size > MAX_READ_BYTES)
+ {
+ /* Restrict request to MAX_READ_BYTES. */
+ size = MAX_READ_BYTES;
+ }
+ else
+ {
+ /* Round odd-ball request up to the next whole block.
+ This really should never happen. (assert()?)
+ */
+ size = (size+ BLOCK_BYTES- 1)& ~(BLOCK_BYTES- 1);
+ }
+
+ /* Reduce "size" when next (last) read would overrun the EOF,
+ but never below one byte (so we'll always get a nice EOF).
+ */
+ if (size > ctx->rest)
+ size = ctx->rest;
+ if (size == 0)
+ size = 1;
+
+ rab->rab$l_ubf = buf;
+ rab->rab$w_usz = size;
+ status = sys$read(rab);
+
+ if (!ERR(status) && rab->rab$w_rsz > 0)
+ {
+ ctx -> status = 0;
+ ctx -> rest -= rab->rab$w_rsz;
+ return rab->rab$w_rsz;
+ }
+ else
+ {
+ ctx->status = (status==RMS$_EOF ? 0:status);
+ if (status == RMS$_EOF)
+ ctx -> rest = 0;
+ return 0;
+ }
+}
+
+/**************************
+ * Function vms_error *
+ **************************/
+int vms_error(rab)
+ struct RAB *rab;
+{
+ if (!CHECK_RAB(rab))
+ return RET_ERROR;
+ return ((Ctxptr) (rab->rab$l_ctx))->status;
+}
+
+
+#ifdef DEBUG
+static void dump_rms_block(p)
+ uch *p;
+{
+ uch bid, len;
+ int err;
+ char *type;
+ char buf[132];
+ int i;
+
+ err = 0;
+ bid = p[0];
+ len = p[1];
+ switch (bid)
+ {
+ case FAB$C_BID:
+ type = "FAB";
+ break;
+ case XAB$C_ALL:
+ type = "xabALL";
+ break;
+ case XAB$C_KEY:
+ type = "xabKEY";
+ break;
+ case XAB$C_DAT:
+ type = "xabDAT";
+ break;
+ case XAB$C_RDT:
+ type = "xabRDT";
+ break;
+ case XAB$C_FHC:
+ type = "xabFHC";
+ break;
+ case XAB$C_PRO:
+ type = "xabPRO";
+ break;
+ default:
+ type = "Unknown";
+ err = 1;
+ break;
+ }
+ printf("Block @%08X of type %s (%d).", p, type, bid);
+ if (err)
+ {
+ printf("\n");
+ return;
+ }
+ printf(" Size = %d\n", len);
+ printf(" Offset - Hex - Dec\n");
+ for (i = 0; i < len; i += 8)
+ {
+ int j;
+
+ printf("%3d - ", i);
+ for (j = 0; j < 8; j++)
+ if (i + j < len)
+ printf("%02X ", p[i + j]);
+ else
+ printf(" ");
+ printf(" - ");
+ for (j = 0; j < 8; j++)
+ if (i + j < len)
+ printf("%03d ", p[i + j]);
+ else
+ printf(" ");
+ printf("\n");
+ }
+}
+#endif /* DEBUG */
+
+#ifdef OLD_COMPRESS
+# define BC_METHOD EB_IZVMS_BC00
+# define COMP_BLK(to,tos,from,froms) _compress( from,to,froms )
+#else
+# define BC_METHOD EB_IZVMS_BCDEFL
+# define COMP_BLK(to,tos,from,froms) memcompress(to,tos,from,froms)
+#endif
+
+static uch *_compress_block(to,from,size,sig)
+register struct IZ_block *to;
+uch *from;
+int size;
+char *sig;
+{
+ ulg cl;
+ to -> sig = *(ush*)IZ_SIGNATURE;
+ to -> bid = *(ulg*)(sig);
+ to -> flags = BC_METHOD;
+ to -> length = size;
+#ifdef DEBUG
+ printf("\nmemcompr(%d,%d,%d,%d)\n",&(to->body[0]),size+PAD,from,size);
+#endif
+ cl = COMP_BLK( &(to->body[0]), size+PAD, from, size );
+#ifdef DEBUG
+ printf("Compressed to %d\n",cl);
+#endif
+ if (cl >= size)
+ {
+ memcpy(&(to->body[0]), from, size);
+ to->flags = EB_IZVMS_BCSTOR;
+ cl = size;
+#ifdef DEBUG
+ printf("Storing block...\n");
+#endif
+ }
+ return (uch*)(to) + (to->size = cl + EXTBSL + RESL) + EB_HEADSIZE;
+}
+
+#define NBITS 32
+
+static int _compress(from,to,size)
+uch *from,*to;
+int size;
+{
+ int off=0;
+ ulg bitbuf=0;
+ int bitcnt=0;
+ int i;
+
+#define _BIT(val,len) { \
+ if (bitcnt + (len) > NBITS) \
+ while(bitcnt >= 8) \
+ { \
+ to[off++] = (uch)bitbuf; \
+ bitbuf >>= 8; \
+ bitcnt -= 8; \
+ } \
+ bitbuf |= ((ulg)(val))<<bitcnt; \
+ bitcnt += len; \
+ }
+
+#define _FLUSH { \
+ while(bitcnt>0) \
+ { \
+ to[off++] = (uch)bitbuf; \
+ bitbuf >>= 8; \
+ bitcnt -= 8; \
+ } \
+ }
+
+ for (i=0; i<size; i++)
+ {
+ if (from[i])
+ {
+ _BIT(1,1);
+ _BIT(from[i],8);
+ }
+ else
+ _BIT(0,1);
+ }
+ _FLUSH;
+ return off;
+}
+
+#endif /* !UTIL */
+
+#endif /* ndef VMS_PK_EXTRA */
+
+#endif /* VMS */
View Lorry Controller Status