/***************************************************
NAME : RemoveAllDefinstances
DESCRIPTION : Removes all definstances constructs
INPUTS : None
RETURNS : TRUE if successful,
FALSE otherwise
SIDE EFFECTS : All definstances deallocated
NOTES : None
***************************************************/
static intBool RemoveAllDefinstances(
void *theEnv)
{
DEFINSTANCES *dptr,*dhead;
int success = TRUE;
#if BLOAD || BLOAD_AND_BSAVE
if (Bloaded(theEnv))
return(FALSE);
#endif
dhead = (DEFINSTANCES *) EnvGetNextDefinstances(theEnv,NULL);
while (dhead != NULL)
{
dptr = dhead;
dhead = (DEFINSTANCES *) EnvGetNextDefinstances(theEnv,(void *) dhead);
if (EnvIsDefinstancesDeletable(theEnv,(void *) dptr))
{
RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr);
RemoveDefinstances(theEnv,(void *) dptr);
}
else
{
DefinstancesDeleteError(theEnv,EnvGetDefinstancesName(theEnv,(void *) dptr));
success = FALSE;
}
}
return(success);
}
/****************************************************************
NAME : ClearDefgenerics
DESCRIPTION : Deletes all generic headers
INPUTS : None
RETURNS : TRUE if all methods deleted, FALSE otherwise
SIDE EFFECTS : Generic headers deleted (and any implicit system
function methods)
NOTES : None
****************************************************************/
globle int ClearDefgenerics(
void *theEnv)
{
register DEFGENERIC *gfunc,*gtmp;
int success = TRUE;
#if BLOAD || BLOAD_AND_BSAVE
if (Bloaded(theEnv) == TRUE) return(FALSE);
#endif
gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL);
while (gfunc != NULL)
{
gtmp = gfunc;
gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc);
if (RemoveAllExplicitMethods(theEnv,gtmp) == FALSE)
{
CantDeleteItemErrorMessage(theEnv,(char*)"generic function",EnvGetDefgenericName(theEnv,gtmp));
success = FALSE;
}
else
{
RemoveConstructFromModule(theEnv,(struct constructHeader *) gtmp);
RemoveDefgeneric(theEnv,(void *) gtmp);
}
}
return(success);
}
/***********************************************************
NAME : EnvUndefinstances
DESCRIPTION : Removes a definstance
INPUTS : Address of definstances to remove
RETURNS : TRUE if successful,
FALSE otherwise
SIDE EFFECTS : Definstance deallocated
NOTES : None
***********************************************************/
globle intBool EnvUndefinstances(
void *theEnv,
void *vptr)
{
#if RUN_TIME || BLOAD_ONLY
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(theEnv,vptr)
#endif
return(FALSE);
#else
DEFINSTANCES *dptr;
dptr = (DEFINSTANCES *) vptr;
#if BLOAD || BLOAD_AND_BSAVE
if (Bloaded(theEnv))
return(FALSE);
#endif
if (dptr == NULL)
return(RemoveAllDefinstances(theEnv));
if (EnvIsDefinstancesDeletable(theEnv,vptr) == FALSE)
return(FALSE);
RemoveConstructFromModule(theEnv,(struct constructHeader *) vptr);
RemoveDefinstances(theEnv,(void *) dptr);
return(TRUE);
#endif
}
/***************************************************
NAME : EnvUndeffunction
DESCRIPTION : External interface routine for
removing a deffunction
INPUTS : Deffunction pointer
RETURNS : FALSE if unsuccessful,
TRUE otherwise
SIDE EFFECTS : Deffunction deleted, if possible
NOTES : None
***************************************************/
globle intBool EnvUndeffunction(
void *theEnv,
EXEC_STATUS,
void *vptr)
{
#if (MAC_MCW || WIN_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theEnv,execStatus,vptr)
#endif
#if BLOAD_ONLY || RUN_TIME
return(FALSE);
#else
#if BLOAD || BLOAD_AND_BSAVE
if (Bloaded(theEnv,execStatus) == TRUE)
return(FALSE);
#endif
if (vptr == NULL)
return(RemoveAllDeffunctions(theEnv,execStatus));
if (EnvIsDeffunctionDeletable(theEnv,execStatus,vptr) == FALSE)
return(FALSE);
RemoveConstructFromModule(theEnv,execStatus,(struct constructHeader *) vptr);
RemoveDeffunction(theEnv,execStatus,vptr);
return(TRUE);
#endif
}
/***************************************************
NAME : RemoveAllDeffunctions
DESCRIPTION : Removes all deffunctions
INPUTS : None
RETURNS : TRUE if all deffunctions
removed, FALSE otherwise
SIDE EFFECTS : Deffunctions removed
NOTES : None
***************************************************/
static intBool RemoveAllDeffunctions(
void *theEnv,
EXEC_STATUS)
{
DEFFUNCTION *dptr,*dtmp;
unsigned oldbusy;
intBool success = TRUE;
#if BLOAD || BLOAD_AND_BSAVE
if (Bloaded(theEnv,execStatus) == TRUE)
return(FALSE);
#endif
dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,NULL);
while (dptr != NULL)
{
if (dptr->executing > 0)
{
DeffunctionDeleteError(theEnv,execStatus,EnvGetDeffunctionName(theEnv,execStatus,(void *) dptr));
success = FALSE;
}
else
{
oldbusy = dptr->busy;
ExpressionDeinstall(theEnv,execStatus,dptr->code);
dptr->busy = oldbusy;
ReturnPackedExpression(theEnv,execStatus,dptr->code);
dptr->code = NULL;
}
dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,(void *) dptr);
}
dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,NULL);
while (dptr != NULL)
{
dtmp = dptr;
dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,(void *) dptr);
if (dtmp->executing == 0)
{
if (dtmp->busy > 0)
{
PrintWarningID(theEnv,execStatus,"DFFNXFUN",1,FALSE);
EnvPrintRouter(theEnv,execStatus,WWARNING,"Deffunction ");
EnvPrintRouter(theEnv,execStatus,WWARNING,EnvGetDeffunctionName(theEnv,execStatus,(void *) dtmp));
EnvPrintRouter(theEnv,execStatus,WWARNING," only partially deleted due to usage by other constructs.\n");
SetDeffunctionPPForm((void *) dtmp,NULL);
success = FALSE;
}
else
{
RemoveConstructFromModule(theEnv,execStatus,(struct constructHeader *) dtmp);
RemoveDeffunction(theEnv,execStatus,dtmp);
}
}
}
return(success);
}
/***************************************************
NAME : EnvUndeffunction
DESCRIPTION : External interface routine for
removing a deffunction
INPUTS : Deffunction pointer
RETURNS : FALSE if unsuccessful,
TRUE otherwise
SIDE EFFECTS : Deffunction deleted, if possible
NOTES : None
***************************************************/
globle intBool EnvUndeffunction(
void *theEnv,
void *vptr)
{
#if BLOAD_ONLY || RUN_TIME
return(FALSE);
#else
#if BLOAD || BLOAD_AND_BSAVE
if (Bloaded(theEnv) == TRUE)
return(FALSE);
#endif
if (vptr == NULL)
return(RemoveAllDeffunctions(theEnv));
if (EnvIsDeffunctionDeletable(theEnv,vptr) == FALSE)
return(FALSE);
RemoveConstructFromModule(theEnv,(struct constructHeader *) vptr);
RemoveDeffunction(theEnv,vptr);
return(TRUE);
#endif
}
/***************************************************************************
NAME : ParseDeffunction
DESCRIPTION : Parses the deffunction construct
INPUTS : The input logical name
RETURNS : FALSE if successful parse, TRUE otherwise
SIDE EFFECTS : Creates valid deffunction definition
NOTES : H/L Syntax :
(deffunction <name> [<comment>]
(<single-field-varible>* [<multifield-variable>])
<action>*)
***************************************************************************/
globle BOOLEAN ParseDeffunction(
void *theEnv,
char *readSource)
{
SYMBOL_HN *deffunctionName;
EXPRESSION *actions;
EXPRESSION *parameterList;
SYMBOL_HN *wildcard;
int min,max,lvars,DeffunctionError = FALSE;
short overwrite = FALSE, owMin = 0, owMax = 0;
DEFFUNCTION *dptr;
SetPPBufferStatus(theEnv,ON);
FlushPPBuffer(theEnv);
SetIndentDepth(theEnv,3);
SavePPBuffer(theEnv,"(deffunction ");
#if BLOAD || BLOAD_AND_BSAVE
if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,"deffunctions");
return(TRUE);
}
#endif
/* =====================================================
Parse the name and comment fields of the deffunction.
===================================================== */
deffunctionName = GetConstructNameAndComment(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,"deffunction",
EnvFindDeffunction,NULL,
"!",TRUE,TRUE,TRUE);
if (deffunctionName == NULL)
return(TRUE);
if (ValidDeffunctionName(theEnv,ValueToString(deffunctionName)) == FALSE)
return(TRUE);
/*==========================*/
/* Parse the argument list. */
/*==========================*/
parameterList = ParseProcParameters(theEnv,readSource,&DeffunctionData(theEnv)->DFInputToken,NULL,&wildcard,
&min,&max,&DeffunctionError,NULL);
if (DeffunctionError)
return(TRUE);
/*===================================================================*/
/* Go ahead and add the deffunction so it can be recursively called. */
/*===================================================================*/
if (ConstructData(theEnv)->CheckSyntaxMode)
{
dptr = (DEFFUNCTION *) EnvFindDeffunction(theEnv,ValueToString(deffunctionName));
if (dptr == NULL)
{ dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); }
else
{
overwrite = TRUE;
owMin = (short) dptr->minNumberOfParameters;
owMax = (short) dptr->maxNumberOfParameters;
dptr->minNumberOfParameters = min;
dptr->maxNumberOfParameters = max;
}
}
else
{ dptr = AddDeffunction(theEnv,deffunctionName,NULL,min,max,0,TRUE); }
if (dptr == NULL)
{
ReturnExpression(theEnv,parameterList);
return(TRUE);
}
/*==================================================*/
/* Parse the actions contained within the function. */
/*==================================================*/
PPCRAndIndent(theEnv);
ExpressionData(theEnv)->ReturnContext = TRUE;
actions = ParseProcActions(theEnv,"deffunction",readSource,
&DeffunctionData(theEnv)->DFInputToken,parameterList,wildcard,
NULL,NULL,&lvars,NULL);
if (actions == NULL)
{
ReturnExpression(theEnv,parameterList);
if (overwrite)
{
dptr->minNumberOfParameters = owMin;
dptr->maxNumberOfParameters = owMax;
}
if ((dptr->busy == 0) && (! overwrite))
{
RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr);
RemoveDeffunction(theEnv,dptr);
}
return(TRUE);
}
/*==============================================*/
/* If we're only checking syntax, don't add the */
/* successfully parsed deffunction to the KB. */
/*==============================================*/
if (ConstructData(theEnv)->CheckSyntaxMode)
{
ReturnExpression(theEnv,parameterList);
ReturnPackedExpression(theEnv,actions);
if (overwrite)
{
dptr->minNumberOfParameters = owMin;
dptr->maxNumberOfParameters = owMax;
}
else
{
RemoveConstructFromModule(theEnv,(struct constructHeader *) dptr);
RemoveDeffunction(theEnv,dptr);
}
return(FALSE);
}
/*=============================*/
/* Reformat the closing token. */
/*=============================*/
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,DeffunctionData(theEnv)->DFInputToken.printForm);
SavePPBuffer(theEnv,"\n");
/*======================*/
/* Add the deffunction. */
/*======================*/
AddDeffunction(theEnv,deffunctionName,actions,min,max,lvars,FALSE);
ReturnExpression(theEnv,parameterList);
return(DeffunctionError);
}
/****************************************************
NAME : AddDeffunction
DESCRIPTION : Adds a deffunction to the list of
deffunctions
INPUTS : 1) The symbolic name
2) The action expressions
3) The minimum number of arguments
4) The maximum number of arguments
(can be -1)
5) The number of local variables
6) A flag indicating if this is
a header call so that the
deffunction can be recursively
called
RETURNS : The new deffunction (NULL on errors)
SIDE EFFECTS : Deffunction structures allocated
NOTES : Assumes deffunction is not executing
****************************************************/
static DEFFUNCTION *AddDeffunction(
void *theEnv,
SYMBOL_HN *name,
EXPRESSION *actions,
int min,
int max,
int lvars,
int headerp)
{
DEFFUNCTION *dfuncPtr;
unsigned oldbusy;
#if DEBUGGING_FUNCTIONS
unsigned DFHadWatch = FALSE;
#endif
/*===============================================================*/
/* If the deffunction doesn't exist, create a new structure to */
/* contain it and add it to the List of deffunctions. Otherwise, */
/* use the existing structure and remove the pretty print form */
/* and interpretive code. */
/*===============================================================*/
dfuncPtr = (DEFFUNCTION *) EnvFindDeffunction(theEnv,ValueToString(name));
if (dfuncPtr == NULL)
{
dfuncPtr = get_struct(theEnv,deffunctionStruct);
InitializeConstructHeader(theEnv,"deffunction",(struct constructHeader *) dfuncPtr,name);
IncrementSymbolCount(name);
dfuncPtr->code = NULL;
dfuncPtr->minNumberOfParameters = min;
dfuncPtr->maxNumberOfParameters = max;
dfuncPtr->numberOfLocalVars = lvars;
dfuncPtr->busy = 0;
dfuncPtr->executing = 0;
}
else
{
#if DEBUGGING_FUNCTIONS
DFHadWatch = EnvGetDeffunctionWatch(theEnv,(void *) dfuncPtr);
#endif
dfuncPtr->minNumberOfParameters = min;
dfuncPtr->maxNumberOfParameters = max;
dfuncPtr->numberOfLocalVars = lvars;
oldbusy = dfuncPtr->busy;
ExpressionDeinstall(theEnv,dfuncPtr->code);
dfuncPtr->busy = oldbusy;
ReturnPackedExpression(theEnv,dfuncPtr->code);
dfuncPtr->code = NULL;
SetDeffunctionPPForm((void *) dfuncPtr,NULL);
/* =======================================
Remove the deffunction from the list so
that it can be added at the end
======================================= */
RemoveConstructFromModule(theEnv,(struct constructHeader *) dfuncPtr);
}
AddConstructToModule((struct constructHeader *) dfuncPtr);
/* ==================================
Install the new interpretive code.
================================== */
if (actions != NULL)
{
/* ===============================
If a deffunction is recursive,
do not increment its busy count
based on self-references
=============================== */
oldbusy = dfuncPtr->busy;
ExpressionInstall(theEnv,actions);
dfuncPtr->busy = oldbusy;
dfuncPtr->code = actions;
}
/* ===============================================================
Install the pretty print form if memory is not being conserved.
=============================================================== */
#if DEBUGGING_FUNCTIONS
EnvSetDeffunctionWatch(theEnv,DFHadWatch ? TRUE : DeffunctionData(theEnv)->WatchDeffunctions,(void *) dfuncPtr);
if ((EnvGetConserveMemory(theEnv) == FALSE) && (headerp == FALSE))
SetDeffunctionPPForm((void *) dfuncPtr,CopyPPBuffer(theEnv));
#endif
return(dfuncPtr);
}