static struct expr *GenPNConstant(
void *theEnv,
struct lhsParseNode *theField)
{
struct expr *top;
/*===============================================*/
/* If the pattern parser is capable of creating */
/* a specialized test, then call the function to */
/* generate the pattern network test and return */
/* the expression generated. */
/*===============================================*/
if (theField->patternType->genPNConstantFunction != NULL)
{ return (*theField->patternType->genPNConstantFunction)(theEnv,theField); }
/*===================================================*/
/* Otherwise, generate a test which uses the eq/neq */
/* function to compare the pattern field/slot to the */
/* constant and then return the expression. */
/*===================================================*/
if (theField->negated)
{ top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); }
else
{ top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); }
top->argList = (*theField->patternType->genGetPNValueFunction)(theEnv,theField);
top->argList->nextArg = GenConstant(theEnv,theField->type,theField->value);
return(top);
}
/******************************************************
NAME : BsaveMethodRestrictions
DESCRIPTION : Bsaves defgeneric methods' retrictions
INPUTS : 1) The defgeneric
2) Output data file pointer
RETURNS : Nothing useful
SIDE EFFECTS : Defgeneric methods' restrictions saved
NOTES : None
******************************************************/
static void BsaveMethodRestrictions(
void *theEnv,
struct constructHeader *theDefgeneric,
void *userBuffer)
{
DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric;
BSAVE_RESTRICTION dummy_restriction;
RESTRICTION *rptr;
short i,j;
for (i = 0 ; i < gfunc->mcnt ; i++)
{
for (j = 0 ; j < gfunc->methods[i].restrictionCount ; j++)
{
rptr = &gfunc->methods[i].restrictions[j];
dummy_restriction.tcnt = rptr->tcnt;
if (rptr->types != NULL)
{
dummy_restriction.types = DefgenericBinaryData(theEnv)->TypeCount;
DefgenericBinaryData(theEnv)->TypeCount += rptr->tcnt;
}
else
dummy_restriction.types = -1L;
if (rptr->query != NULL)
{
dummy_restriction.query = ExpressionData(theEnv)->ExpressionCount;
ExpressionData(theEnv)->ExpressionCount += ExpressionSize(rptr->query);
}
else
dummy_restriction.query = -1L;
GenWrite((void *) &dummy_restriction,
sizeof(BSAVE_RESTRICTION),(FILE *) userBuffer);
}
}
}
static void MarkDefgenericItems(
void *theEnv,
struct constructHeader *theDefgeneric,
void *userBuffer)
{
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(userBuffer)
#endif
DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric;
long i,j;
DEFMETHOD *meth;
RESTRICTION *rptr;
MarkConstructHeaderNeededItems(&gfunc->header,DefgenericBinaryData(theEnv)->GenericCount++);
DefgenericBinaryData(theEnv)->MethodCount += (long) gfunc->mcnt;
for (i = 0 ; i < gfunc->mcnt ; i++)
{
meth = &gfunc->methods[i];
ExpressionData(theEnv)->ExpressionCount += ExpressionSize(meth->actions);
MarkNeededItems(theEnv,meth->actions);
DefgenericBinaryData(theEnv)->RestrictionCount += meth->restrictionCount;
for (j = 0 ; j < meth->restrictionCount ; j++)
{
rptr = &meth->restrictions[j];
ExpressionData(theEnv)->ExpressionCount += ExpressionSize(rptr->query);
MarkNeededItems(theEnv,rptr->query);
DefgenericBinaryData(theEnv)->TypeCount += rptr->tcnt;
}
}
}
static struct expr *GenPNEq(
void *theEnv,
struct lhsParseNode *theField)
{
struct expr *top, *conversion;
/*==================================================*/
/* Replace variables with function calls to extract */
/* the appropriate value from the data entity. */
/*==================================================*/
conversion = GetfieldReplace(theEnv,theField->expression);
/*============================================================*/
/* If the return value constraint is negated by a ~, then use */
/* the neq function to compare the value of the field to the */
/* value returned by the function call. Otherwise, use eq to */
/* compare the two values. */
/*============================================================*/
if (theField->negated)
{ top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NEQ); }
else
{ top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_EQ); }
top->argList = (*theField->patternType->genGetPNValueFunction)(theEnv,theField);
top->argList->nextArg = conversion;
return(top);
}
void RefreshExpressions(
Environment *theEnv)
{
if (ExpressionData(theEnv)->ExpressionArray == NULL) return;
BloadandRefresh(theEnv,ExpressionData(theEnv)->NumberOfExpressions,
sizeof(BSAVE_EXPRESSION),UpdateExpression);
}
globle intBool EnvSetSequenceOperatorRecognition(
void *theEnv,
int value)
{
int ov;
ov = ExpressionData(theEnv)->SequenceOpMode;
ExpressionData(theEnv)->SequenceOpMode = value;
return(ov);
}
globle int ParseConstruct(
void *theEnv,
char *name,
char *logicalName)
{
struct construct *currentPtr;
int rv, ov;
/*=================================*/
/* Look for a valid construct name */
/* (e.g. defrule, deffacts). */
/*=================================*/
currentPtr = FindConstruct(theEnv,name);
if (currentPtr == NULL) return(-1);
/*==================================*/
/* Prepare the parsing environment. */
/*==================================*/
ov = GetHaltExecution(theEnv);
SetEvaluationError(theEnv,FALSE);
SetHaltExecution(theEnv,FALSE);
ClearParsedBindNames(theEnv);
PushRtnBrkContexts(theEnv);
ExpressionData(theEnv)->ReturnContext = FALSE;
ExpressionData(theEnv)->BreakContext = FALSE;
EvaluationData(theEnv)->CurrentEvaluationDepth++;
/*=======================================*/
/* Call the construct's parsing routine. */
/*=======================================*/
ConstructData(theEnv)->ParsingConstruct = TRUE;
rv = (*currentPtr->parseFunction)(theEnv,logicalName);
ConstructData(theEnv)->ParsingConstruct = FALSE;
/*===============================*/
/* Restore environment settings. */
/*===============================*/
EvaluationData(theEnv)->CurrentEvaluationDepth--;
PopRtnBrkContexts(theEnv);
ClearParsedBindNames(theEnv);
SetPPBufferStatus(theEnv,OFF);
SetHaltExecution(theEnv,ov);
/*==============================*/
/* Return the status of parsing */
/* the construct. */
/*==============================*/
return(rv);
}
globle void PushRtnBrkContexts(
void *theEnv)
{
SAVED_CONTEXTS *svtmp;
svtmp = get_struct(theEnv,saved_contexts);
svtmp->rtn = ExpressionData(theEnv)->ReturnContext;
svtmp->brk = ExpressionData(theEnv)->BreakContext;
svtmp->nxt = ExpressionData(theEnv)->svContexts;
ExpressionData(theEnv)->svContexts = svtmp;
}
/****************************************************************
NAME : SetSORCommand
DESCRIPTION : Toggles SequenceOpMode - if TRUE, multifield
references are replaced with sequence
expansion operators
INPUTS : None
RETURNS : The old value of SequenceOpMode
SIDE EFFECTS : SequenceOpMode toggled
NOTES : None
****************************************************************/
globle BOOLEAN SetSORCommand(
void *theEnv)
{
#if (! RUN_TIME) && (! BLOAD_ONLY)
DATA_OBJECT arg;
if (EnvArgTypeCheck(theEnv,"set-sequence-operator-recognition",1,SYMBOL,&arg) == FALSE)
return(ExpressionData(theEnv)->SequenceOpMode);
return(EnvSetSequenceOperatorRecognition(theEnv,(arg.value == EnvFalseSymbol(theEnv)) ?
FALSE : TRUE));
#else
return(ExpressionData(theEnv)->SequenceOpMode);
#endif
}
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 : FindHashedExpressions
DESCRIPTION : Sets the bsave expression array
indices for hashed expression nodes
and marks the items needed by
these expressions
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Atoms marked and ids set
NOTES : None
***************************************************/
void FindHashedExpressions(
Environment *theEnv)
{
unsigned i;
EXPRESSION_HN *exphash;
for (i = 0 ; i < EXPRESSION_HASH_SIZE ; i++)
for (exphash = ExpressionData(theEnv)->ExpressionHashTable[i] ; exphash != NULL ; exphash = exphash->next)
{
MarkNeededItems(theEnv,exphash->exp);
exphash->bsaveID = ExpressionData(theEnv)->ExpressionCount;
ExpressionData(theEnv)->ExpressionCount += ExpressionSize(exphash->exp);
}
}
static struct expr *ReturnParse(
void *theEnv,
struct expr *top,
char *infile)
{
int error_flag = FALSE;
struct token theToken;
if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
ExpressionData(theEnv)->ReturnContext = TRUE;
if (ExpressionData(theEnv)->ReturnContext == FALSE)
{
PrintErrorID(theEnv,"PRCDRPSR",2,TRUE);
EnvPrintRouter(theEnv,WERROR,"The return function is not valid in this context.\n");
ReturnExpression(theEnv,top);
return(NULL);
}
ExpressionData(theEnv)->ReturnContext = FALSE;
SavePPBuffer(theEnv," ");
top->argList = ArgumentParse(theEnv,infile,&error_flag);
if (error_flag)
{
ReturnExpression(theEnv,top);
return(NULL);
}
else if (top->argList == NULL)
{
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,")");
}
else
{
SavePPBuffer(theEnv," ");
GetToken(theEnv,infile,&theToken);
if (theToken.type != RPAREN)
{
SyntaxErrorMessage(theEnv,"return function");
ReturnExpression(theEnv,top);
return(NULL);
}
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,")");
}
return(top);
}
static struct expr *BreakParse(
void *theEnv,
struct expr *top,
char *infile)
{
struct token theToken;
if (ExpressionData(theEnv)->svContexts->brk == FALSE)
{
PrintErrorID(theEnv,"PRCDRPSR",2,TRUE);
EnvPrintRouter(theEnv,WERROR,"The break function not valid in this context.\n");
ReturnExpression(theEnv,top);
return(NULL);
}
SavePPBuffer(theEnv," ");
GetToken(theEnv,infile,&theToken);
if (theToken.type != RPAREN)
{
SyntaxErrorMessage(theEnv,"break function");
ReturnExpression(theEnv,top);
return(NULL);
}
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,")");
return(top);
}
static struct expr *GenPNColon(
void *theEnv,
struct lhsParseNode *theField)
{
struct expr *top, *conversion;
/*==================================================*/
/* Replace variables with function calls to extract */
/* the appropriate value from the data entity. */
/*==================================================*/
conversion = GetfieldReplace(theEnv,theField->expression);
/*================================================*/
/* If the predicate constraint is negated by a ~, */
/* then wrap a "not" function call around the */
/* expression before returning it. Otherwise, */
/* just return the expression. */
/*================================================*/
if (theField->negated)
{
top = GenConstant(theEnv,FCALL,ExpressionData(theEnv)->PTR_NOT);
top->argList = conversion;
}
else
{ top = conversion; }
return(top);
}
/***********************************************************************
NAME : ReplaceSequenceExpansionOps
DESCRIPTION : Replaces function calls which have multifield
references as arguments into a call to a
special function which expands the multifield
into single arguments at run-time.
Multifield references which are not function
arguments are errors
INPUTS : 1) The expression
2) The current function call
3) The address of the internal H/L function
(expansion-call)
4) The address of the H/L function expand$
RETURNS : FALSE if OK, TRUE on errors
SIDE EFFECTS : Function call expressions modified, if necessary
NOTES : Function calls which truly want a multifield
to be passed need use only a single-field
refernce (i.e. ? instead of $? - the $ is
being treated as a special expansion operator)
**********************************************************************/
globle intBool ReplaceSequenceExpansionOps(
void *theEnv,
EXPRESSION *actions,
EXPRESSION *fcallexp,
void *expcall,
void *expmult)
{
EXPRESSION *theExp;
while (actions != NULL)
{
if ((ExpressionData(theEnv)->SequenceOpMode == FALSE) && (actions->type == MF_VARIABLE))
actions->type = SF_VARIABLE;
if ((actions->type == MF_VARIABLE) || (actions->type == MF_GBL_VARIABLE) ||
(actions->value == expmult))
{
if ((fcallexp->type != FCALL) ? FALSE :
(((struct FunctionDefinition *) fcallexp->value)->sequenceuseok == FALSE))
{
PrintErrorID(theEnv,"EXPRNPSR",4,FALSE);
EnvPrintRouter(theEnv,WERROR,"$ Sequence operator not a valid argument for ");
EnvPrintRouter(theEnv,WERROR,ValueToString(((struct FunctionDefinition *)
fcallexp->value)->callFunctionName));
EnvPrintRouter(theEnv,WERROR,".\n");
return(TRUE);
}
if (fcallexp->value != expcall)
{
theExp = GenConstant(theEnv,fcallexp->type,fcallexp->value);
theExp->argList = fcallexp->argList;
theExp->nextArg = NULL;
fcallexp->type = FCALL;
fcallexp->value = expcall;
fcallexp->argList = theExp;
}
if (actions->value != expmult)
{
theExp = GenConstant(theEnv,SF_VARIABLE,actions->value);
if (actions->type == MF_GBL_VARIABLE)
theExp->type = GBL_VARIABLE;
actions->argList = theExp;
actions->type = FCALL;
actions->value = expmult;
}
}
if (actions->argList != NULL)
{
if ((actions->type == GCALL) ||
(actions->type == PCALL) ||
(actions->type == FCALL))
theExp = actions;
else
theExp = fcallexp;
if (ReplaceSequenceExpansionOps(theEnv,actions->argList,theExp,expcall,expmult))
return(TRUE);
}
actions = actions->nextArg;
}
return(FALSE);
}
static struct expr *GenJNVariableComparison(
void *theEnv,
EXEC_STATUS,
struct lhsParseNode *selfNode,
struct lhsParseNode *referringNode,
int isNand)
{
struct expr *top;
/*========================================================*/
/* If either pattern is missing a function for generating */
/* the appropriate test, then no test is generated. */
/*========================================================*/
if ((selfNode->patternType->genCompareJNValuesFunction == NULL) ||
(referringNode->patternType->genCompareJNValuesFunction == NULL))
{ return(NULL); }
/*=====================================================*/
/* If both patterns are of the same type, then use the */
/* special function for generating the join test. */
/*=====================================================*/
if (selfNode->patternType->genCompareJNValuesFunction ==
referringNode->patternType->genCompareJNValuesFunction)
{
return (*selfNode->patternType->genCompareJNValuesFunction)(theEnv,execStatus,selfNode,
referringNode,isNand);
}
/*===========================================================*/
/* If the patterns are of different types, then generate a */
/* join test by using the eq/neq function with its arguments */
/* being function calls to retrieve the appropriate values */
/* from the patterns. */
/*===========================================================*/
if (selfNode->negated) top = GenConstant(theEnv,execStatus,FCALL,ExpressionData(theEnv,execStatus)->PTR_NEQ);
else top = GenConstant(theEnv,execStatus,FCALL,ExpressionData(theEnv,execStatus)->PTR_EQ);
top->argList = (*selfNode->patternType->genGetJNValueFunction)(theEnv,execStatus,selfNode,RHS);
top->argList->nextArg = (*referringNode->patternType->genGetJNValueFunction)(theEnv,execStatus,referringNode,LHS);
return(top);
}
/***************************************************
NAME : BsaveDefinstances
DESCRIPTION : Bsaves a definstances
INPUTS : 1) The definstances
2) Output data file pointer
RETURNS : Nothing useful
SIDE EFFECTS : Definstances saved
NOTES : None
***************************************************/
static void BsaveDefinstances(
void *theEnv,
struct constructHeader *theDefinstances,
void *userBuffer)
{
DEFINSTANCES *dptr = (DEFINSTANCES *) theDefinstances;
BSAVE_DEFINSTANCES dummy_df;
AssignBsaveConstructHeaderVals(&dummy_df.header,&dptr->header);
if (dptr->mkinstance != NULL)
{
dummy_df.mkinstance = ExpressionData(theEnv)->ExpressionCount;
ExpressionData(theEnv)->ExpressionCount += ExpressionSize(dptr->mkinstance);
}
else
dummy_df.mkinstance = -1L;
GenWrite((void *) &dummy_df,(unsigned long) sizeof(BSAVE_DEFINSTANCES),(FILE *) userBuffer);
}
globle void InitExpressionData(
void *theEnv)
{
#if ! RUN_TIME
register unsigned i;
#endif
AllocateEnvironmentData(theEnv,EXPRESSION_DATA,sizeof(struct expressionData),DeallocateExpressionData);
#if ! RUN_TIME
InitExpressionPointers(theEnv);
ExpressionData(theEnv)->ExpressionHashTable = (EXPRESSION_HN **)
gm2(theEnv,(int) (sizeof(EXPRESSION_HN *) * EXPRESSION_HASH_SIZE));
for (i = 0 ; i < EXPRESSION_HASH_SIZE ; i++)
ExpressionData(theEnv)->ExpressionHashTable[i] = NULL;
#endif
}
globle void InitExpressionPointers(
void *theEnv)
{
ExpressionData(theEnv)->PTR_AND = (void *) FindFunction(theEnv,(char*)"and");
ExpressionData(theEnv)->PTR_OR = (void *) FindFunction(theEnv,(char*)"or");
ExpressionData(theEnv)->PTR_EQ = (void *) FindFunction(theEnv,(char*)"eq");
ExpressionData(theEnv)->PTR_NEQ = (void *) FindFunction(theEnv,(char*)"neq");
ExpressionData(theEnv)->PTR_NOT = (void *) FindFunction(theEnv,(char*)"not");
if ((ExpressionData(theEnv)->PTR_AND == NULL) || (ExpressionData(theEnv)->PTR_OR == NULL) ||
(ExpressionData(theEnv)->PTR_EQ == NULL) || (ExpressionData(theEnv)->PTR_NEQ == NULL) || (ExpressionData(theEnv)->PTR_NOT == NULL))
{
SystemError(theEnv,(char*)"EXPRESSN",1);
EnvExitRouter(theEnv,EXIT_FAILURE);
}
}
/***************************************************
NAME : BsaveHashedExpressions
DESCRIPTION : Writes out hashed expressions
INPUTS : Bsave file stream pointer
RETURNS : Nothing useful
SIDE EFFECTS : Expressions written
NOTES : None
***************************************************/
void BsaveHashedExpressions(
Environment *theEnv,
FILE *fp)
{
unsigned i;
EXPRESSION_HN *exphash;
for (i = 0 ; i < EXPRESSION_HASH_SIZE ; i++)
for (exphash = ExpressionData(theEnv)->ExpressionHashTable[i] ; exphash != NULL ; exphash = exphash->next)
BsaveExpression(theEnv,exphash->exp,fp);
}
static struct expr *PrognParse(
void *theEnv,
struct expr *top,
char *infile)
{
struct token tkn;
struct expr *tmp;
ReturnExpression(theEnv,top);
ExpressionData(theEnv)->BreakContext = ExpressionData(theEnv)->svContexts->brk;
ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn;
IncrementIndentDepth(theEnv,3);
PPCRAndIndent(theEnv);
tmp = GroupActions(theEnv,infile,&tkn,TRUE,NULL,FALSE);
DecrementIndentDepth(theEnv,3);
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,tkn.printForm);
return(tmp);
}
/***************************************************
NAME : BsaveDeffunction
DESCRIPTION : Bsaves a deffunction
INPUTS : 1) The deffunction
2) Output data file pointer
RETURNS : Nothing useful
SIDE EFFECTS : Deffunction saved
NOTES : None
***************************************************/
static void BsaveDeffunction(
void *theEnv,
struct constructHeader *theDeffunction,
void *userBuffer)
{
DEFFUNCTION *dptr = (DEFFUNCTION *) theDeffunction;
BSAVE_DEFFUNCTION dummy_df;
AssignBsaveConstructHeaderVals(&dummy_df.header,&dptr->header);
dummy_df.minNumberOfParameters = dptr->minNumberOfParameters;
dummy_df.maxNumberOfParameters = dptr->maxNumberOfParameters;
dummy_df.numberOfLocalVars = dptr->numberOfLocalVars;
if (dptr->code != NULL)
{
dummy_df.code = ExpressionData(theEnv)->ExpressionCount;
ExpressionData(theEnv)->ExpressionCount += ExpressionSize(dptr->code);
}
else
dummy_df.code = -1L;
GenWrite((void *) &dummy_df,sizeof(BSAVE_DEFFUNCTION),(FILE *) userBuffer);
}
static void DeallocateExpressionData(
void *theEnv)
{
#if ! RUN_TIME
int i;
EXPRESSION_HN *tmpPtr, *nextPtr;
#if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE)
if (! Bloaded(theEnv))
#endif
{
for (i = 0; i < EXPRESSION_HASH_SIZE; i++)
{
tmpPtr = ExpressionData(theEnv)->ExpressionHashTable[i];
while (tmpPtr != NULL)
{
nextPtr = tmpPtr->next;
ReturnPackedExpression(theEnv,tmpPtr->exp);
rtn_struct(theEnv,exprHashNode,tmpPtr);
tmpPtr = nextPtr;
}
}
}
rm(theEnv,ExpressionData(theEnv)->ExpressionHashTable,
(int) (sizeof(EXPRESSION_HN *) * EXPRESSION_HASH_SIZE));
#else
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(theEnv)
#endif
#endif
#if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE)
if ((ExpressionData(theEnv)->NumberOfExpressions != 0) && Bloaded(theEnv))
{
genfree(theEnv,(void *) ExpressionData(theEnv)->ExpressionArray,
ExpressionData(theEnv)->NumberOfExpressions * sizeof(struct expr));
}
#endif
}
static struct expr *GenJNEq(
void *theEnv,
EXEC_STATUS,
struct lhsParseNode *theField,
int isNand)
{
struct expr *top, *conversion;
/*==================================================*/
/* Replace variables with function calls to extract */
/* the appropriate value from the data entity. */
/*==================================================*/
if (isNand)
{ conversion = GetvarReplace(theEnv,execStatus,theField->expression,TRUE); }
else
{ conversion = GetvarReplace(theEnv,execStatus,theField->expression,FALSE); }
/*============================================================*/
/* If the return value constraint is negated by a ~, then use */
/* the neq function to compare the value of the field to the */
/* value returned by the function call. Otherwise, use eq to */
/* compare the two values. */
/*============================================================*/
if (theField->negated)
{ top = GenConstant(theEnv,execStatus,FCALL,ExpressionData(theEnv,execStatus)->PTR_NEQ); }
else
{ top = GenConstant(theEnv,execStatus,FCALL,ExpressionData(theEnv,execStatus)->PTR_EQ); }
if (isNand)
{ top->argList = (*theField->patternType->genGetJNValueFunction)(theEnv,execStatus,theField,NESTED_RHS); }
else
{ top->argList = (*theField->patternType->genGetJNValueFunction)(theEnv,execStatus,theField,RHS); }
top->argList->nextArg = conversion;
return(top);
}
/***************************************************
NAME : MarkDeffunctionItems
DESCRIPTION : Marks the needed items for
a deffunction bsave
INPUTS : 1) The deffunction
2) User data buffer (ignored)
RETURNS : Nothing useful
SIDE EFFECTS : Needed items marked
NOTES : None
***************************************************/
static void MarkDeffunctionItems(
void *theEnv,
struct constructHeader *theDeffunction,
void *userBuffer)
{
#if MAC_XCD
#pragma unused(userBuffer)
#endif
MarkConstructHeaderNeededItems(theDeffunction,DeffunctionBinaryData(theEnv)->DeffunctionCount++);
ExpressionData(theEnv)->ExpressionCount += ExpressionSize(((DEFFUNCTION *) theDeffunction)->code);
MarkNeededItems(theEnv,((DEFFUNCTION *) theDeffunction)->code);
}
globle void PopRtnBrkContexts(
void *theEnv)
{
SAVED_CONTEXTS *svtmp;
ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn;
ExpressionData(theEnv)->BreakContext = ExpressionData(theEnv)->svContexts->brk;
svtmp = ExpressionData(theEnv)->svContexts;
ExpressionData(theEnv)->svContexts = ExpressionData(theEnv)->svContexts->nxt;
rtn_struct(theEnv,saved_contexts,svtmp);
}
static void MarkDefinstancesItems(
void *theEnv,
struct constructHeader *theDefinstances,
void *userBuffer)
{
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(userBuffer)
#endif
MarkConstructHeaderNeededItems(theDefinstances,DefinstancesBinaryData(theEnv)->DefinstancesCount++);
ExpressionData(theEnv)->ExpressionCount += ExpressionSize(((DEFINSTANCES *) theDefinstances)->mkinstance);
MarkNeededItems(theEnv,((DEFINSTANCES *) theDefinstances)->mkinstance);
}
static int ExpressionComplexity(
void *theEnv,
struct expr *exprPtr)
{
int complexity = 0;
while (exprPtr != NULL)
{
if (exprPtr->type == FCALL)
{
/*=========================================*/
/* Logical combinations do not add to the */
/* complexity, but their arguments do. */
/*=========================================*/
if ((exprPtr->value == ExpressionData(theEnv)->PTR_AND) ||
(exprPtr->value == ExpressionData(theEnv)->PTR_NOT) ||
(exprPtr->value == ExpressionData(theEnv)->PTR_OR))
{ complexity += ExpressionComplexity(theEnv,exprPtr->argList); }
/*=========================================*/
/* else other function calls increase the */
/* complexity, but their arguments do not. */
/*=========================================*/
else
{ complexity++; }
}
else if ((EvaluationData(theEnv)->PrimitivesArray[exprPtr->type] != NULL) ?
EvaluationData(theEnv)->PrimitivesArray[exprPtr->type]->addsToRuleComplexity : FALSE)
{ complexity++; }
exprPtr = exprPtr->nextArg;
}
return(complexity);
}
/***************************************************
NAME : BsaveMethods
DESCRIPTION : Bsaves defgeneric methods
INPUTS : 1) The defgeneric
2) Output data file pointer
RETURNS : Nothing useful
SIDE EFFECTS : Defgeneric methods saved
NOTES : None
***************************************************/
static void BsaveMethods(
void *theEnv,
struct constructHeader *theDefgeneric,
void *userBuffer)
{
DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric;
DEFMETHOD *meth;
BSAVE_METHOD dummy_method;
long i;
for (i = 0 ; i < gfunc->mcnt ; i++)
{
meth = &gfunc->methods[i];
dummy_method.index = meth->index;
dummy_method.restrictionCount = meth->restrictionCount;
dummy_method.minRestrictions = meth->minRestrictions;
dummy_method.maxRestrictions = meth->maxRestrictions;
dummy_method.localVarCount = meth->localVarCount;
dummy_method.system = meth->system;
if (meth->restrictions != NULL)
{
dummy_method.restrictions = DefgenericBinaryData(theEnv)->RestrictionCount;
DefgenericBinaryData(theEnv)->RestrictionCount += meth->restrictionCount;
}
else
dummy_method.restrictions = -1L;
if (meth->actions != NULL)
{
dummy_method.actions = ExpressionData(theEnv)->ExpressionCount;
ExpressionData(theEnv)->ExpressionCount += ExpressionSize(meth->actions);
}
else
dummy_method.actions = -1L;
GenWrite((void *) &dummy_method,sizeof(BSAVE_METHOD),(FILE *) userBuffer);
}
}
/*****************************************************
NAME : AddHashedExpression
DESCRIPTION : Adds a new expression to the
expression hash table (or increments
the use count if it is already there)
INPUTS : The (new) expression
RETURNS : A pointer to the (new) hash node
SIDE EFFECTS : Adds the new hash node or increments
the count of an existing one
NOTES : It is the caller's responsibility to
delete the passed expression. This
routine copies, packs and installs
the given expression
*****************************************************/
globle EXPRESSION *AddHashedExpression(
void *theEnv,
EXPRESSION *theExp)
{
EXPRESSION_HN *prv,*exphash;
unsigned hashval;
if (theExp == NULL) return(NULL);
exphash = FindHashedExpression(theEnv,theExp,&hashval,&prv);
if (exphash != NULL)
{
exphash->count++;
return(exphash->exp);
}
exphash = get_struct(theEnv,exprHashNode);
exphash->hashval = hashval;
exphash->count = 1;
exphash->exp = PackExpression(theEnv,theExp);
ExpressionInstall(theEnv,exphash->exp);
exphash->next = ExpressionData(theEnv)->ExpressionHashTable[exphash->hashval];
ExpressionData(theEnv)->ExpressionHashTable[exphash->hashval] = exphash;
exphash->bsaveID = 0L;
return(exphash->exp);
}