#error FIXME, FGC: I don't have fixed the const propagation in this code.
Yep, you must run into this error. Please, fix all errors the compiler tells
you. You may do the work in this order:
0) Comment off this lines until the next true comment.

1) Ignore errors for the first time. Look for each "static" function. Change
   all "xxx *" into "const xxx *" and every typedef'ed type (e.g.
   paramboxptr) into the c(onst) variant (e.g cparamboxptr). ONLY do this
   in the arguments.
   Recompile and check for error messages in the the static function.
   Remove all "const" from the parameters where an "readonly l-value
   assignment" is the error.
   In the other cases try to fix the errors with changing local variables
   in the static functions. In nearly all cases you have to change a running
   variable from types like "xxx *" to "const xxx *".
   Recompile.
   Remove the bogus const declarations from all arguments in the static which
   you don't have fixed.
   You are ready.

2) AFTER STEP 1:
   You have to redo the above work for the global functions. Don't process
   this step before step 1.
   There is one exception to step 1: Don't try to change any parameters. Only
   try to fix local variables.

3) Send back all changes to Mark Hessling if you are not Mark Hessling :-)




/*
 *  The Regina Rexx Interpreter
 *  Copyright (C) 1992  Anders Christensen <anders@pvv.unit.no>
 *
 *  This library is free software; you can redistribute it and/or
 *  modify it under the terms of the GNU Library General Public
 *  License as published by the Free Software Foundation; either
 *  version 2 of the License, or (at your option) any later version.
 *
 *  This library is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 *  Library General Public License for more details.
 *
 *  You should have received a copy of the GNU Library General Public
 *  License along with this library; if not, write to the Free
 *  Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

/*
 * $Id: vmsfuncs.c,v 1.1.1.1 2003/10/04 08:33:16 prokushev Exp $
 */

/* huups, have to add one to length in everyting given to Str_ncatstr */

#include "rexx.h"
#include "strings.h"

#include <assert.h>
#include <stdio.h>
#include <ctype.h>

#include <descrip.h>
#include <rmsdef.h>
#include <ssdef.h>
#include <dvidef.h>
#include <jpidef.h>
#include <quidef.h>
#include <syidef.h>
#include <uicdef.h>
#include <libdtdef.h>
#include <jbcmsgdef.h>
#include <lnmdef.h>
#include <psldef.h>
#include <libdef.h>
#include <libdtdef.h>

#include <fab.h>
#include <nam.h>
#include <xab.h>

#define MAX_PATH_LEN 64

#define HEX_DIGIT(a) (((a)<10)?((a)+'0'):((a)-10+'A'))
#define ADD_CHAR(a,b) (a)->value[(a)->len++] = (b)
#define MAX(a,b) (((a)>(b))?(a):(b))
#define MIN(a,b) (((a)<(b))?(a):(b))


typedef struct cli_block {
   short length ;
   char type ;
   char subtype ;
   short flags ;
   short TRO_cnt ;
} cli_block ;

typedef struct com_block {
   unsigned char handler ;
   unsigned char sizes ;
   unsigned char verbtype ;
   unsigned char pad ;
   short name ;
   short image ;
   short outputs ;
   short prefix ;
} com_block ;

struct fabptr {
   struct fabptr *next ;
   int num ;
   streng *name ;
   struct FAB *box ;
} ;

/* f$cvsi()      */
/* f$cvtime()    */
/* f$cvui()      */

/*
 * Values to be returned by the ACPTYPE item of sys$getdvi ... return
 * value is an index into this list of strings. Yes ... I know, this
 * is not the way to do it, but I don't know of any structure in the
 * library that hold this information. Whenever porting Regina to a new
 * version of VMS, make sure that this info is correct (check macros in
 * the file dvidef.h).
 */

#define NUM_ACP_CODES ((sizeof(acp_codes)/sizeof(char*))-1)
static const char *acp_codes[] = {
   "ILLEGAL", "F11CV1", "F11V2", "MTA", "NET", "REM"
} ;

#define NUM_JPI_MODES ((sizeof(jpi_modes)/sizeof(char*))-1)
static const char *jpi_modes[] = {
   "OTHER", "NETWORK", "BATCH", "INTERACTIVE"
} ;


#define NUM_SCH_TYPES ((sizeof(sch_types)/sizeof(char*))-1)
static const char *sch_types[] = {
   "UNKNOWN", "CEF", "COM", "COMO", "CUR", "COLPG", "FPG", "HIB", "HIBO",
   "LEF", "LEFO", "MWAIT", "PFW", "SUSP", "SUSPO"
} ;

typedef struct { /* vms_tsf: static variables of this module (thread-safe) */
   char *                  error_buffer;
   struct dsc$descriptor_s error_descr;
   int                     pid;
   struct fabptr *         fabptrs[16];
} vmf_tsd_t; /* thread-specific but only needed by this module. see
              * init_vmf
              */


/* init_vmf initializes the module.
 * Currently, we set up the thread specific data.
 * The function returns 1 on success, 0 if memory is short.
 */
int init_vmf( tsd_t *TSD )
{
   vmf_tsd_t *vt;

   if (TSD->vmf_tsd != NULL)
      return(1);

   if ((vt = TSD->vmf_tsd = MallocTSD(sizeof(vmf_tsd_t))) == NULL)
      return(0);
   memset(vt,0,sizeof(vmf_tsd_t));  /* correct for all values */
   return(1);
}

static char *select_code( int code, char *values[], int max )
{
   return values[((code<1)||(code>max)) ? 0 : code] ;
}

static const char *all_privs[] = {
   "CMKRNL",   "CMEXEC",  "SYSNAM",   "GRPNAM",    "ALLSPOOL", "DETACH",
   "DIAGNOSE", "LOG_IO",  "GROUP",    "ACNT",      "PRMCEB",   "PRMMBX",
   "PSWAPM",   "SETPRI",  "SETPRV",   "TMPMBX",    "WORLD",    "MOUNT",
   "OPER",     "EXQUOTA", "NETMBX",   "VOLPRO",    "PHY_IO",   "BUGCHK",
   "PRMGBL",   "SYSGBL",  "PFNMAP",   "SHMEM",     "SYSPRV",   "BYPASS",
   "SYSLCK",   "SHARE",   "UPGRADE",  "DOWNGRADE", "GRPPRV",   "READALL",
   "",         "",        "SECURITY", ""
} ;

#define NUM_PRIVS ((sizeof(all_privs)/sizeof(char*)))


static void vms_error( tsd_t *TSD, int err )
{
   unsigned short length ;
   unsigned int rc ;
   vmf_tsd_t *vt;

   vt = TSD->vmf_tsd;
   if (!vt->error_buffer)
   {
      vt->error_descr.dsc$a_pointer = vt->error_buffer = MallocTSD( 256+1 ) ;
      vt->error_descr.dsc$w_length = 256 ;
      vt->error_descr.dsc$b_dtype = DSC$K_DTYPE_T ;
      vt->error_descr.dsc$b_class = DSC$K_CLASS_S ;
   }

   rc=sys$getmsg( err, &length, &vt->error_descr, NULL, NULL ) ;
   if (rc != SS$_NORMAL)
      exiterror( ERR_SYSTEM_FAILURE , 0 ) ;

   vt->error_buffer[length] = 0x00 ;
   printf( "\n" ) ;
   fprintf( stderr, "%s\n", vt->error_buffer ) ;
}


static streng *internal_id( short *id )
{
   streng *result ;

   result = Str_makeTSD( 20 ) ;
   sprintf( result->value, "(%d,%d,%d)", id[0], id[1], id[2] ) ;
   result->len = strlen( result->value ) ;
   return( result ) ;
}

static int name_to_num( tsd_t *TSD, streng *name )
{
   int id, rc ;
   $DESCRIPTOR( descr, "" ) ;

   descr.dsc$w_length = name->len ;
   descr.dsc$a_pointer = name->value ;
   rc = sys$asctoid( &descr, &id, NULL ) ;
   if (rc == SS$_NOSUCHID || rc == SS$_IVIDENT)
      return 0 ;
   if (rc != SS$_NORMAL)
      vms_error( TSD, rc ) ;

   return (id) ;
}


static streng *num_to_name( tsd_t *TSD, int num )
{
   char user[256], group[256] ;
   $DESCRIPTOR( udescr, user ) ;
   $DESCRIPTOR( gdescr, group ) ;
   streng *result ;
   short length, glength ;
   int rc, xnum, context, theid ;

   if (num == 0)
      return NULL ;

   if (!(num & 0x80000000))
   {
      xnum = num | 0x0000ffff ;
      rc = sys$idtoasc( xnum, &glength, &gdescr, NULL, NULL, NULL) ;
      if (rc == SS$_NOSUCHID)
         glength = -1 ;
      else if (rc != SS$_NORMAL)
      {
         vms_error( TSD, rc ) ;
         glength = -1 ;
      }
   }
   else
      glength = -1 ;

   rc = sys$idtoasc( num, &length, &udescr, NULL, NULL, NULL ) ;

   if (rc == SS$_NOSUCHID)
      return NULL ;
   if (rc != SS$_NORMAL)
   {
      vms_error( TSD, rc ) ;
      length = 0 ;
   }

   if (glength > -1)
   {
      result = Str_makeTSD( glength + 1 + length ) ;
      Str_ncatstrTSD( result, group, glength ) ;
      result->value[result->len++] = ',' ;
   }
   else
      result = Str_makeTSD( length ) ;

   Str_ncatstrTSD( result, user, length ) ;
   return result ;
}


static streng *get_prot( int prot )
{
   char *names[] = { "SYSTEM", "OWNER", "GROUP", "WORLD" } ;
   int i ;
   streng *result ;

   result = Str_makeTSD( 50 ) ;
   for (i=0; i<4; i++)
   {
      Str_catstrTSD( result, names[i] ) ;
      if ((prot & 0x0f) != 0x0f)
      {
         /* DCL-bug: says RWED, should say RWLP */
         ADD_CHAR(result, '=') ;
         if (!(prot & 0x01)) ADD_CHAR(result, 'R') ;
         if (!(prot & 0x02)) ADD_CHAR(result, 'W') ;
         if (!(prot & 0x04)) ADD_CHAR(result, 'E') ; /* actually L */
         if (!(prot & 0x08)) ADD_CHAR(result, 'D') ; /* actually P */
      }
      ADD_CHAR( result, ',' ) ;
      ADD_CHAR( result, ' ' ) ;
      prot = prot >> 4 ;
   }
   result->len -= 2 ;
   return result ;
}

static streng *get_uic( tsd_t *TSD, union uicdef *uic )
{
   streng *name ;
   streng *result ;

   result = Str_makeTSD( 14 ) ;
   name = num_to_name( TSD, uic->uic$l_uic ) ;
   if (name)
   {
      ADD_CHAR( result, '[' ) ;
      Str_catTSD( result, name ) ;
      ADD_CHAR( result, ']' ) ;
   }
   else
   {
      sprintf(result->value,"[%o,%o]", uic->uic$v_group, uic->uic$v_member) ;
      result->len = strlen( result->value ) ;
   }
   return result ;
}


struct dvi_items_type {
   int type ;     /* Datatype returned from item, see DVI_ macros above */
   char *name ;   /* Parameter that identifies a particular vitem */
   int addr ;   /* Item identifyer to give to sys$getdvi */
} ;


struct item_list {
   union {
      struct {
         short code ;
         short length ;
      } norm ;
      int terminator ; } frst ;
   char *buffer ;
   int *length ;
} ;

/*
 * Here comes the code to implement the SYS$GETDVI() system service,
 * which is largely the same as the F$GETDVI() lexical function. There
 * are some minor differences, though.
 */

#define TYP_HEX    1    /* 4 byte unsigned hex integer */
#define TYP_ACP    2    /* ACP type code, or 'ILLEGAL' */
#define TYP_BOOL   3    /* 4 byte boolean integer */
#define TYP_LSTR   4    /* 64 byte character string */
#define TYP_4STR   5    /* 4 byte character string */
#define TYP_VEC    6    /* 4 byte unsigned integer */
#define TYP_INT    7    /* 4 byte signed integer */
#define TYP_UIC    8    /* 4 byte user identification code */
#define TYP_SSTR   9    /* 12 byte character string */
#define TYP_PROT  10    /* 4 byte protection mask */
#define TYP_LHEX  11    /* 64 byte binary string, interpreted as hex */
#define TYP_PRIV  12
#define TYP_TIME  13
#define TYP_MODE  14
#define TYP_SCHT  15
#define TYP_DTIM  16
#define TYP_MSTR  17
#define TYP_FLAG  18
#define TYP_TRNM  19
#define TYP_BSTR  20  /* Binary string, don't strip away ASCII zeros */

#define TYP_EXST   1 + 128  /* DVI$_EXISTS */
#define TYP_SPLD   2 + 128  /* force primary characteristics DVI$_DEVNAM */

#define TYP_SPECIFICS 1024
#define TYP_FLF      1024
#define TYP_FLS  1 + 1024
#define TYP_FMF  2 + 1024
#define TYP_JBF  3 + 1024
#define TYP_JBS  4 + 1024
#define TYP_PJR  5 + 1024
#define TYP_QUF  6 + 1024
#define TYP_QUS  7 + 1024

static streng *format_result( tsd_t *TSD, int type, char *buffer, int length )
{
   streng *result ;
   int *iptr = (int *)&(buffer[0]) ;
   int i ;

   switch (type)
   {
      case TYP_INT:
      case TYP_VEC:
         result = Str_makeTSD( 12 ) ;
/*       sprintf( result->value, ((type==TYP_INT) ? "%d" : "%u"), *iptr ) ; */
         sprintf( result->value, "%d", *iptr ) ;  /* DCL-bug */
         result->len = strlen( result->value ) ;
         assert( result->len < result->max ) ;
         break ;

      case TYP_LHEX:
      {
         int i ;

         result = Str_makeTSD( length * 2 ) ;
         for (i=0; i<length; i++)
        {
            result->value[i*2] = HEX_DIGIT((buffer[length-i-1] >> 4) & 0x0f);
            result->value[i*2+1] = HEX_DIGIT(buffer[length-i-1] & 0x0f) ;
         }
         result->len = length * 2 ;
         break ;
      }

      case TYP_DTIM:
      {
         int timer = *((int*)buffer) ;
         int days, hour, min, sec, hund ;
         result = Str_makeTSD( 17 ) ;

         hund = timer % 100 ; timer /= 100 ;
         sec = timer % 60 ; timer /= 60 ;
         min = timer % 60 ; timer /= 60 ;
         hour = timer % 24 ;
         days = timer / 24 ;

         result->len = 16 ;
         sprintf( result->value, "%4d %02d:%02d:%02d.%02d",
                                         days, hour, min, sec, hund ) ;

         break ;
      }

      case TYP_TIME:
      {
         int length, rc ;
         $DESCRIPTOR( desc, "" ) ;
         result = Str_makeTSD( 50 ) ;
         desc.dsc$a_pointer = result->value ;
         desc.dsc$w_length = 50 ;

         rc = lib$format_date_time( &desc, buffer, NULL, &length, NULL ) ;
         if (rc != SS$_NORMAL)
            vms_error( TSD, rc ) ;

         result->len = length ;
         break ;
      }

      case TYP_HEX:
         if (*iptr)
         {
            result = Str_makeTSD( 9 ) ;
            sprintf( result->value, "%08X", *iptr ) ;
            result->len = strlen( result->value ) ;
         }
         else
            result = nullstringptr() ;

         assert( result->len < result->max ) ;
         break ;

      case TYP_ACP:
         result = Str_creTSD(select_code( *iptr, acp_codes, NUM_ACP_CODES )) ;
         break ;

      case TYP_SCHT:
         result = Str_creTSD(select_code( *iptr, sch_types, NUM_SCH_TYPES )) ;
         break ;

      case TYP_MODE:
         result = Str_creTSD(select_code( *iptr, jpi_modes, NUM_JPI_MODES )) ;
         break ;

      case TYP_PRIV:
      {
         result = Str_makeTSD(256) ;
         for (i=0; i<NUM_PRIVS; i++)
            if (buffer[i/8] & (1<<(i%8)))
            {
               Str_catstrTSD( result, all_privs[i] ) ;
               ADD_CHAR( result, ',' ) ;
            }
         if (result->len)
            result->len-- ;
         break ;
      }

      case TYP_BOOL:
         result = Str_creTSD( (*iptr) ? "TRUE" : "FALSE" ) ;
         break ;

      case TYP_LSTR:
      case TYP_SSTR:
      case TYP_4STR:
      case TYP_MSTR:
         for (;length && buffer[length-1]==0x00; length--) ;
      case TYP_BSTR:
      {
         result = Str_ncreTSD( buffer, length ) ;
         break ;
      }

      case TYP_UIC:
      {
         result = get_uic( TSD, ( union uicdef *)buffer ) ;
         break ;
      }

      case TYP_PROT:
      {
         result = get_prot( *iptr ) ;
         break ;
      }

      default:
         exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;

   }
   return result ;
}



#define DVI_XXX    1    /* Must be treated as a special case */
#define DVI_INT    2    /* 4 byte integer */
#define DVI_BOOL   3    /* 4 byte boolean */
#define DVI_LSTR   4    /* 64 byte ASCII string */
#define DVI_SSTR   5    /* 12 byte ASCII string */
#define DVI_4STR   6    /* 4 byte ASCII string */
#define DVI_HEX    7    /* 4 byte hexadecimal number */
#define DVI_ACP    8    /* 4 byte integer index into list */
#define DVI_UIC    9    /* 4 byte VMS UIC */
#define DVI_VEC   10    /* 4 byte vector of bitvalues */
#define DVI_PROT  11    /* 4 byte protection mask */
#define DVI_PRIV  12    /* 64 bit privilege mask */
#define DVI_MODE  13    /* index into list of jpi_mode_list */
#define DVI_TIME  14    /* 64 bit absolute time */
#define DVI_STR   15
#define DVI_PID   16
#define DVI_HTYP  17

#define DVI_BIN DVI_HTYP    /* More or less the same */

#define DVI_XXX_EXISTS 1


static streng *strip_nulls( streng *input )
{
   int i ;

   for (i=input->len-1; (i>=0) && isspace(input->value[i]); i--) ;
   input->len = i+1 ;
   return input ;
}


#define HEXDIG(x) (((x)<'A')?((x)-'0'):(toupper(x)-'A'+10))

static unsigned int read_pid( const streng *hexpid )
{
   int i ;
   unsigned int sum=0 ;

   for (i=0; i<hexpid->len; i++)
      if (isxdigit(hexpid->value[i]))
         sum = sum*16 + HEXDIG( hexpid->value[i] ) ;

   return sum ;
}


