static void ResetFactHashTable(
void *theEnv)
{
struct factHashEntry **newTable;
/*=============================================*/
/* Don't reset the table unless the hash table */
/* has been expanded from its original size. */
/*=============================================*/
if (FactData(theEnv)->FactHashTableSize == SIZE_FACT_HASH)
{ return; }
/*=======================*/
/* Create the new table. */
/*=======================*/
newTable = CreateFactHashTable(theEnv,SIZE_FACT_HASH);
/*=====================================================*/
/* Replace the old hash table with the new hash table. */
/*=====================================================*/
rm3(theEnv,FactData(theEnv)->FactHashTable,sizeof(struct factHashEntry *) * FactData(theEnv)->FactHashTableSize);
FactData(theEnv)->FactHashTableSize = SIZE_FACT_HASH;
FactData(theEnv)->FactHashTable = newTable;
}
globle void ReturnPackedExpression(
struct expr *packPtr)
{
if (packPtr != NULL)
{
rm3((void *) packPtr,(long) sizeof (struct expr) *
ExpressionSize(packPtr));
}
}
globle void FreeAtomicValueStorage(
void *theEnv)
{
if (SymbolData(theEnv)->SymbolArray != NULL)
rm3(theEnv,(void *) SymbolData(theEnv)->SymbolArray,(long) sizeof(SYMBOL_HN *) * SymbolData(theEnv)->NumberOfSymbols);
if (SymbolData(theEnv)->FloatArray != NULL)
rm3(theEnv,(void *) SymbolData(theEnv)->FloatArray,(long) sizeof(FLOAT_HN *) * SymbolData(theEnv)->NumberOfFloats);
if (SymbolData(theEnv)->IntegerArray != NULL)
rm3(theEnv,(void *) SymbolData(theEnv)->IntegerArray,(long) sizeof(INTEGER_HN *) * SymbolData(theEnv)->NumberOfIntegers);
if (SymbolData(theEnv)->BitMapArray != NULL)
rm3(theEnv,(void *) SymbolData(theEnv)->BitMapArray,(long) sizeof(BITMAP_HN *) * SymbolData(theEnv)->NumberOfBitMaps);
SymbolData(theEnv)->SymbolArray = NULL;
SymbolData(theEnv)->FloatArray = NULL;
SymbolData(theEnv)->IntegerArray = NULL;
SymbolData(theEnv)->BitMapArray = NULL;
SymbolData(theEnv)->NumberOfSymbols = 0;
SymbolData(theEnv)->NumberOfFloats = 0;
SymbolData(theEnv)->NumberOfIntegers = 0;
SymbolData(theEnv)->NumberOfBitMaps = 0;
}
static void DeallocateDefruleData(
void *theEnv)
{
struct defruleModule *theModuleItem;
void *theModule;
struct activation *theActivation, *tmpActivation;
struct salienceGroup *theGroup, *tmpGroup;
#if BLOAD || BLOAD_AND_BSAVE
if (Bloaded(theEnv))
{ return; }
#endif
DoForAllConstructs(theEnv,DestroyDefruleAction,DefruleData(theEnv)->DefruleModuleIndex,FALSE,NULL);
for (theModule = EnvGetNextDefmodule(theEnv,NULL);
theModule != NULL;
theModule = EnvGetNextDefmodule(theEnv,theModule))
{
theModuleItem = (struct defruleModule *)
GetModuleItem(theEnv,(struct defmodule *) theModule,
DefruleData(theEnv)->DefruleModuleIndex);
theActivation = theModuleItem->agenda;
while (theActivation != NULL)
{
tmpActivation = theActivation->next;
rtn_struct(theEnv,activation,theActivation);
theActivation = tmpActivation;
}
theGroup = theModuleItem->groupings;
while (theGroup != NULL)
{
tmpGroup = theGroup->next;
rtn_struct(theEnv,salienceGroup,theGroup);
theGroup = tmpGroup;
}
#if ! RUN_TIME
rtn_struct(theEnv,defruleModule,theModuleItem);
#endif
}
rm3(theEnv,DefruleData(theEnv)->AlphaMemoryTable,sizeof (ALPHA_MEMORY_HASH *) * ALPHA_MEMORY_HASH_SIZE);
}
static void ReadNeededBitMaps(
void *theEnv)
{
char *bitMapStorage, *bitMapPtr;
unsigned long space;
long i;
unsigned short *tempSize;
/*=======================================*/
/* Determine the number of bitmaps to be */
/* read and space required for them. */
/*=======================================*/
GenReadBinary(theEnv,(void *) &SymbolData(theEnv)->NumberOfBitMaps,(unsigned long) sizeof(long int));
GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int));
if (SymbolData(theEnv)->NumberOfBitMaps == 0)
{
SymbolData(theEnv)->BitMapArray = NULL;
return;
}
/*=======================================*/
/* Allocate area for bitmaps to be read. */
/*=======================================*/
bitMapStorage = (char *) gm3(theEnv,(long) space);
GenReadBinary(theEnv,(void *) bitMapStorage,space);
/*================================================*/
/* Store the bitMap pointers in the bitmap array. */
/*================================================*/
SymbolData(theEnv)->BitMapArray = (BITMAP_HN **)
gm3(theEnv,(long) sizeof(BITMAP_HN *) * SymbolData(theEnv)->NumberOfBitMaps);
bitMapPtr = bitMapStorage;
for (i = 0; i < SymbolData(theEnv)->NumberOfBitMaps; i++)
{
tempSize = (unsigned short *) bitMapPtr;
SymbolData(theEnv)->BitMapArray[i] = (BITMAP_HN *) EnvAddBitMap(theEnv,bitMapPtr+sizeof(unsigned short),*tempSize);
bitMapPtr += *tempSize + sizeof(unsigned short);
}
/*=========================*/
/* Free the bitmap buffer. */
/*=========================*/
rm3(theEnv,(void *) bitMapStorage,(long) space);
}
globle void ReadNeededSymbols(
void *theEnv)
{
char *symbolNames, *namePtr;
unsigned long space;
long i;
/*=================================================*/
/* Determine the number of symbol names to be read */
/* and space required for them. */
/*=================================================*/
GenReadBinary(theEnv,(void *) &SymbolData(theEnv)->NumberOfSymbols,(unsigned long) sizeof(long int));
GenReadBinary(theEnv,&space,(unsigned long) sizeof(unsigned long int));
if (SymbolData(theEnv)->NumberOfSymbols == 0)
{
SymbolData(theEnv)->SymbolArray = NULL;
return;
}
/*=======================================*/
/* Allocate area for strings to be read. */
/*=======================================*/
symbolNames = (char *) gm3(theEnv,(long) space);
GenReadBinary(theEnv,(void *) symbolNames,space);
/*================================================*/
/* Store the symbol pointers in the symbol array. */
/*================================================*/
SymbolData(theEnv)->SymbolArray = (SYMBOL_HN **)
gm3(theEnv,(long) sizeof(SYMBOL_HN *) * SymbolData(theEnv)->NumberOfSymbols);
namePtr = symbolNames;
for (i = 0; i < SymbolData(theEnv)->NumberOfSymbols; i++)
{
SymbolData(theEnv)->SymbolArray[i] = (SYMBOL_HN *) EnvAddSymbol(theEnv,namePtr);
namePtr += strlen(namePtr) + 1;
}
/*=======================*/
/* Free the name buffer. */
/*=======================*/
rm3(theEnv,(void *) symbolNames,(long) space);
}
static void DeallocatePatternData(
void *theEnv,
EXEC_STATUS)
{
struct reservedSymbol *tmpRSPtr, *nextRSPtr;
struct patternParser *tmpPPPtr, *nextPPPtr;
struct patternNodeHashEntry *tmpPNEPtr, *nextPNEPtr;
unsigned long i;
tmpRSPtr = PatternData(theEnv,execStatus)->ListOfReservedPatternSymbols;
while (tmpRSPtr != NULL)
{
nextRSPtr = tmpRSPtr->next;
rtn_struct(theEnv,execStatus,reservedSymbol,tmpRSPtr);
tmpRSPtr = nextRSPtr;
}
tmpPPPtr = PatternData(theEnv,execStatus)->ListOfPatternParsers;
while (tmpPPPtr != NULL)
{
nextPPPtr = tmpPPPtr->next;
rtn_struct(theEnv,execStatus,patternParser,tmpPPPtr);
tmpPPPtr = nextPPPtr;
}
for (i = 0; i < PatternData(theEnv,execStatus)->PatternHashTableSize; i++)
{
tmpPNEPtr = PatternData(theEnv,execStatus)->PatternHashTable[i];
while (tmpPNEPtr != NULL)
{
nextPNEPtr = tmpPNEPtr->next;
rtn_struct(theEnv,execStatus,patternNodeHashEntry,tmpPNEPtr);
tmpPNEPtr = nextPNEPtr;
}
}
rm3(theEnv,execStatus,PatternData(theEnv,execStatus)->PatternHashTable,
sizeof(struct patternNodeHashEntry *) * PatternData(theEnv,execStatus)->PatternHashTableSize);
}
globle void ReadNeededIntegers(
void *theEnv)
{
long long *integerValues;
long i;
/*==============================================*/
/* Determine the number of integers to be read. */
/*==============================================*/
GenReadBinary(theEnv,&SymbolData(theEnv)->NumberOfIntegers,(unsigned long) sizeof(unsigned long int));
if (SymbolData(theEnv)->NumberOfIntegers == 0)
{
SymbolData(theEnv)->IntegerArray = NULL;
return;
}
/*=================================*/
/* Allocate area for the integers. */
/*=================================*/
integerValues = (long long *) gm3(theEnv,(long) (sizeof(long long) * SymbolData(theEnv)->NumberOfIntegers));
GenReadBinary(theEnv,(void *) integerValues,(unsigned long) (sizeof(long long) * SymbolData(theEnv)->NumberOfIntegers));
/*==========================================*/
/* Store the integers in the integer array. */
/*==========================================*/
SymbolData(theEnv)->IntegerArray = (INTEGER_HN **)
gm3(theEnv,(long) (sizeof(INTEGER_HN *) * SymbolData(theEnv)->NumberOfIntegers));
for (i = 0; i < SymbolData(theEnv)->NumberOfIntegers; i++)
{ SymbolData(theEnv)->IntegerArray[i] = (INTEGER_HN *) EnvAddLong(theEnv,integerValues[i]); }
/*==========================*/
/* Free the integer buffer. */
/*==========================*/
rm3(theEnv,(void *) integerValues,(long) (sizeof(long long) * SymbolData(theEnv)->NumberOfIntegers));
}
globle void ReadNeededFloats(
void *theEnv)
{
double *floatValues;
long i;
/*============================================*/
/* Determine the number of floats to be read. */
/*============================================*/
GenReadBinary(theEnv,&SymbolData(theEnv)->NumberOfFloats,(unsigned long) sizeof(long int));
if (SymbolData(theEnv)->NumberOfFloats == 0)
{
SymbolData(theEnv)->FloatArray = NULL;
return;
}
/*===============================*/
/* Allocate area for the floats. */
/*===============================*/
floatValues = (double *) gm3(theEnv,(long) sizeof(double) * SymbolData(theEnv)->NumberOfFloats);
GenReadBinary(theEnv,(void *) floatValues,(unsigned long) (sizeof(double) * SymbolData(theEnv)->NumberOfFloats));
/*======================================*/
/* Store the floats in the float array. */
/*======================================*/
SymbolData(theEnv)->FloatArray = (FLOAT_HN **)
gm3(theEnv,(long) sizeof(FLOAT_HN *) * SymbolData(theEnv)->NumberOfFloats);
for (i = 0; i < SymbolData(theEnv)->NumberOfFloats; i++)
{ SymbolData(theEnv)->FloatArray[i] = (FLOAT_HN *) EnvAddDouble(theEnv,floatValues[i]); }
/*========================*/
/* Free the float buffer. */
/*========================*/
rm3(theEnv,(void *) floatValues,(long) (sizeof(double) * SymbolData(theEnv)->NumberOfFloats));
}
static void ResizeFactHashTable(
void *theEnv)
{
unsigned long i, newSize, newLocation;
struct factHashEntry **theTable, **newTable;
struct factHashEntry *theEntry, *nextEntry;
theTable = FactData(theEnv)->FactHashTable;
newSize = (FactData(theEnv)->FactHashTableSize * 2) + 1;
newTable = CreateFactHashTable(theEnv,newSize);
/*========================================*/
/* Copy the old entries to the new table. */
/*========================================*/
for (i = 0; i < FactData(theEnv)->FactHashTableSize; i++)
{
theEntry = theTable[i];
while (theEntry != NULL)
{
nextEntry = theEntry->next;
newLocation = theEntry->theFact->hashValue % newSize;
theEntry->next = newTable[newLocation];
newTable[newLocation] = theEntry;
theEntry = nextEntry;
}
}
/*=====================================================*/
/* Replace the old hash table with the new hash table. */
/*=====================================================*/
rm3(theEnv,theTable,sizeof(struct factHashEntry *) * FactData(theEnv)->FactHashTableSize);
FactData(theEnv)->FactHashTableSize = newSize;
FactData(theEnv)->FactHashTable = newTable;
}
template<typename MatrixType> void product_notemporary(const MatrixType& m)
{
/* This test checks the number of temporaries created
* during the evaluation of a complex expression */
typedef typename MatrixType::Index Index;
typedef typename MatrixType::Scalar Scalar;
typedef typename MatrixType::RealScalar RealScalar;
typedef Matrix<Scalar, 1, Dynamic> RowVectorType;
typedef Matrix<Scalar, Dynamic, 1> ColVectorType;
typedef Matrix<Scalar, Dynamic, Dynamic, ColMajor> ColMajorMatrixType;
typedef Matrix<Scalar, Dynamic, Dynamic, RowMajor> RowMajorMatrixType;
Index rows = m.rows();
Index cols = m.cols();
ColMajorMatrixType m1 = MatrixType::Random(rows, cols),
m2 = MatrixType::Random(rows, cols),
m3(rows, cols);
RowVectorType rv1 = RowVectorType::Random(rows), rvres(rows);
ColVectorType cv1 = ColVectorType::Random(cols), cvres(cols);
RowMajorMatrixType rm3(rows, cols);
Scalar s1 = internal::random<Scalar>(),
s2 = internal::random<Scalar>(),
s3 = internal::random<Scalar>();
Index c0 = internal::random<Index>(4,cols-8),
c1 = internal::random<Index>(8,cols-c0),
r0 = internal::random<Index>(4,cols-8),
r1 = internal::random<Index>(8,rows-r0);
VERIFY_EVALUATION_COUNT( m3 = (m1 * m2.adjoint()), 1);
VERIFY_EVALUATION_COUNT( m3 = (m1 * m2.adjoint()).transpose(), 1);
VERIFY_EVALUATION_COUNT( m3.noalias() = m1 * m2.adjoint(), 0);
VERIFY_EVALUATION_COUNT( m3 = s1 * (m1 * m2.transpose()), 1);
// VERIFY_EVALUATION_COUNT( m3 = m3 + s1 * (m1 * m2.transpose()), 1);
VERIFY_EVALUATION_COUNT( m3.noalias() = s1 * (m1 * m2.transpose()), 0);
VERIFY_EVALUATION_COUNT( m3 = m3 + (m1 * m2.adjoint()), 1);
VERIFY_EVALUATION_COUNT( m3 = m3 + (m1 * m2.adjoint()).transpose(), 1);
VERIFY_EVALUATION_COUNT( m3.noalias() = m3 + m1 * m2.transpose(), 0);
VERIFY_EVALUATION_COUNT( m3.noalias() += m3 + m1 * m2.transpose(), 0);
VERIFY_EVALUATION_COUNT( m3.noalias() -= m3 + m1 * m2.transpose(), 0);
VERIFY_EVALUATION_COUNT( m3.noalias() = s1 * m1 * s2 * m2.adjoint(), 0);
VERIFY_EVALUATION_COUNT( m3.noalias() = s1 * m1 * s2 * (m1*s3+m2*s2).adjoint(), 1);
VERIFY_EVALUATION_COUNT( m3.noalias() = (s1 * m1).adjoint() * s2 * m2, 0);
VERIFY_EVALUATION_COUNT( m3.noalias() += s1 * (-m1*s3).adjoint() * (s2 * m2 * s3), 0);
VERIFY_EVALUATION_COUNT( m3.noalias() -= s1 * (m1.transpose() * m2), 0);
VERIFY_EVALUATION_COUNT(( m3.block(r0,r0,r1,r1).noalias() += -m1.block(r0,c0,r1,c1) * (s2*m2.block(r0,c0,r1,c1)).adjoint() ), 0);
VERIFY_EVALUATION_COUNT(( m3.block(r0,r0,r1,r1).noalias() -= s1 * m1.block(r0,c0,r1,c1) * m2.block(c0,r0,c1,r1) ), 0);
// NOTE this is because the Block expression is not handled yet by our expression analyser
VERIFY_EVALUATION_COUNT(( m3.block(r0,r0,r1,r1).noalias() = s1 * m1.block(r0,c0,r1,c1) * (s1*m2).block(c0,r0,c1,r1) ), 1);
VERIFY_EVALUATION_COUNT( m3.noalias() -= (s1 * m1).template triangularView<Lower>() * m2, 0);
VERIFY_EVALUATION_COUNT( rm3.noalias() = (s1 * m1.adjoint()).template triangularView<Upper>() * (m2+m2), 1);
VERIFY_EVALUATION_COUNT( rm3.noalias() = (s1 * m1.adjoint()).template triangularView<UnitUpper>() * m2.adjoint(), 0);
VERIFY_EVALUATION_COUNT( m3.template triangularView<Upper>() = (m1 * m2.adjoint()), 0);
VERIFY_EVALUATION_COUNT( m3.template triangularView<Upper>() -= (m1 * m2.adjoint()), 0);
// NOTE this is because the blas_traits require innerstride==1 to avoid a temporary, but that doesn't seem to be actually needed for the triangular products
VERIFY_EVALUATION_COUNT( rm3.col(c0).noalias() = (s1 * m1.adjoint()).template triangularView<UnitUpper>() * (s2*m2.row(c0)).adjoint(), 1);
VERIFY_EVALUATION_COUNT( m1.template triangularView<Lower>().solveInPlace(m3), 0);
VERIFY_EVALUATION_COUNT( m1.adjoint().template triangularView<Lower>().solveInPlace(m3.transpose()), 0);
VERIFY_EVALUATION_COUNT( m3.noalias() -= (s1 * m1).adjoint().template selfadjointView<Lower>() * (-m2*s3).adjoint(), 0);
VERIFY_EVALUATION_COUNT( m3.noalias() = s2 * m2.adjoint() * (s1 * m1.adjoint()).template selfadjointView<Upper>(), 0);
VERIFY_EVALUATION_COUNT( rm3.noalias() = (s1 * m1.adjoint()).template selfadjointView<Lower>() * m2.adjoint(), 0);
// NOTE this is because the blas_traits require innerstride==1 to avoid a temporary, but that doesn't seem to be actually needed for the triangular products
VERIFY_EVALUATION_COUNT( m3.col(c0).noalias() = (s1 * m1).adjoint().template selfadjointView<Lower>() * (-m2.row(c0)*s3).adjoint(), 1);
VERIFY_EVALUATION_COUNT( m3.col(c0).noalias() -= (s1 * m1).adjoint().template selfadjointView<Upper>() * (-m2.row(c0)*s3).adjoint(), 1);
VERIFY_EVALUATION_COUNT( m3.block(r0,c0,r1,c1).noalias() += m1.block(r0,r0,r1,r1).template selfadjointView<Upper>() * (s1*m2.block(r0,c0,r1,c1)), 0);
VERIFY_EVALUATION_COUNT( m3.block(r0,c0,r1,c1).noalias() = m1.block(r0,r0,r1,r1).template selfadjointView<Upper>() * m2.block(r0,c0,r1,c1), 0);
VERIFY_EVALUATION_COUNT( m3.template selfadjointView<Lower>().rankUpdate(m2.adjoint()), 0);
// Here we will get 1 temporary for each resize operation of the lhs operator; resize(r1,c1) would lead to zero temporaries
m3.resize(1,1);
VERIFY_EVALUATION_COUNT( m3.noalias() = m1.block(r0,r0,r1,r1).template selfadjointView<Lower>() * m2.block(r0,c0,r1,c1), 1);
m3.resize(1,1);
VERIFY_EVALUATION_COUNT( m3.noalias() = m1.block(r0,r0,r1,r1).template triangularView<UnitUpper>() * m2.block(r0,c0,r1,c1), 1);
// Zero temporaries for lazy products ...
VERIFY_EVALUATION_COUNT( Scalar tmp = 0; tmp += Scalar(RealScalar(1)) / (m3.transpose().lazyProduct(m3)).diagonal().sum(), 0 );
// ... and even no temporary for even deeply (>=2) nested products
VERIFY_EVALUATION_COUNT( Scalar tmp = 0; tmp += Scalar(RealScalar(1)) / (m3.transpose() * m3).diagonal().sum(), 0 );
VERIFY_EVALUATION_COUNT( Scalar tmp = 0; tmp += Scalar(RealScalar(1)) / (m3.transpose() * m3).diagonal().array().abs().sum(), 0 );
// Zero temporaries for ... CoeffBasedProductMode
VERIFY_EVALUATION_COUNT( m3.col(0).template head<5>() * m3.col(0).transpose() + m3.col(0).template head<5>() * m3.col(0).transpose(), 0 );
// Check matrix * vectors
VERIFY_EVALUATION_COUNT( cvres.noalias() = m1 * cv1, 0 );
VERIFY_EVALUATION_COUNT( cvres.noalias() -= m1 * cv1, 0 );
VERIFY_EVALUATION_COUNT( cvres.noalias() -= m1 * m2.col(0), 0 );
VERIFY_EVALUATION_COUNT( cvres.noalias() -= m1 * rv1.adjoint(), 0 );
VERIFY_EVALUATION_COUNT( cvres.noalias() -= m1 * m2.row(0).transpose(), 0 );
VERIFY_EVALUATION_COUNT( cvres.noalias() = (m1+m1) * cv1, 0 );
VERIFY_EVALUATION_COUNT( cvres.noalias() = (rm3+rm3) * cv1, 0 );
VERIFY_EVALUATION_COUNT( cvres.noalias() = (m1+m1) * (m1*cv1), 1 );
VERIFY_EVALUATION_COUNT( cvres.noalias() = (rm3+rm3) * (m1*cv1), 1 );
// Check outer products
m3 = cv1 * rv1;
VERIFY_EVALUATION_COUNT( m3.noalias() = cv1 * rv1, 0 );
VERIFY_EVALUATION_COUNT( m3.noalias() = (cv1+cv1) * (rv1+rv1), 1 );
VERIFY_EVALUATION_COUNT( m3.noalias() = (m1*cv1) * (rv1), 1 );
VERIFY_EVALUATION_COUNT( m3.noalias() += (m1*cv1) * (rv1), 1 );
VERIFY_EVALUATION_COUNT( rm3.noalias() = (cv1) * (rv1 * m1), 1 );
VERIFY_EVALUATION_COUNT( rm3.noalias() -= (cv1) * (rv1 * m1), 1 );
VERIFY_EVALUATION_COUNT( rm3.noalias() = (m1*cv1) * (rv1 * m1), 2 );
VERIFY_EVALUATION_COUNT( rm3.noalias() += (m1*cv1) * (rv1 * m1), 2 );
}
globle intBool EnvSaveFacts(
void *theEnv,
char *fileName,
int saveCode,
struct expr *theList)
{
int tempValue1, tempValue2, tempValue3;
struct fact *theFact;
FILE *filePtr;
struct defmodule *theModule;
DATA_OBJECT_PTR theDOArray;
int count, i, printFact, error;
/*======================================================*/
/* Open the file. Use either "fast save" or I/O Router. */
/*======================================================*/
if ((filePtr = GenOpen(theEnv,fileName,(char*)"w")) == NULL)
{
OpenErrorMessage(theEnv,(char*)"save-facts",fileName);
return(FALSE);
}
SetFastSave(theEnv,filePtr);
/*===========================================*/
/* Set the print flags so that addresses and */
/* strings are printed properly to the file. */
/*===========================================*/
tempValue1 = PrintUtilityData(theEnv)->PreserveEscapedCharacters;
PrintUtilityData(theEnv)->PreserveEscapedCharacters = TRUE;
tempValue2 = PrintUtilityData(theEnv)->AddressesToStrings;
PrintUtilityData(theEnv)->AddressesToStrings = TRUE;
tempValue3 = PrintUtilityData(theEnv)->InstanceAddressesToNames;
PrintUtilityData(theEnv)->InstanceAddressesToNames = TRUE;
/*===================================================*/
/* Determine the list of specific facts to be saved. */
/*===================================================*/
theDOArray = GetSaveFactsDeftemplateNames(theEnv,theList,saveCode,&count,&error);
if (error)
{
PrintUtilityData(theEnv)->PreserveEscapedCharacters = tempValue1;
PrintUtilityData(theEnv)->AddressesToStrings = tempValue2;
PrintUtilityData(theEnv)->InstanceAddressesToNames = tempValue3;
GenClose(theEnv,filePtr);
SetFastSave(theEnv,NULL);
return(FALSE);
}
/*=================*/
/* Save the facts. */
/*=================*/
theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
for (theFact = (struct fact *) GetNextFactInScope(theEnv,NULL);
theFact != NULL;
theFact = (struct fact *) GetNextFactInScope(theEnv,theFact))
{
/*===========================================================*/
/* If we're doing a local save and the facts's corresponding */
/* deftemplate isn't in the current module, then don't save */
/* the fact. */
/*===========================================================*/
if ((saveCode == LOCAL_SAVE) &&
(theFact->whichDeftemplate->header.whichModule->theModule != theModule))
{ printFact = FALSE; }
/*=====================================================*/
/* Otherwise, if the list of facts to be printed isn't */
/* restricted, then set the print flag to TRUE. */
/*=====================================================*/
else if (theList == NULL)
{ printFact = TRUE; }
/*=======================================================*/
/* Otherwise see if the fact's corresponding deftemplate */
/* is in the list of deftemplates whose facts are to be */
/* saved. If it's in the list, then set the print flag */
/* to TRUE, otherwise set it to FALSE. */
/*=======================================================*/
else
{
printFact = FALSE;
for (i = 0; i < count; i++)
{
if (theDOArray[i].value == (void *) theFact->whichDeftemplate)
{
printFact = TRUE;
break;
}
}
}
/*===================================*/
/* If the print flag is set to TRUE, */
/* then save the fact to the file. */
/*===================================*/
if (printFact)
{
PrintFact(theEnv,(char *) filePtr,theFact,FALSE,FALSE);
EnvPrintRouter(theEnv,(char *) filePtr,(char*)"\n");
}
}
/*==========================*/
/* Restore the print flags. */
/*==========================*/
PrintUtilityData(theEnv)->PreserveEscapedCharacters = tempValue1;
PrintUtilityData(theEnv)->AddressesToStrings = tempValue2;
PrintUtilityData(theEnv)->InstanceAddressesToNames = tempValue3;
/*=================*/
/* Close the file. */
/*=================*/
GenClose(theEnv,filePtr);
SetFastSave(theEnv,NULL);
/*==================================*/
/* Free the deftemplate name array. */
/*==================================*/
if (theList != NULL) rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * count);
/*===================================*/
/* Return TRUE to indicate no errors */
/* occurred while saving the facts. */
/*===================================*/
return(TRUE);
}
static DATA_OBJECT_PTR GetSaveFactsDeftemplateNames(
void *theEnv,
struct expr *theList,
int saveCode,
int *count,
int *error)
{
struct expr *tempList;
DATA_OBJECT_PTR theDOArray;
int i, tempCount;
struct deftemplate *theDeftemplate = NULL;
/*=============================*/
/* Initialize the error state. */
/*=============================*/
*error = FALSE;
/*=====================================================*/
/* If no deftemplate names were specified as arguments */
/* then the deftemplate name list is empty. */
/*=====================================================*/
if (theList == NULL)
{
*count = 0;
return(NULL);
}
/*======================================*/
/* Determine the number of deftemplate */
/* names to be stored in the name list. */
/*======================================*/
for (tempList = theList, *count = 0;
tempList != NULL;
tempList = tempList->nextArg, (*count)++)
{ /* Do Nothing */ }
/*=========================================*/
/* Allocate the storage for the name list. */
/*=========================================*/
theDOArray = (DATA_OBJECT_PTR) gm3(theEnv,(long) sizeof(DATA_OBJECT) * *count);
/*=====================================*/
/* Loop through each of the arguments. */
/*=====================================*/
for (tempList = theList, i = 0;
i < *count;
tempList = tempList->nextArg, i++)
{
/*========================*/
/* Evaluate the argument. */
/*========================*/
EvaluateExpression(theEnv,tempList,&theDOArray[i]);
if (EvaluationData(theEnv)->EvaluationError)
{
*error = TRUE;
rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count);
return(NULL);
}
/*======================================*/
/* A deftemplate name must be a symbol. */
/*======================================*/
if (theDOArray[i].type != SYMBOL)
{
*error = TRUE;
ExpectedTypeError1(theEnv,(char*)"save-facts",3+i,(char*)"symbol");
rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count);
return(NULL);
}
/*===================================================*/
/* Find the deftemplate. For a local save, look only */
/* in the current module. For a visible save, look */
/* in all visible modules. */
/*===================================================*/
if (saveCode == LOCAL_SAVE)
{
theDeftemplate = (struct deftemplate *)
EnvFindDeftemplate(theEnv,ValueToString(theDOArray[i].value));
if (theDeftemplate == NULL)
{
*error = TRUE;
ExpectedTypeError1(theEnv,(char*)"save-facts",3+i,(char*)"local deftemplate name");
rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count);
return(NULL);
}
}
else if (saveCode == VISIBLE_SAVE)
{
theDeftemplate = (struct deftemplate *)
FindImportedConstruct(theEnv,(char*)"deftemplate",NULL,
ValueToString(theDOArray[i].value),
&tempCount,TRUE,NULL);
if (theDeftemplate == NULL)
{
*error = TRUE;
ExpectedTypeError1(theEnv,(char*)"save-facts",3+i,(char*)"visible deftemplate name");
rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count);
return(NULL);
}
}
/*==================================*/
/* Add a pointer to the deftemplate */
/* to the array being created. */
/*==================================*/
theDOArray[i].type = DEFTEMPLATE_PTR;
theDOArray[i].value = (void *) theDeftemplate;
}
/*===================================*/
/* Return the array of deftemplates. */
/*===================================*/
return(theDOArray);
}
globle void StoreInMultifield(
void *theEnv,
DATA_OBJECT *returnValue,
EXPRESSION *expptr,
int garbageSegment)
{
DATA_OBJECT val_ptr;
DATA_OBJECT *val_arr;
struct multifield *theMultifield;
struct multifield *orig_ptr;
long start, end, i,j, k, argCount;
unsigned long seg_size;
argCount = CountArguments(expptr);
/*=========================================*/
/* If no arguments are given return a NULL */
/* multifield of length zero. */
/*=========================================*/
if (argCount == 0)
{
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,0);
if (garbageSegment) theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L);
else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L);
SetpValue(returnValue,(void *) theMultifield);
return;
}
else
{
/*========================================*/
/* Get a new segment with length equal to */
/* the total length of all the arguments. */
/*========================================*/
val_arr = (DATA_OBJECT *) gm3(theEnv,(long) sizeof(DATA_OBJECT) * argCount);
seg_size = 0;
for (i = 1; i <= argCount; i++, expptr = expptr->nextArg)
{
EvaluateExpression(theEnv,expptr,&val_ptr);
if (EvaluationData(theEnv)->EvaluationError)
{
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,0);
if (garbageSegment)
{ theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L); }
else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L);
SetpValue(returnValue,(void *) theMultifield);
rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount);
return;
}
SetpType(val_arr+i-1,GetType(val_ptr));
if (GetType(val_ptr) == MULTIFIELD)
{
SetpValue(val_arr+i-1,GetpValue(&val_ptr));
start = GetDOBegin(val_ptr);
end = GetDOEnd(val_ptr);
}
else if (GetType(val_ptr) == RVOID)
{
SetpValue(val_arr+i-1,GetValue(val_ptr));
start = 1;
end = 0;
}
else
{
SetpValue(val_arr+i-1,GetValue(val_ptr));
start = end = -1;
}
seg_size += (unsigned long) (end - start + 1);
SetpDOBegin(val_arr+i-1,start);
SetpDOEnd(val_arr+i-1,end);
}
if (garbageSegment)
{ theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,seg_size); }
else theMultifield = (struct multifield *) CreateMultifield2(theEnv,seg_size);
/*========================================*/
/* Copy each argument into new segment. */
/*========================================*/
for (k = 0, j = 1; k < argCount; k++)
{
if (GetpType(val_arr+k) == MULTIFIELD)
{
start = GetpDOBegin(val_arr+k);
end = GetpDOEnd(val_arr+k);
orig_ptr = (struct multifield *) GetpValue(val_arr+k);
for (i = start; i < end + 1; i++, j++)
{
SetMFType(theMultifield,j,(GetMFType(orig_ptr,i)));
SetMFValue(theMultifield,j,(GetMFValue(orig_ptr,i)));
}
}
else if (GetpType(val_arr+k) != RVOID)
{
SetMFType(theMultifield,j,(short) (GetpType(val_arr+k)));
SetMFValue(theMultifield,j,(GetpValue(val_arr+k)));
j++;
}
}
/*=========================*/
/* Return the new segment. */
/*=========================*/
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,(long) seg_size);
SetpValue(returnValue,(void *) theMultifield);
rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount);
return;
}
}