globle void *gm1( void *theEnv, size_t size) { struct memoryPtr *memPtr; char *tmpPtr; size_t i; if (size < (long) sizeof(char *)) size = sizeof(char *); if (size >= MEM_TABLE_SIZE) { tmpPtr = (char *) genalloc(theEnv,(unsigned) size); for (i = 0 ; i < size ; i++) { tmpPtr[i] = '\0'; } return((void *) tmpPtr); } memPtr = (struct memoryPtr *) MemoryData(theEnv)->MemoryTable[size]; if (memPtr == NULL) { tmpPtr = (char *) genalloc(theEnv,(unsigned) size); for (i = 0 ; i < size ; i++) { tmpPtr[i] = '\0'; } return((void *) tmpPtr); } MemoryData(theEnv)->MemoryTable[size] = memPtr->next; tmpPtr = (char *) memPtr; for (i = 0 ; i < size ; i++) { tmpPtr[i] = '\0'; } return ((void *) tmpPtr); }
static void BloadStorage( Environment *theEnv) { size_t space; /*=========================================================*/ /* Determine the number of deftemplate, deftemplateModule, */ /* and templateSlot data structures to be read. */ /*=========================================================*/ GenReadBinary(theEnv,&space,sizeof(size_t)); GenReadBinary(theEnv,&DeftemplateBinaryData(theEnv)->NumberOfDeftemplates,sizeof(long)); GenReadBinary(theEnv,&DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots,sizeof(long)); GenReadBinary(theEnv,&DeftemplateBinaryData(theEnv)->NumberOfTemplateModules,sizeof(long)); /*====================================*/ /* Allocate the space needed for the */ /* deftemplateModule data structures. */ /*====================================*/ if (DeftemplateBinaryData(theEnv)->NumberOfTemplateModules == 0) { DeftemplateBinaryData(theEnv)->DeftemplateArray = NULL; DeftemplateBinaryData(theEnv)->SlotArray = NULL; DeftemplateBinaryData(theEnv)->ModuleArray = NULL; return; } space = DeftemplateBinaryData(theEnv)->NumberOfTemplateModules * sizeof(struct deftemplateModule); DeftemplateBinaryData(theEnv)->ModuleArray = (struct deftemplateModule *) genalloc(theEnv,space); /*===================================*/ /* Allocate the space needed for the */ /* deftemplate data structures. */ /*===================================*/ if (DeftemplateBinaryData(theEnv)->NumberOfDeftemplates == 0) { DeftemplateBinaryData(theEnv)->DeftemplateArray = NULL; DeftemplateBinaryData(theEnv)->SlotArray = NULL; return; } space = DeftemplateBinaryData(theEnv)->NumberOfDeftemplates * sizeof(Deftemplate); DeftemplateBinaryData(theEnv)->DeftemplateArray = (Deftemplate *) genalloc(theEnv,space); /*===================================*/ /* Allocate the space needed for the */ /* templateSlot data structures. */ /*===================================*/ if (DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots == 0) { DeftemplateBinaryData(theEnv)->SlotArray = NULL; return; } space = DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots * sizeof(struct templateSlot); DeftemplateBinaryData(theEnv)->SlotArray = (struct templateSlot *) genalloc(theEnv,space); }
/*************************************************** NAME : BloadStorageObjectPatterns DESCRIPTION : Reads in the storage requirements for the object patterns in this bload image INPUTS : None RETURNS : Nothing useful SIDE EFFECTS : Counts read and arrays allocated NOTES : None ***************************************************/ static void BloadStorageObjectPatterns( void *theEnv) { size_t space; long counts[2]; GenReadBinary(theEnv,(void *) &space,sizeof(size_t)); GenReadBinary(theEnv,(void *) counts,space); ObjectReteBinaryData(theEnv)->AlphaNodeCount = counts[0]; ObjectReteBinaryData(theEnv)->PatternNodeCount = counts[1]; if (ObjectReteBinaryData(theEnv)->AlphaNodeCount == 0L) ObjectReteBinaryData(theEnv)->AlphaArray = NULL; else { space = (ObjectReteBinaryData(theEnv)->AlphaNodeCount * sizeof(OBJECT_ALPHA_NODE)); ObjectReteBinaryData(theEnv)->AlphaArray = (OBJECT_ALPHA_NODE *) genalloc(theEnv,space); } if (ObjectReteBinaryData(theEnv)->PatternNodeCount == 0L) ObjectReteBinaryData(theEnv)->PatternArray = NULL; else { space = (ObjectReteBinaryData(theEnv)->PatternNodeCount * sizeof(OBJECT_PATTERN_NODE)); ObjectReteBinaryData(theEnv)->PatternArray = (OBJECT_PATTERN_NODE *) genalloc(theEnv,space); } }
/*********************************************************************** NAME : BloadStorageDefinstances DESCRIPTION : This routine space required for definstances structures and allocates space for them INPUTS : Nothing RETURNS : Nothing useful SIDE EFFECTS : Arrays allocated and set NOTES : This routine makes no attempt to reset any pointers within the structures ***********************************************************************/ static void BloadStorageDefinstances( void *theEnv) { size_t space; GenReadBinary(theEnv,(void *) &space,sizeof(size_t)); if (space == 0L) return; GenReadBinary(theEnv,(void *) &DefinstancesBinaryData(theEnv)->ModuleCount,sizeof(unsigned long)); GenReadBinary(theEnv,(void *) &DefinstancesBinaryData(theEnv)->DefinstancesCount,sizeof(unsigned long)); if (DefinstancesBinaryData(theEnv)->ModuleCount == 0L) { DefinstancesBinaryData(theEnv)->ModuleArray = NULL; DefinstancesBinaryData(theEnv)->DefinstancesArray = NULL; return; } space = (DefinstancesBinaryData(theEnv)->ModuleCount * sizeof(DEFINSTANCES_MODULE)); DefinstancesBinaryData(theEnv)->ModuleArray = (DEFINSTANCES_MODULE *) genalloc(theEnv,space); if (DefinstancesBinaryData(theEnv)->DefinstancesCount == 0L) { DefinstancesBinaryData(theEnv)->DefinstancesArray = NULL; return; } space = (DefinstancesBinaryData(theEnv)->DefinstancesCount * sizeof(DEFINSTANCES)); DefinstancesBinaryData(theEnv)->DefinstancesArray = (DEFINSTANCES *) genalloc(theEnv,space); }
/*********************************************************************** NAME : BloadStorageDeffunctions DESCRIPTION : This routine space required for deffunction structures and allocates space for them INPUTS : Nothing RETURNS : Nothing useful SIDE EFFECTS : Arrays allocated and set NOTES : This routine makes no attempt to reset any pointers within the structures ***********************************************************************/ static void BloadStorageDeffunctions( void *theEnv) { size_t space; GenReadBinary(theEnv,(void *) &space,sizeof(size_t)); if (space == 0L) return; GenReadBinary(theEnv,(void *) &DeffunctionBinaryData(theEnv)->ModuleCount,sizeof(unsigned long)); GenReadBinary(theEnv,(void *) &DeffunctionBinaryData(theEnv)->DeffunctionCount,sizeof(unsigned long)); if (DeffunctionBinaryData(theEnv)->ModuleCount == 0L) { DeffunctionBinaryData(theEnv)->ModuleArray = NULL; DeffunctionBinaryData(theEnv)->DeffunctionArray = NULL; return; } space = (DeffunctionBinaryData(theEnv)->ModuleCount * sizeof(DEFFUNCTION_MODULE)); DeffunctionBinaryData(theEnv)->ModuleArray = (DEFFUNCTION_MODULE *) genalloc(theEnv,space); if (DeffunctionBinaryData(theEnv)->DeffunctionCount == 0L) { DeffunctionBinaryData(theEnv)->DeffunctionArray = NULL; return; } space = (DeffunctionBinaryData(theEnv)->DeffunctionCount * sizeof(DEFFUNCTION)); DeffunctionBinaryData(theEnv)->DeffunctionArray = (DEFFUNCTION *) genalloc(theEnv,space); }
/*********************************************************************** NAME : BloadStorageGenerics DESCRIPTION : This routine space required for generic function structures and allocates space for them INPUTS : Nothing RETURNS : Nothing useful SIDE EFFECTS : Arrays allocated and set NOTES : This routine makes no attempt to reset any pointers within the structures ***********************************************************************/ static void BloadStorageGenerics( void *theEnv) { size_t space; long counts[5]; GenReadBinary(theEnv,(void *) &space,sizeof(size_t)); if (space == 0L) return; GenReadBinary(theEnv,(void *) counts,space); DefgenericBinaryData(theEnv)->ModuleCount = counts[0]; DefgenericBinaryData(theEnv)->GenericCount = counts[1]; DefgenericBinaryData(theEnv)->MethodCount = counts[2]; DefgenericBinaryData(theEnv)->RestrictionCount = counts[3]; DefgenericBinaryData(theEnv)->TypeCount = counts[4]; if (DefgenericBinaryData(theEnv)->ModuleCount != 0L) { space = (sizeof(DEFGENERIC_MODULE) * DefgenericBinaryData(theEnv)->ModuleCount); DefgenericBinaryData(theEnv)->ModuleArray = (DEFGENERIC_MODULE *) genalloc(theEnv,space); } else return; if (DefgenericBinaryData(theEnv)->GenericCount != 0L) { space = (sizeof(DEFGENERIC) * DefgenericBinaryData(theEnv)->GenericCount); DefgenericBinaryData(theEnv)->DefgenericArray = (DEFGENERIC *) genalloc(theEnv,space); } else return; if (DefgenericBinaryData(theEnv)->MethodCount != 0L) { space = (sizeof(DEFMETHOD) * DefgenericBinaryData(theEnv)->MethodCount); DefgenericBinaryData(theEnv)->MethodArray = (DEFMETHOD *) genalloc(theEnv,space); } else return; if (DefgenericBinaryData(theEnv)->RestrictionCount != 0L) { space = (sizeof(RESTRICTION) * DefgenericBinaryData(theEnv)->RestrictionCount); DefgenericBinaryData(theEnv)->RestrictionArray = (RESTRICTION *) genalloc(theEnv,space); } else return; if (DefgenericBinaryData(theEnv)->TypeCount != 0L) { space = (sizeof(void *) * DefgenericBinaryData(theEnv)->TypeCount); DefgenericBinaryData(theEnv)->TypeArray = (void * *) genalloc(theEnv,space); } }
void MergeSort( void *theEnv, unsigned long listSize, DATA_OBJECT *theList, int (*swapFunction)(void *,DATA_OBJECT *,DATA_OBJECT *)) { DATA_OBJECT *tempList; unsigned long middle; if (listSize <= 1) return; /*==============================*/ /* Create the temporary storage */ /* needed for the merge sort. */ /*==============================*/ tempList = (DATA_OBJECT *) genalloc(theEnv,listSize * sizeof(DATA_OBJECT)); /*=====================================*/ /* Call the merge sort driver routine. */ /*=====================================*/ middle = (listSize + 1) / 2; DoMergeSort(theEnv,theList,tempList,0,middle-1,middle,listSize - 1,swapFunction); /*==================================*/ /* Deallocate the temporary storage */ /* needed by the merge sort. */ /*==================================*/ genfree(theEnv,tempList,listSize * sizeof(DATA_OBJECT)); }
/* * Initialize all of the buffers and windows. The buffer name is passed down * as an argument, because the main routine may have been told to read in a * file by default, and we want the buffer name to be right. */ globle void edinit( void *theEnv, char bname[]) { register BUFFER *bp; register WINDOW *wp; bp = bfind(theEnv,bname, TRUE, 0); /* First buffer */ blistp = bfind(theEnv,"[List]", TRUE, BFTEMP); /* Buffer list buffer */ wp = (WINDOW *) genalloc(theEnv,(unsigned) sizeof(WINDOW)); /* First window */ curbp = bp; /* Make this current */ wheadp = wp; curwp = wp; wp->w_wndp = NULL; /* Initialize window */ wp->w_bufp = bp; bp->b_nwnd = 1; /* Displayed. */ wp->w_linep = bp->b_linep; wp->w_dotp = bp->b_linep; wp->w_doto = 0; wp->w_markp = NULL; wp->w_marko = 0; wp->w_toprow = 0; wp->w_ntrows = (char) term.t_nrow-1; /* "-1" for mode line. */ wp->w_force = 0; wp->w_flag = WFMODE|WFHARD; /* Full. */ /* Secret Buffer for CLIPS Compile output */ CompileBufferp = bfind(theEnv,"[Compilations]",TRUE,BFTEMP); }
static void BloadStorage( void *theEnv, EXEC_STATUS) { size_t space; /*=========================================*/ /* Determine the number of factPatternNode */ /* data structures to be read. */ /*=========================================*/ GenReadBinary(theEnv,execStatus,&space,sizeof(size_t)); GenReadBinary(theEnv,execStatus,&FactBinaryData(theEnv,execStatus)->NumberOfPatterns,sizeof(long int)); /*===================================*/ /* Allocate the space needed for the */ /* factPatternNode data structures. */ /*===================================*/ if (FactBinaryData(theEnv,execStatus)->NumberOfPatterns == 0) { FactBinaryData(theEnv,execStatus)->FactPatternArray = NULL; return; } space = FactBinaryData(theEnv,execStatus)->NumberOfPatterns * sizeof(struct factPatternNode); FactBinaryData(theEnv,execStatus)->FactPatternArray = (struct factPatternNode *) genalloc(theEnv,execStatus,space); }
globle intBool EnvAddRouterWithContext( void *theEnv, EXEC_STATUS, char *routerName, int priority, int (*queryFunction)(void *,EXEC_STATUS,char *), int (*printFunction)(void *,EXEC_STATUS,char *,char *), int (*getcFunction)(void *,EXEC_STATUS,char *), int (*ungetcFunction)(void *,EXEC_STATUS,int,char *), int (*exitFunction)(void *,EXEC_STATUS,int), void *context) { struct router *newPtr, *lastPtr, *currentPtr; char *nameCopy; newPtr = get_struct(theEnv,execStatus,router); nameCopy = (char *) genalloc(theEnv,execStatus,strlen(routerName) + 1); genstrcpy(nameCopy,routerName); newPtr->name = nameCopy; newPtr->active = TRUE; newPtr->environmentAware = TRUE; newPtr->context = context; newPtr->priority = priority; newPtr->query = queryFunction; newPtr->printer = printFunction; newPtr->exiter = exitFunction; newPtr->charget = getcFunction; newPtr->charunget = ungetcFunction; newPtr->next = NULL; if (RouterData(theEnv,execStatus)->ListOfRouters == NULL) { RouterData(theEnv,execStatus)->ListOfRouters = newPtr; return(1); } lastPtr = NULL; currentPtr = RouterData(theEnv,execStatus)->ListOfRouters; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = RouterData(theEnv,execStatus)->ListOfRouters; RouterData(theEnv,execStatus)->ListOfRouters = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } return(1); }
globle intBool AddRouter( char *routerName, int priority, int (*queryFunction)(char *), int (*printFunction)(char *,char *), int (*getcFunction)(char *), int (*ungetcFunction)(int,char *), int (*exitFunction)(int)) { struct router *newPtr, *lastPtr, *currentPtr; void *theEnv; char *nameCopy; theEnv = GetCurrentEnvironment(); newPtr = get_struct(theEnv,router); nameCopy = (char *) genalloc(theEnv,strlen(routerName) + 1); genstrcpy(nameCopy,routerName); newPtr->name = nameCopy; newPtr->active = TRUE; newPtr->environmentAware = FALSE; newPtr->priority = priority; newPtr->context = NULL; newPtr->query = (int (*)(void *,char *)) queryFunction; newPtr->printer = (int (*)(void *,char *,char *)) printFunction; newPtr->exiter = (int (*)(void *,int)) exitFunction; newPtr->charget = (int (*)(void *,char *)) getcFunction; newPtr->charunget = (int (*)(void *,int,char *)) ungetcFunction; newPtr->next = NULL; if (RouterData(theEnv)->ListOfRouters == NULL) { RouterData(theEnv)->ListOfRouters = newPtr; return(1); } lastPtr = NULL; currentPtr = RouterData(theEnv)->ListOfRouters; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : FALSE) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = RouterData(theEnv)->ListOfRouters; RouterData(theEnv)->ListOfRouters = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } return(1); }
globle void *gm3( void *theEnv, size_t size) { struct memoryPtr *memPtr; if (size < (long) sizeof(char *)) size = sizeof(char *); if (size >= MEM_TABLE_SIZE) return(genalloc(theEnv,size)); memPtr = (struct memoryPtr *) MemoryData(theEnv)->MemoryTable[(int) size]; if (memPtr == NULL) { return(genalloc(theEnv,size)); } MemoryData(theEnv)->MemoryTable[(int) size] = memPtr->next; return ((void *) memPtr); }
static void BloadStorageDefglobals( void *theEnv, EXEC_STATUS) { size_t space; /*=======================================================*/ /* Determine the number of defglobal and defglobalModule */ /* data structures to be read. */ /*=======================================================*/ GenReadBinary(theEnv,execStatus,&space,sizeof(size_t)); GenReadBinary(theEnv,execStatus,&DefglobalBinaryData(theEnv,execStatus)->NumberOfDefglobals,sizeof(long int)); GenReadBinary(theEnv,execStatus,&DefglobalBinaryData(theEnv,execStatus)->NumberOfDefglobalModules,sizeof(long int)); /*===================================*/ /* Allocate the space needed for the */ /* defglobalModule data structures. */ /*===================================*/ if (DefglobalBinaryData(theEnv,execStatus)->NumberOfDefglobalModules == 0) { DefglobalBinaryData(theEnv,execStatus)->DefglobalArray = NULL; DefglobalBinaryData(theEnv,execStatus)->ModuleArray = NULL; } space = DefglobalBinaryData(theEnv,execStatus)->NumberOfDefglobalModules * sizeof(struct defglobalModule); DefglobalBinaryData(theEnv,execStatus)->ModuleArray = (struct defglobalModule *) genalloc(theEnv,execStatus,space); /*===================================*/ /* Allocate the space needed for the */ /* defglobal data structures. */ /*===================================*/ if (DefglobalBinaryData(theEnv,execStatus)->NumberOfDefglobals == 0) { DefglobalBinaryData(theEnv,execStatus)->DefglobalArray = NULL; return; } space = (DefglobalBinaryData(theEnv,execStatus)->NumberOfDefglobals * sizeof(struct defglobal)); DefglobalBinaryData(theEnv,execStatus)->DefglobalArray = (struct defglobal *) genalloc(theEnv,execStatus,space); }
static void BloadStorage( void *theEnv) { size_t space; /*=====================================================*/ /* Determine the number of deffacts and deffactsModule */ /* data structures to be read. */ /*=====================================================*/ GenReadBinary(theEnv,&space,sizeof(size_t)); GenReadBinary(theEnv,&DeffactsBinaryData(theEnv)->NumberOfDeffacts,sizeof(long int)); GenReadBinary(theEnv,&DeffactsBinaryData(theEnv)->NumberOfDeffactsModules,sizeof(long int)); /*===================================*/ /* Allocate the space needed for the */ /* deffactsModule data structures. */ /*===================================*/ if (DeffactsBinaryData(theEnv)->NumberOfDeffactsModules == 0) { DeffactsBinaryData(theEnv)->DeffactsArray = NULL; DeffactsBinaryData(theEnv)->ModuleArray = NULL; return; } space = DeffactsBinaryData(theEnv)->NumberOfDeffactsModules * sizeof(struct deffactsModule); DeffactsBinaryData(theEnv)->ModuleArray = (struct deffactsModule *) genalloc(theEnv,space); /*===================================*/ /* Allocate the space needed for the */ /* deffacts data structures. */ /*===================================*/ if (DeffactsBinaryData(theEnv)->NumberOfDeffacts == 0) { DeffactsBinaryData(theEnv)->DeffactsArray = NULL; return; } space = (DeffactsBinaryData(theEnv)->NumberOfDeffacts * sizeof(struct deffacts)); DeffactsBinaryData(theEnv)->DeffactsArray = (struct deffacts *) genalloc(theEnv,space); }
static void BloadStorage( void *theEnv) { size_t space; /*=======================================*/ /* Determine the number of defmodule and */ /* port item data structures to be read. */ /*=======================================*/ GenReadBinary(theEnv,&space,sizeof(size_t)); GenReadBinary(theEnv,&DefmoduleData(theEnv)->BNumberOfDefmodules,sizeof(long int)); GenReadBinary(theEnv,&DefmoduleData(theEnv)->NumberOfPortItems,sizeof(long int)); /*================================*/ /* Allocate the space needed for */ /* the defmodule data structures. */ /*================================*/ if (DefmoduleData(theEnv)->BNumberOfDefmodules == 0) { DefmoduleData(theEnv)->DefmoduleArray = NULL; return; } space = (DefmoduleData(theEnv)->BNumberOfDefmodules * sizeof(struct defmodule)); DefmoduleData(theEnv)->DefmoduleArray = (struct defmodule *) genalloc(theEnv,space); /*================================*/ /* Allocate the space needed for */ /* the port item data structures. */ /*================================*/ if (DefmoduleData(theEnv)->NumberOfPortItems == 0) { DefmoduleData(theEnv)->PortItemArray = NULL; return; } space = (DefmoduleData(theEnv)->NumberOfPortItems * sizeof(struct portItem)); DefmoduleData(theEnv)->PortItemArray = (struct portItem *) genalloc(theEnv,space); }
globle void *gm2( void *theEnv, unsigned int size) { struct memoryPtr *memPtr; if (size < sizeof(char *)) size = sizeof(char *); if (size >= MEM_TABLE_SIZE) return(genalloc(theEnv,(unsigned) size)); memPtr = (struct memoryPtr *) MemoryData(theEnv)->MemoryTable[size]; if (memPtr == NULL) { return(genalloc(theEnv,(unsigned) size)); } MemoryData(theEnv)->MemoryTable[size] = memPtr->next; return ((void *) memPtr); }
globle void ReadNeededConstraints( void *theEnv) { GenReadBinary(theEnv,(void *) &ConstraintData(theEnv)->NumberOfConstraints,sizeof(unsigned long int)); if (ConstraintData(theEnv)->NumberOfConstraints == 0) return; ConstraintData(theEnv)->ConstraintArray = (CONSTRAINT_RECORD *) genalloc(theEnv,(sizeof(CONSTRAINT_RECORD) * ConstraintData(theEnv)->NumberOfConstraints)); BloadandRefresh(theEnv,ConstraintData(theEnv)->NumberOfConstraints,sizeof(BSAVE_CONSTRAINT_RECORD), CopyFromBsaveConstraintRecord); }
void AllocateExpressions( Environment *theEnv) { size_t space; GenReadBinary(theEnv,&ExpressionData(theEnv)->NumberOfExpressions,sizeof(long)); if (ExpressionData(theEnv)->NumberOfExpressions == 0L) ExpressionData(theEnv)->ExpressionArray = NULL; else { space = ExpressionData(theEnv)->NumberOfExpressions * sizeof(struct expr); ExpressionData(theEnv)->ExpressionArray = (struct expr *) genalloc(theEnv,space); } }
/************************************************************ NAME : BloadandRefresh DESCRIPTION : Loads and refreshes objects - will bload all objects at once, if possible, but will aslo work in increments if memory is restricted INPUTS : 1) the number of objects to bload and update 2) the size of one object 3) An update function which takes a bloaded object buffer and the index of the object to refresh as arguments RETURNS : Nothing useful SIDE EFFECTS : Objects bloaded and updated NOTES : Assumes binary file pointer is positioned for bloads of the objects ************************************************************/ globle void BloadandRefresh( void *theEnv, long objcnt, size_t objsz, void (*objupdate)(void *,void *,long)) { register long i,bi; char *buf; long objsmaxread,objsread; size_t space; int (*oldOutOfMemoryFunction)(void *,size_t); if (objcnt == 0L) return; oldOutOfMemoryFunction = EnvSetOutOfMemoryFunction(theEnv,BloadOutOfMemoryFunction); objsmaxread = objcnt; do { space = objsmaxread * objsz; buf = (char *) genalloc(theEnv,space); if (buf == NULL) { if ((objsmaxread / 2) == 0) { if ((*oldOutOfMemoryFunction)(theEnv,space) == TRUE) { EnvSetOutOfMemoryFunction(theEnv,oldOutOfMemoryFunction); return; } } else objsmaxread /= 2; } } while (buf == NULL); EnvSetOutOfMemoryFunction(theEnv,oldOutOfMemoryFunction); i = 0L; do { objsread = (objsmaxread > (objcnt - i)) ? (objcnt - i) : objsmaxread; GenReadBinary(theEnv,(void *) buf,objsread * objsz); for (bi = 0L ; bi < objsread ; bi++ , i++) (*objupdate)(theEnv,buf + objsz * bi,i); } while (i < objcnt); genfree(theEnv,(void *) buf,space); }
globle void *CreateProfileData( void *theEnv) { struct constructProfileInfo *theInfo; theInfo = (struct constructProfileInfo *) genalloc(theEnv,sizeof(struct constructProfileInfo)); theInfo->numberOfEntries = 0; theInfo->childCall = FALSE; theInfo->startTime = 0.0; theInfo->totalSelfTime = 0.0; theInfo->totalWithChildrenTime = 0.0; return(theInfo); }
globle int PrintNRouter( void *theEnv, char *logicalName, char *str, unsigned long length) { char *tempStr; int rv; tempStr = (char *) genalloc(theEnv,length+1); genstrncpy(tempStr,str,length); tempStr[length] = 0; rv = EnvPrintRouter(theEnv,logicalName,tempStr); genfree(theEnv,tempStr,length+1); return(rv); }
SaveCallFunctionItem *AddSaveFunctionToCallList( Environment *theEnv, const char *name, int priority, SaveCallFunction *func, struct saveCallFunctionItem *head, void *context) { struct saveCallFunctionItem *newPtr, *currentPtr, *lastPtr = NULL; char *nameCopy; newPtr = get_struct(theEnv,saveCallFunctionItem); nameCopy = (char *) genalloc(theEnv,strlen(name) + 1); genstrcpy(nameCopy,name); newPtr->name = nameCopy; newPtr->func = func; newPtr->priority = priority; newPtr->context = context; if (head == NULL) { newPtr->next = NULL; return(newPtr); } currentPtr = head; while ((currentPtr != NULL) ? (priority < currentPtr->priority) : false) { lastPtr = currentPtr; currentPtr = currentPtr->next; } if (lastPtr == NULL) { newPtr->next = head; head = newPtr; } else { newPtr->next = currentPtr; lastPtr->next = newPtr; } return(head); }
globle int InstallExternalAddressType( void *theEnv, struct externalAddressType *theAddressType) { struct externalAddressType *copyEAT; int rv = EvaluationData(theEnv)->numberOfAddressTypes; if (EvaluationData(theEnv)->numberOfAddressTypes == MAXIMUM_EXTERNAL_ADDRESS_TYPES) { SystemError(theEnv,"EVALUATN",6); EnvExitRouter(theEnv,EXIT_FAILURE); } copyEAT = (struct externalAddressType *) genalloc(theEnv,sizeof(struct externalAddressType)); memcpy(copyEAT,theAddressType,sizeof(struct externalAddressType)); EvaluationData(theEnv)->ExternalAddressTypes[EvaluationData(theEnv)->numberOfAddressTypes++] = copyEAT; return rv; }
static struct joinNode *CreateNewJoin( void *theEnv, struct expr *joinTest, struct expr *secondaryJoinTest, struct joinNode *lhsEntryStruct, void *rhsEntryStruct, int joinFromTheRight, int negatedRHSPattern, int existsRHSPattern, struct expr *leftHash, struct expr *rightHash) { struct joinNode *newJoin; struct joinLink *theLink; /*===============================================*/ /* If compilations are being watch, print +j to */ /* indicate that a new join has been created for */ /* this pattern of the rule (i.e. a join could */ /* not be shared with another rule. */ /*===============================================*/ #if DEBUGGING_FUNCTIONS if ((EnvGetWatchItem(theEnv,(char*)"compilations") == TRUE) && GetPrintWhileLoading(theEnv)) { EnvPrintRouter(theEnv,WDIALOG,(char*)"+j"); } #endif /*======================*/ /* Create the new join. */ /*======================*/ newJoin = get_struct(theEnv,joinNode); /*======================================================*/ /* The first join of a rule does not have a beta memory */ /* unless the RHS pattern is an exists or not CE. */ /*======================================================*/ if ((lhsEntryStruct != NULL) || existsRHSPattern || negatedRHSPattern || joinFromTheRight) { if (leftHash == NULL) { newJoin->leftMemory = get_struct(theEnv,betaMemory); newJoin->leftMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); newJoin->leftMemory->beta[0] = NULL; newJoin->leftMemory->last = NULL; newJoin->leftMemory->size = 1; newJoin->leftMemory->count = 0; } else { newJoin->leftMemory = get_struct(theEnv,betaMemory); newJoin->leftMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); memset(newJoin->leftMemory->beta,0,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); newJoin->leftMemory->last = NULL; newJoin->leftMemory->size = INITIAL_BETA_HASH_SIZE; newJoin->leftMemory->count = 0; } /*===========================================================*/ /* If the first join of a rule connects to an exists or not */ /* CE, then we create an empty partial match for the usually */ /* empty left beta memory so that we can track the current */ /* current right memory partial match satisfying the CE. */ /*===========================================================*/ if ((lhsEntryStruct == NULL) && (existsRHSPattern || negatedRHSPattern || joinFromTheRight)) { newJoin->leftMemory->beta[0] = CreateEmptyPartialMatch(theEnv); newJoin->leftMemory->beta[0]->owner = newJoin; newJoin->leftMemory->count = 1; } } else { newJoin->leftMemory = NULL; } if (joinFromTheRight) { if (leftHash == NULL) { newJoin->rightMemory = get_struct(theEnv,betaMemory); newJoin->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); newJoin->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); newJoin->rightMemory->beta[0] = NULL; newJoin->rightMemory->last[0] = NULL; newJoin->rightMemory->size = 1; newJoin->rightMemory->count = 0; } else { newJoin->rightMemory = get_struct(theEnv,betaMemory); newJoin->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); newJoin->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); memset(newJoin->rightMemory->beta,0,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); memset(newJoin->rightMemory->last,0,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); newJoin->rightMemory->size = INITIAL_BETA_HASH_SIZE; newJoin->rightMemory->count = 0; } } else if ((lhsEntryStruct == NULL) && (rhsEntryStruct == NULL)) { newJoin->rightMemory = get_struct(theEnv,betaMemory); newJoin->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); newJoin->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); newJoin->rightMemory->beta[0] = CreateEmptyPartialMatch(theEnv); newJoin->rightMemory->beta[0]->owner = newJoin; newJoin->rightMemory->beta[0]->rhsMemory = TRUE; newJoin->rightMemory->last[0] = newJoin->rightMemory->beta[0]; newJoin->rightMemory->size = 1; newJoin->rightMemory->count = 1; } else { newJoin->rightMemory = NULL; } newJoin->nextLinks = NULL; newJoin->joinFromTheRight = joinFromTheRight; if (existsRHSPattern) { newJoin->patternIsNegated = FALSE; } else { newJoin->patternIsNegated = negatedRHSPattern; } newJoin->patternIsExists = existsRHSPattern; newJoin->marked = FALSE; newJoin->initialize = EnvGetIncrementalReset(theEnv); newJoin->logicalJoin = FALSE; newJoin->ruleToActivate = NULL; newJoin->memoryAdds = 0; newJoin->memoryDeletes = 0; newJoin->memoryCompares = 0; /*==============================================*/ /* Install the expressions used to determine */ /* if a partial match satisfies the constraints */ /* associated with this join. */ /*==============================================*/ newJoin->networkTest = AddHashedExpression(theEnv,joinTest); newJoin->secondaryNetworkTest = AddHashedExpression(theEnv,secondaryJoinTest); /*=====================================================*/ /* Install the expression used to hash the beta memory */ /* partial match to determine the location to search */ /* in the alpha memory. */ /*=====================================================*/ newJoin->leftHash = AddHashedExpression(theEnv,leftHash); newJoin->rightHash = AddHashedExpression(theEnv,rightHash); /*============================================================*/ /* Initialize the values associated with the LHS of the join. */ /*============================================================*/ newJoin->lastLevel = lhsEntryStruct; if (lhsEntryStruct == NULL) { newJoin->firstJoin = TRUE; newJoin->depth = 1; } else { newJoin->firstJoin = FALSE; newJoin->depth = lhsEntryStruct->depth; newJoin->depth++; /* To work around Sparcworks C compiler bug */ theLink = get_struct(theEnv,joinLink); theLink->join = newJoin; theLink->enterDirection = LHS; theLink->next = lhsEntryStruct->nextLinks; lhsEntryStruct->nextLinks = theLink; } /*=======================================================*/ /* Initialize the pointer values associated with the RHS */ /* of the join (both for the new join and the join or */ /* pattern which enters this join from the right. */ /*=======================================================*/ newJoin->rightSideEntryStructure = rhsEntryStruct; if (rhsEntryStruct == NULL) { if (newJoin->firstJoin) { theLink = get_struct(theEnv,joinLink); theLink->join = newJoin; theLink->enterDirection = RHS; theLink->next = DefruleData(theEnv)->RightPrimeJoins; DefruleData(theEnv)->RightPrimeJoins = theLink; } newJoin->rightMatchNode = NULL; return(newJoin); } /*===========================================================*/ /* If the first join of a rule is a not CE, then it needs to */ /* be "primed" under certain circumstances. This used to be */ /* handled by adding the (initial-fact) pattern to a rule */ /* with the not CE as its first pattern, but this alternate */ /* mechanism is now used so patterns don't have to be added. */ /*===========================================================*/ if (newJoin->firstJoin && (newJoin->patternIsNegated || newJoin->joinFromTheRight) && (! newJoin->patternIsExists)) { theLink = get_struct(theEnv,joinLink); theLink->join = newJoin; theLink->enterDirection = LHS; theLink->next = DefruleData(theEnv)->LeftPrimeJoins; DefruleData(theEnv)->LeftPrimeJoins = theLink; } if (joinFromTheRight) { theLink = get_struct(theEnv,joinLink); theLink->join = newJoin; theLink->enterDirection = RHS; theLink->next = ((struct joinNode *) rhsEntryStruct)->nextLinks; ((struct joinNode *) rhsEntryStruct)->nextLinks = theLink; newJoin->rightMatchNode = NULL; } else { newJoin->rightMatchNode = ((struct patternNodeHeader *) rhsEntryStruct)->entryJoin; ((struct patternNodeHeader *) rhsEntryStruct)->entryJoin = newJoin; } /*================================*/ /* Return the newly created join. */ /*================================*/ return(newJoin); }
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 void AddBetaMemoriesToJoin( void *theEnv, struct joinNode *theNode) { if ((theNode->leftMemory != NULL) || (theNode->rightMemory != NULL)) { return; } //if ((! theNode->firstJoin) || theNode->patternIsExists) if ((! theNode->firstJoin) || theNode->patternIsExists || theNode-> patternIsNegated || theNode->joinFromTheRight) { if (theNode->leftHash == NULL) { theNode->leftMemory = get_struct(theEnv,betaMemory); theNode->leftMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); theNode->leftMemory->beta[0] = NULL; theNode->leftMemory->size = 1; theNode->leftMemory->count = 0; theNode->leftMemory->last = NULL; } else { theNode->leftMemory = get_struct(theEnv,betaMemory); theNode->leftMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); memset(theNode->leftMemory->beta,0,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); theNode->leftMemory->size = INITIAL_BETA_HASH_SIZE; theNode->leftMemory->count = 0; theNode->leftMemory->last = NULL; } // if (theNode->firstJoin && theNode->patternIsExists) if (theNode->firstJoin && (theNode->patternIsExists || theNode-> patternIsNegated || theNode->joinFromTheRight)) { theNode->leftMemory->beta[0] = CreateEmptyPartialMatch(theEnv); theNode->leftMemory->beta[0]->owner = theNode; } } else { theNode->leftMemory = NULL; } if (theNode->joinFromTheRight) { if (theNode->leftHash == NULL) { theNode->rightMemory = get_struct(theEnv,betaMemory); theNode->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); theNode->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); theNode->rightMemory->beta[0] = NULL; theNode->rightMemory->last[0] = NULL; theNode->rightMemory->size = 1; theNode->rightMemory->count = 0; } else { theNode->rightMemory = get_struct(theEnv,betaMemory); theNode->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); theNode->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE); memset(theNode->rightMemory->beta,0,sizeof(struct partialMatch **) * INITIAL_BETA_HASH_SIZE); memset(theNode->rightMemory->last,0,sizeof(struct partialMatch **) * INITIAL_BETA_HASH_SIZE); theNode->rightMemory->size = INITIAL_BETA_HASH_SIZE; theNode->rightMemory->count = 0; } } else if (theNode->firstJoin && (theNode->rightSideEntryStructure == NULL)) { theNode->rightMemory = get_struct(theEnv,betaMemory); theNode->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); theNode->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *)); theNode->rightMemory->beta[0] = CreateEmptyPartialMatch(theEnv); theNode->rightMemory->beta[0]->owner = theNode; theNode->rightMemory->beta[0]->rhsMemory = TRUE; theNode->rightMemory->last[0] = theNode->rightMemory->beta[0]; theNode->rightMemory->size = 1; theNode->rightMemory->count = 1; } else { theNode->rightMemory = NULL; } }
globle void SortFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { long argumentCount, i, j, k = 0; DATA_OBJECT *theArguments, *theArguments2; DATA_OBJECT theArg; struct multifield *theMultifield, *tempMultifield; char *functionName; struct expr *functionReference; int argumentSize = 0; struct FunctionDefinition *fptr; #if DEFFUNCTION_CONSTRUCT DEFFUNCTION *dptr; #endif /*==================================*/ /* Set up the default return value. */ /*==================================*/ SetpType(returnValue,SYMBOL); SetpValue(returnValue,EnvFalseSymbol(theEnv)); /*=============================================*/ /* The function expects at least one argument. */ /*=============================================*/ if ((argumentCount = EnvArgCountCheck(theEnv,"sort",AT_LEAST,1)) == -1) { return; } /*=============================================*/ /* Verify that the comparison function exists. */ /*=============================================*/ if (EnvArgTypeCheck(theEnv,"sort",1,SYMBOL,&theArg) == FALSE) { return; } functionName = DOToString(theArg); functionReference = FunctionReferenceExpression(theEnv,functionName); if (functionReference == NULL) { ExpectedTypeError1(theEnv,"sort",1,"function name, deffunction name, or defgeneric name"); return; } /*======================================*/ /* For an external function, verify the */ /* correct number of arguments. */ /*======================================*/ if (functionReference->type == FCALL) { fptr = (struct FunctionDefinition *) functionReference->value; if ((GetMinimumArgs(fptr) > 2) || (GetMaximumArgs(fptr) == 0) || (GetMaximumArgs(fptr) == 1)) { ExpectedTypeError1(theEnv,"sort",1,"function name expecting two arguments"); ReturnExpression(theEnv,functionReference); return; } } /*=======================================*/ /* For a deffunction, verify the correct */ /* number of arguments. */ /*=======================================*/ #if DEFFUNCTION_CONSTRUCT if (functionReference->type == PCALL) { dptr = (DEFFUNCTION *) functionReference->value; if ((dptr->minNumberOfParameters > 2) || (dptr->maxNumberOfParameters == 0) || (dptr->maxNumberOfParameters == 1)) { ExpectedTypeError1(theEnv,"sort",1,"deffunction name expecting two arguments"); ReturnExpression(theEnv,functionReference); return; } } #endif /*=====================================*/ /* If there are no items to be sorted, */ /* then return an empty multifield. */ /*=====================================*/ if (argumentCount == 1) { EnvSetMultifieldErrorValue(theEnv,returnValue); ReturnExpression(theEnv,functionReference); return; } /*=====================================*/ /* Retrieve the arguments to be sorted */ /* and determine how many there are. */ /*=====================================*/ theArguments = (DATA_OBJECT *) genalloc(theEnv,(argumentCount - 1) * sizeof(DATA_OBJECT)); for (i = 2; i <= argumentCount; i++) { EnvRtnUnknown(theEnv,i,&theArguments[i-2]); if (GetType(theArguments[i-2]) == MULTIFIELD) { argumentSize += GetpDOLength(&theArguments[i-2]); } else { argumentSize++; } } if (argumentSize == 0) { genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(DATA_OBJECT)); /* Bug Fix */ EnvSetMultifieldErrorValue(theEnv,returnValue); ReturnExpression(theEnv,functionReference); return; } /*====================================*/ /* Pack all of the items to be sorted */ /* into a data object array. */ /*====================================*/ theArguments2 = (DATA_OBJECT *) genalloc(theEnv,argumentSize * sizeof(DATA_OBJECT)); for (i = 2; i <= argumentCount; i++) { if (GetType(theArguments[i-2]) == MULTIFIELD) { tempMultifield = (struct multifield *) GetValue(theArguments[i-2]); for (j = GetDOBegin(theArguments[i-2]); j <= GetDOEnd(theArguments[i-2]); j++, k++) { SetType(theArguments2[k],GetMFType(tempMultifield,j)); SetValue(theArguments2[k],GetMFValue(tempMultifield,j)); } } else { SetType(theArguments2[k],GetType(theArguments[i-2])); SetValue(theArguments2[k],GetValue(theArguments[i-2])); k++; } } genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(DATA_OBJECT)); functionReference->nextArg = SortFunctionData(theEnv)->SortComparisonFunction; SortFunctionData(theEnv)->SortComparisonFunction = functionReference; for (i = 0; i < argumentSize; i++) { ValueInstall(theEnv,&theArguments2[i]); } MergeSort(theEnv,(unsigned long) argumentSize,theArguments2,DefaultCompareSwapFunction); for (i = 0; i < argumentSize; i++) { ValueDeinstall(theEnv,&theArguments2[i]); } SortFunctionData(theEnv)->SortComparisonFunction = SortFunctionData(theEnv)->SortComparisonFunction->nextArg; functionReference->nextArg = NULL; ReturnExpression(theEnv,functionReference); theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,(unsigned long) argumentSize); for (i = 0; i < argumentSize; i++) { SetMFType(theMultifield,i+1,GetType(theArguments2[i])); SetMFValue(theMultifield,i+1,GetValue(theArguments2[i])); } genfree(theEnv,theArguments2,argumentSize * sizeof(DATA_OBJECT)); SetpType(returnValue,MULTIFIELD); SetpDOBegin(returnValue,1); SetpDOEnd(returnValue,argumentSize); SetpValue(returnValue,(void *) theMultifield); }
globle void *genlongalloc( void *theEnv, unsigned long size) { #if (! MAC) && (! IBM_TBC) && (! IBM_MSC) && (! IBM_ICB) && (! IBM_ZTC) && (! IBM_SC) && (! IBM_MCW) unsigned int test; #else void *memPtr; #endif #if BLOCK_MEMORY struct longMemoryPtr *theLongMemory; #endif if (sizeof(int) == sizeof(long)) { return(genalloc(theEnv,(unsigned) size)); } #if (! MAC) && (! IBM_TBC) && (! IBM_MSC) && (! IBM_ICB) && (! IBM_ZTC) && (! IBM_SC) && (! IBM_MCW) test = (unsigned int) size; if (test != size) { PrintErrorID(theEnv,"MEMORY",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Unable to allocate memory block > 32K.\n"); EnvExitRouter(theEnv,EXIT_FAILURE); } return((void *) genalloc(theEnv,(unsigned) test)); #else #if BLOCK_MEMORY size += sizeof(struct longMemoryPtr); #endif memPtr = (void *) SpecialMalloc(size); if (memPtr == NULL) { EnvReleaseMem(theEnv,(long) ((size * 5 > 4096) ? size * 5 : 4096),FALSE); memPtr = (void *) SpecialMalloc(size); if (memPtr == NULL) { EnvReleaseMem(theEnv,-1L,TRUE); memPtr = (void *) SpecialMalloc(size); while (memPtr == NULL) { if ((*MemoryData(theEnv)->OutOfMemoryFunction)(theEnv,size)) return(NULL); memPtr = (void *) SpecialMalloc(size); } } } MemoryData(theEnv)->MemoryAmount += (long) size; MemoryData(theEnv)->MemoryCalls++; #if BLOCK_MEMORY theLongMemory = (struct longMemoryPtr *) memPtr; theLongMemory->next = MemoryData(theEnv)->TopLongMemoryPtr; theLongMemory->prev = NULL; theLongMemory->size = (long) size; memPtr = (void *) (theLongMemory + 1); #endif return(memPtr); #endif }
globle BOOLEAN EnvMatches_PY( void *theEnv, char *logicalName, void *theRule) { struct defrule *rulePtr, *tmpPtr; struct partialMatch *listOfMatches, **theStorage; struct joinNode *theJoin, *lastJoin; int i, depth; ACTIVATION *agendaPtr; int flag; int matchesDisplayed; /*=================================================*/ /* Loop through each of the disjuncts for the rule */ /*=================================================*/ for (rulePtr = (struct defrule *) theRule, tmpPtr = rulePtr; rulePtr != NULL; rulePtr = rulePtr->disjunct) { /*======================================*/ /* Determine the last join in the rule. */ /*======================================*/ lastJoin = rulePtr->lastJoin; /*===================================*/ /* Determine the number of patterns. */ /*===================================*/ depth = GetPatternNumberFromJoin(lastJoin); /*=========================================*/ /* Store the alpha memory partial matches. */ /*=========================================*/ theStorage = (struct partialMatch **) genalloc(theEnv,(unsigned) (depth * sizeof(struct partialMatch))); theJoin = lastJoin; i = depth - 1; while (theJoin != NULL) { if (theJoin->joinFromTheRight) { theJoin = (struct joinNode *) theJoin->rightSideEntryStructure; } else { theStorage[i] = ((struct patternNodeHeader *) theJoin->rightSideEntryStructure)->alphaMemory; i--; theJoin = theJoin->lastLevel; } } /*========================================*/ /* List the alpha memory partial matches. */ /*========================================*/ for (i = 0; i < depth; i++) { if (GetHaltExecution(theEnv) == TRUE) { genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch))); return(TRUE); } EnvPrintRouter(theEnv,logicalName,"Matches for Pattern "); PrintLongInteger(theEnv,logicalName,(long int) i + 1); EnvPrintRouter(theEnv,logicalName,"\n"); listOfMatches = theStorage[i]; if (listOfMatches == NULL) EnvPrintRouter(theEnv,logicalName," None\n"); while (listOfMatches != NULL) { if (GetHaltExecution(theEnv) == TRUE) { genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch))); return(TRUE); } PrintPartialMatch(theEnv,logicalName,listOfMatches); EnvPrintRouter(theEnv,logicalName,"\n"); listOfMatches = listOfMatches->next; } } genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch))); /*========================================*/ /* Store the beta memory partial matches. */ /*========================================*/ depth = lastJoin->depth; theStorage = (struct partialMatch **) genalloc(theEnv,(unsigned) (depth * sizeof(struct partialMatch))); theJoin = lastJoin; for (i = depth - 1; i >= 0; i--) { theStorage[i] = theJoin->beta; theJoin = theJoin->lastLevel; } /*=======================================*/ /* List the beta memory partial matches. */ /*=======================================*/ for (i = 1; i < depth; i++) { if (GetHaltExecution(theEnv) == TRUE) { genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch))); return(TRUE); } matchesDisplayed = 0; EnvPrintRouter(theEnv,logicalName,"Partial matches for CEs 1 - "); PrintLongInteger(theEnv,logicalName,(long int) i + 1); EnvPrintRouter(theEnv,logicalName,"\n"); listOfMatches = theStorage[i]; while (listOfMatches != NULL) { if (GetHaltExecution(theEnv) == TRUE) { genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch))); return(TRUE); } if (listOfMatches->counterf == FALSE) { matchesDisplayed++; PrintPartialMatch(theEnv,logicalName,listOfMatches); EnvPrintRouter(theEnv,logicalName,"\n"); } listOfMatches = listOfMatches->next; } if (matchesDisplayed == 0) { EnvPrintRouter(theEnv,logicalName," None\n"); } } genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct partialMatch))); } /*===================*/ /* List activations. */ /*===================*/ rulePtr = tmpPtr; EnvPrintRouter(theEnv,logicalName,"Activations\n"); flag = 1; for (agendaPtr = (struct activation *) EnvGetNextActivation(theEnv,NULL); agendaPtr != NULL; agendaPtr = (struct activation *) EnvGetNextActivation(theEnv,agendaPtr)) { if (GetHaltExecution(theEnv) == TRUE) return(TRUE); if (((struct activation *) agendaPtr)->theRule->header.name == rulePtr->header.name) { flag = 0; PrintPartialMatch(theEnv,logicalName,GetActivationBasis(agendaPtr)); EnvPrintRouter(theEnv,logicalName,"\n"); } } if (flag) EnvPrintRouter(theEnv,logicalName," None\n"); return(TRUE); }
globle intBool EnvMatchesCount( void *theEnv, void *theRule) { struct defrule *rulePtr, *tmpPtr; struct betaMemory *theMemory, **theStorage; struct partialMatch *listOfMatches; struct alphaMemoryHash *listOfHashNodes, **theAlphaStorage; struct joinNode *theJoin, *lastJoin; int i, depth; ACTIVATION *agendaPtr; long count; /*=================================================*/ /* Loop through each of the disjuncts for the rule */ /*=================================================*/ for (rulePtr = (struct defrule *) theRule, tmpPtr = rulePtr; rulePtr != NULL; rulePtr = rulePtr->disjunct) { /*======================================*/ /* Determine the last join in the rule. */ /*======================================*/ lastJoin = rulePtr->lastJoin; /*===================================*/ /* Determine the number of patterns. */ /*===================================*/ depth = GetPatternNumberFromJoin(lastJoin); /*=========================================*/ /* Store the alpha memory partial matches. */ /*=========================================*/ theAlphaStorage = (struct alphaMemoryHash **) genalloc(theEnv,(unsigned) (depth * sizeof(struct alphaMemoryHash *))); theJoin = lastJoin; i = depth - 1; while (theJoin != NULL) { if (theJoin->joinFromTheRight) { theJoin = (struct joinNode *) theJoin->rightSideEntryStructure; } else { theAlphaStorage[i] = ((struct patternNodeHeader *) theJoin->rightSideEntryStructure)->firstHash; i--; theJoin = theJoin->lastLevel; } } /*========================================*/ /* List the alpha memory partial matches. */ /*========================================*/ for (i = 0; i < depth; i++) { if (GetHaltExecution(theEnv) == TRUE) { genfree(theEnv,theAlphaStorage,(unsigned) (depth * sizeof(struct alphaMemoryHash *))); return(TRUE); } EnvPrintRouter(theEnv,WDISPLAY,"Matches for Pattern "); PrintLongInteger(theEnv,WDISPLAY,(long int) i + 1); EnvPrintRouter(theEnv,WDISPLAY,": "); count = 0; for (listOfHashNodes = theAlphaStorage[i]; listOfHashNodes != NULL; listOfHashNodes = listOfHashNodes->nextHash) { listOfMatches = listOfHashNodes->alphaMemory; while (listOfMatches != NULL) { if (GetHaltExecution(theEnv) == TRUE) { genfree(theEnv,theAlphaStorage,(unsigned) (depth * sizeof(struct alphaMemoryHash *))); return(TRUE); } count++; listOfMatches = listOfMatches->nextInMemory; } } PrintLongInteger(theEnv,WDISPLAY,count); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } genfree(theEnv,theAlphaStorage,(unsigned) (depth * sizeof(struct alphaMemoryHash *))); /*========================================*/ /* Store the beta memory partial matches. */ /*========================================*/ depth = lastJoin->depth; theStorage = (struct betaMemory **) genalloc(theEnv,(unsigned) (depth * sizeof(struct betaMemory *))); theJoin = lastJoin; for (i = depth - 1; i >= 0; i--) { /* theStorage[i] = GetBetaMemory(theEnv,theJoin); */ theStorage[i] = theJoin->leftMemory; theJoin = theJoin->lastLevel; } /*=======================================*/ /* List the beta memory partial matches. */ /*=======================================*/ for (i = 1; i < depth; i++) { if (GetHaltExecution(theEnv) == TRUE) { genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct betaMemory *))); return(TRUE); } /* count = 0; */ EnvPrintRouter(theEnv,WDISPLAY,"Partial matches for CEs 1 - "); PrintLongInteger(theEnv,WDISPLAY,(long int) i + 1); EnvPrintRouter(theEnv,WDISPLAY,": "); theMemory = theStorage[i]; /* for (b = 0; b < theMemory->size; b++) { listOfMatches = theMemory->beta[b]; while (listOfMatches != NULL) { if (GetHaltExecution(theEnv) == TRUE) { genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct betaMemory *))); return(TRUE); } count++; listOfMatches = listOfMatches->nextInMemory; } } */ count = theMemory->count; PrintLongInteger(theEnv,WDISPLAY,count); EnvPrintRouter(theEnv,WDISPLAY,"\n"); } genfree(theEnv,theStorage,(unsigned) (depth * sizeof(struct betaMemory *))); } /*===================*/ /* List activations. */ /*===================*/ rulePtr = tmpPtr; EnvPrintRouter(theEnv,WDISPLAY,"Activations: "); count = 0; for (agendaPtr = (struct activation *) EnvGetNextActivation(theEnv,NULL); agendaPtr != NULL; agendaPtr = (struct activation *) EnvGetNextActivation(theEnv,agendaPtr)) { if (GetHaltExecution(theEnv) == TRUE) return(TRUE); if (((struct activation *) agendaPtr)->theRule->header.name == rulePtr->header.name) { count++; } } PrintLongInteger(theEnv,WDISPLAY,count); EnvPrintRouter(theEnv,WDISPLAY,"\n"); return(TRUE); }