/*******************************************************/ /* "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 . */ /* */ /* 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 #include #include #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); }