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

/*
    This code modified for Win32 port by Ataman Software, Inc. June 29, 1995.
*/

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

/*
 * 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_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_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
 */
#ifndef WIN32
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 ) ;
#endif /* !WIN32 */
#ifdef OLD_REGINA_FEATURES
streng *unx_open( paramboxptr parms ) ;
streng *unx_close( paramboxptr parms ) ;
#endif

/*
 * Extra builtins, for Win32.
 */
#ifdef WIN32
streng *w32_backupeventlog(paramboxptr parms);
streng *w32_callfunc(paramboxptr parms);
streng *w32_callproc(paramboxptr parms);
streng *w32_cleareventlog(paramboxptr parms);
streng *w32_closeeventlog(paramboxptr parms);
streng *w32_createobject(paramboxptr parms);
streng *w32_expandenvironmentstrings(paramboxptr parms);
streng *w32_findeventlogentry(paramboxptr parms);
streng *w32_geteventcategory(paramboxptr parms);
streng *w32_geteventdata(paramboxptr parms);
streng *w32_geteventid(paramboxptr parms);
streng *w32_geteventnumstrings(paramboxptr parms);
streng *w32_geteventstring(paramboxptr parms);
streng *w32_geteventtimegenerated(paramboxptr parms);
streng *w32_geteventtimewritten(paramboxptr parms);
streng *w32_geteventtype(paramboxptr parms);
streng *w32_getnumberofeventlogrecords(paramboxptr parms);
streng *w32_getobject(paramboxptr parms);
streng *w32_getproperty(paramboxptr parms);
streng *w32_getsubobj(paramboxptr parms);
streng *w32_openbackupeventlog(paramboxptr parms);
streng *w32_openeventlog(paramboxptr parms);
streng *w32_putproperty(paramboxptr parms);
streng *w32_regclosekey(paramboxptr parms);
streng *w32_regconnectregistry(paramboxptr parms);
streng *w32_regcreatekey(paramboxptr parms);
streng *w32_regdeletekey(paramboxptr parms);
streng *w32_regdeletevalue(paramboxptr parms);
streng *w32_regenumkey(paramboxptr parms);
streng *w32_regenumvalue(paramboxptr parms);
streng *w32_regflushkey(paramboxptr parms);
streng *w32_reggetkeysecdesc(paramboxptr parms);
streng *w32_regloadkey(paramboxptr parms);
streng *w32_regopenkey(paramboxptr parms);
streng *w32_regqueryinfokey(paramboxptr parms);
streng *w32_regqueryvalue(paramboxptr parms);
streng *w32_regqueryvaluetype(paramboxptr parms);
streng *w32_regrestorekey(paramboxptr parms);
streng *w32_regsavekey(paramboxptr parms);
streng *w32_regsetkeysecdesc(paramboxptr parms);
streng *w32_regsetvalue(paramboxptr parms);
streng *w32_regunloadkey(paramboxptr parms);
streng *w32_releaseobject(paramboxptr parms);
streng *w32_writeeventlog(paramboxptr parms);
#endif


