#ifndef lint
static char *RCSid = "$Id: funcs.c,v 1.14 1993/05/10 06:10:22 anders Exp anders $";
#endif

/*
 *  The Regina Rexx Interpreter
 *  Copyright (C) 1992-1994  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.
 */

#include "rexx.h"
#include <string.h>
#include <ctype.h>
#include <stdio.h>
#include <assert.h>
#include <time.h>

extern int IfcHaveFunctionExit(void);
/* 
 * Prototypes for the standard Rexx builtin functions 
 */
streng *std_abbrev( paramboxptr parms ) ;
streng *std_abs( paramboxptr parms ) ;
streng *std_address( paramboxptr parms ) ;
streng *std_arg( paramboxptr parms ) ;
streng *std_b2x( paramboxptr parms ) ;
streng *std_bitand( paramboxptr parms ) ;
streng *std_bitor( paramboxptr parms ) ;
streng *std_bitxor( paramboxptr parms ) ;
streng *std_c2d( paramboxptr parms ) ;
streng *std_c2x( paramboxptr parms ) ;
streng *std_center( paramboxptr parms ) ;
streng *std_changestr( paramboxptr parms ) ;            /* MH 10-06-96 */
streng *std_charin( paramboxptr parms ) ;
streng *std_charout( paramboxptr parms ) ;
streng *std_chars( paramboxptr parms ) ;
streng *std_compare( paramboxptr parms ) ;
streng *std_condition( paramboxptr parms ) ;
streng *std_copies( paramboxptr parms ) ;
streng *std_countstr( paramboxptr parms ) ;             /* MH 10-06-96 */
streng *std_d2c( paramboxptr parms ) ;
streng *std_d2x( paramboxptr parms ) ;
streng *std_datatype( paramboxptr parms ) ;
streng *std_date( paramboxptr parms ) ;
streng *std_delstr( paramboxptr parms ) ;
streng *std_delword( paramboxptr parms ) ;
streng *std_digits( paramboxptr parms ) ;
streng *std_errortext( paramboxptr parms ) ;
streng *std_form( paramboxptr parms ) ;
streng *std_format( paramboxptr parms ) ;
streng *std_fuzz( paramboxptr parms ) ;
streng *std_insert( paramboxptr parms ) ;
streng *std_lastpos( paramboxptr parms ) ;
streng *std_length( paramboxptr parms ) ;
streng *std_left( paramboxptr parms ) ;
streng *std_linein( paramboxptr parms ) ;
streng *std_lineout( paramboxptr parms ) ;
streng *std_lines( paramboxptr parms ) ;
streng *std_max( paramboxptr parms ) ;
streng *std_min( paramboxptr parms ) ;
streng *std_overlay( paramboxptr parms ) ;
streng *std_pos( paramboxptr parms ) ;
streng *std_queued( paramboxptr parms ) ;
streng *std_right( paramboxptr parms ) ;
streng *std_reverse( paramboxptr parms ) ;
streng *std_random( paramboxptr parms ) ;
streng *std_sign( paramboxptr parms ) ;
streng *std_sourceline( paramboxptr parms ) ;
streng *std_space( paramboxptr parms ) ;
streng *std_stream( paramboxptr parms ) ;
streng *std_strip( paramboxptr parms ) ;
streng *std_substr( paramboxptr parms ) ;
streng *std_subword( paramboxptr parms ) ;
streng *std_symbol( paramboxptr parms ) ;
streng *std_time( paramboxptr parms ) ;
streng *std_trace( paramboxptr parms ) ;
streng *std_translate( paramboxptr parms ) ;
streng *std_trunc( paramboxptr parms ) ;
streng *std_value( paramboxptr parms ) ;
streng *std_verify( paramboxptr parms ) ;
streng *std_word( paramboxptr parms ) ;
streng *std_wordindex( paramboxptr parms ) ;
streng *std_wordlength( paramboxptr parms ) ;
streng *std_wordpos( paramboxptr parms ) ;
streng *std_words( paramboxptr parms ) ;
streng *std_x2b( paramboxptr parms ) ;
streng *std_x2c( paramboxptr parms ) ;
streng *std_x2d( paramboxptr parms ) ;
streng *std_xrange( paramboxptr parms ) ;

/*
 * Extra builtins in Regina, used for debugging purposes, and not 
 * available when compiling without debugging support.
 */
