globle void PrintFactPNConstant1(
void *theEnv,
const char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factConstantPN1Call *hack;
hack = (struct factConstantPN1Call *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,"(fact-pn-constant1 ");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot);
if (hack->testForEquality) EnvPrintRouter(theEnv,logicalName," = ");
else EnvPrintRouter(theEnv,logicalName," != ");
PrintAtom(theEnv,logicalName,GetFirstArgument()->type,GetFirstArgument()->value);
EnvPrintRouter(theEnv,logicalName,")");
#else
#if MAC_XCD
#pragma unused(theEnv)
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
static void PrintJNSimpleCompareFunction2(
void *theEnv,
char *logicalName,
void *theValue)
{
#if DEVELOPER
struct ObjectCmpJoinSingleSlotVars2 *hack;
hack = (struct ObjectCmpJoinSingleSlotVars2 *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,"(jslot-cmp2 ");
EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n ");
PrintLongInteger(theEnv,logicalName,(long) hack->firstPattern);
EnvPrintRouter(theEnv,logicalName," ");
EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->firstSlot)));
EnvPrintRouter(theEnv,logicalName,hack->fromBeginning ? " B" : " E");
PrintLongInteger(theEnv,logicalName,(long) hack->offset);
EnvPrintRouter(theEnv,logicalName," ");
PrintLongInteger(theEnv,logicalName,(long) hack->secondPattern);
EnvPrintRouter(theEnv,logicalName," ");
EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->secondSlot)));
EnvPrintRouter(theEnv,logicalName,")");
#else
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv)
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
globle BOOLEAN FactPNGetVar2(
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 = CurrentPatternFact;
/*============================================*/
/* Extract the value from the specified slot. */
/*============================================*/
fieldPtr = &factPtr->theProposition.theFields[hack->whichSlot];
returnValue->type = fieldPtr->type;
returnValue->value = fieldPtr->value;
return(TRUE);
}
globle void PrintFactPNGetVar3(
void *theEnv,
char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factGetVarPN3Call *hack;
hack = (struct factGetVarPN3Call *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,(char*)"(fact-pn-getvar-3 ");
if (hack->fromBeginning) EnvPrintRouter(theEnv,logicalName,(char*)"t ");
else EnvPrintRouter(theEnv,logicalName,(char*)"f ");
if (hack->fromEnd) EnvPrintRouter(theEnv,logicalName,(char*)"t B");
else EnvPrintRouter(theEnv,logicalName,(char*)"f B");
PrintLongInteger(theEnv,logicalName,(long long) hack->beginOffset);
EnvPrintRouter(theEnv,logicalName,(char*)" E");
PrintLongInteger(theEnv,logicalName,(long long) hack->endOffset);
EnvPrintRouter(theEnv,logicalName,(char*)" S");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot);
EnvPrintRouter(theEnv,logicalName,(char*)")");
#else
#endif
}
globle void PrintFactPNConstant2(
void *theEnv,
char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factConstantPN2Call *hack;
hack = (struct factConstantPN2Call *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,(char*)"(fact-pn-constant2 ");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot);
EnvPrintRouter(theEnv,logicalName,(char*)" ");
PrintLongInteger(theEnv,logicalName,(long long) hack->offset);
if (hack->testForEquality) EnvPrintRouter(theEnv,logicalName,(char*)" = ");
else EnvPrintRouter(theEnv,logicalName,(char*)" != ");
PrintAtom(theEnv,logicalName,GetFirstArgument()->type,GetFirstArgument()->value);
EnvPrintRouter(theEnv,logicalName,(char*)")");
#else
#endif
}
globle void PrintFactJNGetVar1(
void *theEnv,
char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factGetVarJN1Call *hack;
hack = (struct factGetVarJN1Call *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,(char*)"(fact-jn-getvar-1 ");
if (hack->factAddress) EnvPrintRouter(theEnv,logicalName,(char*)"t ");
else EnvPrintRouter(theEnv,logicalName,(char*)"f ");
if (hack->allFields) EnvPrintRouter(theEnv,logicalName,(char*)"t ");
else EnvPrintRouter(theEnv,logicalName,(char*)"f ");
EnvPrintRouter(theEnv,logicalName,(char*)"p");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichPattern + 1);
EnvPrintRouter(theEnv,logicalName,(char*)" ");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichField);
EnvPrintRouter(theEnv,logicalName,(char*)" s");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot);
if (hack->lhs)
{ EnvPrintRouter(theEnv,logicalName,(char*)" L"); }
else if (hack->rhs)
{ EnvPrintRouter(theEnv,logicalName,(char*)" R"); }
EnvPrintRouter(theEnv,logicalName,(char*)")");
#else
#endif
}
globle void PrintFactJNGetVar3(
void *theEnv,
char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factGetVarJN3Call *hack;
hack = (struct factGetVarJN3Call *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,(char*)"(fact-jn-getvar-3 ");
if (hack->fromBeginning) EnvPrintRouter(theEnv,logicalName,(char*)"t ");
else EnvPrintRouter(theEnv,logicalName,(char*)"f ");
if (hack->fromEnd) EnvPrintRouter(theEnv,logicalName,(char*)"t ");
else EnvPrintRouter(theEnv,logicalName,(char*)"f ");
PrintLongInteger(theEnv,logicalName,(long long) hack->beginOffset);
EnvPrintRouter(theEnv,logicalName,(char*)" ");
PrintLongInteger(theEnv,logicalName,(long long) hack->endOffset);
EnvPrintRouter(theEnv,logicalName,(char*)" ");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot);
EnvPrintRouter(theEnv,logicalName,(char*)" p");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichPattern + 1);
if (hack->lhs)
{ EnvPrintRouter(theEnv,logicalName,(char*)" L"); }
else if (hack->rhs)
{ EnvPrintRouter(theEnv,logicalName,(char*)" R"); }
EnvPrintRouter(theEnv,logicalName,(char*)")");
#else
#endif
}
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);
}
globle void PrintFactPNConstant2(
char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factConstantPN2Call *hack;
hack = (struct factConstantPN2Call *) ValueToBitMap(theValue);
PrintRouter(logicalName,"(fact-pn-constant2 ");
PrintLongInteger(logicalName,(long) hack->whichSlot);
PrintRouter(logicalName," ");
PrintLongInteger(logicalName,(long) hack->offset);
if (hack->testForEquality) PrintRouter(logicalName," = ");
else PrintRouter(logicalName," != ");
PrintAtom(logicalName,GetFirstArgument()->type,GetFirstArgument()->value);
PrintRouter(logicalName,")");
#else
#if MAC_MPW || MAC_MCW
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
globle void PrintFactPNGetVar3(
char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factGetVarPN3Call *hack;
hack = (struct factGetVarPN3Call *) ValueToBitMap(theValue);
PrintRouter(logicalName,"(fact-pn-getvar-3 ");
if (hack->fromBeginning) PrintRouter(logicalName,"t ");
else PrintRouter(logicalName,"f ");
if (hack->fromEnd) PrintRouter(logicalName,"t B");
else PrintRouter(logicalName,"f B");
PrintLongInteger(logicalName,(long) hack->beginOffset);
PrintRouter(logicalName," E");
PrintLongInteger(logicalName,(long) hack->endOffset);
PrintRouter(logicalName," S");
PrintLongInteger(logicalName,(long) hack->whichSlot);
PrintRouter(logicalName,")");
#else
#if MAC_MPW || MAC_MCW
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
static void PrintObjectGetVarJN2(
void *theEnv,
char *logicalName,
void *theValue)
{
#if DEVELOPER
struct ObjectMatchVar2 *hack;
hack = (struct ObjectMatchVar2 *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,"(obj-slot-quick-var ");
PrintLongInteger(theEnv,logicalName,(long) hack->whichPattern);
EnvPrintRouter(theEnv,logicalName," ");
EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot)));
if (hack->fromBeginning)
{
EnvPrintRouter(theEnv,logicalName," B");
PrintLongInteger(theEnv,logicalName,(long) (hack->beginningOffset + 1));
}
if (hack->fromEnd)
{
EnvPrintRouter(theEnv,logicalName," E");
PrintLongInteger(theEnv,logicalName,(long) (hack->endOffset + 1));
}
EnvPrintRouter(theEnv,logicalName,")");
#else
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv)
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
static CLIPS_BOOLEAN JNSimpleCompareFunction2(
void *theEnv,
void *theValue,
DATA_OBJECT *theResult)
{
INSTANCE_TYPE *ins1,*ins2;
struct multifieldMarker *theMarks;
struct ObjectCmpJoinSingleSlotVars2 *hack;
int rv;
FIELD f1;
INSTANCE_SLOT *is2;
hack = (struct ObjectCmpJoinSingleSlotVars2 *) ValueToBitMap(theValue);
GetPatternObjectAndMarks(theEnv,((int) hack->firstPattern) - 1,&ins1,&theMarks);
GetInsMultiSlotField(&f1,ins1,(unsigned) hack->firstSlot,
(unsigned) hack->fromBeginning,(unsigned) hack->offset);
GetPatternObjectAndMarks(theEnv,((int) hack->secondPattern) - 1,&ins2,&theMarks);
is2 = GetInsSlot(ins2,hack->secondSlot);
if (f1.type != is2->type)
rv = hack->fail;
else if (f1.value != is2->value)
rv = hack->fail;
else
rv = hack->pass;
theResult->type = SYMBOL;
theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv);
return(rv);
}
globle void PrintFactSlotLength(
void *theEnv,
const char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factCheckLengthPNCall *hack;
hack = (struct factCheckLengthPNCall *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,"(slot-length ");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot);
EnvPrintRouter(theEnv,logicalName," ");
if (hack->exactly) EnvPrintRouter(theEnv,logicalName,"= ");
else EnvPrintRouter(theEnv,logicalName,">= ");
PrintLongInteger(theEnv,logicalName,(long long) hack->minLength);
EnvPrintRouter(theEnv,logicalName,")");
#else
#if MAC_XCD
#pragma unused(theEnv)
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
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 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 void PrintJNSimpleCompareFunction3(
void *theEnv,
const char *logicalName,
void *theValue)
{
#if DEVELOPER
struct ObjectCmpJoinSingleSlotVars3 *hack;
hack = (struct ObjectCmpJoinSingleSlotVars3 *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,"(jslot-cmp3 ");
EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n ");
PrintLongInteger(theEnv,logicalName,(long long) hack->firstPattern);
EnvPrintRouter(theEnv,logicalName," ");
EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->firstSlot)));
EnvPrintRouter(theEnv,logicalName,hack->firstFromBeginning ? " B" : " E");
PrintLongInteger(theEnv,logicalName,(long long) hack->firstOffset);
EnvPrintRouter(theEnv,logicalName," ");
PrintLongInteger(theEnv,logicalName,(long long) hack->secondPattern);
EnvPrintRouter(theEnv,logicalName," ");
EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->secondSlot)));
EnvPrintRouter(theEnv,logicalName,hack->secondFromBeginning ? " B" : " E");
PrintLongInteger(theEnv,logicalName,(long long) hack->secondOffset);
EnvPrintRouter(theEnv,logicalName,")");
#else
#endif
}
static intBool JNSimpleCompareFunction3(
void *theEnv,
void *theValue,
DATA_OBJECT *theResult)
{
INSTANCE_TYPE *ins1,*ins2;
struct multifieldMarker *theMarks;
struct ObjectCmpJoinSingleSlotVars3 *hack;
int rv;
FIELD f1,f2;
hack = (struct ObjectCmpJoinSingleSlotVars3 *) ValueToBitMap(theValue);
GetPatternObjectAndMarks(theEnv,((int) hack->firstPattern),hack->firstPatternLHS,hack->firstPatternRHS,&ins1,&theMarks);
GetInsMultiSlotField(&f1,ins1,(unsigned) hack->firstSlot,
(unsigned) hack->firstFromBeginning,
(unsigned) hack->firstOffset);
GetPatternObjectAndMarks(theEnv,((int) hack->secondPattern),hack->secondPatternLHS,hack->secondPatternRHS,&ins2,&theMarks);
GetInsMultiSlotField(&f2,ins2,(unsigned) hack->secondSlot,
(unsigned) hack->secondFromBeginning,
(unsigned) hack->secondOffset);
if (f1.type != f2.type)
rv = hack->fail;
else if (f1.value != f2.value)
rv = hack->fail;
else
rv = hack->pass;
theResult->type = SYMBOL;
theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv);
return(rv);
}
static void PrintObjectCmpConstant(
void *theEnv,
const char *logicalName,
void *theValue)
{
#if DEVELOPER
struct ObjectCmpPNConstant *hack;
hack = (struct ObjectCmpPNConstant *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,"(obj-const ");
EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n ");
if (hack->general)
PrintExpression(theEnv,logicalName,GetFirstArgument());
else
{
EnvPrintRouter(theEnv,logicalName,hack->fromBeginning ? "B" : "E");
PrintLongInteger(theEnv,logicalName,(long long) hack->offset);
EnvPrintRouter(theEnv,logicalName," ");
PrintExpression(theEnv,logicalName,GetFirstArgument());
}
EnvPrintRouter(theEnv,logicalName,")");
#else
#endif
}
static intBool JNSimpleCompareFunction1(
void *theEnv,
void *theValue,
DATA_OBJECT *theResult)
{
INSTANCE_TYPE *ins1,*ins2;
struct multifieldMarker *theMarks;
struct ObjectCmpJoinSingleSlotVars1 *hack;
int rv;
INSTANCE_SLOT *is1,*is2;
hack = (struct ObjectCmpJoinSingleSlotVars1 *) ValueToBitMap(theValue);
GetPatternObjectAndMarks(theEnv,((int) hack->firstPattern),hack->firstPatternLHS,hack->firstPatternRHS,&ins1,&theMarks);
is1 = GetInsSlot(ins1,hack->firstSlot);
GetPatternObjectAndMarks(theEnv,((int) hack->secondPattern),hack->secondPatternLHS,hack->secondPatternRHS,&ins2,&theMarks);
is2 = GetInsSlot(ins2,hack->secondSlot);
if (is1->type != is2->type)
rv = hack->fail;
else if (is1->value != is2->value)
rv = hack->fail;
else
rv = hack->pass;
theResult->type = SYMBOL;
theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv);
return(rv);
}
static void PrintObjectGetVarPN2(
void *theEnv,
const char *logicalName,
void *theValue)
{
#if DEVELOPER
struct ObjectMatchVar2 *hack;
hack = (struct ObjectMatchVar2 *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,"(ptn-obj-slot-quick-var ");
EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot)));
if (hack->fromBeginning)
{
EnvPrintRouter(theEnv,logicalName," B");
PrintLongInteger(theEnv,logicalName,(long long) (hack->beginningOffset + 1));
}
if (hack->fromEnd)
{
EnvPrintRouter(theEnv,logicalName," E");
PrintLongInteger(theEnv,logicalName,(long long) (hack->endOffset + 1));
}
EnvPrintRouter(theEnv,logicalName,")");
#else
#endif
}
static void PrintSlotLengthTest(
void *theEnv,
char *logicalName,
void *theValue)
{
#if DEVELOPER
struct ObjectMatchLength *hack;
hack = (struct ObjectMatchLength *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,"(obj-slot-len ");
if (hack->exactly)
EnvPrintRouter(theEnv,logicalName,"= ");
else
EnvPrintRouter(theEnv,logicalName,">= ");
PrintLongInteger(theEnv,logicalName,(long) hack->minLength);
EnvPrintRouter(theEnv,logicalName,")");
#else
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv)
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
globle void PrintHandlerSlotPutFunction(
char *logicalName,
void *theValue)
{
#if DEVELOPER
HANDLER_SLOT_REFERENCE *theReference;
DEFCLASS *theDefclass;
SLOT_DESC *sd;
theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue);
PrintRouter(logicalName,"(bind ?self:[");
theDefclass = ClassIDMap[theReference->classID];
PrintRouter(logicalName,ValueToString(theDefclass->header.name));
PrintRouter(logicalName,"]");
sd = theDefclass->instanceTemplate[theDefclass->slotNameMap[theReference->slotID]];
PrintRouter(logicalName,ValueToString(sd->slotName->name));
if (GetFirstArgument() != NULL)
{
PrintRouter(logicalName," ");
PrintExpression(logicalName,GetFirstArgument());
}
PrintRouter(logicalName,")");
#else
#if MAC_MPW || MAC_MCW
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
static void PrintObjectGetVarPN1(
void *theEnv,
const char *logicalName,
void *theValue)
{
#if DEVELOPER
struct ObjectMatchVar1 *hack;
hack = (struct ObjectMatchVar1 *) ValueToBitMap(theValue);
if (hack->objectAddress)
EnvPrintRouter(theEnv,logicalName,"(ptn-obj-ptr ");
else if (hack->allFields)
{
EnvPrintRouter(theEnv,logicalName,"(ptn-obj-slot-contents ");
EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot)));
}
else
{
EnvPrintRouter(theEnv,logicalName,"(ptn-obj-slot-var ");
EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot)));
EnvPrintRouter(theEnv,logicalName," ");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichField);
}
EnvPrintRouter(theEnv,logicalName,")");
#else
#endif
}
globle void PrintFactPNGetVar1(
char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factGetVarPN1Call *hack;
hack = (struct factGetVarPN1Call *) ValueToBitMap(theValue);
PrintRouter(logicalName,"(fact-pn-getvar-1 ");
if (hack->factAddress) PrintRouter(logicalName,"t ");
else PrintRouter(logicalName,"f ");
if (hack->allFields) PrintRouter(logicalName,"t F");
else PrintRouter(logicalName,"f F");
PrintLongInteger(logicalName,(long) hack->whichField);
PrintRouter(logicalName," S");
PrintLongInteger(logicalName,(long) hack->whichSlot);
PrintRouter(logicalName,")");
#else
#if MAC_MPW || MAC_MCW
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
globle void PrintFactJNGetVar2(
void *theEnv,
const char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factGetVarJN2Call *hack;
hack = (struct factGetVarJN2Call *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,"(fact-jn-getvar-2");
EnvPrintRouter(theEnv,logicalName," p");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichPattern + 1);
EnvPrintRouter(theEnv,logicalName," s");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot);
if (hack->lhs)
{ EnvPrintRouter(theEnv,logicalName," L"); }
else if (hack->rhs)
{ EnvPrintRouter(theEnv,logicalName," R"); }
EnvPrintRouter(theEnv,logicalName,")");
#else
#if MAC_XCD
#pragma unused(theEnv)
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
globle int FactPNCompVars1(
void *theEnv,
void *theValue,
DATA_OBJECT *theResult)
{
int rv;
struct field *fieldPtr1, *fieldPtr2;
struct factCompVarsPN1Call *hack;
/*========================================*/
/* Extract the arguments to the function. */
/*========================================*/
hack = (struct factCompVarsPN1Call *) ValueToBitMap(theValue);
fieldPtr1 = &FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->field1];
fieldPtr2 = &FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->field2];
/*=====================*/
/* Compare the values. */
/*=====================*/
if (fieldPtr1->type != fieldPtr2->type) rv = (int) hack->fail;
else if (fieldPtr1->value != fieldPtr2->value) rv = (int) hack->fail;
else rv = (int) hack->pass;
theResult->type = SYMBOL;
if (rv) theResult->value = EnvTrueSymbol(theEnv);
else theResult->value = EnvFalseSymbol(theEnv);
return(rv);
}
/***************************************************
NAME : HandlerSlotGetFunction
DESCRIPTION : Access function for handling the
statically-bound direct slot
references in message-handlers
INPUTS : 1) The bitmap expression
2) A data object buffer
RETURNS : TRUE if OK, FALSE
on errors
SIDE EFFECTS : Data object buffer gets value of
slot. On errors, buffer gets
symbol FALSE, EvaluationError
is set and error messages are
printed
NOTES : It is possible for a handler
(attached to a superclass of
the currently active instance)
containing these static references
to be called for an instance
which does not contain the slots
(e.g., an instance of a subclass
where the original slot was
no-inherit or the subclass
overrode the original slot)
***************************************************/
globle BOOLEAN HandlerSlotGetFunction(
void *theValue,
DATA_OBJECT *theResult)
{
HANDLER_SLOT_REFERENCE *theReference;
DEFCLASS *theDefclass;
INSTANCE_TYPE *theInstance;
INSTANCE_SLOT *sp;
unsigned instanceSlotIndex;
theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue);
theInstance = (INSTANCE_TYPE *) ProcParamArray[0].value;
theDefclass = ClassIDMap[theReference->classID];
if (theInstance->garbage)
{
StaleInstanceAddress("for slot get",0);
theResult->type = SYMBOL;
theResult->value = FalseSymbol;
SetEvaluationError(TRUE);
return(FALSE);
}
if (theInstance->cls == theDefclass)
{
instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
sp = theInstance->slotAddresses[instanceSlotIndex - 1];
}
else
{
if (theReference->slotID > theInstance->cls->maxSlotNameID)
goto HandlerGetError;
instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
if (instanceSlotIndex == 0)
goto HandlerGetError;
instanceSlotIndex--;
sp = theInstance->slotAddresses[instanceSlotIndex];
if (sp->desc->cls != theDefclass)
goto HandlerGetError;
}
theResult->type = sp->type;
theResult->value = sp->value;
if (sp->type == MULTIFIELD)
{
theResult->begin = 0;
theResult->end = GetInstanceSlotLength(sp) - 1;
}
return(TRUE);
HandlerGetError:
EarlySlotBindError(theInstance,theDefclass,theReference->slotID);
theResult->type = SYMBOL;
theResult->value = FalseSymbol;
SetEvaluationError(TRUE);
return(FALSE);
}
globle void PrintFactJNCompVars2(
void *theEnv,
const char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factCompVarsJN2Call *hack;
hack = (struct factCompVarsJN2Call *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,"(fact-jn-cmp-vars2 ");
if (hack->pass) EnvPrintRouter(theEnv,logicalName,"= ");
else EnvPrintRouter(theEnv,logicalName,"<> ");
EnvPrintRouter(theEnv,logicalName,"p");
PrintLongInteger(theEnv,logicalName,(long long) hack->pattern1 + 1);
if (hack->p1lhs)
{ EnvPrintRouter(theEnv,logicalName," L"); }
else if (hack->p1rhs)
{ EnvPrintRouter(theEnv,logicalName," R"); }
EnvPrintRouter(theEnv,logicalName," s");
PrintLongInteger(theEnv,logicalName,(long long) hack->slot1);
if (hack->fromBeginning1) EnvPrintRouter(theEnv,logicalName, " b");
else EnvPrintRouter(theEnv,logicalName," e");
EnvPrintRouter(theEnv,logicalName," f");
PrintLongInteger(theEnv,logicalName,(long long) hack->offset1);
EnvPrintRouter(theEnv,logicalName," p");
PrintLongInteger(theEnv,logicalName,(long long) hack->pattern2 + 1);
if (hack->p2lhs)
{ EnvPrintRouter(theEnv,logicalName," L"); }
else if (hack->p2rhs)
{ EnvPrintRouter(theEnv,logicalName," R"); }
EnvPrintRouter(theEnv,logicalName," s");
PrintLongInteger(theEnv,logicalName,(long long) hack->slot2);
if (hack->fromBeginning2) EnvPrintRouter(theEnv,logicalName," b");
else EnvPrintRouter(theEnv,logicalName," e");
EnvPrintRouter(theEnv,logicalName," f");
PrintLongInteger(theEnv,logicalName,(long long) hack->offset2);
EnvPrintRouter(theEnv,logicalName,")");
#else
#if MAC_XCD
#pragma unused(theEnv)
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
static intBool ObjectGetVarPNFunction2(
void *theEnv,
void *theValue,
DATA_OBJECT *theResult)
{
struct ObjectMatchVar2 *hack;
hack = (struct ObjectMatchVar2 *) ValueToBitMap(theValue);
GetObjectValueSimple(theEnv,theResult,ObjectReteData(theEnv)->CurrentPatternObject,hack);
return(TRUE);
}
static CLIPS_BOOLEAN ObjectGetVarPNFunction1(
void *theEnv,
void *theValue,
DATA_OBJECT *theResult)
{
struct ObjectMatchVar1 *hack;
hack = (struct ObjectMatchVar1 *) ValueToBitMap(theValue);
GetObjectValueGeneral(theEnv,theResult,ObjectReteData(theEnv)->CurrentPatternObject,ObjectReteData(theEnv)->CurrentPatternObjectMarks,hack);
return(TRUE);
}
