/*
**++
**  FACILITY:
**      NEWSRTL
**
**  ABSTRACT:
**      Sundry run time support routines used in a number of NEWS modules
**
**  AUTHOR:
**      Geoff Huston
**
**  COPYRIGHT:
**      Copyright © 1989
**
**  MODIFICATION HISTORY:
**      V5.8     8-Mar-1989     GIH
**        - Initial version
**	V6.1	 2-Feb-1992	rankin@eql.caltech.edu
**		lint cleanup from gcc -Wall
**	V6.1	 1-Jul-1992	reggers@julian.uwo.ca,ake@dayton.saic.com
**		data parse fix for nntp client
**	V6.1	 11-Aug-1992	mark@infocomm.com
**	  - Added new routine fgetlc which reads a line with continuation
**	    character support (i.e. trailing \), and allows invisible 
**	    imbedded comment lines which CAN NOT be continued.
**	    I chose to provide this extra routine instead of "fixing" fgetl
**	    since fgetl is used in lots of different contexts some of which
**	    probably don't allow "#" prefixed comments.  The problem case
**	    that initially inspired this was a NEWS.SYS file that happened to
**	    have a "\" at the end of a comment line.  This "\" caused the
**	    subsequent line(s) also be commented out since they were 
**	    interpreted as continuations of the comment line.
**	V6.1b3	 1-Sep-1992	rankin@eql.caltech.edu
**	  -	Add file deletion and string manipulation routines
**		in order to be able to eliminate a lot of redundant code.
**	V6.1b6	 9-Mar-1993	rankin@eql.caltech.edu
**	  -	parse_usenet_date() -- expand too-short `pdate' buffer and
**		add missing specifier for year to second sscanf format string.
**	V6.1b6	 12-Mar-1992	mark@infocomm.com
**	  -	tz_convert() - had the "sign" of the timezone offsets incorrect
**		for the RFC822 allowed symbolic timezone names (EST, CST,
**		MST ,etc.)
**	V6.1b7	  8-Aug-1993	bailey@genetics.upenn.edu
**	  - added new mem alloc routines
**	V6.1b8	 27-Aug-1993	bailey@genetics.upenn.edu
**	  - fixed news_getenv() to try multiple tables for secure logical names
**	V6.1b8	 10-Sep-1993	mark.martinec@ijs.si
**	  - new error reporting routines and corresponding macros:
**	    get_rms_filename_and_sts, get_cio_filename_and_message,
**	    report_rms_error_routine, report_cio_error_routine,
**	    news_assert_routine, c$cks_routine, c$free_tmp
**	V6.1b8	  8-Oct-1993	volz@process.com
**	  - Updated TCPware support
**	V6.1b8	 20-Oct-1993	volz@process.com
**	  - Updated TCPware support
**	V6.1b8	 22-Dec-1993	mark.martinec@ijs.si
**	  - additional parameter to report_rms_error_routine (rms_status)
**	  - convert calls to RMS to use new sys_* macros for error handling 
**	V6.1b8	  3-Mar-1994 	mark.martinec@ijs.si
**	  - add routine get_cio_fabrab(), which tries to obtain
**	    the FAB and RAB for a given C file.
**	    The method used is UNDOCUMENTED and UNSUPPORTED by DEC.
**	    In case of troubles this routine does nothing (and does no harm).
**	V6.1b8	 11-May-1994	mark.martinec@ijs.si
**	  - added macro news_assert_nonfatal and use it in news_free_raw()
**	V6.1b9	 27-May-1994    mark.martinec@ijs.si
**	  - add conditionally compiled code to news_*alloc* / free routines
**	    to fill the allocated areas with known contents
**	    and to check the guard region before deallocation
**	    (see macros FILL_CH, GUARD_CH, GUARD_L)
**	V6.1b9    6-Jun-1994	saul@hnrc.tufts.edu
**	  - in file_copy, dynamically allocate a buffer of up to 63 blocks
**	V6.1b9	 21-Jun-1994    mark.martinec@ijs.si
**	  - as recommended by Pat Rankin (rankin@eql.caltech.edu) I revoked
**	    the routine get_cio_fabrab(): it was of little use,
**	    the method is unsupported by DEC, and it contained a bug
**	  - use macros set_errno and set_vaxc_errno to set values
**	    of errno and vaxc$errno since the proper way to do it
**	    is compiler-dependent
**	  - change news_assert to just do the normal error signalling
**	    and not to force program to abort
**	V6.1b9	 23-Jun-1994	mark.martinec@ijs.si
**	  - applied code cleanup patch (gcc) by Pat Rankin (rankin@eql.caltech.edu)
**	V6.1b9	17-Aug-1994     Mark Martinec   mark.martinec@ijs.si
**	  - code cleanup to make it compile under gcc 2.6.0 with full
**	    warnings reporting turned on - with no or very few harmless warnings
**	V6.1b9	17-Sep-1994     Mark Martinec   mark.martinec@ijs.si
**	  - code cleanup to preserve the read-only nature of string literals
**	    (strategically placed 'const' attribute to string parameters)
**	  - add sanity check to the size in news_malloc_raw
**	V6.1b9	 6-Oct-1994     Mark Martinec   mark.martinec@ijs.si
**	  - reference XABFHC field xab$b_bkz in a more compiler-independent way
**	    so that DECC on VAX sees the field declaration
**	  - provide an alternative simple version of memory allocation
**	    routines if one prefers a faster but not-so-thourough-checking
**	    and not-so-robust version of memory allocation routines
**	    (enable it by:  #define SIMPLE_MALLOC 1 )
**	V6.1b9	 4-Jan-1995	Mark Martinec   mark.martinec@ijs.si
**	  - allow news_free(NULL)   (ANSI C explicitly allows free(NULL))
**	  - optionally fill news_free-ed memory with VOID_CH in the hope
**	    of catching a reuse of already released memory    (normally off)
**	  - changed return type of news_free*() functions from int to void
**	    to make them interchangeable with equivalent C library functions
**	  - eliminated news_cfree() and news_cfree_raw() since they
**	    were never used and cfree() is not in ANSI C library
**	V6.1b9	 9-Mar-1995	Mark Martinec   mark.martinec@ijs.si
**	  - add new (dummy) site-specific routine try_to_make_some_free_space()
**	    to be called when file creation fails (specially due to
**	    insufficient contiguous free space on NEWS_DEVICE)
**	V6.1b10	17-Aug-1995	Mark Martinec   mark.martinec@ijs.si
**	  - check for input==NULL in util_*cpy routines to prevent
**	    NEWSUTILITY\xoverni() from failing in case of illegal input
**	V6.1b10	23-Aug-1995	Mark Martinec   mark.martinec@ijs.si
**	  - moved 'sa_l=0' in c$cks_routine() to the inside of 'if',
**	    to prevent clobbering of sa_l in case of c$cks_routine routine
**	    being called from nosysprv() which in turn may be called during
**	    another exception processing from send_signal_array().
**	    The common symptom was:
**	      %NEWS-E-INVSA, Invalid signal array length, sa_l = 0
**	V6.1b10  4-Sep-1995	Mark Martinec   mark.martinec@ijs.si
**	  - strip_compress_lower(): convert properly ISO Latin 1 char set
**	V6.1b11 14-Apr-1997	Mark Martinec   mark.martinec@ijs.si
**	  - new routines strnncpy and strnncat (finally got fed up
**	    with programming the same tricks and test over and over again :)
**	  - new routine err_oline_cat to replace common code pattern
**	  - new routine news_strdup to replace common
**	    code pattern:  strcpy(news_malloc(strlen(x)+1),x)
**	V6.1b11  7-May-1997	Mark Martinec   mark.martinec@ijs.si
**	  - new routines util_grp_name_str() and util_grp_name_len()
**	    aiding with handling of possibly not '\0'-terminated
**	    group name in the groups file record
**--
**/

#ifdef vaxc
#module NEWSRTL "V6.2"
#endif

#define _NEWSRTL_C
#define module_name "NEWSRTL"

#include "newsinclude.h"
#include "newsextern.h"

#if NAKED_INCLUDES
#include libdef
#include psldef
#include stsdef
#else
#include <libdef.h>
#include <psldef.h>
#include <stsdef.h>
#endif

int *c$_tmphead = 0;                        /* head of heap store list */


int sa[32];      /* signal array */
int sa_l = 0;    /* signal array length */

void append_to_signal_array(status, nargs, arg1, arg2, arg3)
  int status, nargs, arg1, arg2, arg3;
{
  int fac;

  if (sa_l+5 < 32) {
    sa[sa_l++] = status;
    fac = $VMS_STATUS_FAC_NO(status);
    if (fac == SYSTEM$_FACILITY) ;   /* no FAO count for SYSTEM messages */
    else if (fac == RMS$_FACILITY)   /* for RMS errors STV is required */
      if (nargs >= 1) sa[sa_l++] = arg1;
      else sa[sa_l++] = NEWS$_NOSTV; /* invent stv if the genuine stv is unknown */
    else {                           /* user-supplied message */
      sa[sa_l++] = min(nargs,3);     /* FAO count required */
      if (nargs >= 1) sa[sa_l++] = arg1;
      if (nargs >= 2) sa[sa_l++] = arg2;
      if (nargs >= 3) sa[sa_l++] = arg3;
      }
    }
}