#ifndef NDEBUG
#ifdef TRACEMEM
streng *dbg_allocated( paramboxptr parms ) ;
#endif
streng *dbg_dumpvars( paramboxptr parms ) ;
streng *dbg_dumptree( paramboxptr parms ) ;
streng *dbg_traceback( paramboxptr parms ) ;     
streng *dbg_dumpfiles( paramboxptr parms ) ;
#ifdef TRACEMEM
streng *dbg_listleaked( paramboxptr parms ) ;
streng *dbg_memorystats( paramboxptr parms ) ;    
#endif /* TRACEMEM */
#endif /* !NDEBUG */

/*
 * Extra builtin, intended to give CMS compatibility support
 */
streng *cms_find( paramboxptr parms ) ;
streng *cms_index( paramboxptr parms ) ;
streng *cms_justify( paramboxptr parms ) ;
streng *cms_sleep( paramboxptr parms ) ;
streng *cms_state( paramboxptr parms ) ;
streng *cms_makebuf( paramboxptr parms ) ;
streng *cms_dropbuf( paramboxptr parms ) ;
streng *cms_desbuf( paramboxptr parms ) ;
streng *cms_buftype( paramboxptr parms ) ;

/*
 * Extra builtins in Regina
 */
streng *rex_userid( paramboxptr parms ) ;
streng *rex_rxfuncadd( paramboxptr parms ) ;
streng *rex_rxfuncdrop( paramboxptr parms ) ;
streng *rex_rxfuncquery( paramboxptr parms ) ;
streng *rex_rxfuncerrmsg( paramboxptr parms ) ;

/*
 * Extra builtins, intended for VMS lexical function compatibility. 
 */
#ifdef VAXC
streng *vms_f_cvsi( paramboxptr parms ) ; 
streng *vms_f_cvtime( paramboxptr parms ) ; 
streng *vms_f_cvui( paramboxptr parms ) ; 
streng *vms_f_directory( paramboxptr parms ) ;
streng *vms_f_edit( paramboxptr parms ) ; 
streng *vms_f_element( paramboxptr parms ) ; 
/* streng *vms_f_environment( paramboxptr parms ) ; */
streng *vms_f_extract( paramboxptr parms ) ;
streng *vms_f_fao( paramboxptr parms ) ;
streng *vms_f_file_attributes( paramboxptr parms ) ; 
streng *vms_f_getdvi( paramboxptr parms ) ;
streng *vms_f_getjpi( paramboxptr parms ) ;
streng *vms_f_getqui( paramboxptr parms ) ;
streng *vms_f_getsyi( paramboxptr parms ) ;
streng *vms_f_identifier( paramboxptr parms ) ;
streng *vms_f_integer( paramboxptr parms ) ;
streng *vms_f_length( paramboxptr parms ) ;
streng *vms_f_locate( paramboxptr parms ) ;
streng *vms_f_logical( paramboxptr parms ) ; 
streng *vms_f_message( paramboxptr parms ) ;
streng *vms_f_mode( paramboxptr parms ) ;
streng *vms_f_parse( paramboxptr parms ) ; 
streng *vms_f_pid( paramboxptr parms ) ;
streng *vms_f_privilege( paramboxptr parms ) ;
streng *vms_f_process( paramboxptr parms ) ;
streng *vms_f_search( paramboxptr parms ) ; 
streng *vms_f_setprv( paramboxptr parms ) ;
streng *vms_f_string( paramboxptr parms ) ;
streng *vms_f_time( paramboxptr parms ) ;
streng *vms_f_trnlnm( paramboxptr parms ) ;
streng *vms_f_type( paramboxptr parms ) ; 
streng *vms_f_user( paramboxptr parms ) ; 
/* streng *vms_f_verify( paramboxptr parms ) ; */
#endif

/*
 * Extra builtin functions, giving Unix compatibility
 */
streng *unx_getenv( paramboxptr parms ) ;
streng *unx_getpath( paramboxptr parms ) ;  /* not working ... */
streng *unx_chdir( paramboxptr parms ) ;
streng *unx_unixerror( paramboxptr parms ) ;
streng *unx_eof( paramboxptr parms ) ;
streng *unx_popen( paramboxptr parms ) ;
streng *unx_getpid( paramboxptr parms ) ;     
streng *unx_fork( paramboxptr parms ) ;
streng *unx_uname( paramboxptr parms ) ;
#ifdef OLD_REGINA_FEATURES
streng *unx_open( paramboxptr parms ) ;
streng *unx_close( paramboxptr parms ) ;
#endif

struct function_type
{
   int length ;
   streng *(*function)() ;
   char *funcname ; 
} ;

