void get_argument(void* env, int argposition, void *& value) {
struct dataObject obj;
EnvRtnUnknown(env, argposition, &obj);
if (obj.type == EXTERNAL_ADDRESS) {
value = (((struct externalAddressHashNode *) (obj.value))->externalAddress);
}
}
globle char *GetLogicalName(
void *theEnv,
int whichArgument,
char *defaultLogicalName)
{
char *logicalName;
DATA_OBJECT result;
EnvRtnUnknown(theEnv,whichArgument,&result);
if ((GetType(result) == SYMBOL) ||
(GetType(result) == STRING) ||
(GetType(result) == INSTANCE_NAME))
{
logicalName = ValueToString(result.value);
if ((strcmp(logicalName,"t") == 0) || (strcmp(logicalName,"T") == 0))
{ logicalName = defaultLogicalName; }
}
else if (GetType(result) == FLOAT)
{
logicalName = ValueToString(EnvAddSymbol(theEnv,FloatToString(theEnv,DOToDouble(result))));
}
else if (GetType(result) == INTEGER)
{
logicalName = ValueToString(EnvAddSymbol(theEnv,LongIntegerToString(theEnv,DOToLong(result))));
}
else
{ logicalName = NULL; }
return(logicalName);
}
globle int SetBetaMemoryResizingCommand(
void *theEnv)
{
int oldValue;
DATA_OBJECT argPtr;
oldValue = EnvGetBetaMemoryResizing(theEnv);
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (EnvArgCountCheck(theEnv,"set-beta-memory-resizing",EXACTLY,1) == -1)
{ return(oldValue); }
/*=================================================*/
/* The symbol FALSE disables beta memory resizing. */
/* Any other value enables beta memory resizing. */
/*=================================================*/
EnvRtnUnknown(theEnv,1,&argPtr);
if ((argPtr.value == EnvFalseSymbol(theEnv)) && (argPtr.type == SYMBOL))
{ EnvSetBetaMemoryResizing(theEnv,FALSE); }
else
{ EnvSetBetaMemoryResizing(theEnv,TRUE); }
/*=======================*/
/* Return the old value. */
/*=======================*/
return(oldValue);
}
void get_argument(void* env, int argposition, void *& value) {
struct dataObject obj;
EnvRtnUnknown(env, argposition, &obj);
if (obj.type == EXTERNAL_ADDRESS) {
value = obj.value;
}
}
globle int SetIncrementalResetCommand(
void *theEnv,
EXEC_STATUS)
{
int oldValue;
DATA_OBJECT argPtr;
struct defmodule *theModule;
oldValue = EnvGetIncrementalReset(theEnv,execStatus);
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (EnvArgCountCheck(theEnv,execStatus,"set-incremental-reset",EXACTLY,1) == -1)
{ return(oldValue); }
/*=========================================*/
/* The incremental reset behavior can't be */
/* changed when rules are loaded. */
/*=========================================*/
SaveCurrentModule(theEnv,execStatus);
for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,NULL);
theModule != NULL;
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,theModule))
{
EnvSetCurrentModule(theEnv,execStatus,(void *) theModule);
if (EnvGetNextDefrule(theEnv,execStatus,NULL) != NULL)
{
RestoreCurrentModule(theEnv,execStatus);
PrintErrorID(theEnv,execStatus,"INCRRSET",1,FALSE);
EnvPrintRouter(theEnv,execStatus,WERROR,"The incremental reset behavior cannot be changed with rules loaded.\n");
SetEvaluationError(theEnv,execStatus,TRUE);
return(oldValue);
}
}
RestoreCurrentModule(theEnv,execStatus);
/*==================================================*/
/* The symbol FALSE disables incremental reset. Any */
/* other value enables incremental reset. */
/*==================================================*/
EnvRtnUnknown(theEnv,execStatus,1,&argPtr);
if ((argPtr.value == EnvFalseSymbol(theEnv,execStatus)) && (argPtr.type == SYMBOL))
{ EnvSetIncrementalReset(theEnv,execStatus,FALSE); }
else
{ EnvSetIncrementalReset(theEnv,execStatus,TRUE); }
/*=======================*/
/* Return the old value. */
/*=======================*/
return(oldValue);
}
void get_argument(void* env, int argposition, Value& value) {
struct dataObject obj;
EnvRtnUnknown(env, argposition, &obj);
Values values = data_object_to_values(obj);
if (values.size() > 0) {
value = values[0];
}
}
globle intBool PointerpFunction(
void *theEnv)
{
DATA_OBJECT item;
if (EnvArgCountCheck(theEnv,"pointerp",EXACTLY,1) == -1) return(FALSE);
EnvRtnUnknown(theEnv,1,&item);
if (GetType(item) != EXTERNAL_ADDRESS) return(FALSE);
return(TRUE);
}
globle void ReturnFunction(
void *theEnv,
DATA_OBJECT_PTR result)
{
if (EnvRtnArgCount(theEnv) == 0)
{
result->type = RVOID;
result->value = EnvFalseSymbol(theEnv);
}
else
EnvRtnUnknown(theEnv,1,result);
ProcedureFunctionData(theEnv)->ReturnFlag = TRUE;
}
globle intBool FuzzyvaluepFunction(
void *theEnv)
{
DATA_OBJECT valstruct;
if (EnvArgCountCheck(theEnv,"fuzzyvaluep",EXACTLY,1) == -1) return(FALSE);
EnvRtnUnknown(theEnv,1,&valstruct);
if (GetType(valstruct) != FUZZY_VALUE) return(FALSE);
return(TRUE);
}
globle intBool MultifieldpFunction(
void *theEnv)
{
DATA_OBJECT item;
if (EnvArgCountCheck(theEnv,"multifieldp",EXACTLY,1) == -1) return(FALSE);
EnvRtnUnknown(theEnv,1,&item);
if (GetType(item) != MULTIFIELD) return(FALSE);
return(TRUE);
}
globle intBool IntegerpFunction(
void *theEnv)
{
DATA_OBJECT item;
if (EnvArgCountCheck(theEnv,"integerp",EXACTLY,1) == -1) return(FALSE);
EnvRtnUnknown(theEnv,1,&item);
if (GetType(item) != INTEGER) return(FALSE);
return(TRUE);
}
globle void GetFactListFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
struct defmodule *theModule;
DATA_OBJECT result;
int numArgs;
/*===========================================*/
/* Determine if a module name was specified. */
/*===========================================*/
if ((numArgs = EnvArgCountCheck(theEnv,"get-fact-list",NO_MORE_THAN,1)) == -1)
{
EnvSetMultifieldErrorValue(theEnv,returnValue);
return;
}
if (numArgs == 1)
{
EnvRtnUnknown(theEnv,1,&result);
if (GetType(result) != SYMBOL)
{
EnvSetMultifieldErrorValue(theEnv,returnValue);
ExpectedTypeError1(theEnv,"get-fact-list",1,"defmodule name");
return;
}
if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL)
{
if (strcmp("*",DOToString(result)) != 0)
{
EnvSetMultifieldErrorValue(theEnv,returnValue);
ExpectedTypeError1(theEnv,"get-fact-list",1,"defmodule name");
return;
}
theModule = NULL;
}
}
else
{ theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); }
/*=====================*/
/* Get the constructs. */
/*=====================*/
EnvGetFactList(theEnv,returnValue,theModule);
}
globle intBool StringpFunction(
void *theEnv)
{
DATA_OBJECT item;
if (EnvArgCountCheck(theEnv,(char*)"stringp",EXACTLY,1) == -1) return(FALSE);
EnvRtnUnknown(theEnv,1,&item);
if (GetType(item) == STRING)
{ return(TRUE); }
else
{ return(FALSE); }
}
globle intBool FloatpFunction(
void *theEnv)
{
DATA_OBJECT item;
if (EnvArgCountCheck(theEnv,"floatp",EXACTLY,1) == -1) return(FALSE);
EnvRtnUnknown(theEnv,1,&item);
if (GetType(item) == FLOAT)
{ return(TRUE); }
else
{ return(FALSE); }
}
globle intBool NumberpFunction(
void *theEnv)
{
DATA_OBJECT item;
if (EnvArgCountCheck(theEnv,"numberp",EXACTLY,1) == -1) return(FALSE);
EnvRtnUnknown(theEnv,1,&item);
if ((GetType(item) == FLOAT) || (GetType(item) == INTEGER))
{ return(TRUE); }
else
{ return(FALSE); }
}
globle intBool LexemepFunction(
void *theEnv)
{
DATA_OBJECT item;
if (EnvArgCountCheck(theEnv,"lexemep",EXACTLY,1) == -1) return(FALSE);
EnvRtnUnknown(theEnv,1,&item);
if ((GetType(item) == SYMBOL) || (GetType(item) == STRING))
{ return(TRUE); }
else
{ return(FALSE); }
}
globle intBool SymbolpFunction(
void *theEnv)
{
DATA_OBJECT item;
if (EnvArgCountCheck(theEnv,"symbolp",EXACTLY,1) == -1) return(FALSE);
EnvRtnUnknown(theEnv,1,&item);
if (GetType(item) == SYMBOL)
{ return(TRUE); }
else
{ return(FALSE); }
}
globle struct defmodule *GetModuleName(
void *theEnv,
char *functionName,
int whichArgument,
int *error)
{
DATA_OBJECT result;
struct defmodule *theModule;
*error = FALSE;
/*========================*/
/* Retrieve the argument. */
/*========================*/
EnvRtnUnknown(theEnv,whichArgument,&result);
/*=================================*/
/* A module name must be a symbol. */
/*=================================*/
if (GetType(result) != SYMBOL)
{
ExpectedTypeError1(theEnv,functionName,whichArgument,"defmodule name");
*error = TRUE;
return(NULL);
}
/*=======================================*/
/* Check to see that the symbol actually */
/* corresponds to a defined module. */
/*=======================================*/
if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL)
{
if (strcmp("*",DOToString(result)) != 0)
{
ExpectedTypeError1(theEnv,functionName,whichArgument,"defmodule name");
*error = TRUE;
}
return(NULL);
}
/*=================================*/
/* Return a pointer to the module. */
/*=================================*/
return(theModule);
}
globle char *GetFileName(
void *theEnv,
char *functionName,
int whichArgument)
{
DATA_OBJECT result;
EnvRtnUnknown(theEnv,whichArgument,&result);
if ((GetType(result) != STRING) && (GetType(result) != SYMBOL))
{
ExpectedTypeError1(theEnv,functionName,whichArgument,"file name");
return(NULL);
}
return(DOToString(result));
}
globle int SetFactDuplicationCommand(
void *theEnv)
{
int oldValue;
DATA_OBJECT theValue;
/*=====================================================*/
/* Get the old value of the fact duplication behavior. */
/*=====================================================*/
oldValue = EnvGetFactDuplication(theEnv);
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (EnvArgCountCheck(theEnv,"set-fact-duplication",EXACTLY,1) == -1)
{
return(oldValue);
}
/*========================*/
/* Evaluate the argument. */
/*========================*/
EnvRtnUnknown(theEnv,1,&theValue);
/*===============================================================*/
/* If the argument evaluated to FALSE, then the fact duplication */
/* behavior is disabled, otherwise it is enabled. */
/*===============================================================*/
if ((theValue.value == EnvFalseSymbol(theEnv)) && (theValue.type == SYMBOL))
{
EnvSetFactDuplication(theEnv,FALSE);
}
else
{
EnvSetFactDuplication(theEnv,TRUE);
}
/*========================================================*/
/* Return the old value of the fact duplication behavior. */
/*========================================================*/
return(oldValue);
}
globle int SetIncrementalResetCommand(
void *theEnv)
{
int oldValue;
DATA_OBJECT argPtr;
oldValue = EnvGetIncrementalReset(theEnv);
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (EnvArgCountCheck(theEnv,"set-incremental-reset",EXACTLY,1) == -1)
{ return(oldValue); }
/*=========================================*/
/* The incremental reset behavior can't be */
/* changed when rules are loaded. */
/*=========================================*/
if (EnvGetNextDefrule(theEnv,NULL) != NULL)
{
PrintErrorID(theEnv,"INCRRSET",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"The incremental reset behavior cannot be changed with rules loaded.\n");
SetEvaluationError(theEnv,TRUE);
return(oldValue);
}
/*==================================================*/
/* The symbol FALSE disables incremental reset. Any */
/* other value enables incremental reset. */
/*==================================================*/
EnvRtnUnknown(theEnv,1,&argPtr);
if ((argPtr.value == EnvFalseSymbol(theEnv)) && (argPtr.type == SYMBOL))
{ EnvSetIncrementalReset(theEnv,FALSE); }
else
{ EnvSetIncrementalReset(theEnv,TRUE); }
/*=======================*/
/* Return the old value. */
/*=======================*/
return(oldValue);
}
globle double TimerFunction(
void *theEnv)
{
int numa, i;
double startTime;
DATA_OBJECT returnValue;
startTime = gentime();
numa = EnvRtnArgCount(theEnv);
i = 1;
while ((i <= numa) && (GetHaltExecution(theEnv) != TRUE))
{
EnvRtnUnknown(theEnv,i,&returnValue);
i++;
}
return(gentime() - startTime);
}
globle int SSCCommand(
void *theEnv)
{
int oldValue;
DATA_OBJECT arg_ptr;
oldValue = EnvGetStaticConstraintChecking(theEnv);
if (EnvArgCountCheck(theEnv,"set-static-constraint-checking",EXACTLY,1) == -1)
{ return(oldValue); }
EnvRtnUnknown(theEnv,1,&arg_ptr);
if ((arg_ptr.value == EnvFalseSymbol(theEnv)) && (arg_ptr.type == SYMBOL))
{ EnvSetStaticConstraintChecking(theEnv,FALSE); }
else
{ EnvSetStaticConstraintChecking(theEnv,TRUE); }
return(oldValue);
}
globle struct fact *GetFactAddressOrIndexArgument(
void *theEnv,
const char *theFunction,
int position,
int noFactError)
{
DATA_OBJECT item;
long long factIndex;
struct fact *theFact;
char tempBuffer[20];
EnvRtnUnknown(theEnv,position,&item);
if (GetType(item) == FACT_ADDRESS)
{
if (((struct fact *) GetValue(item))->garbage) return(NULL);
else return (((struct fact *) GetValue(item)));
}
else if (GetType(item) == INTEGER)
{
factIndex = ValueToLong(item.value);
if (factIndex < 0)
{
ExpectedTypeError1(theEnv,theFunction,position,"fact-address or fact-index");
return(NULL);
}
theFact = FindIndexedFact(theEnv,factIndex);
if ((theFact == NULL) && noFactError)
{
gensprintf(tempBuffer,"f-%lld",factIndex);
CantFindItemErrorMessage(theEnv,"fact",tempBuffer);
return(NULL);
}
return(theFact);
}
ExpectedTypeError1(theEnv,theFunction,position,"fact-address or fact-index");
return(NULL);
}
globle long int LengthFunction(
void *theEnv)
{
DATA_OBJECT item;
/*====================================================*/
/* The length$ function expects exactly one argument. */
/*====================================================*/
if (EnvArgCountCheck(theEnv,"length$",EXACTLY,1) == -1) return(-1L);
EnvRtnUnknown(theEnv,1,&item);
/*====================================================*/
/* If the argument is a string or symbol, then return */
/* the number of characters in the argument. */
/*====================================================*/
if ((GetType(item) == STRING) || (GetType(item) == SYMBOL))
{
return( (long) strlen(DOToString(item)));
}
/*====================================================*/
/* If the argument is a multifield value, then return */
/* the number of fields in the argument. */
/*====================================================*/
if (GetType(item) == MULTIFIELD)
{
return ( (long) GetDOLength(item));
}
/*=============================================*/
/* If the argument wasn't a string, symbol, or */
/* multifield value, then generate an error. */
/*=============================================*/
SetEvaluationError(theEnv,TRUE);
ExpectedTypeError2(theEnv,"length$",1);
return(-1L);
}
globle char *GetConstructName(
void *theEnv,
char *functionName,
char *constructType)
{
DATA_OBJECT result;
if (EnvRtnArgCount(theEnv) != 1)
{
ExpectedCountError(theEnv,functionName,EXACTLY,1);
return(NULL);
}
EnvRtnUnknown(theEnv,1,&result);
if (GetType(result) != SYMBOL)
{
ExpectedTypeError1(theEnv,functionName,1,constructType);
return(NULL);
}
return(DOToString(result));
}
globle long long FactIndexFunction(
void *theEnv)
{
DATA_OBJECT item;
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (EnvArgCountCheck(theEnv,(char*)"fact-index",EXACTLY,1) == -1) return(-1LL);
/*========================*/
/* Evaluate the argument. */
/*========================*/
EnvRtnUnknown(theEnv,1,&item);
/*======================================*/
/* The argument must be a fact address. */
/*======================================*/
if (GetType(item) != FACT_ADDRESS)
{
ExpectedTypeError1(theEnv,(char*)"fact-index",1,(char*)"fact-address");
return(-1L);
}
/*================================================*/
/* Return the fact index associated with the fact */
/* address. If the fact has been retracted, then */
/* return -1 for the fact index. */
/*================================================*/
if (((struct fact *) GetValue(item))->garbage) return(-1LL);
return (EnvFactIndex(theEnv,GetValue(item)));
}
globle int SetAutoFloatDividendCommand(
void *theEnv)
{
int oldValue;
DATA_OBJECT theArgument;
/*===============================*/
/* Remember the present setting. */
/*===============================*/
oldValue = BasicMathFunctionData(theEnv)->AutoFloatDividend;
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (EnvArgCountCheck(theEnv,"set-auto-float-dividend",EXACTLY,1) == -1)
{ return(oldValue); }
EnvRtnUnknown(theEnv,1,&theArgument);
/*============================================================*/
/* The symbol FALSE disables the auto float dividend feature. */
/*============================================================*/
if ((theArgument.value == EnvFalseSymbol(theEnv)) && (theArgument.type == SYMBOL))
{ BasicMathFunctionData(theEnv)->AutoFloatDividend = FALSE; }
else
{ BasicMathFunctionData(theEnv)->AutoFloatDividend = TRUE; }
/*======================================*/
/* Return the old value of the feature. */
/*======================================*/
return(oldValue);
}
globle int SetResetGlobalsCommand(
void *theEnv)
{
int oldValue;
DATA_OBJECT arg_ptr;
/*===========================================*/
/* Remember the old value of this attribute. */
/*===========================================*/
oldValue = EnvGetResetGlobals(theEnv);
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (EnvArgCountCheck(theEnv,"set-reset-globals",EXACTLY,1) == -1)
{ return(oldValue); }
/*===========================================*/
/* Determine the new value of the attribute. */
/*===========================================*/
EnvRtnUnknown(theEnv,1,&arg_ptr);
if ((arg_ptr.value == EnvFalseSymbol(theEnv)) && (arg_ptr.type == SYMBOL))
{ EnvSetResetGlobals(theEnv,FALSE); }
else
{ EnvSetResetGlobals(theEnv,TRUE); }
/*========================================*/
/* Return the old value of the attribute. */
/*========================================*/
return(oldValue);
}
globle void PPFactFunction(
void *theEnv)
{
struct fact *theFact;
int numberOfArguments;
const char *logicalName = NULL; /* Avoids warning */
int ignoreDefaults = FALSE;
DATA_OBJECT theArg;
if ((numberOfArguments = EnvArgRangeCheck(theEnv,"ppfact",1,3)) == -1) return;
theFact = GetFactAddressOrIndexArgument(theEnv,"ppfact",1,TRUE);
if (theFact == NULL) return;
/*===============================================================*/
/* Determine the logical name to which the fact will be printed. */
/*===============================================================*/
if (numberOfArguments == 1)
{ logicalName = STDOUT; }
else
{
logicalName = GetLogicalName(theEnv,2,STDOUT);
if (logicalName == NULL)
{
IllegalLogicalNameMessage(theEnv,"ppfact");
EnvSetHaltExecution(theEnv,TRUE);
EnvSetEvaluationError(theEnv,TRUE);
return;
}
}
/*=========================================*/
/* Should slot values be printed if they */
/* are the same as the default slot value. */
/*=========================================*/
if (numberOfArguments == 3)
{
EnvRtnUnknown(theEnv,3,&theArg);
if ((theArg.value == EnvFalseSymbol(theEnv)) && (theArg.type == SYMBOL))
{ ignoreDefaults = FALSE; }
else
{ ignoreDefaults = TRUE; }
}
/*============================================================*/
/* Determine if any router recognizes the output destination. */
/*============================================================*/
if (strcmp(logicalName,"nil") == 0)
{ return; }
else if (QueryRouters(theEnv,logicalName) == FALSE)
{
UnrecognizedRouterMessage(theEnv,logicalName);
return;
}
EnvPPFact(theEnv,theFact,logicalName,ignoreDefaults);
}