void send_signal_array(void)
{
  int saved_sysprv = !sysprv_off;

  /* preventively turn off SYSPRV in case condition handler decides
     to continue execution somewhere else */
  nosysprv();
  if (sa_l <= 0) { lib$signal(NEWS$_INVSA, 1,sa_l); sa_l =  0; }
  if (sa_l > 16) { lib$signal(NEWS$_LONGSA,1,sa_l); sa_l = 16; }
  switch (sa_l) {
    case  0: break;
    case  1: lib$signal(sa[0]); break;
    case  2: lib$signal(sa[0],sa[1]); break;
    case  3: lib$signal(sa[0],sa[1],sa[2]); break;
    case  4: lib$signal(sa[0],sa[1],sa[2],sa[3]); break;
    case  5: lib$signal(sa[0],sa[1],sa[2],sa[3],sa[4]); break;
    case  6: lib$signal(sa[0],sa[1],sa[2],sa[3],sa[4],sa[5]); break;
    case  7: lib$signal(sa[0],sa[1],sa[2],sa[3],sa[4],sa[5],sa[6]); break;
    case  8: lib$signal(sa[0],sa[1],sa[2],sa[3],sa[4],sa[5],sa[6],sa[7]); break;
    case  9: lib$signal(sa[0],sa[1],sa[2],sa[3],sa[4],sa[5],sa[6],sa[7],sa[8]); break;
    case 10: lib$signal(sa[0],sa[1],sa[2],sa[3],sa[4],sa[5],sa[6],sa[7],sa[8],sa[9]); break;
    case 11: lib$signal(sa[0],sa[1],sa[2],sa[3],sa[4],sa[5],sa[6],sa[7],sa[8],sa[9],sa[10]); break;
    case 12: lib$signal(sa[0],sa[1],sa[2],sa[3],sa[4],sa[5],sa[6],sa[7],sa[8],sa[9],sa[10],sa[11]); break;
    case 13: lib$signal(sa[0],sa[1],sa[2],sa[3],sa[4],sa[5],sa[6],sa[7],sa[8],sa[9],sa[10],sa[11],sa[12]); break;
    case 14: lib$signal(sa[0],sa[1],sa[2],sa[3],sa[4],sa[5],sa[6],sa[7],sa[8],sa[9],sa[10],sa[11],sa[12],sa[13]); break;
    case 15: lib$signal(sa[0],sa[1],sa[2],sa[3],sa[4],sa[5],sa[6],sa[7],sa[8],sa[9],sa[10],sa[11],sa[12],sa[13],sa[14]); break;
    case 16: lib$signal(sa[0],sa[1],sa[2],sa[3],sa[4],sa[5],sa[6],sa[7],sa[8],sa[9],sa[10],sa[11],sa[12],sa[13],sa[14],sa[15]); break;
    }
  /* if execution continues here then restore SYSPRV if we had it before */
  if (saved_sysprv) sysprv();
  sa_l = 0;
}


/* 
 * get_rms_filename_and_sts
 *
 * From a given FAB or RAB it obtains sts, stv and file descriptor.
 * See also function report_rms_error.
 *
 */

void get_rms_filename_and_sts(p, dsc, sts, stv, rms_status)
  void *p;   /* may be either a pointer to FAB or a pointer to RAB */
  struct dsc$descriptor_s *dsc; /* returned file name descriptor   */
                                /*  (descriptor will be initialized) */
  int *sts, *stv;      /* returned RMS sts and stv values */
  int rms_status;      /* provide RMS status in case of invalid FAB/RAB block */
{
  int dsc_l;
  const char *dsc_a = NULL;
  struct FAB *fab_p;
  struct RAB *rab_p;
  struct NAM *nam_p;

  *sts = rms_status; *stv = 0;
  if (!p)
    { dsc_a = "<no name, FAB or RAB pointer is null>"; dsc_l = strlen(dsc_a); }
  else {
    fab_p = (struct FAB *) p;
    rab_p = (struct RAB *) p;
    /* relies on the same offset of rab$b_bid and fab$b_bid in RAB and FAB */
    if (fab_p->fab$b_bid == FAB$C_BID) {
      *sts = fab_p->fab$l_sts;
      *stv = fab_p->fab$l_stv;
      }
    else if (rab_p->rab$b_bid == RAB$C_BID) {
      *sts = rab_p->rab$l_sts;
      *stv = rab_p->rab$l_stv;
      fab_p = rab_p->rab$l_fab;
      }
    /* fab_p should now point to a FAB */
    if (fab_p->fab$b_bid != FAB$C_BID)
      { dsc_a = "<no name, illegal/unitialized FAB>"; dsc_l = strlen(dsc_a); }
    else {
      dsc_l = 0;
      if ((nam_p = (struct NAM *) fab_p->fab$l_nam) != 0) {
        if ((dsc_l = nam_p->nam$b_rsl) != 0)
            dsc_a = nam_p->nam$l_rsa;
        else {
            dsc_l = nam_p->nam$b_esl;
            dsc_a = nam_p->nam$l_esa;
          }
        }
      if (!dsc_l) {
        dsc_l = fab_p->fab$b_fns;
        dsc_a = fab_p->fab$l_fna;
        }
      }
    }
  dsc->dsc$b_dtype = DSC$K_DTYPE_T;
  dsc->dsc$b_class = DSC$K_CLASS_S;
  dsc->dsc$w_length  = dsc_l;
  dsc->dsc$a_pointer = (char *) dsc_a;
}

/*
 * report_rms_error_routine
 *   (called by macro report_rms_error and others of the form sys_* )
 *
 * This function is supposed to be called after failing RMS calls.
 * It signals a user condition code, together with an associated
 * RMS condition code.  Function returns the first argument as the
 * function value.
 *
 * A message associated with the user_status is supposed to contain
 * a  !AS  FAO directive, which (during message formatting) gets
 * the corresponding file name as a value.
 *
 * The third parameter is a pointer to FAB or a pointer to RAB.
 * If RAB is specified it must contain a pointer to valid FAB.
 * If FAB contains a pointer to NAM with valid RSA or ESA fields,
 * the file name in the error message will contain more specific information.
 *
 * The RMS status (STS and STV) is taken from the block pointed to by p.
 * In case of an invalid fab/rab block the STS is provided by the second
 * parameter rms_status, which under normal circumstances is supposed
 * to be equal to the STS value in the fab/rab block.
 *
 * It is essential that after RMS calls operating on FAB the *FAB is specified
 * and after RMS calls operating on RAB the *RAB is specified as the second
 * argument to this function.
 *
 * This function is modeled after the VMS library function UTIL$Report_IO_Error.
 */

int report_rms_error_routine(user_status, rms_status, p, module, line_number)
  int user_status; /* should be a 'user-supplied messages' (not SYSTEM or RMS)*/
  int rms_status;  /* should be the status returned by the last RMS operation */
  const void *p;   /* may be either a pointer to FAB or a pointer to RAB */
  const char *module; /* string with module name or NULL */
  int line_number; /* source line number to be reported */
{
  int sts,stv;
  struct dsc$descriptor_s name_dsc;

  get_rms_filename_and_sts(p,&name_dsc,&sts,&stv,rms_status);
  sa_l = 0;
  append_to_signal_array(user_status,1,(int)&name_dsc,0,0);
  if (sts) append_to_signal_array(sts,1,stv,0,0);
  if (module) {
    static struct dsc$descriptor_const_s modu_dsc = { 0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0 };
    modu_dsc.dsc$w_length = strlen(module); modu_dsc.dsc$a_pointer = module;
    append_to_signal_array(NEWS$_SOURCE,2,(int)&modu_dsc,line_number,0);
    }
  send_signal_array();
  return user_status;
}


/* 
 * get_cio_filename_and_message
 *
 * From a given file pointer obtain a file name descriptor
 * and the error message corresponding to errno.
 *
 * name_dsc will point to a static read-only buffer.
 * mess_dsc is modified to point to an internal read-only message string.
 */

void get_cio_filename_and_message(file_ptr, file_name,
                                  name_dsc, mess_dsc)
  FILE *file_ptr;   /* file pointer (possibly NULL if op (e.g. fopen) failed) */
  char *file_name;  /* optional file name to supplement error msg in case
                       file_ptr==NULL or fgetname fails */
  struct dsc$descriptor_const_s *name_dsc;/* returned file name descriptor    */
                                          /* (descriptor will be initialized) */
  struct dsc$descriptor_const_s *mess_dsc;/* returned error message descriptor*/
                                          /* (descriptor will be initialized) */
{
  static char name[256];
  int saved_errno = errno;

  name_dsc->dsc$b_dtype = DSC$K_DTYPE_T; name_dsc->dsc$b_class = DSC$K_CLASS_S;
  mess_dsc->dsc$b_dtype = DSC$K_DTYPE_T; mess_dsc->dsc$b_class = DSC$K_CLASS_S;

  name[0] = '\0';
  name_dsc->dsc$a_pointer = name;
  name_dsc->dsc$w_length = 0;

  if (!file_ptr) {
    if (file_name) strnncpy(name,sizeof(name), file_name,-1, 0);
    else name_dsc->dsc$a_pointer = "<no name, file_ptr is null>";
    }
  else if (!fgetname(file_ptr,name)) {
    if (file_name) strnncpy(name,sizeof(name), file_name,-1, 0);
    else name_dsc->dsc$a_pointer = "<no name, fgetname failed>";
    }
  name_dsc->dsc$w_length = strlen(name_dsc->dsc$a_pointer);

  mess_dsc->dsc$w_length = 0;
  if ( (mess_dsc->dsc$a_pointer = strerror(saved_errno)) )
    mess_dsc->dsc$w_length = strlen(mess_dsc->dsc$a_pointer);
}


int report_cio_error_routine(user_status, file_ptr, file_name,
                             module, line_number)
  int user_status; /* should be a 'user-supplied messages' (not SYSTEM or RMS)*/
  const FILE *file_ptr;  /* file pointer (possibly NULL if last op failed)    */
  const char *file_name; /* optional file name to supplement error msg in case
                        file_ptr==NULL or fgetname fails (useful after fopen) */
  const char *module;    /* string with module name or NULL */
  int line_number;       /* source line number to be reported */
{
  struct dsc$descriptor_const_s name_dsc, mess_dsc;
  int sts = vaxc$errno;
  int saved_errno = errno;

  get_cio_filename_and_message(file_ptr, file_name, &name_dsc, &mess_dsc);
  sa_l = 0;
  append_to_signal_array(user_status,1,(int)&name_dsc,0,0);
  if (saved_errno != EVMSERR)
    append_to_signal_array(NEWS$_PERROR,1,(int)&mess_dsc,0,0);
  if (!(sts&1) || (saved_errno == EVMSERR && sts != SS$_NORMAL))
    append_to_signal_array(sts,0,0,0,0);
  if (module) {
    static struct dsc$descriptor_const_s modu_dsc = { 0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0 };
    modu_dsc.dsc$w_length = strlen(module); modu_dsc.dsc$a_pointer = module;
    append_to_signal_array(NEWS$_SOURCE,2,(int)&modu_dsc,line_number,0);
    }
  send_signal_array();
/*
 * When signalling a condition code with facility=RMS$_FACILITY
 * the system service $PUTMSG expects [FAB/RAB]$L_STS to be always
 * accompanied by [FAB/RAB]$L_STV as the next parameter in signal array.
 *
 * The interpretation of stv depends on sts:  stv may be a value
 * to be included in the error message as the FAO argument,
 * may be another condition code or it may be ignored by $PUTMSG -
 * - BUT IT MUST BE PRESENT !
 *
 * Now then.  The ugly VAXC RTL allows no legal/supported way
 * to obtain the FAB/RAB of C files, therefore stv is unknown to us.
 *
 * This routine supplies the user-status NEWS$_NOSTVC instead of
 * the appropriate stv. This will give meaningful message in most cases,
 * in others it will include a strange integer in the RMS message.
 *    mark.martinec@ijs.si
 */
  set_errno(0); set_vaxc_errno(SS$_NORMAL);
  if (file_ptr && *file_ptr) clearerr(file_ptr);
  return user_status;
}