struct function_type functions[] = {
      { 0,			std_abbrev, "ABBREV" },     
      { 0,			std_abs, "ABS" }, 
      { 0,			std_address, "ADDRESS" }, 
#ifdef TRACEMEM
      { 0,			dbg_allocated, "ALLOCATED" },
#endif
      { 0,			std_arg, "ARG" },    
      { 0,			std_b2x, "B2X" },
      { 0,			std_bitand, "BITAND" },  
      { 0,			std_bitor, "BITOR" },  
      { 0,			std_bitxor, "BITXOR" }, 
      { EXT_BUFTYPE_BIF,	cms_buftype, "BUFTYPE" },
      { 0,			std_c2d, "C2D" },     
      { 0,			std_c2x, "C2X" },
      { 0,			unx_chdir, "CD" },
      { 0,			std_center, "CENTER" },
      { 0,			std_center, "CENTRE" },  
      { 0,			std_changestr, "CHANGESTR" }, /* ANSI Std 1996 - MH 10-06-96 */
      { 0,			std_charin, "CHARIN" }, 
      { 0,			std_charout, "CHAROUT" }, 
      { 0,			std_chars, "CHARS" }, 
      { 0,			unx_chdir, "CHDIR" },
#ifdef OLD_REGINA_FEATURES
      { 0,			unx_close, "CLOSE" },
#endif
      { 0,			std_compare, "COMPARE" },
      { 0,			std_condition, "CONDITION" },
      { 0,			std_copies, "COPIES" }, 
      { 0,			std_countstr, "COUNTSTR" },   /* ANSI Std 1996 - MH 10-06-96 */
      { 0,			std_d2c, "D2C" },
      { 0,			std_d2x, "D2X" },
      { 0,			std_datatype, "DATATYPE" },
      { 0,			std_date, "DATE" },   
      { 0,			std_delstr, "DELSTR" },
      { 0,			std_delword, "DELWORD" }, 
      { EXT_DESBUF_BIF,		cms_desbuf, "DESBUF" },
      { 0,			std_digits, "DIGITS" }, 
      { EXT_DROPBUF_BIF,	cms_dropbuf, "DROPBUF" },
#ifndef NDEBUG
      { 0,			dbg_dumpfiles, "DUMPFILES" },
      { 0,			dbg_dumptree, "DUMPTREE" },
      { 0,			dbg_dumpvars, "DUMPVARS" },
#endif
      { 0,			unx_eof, "EOF" },
      { 0,			std_errortext, "ERRORTEXT" },
#ifdef VAXC
      { 0,			vms_f_cvsi, "F$CVSI" },
      { 0,			vms_f_cvtime, "F$CVTIME" },
      { 0,			vms_f_cvui, "F$CVUI" },
      { 0,			vms_f_directory, "F$DIRECTORY" },
      { 0,			vms_f_element, "F$ELEMENT" },
      { 0,			vms_f_extract, "F$EXTRACT" },
      { 0,			vms_f_fao, "F$FAO" },
      { 0,			vms_f_file_attributes, "F$FILE_ATTRIBUTES" },
      { 0,			vms_f_getdvi, "F$GETDVI" },
      { 0,			vms_f_getjpi, "F$GETJPI" },
      { 0,			vms_f_getqui, "F$GETQUI" },
      { 0,			vms_f_getsyi, "F$GETSYI" },
      { 0,			vms_f_identifier, "F$IDENTIFIER" },
      { 0,			vms_f_integer, "F$INTEGER" },
      { 0,			vms_f_length, "F$LENGTH" },
      { 0,			vms_f_locate, "F$LOCATE" },
      { 0,			vms_f_logical, "F$LOGICAL" },
      { 0,			vms_f_message, "F$MESSAGE" },
      { 0,			vms_f_mode, "F$MODE" },
      { 0,			vms_f_parse, "F$PARSE" },
      { 0,			vms_f_pid, "F$PID" },
      { 0,			vms_f_privilege, "F$PRIVILEGE" },
      { 0,			vms_f_process, "F$PROCESS" },
      { 0,			vms_f_search, "F$SEARCH" },
      { 0,			vms_f_setprv, "F$SETPRV" },
      { 0,			vms_f_string, "F$STRING" },
      { 0,			vms_f_time, "F$TIME" },
      { 0,			vms_f_trnlnm, "F$TRNLNM" },
      { 0,			vms_f_type, "F$TYPE" },
      { 0,			vms_f_user, "F$USER" },
/*    { 0,			vms_f_verify, "F$VERIFY" }, */
#endif
      { EXT_FIND_BIF,		cms_find, "FIND" },
#ifdef OLD_REGINA_FEATURES
      { 0,			unx_close, "FINIS" },
#endif /* OLD_REGINA_FEATURES */
      { 0,			unx_fork, "FORK" },
      { 0,			std_form, "FORM" }, 
      { 0,			std_format, "FORMAT" },
      { 0,			std_fuzz, "FUZZ" }, 
      { 0,			unx_getenv, "GETENV" }, 
      { 0,			unx_getpath, "GETPATH" },
      { 0,			unx_getpid, "GETPID" },
      { 0,			cms_index, "INDEX" },
      { 0,			std_insert, "INSERT" },
      { 0,			cms_justify, "JUSTIFY" },
      { 0,			std_lastpos, "LASTPOS" }, 
      { 0,			std_left, "LEFT" },
      { 0,			std_length, "LENGTH" },
      { 0,			std_linein, "LINEIN" },
      { 0,			std_lineout, "LINEOUT" },
      { 0,			std_lines, "LINES" },
#ifdef TRACEMEM
      { 0,			dbg_listleaked, "LISTLEAKED" },
#endif
      { EXT_MAKEBUF_BIF,	cms_makebuf, "MAKEBUF" },
      { 0,			std_max, "MAX" },
#ifdef TRACEMEM
      { 0,			dbg_memorystats, "MEMORYSTATS" },
#endif
      { 0,			std_min, "MIN" },
#ifdef OLD_REGINA_FEATURES
      { EXT_OPEN_BIF,	unx_open, "OPEN" },
#endif /* OLD_REGINA_FEATURES */
      { 0,			std_overlay, "OVERLAY" },
      { 0,			unx_popen, "POPEN" },
      { 0,			std_pos, "POS" }, 
      { 0,			std_queued, "QUEUED" }, 
      { 0,			std_random, "RANDOM" }, 
      { 0,			std_reverse, "REVERSE" }, 
      { 0,			std_right, "RIGHT" }, 