streng *vms_f_directory( tsd_t *TSD, cparamboxptr parms )
{
   char buffer[ MAX_PATH_LEN ] ;
   short length ;
   int rc ;
   streng *result ;
   $DESCRIPTOR( dir, buffer ) ;

   checkparam( parms, 0, 0, "VMS_F_DIRECTORY" ) ;

   rc = sys$setddir( NULL, &length, &dir ) ;
   if (rc != RMS$_NORMAL)
      vms_error( TSD, rc ) ;

   if (length > MAX_PATH_LEN)
      exiterror( ERR_SYSTEM_FAILURE , 0 ) ;

   result = Str_makeTSD( length ) ;
   result = Str_ncatstrTSD( result, buffer, length ) ;
   return (result) ;
}


/* f$edit() */
/* f$element() */
/* f$environment()   --- not sure how to handle this */
/* f$extract() */
/* f$fao() */

/*
streng *vms_f_file_attributes( tsd_t *TSD, cparamboxptr parms )
{
   checkparam( parms, 2, 2, "VMS_F_FILE_ATTRIBUTES" ) ;
}
*/

struct dvi_items_type dvi_items[] =
{
   { TYP_HEX,   "ACPPID",         DVI$_ACPPID          },
   { TYP_ACP,   "ACPTYPE",        DVI$_ACPTYPE         },
   { TYP_BOOL,  "ALL",            DVI$_ALL             },
   { TYP_LSTR,  "ALLDEVNAM",      DVI$_ALLDEVNAM       },
   { TYP_INT,   "ALLOCLASS",      DVI$_ALLOCLASS       },
   { TYP_BOOL,  "ALT_HOST_AVAIL", DVI$_ALT_HOST_AVAIL  },
   { TYP_LSTR,  "ALT_HOST_NAME",  DVI$_ALT_HOST_NAME   },
   { TYP_4STR,  "ALT_HOST_TYPE",  DVI$_ALT_HOST_TYPE   },
   { TYP_BOOL,  "AVL",            DVI$_AVL             },
   { TYP_BOOL,  "CCL",            DVI$_CCL             },
   { TYP_INT,   "CLUSTER",        DVI$_CLUSTER         },
   { TYP_BOOL,  "CONCEALED",      DVI$_CONCEALED       }, /* undoc'ed */
   { TYP_INT,   "CYLINDERS",      DVI$_CYLINDERS       },
   { TYP_INT,   "DEVBUFSIZ",      DVI$_DEVBUFSIZ       },
   { TYP_VEC,   "DEVCHAR",        DVI$_DEVCHAR         },
   { TYP_VEC,   "DEVCHAR2",       DVI$_DEVCHAR2        },
   { TYP_INT,   "DEVCLASS",       DVI$_DEVCLASS        },
   { TYP_VEC,   "DEVDEPEND",      DVI$_DEVDEPEND       },
   { TYP_VEC,   "DEVDEPEND2",     DVI$_DEVDEPEND2      },
   { TYP_LHEX,  "DEVLOCKNAM",     DVI$_DEVLOCKNAM      },
   { TYP_LSTR,  "DEVNAM",         DVI$_DEVNAM          },
   { TYP_VEC,   "DEVSTS",         DVI$_DEVSTS          },
   { TYP_INT,   "DEVTYPE",        DVI$_DEVTYPE         },
   { TYP_BOOL,  "DIR",            DVI$_DIR             },
 /*  DVI$_DISPLAY_DEVNAM refered to in SS, not in LexFuncs */
   { TYP_BOOL,  "DMT",            DVI$_DMT             },
   { TYP_BOOL,  "DUA",            DVI$_DUA             },
   { TYP_BOOL,  "ELG",            DVI$_ELG             },
   { TYP_INT,   "ERRCNT",         DVI$_ERRCNT          },
   { TYP_EXST,  "EXISTS",         DVI$_DIR             },
   { TYP_BOOL,  "FOD",            DVI$_FOD             },
   { TYP_BOOL,  "FOR",            DVI$_FOR             },
   { TYP_INT,   "FREEBLOCKS",     DVI$_FREEBLOCKS      },
   { TYP_LSTR,  "FULLDEVNAM",     DVI$_FULLDEVNAM      },
   { TYP_BOOL,  "GEN",            DVI$_GEN             },
   { TYP_BOOL,  "HOST_AVAIL",     DVI$_HOST_AVAIL      },
   { TYP_INT,   "HOST_COUNT",     DVI$_HOST_COUNT      },
   { TYP_LSTR,  "HOST_NAME",      DVI$_HOST_NAME       },
   { TYP_4STR,  "HOST_TYPE",      DVI$_HOST_TYPE       },
   { TYP_BOOL,  "IDV",            DVI$_IDV             },
   { TYP_HEX,   "LOCKID",         DVI$_LOCKID          },
   { TYP_LSTR,  "LOGVOLNAM",      DVI$_LOGVOLNAM       },
   { TYP_INT,   "MAXBLOCK",       DVI$_MAXBLOCK        },
   { TYP_INT,   "MAXFILES",       DVI$_MAXFILES        },
   { TYP_BOOL,  "MBX",            DVI$_MBX             },
   { TYP_VEC,   "MEDIA_ID",       DVI$_MEDIA_ID        },
   { TYP_LSTR , "MEDIA_NAME",     DVI$_MEDIA_NAME      },
   { TYP_LSTR , "MEDIA_TYPE",     DVI$_MEDIA_TYPE      },
   { TYP_BOOL,  "MNT",            DVI$_MNT             },
   { TYP_INT,   "MOUNTCNT",       DVI$_MOUNTCNT        },
 /*  DVI$_MSCP_UNIT_NUMBER refered to in SS, not in LexFuncs */
   { TYP_BOOL,  "NET",            DVI$_NET             },
   { TYP_LSTR , "NEXTDEVNAM",     DVI$_NEXTDEVNAM      },
   { TYP_BOOL,  "ODV",            DVI$_ODV             },
   { TYP_INT,   "OPCNT",          DVI$_OPCNT           },
   { TYP_BOOL,  "OPR",            DVI$_OPR             },
   { TYP_UIC,   "OWNUIC",         DVI$_OWNUIC          },
   { TYP_HEX,   "PID",            DVI$_PID             },
   { TYP_BOOL,  "RCK",            DVI$_RCK             },
   { TYP_BOOL,  "RCT",            DVI$_RCT             },
   { TYP_BOOL,  "REC",            DVI$_REC             },
   { TYP_INT,   "RECSIZ",         DVI$_RECSIZ          },
   { TYP_INT,   "REFCNT",         DVI$_REFCNT          },
   { TYP_BOOL,  "REMOTE_DEVICE",  DVI$_REMOTE_DEVICE   },
   { TYP_BOOL,  "RND",            DVI$_RND             },
   { TYP_LSTR,  "ROOTDEVNAM",     DVI$_ROOTDEVNAM      },
   { TYP_BOOL,  "RTM",            DVI$_RTM             },
   { TYP_BOOL,  "SDI",            DVI$_SDI             },
   { TYP_INT,   "SECTORS",        DVI$_SECTORS         },
   { TYP_VEC,   "SERIALNUM",      DVI$_SERIALNUM       },
   { TYP_BOOL,  "SERVED_DEVICE",  DVI$_SERVED_DEVICE   },
   { TYP_BOOL,  "SHR",            DVI$_SHR             },
   { TYP_BOOL,  "SPL",            DVI$_SPL             },
   { TYP_SPLD,  "SPLDEVNAM",      DVI$_DEVNAM          },
   { TYP_BOOL,  "SQD",            DVI$_SQD             },
   { TYP_VEC,   "STS",            DVI$_STS             },
   { TYP_BOOL,  "SWL",            DVI$_SWL             },
   { TYP_INT,   "TRACKS",         DVI$_TRACKS          },
   { TYP_INT,   "TRANSCNT",       DVI$_TRANSCNT        },
   { TYP_BOOL,  "TRM",            DVI$_TRM             },
   { TYP_LSTR,  "TT_ACCPORNAM",   DVI$_TT_ACCPORNAM    },
   { TYP_BOOL,  "TT_ALTYPEAHD",   DVI$_TT_ALTYPEAHD    },
   { TYP_BOOL,  "TT_ANSICRT",     DVI$_TT_ANSICRT      },
   { TYP_BOOL,  "TT_APP_KEYPAD",  DVI$_TT_APP_KEYPAD   },
   { TYP_BOOL,  "TT_AUTOBAUD",    DVI$_TT_AUTOBAUD     },
   { TYP_BOOL,  "TT_AVO",         DVI$_TT_AVO          },
   { TYP_BOOL,  "TT_BLOCK",       DVI$_TT_BLOCK        },
   { TYP_BOOL,  "TT_BRDCSTMBX",   DVI$_TT_BRDCSTMBX    },
   { TYP_BOOL,  "TT_CRFILL",      DVI$_TT_CRFILL       },
   { TYP_BOOL,  "TT_DECCRT",      DVI$_TT_DECCRT       },
   { TYP_BOOL,  "TT_DECCRT2",     DVI$_TT_DECCRT2      },
   { TYP_BOOL,  "TT_DIALUP",      DVI$_TT_DIALUP       },
   { TYP_BOOL,  "TT_DISCONNECT",  DVI$_TT_DISCONNECT   },
   { TYP_BOOL,  "TT_DMA",         DVI$_TT_DMA          },
   { TYP_BOOL,  "TT_DRCS",        DVI$_TT_DRCS         },
   { TYP_BOOL,  "TT_EDIT",        DVI$_TT_EDIT         },
   { TYP_BOOL,  "TT_EDITING",     DVI$_TT_EDITING      },
   { TYP_BOOL,  "TT_EIGHTBIT",    DVI$_TT_EIGHTBIT     },
   { TYP_BOOL,  "TT_ESCAPE",      DVI$_TT_ESCAPE       },
   { TYP_BOOL,  "TT_FALLBACK",    DVI$_TT_FALLBACK     },
   { TYP_BOOL,  "TT_HALFDUP",     DVI$_TT_HALFDUP      },
   { TYP_BOOL,  "TT_HANGUP",      DVI$_TT_HANGUP       },
   { TYP_BOOL,  "TT_HOSTSYNC",    DVI$_TT_HOSTSYNC     },
   { TYP_BOOL,  "TT_INSERT",      DVI$_TT_INSERT       },
   { TYP_BOOL,  "TT_LFFILL",      DVI$_TT_LFFILL       },
   { TYP_BOOL,  "TT_LOCALECHO",   DVI$_TT_LOCALECHO    },
   { TYP_BOOL,  "TT_LOWER",       DVI$_TT_LOWER        },
   { TYP_BOOL,  "TT_MBXDSABL",    DVI$_TT_MBXDSABL     },
   { TYP_BOOL,  "TT_MECHFORM",    DVI$_TT_MECHFORM     },
   { TYP_BOOL,  "TT_MECHTAB",     DVI$_TT_MECHTAB      },
   { TYP_BOOL,  "TT_MODEM",       DVI$_TT_MODEM        },
   { TYP_BOOL,  "TT_MODHANGUP",   DVI$_TT_MODHANGUP    },
   { TYP_BOOL,  "TT_NOBRDCST",    DVI$_TT_NOBRDCST     },
   { TYP_BOOL,  "TT_NOECHO",      DVI$_TT_NOECHO       },
   { TYP_BOOL,  "TT_NOTYPEAHD",   DVI$_TT_NOTYPEAHD    },
   { TYP_BOOL,  "TT_OPER",        DVI$_TT_OPER         },
   { TYP_INT,   "TT_PAGE",        DVI$_TT_PAGE         },
   { TYP_BOOL,  "TT_PASTHRU",     DVI$_TT_PASTHRU      },
   { TYP_LSTR,  "TT_PHYDEVNAM",   DVI$_TT_PHYDEVNAM    },
   { TYP_BOOL,  "TT_PRINTER",     DVI$_TT_PRINTER      },
   { TYP_BOOL,  "TT_READSYNC",    DVI$_TT_READSYNC     },
   { TYP_BOOL,  "TT_REGIS",       DVI$_TT_REGIS        },
   { TYP_BOOL,  "TT_REMOTE",      DVI$_TT_REMOTE       },
   { TYP_BOOL,  "TT_SCOPE",       DVI$_TT_SCOPE        },
   { TYP_BOOL,  "TT_SECURE",      DVI$_TT_SECURE       },
   { TYP_BOOL,  "TT_SETSPEED",    DVI$_TT_SETSPEED     },
   { TYP_BOOL,  "TT_SIXEL",       DVI$_TT_SIXEL        },
   { TYP_BOOL,  "TT_SYSPWD",      DVI$_TT_SYSPWD       },
   { TYP_BOOL,  "TT_TTSYNC",      DVI$_TT_TTSYNC       },
   { TYP_BOOL,  "TT_WRAP",        DVI$_TT_WRAP         },
   { TYP_INT,   "UNIT",           DVI$_UNIT            },
   { TYP_INT,   "VOLCOUNT",       DVI$_VOLCOUNT        },
   { TYP_SSTR,  "VOLNAM",         DVI$_VOLNAM          },
   { TYP_INT,   "VOLNUMBER",      DVI$_VOLNUMBER       },
   { TYP_BOOL,  "VOLSETMEM",      DVI$_VOLSETMEM       },
   { TYP_PROT,  "VPROT",          DVI$_VPROT           },
   { TYP_BOOL,  "WCK",            DVI$_WCK             },
} ;



static struct dvi_items_type *item_info(
     const streng *name, struct dvi_items_type *xlist, int size )
{
   int top, bot, mid, tmp ;
   const char *poss, *cptr ;

   top = size / sizeof( struct dvi_items_type ) - 1 ;
   bot = 0 ;

   for ( ; bot<=top; )
   {
      mid = (top+bot)/2 ;

      cptr = name->value ;
      poss = (const char *) xlist[mid].name ;
      for (tmp=name->len; tmp--; )
         if (toupper(*(cptr++))!=(*(poss++))) break ;

      if (tmp==(-1))
         tmp = - *poss ;
      else
         tmp = toupper(*(cptr-1)) - *(poss-1) ;

      if (tmp<0)
         top = mid - 1 ;
      else if (tmp)
         bot = mid + 1 ;
      else
         return &(xlist[mid]) ;
   }
   return NULL ;
}


/*
 * Why do I use sys$getdviw() instead of lib$getdvi ... because Digital
 * fucked up the implementation of lib$getdvi(). Problem: When secondary
 * characteristics are chosen (1 is added to item-code, ... or item-code
 * is or'ed with DVI$C_SECONDARY), lib$getdvi interprets the result as
 * numeric in all cases, and never do any dataconversion, except from
 * converting everything to decimal integer. Ergo, lib$getdvi is utterly
 * useless for obtaining non-numeric info about secondary devices.
 * When (if!) they fix it, undefining the LIB$GETDVI_BUG should make the
 * code far simpler, and also much more compatible.
 */


streng *vms_f_getdvi( tsd_t *TSD, cparamboxptr parms )
{
   char *buffer, buffer1[64], buffer2[64] ;
   int spooled, slength=4, rc, itemcode, length ;
   short length1, length2 ;
   struct dvi_items_type *ptr ;
   int item[12], type ;
   struct dsc$descriptor_s name ;
   struct dsc$descriptor_s dir = {
       sizeof(buffer)-1, DSC$K_DTYPE_T, DSC$K_CLASS_S, buffer } ;

   checkparam( parms, 2, 2, "VMS_F_GETDVI" ) ;

   ptr = item_info( parms->next->value, dvi_items, sizeof( dvi_items)) ;
   if (!ptr)
      exiterror( ERR_INCORRECT_CALL , 0 ) ;

   name.dsc$w_length = Str_len( parms->value ) ;
   name.dsc$b_dtype = DSC$K_DTYPE_T ;
   name.dsc$b_class = DSC$K_CLASS_S ;
   name.dsc$a_pointer = parms->value->value ;

   item[0] = 64 + ((ptr->addr) << 16) ;
   item[1] = (int)buffer1 ;
   item[2] = (int)&length1 ;
   item[3] = 64 + ((ptr->addr | DVI$C_SECONDARY) << 16) ;
   item[4] = (int)buffer2 ;
   item[5] = (int)&length2 ;
   item[6] = 4 + ((DVI$_SPL | DVI$C_SECONDARY) << 16) ;
   item[7] = (int)&spooled ;
   item[8] = (int)&slength ;
   item[9] = item[10] = item[11] = 0 ;


   rc = sys$getdviw( NULL, NULL, &name, &item, NULL, NULL, NULL, NULL ) ;

   if (ptr->type == TYP_SPLD)
   {
      spooled = 0 ;
      type = TYP_LSTR ;
   }
   else
      type = ptr->type ;

   buffer = (spooled) ? buffer2 : buffer1 ;
   length = (spooled) ? length2 : length1 ;

   if (type == TYP_EXST)
   {
      if (rc == SS$_NOSUCHDEV) return Str_creTSD( "FALSE" ) ;
      if (rc == SS$_NORMAL) return Str_creTSD( "TRUE" ) ;
   }

   if (rc != SS$_NORMAL)
   {
      vms_error( TSD, rc ) ;
      return Str_creTSD("") ;
   }

   return format_result( TSD, type, buffer, length ) ;
}


