globle void ModFunction(
void *theEnv,
DATA_OBJECT_PTR result)
{
DATA_OBJECT item1, item2;
double fnum1, fnum2;
long long lnum1, lnum2;
if (EnvArgCountCheck(theEnv,"mod",EXACTLY,2) == -1)
{
result->type = INTEGER;
result->value = (void *) EnvAddLong(theEnv,0L);
return;
}
if (EnvArgTypeCheck(theEnv,"mod",1,INTEGER_OR_FLOAT,&item1) == FALSE)
{
result->type = INTEGER;
result->value = (void *) EnvAddLong(theEnv,0L);
return;
}
if (EnvArgTypeCheck(theEnv,"mod",2,INTEGER_OR_FLOAT,&item2) == FALSE)
{
result->type = INTEGER;
result->value = (void *) EnvAddLong(theEnv,0L);
return;
}
if (((item2.type == INTEGER) ? (ValueToLong(item2.value) == 0L) : FALSE) ||
((item2.type == FLOAT) ? ValueToDouble(item2.value) == 0.0 : FALSE))
{
DivideByZeroErrorMessage(theEnv,"mod");
SetEvaluationError(theEnv,TRUE);
result->type = INTEGER;
result->value = (void *) EnvAddLong(theEnv,0L);
return;
}
if ((item1.type == FLOAT) || (item2.type == FLOAT))
{
fnum1 = CoerceToDouble(item1.type,item1.value);
fnum2 = CoerceToDouble(item2.type,item2.value);
result->type = FLOAT;
result->value = (void *) EnvAddDouble(theEnv,fnum1 - (dtrunc(fnum1 / fnum2) * fnum2));
}
else
{
lnum1 = DOToLong(item1);
lnum2 = DOToLong(item2);
result->type = INTEGER;
result->value = (void *) EnvAddLong(theEnv,lnum1 - (lnum1 / lnum2) * lnum2);
}
}
globle double SetProfilePercentThresholdCommand(
void *theEnv)
{
DATA_OBJECT theValue;
double newThreshold;
if (EnvArgCountCheck(theEnv,"set-profile-percent-threshold",EXACTLY,1) == -1)
{ return(ProfileFunctionData(theEnv)->PercentThreshold); }
if (EnvArgTypeCheck(theEnv,"set-profile-percent-threshold",1,INTEGER_OR_FLOAT,&theValue) == FALSE)
{ return(ProfileFunctionData(theEnv)->PercentThreshold); }
if (GetType(theValue) == INTEGER)
{ newThreshold = (double) DOToLong(theValue); }
else
{ newThreshold = (double) DOToDouble(theValue); }
if ((newThreshold < 0.0) || (newThreshold > 100.0))
{
ExpectedTypeError1(theEnv,"set-profile-percent-threshold",1,
"number in the range 0 to 100");
return(-1.0);
}
return(SetProfilePercentThreshold(theEnv,newThreshold));
}
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 long RandomFunction(
void *theEnv)
{
int argCount;
long rv;
DATA_OBJECT theValue;
long begin, end;
/*====================================*/
/* The random function accepts either */
/* zero or two arguments. */
/*====================================*/
argCount = EnvRtnArgCount(theEnv);
if ((argCount != 0) && (argCount != 2))
{
PrintErrorID(theEnv,"MISCFUN",2,FALSE);
EnvPrintRouter(theEnv,WERROR,"Function random expected either 0 or 2 arguments\n");
}
/*========================================*/
/* Return the randomly generated integer. */
/*========================================*/
rv = genrand();
if (argCount == 2)
{
if (EnvArgTypeCheck(theEnv,"random",1,INTEGER,&theValue) == FALSE) return(rv);
begin = DOToLong(theValue);
if (EnvArgTypeCheck(theEnv,"random",2,INTEGER,&theValue) == FALSE) return(rv);
end = DOToLong(theValue);
if (end < begin)
{
PrintErrorID(theEnv,"MISCFUN",3,FALSE);
EnvPrintRouter(theEnv,WERROR,"Function random expected argument #1 to be less than argument #2\n");
return(rv);
}
rv = begin + (rv % ((end - begin) + 1));
}
return(rv);
}
globle intBool EvenpFunction(
void *theEnv)
{
DATA_OBJECT item;
long long num, halfnum;
if (EnvArgCountCheck(theEnv,"evenp",EXACTLY,1) == -1) return(FALSE);
if (EnvArgTypeCheck(theEnv,"evenp",1,INTEGER,&item) == FALSE) return(FALSE);
num = DOToLong(item);
halfnum = (num / 2) * 2;
if (num != halfnum) return(FALSE);
return(TRUE);
}
globle intBool OddpFunction(
void *theEnv,
EXEC_STATUS)
{
DATA_OBJECT item;
long long num, halfnum;
if (EnvArgCountCheck(theEnv,execStatus,"oddp",EXACTLY,1) == -1) return(FALSE);
if (EnvArgTypeCheck(theEnv,execStatus,"oddp",1,INTEGER,&item) == FALSE) return(FALSE);
num = DOToLong(item);
halfnum = (num / 2) * 2;
if (num == halfnum) return(FALSE);
return(TRUE);
}
globle void SeedFunction(
void *theEnv)
{
DATA_OBJECT theValue;
/*==========================================================*/
/* Check to see that a single integer argument is provided. */
/*==========================================================*/
if (EnvArgCountCheck(theEnv,"seed",EXACTLY,1) == -1) return;
if (EnvArgTypeCheck(theEnv,"seed",1,INTEGER,&theValue) == FALSE) return;
/*=============================================================*/
/* Seed the random number generator with the provided integer. */
/*=============================================================*/
genseed((int) DOToLong(theValue));
}
globle void RunCommand(
void *theEnv)
{
int numArgs;
long int runLimit = -1;
DATA_OBJECT argPtr;
if ((numArgs = EnvArgCountCheck(theEnv,"run",NO_MORE_THAN,1)) == -1) return;
if (numArgs == 0)
{ runLimit = -1; }
else if (numArgs == 1)
{
if (EnvArgTypeCheck(theEnv,"run",1,INTEGER,&argPtr) == FALSE) return;
runLimit = DOToLong(argPtr);
}
EnvRun(theEnv,runLimit);
return;
}
static long long GetFactsArgument(
void *theEnv,
int whichOne,
int argumentCount)
{
long long factIndex;
DATA_OBJECT theValue;
if (whichOne > argumentCount) return(UNSPECIFIED);
if (EnvArgTypeCheck(theEnv,(char*)"facts",whichOne,INTEGER,&theValue) == FALSE) return(INVALID);
factIndex = DOToLong(theValue);
if (factIndex < 0)
{
ExpectedTypeError1(theEnv,(char*)"facts",whichOne,(char*)"positive number");
SetHaltExecution(theEnv,TRUE);
SetEvaluationError(theEnv,TRUE);
return(INVALID);
}
return(factIndex);
}
globle void FactsCommand(
void *theEnv)
{
int argumentCount;
long long start = UNSPECIFIED, end = UNSPECIFIED, max = UNSPECIFIED;
struct defmodule *theModule;
DATA_OBJECT theValue;
int argOffset;
/*=========================================================*/
/* Determine the number of arguments to the facts command. */
/*=========================================================*/
if ((argumentCount = EnvArgCountCheck(theEnv,(char*)"facts",NO_MORE_THAN,4)) == -1) return;
/*==================================*/
/* The default module for the facts */
/* command is the current module. */
/*==================================*/
theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
/*==========================================*/
/* If no arguments were specified, then use */
/* the default values to list the facts. */
/*==========================================*/
if (argumentCount == 0)
{
EnvFacts(theEnv,WDISPLAY,theModule,start,end,max);
return;
}
/*========================================================*/
/* Since there are one or more arguments, see if a module */
/* or start index was specified as the first argument. */
/*========================================================*/
EnvRtnUnknown(theEnv,1,&theValue);
/*===============================================*/
/* If the first argument is a symbol, then check */
/* to see that a valid module was specified. */
/*===============================================*/
if (theValue.type == SYMBOL)
{
theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theValue.value));
if ((theModule == NULL) && (strcmp(ValueToString(theValue.value),"*") != 0))
{
SetEvaluationError(theEnv,TRUE);
CantFindItemErrorMessage(theEnv,(char*)"defmodule",ValueToString(theValue.value));
return;
}
if ((start = GetFactsArgument(theEnv,2,argumentCount)) == INVALID) return;
argOffset = 1;
}
/*================================================*/
/* Otherwise if the first argument is an integer, */
/* check to see that a valid index was specified. */
/*================================================*/
else if (theValue.type == INTEGER)
{
start = DOToLong(theValue);
if (start < 0)
{
ExpectedTypeError1(theEnv,(char*)"facts",1,(char*)"symbol or positive number");
SetHaltExecution(theEnv,TRUE);
SetEvaluationError(theEnv,TRUE);
return;
}
argOffset = 0;
}
/*==========================================*/
/* Otherwise the first argument is invalid. */
/*==========================================*/
else
{
ExpectedTypeError1(theEnv,(char*)"facts",1,(char*)"symbol or positive number");
SetHaltExecution(theEnv,TRUE);
SetEvaluationError(theEnv,TRUE);
return;
}
/*==========================*/
/* Get the other arguments. */
/*==========================*/
if ((end = GetFactsArgument(theEnv,2 + argOffset,argumentCount)) == INVALID) return;
if ((max = GetFactsArgument(theEnv,3 + argOffset,argumentCount)) == INVALID) return;
/*=================*/
/* List the facts. */
/*=================*/
EnvFacts(theEnv,WDISPLAY,theModule,start,end,max);
}
globle void LoopForCountFunction(
DATA_OBJECT_PTR loopResult)
{
DATA_OBJECT arg_ptr;
long iterationEnd;
LOOP_COUNTER_STACK *tmpCounter;
tmpCounter = get_struct(loopCounterStack);
tmpCounter->loopCounter = 0L;
tmpCounter->nxt = LoopCounterStack;
LoopCounterStack = tmpCounter;
if (ArgTypeCheck("loop-for-count",1,INTEGER,&arg_ptr) == FALSE)
{
loopResult->type = SYMBOL;
loopResult->value = FalseSymbol;
LoopCounterStack = tmpCounter->nxt;
rtn_struct(loopCounterStack,tmpCounter);
return;
}
tmpCounter->loopCounter = DOToLong(arg_ptr);
if (ArgTypeCheck("loop-for-count",2,INTEGER,&arg_ptr) == FALSE)
{
loopResult->type = SYMBOL;
loopResult->value = FalseSymbol;
LoopCounterStack = tmpCounter->nxt;
rtn_struct(loopCounterStack,tmpCounter);
return;
}
iterationEnd = DOToLong(arg_ptr);
while ((tmpCounter->loopCounter <= iterationEnd) &&
(HaltExecution != TRUE))
{
if ((BreakFlag == TRUE) || (ReturnFlag == TRUE))
break;
CurrentEvaluationDepth++;
RtnUnknown(3,&arg_ptr);
CurrentEvaluationDepth--;
if (ReturnFlag == TRUE)
{ PropagateReturnValue(&arg_ptr); }
PeriodicCleanup(FALSE,TRUE);
if ((BreakFlag == TRUE) || (ReturnFlag == TRUE))
break;
tmpCounter->loopCounter++;
}
BreakFlag = FALSE;
if (ReturnFlag == TRUE)
{
loopResult->type = arg_ptr.type;
loopResult->value = arg_ptr.value;
loopResult->begin = arg_ptr.begin;
loopResult->end = arg_ptr.end;
}
else
{
loopResult->type = SYMBOL;
loopResult->value = FalseSymbol;
}
LoopCounterStack = tmpCounter->nxt;
rtn_struct(loopCounterStack,tmpCounter);
}
globle void LoopForCountFunction(
void *theEnv,
DATA_OBJECT_PTR loopResult)
{
DATA_OBJECT arg_ptr;
long long iterationEnd;
LOOP_COUNTER_STACK *tmpCounter;
struct garbageFrame newGarbageFrame;
struct garbageFrame *oldGarbageFrame;
tmpCounter = get_struct(theEnv,loopCounterStack);
tmpCounter->loopCounter = 0L;
tmpCounter->nxt = ProcedureFunctionData(theEnv)->LoopCounterStack;
ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter;
if (EnvArgTypeCheck(theEnv,"loop-for-count",1,INTEGER,&arg_ptr) == FALSE)
{
loopResult->type = SYMBOL;
loopResult->value = EnvFalseSymbol(theEnv);
ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter->nxt;
rtn_struct(theEnv,loopCounterStack,tmpCounter);
return;
}
tmpCounter->loopCounter = DOToLong(arg_ptr);
if (EnvArgTypeCheck(theEnv,"loop-for-count",2,INTEGER,&arg_ptr) == FALSE)
{
loopResult->type = SYMBOL;
loopResult->value = EnvFalseSymbol(theEnv);
ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter->nxt;
rtn_struct(theEnv,loopCounterStack,tmpCounter);
return;
}
oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame;
memset(&newGarbageFrame,0,sizeof(struct garbageFrame));
newGarbageFrame.priorFrame = oldGarbageFrame;
UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame;
iterationEnd = DOToLong(arg_ptr);
while ((tmpCounter->loopCounter <= iterationEnd) &&
(EvaluationData(theEnv)->HaltExecution != TRUE))
{
if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE))
break;
EnvRtnUnknown(theEnv,3,&arg_ptr);
if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE))
break;
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
tmpCounter->loopCounter++;
}
ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)
{
loopResult->type = arg_ptr.type;
loopResult->value = arg_ptr.value;
loopResult->begin = arg_ptr.begin;
loopResult->end = arg_ptr.end;
}
else
{
loopResult->type = SYMBOL;
loopResult->value = EnvFalseSymbol(theEnv);
}
ProcedureFunctionData(theEnv)->LoopCounterStack = tmpCounter->nxt;
rtn_struct(theEnv,loopCounterStack,tmpCounter);
RestorePriorGarbageFrame(theEnv,&newGarbageFrame,oldGarbageFrame,loopResult);
CallPeriodicTasks(theEnv);
}
Values data_object_to_values( dataObject& clipsdo ) {
Values values;
std::string s;
double d;
long int i;
void* p;
void* mfptr;
long int end;
switch ( GetType( clipsdo ) ) {
case RVOID:
return values;
case STRING:
s = DOToString( clipsdo );
values.push_back( Value( s, TYPE_STRING ) );
return values;
case INSTANCE_NAME:
s = DOToString( clipsdo );
values.push_back( Value( s, TYPE_INSTANCE_NAME ) );
return values;
case SYMBOL:
s = DOToString( clipsdo );
values.push_back( Value( s, TYPE_SYMBOL ) );
return values;
case FLOAT:
d = DOToDouble( clipsdo );
values.push_back( Value( d ) );
return values;
case INTEGER:
i = DOToLong( clipsdo );
values.push_back( Value( i ) );
return values;
case INSTANCE_ADDRESS:
p = DOToPointer( clipsdo );
values.push_back( Value( p, TYPE_INSTANCE_ADDRESS ) );
return values;
case EXTERNAL_ADDRESS:
p = (((struct externalAddressHashNode *) (clipsdo.value))->externalAddress);
values.push_back( Value( p, TYPE_EXTERNAL_ADDRESS ) );
return values;
case MULTIFIELD:
end = GetDOEnd( clipsdo );
mfptr = GetValue( clipsdo );
for ( int iter = GetDOBegin( clipsdo ); iter <= end; iter++ ) {
switch ( GetMFType( mfptr, iter ) ) {
case STRING:
s = ValueToString( GetMFValue( mfptr, iter ) );
values.push_back( Value( s, TYPE_STRING ) );
break;
case SYMBOL:
s = ValueToString( GetMFValue( mfptr, iter ) );
values.push_back( Value( s, TYPE_SYMBOL ) );
break;
case FLOAT:
d = ValueToDouble( GetMFValue( mfptr, iter ) );
values.push_back( Value( d ) );
break;
case INTEGER:
i = ValueToLong( GetMFValue( mfptr, iter ) );
values.push_back( Value( i ) );
break;
case EXTERNAL_ADDRESS:
p = ValueToExternalAddress( GetMFValue( mfptr, iter ) );
values.push_back( Value( p, TYPE_EXTERNAL_ADDRESS ) );
break;
default:
throw std::logic_error( "clipsmm::data_object_to_values: Unhandled multifield type" );
}
}
return values;
default:
//std::cout << std::endl << "Type: " << GetType(clipsdo) << std::endl;
throw std::logic_error( "clipsmm::data_object_to_values: Unhandled data object type" );
}
}