      { 0,			rex_rxfuncadd, "RXFUNCADD" },
      { 0,			rex_rxfuncdrop, "RXFUNCDROP" },
      { 0,			rex_rxfuncerrmsg, "RXFUNCERRMSG" },
      { 0,			rex_rxfuncquery, "RXFUNCQUERY" },

      { 0,			std_sign, "SIGN" },
      { 0,			cms_sleep, "SLEEP" },
      { 0,			std_sourceline, "SOURCELINE" },
      { 0,			std_space, "SPACE" },
      { 0,			cms_state, "STATE" },
      { 0,			std_stream, "STREAM" }, 
      { 0,			std_strip, "STRIP" },
      { 0,			std_substr, "SUBSTR" },
      { 0,			std_subword, "SUBWORD" },
      { 0,			std_symbol, "SYMBOL" }, 
      { 0,			std_time, "TIME" },
      { 0,			std_trace, "TRACE" },
#ifndef NDEBUG
      { 0,			dbg_traceback, "TRACEBACK" },
#endif
      { 0,			std_translate, "TRANSLATE" },
      { 0,			std_trunc, "TRUNC" }, 
      { 0,                      unx_uname, "UNAME" },
      { 0,			unx_unixerror, "UNIXERROR" },
      { 0,			rex_userid, "USERID" },
      { 0,			std_value, "VALUE" }, 
      { 0,			std_verify, "VERIFY" }, 
      { 0,			std_word, "WORD" },
      { 0,			std_wordindex, "WORDINDEX" }, 
      { 0,			std_wordlength, "WORDLENGTH" }, 
      { 0,			std_wordpos, "WORDPOS" }, 
      { 0,			std_words, "WORDS" },
      { 0,			std_x2b, "X2B" },
      { 0,			std_x2c, "X2C" },
      { 0,			std_x2d, "X2D" },
      { 0,			std_xrange, "XRANGE" },
      { 0,			NULL, NULL } 
} ;

static int num_funcs = sizeof(functions)/(sizeof(struct function_type)) - 1 ;


#ifdef TRACEMEM
static paramboxptr listleaked_params ;

void mark_listleaked_params()
{
   extern paramboxptr listleaked_params ;
   paramboxptr pptr=NULL ;

   for (pptr=listleaked_params; pptr; pptr=pptr->next) 
   {
      markmemory( pptr, TRC_PROCARG ) ;
      if (pptr->value) 
         markmemory( pptr->value, TRC_PROCARG ) ;
   }
}
#endif


streng nofunc = { 1, 1, "" } ;
   