static const struct dvi_items_type jpi_items[] =
{
   { TYP_LSTR,  "ACCOUNT",      JPI$_ACCOUNT    },
   { TYP_INT,   "APTCNT",       JPI$_APTCNT     },
   { TYP_INT,   "ASTACT",       JPI$_ASTACT     },
   { TYP_INT,   "ASTCNT",       JPI$_ASTCNT     },
   { TYP_INT,   "ASTEN",        JPI$_ASTEN      },
   { TYP_INT,   "ASTLM",        JPI$_ASTLM      },
   { TYP_INT,   "AUTHPRI",      JPI$_AUTHPRI    },
   { TYP_PRIV,  "AUTHPRIV",     JPI$_AUTHPRIV   },
   { TYP_INT,   "BIOCNT",       JPI$_BIOCNT     },
   { TYP_INT,   "BIOLM",        JPI$_BIOLM      },
   { TYP_INT,   "BUFIO",        JPI$_BUFIO      },
   { TYP_INT,   "BYTCNT",       JPI$_BYTCNT     },
   { TYP_INT,   "BYTLM",        JPI$_BYTLM      },
   { TYP_LSTR,  "CLINAME",      JPI$_CLINAME    },
   { TYP_INT,   "CPULIM",       JPI$_CPULIM     },
   { TYP_INT,   "CPUTIM",       JPI$_CPUTIM     },
   { TYP_PRIV,  "CURPRIV",      JPI$_CURPRIV    },
   { TYP_INT,   "DFPFC",        JPI$_DFPFC      },
   { TYP_INT,   "DFWSCNT",      JPI$_DFWSCNT    },
   { TYP_INT,   "DIOCNT",       JPI$_DIOCNT     },
   { TYP_INT,   "DIOLM",        JPI$_DIOLM      },
   { TYP_INT,   "DIRIO",        JPI$_DIRIO      },
   { TYP_INT,   "EFCS",         JPI$_EFCS       },
   { TYP_INT,   "EFCU",         JPI$_EFCU       },
   { TYP_INT,   "EFWM",         JPI$_EFWM       },
   { TYP_INT,   "ENQCNT",       JPI$_ENQCNT     },
   { TYP_INT,   "ENQLM",        JPI$_ENQLM      },
   { TYP_HEX,   "EXCVEC",       JPI$_EXCVEC     },
   { TYP_INT,   "FILCNT",       JPI$_FILCNT     },
   { TYP_INT,   "FILLM",        JPI$_FILLM      },
   { TYP_HEX,   "FINALEXC",     JPI$_FINALEXC   },
   { TYP_HEX,   "FREP0VA",      JPI$_FREP0VA    },
   { TYP_HEX,   "FREP1VA",      JPI$_FREP1VA    },
   { TYP_INT,   "FREPTECNT",    JPI$_FREPTECNT  },
   { TYP_INT,   "GPGCNT",       JPI$_GPGCNT     },
   { TYP_INT,   "GRP",          JPI$_GRP        },
   { TYP_INT,   "IMAGECOUNT",   JPI$_IMAGECOUNT },
   { TYP_LSTR,  "IMAGNAME",     JPI$_IMAGNAME   },
   { TYP_PRIV,  "IMAGPRIV",     JPI$_IMAGPRIV   },
   { TYP_INT,   "JOBPRCCNT",    JPI$_JOBPRCCNT  },
   { TYP_TIME,  "LOGINTIM",     JPI$_LOGINTIM   },
   { TYP_HEX,   "MASTER_PID",   JPI$_MASTER_PID },
   { TYP_INT,   "MEM",          JPI$_MEM        },
   { TYP_MODE,  "MODE",         JPI$_MODE       },
   { TYP_INT,   "MSGMASK",      JPI$_MSGMASK    },
   { TYP_HEX,   "OWNER",        JPI$_OWNER      },
   { TYP_INT,   "PAGEFLTS",     JPI$_PAGEFLTS   },
   { TYP_INT,   "PAGFILCNT",    JPI$_PAGFILCNT  },
   { TYP_HEX,   "PAGFILLOC",    JPI$_PAGFILLOC  },
   { TYP_INT,   "PGFLQUOTA",    JPI$_PGFLQUOTA  },
   { TYP_VEC,   "PHDFLAGS",     JPI$_PHDFLAGS   },
   { TYP_HEX,   "PID",          JPI$_PID        },
   { TYP_INT,   "PPGCNT",       JPI$_PPGCNT     },
   { TYP_INT,   "PRCCNT",       JPI$_PRCCNT     },
   { TYP_INT,   "PRCLM",        JPI$_PRCLM      },
   { TYP_LSTR,  "PRCNAM",       JPI$_PRCNAM     },
   { TYP_INT,   "PRIB",         JPI$_PRIB       },
   { TYP_PRIV,  "PROCPRIV",     JPI$_PROCPRIV   },
   { TYP_INT,   "SITESPEC",     JPI$_SITESPEC   },
   { TYP_SCHT,  "STATE",        JPI$_STATE      },
   { TYP_INT,   "STS",          JPI$_STS        },
   { TYP_HEX,   "SWPFILLOC",    JPI$_SWPFILLOC  },
   { TYP_SSTR,  "TERMINAL",     JPI$_TERMINAL   },
   { TYP_INT,   "TMBU",         JPI$_TMBU       },
   { TYP_INT,   "TQCNT",        JPI$_TQCNT      },
   { TYP_INT,   "TQLM",         JPI$_TQLM       },
   { TYP_UIC,   "UIC",          JPI$_UIC        },
   { TYP_SSTR,  "USERNAME",     JPI$_USERNAME   },
   { TYP_INT,   "VIRTPEAK",     JPI$_VIRTPEAK   },
   { TYP_INT,   "VOLUMES",      JPI$_VOLUMES    },
   { TYP_INT,   "WSAUTH",       JPI$_WSAUTH     },
   { TYP_INT,   "WSAUTHEXT",    JPI$_WSAUTHEXT  },
   { TYP_INT,   "WSEXTENT",     JPI$_WSEXTENT   },
   { TYP_INT,   "WSPEAK",       JPI$_WSPEAK     },
   { TYP_INT,   "WSQUOTA",      JPI$_WSQUOTA    },
   { TYP_INT,   "WSSIZE",       JPI$_WSSIZE     },
} ;


streng *vms_f_getjpi( tsd_t *TSD, cparamboxptr parms )
{
   char buffer[64] ;
   int item[6] ;
   short length=0 ;
   int rc, pid, *pidaddr ;
   struct dvi_items_type *ptr ;
   struct dsc$descriptor_s dir = {
       sizeof(buffer)-1, DSC$K_DTYPE_T, DSC$K_CLASS_S, buffer } ;

   checkparam( parms, 2, 2, "VMS_F_GETJPI" ) ;

   ptr = item_info( parms->next->value, jpi_items, sizeof(jpi_items)) ;
   if (!ptr)
      exiterror( ERR_INCORRECT_CALL , 0 ) ;

   if ((!parms->value) || (!parms->value->len))
      pidaddr = NULL ;
   else
   {
      pid = read_pid( parms->value ) ;
      pidaddr = &pid ;
   }

   item[0] = 64 + ( ptr->addr << 16 ) ;
   item[1] = (int)buffer ;
   item[2] = (int)&length ;
   item[3] = item[4] = item[5] = 0 ;

   rc = sys$getjpiw( NULL, pidaddr, NULL, &item, NULL, NULL, NULL ) ;

   if (rc != SS$_NORMAL)
   {
      vms_error( TSD, rc ) ;
      return Str_creTSD("") ;
   }

   return format_result( TSD, ptr->type, buffer, length ) ;
}

/*
 * Warning, the sequence of these records *must* match the macros
 * given below (CARAC, ENTRY, ENTRY), which is used in initializing
 * the array leg_items
 */
static const struct dvi_items_type qui_funcs[] = {
   { 0x70, "CANCEL_OPERATION",       QUI$_CANCEL_OPERATION },
   { 0x02, "DISPLAY_CHARACTERISTIC", QUI$_DISPLAY_CHARACTERISTIC },
   { 0x00, "DISPLAY_ENTRY",          QUI$_DISPLAY_ENTRY },
   { 0x20, "DISPLAY_FILE",           QUI$_DISPLAY_FILE },
   { 0x02, "DISPLAY_FORM",           QUI$_DISPLAY_FORM },
   { 0x20, "DISPLAY_JOB",            QUI$_DISPLAY_JOB },
   { 0x02, "DISPLAY_QUEUE",          QUI$_DISPLAY_QUEUE },
   { 0x42, "TRANSLATE_QUEUE",        QUI$_TRANSLATE_QUEUE },
} ;

/*
static const char char qui_chars[] = {
   0x70, 0x02, 0x00, 0x20, 0x02, 0x20, 0x02, 0x42
} ;

static const int qui_func_codes[] = {
   QUI$_CANCEL_OPERATION, QUI$_DISPLAY_CHARACTERISTIC, QUI$_DISPLAY_ENTRY,
   QUI$_DISPLAY_FILE, QUI$_DISPLAY_FORM, QUI$_DISPLAY_JOB,
   QUI$_DISPLAY_QUEUE, QUI$_TRANSLATE_QUEUE
} ;
*/

static const int qui_spec_values[] = {
   QUI$_FILE_FLAGS, QUI$_FILE_STATUS, QUI$_FORM_FLAGS, QUI$_JOB_FLAGS,
   QUI$_JOB_STATUS, QUI$_PENDING_JOB_REASON, QUI$_QUEUE_FLAGS,
   QUI$_QUEUE_STATUS
} ;

#define CHARAC  0x02  /* display_characteristics */
#define ENTRY   0x04  /* diskplay_entry */
#define FILE    0x08  /* display_file */
#define FORM    0x10  /* display_form */
#define JOB     0x20  /* display_job */
#define QUEUE   0x40  /* display_queue */
#define TRANS   0x80  /* translate_queue */

static const char leg_items[] = {
                  ENTRY + JOB, /* ACCOUNT_NAME */
                  ENTRY + JOB, /* AFTER_TIME */
                        QUEUE, /* ASSIGNED_QUEUE_NAME */
                        QUEUE, /* BASE_PRIORITY */
          ENTRY + JOB + QUEUE, /* CHARACTERISTICS */
                       CHARAC, /* CHARACTERISTIC_NAME */
                       CHARAC, /* CHARACTERISTIC_NUMBER */
                  ENTRY + JOB, /* CHECKPOINT_DATA */
                  ENTRY + JOB, /* CLI */
                  ENTRY + JOB, /* COMPLETE_BLOCKS */
                  ENTRY + JOB, /* CONDITION_VECTOR */
                        QUEUE, /* CPU_DEFAULT */
          ENTRY + JOB + QUEUE, /* CPU_LIMIT */
                        QUEUE, /* DEFAULT_FORM_NAME */
                        QUEUE, /* DEFAULT_FORM_STOCK */
                        QUEUE, /* DEVICE_NAME */
                  ENTRY + JOB, /* ENTRY_NUMBER */
                        QUEUE, /* EXECUTING_JOB_COUNT */
                         FILE, /* FILE_BURST */
                         FILE, /* FILE_CHECKPOINTED */
                         FILE, /* FILE_COPIES */
                         FILE, /* FILE_COPIES_DONE */
                         FILE, /* FILE_DELETE */
                         FILE, /* FILE_DOUBLE_SPACE */
                         FILE, /* FILE_EXECUTING */
                         FILE, /* FILE_FLAG */
                         FILE, /* FILE_FLAGS */
                         FILE, /* FILE_IDENTIFICATION */
                         FILE, /* FILE_PAGE_HEADER */
                         FILE, /* FILE_PAGINATE */
                         FILE, /* FILE_PASSALL */
                         FILE, /* FILE_SETUP_MODULES */
                         FILE, /* FILE_SPECIFICATION */
                         FILE, /* FILE_STATUS */
                         FILE, /* FILE_TRAILER */
                         FILE, /* FIRST_PAGE */
                         FORM, /* FORM_DESCRIPTION */
                         FORM, /* FORM_FLAGS */
                         FORM, /* FORM_LENGTH */
                         FORM, /* FORM_MARGIN_BOTTOM */
                         FORM, /* FORM_MARGIN_LEFT */
                         FORM, /* FORM_MARGIN_RIGHT */
                         FORM, /* FORM_MARGIN_TOP */
   FORM + ENTRY + JOB + QUEUE, /* FORM_NAME */
                         FORM, /* FORM_NUMBER */
                         FORM, /* FORM_SETUP_MODULES */
                         FORM, /* FORM_SHEET_FEED */
   FORM + ENTRY + JOB + QUEUE, /* FORM_STOCK */
                         FORM, /* FORM_TRUNCATE */
                         FORM, /* FORM_WIDTH */
                         FORM, /* FORM_WRAP */
                        QUEUE, /* GENERIC_TARGET */
                        QUEUE, /* HOLDING_JOB_COUNT */
                  ENTRY + JOB, /* INTERVENING_BLOCKS */
            /* see comment in vms.rexx about intervening jobs */
            /* ENTRY + */ JOB, /* INTERVENING_JOBS */
                  ENTRY + JOB, /* JOB_ABORTING */
                  ENTRY + JOB, /* JOB_COPIES */
                  ENTRY + JOB, /* JOB_COPIES_DONE */
                  ENTRY + JOB, /* JOB_CPU_LIMIT */
                  ENTRY + JOB, /* JOB_EXECUTING */
                  ENTRY + JOB, /* JOB_FILE_BURST */
                  ENTRY + JOB, /* JOB_FILE_BURST_ONE */
                  ENTRY + JOB, /* JOB_FILE_FLAG */
                  ENTRY + JOB, /* JOB_FILE_FLAG_ONE */
                  ENTRY + JOB, /* JOB_FILE_PAGINATE */
                  ENTRY + JOB, /* JOB_FILE_TRAILER */
                  ENTRY + JOB, /* JOB_FILE_TRAILER_ONE */
                  ENTRY + JOB, /* JOB_FLAGS */
                  ENTRY + JOB, /* JOB_HOLDING */
                  ENTRY + JOB, /* JOB_INACCESSIBLE */
                        QUEUE, /* JOB_LIMIT */
                  ENTRY + JOB, /* JOB_LOG_DELETE */
                  ENTRY + JOB, /* JOB_LOG_NULL */
                  ENTRY + JOB, /* JOB_LOG_SPOOL */
                  ENTRY + JOB, /* JOB_LOWERCASE */
                  ENTRY + JOB, /* JOB_NAME */
                  ENTRY + JOB, /* JOB_NOTIFY */
                  ENTRY + JOB, /* JOB_PENDING */
                  ENTRY + JOB, /* JOB_PID */
                  ENTRY + JOB, /* JOB_REFUSED */
                        QUEUE, /* JOB_RESET_MODULES */
                  ENTRY + JOB, /* JOB_RESTART */
                  ENTRY + JOB, /* JOB_RETAINED */
                  ENTRY + JOB, /* JOB_SIZE */
                        QUEUE, /* JOB_SIZE_MAXIMUM */
                        QUEUE, /* JOB_SIZE_MINIMUM */
                  ENTRY + JOB, /* JOB_STARTING */
                  ENTRY + JOB, /* JOB_STATUS */
                  ENTRY + JOB, /* JOB_SUSPENDED */
                  ENTRY + JOB, /* JOB_TIMED_RELEASE */
                  ENTRY + JOB, /* JOB_WSDEFAULT */
                  ENTRY + JOB, /* JOB_WSEXTENT */
                  ENTRY + JOB, /* JOB_WSQUOTA */
                         FILE, /* LAST_PAGE */
                        QUEUE, /* LIBRARY_SPECIFICATION */
                  ENTRY + JOB, /* LOG_QUEUE */
                  ENTRY + JOB, /* LOG_SPECIFICATION */
                  ENTRY + JOB, /* NOTE */
                  ENTRY + JOB, /* OPERATOR_REQUEST */
                        QUEUE, /* OWNER_UIC */
                         FORM, /* PAGE_SETUP_MODULES */
                  ENTRY + JOB, /* PARAMETER_1 */
                  ENTRY + JOB, /* PARAMETER_2 */
                  ENTRY + JOB, /* PARAMETER_3 */
                  ENTRY + JOB, /* PARAMETER_4 */
                  ENTRY + JOB, /* PARAMETER_5 */
                  ENTRY + JOB, /* PARAMETER_6 */
                  ENTRY + JOB, /* PARAMETER_7 */
                  ENTRY + JOB, /* PARAMETER_8 */
                        QUEUE, /* PENDING_JOB_BLOCK_COUNT */
                        QUEUE, /* PENDING_JOB_COUNT */
                  ENTRY + JOB, /* PENDING_JOB_REASON */
                  ENTRY + JOB, /* PEND_CHAR_MISMATCH */
                  ENTRY + JOB, /* PEND_JOB_SIZE_MAX */
                  ENTRY + JOB, /* PEND_JOB_SIZE_MIN */
                  ENTRY + JOB, /* PEND_LOWERCASE_MISMATCH */
                  ENTRY + JOB, /* PEND_NO_ACCESS */
                  ENTRY + JOB, /* PEND_QUEUE_BUSY */
                  ENTRY + JOB, /* PEND_QUEUE_STATE */
                  ENTRY + JOB, /* PEND_STOCK_MISMATCH */
                  ENTRY + JOB, /* PRIORITY */
                        QUEUE, /* PROCESSOR */
                        QUEUE, /* PROTECTION */
                        QUEUE, /* QUEUE_DESCRIPTION */
                        QUEUE, /* QUEUE_ACL_SPECIFIED */
                        QUEUE, /* QUEUE_ALIGNING */
                        QUEUE, /* QUEUE_BATCH */
                        QUEUE, /* QUEUE_CLOSED */
                        QUEUE, /* QUEUE_CPU_DEFAULT */
                        QUEUE, /* QUEUE_CPU_LIMIT */
                        QUEUE, /* QUEUE_FILE_BURST */
                        QUEUE, /* QUEUE_FILE_BURST_ONE */
                        QUEUE, /* QUEUE_FILE_FLAG */
                        QUEUE, /* QUEUE_FILE_FLAG_ONE */
                        QUEUE, /* QUEUE_FILE_PAGINATE */
                        QUEUE, /* QUEUE_FILE_TRAILER */
                        QUEUE, /* QUEUE_FILE_TRAILER_ONE */
                        QUEUE, /* QUEUE_FLAGS */
                        QUEUE, /* QUEUE_GENERIC */
                        QUEUE, /* QUEUE_GENERIC_SELECTION */
                        QUEUE, /* QUEUE_IDLE */
                        QUEUE, /* QUEUE_JOB_BURST */
                        QUEUE, /* QUEUE_JOB_FLAG */
                        QUEUE, /* QUEUE_JOB_SIZE_SCHED */
                        QUEUE, /* QUEUE_JOB_TRAILER */
                        QUEUE, /* QUEUE_LOWERCASE */
  TRANS + ENTRY + JOB + QUEUE, /* QUEUE_NAME */
                        QUEUE, /* QUEUE_PAUSED */
                        QUEUE, /* QUEUE_PAUSING */
                        QUEUE, /* QUEUE_PRINTER */
                        QUEUE, /* QUEUE_RECORD_BLOCKING */
                        QUEUE, /* QUEUE_REMOTE */
                        QUEUE, /* QUEUE_RESETTING */
                        QUEUE, /* QUEUE_RESUMING */
                        QUEUE, /* QUEUE_RETAIN_ALL */
                        QUEUE, /* QUEUE_RETAIN_ERROR */
                        QUEUE, /* QUEUE_SERVER */
                        QUEUE, /* QUEUE_STALLED */
                        QUEUE, /* QUEUE_STARTING */
                        QUEUE, /* QUEUE_STATUS */
                        QUEUE, /* QUEUE_STOPPED */
                        QUEUE, /* QUEUE_STOPPING */
                        QUEUE, /* QUEUE_SWAP */
                        QUEUE, /* QUEUE_TERMINAL */
                        QUEUE, /* QUEUE_UNAVAILABLE */
                        QUEUE, /* QUEUE_WSDEFAULT */
                        QUEUE, /* QUEUE_WSEXTENT */
                        QUEUE, /* QUEUE_WSQUOTA */
                  ENTRY + JOB, /* REQUEUE_QUEUE_NAME */
                          JOB, /* RESTART_QUEUE_NAME */
                        QUEUE, /* RETAINED_JOB_COUNT */
                        QUEUE, /* SCSNODE_NAME */
                  ENTRY + JOB, /* SUBMISSION_TIME */
                        QUEUE, /* TIMED_RELEASE_JOB_COUNT */
                  ENTRY + JOB, /* UIC */
                  ENTRY + JOB, /* USERNAME */
          ENTRY + JOB + QUEUE, /* WSDEFAULT */
          ENTRY + JOB + QUEUE, /* WSEXTENT */
          ENTRY + JOB + QUEUE, /* WSQUOTA */
} ;


