/* VMS-specific code for GnuPG.
 * 2008-03-31 SMS.
 */

#include <ctype.h>
#include <errno.h>
#include <fcntl.h>
#include <stdio.h>
#include <string.h>

#include <dcdef.h>
#include <descrip.h>
#include <dvidef.h>
#include <fabdef.h>
#include <iodef.h>
#include <jpidef.h>
#include <lib$routines.h>
#include <libwaitdef.h>
#include <namdef.h>
#include <starlet.h>
#include <stsdef.h>
#include <ttdef.h>
#include <unixlib.h>
#include <xabprodef.h>

/* Modern code would use fabdef.h, namdef.h, and rabdef.h, but some
 * old environments can't deal with both XXX.h and XXXdef.h and or only
 * XXXdef.h.
 */
#include <fab.h>
#include <nam.h>
#include <rab.h>
#include <rmsdef.h>

#include "config.h"
#include "main.h"
#include "options.h"
#include "util.h"
#include "i18n.h"

#include "vms.h"


/* 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 */


/* Action routine for decc$to_vms(), in sense_ods5_dest(). */

char vms_path[ NAM_MAXRSS+ 1];

int
set_vms_name( char *name, int type)
{
    strncpy( vms_path, name, NAM_MAXRSS);
    vms_path[ NAM_MAXRSS] = '\0';
    return 1;
}



/* sense_ods5_dest()

       Sense ODS level file system type of the argument: 0 for ODS2,
       1 for ODS5, -1 for other/unknown or failure.
*/

int
sense_ods5_dest( const char *path)
{
#ifdef DVI$C_ACP_F11V5

    /* Should know about ODS5 file system.  Do actual check.
     * (This should be non-VAX with __CRTL_VER >= 70200000.)
     */

    struct dsc$descriptor_s dev_descr =
     { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0 };

    int acp_code;
    int ods5_dest;
    int sts;

    /* Load path argument into device descriptor.
     * Default to current default device.
     * Using the raw file spec instead of getting a real device spec
     * from sys$parse() is crude, but is believed to work wherever ODS5
     * is available.  Failure will cause the ODS2 rule to be used on
     * ODS5.
     */
    if (path == NULL)
    {
        dev_descr.dsc$a_pointer = "SYS$DISK";
    }
    else
    {
        /* In the case of an obviously UNIX-like path, convert to a
         * VMS-like path.
         */
        if (strchr( path, '/') != NULL)
        {
            sts = decc$to_vms( path, set_vms_name, 0, 0);
            path = vms_path;
        }

        dev_descr.dsc$a_pointer = (char *)path;
    }
    dev_descr.dsc$w_length = strlen( dev_descr.dsc$a_pointer);

    /* Get filesystem type code.
     * (Text results for this item code have been unreliable.)
     */
    sts = lib$getdvi( &((int) DVI$_ACPTYPE),
                      0,
                      &dev_descr,
                      &acp_code,
                      0,
                      0);

    ods5_dest = -1;
    if ((sts& STS$M_SEVERITY) == STS$K_SUCCESS)
    {
        if (acp_code == DVI$C_ACP_F11V2)
        {
            ods5_dest = 0;
        }
        else if (acp_code == DVI$C_ACP_F11V5)
        {
            ods5_dest = 1;
        }
    }
    return ods5_dest;

#else /* def DVI$C_ACP_F11V5 */

    /* Too old for ODS5 file system.  Do nothing. */

    return -1;

#endif /* def DVI$C_ACP_F11V5 */
}


/* VMS-specific supplement for open_outfile() function. */

char *vms_append_ext( char *oname, const char *iname, const char *sfx)
{
    char *sep;

    if (sense_ods5_dest( iname) > 0)
    {
        sep = EXTSEP_S;
    }
    else
    {
        sep = EXTSEP_S2;
    }
    strcpy( stpcpy( stpcpy( oname, iname), sep), sfx);
    return oname;
}


/* VMS-specific make_outfile_name() replacement function. */

#define CMP_FILENAME(a,b) strcasecmp( (a), (b) )

/****************
 * Strip known extensions from iname and return a newly allocated
 * filename.  Return NULL if we can't do that.
 */
