/* 2005-09-25 SMS.
   VMS-specific code for BZIP2.
*/

#include <stdio.h>
#include <string.h>

/* Work around /NAMES = AS_IS problems on VAX. */

#ifdef VAX
# ifndef sys$close
#  define sys$close SYS$CLOSE
# endif /* ndef sys$close */
# ifndef sys$getjpiw
#  define sys$getjpiw SYS$GETJPIW
# endif /* ndef sys$getjpiw */
# ifndef sys$open
#  define sys$open SYS$OPEN
# endif /* ndef sys$open */
# ifndef sys$parse
#  define sys$parse SYS$PARSE
# endif /* ndef sys$parse */
# ifndef sys$search
#  define sys$search SYS$SEARCH
# endif /* ndef sys$search */
#endif /* def VAX */

#include <starlet.h>
#include <jpidef.h>
#include <namdef.h>
#include <fabdef.h>
#include <rabdef.h>
#include <fab.h>                /* Needed only in old environments. */
#include <nam.h>                /* Needed only in old environments. */
#include <rmsdef.h>
#include <stsdef.h>
#include <xabdef.h>
#include <xabitmdef.h>

#include "vms.h"


/* Define macros for use with either NAM or NAML. */

#ifdef NAML$C_MAXRSS            /* NAML is available.  Use it. */

#  define NAM_STRUCT NAML

#  define FAB_OR_NAM( fab, nam) nam
#  define FAB_OR_NAM_DNA naml$l_long_defname
#  define FAB_OR_NAM_DNS naml$l_long_defname_size
#  define FAB_OR_NAM_FNA naml$l_long_filename
#  define FAB_OR_NAM_FNS naml$l_long_filename_size

#  define CC_RMS_NAM cc$rms_naml
#  define FAB_NAM fab$l_naml
#  define NAME_DNA naml$l_long_defname
#  define NAME_DNS naml$l_long_defname_size
#  define NAME_FNA naml$l_long_filename
#  define NAME_FNS naml$l_long_filename_size
#  define NAM_DID naml$w_did
#  define NAM_DVI naml$t_dvi
#  define NAM_ESA naml$l_long_expand
#  define NAM_ESL naml$l_long_expand_size
#  define NAM_ESS naml$l_long_expand_alloc
#  define NAM_FID naml$w_fid
#  define NAM_FNB naml$l_fnb
#  define NAM_RSA naml$l_long_result
#  define NAM_RSL naml$l_long_result_size
#  define NAM_RSS naml$l_long_result_alloc
#  define NAM_MAXRSS NAML$C_MAXRSS
#  define NAM_NOP naml$b_nop
#  define NAM_M_SYNCHK NAML$M_SYNCHK
#  define NAM_B_DEV naml$l_long_dev_size
#  define NAM_L_DEV naml$l_long_dev
#  define NAM_B_DIR naml$l_long_dir_size
#  define NAM_L_DIR naml$l_long_dir
#  define NAM_B_NAME naml$l_long_name_size
#  define NAM_L_NAME naml$l_long_name
#  define NAM_B_TYPE naml$l_long_type_size
#  define NAM_L_TYPE naml$l_long_type
#  define NAM_B_VER naml$l_long_ver_size
#  define NAM_L_VER naml$l_long_ver

#else /* def NAML$C_MAXRSS */   /* NAML is not available.  Use NAM. */

#  define NAM_STRUCT NAM

#  define FAB_OR_NAM( fab, nam) fab
#  define FAB_OR_NAM_DNA fab$l_dna
#  define FAB_OR_NAM_DNS fab$b_dns
#  define FAB_OR_NAM_FNA fab$l_fna
#  define FAB_OR_NAM_FNS fab$b_fns

#  define CC_RMS_NAM cc$rms_nam
#  define FAB_NAM fab$l_nam
#  define NAME_DNA fab$l_dna
#  define NAME_DNS fab$b_dns
#  define NAME_FNA fab$l_fna
#  define NAME_FNS fab$b_fns
#  define NAM_DID nam$w_did
#  define NAM_DVI nam$t_dvi
#  define NAM_ESA nam$l_esa
#  define NAM_ESL nam$b_esl
#  define NAM_ESS nam$b_ess
#  define NAM_FID nam$w_fid
#  define NAM_FNB nam$l_fnb
#  define NAM_RSA nam$l_rsa
#  define NAM_RSL nam$b_rsl
#  define NAM_RSS nam$b_rss
#  define NAM_MAXRSS NAM$C_MAXRSS
#  define NAM_NOP nam$b_nop
#  define NAM_M_SYNCHK NAM$M_SYNCHK
#  define NAM_B_DEV nam$b_dev
#  define NAM_L_DEV nam$l_dev
#  define NAM_B_DIR nam$b_dir
#  define NAM_L_DIR nam$l_dir
#  define NAM_B_NAME nam$b_name
#  define NAM_L_NAME nam$l_name
#  define NAM_B_TYPE nam$b_type
#  define NAM_L_TYPE nam$l_type
#  define NAM_B_VER nam$b_ver
#  define NAM_L_VER nam$l_ver

