clips-sys 0.4.0

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*            CLIPS Version 6.40  07/10/18             */
   /*                                                     */
   /*            MISCELLANEOUS FUNCTIONS MODULE           */
   /*******************************************************/

/*************************************************************/
/* Purpose:                                                  */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Gary D. Riley                                        */
/*                                                           */
/* Contributing Programmer(s):                               */
/*      Brian L. Dantes                                      */
/*                                                           */
/* Revision History:                                         */
/*                                                           */
/*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
/*                                                           */
/*            Corrected compilation errors for files         */
/*            generated by constructs-to-c. DR0861           */
/*                                                           */
/*            Changed name of variable exp to theExp         */
/*            because of Unix compiler warnings of shadowed  */
/*            definitions.                                   */
/*                                                           */
/*      6.24: Removed CONFLICT_RESOLUTION_STRATEGIES,        */
/*            DYNAMIC_SALIENCE, INCREMENTAL_RESET,           */
/*            LOGICAL_DEPENDENCIES, IMPERATIVE_METHODS       */
/*            INSTANCE_PATTERN_MATCHING,                     */
/*            IMPERATIVE_MESSAGE_HANDLERS, and               */
/*            AUXILIARY_MESSAGE_HANDLERS compilation flags.  */
/*                                                           */
/*            Renamed BOOLEAN macro type to intBool.         */
/*                                                           */
/*      6.30: Support for long long integers.                */
/*                                                           */
/*            Used gensprintf instead of sprintf.            */
/*                                                           */
/*            Removed conditional code for unsupported       */
/*            compilers/operating systems.                   */
/*                                                           */
/*            Renamed EX_MATH compiler flag to               */
/*            EXTENDED_MATH_FUNCTIONS.                       */
/*                                                           */
/*            Combined BASIC_IO and EXT_IO compilation       */
/*            flags into the IO_FUNCTIONS compilation flag.  */
/*                                                           */
/*            Removed code associated with HELP_FUNCTIONS    */
/*            and EMACS_EDITOR compiler flags.               */
/*                                                           */
/*            Added operating-system function.               */
/*                                                           */
/*            Added new function (for future use).           */
/*                                                           */
/*            Added const qualifiers to remove C++           */
/*            deprecation warnings.                          */
/*                                                           */
/*            Removed deallocating message parameter from    */
/*            EnvReleaseMem.                                 */
/*                                                           */
/*            Removed support for BLOCK_MEMORY.              */
/*                                                           */
/*      6.31: Added local-time and gm-time functions.        */
/*                                                           */
/*      6.40: Changed restrictions from char * to            */
/*            CLIPSLexeme * to support strings               */
/*            originating from sources that are not          */
/*            statically allocated.                          */
/*                                                           */
/*            Added Env prefix to GetEvaluationError and     */
/*            SetEvaluationError functions.                  */
/*                                                           */
/*            Added Env prefix to GetHaltExecution and       */
/*            SetHaltExecution functions.                    */
/*                                                           */
/*            Refactored code to reduce header dependencies  */
/*            in sysdep.c.                                   */
/*                                                           */
/*            Pragma once and other inclusion changes.       */
/*                                                           */
/*            Added support for booleans with <stdbool.h>.   */
/*                                                           */
/*            Removed use of void pointers for specific      */
/*            data structures.                               */
/*                                                           */
/*            Removed VAX_VMS support.                       */
/*                                                           */
/*            Removed mv-append and length functions.        */
/*                                                           */
/*            UDF redesign.                                  */
/*                                                           */
/*            The system function now returns the completion */
/*            status of the command. If no arguments are     */
/*            passed, the return value indicates whether a   */
/*            command processor is available.                */
/*                                                           */
/*            Added get-error, set-error, and clear-error    */
/*            functions.                                     */
/*                                                           */
/*            Added void function.                           */
/*                                                           */
/*            Function operating system returns MAC-OS       */
/*            instead of MAC-OS-X.                           */
/*                                                           */
/*************************************************************/

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

#include "setup.h"

#include "argacces.h"
#include "envrnmnt.h"
#include "exprnpsr.h"
#include "memalloc.h"
#include "multifld.h"
#include "prntutil.h"
#include "router.h"
#include "sysdep.h"
#include "utility.h"

#if DEFFUNCTION_CONSTRUCT
#include "dffnxfun.h"
#endif

#if DEFTEMPLATE_CONSTRUCT
#include "factfun.h"
#include "tmpltutl.h"
#endif

#include "miscfun.h"

#define MISCFUN_DATA 9

struct miscFunctionData
  {
   long long GensymNumber;
   CLIPSValue errorCode;
  };

#define MiscFunctionData(theEnv) ((struct miscFunctionData *) GetEnvironmentData(theEnv,MISCFUN_DATA))

/***************************************/
/* LOCAL INTERNAL FUNCTION DEFINITIONS */
/***************************************/

   static void                    ExpandFuncMultifield(Environment *,UDFValue *,Expression *,
                                                       Expression **,void *);
   static int                     FindLanguageType(Environment *,const char *);
   static void                    ConvertTime(Environment *,UDFValue *,struct tm *);