static const struct dvi_items_type qui_items[] = {
   { TYP_LSTR, "ACCOUNT_NAME",          QUI$_ACCOUNT_NAME               },
   { TYP_TIME, "AFTER_TIME",            QUI$_AFTER_TIME                 },
   { TYP_LSTR, "ASSIGNED_QUEUE_NAME",   QUI$_ASSIGNED_QUEUE_NAME        },
   { TYP_INT,  "BASE_PRIORITY",         QUI$_BASE_PRIORITY              },
   { TYP_LSTR, "CHARACTERISTICS",       QUI$_CHARACTERISTICS            },
   { TYP_LSTR, "CHARACTERISTIC_NAME",   QUI$_CHARACTERISTIC_NAME        },
   { TYP_INT,  "CHARACTERISTIC_NUMBER", QUI$_CHARACTERISTIC_NUMBER      },
   { TYP_LSTR, "CHECKPOINT_DATA",       QUI$_CHECKPOINT_DATA            },
   { TYP_LSTR, "CLI",                   QUI$_CLI                        },
   { TYP_INT,  "COMPLETED_BLOCKS",      QUI$_COMPLETED_BLOCKS           },
   { TYP_HEX,  "CONDITION_VECTOR",      QUI$_CONDITION_VECTOR           },
   { TYP_DTIM, "CPU_DEFAULT",           QUI$_CPU_DEFAULT                },
   { TYP_DTIM, "CPU_LIMIT",             QUI$_CPU_LIMIT                  },
   { TYP_LSTR, "DEFAULT_FORM_NAME",     QUI$_DEFAULT_FORM_NAME          },
   { TYP_LSTR, "DEFAULT_FORM_STOCK",    QUI$_DEFAULT_FORM_STOCK         },
   { TYP_LSTR, "DEVICE_NAME",           QUI$_DEVICE_NAME                },
   { TYP_INT,  "ENTRY_NUMBER",          QUI$_ENTRY_NUMBER               },
   { TYP_INT,  "EXECUTING_JOB_COUNT",   QUI$_EXECUTING_JOB_COUNT        },
   { TYP_FLF,  "FILE_BURST",            QUI$M_FILE_BURST                },
   { TYP_FLS,  "FILE_CHECKPOINTED",     QUI$M_FILE_CHECKPOINTED         },
   { TYP_INT,  "FILE_COPIES",           QUI$_FILE_COPIES                },
   { TYP_INT,  "FILE_COPIES_DONE",      QUI$_FILE_COPIES_DONE           },
   { TYP_FLF,  "FILE_DELETE",           QUI$M_FILE_DELETE               },
   { TYP_FLF,  "FILE_DOUBLE_SPACE",     QUI$M_FILE_DOUBLE_SPACE         },
   { TYP_FLS,  "FILE_EXECUTING",        QUI$M_FILE_EXECUTING            },
   { TYP_FLF,  "FILE_FLAG",             QUI$M_FILE_FLAG                 },
   { TYP_INT,  "FILE_FLAGS",            QUI$_FILE_FLAGS                 },
   { TYP_LSTR, "FILE_IDENTIFICATION",   QUI$_FILE_IDENTIFICATION        },
   { TYP_FLF,  "FILE_PAGE_HEADER",      QUI$M_FILE_PAGE_HEADER          },
   { TYP_FLF,  "FILE_PAGINATE",         QUI$M_FILE_PAGINATE             },
   { TYP_FLF,  "FILE_PASSALL",          QUI$M_FILE_PASSALL              },
   { TYP_LSTR, "FILE_SETUP_MODULES",    QUI$_FILE_SETUP_MODULES         },
   { TYP_LSTR, "FILE_SPECIFICATION",    QUI$_FILE_SPECIFICATION         },
   { TYP_INT,  "FILE_STATUS",           QUI$_FILE_STATUS                },
   { TYP_FLF,  "FILE_TRAILER",          QUI$M_FILE_TRAILER              },
   { TYP_INT,  "FIRST_PAGE",            QUI$_FIRST_PAGE                 },
   { TYP_LSTR, "FORM_DESCRIPTION",      QUI$_FORM_DESCRIPTION           },
   { TYP_INT,  "FORM_FLAGS",            QUI$_FORM_FLAGS                 },
   { TYP_INT,  "FORM_LENGTH",           QUI$_FORM_LENGTH                },
   { TYP_INT,  "FORM_MARGIN_BOTTOM",    QUI$_FORM_MARGIN_BOTTOM         },
   { TYP_INT,  "FORM_MARGIN_LEFT",      QUI$_FORM_MARGIN_LEFT           },
   { TYP_INT,  "FORM_MARGIN_RIGHT",     QUI$_FORM_MARGIN_RIGHT          },
   { TYP_INT,  "FORM_MARGIN_TOP",       QUI$_FORM_MARGIN_TOP            },
   { TYP_LSTR, "FORM_NAME",             QUI$_FORM_NAME                  },
   { TYP_INT,  "FORM_NUMBER",           QUI$_FORM_NUMBER                },
   { TYP_LSTR, "FORM_SETUP_MODULES",    QUI$_FORM_SETUP_MODULES         },
   { TYP_FMF,  "FORM_SHEET_FEED",       QUI$M_FORM_SHEET_FEED           },
   { TYP_LSTR, "FORM_STOCK",            QUI$_FORM_STOCK                 },
   { TYP_FMF,  "FORM_TRUNCATE",         QUI$M_FORM_TRUNCATE             },
   { TYP_INT,  "FORM_WIDTH",            QUI$_FORM_WIDTH                 },
   { TYP_FMF,  "FORM_WRAP",             QUI$M_FORM_WRAP                 },
   { TYP_LSTR, "GENERIC_TARGET",        QUI$_GENERIC_TARGET             },
   { TYP_INT,  "HOLDING_JOB_COUNT",     QUI$_HOLDING_JOB_COUNT          },
   { TYP_INT,  "INTERVENING_BLOCKS",    QUI$_INTERVENING_BLOCKS         },
   { TYP_INT,  "INTERVENING_JOBS",      QUI$_INTERVENING_JOBS           },
   { TYP_JBS,  "JOB_ABORTING",          QUI$M_JOB_ABORTING              },
   { TYP_INT,  "JOB_COPIES",            QUI$_JOB_COPIES                 },
   { TYP_INT,  "JOB_COPIES_DONE",       QUI$_JOB_COPIES_DONE            },
   { TYP_JBF,  "JOB_CPU_LIMIT",         QUI$M_JOB_CPU_LIMIT             },
   { TYP_JBS,  "JOB_EXECUTING",         QUI$M_JOB_EXECUTING             },
   { TYP_JBF,  "JOB_FILE_BURST",        QUI$M_JOB_FILE_BURST            },
   { TYP_JBF,  "JOB_FILE_BURST_ONE",    QUI$M_JOB_FILE_BURST_ONE        },
   { TYP_JBF,  "JOB_FILE_FLAG",         QUI$M_JOB_FILE_FLAG             },
   { TYP_JBF,  "JOB_FILE_FLAG_ONE",     QUI$M_JOB_FILE_FLAG_ONE         },
   { TYP_JBF,  "JOB_FILE_PAGINATE",     QUI$M_JOB_FILE_PAGINATE         },
   { TYP_JBF,  "JOB_FILE_TRAILER",      QUI$M_JOB_FILE_TRAILER          },
   { TYP_JBF,  "JOB_FILE_TRAILER_ONE",  QUI$M_JOB_FILE_TRAILER_ONE      },
   { TYP_INT,  "JOB_FLAGS",             QUI$_JOB_FLAGS                  },
   { TYP_JBS,  "JOB_HOLDING",           QUI$M_JOB_HOLDING               },
   { TYP_JBS,  "JOB_INACCESSIBLE",      QUI$M_JOB_INACCESSIBLE          },
   { TYP_INT,  "JOB_LIMIT",             QUI$_JOB_LIMIT                  },
   { TYP_JBF,  "JOB_LOG_DELETE",        QUI$M_JOB_LOG_DELETE            },
   { TYP_JBF,  "JOB_LOG_NULL",          QUI$M_JOB_LOG_NULL              },
   { TYP_JBF,  "JOB_LOG_SPOOL",         QUI$M_JOB_LOG_SPOOL             },
   { TYP_JBF,  "JOB_LOWERCASE",         QUI$M_JOB_LOWERCASE             },
   { TYP_LSTR, "JOB_NAME",              QUI$_JOB_NAME                   },
   { TYP_JBF,  "JOB_NOTIFY",            QUI$M_JOB_NOTIFY                },
   { TYP_JBS,  "JOB_PENDING",           QUI$M_JOB_PENDING               },
   { TYP_HEX,  "JOB_PID",               QUI$_JOB_PID                    },
   { TYP_JBS,  "JOB_REFUSED",           QUI$M_JOB_REFUSED               },
   { TYP_LSTR, "JOB_RESET_MODULES",     QUI$_JOB_RESET_MODULES          },
   { TYP_JBF,  "JOB_RESTART",           QUI$M_JOB_RESTART               },
   { TYP_JBS,  "JOB_RETAINED",          QUI$M_JOB_RETAINED              },
   { TYP_INT,  "JOB_SIZE",              QUI$_JOB_SIZE                   },
   { TYP_INT,  "JOB_SIZE_MAXIMUM",      QUI$_JOB_SIZE_MAXIMUM           },
   { TYP_INT,  "JOB_SIZE_MINIMUM",      QUI$_JOB_SIZE_MINIMUM           },
   { TYP_JBS,  "JOB_STARTING",          QUI$M_JOB_STARTING              },
   { TYP_INT,  "JOB_STATUS",            QUI$_JOB_STATUS                 },
   { TYP_JBS,  "JOB_SUSPENDED",         QUI$M_JOB_SUSPENDED             },
   { TYP_JBS,  "JOB_TIMED_RELEASE",     QUI$M_JOB_TIMED_RELEASE         },
   { TYP_JBF,  "JOB_WSDEFAULT",         QUI$M_JOB_WSDEFAULT             },
   { TYP_JBF,  "JOB_WSEXTENT",          QUI$M_JOB_WSEXTENT              },
   { TYP_JBF,  "JOB_WSQUOTA",           QUI$M_JOB_WSQUOTA               },
   { TYP_INT,  "LAST_PAGE",             QUI$_LAST_PAGE                  },
   { TYP_LSTR, "LIBRARY_SPECIFICATION", QUI$_LIBRARY_SPECIFICATION      },
   { TYP_LSTR, "LOG_QUEUE",             QUI$_LOG_QUEUE                  },
   { TYP_LSTR, "LOG_SPECIFICATION",     QUI$_LOG_SPECIFICATION          },
   { TYP_LSTR, "NOTE",                  QUI$_NOTE                       },
   { TYP_LSTR, "OPERATOR_REQUEST",      QUI$_OPERATOR_REQUEST           },
   { TYP_UIC,  "OWNER_UIC",             QUI$_OWNER_UIC                  },
   { TYP_LSTR, "PAGE_SETUP_MODULES",    QUI$_PAGE_SETUP_MODULES         },
   { TYP_LSTR, "PARAMETER_1",           QUI$_PARAMETER_1                },
   { TYP_LSTR, "PARAMETER_2",           QUI$_PARAMETER_2                },
   { TYP_LSTR, "PARAMETER_3",           QUI$_PARAMETER_3                },
   { TYP_LSTR, "PARAMETER_4",           QUI$_PARAMETER_4                },
   { TYP_LSTR, "PARAMETER_5",           QUI$_PARAMETER_5                },
   { TYP_LSTR, "PARAMETER_6",           QUI$_PARAMETER_6                },
   { TYP_LSTR, "PARAMETER_7",           QUI$_PARAMETER_7                },
   { TYP_LSTR, "PARAMETER_8",           QUI$_PARAMETER_8                },
   { TYP_INT,  "PENDING_JOB_BLOCK_COUNT",QUI$_PENDING_JOB_BLOCK_COUNT   },
   { TYP_INT,  "PENDING_JOB_COUNT",     QUI$_PENDING_JOB_COUNT          },
   { TYP_INT,  "PENDING_JOB_REASON",    QUI$_PENDING_JOB_REASON         },
   { TYP_PJR,  "PEND_CHAR_MISMATCH",    QUI$M_PEND_CHAR_MISMATCH        },
   { TYP_PJR,  "PEND_JOB_SIZE_MAX",     QUI$M_PEND_JOB_SIZE_MAX         },
   { TYP_PJR,  "PEND_JOB_SIZE_MIN",     QUI$M_PEND_JOB_SIZE_MIN         },
   { TYP_PJR,  "PEND_LOWERCASE_MISMATCH",QUI$M_PEND_LOWERCASE_MISMATCH  },
   { TYP_PJR,  "PEND_NO_ACCESS",        QUI$M_PEND_NO_ACCESS            },
   { TYP_PJR,  "PEND_QUEUE_BUSY",       QUI$M_PEND_QUEUE_BUSY           },
   { TYP_PJR,  "PEND_QUEUE_STATE",      QUI$M_PEND_QUEUE_STATE          },
   { TYP_PJR,  "PEND_STOCK_MISMATCH",   QUI$M_PEND_STOCK_MISMATCH       },
   { TYP_INT,  "PRIORITY",              QUI$_PRIORITY                   },
   { TYP_LSTR, "PROCESSOR",             QUI$_PROCESSOR                  },
   { TYP_PROT, "PROTECTION",            QUI$_PROTECTION                 },
   { TYP_QUF,  "QUEUE_ACL_SPECIFIED",   QUI$M_QUEUE_ACL_SPECIFIED       },
   { TYP_QUS,  "QUEUE_ALIGNING",        QUI$M_QUEUE_ALIGNING            },
   { TYP_QUF,  "QUEUE_BATCH",           QUI$M_QUEUE_BATCH               },
   { TYP_QUS,  "QUEUE_CLOSED",          QUI$M_QUEUE_CLOSED              },
   { TYP_QUF,  "QUEUE_CPU_DEFAULT",     QUI$M_QUEUE_CPU_DEFAULT         },
   { TYP_QUF,  "QUEUE_CPU_LIMIT",       QUI$M_QUEUE_CPU_LIMIT           },
   { TYP_MSTR, "QUEUE_DESCRIPTION",     QUI$_QUEUE_DESCRIPTION          },
   { TYP_QUF,  "QUEUE_FILE_BURST",      QUI$M_QUEUE_FILE_BURST          },
   { TYP_QUF,  "QUEUE_FILE_BURST_ONE",  QUI$M_QUEUE_FILE_BURST_ONE      },
   { TYP_QUF,  "QUEUE_FILE_FLAG",       QUI$M_QUEUE_FILE_FLAG           },
   { TYP_QUF,  "QUEUE_FILE_FLAG_ONE",   QUI$M_QUEUE_FILE_FLAG_ONE       },
   { TYP_QUF,  "QUEUE_FILE_PAGINATE",   QUI$M_QUEUE_FILE_PAGINATE       },
   { TYP_QUF,  "QUEUE_FILE_TRAILER",    QUI$M_QUEUE_FILE_TRAILER        },
   { TYP_QUF,  "QUEUE_FILE_TRAILER_ONE",QUI$M_QUEUE_FILE_TRAILER_ONE    },
   { TYP_INT,  "QUEUE_FLAGS",           QUI$_QUEUE_FLAGS                },
   { TYP_QUF,  "QUEUE_GENERIC",         QUI$M_QUEUE_GENERIC             },
   { TYP_QUF,  "QUEUE_GENERIC_SELECTION",QUI$M_QUEUE_GENERIC_SELECTION  },
   { TYP_QUS,  "QUEUE_IDLE",            QUI$M_QUEUE_IDLE                },
   { TYP_QUF,  "QUEUE_JOB_BURST",       QUI$M_QUEUE_JOB_BURST           },
   { TYP_QUF,  "QUEUE_JOB_FLAG",        QUI$M_QUEUE_JOB_FLAG            },
   { TYP_QUF,  "QUEUE_JOB_SIZE_SCHED",  QUI$M_QUEUE_JOB_SIZE_SCHED      },
   { TYP_QUF,  "QUEUE_JOB_TRAILER",     QUI$M_QUEUE_JOB_TRAILER         },
   { TYP_QUS,  "QUEUE_LOWERCASE",       QUI$M_QUEUE_LOWERCASE           },
   { TYP_LSTR, "QUEUE_NAME",            QUI$_QUEUE_NAME                 },
   { TYP_QUS,  "QUEUE_PAUSED",          QUI$M_QUEUE_PAUSED              },
   { TYP_QUS,  "QUEUE_PAUSING",         QUI$M_QUEUE_PAUSING             },
   { TYP_QUF,  "QUEUE_PRINTER",         QUI$M_QUEUE_PRINTER             },
   { TYP_QUF,  "QUEUE_RECORD_BLOCKING", QUI$M_QUEUE_RECORD_BLOCKING     },
   { TYP_QUS,  "QUEUE_REMOTE",          QUI$M_QUEUE_REMOTE              },
   { TYP_QUS,  "QUEUE_RESETTING",       QUI$M_QUEUE_RESETTING           },
   { TYP_QUS,  "QUEUE_RESUMING",        QUI$M_QUEUE_RESUMING            },
   { TYP_QUF,  "QUEUE_RETAIN_ALL",      QUI$M_QUEUE_RETAIN_ALL          },
   { TYP_QUF,  "QUEUE_RETAIN_ERROR",    QUI$M_QUEUE_RETAIN_ERROR        },
   { TYP_QUS,  "QUEUE_SERVER",          QUI$M_QUEUE_SERVER              },
   { TYP_QUS,  "QUEUE_STALLED",         QUI$M_QUEUE_STALLED             },
   { TYP_QUS,  "QUEUE_STARTING",        QUI$M_QUEUE_STARTING            },
   { TYP_INT,  "QUEUE_STATUS",          QUI$_QUEUE_STATUS               },
   { TYP_QUS,  "QUEUE_STOPPED",         QUI$M_QUEUE_STOPPED             },
   { TYP_QUS,  "QUEUE_STOPPING",        QUI$M_QUEUE_STOPPING            },
   { TYP_QUF,  "QUEUE_SWAP",            QUI$M_QUEUE_SWAP                },
   { TYP_QUF,  "QUEUE_TERMINAL",        QUI$M_QUEUE_TERMINAL            },
   { TYP_QUS,  "QUEUE_UNAVAILABLE",     QUI$M_QUEUE_UNAVAILABLE         },
   { TYP_QUF,  "QUEUE_WSDEFAULT",       QUI$M_QUEUE_WSDEFAULT           },
   { TYP_QUF,  "QUEUE_WSEXTENT",        QUI$M_QUEUE_WSEXTENT            },
   { TYP_QUF,  "QUEUE_WSQUOTA",         QUI$M_QUEUE_WSQUOTA             },
   { TYP_LSTR, "REQUEUE_QUEUE_NAME",    QUI$_REQUEUE_QUEUE_NAME         },
   { TYP_LSTR, "RESTART_QUEUE_NAME",    QUI$_RESTART_QUEUE_NAME         },
   { TYP_INT,  "RETAINED_JOB_COUNT",    QUI$_RETAINED_JOB_COUNT         },
   { TYP_LSTR, "SCSNODE_NAME",          QUI$_SCSNODE_NAME               },
   { TYP_TIME, "SUBMISSION_TIME",       QUI$_SUBMISSION_TIME            },
   { TYP_INT,  "TIMED_RELEASE_JOB_COUNT",QUI$_TIMED_RELEASE_JOB_COUNT   },
   { TYP_LSTR, "UIC",                   QUI$_UIC                        },
   { TYP_LSTR, "USERNAME",              QUI$_USERNAME                   },
   { TYP_INT,  "WSDEFAULT",             QUI$_WSDEFAULT                  },
   { TYP_INT,  "WSEXTENT",              QUI$_WSEXTENT                   },
   { TYP_INT,  "WSQUOTA",               QUI$_WSQUOTA                    },
} ;

