globle void EnvFactSlotNames( void *theEnv, void *vTheFact, DATA_OBJECT *returnValue) { struct fact *theFact = (struct fact *) vTheFact; struct multifield *theList; struct templateSlot *theSlot; unsigned long count; /*===============================================*/ /* If we're dealing with an implied deftemplate, */ /* then the only slot names is "implied." */ /*===============================================*/ if (theFact->whichDeftemplate->implied) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,1); theList = (struct multifield *) EnvCreateMultifield(theEnv,(int) 1); SetMFType(theList,1,SYMBOL); SetMFValue(theList,1,EnvAddSymbol(theEnv,"implied")); SetpValue(returnValue,(void *) theList); return; } /*=================================*/ /* Count the number of slot names. */ /*=================================*/ for (count = 0, theSlot = theFact->whichDeftemplate->slotList; theSlot != NULL; count++, theSlot = theSlot->next) { /* Do Nothing */ } /*=============================================================*/ /* Create a multifield value in which to store the slot names. */ /*=============================================================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*===============================================*/ /* Store the slot names in the multifield value. */ /*===============================================*/ for (count = 1, theSlot = theFact->whichDeftemplate->slotList; theSlot != NULL; count++, theSlot = theSlot->next) { SetMFType(theList,count,SYMBOL); SetMFValue(theList,count,theSlot->slotName); } }
globle void EnvGetFocusStack( void *theEnv, DATA_OBJECT_PTR returnValue) { struct focus *theFocus; struct multifield *theList; unsigned long count = 0; /*===========================================*/ /* If there is no current focus, then return */ /* a multifield value of length zero. */ /*===========================================*/ if (EngineData(theEnv)->CurrentFocus == NULL) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,0); SetpValue(returnValue,(void *) EnvCreateMultifield(theEnv,0L)); return; } /*=====================================================*/ /* Determine the number of modules on the focus stack. */ /*=====================================================*/ for (theFocus = EngineData(theEnv)->CurrentFocus; theFocus != NULL; theFocus = theFocus->next) { count++; } /*=============================================*/ /* Create a multifield of the appropriate size */ /* in which to store the module names. */ /*=============================================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*=================================================*/ /* Store the module names in the multifield value. */ /*=================================================*/ for (theFocus = EngineData(theEnv)->CurrentFocus, count = 1; theFocus != NULL; theFocus = theFocus->next, count++) { SetMFType(theList,count,SYMBOL); SetMFValue(theList,count,theFocus->theModule->name); } }
/******************************************************************** NAME : EnvClassSlots DESCRIPTION : Groups slot info for a class into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class 2) Data object buffer to hold the slots of the class 3) Include (1) or exclude (0) inherited slots RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names of the slots of the class NOTES : None ********************************************************************/ globle void EnvClassSlots( void *theEnv, void *clsptr, DATA_OBJECT *result, int inhp) { long size; register DEFCLASS *cls; long i; cls = (DEFCLASS *) clsptr; size = inhp ? cls->instanceSlotCount : cls->slotCount; result->type = MULTIFIELD; SetpDOBegin(result,1); SetpDOEnd(result,size); result->value = (void *) EnvCreateMultifield(theEnv,size); if (size == 0) return; if (inhp) { for (i = 0 ; i < cls->instanceSlotCount ; i++) { SetMFType(result->value,i+1,SYMBOL); SetMFValue(result->value,i+1,cls->instanceTemplate[i]->slotName->name); } } else { for (i = 0 ; i < cls->slotCount ; i++) { SetMFType(result->value,i+1,SYMBOL); SetMFValue(result->value,i+1,cls->slots[i].slotName->name); } } }
/*************************************************************************** NAME : EnvClassSuperclasses DESCRIPTION : Groups the names of superclasses into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class 2) Data object buffer to hold the superclasses of the class 3) Include (1) or exclude (0) indirect superclasses RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names of the superclasses of the class NOTES : None ***************************************************************************/ globle void EnvClassSuperclasses( void *theEnv, void *clsptr, DATA_OBJECT *result, int inhp) { PACKED_CLASS_LINKS *plinks; unsigned offset; long i,j; if (inhp) { plinks = &((DEFCLASS *) clsptr)->allSuperclasses; offset = 1; } else { plinks = &((DEFCLASS *) clsptr)->directSuperclasses; offset = 0; } result->type = MULTIFIELD; result->begin = 0; SetpDOEnd(result,plinks->classCount - offset); result->value = (void *) EnvCreateMultifield(theEnv,result->end + 1U); if (result->end == -1) return; for (i = offset , j = 1 ; i < plinks->classCount ; i++ , j++) { SetMFType(result->value,j,SYMBOL); SetMFValue(result->value,j,GetDefclassNamePointer((void *) plinks->classArray[i])); } }
globle int QGetDefglobalValue( void *theEnv, void *vTheGlobal, DATA_OBJECT_PTR vPtr) { struct defglobal *theGlobal = (struct defglobal *) vTheGlobal; /*===============================================*/ /* Transfer values which can be copied directly. */ /*===============================================*/ vPtr->type = theGlobal->current.type; vPtr->value = theGlobal->current.value; vPtr->begin = theGlobal->current.begin; vPtr->end = theGlobal->current.end; /*===========================================================*/ /* If the global contains a multifield value, return a copy */ /* of the value so that routines which use this value are */ /* not affected if the value of the global is later changed. */ /*===========================================================*/ if (vPtr->type == MULTIFIELD) { vPtr->value = EnvCreateMultifield(theEnv,(unsigned long) (vPtr->end + 1)); GenCopyMemory(struct field,vPtr->end + 1, &((struct multifield *) vPtr->value)->theFields[0], &((struct multifield *) theGlobal->current.value)->theFields[theGlobal->current.begin]); }
globle void EnvSlotAllowedClasses( void *theEnv, void *clsptr, const char *sname, DATA_OBJECT *result) { register int i; register SLOT_DESC *sp; register EXPRESSION *theExp; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-allowed-classes")) == NULL) return; if ((sp->constraint != NULL) ? (sp->constraint->classList == NULL) : TRUE) { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } result->end = ExpressionSize(sp->constraint->classList) - 1; result->value = EnvCreateMultifield(theEnv,(unsigned long) (result->end + 1)); i = 1; theExp = sp->constraint->classList; while (theExp != NULL) { SetMFType(result->value,i,theExp->type); SetMFValue(result->value,i,theExp->value); theExp = theExp->nextArg; i++; } }
globle void GetFunctionListFunction( void *theEnv, DATA_OBJECT *returnValue) { struct FunctionDefinition *theFunction; struct multifield *theList; unsigned long functionCount = 0; if (EnvArgCountCheck(theEnv,"get-function-list",EXACTLY,0) == -1) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } for (theFunction = GetFunctionList(theEnv); theFunction != NULL; theFunction = theFunction->next) { functionCount++; } SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,functionCount); theList = (struct multifield *) EnvCreateMultifield(theEnv,functionCount); SetpValue(returnValue,(void *) theList); for (theFunction = GetFunctionList(theEnv), functionCount = 1; theFunction != NULL; theFunction = theFunction->next, functionCount++) { SetMFType(theList,functionCount,SYMBOL); SetMFValue(theList,functionCount,theFunction->callFunctionName); } }
/*********************************************************** NAME : EvaluateAndStoreInDataObject DESCRIPTION : Evaluates slot-value expressions and stores the result in a Kernel data object INPUTS : 1) Flag indicating if multifields are OK 2) The value-expression 3) The data object structure 4) Flag indicating if a multifield value should be placed on the garbage list. RETURNS : FALSE on errors, TRUE otherwise SIDE EFFECTS : Segment allocated for storing multifield values NOTES : None ***********************************************************/ globle int EvaluateAndStoreInDataObject( void *theEnv, int mfp, EXPRESSION *theExp, DATA_OBJECT *val, int garbageSegment) { val->type = MULTIFIELD; val->begin = 0; val->end = -1; if (theExp == NULL) { if (garbageSegment) val->value = EnvCreateMultifield(theEnv,0L); else val->value = CreateMultifield2(theEnv,0L); return(TRUE); } if ((mfp == 0) && (theExp->nextArg == NULL)) EvaluateExpression(theEnv,theExp,val); else StoreInMultifield(theEnv,val,theExp,garbageSegment); return(EvaluationData(theEnv)->EvaluationError ? FALSE : TRUE); }
globle void EnvSlotCardinality( void *theEnv, void *clsptr, const char *sname, DATA_OBJECT *result) { register SLOT_DESC *sp; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-cardinality")) == NULL) return; if (sp->multiple == 0) { EnvSetMultifieldErrorValue(theEnv,result); return; } result->end = 1; result->value = EnvCreateMultifield(theEnv,2L); if (sp->constraint != NULL) { SetMFType(result->value,1,sp->constraint->minFields->type); SetMFValue(result->value,1,sp->constraint->minFields->value); SetMFType(result->value,2,sp->constraint->maxFields->type); SetMFValue(result->value,2,sp->constraint->maxFields->value); } else { SetMFType(result->value,1,INTEGER); SetMFValue(result->value,1,SymbolData(theEnv)->Zero); SetMFType(result->value,2,SYMBOL); SetMFValue(result->value,2,SymbolData(theEnv)->PositiveInfinity); } }
static void SetErrorCaptureValues( void *theEnv, DATA_OBJECT_PTR returnValue) { struct multifield *theMultifield; theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,2L); if (ParseFunctionData(theEnv)->ErrorString != NULL) { SetMFType(theMultifield,1,STRING); SetMFValue(theMultifield,1,EnvAddSymbol(theEnv,ParseFunctionData(theEnv)->ErrorString)); } else { SetMFType(theMultifield,1,SYMBOL); SetMFValue(theMultifield,1,EnvFalseSymbol(theEnv)); } if (ParseFunctionData(theEnv)->WarningString != NULL) { SetMFType(theMultifield,2,STRING); SetMFValue(theMultifield,2,EnvAddSymbol(theEnv,ParseFunctionData(theEnv)->WarningString)); } else { SetMFType(theMultifield,2,SYMBOL); SetMFValue(theMultifield,2,EnvFalseSymbol(theEnv)); } SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,2); SetpValue(returnValue,(void *) theMultifield); }
globle void EnvSlotRange( void *theEnv, void *clsptr, const char *sname, DATA_OBJECT *result) { register SLOT_DESC *sp; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-range")) == NULL) return; if ((sp->constraint == NULL) ? FALSE : (sp->constraint->anyAllowed || sp->constraint->floatsAllowed || sp->constraint->integersAllowed)) { result->end = 1; result->value = EnvCreateMultifield(theEnv,2L); SetMFType(result->value,1,sp->constraint->minValue->type); SetMFValue(result->value,1,sp->constraint->minValue->value); SetMFType(result->value,2,sp->constraint->maxValue->type); SetMFValue(result->value,2,sp->constraint->maxValue->value); } else { result->type = SYMBOL; result->value = EnvFalseSymbol(theEnv); return; } }
/****************************************************************************** NAME : QueryFindAllInstances DESCRIPTION : Finds all sets of instances which satisfy the query and stores their names in the user's multi-field variable The sets are stored sequentially : Number of sets = (Multi-field length) / (Set length) The first set is if the first (set length) atoms of the multi-field variable, and so on. 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. NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle void QueryFindAllInstances( void *theEnv, EXEC_STATUS, DATA_OBJECT *result) { QUERY_CLASS *qclasses; unsigned rcnt; register unsigned i,j; result->type = MULTIFIELD; result->begin = 0; result->end = -1; qclasses = DetermineQueryClasses(theEnv,execStatus,GetFirstArgument()->nextArg, "find-all-instances",&rcnt); if (qclasses == NULL) { result->value = (void *) EnvCreateMultifield(theEnv,execStatus,0L); 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; result->value = (void *) EnvCreateMultifield(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->soln_cnt * rcnt); while (InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set != NULL) { for (i = 0 , j = (unsigned) (result->end + 2) ; i < rcnt ; i++ , j++) { SetMFType(result->value,j,INSTANCE_NAME); SetMFValue(result->value,j,GetFullInstanceName(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set->soln[i])); } result->end = (long) j-2; PopQuerySoln(theEnv,execStatus); } 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); }
globle void EnvSetMultifieldErrorValue( void *theEnv, DATA_OBJECT_PTR returnValue) { returnValue->type = MULTIFIELD; returnValue->value = EnvCreateMultifield(theEnv,0L); returnValue->begin = 1; returnValue->end = 0; }
/****************************************************************************** NAME : QueryFindAllFacts DESCRIPTION : Finds all sets of facts which satisfy the query and stores their names in the user's multi-field variable The sets are stored sequentially : Number of sets = (Multi-field length) / (Set length) The first set is if the first (set length) atoms of the multi-field variable, and so on. 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. NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle void QueryFindAllFacts( void *theEnv, DATA_OBJECT *result) { QUERY_TEMPLATE *qtemplates; unsigned rcnt; register unsigned i,j; result->type = MULTIFIELD; result->begin = 0; result->end = -1; qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg, "find-all-facts",&rcnt); if (qtemplates == NULL) { result->value = (void *) EnvCreateMultifield(theEnv,0L); 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; result->value = (void *) EnvCreateMultifield(theEnv,FactQueryData(theEnv)->QueryCore->soln_cnt * rcnt); while (FactQueryData(theEnv)->QueryCore->soln_set != NULL) { for (i = 0 , j = (unsigned) (result->end + 2) ; i < rcnt ; i++ , j++) { SetMFType(result->value,j,FACT_ADDRESS); SetMFValue(result->value,j,FactQueryData(theEnv)->QueryCore->soln_set->soln[i]); } result->end = (long) j-2; PopQuerySoln(theEnv); } 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 : QueryFindInstance DESCRIPTION : Finds the first set of instances which satisfy the query and stores their names in the user's multi-field variable INPUTS : Caller's result buffer RETURNS : TRUE if the query is satisfied, FALSE otherwise SIDE EFFECTS : The query class-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on instance restrictions and how early the expression evaulates to TRUE - if at all). NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle void QueryFindInstance( void *theEnv, EXEC_STATUS, DATA_OBJECT *result) { QUERY_CLASS *qclasses; unsigned rcnt,i; result->type = MULTIFIELD; result->begin = 0; result->end = -1; qclasses = DetermineQueryClasses(theEnv,execStatus,GetFirstArgument()->nextArg, "find-instance",&rcnt); if (qclasses == NULL) { result->value = (void *) EnvCreateMultifield(theEnv,execStatus,0L); 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(); if (TestForFirstInChain(theEnv,execStatus,qclasses,0) == TRUE) { result->value = (void *) EnvCreateMultifield(theEnv,execStatus,rcnt); SetpDOEnd(result,rcnt); for (i = 1 ; i <= rcnt ; i++) { SetMFType(result->value,i,INSTANCE_NAME); SetMFValue(result->value,i,GetFullInstanceName(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->solns[i - 1])); } } else result->value = (void *) EnvCreateMultifield(theEnv,execStatus,0L); InstanceQueryData(theEnv,execStatus)->AbortQuery = 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); }
extern "C" void GetCurrentlyPressedKeys(void* theEnv, DATA_OBJECT_PTR returnValue) { void* multifield; AdventureEngine::AdventureEngineEngine* engine = PullOutEngine(theEnv); Common::EventManager* _eventMan = engine->getEventManager(); Common::Event keyEvent; //this function does generate side effects if we assert facts //However, if we return a multifield with all the contents then we need to //parse it....hmmmmmm, doing the multifield is easier //only check for a single key at this point while(_eventMan->pollEvent(keyEvent)) { //let's do a simple test switch(keyEvent.type) { case Common::EVENT_KEYDOWN: switch(keyEvent.kbd.keycode) { case Common::KEYCODE_ESCAPE: multifield = EnvCreateMultifield(theEnv, 1); SetMFType(multifield, 1, SYMBOL); SetMFValue(multifield, 1, EnvAddSymbol(theEnv, (char*)"escape")); SetpType(returnValue, MULTIFIELD); SetpValue(returnValue, multifield); SetpDOBegin(returnValue, 1); SetpDOEnd(returnValue, 1); return; default: multifield = EnvCreateMultifield(theEnv, 1); SetMFType(multifield, 1, INTEGER); SetMFValue(multifield, 1, EnvAddLong(theEnv, keyEvent.kbd.keycode)); SetpType(returnValue, MULTIFIELD); SetpValue(returnValue, multifield); SetpDOBegin(returnValue, 1); SetpDOEnd(returnValue, 1); return; } default: NullMultifield(theEnv, returnValue); return; } } NullMultifield(theEnv, returnValue); }
/****************************************************************************** NAME : QueryFindFact DESCRIPTION : Finds the first set of facts which satisfy the query and stores their addresses in the user's multi-field variable INPUTS : Caller's result buffer RETURNS : TRUE if the query is satisfied, FALSE otherwise SIDE EFFECTS : The query template-expressions are evaluated once, and the query boolean-expression is evaluated zero or more times (depending on fact restrictions and how early the expression evaulates to TRUE - if at all). NOTES : H/L Syntax : See ParseQueryNoAction() ******************************************************************************/ globle void QueryFindFact( void *theEnv, DATA_OBJECT *result) { QUERY_TEMPLATE *qtemplates; unsigned rcnt,i; result->type = MULTIFIELD; result->begin = 0; result->end = -1; qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg, "find-fact",&rcnt); if (qtemplates == NULL) { result->value = (void *) EnvCreateMultifield(theEnv,0L); 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(); if (TestForFirstInChain(theEnv,qtemplates,0) == TRUE) { result->value = (void *) EnvCreateMultifield(theEnv,rcnt); SetpDOEnd(result,rcnt); for (i = 1 ; i <= rcnt ; i++) { SetMFType(result->value,i,FACT_ADDRESS); SetMFValue(result->value,i,FactQueryData(theEnv)->QueryCore->solns[i - 1]); } } else result->value = (void *) EnvCreateMultifield(theEnv,0L); FactQueryData(theEnv)->AbortQuery = 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); }
globle void OldGetConstructList( void *theEnv, EXEC_STATUS, DATA_OBJECT_PTR returnValue, void *(*nextFunction)(void *,EXEC_STATUS,void *), char *(*nameFunction)(void *,EXEC_STATUS,void *)) { void *theConstruct; unsigned long count = 0; struct multifield *theList; /*====================================*/ /* Determine the number of constructs */ /* of the specified type. */ /*====================================*/ for (theConstruct = (*nextFunction)(theEnv,execStatus,NULL); theConstruct != NULL; theConstruct = (*nextFunction)(theEnv,execStatus,theConstruct)) { count++; } /*===========================*/ /* Create a multifield large */ /* enough to store the list. */ /*===========================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,execStatus,count); SetpValue(returnValue,(void *) theList); /*====================================*/ /* Store the names in the multifield. */ /*====================================*/ for (theConstruct = (*nextFunction)(theEnv,execStatus,NULL), count = 1; theConstruct != NULL; theConstruct = (*nextFunction)(theEnv,execStatus,theConstruct), count++) { if (execStatus->HaltExecution == TRUE) { EnvSetMultifieldErrorValue(theEnv,execStatus,returnValue); return; } SetMFType(theList,count,SYMBOL); SetMFValue(theList,count,EnvAddSymbol(theEnv,execStatus,(*nameFunction)(theEnv,execStatus,theConstruct))); } }
extern "C" void GetMouseLocation(void* theEnv, DATA_OBJECT_PTR returnValue) { void* multifield; AdventureEngine::AdventureEngineEngine* engine = PullOutEngine(theEnv); multifield = EnvCreateMultifield(theEnv, 2); Common::EventManager* _eventMan = engine->getEventManager(); Common::Point pos = _eventMan->getMousePos(); SetMFType(multifield, 1, INTEGER); SetMFValue(multifield, 1, EnvAddLong(theEnv, pos.x)); SetMFType(multifield, 2, INTEGER); SetMFValue(multifield, 2, EnvAddLong(theEnv, pos.y)); SetpType(returnValue, MULTIFIELD); SetpValue(returnValue, multifield); SetpDOBegin(returnValue, 1); SetpDOEnd(returnValue, 2); }
dataObject * value_to_data_object( const Environment& env, const Values & values ) { void *p, *p2; if (values.size() == 0 ) return NULL; if ( values.size() == 1 ) return value_to_data_object( env, values[0] ); dataObject* clipsdo = new dataObject; p = EnvCreateMultifield( env.cobj(), values.size() ); for (unsigned int iter = 0; iter < values.size(); iter++) { unsigned int mfi = iter + 1; // mfptr indices start at 1 SetMFType(p, mfi, values[iter].type()); switch ( values[iter].type() ) { case TYPE_SYMBOL: case TYPE_STRING: case TYPE_INSTANCE_NAME: p2 = EnvAddSymbol( env.cobj(), const_cast<char*>(values[iter].as_string().c_str()) ); SetMFValue(p, mfi, p2); break; case TYPE_INTEGER: p2 = EnvAddLong( env.cobj(), values[iter].as_integer() ); SetMFValue(p, mfi, p2); break; case TYPE_FLOAT: p2 = EnvAddDouble( env.cobj(), values[iter].as_float() ); SetMFValue(p, mfi, p2); break; case TYPE_EXTERNAL_ADDRESS: p2 = EnvAddExternalAddress( env.cobj(), values[iter].as_address(), EXTERNAL_ADDRESS ); SetMFValue(p, mfi, p2); break; default: throw std::logic_error( "clipsmm::value_to_data_object: Unhandled data object type" ); } } SetpType(clipsdo, MULTIFIELD); SetpValue(clipsdo, p); SetpDOBegin(clipsdo, 1); SetpDOEnd(clipsdo, values.size()); return clipsdo; }
void EnvGetDefmoduleList( void *theEnv, CLIPSValue *returnValue) { void *theConstruct; unsigned long count = 0; struct multifield *theList; /*====================================*/ /* Determine the number of constructs */ /* of the specified type. */ /*====================================*/ for (theConstruct = EnvGetNextDefmodule(theEnv,NULL); theConstruct != NULL; theConstruct = EnvGetNextDefmodule(theEnv,theConstruct)) { count++; } /*===========================*/ /* Create a multifield large */ /* enough to store the list. */ /*===========================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*====================================*/ /* Store the names in the multifield. */ /*====================================*/ for (theConstruct = EnvGetNextDefmodule(theEnv,NULL), count = 1; theConstruct != NULL; theConstruct = EnvGetNextDefmodule(theEnv,theConstruct), count++) { if (EvaluationData(theEnv)->HaltExecution == true) { EnvSetMultifieldErrorValue(theEnv,returnValue); return; } SetMFType(theList,count,SYMBOL); SetMFValue(theList,count,EnvAddSymbol(theEnv,EnvGetDefmoduleName(theEnv,theConstruct))); } }
globle void EnvSlotSources( void *theEnv, void *clsptr, const char *sname, DATA_OBJECT *result) { register unsigned i; register int classi; register SLOT_DESC *sp,*csp; CLASS_LINK *ctop,*ctmp; DEFCLASS *cls; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-sources")) == NULL) return; i = 1; ctop = get_struct(theEnv,classLink); ctop->cls = sp->cls; ctop->nxt = NULL; if (sp->composite) { for (classi = 1 ; classi < sp->cls->allSuperclasses.classCount ; classi++) { cls = sp->cls->allSuperclasses.classArray[classi]; csp = FindClassSlot(cls,sp->slotName->name); if ((csp != NULL) ? (csp->noInherit == 0) : FALSE) { ctmp = get_struct(theEnv,classLink); ctmp->cls = cls; ctmp->nxt = ctop; ctop = ctmp; i++; if (csp->composite == 0) break; } } } SetpDOEnd(result,i); result->value = (void *) EnvCreateMultifield(theEnv,i); for (ctmp = ctop , i = 1 ; ctmp != NULL ; ctmp = ctmp->nxt , i++) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i,GetDefclassNamePointer((void *) ctmp->cls)); } DeleteClassLinks(theEnv,ctop); }
/************************************************************************** NAME : ClassSubclassAddresses DESCRIPTION : Groups the class addresses of subclasses for a class into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class 2) Data object buffer to hold the sublclasses of the class 3) Include (1) or exclude (0) indirect subclasses RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the subclass addresss of the class NOTES : None **************************************************************************/ globle void ClassSubclassAddresses( void *theEnv, void *clsptr, DATA_OBJECT *result, int inhp) { register int i; // Bug fix 2014-07-18: Previously unsigned and SetpDOEnd decremented to -1. register int id; if ((id = GetTraversalID(theEnv)) == -1) return; i = CountSubclasses((DEFCLASS *) clsptr,inhp,id); ReleaseTraversalID(theEnv); result->type = MULTIFIELD; result->begin = 0; SetpDOEnd(result,i); result->value = (void *) EnvCreateMultifield(theEnv,i); if (i == 0) return; if ((id = GetTraversalID(theEnv)) == -1) return; StoreSubclasses(result->value,1,(DEFCLASS *) clsptr,inhp,id,FALSE); ReleaseTraversalID(theEnv); }
/************************************************************************** NAME : EnvClassSubclasses DESCRIPTION : Groups the names of subclasses for a class into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class 2) Data object buffer to hold the sublclasses of the class 3) Include (1) or exclude (0) indirect subclasses RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names the subclasses of the class NOTES : None **************************************************************************/ globle void EnvClassSubclasses( void *theEnv, void *clsptr, DATA_OBJECT *result, int inhp) { register unsigned i; register int id; if ((id = GetTraversalID(theEnv)) == -1) return; i = CountSubclasses((DEFCLASS *) clsptr,inhp,id); ReleaseTraversalID(theEnv); result->type = MULTIFIELD; result->begin = 0; SetpDOEnd(result,i); result->value = (void *) EnvCreateMultifield(theEnv,i); if (i == 0) return; if ((id = GetTraversalID(theEnv)) == -1) return; StoreSubclasses(result->value,1,(DEFCLASS *) clsptr,inhp,id,TRUE); ReleaseTraversalID(theEnv); }
globle void StoreInMultifield( void *theEnv, DATA_OBJECT *returnValue, EXPRESSION *expptr, int garbageSegment) { DATA_OBJECT val_ptr; DATA_OBJECT *val_arr; struct multifield *theMultifield; struct multifield *orig_ptr; long start, end, i,j, k, argCount; unsigned long seg_size; argCount = CountArguments(expptr); /*=========================================*/ /* If no arguments are given return a NULL */ /* multifield of length zero. */ /*=========================================*/ if (argCount == 0) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,0); if (garbageSegment) theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L); else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L); SetpValue(returnValue,(void *) theMultifield); return; } else { /*========================================*/ /* Get a new segment with length equal to */ /* the total length of all the arguments. */ /*========================================*/ val_arr = (DATA_OBJECT *) gm3(theEnv,(long) sizeof(DATA_OBJECT) * argCount); seg_size = 0; for (i = 1; i <= argCount; i++, expptr = expptr->nextArg) { EvaluateExpression(theEnv,expptr,&val_ptr); if (EvaluationData(theEnv)->EvaluationError) { SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,0); if (garbageSegment) { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L); } else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L); SetpValue(returnValue,(void *) theMultifield); rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount); return; } SetpType(val_arr+i-1,GetType(val_ptr)); if (GetType(val_ptr) == MULTIFIELD) { SetpValue(val_arr+i-1,GetpValue(&val_ptr)); start = GetDOBegin(val_ptr); end = GetDOEnd(val_ptr); } else if (GetType(val_ptr) == RVOID) { SetpValue(val_arr+i-1,GetValue(val_ptr)); start = 1; end = 0; } else { SetpValue(val_arr+i-1,GetValue(val_ptr)); start = end = -1; } seg_size += (unsigned long) (end - start + 1); SetpDOBegin(val_arr+i-1,start); SetpDOEnd(val_arr+i-1,end); } if (garbageSegment) { theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,seg_size); } else theMultifield = (struct multifield *) CreateMultifield2(theEnv,seg_size); /*========================================*/ /* Copy each argument into new segment. */ /*========================================*/ for (k = 0, j = 1; k < argCount; k++) { if (GetpType(val_arr+k) == MULTIFIELD) { start = GetpDOBegin(val_arr+k); end = GetpDOEnd(val_arr+k); orig_ptr = (struct multifield *) GetpValue(val_arr+k); for (i = start; i < end + 1; i++, j++) { SetMFType(theMultifield,j,(GetMFType(orig_ptr,i))); SetMFValue(theMultifield,j,(GetMFValue(orig_ptr,i))); } } else if (GetpType(val_arr+k) != RVOID) { SetMFType(theMultifield,j,(short) (GetpType(val_arr+k))); SetMFValue(theMultifield,j,(GetpValue(val_arr+k))); j++; } } /*=========================*/ /* Return the new segment. */ /*=========================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) seg_size); SetpValue(returnValue,(void *) theMultifield); rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount); return; } }
globle void *CreateMultifield( long size) { return EnvCreateMultifield(GetCurrentEnvironment(),size); }
/************************************************************************ NAME : EnvGetDefmessageHandlerList DESCRIPTION : Groups handler info for a class into a multifield value for dynamic perusal INPUTS : 1) Generic pointer to class (NULL to get handlers for all classes) 2) Data object buffer to hold the handlers of the class 3) Include (1) or exclude (0) inherited handlers RETURNS : Nothing useful SIDE EFFECTS : Creates a multifield storing the names and types of the message-handlers of the class NOTES : None ************************************************************************/ globle void EnvGetDefmessageHandlerList( void *theEnv, void *clsptr, DATA_OBJECT *result, int inhp) { DEFCLASS *cls,*svcls,*svnxt,*supcls; long j; register int classi,classiLimit; unsigned long i, sublen, len; if (clsptr == NULL) { inhp = 0; cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL); svnxt = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls); } else { cls = (DEFCLASS *) clsptr; svnxt = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls); SetNextDefclass((void *) cls,NULL); } for (svcls = cls , i = 0 ; cls != NULL ; cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls)) { classiLimit = inhp ? cls->allSuperclasses.classCount : 1; for (classi = 0 ; classi < classiLimit ; classi++) i += cls->allSuperclasses.classArray[classi]->handlerCount; } len = i * 3; result->type = MULTIFIELD; SetpDOBegin(result,1); SetpDOEnd(result,len); result->value = (void *) EnvCreateMultifield(theEnv,len); for (cls = svcls , sublen = 0 ; cls != NULL ; cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls)) { classiLimit = inhp ? cls->allSuperclasses.classCount : 1; for (classi = 0 ; classi < classiLimit ; classi++) { supcls = cls->allSuperclasses.classArray[classi]; if (inhp == 0) i = sublen + 1; else i = len - (supcls->handlerCount * 3) - sublen + 1; for (j = 0 ; j < supcls->handlerCount ; j++) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,GetDefclassNamePointer((void *) supcls)); SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,supcls->handlers[j].name); SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i++,EnvAddSymbol(theEnv,MessageHandlerData(theEnv)->hndquals[supcls->handlers[j].type])); } sublen += supcls->handlerCount * 3; } } if (svcls != NULL) SetNextDefclass((void *) svcls,(void *) svnxt); }
globle void EnvGetFactList( void *theEnv, DATA_OBJECT_PTR returnValue, void *vTheModule) { struct fact *theFact; unsigned long count; struct multifield *theList; struct defmodule *theModule = (struct defmodule *) vTheModule; /*==========================*/ /* Save the current module. */ /*==========================*/ SaveCurrentModule(theEnv); /*============================================*/ /* Count the number of facts to be retrieved. */ /*============================================*/ if (theModule == NULL) { for (theFact = (struct fact *) EnvGetNextFact(theEnv,NULL), count = 0; theFact != NULL; theFact = (struct fact *) EnvGetNextFact(theEnv,theFact), count++) { /* Do Nothing */ } } else { EnvSetCurrentModule(theEnv,(void *) theModule); UpdateDeftemplateScope(theEnv); for (theFact = (struct fact *) GetNextFactInScope(theEnv,NULL), count = 0; theFact != NULL; theFact = (struct fact *) GetNextFactInScope(theEnv,theFact), count++) { /* Do Nothing */ } } /*===========================================================*/ /* Create the multifield value to store the construct names. */ /*===========================================================*/ SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,(long) count); theList = (struct multifield *) EnvCreateMultifield(theEnv,count); SetpValue(returnValue,(void *) theList); /*==================================================*/ /* Store the fact pointers in the multifield value. */ /*==================================================*/ if (theModule == NULL) { for (theFact = (struct fact *) EnvGetNextFact(theEnv,NULL), count = 1; theFact != NULL; theFact = (struct fact *) EnvGetNextFact(theEnv,theFact), count++) { SetMFType(theList,count,FACT_ADDRESS); SetMFValue(theList,count,(void *) theFact); } } else { for (theFact = (struct fact *) GetNextFactInScope(theEnv,NULL), count = 1; theFact != NULL; theFact = (struct fact *) GetNextFactInScope(theEnv,theFact), count++) { SetMFType(theList,count,FACT_ADDRESS); SetMFValue(theList,count,(void *) theFact); } } /*=============================*/ /* Restore the current module. */ /*=============================*/ RestoreCurrentModule(theEnv); UpdateDeftemplateScope(theEnv); }
globle void EnvSlotFacets( void *theEnv, void *clsptr, const char *sname, DATA_OBJECT *result) { register int i; register SLOT_DESC *sp; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-facets")) == NULL) return; #if DEFRULE_CONSTRUCT result->end = 9; result->value = (void *) EnvCreateMultifield(theEnv,10L); for (i = 1 ; i <= 10 ; i++) SetMFType(result->value,i,SYMBOL); #else result->end = 8; result->value = (void *) EnvCreateMultifield(theEnv,9L); for (i = 1 ; i <= 9 ; i++) SetMFType(result->value,i,SYMBOL); #endif if (sp->multiple) SetMFValue(result->value,1,EnvAddSymbol(theEnv,"MLT")); else SetMFValue(result->value,1,EnvAddSymbol(theEnv,"SGL")); if (sp->noDefault) SetMFValue(result->value,2,EnvAddSymbol(theEnv,"NIL")); else { if (sp->dynamicDefault) SetMFValue(result->value,2,EnvAddSymbol(theEnv,"DYN")); else SetMFValue(result->value,2,EnvAddSymbol(theEnv,"STC")); } if (sp->noInherit) SetMFValue(result->value,3,EnvAddSymbol(theEnv,"NIL")); else SetMFValue(result->value,3,EnvAddSymbol(theEnv,"INH")); if (sp->initializeOnly) SetMFValue(result->value,4,EnvAddSymbol(theEnv,"INT")); else if (sp->noWrite) SetMFValue(result->value,4,EnvAddSymbol(theEnv,"R")); else SetMFValue(result->value,4,EnvAddSymbol(theEnv,"RW")); if (sp->shared) SetMFValue(result->value,5,EnvAddSymbol(theEnv,"SHR")); else SetMFValue(result->value,5,EnvAddSymbol(theEnv,"LCL")); #if DEFRULE_CONSTRUCT if (sp->reactive) SetMFValue(result->value,6,EnvAddSymbol(theEnv,"RCT")); else SetMFValue(result->value,6,EnvAddSymbol(theEnv,"NIL")); if (sp->composite) SetMFValue(result->value,7,EnvAddSymbol(theEnv,"CMP")); else SetMFValue(result->value,7,EnvAddSymbol(theEnv,"EXC")); if (sp->publicVisibility) SetMFValue(result->value,8,EnvAddSymbol(theEnv,"PUB")); else SetMFValue(result->value,8,EnvAddSymbol(theEnv,"PRV")); SetMFValue(result->value,9,EnvAddSymbol(theEnv,GetCreateAccessorString((void *) sp))); SetMFValue(result->value,10,sp->noWrite ? EnvAddSymbol(theEnv,"NIL") : (void *) sp->overrideMessage); #else if (sp->composite) SetMFValue(result->value,6,EnvAddSymbol(theEnv,"CMP")); else SetMFValue(result->value,6,EnvAddSymbol(theEnv,"EXC")); if (sp->publicVisibility) SetMFValue(result->value,7,EnvAddSymbol(theEnv,"PUB")); else SetMFValue(result->value,7,EnvAddSymbol(theEnv,"PRV")); SetMFValue(result->value,8,EnvAddSymbol(theEnv,GetCreateAccessorString((void *) sp))); SetMFValue(result->value,9,sp->noWrite ? EnvAddSymbol(theEnv,"NIL") : (void *) sp->overrideMessage); #endif }
globle void EnvSlotTypes( void *theEnv, void *clsptr, const char *sname, DATA_OBJECT *result) { register unsigned i,j; register SLOT_DESC *sp; char typemap[2]; unsigned msize; if ((sp = SlotInfoSlot(theEnv,result,(DEFCLASS *) clsptr,sname,"slot-types")) == NULL) return; if ((sp->constraint != NULL) ? sp->constraint->anyAllowed : TRUE) { typemap[0] = typemap[1] = (char) 0xFF; ClearBitMap(typemap,MULTIFIELD); msize = 8; } else { typemap[0] = typemap[1] = (char) 0x00; msize = 0; if (sp->constraint->symbolsAllowed) { msize++; SetBitMap(typemap,SYMBOL); } if (sp->constraint->stringsAllowed) { msize++; SetBitMap(typemap,STRING); } if (sp->constraint->floatsAllowed) { msize++; SetBitMap(typemap,FLOAT); } if (sp->constraint->integersAllowed) { msize++; SetBitMap(typemap,INTEGER); } if (sp->constraint->instanceNamesAllowed) { msize++; SetBitMap(typemap,INSTANCE_NAME); } if (sp->constraint->instanceAddressesAllowed) { msize++; SetBitMap(typemap,INSTANCE_ADDRESS); } if (sp->constraint->externalAddressesAllowed) { msize++; SetBitMap(typemap,EXTERNAL_ADDRESS); } if (sp->constraint->factAddressesAllowed) { msize++; SetBitMap(typemap,FACT_ADDRESS); } } SetpDOEnd(result,msize); result->value = EnvCreateMultifield(theEnv,msize); i = 1; j = 0; while (i <= msize) { if (TestBitMap(typemap,j)) { SetMFType(result->value,i,SYMBOL); SetMFValue(result->value,i, (void *) GetDefclassNamePointer((void *) DefclassData(theEnv)->PrimitiveClassMap[j])); i++; } j++; } }