streng *buildtinfunc( nodeptr this ) 
{
   static paramboxptr first=NULL ;
   int low=0, topp=0, mid=0, end=1, up=num_funcs-1, i=0 ;
   streng *ptr=NULL ;
   int ext=0 ;
   void *vptr=NULL ;
   streng *(*func)(paramboxptr)=NULL ;
   streng *upper_name=Str_upper(Str_dup(this->name));

   /*
    * Look for a function registered in a DLL
    */
   vptr = loaded_lib_func( ( upper_name ) ) ;
   if (vptr)
      func = std_center ; /* e.g. */

   Free_string( upper_name );

   /*
    * If no function registered in a DLL, look for one in the
    * current EXE
    */
   if (!func)
   {
      ext = external_func( this->name ) ;
      if (ext)
         func = std_center ; /* e.g. */
   }

   /*
    * If no function registered in a DLL or EXE, look for a builtin
    */
   if (!func)
   {
      topp = Str_len( this->name ) ;

      if (this->u.func) 
         func = this->u.func ;
      else
      {
         mid = 0 ;  /* to keep the compiler happy */
         while ((end)&&(up>=low)) 
         {
            mid = (up+low)/2 ;
            for (i=0; i<topp; i++ )
               if (this->name->value[i] != functions[mid].funcname[i]) 
                  break ;

            if (i==topp) 
               end = (functions[mid].funcname[i]!=0x00) ;
            else
               end = ( functions[mid].funcname[i] - this->name->value[i] ) ;

            if (end>0) 
               up = mid-1 ;
            else 
               low = mid+1 ; 
         }
         if (!end)
         {
            if (functions[mid].length)
            {
               int obyte = functions[mid].length/(sizeof(unsigned char)*8) ;
               int obit = functions[mid].length%(sizeof(unsigned char)*8) ;
   
               if (!(currlevel->u.flags[obyte] & (1<<(7-obit))))
                  func = NULL ;
               else
               {
                  func = functions[mid].function ;
                  if (currlevel->u.options.cacheext)
                     this->u.func = func ;
               }
            }
            else
               this->u.func = func = functions[mid].function ;
         }
      }
   }

   if (func)
   {
      if (first)
         deallocplink( first ) ;
      
      first = initplist( this ) ;
      if (ext)
         ptr = do_an_external( this->name, first, 0, this->called) ;
      else if (vptr)
         ptr = do_an_external_dll( vptr, first, this->called ) ;
      else
         ptr = (*func)(first /* ->next */ ) ;

      deallocplink( first ) ;
      first = NULL ;
      return ptr ;
   }
   else
   {
    if (IfcHaveFunctionExit()) /* we have an exit handler */
      {
       if (first)
          deallocplink( first ) ;
      
       first = initplist( this ) ;
       ptr = do_an_external( this->name, first, 1, this->called ) ;
       deallocplink( first ) ;
       first = NULL ;
      }
    else
      return &nofunc ;
   }
   /* add return to keep compiler happy. won't ever reach here */
   return NULL;
}


paramboxptr par_stack = NULL ;


paramboxptr initplist( nodeptr this )
{
#ifdef TRACEMEM
   extern paramboxptr listleaked_params ;
#endif
   paramboxptr first=NULL, new=NULL, currnt=NULL ;
   streng *pptr=NULL ;
   streng *junk=NULL ;

   first = currnt = NULL ;
   for (this=this->p[0]; this; this=this->p[1])
   {
      if (par_stack)
      {
         new = par_stack ;
         par_stack = new->next ;
      }
      else
         new = Malloc( sizeof( parambox )) ;

      if (!first)
         first = currnt = new ;
      else
      {
         currnt->next = new ;
         currnt = new ;
      }

      if (this->type==X_CEXPRLIST && trace_stat!='I')
      {
         if (this->u.strng)
            pptr = this->u.strng ;
         else
            pptr = NULL ;

         currnt->dealloc = 0 ;
      }
      else
      {
         currnt->dealloc = 1 ;
         if (this->p[0])
            pptr = evaluate( this->p[0], &junk ) ;
         else
            pptr = NULL ;

         if (!junk)
/*            pptr = Str_dup( pptr ) ; */
            currnt->dealloc = 0 ;
      }

      currnt->value = pptr ;
   }
#ifdef TRACEMEM
   listleaked_params = first ;
#endif
   currnt->next = NULL ;
   return first ;
}


void deallocplink( paramboxptr first ) 
{
   paramboxptr this=NULL ;

   for (;first;)
   {
      this = first ;
      first = first->next ;
      if (this->dealloc && this->value) 
         Free_string( this->value ) ;

      this->next = par_stack ;
      par_stack = this ;
   }
}


#ifdef TRACEMEM
void mark_param_cache()
{
   paramboxptr ptr=NULL ;
  
   ptr = par_stack ;
   for (; ptr; ptr=ptr->next ) 
      markmemory( ptr, TRC_P_CACHE ) ;
}
#endif



int myatol( streng *text )
{
   int *num=NULL ;

   num = streng_to_int( text ) ;
   if (num==NULL) 
       exiterror( ERR_INVALID_INTEGER, 0 )  ;
   
   return *num ;
}