static const struct dvi_items_type qui_flags[] = {
   { TYP_INT, "ALL_JOBS",               QUI$M_SEARCH_ALL_JOBS           },
   { TYP_INT, "BATCH",                  QUI$M_SEARCH_BATCH              },
   { TYP_INT, "EXECUTING_JOBS",         QUI$M_SEARCH_EXECUTING_JOBS     },
   { TYP_INT, "FREEZE_CONTEXT",         QUI$M_SEARCH_FREEZE_CONTEXT     },
   { TYP_INT, "GENERIC",                QUI$M_SEARCH_GENERIC            },
   { TYP_INT, "HOLDING_JOBS",           QUI$M_SEARCH_HOLDING_JOBS       },
   { TYP_INT, "PENDING_JOBS",           QUI$M_SEARCH_PENDING_JOBS       },
   { TYP_INT, "PRINTER",                QUI$M_SEARCH_PRINTER            },
   { TYP_INT, "RETAINED_JOBS",          QUI$M_SEARCH_RETAINED_JOBS      },
   { TYP_INT, "SERVER",                 QUI$M_SEARCH_SERVER             },
   { TYP_INT, "SYMBIONT",               QUI$M_SEARCH_SYMBIONT           },
   { TYP_INT, "TERMINAL",               QUI$M_SEARCH_TERMINAL           },
   { TYP_INT, "THIS_JOB",               QUI$M_SEARCH_THIS_JOB           },
   { TYP_INT, "TIMED_RELEASE_JOBS",     QUI$M_SEARCH_TIMED_RELEASE_JOBS },
   { TYP_INT, "WILDCARD",               QUI$M_SEARCH_WILDCARD           },
} ;

static const int qui_stats[] = {
        QUI$_FILE_FLAGS,                QUI$_FILE_STATUS,
        QUI$_FORM_FLAGS,                QUI$_JOB_FLAGS,
        QUI$_JOB_STATUS,                QUI$_PENDING_JOB_REASON,
        QUI$_QUEUE_FLAGS,               QUI$_QUEUE_STATUS,
} ;


streng *vms_f_getqui( tsd_t *TSD, cparamboxptr parms )
{
   short length, func ;
   int flags, i, item_value, objnum, rc, usenum, item_mask ;
   char buffer[256] ;
   int items[21], cnt=0, *vector ;
   int search_flags=0, search_length=4, search_number[10], search_nlength ;
   cparamboxptr tmp ;
   int ioblk[2] ;
   streng *item, *objid ;
   struct dvi_items_type *ptr, *item_ptr ;
   $DESCRIPTOR( objdescr, "" ) ;
   $DESCRIPTOR( resdescr, buffer ) ;

   if (!parms->value)
      exiterror( ERR_INCORRECT_CALL , 0 ) ;

/*
 * First, find the function we are to perform, that is the first parameter
 * in the call to f$getqui().
 */
   if (!(ptr=item_info( parms->value, qui_funcs, sizeof(qui_funcs))))
      exiterror( ERR_INCORRECT_CALL , 0 )  ;

/*
 * Depending on the function chosen, check that the parameters are legal
 * for than function. I.e. all parameters that must be specified exists,
 * and no illegal parameters are specified.
 */
   tmp = parms->next ;
   for (i=0; i<3; i++)
   {
      if (((ptr->type >> i) & 0x01) && ((!tmp) || (!tmp->value)))
         exiterror( ERR_INCORRECT_CALL , 0 ) ;

      if (((ptr->type >> i) & 0x10) && ((tmp) && (tmp->value)))
         exiterror( ERR_INCORRECT_CALL , 0 ) ;

      if (tmp) tmp = tmp->next ;
   }

   tmp = parms->next ;
   if (objid = (tmp && tmp->next) ? ((tmp=tmp->next)->value) : NULL )
   {
      if (usenum=myisnumber(objid))
      {
         items[cnt++] = 4 + ( QUI$_SEARCH_NUMBER << 16 ) ;
         items[cnt++] = (int)&(search_number[0]) ;
         items[cnt++] = (int)NULL /* &search_nlength  */ ;
         search_number[0] = atozpos(TSD, objid, "VMS_F_GETQUI", 0 ) ;
         search_nlength = 0 ;
         length = 0 ;
      }
      else
      {
         items[cnt++] = objid->len + ( QUI$_SEARCH_NAME << 16 ) ;
         items[cnt++] = (int)&(objid->value[0]) ;
         items[cnt++] = (int)&search_nlength ;
         search_nlength = objid->len ;
      }
   }

/*
 * Now, find the item for which we are to retrieve information. If the
 * type-specified indicates that this is part of a vector which must
 * be split up, then save som vital information.
 */
   item = (tmp=parms->next) ? (tmp->value) : NULL ;
   if (item)
   {
      item_ptr = item_info( item, qui_items, sizeof( qui_items )) ;
      if (!item_ptr)
         exiterror( ERR_INCORRECT_CALL , 0 ) ;

      if (item_ptr->type >= TYP_SPECIFICS)
      {
         item_value = qui_stats[ item_ptr->type - TYP_SPECIFICS ] ;
         item_mask = item_ptr->addr ;
      }
      else
         item_value = item_ptr->addr ;

      items[cnt++] = 256 + ( item_value << 16 ) ;
      items[cnt++] = (int)buffer ;
      items[cnt++] = (int)&length ;
      vector = (int *)buffer ;

      if (!(leg_items[item_ptr - qui_items] & (1 << (ptr-qui_funcs))))
          exiterror( ERR_INCORRECT_CALL , 0 ) ;
   }
   else
      item_ptr = NULL ;

   items[cnt++] = 0 ;
   items[cnt++] = 0 ;
   items[cnt++] = 0 ;

   func = ptr->addr ;
   ioblk[0] = ioblk[1] = 0 ;

   rc = sys$getquiw( NULL, func, NULL, &items, ioblk, NULL, NULL ) ;

   if ((rc==SS$_NORMAL) && ((ioblk[0]==JBC$_NOSUCHJOB) ||
          (ioblk[0]==JBC$_NOMOREQUE) || (ioblk[0]==JBC$_NOQUECTX)))
      return nullstringptr() ;

   if (rc != SS$_NORMAL)
   {
      vms_error( TSD, rc ) ;
      return nullstringptr() ;
   }

   if (!item_ptr)
      return nullstringptr() ;

   if (ioblk[0] != JBC$_NORMAL)
   {
      vms_error( TSD, ioblk[0] ) ;
      return nullstringptr() ;
   }

   if ( item_ptr->type >= TYP_SPECIFICS)
      return Str_creTSD( (*vector & item_ptr->addr) ? "TRUE" : "FALSE" ) ;

   return format_result( TSD, item_ptr->type, buffer, length ) ;
}



static const struct dvi_items_type syi_items[] = {
   { TYP_INT,  "ACTIVECPU_CNT",         SYI$_ACTIVECPU_CNT              },
   { TYP_INT,  "ARCHFLAG",              SYI$_ARCHFLAG                   },
   { TYP_INT,  "AVAILCPU_CNT",          SYI$_AVAILCPU_CNT               },
   { TYP_TIME, "BOOTTIME",              SYI$_BOOTTIME                   },
   { TYP_BOOL, "CHARACTER_EMULATED",    SYI$_CHARACTER_EMULATED         },
/* { TYP_INT,  "CLUSTER_EVOTES",        SYI$_CLUSTER_EVOTES             }, */
   { TYP_LHEX, "CLUSTER_FSYSID",        SYI$_CLUSTER_FSYSID             },
   { TYP_TIME, "CLUSTER_FTIME",         SYI$_CLUSTER_FTIME              },
   { TYP_BOOL, "CLUSTER_MEMBER",        SYI$_CLUSTER_MEMBER             },
   { TYP_INT,  "CLUSTER_NODES",         SYI$_CLUSTER_NODES              },
   { TYP_INT,  "CLUSTER_QUORUM",        SYI$_CLUSTER_QUORUM             },
   { TYP_INT,  "CLUSTER_VOTES",         SYI$_CLUSTER_VOTES              },
   { TYP_INT,  "CONTIG_GBLPAGES",       SYI$_CONTIG_GBLPAGES            },
   { TYP_INT,  "CPU",                   SYI$_CPU                        },
   { TYP_BOOL, "DECIMAL_EMULATED",      SYI$_DECIMAL_EMULATED           },
   { TYP_BOOL, "D_FLOAT_EMULATED",      SYI$_D_FLOAT_EMULATED           },
   { TYP_INT,  "ERRORLOGBUFFERS",       SYI$_ERRORLOGBUFFERS            },
   { TYP_INT,  "FREE_GBLPAGES",         SYI$_FREE_GBLPAGES              },
   { TYP_INT,  "FREE_GBLSECTS",         SYI$_FREE_GBLSECTS              },
   { TYP_BOOL, "F_FLOAT_EMULATED",      SYI$_F_FLOAT_EMULATED           },
   { TYP_BOOL, "G_FLOAT_EMULATED",      SYI$_G_FLOAT_EMULATED           },
   { TYP_INT,  "HW_MODEL",              SYI$_HW_MODEL                   },
   { TYP_LSTR, "HW_NAME",               SYI$_HW_NAME                    },
   { TYP_BOOL, "H_FLOAT_EMULATED",      SYI$_H_FLOAT_EMULATED           },
   { TYP_LSTR, "NODENAME",              SYI$_NODENAME                   },
   { TYP_INT,  "NODE_AREA",             SYI$_NODE_AREA                  },
   { TYP_LHEX, "NODE_CSID",             SYI$_NODE_CSID                  },
   { TYP_INT,  "NODE_EVOTES",           SYI$_NODE_EVOTES                },
   { TYP_LSTR, "NODE_HWTYPE",           SYI$_NODE_HWTYPE                },
   { TYP_LHEX, "NODE_HWVERS",           SYI$_NODE_HWVERS                },
   { TYP_INT,  "NODE_NUMBER",           SYI$_NODE_NUMBER                },
   { TYP_INT,  "NODE_QUORUM",           SYI$_NODE_QUORUM                },
   { TYP_LHEX, "NODE_SWINCARN",         SYI$_NODE_SWINCARN              },
   { TYP_LSTR, "NODE_SWTYPE",           SYI$_NODE_SWTYPE                },
   { TYP_LSTR, "NODE_SWVERS",           SYI$_NODE_SWVERS                },
   { TYP_LHEX, "NODE_SYSTEMID",         SYI$_NODE_SYSTEMID              },
   { TYP_INT,  "NODE_VOTES",            SYI$_NODE_VOTES                 },
   { TYP_INT,  "PAGEFILE_FREE",         SYI$_PAGEFILE_FREE              },
   { TYP_INT,  "PAGEFILE_PAGE",         SYI$_PAGEFILE_PAGE              },
   { TYP_BOOL, "SCS_EXISTS",            SYI$_SCS_EXISTS                 },
   { TYP_INT,  "SID",                   SYI$_SID                        },
   { TYP_INT,  "SWAPFILE_FREE",         SYI$_SWAPFILE_FREE              },
   { TYP_INT,  "SWAPFILE_PAGE",         SYI$_SWAPFILE_PAGE              },
   { TYP_LSTR, "VERSION",               SYI$_VERSION                    },
   { TYP_INT,  "XCPU",                  SYI$_XCPU                       },
   { TYP_INT,  "XSID",                  SYI$_XSID                       },
} ;

streng *vms_f_getsyi( tsd_t *TSD, cparamboxptr parms )
{
   char buffer[64] ;
   int length=0, rc, item[6] ;
   struct dvi_items_type *ptr ;
   struct dsc$descriptor_s name, *namep=NULL ;
   struct dsc$descriptor_s dir = {
       sizeof(buffer)-1, DSC$K_DTYPE_T, DSC$K_CLASS_S, buffer } ;

   checkparam( parms, 1, 2, "VMS_F_GETSYI" ) ;

   ptr = item_info( parms->value, syi_items, sizeof( syi_items)) ;
   if (!ptr)
      exiterror( ERR_INCORRECT_CALL , 0 ) ;

   item[0] = 64 + (ptr->addr << 16) ;
   item[1] = (int)buffer ;
   item[2] = (int)&length ;
   item[3] = item[4] = item[5] = 0 ;

   if (parms->next && parms->next->value)
   {
      namep = &name ;
      name.dsc$w_length = Str_len( parms->value ) ;
      name.dsc$b_dtype = DSC$K_DTYPE_T ;
      name.dsc$b_class = DSC$K_CLASS_S ;
      name.dsc$a_pointer = parms->value->value ;
   }

   rc = sys$getsyiw( NULL, NULL, namep, &item[0], NULL, NULL, NULL ) ;

   if (rc != SS$_NORMAL)
   {
      vms_error( TSD, rc ) ;
      return Str_creTSD("") ;
   }

   return format_result( TSD, ptr->type, buffer, length ) ;
}



streng *vms_f_identifier( tsd_t *TSD, cparamboxptr parms )
{
   streng *in, *type, *result ;
   int id=0 ;

   checkparam( parms, 2, 2, "VMS_F_IDENTIFIER" ) ;

   type = parms->next->value ;

   if (type->len != 14)
      exiterror( ERR_INCORRECT_CALL , 0 ) ;

   if (!strncmp(type->value, "NAME_TO_NUMBER", 14))
      result = int_to_streng( TSD, name_to_num( TSD, parms->value )) ;
   else if (!strncmp(type->value, "NUMBER_TO_NAME", 14))
   {
      result = num_to_name( TSD, atozpos( TSD, parms->value, "VMS_F_IDENTIFIER", 1 )) ;
      if (!result)
         result = nullstringptr() ;
   }
   else
      exiterror( ERR_INCORRECT_CALL , 0 ) ;

   return result ;
}



streng *vms_f_message( tsd_t *TSD, cparamboxptr parms )
{
   char buffer[256] ;
   $DESCRIPTOR( name, buffer ) ;
   int length, rc, errmsg ;

   checkparam( parms, 1, 1, "VMS_F_MESSAGE" ) ;
   errmsg = atopos( TSD, parms->value, "VMS_F_MESSAGE", 1 ) ;

   rc = sys$getmsg( errmsg, &length, &name, NULL, NULL ) ;

   if ((rc != SS$_NORMAL) && (rc != SS$_MSGNOTFND))
      vms_error( TSD, rc ) ;

   return Str_ncatstrTSD( Str_makeTSD(length), buffer, length ) ;
}


streng *vms_f_mode( tsd_t *TSD, cparamboxptr parms )
{
   char buffer[256] ;
   $DESCRIPTOR( descr, buffer ) ;
   int item = JPI$_MODE, length, rc ;

   rc = lib$getjpi( &item, NULL, NULL, NULL, &descr, &length ) ;

   if (rc != SS$_NORMAL)
      vms_error( TSD, rc ) ;

   return Str_ncatstrTSD( Str_makeTSD(length), buffer, length ) ;
}


