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);
}
}
/*********************************************************************
NAME : StoreSubclasses
DESCRIPTION : Stores the names of direct or indirect
subclasses for a class in a mutlifield
INPUTS : 1) Caller's multifield buffer
2) Starting index
3) Address of the class
4) Include (1) or exclude (0) indirect subclasses
5) Traversal id
RETURNS : The number of subclass names stored in the multifield
SIDE EFFECTS : Multifield set with subclass names
NOTES : Assumes multifield is big enough to hold subclasses
*********************************************************************/
static unsigned StoreSubclasses(
void *mfval,
unsigned si,
DEFCLASS *cls,
int inhp,
int tvid,
short storeName)
{
long i,classi;
register DEFCLASS *subcls;
for (i = si , classi = 0 ; classi < cls->directSubclasses.classCount ; classi++)
{
subcls = cls->directSubclasses.classArray[classi];
if (TestTraversalID(subcls->traversalRecord,tvid) == 0)
{
SetTraversalID(subcls->traversalRecord,tvid);
if (storeName)
{
SetMFType(mfval,i,SYMBOL);
SetMFValue(mfval,i++,(void *) GetDefclassNamePointer((void *) subcls));
}
else
{
SetMFType(mfval,i,DEFCLASS_PTR);
SetMFValue(mfval,i++,(void *) subcls);
}
if (inhp && (subcls->directSubclasses.classCount != 0))
i += StoreSubclasses(mfval,i,subcls,inhp,tvid,storeName);
}
}
return(i - si);
}
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 : ClassSlots
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 ClassSlots(
void *clsptr,
DATA_OBJECT *result,
int inhp)
{
long size; /* 6.04 Bug Fix */
register DEFCLASS *cls;
register long i; /* 6.04 Bug Fix */
cls = (DEFCLASS *) clsptr;
size = inhp ? cls->instanceSlotCount : cls->slotCount;
result->type = MULTIFIELD;
result->begin = 0;
result->end = size - 1;
result->value = (void *) CreateMultifield(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);
}
}
}
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);
}
static void SetErrorCaptureValues(
DATA_OBJECT_PTR returnValue)
{
struct multifield *theMultifield;
theMultifield = (struct multifield *) CreateMultifield(2L);
if (ErrorString != NULL)
{
SetMFType(theMultifield,1,STRING);
SetMFValue(theMultifield,1,AddSymbol(ErrorString));
}
else
{
SetMFType(theMultifield,1,SYMBOL);
SetMFValue(theMultifield,1,FalseSymbol);
}
if (WarningString != NULL)
{
SetMFType(theMultifield,2,STRING);
SetMFValue(theMultifield,2,AddSymbol(WarningString));
}
else
{
SetMFType(theMultifield,2,SYMBOL);
SetMFValue(theMultifield,2,FalseSymbol);
}
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,2);
SetpValue(returnValue,(void *) theMultifield);
}
/********************************************************************
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);
}
}
}
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);
}
}
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);
}
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);
}
}
globle void SlotAllowedValues(
void *clsptr,
char *sname,
DATA_OBJECT *result)
{
register int i;
register SLOT_DESC *sp;
register EXPRESSION *exp;
if ((sp = SlotInfoSlot(result,(DEFCLASS *) clsptr,sname,"slot-allowed-values")) == NULL)
return;
if ((sp->constraint != NULL) ? (sp->constraint->restrictionList == NULL) : TRUE)
{
result->type = SYMBOL;
result->value = FalseSymbol;
return;
}
result->end = ExpressionSize(sp->constraint->restrictionList) - 1;
result->value = CreateMultifield(result->end + 1);
i = 1;
exp = sp->constraint->restrictionList;
while (exp != NULL)
{
SetMFType(result->value,i,exp->type);
SetMFValue(result->value,i,exp->value);
exp = exp->nextArg;
i++;
}
}
/***************************************************************************
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]));
}
}
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;
}
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);
}
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);
}
}
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)));
}
}
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)));
}
}
/******************************************************************************
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 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 : 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 : 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(
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
int rcnt;
register int i,j;
result->type = MULTIFIELD;
result->begin = 0;
result->end = -1;
qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg,
"find-all-instances",&rcnt);
if (qclasses == NULL)
{
result->value = (void *) CreateMultifield(0L);
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;
result->value = (void *) CreateMultifield(QueryCore->soln_cnt * rcnt);
while (QueryCore->soln_set != NULL)
{
for (i = 0 , j = result->end + 2 ; i < rcnt ; i++ , j++)
{
SetMFType(result->value,j,INSTANCE_NAME);
SetMFValue(result->value,j,GetFullInstanceName(QueryCore->soln_set->soln[i]));
}
result->end = j-2;
PopQuerySoln();
}
rm((void *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(query_core,QueryCore);
PopQueryCore();
DeleteQueryClasses(qclasses);
}
/******************************************************************************
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);
}
/******************************************************************************
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);
}
/******************************************************************************
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(
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
int rcnt,i;
result->type = MULTIFIELD;
result->begin = 0;
result->end = -1;
qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg,
"find-instance",&rcnt);
if (qclasses == NULL)
{
result->value = (void *) CreateMultifield(0L);
return;
}
PushQueryCore();
QueryCore = get_struct(query_core);
QueryCore->solns = (INSTANCE_TYPE **)
gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
QueryCore->query = GetFirstArgument();
if (TestForFirstInChain(qclasses,0) == TRUE)
{
result->value = (void *) CreateMultifield(rcnt);
result->end = rcnt-1;
for (i = 1 ; i <= rcnt ; i++)
{
SetMFType(result->value,i,INSTANCE_NAME);
SetMFValue(result->value,i,GetFullInstanceName(QueryCore->solns[i - 1]));
}
}
else
result->value = (void *) CreateMultifield(0L);
AbortQuery = FALSE;
rm((void *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(query_core,QueryCore);
PopQueryCore();
DeleteQueryClasses(qclasses);
}
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 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 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++;
}
}
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
}
/************************************************************************
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);
}