int report_sys_error_routine(user_status, user_value, status,
                             module, line_number)
  int user_status; /* should be a 'user-supplied messages' (not SYSTEM or RMS)*/
  int user_value;  /* optional FAO argument to user_status message text */
  int status;      /* cond. code with facility=SYSTEM; if 0 then not reported */
  const char *module; /* string with module name or NULL */
  int line_number; /* source line number to be reported */
{
  sa_l = 0;
  if (user_status!=0 && user_status!=SS$_NORMAL)
    append_to_signal_array(user_status,1,user_value,0,0);
  if (status!=0 && status!=SS$_NORMAL)
    append_to_signal_array(status,0,0,0,0);   /* should be of facility=system */
  if (module) {
    static struct dsc$descriptor_const_s modu_dsc = { 0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0 };
    modu_dsc.dsc$w_length = strlen(module); modu_dsc.dsc$a_pointer = module;
    append_to_signal_array(NEWS$_SOURCE,2,(int)&modu_dsc,line_number,0);
    }
  send_signal_array();
  return status;
}


/*
 *  news_abort
 *
 *  Terminate program, preferably in a controlled manner
 */

void news_abort(void)
{
  if (!closing_files) {
    sa_l = 0;
    append_to_signal_array(NEWS$_CLEANUP,0,0,0,0);
    send_signal_array();
    closefiles();
  }
  sys$exit(NEWS$_ABORT);
}

/*
 *  news_assert_routine
 *
 *  Called by macros news_assert and news_assert_nonfatal
 *  to report a problem and terminate / continue program.
 */

void news_assert_routine(expr, module, line_number, nonfatal)
  const char *expr;
  const char *module;
  int line_number;
  int nonfatal; /* if true the severity is changed to INFO and prog continues */
{
  /* use static descriptors to allow error reporting not to depend on malloc */
  static struct dsc$descriptor_const_s expr_dsc = { 0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0 };
  static struct dsc$descriptor_const_s modu_dsc = { 0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0 };
  int status = NEWS$_ASSERT;

  if (nonfatal) status = (status & (~7)) | STS$K_INFO;
  expr_dsc.dsc$w_length = strlen(expr);   expr_dsc.dsc$a_pointer = expr;
  modu_dsc.dsc$w_length = strlen(module); modu_dsc.dsc$a_pointer = module;
  sa_l = 0;
  append_to_signal_array(status,1,(int)&expr_dsc,0,0);
  append_to_signal_array(NEWS$_SOURCE,2,(int)&modu_dsc,line_number,0);
  send_signal_array();
/*if (!nonfatal) news_abort(); */
}


/*
 *  c$alloc_tmp
 *
 *  Allocate temporary storage for use with c$ calls
 */

int *c$alloc_tmp(size)
  int size;
{
  int *c$_tmp;

  c$_tmp = (int *) news_malloc(size + 4);
  *c$_tmp = (int) c$_tmphead;
  c$_tmphead = c$_tmp;
  return(c$_tmphead + 1);
}

int *c$realloc_tmp(oldptr,size)
  int *oldptr, size;
{
  int *x, *i, fst;

  x = oldptr - 1;
  i = c$_tmphead;
  while (i && (i != x)) i = *(int **)i;
  if (i) {
    fst = (i == c$_tmphead);
    i = news_realloc(i,size + 4);
    if (fst) c$_tmphead = i;
    return(i+1);
    }
  return(0);
}

void c$free_tmp(void)
{
  int *tmp;

  while (c$_tmphead) {
    tmp = (int *) *c$_tmphead;
    news_free((void *) c$_tmphead);
    c$_tmphead = tmp;
    }
}

/*
 *  c$rfi
 *
 *  Generate a reference to a temp integer value
 */

int *c$rfi(value)
  int value;
{
  int *tmp = c$alloc_tmp(4);

  *tmp = value;
  return(tmp);
}

/*
 *  c$dsc
 *
 * Allocate a string descriptor in the temp arg area,
 * pointing to the 'const' string.
 */

struct dsc$descriptor_const_s *c$dsc(str)
  const char *str;
{
  struct dsc$descriptor_const_s *tmpdsc;

  tmpdsc = (struct dsc$descriptor_const_s *) c$alloc_tmp(8);
  tmpdsc->dsc$w_length = strlen(str);
  tmpdsc->dsc$b_dtype = DSC$K_DTYPE_T;
  tmpdsc->dsc$b_class = DSC$K_CLASS_S;
  tmpdsc->dsc$a_pointer = str;
  return(tmpdsc);
}

/*
 *  c$dsc_rw
 *
 * Allocate a string descriptor in the temp arg area,
 * pointing to a read/write string
 */

struct dsc$descriptor_s *c$dsc_rw(str)
  char *str;
{
  struct dsc$descriptor_s *tmpdsc;

  tmpdsc = (struct dsc$descriptor_s *) c$alloc_tmp(8);
  tmpdsc->dsc$w_length = strlen(str);
  tmpdsc->dsc$b_dtype = DSC$K_DTYPE_T;
  tmpdsc->dsc$b_class = DSC$K_CLASS_S;
  tmpdsc->dsc$a_pointer = str;
  return(tmpdsc);
}

/*
 *  c$dscl
 *
 * Update the length field in a string descriptor
 * and cast it into a 'const' string descriptor.
 */

struct dsc$descriptor_const_s *c$dscl(d)
  struct dsc$descriptor_s *d;
{
  d->dsc$w_length = strlen(d->dsc$a_pointer);
  return((struct dsc$descriptor_const_s *) d);
}

/*
 *  c$cks_routine is called by macro c$cks
 *
 *  Check condition code, signal errors, and free the temp argument area
 */

int c$cks_routine(status, module, line_number)
  int status;
  const char *module;
  int line_number;
{
  /* use static descriptor to allow error reporting not to depend on malloc */
  if (!(status & 1)) {
    sa_l = 0;
    append_to_signal_array(status,0,0,0,0);
    if (module) {
      static struct dsc$descriptor_const_s modu_dsc = { 0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0 };
      modu_dsc.dsc$w_length = strlen(module); modu_dsc.dsc$a_pointer = module;
      append_to_signal_array(NEWS$_SOURCE,2,(int)&modu_dsc,line_number,0);
      }
    send_signal_array();
    }
  if (c$_tmphead) c$free_tmp();
  return status;
}

/*
 *  cks_routine is called by macro _c$cks
 *
 *  Check condition code and signal errors
 */

int cks_routine(status, module, line_number)
  int status;
  const char *module;
  int line_number;
{
  sa_l = 0; append_to_signal_array(status,0,0,0,0);
  if (module) {
    static struct dsc$descriptor_const_s modu_dsc = { 0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0 };
    modu_dsc.dsc$w_length = strlen(module); modu_dsc.dsc$a_pointer = module;
    append_to_signal_array(NEWS$_SOURCE,2,(int)&modu_dsc,line_number,0);
    }
  send_signal_array();
  return status;
}


/*
 *  try_to_make_some_free_space
 *
 *  This routine is normally called when a file creation on NEWS_DEVICE failed.
 *  If there are any site-specific ways to make more space available on that
 *  device, this routine should make it so.
 *
 *  If the name of the file whose creation failed is known, this procedure
 *  may use the device/directory information from the file specification
 *  to decide on the most appropriate action.
 *
 *  If the routine was at least partially successful and it would make sense
 *  for the caller to retry the file creation, the returned value should be 1,
 *  otherwise 0.
 *
 *  NOTE: - this code is supposed to run with SYSPRV enabled
 *        - errno and vaxc$errno values are to be retained
 */

int try_to_make_some_free_space(stv,file_blocks,filename,priority)
  int stv;             /* detailed status of the failed operation (FAB$L_STV)
                          if known, otherwise 0 */
  int file_blocks;     /* disk blocks required if known, otherwise 0 */
  const char *filename;/* file name with directory specification if available,
                          otherwise NULL */
  int priority;        /* try harder to make space (e.g. for local postings);
                          normally 0 for ADD FILE, >0 for local posting */
{
  int success = 0;
  int saved_errno = errno, sts = vaxc$errno;
    /* add site specific code here */
  stat_make_space_called++; if (success) stat_make_space_succeeded++;
  set_errno(saved_errno); set_vaxc_errno(sts);
  return success;
}


/*
 *  fgetl
 *
 *  Read lines from file with '\' continuation character support
 */

char *fgetl(f)
  FILE *f;
{
  static char *rbuffer = 0;
  static int rbuffer_l = 0;  /* length of string in rbuffer */
  static int rb_size = 0;    /* allocated buffer size */

  char inl[IO_SIZE];
  int inl_l;  /* strlen(inl) */
    
  if (!rbuffer) rbuffer = (char *) news_malloc(rb_size = sizeof(inl));
  *rbuffer = '\0'; rbuffer_l = 0;
  for (;;) {
    if (!fgets(inl,sizeof(inl),f)) {
      _ck_get(f);
      if (rbuffer_l > 0) return(rbuffer); else return(0);
    } else {
      inl_l = strlen(inl);
      if (rbuffer_l + inl_l + 1 > rb_size)
        rbuffer = (char *) news_realloc(rbuffer,rb_size += sizeof(inl));
      strnncat(rbuffer,rb_size,rbuffer_l, inl,inl_l, &rbuffer_l);
      if (rbuffer[rbuffer_l-1] == '\n') {
        if (rbuffer_l>=2 && rbuffer[rbuffer_l-2] == '\\')
          { rbuffer_l -= 2; rbuffer[rbuffer_l] = '\0'; }
        else return(rbuffer);
        }
      }
    }
  return(0);  /* should not happen */
}