/*****************************************************************/
/* MiscFunctionDefinitions: Initializes miscellaneous functions. */
/*****************************************************************/
void MiscFunctionDefinitions(
  Environment *theEnv)
  {
   AllocateEnvironmentData(theEnv,MISCFUN_DATA,sizeof(struct miscFunctionData),NULL);
   MiscFunctionData(theEnv)->GensymNumber = 1;
   MiscFunctionData(theEnv)->errorCode.lexemeValue = FalseSymbol(theEnv);
   Retain(theEnv,MiscFunctionData(theEnv)->errorCode.header);

#if ! RUN_TIME
   AddUDF(theEnv,"exit","v",0,1,"l",ExitCommand,"ExitCommand",NULL);

   AddUDF(theEnv,"gensym","y",0,0,NULL,GensymFunction,"GensymFunction",NULL);
   AddUDF(theEnv,"gensym*","y",0,0,NULL,GensymStarFunction,"GensymStarFunction",NULL);
   AddUDF(theEnv,"setgen","l",1,1,"l",SetgenFunction,"SetgenFunction",NULL);

   AddUDF(theEnv,"system","ly",0,UNBOUNDED,"sy",SystemCommand,"SystemCommand",NULL);
   AddUDF(theEnv,"length$","l",1,1,"m",LengthFunction,"LengthFunction",NULL);
   AddUDF(theEnv,"time","d",0,0,NULL,TimeFunction,"TimeFunction",NULL);
   AddUDF(theEnv,"local-time","m",0,0,NULL,LocalTimeFunction,"LocalTimeFunction",NULL);
   AddUDF(theEnv,"gm-time","m",0,0,NULL,GMTimeFunction,"GMTimeFunction",NULL);

   AddUDF(theEnv,"random","l",0,2,"l",RandomFunction,"RandomFunction",NULL);
   AddUDF(theEnv,"seed","v",1,1,"l",SeedFunction,"SeedFunction",NULL);
   AddUDF(theEnv,"conserve-mem","v",1,1,"y",ConserveMemCommand,"ConserveMemCommand",NULL);
   AddUDF(theEnv,"release-mem","l",0,0,NULL,ReleaseMemCommand,"ReleaseMemCommand",NULL);
#if DEBUGGING_FUNCTIONS
   AddUDF(theEnv,"mem-used","l",0,0,NULL,MemUsedCommand,"MemUsedCommand",NULL);
   AddUDF(theEnv,"mem-requests","l",0,0,NULL,MemRequestsCommand,"MemRequestsCommand",NULL);
#endif

   AddUDF(theEnv,"options","v",0,0,NULL,OptionsCommand,"OptionsCommand",NULL);

   AddUDF(theEnv,"operating-system","y",0,0,NULL,OperatingSystemFunction,"OperatingSystemFunction",NULL);
   AddUDF(theEnv,"(expansion-call)","*",0,UNBOUNDED,NULL,ExpandFuncCall,"ExpandFuncCall",NULL);
   AddUDF(theEnv,"expand$","*",1,1,"m",DummyExpandFuncMultifield,"DummyExpandFuncMultifield",NULL);
   FuncSeqOvlFlags(theEnv,"expand$",false,false);
   AddUDF(theEnv,"(set-evaluation-error)","y",0,0,NULL,CauseEvaluationError,"CauseEvaluationError",NULL);
   AddUDF(theEnv,"set-sequence-operator-recognition","b",1,1,"y",SetSORCommand,"SetSORCommand",NULL);
   AddUDF(theEnv,"get-sequence-operator-recognition","b",0,0,NULL,GetSORCommand,"GetSORCommand",NULL);
   AddUDF(theEnv,"get-function-restrictions","s",1,1,"y",GetFunctionRestrictions,"GetFunctionRestrictions",NULL);
   AddUDF(theEnv,"create$","m",0,UNBOUNDED,NULL,CreateFunction,"CreateFunction",NULL);
   AddUDF(theEnv,"apropos","v",1,1,"y",AproposCommand,"AproposCommand",NULL);
   AddUDF(theEnv,"get-function-list","m",0,0,NULL,GetFunctionListFunction,"GetFunctionListFunction",NULL);
   AddUDF(theEnv,"funcall","*",1,UNBOUNDED,"*;sy",FuncallFunction,"FuncallFunction",NULL);
   AddUDF(theEnv,"new","*",1,UNBOUNDED,"*;y",NewFunction,"NewFunction",NULL);
   AddUDF(theEnv,"call","*",1,UNBOUNDED,"*",CallFunction,"CallFunction",NULL);
   AddUDF(theEnv,"timer","d",0,UNBOUNDED,NULL,TimerFunction,"TimerFunction",NULL);

   AddUDF(theEnv,"get-error","*",0,0,NULL,GetErrorFunction,"GetErrorFunction",NULL);
   AddUDF(theEnv,"clear-error","*",0,0,NULL,ClearErrorFunction,"ClearErrorFunction",NULL);
   AddUDF(theEnv,"set-error","v",1,1,NULL,SetErrorFunction,"SetErrorFunction",NULL);

   AddUDF(theEnv,"void","v",0,0,NULL,VoidFunction,"VoidFunction",NULL);
#endif
  }

/*****************************************************/
/* ExitCommand: H/L command for exiting the program. */
/*****************************************************/
void ExitCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   unsigned int argCnt;
   int status;
   UDFValue theArg;

   argCnt = UDFArgumentCount(context);

   if (argCnt == 0)
     { ExitRouter(theEnv,EXIT_SUCCESS); }
   else
    {
     if (! UDFFirstArgument(context,INTEGER_BIT,&theArg))
       { ExitRouter(theEnv,EXIT_SUCCESS); }

     status = (int) theArg.integerValue->contents;
     if (GetEvaluationError(theEnv)) return;
     ExitRouter(theEnv,status);
    }

   return;
  }

/******************************************************************/
/* CreateFunction: H/L access routine for the create$ function.   */
/******************************************************************/
void CreateFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   StoreInMultifield(theEnv,returnValue,GetFirstArgument(),true);
  }

/*****************************************************************/
/* SetgenFunction: H/L access routine for the setgen function.   */
/*****************************************************************/
void SetgenFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   long long theLong;

   /*====================================================*/
   /* Check to see that an integer argument is provided. */
   /*====================================================*/

   if (! UDFNthArgument(context,1,INTEGER_BIT,returnValue))
     { return; }

   /*========================================*/
   /* The integer must be greater than zero. */
   /*========================================*/

   theLong = returnValue->integerValue->contents;

   if (theLong < 1LL)
     {
      UDFInvalidArgumentMessage(context,"integer (greater than or equal to 1)");
      returnValue->integerValue = CreateInteger(theEnv,MiscFunctionData(theEnv)->GensymNumber);
      return;
     }

   /*==============================================*/
   /* Set the gensym index to the number provided. */
   /*==============================================*/

   MiscFunctionData(theEnv)->GensymNumber = theLong;
  }

/****************************************/
/* GensymFunction: H/L access routine   */
/*   for the gensym function.           */
/****************************************/
void GensymFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   char genstring[128];

   /*================================================*/
   /* Create a symbol using the current gensym index */
   /* as the postfix.                                */
   /*================================================*/

   gensprintf(genstring,"gen%lld",MiscFunctionData(theEnv)->GensymNumber);
   MiscFunctionData(theEnv)->GensymNumber++;

   /*====================*/
   /* Return the symbol. */
   /*====================*/

   returnValue->lexemeValue = CreateSymbol(theEnv,genstring);
  }

/************************************************/
/* GensymStarFunction: H/L access routine for   */
/*   the gensym* function.                      */
/************************************************/
void GensymStarFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   /*====================*/
   /* Return the symbol. */
   /*====================*/

   GensymStar(theEnv,returnValue);
  }