char *
vms_make_outfile_name( const char *iname )
{
    size_t n;
    size_t ns;

    if ( iobuf_is_pipe_filename (iname) )
	return xstrdup("-");

    /* Detect/locate a known suffix. */
    n = strlen(iname);
    ns = 0;
    if ((n > 4) &&
     (!CMP_FILENAME( iname+ n- 3, "gpg") ||
      !CMP_FILENAME( iname+ n- 3, "pgp") ||
      !CMP_FILENAME( iname+ n- 3, "sig") ||
      !CMP_FILENAME( iname+ n- 3, "asc")) &&
     ((iname[ n- 4] == EXTSEP_C) || (iname[ n- 4] == EXTSEP_C2))) {
        ns = 4;
    }
    else if ((n > 5) &&
     (!CMP_FILENAME( iname+ n- 4, "sign")) &&
     ((iname[ n- 5] == EXTSEP_C) || (iname[ n- 5] == EXTSEP_C2))) {
        ns = 5;
    }

    /* If found, strip the known suffix. */
    if (ns > 0) {
        char *buf = xstrdup( iname);
	buf[ n- ns] = 0;
        /* If the suffix was dot-separated, then re-dotify any last "^.". */
        if ((iname[ n- ns] == EXTSEP_C) && (n > ns)) {
            char *dot = strrchr( buf, EXTSEP_C);
            if ((dot != NULL) && (*(dot- 1) == '^')) {
                for ( ; *(dot- 1) = *dot; *dot != '\0') {
                    dot++;
                }
            }
        }
        return buf;
    }

    log_info(_("%s: unknown suffix\n"), iname);
    return NULL;
}


/* VMS-specific path_access() replacement function.
 *
 *  We assume that "file" is actually a foreign command symbol of one of
 *  these forms:
 *
 *      @ <file_spec>     ! <file_spec> defaults to type ".COM".
 *      $ <file_spec>     ! <file_spec> defaults to type ".EXE".
 *
 *  The test here is actually on symbol form and file open/read
 *  capability, ignoring the "mode" argument.
 */

int
path_access( const char *file, int mode)
{
    int sts;
    char *def_typ;
    char *sym_ptr;
    static char symbol_value[ 256];
    short symbol_value_len;

    struct FAB fab;
    struct NAM_STRUCT nam;
    struct XABPRO xabpro;
    char result[ NAM_MAXRSS+ 1];
    char exp[ NAM_MAXRSS+ 1];

    $DESCRIPTOR( symbol_value_dscr, symbol_value);
    struct dsc$descriptor_s file_dscr =
     { 0 , DSC$K_DTYPE_T, DSC$K_CLASS_S, NULL };

    /* Fill in the "file" (symbol) descriptor. */
    file_dscr.dsc$w_length = strlen( file);
    file_dscr.dsc$a_pointer = (char *) file;

    /* Evaluate the "file" symbol. */
    sts = lib$get_symbol( &file_dscr,           /* Symbol. */
                          &symbol_value_dscr,   /* Resultant value. */
                          &symbol_value_len,    /* Resultant value length. */
                          0);                   /* (Resultant table.) */

    if ((sts& STS$M_SEVERITY) != STS$K_SUCCESS)
        return -1;

    /* NUL-terminate the symbol value string. */
    symbol_value[ symbol_value_len] = '\0';

    /* Trim off any leading white space. */
    sym_ptr = symbol_value;
    while ((*sym_ptr != '\0') && isspace( *sym_ptr))
        sym_ptr++;

    /* Analyze the first (real) character. */
    if (*sym_ptr == '$')
    {
        def_typ = ".EXE";
    }
    else if (*sym_ptr == '@')
    {
        def_typ = ".COM";
    }
    else
    {
        return -2;
    }

    /* Trim off any intervening white space. */
    sym_ptr++;
    while ((*sym_ptr != '\0') && isspace( *sym_ptr))
        sym_ptr++;

    /* Prepare FAB and NAM to look for the file. */

    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 */

    FAB_OR_NAM( fab, nam).FAB_OR_NAM_FNA = sym_ptr;     /* Symbol file name, */
    FAB_OR_NAM( fab, nam).FAB_OR_NAM_FNS = strlen( sym_ptr);    /* length. */

    FAB_OR_NAM( fab, nam).FAB_OR_NAM_DNA = def_typ;     /* Default type. */
    FAB_OR_NAM( fab, nam).FAB_OR_NAM_DNS = strlen( def_typ);    /* length. */

    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. */

    /* Parse in the default file type. */
    sts = sys$parse( &fab);
    if ((sts& STS$M_SEVERITY) != STS$K_SUCCESS)
        return -3;

    /* Look for the file. */
    sts = sys$search( &fab);
    if ((sts& STS$M_SEVERITY) != STS$K_SUCCESS)
        return -4;

    /* Make the file open maximally harmless: read-only, all-sharing. */
    fab.fab$b_fac = FAB$M_GET;
    fab.fab$b_shr =
     FAB$M_SHRPUT| FAB$M_SHRGET| FAB$M_SHRDEL| FAB$M_SHRUPD|
     FAB$M_MSE| FAB$M_UPI| FAB$M_NQL;

    fab.fab$l_xab = &xabpro;                    /* FAB -> XAB */
    xabpro = cc$rms_xabpro;                     /* Initialize XAB. */

    /* Open the file (collecting protection/access info in the XAB). */
    sts = sys$open( &fab,                       /* FAB. */
                    0,                          /* Error AST. */
                    0);                         /* Success AST. */

    if ((sts& STS$M_SEVERITY) != STS$K_SUCCESS)
        return -5;

    /* If the open worked, then close immediately. */
    sts = sys$close( &fab,                      /* FAB. */
                     0,                         /* Error AST. */
                     0);                        /* Success AST. */

    if ((sts& STS$M_SEVERITY) != STS$K_SUCCESS)
        return -6;

    /* We'll assume that if the open worked, that command execution will
       also work.  (Fancy access testing should be possible for the
       ambitious.)
    */
    return 0;
}