#endif /* def NAML$C_MAXRSS */


/* 2005-09-29 SMS.
 *
 * vms_basename()
 *
 *    Extract the basename from a VMS file spec.
 */

char *vms_basename( char *file_spec)
{
    /* Static storage for NAM[L], and so on. */

    static struct NAM_STRUCT nam;
    static char exp_name[ NAM_MAXRSS+ 1];
    static char res_name[ NAM_MAXRSS+ 1];

    struct FAB fab;
    int status;

    /* Set up the FAB and NAM[L] blocks. */

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

    /* Arg name and length. */
    FAB_OR_NAM( fab, nam).FAB_OR_NAM_FNA = file_spec;
    FAB_OR_NAM( fab, nam).FAB_OR_NAM_FNS = strlen( file_spec);

    nam.NAM_ESA = exp_name;         /* Expanded name. */
    nam.NAM_ESS = NAM_MAXRSS;       /* Max length. */
    nam.NAM_RSA = res_name;         /* Resulting name. */
    nam.NAM_RSS = NAM_MAXRSS;       /* Max length. */

    nam.NAM_NOP = NAM_M_SYNCHK;     /* Syntax-only analysis. */

    /* Parse the file name. */
    status = sys$parse( &fab);      /* What could go wrong? */

    nam.NAM_L_NAME[ nam.NAM_B_NAME] = '\0';

    return nam.NAM_L_NAME;
}


/* 2005-09-26 SMS.
 *
 * vms_wild()
 *
 *    Expand a wild-card file spec.  Exclude directory files.
 *       First, call with real name.
 *       Thereafter, call with NULL arg (until NULL is returned).
 */

