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 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 }
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 }
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 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 int EnvArgRangeCheck( void *theEnv, char *functionName, int min, int max) { int numberOfArguments; numberOfArguments = EnvRtnArgCount(theEnv); if ((numberOfArguments < min) || (numberOfArguments > max)) { PrintErrorID(theEnv,"ARGACCES",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," expected at least "); PrintLongInteger(theEnv,WERROR,(long) min); EnvPrintRouter(theEnv,WERROR," and no more than "); PrintLongInteger(theEnv,WERROR,(long) max); EnvPrintRouter(theEnv,WERROR," arguments.\n"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(-1); } return(numberOfArguments); }
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 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 }
static void PrintObjectGetVarJN1( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct ObjectMatchVar1 *hack; hack = (struct ObjectMatchVar1 *) ValueToBitMap(theValue); if (hack->objectAddress) { EnvPrintRouter(theEnv,logicalName,"(obj-ptr "); PrintLongInteger(theEnv,logicalName,(long long) hack->whichPattern); } else if (hack->allFields) { EnvPrintRouter(theEnv,logicalName,"(obj-slot-contents "); PrintLongInteger(theEnv,logicalName,(long long) hack->whichPattern); EnvPrintRouter(theEnv,logicalName," "); EnvPrintRouter(theEnv,logicalName,ValueToString(FindIDSlotName(theEnv,(unsigned) hack->whichSlot))); } else { EnvPrintRouter(theEnv,logicalName,"(obj-slot-var "); PrintLongInteger(theEnv,logicalName,(long long) hack->whichPattern); EnvPrintRouter(theEnv,logicalName," "); 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 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 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 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 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 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 void ShowFactPatternNetwork( void *theEnv) { struct factPatternNode *patternPtr; struct deftemplate *theDeftemplate; char *theName; int depth = 0, i; theName = GetConstructName(theEnv,(char*)"show-fpn",(char*)"template name"); if (theName == NULL) return; theDeftemplate = (struct deftemplate *) EnvFindDeftemplate(theEnv,theName); if (theDeftemplate == NULL) return; patternPtr = theDeftemplate->patternNetwork; while (patternPtr != NULL) { for (i = 0; i < depth; i++) EnvPrintRouter(theEnv,WDISPLAY,(char*)" "); if (patternPtr->header.singlefieldNode) EnvPrintRouter(theEnv,WDISPLAY,(char*)"SF "); else if (patternPtr->header.multifieldNode) { EnvPrintRouter(theEnv,WDISPLAY,(char*)"MF"); if (patternPtr->header.endSlot) EnvPrintRouter(theEnv,WDISPLAY,(char*)")"); else EnvPrintRouter(theEnv,WDISPLAY,(char*)"*"); PrintLongInteger(theEnv,WDISPLAY,(long long) patternPtr->leaveFields); EnvPrintRouter(theEnv,WDISPLAY,(char*)" "); } EnvPrintRouter(theEnv,WDISPLAY,(char*)"Slot: "); PrintLongInteger(theEnv,WDISPLAY,(long long) patternPtr->whichSlot); EnvPrintRouter(theEnv,WDISPLAY,(char*)" Field: "); PrintLongInteger(theEnv,WDISPLAY,(long long) patternPtr->whichField); EnvPrintRouter(theEnv,WDISPLAY,(char*)" Expression: "); if (patternPtr->networkTest == NULL) EnvPrintRouter(theEnv,WDISPLAY,(char*)"None"); else PrintExpression(theEnv,WDISPLAY,patternPtr->networkTest); EnvPrintRouter(theEnv,WDISPLAY,(char*)" RightHash: "); if (patternPtr->header.rightHash == NULL) EnvPrintRouter(theEnv,WDISPLAY,(char*)"None"); else PrintExpression(theEnv,WDISPLAY,patternPtr->header.rightHash); EnvPrintRouter(theEnv,WDISPLAY,(char*)"\n"); if (patternPtr->nextLevel == NULL) { while (patternPtr->rightNode == NULL) { patternPtr = patternPtr->lastLevel; depth--; if (patternPtr == NULL) return; } patternPtr = patternPtr->rightNode; } else { patternPtr = patternPtr->nextLevel; depth++; } } }
globle void SalienceRangeError( int min, int max) { PrintErrorID("PRNTUTIL",9,TRUE); PrintRouter(WERROR,"Salience value out of range "); PrintLongInteger(WERROR,(long int) min); PrintRouter(WERROR," to "); PrintLongInteger(WERROR,(long int) max); PrintRouter(WERROR,".\n"); }
static void ConstraintConflictMessage( void *theEnv, struct symbolHashNode *variableName, int thePattern, int theField, struct symbolHashNode *theSlot) { /*=========================*/ /* Print the error header. */ /*=========================*/ PrintErrorID(theEnv,"RULECSTR",1,TRUE); /*======================================================*/ /* Print the variable name (if available) and CE number */ /* for which the constraint violation occurred. */ /*======================================================*/ if (variableName != NULL) { EnvPrintRouter(theEnv,WERROR,"Variable ?"); EnvPrintRouter(theEnv,WERROR,ValueToString(variableName)); EnvPrintRouter(theEnv,WERROR," in CE #"); PrintLongInteger(theEnv,WERROR,(long int) thePattern); } else { EnvPrintRouter(theEnv,WERROR,"Pattern #"); PrintLongInteger(theEnv,WERROR,(long int) thePattern); } /*=======================================*/ /* Print the slot name or field position */ /* in which the violation occurred. */ /*=======================================*/ if (theSlot == NULL) { EnvPrintRouter(theEnv,WERROR," field #"); PrintLongInteger(theEnv,WERROR,(long int) theField); } else { EnvPrintRouter(theEnv,WERROR," slot "); EnvPrintRouter(theEnv,WERROR,ValueToString(theSlot)); } /*======================================*/ /* Print the rest of the error message. */ /*======================================*/ EnvPrintRouter(theEnv,WERROR,"\nhas constraint conflicts which make the pattern unmatchable.\n"); }
static void PrintObjectGetVarPN1( void *theEnv, 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) hack->whichField); } EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif }
/*************************************************** NAME : SaveDeffunctionHeader DESCRIPTION : Writes a deffunction forward declaration to the save file INPUTS : 1) The deffunction 2) The logical name of the output RETURNS : Nothing useful SIDE EFFECTS : Defffunction header written NOTES : None ***************************************************/ static void SaveDeffunctionHeader( void *theEnv, struct constructHeader *theDeffunction, void *userBuffer) { DEFFUNCTION *dfnxPtr = (DEFFUNCTION *) theDeffunction; char *logicalName = (char *) userBuffer; register int i; if (EnvGetDeffunctionPPForm(theEnv,(void *) dfnxPtr) != NULL) { EnvPrintRouter(theEnv,logicalName,(char*)"(deffunction "); EnvPrintRouter(theEnv,logicalName,EnvDeffunctionModule(theEnv,(void *) dfnxPtr)); EnvPrintRouter(theEnv,logicalName,(char*)"::"); EnvPrintRouter(theEnv,logicalName,EnvGetDeffunctionName(theEnv,(void *) dfnxPtr)); EnvPrintRouter(theEnv,logicalName,(char*)" ("); for (i = 0 ; i < dfnxPtr->minNumberOfParameters ; i++) { EnvPrintRouter(theEnv,logicalName,(char*)"?p"); PrintLongInteger(theEnv,logicalName,(long long) i); if (i != dfnxPtr->minNumberOfParameters-1) EnvPrintRouter(theEnv,logicalName,(char*)" "); } if (dfnxPtr->maxNumberOfParameters == -1) { if (dfnxPtr->minNumberOfParameters != 0) EnvPrintRouter(theEnv,logicalName,(char*)" "); EnvPrintRouter(theEnv,logicalName,(char*)"$?wildargs))\n\n"); } else EnvPrintRouter(theEnv,logicalName,(char*)"))\n\n"); } }
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 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 }
/*************************************************************** NAME : CheckHandlerArgCount DESCRIPTION : Verifies that the current argument list satisfies the current handler's parameter count restriction INPUTS : None RETURNS : TRUE if all OK, FALSE otherwise SIDE EFFECTS : EvaluationError set on errors NOTES : Uses ProcParamArraySize and CurrentCore globals ***************************************************************/ globle int CheckHandlerArgCount( void *theEnv, EXEC_STATUS) { HANDLER *hnd; hnd = MessageHandlerData(theEnv,execStatus)->CurrentCore->hnd; if ((hnd->maxParams == -1) ? (ProceduralPrimitiveData(theEnv,execStatus)->ProcParamArraySize < hnd->minParams) : (ProceduralPrimitiveData(theEnv,execStatus)->ProcParamArraySize != hnd->minParams)) { SetEvaluationError(theEnv,execStatus,TRUE); PrintErrorID(theEnv,execStatus,"MSGFUN",2,FALSE); EnvPrintRouter(theEnv,execStatus,WERROR,"Message-handler "); EnvPrintRouter(theEnv,execStatus,WERROR,ValueToString(hnd->name)); EnvPrintRouter(theEnv,execStatus,WERROR," "); EnvPrintRouter(theEnv,execStatus,WERROR,MessageHandlerData(theEnv,execStatus)->hndquals[hnd->type]); EnvPrintRouter(theEnv,execStatus,WERROR," in class "); EnvPrintRouter(theEnv,execStatus,WERROR,EnvGetDefclassName(theEnv,execStatus,(void *) hnd->cls)); EnvPrintRouter(theEnv,execStatus,WERROR," expected "); if (hnd->maxParams == -1) EnvPrintRouter(theEnv,execStatus,WERROR,"at least "); else EnvPrintRouter(theEnv,execStatus,WERROR,"exactly "); PrintLongInteger(theEnv,execStatus,WERROR,(long long) (hnd->minParams-1)); EnvPrintRouter(theEnv,execStatus,WERROR," argument(s).\n"); return(FALSE); } return(TRUE); }
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 InstanceTableUsage( void *theEnv) { unsigned long i; int instanceCounts[COUNT_SIZE]; INSTANCE_TYPE *ins; unsigned long int instanceCount, totalInstanceCount = 0; EnvArgCountCheck(theEnv,"instance-table-usage",EXACTLY,0); for (i = 0; i < COUNT_SIZE; i++) { instanceCounts[i] = 0; } /*======================================*/ /* Count entries in the instance table. */ /*======================================*/ for (i = 0; i < INSTANCE_TABLE_HASH_SIZE; i++) { instanceCount = 0; for (ins = InstanceData(theEnv)->InstanceTable[i]; ins != NULL; ins = ins->nxtHash) { instanceCount++; totalInstanceCount++; } if (instanceCount < (COUNT_SIZE - 1)) { instanceCounts[instanceCount]++; } else { instanceCounts[COUNT_SIZE - 1]++; } } /*========================*/ /* Print the information. */ /*========================*/ EnvPrintRouter(theEnv,WDISPLAY,"Total Instances: "); PrintLongInteger(theEnv,WDISPLAY,(long) totalInstanceCount); EnvPrintRouter(theEnv,WDISPLAY,"\n"); for (i = 0; i < COUNT_SIZE; i++) { PrintLongInteger(theEnv,WDISPLAY,(long) i); EnvPrintRouter(theEnv,WDISPLAY," "); PrintLongInteger(theEnv,WDISPLAY,(long) instanceCounts[i]); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } }
/******************************************************* NAME : UnboundMethodErr DESCRIPTION : Print out a synopis of the currently executing method for unbound variable errors INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Error synopsis printed to WERROR NOTES : None *******************************************************/ void UnboundMethodErr( void *theEnv) { EnvPrintRouter(theEnv,WERROR,"generic function "); EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) DefgenericData(theEnv)->CurrentGeneric)); EnvPrintRouter(theEnv,WERROR," method #"); PrintLongInteger(theEnv,WERROR,(long long) DefgenericData(theEnv)->CurrentMethod->index); EnvPrintRouter(theEnv,WERROR,".\n"); }
globle void PrintFactJNCompVars2( char *logicalName, void *theValue) { #if DEVELOPER struct factCompVarsJN2Call *hack; hack = (struct factCompVarsJN2Call *) ValueToBitMap(theValue); PrintRouter(logicalName,"(fact-jn-cmp-vars2 "); if (hack->pass) PrintRouter(logicalName,"p "); else PrintRouter(logicalName,"n "); PrintRouter(logicalName,"s"); PrintLongInteger(logicalName,(long) hack->slot1); PrintRouter(logicalName," "); if (hack->fromBeginning1) PrintRouter(logicalName,"b "); else PrintRouter(logicalName,"e "); PrintRouter(logicalName,"f"); PrintLongInteger(logicalName,(long) hack->offset1); PrintRouter(logicalName," "); PrintRouter(logicalName,"p"); PrintLongInteger(logicalName,(long) hack->pattern2); PrintRouter(logicalName," "); PrintRouter(logicalName,"s"); PrintLongInteger(logicalName,(long) hack->slot2); PrintRouter(logicalName," "); if (hack->fromBeginning2) PrintRouter(logicalName,"b "); else PrintRouter(logicalName,"e "); PrintRouter(logicalName,"f"); PrintLongInteger(logicalName,(long) hack->offset2); PrintRouter(logicalName,")"); #else #if MAC_MPW || MAC_MCW #pragma unused(logicalName) #pragma unused(theValue) #endif #endif }
static void PrintMatchesMemory( void *theEnv, struct joinNode *theJoin, struct betaMemory *theMemory, int startCE, int endCE) { #if MAC_MCW || WIN_MCW || MAC_XCD #pragma unused(theJoin) #endif struct partialMatch *listOfMatches; unsigned long b; int matchesDisplayed; if (GetHaltExecution(theEnv) == TRUE) { return; } matchesDisplayed = 0; EnvPrintRouter(theEnv,WDISPLAY,"Partial matches for CEs "); PrintLongInteger(theEnv,WDISPLAY,(long int) startCE); EnvPrintRouter(theEnv,WDISPLAY," - "); PrintLongInteger(theEnv,WDISPLAY,(long int) endCE); EnvPrintRouter(theEnv,WDISPLAY,"\n"); for (b = 0; b < theMemory->size; b++) { listOfMatches = theMemory->beta[b]; while (listOfMatches != NULL) { if (GetHaltExecution(theEnv) == TRUE) { return; } matchesDisplayed++; PrintPartialMatch(theEnv,WDISPLAY,listOfMatches); EnvPrintRouter(theEnv,WDISPLAY,"\n"); listOfMatches = listOfMatches->nextInMemory; } } if (matchesDisplayed == 0) { EnvPrintRouter(theEnv,WDISPLAY," None\n"); } }
globle void PrintFactJNCompVars1( void *theEnv, const char *logicalName, void *theValue) { #if DEVELOPER struct factCompVarsJN1Call *hack; hack = (struct factCompVarsJN1Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,"(fact-jn-cmp-vars1 "); 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); 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); EnvPrintRouter(theEnv,logicalName,")"); #else #if MAC_XCD #pragma unused(theEnv) #pragma unused(logicalName) #pragma unused(theValue) #endif #endif }
globle void PrintFactPNCompVars1( void *theEnv, char *logicalName, void *theValue) { #if DEVELOPER struct factCompVarsPN1Call *hack; hack = (struct factCompVarsPN1Call *) ValueToBitMap(theValue); EnvPrintRouter(theEnv,logicalName,(char*)"(fact-pn-cmp-vars "); if (hack->pass) EnvPrintRouter(theEnv,logicalName,(char*)"p "); else EnvPrintRouter(theEnv,logicalName,(char*)"n "); PrintLongInteger(theEnv,logicalName,(long long) hack->field1); EnvPrintRouter(theEnv,logicalName,(char*)" "); PrintLongInteger(theEnv,logicalName,(long long) hack->field2); EnvPrintRouter(theEnv,logicalName,(char*)")"); #else #endif }