/******************************************************************************
NAME : QueryDoForAllInstances
DESCRIPTION : Finds all sets of instances which satisfy the query and
executes a user-function for each set as it is found
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query class-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every instance set. Also, the action is
executed for every instance set.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See ParseQueryAction()
******************************************************************************/
globle void QueryDoForAllInstances(
void *theEnv,
EXEC_STATUS,
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
unsigned rcnt;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv,execStatus);
qclasses = DetermineQueryClasses(theEnv,execStatus,GetFirstArgument()->nextArg->nextArg,
"do-for-all-instances",&rcnt);
if (qclasses == NULL)
return;
PushQueryCore(theEnv,execStatus);
InstanceQueryData(theEnv,execStatus)->QueryCore = get_struct(theEnv,execStatus,query_core);
InstanceQueryData(theEnv,execStatus)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,execStatus,(sizeof(INSTANCE_TYPE *) * rcnt));
InstanceQueryData(theEnv,execStatus)->QueryCore->query = GetFirstArgument();
InstanceQueryData(theEnv,execStatus)->QueryCore->action = GetFirstArgument()->nextArg;
InstanceQueryData(theEnv,execStatus)->QueryCore->result = result;
ValueInstall(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->result);
TestEntireChain(theEnv,execStatus,qclasses,0);
ValueDeinstall(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->result);
PropagateReturnValue(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->result);
InstanceQueryData(theEnv,execStatus)->AbortQuery = FALSE;
ProcedureFunctionData(theEnv,execStatus)->BreakFlag = FALSE;
rm(theEnv,execStatus,(void *) InstanceQueryData(theEnv,execStatus)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(theEnv,execStatus,query_core,InstanceQueryData(theEnv,execStatus)->QueryCore);
PopQueryCore(theEnv,execStatus);
DeleteQueryClasses(theEnv,execStatus,qclasses);
}
/******************************************************************************
NAME : QueryDoForAllFacts
DESCRIPTION : Finds all sets of facts which satisfy the query and
executes a user-function for each set as it is found
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query template-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every fact set. Also, the action is
executed for every fact set.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See FactParseQueryAction()
******************************************************************************/
globle void QueryDoForAllFacts(
void *theEnv,
DATA_OBJECT *result)
{
QUERY_TEMPLATE *qtemplates;
unsigned rcnt;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv);
qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg,
"do-for-all-facts",&rcnt);
if (qtemplates == NULL)
return;
PushQueryCore(theEnv);
FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt));
FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
FactQueryData(theEnv)->QueryCore->result = result;
ValueInstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
TestEntireChain(theEnv,qtemplates,0);
ValueDeinstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
PropagateReturnValue(theEnv,FactQueryData(theEnv)->QueryCore->result);
FactQueryData(theEnv)->AbortQuery = FALSE;
ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt));
rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
PopQueryCore(theEnv);
DeleteQueryTemplates(theEnv,qtemplates);
}
/******************************************************************************
NAME : QueryDoForAllInstances
DESCRIPTION : Finds all sets of instances which satisfy the query and
executes a user-function for each set as it is found
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query class-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every instance set. Also, the action is
executed for every instance set.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See ParseQueryAction()
******************************************************************************/
globle void QueryDoForAllInstances(
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
int rcnt;
result->type = SYMBOL;
result->value = FalseSymbol;
qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg->nextArg,
"do-for-all-instances",&rcnt);
if (qclasses == NULL)
return;
PushQueryCore();
QueryCore = get_struct(query_core);
QueryCore->solns = (INSTANCE_TYPE **) gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
QueryCore->query = GetFirstArgument();
QueryCore->action = GetFirstArgument()->nextArg;
QueryCore->result = result;
ValueInstall(QueryCore->result);
TestEntireChain(qclasses,0);
ValueDeinstall(QueryCore->result);
PropagateReturnValue(QueryCore->result);
AbortQuery = FALSE;
BreakFlag = FALSE;
rm((void *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(query_core,QueryCore);
PopQueryCore();
DeleteQueryClasses(qclasses);
}
globle void WhileFunction(
DATA_OBJECT_PTR returnValue)
{
DATA_OBJECT theResult;
/*====================================================*/
/* Evaluate the body of the while loop as long as the */
/* while condition evaluates to a non-FALSE value. */
/*====================================================*/
CurrentEvaluationDepth++;
RtnUnknown(1,&theResult);
while (((theResult.value != FalseSymbol) ||
(theResult.type != SYMBOL)) &&
(HaltExecution != TRUE))
{
if ((BreakFlag == TRUE) || (ReturnFlag == TRUE))
break;
RtnUnknown(2,&theResult);
CurrentEvaluationDepth--;
if (ReturnFlag == TRUE)
{ PropagateReturnValue(&theResult); }
PeriodicCleanup(FALSE,TRUE);
CurrentEvaluationDepth++;
if ((BreakFlag == TRUE) || (ReturnFlag == TRUE))
break;
RtnUnknown(1,&theResult);
}
CurrentEvaluationDepth--;
/*=====================================================*/
/* Reset the break flag. The return flag is not reset */
/* because the while loop is probably contained within */
/* a deffunction or RHS of a rule which needs to be */
/* returned from as well. */
/*=====================================================*/
BreakFlag = FALSE;
/*====================================================*/
/* If the return command was issued, then return that */
/* value, otherwise return the symbol FALSE. */
/*====================================================*/
if (ReturnFlag == TRUE)
{
returnValue->type = theResult.type;
returnValue->value = theResult.value;
returnValue->begin = theResult.begin;
returnValue->end = theResult.end;
}
else
{
returnValue->type = SYMBOL;
returnValue->value = FalseSymbol;
}
}
/******************************************************************************
NAME : DelayedQueryDoForAllInstances
DESCRIPTION : Finds all sets of instances which satisfy the query and
and exceutes a user-action for each set
This function differs from QueryDoForAllInstances() in
that it forms the complete list of query satisfactions
BEFORE executing any actions.
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query class-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every instance set. The action is executed
for evry query satisfaction.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See ParseQueryNoAction()
******************************************************************************/
globle void DelayedQueryDoForAllInstances(
void *theEnv,
EXEC_STATUS,
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
unsigned rcnt;
register unsigned i;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv,execStatus);
qclasses = DetermineQueryClasses(theEnv,execStatus,GetFirstArgument()->nextArg->nextArg,
"delayed-do-for-all-instances",&rcnt);
if (qclasses == NULL)
return;
PushQueryCore(theEnv,execStatus);
InstanceQueryData(theEnv,execStatus)->QueryCore = get_struct(theEnv,execStatus,query_core);
InstanceQueryData(theEnv,execStatus)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,execStatus,(sizeof(INSTANCE_TYPE *) * rcnt));
InstanceQueryData(theEnv,execStatus)->QueryCore->query = GetFirstArgument();
InstanceQueryData(theEnv,execStatus)->QueryCore->action = NULL;
InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set = NULL;
InstanceQueryData(theEnv,execStatus)->QueryCore->soln_size = rcnt;
InstanceQueryData(theEnv,execStatus)->QueryCore->soln_cnt = 0;
TestEntireChain(theEnv,execStatus,qclasses,0);
InstanceQueryData(theEnv,execStatus)->AbortQuery = FALSE;
InstanceQueryData(theEnv,execStatus)->QueryCore->action = GetFirstArgument()->nextArg;
while (InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set != NULL)
{
for (i = 0 ; i < rcnt ; i++)
InstanceQueryData(theEnv,execStatus)->QueryCore->solns[i] = InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set->soln[i];
PopQuerySoln(theEnv,execStatus);
execStatus->CurrentEvaluationDepth++;
EvaluateExpression(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->action,result);
execStatus->CurrentEvaluationDepth--;
if (ProcedureFunctionData(theEnv,execStatus)->ReturnFlag == TRUE)
{ PropagateReturnValue(theEnv,execStatus,result); }
PeriodicCleanup(theEnv,execStatus,FALSE,TRUE);
if (execStatus->HaltExecution || ProcedureFunctionData(theEnv,execStatus)->BreakFlag || ProcedureFunctionData(theEnv,execStatus)->ReturnFlag)
{
while (InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set != NULL)
PopQuerySoln(theEnv,execStatus);
break;
}
}
ProcedureFunctionData(theEnv,execStatus)->BreakFlag = FALSE;
rm(theEnv,execStatus,(void *) InstanceQueryData(theEnv,execStatus)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(theEnv,execStatus,query_core,InstanceQueryData(theEnv,execStatus)->QueryCore);
PopQueryCore(theEnv,execStatus);
DeleteQueryClasses(theEnv,execStatus,qclasses);
}
/******************************************************************************
NAME : DelayedQueryDoForAllFacts
DESCRIPTION : Finds all sets of facts which satisfy the query and
and exceutes a user-action for each set
This function differs from QueryDoForAllFacts() in
that it forms the complete list of query satisfactions
BEFORE executing any actions.
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query template-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every fact set. The action is executed
for evry query satisfaction.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See FactParseQueryNoAction()
******************************************************************************/
globle void DelayedQueryDoForAllFacts(
void *theEnv,
DATA_OBJECT *result)
{
QUERY_TEMPLATE *qtemplates;
unsigned rcnt;
register unsigned i;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv);
qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg,
"delayed-do-for-all-facts",&rcnt);
if (qtemplates == NULL)
return;
PushQueryCore(theEnv);
FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt));
FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
FactQueryData(theEnv)->QueryCore->action = NULL;
FactQueryData(theEnv)->QueryCore->soln_set = NULL;
FactQueryData(theEnv)->QueryCore->soln_size = rcnt;
FactQueryData(theEnv)->QueryCore->soln_cnt = 0;
TestEntireChain(theEnv,qtemplates,0);
FactQueryData(theEnv)->AbortQuery = FALSE;
FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
while (FactQueryData(theEnv)->QueryCore->soln_set != NULL)
{
for (i = 0 ; i < rcnt ; i++)
FactQueryData(theEnv)->QueryCore->solns[i] = FactQueryData(theEnv)->QueryCore->soln_set->soln[i];
PopQuerySoln(theEnv);
EvaluationData(theEnv)->CurrentEvaluationDepth++;
EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,result);
EvaluationData(theEnv)->CurrentEvaluationDepth--;
if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)
{ PropagateReturnValue(theEnv,result); }
PeriodicCleanup(theEnv,FALSE,TRUE);
if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag)
{
while (FactQueryData(theEnv)->QueryCore->soln_set != NULL)
PopQuerySoln(theEnv);
break;
}
}
ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt));
rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
PopQueryCore(theEnv);
DeleteQueryTemplates(theEnv,qtemplates);
}
/******************************************************************************
NAME : DelayedQueryDoForAllInstances
DESCRIPTION : Finds all sets of instances which satisfy the query and
and exceutes a user-action for each set
This function differs from QueryDoForAllInstances() in
that it forms the complete list of query satisfactions
BEFORE executing any actions.
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query class-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every instance set. The action is executed
for evry query satisfaction.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See ParseQueryNoAction()
******************************************************************************/
globle void DelayedQueryDoForAllInstances(
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
int rcnt;
register int i;
result->type = SYMBOL;
result->value = FalseSymbol;
qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg->nextArg,
"delayed-do-for-all-instances",&rcnt);
if (qclasses == NULL)
return;
PushQueryCore();
QueryCore = get_struct(query_core);
QueryCore->solns = (INSTANCE_TYPE **) gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
QueryCore->query = GetFirstArgument();
QueryCore->action = NULL;
QueryCore->soln_set = NULL;
QueryCore->soln_size = rcnt;
QueryCore->soln_cnt = 0;
TestEntireChain(qclasses,0);
AbortQuery = FALSE;
QueryCore->action = GetFirstArgument()->nextArg;
while (QueryCore->soln_set != NULL)
{
for (i = 0 ; i < rcnt ; i++)
QueryCore->solns[i] = QueryCore->soln_set->soln[i];
PopQuerySoln();
CurrentEvaluationDepth++;
EvaluateExpression(QueryCore->action,result);
CurrentEvaluationDepth--;
if (ReturnFlag == TRUE)
{ PropagateReturnValue(result); }
PeriodicCleanup(FALSE,TRUE);
if (HaltExecution || BreakFlag || ReturnFlag)
{
while (QueryCore->soln_set != NULL)
PopQuerySoln();
break;
}
}
BreakFlag = FALSE;
rm((void *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(query_core,QueryCore);
PopQueryCore();
DeleteQueryClasses(qclasses);
}
globle int EvaluateExpression(
struct expr *problem,
DATA_OBJECT_PTR returnValue)
{
struct expr *oldArgument;
struct FunctionDefinition *fptr;
#if PROFILING_FUNCTIONS
struct profileFrameInfo profileFrame;
#endif
if (problem == NULL)
{
returnValue->type = SYMBOL;
returnValue->value = FalseSymbol;
return(EvaluationError);
}
switch (problem->type)
{
case STRING:
case SYMBOL:
case FLOAT:
case INTEGER:
#if OBJECT_SYSTEM
case INSTANCE_NAME:
case INSTANCE_ADDRESS:
#endif
#if FUZZY_DEFTEMPLATES
case FUZZY_VALUE:
#endif
case EXTERNAL_ADDRESS:
returnValue->type = problem->type;
returnValue->value = problem->value;
break;
#if FUZZY_DEFTEMPLATES
case S_FUNCTION:
case PI_FUNCTION:
case Z_FUNCTION:
case SINGLETON_EXPRESSION:
/* At some time it may be worthwhile making this into an FCALL
but only when we allow user's to create functions that return
fuzzy values -- this may not happen
*/
{
struct fuzzy_value *fvptr;
fvptr = getConstantFuzzyValue(problem, &EvaluationError);
returnValue->type = FUZZY_VALUE;
if (fvptr != NULL)
{
returnValue->value = (VOID *)AddFuzzyValue(fvptr);
/* AddFuzzyValue makes a copy of the fuzzy value -- so remove this one */
rtnFuzzyValue(fvptr);
}
else
{
returnValue->type = RVOID;
returnValue->value = CLIPSFalseSymbol;
SetEvaluationError(TRUE);
}
}
break;
#endif
case FCALL:
{
fptr = (struct FunctionDefinition *) problem->value;
#if PROFILING_FUNCTIONS
StartProfile(&profileFrame,
&fptr->usrData,
ProfileUserFunctions);
#endif
oldArgument = CurrentExpression;
CurrentExpression = problem;
switch(fptr->returnValueType)
{
case 'v' :
(* (void (*)(void)) fptr->functionPointer)();
returnValue->type = RVOID;
returnValue->value = FalseSymbol;
break;
case 'b' :
returnValue->type = SYMBOL;
if ((* (int (*)(void)) fptr->functionPointer)())
returnValue->value = TrueSymbol;
else
returnValue->value = FalseSymbol;
break;
case 'a' :
returnValue->type = EXTERNAL_ADDRESS;
returnValue->value =
(* (void *(*)(void)) fptr->functionPointer)();
break;
case 'i' :
returnValue->type = INTEGER;
returnValue->value = (void *)
AddLong((long) (* (int (*)(void)) fptr->functionPointer)());
break;
case 'l' :
returnValue->type = INTEGER;
returnValue->value = (void *)
AddLong((* (long int (*)(void)) fptr->functionPointer)());
break;
#if FUZZY_DEFTEMPLATES
case 'F' :
{
struct fuzzy_value *fvPtr;
fvPtr = (* (struct fuzzy_value * (*)(VOID_ARG)) fptr->functionPointer)();
if (fvPtr != NULL)
{
returnValue->type = FUZZY_VALUE;
returnValue->value = (VOID *)AddFuzzyValue( fvPtr );
/* AddFuzzyValue makes a copy of fv .. so return it */
rtnFuzzyValue( fvPtr );
}
else
{
returnValue->type = RVOID;
returnValue->value = CLIPSFalseSymbol;
}
}
break;
#endif
case 'f' :
returnValue->type = FLOAT;
returnValue->value = (void *)
AddDouble((double) (* (float (*)(void)) fptr->functionPointer)());
break;
case 'd' :
returnValue->type = FLOAT;
returnValue->value = (void *)
AddDouble((* (double (*)(void)) fptr->functionPointer)());
break;
case 's' :
returnValue->type = STRING;
returnValue->value = (void *)
(* (SYMBOL_HN *(*)(void)) fptr->functionPointer)();
break;
case 'w' :
returnValue->type = SYMBOL;
returnValue->value = (void *)
(* (SYMBOL_HN *(*)(void)) fptr->functionPointer)();
break;
#if OBJECT_SYSTEM
case 'x' :
returnValue->type = INSTANCE_ADDRESS;
returnValue->value =
(* (void *(*)(void)) fptr->functionPointer)();
break;
case 'o' :
returnValue->type = INSTANCE_NAME;
returnValue->value = (void *)
(* (SYMBOL_HN *(*)(void)) fptr->functionPointer)();
break;
#endif
case 'c' :
{
char cbuff[2];
cbuff[0] = (* (char (*)(void)) fptr->functionPointer)();
cbuff[1] = EOS;
returnValue->type = SYMBOL;
returnValue->value = (void *) AddSymbol(cbuff);
break;
}
case 'j' :
case 'k' :
case 'm' :
case 'n' :
case 'u' :
(* (void (*)(DATA_OBJECT_PTR)) fptr->functionPointer)(returnValue);
break;
default :
SystemError("EVALUATN",2);
ExitRouter(EXIT_FAILURE);
break;
}
#if PROFILING_FUNCTIONS
EndProfile(&profileFrame);
#endif
CurrentExpression = oldArgument;
break;
}
case MULTIFIELD:
returnValue->type = MULTIFIELD;
returnValue->value = ((DATA_OBJECT_PTR) (problem->value))->value;
returnValue->begin = ((DATA_OBJECT_PTR) (problem->value))->begin;
returnValue->end = ((DATA_OBJECT_PTR) (problem->value))->end;
break;
case MF_VARIABLE:
case SF_VARIABLE:
if (GetBoundVariable(returnValue,(SYMBOL_HN *) problem->value) == FALSE)
{
PrintErrorID("EVALUATN",1,FALSE);
PrintRouter(WERROR,"Variable ");
PrintRouter(WERROR,ValueToString(problem->value));
PrintRouter(WERROR," is unbound\n");
returnValue->type = SYMBOL;
returnValue->value = FalseSymbol;
SetEvaluationError(TRUE);
}
break;
default:
if (PrimitivesArray[problem->type] == NULL)
{
SystemError("EVALUATN",3);
ExitRouter(EXIT_FAILURE);
}
if (PrimitivesArray[problem->type]->copyToEvaluate)
{
returnValue->type = problem->type;
returnValue->value = problem->value;
break;
}
if (PrimitivesArray[problem->type]->evaluateFunction == NULL)
{
SystemError("EVALUATN",4);
ExitRouter(EXIT_FAILURE);
}
oldArgument = CurrentExpression;
CurrentExpression = problem;
#if PROFILING_FUNCTIONS
StartProfile(&profileFrame,
&PrimitivesArray[problem->type]->usrData,
ProfileUserFunctions);
#endif
(*PrimitivesArray[problem->type]->evaluateFunction)(problem->value,returnValue);
#if PROFILING_FUNCTIONS
EndProfile(&profileFrame);
#endif
CurrentExpression = oldArgument;
break;
}
PropagateReturnValue(returnValue);
return(EvaluationError);
}
/*****************************************************
NAME : PerformMessage
DESCRIPTION : Calls core framework for a message
INPUTS : 1) Caller's result buffer
2) Message argument expressions
(including implicit object)
3) Message name
RETURNS : Nothing useful
SIDE EFFECTS : Any side-effects of message execution
and caller's result buffer set
NOTES : None
*****************************************************/
static void PerformMessage(
DATA_OBJECT *result,
EXPRESSION *args,
SYMBOL_HN *mname)
{
int oldce;
HANDLER_LINK *oldCore;
DEFCLASS *cls = NULL;
INSTANCE_TYPE *ins = NULL;
SYMBOL_HN *oldName;
#if PROFILING_FUNCTIONS
struct profileFrameInfo profileFrame;
#endif
result->type = SYMBOL;
result->value = FalseSymbol;
EvaluationError = FALSE;
if (HaltExecution)
return;
oldce = ExecutingConstruct();
SetExecutingConstruct(TRUE);
oldName = CurrentMessageName;
CurrentMessageName = mname;
CurrentEvaluationDepth++;
PushProcParameters(args,CountArguments(args),
ValueToString(CurrentMessageName),"message",
UnboundHandlerErr);
if (EvaluationError)
{
CurrentEvaluationDepth--;
CurrentMessageName = oldName;
PeriodicCleanup(FALSE,TRUE);
SetExecutingConstruct(oldce);
return;
}
if (ProcParamArray->type == INSTANCE_ADDRESS)
{
ins = (INSTANCE_TYPE *) ProcParamArray->value;
if (ins->garbage == 1)
{
StaleInstanceAddress("send",0);
SetEvaluationError(TRUE);
}
else if (DefclassInScope(ins->cls,(struct defmodule *) GetCurrentModule()) == FALSE)
NoInstanceError(ValueToString(ins->name),"send");
else
{
cls = ins->cls;
ins->busy++;
}
}
else if (ProcParamArray->type == INSTANCE_NAME)
{
ins = FindInstanceBySymbol((SYMBOL_HN *) ProcParamArray->value);
if (ins == NULL)
{
PrintErrorID("MSGPASS",2,FALSE);
PrintRouter(WERROR,"No such instance ");
PrintRouter(WERROR,ValueToString((SYMBOL_HN *) ProcParamArray->value));
PrintRouter(WERROR," in function send.\n");
SetEvaluationError(TRUE);
}
else
{
ProcParamArray->value = (void *) ins;
ProcParamArray->type = INSTANCE_ADDRESS;
cls = ins->cls;
ins->busy++;
}
}
else if ((cls = PrimitiveClassMap[ProcParamArray->type]) == NULL)
{
SystemError("MSGPASS",1);
ExitRouter(EXIT_FAILURE);
}
if (EvaluationError)
{
PopProcParameters();
CurrentEvaluationDepth--;
CurrentMessageName = oldName;
PeriodicCleanup(FALSE,TRUE);
SetExecutingConstruct(oldce);
return;
}
oldCore = TopOfCore;
TopOfCore = FindApplicableHandlers(cls,mname);
if (TopOfCore != NULL)
{
HANDLER_LINK *oldCurrent,*oldNext;
oldCurrent = CurrentCore;
oldNext = NextInCore;
#if IMPERATIVE_MESSAGE_HANDLERS
if (TopOfCore->hnd->type == MAROUND)
{
CurrentCore = TopOfCore;
NextInCore = TopOfCore->nxt;
#if DEBUGGING_FUNCTIONS
if (WatchMessages)
WatchMessage(WTRACE,BEGIN_TRACE);
if (CurrentCore->hnd->trace)
WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE);
#endif
if (CheckHandlerArgCount())
{
#if PROFILING_FUNCTIONS
StartProfile(&profileFrame,
&CurrentCore->hnd->usrData,
ProfileConstructs);
#endif
EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule,
CurrentCore->hnd->actions,
CurrentCore->hnd->localVarCount,
result,UnboundHandlerErr);
#if PROFILING_FUNCTIONS
EndProfile(&profileFrame);
#endif
}
#if DEBUGGING_FUNCTIONS
if (CurrentCore->hnd->trace)
WatchHandler(WTRACE,CurrentCore,END_TRACE);
if (WatchMessages)
WatchMessage(WTRACE,END_TRACE);
#endif
}
else
#endif /* IMPERATIVE_MESSAGE_HANDLERS */
{
CurrentCore = NULL;
NextInCore = TopOfCore;
#if DEBUGGING_FUNCTIONS
if (WatchMessages)
WatchMessage(WTRACE,BEGIN_TRACE);
#endif
CallHandlers(result);
#if DEBUGGING_FUNCTIONS
if (WatchMessages)
WatchMessage(WTRACE,END_TRACE);
#endif
}
DestroyHandlerLinks(TopOfCore);
CurrentCore = oldCurrent;
NextInCore = oldNext;
}
TopOfCore = oldCore;
ReturnFlag = FALSE;
if (ins != NULL)
ins->busy--;
/* ==================================
Restore the original calling frame
================================== */
PopProcParameters();
CurrentEvaluationDepth--;
CurrentMessageName = oldName;
PropagateReturnValue(result);
PeriodicCleanup(FALSE,TRUE);
SetExecutingConstruct(oldce);
if (EvaluationError)
{
result->type = SYMBOL;
result->value = FalseSymbol;
}
}
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);
}