char *vms_wild( char *file_spec, int *wild)
{
    /* Static storage for FAB, NAM[L], XAB, and so on. */

    static struct NAM_STRUCT nam;
    static char exp_name[ NAM_MAXRSS+ 1];
    static char res_name[ NAM_MAXRSS+ 1];
    static struct FAB fab;

    /* XAB item descriptor set.
      (Item structure matches jpi item structure.)
    */
    static int is_directory;
    static int xab_dir_len;

    static struct
    {
        jpi_item_t xab_dir_itm;
        int term;
    } xab_itm_lst =
     { { 4, XAB$_UCHAR_DIRECTORY, &is_directory, &xab_dir_len },
       0
     };

    static struct XABITM xab_items =
     { XAB$C_ITM, XAB$C_ITMLEN,
#ifndef VAX     /* VAX has a peculiar XABITM structure declaration. */
                                0,
#endif /* ndef VAX */
                                   NULL, &xab_itm_lst, XAB$K_SENSEMODE };

    static int vms_wild_detected;

    int status;
    int unsuitable;

    if (file_spec != NULL)
    {
        vms_wild_detected = 0;          /* Clear wild-card flag. */
        if (wild != NULL)
            *wild = 0;

        /* Set up the FAB and NAM[L] blocks. */

        fab = cc$rms_fab;               /* Initialize FAB. */
        nam = CC_RMS_NAM;               /* Initialize NAM[L]. */

        fab.FAB_NAM = &nam;             /* FAB -> NAM[L] */

        /* FAB items for XAB attribute sensing. */
        fab.fab$l_xab = (void *) &xab_items;
        fab.fab$b_shr = FAB$M_SHRUPD;   /* Play well with others. */
        fab.fab$b_fac = FAB$M_GET;
        fab.fab$v_nam = 1;              /* Use sys$search() results. */

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

        /* Arg wild name and length. */
        FAB_OR_NAM( fab, nam).FAB_OR_NAM_FNA = file_spec;
        FAB_OR_NAM( fab, nam).FAB_OR_NAM_FNS = strlen( file_spec);

#define DEF_DEVDIR "SYS$DISK:[]*.*;0"

        /* Default file spec and length. */
        FAB_OR_NAM( fab, nam).FAB_OR_NAM_DNA = DEF_DEVDIR;
        FAB_OR_NAM( fab, nam).FAB_OR_NAM_DNS = sizeof( DEF_DEVDIR)- 1;

        nam.NAM_ESA = exp_name;         /* Expanded name. */
        nam.NAM_ESS = NAM_MAXRSS;       /* Max length. */
        nam.NAM_RSA = res_name;         /* Resulting name. */
        nam.NAM_RSS = NAM_MAXRSS;       /* Max length. */

        /* Parse the file name. */
        status = sys$parse( &fab);

        if (status != RMS$_NORMAL)
        {
            /* Parse failed.
               Return original file spec and let someone else complain.
            */
            return file_spec;
        }
        /* Set the local wild-card flag. */
        vms_wild_detected = ((nam.NAM_FNB& NAM$M_WILDCARD) != 0);
        if (wild != NULL)
            *wild = vms_wild_detected;
    }
    else if (vms_wild_detected == 0)
    {
        /* Non-first call with no wild-card in file spec.  Done. */
        return NULL;
    }

    /* Search for the next matching file spec. */
    unsuitable = 1;
    while (unsuitable != 0)
    {
        status = sys$search( &fab);

        if (status == RMS$_NORMAL)
        {
            /* Found one.  If suitable, return resultant file spec. */
            status = sys$open( &fab);

            /* Clear internal file index.
               (Required after sys$open(), for next sys$search().)
            */
            fab.fab$w_ifi = 0;

            if (status == RMS$_NORMAL)
            {
                unsuitable = is_directory;
                status = sys$close( &fab);
            }
            else
            {
                /* Open failed.  Let someone else complain. */
                unsuitable = 0;
            }

            if (!unsuitable)
            {
                /* Suitable.  Return the resultant file spec. */
                res_name[ nam.NAM_RSL] = '\0';
                return res_name;
            }
        }
        else if (status == RMS$_NMF)
        {
            /* No more (wild-card) files.  Done. */
            return NULL;
        }
        else
        {
            /* Unexpected search failure.
               Return expanded file spec and let someone else complain.
               Could probably return the original spec instead.
            */
            exp_name[ nam.NAM_ESL] = '\0';
            return exp_name;
        }
    }
}


/* 2005-09-26 SMS.
 *
 * trimFileNameVersion()
 *
 *    Terminate a file name to discard (effectively) its version number.
 *
 *    Note: Exotic cases like A.B.1 (instead of A.B;1) are not handled
 *    properly, but using sys$parse() to get this right causes its own
 *    problems.  (String not trimmed in place, default device and
 *    directory added, and so on.)
 */

void trimFileNameVersion( char *file_name)
{
   char *cp;

   /* Find the first (apparent) non-version-digit. */
   for (cp = file_name+ strlen( file_name)- 1;
    (*cp >= '0') && (*cp <= '9') && (cp != file_name);
    cp--);

   /* If the pre-digit character exists and is an unescaped
      semi-colon, then terminate the string at the semi-colon.
   */
   if (cp != file_name)
   {
      if ((*cp == ';') && (*(cp- 1) != '^'))
      {
         *cp = '\0';
      }
   }   
   return;
}


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

extern int verbosity;

#define DIAG_FLAG (verbosity >= 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. */

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

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


/* 2004-11-23 SMS.
 *
 *       acc_cb(), access callback function for DEC C fopen().
 *
 *    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 VMS.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 fopr_id = FOPR_ID;          /* Callback id storage, read. */
int fopw_id = FOPW_ID;          /* Callback id storage, write. */

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

    /* Set the "sequential access only" flag to avoid excessive lock
       time when writing on a file system with highwater marking
       enabled.
    */
    fab-> fab$v_sqo = 1;

    if (DIAG_FLAG)
        {
        fprintf( stderr,
         "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;
}


/*
 * 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 __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. */
         fprintf( stderr,
          " 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. */
      fprintf( stderr,
       " 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 PSECT, with proper alignment and
   attributes.
*/
globaldef { "LIB$INITIALIZ" } readonly _align (LONGWORD)
   int spare[8] = { 0 };
globaldef { "LIB$INITIALIZE" } readonly _align (LONGWORD)
   void (*x_decc_init)() = decc_init;

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