/************************************/
/* GensymStar: C access routine for */
/*   the gensym* function.          */
/************************************/
void GensymStar(
  Environment *theEnv,
  UDFValue *returnValue)
  {
   char genstring[128];

   /*=======================================================*/
   /* Create a symbol using the current gensym index as the */
   /* postfix. If the symbol is already present in the      */
   /* symbol table, then continue generating symbols until  */
   /* a unique symbol is found.                             */
   /*=======================================================*/

   do
     {
      gensprintf(genstring,"gen%lld",MiscFunctionData(theEnv)->GensymNumber);
      MiscFunctionData(theEnv)->GensymNumber++;
     }
   while (FindSymbolHN(theEnv,genstring,SYMBOL_BIT) != NULL);

   /*====================*/
   /* Return the symbol. */
   /*====================*/

   returnValue->lexemeValue = CreateSymbol(theEnv,genstring);
  }

/********************************************/
/* RandomFunction: H/L access routine for   */
/*   the random function.                   */
/********************************************/
void RandomFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   unsigned int argCount;
   long long rv;
   UDFValue theArg;
   long long begin, end;

   /*====================================*/
   /* The random function accepts either */
   /* zero or two arguments.             */
   /*====================================*/

   argCount = UDFArgumentCount(context);

   if ((argCount != 0) && (argCount != 2))
     {
      PrintErrorID(theEnv,"MISCFUN",2,false);
      WriteString(theEnv,STDERR,"Function random expected either 0 or 2 arguments\n");
     }

   /*========================================*/
   /* Return the randomly generated integer. */
   /*========================================*/

   rv = genrand();

   if (argCount == 2)
     {
      if (! UDFFirstArgument(context,INTEGER_BIT,&theArg))
        { return; }
      begin = theArg.integerValue->contents;

      if (! UDFNextArgument(context,INTEGER_BIT,&theArg))
        { return; }

      end = theArg.integerValue->contents;
      if (end < begin)
        {
         PrintErrorID(theEnv,"MISCFUN",3,false);
         WriteString(theEnv,STDERR,"Function random expected argument #1 to be less than argument #2\n");
         returnValue->integerValue = CreateInteger(theEnv,rv);
         return;
        }

      rv = begin + (rv % ((end - begin) + 1));
     }

   returnValue->integerValue = CreateInteger(theEnv,rv);
  }

/******************************************/
/* SeedFunction: H/L access routine for   */
/*   the seed function.                   */
/******************************************/
void SeedFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   UDFValue theValue;

   /*==========================================================*/
   /* Check to see that a single integer argument is provided. */
   /*==========================================================*/

   if (! UDFFirstArgument(context,INTEGER_BIT,&theValue))
     { return; }

   /*=============================================================*/
   /* Seed the random number generator with the provided integer. */
   /*=============================================================*/

   genseed((unsigned int) theValue.integerValue->contents);
  }

/********************************************/
/* LengthFunction: H/L access routine for   */
/*   the length$ function.                  */
/********************************************/
void LengthFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   UDFValue theArg;

   /*====================================================*/
   /* The length$ function expects exactly one argument. */
   /*====================================================*/

   if (! UDFFirstArgument(context, MULTIFIELD_BIT, &theArg))
     { return; }

   /*==============================================*/
   /* Return the number of fields in the argument. */
   /*==============================================*/

   returnValue->value = CreateInteger(theEnv,(long long) theArg.range);
  }

/*******************************************/
/* ReleaseMemCommand: H/L access routine   */
/*   for the release-mem function.         */
/*******************************************/
void ReleaseMemCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   /*========================================*/
   /* Release memory to the operating system */
   /* and return the amount of memory freed. */
   /*========================================*/

   returnValue->integerValue = CreateInteger(theEnv,ReleaseMem(theEnv,-1));
  }

/******************************************/
/* ConserveMemCommand: H/L access routine */
/*   for the conserve-mem command.        */
/******************************************/
void ConserveMemCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   const char *argument;
   UDFValue theValue;

   /*===================================*/
   /* The conserve-mem function expects */
   /* a single symbol argument.         */
   /*===================================*/

   if (! UDFFirstArgument(context,SYMBOL_BIT,&theValue))
     { return; }

   argument = theValue.lexemeValue->contents;

   /*====================================================*/
   /* If the argument is the symbol "on", then store the */
   /* pretty print representation of a construct when it */
   /* is defined.                                        */
   /*====================================================*/

   if (strcmp(argument,"on") == 0)
     { SetConserveMemory(theEnv,true); }

   /*======================================================*/
   /* Otherwise, if the argument is the symbol "off", then */
   /* don't store the pretty print representation of a     */
   /* construct when it is defined.                        */
   /*======================================================*/

   else if (strcmp(argument,"off") == 0)
     { SetConserveMemory(theEnv,false); }

   /*=====================================================*/
   /* Otherwise, generate an error since the only allowed */
   /* arguments are "on" or "off."                        */
   /*=====================================================*/

   else
     {
      UDFInvalidArgumentMessage(context,"symbol with value on or off");
      return;
     }

   return;
  }

#if DEBUGGING_FUNCTIONS

/****************************************/
/* MemUsedCommand: H/L access routine   */
/*   for the mem-used command.          */
/****************************************/
void MemUsedCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   /*============================================*/
   /* Return the amount of memory currently held */
   /* (both for current use and for later use).  */
   /*============================================*/

   returnValue->integerValue = CreateInteger(theEnv,MemUsed(theEnv));
  }

/********************************************/
/* MemRequestsCommand: H/L access routine   */
/*   for the mem-requests command.          */
/********************************************/
void MemRequestsCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   /*==================================*/
   /* Return the number of outstanding */
   /* memory requests.                 */
   /*==================================*/

   returnValue->integerValue = CreateInteger(theEnv,MemRequests(theEnv));
  }

#endif

/****************************************/
/* AproposCommand: H/L access routine   */
/*   for the apropos command.           */
/****************************************/
void AproposCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   const char *argument;
   UDFValue theArg;
   CLIPSLexeme *hashPtr = NULL;
   size_t theLength;

   /*=======================================================*/
   /* The apropos command expects a single symbol argument. */
   /*=======================================================*/

   if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg))
     { return; }

   /*=======================================*/
   /* Determine the length of the argument. */
   /*=======================================*/

   argument = theArg.lexemeValue->contents;
   theLength = strlen(argument);

   /*====================================================================*/
   /* Print each entry in the symbol table that contains the argument as */
   /* a substring. When using a non-ANSI compiler, only those strings    */
   /* that contain the substring starting at the beginning of the string */
   /* are printed.                                                       */
   /*====================================================================*/

   while ((hashPtr = GetNextSymbolMatch(theEnv,argument,theLength,hashPtr,true,NULL)) != NULL)
     {
      WriteString(theEnv,STDOUT,hashPtr->contents);
      WriteString(theEnv,STDOUT,"\n");
     }
  }