/* Terminal characteristics buffer structure. */
typedef struct
{
    char class;
    char type;
    short page_width;
    int basic_chars;    /* (The high eight bits are page length.) */
    int extended_chars;
} term_chars_t;


/* Enable/disable terminal echo. */

int vms_set_term_echo( int able)
{
    int sts;
    int sts2;
    short term_chan;
    $DESCRIPTOR( term_dscr, "SYS$COMMAND");
    term_chars_t term_chars;
    static int initial_echo = -1;

    /* Open a channel to the terminal device. */
    sts = sys$assign( &term_dscr,       /* Terminal device name. */
                      &term_chan,       /* Channel. */
                      0,                /* Access mode. */
                      0);               /* Mailbox. */

    /* Return immediately on failure. */
    if ((sts& STS$M_SEVERITY) != STS$K_SUCCESS)
    {
        errno = EVMSERR;
        vaxc$errno = sts;
        return -1;
    }

    /* Get the current terminal characteristics (mode). */
    sts = sys$qiow( 0,                          /* Event flag. */
                    term_chan,                  /* Channel. */
                    IO$_SENSEMODE,              /* Function. */
                    0,                          /* IOSB. */
                    0,                          /* AST address. */
                    0,                          /* AST parameter. */
                    &term_chars,                /* P1 = Buffer address. */
                    sizeof term_chars,          /* P2 = Buffer size. */
                    0, 0, 0, 0);                /* P3-P6 not used. */

    if ((sts& STS$M_SEVERITY) != STS$K_SUCCESS)
    {
        errno = EVMSERR;
        vaxc$errno = sts;
    }
    else if (term_chars.class != DC$_TERM)
    {
        errno = ENOTTY;
    }
    else
    {
        /* Save the initial echo state, to allow proper restoration. */
        if (initial_echo < 0)
        {
            initial_echo = ((term_chars.basic_chars& TT$M_NOECHO) == 0);
        }

        if (able < 0)
        {
           if (initial_echo)
           {
               /* Was initially enabled. */
               able = 1;
           }
           else
           {
               /* Was initially disabled. */
               able = 0;
           }
        }

        if (able == 0)
        {
            /* Disable.  Set the no-echo bit. */
            term_chars.basic_chars |= TT$M_NOECHO;
        }
        else
        {
            /* Enable.  Clear the no-echo bit. */
            term_chars.basic_chars &= ~TT$M_NOECHO;
        }

        /* Set the terminal characteristics (mode). */
        sts = sys$qiow( 0,                      /* Event flag. */
                        term_chan,              /* Channel. */
                        IO$_SETMODE,            /* Function. */
                        0,                      /* IOSB. */
                        0,                      /* AST address. */
                        0,                      /* AST parameter. */
                        &term_chars,            /* P1 = Buffer address. */
                        sizeof term_chars,      /* P2 = Buffer size. */
                        0, 0, 0, 0);            /* P3-P6 not used. */

        if ((sts& STS$M_SEVERITY) != STS$K_SUCCESS)
        {
            errno = EVMSERR;
            vaxc$errno = sts;
        }
        else
        {
            /* All is well. */
            sts = 0;
        }
    }

    /* Close the channel to the terminal device. */
    sts2 = sys$dassgn( term_chan);              /* Channel. */
    if ((sts2& STS$M_SEVERITY) != STS$K_SUCCESS)
    {
        /* If all was not well, leave the old error codes as were. */
        if (sts == 0)
        {
            /* All was well, but DASSGN failed. */
            errno = EVMSERR;
            vaxc$errno = sts2;
            sts = sts2;
        }
    }
    return sts;
}


