/**************************************************************************
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 : GetQueryInstanceSlot
DESCRIPTION : Internal function for referring to slots of instances in
instance array on instance-queries
INPUTS : The caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : Caller's result buffer set appropriately
NOTES : H/L Syntax : ((query-instance-slot) <index> <slot-name>)
**************************************************************************/
globle void GetQueryInstanceSlot(
void *theEnv,
EXEC_STATUS,
DATA_OBJECT *result)
{
INSTANCE_TYPE *ins;
INSTANCE_SLOT *sp;
DATA_OBJECT temp;
QUERY_CORE *core;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv,execStatus);
core = FindQueryCore(theEnv,execStatus,ValueToInteger(GetpValue(GetFirstArgument())));
ins = core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))];
EvaluateExpression(theEnv,execStatus,GetFirstArgument()->nextArg->nextArg,&temp);
if (temp.type != SYMBOL)
{
ExpectedTypeError1(theEnv,execStatus,"get",1,"symbol");
SetEvaluationError(theEnv,execStatus,TRUE);
return;
}
sp = FindInstanceSlot(theEnv,execStatus,ins,(SYMBOL_HN *) temp.value);
if (sp == NULL)
{
SlotExistError(theEnv,execStatus,ValueToString(temp.value),"instance-set query");
return;
}
result->type = (unsigned short) sp->type;
result->value = sp->value;
if (sp->type == MULTIFIELD)
{
result->begin = 0;
SetpDOEnd(result,GetInstanceSlotLength(sp));
}
}
/**************************************************************************
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);
}
/***************************************************
NAME : GetObjectValueGeneral
DESCRIPTION : Access function for getting
pattern variable values within the
object pattern and join networks
INPUTS : 1) The result data object buffer
2) The instance to access
3) The list of multifield markers
for the pattern
4) Data for variable reference
RETURNS : Nothing useful
SIDE EFFECTS : Data object is filled with the
values of the pattern variable
NOTES : None
***************************************************/
static void GetObjectValueGeneral(
void *theEnv,
DATA_OBJECT *result,
INSTANCE_TYPE *theInstance,
struct multifieldMarker *theMarks,
struct ObjectMatchVar1 *matchVar)
{
long field, extent; /* 6.04 Bug Fix */
INSTANCE_SLOT **insSlot,*basisSlot;
if (matchVar->objectAddress)
{
result->type = INSTANCE_ADDRESS;
result->value = (void *) theInstance;
return;
}
if (matchVar->whichSlot == ISA_ID)
{
result->type = SYMBOL;
result->value = (void *) GetDefclassNamePointer((void *) theInstance->cls);
return;
}
if (matchVar->whichSlot == NAME_ID)
{
result->type = INSTANCE_NAME;
result->value = (void *) theInstance->name;
return;
}
insSlot =
&theInstance->slotAddresses
[theInstance->cls->slotNameMap[matchVar->whichSlot] - 1];
/* =========================================
We need to reference the basis slots if
the slot of this object has changed while
the RHS was executing
However, if the reference is being done
by the LHS of a rule (as a consequence of
an RHS action), give the pattern matcher
the real value of the slot
========================================= */
if ((theInstance->basisSlots != NULL) &&
(! EngineData(theEnv)->JoinOperationInProgress))
{
basisSlot = theInstance->basisSlots + (insSlot - theInstance->slotAddresses);
if (basisSlot->value != NULL)
insSlot = &basisSlot;
}
/* ==================================================
If we know we are accessing the entire slot,
the don't bother with searching multifield markers
or calculating offsets
================================================== */
if (matchVar->allFields)
{
result->type = (unsigned short) (*insSlot)->type;
result->value = (*insSlot)->value;
if (result->type == MULTIFIELD)
{
result->begin = 0;
SetpDOEnd(result,GetMFLength((*insSlot)->value));
}
return;
}
/* =============================================
Access a general field in a slot pattern with
two or more multifield variables
============================================= */
field = CalculateSlotField(theMarks,*insSlot,matchVar->whichField,&extent);
if (extent == -1)
{
if ((*insSlot)->desc->multiple)
{
result->type = GetMFType((*insSlot)->value,field);
result->value = GetMFValue((*insSlot)->value,field);
}
else
{
result->type = (unsigned short) (*insSlot)->type;
result->value = (*insSlot)->value;
}
}
else
{
result->type = MULTIFIELD;
result->value = (*insSlot)->value;
result->begin = field - 1;
result->end = field + extent - 2;
}
}
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 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++;
}
}
/************************************************************************
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 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;
}
}
/*might be dangerous, maybe trasfer to from mf instead*/
VOID tpn_mf_mirror(DATA_OBJECT_PTR rp)
{
int *pi,i,num,offset=0,stride=1;
float *pf;
double *pd;
char tstr[9],type,t1[2];
VOID *mfp;
t1[1]='\0';
/*get the type*/
sprintf(tstr,"%s",(char *)RtnLexeme(1));
type = tolower(tstr[0]);
if(type!='i' && type!='f' && type!='d' && type!='b')
{
printf("[1st arg=type:i or f or d]");
return;
}
/*get number (& offset & stride) to put to a m.f.*/
if(RtnArgCount() > 2) num=(int)RtnLong(3);
if(RtnArgCount() > 3) offset=(int)RtnLong(4);
if(RtnArgCount() > 4) stride=(int)RtnLong(5);
/*could use SetMultifieldErrorValue(rp); return;*/
mfp = CreateMultifield(num);
/*get the ptr, and set the MF*/
switch(type)
{
case 'i' : pi = (int *)get_ptr(2);
for(i=0; i<num; i++)
{
printf(",%d ",
SetMFType(mfp,i,INTEGER));
/*SetMFValue(mfp,i,AddLong(pi[offset+i]));
set the Data_Object ptr to the address*/
}
break;
case 'f' : pf = (float *)get_ptr(2);
for(i=0; i<num; i++)
{
printf("%f to mf,",pf[offset+i]);
fflush(stdout);
printf(",%d ",
SetMFType(mfp,i,FLOAT));
fflush(stdout);
/*SetMFValue(mfp,i,AddDouble((double)pf[offset+i]));
set the Data_Object ptr to the address*/
}
break;
case 'd' : pd = (double *)get_ptr(2);
for(i=0; i<num; i++)
{
SetMFType(mfp,i,FLOAT);
/*SetMFValue(mfp,i,AddDouble(pd[offset+i]));
set the Data_Object ptr to the address*/
}
break;
}
SetpType(rp,MULTIFIELD);
SetpValue(rp,mfp);
SetpDOBegin(rp,1);
SetpDOEnd(rp,num);
return;
}
static void DuplicateModifyCommand(
void *theEnv,
int retractIt,
DATA_OBJECT_PTR returnValue)
{
long int factNum;
struct fact *oldFact, *newFact, *theFact;
struct expr *testPtr;
DATA_OBJECT computeResult;
struct deftemplate *templatePtr;
struct templateSlot *slotPtr;
int i, position, found;
/*===================================================*/
/* Set the default return value to the symbol FALSE. */
/*===================================================*/
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,SymbolData(theEnv)->FalseSymbol);
/*==================================================*/
/* Evaluate the first argument which is used to get */
/* a pointer to the fact to be modified/duplicated. */
/*==================================================*/
testPtr = GetFirstArgument();
EvaluateExpression(theEnv,testPtr,&computeResult);
/*==============================================================*/
/* If an integer is supplied, then treat it as a fact-index and */
/* search the fact-list for the fact with that fact-index. */
/*==============================================================*/
if (computeResult.type == INTEGER)
{
factNum = ValueToLong(computeResult.value);
if (factNum < 0)
{
if (retractIt) ExpectedTypeError2(theEnv,"modify",1);
else ExpectedTypeError2(theEnv,"duplicate",1);
SetEvaluationError(theEnv,TRUE);
return;
}
oldFact = (struct fact *) EnvGetNextFact(theEnv,NULL);
while (oldFact != NULL)
{
if (oldFact->factIndex == factNum)
{ break; }
else
{ oldFact = oldFact->nextFact; }
}
if (oldFact == NULL)
{
char tempBuffer[20];
sprintf(tempBuffer,"f-%ld",factNum);
CantFindItemErrorMessage(theEnv,"fact",tempBuffer);
return;
}
}
/*==========================================*/
/* Otherwise, if a pointer is supplied then */
/* no lookup is required. */
/*==========================================*/
else if (computeResult.type == FACT_ADDRESS)
{ oldFact = (struct fact *) computeResult.value; }
/*===========================================*/
/* Otherwise, the first argument is invalid. */
/*===========================================*/
else
{
if (retractIt) ExpectedTypeError2(theEnv,"modify",1);
else ExpectedTypeError2(theEnv,"duplicate",1);
SetEvaluationError(theEnv,TRUE);
return;
}
/*==================================*/
/* See if it is a deftemplate fact. */
/*==================================*/
templatePtr = oldFact->whichDeftemplate;
if (templatePtr->implied) return;
/*================================================================*/
/* Duplicate the values from the old fact (skipping multifields). */
/*================================================================*/
newFact = (struct fact *) CreateFactBySize(theEnv,oldFact->theProposition.multifieldLength);
newFact->whichDeftemplate = templatePtr;
for (i = 0; i < (int) oldFact->theProposition.multifieldLength; i++)
{
newFact->theProposition.theFields[i].type = oldFact->theProposition.theFields[i].type;
if (newFact->theProposition.theFields[i].type != MULTIFIELD)
{ newFact->theProposition.theFields[i].value = oldFact->theProposition.theFields[i].value; }
else
{ newFact->theProposition.theFields[i].value = NULL; }
}
/*========================*/
/* Start replacing slots. */
/*========================*/
testPtr = testPtr->nextArg;
while (testPtr != NULL)
{
/*============================================================*/
/* If the slot identifier is an integer, then the slot was */
/* previously identified and its position within the template */
/* was stored. Otherwise, the position of the slot within the */
/* deftemplate has to be determined by comparing the name of */
/* the slot against the list of slots for the deftemplate. */
/*============================================================*/
if (testPtr->type == INTEGER)
{ position = (int) ValueToLong(testPtr->value); }
else
{
found = FALSE;
position = 0;
slotPtr = templatePtr->slotList;
while (slotPtr != NULL)
{
if (slotPtr->slotName == (SYMBOL_HN *) testPtr->value)
{
found = TRUE;
slotPtr = NULL;
}
else
{
slotPtr = slotPtr->next;
position++;
}
}
if (! found)
{
InvalidDeftemplateSlotMessage(theEnv,ValueToString(testPtr->value),
ValueToString(templatePtr->header.name));
SetEvaluationError(theEnv,TRUE);
ReturnFact(theEnv,newFact);
return;
}
}
/*===================================================*/
/* If a single field slot is being replaced, then... */
/*===================================================*/
if (newFact->theProposition.theFields[position].type != MULTIFIELD)
{
/*======================================================*/
/* If the list of values to store in the slot is empty */
/* or contains more than one member than an error has */
/* occured because a single field slot can only contain */
/* a single value. */
/*======================================================*/
if ((testPtr->argList == NULL) ? TRUE : (testPtr->argList->nextArg != NULL))
{
MultiIntoSingleFieldSlotError(theEnv,GetNthSlot(templatePtr,position),templatePtr);
ReturnFact(theEnv,newFact);
return;
}
/*===================================================*/
/* Evaluate the expression to be stored in the slot. */
/*===================================================*/
EvaluateExpression(theEnv,testPtr->argList,&computeResult);
SetEvaluationError(theEnv,FALSE);
/*====================================================*/
/* If the expression evaluated to a multifield value, */
/* then an error occured since a multifield value can */
/* not be stored in a single field slot. */
/*====================================================*/
if (computeResult.type == MULTIFIELD)
{
ReturnFact(theEnv,newFact);
MultiIntoSingleFieldSlotError(theEnv,GetNthSlot(templatePtr,position),templatePtr);
return;
}
/*=============================*/
/* Store the value in the slot */
/*=============================*/
newFact->theProposition.theFields[position].type =
computeResult.type;
newFact->theProposition.theFields[position].value =
computeResult.value;
}
/*=================================*/
/* Else replace a multifield slot. */
/*=================================*/
else
{
/*======================================*/
/* Determine the new value of the slot. */
/*======================================*/
StoreInMultifield(theEnv,&computeResult,testPtr->argList,FALSE);
SetEvaluationError(theEnv,FALSE);
/*=============================*/
/* Store the value in the slot */
/*=============================*/
newFact->theProposition.theFields[position].type =
computeResult.type;
newFact->theProposition.theFields[position].value =
computeResult.value;
}
testPtr = testPtr->nextArg;
}
/*=====================================*/
/* Copy the multifield values from the */
/* old fact that were not replaced. */
/*=====================================*/
for (i = 0; i < (int) oldFact->theProposition.multifieldLength; i++)
{
if ((newFact->theProposition.theFields[i].type == MULTIFIELD) &&
(newFact->theProposition.theFields[i].value == NULL))
{
newFact->theProposition.theFields[i].value =
CopyMultifield(theEnv,(struct multifield *) oldFact->theProposition.theFields[i].value);
}
}
/*======================================*/
/* Perform the duplicate/modify action. */
/*======================================*/
if (retractIt) EnvRetract(theEnv,oldFact);
theFact = (struct fact *) EnvAssert(theEnv,newFact);
/*========================================*/
/* The asserted fact is the return value. */
/*========================================*/
if (theFact != NULL)
{
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,theFact->theProposition.multifieldLength);
SetpType(returnValue,FACT_ADDRESS);
SetpValue(returnValue,(void *) theFact);
}
return;
}
globle void SortFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
long argumentCount, i, j, k = 0;
DATA_OBJECT *theArguments, *theArguments2;
DATA_OBJECT theArg;
struct multifield *theMultifield, *tempMultifield;
char *functionName;
struct expr *functionReference;
int argumentSize = 0;
struct FunctionDefinition *fptr;
#if DEFFUNCTION_CONSTRUCT
DEFFUNCTION *dptr;
#endif
/*==================================*/
/* Set up the default return value. */
/*==================================*/
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvFalseSymbol(theEnv));
/*=============================================*/
/* The function expects at least one argument. */
/*=============================================*/
if ((argumentCount = EnvArgCountCheck(theEnv,"sort",AT_LEAST,1)) == -1)
{ return; }
/*=============================================*/
/* Verify that the comparison function exists. */
/*=============================================*/
if (EnvArgTypeCheck(theEnv,"sort",1,SYMBOL,&theArg) == FALSE)
{ return; }
functionName = DOToString(theArg);
functionReference = FunctionReferenceExpression(theEnv,functionName);
if (functionReference == NULL)
{
ExpectedTypeError1(theEnv,"sort",1,"function name, deffunction name, or defgeneric name");
return;
}
/*======================================*/
/* For an external function, verify the */
/* correct number of arguments. */
/*======================================*/
if (functionReference->type == FCALL)
{
fptr = (struct FunctionDefinition *) functionReference->value;
if ((GetMinimumArgs(fptr) > 2) ||
(GetMaximumArgs(fptr) == 0) ||
(GetMaximumArgs(fptr) == 1))
{
ExpectedTypeError1(theEnv,"sort",1,"function name expecting two arguments");
ReturnExpression(theEnv,functionReference);
return;
}
}
/*=======================================*/
/* For a deffunction, verify the correct */
/* number of arguments. */
/*=======================================*/
#if DEFFUNCTION_CONSTRUCT
if (functionReference->type == PCALL)
{
dptr = (DEFFUNCTION *) functionReference->value;
if ((dptr->minNumberOfParameters > 2) ||
(dptr->maxNumberOfParameters == 0) ||
(dptr->maxNumberOfParameters == 1))
{
ExpectedTypeError1(theEnv,"sort",1,"deffunction name expecting two arguments");
ReturnExpression(theEnv,functionReference);
return;
}
}
#endif
/*=====================================*/
/* If there are no items to be sorted, */
/* then return an empty multifield. */
/*=====================================*/
if (argumentCount == 1)
{
EnvSetMultifieldErrorValue(theEnv,returnValue);
ReturnExpression(theEnv,functionReference);
return;
}
/*=====================================*/
/* Retrieve the arguments to be sorted */
/* and determine how many there are. */
/*=====================================*/
theArguments = (DATA_OBJECT *) genalloc(theEnv,(argumentCount - 1) * sizeof(DATA_OBJECT));
for (i = 2; i <= argumentCount; i++)
{
EnvRtnUnknown(theEnv,i,&theArguments[i-2]);
if (GetType(theArguments[i-2]) == MULTIFIELD)
{ argumentSize += GetpDOLength(&theArguments[i-2]); }
else
{ argumentSize++; }
}
if (argumentSize == 0)
{
genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(DATA_OBJECT)); /* Bug Fix */
EnvSetMultifieldErrorValue(theEnv,returnValue);
ReturnExpression(theEnv,functionReference);
return;
}
/*====================================*/
/* Pack all of the items to be sorted */
/* into a data object array. */
/*====================================*/
theArguments2 = (DATA_OBJECT *) genalloc(theEnv,argumentSize * sizeof(DATA_OBJECT));
for (i = 2; i <= argumentCount; i++)
{
if (GetType(theArguments[i-2]) == MULTIFIELD)
{
tempMultifield = (struct multifield *) GetValue(theArguments[i-2]);
for (j = GetDOBegin(theArguments[i-2]); j <= GetDOEnd(theArguments[i-2]); j++, k++)
{
SetType(theArguments2[k],GetMFType(tempMultifield,j));
SetValue(theArguments2[k],GetMFValue(tempMultifield,j));
}
}
else
{
SetType(theArguments2[k],GetType(theArguments[i-2]));
SetValue(theArguments2[k],GetValue(theArguments[i-2]));
k++;
}
}
genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(DATA_OBJECT));
functionReference->nextArg = SortFunctionData(theEnv)->SortComparisonFunction;
SortFunctionData(theEnv)->SortComparisonFunction = functionReference;
for (i = 0; i < argumentSize; i++)
{ ValueInstall(theEnv,&theArguments2[i]); }
MergeSort(theEnv,(unsigned long) argumentSize,theArguments2,DefaultCompareSwapFunction);
for (i = 0; i < argumentSize; i++)
{ ValueDeinstall(theEnv,&theArguments2[i]); }
SortFunctionData(theEnv)->SortComparisonFunction = SortFunctionData(theEnv)->SortComparisonFunction->nextArg;
functionReference->nextArg = NULL;
ReturnExpression(theEnv,functionReference);
theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,(unsigned long) argumentSize);
for (i = 0; i < argumentSize; i++)
{
SetMFType(theMultifield,i+1,GetType(theArguments2[i]));
SetMFValue(theMultifield,i+1,GetValue(theArguments2[i]));
}
genfree(theEnv,theArguments2,argumentSize * sizeof(DATA_OBJECT));
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,argumentSize);
SetpValue(returnValue,(void *) theMultifield);
}
globle intBool FactJNGetVar1(
void *theEnv,
EXEC_STATUS,
void *theValue,
DATA_OBJECT_PTR returnValue)
{
unsigned short theField, theSlot;
struct fact *factPtr;
struct field *fieldPtr;
struct multifieldMarker *marks;
struct multifield *segmentPtr;
int extent;
struct factGetVarJN1Call *hack;
/*==========================================*/
/* Retrieve the arguments for the function. */
/*==========================================*/
hack = (struct factGetVarJN1Call *) ValueToBitMap(theValue);
/*=====================================================*/
/* Get the pointer to the fact from the partial match. */
/*=====================================================*/
if (hack->lhs)
{
factPtr = (struct fact *) get_nth_pm_match(LocalEngineData(theEnv,execStatus).LHSBinds,hack->whichPattern)->matchingItem;
marks = get_nth_pm_match(LocalEngineData(theEnv,execStatus).LHSBinds,hack->whichPattern)->markers;
}
else if (hack->rhs)
{
factPtr = (struct fact *) get_nth_pm_match(LocalEngineData(theEnv,execStatus).RHSBinds,hack->whichPattern)->matchingItem;
marks = get_nth_pm_match(LocalEngineData(theEnv,execStatus).RHSBinds,hack->whichPattern)->markers;
}
else if (LocalEngineData(theEnv,execStatus).RHSBinds == NULL)
{
factPtr = (struct fact *) get_nth_pm_match(LocalEngineData(theEnv,execStatus).LHSBinds,hack->whichPattern)->matchingItem;
marks = get_nth_pm_match(LocalEngineData(theEnv,execStatus).LHSBinds,hack->whichPattern)->markers;
}
else if ((((unsigned short) (EngineData(theEnv,execStatus)->GlobalJoin->depth - 1))) == hack->whichPattern)
{
factPtr = (struct fact *) get_nth_pm_match(LocalEngineData(theEnv,execStatus).RHSBinds,0)->matchingItem;
marks = get_nth_pm_match(LocalEngineData(theEnv,execStatus).RHSBinds,0)->markers;
}
else
{
factPtr = (struct fact *) get_nth_pm_match(LocalEngineData(theEnv,execStatus).LHSBinds,hack->whichPattern)->matchingItem;
marks = get_nth_pm_match(LocalEngineData(theEnv,execStatus).LHSBinds,hack->whichPattern)->markers;
}
/*==========================================================*/
/* Determine if we want to retrieve the fact address of the */
/* fact, rather than retrieving a field from the fact. */
/*==========================================================*/
if (hack->factAddress)
{
returnValue->type = FACT_ADDRESS;
returnValue->value = (void *) factPtr;
return(TRUE);
}
/*=========================================================*/
/* Determine if we want to retrieve the entire slot value. */
/*=========================================================*/
if (hack->allFields)
{
theSlot = hack->whichSlot;
fieldPtr = &factPtr->theProposition.theFields[theSlot];
returnValue->type = fieldPtr->type;
returnValue->value = fieldPtr->value;
if (returnValue->type == MULTIFIELD)
{
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,((struct multifield *) fieldPtr->value)->multifieldLength);
}
return(TRUE);
}
/*====================================================*/
/* If the slot being accessed is a single field slot, */
/* then just return the single value found in that */
/* slot. The multifieldMarker data structures do not */
/* have to be considered since access to a single */
/* field slot is not affected by variable bindings */
/* from multifield slots. */
/*====================================================*/
theField = hack->whichField;
theSlot = hack->whichSlot;
fieldPtr = &factPtr->theProposition.theFields[theSlot];
if (fieldPtr->type != MULTIFIELD)
{
returnValue->type = fieldPtr->type;
returnValue->value = fieldPtr->value;
return(TRUE);
}
/*==========================================================*/
/* Retrieve a value from a multifield slot. First determine */
/* the range of fields for the variable being retrieved. */
/*==========================================================*/
extent = -1;
theField = AdjustFieldPosition(theEnv,execStatus,marks,theField,theSlot,&extent);
/*=============================================================*/
/* If a range of values are being retrieved (i.e. a multifield */
/* variable), then return the values as a multifield. */
/*=============================================================*/
if (extent != -1)
{
returnValue->type = MULTIFIELD;
returnValue->value = (void *) fieldPtr->value;
returnValue->begin = theField;
returnValue->end = theField + extent - 1;
return(TRUE);
}
/*========================================================*/
/* Otherwise a single field value is being retrieved from */
/* a multifield slot. Just return the type and value. */
/*========================================================*/
segmentPtr = (struct multifield *) factPtr->theProposition.theFields[theSlot].value;
fieldPtr = &segmentPtr->theFields[theField];
returnValue->type = fieldPtr->type;
returnValue->value = fieldPtr->value;
return(TRUE);
}
void C_leer_ficha(void *environment, DATA_OBJECT_PTR returnValuePtr)
{
SDL_Event evento;
int x, y, pos, head=1;
void *retorno;
char fin=0, fin2=0;
if (n == 0) {
x=-1;
y=-1;
fin = 1;
}
leyendo=1;
while (!fin) {
while (SDL_PollEvent(&evento)) {
switch (evento.type) {
case SDL_QUIT:
SDL_Quit();
fin = 1;
break;
case SDL_MOUSEBUTTONDOWN:
if (evento.button.button == SDL_BUTTON_RIGHT) {
x=-1; y=-1;
fin = 1;
break;
}
if (evento.button.y >= FICHAS_Y &&
evento.button.y <= FICHAS_Y + fichaH) {
for (pos=0; pos<n; ++pos) {
if (evento.button.y >= FICHAS_Y &&
evento.button.y <= FICHAS_Y + fichaH) {
if (evento.button.x >= (30 + pos*(fichaW + 10)) &&
evento.button.x <= (30 + pos*(fichaW + 10) + fichaW)) {
if (evento.button.y > FICHAS_Y + fichaH/2) {
x = fichas[jugador[pos]].y;
y = fichas[jugador[pos]].x;
}
else {
x = fichas[jugador[pos]].x;
y = fichas[jugador[pos]].y;
}
fin2=0;
while (!fin2) {
SDL_PollEvent(&evento);
switch (evento.type) {
case SDL_MOUSEBUTTONDOWN:
if (evento.button.button == SDL_BUTTON_RIGHT) fin2=1;
else {
if (is_head (evento.button.x, evento.button.y))
fin=1, fin2=1;
else if (is_tail (evento.button.x, evento.button.y)) {
fin = x;
x = y;
y = fin;
fin = 1;
head = 0;
fin2=1;
}
}
break;
}
}
}
}
}
}
break;
}
}
C_flip(environment);
}
retorno = EnvCreateMultifield(environment,3);
SetMFType(retorno, 1, INTEGER);
SetMFValue(retorno, 1, EnvAddLong(environment,x));
SetMFType(retorno, 2, INTEGER);
SetMFValue(retorno, 2, EnvAddLong(environment,y));
SetMFType(retorno, 3, INTEGER);
SetMFValue(retorno, 3, EnvAddLong(environment,head));
SetpType(returnValuePtr, MULTIFIELD);
SetpValue(returnValuePtr, retorno);
SetpDOBegin(returnValuePtr, 1);
SetpDOEnd(returnValuePtr, 3);
n=0;
while (SDL_PollEvent(&evento));
}
/***************************************************
NAME : GetObjectValueSimple
DESCRIPTION : Access function for getting
pattern variable values within the
object pattern and join networks
INPUTS : 1) The result data object buffer
2) The instance to access
3) Data for variable reference
RETURNS : Nothing useful
SIDE EFFECTS : Data object is filled with the
values of the pattern variable
NOTES : None
***************************************************/
static void GetObjectValueSimple(
void *theEnv,
DATA_OBJECT *result,
INSTANCE_TYPE *theInstance,
struct ObjectMatchVar2 *matchVar)
{
INSTANCE_SLOT **insSlot,*basisSlot;
SEGMENT *segmentPtr;
FIELD *fieldPtr;
insSlot =
&theInstance->slotAddresses
[theInstance->cls->slotNameMap[matchVar->whichSlot] - 1];
/* =========================================
We need to reference the basis slots if
the slot of this object has changed while
the RHS was executing
However, if the reference is being done
by the LHS of a rule (as a consequence of
an RHS action), give the pattern matcher
the real value of the slot
========================================= */
if ((theInstance->basisSlots != NULL) &&
(! EngineData(theEnv)->JoinOperationInProgress))
{
basisSlot = theInstance->basisSlots + (insSlot - theInstance->slotAddresses);
if (basisSlot->value != NULL)
insSlot = &basisSlot;
}
if ((*insSlot)->desc->multiple)
{
segmentPtr = (SEGMENT *) (*insSlot)->value;
if (matchVar->fromBeginning)
{
if (matchVar->fromEnd)
{
result->type = MULTIFIELD;
result->value = (void *) segmentPtr;
result->begin = matchVar->beginningOffset;
SetpDOEnd(result,GetMFLength(segmentPtr) - matchVar->endOffset);
}
else
{
fieldPtr = &segmentPtr->theFields[matchVar->beginningOffset];
result->type = fieldPtr->type;
result->value = fieldPtr->value;
}
}
else
{
fieldPtr = &segmentPtr->theFields[segmentPtr->multifieldLength -
(matchVar->endOffset + 1)];
result->type = fieldPtr->type;
result->value = fieldPtr->value;
}
}
else
{
result->type = (unsigned short) (*insSlot)->type;
result->value = (*insSlot)->value;
}
}
/*-deref or pk_tpn can fill malloced space, then can use this to get to a m.f.*/
VOID tpn_to_mf(DATA_OBJECT_PTR rp)
{
int num=1,stride=1,*pi,offset=0,i;
float *pf;
double *pd;
char tstr[9],type,*pc,t1[2];
VOID *mfp;
t1[1]='\0';
/*get the type*/
sprintf(tstr,"%s",(char *)RtnLexeme(1));
type = tolower(tstr[0]);
if(type!='i' && type!='f' && type!='d' && type!='b')
{
printf("[1st arg=type:i or f or d]");
return;
}
/*get number (& offset & stride) to put to a m.f.*/
if(RtnArgCount() > 2) num=(int)RtnLong(3);
if(RtnArgCount() > 3) offset=(int)RtnLong(4);
if(RtnArgCount() > 4) stride=(int)RtnLong(5);
/*could use SetMultifieldErrorValue(rp); return;*/
mfp = CreateMultifield(num);
/*get the ptr, and set the MF*/
switch(type)
{
case 'i' : pi = (int *)get_ptr(2);
for(i=0; i<num; i++)
{
SetMFType(mfp,i,INTEGER);
SetMFValue(mfp,i,AddLong(pi[offset+i]));
}
break;
case 'f' : pf = (float *)get_ptr(2);
for(i=0; i<num; i++)
{
printf("%f to mf,",pf[offset+i]); fflush(stdout);
SetMFType(mfp,i,FLOAT);
SetMFValue(mfp,i,AddDouble((double)pf[offset+i]));
}
break;
case 'd' : pd = (double *)get_ptr(2);
for(i=0; i<num; i++)
{
SetMFType(mfp,i,FLOAT);
SetMFValue(mfp,i,AddDouble(pd[offset+i]));
}
break;
/*this one could go per char or by stride or by space breaks*/
/*go by char for now*/
case 'b' : pc = (char *)get_ptr(2);
for(i=0; i<num; i++)
{
SetMFType(mfp,i,SYMBOL);
t1[0]=pc[offset+i];
SetMFValue(mfp,i,AddSymbol(t1));
}
break;
} /*gets past this and dies when printing out the result-
-looks liked capped ok though*/
SetpType(rp,MULTIFIELD);
SetpValue(rp,mfp);
SetpDOBegin(rp,1);
SetpDOEnd(rp,num);
return;
}
globle intBool FactPNGetVar1(
void *theEnv,
void *theValue,
DATA_OBJECT_PTR returnValue)
{
unsigned short theField, theSlot;
struct fact *factPtr;
struct field *fieldPtr;
struct multifieldMarker *marks;
struct multifield *segmentPtr;
long extent;
struct factGetVarPN1Call *hack;
/*==========================================*/
/* Retrieve the arguments for the function. */
/*==========================================*/
hack = (struct factGetVarPN1Call *) ValueToBitMap(theValue);
/*=====================================================*/
/* Get the pointer to the fact from the partial match. */
/*=====================================================*/
factPtr = FactData(theEnv)->CurrentPatternFact;
marks = FactData(theEnv)->CurrentPatternMarks;
/*==========================================================*/
/* Determine if we want to retrieve the fact address of the */
/* fact, rather than retrieving a field from the fact. */
/*==========================================================*/
if (hack->factAddress)
{
returnValue->type = FACT_ADDRESS;
returnValue->value = (void *) factPtr;
return(TRUE);
}
/*=========================================================*/
/* Determine if we want to retrieve the entire slot value. */
/*=========================================================*/
if (hack->allFields)
{
theSlot = hack->whichSlot;
fieldPtr = &factPtr->theProposition.theFields[theSlot];
returnValue->type = fieldPtr->type;
returnValue->value = fieldPtr->value;
if (returnValue->type == MULTIFIELD)
{
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,((struct multifield *) fieldPtr->value)->multifieldLength);
}
return(TRUE);
}
/*====================================================*/
/* If the slot being accessed is a single field slot, */
/* then just return the single value found in that */
/* slot. The multifieldMarker data structures do not */
/* have to be considered since access to a single */
/* field slot is not affected by variable bindings */
/* from multifield slots. */
/*====================================================*/
theField = hack->whichField;
theSlot = hack->whichSlot;
fieldPtr = &factPtr->theProposition.theFields[theSlot];
/*==========================================================*/
/* Retrieve a value from a multifield slot. First determine */
/* the range of fields for the variable being retrieved. */
/*==========================================================*/
extent = -1;
theField = AdjustFieldPosition(theEnv,marks,theField,theSlot,&extent);
/*=============================================================*/
/* If a range of values are being retrieved (i.e. a multifield */
/* variable), then return the values as a multifield. */
/*=============================================================*/
if (extent != -1)
{
returnValue->type = MULTIFIELD;
returnValue->value = (void *) fieldPtr->value;
returnValue->begin = theField;
returnValue->end = theField + extent - 1;
return(TRUE);
}
/*========================================================*/
/* Otherwise a single field value is being retrieved from */
/* a multifield slot. Just return the type and value. */
/*========================================================*/
segmentPtr = (struct multifield *) fieldPtr->value;
fieldPtr = &segmentPtr->theFields[theField];
returnValue->type = fieldPtr->type;
returnValue->value = fieldPtr->value;
return(TRUE);
}
globle void DeriveDefaultFromConstraints(
void *theEnv,
CONSTRAINT_RECORD *constraints,
DATA_OBJECT *theDefault,
int multifield,
int garbageMultifield)
{
unsigned short theType;
unsigned long minFields;
void *theValue;
/*=============================================================*/
/* If no constraints are specified, then use the symbol nil as */
/* a default for single field slots and a multifield of length */
/* 0 as a default for multifield slots. */
/*=============================================================*/
if (constraints == NULL)
{
if (multifield)
{
SetpType(theDefault,MULTIFIELD);
SetpDOBegin(theDefault,1);
SetpDOEnd(theDefault,0);
if (garbageMultifield) SetpValue(theDefault,(void *) EnvCreateMultifield(theEnv,0L));
else SetpValue(theDefault,(void *) CreateMultifield2(theEnv,0L));
}
else
{
theDefault->type = SYMBOL;
theDefault->value = EnvAddSymbol(theEnv,(char*)"nil");
}
return;
}
/*=========================================*/
/* Determine the default's type and value. */
/*=========================================*/
if (constraints->anyAllowed || constraints->symbolsAllowed)
{
theType = SYMBOL;
theValue = FindDefaultValue(theEnv,SYMBOL,constraints,EnvAddSymbol(theEnv,(char*)"nil"));
}
else if (constraints->stringsAllowed)
{
theType = STRING;
theValue = FindDefaultValue(theEnv,STRING,constraints,EnvAddSymbol(theEnv,(char*)""));
}
else if (constraints->integersAllowed)
{
theType = INTEGER;
theValue = FindDefaultValue(theEnv,INTEGER,constraints,EnvAddLong(theEnv,0LL));
}
else if (constraints->floatsAllowed)
{
theType = FLOAT;
theValue = FindDefaultValue(theEnv,FLOAT,constraints,EnvAddDouble(theEnv,0.0));
}
#if OBJECT_SYSTEM
else if (constraints->instanceNamesAllowed)
{
theType = INSTANCE_NAME;
theValue = FindDefaultValue(theEnv,INSTANCE_NAME,constraints,EnvAddSymbol(theEnv,(char*)"nil"));
}
else if (constraints->instanceAddressesAllowed)
{
theType = INSTANCE_ADDRESS;
theValue = (void *) &InstanceData(theEnv)->DummyInstance;
}
#endif
#if DEFTEMPLATE_CONSTRUCT
else if (constraints->factAddressesAllowed)
{
theType = FACT_ADDRESS;
theValue = (void *) &FactData(theEnv)->DummyFact;
}
#endif
else if (constraints->externalAddressesAllowed)
{
theType = EXTERNAL_ADDRESS;
theValue = EnvAddExternalAddress(theEnv,NULL,0);
}
else
{
theType = SYMBOL;
theValue = EnvAddSymbol(theEnv,(char*)"nil");
}
/*=========================================================*/
/* If the default is for a multifield slot, then create a */
/* multifield default value that satisfies the cardinality */
/* constraints for the slot. The default value for a */
/* multifield slot is a multifield of length 0. */
/*=========================================================*/
if (multifield)
{
if (constraints->minFields == NULL) minFields = 0;
else if (constraints->minFields->value == SymbolData(theEnv)->NegativeInfinity) minFields = 0;
else minFields = (unsigned long) ValueToLong(constraints->minFields->value);
SetpType(theDefault,MULTIFIELD);
SetpDOBegin(theDefault,1);
SetpDOEnd(theDefault,(long) minFields);
if (garbageMultifield) SetpValue(theDefault,(void *) EnvCreateMultifield(theEnv,minFields));
else SetpValue(theDefault,(void *) CreateMultifield2(theEnv,minFields));
for (; minFields > 0; minFields--)
{
SetMFType(GetpValue(theDefault),minFields,theType);
SetMFValue(GetpValue(theDefault),minFields,theValue);
}
}
else
{
theDefault->type = theType;
theDefault->value = theValue;
}
}