/*
 *  fgetlc
 *
 *  Read lines from file with '\' continuation character support
 */

char *fgetlc(f)
  FILE *f;
{
  static char *rbuffer = 0;
  static int rbuffer_l = 0;  /* length of string in rbuffer */
  static int rb_size = 0;    /* allocated buffer size */

  char inl[IO_SIZE];
  int inl_l;  /* strlen(inl) */

  if (!rbuffer) rbuffer = (char *) news_malloc(rb_size = sizeof(inl));
  *rbuffer = '\0'; rbuffer_l = 0;
  for (;;) {
    if (!fgets(inl,sizeof(inl),f)) {
      _ck_get(f);
      if (rbuffer_l > 0) return(rbuffer); else return(0);
    } else {
      chop_str(inl,'#');
      inl_l = strlen(inl);
      if (rbuffer_l + inl_l + 1 > rb_size)
        rbuffer = (char *) news_realloc(rbuffer,rb_size += sizeof(inl));
      strnncat(rbuffer,rb_size,rbuffer_l, inl,inl_l, &rbuffer_l);
      if (rbuffer[rbuffer_l-1] == '\n') {
        if (rbuffer_l>=2 && rbuffer[rbuffer_l-2] == '\\')
          { rbuffer_l -= 2; rbuffer[rbuffer_l] = '\0'; }
        else return(rbuffer);
        }
      }
    }
  return(0);  /* should not happen */
}

/*
 *  strip_compress_lower
 *
 *  Strip off leading and trailing blanks, convert all whitespace to a single
 *  space, and convert all alphas to lower case.
 */

void
strip_compress_lower(s)
  char *s;
{
  char *start = s,
       *r = s;

  for (; *s; s++) {
    if (isgraph(*s)) 
      /* tolower does not convert neither ISO Latin 1 nor DEC Multinational
         character set properly.  Do it the ISO Latin 1 way: */
      if (((*s >= 'A') && (*s <= 'Z')) ||
          ((*s >= '\300') && (*s <= '\326')) ||
          ((*s >= '\330') && (*s <= '\336')))
       /* forget about DEC Multinational:
          ((*s>='\300') && (*s<='\317')) || ((*s>='\321') && (*s<='\335'))) */
        *r++ = *s + ('a' - 'A');
      else
        *r++ = *s;

    else if ((r > start) && (*(r-1) != ' ')) *r++ = ' ';
    }
  if ((r > start) && (*(r-1) == ' ')) --r;
  *r = '\0';
}


void
strip_compress(s)
  char *s;
{
  char *start = s,
       *r = s;

  for (; *s; s++) {
    if (isgraph(*s)) *r++ = *s;
    else if ((r > start) && (*(r-1) != ' ')) *r++ = ' ';
    }
  if ((r > start) && (*(r-1) == ' ')) --r;
  *r = '\0';
}

/*
 *  blank_strip
 *
 *  Remove all non-print characters from a string.
 */

void
blank_strip(s)
  char *s;
{
  char *r = s;

  --s;
  while (*++s)
    if (isgraph(*s)) *r++ = *s;
  *r = '\0';
}

/*
 *  lower_case
 *
 *  convert a string to lower case
 */

char *lower_case(s)
  char *s;
{
  register char *p;

  /* The tolower does not convert multinational character set properly. */
  for (p=s; *p; p++) {
    if (((*p >= 'A') && (*p <= 'Z')) ||
        ((*s >= '\300') && (*s <= '\317')) || ((*s >= '\321') && (*s <= '\335')))
/*      ((*s >= '\xC0') && (*s <= '\xCF')) || ((*s >= '\xD1') && (*s <= '\xDD')))  */
/*                                  (meaning of \x varies with -traditional)  */
      *p += 'a' - 'A';
    }
  return(s);
}


/*
 *  substrcmp
 *
 *  return 1 if the second arg is a substring of the first arg
 */

int substrcmp(s,sub)
  const char *s, *sub;
{
  int i, bl = strlen(sub), sl = strlen(s);

  for (i = 0; i <= (sl - bl); ++i)
    if (!strncmp(&s[i],sub,bl)) return(i+1);
  return(0);
}

/*
 *  substrcasecmp - case-insensitive substrcmp
 *
 *  return 1 if the second arg is a substring of the first arg
 */

int substrcasecmp(s,sub)
  const char *s, *sub;
{
  int i, bl = strlen(sub), sl = strlen(s);

  for (i = 0; i <= (sl - bl); ++i)
    if (!news_strncasecmp(&s[i],sub,bl)) return(i+1);
  return(0);
}

/*
 *  strnncpy
 *
 *  'do The Right Thing strcpy':
 *
 *  Copies at most src_l characters (or strlen(src) chars if src_l<0)
 *  from string src into dst, guaranteeing not to copy more than
 *  dst_m-1 characters (dst_m is normally set to sizeof(dst) by the caller)
 *  and guaranteeing to null-terminate the resulting string.
 *  src and dst must not overlap.
 *  If src_l is explicitly given (>=0) then src may contain null characters.
 *
 *  src == NULL && src_l <= 0 is allowed and implies src_l == 0.
 *
 *  If src_l == 0 then dst may forgivingly be NULL and
 *  null-terminating it will not be attempted.
 *
 *  If the parameter newdst_l is not NULL, it receives the resulting string
 *  length of dst. Function returns dst as the function value.
 */

char *strnncpy(char *dst, int dst_m,
               const char *src, int src_l,
               int *newdst_l)
{
  news_assert(dst_m >= 1);

  if (dst_m == sizeof(char*)) {
   /* forgivingly trap common mistake of supplying sizeof pointer as dst_m
      instead of the actual buffer size */
    int status;
    _ck_sys(NEWS$_IGNORELIMIT,0,1);
    dst_m = 999999999;
    }
  if (!src && src_l<0) src_l = 0;
  if (src_l != 0) news_assert(src != NULL);
  if (src_l < 0) src_l = strlen(src);
  if (src_l > 0) news_assert(dst != NULL);
  if (src_l >= dst_m) {
    lib$signal(NEWS$_BUFOVF,2,src_l,dst_m-1);                  /* warning */
    src_l = dst_m-1;
    }
  if (src_l >= 14)             /* worth calling memcpy only for large strings */
    memcpy(dst,src,src_l);
  else {
    register int k;
    char *d = dst;  const char *s = src;
    for (k=src_l; k>0; k--) *d++ = *s++;
    }
  if (dst) dst[src_l] = '\0';
  if (newdst_l) *newdst_l = src_l;
  return dst;
}

/*
 *  strnncat
 *
 *  'do The Right Thing strcat':
 *
 *  Append at most src_l characters (or strlen(src) chars if src_l<0)
 *  from string src into dst, guaranteeing not to overwrite buffer
 *  (dst_m is normally set to sizeof(dst) by the caller)
 *  and guaranteeing to null-terminate the resulting string.
 *  src and dst must not overlap.
 *
 *  If dst_l >= 0 then dst_l is the initial size of string in dst
 *  and it need not be null-terminated; otherwise strlen(dst) is used
 *  as the initial dst size.
 *
 *  If dst_l is explicitly given (>=0) then dst may contain null characters.
 *  If src_l is explicitly given (>=0) then src may contain null characters.
 *
 *  src == NULL && src_l <= 0 is allowed and implies src_l == 0.
 *
 *  If src_l == 0 then dst may forgivingly be NULL and
 *  null-terminating it will not be attempted.
 *
 *  If the parameter newdst_l is not NULL, it receives the new string
 *  length of dst. Function returns dst as the function value.
 */

char *strnncat(char *dst, int dst_m, int dst_l,
               const char *src, int src_l,
               int *newdst_l)
{
  news_assert(dst_m >= 1);

  if (dst_m == sizeof(char*)) {
   /* forgivingly trap common mistake of supplying sizeof pointer as dst_m
      instead of the actual buffer size */
    int status;
    _ck_sys(NEWS$_IGNORELIMIT,0,1);
    dst_m = 999999999;
    }
  if (!src && src_l<0) src_l = 0;
  if (src_l != 0) news_assert(src != NULL);
  if (src_l < 0) src_l = strlen(src);
  if (dst_l < 0) dst_l = strlen(dst);
  if (dst_l+src_l > 0) news_assert(dst != NULL);
  news_assert(dst_l < dst_m);

  if (dst_l+src_l >= dst_m) {
    lib$signal(NEWS$_BUFOVF,2,src_l,dst_m-dst_l-1);            /* warning */
    src_l = dst_m-dst_l-1;
    if (src_l < 0) src_l = 0;
    }
  if (src_l >= 14)             /* worth calling memcpy only for large strings */
    memcpy(&dst[dst_l],src,src_l);
  else {
    register int k;
    char *d = &dst[dst_l];  const char *s = src;
    for (k=src_l; k>0; k--) *d++ = *s++;
    }
  if (dst) dst[dst_l+src_l] = '\0';
  if (newdst_l) *newdst_l = dst_l+src_l;
  return dst;
}

void err_oline_cat(const char *str)
{
  strnncat(err_oline,err_oline_m,-1, str,-1, 0);
}

char *news_strdup(const char *str, int str_l)
{
  char *dst;
  if (str_l != 0) news_assert(str != NULL);
  if (str_l<0) str_l = strlen(str);
  dst = news_malloc(str_l+1);
  news_assert(dst != NULL);
  if (str_l >= 14)             /* worth calling memcpy only for large strings */
    memcpy(dst,str,str_l);
  else {
    register int k;
    char *d = dst;  const char *s = str;
    for (k=str_l; k>0; k--) *d++ = *s++;
    }
  dst[str_l] = '\0';
  return dst;
}

/*
 *  util_idcpy
 *
 *  block copy (including padding nulls)
 */

void util_idcpy(result,input)
  char *result;
  const char *input;
{
  strncpy(result,(input?input:""),IDLEN-1); result[IDLEN-1] = '\0';
}
/*
 *  util_fromcpy
 *
 *  block copy (including padding nulls)
 */

void util_fromcpy(result,input)
  char *result;
  const char *input;
{
  strncpy(result,(input?input:""),FROMLEN-1); result[FROMLEN-1] = '\0';
}