/****************************************/
/* OptionsCommand: H/L access routine   */
/*   for the options command.           */
/****************************************/
void OptionsCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   /*=======================*/
   /* Set the return value. */
   /*=======================*/

   returnValue->voidValue = VoidConstant(theEnv);

   /*=================================*/
   /* Print the state of the compiler */
   /* flags for this executable.      */
   /*=================================*/

   WriteString(theEnv,STDOUT,"Machine type: ");

#if GENERIC
   WriteString(theEnv,STDOUT,"Generic ");
#endif
#if UNIX_V
   WriteString(theEnv,STDOUT,"UNIX System V or 4.2BSD ");
#endif
#if DARWIN
   WriteString(theEnv,STDOUT,"Darwin ");
#endif
#if LINUX
   WriteString(theEnv,STDOUT,"Linux ");
#endif
#if UNIX_7
   WriteString(theEnv,STDOUT,"UNIX System III Version 7 or Sun Unix ");
#endif
#if MAC_XCD
   WriteString(theEnv,STDOUT,"Apple Macintosh with Xcode");
#endif
#if WIN_MVC
   WriteString(theEnv,STDOUT,"Microsoft Windows with Microsoft Visual C++");
#endif
#if WIN_GCC
   WriteString(theEnv,STDOUT,"Microsoft Windows with DJGPP");
#endif
WriteString(theEnv,STDOUT,"\n");

WriteString(theEnv,STDOUT,"Defrule construct is ");
#if DEFRULE_CONSTRUCT
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"Defmodule construct is ");
#if DEFMODULE_CONSTRUCT
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"Deftemplate construct is ");
#if DEFTEMPLATE_CONSTRUCT
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"  Fact-set queries are ");
#if FACT_SET_QUERIES
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

#if DEFTEMPLATE_CONSTRUCT

WriteString(theEnv,STDOUT,"  Deffacts construct is ");
#if DEFFACTS_CONSTRUCT
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

#endif

WriteString(theEnv,STDOUT,"Defglobal construct is ");
#if DEFGLOBAL_CONSTRUCT
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"Deffunction construct is ");
#if DEFFUNCTION_CONSTRUCT
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"Defgeneric/Defmethod constructs are ");
#if DEFGENERIC_CONSTRUCT
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"Object System is ");
#if OBJECT_SYSTEM
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

#if OBJECT_SYSTEM

WriteString(theEnv,STDOUT,"  Definstances construct is ");
#if DEFINSTANCES_CONSTRUCT
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"  Instance-set queries are ");
#if INSTANCE_SET_QUERIES
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"  Binary loading of instances is ");
#if BLOAD_INSTANCES
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"  Binary saving of instances is ");
#if BSAVE_INSTANCES
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

#endif

WriteString(theEnv,STDOUT,"Extended math function package is ");
#if EXTENDED_MATH_FUNCTIONS
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"Text processing function package is ");
#if TEXTPRO_FUNCTIONS
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"Bload capability is ");
#if BLOAD_ONLY
  WriteString(theEnv,STDOUT,"BLOAD ONLY");
#endif
#if BLOAD
  WriteString(theEnv,STDOUT,"BLOAD");
#endif
#if BLOAD_AND_BSAVE
  WriteString(theEnv,STDOUT,"BLOAD AND BSAVE");
#endif
#if (! BLOAD_ONLY) && (! BLOAD) && (! BLOAD_AND_BSAVE)
  WriteString(theEnv,STDOUT,"OFF ");
#endif
WriteString(theEnv,STDOUT,"\n");

WriteString(theEnv,STDOUT,"Construct compiler is ");
#if CONSTRUCT_COMPILER
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"I/O function package is ");
#if IO_FUNCTIONS
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"String function package is ");
#if STRING_FUNCTIONS
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"Multifield function package is ");
#if MULTIFIELD_FUNCTIONS
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"Debugging function package is ");
#if DEBUGGING_FUNCTIONS
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"Window Interface flag is ");
#if WINDOW_INTERFACE
   WriteString(theEnv,STDOUT,"ON\n");
#else
   WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"Developer flag is ");
#if DEVELOPER
   WriteString(theEnv,STDOUT,"ON\n");
#else
   WriteString(theEnv,STDOUT,"OFF\n");
#endif

WriteString(theEnv,STDOUT,"Run time module is ");
#if RUN_TIME
  WriteString(theEnv,STDOUT,"ON\n");
#else
  WriteString(theEnv,STDOUT,"OFF\n");
#endif
  }

/***********************************************/
/* OperatingSystemFunction: H/L access routine */
/*   for the operating system function.        */
/***********************************************/
void OperatingSystemFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
#if GENERIC
   returnValue->lexemeValue = CreateSymbol(theEnv,"UNKNOWN");
#elif UNIX_V
   returnValue->lexemeValue = CreateSymbol(theEnv,"UNIX-V");
#elif UNIX_7
   returnValue->lexemeValue = CreateSymbol(theEnv,"UNIX-7");
#elif LINUX
   returnValue->lexemeValue = CreateSymbol(theEnv,"LINUX");
#elif DARWIN
   returnValue->lexemeValue = CreateSymbol(theEnv,"DARWIN");
#elif MAC_XCD
   returnValue->lexemeValue = CreateSymbol(theEnv,"MAC-OS");
#elif IBM && (! WINDOW_INTERFACE)
   returnValue->lexemeValue = CreateSymbol(theEnv,"DOS");
#elif IBM && WINDOW_INTERFACE
   returnValue->lexemeValue = CreateSymbol(theEnv,"WINDOWS");
#else
   returnValue->lexemeValue = CreateSymbol(theEnv,"UNKNOWN");
#endif
  }

/********************************************************************
  NAME         : ExpandFuncCall
  DESCRIPTION  : This function is a wrap-around for a normal
                   function call.  It preexamines the argument
                   expression list and expands any references to the
                   sequence operator.  It builds a copy of the
                   function call expression with these new arguments
                   inserted and evaluates the function call.
  INPUTS       : A data object buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Expressions alloctaed/deallocated
                 Function called and arguments evaluated
                 EvaluationError set on errors
  NOTES        : None
 *******************************************************************/
