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);
}