/*
 *  util_subjcpy
 *
 *  block copy (including padding nulls)
 */

void util_subjcpy(result,input)
  char *result;
  const char *input;
{
  strncpy(result,(input?input:""),SUBJLEN-1); result[SUBJLEN-1] = '\0';
}

/*
 * util_grp_name_str
 *   Parameter grp_name is a group name string
 *   in a buffer of size GRPNAMELEN_F (like newsgrp.grp_name),
 *   which is not necessarily '\0'-terminated, but can be filled
 *   completely with a name.
 *
 *   Returns a pointer to a statically allocated copy of the name,
 *   which is guaranteed to be '\0'-terminated, possibly at the
 *   position just beyond GRPNAMELEN_F.
 */
char *util_grp_name_str(const char *grp_name)
{
  static char zero_terminated_grp_name[GRPNAMELEN_F+1];

  memcpy(zero_terminated_grp_name, grp_name, GRPNAMELEN_F);
  zero_terminated_grp_name[GRPNAMELEN_F] = '\0';
  return zero_terminated_grp_name;
}

/*
 * util_grp_name_len
 *   Parameter grp_name is a group name string
 *   in a buffer of size GRPNAMELEN_F (like newsgrp.grp_name),
 *   which is not necessarily '\0'-terminated, but can be filled
 *   completely with a name.
 *
 *   Returns the actual length of the group name ( <= GRPNAMELEN_F ).
 */
int util_grp_name_len(const char *grp_name)
{
  int j;

  for (j=0; j<GRPNAMELEN_F && grp_name[j]; j++) {}
  return j;
}


char *quotes(s)
  const char *s;
{
  static char qrtn[IO_SIZE];
  char *cp = qrtn;

  for (; *s; s++) {
    news_assert(cp-qrtn+1 < sizeof(qrtn));
    *cp++ = *s;
    if (*s == '"') *cp++ = '"';
    }
  *cp = '\0';

  return(qrtn);
}

/*
 *  file_copy
 *
 *  Use RMS to copy a file.
 */

int file_copy(from,to,bypass_signalling_errors)
  const char *from, *to;
  int bypass_signalling_errors;  /* bypass signalling of some
                                    of the more common errors */
    /* 6/6/94 - saul@hnrc.tufts.edu - Dynamically allocate the buffer
		up to 63 blocks */
	    
{
  struct FAB infab,
             outfab;
  struct RAB inrab,
             outrab;
  struct XABDAT inxabdat,
                outxabdat;
  struct XABFHC inxabfhc,
                outxabfhc;
  struct XABRDT inxabrdt,
                outxabrdt;
  struct XABPRO inxabpro,
                outxabpro;
  int status, ret_stat;

  ret_stat = SS$_NORMAL;

  infab = cc$rms_fab;
  infab.fab$l_fna = (char *) from;
  infab.fab$b_fns = strlen(from);
  infab.fab$b_fac = FAB$M_BIO | FAB$M_GET;
  infab.fab$l_xab = (char *) &inxabdat;

  inxabdat = cc$rms_xabdat;
  inxabdat.xab$l_nxt = (char *) &inxabfhc;

  inxabfhc = cc$rms_xabfhc;
  inxabfhc.xab$l_nxt = (char *) &inxabrdt;

  inxabrdt = cc$rms_xabrdt;
  inxabrdt.xab$l_nxt = (char *) &inxabpro;

  inxabpro = cc$rms_xabpro;

  inrab = cc$rms_rab;
  inrab.rab$l_fab = &infab;
  inrab.rab$l_bkt = 0;

  if (! ((status=sys$open(&infab)) & 1)) {
    ret_stat = status;
    if (!bypass_signalling_errors)
      report_rms_error_routine(NEWS$_OPNFAIL,status,&infab,module_name_str,__LINE__);
    }
  else {
    if (! ((status=sys$connect(&inrab)) & 1)) {
      ret_stat = status;
      if (!bypass_signalling_errors)
        report_rms_error_routine(NEWS$_CONFAIL,status,&inrab,module_name_str,__LINE__);
      }
    else {
      outfab = cc$rms_fab;
      outfab.fab$l_fna = (char *) to;
      outfab.fab$b_fns = strlen(to);
      outfab.fab$l_fop = FAB$M_CBT;
      outfab.fab$b_fac = FAB$M_BIO | FAB$M_PUT;
      outfab.fab$b_rat = FAB$M_CR;
      outfab.fab$l_xab = (char *) &outxabdat;

      outxabdat = cc$rms_xabdat;
      outxabdat.xab$l_nxt = (char *) &outxabfhc;

      outxabfhc = cc$rms_xabfhc;
      outxabfhc.xab$l_nxt = (char *) &outxabrdt;

      outxabrdt = cc$rms_xabrdt;
      outxabrdt.xab$l_nxt = (char *) &outxabpro;

      outxabpro = cc$rms_xabpro;

      outrab = cc$rms_rab;
      outrab.rab$l_fab = &outfab;
      outrab.rab$l_bkt = 0;

      outfab.fab$l_alq = infab.fab$l_alq;
      outfab.fab$w_deq = infab.fab$w_deq;
      outfab.fab$b_fsz = infab.fab$b_fsz;
      outfab.fab$l_mrn = infab.fab$l_mrn;
      outfab.fab$w_mrs = infab.fab$w_mrs;
      outfab.fab$b_org = infab.fab$b_org;
      outfab.fab$b_rat = infab.fab$b_rat;
      outfab.fab$b_rfm = infab.fab$b_rfm;

      outxabfhc.xab$b_rfo = inxabfhc.xab$b_rfo;
      outxabfhc.xab$b_atr = inxabfhc.xab$b_atr;
      outxabfhc.xab$w_lrl = inxabfhc.xab$w_lrl;
#if defined(__DECC) && !defined(__ALPHA)
        /* xab$b_bkz is common for FHC and ALQ XABs and it is declared in a
           separate structure.  DECC on VAX has no field xab$b_bkz in XABFHC */
      ((struct XABDEF1*)&outxabfhc)->xab$b_bkz =
        ((struct XABDEF1*)&inxabfhc)->xab$b_bkz;
#else
      outxabfhc.xab$b_bkz = inxabfhc.xab$b_bkz;
#endif
      outxabfhc.xab$b_hsz = inxabfhc.xab$b_hsz;
      outxabfhc.xab$w_mrz = inxabfhc.xab$w_mrz;
      outxabfhc.xab$w_dxq = inxabfhc.xab$w_dxq;
      outxabfhc.xab$l_sbn = 0;
      outxabdat.xab$w_rvn = inxabdat.xab$w_rvn + 1;
      outxabrdt.xab$w_rvn = inxabrdt.xab$w_rvn + 1;
      outxabpro.xab$w_pro = inxabpro.xab$w_pro;

      status = sys$create(&outfab);
      if (! (status & 1)) {
        if (outfab.fab$l_sts == RMS$_CRE)
          if (try_to_make_some_free_space(outfab.fab$l_stv,outfab.fab$l_alq,to,0)) {
            status = sys$create(&outfab);
            if (status&1) stat_make_space_retry_success++;
            }
        }
      if (! (status & 1)) {
        ret_stat = status;
        if (!bypass_signalling_errors)
          report_rms_error_routine(NEWS$_CREFAIL,status,&outfab,module_name_str,__LINE__);
        }
      else {
        if (! ((status=sys$connect(&outrab)) & 1)) {
          ret_stat = status;
          if (!bypass_signalling_errors)
            report_rms_error_routine(NEWS$_CONFAIL,status,&outrab,module_name_str,__LINE__);
          }
        else {
	  /* buffer space allocation 6/6/94 saul@hnrc.tufts.edu */
	  char * buf_ptr;
	  int buf_size,buf_page;
	  char fall_back_buffer[4*512];

	  /* set buffer size to minimum(last_block_of_input_file, 63) */
          buf_page = (inxabfhc.xab$l_ebk <= 63) ? inxabfhc.xab$l_ebk : 63;

	  status = lib$get_vm_page (&buf_page, &buf_ptr);
	  buf_size = buf_page * 512;
/* if, for any reason we can't get memory, use a builtin fall back buffer */
	  if (!(status & 1)) {
		    buf_size = sizeof(fall_back_buffer);
		    buf_ptr  = fall_back_buffer;
		    }
	    inrab.rab$l_ubf = buf_ptr;
	    outrab.rab$l_rbf = buf_ptr;
	    inrab.rab$w_usz = buf_size;

          while (sys_read_noeof(&inrab)) {
            outrab.rab$w_rsz = inrab.rab$w_rsz;
            if (! ((status=sys$write(&outrab)) & 1)) {
              ret_stat = status;
              if (!bypass_signalling_errors)
                report_rms_error_routine(NEWS$_WRFAIL,status,&outrab,module_name_str,__LINE__);
              break;
              }
            }
          if (status == RMS$_EOF) status = SS$_NORMAL;
          ret_stat = status;
	if (buf_ptr != fall_back_buffer) {
	    lib$free_vm_page (
		&buf_page,
            	&buf_ptr);
	    }
          }
        sys_close(&outfab);
        }
      }
    sys_close(&infab);
    }
  return(ret_stat);
}

/*
 *  wild_match
 *
 *  String equality routine, including matching the '*' character.
 */

int wild_match(l,p)
    const char *l, *p;
{
    if (!*l) {
        if (!*p) return(1);
        else if (*p == '*') return(wild_match(l,p+1));
        else return(0);
        }
    if (*p == '*') {
        while (!wild_match(l,p+1)) {
            l++;
            if (!*l) {
                if (!*(p+1)) return(1);
                else return(0);
                }
            }
        return(1);
        }
    if ((*p == '%') || (*p == '?')) return(wild_match(l+1,p+1));
    if (*p == '\\') return((*l == *(p+1)) && wild_match(l+1,p+2));
    return((*l == *p) && wild_match(l+1,p+1));
}

/*
 *  cvt_date_val
 *
 *  Convert from VMS date format to unix integer date value
 */