void ExpandFuncCall(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   Expression *newargexp,*fcallexp;
   struct functionDefinition *func;

   /* ======================================================================
      Copy the original function call's argument expression list.
      Look for expand$ function callsexpressions and replace those
        with the equivalent expressions of the expansions of evaluations
        of the arguments.
      ====================================================================== */
   newargexp = CopyExpression(theEnv,GetFirstArgument()->argList);
   ExpandFuncMultifield(theEnv,returnValue,newargexp,&newargexp,
                        FindFunction(theEnv,"expand$"));

   /* ===================================================================
      Build the new function call expression with the expanded arguments.
      Check the number of arguments, if necessary, and call the thing.
      =================================================================== */
   fcallexp = get_struct(theEnv,expr);
   fcallexp->type = GetFirstArgument()->type;
   fcallexp->value = GetFirstArgument()->value;
   fcallexp->nextArg = NULL;
   fcallexp->argList = newargexp;
   if (fcallexp->type == FCALL)
     {
      func = fcallexp->functionValue;
      if (CheckFunctionArgCount(theEnv,func,CountArguments(newargexp)) == false)
        {
         returnValue->lexemeValue = FalseSymbol(theEnv);
         ReturnExpression(theEnv,fcallexp);
         return;
        }
     }
#if DEFFUNCTION_CONSTRUCT
   else if (fcallexp->type == PCALL)
     {
      if (CheckDeffunctionCall(theEnv,(Deffunction *) fcallexp->value,
              CountArguments(fcallexp->argList)) == false)
        {
         returnValue->lexemeValue = FalseSymbol(theEnv);
         ReturnExpression(theEnv,fcallexp);
         SetEvaluationError(theEnv,true);
         return;
        }
     }
#endif

   EvaluateExpression(theEnv,fcallexp,returnValue);
   ReturnExpression(theEnv,fcallexp);
  }

/***********************************************************************
  NAME         : DummyExpandFuncMultifield
  DESCRIPTION  : The expansion of multifield arguments is valid only
                 when done for a function call.  All these expansions
                 are handled by the H/L wrap-around function
                 (expansion-call) - see ExpandFuncCall.  If the H/L
                 function, epand-multifield is ever called directly,
                 it is an error.
  INPUTS       : Data object buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : EvaluationError set
  NOTES        : None
 **********************************************************************/
void DummyExpandFuncMultifield(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   returnValue->lexemeValue = FalseSymbol(theEnv);
   SetEvaluationError(theEnv,true);
   PrintErrorID(theEnv,"MISCFUN",1,false);
   WriteString(theEnv,STDERR,"The function 'expand$' must be used in the argument list of a function call.\n");
  }

/***********************************************************************
  NAME         : ExpandFuncMultifield
  DESCRIPTION  : Recursively examines an expression and replaces
                   PROC_EXPAND_MULTIFIELD expressions with the expanded
                   evaluation expression of its argument
  INPUTS       : 1) A data object result buffer
                 2) The expression to modify
                 3) The address of the expression, in case it is
                    deleted entirely
                 4) The address of the H/L function expand$
  RETURNS      : Nothing useful
  SIDE EFFECTS : Expressions allocated/deallocated as necessary
                 Evaluations performed
                 On errors, argument expression set to call a function
                   which causes an evaluation error when evaluated
                   a second time by actual caller.
  NOTES        : THIS ROUTINE MODIFIES EXPRESSIONS AT RUNTIME!!  MAKE
                 SURE THAT THE Expression PASSED IS SAFE TO CHANGE!!
 **********************************************************************/
static void ExpandFuncMultifield(
  Environment *theEnv,
  UDFValue *returnValue,
  Expression *theExp,
  Expression **sto,
  void *expmult)
  {
   Expression *newexp,*top,*bot;
   size_t i; /* 6.04 Bug Fix */

   while (theExp != NULL)
     {
      if (theExp->value == expmult)
        {
         EvaluateExpression(theEnv,theExp->argList,returnValue);
         ReturnExpression(theEnv,theExp->argList);
         if ((EvaluationData(theEnv)->EvaluationError) ||
             (returnValue->header->type != MULTIFIELD_TYPE))
           {
            theExp->argList = NULL;
            if ((EvaluationData(theEnv)->EvaluationError == false) &&
                (returnValue->header->type != MULTIFIELD_TYPE))
              ExpectedTypeError2(theEnv,"expand$",1);
            theExp->value = FindFunction(theEnv,"(set-evaluation-error)");
            EvaluationData(theEnv)->EvaluationError = false;
            EvaluationData(theEnv)->HaltExecution = false;
            return;
           }
         top = bot = NULL;
         for (i = returnValue->begin ; i < (returnValue->begin + returnValue->range) ; i++)
           {
            newexp = get_struct(theEnv,expr);
            newexp->type = returnValue->multifieldValue->contents[i].header->type;
            newexp->value = returnValue->multifieldValue->contents[i].value;
            newexp->argList = NULL;
            newexp->nextArg = NULL;
            if (top == NULL)
              top = newexp;
            else
              bot->nextArg = newexp;
            bot = newexp;
           }
         if (top == NULL)
           {
            *sto = theExp->nextArg;
            rtn_struct(theEnv,expr,theExp);
            theExp = *sto;
           }
         else
           {
            bot->nextArg = theExp->nextArg;
            *sto = top;
            rtn_struct(theEnv,expr,theExp);
            sto = &bot->nextArg;
            theExp = bot->nextArg;
           }
        }
      else
        {
         if (theExp->argList != NULL)
           ExpandFuncMultifield(theEnv,returnValue,theExp->argList,&theExp->argList,expmult);
         sto = &theExp->nextArg;
         theExp = theExp->nextArg;
        }
     }
  }

/****************************************************************
  NAME         : CauseEvaluationError
  DESCRIPTION  : Dummy function use to cause evaluation errors on
                   a function call to generate error messages
  INPUTS       : None
  RETURNS      : A pointer to the FalseSymbol
  SIDE EFFECTS : EvaluationError set
  NOTES        : None
 ****************************************************************/
void CauseEvaluationError(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   SetEvaluationError(theEnv,true);
   returnValue->lexemeValue = FalseSymbol(theEnv);
  }

/************************************************/
/* GetSORCommand: H/L access routine for the    */
/*   get-sequence-operator-recognition command. */
/************************************************/
void GetSORCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   returnValue->lexemeValue = CreateBoolean(theEnv,GetSequenceOperatorRecognition(theEnv));
  }

