summaryrefslogtreecommitdiff
path: root/vms/vms.c
diff options
context:
space:
mode:
Diffstat (limited to 'vms/vms.c')
-rw-r--r--vms/vms.c1007
1 files changed, 1007 insertions, 0 deletions
diff --git a/vms/vms.c b/vms/vms.c
new file mode 100644
index 0000000..1b194c6
--- /dev/null
+++ b/vms/vms.c
@@ -0,0 +1,1007 @@
+/*
+ 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.c (zip) by Igor Mandrichenko Version 2.2-2
+ *
+ * Revision history:
+ * ...
+ * 2.2-2 18-jan-1993 I.Mandrichenko
+ * vms_stat() added - version of stat() that handles special
+ * case when end-of-file-block == 0
+ *
+ * 3.0 11-oct-2004 SMS
+ * It would be nice to know why vms_stat() is needed. If EOF can't
+ * be trusted for a zero-length file, why trust it for any file?
+ * Anyway, I removed the (int) cast on ->st_size, which may now be
+ * bigger than an int, just in case this code ever does get used.
+ * (A true zero-length file should still report zero length, even
+ * after the long fight with RMS.)
+ * Moved the VMS_PK_EXTRA test(s) into VMS_IM.C and VMS_PK.C to
+ * allow more general automatic dependency generation.
+ */
+
+#ifdef VMS /* For VMS only ! */
+
+#define NO_ZIPUP_H /* Prevent full inclusion of vms/zipup.h. */
+
+#include "zip.h"
+#include "zipup.h" /* Only partial. */
+
+#include <stdio.h>
+#include <string.h>
+
+#include <jpidef.h>
+#include <fab.h> /* Needed only in old environments. */
+#include <nam.h> /* Needed only in old environments. */
+#include <starlet.h>
+#include <ssdef.h>
+#include <stsdef.h>
+
+/* On VAX, define Goofy VAX Type-Cast to obviate /standard = vaxc.
+ Otherwise, lame system headers on VAX cause compiler warnings.
+ (GNU C may define vax but not __VAX.)
+*/
+#ifdef vax
+# define __VAX 1
+#endif /* def vax */
+
+#ifdef __VAX
+# define GVTC (unsigned int)
+#else /* def __VAX */
+# define GVTC
+#endif /* def __VAX */
+
+
+#ifdef UTIL
+
+/* For utilities, include only vms.h, as either of the vms_XX.c files
+ * would do.
+ */
+
+# include "vms.h"
+
+#else /* not UTIL */
+
+/* Include the `VMS attributes' preserving file-io code. We distinguish
+ between two incompatible flavours of storing VMS attributes in the
+ Zip archive:
+ a) The "PKware" style follows the extra field specification for
+ PKware's VMS Zip.
+ b) The "IM (Info-ZIP)" flavour was defined from scratch by
+ Igor Mandrichenko. This version has be used in official Info-ZIP
+ releases for several years and is known to work well.
+ */
+
+/* Note that only one of these #include directives will include any
+ * active code, depending on VMS_PK_EXTRA. Both are included here (and
+ * tested there) to allow more general automatic dependency generation.
+ */
+
+#include "vms_pk.c"
+#include "vms_im.c"
+
+#endif /* not UTIL [else] */
+
+#ifndef ERR
+#define ERR(x) (((x)&1)==0)
+#endif
+
+#ifndef NULL
+#define NULL (void*)(0L)
+#endif
+
+int vms_stat( char *file, stat_t *s)
+{
+ int status;
+ int staterr;
+ struct FAB fab;
+ struct NAM_STRUCT nam;
+ struct XABFHC fhc;
+
+ /*
+ * In simplest case when stat() returns "ok" and file size is
+ * nonzero or this is directory, finish with this
+ */
+
+ if( (staterr=stat(file,s)) == 0
+ && ( s->st_size >= 0 /* Size - ok */
+ || (s->st_mode & S_IFREG) == 0 /* Not a plain file */
+ )
+ ) return staterr;
+
+ /*
+ * Get here to handle the special case when stat() returns
+ * invalid file size. Use RMS to compute the size.
+ * When EOF block is zero, set file size to its physical size.
+ * One more case to get here is when this is remote file accessed
+ * via DECnet.
+ */
+
+ fab = cc$rms_fab;
+ nam = CC_RMS_NAM;
+ fhc = cc$rms_xabfhc;
+ fab.FAB_NAM = &nam;
+ fab.fab$l_xab = (char*)(&fhc);
+
+#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 = file;
+ FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNS = strlen( file);
+
+ fab.fab$b_fac = FAB$M_GET;
+
+ status = sys$open(&fab);
+ fab.fab$l_xab = (char*)0L;
+ sys$close(&fab);
+
+ if( !ERR(status) )
+ {
+ if( fhc.xab$l_ebk > 0 )
+ s->st_size = ( fhc.xab$l_ebk-1 ) * 512 + fhc.xab$w_ffb;
+ else if( fab.fab$b_org == FAB$C_IDX
+ || fab.fab$b_org == FAB$C_REL
+ || fab.fab$b_org == FAB$C_HSH )
+ /* Special case, when ebk=0: save entire allocated space */
+ s->st_size = fhc.xab$l_hbk * 512;
+ else
+ s->st_size = fhc.xab$w_ffb;
+ return 0; /* stat() success code */
+ }
+ else
+ return status;
+}
+
+
+/*
+ * 2007-01-29 SMS.
+ *
+ * VMS Status Code Summary (See STSDEF.H for details.)
+ *
+ * Bits: 31:28 27:16 15:3 2:0
+ * Field: Control Facility Message Severity
+ *
+ * In the Control field, bits 31:29 are reserved. Bit 28 inhibits
+ * printing the message. In the Facility field, bit 27 means
+ * customer-defined (not HP-assigned, like us). In the Message field,
+ * bit 15 means facility-specific (which our messages are). The
+ * Severity codes are 0 = Warning, 1 = Success, 2 = Error, 3 = Info,
+ * 4 = Severe (fatal).
+ *
+ * Previous versions of Info-ZIP programs used a generic ("chosen (by
+ * experimentation)") Control+Facility code of 0x7FFF, which included
+ * some reserved control bits, the inhibit-printing bit, and the
+ * customer-defined bit.
+ *
+ * HP has now assigned official Facility names and corresponding
+ * Facility codes for the Info-ZIP products:
+ *
+ * Facility Name Facility Code
+ * IZ_UNZIP 1954 = 0x7A2
+ * IZ_ZIP 1955 = 0x7A3
+ *
+ * Now, unless the CTL_FAC_IZ_ZIP macro is defined at build-time, we
+ * will use the official Facility code.
+ *
+ */
+
+/* Official HP-assigned Info-ZIP Zip Facility code. */
+#define FAC_IZ_ZIP 1955 /* 0x7A3 */
+
+#ifndef CTL_FAC_IZ_ZIP
+ /*
+ * Default is inhibit-printing with the official Facility code.
+ */
+# define CTL_FAC_IZ_ZIP ((0x1 << 12)| FAC_IZ_ZIP)
+# define MSG_FAC_SPEC 0x8000 /* Facility-specific code. */
+#else /* ndef CTL_FAC_IZ_ZIP */
+ /* Use the user-supplied Control+Facility code for err or warn. */
+# define OLD_STATUS
+# ifndef MSG_FAC_SPEC /* Old default is not Facility-specific. */
+# define MSG_FAC_SPEC 0x0 /* Facility-specific code. Or 0x8000. */
+# endif /* ndef MSG_FAC_SPEC */
+#endif /* ndef CTL_FAC_IZ_ZIP [else] */
+
+
+/* Return an intelligent status/severity code. */
+
+void vms_exit(e)
+ int e;
+{
+ {
+#ifndef OLD_STATUS
+
+ /*
+ * Exit with code comprising Control, Facility, (facility-specific)
+ * Message, and Severity.
+ */
+ exit( (CTL_FAC_IZ_ZIP << 16) | /* Facility */
+ MSG_FAC_SPEC | /* Facility-specific */
+ (e << 4) | /* Message code */
+ (ziperrors[ e].severity & 0x07) /* Severity */
+ );
+
+#else /* ndef OLD_STATUS */
+
+ /* 2007-01-17 SMS.
+ * Defining OLD_STATUS provides the same behavior as in Zip versions
+ * before an official VMS Facility code had been assigned, which
+ * means that Success (ZE_OK) gives a status value of 1 (SS$_NORMAL)
+ * with no Facility code, while any error or warning gives a status
+ * value which includes a Facility code. (Curiously, under the old
+ * scheme, message codes were left-shifted by 4 instead of 3,
+ * resulting in all-even message codes.) I don't like this, but I
+ * was afraid to remove it, as someone, somewhere may be depending
+ * on it. Define CTL_FAC_IZ_ZIP as 0x7FFF to get the old behavior.
+ * Define only OLD_STATUS to get the old behavior for Success
+ * (ZE_OK), but using the official HP-assigned Facility code for an
+ * error or warning. Define MSG_FAC_SPEC to get the desired
+ * behavior.
+ *
+ * Exit with simple SS$_NORMAL for ZE_OK. Otherwise, exit with code
+ * comprising Control, Facility, Message, and Severity.
+ */
+ exit(
+ (e == ZE_OK) ? SS$_NORMAL : /* Success (others below) */
+ ((CTL_FAC_IZ_ZIP << 16) | /* Facility */
+ MSG_FAC_SPEC | /* Facility-specific (?) */
+ (e << 4) | /* Message code */
+ (ziperrors[ e].severity & 0x07) /* Severity */
+ )
+ );
+
+#endif /* ndef OLD_STATUS */
+ }
+}
+
+
+/******************************/
+/* Function version_local() */
+/******************************/
+
+void version_local()
+{
+ static ZCONST char CompiledWith[] = "Compiled with %s%s for %s%s%s%s.\n\n";
+#ifdef VMS_VERSION
+ char *chrp1;
+ char *chrp2;
+ char buf[40];
+ char vms_vers[ 16];
+ int ver_maj;
+#endif
+#ifdef __DECC_VER
+ char buf2[40];
+ int vtyp;
+#endif
+
+#ifdef VMS_VERSION
+ /* Truncate the version string at the first (trailing) space. */
+ strncpy( vms_vers, VMS_VERSION, sizeof( vms_vers));
+ chrp1 = strchr( vms_vers, ' ');
+ if (chrp1 != NULL)
+ *chrp1 = '\0';
+
+ /* Determine the major version number. */
+ ver_maj = 0;
+ chrp1 = strchr( &vms_vers[ 1], '.');
+ for (chrp2 = &vms_vers[ 1];
+ chrp2 < chrp1;
+ ver_maj = ver_maj* 10+ *(chrp2++)- '0');
+
+#endif /* def VMS_VERSION */
+
+/* DEC C in ANSI mode does not like "#ifdef MACRO" inside another
+ macro when MACRO is equated to a value (by "#define MACRO 1"). */
+
+ printf(CompiledWith,
+
+#ifdef __GNUC__
+ "gcc ", __VERSION__,
+#else
+# if defined(DECC) || defined(__DECC) || defined (__DECC__)
+ "DEC C",
+# ifdef __DECC_VER
+ (sprintf(buf2, " %c%d.%d-%03d",
+ ((vtyp = (__DECC_VER / 10000) % 10) == 6 ? 'T' :
+ (vtyp == 8 ? 'S' : 'V')),
+ __DECC_VER / 10000000,
+ (__DECC_VER % 10000000) / 100000, __DECC_VER % 1000), buf2),
+# else
+ "",
+# endif
+# else
+# ifdef VAXC
+ "VAX C", "",
+# else
+ "unknown compiler", "",
+# endif
+# endif
+#endif
+
+#ifdef VMS_VERSION
+# if defined( __alpha)
+ "OpenVMS",
+ (sprintf( buf, " (%s Alpha)", vms_vers), buf),
+# elif defined( __ia64) /* defined( __alpha) */
+ "OpenVMS",
+ (sprintf( buf, " (%s IA64)", vms_vers), buf),
+# else /* defined( __alpha) */
+ (ver_maj >= 6) ? "OpenVMS" : "VMS",
+ (sprintf( buf, " (%s VAX)", vms_vers), buf),
+# endif /* defined( __alpha) */
+#else
+ "VMS",
+ "",
+#endif /* def VMS_VERSION */
+
+#ifdef __DATE__
+ " on ", __DATE__
+#else
+ "", ""
+#endif
+ );
+
+} /* end function version_local() */
+
+/* 2004-10-08 SMS.
+ *
+ * tempname() for VMS.
+ *
+ * Generate a temporary Zip archive file name, near the actual
+ * destination Zip archive file, or at "tempath", if specified.
+ *
+ * Using sys$parse() is probably more work than it's worth, but it
+ * should also be ODS5-safe.
+ *
+ * Note that the generic method using tmpnam() (in FILEIO.C)
+ * produces "ziXXXXXX", where "XXXXXX" is the low six digits of the
+ * decimal representation of the process ID. This method produces
+ * "ZIxxxxxxxx", where "xxxxxxxx" is the (whole) eight-digit
+ * hexadecimal representation of the process ID. More important, it
+ * actually uses the directory part of the argument or "tempath".
+ */
+
+
+char *tempname( char *zip)
+/* char *zip; */ /* Path name of Zip archive. */
+{
+ char *temp_name; /* Return value. */
+ int sts; /* System service status. */
+
+ static int pid; /* Process ID. */
+ static int pid_len; /* Returned size of process ID. */
+
+ struct /* Item list for GETJPIW. */
+ {
+ short buf_len; /* Buffer length. */
+ short itm_cod; /* Item code. */
+ int *buf; /* Buffer address. */
+ int *ret_len; /* Returned length. */
+ int term; /* Item list terminator. */
+ } jpi_itm_lst = { sizeof( pid), JPI$_PID, &pid, &pid_len };
+
+ /* ZI<UNIQUE> name storage. */
+ static char zip_tmp_nam[ 16] = "ZI<unique>.;";
+
+ struct FAB fab; /* FAB structure. */
+ struct NAM_STRUCT nam; /* NAM[L] structure. */
+
+ char exp_str[ NAM_MAXRSS+ 1]; /* Expanded name storage. */
+
+#ifdef VMS_UNIQUE_TEMP_BY_TIME
+
+ /* Use alternate time-based scheme to generate a unique temporary name. */
+ sprintf( &zip_tmp_nam[ 2], "%08X", time( NULL));
+
+#else /* def VMS_UNIQUE_TEMP_BY_TIME */
+
+ /* Use the process ID to generate a unique temporary name. */
+ sts = sys$getjpiw( 0, 0, 0, &jpi_itm_lst, 0, 0, 0);
+ sprintf( &zip_tmp_nam[ 2], "%08X", pid);
+
+#endif /* def VMS_UNIQUE_TEMP_BY_TIME */
+
+ /* Smoosh the unique temporary name against the actual Zip archive
+ name (or "tempath") to create the full temporary path name.
+ (Truncate it at the file type to remove any file type.)
+ */
+ if (tempath != NULL) /* Use "tempath", if it's been specified. */
+ zip = tempath;
+
+ /* Initialize the FAB and NAM[L], and link the NAM[L] to the FAB. */
+ fab = cc$rms_fab;
+ nam = CC_RMS_NAM;
+ fab.FAB_NAM = &nam;
+
+ /* Point the FAB/NAM[L] fields to the actual name and default name. */
+
+#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 */
+
+ /* Default name = Zip archive name. */
+ FAB_OR_NAML( fab, nam).FAB_OR_NAML_DNA = zip;
+ FAB_OR_NAML( fab, nam).FAB_OR_NAML_DNS = strlen( zip);
+
+ /* File name = "ZI<unique>,;". */
+ FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNA = zip_tmp_nam;
+ FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNS = strlen( zip_tmp_nam);
+
+ nam.NAM_ESA = exp_str; /* Expanded name (result) storage. */
+ nam.NAM_ESS = NAM_MAXRSS; /* Size of expanded name storage. */
+
+ nam.NAM_NOP = NAM_M_SYNCHK; /* Syntax-only analysis. */
+
+ temp_name = NULL; /* Prepare for failure (unlikely). */
+ sts = sys$parse( &fab, 0, 0); /* Parse the name(s). */
+
+ if ((sts& STS$M_SEVERITY) == STS$M_SUCCESS)
+ {
+ /* Overlay any resulting file type (typically ".ZIP") with none. */
+ strcpy( nam.NAM_L_TYPE, ".;");
+
+ /* Allocate temp name storage (as caller expects), and copy the
+ (truncated) temp name into the new location.
+ */
+ temp_name = malloc( strlen( nam.NAM_ESA)+ 1);
+
+ if (temp_name != NULL)
+ {
+ strcpy( temp_name, nam.NAM_ESA);
+ }
+ }
+ return temp_name;
+} /* tempname() for VMS. */
+
+
+/* 2005-02-17 SMS.
+ *
+ * ziptyp() for VMS.
+ *
+ * Generate a real Zip archive file name (exact, if it exists), using
+ * a default file name.
+ *
+ * 2005-02-17 SMS. Moved to here from [-]ZIPFILE.C, to segregate
+ * better the RMS stuff.
+ *
+ * Before 2005-02-17, if sys$parse() failed, ziptyp() returned a null
+ * string ("&zero", where "static char zero = '\0';"). This
+ * typically caused Zip to proceed, but then the final rename() of
+ * the temporary archive would (silently) fail (null file name, after
+ * all), leaving only the temporary archive file, and providing no
+ * warning message to the victim. Now, when sys$parse() fails,
+ * ziptyp() returns the original string, so a later open() fails, and
+ * a relatively informative message is provided. (A VMS-specific
+ * message could also be provided here, if desired.)
+ *
+ * 2005-09-16 SMS.
+ * Changed name parsing in ziptyp() to solve a problem with a
+ * search-list logical name device-directory spec for the zipfile.
+ * Previously, when the zipfile did not exist (so sys$search()
+ * failed), the expanded name was used, but as it was
+ * post-sys$search(), it was based on the _last_ member of the search
+ * list instead of the first. Now, the expanded name from the
+ * original sys$parse() (pre-sys$search()) is retained, and it is
+ * used if sys$search() fails. This name is based on the first
+ * member of the search list, as a user might expect.
+ */
+
+/* Default Zip archive file spec. */
+#define DEF_DEVDIRNAM "SYS$DISK:[].zip"
+
+char *ziptyp( char *s)
+{
+ int status;
+ int exp_len;
+ struct FAB fab;
+ struct NAM_STRUCT nam;
+ char result[ NAM_MAXRSS+ 1];
+ char exp[ NAM_MAXRSS+ 1];
+ char *p;
+
+ fab = cc$rms_fab; /* Initialize FAB. */
+ nam = CC_RMS_NAM; /* Initialize NAM[L]. */
+ fab.FAB_NAM = &nam; /* FAB -> NAM[L] */
+
+#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 */
+
+ /* Argument file name and length. */
+ FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNA = s;
+ FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNS = strlen( s);
+
+ /* Default file spec and length. */
+ FAB_OR_NAML( fab, nam).FAB_OR_NAML_DNA = DEF_DEVDIRNAM;
+ FAB_OR_NAML( fab, nam).FAB_OR_NAML_DNS = sizeof( DEF_DEVDIRNAM)- 1;
+
+ nam.NAM_ESA = exp; /* Expanded name, */
+ nam.NAM_ESS = NAM_MAXRSS; /* storage size. */
+ nam.NAM_RSA = result; /* Resultant name, */
+ nam.NAM_RSS = NAM_MAXRSS; /* storage size. */
+
+ status = sys$parse(&fab);
+ if ((status & 1) == 0)
+ {
+ /* Invalid file name. Return (re-allocated) original, and hope
+ for a later error message.
+ */
+ if ((p = malloc( strlen( s)+ 1)) != NULL )
+ {
+ strcpy( p, s);
+ }
+ return p;
+ }
+
+ /* Save expanded name length from sys$parse(). */
+ exp_len = nam.NAM_ESL;
+
+ /* Leave expanded name as-is, in case of search failure. */
+ nam.NAM_ESA = NULL; /* Expanded name, */
+ nam.NAM_ESS = 0; /* storage size. */
+
+ status = sys$search(&fab);
+ if (status & 1)
+ { /* Zip file exists. Use resultant (complete, exact) name. */
+ if ((p = malloc( nam.NAM_RSL+ 1)) != NULL )
+ {
+ result[ nam.NAM_RSL] = '\0';
+ strcpy( p, result);
+ }
+ }
+ else
+ { /* New Zip file. Use pre-search expanded name. */
+ if ((p = malloc( exp_len+ 1)) != NULL )
+ {
+ exp[ exp_len] = '\0';
+ strcpy( p, exp);
+ }
+ }
+ return p;
+} /* ziptyp() for VMS. */
+
+
+/* 2005-12-30 SMS.
+ *
+ * vms_file_version().
+ *
+ * Return the ";version" part of a VMS file specification.
+ */
+
+char *vms_file_version( char *s)
+{
+ int status;
+ struct FAB fab;
+ struct NAM_STRUCT nam;
+ char *p;
+
+ static char exp[ NAM_MAXRSS+ 1]; /* Expanded name storage. */
+
+
+ fab = cc$rms_fab; /* Initialize FAB. */
+ nam = CC_RMS_NAM; /* Initialize NAM[L]. */
+ fab.FAB_NAM = &nam; /* FAB -> NAM[L] */
+
+#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 */
+
+ /* Argument file name and length. */
+ FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNA = s;
+ FAB_OR_NAML( fab, nam).FAB_OR_NAML_FNS = strlen( s);
+
+ nam.NAM_ESA = exp; /* Expanded name, */
+ nam.NAM_ESS = NAM_MAXRSS; /* storage size. */
+
+ nam.NAM_NOP = NAM_M_SYNCHK; /* Syntax-only analysis. */
+
+ status = sys$parse(&fab);
+
+ if ((status & 1) == 0)
+ {
+ /* Invalid file name. Return "". */
+ exp[ 0] = '\0';
+ p = exp;
+ }
+ else
+ {
+ /* Success. NUL-terminate, and return a pointer to the ";" in
+ the expanded name storage buffer.
+ */
+ p = nam.NAM_L_VER;
+ p[ nam.NAM_B_VER] = '\0';
+ }
+ return p;
+} /* vms_file_version(). */
+
+
+/* 2004-11-23 SMS.
+ *
+ * get_rms_defaults().
+ *
+ * Get user-specified values from (DCL) SET RMS_DEFAULT. FAB/RAB
+ * items of particular interest are:
+ *
+ * fab$w_deq default extension quantity (blocks) (write).
+ * rab$b_mbc multi-block count.
+ * rab$b_mbf multi-buffer count (used with rah and wbh).
+ */
+
+#define DIAG_FLAG (verbose >= 2)
+
+/* Default RMS parameter values. */
+
+#define RMS_DEQ_DEFAULT 16384 /* About 1/4 the max (65535 blocks). */
+#define RMS_MBC_DEFAULT 127 /* The max, */
+#define RMS_MBF_DEFAULT 2 /* Enough to enable rah and wbh. */
+
+/* GETJPI item descriptor structure. */
+typedef struct
+ {
+ short buf_len;
+ short itm_cod;
+ void *buf;
+ int *ret_len;
+ } jpi_item_t;
+
+/* Durable storage */
+
+static int rms_defaults_known = 0;
+
+/* JPI item buffers. */
+static unsigned short rms_ext;
+static char rms_mbc;
+static unsigned char rms_mbf;
+
+/* Active RMS item values. */
+unsigned short rms_ext_active;
+char rms_mbc_active;
+unsigned char rms_mbf_active;
+
+/* GETJPI item lengths. */
+static int rms_ext_len; /* Should come back 2. */
+static int rms_mbc_len; /* Should come back 1. */
+static int rms_mbf_len; /* Should come back 1. */
+
+/* Desperation attempts to define unknown macros. Probably doomed.
+ * If these get used, expect sys$getjpiw() to return %x00000014 =
+ * %SYSTEM-F-BADPARAM, bad parameter value.
+ * They keep compilers with old header files quiet, though.
+ */
+#ifndef JPI$_RMS_EXTEND_SIZE
+# define JPI$_RMS_EXTEND_SIZE 542
+#endif /* ndef JPI$_RMS_EXTEND_SIZE */
+
+#ifndef JPI$_RMS_DFMBC
+# define JPI$_RMS_DFMBC 535
+#endif /* ndef JPI$_RMS_DFMBC */
+
+#ifndef JPI$_RMS_DFMBFSDK
+# define JPI$_RMS_DFMBFSDK 536
+#endif /* ndef JPI$_RMS_DFMBFSDK */
+
+/* GETJPI item descriptor set. */
+
+struct
+ {
+ jpi_item_t rms_ext_itm;
+ jpi_item_t rms_mbc_itm;
+ jpi_item_t rms_mbf_itm;
+ int term;
+ } jpi_itm_lst =
+ { { 2, JPI$_RMS_EXTEND_SIZE, &rms_ext, &rms_ext_len },
+ { 1, JPI$_RMS_DFMBC, &rms_mbc, &rms_mbc_len },
+ { 1, JPI$_RMS_DFMBFSDK, &rms_mbf, &rms_mbf_len },
+ 0
+ };
+
+int get_rms_defaults()
+{
+int sts;
+
+/* Get process RMS_DEFAULT values. */
+
+sts = sys$getjpiw( 0, 0, 0, &jpi_itm_lst, 0, 0, 0);
+if ((sts& STS$M_SEVERITY) != STS$M_SUCCESS)
+ {
+ /* Failed. Don't try again. */
+ rms_defaults_known = -1;
+ }
+else
+ {
+ /* Fine, but don't come back. */
+ rms_defaults_known = 1;
+ }
+
+/* Limit the active values according to the RMS_DEFAULT values. */
+
+if (rms_defaults_known > 0)
+ {
+ /* Set the default values. */
+
+ rms_ext_active = RMS_DEQ_DEFAULT;
+ rms_mbc_active = RMS_MBC_DEFAULT;
+ rms_mbf_active = RMS_MBF_DEFAULT;
+
+ /* Default extend quantity. Use the user value, if set. */
+ if (rms_ext > 0)
+ {
+ rms_ext_active = rms_ext;
+ }
+
+ /* Default multi-block count. Use the user value, if set. */
+ if (rms_mbc > 0)
+ {
+ rms_mbc_active = rms_mbc;
+ }
+
+ /* Default multi-buffer count. Use the user value, if set. */
+ if (rms_mbf > 0)
+ {
+ rms_mbf_active = rms_mbf;
+ }
+ }
+
+if (DIAG_FLAG)
+ {
+ fprintf( stderr,
+ "Get RMS defaults. getjpi sts = %%x%08x.\n",
+ sts);
+
+ if (rms_defaults_known > 0)
+ {
+ fprintf( stderr,
+ " Default: deq = %6d, mbc = %3d, mbf = %3d.\n",
+ rms_ext, rms_mbc, rms_mbf);
+ }
+ }
+return sts;
+}
+
+#ifdef __DECC
+
+/* 2004-11-23 SMS.
+ *
+ * acc_cb(), access callback function for DEC C zfopen().
+ *
+ * Set some RMS FAB/RAB items, with consideration of user-specified
+ * values from (DCL) SET RMS_DEFAULT. Items of particular interest are:
+ *
+ * fab$w_deq default extension quantity (blocks).
+ * rab$b_mbc multi-block count.
+ * rab$b_mbf multi-buffer count (used with rah and wbh).
+ *
+ * See also the FOP* macros in OSDEP.H. Currently, no notice is
+ * taken of the caller-ID value, but options could be set differently
+ * for read versus write access. (I assume that specifying fab$w_deq,
+ * for example, for a read-only file has no ill effects.)
+ */
+
+/* Global storage. */
+
+int fopm_id = FOPM_ID; /* Callback id storage, modify. */
+int fopr_id = FOPR_ID; /* Callback id storage, read. */
+int fopw_id = FOPW_ID; /* Callback id storage, write. */
+
+int fhow_id = FHOW_ID; /* Callback id storage, in read. */
+
+/* acc_cb() */
+
+int acc_cb( int *id_arg, struct FAB *fab, struct RAB *rab)
+{
+int sts;
+
+/* Get process RMS_DEFAULT values, if not already done. */
+if (rms_defaults_known == 0)
+ {
+ get_rms_defaults();
+ }
+
+/* If RMS_DEFAULT (and adjusted active) values are available, then set
+ * the FAB/RAB parameters. If RMS_DEFAULT values are not available,
+ * suffer with the default parameters.
+ */
+if (rms_defaults_known > 0)
+ {
+ /* Set the FAB/RAB parameters accordingly. */
+ fab-> fab$w_deq = rms_ext_active;
+ rab-> rab$b_mbc = rms_mbc_active;
+ rab-> rab$b_mbf = rms_mbf_active;
+
+ /* Truncate at EOF on close, as we'll probably over-extend. */
+ fab-> fab$v_tef = 1;
+
+ /* If using multiple buffers, enable read-ahead and write-behind. */
+ if (rms_mbf_active > 1)
+ {
+ rab-> rab$v_rah = 1;
+ rab-> rab$v_wbh = 1;
+ }
+
+ if (DIAG_FLAG)
+ {
+ fprintf( mesg,
+ "Open callback. ID = %d, deq = %6d, mbc = %3d, mbf = %3d.\n",
+ *id_arg, fab-> fab$w_deq, rab-> rab$b_mbc, rab-> rab$b_mbf);
+ }
+ }
+
+/* Declare success. */
+return 0;
+}
+
+#endif /* def __DECC */
+
+/*
+ * 2004-09-19 SMS.
+ *
+ *----------------------------------------------------------------------
+ *
+ * decc_init()
+ *
+ * On non-VAX systems, uses LIB$INITIALIZE to set a collection of C
+ * RTL features without using the DECC$* logical name method.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef __DECC
+
+#ifdef __CRTL_VER
+
+#if !defined( __VAX) && (__CRTL_VER >= 70301000)
+
+#include <unixlib.h>
+
+/*--------------------------------------------------------------------*/
+
+/* Global storage. */
+
+/* Flag to sense if decc_init() was called. */
+
+int decc_init_done = -1;
+
+/*--------------------------------------------------------------------*/
+
+/* decc_init()
+
+ Uses LIB$INITIALIZE to set a collection of C RTL features without
+ requiring the user to define the corresponding logical names.
+*/
+
+/* Structure to hold a DECC$* feature name and its desired value. */
+
+typedef struct
+ {
+ char *name;
+ int value;
+ } decc_feat_t;
+
+/* Array of DECC$* feature names and their desired values. */
+
+decc_feat_t decc_feat_array[] = {
+
+ /* Preserve command-line case with SET PROCESS/PARSE_STYLE=EXTENDED */
+ { "DECC$ARGV_PARSE_STYLE", 1 },
+
+ /* Preserve case for file names on ODS5 disks. */
+ { "DECC$EFS_CASE_PRESERVE", 1 },
+
+ /* Enable multiple dots (and most characters) in ODS5 file names,
+ while preserving VMS-ness of ";version". */
+ { "DECC$EFS_CHARSET", 1 },
+
+ /* List terminator. */
+ { (char *)NULL, 0 } };
+
+/* LIB$INITIALIZE initialization function. */
+
+static void decc_init( void)
+{
+int feat_index;
+int feat_value;
+int feat_value_max;
+int feat_value_min;
+int i;
+int sts;
+
+/* Set the global flag to indicate that LIB$INITIALIZE worked. */
+
+decc_init_done = 1;
+
+/* Loop through all items in the decc_feat_array[]. */
+
+for (i = 0; decc_feat_array[ i].name != NULL; i++)
+ {
+ /* Get the feature index. */
+ feat_index = decc$feature_get_index( decc_feat_array[ i].name);
+ if (feat_index >= 0)
+ {
+ /* Valid item. Collect its properties. */
+ feat_value = decc$feature_get_value( feat_index, 1);
+ feat_value_min = decc$feature_get_value( feat_index, 2);
+ feat_value_max = decc$feature_get_value( feat_index, 3);
+
+ if ((decc_feat_array[ i].value >= feat_value_min) &&
+ (decc_feat_array[ i].value <= feat_value_max))
+ {
+ /* Valid value. Set it if necessary. */
+ if (feat_value != decc_feat_array[ i].value)
+ {
+ sts = decc$feature_set_value( feat_index,
+ 1,
+ decc_feat_array[ i].value);
+ }
+ }
+ else
+ {
+ /* Invalid DECC feature value. */
+ printf( " INVALID DECC FEATURE VALUE, %d: %d <= %s <= %d.\n",
+ feat_value,
+ feat_value_min, decc_feat_array[ i].name, feat_value_max);
+ }
+ }
+ else
+ {
+ /* Invalid DECC feature name. */
+ printf( " UNKNOWN DECC FEATURE: %s.\n", decc_feat_array[ i].name);
+ }
+ }
+}
+
+/* Get "decc_init()" into a valid, loaded LIB$INITIALIZE PSECT. */
+
+#pragma nostandard
+
+/* Establish the LIB$INITIALIZE PSECTs, with proper alignment and
+ other attributes. Note that "nopic" is significant only on VAX.
+*/
+#pragma extern_model save
+
+#pragma extern_model strict_refdef "LIB$INITIALIZ" 2, nopic, nowrt
+const int spare[ 8] = { 0 };
+
+#pragma extern_model strict_refdef "LIB$INITIALIZE" 2, nopic, nowrt
+void (*const x_decc_init)() = decc_init;
+
+#pragma extern_model restore
+
+/* Fake reference to ensure loading the LIB$INITIALIZE PSECT. */
+
+#pragma extern_model save
+
+int LIB$INITIALIZE( void);
+
+#pragma extern_model strict_refdef
+int dmy_lib$initialize = (int) LIB$INITIALIZE;
+
+#pragma extern_model restore
+
+#pragma standard
+
+#endif /* !defined( __VAX) && (__CRTL_VER >= 70301000) */
+
+#endif /* def __CRTL_VER */
+
+#endif /* def __DECC */
+
+#endif /* VMS */