int atozpos( streng *text )
{ 
   int result=0 ;

   if ((result=myatol(text))<0)
       exiterror( ERR_INCORRECT_CALL, 0 )  ;

   return result ;
}


char getoptionchar( streng *text, char *choices ) 
{
   char ch=' ' ;

   if (text->len==0) 
       return 0;
   
   ch = toupper( text->value[0] ) ;

   for (; *choices; choices++) 
      if (*choices==ch)
         return ch ;

   return 0 ;
}


char getonechar( streng *text )
{
   if ((!text)||(Str_len(text)!=1))
       exiterror( ERR_INCORRECT_CALL, 0 )  ;
   
   return text->value[0] ;
}

int atopos( streng *text )
{ 
   int result=0 ;

   if ((result=myatol(text))<=0)
       exiterror( ERR_INCORRECT_CALL, 0 )  ;

   return result ;
}



streng *int_to_streng( int input )
{
   streng *output=NULL ;
   char *cptr=NULL, *start=NULL, *top=NULL ;

   output = Str_make( sizeof(int)*3 + 2 ) ;
   start = output->value ;
   cptr = start + sizeof(int)*3 + 2 ;
   if (input)
   {
      if (input<0)
      {
         input = - input ;
         *(start++) = '-' ;
      } 

      for (top=cptr;input;)
      {
         *(--cptr) = input % 10 + '0' ;
         input = input / 10 ;
      }

      memmove( start, cptr, top-cptr ) ;
      output->len = top-cptr + start-output->value ;
   }
   else
   {
      *start = '0' ;
      output->len = 1 ;
   }

   return output ;
}


void checkparam( paramboxptr params, int min, int max, char *name )
{
   int i=0 ;

   for (i=0;i<min;i++,params=params->next)
      if ((!params)||(!params->value)) 
          exiterror( ERR_INCORRECT_CALL, 3, name, min )  ;

   for (;(i<max)&&(params);i++,params=params->next) ;
   if (((i==max)&&(params))&&((max)||(params->value)))
       exiterror( ERR_INCORRECT_CALL, 4, name, max )  ;
}
   

streng *cpy( streng *source )
{
   return Str_dup( source ) ;
}


streng *param( paramboxptr ptr, int num )
{
   int i=0 ;
   for (i=1;i<num;i++,ptr=ptr->next) 
      if (!ptr)
          exiterror( ERR_INTERPRETER_FAILURE, 0 )  ;

   return ((ptr)&&(ptr->value)) ? ptr->value : NULL ;
}

char getoption( streng *test ) 
{ 
   if ((!test)||(!Str_len(test)))
      return 0x00 ;
  
   return toupper(test->value[0]) ; 
}

/*
 * These functions are rather ugly, but they works :-)
 */
/*
 * Converts a date supplied in an external format (specified by suppformat)
 * into a struct tm (individual values for year, month, day, year_days and
 * base days).
 */