/************************************************/
/* SetSORCommand: H/L access routine for the    */
/*   set-sequence-operator-recognition command. */
/************************************************/
void SetSORCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
#if (! RUN_TIME) && (! BLOAD_ONLY)
   UDFValue theArg;

   if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg))
     { return; }

   returnValue->lexemeValue = CreateBoolean(theEnv,SetSequenceOperatorRecognition(theEnv,theArg.value != FalseSymbol(theEnv)));
#else
   returnValue->lexemeValue = CreateBoolean(theEnv,ExpressionData(theEnv)->SequenceOpMode);
#endif
  }

/********************************************************************
  NAME         : GetFunctionRestrictions
  DESCRIPTION  : Gets DefineFunction2() restriction list for function
  INPUTS       : None
  RETURNS      : A string containing the function restriction codes
  SIDE EFFECTS : EvaluationError set on errors
  NOTES        : None
 ********************************************************************/
void GetFunctionRestrictions(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   UDFValue theArg;
   struct functionDefinition *fptr;
   char *stringBuffer = NULL;
   size_t bufferPosition = 0;
   size_t bufferMaximum = 0;

   if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg))
     { return; }

   fptr = FindFunction(theEnv,theArg.lexemeValue->contents);
   if (fptr == NULL)
     {
      CantFindItemErrorMessage(theEnv,"function",theArg.lexemeValue->contents,true);
      SetEvaluationError(theEnv,true);
      returnValue->lexemeValue = CreateString(theEnv,"");
      return;
     }

   if (fptr->minArgs == UNBOUNDED)
     {
      stringBuffer = AppendToString(theEnv,"0",
                                    stringBuffer,&bufferPosition,&bufferMaximum);
     }
   else
     {
      stringBuffer = AppendToString(theEnv,LongIntegerToString(theEnv,fptr->minArgs),
                                    stringBuffer,&bufferPosition,&bufferMaximum);
     }

   stringBuffer = AppendToString(theEnv,";",
                                 stringBuffer,&bufferPosition,&bufferMaximum);

   if (fptr->maxArgs == UNBOUNDED)
     {
      stringBuffer = AppendToString(theEnv,"*",
                                    stringBuffer,&bufferPosition,&bufferMaximum);
     }
   else
     {
      stringBuffer = AppendToString(theEnv,LongIntegerToString(theEnv,fptr->maxArgs),
                                    stringBuffer,&bufferPosition,&bufferMaximum);
     }
     
   stringBuffer = AppendToString(theEnv,";",
                                 stringBuffer,&bufferPosition,&bufferMaximum);

   if (fptr->restrictions == NULL)
     {
      stringBuffer = AppendToString(theEnv,"*",
                                    stringBuffer,&bufferPosition,&bufferMaximum);
     }
   else
     {
      stringBuffer = AppendToString(theEnv,fptr->restrictions->contents,
                                    stringBuffer,&bufferPosition,&bufferMaximum);
     }

   returnValue->lexemeValue = CreateString(theEnv,stringBuffer);

   rm(theEnv,stringBuffer,bufferMaximum);
  }

/*************************************************/
/* GetFunctionListFunction: H/L access routine   */
/*   for the get-function-list function.         */
/*************************************************/
void GetFunctionListFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   struct functionDefinition *theFunction;
   Multifield *theList;
   unsigned long functionCount = 0;

   for (theFunction = GetFunctionList(theEnv);
        theFunction != NULL;
        theFunction = theFunction->next)
     { functionCount++; }

   returnValue->begin = 0;
   returnValue->range = functionCount;
   theList = CreateMultifield(theEnv,functionCount);
   returnValue->value = theList;

   for (theFunction = GetFunctionList(theEnv), functionCount = 0;
        theFunction != NULL;
        theFunction = theFunction->next, functionCount++)
     {
      theList->contents[functionCount].lexemeValue = theFunction->callFunctionName;
     }
  }

/***************************************/
/* FuncallFunction: H/L access routine */
/*   for the funcall function.         */
/***************************************/
void FuncallFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   size_t j;
   UDFValue theArg;
   Expression theReference;
   const char *name;
   Multifield *theMultifield;
   struct expr *lastAdd = NULL, *nextAdd, *multiAdd;
   struct functionDefinition *theFunction = NULL;

   /*==================================*/
   /* Set up the default return value. */
   /*==================================*/

   returnValue->lexemeValue = FalseSymbol(theEnv);

   /*============================================*/
   /* Get the name of the function to be called. */
   /*============================================*/

   if (! UDFFirstArgument(context,LEXEME_BITS,&theArg))
     { return; }

   /*====================*/
   /* Find the function. */
   /*====================*/

   name = theArg.lexemeValue->contents;
   if (! GetFunctionReference(theEnv,name,&theReference))
     {
      ExpectedTypeError1(theEnv,"funcall",1,"function, deffunction, or generic function name");
      return;
     }

   /*====================================*/
   /* Functions with specialized parsers */
   /* cannot be used with funcall.       */
   /*====================================*/

   if (theReference.type == FCALL)
     {
      theFunction = FindFunction(theEnv,name);
      if (theFunction->parser != NULL)
        {
         ExpectedTypeError1(theEnv,"funcall",1,"function without specialized parser");
         return;
        }
     }

   /*======================================*/
   /* Add the arguments to the expression. */
   /*======================================*/

   ExpressionInstall(theEnv,&theReference);

   while (UDFHasNextArgument(context))
     {
      if (! UDFNextArgument(context,ANY_TYPE_BITS,&theArg))
        {
         ExpressionDeinstall(theEnv,&theReference);
         return;
        }

      switch(theArg.header->type)
        {
         case MULTIFIELD_TYPE:
           nextAdd = GenConstant(theEnv,FCALL,FindFunction(theEnv,"create$"));

           if (lastAdd == NULL)
             { theReference.argList = nextAdd; }
           else
             { lastAdd->nextArg = nextAdd; }
           lastAdd = nextAdd;

           multiAdd = NULL;
           theMultifield = theArg.multifieldValue;
           for (j = theArg.begin; j < (theArg.begin + theArg.range); j++)
             {
              nextAdd = GenConstant(theEnv,theMultifield->contents[j].header->type,
                                           theMultifield->contents[j].value);
              if (multiAdd == NULL)
                { lastAdd->argList = nextAdd; }
              else
                { multiAdd->nextArg = nextAdd; }
              multiAdd = nextAdd;
             }

           ExpressionInstall(theEnv,lastAdd);
           break;

         default:
           nextAdd = GenConstant(theEnv,theArg.header->type,theArg.value);
           if (lastAdd == NULL)
             { theReference.argList = nextAdd; }
           else
             { lastAdd->nextArg = nextAdd; }
           lastAdd = nextAdd;
           ExpressionInstall(theEnv,lastAdd);
           break;
        }
     }

   /*===========================================================*/
   /* Verify a deffunction has the correct number of arguments. */
   /*===========================================================*/