streng *vms_f_pid( tsd_t *TSD, cparamboxptr parms )
{
   short length ;
   int *pidp=NULL, rc, buffer ;
   unsigned int items[6] ;
   const streng *Pid ;
   vmf_tsd_t *vt;
   char *str;
   streng *val;

   vt = TSD->vmf_tsd;
   checkparam( parms, 1, 1, "VMS_F_PID" ) ;

   items[0] = ( JPI$_PID << 16 ) + 4 ;
   items[1] = (unsigned int)&buffer ;
   items[2] = (unsigned int)&length ;
   items[3] = 0 ;
   items[4] = 0 ;
   items[5] = 0 ;

   Pid = getvalue( TSD, parms->value, 0 ) ;

   if (Pid->len)
   {
      str = str_of( TSD, val ) ;
      sscanf( str, "%x", &pid ) ;
      FreeTSD( str ) ;
   }
   else
      pid = -1 ;

   do {
      rc = sys$getjpiw( NULL, &pid, NULL, &items, NULL, NULL, NULL ) ;
   while (rc == SS$_NOPRIV) ;

   if ((rc != SS$_NORMAL) && (rc != SS$_NOMOREPROC))
      vms_error( TSD, rc ) ;

   sprintf( (val=Str_makeTSD(10))->value, "%08x", pid ) ;
   val->len = 8 ;
   setvalue( TSD, parms->value, val ) ;

   if (rc == SS$_NOMOREPROC)
      return nullstringptr() ;

   assert( length==4 ) ;
   sprintf( (val=Str_makeTSD(10))->value, "%08x", buffer ) ;
   val->len = 8 ;

   return val ;
}


#define MAX_PRIVS (sizeof(all_privs)/sizeof(char*))

static streng *map_privs( const int *vector )
{
   int i ;
   char *ptr, buffer[512] ;

   *(ptr=buffer) = 0x00 ;
   for (i=0; i<MAX_PRIVS; i++)
      if ((vector[i/32] >> (i%32)) & 0x01)
      {
         strcat( ptr, all_privs[i] ) ;
         ptr += strlen(all_privs[i]) ;
         strcat( ptr++, "," ) ;
      }

   if (ptr>buffer)
      *(--ptr) = 0x00 ;

   return Str_ncatstrTSD( Str_makeTSD(ptr-buffer), buffer, (ptr-buffer)) ;
}

static int extract_privs( int *vector, const streng *privs )
{
   int max_priv, negate, i ;
   const char *ptr, *eptr, *tptr, *lptr ;

   max_priv = MAX_PRIVS ;

   eptr = Str_end( privs ) ;
   for (ptr=privs->value; ptr<eptr; ptr=(++lptr) )
   {
      for (; isspace(*ptr) && ptr<eptr; ptr++ ) ;
      for (lptr=ptr; (lptr<eptr) && (*lptr!=','); lptr++) ;
      for (tptr=lptr; isspace(*(tptr-1)) && tptr>=ptr; tptr-- ) ;
      if (tptr-ptr<3)
         return 1 ;

      negate = ((*ptr=='N') && (*(ptr+1)=='O')) * 2 ;
      for (i=0; i<max_priv; i++)
         if ((!strncmp(ptr+negate,all_privs[i],tptr-ptr-negate)) &&
                                (all_privs[i][tptr-ptr-negate] == 0x00))
         {
            if (negate)
               vector[2+i/32] |= (1 << (i%32)) ;
            else
               vector[i/32] |= (1 << (i%32)) ;
            break ;
         }

      if (i==max_priv)
         return 1 ;
   }
   return 0 ;
}


streng *vms_f_privilege( tsd_t *TSD, cparamboxptr parms )
{
   int privbits[4], privs[2] ;
   int rc ;
   char *ptr, *eptr, *tptr ;

   checkparam( parms, 1, 1, "VMS_F_PRIVILEGE" ) ;
   extract_privs( privbits, parms->value ) ;

   rc = lib$getjpi( &JPI$_PROCPRIV, NULL, NULL, &privs, NULL, NULL ) ;
   if (rc != SS$_NORMAL)
      vms_error( TSD, rc ) ;

   return Str_creTSD(
            (((privbits[0] & ~privs[0]) | ( privbits[2] & privs[0] )) ||
             ((privbits[1] & ~privs[1]) | ( privbits[3] & privs[1] ))) ?
                     "FALSE" : "TRUE" ) ;
}



streng *vms_f_process( tsd_t *TSD, cparamboxptr parms )
{
   int rc, length ;
   char buffer[64] ;
   $DESCRIPTOR( descr, buffer ) ;

   checkparam( parms, 0, 0, "VMS_F_PROCESS" ) ;
   rc = lib$getjpi( &JPI$_PRCNAM, NULL, NULL, NULL, &descr, &length ) ;

   if ( rc != SS$_NORMAL)
      vms_error( TSD, rc ) ;

   return Str_ncatstrTSD( Str_makeTSD(length), buffer, length ) ;
}


streng *vms_f_string( tsd_t *TSD, cparamboxptr parms )
{
   checkparam( parms, 1, 1, "VMS_F_STRING" ) ;

/*   return str_norm( TSD, parms->value ) ;   / * if it existed */
   return Str_dupTSD(parms->value) ;
}



#define DAT_TIME_LEN 23

streng *vms_f_time( tsd_t *TSD, cparamboxptr parms )
{
   int rc ;
   char buffer[32] ;
   $DESCRIPTOR( descr, buffer ) ;

   checkparam( parms, 0, 0, "VMS_F_TIME" ) ;

   rc = lib$date_time( &descr ) ;
   if (rc != SS$_NORMAL)
      vms_error( TSD, rc ) ;

   return Str_ncatstrTSD( Str_makeTSD(DAT_TIME_LEN+1), buffer, DAT_TIME_LEN) ;
}


streng *vms_f_setprv( tsd_t *TSD, cparamboxptr parms )
{
   int privbits[4], old[2] ;
   int rc ;

   checkparam( parms, 1, 1, "VMS_F_SETPRV" ) ;

   extract_privs( privbits, parms->value ) ;
   rc = sys$setprv( 0, &privbits[0], 0, &old ) ;
   if (rc != SS$_NORMAL)
      vms_error( TSD, rc ) ;

   rc = sys$setprv( 1, &privbits[2], 0, NULL ) ;
   if (rc != SS$_NORMAL)
      vms_error( TSD, rc ) ;

   return map_privs( old ) ;
}


streng *vms_f_user( tsd_t *TSD, cparamboxptr parms )
{
   int item[6], rc ;
   short length ;
   union uicdef uic ;

   checkparam( parms, 0, 0, "VMS_F_USER" ) ;

   item[0] = 4 + ( JPI$_UIC << 16 ) ;
   item[1] = (int)&uic ;
   item[2] = (int)&length ;
   item[3] = item[4] = item[5] = 0 ;

   rc = sys$getjpi( NULL, NULL, NULL, item, NULL, NULL, NULL ) ;

   if ((rc != SS$_NORMAL) || (length != 4))
   {
      vms_error( TSD, rc ) ;
      return nullstringptr() ;
   }

   return get_uic( TSD, &uic ) ;
}


streng *vms_f_locate( tsd_t *TSD, cparamboxptr parms )
{
   int res ;

   checkparam( parms, 2, 2, "VMS_F_LOCATE" ) ;
   res = bmstrstr( parms->next->value, 0, parms->value ) ;
   if (res==(-1))
      res = parms->next->value->len + 1 ;

   return int_to_streng( TSD, res ) ;
}


streng *vms_f_length( tsd_t *TSD, cparamboxptr parms )
{
   checkparam( parms, 1, 1, "VMS_F_LENGTH" ) ;
   return int_to_streng( TSD, parms->value->len ) ;
}


streng *vms_f_integer( tsd_t *TSD, cparamboxptr parms )
{
   checkparam( parms, 1, 1, "VMS_F_INTEGER" ) ;
   return int_to_streng( TSD, myatol( TSD, parms->value )) ;
}


static const struct dvi_items_type trnlnm_cases[] = {
   { 1, "CASE_BLIND",     LNM$M_CASE_BLIND   },
   { 0, "CASE_SENSITIVE", LNM$M_CASE_BLIND   },
} ;

static const struct dvi_items_type trnlnm_modes[] = {
   { 0,        "EXECUTIVE",   PSL$C_EXEC      },
   { 0,        "KERNEL",      PSL$C_KERNEL    },
   { 0,        "SUPERVISOR",  PSL$C_SUPER     },
   { 0,        "USER",        PSL$C_USER      },
} ;

static const struct dvi_items_type trnlnm_list[] = {
   { TYP_TRNM, "ACCESS_MODE", LNM$_ACMODE     },
   { TYP_FLAG, "CONCEALED",   LNM$M_CONCEALED },
   { TYP_FLAG, "CONFINE",     LNM$M_CONFINE   },
   { TYP_FLAG, "CRELOG",      LNM$M_CRELOG    },
   { TYP_INT,  "LENGTH",      LNM$_LENGTH     },
   { TYP_INT,  "MAX_INDEX",   LNM$_MAX_INDEX  },
   { TYP_FLAG, "NO_ALIAS",    LNM$M_NO_ALIAS  },
   { TYP_FLAG, "TABLE",       LNM$M_TABLE     },
   { TYP_LSTR, "TABLE_NAME",  LNM$_TABLE      },
   { TYP_FLAG, "TERMINAL",    LNM$M_TERMINAL  },
   { TYP_BSTR, "VALUE",       LNM$_STRING     },
} ;

streng *vms_f_trnlnm( tsd_t *TSD, cparamboxptr parms )
{
   char buffer[256] ;
   $DESCRIPTOR( lognam, "" ) ;
   $DESCRIPTOR( tabnam, "LNM$DCL_LOGICAL" ) ;
   short length ;
   int attr=0, item=LNM$_STRING, rc, cnt=0, index ;
   unsigned char mode ;
   int attribs, lattribs ;
   struct dvi_items_type *item_ptr ;
   cparamboxptr ptr ;
   int items[20] ;

   checkparam( parms, 1, 6, "VMS_F_TRNLNM" ) ;

   ptr = parms ;
   lognam.dsc$a_pointer = ptr->value->value ;
   lognam.dsc$w_length = ptr->value->len ;

   if (ptr) ptr=ptr->next ;
   if (ptr && ptr->value)
   {
      tabnam.dsc$a_pointer = ptr->value->value ;
      tabnam.dsc$w_length = ptr->value->len ;
   }

   if (ptr) ptr=ptr->next ;
   if (ptr && ptr->value)
   {
      index = atozpos( TSD, ptr->value, "VMS_F_TRNLNM", 0 ) ;
      if (index<0 || index>127)
         exiterror( ERR_INCORRECT_CALL , 0 ) ;

      items[cnt++] = 4 + ( LNM$_INDEX << 16 ) ;
      items[cnt++] = (int)&index ;
      items[cnt++] = 0 ;
   }

   if (ptr) ptr=ptr->next ;
   if (ptr && ptr->value)
   {
      item_ptr = item_info( ptr->value, trnlnm_modes, sizeof( trnlnm_modes)) ;
      if (!item_ptr)
         exiterror( ERR_INCORRECT_CALL , 0 ) ;

      mode = item_ptr->addr ;
   }
   else
      mode = PSL$C_USER ;

   if (ptr) ptr=ptr->next ;
   if (ptr && ptr->value)
   {
      item_ptr = item_info( ptr->value, trnlnm_cases, sizeof( trnlnm_cases)) ;
      if (!item_ptr)
         exiterror( ERR_INCORRECT_CALL , 0 ) ;
/*
 * Digital says that bit zero is used, and LNM$M_CASE_BLIND points to
 * that bit, but LNM$M_CASE_BLIND is (1<<25). My guess is that there
 * is (yet another) f*ckup in DEC's documentation, so I hardcode the
 * value.
 */
/*    attr = ( item_ptr->type << item_ptr->addr ) ; */  /* don't work */
      attr = ( item_ptr->type << 0 ) ;
   }

   if (ptr) ptr=ptr->next ;
   if (ptr && ptr->value)
   {
      item_ptr = item_info( ptr->value, trnlnm_list, sizeof(trnlnm_list)) ;
      if (!item_ptr)
         exiterror( ERR_INCORRECT_CALL , 0 ) ;

      if (item_ptr->type == TYP_FLAG)
         item = (LNM$_ATTRIBUTES) ;
      else
         item = item_ptr->addr ;
   }
   else
      item_ptr = 0 ;

   items[cnt++] = 256 + ( item << 16 ) ;
   items[cnt++] = (int)buffer ;
   items[cnt++] = (int)&length ;

   items[cnt++] = 0 ;
   items[cnt++] = 0 ;
   items[cnt++] = 0 ;

   rc = sys$trnlnm( &attr, &tabnam, &lognam, &mode, items ) ;

   if (rc== SS$_NOLOGNAM)
      return nullstringptr() ;

   if (rc != SS$_NORMAL)
   {
      vms_error( TSD, rc ) ;
      return nullstringptr() ;
   }

   if (buffer[0]==0x1b && buffer[1]==0x00 &&
       ((item_ptr && item_ptr->addr==LNM$_STRING) || (!item_ptr)))
      return format_result( TSD, TYP_LSTR, &buffer[4], length-4) ;

   if (item_ptr && item_ptr->type == TYP_TRNM)
   {
      for (cnt=0; cnt<sizeof(trnlnm_modes)/sizeof(struct dvi_items_type);cnt++)
         if (trnlnm_modes[cnt].addr == (*((unsigned char*)buffer)))
            return Str_creTSD( trnlnm_modes[cnt].name ) ;
      exiterror( ERR_SYSTEM_FAILURE , 0 ) ;
   }

   if (item_ptr && item_ptr->type == TYP_FLAG)
      return Str_creTSD( (*((int*)buffer) & item_ptr->addr) ? "TRUE" : "FALSE" ) ;

   if (item_ptr)
      return format_result( TSD, item_ptr->type, buffer, length ) ;
   else
      return format_result( TSD, TYP_BSTR, buffer, length ) ;
}



streng *vms_f_logical( tsd_t *TSD, cparamboxptr parms )
{
   checkparam( parms, 1, 1, "VMS_F_LOGICAL" ) ;
   return vms_f_trnlnm( parms ) ;
}



static const struct dvi_items_type parse_types[] = {
   { 0, "NO_CONCEAL",  NAM$M_NOCONCEAL },
   { 0, "SYNTAX_ONLY", NAM$M_SYNCHK    },
} ;


#define PARSE_EVERYTHING 0x00
#define PARSE_DEVICE     0x01
#define PARSE_DIRECTORY  0x02
#define PARSE_NAME       0x04
#define PARSE_NODE       0x08
#define PARSE_TYPE       0x10
#define PARSE_VERSION    0x20

static const struct dvi_items_type parse_fields[] = {
   { 0, "DEVICE",    PARSE_DEVICE    },
   { 0, "DIRECTORY", PARSE_DIRECTORY },
   { 0, "NAME",      PARSE_NAME      },
   { 0, "NODE",      PARSE_NODE      },
   { 0, "TYPE",      PARSE_TYPE      },
   { 0, "VERSION",   PARSE_VERSION   },
} ;



streng *vms_f_parse( tsd_t *TSD, cparamboxptr parms )
{
   char relb[256], expb[256], relb2[256], expb2[256] ;
   int clen, rc, fields ;
   char *cptr ;
   struct dvi_items_type *item ;
   cparamboxptr ptr ;
   streng *result ;
   struct FAB fab, relfab ;
   struct NAM nam, relnam ;

   checkparam( parms, 1, 5, "VMS_F_PARSE" ) ;
   ptr = parms ;

   memcpy( &fab, &cc$rms_fab, sizeof(struct FAB)) ;
   memcpy( &nam, &cc$rms_nam, sizeof(struct NAM)) ;

   fab.fab$l_fna = ptr->value->value ;
   fab.fab$b_fns = ptr->value->len ;

/*
   nam.nam$l_rsa = buffer ;
   nam.nam$b_rss = sizeof(buffer)-1 ;
 */
   nam.nam$l_esa = expb ;
   nam.nam$b_ess = sizeof(expb)-1 ;

   fab.fab$w_ifi = 0 ;
   fab.fab$l_fop &= ~(FAB$M_OFP) ;
   fab.fab$l_nam = &nam ;

   ptr=ptr->next ;
   if (ptr && ptr->value)
   {
      fab.fab$l_dna = ptr->value->value ;
      fab.fab$b_dns = ptr->value->len ;
   }

   if (ptr) ptr=ptr->next ;
   if (ptr && ptr->value)
   {
      memcpy( &relfab, &cc$rms_fab, sizeof(struct FAB)) ;
      memcpy( &relnam, &cc$rms_nam, sizeof(struct NAM)) ;
      relnam.nam$l_rsa = ptr->value->value ;
      relnam.nam$b_rsl = ptr->value->len ;
      relnam.nam$b_rss = ptr->value->len ;

      nam.nam$l_rlf = &relnam ;
   }

   if (ptr) ptr=ptr->next ;
   if (ptr && ptr->value)
   {
      item = item_info( ptr->value, parse_fields, sizeof(parse_fields)) ;
      if (!item)
         exiterror( ERR_INCORRECT_CALL , 0 ) ;
      fields = item->addr ;
   }
   else
      fields = PARSE_EVERYTHING ;

   if (ptr) ptr=ptr->next ;
   if (ptr && ptr->value)
   {
      item = item_info( ptr->value, parse_types, sizeof(parse_types)) ;
      if (!item)
         exiterror( ERR_INCORRECT_CALL , 0 ) ;
      nam.nam$b_nop |= item->addr ;
   }

   rc = sys$parse( &fab, NULL, NULL ) ;

   if ((rc==RMS$_SYN) || (rc==RMS$_DEV) || (rc==RMS$_DNF) || (rc==RMS$_DIR) ||
       (rc==RMS$_NOD))
      return nullstringptr() ;

   if (rc != RMS$_NORMAL)
   {
      vms_error( TSD, rc ) ;
      return nullstringptr() ;
   }

   switch( fields )
   {
      case PARSE_EVERYTHING:
         cptr = nam.nam$l_esa ;  clen = nam.nam$b_esl ;  break ;

      case PARSE_DEVICE:
         cptr = nam.nam$l_dev ;  clen = nam.nam$b_dev ;  break ;

      case PARSE_DIRECTORY:
         cptr = nam.nam$l_dir ;  clen = nam.nam$b_dir ;  break ;

      case PARSE_NAME:
         cptr = nam.nam$l_name ; clen = nam.nam$b_name ; break ;

      case PARSE_NODE:
         cptr = nam.nam$l_node ; clen = nam.nam$b_node ; break ;

      case PARSE_TYPE:
         cptr = nam.nam$l_type ; clen = nam.nam$b_type ; break ;

      case PARSE_VERSION:
         cptr = nam.nam$l_ver ;  clen = nam.nam$b_ver ;  break ;

      default:
         exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;
   }

   result = Str_makeTSD( clen ) ;
   memcpy( result->value, cptr, result->len=clen ) ;

   return result ;
}



streng *vms_f_search( tsd_t *TSD, cparamboxptr parms )
{
   streng *name, *result ;
   int context, rc, search ;
   struct fabptr *fptr ;
   vmf_tsd_t *vt;

   vt = TSD->vmf_tsd;
   checkparam( parms, 1, 2, "VMS_F_SEARCH" ) ;

   name = parms->value ;
   context = (parms->next && parms->next->value) ?
                      atopos(TSD, parms->next->value, "VMS_F_SEARCH", 2 ) : 0 ;

   search = (context/16) ;
   for (fptr=vt->fabptrs[search]; fptr && fptr->num!=context; fptr=fptr->next) ;
   if (!fptr)
   {

      fptr = MallocTSD( sizeof(struct fabptr)) ;
      fptr->num = context ;
      fptr->next = vt->fabptrs[search] ;
      vt->fabptrs[search] = fptr ;
      fptr->box = MallocTSD( sizeof(struct FAB)) ;
      memcpy( fptr->box, &cc$rms_fab, sizeof(struct FAB)) ;
      fptr->box->fab$l_nam = MallocTSD( sizeof(struct NAM)) ;
      memcpy( fptr->box->fab$l_nam, &cc$rms_nam, sizeof(struct NAM)) ;
      fptr->box->fab$l_nam->nam$l_esa = MallocTSD( 256 ) ;
      fptr->box->fab$l_nam->nam$b_ess = 255 ;
      fptr->box->fab$l_nam->nam$l_rsa = MallocTSD( 256 ) ;
      fptr->box->fab$l_nam->nam$b_rss = 255 ;
      fptr->box->fab$l_nam->nam$b_rsl = 0 ;
      fptr->box->fab$l_fna = NULL ;
      fptr->box->fab$b_fns = 0 ;
   }

   if (context==0 && ((name->len!=fptr->box->fab$b_fns) ||
                      memcmp(name->value, fptr->box->fab$l_fna, name->len )))
      fptr->box->fab$l_nam->nam$b_rsl = 0 ;

   if (fptr->box->fab$l_nam->nam$b_rsl == 0)
   {
/*      fptr->box->fab$l_dna = NULL ;
      fptr->box->fab$b_dns = 0 ; */
      fptr->name = Str_dupTSD( name ) ;
      fptr->box->fab$l_fna = fptr->name->value ;
      fptr->box->fab$b_fns = fptr->name->len ;
/*      fptr->box->fab$l_fop |= FAB$M_OFP ; */
      fptr->box->fab$w_ifi = 0 ;
/*      fptr->box->fab$l_nam->nam$b_nop = NAM$M_PWD ;
      fptr->box->fab$l_nam->nam$l_rlf = NULL ; */

      rc = sys$parse( fptr->box, NULL, NULL ) ;

      if (rc != RMS$_NORMAL)
      {
         vms_error( TSD, rc ) ;
         return nullstringptr() ;
      }
   }

   rc = sys$search( fptr->box, NULL, NULL ) ;
   if (rc == RMS$_NMF)
      return nullstringptr() ;

   if (rc != RMS$_NORMAL)
   {
      vms_error( TSD, rc ) ;
      return nullstringptr() ;
   }

   result = Str_makeTSD( fptr->box->fab$l_nam->nam$b_rsl ) ;
   result->len = fptr->box->fab$l_nam->nam$b_rsl ;
   memcpy( result->value, fptr->box->fab$l_nam->nam$l_rsa, result->len ) ;

   return result ;
}



streng *vms_f_type( tsd_t *TSD, cparamboxptr parms )
{
   checkparam( parms, 1, 1, "VMS_F_TYPE" ) ;
   return Str_creTSD(myisinteger( parms->value ) ? "INTEGER" : "STRING" ) ;
}


static streng *boolean( int param )
{
   return Str_creTSD( param ? "TRUE" : "FALSE" ) ;
}

#define FIL_ALQ 1
#define FIL_BDT 2
#define FIL_BKS 3
#define FIL_BLS 4
#define FIL_CBT 5
#define FIL_CDT 6
#define FIL_CTG 7
#define FIL_DEQ 8
#define FIL_DID 9
#define FIL_DVI 10
#define FIL_EDT 11
#define FIL_EOF 12
#define FIL_FID 13
#define FIL_FSZ 14
#define FIL_GRP 15
#define FIL_KNOWN 16
#define FIL_MBM 17
#define FIL_MRN 101
#define FIL_MRS 18
#define FIL_NOA 19
#define FIL_NOK 20
#define FIL_ORG 21
#define FIL_PRO 22
#define FIL_PVN 23
#define FIL_RAT 24
#define FIL_RCK 25
#define FIL_RDT 26
#define FIL_RFM 27
#define FIL_RVN 28
#define FIL_UIC 29
#define FIL_WCK 30


static const struct dvi_items_type file_attribs[] = {
   { TYP_INT,  "ALQ",   FIL_ALQ },
   { TYP_INT,  "BDT",   FIL_BDT },
   { TYP_INT,  "BKS",   FIL_BKS },
   { TYP_INT,  "BLS",   FIL_BLS },
   { TYP_INT,  "CBT",   FIL_CBT },
   { TYP_INT,  "CDT",   FIL_CDT },
   { TYP_INT,  "CTG",   FIL_CTG },
   { TYP_INT,  "DEQ",   FIL_DEQ },
   { TYP_INT,  "DID",   FIL_DID },
   { TYP_INT,  "DVI",   FIL_DVI },
   { TYP_INT,  "EDT",   FIL_EDT },
   { TYP_INT,  "EOF",   FIL_EOF },
   { TYP_INT,  "FID",   FIL_FID },
   { TYP_INT,  "FSZ",   FIL_FSZ },
   { TYP_INT,  "GRP",   FIL_GRP },
   { TYP_INT,  "KNOWN", FIL_KNOWN },
   { TYP_INT,  "MBM",   FIL_MBM   },
   { TYP_INT,  "MRN",   FIL_MRN   },
   { TYP_INT,  "MRS",   FIL_MRS   },
   { TYP_INT,  "NOA",   FIL_NOA   },
   { TYP_INT,  "NOK",   FIL_NOK   },
   { TYP_INT,  "ORG",   FIL_ORG   },
   { TYP_INT,  "PRO",   FIL_PRO   },
   { TYP_INT,  "PVN",   FIL_PVN   },
   { TYP_INT,  "RAT",   FIL_RAT   },
   { TYP_INT,  "RCK",   FIL_RCK   },
   { TYP_INT,  "RDT",   FIL_RDT   },
   { TYP_INT,  "RFM",   FIL_RFM   },
   { TYP_INT,  "RVN",   FIL_RVN   },
   { TYP_INT,  "UIC",   FIL_UIC   },
   { TYP_INT,  "WCK",   FIL_WCK   },
} ;

streng *vms_f_file_attributes( tsd_t *TSD, cparamboxptr parms )
{
   struct dvi_items_type *item ;
   int rc, rc2, tmp ;
   char temp_space[256] ;
   streng *res ;
   struct FAB fab ;
   struct NAM nam ;
   struct XABALL xaball ;
   struct XABDAT xabdat ;
   struct XABPRO xabpro ;
   struct XABSUM xabsum ;
   struct XABFHC xabfhc ;

   checkparam( parms, 2, 2, "VMS_F_FILE_ATTRIBUTES" ) ;
   item = item_info( parms->next->value, file_attribs, sizeof(file_attribs)) ;

   memcpy( &fab, &cc$rms_fab, sizeof( struct FAB )) ;
   memcpy( &nam, &cc$rms_nam, sizeof( struct NAM )) ;
   memcpy( &xaball, &cc$rms_xaball, sizeof( struct XABALL )) ;
   memcpy( &xabdat, &cc$rms_xabdat, sizeof( struct XABDAT )) ;
   memcpy( &xabpro, &cc$rms_xabpro, sizeof( struct XABPRO )) ;
   memcpy( &xabsum, &cc$rms_xabsum, sizeof( struct XABSUM )) ;
   memcpy( &xabfhc, &cc$rms_xabfhc ,sizeof( struct XABFHC )) ;

   fab.fab$l_fna = parms->value->value ;
   fab.fab$b_fns = parms->value->len ;
   fab.fab$l_nam = &nam ;

   fab.fab$l_xab = (char)&xabdat ;
   xabdat.xab$l_nxt = (char)&xabpro ;
   xabpro.xab$l_nxt = (char)&xabsum ;
   xabsum.xab$l_nxt = (char)&xabfhc ;
/*   xaball.xab$l_next = &xabdat ; */

   if (item->addr==FIL_KNOWN)
   {
      /* This field is undocumented in 'The Grey Wall', I spent quite
       * some time trying to find this ... sigh. Also note that the
       * return code RMS$_KFF is an Digital internal code.
       */
      fab.fab$l_fop |= FAB$M_KFO ;
      fab.fab$l_ctx = 0 ;

      nam.nam$b_nop |= NAM$M_NOCONCEAL ;
      nam.nam$l_esa = temp_space ;
      nam.nam$b_ess = 255 ;
   }

   rc = sys$open( &fab, NULL, NULL ) ;

   if (item->addr==FIL_KNOWN)
   {
      if (rc==RMS$_NORMAL || rc==RMS$_KFF)
      {
         /* OK, we ought to check the rc from sys$close() ... */
         sys$close( &fab, NULL, NULL ) ;
         return Str_creTSD( (fab.fab$l_ctx) ? "TRUE" : "FALSE" ) ;
      }
   }
   if (rc != RMS$_FNF)
   {
      if (rc != RMS$_NORMAL)
      {
         vms_error( TSD, rc ) ;
         return nullstringptr() ;
      }
   }
   else
      return nullstringptr() ;

#define fr(a,b,c) format_result(TSD,a,b,c)
   switch (item->addr)
   {
      case FIL_ALQ:  res = int_to_streng( TSD, fab.fab$l_alq ); break ;
      case FIL_BDT:  res = fr( TYP_TIME, xabdat.xab$q_bdt, 8 ); break ;
/*      case FIL_BDT:  res = fr( TYP_TIME, &(xabdat.xab$q_bdt), 8 ); break ; */
      case FIL_BKS:  res = int_to_streng( TSD, fab.fab$b_bks ); break ;
      case FIL_BLS:  res = int_to_streng( TSD, fab.fab$w_bls ); break ;
      case FIL_CBT:  res = boolean( fab.fab$l_fop & FAB$M_CBT ); break ;
      case FIL_CDT:  res = fr( TYP_TIME, xabdat.xab$q_cdt, 8 ); break ;
/*      case FIL_CDT:  res = fr( TYP_TIME, &(xabdat.xab$q_cdt), 8 ); break ; */
      case FIL_CTG:  res = boolean( fab.fab$l_fop & FAB$M_CTG ); break ;
      case FIL_DEQ:  res = int_to_streng( TSD,    fab.fab$w_deq ); break ;
      case FIL_DID:  res = internal_id( (short)nam.nam$w_did ); break ;
      case FIL_DVI:
        res = Str_makeTSD( nam.nam$t_dvi[0] ) ;
        memcpy( res->value, &(nam.nam$t_dvi[1]), res->len=nam.nam$t_dvi[0] ) ;
        break ;
      case FIL_EDT:  res = fr( TYP_TIME, xabdat.xab$q_edt, 8 ); break ;
/*      case FIL_EDT:  res = fr( TYP_TIME, &(xabdat.xab$q_edt), 8 ); break ; */
      case FIL_EOF:
         res = int_to_streng( TSD, xabfhc.xab$l_ebk - (xabfhc.xab$w_ffb==0));
         break ;
      case FIL_FID:  res = internal_id( (short)nam.nam$w_fid ); break ;
      case FIL_FSZ:  res = int_to_streng( TSD,    fab.fab$b_fsz ); break ;
      case FIL_KNOWN: res = nullstringptr() ; /* must be nonexistent */
         break ;
      case FIL_GRP:  res = int_to_streng( TSD, xabpro.xab$w_grp ); break ;
      case FIL_MBM:  res = int_to_streng( TSD, xabpro.xab$w_mbm ); break ;
      case FIL_MRN:  res = int_to_streng( TSD,    fab.fab$l_mrn ); break ;
      case FIL_MRS:  res = int_to_streng( TSD,    fab.fab$w_mrs ); break ;
      case FIL_NOA:  res = int_to_streng( TSD, xabsum.xab$b_noa ); break ;
      case FIL_NOK:  res = int_to_streng( TSD, xabsum.xab$b_nok ); break ;
      case FIL_ORG:
         switch (xabfhc.xab$b_rfo & 48 )   /* magic number! */
         {
            case FAB$C_IDX: res = Str_creTSD( "IDX" ) ; break ;
            case FAB$C_REL: res = Str_creTSD( "REL" ) ; break ;
            case FAB$C_SEQ: res = Str_creTSD( "SEQ" ) ; break ;
            default: exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;
         }
         break ;
      case FIL_PRO:  res = get_prot( tmp=xabpro.xab$w_pro ); break ;
      case FIL_PVN:  res = int_to_streng( TSD, xabsum.xab$w_pvn ); break ;
      case FIL_RAT:
         if (fab.fab$b_rat & FAB$M_BLK)
            res = Str_creTSD( "" ) ;
         else if (fab.fab$b_rat & FAB$M_CR)
            res = Str_creTSD( "CR" ) ;
         else if (fab.fab$b_rat & FAB$M_FTN)
            res = Str_creTSD( "FTN" ) ;
         else if (fab.fab$b_rat & FAB$M_PRN)
            res = Str_creTSD( "PRN" ) ;
         else
            res = nullstringptr() ;
         break ;
      case FIL_RCK:  res = boolean( fab.fab$l_fop & FAB$M_RCK ); break ;
      case FIL_RDT:  res = fr( TYP_TIME, xabdat.xab$q_rdt, 8 ); break ;
/*      case FIL_RDT:  res = fr( TYP_TIME, &(xabdat.xab$q_rdt), 8 ); break ; */
      case FIL_RFM:
         switch (xabfhc.xab$b_rfo & 15 ) /* magic number! */
         {
            case FAB$C_VAR: res = Str_creTSD( "VAR" ) ; break ;
            case FAB$C_FIX: res = Str_creTSD( "FIX" ) ; break ;
            case FAB$C_VFC: res = Str_creTSD( "VFC" ) ; break ;
            case FAB$C_UDF: res = Str_creTSD( "UDF" ) ; break ;
            case FAB$C_STM: res = Str_creTSD( "STM" ) ; break ;
            case FAB$C_STMLF: res = Str_creTSD( "STMLF" ) ; break ;
            case FAB$C_STMCR: res = Str_creTSD( "STMCR" ) ; break ;
            default: exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;
         }
         break ;
      case FIL_RVN:  res = int_to_streng( TSD, xabdat.xab$w_rvn ); break ;
      case FIL_UIC:  res = get_uic( TSD, ( union uicdef *)&(xabpro.xab$l_uic) ); break ;
      case FIL_WCK:  res = boolean( fab.fab$l_fop & FAB$M_WCK ); break ;
      default:
         exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;
   }

   if (rc == RMS$_NORMAL)
   {
      rc = sys$close( &fab, NULL, NULL ) ;
      if (rc != RMS$_NORMAL )
      {
         vms_error( TSD, rc ) ;
         return nullstringptr() ;
      }
   }
   return res ;
}


streng *vms_f_extract( tsd_t *TSD, cparamboxptr parms )
{
   int start, length ;
   streng *result, *string ;

   checkparam( parms, 3, 3, "VMS_F_EXTRACT" ) ;
   start = atozpos( TSD, parms->value, "VMS_F_EXTRACT", 1 ) ;
   length = atozpos( TSD, (parms=parms->next)->value, "VMS_F_EXTRACT", 2 ) ;
   string = parms->next->value ;

   if (start>string->len)
      start = string->len ;

   if (length > string->len - start)
      length = (string->len - start) ;

   result = Str_makeTSD( length ) ;
   memcpy( result->value, string->value+start, length ) ;
   result->len = length ;

   return result ;
}

streng *vms_f_element( tsd_t *TSD, cparamboxptr parms )
{
   int number, count ;
   streng *string, *result ;
   char delim, *cptr, *cend, *cmax ;

   checkparam( parms, 3, 3, "VMS_F_ELEMENT" ) ;

   number = atozpos( TSD, parms->value, "VMS_F_ELEMENT", 1 ) ;
   delim = getonechar( TSD, (parms=parms->next)->value, "VMS_F_ELEMENT", 2) ;
   string = parms->next->value ;

   cptr = string->value ;
   cend = cptr + string->len ;
   for (count=0;count<number && cptr<cend;)
      if (*(cptr++)==delim) count++ ;

   if (count<number)
   {
      result = Str_makeTSD( 1 ) ;
      result->len = 1 ;
      result->value[0] = delim ;
   }
   else
   {
      for (cmax=cptr; *cmax!=delim && cmax<cend; cmax++) ;
      result = Str_makeTSD( cmax - cptr ) ;
      result->len = cmax - cptr ;
      memcpy( result->value, cptr, cmax-cptr ) ;
   }

   return result ;
}


static streng *convert_bin( tsd_t *TSD, const paramboxptr parms, int issigned, char bif )
{
   int start, length, obyte, obit, count, bit=0 ;
   streng *string, *result, *temp ;

   checkparam( parms, 3, 3, bif ) ;

   start = atozpos( TSD, parms->value, bif, 1 ) ;
   length = atozpos( TSD, parms->next->value, bif, 2 ) ;
   string = parms->next->next->value ;

   if (issigned)
   {
      start++ ;
      length-- ;
   }

   if ((start+length > string->len*8) || length<0)
      exiterror( ERR_INCORRECT_CALL , 0 ) ;

   temp = Str_makeTSD((start+length)/8 + 2) ;
   obyte = (start+length)/8 + 1 ;
   temp->len = obyte + 1 ;
   obit = 7 ;
   for (count=0; count<=obyte; temp->value[count++] = 0x00) ;

   for (count=start+length-1; count>=start; count--)
   {
      bit = (string->value[count/8] >> (7-(count%8))) & 1 ;
      temp->value[obyte] |= bit << (7-obit--) ;
      if (obit<0)
      {
         obit = 7 ;
         obyte-- ;
      }
   }

   if (issigned)
      bit = (string->value[count/8] >> (7-(count%8))) & 1 ;

   if (issigned && bit)
      for (;obyte>=0;)
      {
         temp->value[obyte] |= 1 << (7-obit--) ;
         if (obit<0)
         {
            obit = 7 ;
            obyte-- ;
         }
      }

   result = str_digitize( TSD, temp, 0, 1 ) ;
   FreeTSD( temp ) ;
   return result ;
}



streng *vms_f_cvui( tsd_t *TSD, cparamboxptr parms )
{
   return convert_bin( TSD, parms, 0, "VMS_F_CVUI" ) ;
}

streng *vms_f_cvsi( tsd_t *TSD, cparamboxptr parms )
{
   return convert_bin( TSD, parms, 1, "VMS_F_CVSI" ) ;
}


static const char *vms_weekdays[] = { "Monday", "Tuesday", "Wednesday",
                                      "Thursday", "Friday", "Saturday",
                                      "Sunday" } ;
static const char *vms_months[] = { "", "JAN", "FEB", "MAR", "APR", "MAY",
                                        "JUN", "JUL", "AUG", "SEP", "OCT",
                                        "NOV", "DEC" } ;

enum outs { absolute, comparison, delta } ;
enum funcs { year, month, day, hour, minute, second, hundredth,
               weekday, time, date, datetime } ;


static char *read_abs_time( char *ptr, char *end, short *times )
{
   int cnt, increment, rc ;
   char *tmp ;

   rc = sys$numtim( times, NULL ) ;

   if (ptr>=end) exiterror( ERR_INCORRECT_CALL, 0 ) ;
   if (*ptr=='-')
   {
      ptr++ ;
      goto abs_hours ;
   }

   if (*ptr=='+')
      return ptr ;

   if (isspace(*ptr))
      return ptr ;

   if (*ptr==':')
   {
      ptr++ ;
      goto abs_minutes ;
   }

   if (!isdigit(*ptr))
   {
      if (ptr+3>=end ) exiterror( ERR_INCORRECT_CALL, 0 ) ;
      for (cnt=1; cnt<=12; cnt++)
         if (!memcmp(ptr,vms_months[cnt],3))
         {
            ptr += 3 ;
            times[month] = cnt ;
            if (ptr>=end)
               return ptr ;
            else if (*ptr==':')
            {
               ptr++ ;
               goto abs_hours ;
            }
            else if (*ptr=='-')
            {
               ptr++ ;
               goto abs_years ;
            }
            else
               return ptr ;
         }
      exiterror( ERR_INCORRECT_CALL , 0 ) ;
   }
   else
   {
      for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
         cnt = cnt*10 + *ptr-'0' ;

      if (ptr>=end || isspace(*ptr) || *ptr==':')
      {
         if (ptr<end && *ptr==':') ptr++ ;
         if (cnt>23) exiterror( ERR_INCORRECT_CALL, 0 ) ;
         times[hour] = cnt ;
         goto abs_minutes ;
      }
      else if (*ptr=='-')
      {
         ptr++ ;
         times[day] = cnt ;
         goto abs_months ;
      }
      else
        return ptr ;
   }


   abs_months:
   if (ptr<end && isalpha(*ptr))
   {
      if (ptr+3>=end) exiterror( ERR_INCORRECT_CALL, 0 ) ;
      for (cnt=1; cnt<=12; cnt++)
         if (!memcmp(ptr,vms_months[cnt],3))
         {
            ptr += 3 ;
            times[month] = cnt ;

            if (ptr>=end)
               return ptr ;
            else if (*ptr==':')
            {
               ptr++ ;
               goto abs_hours ;
            }
            else if (*ptr=='-')
            {
               ptr++ ;
               goto abs_years ;
            }
            else
               return ptr ;
         }
      exiterror( ERR_INCORRECT_CALL , 0 ) ;
   }
   else if (ptr>=end || isspace(*ptr))
      return ptr ;
   else if (*ptr=='-')
   {
      ptr++ ;
      goto abs_years ;
   }
   else if (*ptr==':')
   {
      ptr++ ;
      goto abs_hours ;
   }
   else
      exiterror( ERR_INCORRECT_CALL , 0 ) ;


   abs_years:
   if (ptr<end && isdigit(*ptr))
   {
      for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
         cnt = cnt*10 + *ptr-'0' ;

      if (cnt>9999) exiterror( ERR_INCORRECT_CALL, 0 ) ;
      times[year] = cnt ;
      if (ptr<end && *ptr==':')
      {
         ptr++ ;
         goto abs_hours ;
      }
      else
         return ptr ;
   }
   else if (ptr<end && *ptr==':')
   {
      ptr++ ;
      goto abs_hours ;
   }
   else
      return ptr ;


   abs_hours:
   if (ptr<end && isdigit(*ptr))
   {
      for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
         cnt = cnt*10 + *ptr-'0' ;

      if (cnt>23) exiterror( ERR_INCORRECT_CALL, 0 ) ;
      times[hour] = cnt ;
      if (ptr<end && *ptr==':')
      {
         ptr++ ;
         goto abs_minutes ;
      }
      else
         return ptr ;
   }
   else if (ptr<end && *ptr==':')
   {
      ptr++ ;
      goto abs_minutes ;
   }
   else
      return ptr ;


   abs_minutes:
   if (ptr<end && isdigit(*ptr))
   {
      for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
         cnt = cnt*10 + *ptr-'0' ;

      if (cnt>59) exiterror( ERR_INCORRECT_CALL, 0 ) ;
      times[minute] = cnt ;
      if (ptr<end && *ptr==':')
      {
         ptr++ ;
         goto abs_seconds ;
      }
      else
         return ptr ;
   }
   else if (ptr<end && *ptr==':')
   {
      ptr++ ;
      goto abs_seconds ;
   }
   else
      return ptr ;


   abs_seconds:
   if (ptr<end && isdigit(*ptr))
   {
      for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
         cnt = cnt*10 + *ptr-'0' ;

      if (cnt>59) exiterror( ERR_INCORRECT_CALL, 0 ) ;
      times[second] = cnt ;
      if (ptr<end && *ptr=='.')
      {
         ptr++ ;
         goto abs_hundredths ;
      }
      else
         return ptr ;
   }
   else if (ptr<end && *ptr=='.')
   {
      ptr++ ;
      goto abs_hundredths ;
   }
   else
      return ptr ;


   abs_hundredths:
   if (ptr<end && isdigit(*ptr))
   {
      tmp = ptr ;
      for (cnt=0; ptr<end && ptr<tmp+2 && isdigit(*ptr); ptr++)
         cnt = cnt*10 + *ptr-'0' ;

      increment = (ptr<end && isdigit(*ptr) && (*ptr-'0'>=5)) ;
      for (;ptr<end && isdigit(*ptr); ptr++) ;
      times[hundredth] = cnt + increment ;
      return ptr ;
   }
   else
      return ptr ;
}


static char *read_delta_time( char *ptr, char *end, short *times )
{
   int cnt, increment ;
   char *tmp ;

   for (cnt=0; cnt<7; times[cnt++]=0) ;

   if (ptr>=end) exiterror( ERR_INCORRECT_CALL, 0 ) ;
   if (*ptr=='-')
   {
      ptr++ ;
      goto delta_hours ;
   }

   if (*ptr==':')
   {
      ptr++ ;
      goto delta_minutes ;
   }

   if (!isdigit( *ptr )) exiterror( ERR_INCORRECT_CALL, 0 ) ;
   for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
      cnt = cnt*10 + *ptr-'0' ;

   if (ptr>=end || isspace(*ptr) || *ptr==':')
   {
      if (ptr<end && *ptr==':') ptr++ ;
      if (cnt>23) exiterror( ERR_INCORRECT_CALL, 0 ) ;
      times[hour] = cnt ;
      goto delta_minutes ;
   }
   else
   {
      if (*ptr!='-') exiterror( ERR_INCORRECT_CALL, 0 ) ;
      ptr++ ;
      if (cnt>9999) exiterror( ERR_INCORRECT_CALL, 0 ) ;
      times[day] = cnt ;
      goto delta_hours ;
   }

   delta_hours:
   if (ptr<end && isdigit(*ptr))
   {
      for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
         cnt = cnt*10 + *ptr-'0' ;

      if (cnt>23) exiterror( ERR_INCORRECT_CALL, 0 ) ;
      times[hour] = cnt ;
      if (ptr<end && *ptr==':')
      {
         ptr++ ;
         goto delta_minutes ;
      }
      else
         return ptr ;
   }
   else if (ptr<end && *ptr==':')
   {
      ptr++ ;
      goto delta_minutes ;
   }
   else
      return ptr ;


   delta_minutes:
   if (ptr<end && isdigit(*ptr))
   {
      for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
         cnt = cnt*10 + *ptr-'0' ;

      if (cnt>59) exiterror( ERR_INCORRECT_CALL, 0 ) ;
      times[minute] = cnt ;
      if (ptr<end && *ptr==':')
      {
         ptr++ ;
         goto delta_seconds ;
      }
      else
         return ptr ;
   }
   else if (ptr<end && *ptr==':')
   {
      ptr++ ;
      goto delta_seconds ;
   }
   else
      return ptr ;


   delta_seconds:
   if (ptr<end && isdigit(*ptr))
   {
      for (cnt=0; ptr<end && isdigit(*ptr); ptr++)
         cnt = cnt*10 + *ptr-'0' ;

      if (cnt>59) exiterror( ERR_INCORRECT_CALL, 0 ) ;
      times[second] = cnt ;
      if (ptr<end && *ptr=='.')
      {
         ptr++ ;
         goto delta_hundredths ;
      }
      else
         return ptr ;
   }
   else if (ptr<end && *ptr=='.')
   {
      ptr++ ;
      goto delta_hundredths ;
   }
   else
      return ptr ;


   delta_hundredths:
   if (ptr<end && isdigit(*ptr))
   {
      tmp = ptr ;
      for (cnt=0; ptr<end && ptr<tmp+2 && isdigit(*ptr); ptr++)
         cnt = cnt*10 + *ptr-'0' ;

      increment = (ptr<end && isdigit(*ptr) && (*ptr-'0'>=5)) ;
      for (;ptr<end && isdigit(*ptr); ptr++) ;
      times[hundredth] = cnt + increment ;
      return ptr ;
   }
   else
      return ptr ;
}


streng *vms_f_cvtime( tsd_t *TSD, cparamboxptr parms )
{
   streng *item=NULL, *input=NULL, *output=NULL, *result ;
   int rc, res, cnt, abs=0 ;
   short times[7], timearray[7], btime[4] ;
   char *cptr, *cend, *ctmp, *cptr2 ;
   $DESCRIPTOR( timbuf, "" ) ;
   enum funcs func ;
   enum outs out ;

   checkparam( parms, 0, 3, "VMS_F_CVTIME" ) ;
   func = datetime ;
   out = comparison ;

   input = parms->value ;
   if (parms->next)
   {
      output = parms->next->value ;
      if (parms->next->next)
         item = parms->next->next->value ;
   }

   if (item)
   {
      for (cnt=0; cnt<item->len; cnt++)
         if (islower(item->value[cnt]) )
            item->value[cnt] = toupper(item->value[cnt]) ;

      if (item->len==4 && !memcmp(item->value, "YEAR", 4))
         func = year ;
      else if (item->len==5 && !memcmp(item->value, "MONTH", 5))
         func = month ;
      else if (item->len==8 && !memcmp(item->value, "DATETIME", 8))
         func = datetime ;
      else if (item->len==3 && !memcmp(item->value, "DAY", 3))
         func = day ;
      else if (item->len==4 && !memcmp(item->value, "DATE", 4))
         func = date ;
      else if (item->len==4 && !memcmp(item->value, "TIME", 4))
         func = time ;
      else if (item->len==4 && !memcmp(item->value, "HOUR", 4))
         func = hour ;
      else if (item->len==6 && !memcmp(item->value, "SECOND", 6))
         func = second ;
      else if (item->len==6 && !memcmp(item->value, "MINUTE", 6))
         func = minute ;
      else if (item->len==9 && !memcmp(item->value, "HUNDREDTH", 9))
         func = hundredth ;
      else if (item->len==7 && !memcmp(item->value, "WEEKDAY", 7))
         func = weekday ;
      else
         exiterror( ERR_INCORRECT_CALL , 0 ) ;
   }

   if (output)
   {
      for (cnt=0; cnt<output->len; cnt++)
         if (islower(output->value[cnt]))
            output->value[cnt] = toupper(output->value[cnt]) ;

      if (output->len==5 && !memcmp(output->value, "DELTA", 5))
         out = delta ;
      else if (output->len==10 && !memcmp(output->value, "COMPARISON", 10))
         abs = 0 ;
      else if (output->len==8 && !memcmp(output->value, "ABSOLUTE", 8))
         abs = 1 ;
      else
         exiterror( ERR_INCORRECT_CALL , 0 ) ;
   }

   if (out==delta)
      if (func==year  || func==month || func==weekday)
         exiterror( ERR_INCORRECT_CALL , 0 ) ;

   if (input)
   {
      short atime[4], dtime[4], xtime[4], ttimes[7] = {0,0,0,0,0,0,1} ;
      int rc2, increment ;

      lib$cvt_vectim( ttimes, xtime ) ;
      cptr = input->value ;
      cend = cptr + input->len ;

      for (ctmp=cptr;ctmp<cend;ctmp++)
         if (islower(*ctmp))
            *ctmp = toupper(*ctmp) ;

      for (;isspace(*cptr);cptr++) ; /* strip leading spaces */
      if (out!=delta)
      {
         if (cptr<cend && *cptr!='-')
         {
            cptr = read_abs_time( cptr, cend, times ) ;
            if ((increment=(times[hundredth]==100)))
               times[hundredth] -= 1 ; ;

            rc = lib$cvt_vectim( times, btime ) ;
            if (increment)
            {
               lib$add_times( xtime, btime, dtime ) ;
               btime[0] = dtime[0] ;
               btime[1] = dtime[1] ;
               btime[2] = dtime[2] ;
               btime[3] = dtime[3] ;
            }
         }
         else
         {
            rc = sys$gettim( btime ) ;
         }

         if (cptr<cend && (*cptr=='-' || *cptr=='+'))
         {
            char oper = *cptr ;
            cptr2 = read_delta_time( ++cptr, cend, times ) ;
            if ((increment=(times[7]==100)))
               times[7] -= 1 ;

            rc2 = lib$cvt_vectim( times, dtime ) ;
            if (increment)
            {
               lib$add_times( dtime, xtime, atime ) ;
               dtime[0] = atime[0] ;
               dtime[1] = atime[1] ;
               dtime[2] = atime[2] ;
               dtime[3] = atime[3] ;
            }

            if (oper=='+')
               rc = lib$add_times( btime, dtime, atime ) ;
            else
               rc = lib$sub_times( btime, dtime, atime ) ;

            btime[0] = atime[0] ;
            btime[1] = atime[1] ;
            btime[2] = atime[2] ;
            btime[3] = atime[3] ;
         }
      }
      else
      {
         cptr = read_delta_time( cptr, cend, times ) ;
         if ((increment=(times[6]==100)))
            times[6] -= 1 ;

         rc = lib$cvt_vectim( times, &btime ) ;
         if (increment)
         {
            lib$add_times( xtime, btime, atime ) ;
            btime[0] = atime[0] ;
            btime[1] = atime[1] ;
            btime[2] = atime[2] ;
            btime[3] = atime[3] ;
         }
      }
   }
   else
      rc = sys$gettim( &btime ) ;

   if (rc!=SS$_NORMAL && rc!=LIB$_NORMAL)
   {
      vms_error( TSD, rc ) ;
      return nullstringptr() ;
   }

   rc = sys$numtim( timearray, &btime ) ;
   if (rc!=SS$_NORMAL)
   {
      vms_error( TSD, rc ) ;
      return nullstringptr() ;
   }

   switch (func)
   {
      case year:
         result = Str_makeTSD( 5 ) ;
         sprintf( result->value, ((abs) ? "%04d" : "%d"), timearray[func]);
         result->len = strlen( result->value ) ;
         break ;

      case hour:
      case minute:
      case second:
      case hundredth:
         abs = 0 ;
      case day:
         result = Str_makeTSD( 3 ) ;
         sprintf( result->value, ((abs) ? "%d" : "%02d"), timearray[func]);
         result->len = strlen( result->value ) ;
         break ;

      case month:
         if (abs)
            result = Str_creTSD( vms_months[ func ]) ;
         else
         {
            result = Str_makeTSD( 3 ) ;
            sprintf( result->value, "%02d", timearray[month]) ;
            result->len = 2 ;
         }
         break ;

      case time:
         result = Str_makeTSD( 12 ) ;
         sprintf(result->value, "%02d:%02d:%02d.%02d", timearray[hour],
              timearray[minute], timearray[second], timearray[hundredth]) ;
         result->len = 11 ;
         break ;

      case date:
         result = Str_makeTSD( 12 ) ;
         if (out==delta)
            sprintf( result->value, "%d", timearray[day] ) ;
         else if (abs)
            sprintf( result->value, "%d-%s-%d", timearray[day],
                vms_months[timearray[month]], timearray[year] ) ;
         else
            sprintf( result->value, "%04d-%02d-%02d", timearray[year],
                timearray[month], timearray[day] ) ;

         result->len = strlen( result->value ) ;
         break ;

      case datetime:
         result = Str_makeTSD( 24 ) ;
         if (out==delta)
            sprintf( result->value, "%d %02d:%02d:%02d.%02d",
                   timearray[day], timearray[hour], timearray[minute],
                   timearray[second], timearray[hundredth] ) ;
         else if (abs)
            sprintf( result->value, "%d-%s-%d %02d:%02d:%02d.%02d",
                   timearray[day], vms_months[timearray[month]],
                   timearray[year], timearray[hour], timearray[minute],
                   timearray[second], timearray[hundredth] ) ;
         else
            sprintf( result->value, "%04d-%02d-%02d %02d:%02d:%02d.%02d",
                   timearray[year], timearray[month], timearray[day],
                   timearray[hour], timearray[minute], timearray[second],
                   timearray[hundredth] ) ;
         result->len = strlen( result->value ) ;
         break ;

      case weekday:
      {
         int op=LIB$K_DAY_OF_WEEK, res ;
         rc = lib$cvt_from_internal_time( &op, &res, &btime ) ;
         if (rc!=LIB$_NORMAL)
         {
            vms_error( TSD, rc ) ;
            return nullstringptr() ;
         }
         result = Str_creTSD( vms_weekdays[res-1] ) ;
         break ;
      }

      default: exiterror( ERR_INTERPRETER_FAILURE, 1, __FILE__, __LINE__, "" )  ;
   }

   return result ;
}


streng *vms_f_fao( tsd_t *TSD, cparamboxptr parms )
{
   void *prmlst[30] = {NULL} ;
   int i, cnt, paran, rc, pcnt=0, icnt=0 ;
   int int_list[30], dcnt=0, xper ;
   struct dsc$descriptor_s dscs[15] ;
   cparamboxptr p ;
   char buffer[512], *cstart, *cptr, *cend ;
   streng *result ;
   $DESCRIPTOR( ctrl, "" ) ;
   $DESCRIPTOR( outbuf, buffer ) ;
   short outlen ;

   if (parms->value==NULL)
      exiterror( ERR_INCORRECT_CALL , 0 ) ;

   ctrl.dsc$a_pointer = parms->value->value ;
   ctrl.dsc$w_length = parms->value->len ;

   cptr = cstart = parms->value->value ;
   cend = cptr + parms->value->len ;

   p = parms->next ;

   for (cptr=cstart; cptr<cend; cptr++)
   {
      if (*cptr!='!') continue ;

      if (*(++cptr)=='#')
      {
         cptr++ ;
         if (!p || !p->value)
            exiterror( ERR_INCORRECT_CALL , 0 ) ;

         cnt = atopos( TSD, p->value, "VMS_F_FAO", pcnt ) ;
         prmlst[pcnt++] = int_list + icnt ;
         int_list[icnt++] = cnt ;
         p = p->next ;
      }
      else if (!isdigit(*cptr))
         cnt = 1 ;
      else
         for (cnt=0;cptr<cend && isdigit(*cptr); cptr++)
            cnt = cnt*10 + *cptr-'0' ;

      paran = 0 ;
      if (cptr<cend && *cptr=='(')
      {
         paran = 1 ;
         cptr++ ;
         if (*cptr=='#')
         {
            if (!p || !p->value)
               exiterror( ERR_INCORRECT_CALL , 0 ) ;

            prmlst[pcnt++] = int_list + icnt ;
            int_list[icnt++] = atopos( TSD, p->value, "VMS_F_FAO", 0 ) ;
            p = p->next ;
         }
         else
            for (;cptr<cend && isdigit(*cptr); cptr++ ) ;
      }

      if (cptr<cend)
      {
         xper = toupper(*cptr) ;
         if (xper=='O' || xper=='X' || xper=='Z' || xper=='U' || xper=='S')
         {
            cptr++ ;
            xper = toupper(*cptr) ;
            if (xper!='B' && xper!='W' && xper!='L')
               exiterror( ERR_INCORRECT_CALL , 0 ) ;

            for (i=0; i<cnt; i++)
            {
               if (!p || !p->value)
                  exiterror( ERR_INCORRECT_CALL , 0 ) ;

               prmlst[pcnt++] = (void *)myatol( TSD, p->value ) ;
               p = p->next ;
            }
         }
         else if (toupper(*cptr)=='A')
         {
            cptr++ ;
            if (cptr<cend && toupper(*cptr)!='S')
               exiterror( ERR_INCORRECT_CALL , 0 ) ;

            for (i=0; i<cnt; i++ )
            {
               if (!p || !p->value)
                  exiterror( ERR_INCORRECT_CALL , 0 ) ;

               dscs[dcnt].dsc$b_class = DSC$K_CLASS_S ;
               dscs[dcnt].dsc$b_dtype = DSC$K_DTYPE_T ;
               dscs[dcnt].dsc$a_pointer = p->value->value ;
               dscs[dcnt].dsc$w_length = p->value->len ;
               prmlst[pcnt++] = &(dscs[dcnt++]) ;
               p = p->next ;
            }
         }
      }
      else
         exiterror( ERR_INCORRECT_CALL , 0 ) ;

      if (paran)
         if (cptr<cend-1 && *(++cptr)!=')')
             exiterror( ERR_INCORRECT_CALL , 0 ) ;
   }

   rc = sys$faol( &ctrl, &outlen, &outbuf, prmlst ) ;
   if (rc!=SS$_NORMAL)
   {
      vms_error( TSD, rc ) ;
/*      return nullstringptr() ; */
   }

   result = Str_makeTSD( outlen ) ;
   result->len = outlen ;
   memcpy( result->value, buffer, outlen ) ;

   return result ;
}