/* 2008-03-31 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 (opt.verbose > 1)

/* 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. */

/* 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. */


/* GETxxI item descriptor structure. */
typedef struct
{
    short buf_len;
    short itm_cod;
    void *buf;
    int *ret_len;
} xxi_item_t;


/* GETJPI item descriptor set. */

struct
{
    xxi_item_t rms_ext_itm;
    xxi_item_t rms_mbc_itm;
    xxi_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$K_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)
    {
        log_info( _("Get RMS defaults.  getjpi sts = %%x%08x.\n"), sts);

        if (rms_defaults_known > 0)
        {
            log_info(
             _("               Default: deq = %6d, mbc = %3d, mbf = %3d.\n"),
             rms_ext, rms_mbc, rms_mbf);
        }
    }
    return sts;
}


/* 2008-03-31 SMS.
 *
 *       acc_cb(), access callback function for DEC C [f]open().
 *
 *    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%_ID macros in VMS.H.
 */

/* Global storage. */

int fopi_id = FOPI_ID;          /* Callback id storage, input. */
int fopo_id = FOPO_ID;          /* Callback id storage, output. */

/* 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;
        }

        /* For an output file (only), set the "sequential access only"
         * flag to avoid excessive lock time when writing on a file
         * system with highwater marking enabled.  (Program may seek in
         * input files, causing a failure with SQO set.)
         */
        if (*id_arg == 2)
        {
            fab-> fab$v_sqo = 1;
        }

        if (DIAG_FLAG)
        {
            log_info(
             _("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;
}


/* Extra [f]open() arguments for VMS with DEC/Compaq/HP C. */
#define OPEN_ARGS_I "acc", acc_cb, &fopi_id
#define OPEN_ARGS_O "acc", acc_cb, &fopo_id


/* 2008-03-30 SMS.
 * VMS-specific file open().
 */
int open_vms( const char *file_spec, int flags, mode_t mode)
{
    if ((flags& (O_WRONLY| O_RDWR| O_APPEND)) == 0)
    {
        /* Input file. */
        return open( file_spec, flags, mode, OPEN_ARGS_I);
    }
    else
    {
        /* Output file. */
        return open( file_spec, flags, mode, OPEN_ARGS_O);
    }
}


/* 2008-03-30 SMS.
 * VMS-specific file fopen().
 */
FILE *fopen_vms( const char *file_spec, const char *a_mode)
{
    if ((strchr( a_mode, 'a') == NULL) &&
     (strchr( a_mode, 'w') == NULL) &&
     (strchr( a_mode, '+') == NULL))
    {
        /* Input file. */
        return fopen( file_spec, a_mode, OPEN_ARGS_I);
    }
    else
    {
        /* Output file. */
        return fopen( file_spec, a_mode, OPEN_ARGS_O);
    }
}


/* 2008-03-31 SMS.
 * VMS-specific fractional-second sleeper.
 */

/* The compiler should know which type of floating-double we're using. */
#if __G_FLOAT
# define WAIT_TYPE LIB$K_VAX_G          /* VAX G (Alpha default). */
#endif /* __G_FLOAT */
#if __IEEE_FLOAT || _IEEE_FP
# define WAIT_TYPE LIB$K_IEEE_T         /* IEEE T (IA64 default). */
#endif /* __IEEE_FLOAT || _IEEE_FP */
#ifndef WAIT_TYPE
# define WAIT_TYPE LIB$K_VAX_D          /* VAX D (VAX default). */
#endif /* ndef WAIT_TYPE */

int wait_vms( double delay)
{
    int sts;
    double wait_delay = delay;
    int wait_flags = LIB$K_WAKE;
    int wait_type = WAIT_TYPE;

    sts = lib$wait( &wait_delay, &wait_flags, &wait_type);
    return ((sts& STS$M_SEVERITY) != STS$K_SUCCESS);
}


/*
 * 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. */
                log_info( 
                 _(" 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. */
            log_info( _(" 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 */