#if DEFFUNCTION_CONSTRUCT
   if (theReference.type == PCALL)
     {
      if (CheckDeffunctionCall(theEnv,(Deffunction *) theReference.value,CountArguments(theReference.argList)) == false)
        {
         PrintErrorID(theEnv,"MISCFUN",4,false);
         WriteString(theEnv,STDERR,"Function 'funcall' called with the wrong number of arguments for deffunction '");
         WriteString(theEnv,STDERR,DeffunctionName((Deffunction *) theReference.value));
         WriteString(theEnv,STDERR,"'.\n");
         ExpressionDeinstall(theEnv,&theReference);
         ReturnExpression(theEnv,theReference.argList);
         return;
        }
     }
#endif

   /*=========================================*/
   /* Verify the correct number of arguments. */
   /*=========================================*/

// TBD Support run time check of arguments
#if ! RUN_TIME
   if (theReference.type == FCALL)
     {
      if (CheckExpressionAgainstRestrictions(theEnv,&theReference,theFunction,name))
        {
         ExpressionDeinstall(theEnv,&theReference);
         ReturnExpression(theEnv,theReference.argList);
         return;
        }
     }
#endif

   /*======================*/
   /* Call the expression. */
   /*======================*/

   EvaluateExpression(theEnv,&theReference,returnValue);

   /*========================================*/
   /* Return the expression data structures. */
   /*========================================*/

   ExpressionDeinstall(theEnv,&theReference);
   ReturnExpression(theEnv,theReference.argList);
  }

/***********************************/
/* NewFunction: H/L access routine */
/*   for the new function.         */
/***********************************/
void NewFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   int theType;
   UDFValue theValue;
   const char *name;

   /*==================================*/
   /* Set up the default return value. */
   /*==================================*/

   returnValue->lexemeValue = FalseSymbol(theEnv);

   /*====================================*/
   /* Get the name of the language type. */
   /*====================================*/

   if (! UDFFirstArgument(context,SYMBOL_BIT,&theValue))
     { return; }

   /*=========================*/
   /* Find the language type. */
   /*=========================*/

   name = theValue.lexemeValue->contents;

   theType = FindLanguageType(theEnv,name);

   if (theType == -1)
     {
      ExpectedTypeError1(theEnv,"new",1,"external language");
      return;
     }

   /*====================================================*/
   /* Invoke the new function for the specific language. */
   /*====================================================*/

   if ((EvaluationData(theEnv)->ExternalAddressTypes[theType] != NULL) &&
       (EvaluationData(theEnv)->ExternalAddressTypes[theType]->newFunction != NULL))
     { (*EvaluationData(theEnv)->ExternalAddressTypes[theType]->newFunction)(context,returnValue); }
  }

/************************************/
/* CallFunction: H/L access routine */
/*   for the new function.          */
/************************************/
void CallFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   int theType;
   UDFValue theValue;
   const char *name;
   CLIPSExternalAddress *theEA;

   /*==================================*/
   /* Set up the default return value. */
   /*==================================*/

   returnValue->lexemeValue = FalseSymbol(theEnv);

   /*=========================*/
   /* Get the first argument. */
   /*=========================*/

   if (! UDFFirstArgument(context,SYMBOL_BIT | EXTERNAL_ADDRESS_BIT,&theValue))
     { return; }

   /*============================================*/
   /* If the first argument is a symbol, then it */
   /* should be an external language type.       */
   /*============================================*/

   if (theValue.header->type == SYMBOL_TYPE)
     {
      name = theValue.lexemeValue->contents;

      theType = FindLanguageType(theEnv,name);

      if (theType == -1)
        {
         ExpectedTypeError1(theEnv,"call",1,"external language symbol or external address");
         return;
        }

      /*====================================================================*/
      /* Invoke the call function for the specific language. Typically this */
      /* will invoke a static method of a class (specified with the third   */
      /* and second arguments to the call function.                         */
      /*====================================================================*/

      if ((EvaluationData(theEnv)->ExternalAddressTypes[theType] != NULL) &&
          (EvaluationData(theEnv)->ExternalAddressTypes[theType]->callFunction != NULL))
        { (*EvaluationData(theEnv)->ExternalAddressTypes[theType]->callFunction)(context,&theValue,returnValue); }

      return;
     }

   /*===============================================*/
   /* If the first argument is an external address, */
   /* then we can determine the external language   */
   /* type be examining the pointer.                */
   /*===============================================*/

   if (theValue.header->type == EXTERNAL_ADDRESS_TYPE)
     {
      theEA = theValue.externalAddressValue;

      theType = theEA->type;

      if ((EvaluationData(theEnv)->ExternalAddressTypes[theType] != NULL) &&
          (EvaluationData(theEnv)->ExternalAddressTypes[theType]->callFunction != NULL))
        { (*EvaluationData(theEnv)->ExternalAddressTypes[theType]->callFunction)(context,&theValue,returnValue); }

      return;
     }
  }

/*********************/
/* FindLanguageType: */
/*********************/
static int FindLanguageType(
  Environment *theEnv,
  const char *languageName)
  {
   int theType;

   for (theType = 0; theType < EvaluationData(theEnv)->numberOfAddressTypes; theType++)
     {
      if (strcmp(EvaluationData(theEnv)->ExternalAddressTypes[theType]->name,languageName) == 0)
        { return(theType); }
     }

   return -1;
  }

/************************************/
/* TimeFunction: H/L access routine */
/*   for the time function.         */
/************************************/
void TimeFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   /*==================*/
   /* Return the time. */
   /*==================*/

   returnValue->floatValue = CreateFloat(theEnv,gentime());
  }