int
cvt_date(vdate)
  int *vdate;
{
  int offset[2] = {0X4BEB4000, 0X007C9567},
      adjtim[2],
      divisor = 10000000,
      udate;

  if (vdate[1] < 0) {
    int now[2],
        then[2],
        len = 2;

    sys$gettim(now);
    lib$subx(now,vdate,then, &len);
    *vdate = *then;
    *(vdate + 1) = *(then + 1);
    }
  lib$subx(vdate, offset, adjtim, c$ac(2));
  lib$ediv(&divisor, adjtim, &udate, vdate);
  return(udate);
}

int cvt_date_val(str)
    char *str;
{
  char locstr[132],
       *l, *p;
  time_t ctime;
  struct tm *stm;
  int vdate[2];

  for (p=str, l=locstr;  *p;  p++, l++) *l = toupper(*p);
  *l = '\0';

  if (!strcmp(locstr,"TODAY")) {
    time(&ctime);
    stm = localtime(&ctime);
    return(ctime - (stm->tm_sec + (stm->tm_min * 60) + (stm->tm_hour * 3600)));
    }
  if (!strcmp(locstr,"YESTERDAY")) {
    time(&ctime);
    stm = localtime(&ctime);
    return(ctime - (stm->tm_sec + (stm->tm_min * 60) + (stm->tm_hour * 3600) + DAY_SECS));
    }
  if (!strcmp(locstr,"TOMORROW")) {
    time(&ctime);
    stm = localtime(&ctime);
    return(ctime - (stm->tm_sec + (stm->tm_min * 60) + (stm->tm_hour * 3600)) + DAY_SECS);
    }
  if (!(sys$bintim(c$dsc(locstr),vdate) & 1)) return(0);
  return(cvt_date(vdate));
}

/*
 *  parse_usenet_date
 *
 *  Convert a Unix date string to a time value.
 */

static const struct zone {
    const char *name;
    int offset;
 } zones[] = {
    {"GMT", 0},
    {"UT",  0},
    {"METDST", 2*60*60},
    {"CETDST", 2*60*60},
    {"MET",  1*60*60},
    {"CET",  1*60*60},
    {"EDT", -4*60*60},
    {"EST", -5*60*60},
    {"CDT", -5*60*60},
    {"CST", -6*60*60},
    {"MDT", -6*60*60},
    {"MST", -7*60*60},
    {"PDT", -7*60*60},
    {"PST", -8*60*60},
    {NULL, 0},
 };

/*
 * tz_convert
 *
 * Return number of seconds to be added to UTC
 * to obtain local time for a given timezone
 */

static int tz_convert(tz)
char *tz;
{
  const struct zone *z;
  int minutes, sign = 1;

  if ( ! *tz ) return (0);  /* assume GMT if nothing given */

  for (z=zones; z->name; z++)
    if (strcmp(z->name, tz) == 0) return(z->offset);

  if (*tz == '+')
    ++tz;
  else if (*tz == '-') {
    ++tz;
    sign = -1;
    }
  if ((!isdigit(*tz)) ||(strlen(tz) != 4))
    return (gmt_offset); /* Local Timezone Default */
  minutes = atoi(tz);
  return(sign*60*(60*(minutes/100) + minutes%100));
}

/*
 *  init_tz - determine local timeone and GMT offset from logicals
 */

void init_tz()
{
  char *gotenv, *cp;

  gotenv = news_getenv("NEWS_TIMEZONE",0);
  if (!gotenv) gotenv = news_getenv("PMDF_TIMEZONE",0);
#ifdef MULTINET
  if (!gotenv) gotenv = news_getenv("MULTINET_TIMEZONE",0);
#endif
#ifdef TWG
  if (!gotenv) gotenv = news_getenv("WIN$TIME_ZONE",0);
#endif
#ifdef TCPWARE
   if (!gotenv) gotenv = news_getenv("TCPWARE_TIMEZONE",0);
   if (gotenv && (strlen(gotenv) > 5)) gotenv[5] = '\0';
#endif
  if (!gotenv) strcpy(news_timezone,"GMT");
  else {
    strnncpy(news_timezone,news_timezone_m, gotenv,-1, 0);
    for (cp=news_timezone; *cp; cp++) *cp = toupper(*cp);
    }

  if ( (gotenv = news_getenv("NEWS_GMT_OFFSET",0)) ) {
    int sign = 1, hr, mn, se;

    blank_strip(gotenv);
    cp = gotenv;
    if (*cp == '-') {
      cp++;
      sign = -1;
      }
    if (*cp == '+') {
      cp++;
      sign = 1;
      }
    hr = mn = se = 0;
    if (sscanf(cp,"%d:%d:%d",&hr,&mn,&se) > 0) {
      gmt_offset = (60 * 60 * hr) + (60 * mn) + se;
      gmt_offset *= sign;
      }
    }
  else {
    char scratch[256], *cp2;

    cp = strnncpy(scratch,sizeof(scratch), news_timezone,-1, 0);
    for (;        isspace(*cp);  cp++)  {}
    for (cp2=cp; !isspace(*cp2); cp2++) {}
    *cp2 = '\0';
    gmt_offset = tz_convert(scratch);
    }

}  /*  end of init_tz()  */

int parse_usenet_date(s)
  const char *s;
{
  char *cp, mon[80], pdate[30], tz[80];
  int dom = 0, yr = 0, hr = 0, mn = 0, sc = 0, count;

  if (!s || !*s) return(0);
  if ((cp = strchr(s,',')) != 0) s = ++cp;
  while (isspace(*s)) s++;
  *mon = *tz = '\0';
  if (isdigit(*s)) {
    count = sscanf(s,"%d %s %d %d:%d:%d %s",&dom,mon,&yr,&hr,&mn,&sc,tz);
    /* correct if only last two year digits found - reggers@julian.uwo.ca, ake@dayton.saic.com */
    if (yr < 70) yr += 2000;
    if (yr < 100) yr += 1900;
    }
  else count = sscanf(s,"%*s %s %d %d:%d:%d %d %s",mon,&dom,&hr,&mn,&sc,&yr,tz);

  if (!dom || !yr || !*mon) return(0);
  if ((dom <= 0) || (dom >= 32)) return(0);
  if ((yr < 1989) || (yr > 2020)) return(0);
  if (strlen(mon) > 10) return(0);
  if ((hr < 0) || (hr > 23)) return(0);
  if ((mn < 0) || (mn > 59)) return(0);
  if ((sc < 0) || (sc > 59)) return(0);
  for (cp=mon; *cp; cp++) *cp = toupper(*cp);
  if (count == 5)
    if ((cp = strchr(s, ':')) != 0) sscanf(cp, ":%d %s", &mn, tz);

  sprintf(pdate,"%d-%s-%d %d:%d:%d",dom,mon,yr,hr,mn,sc);
  if ( getenv("SYS$LOCALTIME") )
    return(cvt_date_val(pdate) - tz_convert(tz));
  else
    return(cvt_date_val(pdate) + gmt_offset - tz_convert(tz));
}

/*
 *  parse_expiry_date
 *
 *  parse a usenet-format date into an expiry period (days)
 */

int parse_expiry_date(s)
  const char *s;
{
  int udate, cdate;

  if (!(udate = parse_usenet_date(s))) return(0);
  time((time_t *) &cdate);
  if (udate <= cdate) return(MIN_DAYS);
  udate = ((udate - cdate) / DAY_SECS) + 1;
  if (udate < MIN_DAYS) udate = MIN_DAYS;
  if (udate > MAX_DAYS) udate = MAX_DAYS;
  return(udate);
}

/*
 *  Delete all versions of a file.
 */
void delete_file_versions(fname)
  const char *fname;
{
  while (delete(fname) == 0) continue;
}

/*
 *  Truncate a string at the indicated character.
 */
char *chop_str(s,c)
  char *s;
  int c;
{
  char *p = strchr(s, c);
  if (p) *p = '\0';
  return p;
}

/*
 *  As above, but increment the return value.
 */
char *chop_str_plus(s,c)
  char *s;
  int c;
{
  char *p = strchr(s, c);
  if (p) *p++ = '\0';
  return p;
}


/* The _toupper and _tolower are defined as macros in ctype.h (with VAXC),
 * but the gcc does not define them (which is ok, as they are not ansi) -
 * - so we do it here:  */
#ifndef _toupper
#define _toupper(c)	((c) >= 'a' && (c) <= 'z' ? (c) & 0x5F : (c))
#endif
#ifndef _tolower
#define _tolower(c)	((c) >= 'A' && (c) <= 'Z' ? (c) | 0x20 : (c))
#endif

/*
 * news_strncasecmp - this is a mostly a vanilla strncasecmp, except that if
 * n == 0, it compares until it reaches the end of one string (i.e. behaves
 * like strcmp)
 */

int news_strncasecmp(cp1,cp2,n)
  const char *cp1,*cp2;
  int n;
{
  register int tmp, i;

  for (i=0;  *cp1;  i++, cp1++, cp2++) {
    if (!*cp2) return(1);
    tmp = _toupper(*cp1) - _toupper(*cp2);
    if (tmp) return(tmp);
    if (i+1 == n) return(0);
    }
  if (*cp2) return(-1);
  return(0);
}


/*
 *  news_getenv - translate a logical name, and return the equivalence string
 *                (return 0 if no translation or an error encountered)
 *                if systflag != 0, follow rules established in NewsSite.H
 *                for secure logical names.
 */

char *news_getenv(lognam,systflag) 
  const char *lognam;
  unsigned long int systflag;
{
  static char eqvstr[LNM$C_NAMLENGTH+1];
  char systbl[] = SECLNM_TABLE, alltbl[] = "LNM$FILE_DEV", *cp1, *cp2;
  unsigned char trnmode = SECLNM_MODE;
  unsigned long int attr = LNM$M_CASE_BLIND;
  unsigned short int retlen;
  struct dsc$descriptor_const_s tabdsc = {0, DSC$K_DTYPE_B, DSC$K_CLASS_S, 0},
                                lnmdsc = {0, DSC$K_DTYPE_B, DSC$K_CLASS_S, 0};
  struct itmlst { unsigned short  buflen;
                  unsigned short  itmcod;
                  void           *bufadr;
                  unsigned short *lenadr; }
    trnlst[2] = { {sizeof eqvstr, LNM$_STRING, eqvstr, &retlen}, {0,0,0,0} };

  lnmdsc.dsc$w_length = strlen(lognam);
  lnmdsc.dsc$a_pointer = lognam;

  if (systflag) {

    cp1 = systbl;
    do {
      cp2 = strchr(cp1,',');
      tabdsc.dsc$w_length = cp2 ? cp2 - cp1 : sizeof systbl - 1 + systbl - cp1;
      tabdsc.dsc$a_pointer = cp1;

      if (sys$trnlnm(&attr,&tabdsc,&lnmdsc,&trnmode,&trnlst) & 1) {
        eqvstr[retlen] = '\0';
        return eqvstr;
        }
    
      cp1 = cp2 + 1;
      } while (cp2);
#ifdef SECURE_LOGICALS
    return 0;
#endif
    }

  tabdsc.dsc$w_length = sizeof alltbl - 1;
  tabdsc.dsc$a_pointer = alltbl;
  if (sys$trnlnm(&attr,&tabdsc,&lnmdsc,0,&trnlst) & 1) {
    eqvstr[retlen] = '\0';
    return eqvstr;
    }
  return 0;
}


