globle intBool FactPNGetVar3(
void *theEnv,
void *theValue,
DATA_OBJECT_PTR returnValue)
{
struct fact *factPtr;
struct multifield *segmentPtr;
struct field *fieldPtr;
struct factGetVarPN3Call *hack;
/*==========================================*/
/* Retrieve the arguments for the function. */
/*==========================================*/
hack = (struct factGetVarPN3Call *) ValueToBitMap(theValue);
/*==============================*/
/* Get the pointer to the fact. */
/*==============================*/
factPtr = FactData(theEnv)->CurrentPatternFact;
/*============================================================*/
/* Get the multifield value from which the data is retrieved. */
/*============================================================*/
segmentPtr = (struct multifield *) factPtr->theProposition.theFields[hack->whichSlot].value;
/*=========================================*/
/* If the beginning and end flags are set, */
/* then retrieve a multifield value. */
/*=========================================*/
if (hack->fromBeginning && hack->fromEnd)
{
returnValue->type = MULTIFIELD;
returnValue->value = (void *) segmentPtr;
returnValue->begin = (long) hack->beginOffset;
returnValue->end = (long) (segmentPtr->multifieldLength - (hack->endOffset + 1));
return(TRUE);
}
/*=====================================================*/
/* Return a single field value from a multifield slot. */
/*=====================================================*/
if (hack->fromBeginning)
{
fieldPtr = &segmentPtr->theFields[hack->beginOffset];
}
else
{
fieldPtr = &segmentPtr->theFields[segmentPtr->multifieldLength - (hack->endOffset + 1)];
}
returnValue->type = fieldPtr->type;
returnValue->value = fieldPtr->value;
return(TRUE);
}
bool FactPNGetVar2(
Environment *theEnv,
void *theValue,
UDFValue *returnValue)
{
Fact *factPtr;
struct factGetVarPN2Call *hack;
CLIPSValue *fieldPtr;
/*==========================================*/
/* Retrieve the arguments for the function. */
/*==========================================*/
hack = (struct factGetVarPN2Call *) ((CLIPSBitMap *) theValue)->contents;
/*==============================*/
/* Get the pointer to the fact. */
/*==============================*/
factPtr = FactData(theEnv)->CurrentPatternFact;
/*============================================*/
/* Extract the value from the specified slot. */
/*============================================*/
fieldPtr = &factPtr->theProposition.contents[hack->whichSlot];
returnValue->value = fieldPtr->value;
return true;
}
static void UpdateDeftemplate(
void *theEnv,
void *buf,
long obji)
{
struct deftemplate *theDeftemplate;
struct bsaveDeftemplate *bdtPtr;
bdtPtr = (struct bsaveDeftemplate *) buf;
theDeftemplate = (struct deftemplate *) &DeftemplateBinaryData(theEnv)->DeftemplateArray[obji];
UpdateConstructHeader(theEnv,&bdtPtr->header,&theDeftemplate->header,
(int) sizeof(struct deftemplateModule),(void *) DeftemplateBinaryData(theEnv)->ModuleArray,
(int) sizeof(struct deftemplate),(void *) DeftemplateBinaryData(theEnv)->DeftemplateArray);
if (bdtPtr->slotList != -1L)
{ theDeftemplate->slotList = (struct templateSlot *) &DeftemplateBinaryData(theEnv)->SlotArray[bdtPtr->slotList]; }
else
{ theDeftemplate->slotList = NULL; }
if (bdtPtr->patternNetwork != -1L)
{ theDeftemplate->patternNetwork = (struct factPatternNode *) BloadFactPatternPointer(bdtPtr->patternNetwork); }
else
{ theDeftemplate->patternNetwork = NULL; }
theDeftemplate->implied = bdtPtr->implied;
#if DEBUGGING_FUNCTIONS
theDeftemplate->watch = FactData(theEnv)->WatchFacts;
#endif
theDeftemplate->inScope = FALSE;
theDeftemplate->numberOfSlots = (unsigned short) bdtPtr->numberOfSlots;
theDeftemplate->factList = NULL;
theDeftemplate->lastFact = NULL;
}
globle intBool FactPNConstant1(
void *theEnv,
void *theValue,
DATA_OBJECT_PTR returnValue)
{
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(returnValue)
#endif
struct factConstantPN1Call *hack;
struct field *fieldPtr;
struct expr *theConstant;
/*==========================================*/
/* Retrieve the arguments for the function. */
/*==========================================*/
hack = (struct factConstantPN1Call *) ValueToBitMap(theValue);
/*============================================*/
/* Extract the value from the specified slot. */
/*============================================*/
fieldPtr = &FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->whichSlot];
/*====================================*/
/* Compare the value to the constant. */
/*====================================*/
theConstant = GetFirstArgument();
if (theConstant->type != fieldPtr->type) return(1 - hack->testForEquality);
if (theConstant->value != fieldPtr->value) return(1 - hack->testForEquality);
return(hack->testForEquality);
}
globle intBool FactPNGetVar2(
void *theEnv,
void *theValue,
DATA_OBJECT_PTR returnValue)
{
struct fact *factPtr;
struct factGetVarPN2Call *hack;
struct field *fieldPtr;
/*==========================================*/
/* Retrieve the arguments for the function. */
/*==========================================*/
hack = (struct factGetVarPN2Call *) ValueToBitMap(theValue);
/*==============================*/
/* Get the pointer to the fact. */
/*==============================*/
factPtr = FactData(theEnv)->CurrentPatternFact;
/*============================================*/
/* Extract the value from the specified slot. */
/*============================================*/
fieldPtr = &factPtr->theProposition.theFields[hack->whichSlot];
returnValue->type = fieldPtr->type;
returnValue->value = fieldPtr->value;
return(TRUE);
}
void AssignErrorValue(
UDFContext *context)
{
if (context->theFunction->unknownReturnValueType & BOOLEAN_TYPE)
{ mCVSetBoolean(context->returnValue,false); }
else if (context->theFunction->unknownReturnValueType & STRING_TYPE)
{ mCVSetString(context->returnValue,""); }
else if (context->theFunction->unknownReturnValueType & SYMBOL_TYPE)
{ mCVSetSymbol(context->returnValue,"nil"); }
else if (context->theFunction->unknownReturnValueType & INTEGER_TYPE)
{ mCVSetInteger(context->returnValue,0); }
else if (context->theFunction->unknownReturnValueType & FLOAT_TYPE)
{ mCVSetFloat(context->returnValue,0.0); }
else if (context->theFunction->unknownReturnValueType & MULTIFIELD_TYPE)
{ EnvSetMultifieldErrorValue(context->environment,context->returnValue); }
else if (context->theFunction->unknownReturnValueType & INSTANCE_NAME_TYPE)
{ mCVSetInstanceName(context->returnValue,"nil"); }
else if (context->theFunction->unknownReturnValueType & FACT_ADDRESS_TYPE)
{ mCVSetFactAddress(context->returnValue,&FactData(context->environment)->DummyFact); }
else if (context->theFunction->unknownReturnValueType & INSTANCE_ADDRESS_TYPE)
{ mCVSetInstanceAddress(context->returnValue,&InstanceData(context->environment)->DummyInstance); }
else if (context->theFunction->unknownReturnValueType & EXTERNAL_ADDRESS_TYPE)
{ CVSetExternalAddress(context->returnValue,NULL,0); }
else
{ mCVSetVoid(context->returnValue); }
}
static void UpdateDeftemplate(
Environment *theEnv,
void *buf,
unsigned long obji)
{
Deftemplate *theDeftemplate;
struct bsaveDeftemplate *bdtPtr;
bdtPtr = (struct bsaveDeftemplate *) buf;
theDeftemplate = &DeftemplateBinaryData(theEnv)->DeftemplateArray[obji];
UpdateConstructHeader(theEnv,&bdtPtr->header,&theDeftemplate->header,DEFTEMPLATE,
sizeof(struct deftemplateModule),DeftemplateBinaryData(theEnv)->ModuleArray,
sizeof(Deftemplate),DeftemplateBinaryData(theEnv)->DeftemplateArray);
if (bdtPtr->slotList != ULONG_MAX)
{ theDeftemplate->slotList = (struct templateSlot *) &DeftemplateBinaryData(theEnv)->SlotArray[bdtPtr->slotList]; }
else
{ theDeftemplate->slotList = NULL; }
if (bdtPtr->patternNetwork != ULONG_MAX)
{ theDeftemplate->patternNetwork = (struct factPatternNode *) BloadFactPatternPointer(bdtPtr->patternNetwork); }
else
{ theDeftemplate->patternNetwork = NULL; }
theDeftemplate->implied = bdtPtr->implied;
#if DEBUGGING_FUNCTIONS
theDeftemplate->watch = FactData(theEnv)->WatchFacts;
#endif
theDeftemplate->inScope = false;
theDeftemplate->numberOfSlots = bdtPtr->numberOfSlots;
theDeftemplate->factList = NULL;
theDeftemplate->lastFact = NULL;
}
bool FactPNConstant2(
Environment *theEnv,
void *theValue,
UDFValue *returnValue)
{
#if MAC_XCD
#pragma unused(returnValue)
#endif
struct factConstantPN2Call *hack;
CLIPSValue *fieldPtr;
struct expr *theConstant;
Multifield *segmentPtr;
/*==========================================*/
/* Retrieve the arguments for the function. */
/*==========================================*/
hack = (struct factConstantPN2Call *) ((CLIPSBitMap *) theValue)->contents;
/*==========================================================*/
/* Extract the value from the specified slot. Note that the */
/* test to determine the slot's type (multifield) should be */
/* unnecessary since this routine should only be used for */
/* multifield slots. */
/*==========================================================*/
fieldPtr = &FactData(theEnv)->CurrentPatternFact->theProposition.contents[hack->whichSlot];
if (fieldPtr->header->type == MULTIFIELD_TYPE)
{
segmentPtr = fieldPtr->multifieldValue;
if (hack->fromBeginning)
{ fieldPtr = &segmentPtr->contents[hack->offset]; }
else
{
fieldPtr = &segmentPtr->contents[segmentPtr->length -
(hack->offset + 1)];
}
}
/*====================================*/
/* Compare the value to the constant. */
/*====================================*/
theConstant = GetFirstArgument();
if (theConstant->value != fieldPtr->value)
{
if (1 - hack->testForEquality)
{ return true; }
else
{ return false; }
}
if (hack->testForEquality)
{ return true; }
else
{ return false; }
}
static void PatternNetErrorMessage(
void *theEnv,
struct factPatternNode *patternPtr)
{
char buffer[60];
struct templateSlot *theSlots;
int i;
/*=======================================*/
/* Print the fact being pattern matched. */
/*=======================================*/
PrintErrorID(theEnv,"FACTMCH",1,TRUE);
EnvPrintRouter(theEnv,WERROR,"This error occurred in the fact pattern network\n");
EnvPrintRouter(theEnv,WERROR," Currently active fact: ");
PrintFact(theEnv,WERROR,FactData(theEnv)->CurrentPatternFact,FALSE,FALSE);
EnvPrintRouter(theEnv,WERROR,"\n");
/*==============================================*/
/* Print the field position or slot name of the */
/* pattern from which the error originated. */
/*==============================================*/
if (FactData(theEnv)->CurrentPatternFact->whichDeftemplate->implied)
{
sprintf(buffer," Problem resides in field #%d\n",patternPtr->whichField);
}
else
{
theSlots = FactData(theEnv)->CurrentPatternFact->whichDeftemplate->slotList;
for (i = 0; i < (int) patternPtr->whichSlot; i++) theSlots = theSlots->next;
sprintf(buffer," Problem resides in slot %s\n",ValueToString(theSlots->slotName));
}
EnvPrintRouter(theEnv,WERROR,buffer);
/*==========================================================*/
/* Trace the pattern to its entry point to the join network */
/* (which then traces to the defrule data structure so that */
/* the name(s) of the rule(s) utilizing the patterns can be */
/* printed). */
/*==========================================================*/
TraceErrorToJoin(theEnv,patternPtr,FALSE);
EnvPrintRouter(theEnv,WERROR,"\n");
}
globle void AddHashedFact(
void *theEnv,
struct fact *theFact,
unsigned long hashValue)
{
struct factHashEntry *newhash, *temp;
if (FactData(theEnv)->NumberOfFacts > FactData(theEnv)->FactHashTableSize)
{ ResizeFactHashTable(theEnv); }
newhash = get_struct(theEnv,factHashEntry);
newhash->theFact = theFact;
hashValue = (hashValue % FactData(theEnv)->FactHashTableSize);
temp = FactData(theEnv)->FactHashTable[hashValue];
FactData(theEnv)->FactHashTable[hashValue] = newhash;
newhash->next = temp;
}
bool FactPNGetVar3(
Environment *theEnv,
void *theValue,
UDFValue *returnValue)
{
Fact *factPtr;
Multifield *segmentPtr;
CLIPSValue *fieldPtr;
struct factGetVarPN3Call *hack;
/*==========================================*/
/* Retrieve the arguments for the function. */
/*==========================================*/
hack = (struct factGetVarPN3Call *) ((CLIPSBitMap *) theValue)->contents;
/*==============================*/
/* Get the pointer to the fact. */
/*==============================*/
factPtr = FactData(theEnv)->CurrentPatternFact;
/*============================================================*/
/* Get the multifield value from which the data is retrieved. */
/*============================================================*/
segmentPtr = factPtr->theProposition.contents[hack->whichSlot].multifieldValue;
/*=========================================*/
/* If the beginning and end flags are set, */
/* then retrieve a multifield value. */
/*=========================================*/
if (hack->fromBeginning && hack->fromEnd)
{
returnValue->value = segmentPtr;
returnValue->begin = hack->beginOffset;
returnValue->range = segmentPtr->length - (hack->endOffset + hack->beginOffset);
return true;
}
/*=====================================================*/
/* Return a single field value from a multifield slot. */
/*=====================================================*/
if (hack->fromBeginning)
{ fieldPtr = &segmentPtr->contents[hack->beginOffset]; }
else
{ fieldPtr = &segmentPtr->contents[segmentPtr->length - (hack->endOffset + 1)]; }
returnValue->value = fieldPtr->value;
return true;
}
globle void ShowFactHashTable(
void *theEnv)
{
int i, count;
struct factHashEntry *theEntry;
char buffer[20];
for (i = 0; i < FactData(theEnv)->FactHashTableSize; i++)
{
for (theEntry = FactData(theEnv)->FactHashTable[i], count = 0;
theEntry != NULL;
theEntry = theEntry->next)
{ count++; }
if (count != 0)
{
gensprintf(buffer,"%4d: %4d\n",i,count);
EnvPrintRouter(theEnv,WDISPLAY,buffer);
}
}
}
globle intBool FactPNConstant2(
void *theEnv,
EXEC_STATUS,
void *theValue,
DATA_OBJECT_PTR returnValue)
{
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(returnValue)
#endif
struct factConstantPN2Call *hack;
struct field *fieldPtr;
struct expr *theConstant;
struct multifield *segmentPtr;
/*==========================================*/
/* Retrieve the arguments for the function. */
/*==========================================*/
hack = (struct factConstantPN2Call *) ValueToBitMap(theValue);
/*==========================================================*/
/* Extract the value from the specified slot. Note that the */
/* test to determine the slot's type (multifield) should be */
/* unnecessary since this routine should only be used for */
/* multifield slots. */
/*==========================================================*/
fieldPtr = &FactData(theEnv,execStatus)->CurrentPatternFact->theProposition.theFields[hack->whichSlot];
if (fieldPtr->type == MULTIFIELD)
{
segmentPtr = (struct multifield *) fieldPtr->value;
if (hack->fromBeginning)
{ fieldPtr = &segmentPtr->theFields[hack->offset]; }
else
{
fieldPtr = &segmentPtr->theFields[segmentPtr->multifieldLength -
(hack->offset + 1)];
}
}
/*====================================*/
/* Compare the value to the constant. */
/*====================================*/
theConstant = GetFirstArgument();
if (theConstant->type != fieldPtr->type) return(1 - hack->testForEquality);
if (theConstant->value != fieldPtr->value) return(1 - hack->testForEquality);
return(hack->testForEquality);
}
globle intBool RemoveHashedFact(
void *theEnv,
struct fact *theFact)
{
unsigned long hashValue;
struct factHashEntry *hptr, *prev;
hashValue = HashFact(theFact);
hashValue = (hashValue % FactData(theEnv)->FactHashTableSize);
for (hptr = FactData(theEnv)->FactHashTable[hashValue], prev = NULL;
hptr != NULL;
hptr = hptr->next)
{
if (hptr->theFact == theFact)
{
if (prev == NULL)
{
FactData(theEnv)->FactHashTable[hashValue] = hptr->next;
rtn_struct(theEnv,factHashEntry,hptr);
if (FactData(theEnv)->NumberOfFacts == 1)
{ ResetFactHashTable(theEnv); }
return(1);
}
else
{
prev->next = hptr->next;
rtn_struct(theEnv,factHashEntry,hptr);
if (FactData(theEnv)->NumberOfFacts == 1)
{ ResetFactHashTable(theEnv); }
return(1);
}
}
prev = hptr;
}
return(0);
}
globle intBool FactSlotLength(
void *theEnv,
void *theValue,
DATA_OBJECT_PTR returnValue)
{
struct factCheckLengthPNCall *hack;
struct multifield *segmentPtr;
long extraOffset = 0;
struct multifieldMarker *tempMark;
returnValue->type = SYMBOL;
returnValue->value = EnvFalseSymbol(theEnv);
hack = (struct factCheckLengthPNCall *) ValueToBitMap(theValue);
for (tempMark = FactData(theEnv)->CurrentPatternMarks;
tempMark != NULL;
tempMark = tempMark->next)
{
if (tempMark->where.whichSlotNumber != hack->whichSlot) continue;
extraOffset += ((tempMark->endPosition - tempMark->startPosition) + 1);
}
segmentPtr = (struct multifield *) FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->whichSlot].value;
if (segmentPtr->multifieldLength < (hack->minLength + extraOffset))
{
return(FALSE);
}
if (hack->exactly && (segmentPtr->multifieldLength > (hack->minLength + extraOffset)))
{
return(FALSE);
}
returnValue->value = EnvTrueSymbol(theEnv);
return(TRUE);
}
static struct fact *FactExists(
void *theEnv,
struct fact *theFact,
unsigned long hashValue)
{
struct factHashEntry *theFactHash;
hashValue = (hashValue % FactData(theEnv)->FactHashTableSize);
for (theFactHash = FactData(theEnv)->FactHashTable[hashValue];
theFactHash != NULL;
theFactHash = theFactHash->next)
{
if (theFact->hashValue != theFactHash->theFact->hashValue)
{ continue; }
if ((theFact->whichDeftemplate == theFactHash->theFact->whichDeftemplate) ?
MultifieldsEqual(&theFact->theProposition,
&theFactHash->theFact->theProposition) : FALSE)
{ return(theFactHash->theFact); }
}
return(NULL);
}
bool FactPNConstant1(
Environment *theEnv,
void *theValue,
UDFValue *returnValue)
{
#if MAC_XCD
#pragma unused(returnValue)
#endif
struct factConstantPN1Call *hack;
CLIPSValue *fieldPtr;
struct expr *theConstant;
/*==========================================*/
/* Retrieve the arguments for the function. */
/*==========================================*/
hack = (struct factConstantPN1Call *) ((CLIPSBitMap *) theValue)->contents;
/*============================================*/
/* Extract the value from the specified slot. */
/*============================================*/
fieldPtr = &FactData(theEnv)->CurrentPatternFact->theProposition.contents[hack->whichSlot];
/*====================================*/
/* Compare the value to the constant. */
/*====================================*/
theConstant = GetFirstArgument();
if (theConstant->value != fieldPtr->value)
{
if (1 - hack->testForEquality)
{ return true; }
else
{ return false; }
}
if (hack->testForEquality)
{ return true; }
else
{ return false; }
}
globle unsigned long HandleFactDuplication(
void *theEnv,
void *theFact,
intBool *duplicate)
{
struct fact *tempPtr;
unsigned long hashValue;
*duplicate = FALSE;
hashValue = HashFact((struct fact *) theFact);
if (FactData(theEnv)->FactDuplication) return(hashValue);
tempPtr = FactExists(theEnv,(struct fact *) theFact,hashValue);
if (tempPtr == NULL) return(hashValue);
ReturnFact(theEnv,(struct fact *) theFact);
#if DEFRULE_CONSTRUCT
AddLogicalDependencies(theEnv,(struct patternEntity *) tempPtr,TRUE);
#endif
*duplicate = TRUE;
return(0);
}
static void ResizeFactHashTable(
void *theEnv)
{
unsigned long i, newSize, newLocation;
struct factHashEntry **theTable, **newTable;
struct factHashEntry *theEntry, *nextEntry;
theTable = FactData(theEnv)->FactHashTable;
newSize = (FactData(theEnv)->FactHashTableSize * 2) + 1;
newTable = CreateFactHashTable(theEnv,newSize);
/*========================================*/
/* Copy the old entries to the new table. */
/*========================================*/
for (i = 0; i < FactData(theEnv)->FactHashTableSize; i++)
{
theEntry = theTable[i];
while (theEntry != NULL)
{
nextEntry = theEntry->next;
newLocation = theEntry->theFact->hashValue % newSize;
theEntry->next = newTable[newLocation];
newTable[newLocation] = theEntry;
theEntry = nextEntry;
}
}
/*=====================================================*/
/* Replace the old hash table with the new hash table. */
/*=====================================================*/
rm3(theEnv,theTable,sizeof(struct factHashEntry *) * FactData(theEnv)->FactHashTableSize);
FactData(theEnv)->FactHashTableSize = newSize;
FactData(theEnv)->FactHashTable = newTable;
}
globle void FactPatternMatch(
void *theEnv,
struct fact *theFact,
struct factPatternNode *patternPtr,
int offset,
struct multifieldMarker *markers,
struct multifieldMarker *endMark)
{
int theSlotField;
int offsetSlot;
DATA_OBJECT theResult;
struct factPatternNode *tempPtr;
/*=========================================================*/
/* If there's nothing left in the pattern network to match */
/* against, then the current traversal of the pattern */
/* network needs to back up. */
/*=========================================================*/
if (patternPtr == NULL) return;
/*=======================================================*/
/* The offsetSlot variable indicates the current offset */
/* within the multifield slot being pattern matched. */
/* (Recall that a multifield wildcard or variable */
/* recursively iterates through all possible bindings.) */
/* Once a new slot starts being pattern matched, the */
/* offset is reset to zero. */
/*=======================================================*/
offsetSlot = patternPtr->whichSlot;
/*================================================*/
/* Set up some global parameters for use by the */
/* Rete access functions and general convenience. */
/*================================================*/
FactData(theEnv)->CurrentPatternFact = theFact;
FactData(theEnv)->CurrentPatternMarks = markers;
/*============================================*/
/* Loop through each node in pattern network. */
/*============================================*/
while (patternPtr != NULL)
{
/*=============================================================*/
/* Determine the position of the field we're going to pattern */
/* match. If this routine has been entered recursively because */
/* of multifield wildcards or variables, then add in the */
/* additional offset caused by the values which match these */
/* multifields. This offset may be negative (if for example a */
/* a multifield matched a zero length value). */
/*=============================================================*/
theSlotField = patternPtr->whichField;
if (offsetSlot == patternPtr->whichSlot)
{ theSlotField += offset; }
/*===================================*/
/* Determine if we want to skip this */
/* node during an incremental reset. */
/*===================================*/
if (SkipFactPatternNode(theEnv,patternPtr))
{ patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr); }
/*=========================================================*/
/* If this is a single field pattern node, then determine */
/* if the constraints for the node have been satisfied for */
/* the current field in the slot being examined. */
/*=========================================================*/
else if (patternPtr->header.singlefieldNode)
{
/*==================================================*/
/* If we're at the last slot in the pattern, make */
/* sure the number of fields in the fact correspond */
/* to the number of fields required by the pattern */
/* based on the binding of multifield variables. */
/*==================================================*/
int skipit = FALSE;
if (patternPtr->header.endSlot &&
((FactData(theEnv)->CurrentPatternMarks == NULL) ?
FALSE :
(FactData(theEnv)->CurrentPatternMarks->where.whichSlotNumber == patternPtr->whichSlot)) &&
(FactData(theEnv)->CurrentPatternFact->theProposition.theFields
[patternPtr->whichSlot].type == MULTIFIELD))
{
if ((patternPtr->leaveFields + theSlotField) != (int)
((struct multifield *) FactData(theEnv)->CurrentPatternFact->theProposition.theFields
[patternPtr->whichSlot].value)->multifieldLength)
{ skipit = TRUE; }
}
if (skipit)
{ patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr); }
else
if (patternPtr->header.selector)
{
if (EvaluatePatternExpression(theEnv,patternPtr,patternPtr->networkTest->nextArg))
{
EvaluateExpression(theEnv,patternPtr->networkTest,&theResult);
tempPtr = (struct factPatternNode *) FindHashedPatternNode(theEnv,patternPtr,theResult.type,theResult.value);
}
else
{ tempPtr = NULL; }
if (tempPtr != NULL)
{
if (SkipFactPatternNode(theEnv,tempPtr))
{ patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr); }
else
{
if (tempPtr->header.stopNode)
{ ProcessFactAlphaMatch(theEnv,theFact,markers,tempPtr); }
patternPtr = GetNextFactPatternNode(theEnv,FALSE,tempPtr);
}
}
else
{ patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr); }
}
/*=============================================*/
/* If the constraints are satisified, then ... */
/*=============================================*/
else if (EvaluatePatternExpression(theEnv,patternPtr,patternPtr->networkTest))
{
/*=======================================================*/
/* If a leaf pattern node has been successfully reached, */
/* then the pattern has been satisified. Generate an */
/* alpha match to store in the pattern node. */
/*=======================================================*/
if (patternPtr->header.stopNode)
{ ProcessFactAlphaMatch(theEnv,theFact,markers,patternPtr); }
/*===================================*/
/* Move on to the next pattern node. */
/*===================================*/
patternPtr = GetNextFactPatternNode(theEnv,FALSE,patternPtr);
}
/*==============================================*/
/* Otherwise, move on to the next pattern node. */
/*==============================================*/
else
{ patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr); }
}
/*======================================================*/
/* If this is a multifield pattern node, then determine */
/* if the constraints for the node have been satisfied */
/* for the current field in the slot being examined. */
/*======================================================*/
else if (patternPtr->header.multifieldNode)
{
/*========================================================*/
/* Determine if the multifield pattern node's constraints */
/* are satisfied. If we've traversed to a different slot */
/* than the one we started this routine with, then the */
/* offset into the slot is reset to zero. */
/*========================================================*/
if (offsetSlot == patternPtr->whichSlot)
{ ProcessMultifieldNode(theEnv,patternPtr,markers,endMark,offset); }
else
{ ProcessMultifieldNode(theEnv,patternPtr,markers,endMark,0); }
/*===================================================*/
/* Move on to the next pattern node. Since the lower */
/* branches of the pattern network have already been */
/* recursively processed by ProcessMultifieldNode, */
/* we get the next pattern node by treating this */
/* multifield pattern node as if it were a single */
/* field pattern node that failed its constraint. */
/*===================================================*/
patternPtr = GetNextFactPatternNode(theEnv,TRUE,patternPtr);
}
}
}
static void ProcessMultifieldNode(
void *theEnv,
struct factPatternNode *thePattern,
struct multifieldMarker *markers,
struct multifieldMarker *endMark,
int offset)
{
struct multifieldMarker *newMark, *oldMark;
int repeatCount;
struct multifield *theSlotValue;
DATA_OBJECT theResult;
struct factPatternNode *tempPtr;
intBool success;
/*========================================*/
/* Get a pointer to the slot value of the */
/* multifield slot being pattern matched. */
/*========================================*/
theSlotValue = (struct multifield *)
FactData(theEnv)->CurrentPatternFact->theProposition.theFields[thePattern->whichSlot].value;
/*===============================================*/
/* Save the value of the markers already stored. */
/*===============================================*/
oldMark = markers;
/*===========================================*/
/* Create a new multifield marker and append */
/* it to the end of the current list. */
/*===========================================*/
newMark = get_struct(theEnv,multifieldMarker);
newMark->whichField = thePattern->whichField - 1;
newMark->where.whichSlotNumber = (short) thePattern->whichSlot;
newMark->startPosition = (thePattern->whichField - 1) + offset;
newMark->next = NULL;
if (endMark == NULL)
{
markers = newMark;
FactData(theEnv)->CurrentPatternMarks = markers;
}
else
{ endMark->next = newMark; }
/*============================================*/
/* Handle a multifield constraint as the last */
/* constraint of a slot as a special case. */
/*============================================*/
if (thePattern->header.endSlot)
{
newMark->endPosition = (long) theSlotValue->multifieldLength -
(thePattern->leaveFields + 1);
/*=======================================================*/
/* Make sure the endPosition is never more than less one */
/* less of the startPosition (a multifield containing no */
/* values. */
/*=======================================================*/
if (newMark->endPosition < newMark->startPosition)
{ newMark->endPosition = newMark->startPosition - 1; }
/*===========================================*/
/* Determine if the constraint is satisfied. */
/*===========================================*/
if (thePattern->header.selector)
{
if (EvaluatePatternExpression(theEnv,thePattern,thePattern->networkTest->nextArg))
{
EvaluateExpression(theEnv,thePattern->networkTest,&theResult);
thePattern = (struct factPatternNode *) FindHashedPatternNode(theEnv,thePattern,theResult.type,theResult.value);
if (thePattern != NULL)
{ success = TRUE; }
else
{ success = FALSE; }
}
else
{ success = FALSE; }
}
else if ((thePattern->networkTest == NULL) ?
TRUE :
(EvaluatePatternExpression(theEnv,thePattern,thePattern->networkTest)))
{ success = TRUE; }
else
{ success = FALSE; }
if (success)
{
/*=======================================================*/
/* If a leaf pattern node has been successfully reached, */
/* then the pattern has been satisified. Generate an */
/* alpha match to store in the pattern node. */
/*=======================================================*/
if (thePattern->header.stopNode)
{ ProcessFactAlphaMatch(theEnv,FactData(theEnv)->CurrentPatternFact,FactData(theEnv)->CurrentPatternMarks,thePattern); }
/*=============================================*/
/* Recursively continue pattern matching based */
/* on the multifield binding just generated. */
/*=============================================*/
FactPatternMatch(theEnv,FactData(theEnv)->CurrentPatternFact,
thePattern->nextLevel,0,FactData(theEnv)->CurrentPatternMarks,newMark);
}
/*================================================*/
/* Discard the multifield marker since we've done */
/* all the pattern matching for this binding of */
/* the multifield slot constraint. */
/*================================================*/
rtn_struct(theEnv,multifieldMarker,newMark);
if (endMark != NULL) endMark->next = NULL;
FactData(theEnv)->CurrentPatternMarks = oldMark;
return;
}
/*==============================================*/
/* Perform matching for nodes beneath this one. */
/*==============================================*/
for (repeatCount = (long) (theSlotValue->multifieldLength -
(newMark->startPosition + thePattern->leaveFields));
repeatCount >= 0;
repeatCount--)
{
newMark->endPosition = newMark->startPosition + (repeatCount - 1);
if (thePattern->header.selector)
{
if (EvaluatePatternExpression(theEnv,thePattern,thePattern->networkTest->nextArg))
{
EvaluateExpression(theEnv,thePattern->networkTest,&theResult);
tempPtr = (struct factPatternNode *) FindHashedPatternNode(theEnv,thePattern,theResult.type,theResult.value);
if (tempPtr != NULL)
{
FactPatternMatch(theEnv,FactData(theEnv)->CurrentPatternFact,
tempPtr->nextLevel,offset + repeatCount - 1,
FactData(theEnv)->CurrentPatternMarks,newMark);
}
}
}
else if ((thePattern->networkTest == NULL) ?
TRUE :
(EvaluatePatternExpression(theEnv,thePattern,thePattern->networkTest)))
{
FactPatternMatch(theEnv,FactData(theEnv)->CurrentPatternFact,
thePattern->nextLevel,offset + repeatCount - 1,
FactData(theEnv)->CurrentPatternMarks,newMark);
}
}
/*======================================================*/
/* Get rid of the marker created for a multifield node. */
/*======================================================*/
rtn_struct(theEnv,multifieldMarker,newMark);
if (endMark != NULL) endMark->next = NULL;
FactData(theEnv)->CurrentPatternMarks = oldMark;
}
globle const char *DataObjectToString(
void *theEnv,
DATA_OBJECT *theDO)
{
void *thePtr;
const char *theString;
char *newString;
const char *prefix, *postfix;
size_t length;
struct externalAddressHashNode *theAddress;
char buffer[30];
switch (GetpType(theDO))
{
case MULTIFIELD:
prefix = "(";
theString = ValueToString(ImplodeMultifield(theEnv,theDO));
postfix = ")";
break;
case STRING:
prefix = "\"";
theString = DOPToString(theDO);
postfix = "\"";
break;
case INSTANCE_NAME:
prefix = "[";
theString = DOPToString(theDO);
postfix = "]";
break;
case SYMBOL:
return(DOPToString(theDO));
case FLOAT:
return(FloatToString(theEnv,DOPToDouble(theDO)));
case INTEGER:
return(LongIntegerToString(theEnv,DOPToLong(theDO)));
case RVOID:
return("");
#if OBJECT_SYSTEM
case INSTANCE_ADDRESS:
thePtr = DOPToPointer(theDO);
if (thePtr == (void *) &InstanceData(theEnv)->DummyInstance)
{ return("<Dummy Instance>"); }
if (((struct instance *) thePtr)->garbage)
{
prefix = "<Stale Instance-";
theString = ValueToString(((struct instance *) thePtr)->name);
postfix = ">";
}
else
{
prefix = "<Instance-";
theString = ValueToString(GetFullInstanceName(theEnv,(INSTANCE_TYPE *) thePtr));
postfix = ">";
}
break;
#endif
case EXTERNAL_ADDRESS:
theAddress = (struct externalAddressHashNode *) DOPToPointer(theDO);
/* TBD Need specific routine for creating name string. */
gensprintf(buffer,"<Pointer-%d-%p>",(int) theAddress->type,DOPToExternalAddress(theDO));
thePtr = EnvAddSymbol(theEnv,buffer);
return(ValueToString(thePtr));
#if DEFTEMPLATE_CONSTRUCT
case FACT_ADDRESS:
if (DOPToPointer(theDO) == (void *) &FactData(theEnv)->DummyFact)
{ return("<Dummy Fact>"); }
thePtr = DOPToPointer(theDO);
gensprintf(buffer,"<Fact-%lld>",((struct fact *) thePtr)->factIndex);
thePtr = EnvAddSymbol(theEnv,buffer);
return(ValueToString(thePtr));
#endif
default:
return("UNK");
}
length = strlen(prefix) + strlen(theString) + strlen(postfix) + 1;
newString = (char *) genalloc(theEnv,length);
newString[0] = '\0';
genstrcat(newString,prefix);
genstrcat(newString,theString);
genstrcat(newString,postfix);
thePtr = EnvAddSymbol(theEnv,newString);
genfree(theEnv,newString,length);
return(ValueToString(thePtr));
}
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 intBool EnvGetFactDuplication(
void *theEnv)
{
return(FactData(theEnv)->FactDuplication);
}
globle void InitializeFactHashTable(
void *theEnv)
{
FactData(theEnv)->FactHashTable = CreateFactHashTable(theEnv,SIZE_FACT_HASH);
FactData(theEnv)->FactHashTableSize = SIZE_FACT_HASH;
}
globle void InitializeFactPatterns(
void *theEnv)
{
#if DEFRULE_CONSTRUCT
struct patternParser *newPtr;
InitializeFactReteFunctions(theEnv);
newPtr = get_struct(theEnv,patternParser);
newPtr->name = "facts";
newPtr->priority = 0;
newPtr->entityType = &FactData(theEnv)->FactInfo;
#if (! RUN_TIME) && (! BLOAD_ONLY)
newPtr->recognizeFunction = FactPatternParserFind;
newPtr->parseFunction = FactPatternParse;
newPtr->postAnalysisFunction = NULL;
newPtr->addPatternFunction = PlaceFactPattern;
newPtr->removePatternFunction = DetachFactPattern;
newPtr->genJNConstantFunction = NULL;
newPtr->replaceGetJNValueFunction = FactReplaceGetvar;
newPtr->genGetJNValueFunction = FactGenGetvar;
newPtr->genCompareJNValuesFunction = FactJNVariableComparison;
newPtr->genPNConstantFunction = FactGenPNConstant;
newPtr->replaceGetPNValueFunction = FactReplaceGetfield;
newPtr->genGetPNValueFunction = FactGenGetfield;
newPtr->genComparePNValuesFunction = FactPNVariableComparison;
newPtr->returnUserDataFunction = NULL;
newPtr->copyUserDataFunction = NULL;
#else
newPtr->recognizeFunction = NULL;
newPtr->parseFunction = NULL;
newPtr->postAnalysisFunction = NULL;
newPtr->addPatternFunction = NULL;
newPtr->removePatternFunction = NULL;
newPtr->genJNConstantFunction = NULL;
newPtr->replaceGetJNValueFunction = NULL;
newPtr->genGetJNValueFunction = NULL;
newPtr->genCompareJNValuesFunction = NULL;
newPtr->genPNConstantFunction = NULL;
newPtr->replaceGetPNValueFunction = NULL;
newPtr->genGetPNValueFunction = NULL;
newPtr->genComparePNValuesFunction = NULL;
newPtr->returnUserDataFunction = NULL;
newPtr->copyUserDataFunction = NULL;
#endif
#if INCREMENTAL_RESET
newPtr->markIRPatternFunction = MarkFactPatternForIncrementalReset;
newPtr->incrementalResetFunction = FactsIncrementalReset;
#else
newPtr->markIRPatternFunction = NULL;
newPtr->incrementalResetFunction = NULL;
#endif
#if (! RUN_TIME) && (! BLOAD_ONLY)
newPtr->initialPatternFunction = CreateInitialFactPattern;
#if CONSTRUCT_COMPILER
newPtr->codeReferenceFunction = FactPatternNodeReference;
#else
newPtr->codeReferenceFunction = NULL;
#endif
#else
newPtr->initialPatternFunction = NULL;
newPtr->codeReferenceFunction = NULL;
#endif
AddPatternParser(theEnv,newPtr);
#endif
}
static struct factPatternNode *CreateNewPatternNode(
void *theEnv,
struct lhsParseNode *thePattern,
struct factPatternNode *nodeBeforeMatch,
struct factPatternNode *upperLevel,
unsigned endSlot)
{
struct factPatternNode *newNode;
/*========================================*/
/* Create the pattern node and initialize */
/* its slots to the default values. */
/*========================================*/
newNode = get_struct(theEnv,factPatternNode);
newNode->nextLevel = NULL;
newNode->rightNode = NULL;
newNode->leftNode = NULL;
newNode->leaveFields = thePattern->singleFieldsAfter;
InitializePatternHeader(theEnv,(struct patternNodeHeader *) &newNode->header);
if (thePattern->index > 0)
{ newNode->whichField = (unsigned short) thePattern->index; }
else newNode->whichField = 0;
if (thePattern->slotNumber >= 0)
{ newNode->whichSlot = (unsigned short) (thePattern->slotNumber - 1); }
else
{ newNode->whichSlot = newNode->whichField; }
/*=============================================================*/
/* Set the slot values which indicate whether the pattern node */
/* is a single-field, multifield, or end-of-pattern node. */
/*=============================================================*/
if ((thePattern->type == SF_WILDCARD) || (thePattern->type == SF_VARIABLE))
{ newNode->header.singlefieldNode = TRUE; }
else if ((thePattern->type == MF_WILDCARD) || (thePattern->type == MF_VARIABLE))
{ newNode->header.multifieldNode = TRUE; }
newNode->header.endSlot = endSlot;
/*===========================================================*/
/* Install the expression associated with this pattern node. */
/*===========================================================*/
newNode->networkTest = AddHashedExpression(theEnv,thePattern->networkTest);
/*===============================================*/
/* Set the upper level pointer for the new node. */
/*===============================================*/
newNode->lastLevel = upperLevel;
/*======================================================*/
/* If there are no nodes on this level, then attach the */
/* new node to the child pointer of the upper level. */
/*======================================================*/
if (nodeBeforeMatch == NULL)
{
if (upperLevel == NULL) FactData(theEnv)->CurrentDeftemplate->patternNetwork = newNode;
else upperLevel->nextLevel = newNode;
return(newNode);
}
/*=====================================================*/
/* If there is an upper level above the new node, then */
/* place the new node as the first child in the upper */
/* level's nextLevel (child) link. */
/*=====================================================*/
if (upperLevel != NULL)
{
newNode->rightNode = upperLevel->nextLevel;
if (upperLevel->nextLevel != NULL)
{ upperLevel->nextLevel->leftNode = newNode; }
upperLevel->nextLevel = newNode;
return(newNode);
}
/*=====================================================*/
/* Since there is no upper level above the new node, */
/* (i.e. the new node is being added to the highest */
/* level in the pattern network), the new node becomes */
/* the first node visited in the pattern network. */
/*=====================================================*/
newNode->rightNode = FactData(theEnv)->CurrentDeftemplate->patternNetwork;
if (FactData(theEnv)->CurrentDeftemplate->patternNetwork != NULL)
{ FactData(theEnv)->CurrentDeftemplate->patternNetwork->leftNode = newNode; }
FactData(theEnv)->CurrentDeftemplate->patternNetwork = newNode;
return(newNode);
}
static struct patternNodeHeader *PlaceFactPattern(
void *theEnv,
struct lhsParseNode *thePattern)
{
struct lhsParseNode *tempPattern = NULL;
struct factPatternNode *currentLevel, *lastLevel;
struct factPatternNode *nodeBeforeMatch, *newNode = NULL;
unsigned endSlot;
int count;
char *deftemplateName;
/*======================================================================*/
/* Get the name of the deftemplate associated with the pattern being */
/* added (recall that the first field of any pattern must be a symbol). */
/*======================================================================*/
deftemplateName = ValueToString(thePattern->right->bottom->value);
/*=====================================================*/
/* Remove any slot tests that test only for existance. */
/*=====================================================*/
thePattern->right = RemoveUnneededSlots(theEnv,thePattern->right);
/*========================================================*/
/* If the constant test for the relation name is the only */
/* pattern network test and there are no other network */
/* tests, then remove the test, but keep the node since */
/* there must be a link from the fact pattern network to */
/* the join network. Otherwise, remove the test for the */
/* relation name since this test has already been done */
/* before entering the pattern network (since each */
/* deftemplate has its own pattern network). */
/*========================================================*/
if (thePattern->right->right == NULL)
{
ReturnExpression(theEnv,thePattern->right->networkTest);
thePattern->right->networkTest = NULL;
}
else
{
tempPattern = thePattern->right;
thePattern->right = thePattern->right->right;
tempPattern->right = NULL;
ReturnLHSParseNodes(theEnv,tempPattern);
tempPattern = NULL;
}
/*============================================================*/
/* Get a pointer to the deftemplate data structure associated */
/* with the pattern (use the deftemplate name extracted from */
/* the first field of the pattern). */
/*============================================================*/
FactData(theEnv)->CurrentDeftemplate = (struct deftemplate *)
FindImportedConstruct(theEnv,"deftemplate",NULL,
deftemplateName,&count,
TRUE,NULL);
/*================================================*/
/* Initialize some pointers to indicate where the */
/* pattern is being added to the pattern network. */
/*================================================*/
currentLevel = FactData(theEnv)->CurrentDeftemplate->patternNetwork;
lastLevel = NULL;
thePattern = thePattern->right;
/*===========================================*/
/* Loop until all fields in the pattern have */
/* been added to the pattern network. */
/*===========================================*/
while (thePattern != NULL)
{
/*===========================================================*/
/* If a multifield slot is being processed, then process the */
/* pattern nodes attached to the multifield pattern node. */
/*===========================================================*/
if (thePattern->multifieldSlot)
{
tempPattern = thePattern;
thePattern = thePattern->bottom;
}
/*============================================*/
/* Determine if the last pattern field within */
/* a multifield slot is being processed. */
/*============================================*/
if ((thePattern->right == NULL) && (tempPattern != NULL))
{ endSlot = TRUE; }
else
{ endSlot = FALSE; }
/*========================================*/
/* Is there a node in the pattern network */
/* that can be reused (shared)? */
/*========================================*/
newNode = FindPatternNode(currentLevel,thePattern,&nodeBeforeMatch,endSlot);
/*================================================*/
/* If the pattern node cannot be shared, then add */
/* a new pattern node to the pattern network. */
/*================================================*/
if (newNode == NULL)
{ newNode = CreateNewPatternNode(theEnv,thePattern,nodeBeforeMatch,lastLevel,endSlot); }
/*===========================================================*/
/* Move on to the next field in the new pattern to be added. */
/*===========================================================*/
if ((thePattern->right == NULL) && (tempPattern != NULL))
{
thePattern = tempPattern;
tempPattern = NULL;
}
thePattern = thePattern->right;
/*==========================================================*/
/* If there are no more pattern nodes to be added to the */
/* pattern network, then mark the last pattern node added */
/* as a stop node (i.e. if you get to this node and the */
/* network test succeeds, then a pattern has been matched). */
/*==========================================================*/
if (thePattern == NULL) newNode->header.stopNode = TRUE;
/*================================================*/
/* Update the pointers which indicate where we're */
/* trying to add the new pattern to the currently */
/* existing pattern network. */
/*================================================*/
lastLevel = newNode;
currentLevel = newNode->nextLevel;
}
/*==================================================*/
/* Return the leaf node of the newly added pattern. */
/*==================================================*/
return((struct patternNodeHeader *) newNode);
}
/*********************************************************
NAME : UpdateExpression
DESCRIPTION : Given a bloaded expression buffer,
this routine refreshes the pointers
in the expression array
INPUTS : 1) a bloaded expression buffer
2) the index of the expression to refresh
RETURNS : Nothing useful
SIDE EFFECTS : Expression updated
NOTES : None
*********************************************************/
static void UpdateExpression(
Environment *theEnv,
void *buf,
unsigned long obji)
{
BSAVE_EXPRESSION *bexp;
unsigned long theIndex;
bexp = (BSAVE_EXPRESSION *) buf;
ExpressionData(theEnv)->ExpressionArray[obji].type = bexp->type;
switch(bexp->type)
{
case FCALL:
ExpressionData(theEnv)->ExpressionArray[obji].value = BloadData(theEnv)->FunctionArray[bexp->value];
break;
case GCALL:
#if DEFGENERIC_CONSTRUCT
ExpressionData(theEnv)->ExpressionArray[obji].value = GenericPointer(bexp->value);
#else
ExpressionData(theEnv)->ExpressionArray[obji].value = NULL;
#endif
break;
case PCALL:
#if DEFFUNCTION_CONSTRUCT
ExpressionData(theEnv)->ExpressionArray[obji].value = DeffunctionPointer(bexp->value);
#else
ExpressionData(theEnv)->ExpressionArray[obji].value = NULL;
#endif
break;
case DEFTEMPLATE_PTR:
#if DEFTEMPLATE_CONSTRUCT
ExpressionData(theEnv)->ExpressionArray[obji].value = DeftemplatePointer(bexp->value);
#else
ExpressionData(theEnv)->ExpressionArray[obji].value = NULL;
#endif
break;
case DEFCLASS_PTR:
#if OBJECT_SYSTEM
ExpressionData(theEnv)->ExpressionArray[obji].value = DefclassPointer(bexp->value);
#else
ExpressionData(theEnv)->ExpressionArray[obji].value = NULL;
#endif
break;
case DEFGLOBAL_PTR:
#if DEFGLOBAL_CONSTRUCT
ExpressionData(theEnv)->ExpressionArray[obji].value = DefglobalPointer(bexp->value);
#else
ExpressionData(theEnv)->ExpressionArray[obji].value = NULL;
#endif
break;
case INTEGER_TYPE:
ExpressionData(theEnv)->ExpressionArray[obji].value = SymbolData(theEnv)->IntegerArray[bexp->value];
IncrementIntegerCount(ExpressionData(theEnv)->ExpressionArray[obji].integerValue);
break;
case FLOAT_TYPE:
ExpressionData(theEnv)->ExpressionArray[obji].value = SymbolData(theEnv)->FloatArray[bexp->value];
IncrementFloatCount(ExpressionData(theEnv)->ExpressionArray[obji].floatValue);
break;
case INSTANCE_NAME_TYPE:
#if ! OBJECT_SYSTEM
ExpressionData(theEnv)->ExpressionArray[obji].type = SYMBOL_TYPE;
#endif
case GBL_VARIABLE:
case SYMBOL_TYPE:
case STRING_TYPE:
ExpressionData(theEnv)->ExpressionArray[obji].value = SymbolData(theEnv)->SymbolArray[bexp->value];
IncrementLexemeCount(ExpressionData(theEnv)->ExpressionArray[obji].lexemeValue);
break;
#if DEFTEMPLATE_CONSTRUCT
case FACT_ADDRESS_TYPE:
ExpressionData(theEnv)->ExpressionArray[obji].value = &FactData(theEnv)->DummyFact;
RetainFact((Fact *) ExpressionData(theEnv)->ExpressionArray[obji].value);
break;
#endif
#if OBJECT_SYSTEM
case INSTANCE_ADDRESS_TYPE:
ExpressionData(theEnv)->ExpressionArray[obji].value = &InstanceData(theEnv)->DummyInstance;
RetainInstance((Instance *) ExpressionData(theEnv)->ExpressionArray[obji].value);
break;
#endif
case EXTERNAL_ADDRESS_TYPE:
ExpressionData(theEnv)->ExpressionArray[obji].value = NULL;
break;
case VOID_TYPE:
break;
default:
if (EvaluationData(theEnv)->PrimitivesArray[bexp->type] == NULL) break;
if (EvaluationData(theEnv)->PrimitivesArray[bexp->type]->bitMap)
{
ExpressionData(theEnv)->ExpressionArray[obji].value = SymbolData(theEnv)->BitMapArray[bexp->value];
IncrementBitMapCount((CLIPSBitMap *) ExpressionData(theEnv)->ExpressionArray[obji].value);
}
break;
}
theIndex = bexp->nextArg;
if (theIndex == ULONG_MAX)
{ ExpressionData(theEnv)->ExpressionArray[obji].nextArg = NULL; }
else
{ ExpressionData(theEnv)->ExpressionArray[obji].nextArg = (struct expr *) &ExpressionData(theEnv)->ExpressionArray[theIndex]; }
theIndex = bexp->argList;
if (theIndex == ULONG_MAX)
{ ExpressionData(theEnv)->ExpressionArray[obji].argList = NULL; }
else
{ ExpressionData(theEnv)->ExpressionArray[obji].argList = (struct expr *) &ExpressionData(theEnv)->ExpressionArray[theIndex]; }
}
bool FactPNGetVar1(
Environment *theEnv,
void *theValue,
UDFValue *returnValue)
{
size_t adjustedField;
unsigned short theField, theSlot;
Fact *factPtr;
CLIPSValue *fieldPtr;
struct multifieldMarker *marks;
Multifield *segmentPtr;
size_t extent;
struct factGetVarPN1Call *hack;
/*==========================================*/
/* Retrieve the arguments for the function. */
/*==========================================*/
hack = (struct factGetVarPN1Call *) ((CLIPSBitMap *) theValue)->contents;
/*=====================================================*/
/* 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->value = factPtr;
return true;
}
/*=========================================================*/
/* Determine if we want to retrieve the entire slot value. */
/*=========================================================*/
if (hack->allFields)
{
theSlot = hack->whichSlot;
fieldPtr = &factPtr->theProposition.contents[theSlot];
returnValue->value = fieldPtr->value;
if (returnValue->header->type == MULTIFIELD_TYPE)
{
returnValue->begin = 0;
returnValue->range = fieldPtr->multifieldValue->length;
}
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.contents[theSlot];
/*==========================================================*/
/* Retrieve a value from a multifield slot. First determine */
/* the range of fields for the variable being retrieved. */
/*==========================================================*/
extent = SIZE_MAX;
adjustedField = 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 != SIZE_MAX)
{
returnValue->value = fieldPtr->value;
returnValue->begin = adjustedField;
returnValue->range = extent;
return true;
}
/*========================================================*/
/* Otherwise a single field value is being retrieved from */
/* a multifield slot. Just return the type and value. */
/*========================================================*/
segmentPtr = fieldPtr->multifieldValue;
fieldPtr = &segmentPtr->contents[adjustedField];
returnValue->value = fieldPtr->value;
return true;
}