/****************************************/
/* ConvertTime: Function for converting */
/*   time for local-time and gm-time.   */
/****************************************/
static void ConvertTime(
  Environment *theEnv,
  UDFValue *returnValue,
  struct tm *info)
  {
   returnValue->begin = 0;
   returnValue->range = 9;
   returnValue->value = CreateMultifield(theEnv,9L);
   
   returnValue->multifieldValue->contents[0].integerValue = CreateInteger(theEnv,info->tm_year + 1900);
   returnValue->multifieldValue->contents[1].integerValue = CreateInteger(theEnv,info->tm_mon + 1);
   returnValue->multifieldValue->contents[2].integerValue = CreateInteger(theEnv,info->tm_mday);
   returnValue->multifieldValue->contents[3].integerValue = CreateInteger(theEnv,info->tm_hour);
   returnValue->multifieldValue->contents[4].integerValue = CreateInteger(theEnv,info->tm_min);
   returnValue->multifieldValue->contents[5].integerValue = CreateInteger(theEnv,info->tm_sec);

   switch (info->tm_wday)
     {
      case 0:
        returnValue->multifieldValue->contents[6].lexemeValue = CreateSymbol(theEnv,"Sunday");
        break;

      case 1:
        returnValue->multifieldValue->contents[6].lexemeValue = CreateSymbol(theEnv,"Monday");
        break;

      case 2:
        returnValue->multifieldValue->contents[6].lexemeValue = CreateSymbol(theEnv,"Tuesday");
        break;

      case 3:
        returnValue->multifieldValue->contents[6].lexemeValue = CreateSymbol(theEnv,"Wednesday");
        break;

      case 4:
        returnValue->multifieldValue->contents[6].lexemeValue = CreateSymbol(theEnv,"Thursday");
        break;

      case 5:
        returnValue->multifieldValue->contents[6].lexemeValue = CreateSymbol(theEnv,"Friday");
        break;

      case 6:
        returnValue->multifieldValue->contents[6].lexemeValue = CreateSymbol(theEnv,"Saturday");
        break;
     }

   returnValue->multifieldValue->contents[7].integerValue = CreateInteger(theEnv,info->tm_yday);

   if (info->tm_isdst > 0)
     { returnValue->multifieldValue->contents[8].lexemeValue = TrueSymbol(theEnv); }
   else if (info->tm_isdst == 0)
     { returnValue->multifieldValue->contents[8].lexemeValue = FalseSymbol(theEnv); }
   else
     { returnValue->multifieldValue->contents[8].lexemeValue = CreateSymbol(theEnv,"UNKNOWN"); }
  }

/*****************************************/
/* LocalTimeFunction: H/L access routine */
/*   for the local-time function.        */
/*****************************************/
void LocalTimeFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   time_t rawtime;
   struct tm *info;

   /*=====================*/
   /* Get the local time. */
   /*=====================*/

   time(&rawtime);
   info = localtime(&rawtime);

   ConvertTime(theEnv,returnValue,info);
  }

/**************************************/
/* GMTimeFunction: H/L access routine */
/*   for the gm-time function.        */
/**************************************/
void GMTimeFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   time_t rawtime;
   struct tm *info;

   /*=====================*/
   /* Get the local time. */
   /*=====================*/

   time(&rawtime);
   info = gmtime(&rawtime);

   ConvertTime(theEnv,returnValue,info);
  }

/***************************************/
/* TimerFunction: H/L access routine   */
/*   for the timer function.           */
/***************************************/
void TimerFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   double startTime;
   UDFValue theArg;

   startTime = gentime();

   while (UDFHasNextArgument(context) &&
          (! GetHaltExecution(theEnv)))
     { UDFNextArgument(context,ANY_TYPE_BITS,&theArg); }

   returnValue->floatValue = CreateFloat(theEnv,gentime() - startTime);
  }

/***************************************/
/* SystemCommand: H/L access routine   */
/*   for the system function.          */
/***************************************/
void SystemCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   char *commandBuffer = NULL;
   size_t bufferPosition = 0;
   size_t bufferMaximum = 0;
   UDFValue tempValue;
   const char *theString;

   /*============================================================*/
   /* Concatenate the arguments together to form a single string */
   /* containing the command to be sent to the operating system. */
   /*============================================================*/

   while (UDFHasNextArgument(context))
     {
      if (! UDFNextArgument(context,LEXEME_BITS,&tempValue))
        {
         returnValue->lexemeValue = FalseSymbol(theEnv);
         return;
        }

     theString = tempValue.lexemeValue->contents;

     commandBuffer = AppendToString(theEnv,theString,commandBuffer,&bufferPosition,&bufferMaximum);
    }

   /*=======================================*/
   /* Execute the operating system command. */
   /*=======================================*/

   returnValue->integerValue = CreateInteger(theEnv,gensystem(theEnv,commandBuffer));

   /*==================================================*/
   /* Return the string buffer containing the command. */
   /*==================================================*/

   if (commandBuffer != NULL)
     { rm(theEnv,commandBuffer,bufferMaximum); }
  }

/****************************************/
/* GetErrorFunction: H/L access routine */
/*   for the geterror function.         */
/****************************************/
void GetErrorFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   CLIPSToUDFValue(&MiscFunctionData(theEnv)->errorCode,returnValue);
  }

/*****************/
/* SetErrorValue */
/*****************/
void SetErrorValue(
  Environment *theEnv,
  TypeHeader *theValue)
  {
   Release(theEnv,MiscFunctionData(theEnv)->errorCode.header);
   
   if (theValue == NULL)
     { MiscFunctionData(theEnv)->errorCode.lexemeValue = FalseSymbol(theEnv); }
   else
     { MiscFunctionData(theEnv)->errorCode.header = theValue; }
     
   Retain(theEnv,MiscFunctionData(theEnv)->errorCode.header);
  }

/*******************/
/* ClearErrorValue */
/*******************/
void ClearErrorValue(
  Environment *theEnv)
  {
   Release(theEnv,MiscFunctionData(theEnv)->errorCode.header);
   MiscFunctionData(theEnv)->errorCode.lexemeValue = FalseSymbol(theEnv);
   Retain(theEnv,MiscFunctionData(theEnv)->errorCode.header);
  }

/******************************************/
/* ClearErrorFunction: H/L access routine */
/*   for the clear-error function.        */
/******************************************/
void ClearErrorFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   CLIPSToUDFValue(&MiscFunctionData(theEnv)->errorCode,returnValue);
   ClearErrorValue(theEnv);
  }

/****************************************/
/* SetErrorFunction: H/L access routine */
/*   for the set-error function.        */
/****************************************/
void SetErrorFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   CLIPSValue cv;
   UDFValue theArg;
   
   if (! UDFFirstArgument(context,ANY_TYPE_BITS,&theArg))
     { return; }
     
   NormalizeMultifield(theEnv,&theArg);
   cv.value = theArg.value;
   SetErrorValue(theEnv,cv.header);
  }

/************************************/
/* VoidFunction: H/L access routine */
/*   for the void function.         */
/************************************/
void VoidFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   returnValue->voidValue = VoidConstant(theEnv);
  }