/*
 *  init_names - set up node name and address based on logicals
 */

void init_names()
{
  char *gotenv;

  *news_node = '\0';
  gotenv = news_getenv("NEWS_NODE",1);
#ifdef MULTINET
  if (!gotenv) gotenv = news_getenv("MULTINET_SMTP_HOST_NAME",1);
  if (!gotenv) gotenv = news_getenv("MULTINET_HOST_NAME",1);
#endif
#ifdef TCPWARE
  if (!gotenv) gotenv = news_getenv("TCPWARE_SMTP_FROM_DOMAIN",1);
  if (!gotenv) gotenv = news_getenv("TCPWARE_DOMAINNAME",1);
#endif
#ifdef TWG
  if (!gotenv) gotenv = news_getenv("ARPANET_HOST_NAME",1);
#endif
#ifdef UCX
  if (!gotenv) gotenv = news_getenv("UCX$INET_HOST",1);
#endif
  if (!gotenv) gotenv = news_getenv("INTERNET_HOST_NAME",1);
  if (!gotenv) gotenv = news_getenv("SYS$CLUSTER_NODE",1);
  if (!gotenv) gotenv = news_getenv("SYS$NODE",1);

  if (!gotenv) {
    printf("Can't determine node name (NEWS_NODE) - exiting\n");
    exit(1);
    }
  strnncpy(news_node,news_node_m, gotenv,-1, 0);
  lower_case(news_node);
  if ((gotenv = strchr(news_node,':')) != 0) *gotenv = '\0';

  *Node_address = '\0';
  gotenv = news_getenv("NEWS_ADDRESS",1);
  if (gotenv)
    lower_case(strnncpy(Node_address,Node_address_m, gotenv,-1, 0));
  else strnncpy(Node_address,Node_address_m, news_node,-1, 0);

  if ( (gotenv = news_getenv("NEWS_PATHNAME",1)) )
    lower_case(strnncpy(news_pathname,news_pathname_m, gotenv,-1, 0));
  else strnncpy(news_pathname,news_pathname_m, news_node,-1, 0);

}  /*  end of init_names()  */


#if SIMPLE_MALLOC
/* Memory management (simple alternative)
 *
 * News uses the memory management routines below instead of the C RTL
 * *alloc() and *free() routines. In general, you should use the routines
 * news_malloc(), news_calloc(), news_realloc(), and news_free()
 * to manage dynamic memory allocation in News, except under
 * extraordinary circumstances (see description below for more detail).
 *
 * The following are macros and are defined in NEWSDEFINE.H :
 *   news_malloc_raw(), news_cmalloc_raw(), news_realloc_raw()
 *   news_free_raw(), news_free()
 */

void *news_malloc(size)
  size_t size;
{ void *p;
  news_assert(size < MALLOC_SANITY_LIMIT);  /* sanity check */
  p = news_malloc_raw(size);
  if (!p) c$cks(LIB$_INSVIRMEM);
  return p;
}

void *news_calloc(numcells,cellsize)
  size_t numcells,cellsize;
{ void *p;
  news_assert(numcells*cellsize < MALLOC_SANITY_LIMIT);  /* sanity check */
  p = news_calloc_raw(numcells,cellsize);
  if (!p) c$cks(LIB$_INSVIRMEM);
  return p;
}

void *news_realloc(oldptr,newsize)
  void *oldptr;
  size_t newsize;
{ void *p;
  news_assert(oldptr != NULL);
  news_assert(newsize < MALLOC_SANITY_LIMIT);  /* sanity check */
  p = news_realloc_raw(oldptr,newsize);
  if (!p) c$cks(LIB$_INSVIRMEM);
  return p;
}

unsigned long int init_mem()
{ return(SS$_NORMAL); }
unsigned long int set_mem_ceiling()
{ return(SS$_NORMAL); }

#else
/* 
 * Memory management (normal alternative - with graceful failure handling)
 *
 * In order to provide some semblance of grace in low memory situations,
 * News uses the memory management routines below instead of the C RTL
 * *alloc() and *free() routines. In general, you should use the routines
 * news_malloc(), news_calloc(), news_realloc(), and news_free()
 * to manage dynamic memory allocation in News, except under
 * extraordinary circumstances (see description below for more detail).
 *
 * News memory allocation routines are built on lib$get_vm, and imitate the C
 * RTL allocation routines wrt calling sequence.  There are two sets of
 * routines:
 * 1. news_malloc_raw(), news_calloc_raw(), news_realloc_raw()
 *   These routines simply return NULL if they are unable to allocate
 *   the block of memory requested.
 * 2. news_malloc(), news_calloc(), news_realloc()
 *   If unable to allocate the block of memory requested, these routines
 *   will call mem_fail(), which is written specifically for each image
 *   (see general description below).
 *
 * You should use the _raw routines only when performing an operation which
 * cannot tolerate the action of mem_fail(), and should use the 'normal'
 * routines at all other times.
 *
 * There are two sets of deallocation routines as well:
 * 1. news_free_raw()
 * 2. news_free()
 * All of these routines are identical, and the different entry points are
 * provided only for consistency with the naming of the allocation routines.
 * Therefore, blocks of memory allocated with any of the allocation routines
 * can be deallocated by any of the deallocation routines.
 * The deallocation routines also check whether mem_reserve is below
 * its initial value (MEM_RESERVE_SIZE), in which case they won't cache any
 * deallocated blocks.  If this isn't the case, they will maintain a list
 * of the 10 largest blocks of freed memory whose size is less than the
 * constant MEM_CACHEMAX, for use in later calls to the alloc routines.
 *
 * These routines do not signal errors, but do set errno and vaxc$errno if
 * any system service or lib$ calls fail.  In general, you can depend on
 * the _raw routines not to signal errors, but the 'normal' routines may
 * be modified in the future to signal conditions, and the current version
 * of mem_fail() for News.Exe does so.
 *
 * In order to incorporate support for these routines into a new image,
 * do the following (in addition to including the routines themselves):
 *   o #define the C preprocessor constants
 *       MEM_RESERVE_SIZE - value of mem_reserve under normal circumstances
 *       MEM_CACHEMAX - largest size block of VM eligible for caching by
 *                      these routines when freed.  Cached blocks can be
 *                      used to satisfy future allocation requests, and
 *                      avoid the overhead of calls to lib$ routines.
 *       MEM_DYNAMIC_QUOTA - If true, then the remaining JPI$_PAGFILCNT is
 *                      obtained each time free memory is checked. If false,
 *                      this value is obtained only when you explicitly
 *                      call set_mem_ceiling().
 *     News does this in NewsSite.H.
 *   o Declare a global variable of type size_t named mem_reserve.  This
 *     will be set to the minimum amount of free virtual memory which
 *     must remain before the allocation routines will trigger a low memory
 *     response.
 *   o At image startup, call the routine init_mem().  This will set up the
 *     environment for the memory management routines.
 *   o If you have not #defined MEM_DYNAMIC_QUOTA to be true (necessary only
 *     if you expect another process to be consuming pagefile quota simul-
 *     taneously with this image), then call set_mem_ceiling() whenever you
 *     think it's likely another process has taken a chunk of pagefile quota
 *     (e.g. when returning to this process after attaching to a subprocess).
 *   o Include in your image a routine named mem_fail(), which will be called
 *     by the allocation routines when the remaining free memory would fall
 *     below mem_reserve if the memory were allocated.  This routine should
 *     be written for each application specifically (e.g. News.Exe, NNTP
 *     server), according to the following prototype:
 *       void *mem_fail(size_t size);
 *     size is the size (in bytes) of the block to be allocated.
 *     If mem_fail() can allocate a block of the specified size from some
 *     reserve, it should return the address of the block.  If it cannot,
 *     it should return NULL.  (Note that mem_fail() need not try to allocate
 *     memory; it may just perform whatever actions you deem appropriate in
 *     a low-memory situation, and then return NULL.  In fact, this is what
 *     all of the current instances of mem_fail() do.)
 */

/* number of longwords (used for housekeeping) stored immediately
   *before* the actual (user) memory block returned by news_*malloc* routines */
#define MEM_BLOCK_HEADER_L  3

#define MEM_REALSIZE_OFFSET	0  /* complete size of mem block, incl header */
#define MEM_USERSIZE_OFFSET	1  /* actual size requested by user */
#define MEM_CHECK_OFFSET	2  /* additional redundant word for checking */
#define MEM_CHECK_MAGIC 501793586  /* redundant word should contain:
                                      realsize + usersize + MEM_CHECK_MAGIC */
#define MEM_REALSIZE(userblock) \
  ( *((size_t *)(userblock) + (MEM_REALSIZE_OFFSET - MEM_BLOCK_HEADER_L)) )
#define MEM_USERSIZE(userblock) \
  ( *((size_t *)(userblock) + (MEM_USERSIZE_OFFSET - MEM_BLOCK_HEADER_L)) )
#define MEM_CHECK(userblock) \
  ( *((size_t *)(userblock) + (MEM_CHECK_OFFSET - MEM_BLOCK_HEADER_L)) )
#define MEM_COMPUTE_CHECK(userblock) \
  ( MEM_REALSIZE(userblock) + MEM_USERSIZE(userblock) + MEM_CHECK_MAGIC )