int convert_date(streng *suppdate, char suppformat, void *conv_tmdata)
{
 extern char *months[];
 extern int DaysInYear[];
 extern int MonthDays[];

 struct tm *indate=(struct tm *)conv_tmdata;
 int rc=0,i=0,off=0;
 long num1=0,num2=0,num3=0;
 char buf[20];
 char *ptr=suppdate->value;

 switch(suppformat)
   {
    case 'B':
         memcpy(buf,ptr,suppdate->len);
         buf[suppdate->len] = '\0';
         if ((num1 = atol(buf)) == 0)
           {
            for (i=0;i<suppdate->len;i++)
              if (buf[i] != '0')
                 return(1);
           }
         base2date(num1,indate);
         break;
    case 'D':
         memcpy(buf,ptr,suppdate->len);
         buf[suppdate->len] = '\0';
         if ((num1 = atol(buf)) == 0)
           {
            for (i=0;i<suppdate->len;i++)
              if (buf[i] != '0')
                 return(1);
           }
         base2date(num1+basedays(indate->tm_year)-1,indate);
         break;
    case 'E':
    case 'O':
    case 'U':
         if (suppdate->len != 8)
            return(1);
         if (*(ptr+2) != '/'
         &&  *(ptr+5) != '/')
            return( 1 );
         memcpy(buf,ptr,2);
         buf[2] = '\0';
         if ( !isdigit( buf[0] ) || !isdigit( buf[1] ) )
            return( 1 );
         num1 = atol( buf );
         memcpy(buf,(ptr+3),2);
         buf[2] = '\0';
         if ( !isdigit( buf[0] ) || !isdigit( buf[1] ) )
            return( 1 );
         num2 = atol( buf );
         memcpy(buf,(ptr+6),2);
         buf[2] = '\0';
         if ( !isdigit( buf[0] ) || !isdigit( buf[1] ) )
            return( 1 );
         num3 = atol( buf );
         switch(suppformat)
           {
            case 'E':
                 if ( num1 == 0 || num2 == 0 )
                    return( 1 );
                 indate->tm_mday = num1;
                 indate->tm_mon = num2-1;
                 indate->tm_year = num3;
                 break;
            case 'O':
                 if ( num3 == 0 || num2 == 0 )
                    return( 1 );
                 indate->tm_mday = num3;
                 indate->tm_mon = num2-1;
                 indate->tm_year = num1;
                 break;
            case 'U':
                 if ( num2 == 0 || num1 == 0 )
                    return( 1 );
                 indate->tm_mday = num2;
                 indate->tm_mon = num1-1;
                 indate->tm_year = num3;
                 break;
           }
         if (indate->tm_year < 100)   /* do something with century ... */
            indate->tm_year += (indate->tm_year < 50) ? 2000 : 1900;
         break;
    case 'N':
         if (suppdate->len != 11
         &&  suppdate->len != 10)
            return(1);
         if (suppdate->len == 10)
            off = 1;
         if (*(ptr+2-off) != ' '
         &&  *(ptr+6-off) != ' ')
            return(1);
         memcpy(buf,ptr,2-off);
         buf[2-off] = '\0';
         if ((num1 = atol(buf)) == 0)
            return(1);
         memcpy(buf,(ptr+3-off),3);
         buf[3] = '\0';
         /* find month */
         num2 = (-1);
         for (i=0;i<11;i++)
           {
            if (strncmp(months[i],buf,3) == 0)
               num2 = i;
           }
         if (num2 == (-1))
            return(1);
         memcpy(buf,(ptr+7-off),4);
         buf[4] = '\0';
         if ((num3 = atol(buf)) == 0
         &&  strcmp("0000",buf) != 0)
            return(1);
         indate->tm_mday = num1;
         indate->tm_mon = num2;
         indate->tm_year = num3;
         break;
    case 'S':
         if (suppdate->len != 8)
            return(1);
         memcpy(buf,ptr,4);
         buf[4] = '\0';
         if ((num1 = atol(buf)) == 0)
            return(1);
         memcpy(buf,(ptr+4),2);
         buf[2] = '\0';
         if ((num2 = atol(buf)) == 0)
            return(1);
         memcpy(buf,(ptr+6),2);
         buf[2] = '\0';
         if ((num3 = atol(buf)) == 0)
            return(1);
         indate->tm_mday = num3;
         indate->tm_mon = num2-1;
         indate->tm_year = num1;
         break;
    default:
         exiterror( ERR_INCORRECT_CALL, 0 ) ;
         break;
   }
 if (indate->tm_mday > MonthDays[indate->tm_mon] + leapyear(indate->tm_year)
 ||  indate->tm_mday < 1
 ||  indate->tm_mon > 11
 ||  indate->tm_mon < 0
 ||  indate->tm_year < 0)
    return(1);

 indate->tm_yday = DaysInYear[indate->tm_mon]+
                   ((leapyear(indate->tm_year)&&indate->tm_mon>1)?1:0)+
                   indate->tm_mday - 1;
 indate->tm_wday = (((indate->tm_yday+basedays(indate->tm_year))+8) % 7);
 return(rc);
}

/*
 * Converts a year (MUST have century) to a number of days
 * Base year is 0001 - hence the date 01 Jan 0001 is base day 1
 */
int basedays(int year)
{
 return((year-1)*365 + (year-1)/4 - (year-1)/100 + (year-1)/400);
}

/*
 * Determines if a year (MUST have a century) is a leap year
 */
int leapyear(long year)
{
 if (year%4 == 0 && year%100 != 0 || year%400 == 0)
    return(1);
 else
    return(0);
}

/*
 * Converts a number (representing the number of days since 01 Jan 0001)
 * to a struct tm value (individual fields for year, month, day and days in year)
 */
int base2date(long basedate,void *conv_tmdata)
{
 extern int MonthDays[];
 struct tm *outdate=(struct tm *)conv_tmdata;
 int i=0;
 long day=0L,year=0L,month=0L,yeardays=0L,thismonth=0L;

 day = basedate + 1L;
 year = day / 366;
 day -= ((year*365) + (year/4) - (year/100) + (year/400));
 year++;
 while (day > (365 + leapyear(year)))
   {
    day -= (365 + leapyear(year));
    year++;
   }

 yeardays = day;
 for (i=0;i<11;i++)
   {
    thismonth = (MonthDays[i]) + ((i == 1) ? leapyear(year) : 0);
    if (day <= thismonth)
       break;
    day -= thismonth;
   }
 month = i;
 outdate->tm_year = year;
 outdate->tm_mon = month;
 outdate->tm_mday = day;
 outdate->tm_yday = yeardays;
 outdate->tm_wday = ((basedate+8) % 7);
 return(0);
}

