/****************************************************
NAME : LookupDefclassInScope
DESCRIPTION : Finds a class in current or imported
modules (module specifier
is not allowed)
INPUTS : The class name
RETURNS : The class (NULL if not found)
SIDE EFFECTS : Error message printed on
ambiguous references
NOTES : Assumes no two classes of the same
name are ever in the same scope
****************************************************/
globle DEFCLASS *LookupDefclassInScope(
void *theEnv,
const char *className)
{
DEFCLASS *cls;
SYMBOL_HN *classSymbol;
if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL)
return(NULL);
cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)];
while (cls != NULL)
{
if ((cls->header.name == classSymbol) && DefclassInScope(theEnv,cls,NULL))
return(cls->installed ? cls : NULL);
cls = cls->nxtHash;
}
return(NULL);
}
/*****************************************************
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;
}
}
/*****************************************************************
NAME : TestForFirstInstanceInClass
DESCRIPTION : Processes all instances in a class and then
all subclasses of a class until success or done
INPUTS : 1) The module for which classes tested must be
in scope
2) Visitation traversal id
3) The class
4) The current class restriction chain
5) The index of the current restriction
RETURNS : TRUE if query succeeds, FALSE otherwise
SIDE EFFECTS : Instance variable values set
NOTES : None
*****************************************************************/
static int TestForFirstInstanceInClass(
void *theEnv,
EXEC_STATUS,
struct defmodule *theModule,
int id,
DEFCLASS *cls,
QUERY_CLASS *qchain,
int indx)
{
long i;
INSTANCE_TYPE *ins;
DATA_OBJECT temp;
if (TestTraversalID(cls->traversalRecord,id))
return(FALSE);
SetTraversalID(cls->traversalRecord,id);
if (DefclassInScope(theEnv,execStatus,cls,theModule) == FALSE)
return(FALSE);
ins = cls->instanceList;
while (ins != NULL)
{
InstanceQueryData(theEnv,execStatus)->QueryCore->solns[indx] = ins;
if (qchain->nxt != NULL)
{
ins->busy++;
if (TestForFirstInChain(theEnv,execStatus,qchain->nxt,indx+1) == TRUE)
{
ins->busy--;
break;
}
ins->busy--;
if ((execStatus->HaltExecution == TRUE) || (InstanceQueryData(theEnv,execStatus)->AbortQuery == TRUE))
break;
}
else
{
ins->busy++;
execStatus->CurrentEvaluationDepth++;
EvaluateExpression(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->query,&temp);
execStatus->CurrentEvaluationDepth--;
PeriodicCleanup(theEnv,execStatus,FALSE,TRUE);
ins->busy--;
if (execStatus->HaltExecution == TRUE)
break;
if ((temp.type != SYMBOL) ? TRUE :
(temp.value != EnvFalseSymbol(theEnv,execStatus)))
break;
}
ins = ins->nxtClass;
while ((ins != NULL) ? (ins->garbage == 1) : FALSE)
ins = ins->nxtClass;
}
if (ins != NULL)
return(((execStatus->HaltExecution == TRUE) || (InstanceQueryData(theEnv,execStatus)->AbortQuery == TRUE))
? FALSE : TRUE);
for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
{
if (TestForFirstInstanceInClass(theEnv,execStatus,theModule,id,cls->directSubclasses.classArray[i],
qchain,indx))
return(TRUE);
if ((execStatus->HaltExecution == TRUE) || (InstanceQueryData(theEnv,execStatus)->AbortQuery == TRUE))
return(FALSE);
}
return(FALSE);
}
/*************************************************************
NAME : FormChain
DESCRIPTION : Builds a list of classes to be used in
instance queries - uses parse form.
INPUTS : 1) Name of calling function for error msgs
2) Data object - must be a symbol or a
multifield value containing all symbols
The symbols must be names of existing classes
RETURNS : The query chain, or NULL on errors
SIDE EFFECTS : Memory allocated for chain
Busy count incremented for all classes
NOTES : None
*************************************************************/
static QUERY_CLASS *FormChain(
void *theEnv,
EXEC_STATUS,
char *func,
DATA_OBJECT *val)
{
DEFCLASS *cls;
QUERY_CLASS *head,*bot,*tmp;
register long i,end; /* 6.04 Bug Fix */
char *className;
struct defmodule *currentModule;
currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv,execStatus));
if (val->type == DEFCLASS_PTR)
{
IncrementDefclassBusyCount(theEnv,execStatus,(void *) val->value);
head = get_struct(theEnv,execStatus,query_class);
head->cls = (DEFCLASS *) val->value;
if (DefclassInScope(theEnv,execStatus,head->cls,currentModule))
head->theModule = currentModule;
else
head->theModule = head->cls->header.whichModule->theModule;
head->chain = NULL;
head->nxt = NULL;
return(head);
}
if (val->type == SYMBOL)
{
/* ===============================================
Allow instance-set query restrictions to have a
module specifier as part of the class name,
but search imported defclasses too if a
module specifier is not given
=============================================== */
cls = LookupDefclassByMdlOrScope(theEnv,execStatus,DOPToString(val));
if (cls == NULL)
{
ClassExistError(theEnv,execStatus,func,DOPToString(val));
return(NULL);
}
IncrementDefclassBusyCount(theEnv,execStatus,(void *) cls);
head = get_struct(theEnv,execStatus,query_class);
head->cls = cls;
if (DefclassInScope(theEnv,execStatus,head->cls,currentModule))
head->theModule = currentModule;
else
head->theModule = head->cls->header.whichModule->theModule;
head->chain = NULL;
head->nxt = NULL;
return(head);
}
if (val->type == MULTIFIELD)
{
head = bot = NULL;
end = GetpDOEnd(val);
for (i = GetpDOBegin(val) ; i <= end ; i++)
{
if (GetMFType(val->value,i) == SYMBOL)
{
className = ValueToString(GetMFValue(val->value,i));
cls = LookupDefclassByMdlOrScope(theEnv,execStatus,className);
if (cls == NULL)
{
ClassExistError(theEnv,execStatus,func,className);
DeleteQueryClasses(theEnv,execStatus,head);
return(NULL);
}
}
else
{
DeleteQueryClasses(theEnv,execStatus,head);
return(NULL);
}
IncrementDefclassBusyCount(theEnv,execStatus,(void *) cls);
tmp = get_struct(theEnv,execStatus,query_class);
tmp->cls = cls;
if (DefclassInScope(theEnv,execStatus,tmp->cls,currentModule))
tmp->theModule = currentModule;
else
tmp->theModule = tmp->cls->header.whichModule->theModule;
tmp->chain = NULL;
tmp->nxt = NULL;
if (head == NULL)
head = tmp;
else
bot->chain = tmp;
bot = tmp;
}
return(head);
}
return(NULL);
}
/*****************************************************************
NAME : TestEntireClass
DESCRIPTION : Processes all instances in a class and then
all subclasses of a class until done
INPUTS : 1) The module for which classes tested must be
in scope
2) Visitation traversal id
3) The class
4) The current class restriction chain
5) The index of the current restriction
RETURNS : Nothing useful
SIDE EFFECTS : Instance variable values set
Solution sets stored in global list
NOTES : None
*****************************************************************/
static void TestEntireClass(
struct defmodule *theModule,
int id,
DEFCLASS *cls,
QUERY_CLASS *qchain,
int indx)
{
register unsigned i;
INSTANCE_TYPE *ins;
DATA_OBJECT temp;
if (TestTraversalID(cls->traversalRecord,id))
return;
SetTraversalID(cls->traversalRecord,id);
if (DefclassInScope(cls,theModule) == FALSE)
return;
ins = cls->instanceList;
while (ins != NULL)
{
QueryCore->solns[indx] = ins;
if (qchain->nxt != NULL)
{
ins->busy++;
TestEntireChain(qchain->nxt,indx+1);
ins->busy--;
if ((HaltExecution == TRUE) || (AbortQuery == TRUE))
break;
}
else
{
ins->busy++;
CurrentEvaluationDepth++;
EvaluateExpression(QueryCore->query,&temp);
CurrentEvaluationDepth--;
PeriodicCleanup(FALSE,TRUE);
ins->busy--;
if (HaltExecution == TRUE)
break;
if ((temp.type != SYMBOL) ? TRUE :
(temp.value != FalseSymbol))
{
if (QueryCore->action != NULL)
{
ins->busy++;
CurrentEvaluationDepth++;
ValueDeinstall(QueryCore->result);
EvaluateExpression(QueryCore->action,QueryCore->result);
ValueInstall(QueryCore->result);
CurrentEvaluationDepth--;
PeriodicCleanup(FALSE,TRUE);
ins->busy--;
if (BreakFlag || ReturnFlag)
{
AbortQuery = TRUE;
break;
}
if (HaltExecution == TRUE)
break;
}
else
AddSolution();
}
}
ins = ins->nxtClass;
while ((ins != NULL) ? (ins->garbage == 1) : FALSE)
ins = ins->nxtClass;
}
if (ins != NULL)
return;
for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
{
TestEntireClass(theModule,id,cls->directSubclasses.classArray[i],qchain,indx);
if ((HaltExecution == TRUE) || (AbortQuery == TRUE))
return;
}
}
/*****************************************************************
NAME : TestForFirstInstanceInClass
DESCRIPTION : Processes all instances in a class and then
all subclasses of a class until success or done
INPUTS : 1) The module for which classes tested must be
in scope
2) Visitation traversal id
3) The class
4) The current class restriction chain
5) The index of the current restriction
RETURNS : TRUE if query succeeds, FALSE otherwise
SIDE EFFECTS : Instance variable values set
NOTES : None
*****************************************************************/
static int TestForFirstInstanceInClass(
void *theEnv,
struct defmodule *theModule,
int id,
DEFCLASS *cls,
QUERY_CLASS *qchain,
int indx)
{
long i;
INSTANCE_TYPE *ins;
DATA_OBJECT temp;
struct garbageFrame newGarbageFrame;
struct garbageFrame *oldGarbageFrame;
if (TestTraversalID(cls->traversalRecord,id))
return(FALSE);
SetTraversalID(cls->traversalRecord,id);
if (DefclassInScope(theEnv,cls,theModule) == FALSE)
return(FALSE);
oldGarbageFrame = UtilityData(theEnv)->CurrentGarbageFrame;
memset(&newGarbageFrame,0,sizeof(struct garbageFrame));
newGarbageFrame.priorFrame = oldGarbageFrame;
UtilityData(theEnv)->CurrentGarbageFrame = &newGarbageFrame;
ins = cls->instanceList;
while (ins != NULL)
{
InstanceQueryData(theEnv)->QueryCore->solns[indx] = ins;
if (qchain->nxt != NULL)
{
ins->busy++;
if (TestForFirstInChain(theEnv,qchain->nxt,indx+1) == TRUE)
{
ins->busy--;
break;
}
ins->busy--;
if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE))
break;
}
else
{
ins->busy++;
EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->query,&temp);
ins->busy--;
if (EvaluationData(theEnv)->HaltExecution == TRUE)
break;
if ((temp.type != SYMBOL) ? TRUE :
(temp.value != EnvFalseSymbol(theEnv)))
break;
}
CleanCurrentGarbageFrame(theEnv,NULL);
CallPeriodicTasks(theEnv);
ins = ins->nxtClass;
while ((ins != NULL) ? (ins->garbage == 1) : FALSE)
ins = ins->nxtClass;
}
RestorePriorGarbageFrame(theEnv,&newGarbageFrame, oldGarbageFrame,NULL);
CallPeriodicTasks(theEnv);
if (ins != NULL)
return(((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE))
? FALSE : TRUE);
for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
{
if (TestForFirstInstanceInClass(theEnv,theModule,id,cls->directSubclasses.classArray[i],
qchain,indx))
return(TRUE);
if ((EvaluationData(theEnv)->HaltExecution == TRUE) || (InstanceQueryData(theEnv)->AbortQuery == TRUE))
return(FALSE);
}
return(FALSE);
}