#if 0   /* set this to 1 to enable filling and checking the malloc-ed areas */
#define GUARD_L  9    /* malloc at least GUARD_L bytes beyond the requested size */
#define GUARD_CH '¨'  /* fill the unused portion of malloc-ed areas with this char */
#define FILL_CH  '§'  /* fill the malloc-ed user areas with this character */
#define VOID_CH  0x7E /* fill the free-ed user areas with this character */
#endif

static size_t __mem_quota;  /* max bytes VM avaliable to process */
static size_t *__mem_list[10];         /* list of cached free blocks */


#if MEM_CHECK_QUOTA

static unsigned long int showvm_parse_bytes(string,addr)
  struct dsc$descriptor_const_s *string;
  unsigned long int *addr;
{
  int j, n = 0;
  int s_l = string->dsc$w_length;
  const char *s = string->dsc$a_pointer;

  for (j = 0; j<s_l && isspace(*s); j++,s++);
  for (     ; j<s_l && isdigit(*s); j++,s++) n = 10*n + (*s - '0');
  *addr = n;
  return(SS$_NORMAL);

} /* end of showvm_parse_bytes() */


unsigned long int set_mem_ceiling()
{
  long int code = 3;
  size_t bytes;
  unsigned long int sts;
  IOSB_DEF iosb;
  struct {
    unsigned short buflen;
    unsigned short itmcod;
    void           *bufadr;
    unsigned short *retlen;
    } jpilst[2] = { {sizeof(__mem_quota), JPI$_PAGFILCNT, &__mem_quota, 0},
                    {0,0,0,0} };

  if (!((sts = sys$getjpiw(0,0,0,jpilst,&iosb,0,0)) & 1)) return(sts);
  if (!((sts = (int)iosb.status) & 1)) return(sts);
  __mem_quota *= 512;

  if (!((sts = lib$show_vm(&code,&showvm_parse_bytes,&bytes)) & 1))
    return(sts);
  __mem_quota += bytes;

   return(SS$_NORMAL);

}  /* end of set_mem_ceiling() */

#endif  /* MEM_CHECK_QUOTA */


unsigned long int init_mem()
{
  int status;

#if MEM_CHECK_QUOTA
  mem_reserve = MEM_RESERVE_SIZE;
#if !MEM_DYNAMIC_QUOTA
  _c$cks(set_mem_ceiling());
#endif  /* !MEM_DYNAMIC_QUOTA */
#endif  /* MEM_CHECK_QUOTA */

  return(SS$_NORMAL);
}  /* end of init_mem() */


void *news_malloc_raw(size)
  size_t size;
{
  size_t realsize, bytes, *userblock;
  register int i,j,sts;
  long int code = 3;

  news_assert(size < MALLOC_SANITY_LIMIT);  /* sanity check */

  realsize = size + MEM_BLOCK_HEADER_L * sizeof(size_t);
#ifdef GUARD_CH
  realsize += GUARD_L;
#endif

  for (i = 9; i >= 0; i--) {
    if (__mem_list[i] && (realsize <= *(__mem_list[i] + MEM_REALSIZE_OFFSET))) {
      userblock = __mem_list[i] + MEM_BLOCK_HEADER_L;
      news_assert(MEM_CHECK(userblock) == MEM_COMPUTE_CHECK(userblock));
      MEM_USERSIZE(userblock) = size;
      MEM_CHECK(userblock) = MEM_COMPUTE_CHECK(userblock);
      for (j = i; j < 9; j++) __mem_list[j] = __mem_list[j+1];
      __mem_list[9] = NULL;
#ifdef FILL_CH
      memset(userblock,FILL_CH,size);
#endif
#ifdef GUARD_CH
      memset(((char *)userblock) + size, GUARD_CH,
             (MEM_REALSIZE(userblock) - MEM_BLOCK_HEADER_L*sizeof(size_t))
             - size);
#endif
      return((void *)userblock);
      }
    }

#if MEM_CHECK_QUOTA
  if (!((sts = lib$show_vm(&code,&showvm_parse_bytes,&bytes)) & 1)) {
    set_errno(EVMSERR);
    set_vaxc_errno(sts);
    return(NULL);
    }
  if (
#if !MEM_DYNAMIC_QUOTA
       !__mem_quota &&
#endif
                        !((sts = set_mem_ceiling()) & 1)) {
    set_errno(EVMSERR);
    set_vaxc_errno(sts);
    return(NULL);
    }

  if (__mem_quota - bytes - realsize < mem_reserve) {
    set_errno(ENOMEM);
    return(NULL);
    }
#endif  /* MEM_CHECK_QUOTA */

  if ((sts = lib$get_vm(&realsize,&userblock,0)) & 1) {
    userblock += MEM_BLOCK_HEADER_L;
    MEM_REALSIZE(userblock) = realsize;
    MEM_USERSIZE(userblock) = size;
    MEM_CHECK(userblock) = MEM_COMPUTE_CHECK(userblock);
#ifdef FILL_CH
    memset(userblock,FILL_CH,size);
#endif
#ifdef GUARD_CH
    memset(((char *)userblock) + size, GUARD_CH,
           (realsize - MEM_BLOCK_HEADER_L*sizeof(size_t)) - size);
#endif
    return((void *)userblock);
    }
  else {
    set_errno(EVMSERR);
    set_vaxc_errno(sts);
    return(NULL);
    }

  return(NULL);  /* should not happen */
}  /* end of news_malloc_raw() */


void *news_malloc(size)
  size_t size;
{
  size_t *userblock;

  if ((userblock = (size_t *) news_malloc_raw(size)) == NULL) {
    size_t realsize;

    realsize = size + MEM_BLOCK_HEADER_L * sizeof(size_t);
    if ((userblock = (size_t *) mem_fail(realsize)) == NULL)
      return(NULL);
    userblock += MEM_BLOCK_HEADER_L;
    MEM_REALSIZE(userblock) = realsize;
    MEM_USERSIZE(userblock) = size;
    MEM_CHECK(userblock) = MEM_COMPUTE_CHECK(userblock);
    }
  return((void *)userblock);

}  /* end of news_malloc() */


void *news_calloc_raw(numcells,cellsize)
  size_t numcells,cellsize;
{
  size_t size;
  void *userblock;

  size = numcells * cellsize;
  if ((userblock = news_malloc_raw(size)) != NULL) memset(userblock,0,size);
  return(userblock);

}  /* end of news_calloc_raw() */


void *news_calloc(numcells,cellsize)
  size_t numcells,cellsize;
{
  size_t size;
  void *userblock;

  size = numcells * cellsize;
  if ((userblock = news_malloc(size)) != NULL) memset(userblock,0,size);
  return(userblock);

}  /* end of news_calloc() */

void *news_realloc_raw(oldptr,newsize)
  void *oldptr;
  size_t newsize;
{
  size_t oldsize;
  void *userblock;

  news_assert(MEM_CHECK(oldptr) == MEM_COMPUTE_CHECK(oldptr));
  if ((userblock = news_malloc_raw(newsize)) != NULL) {
    oldsize = MEM_USERSIZE(oldptr);
    memcpy(userblock,oldptr,min(oldsize,newsize));
    news_free_raw(oldptr);
    }
  return(userblock);

}  /*  end of news_realloc_raw()  */


void *news_realloc(oldptr,newsize)
  void *oldptr;
  size_t newsize;
{
  size_t oldsize;
  void *userblock;
 
  news_assert(MEM_CHECK(oldptr) == MEM_COMPUTE_CHECK(oldptr));
  if ((userblock = news_malloc(newsize)) != NULL) {
    oldsize = MEM_USERSIZE(oldptr);
    memcpy(userblock,oldptr,min(oldsize,newsize));
    news_free(oldptr);
    }
  return(userblock);

}  /*  end of news_realloc()  */


void news_free_raw(userblock)
  void *userblock;
{
  int i,j,sts;
  size_t size, realsize;
  size_t vm_size, *free_real_block;

  if (!userblock) return;                /* NULL is legal according to ANSI C */

  size     = MEM_USERSIZE(userblock);
  realsize = MEM_REALSIZE(userblock);

  if (!news_assert_nonfatal(MEM_CHECK(userblock) == MEM_COMPUTE_CHECK(userblock)))
    return /*1*/;         /* block not ok, report problem and skip freeing it */
  news_assert(size + MEM_BLOCK_HEADER_L * sizeof(size_t) <= realsize);
#ifdef GUARD_CH
  { int j,k, bad=0;
    k = MEM_REALSIZE(userblock) - MEM_BLOCK_HEADER_L*sizeof(size_t);
    for (j=MEM_USERSIZE(userblock); j<k; j++)
      if (((char *)userblock)[j] != GUARD_CH) { bad = 1; break; }
    news_assert_nonfatal(!bad);
  }
#endif
#ifdef VOID_CH
  memset(userblock,VOID_CH,size);
#endif
  free_real_block = (size_t *)userblock - MEM_BLOCK_HEADER_L;

  if (mem_reserve >= MEM_RESERVE_SIZE) {
    if (realsize <= MEM_CACHEMAX) {
      for (i = 0; i < 10; i++) {
        if (!__mem_list[i]) {
          __mem_list[i] = free_real_block;
          return /*1*/;
          }
        else if (realsize > *(__mem_list[i] + MEM_REALSIZE_OFFSET)) {
          free_real_block = __mem_list[9] ? __mem_list[9] : NULL;
          for (j = 8; j >= i; j--) __mem_list[j+1] = __mem_list[j];
          __mem_list[i] = (size_t *)userblock - MEM_BLOCK_HEADER_L;
          if (!free_real_block) return /*1*/;
          break;
          }
        }
      }
    }
  else {
    for (i = 0; i < 10; i++) {
      if (__mem_list[i]) {
        vm_size = *(__mem_list[i] + MEM_REALSIZE_OFFSET);
        lib$free_vm(&vm_size,&__mem_list[i],0);
        __mem_list[i] = NULL;
        }
      }
    }
    
  vm_size = *(free_real_block + MEM_REALSIZE_OFFSET);
  if (!((sts = lib$free_vm(&vm_size,&free_real_block,0)) & 1)) {
    set_errno(EVMSERR);
    set_vaxc_errno(sts);
    return /*0*/;
    }
  return /*1*/;

}  /* end of news_free_raw() */

#ifndef news_free
void news_free(ptr)
  void *ptr;
{
  return(news_free_raw(ptr));
}
#endif

#endif