/*
 * Converts a time supplied in an external format (specified by suppformat)
 * into a struct tm (individual values for hour, minute, second).
 */
int convert_time(streng *supptime, char suppformat, void *conv_tmdata,void *inunow)
{
 struct tm *intime=(struct tm *)conv_tmdata;
 int rc=0,i=0;
 long num1=0,num2=0,num3=0,num4=0;
 char buf[20];
 char *ptr=supptime->value;
 time_t *unow=(time_t *)inunow;

 switch(suppformat)
   {
    case 'C':
         if (*(ptr+2) != ':')
            return(1);
         if (memcmp("am",ptr+5,2) != 0
         &&  memcmp("pm",ptr+5,2) != 0)
            return(1);
         memcpy(buf,ptr,2);
         buf[2] = '\0';
         if ((num1 = atol(buf)) == 0
         && strcmp("00",buf) != 0)
            return(1);
         if (num1 > 12)
            return(1);
         memcpy(buf,ptr+3,2);
         buf[2] = '\0';
         if ((num2 = atol(buf)) == 0
         && strcmp("00",buf) != 0)
            return(1);
         if (num2 > 59)
            return(1);
         intime->tm_sec = 0;
         if (memcmp("am",ptr+5,2)==0)
           {
            if (num1 == 12)
               intime->tm_hour = 0;
            else
               intime->tm_hour = num1;
           }
         else
           {
            if (num1 == 12)
               intime->tm_hour = num1;
            else
               intime->tm_hour = num1+12;
           }
         intime->tm_min = num2;
         *unow = 0;
         break;
    case 'H':
    case 'M':
    case 'S':
         memcpy(buf,ptr,supptime->len);
         buf[supptime->len] = '\0';
         if ((num1 = atol(buf)) == 0)
           {
            for (i=0;i<supptime->len;i++)
              if (buf[i] != '0')
                 return(1);
           }
         switch(suppformat)
           {
            case 'H':
                 intime->tm_hour = num1;
                 intime->tm_min = intime->tm_sec = 0;
                 break;
            case 'M':
                 intime->tm_hour = num1 / 60;
                 intime->tm_min = num1 % 60;
                 intime->tm_sec = 0;
                 break;
            case 'S':
                 intime->tm_hour = num1 / 3600;
                 intime->tm_min = (num1 % 3600) / 60;
                 intime->tm_sec = (num1 % 3600) % 60;
                 break;
           }
         if (intime->tm_sec > 59
         ||  intime->tm_hour > 23
         ||  intime->tm_min > 59)
            return(1);
         *unow = 0;
         break;
    case 'L':
    case 'N':
         if (suppformat == 'N'
         &&  supptime->len != 8)
            return(1);
         if (suppformat == 'L'
         &&  supptime->len != 15)
            return(1);
         if (*(ptr+2) != ':'
         &&  *(ptr+5) != ':')
            return(1);
         memcpy(buf,ptr,2);
         buf[2] = '\0';
         if ((num1 = atol(buf)) == 0
         && strcmp("00",buf) != 0)
            return(1);
         if (num1 < 0 || num1 > 23)
            return(1);

         memcpy(buf,ptr+3,2);
         buf[2] = '\0';
         if ((num2 = atol(buf)) == 0
         && strcmp("00",buf) != 0)
            return(1);
         if (num2 < 0 || num2 > 59)
            return(1);

         memcpy(buf,ptr+6,2);
         buf[2] = '\0';
         if ((num3 = atol(buf)) == 0
         && strcmp("00",buf) != 0)
            return(1);
         if (num3 < 0 || num3 > 59)
            return(1);
         intime->tm_sec = num3;
         intime->tm_hour = num1;
         intime->tm_min = num2;
         if (suppformat == 'N')
           {
            *unow = 0;
            break;
           }
         if (*(ptr+8) != '.')
            return(1);
         memcpy(buf,ptr+9,6);
         buf[6] = '\0';
         if ((num4 = atol(buf)) == 0
         && strcmp("000000",buf) != 0)
            return(1);
         if (num4 < 0)
            return(1);
         *unow = num4;
         break;
    default:
         exiterror( ERR_INCORRECT_CALL, 0 ) ;
         break;
   }

 return(rc);
}