struct function_type
{
   int length ;
   streng *(*function)(void *) ;
   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" },
#ifndef WIN32
      { 0,			unx_chdir, "CD" },
#endif /* !WIN32 */
      { 0,			std_center, "CENTER" },
      { 0,			std_center, "CENTRE" },
      { 0,			std_charin, "CHARIN" },
      { 0,			std_charout, "CHAROUT" },
      { 0,			std_chars, "CHARS" },
#ifndef WIN32
      { 0,			unx_chdir, "CHDIR" },
#endif /* !WIN32 */
#ifdef OLD_REGINA_FEATURES
      { 0,			unx_close, "CLOSE" },
#endif
      { 0,			std_compare, "COMPARE" },
      { 0,			std_condition, "CONDITION" },
      { 0,			std_copies, "COPIES" },
      { 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
#ifndef WIN32
      { 0,			unx_eof, "EOF" },
#endif /* !WIN32 */
      { 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 */
#ifndef WIN32
      { 0,                      unx_fork, "FORK" },
#endif /* !WIN32 */
      { 0,			std_form, "FORM" },
      { 0,			std_format, "FORMAT" },
      { 0,			std_fuzz, "FUZZ" },
#ifndef WIN32
      { 0,			unx_getenv, "GETENV" },
#endif /* !WIN32 */
#ifndef WIN32
      { 0,			unx_getpath, "GETPATH" },
#endif /* !WIN32 */
#ifndef WIN32
      { 0,			unx_getpid, "GETPID" },
#endif /* !WIN32 */
      { 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" },
#ifndef WIN32
      { 0,			unx_popen, "POPEN" },
#endif /* !WIN32 */
      { 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" },
#ifndef WIN32
      { 0,                      unx_uname, "UNAME" },
#endif /* !WIN32 */
#ifndef WIN32
      { 0,			unx_unixerror, "UNIXERROR" },
#endif /* !WIN32 */
      { 0,			rex_userid, "USERID" },
      { 0,			std_value, "VALUE" },
      { 0,			std_verify, "VERIFY" },
#ifdef WIN32
      { 0,			w32_backupeventlog, "W32BACKUPEVENTLOG" },
      { 0,			w32_callfunc, "W32CALLFUNC" },
      { 0,			w32_callproc, "W32CALLPROC" },
      { 0,			w32_cleareventlog, "W32CLEAREVENTLOG" },
      { 0,			w32_closeeventlog, "W32CLOSEEVENTLOG" },
      { 0,			w32_createobject, "W32CREATEOBJECT" },
      { 0,			w32_expandenvironmentstrings, "W32EXPANDENVIRONMENTSTRINGS" },
      { 0,			w32_findeventlogentry, "W32FINDEVENTLOGENTRY" },
      { 0,			w32_geteventcategory, "W32GETEVENTCATEGORY" },
      { 0,			w32_geteventdata, "W32GETEVENTDATA" },
      { 0,			w32_geteventid, "W32GETEVENTID" },
      { 0,			w32_geteventnumstrings, "W32GETEVENTNUMSTRINGS" },
      { 0,			w32_geteventstring, "W32GETEVENTSTRING" },
      { 0,			w32_geteventtimegenerated, "W32GETEVENTTIMEGENERATED" },
      { 0,			w32_geteventtimewritten, "W32GETEVENTTIMEWRITTEN" },
      { 0,			w32_geteventtype, "W32GETEVENTTYPE" },
      { 0,			w32_getnumberofeventlogrecords, "W32GETNUMBEROFEVENTLOGRECORDS" },
      { 0,			w32_getobject, "W32GETOBJECT" },
      { 0,			w32_getproperty, "W32GETPROPERTY" },
      { 0,			w32_getsubobj, "W32GETSUBOBJ" },
      { 0,			w32_openbackupeventlog, "W32OPENBACKUPEVENTLOG" },
      { 0,			w32_openeventlog, "W32OPENEVENTLOG" },
      { 0,			w32_putproperty, "W32PUTPROPERTY" },
      { 0,			w32_regclosekey, "W32REGCLOSEKEY" },
      { 0,			w32_regconnectregistry, "W32REGCONNECTREGISTRY" },
      { 0,			w32_regcreatekey, "W32REGCREATEKEY" },
      { 0,			w32_regdeletekey, "W32REGDELETEKEY" },
      { 0,			w32_regdeletevalue, "W32REGDELETEVALUE" },
      { 0,			w32_regenumkey, "W32REGENUMKEY" },
      { 0,			w32_regenumvalue, "W32REGENUMVALUE" },
      { 0,			w32_regflushkey, "W32REGFLUSHKEY" },
      { 0,			w32_reggetkeysecdesc, "W32REGGETKEYSECDESC" },
      { 0,			w32_regloadkey, "W32REGLOADKEY" },
      { 0,			w32_regopenkey, "W32REGOPENKEY" },
      { 0,			w32_regqueryinfokey, "W32REGQUERYINFOKEY" },
      { 0,			w32_regqueryvalue, "W32REGQUERYVALUE" },
      { 0,			w32_regqueryvaluetype, "W32REGQUERYVALUETYPE" },
      { 0,			w32_regrestorekey, "W32REGRESTOREKEY" },
      { 0,			w32_regsavekey, "W32REGSAVEKEY" },
      { 0,			w32_regsetkeysecdesc, "W32REGSETKEYSECDESC" },
      { 0,			w32_regsetvalue, "W32REGSETVALUE" },
      { 0,			w32_regunloadkey, "W32REGUNLOADKEY" },
      { 0,			w32_releaseobject, "W32RELEASEOBJECT" },
      { 0,			w32_writeeventlog, "W32WRITEEVENTLOG" },
#endif
      { 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 ;

   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, mid, end=1, up=num_funcs-1, i ;
   streng *ptr ;
   int ext=0 ;
   void *vptr ;
   streng *(*func)(paramboxptr)=NULL ;

   vptr = loaded_lib_func( this->name ) ;
   if (vptr)
      func = std_center ; /* e.g. */

   if (!func)
   {
      ext = external_func( this->name ) ;
      if (ext)
         func = std_center ; /* e.g. */
   }

   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 ) ;
      else if (vptr)
         ptr = do_loaded_func( vptr, first ) ;
      else
         ptr = (*func)(first /* ->next */ ) ;

      deallocplink( first ) ;
      first = NULL ;
      return ptr ;
   }
   else
      return &nofunc ;
}


paramboxptr par_stack = NULL ;


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

   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 ;

   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 ;

   ptr = par_stack ;
   for (; ptr; ptr=ptr->next )
      markmemory( ptr, TRC_P_CACHE ) ;
}
#endif



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

   num = streng_to_int( text ) ;
   if (num==NULL)
      exiterror( ERR_INVALID_INTEGER ) ;

   return *num ;
}


int atozpos( streng *text )
{
   int result ;

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

   return result ;
}


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

   if (text->len==0)
      exiterror( ERR_INCORRECT_CALL ) ;

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

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

   exiterror( ERR_INCORRECT_CALL ) ;
   return 0x00 ; /* just to please the compiler */
}


char getonechar( streng *text )
{
   if ((!text)||(Str_len(text)!=1))
      exiterror( ERR_INCORRECT_CALL ) ;

   return text->value[0] ;
}

int atopos( streng *text )
{
   int result ;

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

   return result ;
}



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

   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 )
{
   int i ;

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

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


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


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

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

char getoption( streng *test )
{
   if ((!test)||(!Str_len(test)))
      return 0x00 ;

   return toupper(test->value[0]) ;
}
