/**************************************************** 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); }