bool UndefineFunction(
void *theEnv,
const char *functionName)
{
SYMBOL_HN *findValue;
struct FunctionDefinition *fPtr, *lastPtr = NULL;
findValue = (SYMBOL_HN *) FindSymbolHN(theEnv,functionName);
for (fPtr = ExternalFunctionData(theEnv)->ListOfFunctions;
fPtr != NULL;
fPtr = fPtr->next)
{
if (fPtr->callFunctionName == findValue)
{
DecrementSymbolCount(theEnv,fPtr->callFunctionName);
RemoveHashFunction(theEnv,fPtr);
if (lastPtr == NULL)
{ ExternalFunctionData(theEnv)->ListOfFunctions = fPtr->next; }
else
{ lastPtr->next = fPtr->next; }
if (fPtr->restrictions != NULL)
{ DecrementSymbolCount(theEnv,fPtr->restrictions); }
ClearUserDataList(theEnv,fPtr->usrData);
rtn_struct(theEnv,FunctionDefinition,fPtr);
return(true);
}
lastPtr = fPtr;
}
return(false);
}
globle int UndefineFunction(
char *functionName)
{
SYMBOL_HN *findValue;
struct FunctionDefinition *fPtr, *lastPtr = NULL;
findValue = (SYMBOL_HN *) FindSymbol(functionName);
for (fPtr = ListOfFunctions;
fPtr != NULL;
fPtr = fPtr->next)
{
if (fPtr->callFunctionName == findValue)
{
DecrementSymbolCount(fPtr->callFunctionName);
RemoveHashFunction(fPtr);
if (lastPtr == NULL)
{ ListOfFunctions = fPtr->next; }
else
{ lastPtr->next = fPtr->next; }
rtn_struct(FunctionDefinition,fPtr);
return(TRUE);
}
lastPtr = fPtr;
}
return(FALSE);
}
/***************************************************
NAME : DeleteSlots
DESCRIPTION : Deallocates a list of slots and
their values
INPUTS : The address of the slot list
RETURNS : Nothing useful
SIDE EFFECTS : The slot list is destroyed
NOTES : None
***************************************************/
globle void DeleteSlots(
void *theEnv,
EXEC_STATUS,
TEMP_SLOT_LINK *slots)
{
TEMP_SLOT_LINK *stmp;
while (slots != NULL)
{
stmp = slots;
slots = slots->nxt;
DeleteSlotName(theEnv,execStatus,stmp->desc->slotName);
DecrementSymbolCount(theEnv,execStatus,stmp->desc->overrideMessage);
RemoveConstraint(theEnv,execStatus,stmp->desc->constraint);
if (stmp->desc->dynamicDefault == 1)
{
ExpressionDeinstall(theEnv,execStatus,(EXPRESSION *) stmp->desc->defaultValue);
ReturnPackedExpression(theEnv,execStatus,(EXPRESSION *) stmp->desc->defaultValue);
}
else if (stmp->desc->defaultValue != NULL)
{
ValueDeinstall(theEnv,execStatus,(DATA_OBJECT *) stmp->desc->defaultValue);
rtn_struct(theEnv,execStatus,dataObject,stmp->desc->defaultValue);
}
rtn_struct(theEnv,execStatus,slotDescriptor,stmp->desc);
rtn_struct(theEnv,execStatus,tempSlotLink,stmp);
}
}
static void ClearBload()
{
long i;
unsigned long space;
struct portItem *theList;
/*===========================*/
/* Decrement in use counters */
/* used by the binary image. */
/*===========================*/
for (i = 0; i < NumberOfDefmodules; i++)
{
DecrementSymbolCount(DefmoduleArray[i].name);
for (theList = DefmoduleArray[i].importList;
theList != NULL;
theList = theList->next)
{
if (theList->moduleName != NULL) DecrementSymbolCount(theList->moduleName);
if (theList->constructType != NULL) DecrementSymbolCount(theList->constructType);
if (theList->constructName != NULL) DecrementSymbolCount(theList->constructName);
}
for (theList = DefmoduleArray[i].exportList;
theList != NULL;
theList = theList->next)
{
if (theList->moduleName != NULL) DecrementSymbolCount(theList->moduleName);
if (theList->constructType != NULL) DecrementSymbolCount(theList->constructType);
if (theList->constructName != NULL) DecrementSymbolCount(theList->constructName);
}
rm(DefmoduleArray[i].itemsArray,(int) sizeof(void *) * GetNumberOfModuleItems());
}
/*================================*/
/* Deallocate the space used for */
/* the defmodule data structures. */
/*================================*/
space = NumberOfDefmodules * sizeof(struct defmodule);
if (space != 0) genlongfree((void *) DefmoduleArray,space);
/*================================*/
/* Deallocate the space used for */
/* the port item data structures. */
/*================================*/
space = NumberOfPortItems * sizeof(struct portItem);
if (space != 0) genlongfree((void *) PortItemArray,space);
/*===========================*/
/* Reset module information. */
/*===========================*/
SetListOfDefmodules(NULL);
CreateMainModule();
MainModuleRedefinable = TRUE;
}
static void ClearBload(
void *theEnv)
{
size_t space;
int i;
/*=============================================*/
/* Decrement in use counters for atomic values */
/* contained in the construct headers. */
/*=============================================*/
for (i = 0; i < DeftemplateBinaryData(theEnv)->NumberOfDeftemplates; i++)
{ UnmarkConstructHeader(theEnv,&DeftemplateBinaryData(theEnv)->DeftemplateArray[i].header); }
/*=======================================*/
/* Decrement in use counters for symbols */
/* used as slot names. */
/*=======================================*/
for (i = 0; i < DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots; i++)
{ DecrementSymbolCount(theEnv,DeftemplateBinaryData(theEnv)->SlotArray[i].slotName); }
/*======================================================================*/
/* Deallocate the space used for the deftemplateModule data structures. */
/*======================================================================*/
space = DeftemplateBinaryData(theEnv)->NumberOfTemplateModules * sizeof(struct deftemplateModule);
if (space != 0) genfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->ModuleArray,space);
DeftemplateBinaryData(theEnv)->NumberOfTemplateModules = 0;
/*================================================================*/
/* Deallocate the space used for the deftemplate data structures. */
/*================================================================*/
space = DeftemplateBinaryData(theEnv)->NumberOfDeftemplates * sizeof(struct deftemplate);
if (space != 0) genfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->DeftemplateArray,space);
DeftemplateBinaryData(theEnv)->NumberOfDeftemplates = 0;
/*=================================================================*/
/* Deallocate the space used for the templateSlot data structures. */
/*=================================================================*/
space = DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots * sizeof(struct templateSlot);
if (space != 0) genfree(theEnv,(void *) DeftemplateBinaryData(theEnv)->SlotArray,space);
DeftemplateBinaryData(theEnv)->NumberOfTemplateSlots = 0;
/*======================================*/
/* Create the initial-fact deftemplate. */
/*======================================*/
#if (! BLOAD_ONLY)
CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"),FALSE);
#endif
}
/**************************************************************
NAME : RemoveDefinstances
DESCRIPTION : Deallocates and removes a definstance construct
INPUTS : The definstance address
RETURNS : Nothing useful
SIDE EFFECTS : Existing definstance construct deleted
NOTES : Assumes busy count of definstance is 0
**************************************************************/
static void RemoveDefinstances(
void *theEnv,
void *vdptr)
{
DEFINSTANCES *dptr = (DEFINSTANCES *) vdptr;
DecrementSymbolCount(theEnv,GetDefinstancesNamePointer((void *) dptr));
ExpressionDeinstall(theEnv,dptr->mkinstance);
ReturnPackedExpression(theEnv,dptr->mkinstance);
SetDefinstancesPPForm((void *) dptr,NULL);
ClearUserDataList(theEnv,dptr->header.usrData);
rtn_struct(theEnv,definstances,dptr);
}
static void ReturnDeftemplate(
void *theEnv,
void *vTheConstruct)
{
#if (MAC_MCW || WIN_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theEnv,vTheConstruct)
#endif
#if (! BLOAD_ONLY) && (! RUN_TIME)
struct deftemplate *theConstruct = (struct deftemplate *) vTheConstruct;
struct templateSlot *slotPtr;
if (theConstruct == NULL) return;
/*====================================================================*/
/* If a template is redefined, then we want to save its debug status. */
/*====================================================================*/
#if DEBUGGING_FUNCTIONS
DeftemplateData(theEnv)->DeletedTemplateDebugFlags = 0;
if (theConstruct->watch) BitwiseSet(DeftemplateData(theEnv)->DeletedTemplateDebugFlags,0);
#endif
/*===========================================*/
/* Free storage used by the templates slots. */
/*===========================================*/
slotPtr = theConstruct->slotList;
while (slotPtr != NULL)
{
DecrementSymbolCount(theEnv,slotPtr->slotName);
RemoveHashedExpression(theEnv,slotPtr->defaultList);
slotPtr->defaultList = NULL;
RemoveHashedExpression(theEnv,slotPtr->facetList);
slotPtr->facetList = NULL;
RemoveConstraint(theEnv,slotPtr->constraints);
slotPtr->constraints = NULL;
slotPtr = slotPtr->next;
}
ReturnSlots(theEnv,theConstruct->slotList);
/*==================================*/
/* Free storage used by the header. */
/*==================================*/
DeinstallConstructHeader(theEnv,&theConstruct->header);
rtn_struct(theEnv,deftemplate,theConstruct);
#endif
}
/***************************************************
NAME : RemoveDeffunction
DESCRIPTION : Removes a deffunction
INPUTS : Deffunction pointer
RETURNS : Nothing useful
SIDE EFFECTS : Deffunction deallocated
NOTES : Assumes deffunction is not in use!!
***************************************************/
globle void RemoveDeffunction(
void *theEnv,
void *vdptr)
{
DEFFUNCTION *dptr = (DEFFUNCTION *) vdptr;
if (dptr == NULL)
return;
DecrementSymbolCount(theEnv,GetDeffunctionNamePointer((void *) dptr));
ExpressionDeinstall(theEnv,dptr->code);
ReturnPackedExpression(theEnv,dptr->code);
SetDeffunctionPPForm((void *) dptr,NULL);
ClearUserDataList(theEnv,dptr->header.usrData);
rtn_struct(theEnv,deffunctionStruct,dptr);
}
/**************************************************
NAME : RemoveDefgeneric
DESCRIPTION : Removes a generic function node
from the generic list along with
all its methods
INPUTS : The generic function
RETURNS : Nothing useful
SIDE EFFECTS : List adjusted
Nodes deallocated
NOTES : Assumes generic is not in use!!!
**************************************************/
globle void RemoveDefgeneric(
void *vgfunc)
{
DEFGENERIC *gfunc = (DEFGENERIC *) vgfunc;
register int i;
for (i = 0 ; i < gfunc->mcnt ; i++)
DeleteMethodInfo(gfunc,&gfunc->methods[i]);
if (gfunc->mcnt != 0)
rm((void *) gfunc->methods,(int) (sizeof(DEFMETHOD) * gfunc->mcnt));
DecrementSymbolCount(GetDefgenericNamePointer((void *) gfunc));
SetDefgenericPPForm((void *) gfunc,NULL);
ClearUserDataList(gfunc->header.usrData);
rtn_struct(defgeneric,gfunc);
}
globle void DeinstallConstructHeader(
struct constructHeader *theHeader)
{
DecrementSymbolCount(theHeader->name);
if (theHeader->ppForm != NULL)
{
rm(theHeader->ppForm,
(int) sizeof(char) * ((int) strlen(theHeader->ppForm) + 1));
theHeader->ppForm = NULL;
}
if (theHeader->usrData != NULL)
{
ClearUserDataList(theHeader->usrData);
theHeader->usrData = NULL;
}
}
globle void ReturnValues(
void *theEnv,
DATA_OBJECT_PTR garbagePtr,
intBool decrementSupplementalInfo)
{
DATA_OBJECT_PTR nextPtr;
while (garbagePtr != NULL)
{
nextPtr = garbagePtr->next;
ValueDeinstall(theEnv,garbagePtr);
if ((garbagePtr->supplementalInfo != NULL) && decrementSupplementalInfo)
{ DecrementSymbolCount(theEnv,(struct symbolHashNode *) garbagePtr->supplementalInfo); }
rtn_struct(theEnv,dataObject,garbagePtr);
garbagePtr = nextPtr;
}
}
globle void AtomDeinstall(
int type,
void *vPtr)
{
switch (type)
{
case SYMBOL:
case STRING:
#if DEFGLOBAL_CONSTRUCT
case GBL_VARIABLE:
#endif
#if OBJECT_SYSTEM
case INSTANCE_NAME:
#endif
DecrementSymbolCount((SYMBOL_HN *) vPtr);
break;
case FLOAT:
DecrementFloatCount((FLOAT_HN *) vPtr);
break;
case INTEGER:
DecrementIntegerCount((INTEGER_HN *) vPtr);
break;
#if FUZZY_DEFTEMPLATES
case FUZZY_VALUE:
DeinstallFuzzyValue(vPtr);
break;
#endif
case MULTIFIELD:
MultifieldDeinstall((struct multifield *) vPtr);
break;
case RVOID:
break;
default:
if (PrimitivesArray[type] == NULL) break;
if (PrimitivesArray[type]->bitMap) DecrementBitMapCount((BITMAP_HN *) vPtr);
else if (PrimitivesArray[type]->decrementBusyCount)
{ (*PrimitivesArray[type]->decrementBusyCount)(vPtr); }
}
}
/**************************************************
NAME : RemoveDefgeneric
DESCRIPTION : Removes a generic function node
from the generic list along with
all its methods
INPUTS : The generic function
RETURNS : Nothing useful
SIDE EFFECTS : List adjusted
Nodes deallocated
NOTES : Assumes generic is not in use!!!
**************************************************/
globle void RemoveDefgeneric(
void *theEnv,
EXEC_STATUS,
void *vgfunc)
{
DEFGENERIC *gfunc = (DEFGENERIC *) vgfunc;
long i;
for (i = 0 ; i < gfunc->mcnt ; i++)
DeleteMethodInfo(theEnv,execStatus,gfunc,&gfunc->methods[i]);
if (gfunc->mcnt != 0)
rm(theEnv,execStatus,(void *) gfunc->methods,(sizeof(DEFMETHOD) * gfunc->mcnt));
DecrementSymbolCount(theEnv,execStatus,GetDefgenericNamePointer((void *) gfunc));
SetDefgenericPPForm((void *) gfunc,NULL);
ClearUserDataList(theEnv,execStatus,gfunc->header.usrData);
rtn_struct(theEnv,execStatus,defgeneric,gfunc);
}
globle void AtomDeinstall(
void *theEnv,
int type,
void *vPtr)
{
switch (type)
{
case SYMBOL:
case STRING:
#if DEFGLOBAL_CONSTRUCT
case GBL_VARIABLE:
#endif
#if OBJECT_SYSTEM
case INSTANCE_NAME:
#endif
DecrementSymbolCount(theEnv,(SYMBOL_HN *) vPtr);
break;
case FLOAT:
DecrementFloatCount(theEnv,(FLOAT_HN *) vPtr);
break;
case INTEGER:
DecrementIntegerCount(theEnv,(INTEGER_HN *) vPtr);
break;
case EXTERNAL_ADDRESS:
DecrementExternalAddressCount(theEnv,(EXTERNAL_ADDRESS_HN *) vPtr);
break;
case MULTIFIELD:
MultifieldDeinstall(theEnv,(struct multifield *) vPtr);
break;
case RVOID:
break;
default:
if (EvaluationData(theEnv)->PrimitivesArray[type] == NULL) break;
if (EvaluationData(theEnv)->PrimitivesArray[type]->bitMap) DecrementBitMapCount(theEnv,(BITMAP_HN *) vPtr);
else if (EvaluationData(theEnv)->PrimitivesArray[type]->decrementBusyCount)
{ (*EvaluationData(theEnv)->PrimitivesArray[type]->decrementBusyCount)(theEnv,vPtr); }
}
}
globle void DeinstallConstructHeader(
void *theEnv,
EXEC_STATUS,
struct constructHeader *theHeader)
{
DecrementSymbolCount(theEnv,execStatus,theHeader->name);
if (theHeader->ppForm != NULL)
{
rm(theEnv,execStatus,theHeader->ppForm,
sizeof(char) * (strlen(theHeader->ppForm) + 1));
theHeader->ppForm = NULL;
}
if (theHeader->usrData != NULL)
{
ClearUserDataList(theEnv,execStatus,theHeader->usrData);
theHeader->usrData = NULL;
}
}
/************************************************************
NAME : ParseSlot
DESCRIPTION : Parses slot definitions for a
defclass statement
INPUTS : 1) The logical name of the input source
2) The current slot list
3) The class precedence list for the class
to which this slot is being attached
(used to find facets for composite slots)
4) A flag indicating if this is a multifield
slot or not
5) A flag indicating if the type of slot
(single or multi) was explicitly
specified or not
RETURNS : The address of the list of slots,
NULL if there was an error
SIDE EFFECTS : The slot list is allocated
NOTES : Assumes "(slot" has already been parsed.
************************************************************/
globle TEMP_SLOT_LINK *ParseSlot(
void *theEnv,
EXEC_STATUS,
char *readSource,
TEMP_SLOT_LINK *slist,
PACKED_CLASS_LINKS *preclist,
int multiSlot,
int fieldSpecified)
{
SLOT_DESC *slot;
CONSTRAINT_PARSE_RECORD parsedConstraint;
char specbits[2];
int rtnCode;
SYMBOL_HN *newOverrideMsg;
/* ===============================================================
Bits in specbits are when slot qualifiers are specified so that
duplicate or conflicting qualifiers can be detected.
Shared/local bit-0
Single/multiple bit-1
Read-only/Read-write/Initialize-Only bit-2
Inherit/No-inherit bit-3
Composite/Exclusive bit-4
Reactive/Nonreactive bit-5
Default bit-6
Default-dynamic bit-7
Visibility bit-8
Override-message bit-9
=============================================================== */
SavePPBuffer(theEnv,execStatus," ");
specbits[0] = specbits[1] = '\0';
GetToken(theEnv,execStatus,readSource,&DefclassData(theEnv,execStatus)->ObjectParseToken);
if (GetType(DefclassData(theEnv,execStatus)->ObjectParseToken) != SYMBOL)
{
DeleteSlots(theEnv,execStatus,slist);
SyntaxErrorMessage(theEnv,execStatus,"defclass slot");
return(NULL);
}
if ((DefclassData(theEnv,execStatus)->ObjectParseToken.value == (void *) DefclassData(theEnv,execStatus)->ISA_SYMBOL) ||
(DefclassData(theEnv,execStatus)->ObjectParseToken.value == (void *) DefclassData(theEnv,execStatus)->NAME_SYMBOL))
{
DeleteSlots(theEnv,execStatus,slist);
SyntaxErrorMessage(theEnv,execStatus,"defclass slot");
return(NULL);
}
slot = NewSlot(theEnv,execStatus,(SYMBOL_HN *) GetValue(DefclassData(theEnv,execStatus)->ObjectParseToken));
slist = InsertSlot(theEnv,execStatus,slist,slot);
if (slist == NULL)
return(NULL);
if (multiSlot)
slot->multiple = TRUE;
if (fieldSpecified)
SetBitMap(specbits,FIELD_BIT);
GetToken(theEnv,execStatus,readSource,&DefclassData(theEnv,execStatus)->ObjectParseToken);
IncrementIndentDepth(theEnv,execStatus,3);
InitializeConstraintParseRecord(&parsedConstraint);
while (GetType(DefclassData(theEnv,execStatus)->ObjectParseToken) == LPAREN)
{
PPBackup(theEnv,execStatus);
PPCRAndIndent(theEnv,execStatus);
SavePPBuffer(theEnv,execStatus,"(");
GetToken(theEnv,execStatus,readSource,&DefclassData(theEnv,execStatus)->ObjectParseToken);
if (GetType(DefclassData(theEnv,execStatus)->ObjectParseToken) != SYMBOL)
{
SyntaxErrorMessage(theEnv,execStatus,"defclass slot");
goto ParseSlotError;
}
else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),DEFAULT_FACET) == 0)
{
if (ParseDefaultFacet(theEnv,execStatus,readSource,specbits,slot) == FALSE)
goto ParseSlotError;
}
else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),DYNAMIC_FACET) == 0)
{
SetBitMap(specbits,DEFAULT_DYNAMIC_BIT);
if (ParseDefaultFacet(theEnv,execStatus,readSource,specbits,slot) == FALSE)
goto ParseSlotError;
}
else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),ACCESS_FACET) == 0)
{
rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,ACCESS_FACET,ACCESS_BIT,
SLOT_RDWRT_RLN,SLOT_RDONLY_RLN,SLOT_INIT_RLN,
NULL,NULL);
if (rtnCode == -1)
goto ParseSlotError;
else if (rtnCode == 1)
slot->noWrite = 1;
else if (rtnCode == 2)
slot->initializeOnly = 1;
}
else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),STORAGE_FACET) == 0)
{
rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,STORAGE_FACET,STORAGE_BIT,
SLOT_LOCAL_RLN,SLOT_SHARE_RLN,NULL,NULL,NULL);
if (rtnCode == -1)
goto ParseSlotError;
slot->shared = rtnCode;
}
else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),PROPAGATION_FACET) == 0)
{
rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,PROPAGATION_FACET,PROPAGATION_BIT,
SLOT_INH_RLN,SLOT_NO_INH_RLN,NULL,NULL,NULL);
if (rtnCode == -1)
goto ParseSlotError;
slot->noInherit = rtnCode;
}
else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),SOURCE_FACET) == 0)
{
rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,SOURCE_FACET,SOURCE_BIT,
SLOT_EXCLUSIVE_RLN,SLOT_COMPOSITE_RLN,NULL,NULL,NULL);
if (rtnCode == -1)
goto ParseSlotError;
slot->composite = rtnCode;
}
#if DEFRULE_CONSTRUCT
else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),MATCH_FACET) == 0)
{
rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,MATCH_FACET,MATCH_BIT,
SLOT_NONREACTIVE_RLN,SLOT_REACTIVE_RLN,NULL,NULL,NULL);
if (rtnCode == -1)
goto ParseSlotError;
slot->reactive = rtnCode;
}
#endif
else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),VISIBILITY_FACET) == 0)
{
rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,VISIBILITY_FACET,VISIBILITY_BIT,
SLOT_PRIVATE_RLN,SLOT_PUBLIC_RLN,NULL,NULL,NULL);
if (rtnCode == -1)
goto ParseSlotError;
slot->publicVisibility = rtnCode;
}
else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),CREATE_ACCESSOR_FACET) == 0)
{
rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,CREATE_ACCESSOR_FACET,
CREATE_ACCESSOR_BIT,
SLOT_READ_RLN,SLOT_WRITE_RLN,SLOT_RDWRT_RLN,
SLOT_NONE_RLN,NULL);
if (rtnCode == -1)
goto ParseSlotError;
if ((rtnCode == 0) || (rtnCode == 2))
slot->createReadAccessor = TRUE;
if ((rtnCode == 1) || (rtnCode == 2))
slot->createWriteAccessor = TRUE;
}
else if (strcmp(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),OVERRIDE_MSG_FACET) == 0)
{
rtnCode = ParseSimpleFacet(theEnv,execStatus,readSource,specbits,OVERRIDE_MSG_FACET,OVERRIDE_MSG_BIT,
NULL,NULL,NULL,SLOT_DEFAULT_RLN,&newOverrideMsg);
if (rtnCode == -1)
goto ParseSlotError;
if (rtnCode == 4)
{
DecrementSymbolCount(theEnv,execStatus,slot->overrideMessage);
slot->overrideMessage = newOverrideMsg;
IncrementSymbolCount(slot->overrideMessage);
}
slot->overrideMessageSpecified = TRUE;
}
else if (StandardConstraint(DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken)))
{
if (ParseStandardConstraint(theEnv,execStatus,readSource,DOToString(DefclassData(theEnv,execStatus)->ObjectParseToken),
slot->constraint,&parsedConstraint,TRUE) == FALSE)
goto ParseSlotError;
}
else
{
SyntaxErrorMessage(theEnv,execStatus,"defclass slot");
goto ParseSlotError;
}
GetToken(theEnv,execStatus,readSource,&DefclassData(theEnv,execStatus)->ObjectParseToken);
}
if (GetType(DefclassData(theEnv,execStatus)->ObjectParseToken) != RPAREN)
{
SyntaxErrorMessage(theEnv,execStatus,"defclass slot");
goto ParseSlotError;
}
if (DefclassData(theEnv,execStatus)->ClassDefaultsMode == CONVENIENCE_MODE)
{
if (! TestBitMap(specbits,CREATE_ACCESSOR_BIT))
{
slot->createReadAccessor = TRUE;
if (! slot->noWrite)
{ slot->createWriteAccessor = TRUE; }
}
}
if (slot->composite)
BuildCompositeFacets(theEnv,execStatus,slot,preclist,specbits,&parsedConstraint);
if (CheckForFacetConflicts(theEnv,execStatus,slot,&parsedConstraint) == FALSE)
goto ParseSlotError;
if (CheckConstraintParseConflicts(theEnv,execStatus,slot->constraint) == FALSE)
goto ParseSlotError;
if (EvaluateSlotDefaultValue(theEnv,execStatus,slot,specbits) == FALSE)
goto ParseSlotError;
if ((slot->dynamicDefault == 0) && (slot->noWrite == 1) &&
(slot->initializeOnly == 0))
slot->shared = 1;
slot->constraint = AddConstraint(theEnv,execStatus,slot->constraint);
DecrementIndentDepth(theEnv,execStatus,3);
return(slist);
ParseSlotError:
DecrementIndentDepth(theEnv,execStatus,3);
DeleteSlots(theEnv,execStatus,slist);
return(NULL);
}
globle void BindFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
DATA_OBJECT *theBind, *lastBind;
int found = FALSE,
unbindVar = FALSE;
SYMBOL_HN *variableName = NULL;
#if DEFGLOBAL_CONSTRUCT
struct defglobal *theGlobal = NULL;
#endif
/*===============================================*/
/* Determine the name of the variable to be set. */
/*===============================================*/
#if DEFGLOBAL_CONSTRUCT
if (GetFirstArgument()->type == DEFGLOBAL_PTR)
{ theGlobal = (struct defglobal *) GetFirstArgument()->value; }
else
#endif
{
EvaluateExpression(theEnv,GetFirstArgument(),returnValue);
variableName = (SYMBOL_HN *) DOPToPointer(returnValue);
}
/*===========================================*/
/* Determine the new value for the variable. */
/*===========================================*/
if (GetFirstArgument()->nextArg == NULL)
{ unbindVar = TRUE; }
else if (GetFirstArgument()->nextArg->nextArg == NULL)
{ EvaluateExpression(theEnv,GetFirstArgument()->nextArg,returnValue); }
else
{ StoreInMultifield(theEnv,returnValue,GetFirstArgument()->nextArg,TRUE); }
/*==================================*/
/* Bind a defglobal if appropriate. */
/*==================================*/
#if DEFGLOBAL_CONSTRUCT
if (theGlobal != NULL)
{
QSetDefglobalValue(theEnv,theGlobal,returnValue,unbindVar);
return;
}
#endif
/*===============================================*/
/* Search for the variable in the list of binds. */
/*===============================================*/
theBind = ProcedureFunctionData(theEnv)->BindList;
lastBind = NULL;
while ((theBind != NULL) && (found == FALSE))
{
if (theBind->supplementalInfo == (void *) variableName)
{ found = TRUE; }
else
{
lastBind = theBind;
theBind = theBind->next;
}
}
/*========================================================*/
/* If variable was not in the list of binds, then add it. */
/* Make sure that this operation preserves the bind list */
/* as a stack. */
/*========================================================*/
if (found == FALSE)
{
if (unbindVar == FALSE)
{
theBind = get_struct(theEnv,dataObject);
theBind->supplementalInfo = (void *) variableName;
IncrementSymbolCount(variableName);
theBind->next = NULL;
if (lastBind == NULL)
{ ProcedureFunctionData(theEnv)->BindList = theBind; }
else
{ lastBind->next = theBind; }
}
else
{
returnValue->type = SYMBOL;
returnValue->value = EnvFalseSymbol(theEnv);
return;
}
}
else
{ ValueDeinstall(theEnv,theBind); }
/*================================*/
/* Set the value of the variable. */
/*================================*/
if (unbindVar == FALSE)
{
theBind->type = returnValue->type;
theBind->value = returnValue->value;
theBind->begin = returnValue->begin;
theBind->end = returnValue->end;
ValueInstall(theEnv,returnValue);
}
else
{
if (lastBind == NULL) ProcedureFunctionData(theEnv)->BindList = theBind->next;
else lastBind->next = theBind->next;
DecrementSymbolCount(theEnv,(struct symbolHashNode *) theBind->supplementalInfo);
rtn_struct(theEnv,dataObject,theBind);
returnValue->type = SYMBOL;
returnValue->value = EnvFalseSymbol(theEnv);
}
}
static void ClearBload(
void *theEnv)
{
long i;
size_t space;
struct portItem *theList;
/*===========================*/
/* Decrement in use counters */
/* used by the binary image. */
/*===========================*/
for (i = 0; i < DefmoduleData(theEnv)->BNumberOfDefmodules; i++)
{
DecrementSymbolCount(theEnv,DefmoduleData(theEnv)->DefmoduleArray[i].name);
for (theList = DefmoduleData(theEnv)->DefmoduleArray[i].importList;
theList != NULL;
theList = theList->next)
{
if (theList->moduleName != NULL) DecrementSymbolCount(theEnv,theList->moduleName);
if (theList->constructType != NULL) DecrementSymbolCount(theEnv,theList->constructType);
if (theList->constructName != NULL) DecrementSymbolCount(theEnv,theList->constructName);
}
for (theList = DefmoduleData(theEnv)->DefmoduleArray[i].exportList;
theList != NULL;
theList = theList->next)
{
if (theList->moduleName != NULL) DecrementSymbolCount(theEnv,theList->moduleName);
if (theList->constructType != NULL) DecrementSymbolCount(theEnv,theList->constructType);
if (theList->constructName != NULL) DecrementSymbolCount(theEnv,theList->constructName);
}
rm(theEnv,DefmoduleData(theEnv)->DefmoduleArray[i].itemsArray,sizeof(void *) * GetNumberOfModuleItems(theEnv));
}
/*================================*/
/* Deallocate the space used for */
/* the defmodule data structures. */
/*================================*/
space = DefmoduleData(theEnv)->BNumberOfDefmodules * sizeof(struct defmodule);
if (space != 0) genfree(theEnv,(void *) DefmoduleData(theEnv)->DefmoduleArray,space);
DefmoduleData(theEnv)->BNumberOfDefmodules = 0;
/*================================*/
/* Deallocate the space used for */
/* the port item data structures. */
/*================================*/
space = DefmoduleData(theEnv)->NumberOfPortItems * sizeof(struct portItem);
if (space != 0) genfree(theEnv,(void *) DefmoduleData(theEnv)->PortItemArray,space);
DefmoduleData(theEnv)->NumberOfPortItems = 0;
/*===========================*/
/* Reset module information. */
/*===========================*/
SetListOfDefmodules(theEnv,NULL);
CreateMainModule(theEnv);
DefmoduleData(theEnv)->MainModuleRedefinable = TRUE;
}
static void ReturnDefmodule(
void *theEnv,
struct defmodule *theDefmodule,
intBool environmentClear)
{
int i;
struct moduleItem *theItem;
struct portItem *theSpec, *nextSpec;
/*=====================================================*/
/* Set the current module to the module being deleted. */
/*=====================================================*/
if (theDefmodule == NULL) return;
if (! environmentClear)
{ EnvSetCurrentModule(theEnv,(void *) theDefmodule); }
/*============================================*/
/* Call the free functions for the constructs */
/* belonging to this module. */
/*============================================*/
if (theDefmodule->itemsArray != NULL)
{
if (! environmentClear)
{
for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems;
(i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL);
i++, theItem = theItem->next)
{
if (theItem->freeFunction != NULL)
{ (*theItem->freeFunction)(theEnv,theDefmodule->itemsArray[i]); }
}
}
rm(theEnv,theDefmodule->itemsArray,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems);
}
/*======================================================*/
/* Decrement the symbol count for the defmodule's name. */
/*======================================================*/
if (! environmentClear)
{ DecrementSymbolCount(theEnv,theDefmodule->name); }
/*====================================*/
/* Free the items in the import list. */
/*====================================*/
theSpec = theDefmodule->importList;
while (theSpec != NULL)
{
nextSpec = theSpec->next;
if (! environmentClear)
{
if (theSpec->moduleName != NULL) DecrementSymbolCount(theEnv,theSpec->moduleName);
if (theSpec->constructType != NULL) DecrementSymbolCount(theEnv,theSpec->constructType);
if (theSpec->constructName != NULL) DecrementSymbolCount(theEnv,theSpec->constructName);
}
rtn_struct(theEnv,portItem,theSpec);
theSpec = nextSpec;
}
/*====================================*/
/* Free the items in the export list. */
/*====================================*/
theSpec = theDefmodule->exportList;
while (theSpec != NULL)
{
nextSpec = theSpec->next;
if (! environmentClear)
{
if (theSpec->moduleName != NULL) DecrementSymbolCount(theEnv,theSpec->moduleName);
if (theSpec->constructType != NULL) DecrementSymbolCount(theEnv,theSpec->constructType);
if (theSpec->constructName != NULL) DecrementSymbolCount(theEnv,theSpec->constructName);
}
rtn_struct(theEnv,portItem,theSpec);
theSpec = nextSpec;
}
/*=========================================*/
/* Free the defmodule pretty print string. */
/*=========================================*/
if (theDefmodule->ppForm != NULL)
{
rm(theEnv,theDefmodule->ppForm,
(int) sizeof(char) * (strlen(theDefmodule->ppForm) + 1));
}
/*=======================*/
/* Return the user data. */
/*=======================*/
ClearUserDataList(theEnv,theDefmodule->usrData);
/*======================================*/
/* Return the defmodule data structure. */
/*======================================*/
rtn_struct(theEnv,defmodule,theDefmodule);
}
/***************************************************************
NAME : ClearBloadObjects
DESCRIPTION : Release all binary-loaded class and handler
structure arrays (and others)
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Memory cleared
NOTES : None
***************************************************************/
static void ClearBloadObjects()
{
register long i;
UNLN space;
space = (unsigned long) (sizeof(DEFCLASS_MODULE) * ModuleCount);
if (space == 0L)
return;
genlongfree((void *) ModuleArray,space);
ModuleArray = NULL;
ModuleCount = 0L;
if (ClassCount != 0L)
{
rm((void *) ClassIDMap,(int) (sizeof(DEFCLASS *) * MaxClassID));
ClassIDMap = NULL;
MaxClassID = 0;
for (i = 0L ; i < ClassCount ; i++)
{
UnmarkConstructHeader(&defclassArray[i].header);
#if DEFMODULE_CONSTRUCT
DecrementBitMapCount(defclassArray[i].scopeMap);
#endif
RemoveClassFromTable((DEFCLASS *) &defclassArray[i]);
}
for (i = 0L ; i < SlotCount ; i++)
{
DecrementSymbolCount(slotArray[i].overrideMessage);
if ((slotArray[i].defaultValue != NULL) && (slotArray[i].dynamicDefault == 0))
{
ValueDeinstall((DATA_OBJECT *) slotArray[i].defaultValue);
rtn_struct(dataObject,slotArray[i].defaultValue);
}
}
for (i = 0L ; i < SlotNameCount ; i++)
{
SlotNameTable[slotNameArray[i].hashTableIndex] = NULL;
DecrementSymbolCount(slotNameArray[i].name);
DecrementSymbolCount(slotNameArray[i].putHandlerName);
}
space = (UNLN) (sizeof(DEFCLASS) * ClassCount);
if (space != 0L)
{
genlongfree((void *) defclassArray,space);
defclassArray = NULL;
ClassCount = 0L;
}
space = (UNLN) (sizeof(DEFCLASS *) * LinkCount);
if (space != 0L)
{
genlongfree((void *) linkArray,space);
linkArray = NULL;
LinkCount = 0L;
}
space = (UNLN) (sizeof(SLOT_DESC) * SlotCount);
if (space != 0L)
{
genlongfree((void *) slotArray,space);
slotArray = NULL;
SlotCount = 0L;
}
space = (UNLN) (sizeof(SLOT_NAME) * SlotNameCount);
if (space != 0L)
{
genlongfree((void *) slotNameArray,space);
slotNameArray = NULL;
SlotNameCount = 0L;
}
space = (UNLN) (sizeof(SLOT_DESC *) * TemplateSlotCount);
if (space != 0L)
{
genlongfree((void *) tmpslotArray,space);
tmpslotArray = NULL;
TemplateSlotCount = 0L;
}
space = (UNLN) (sizeof(unsigned) * SlotNameMapCount);
if (space != 0L)
{
genlongfree((void *) mapslotArray,space);
mapslotArray = NULL;
SlotNameMapCount = 0L;
}
}
if (HandlerCount != 0L)
{
for (i = 0L ; i < HandlerCount ; i++)
DecrementSymbolCount(handlerArray[i].name);
space = (UNLN) (sizeof(HANDLER) * HandlerCount);
if (space != 0L)
{
genlongfree((void *) handlerArray,space);
handlerArray = NULL;
space = (UNLN) (sizeof(unsigned) * HandlerCount);
genlongfree((void *) maphandlerArray,space);
maphandlerArray = NULL;
HandlerCount = 0L;
}
}
}
static void StrOrSymCatFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue,
unsigned short returnType)
{
DATA_OBJECT theArg;
int numArgs, i, total, j;
char *theString;
SYMBOL_HN **arrayOfStrings;
SYMBOL_HN *hashPtr;
char *functionName;
/*============================================*/
/* Determine the calling function name. */
/* Store the null string or the symbol nil as */
/* the return value in the event of an error. */
/*============================================*/
SetpType(returnValue,returnType);
if (returnType == STRING)
{
functionName = "str-cat";
SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,""));
}
else
{
functionName = "sym-cat";
SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,"nil"));
}
/*===============================================*/
/* Determine the number of arguments as create a */
/* string array which is large enough to store */
/* the string representation of each argument. */
/*===============================================*/
numArgs = EnvRtnArgCount(theEnv);
arrayOfStrings = (SYMBOL_HN **) gm1(theEnv,(int) sizeof(SYMBOL_HN *) * numArgs);
for (i = 0; i < numArgs; i++)
{ arrayOfStrings[i] = NULL; }
/*=============================================*/
/* Evaluate each argument and store its string */
/* representation in the string array. */
/*=============================================*/
total = 1;
for (i = 1 ; i <= numArgs ; i++)
{
EnvRtnUnknown(theEnv,i,&theArg);
switch(GetType(theArg))
{
case STRING:
#if OBJECT_SYSTEM
case INSTANCE_NAME:
#endif
case SYMBOL:
hashPtr = (SYMBOL_HN *) GetValue(theArg);
arrayOfStrings[i-1] = hashPtr;
IncrementSymbolCount(hashPtr);
break;
case FLOAT:
hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,FloatToString(theEnv,ValueToDouble(GetValue(theArg))));
arrayOfStrings[i-1] = hashPtr;
IncrementSymbolCount(hashPtr);
break;
case INTEGER:
hashPtr = (SYMBOL_HN *) EnvAddSymbol(theEnv,LongIntegerToString(theEnv,ValueToLong(GetValue(theArg))));
arrayOfStrings[i-1] = hashPtr;
IncrementSymbolCount(hashPtr);
break;
default:
ExpectedTypeError1(theEnv,functionName,i,"string, instance name, symbol, float, or integer");
SetEvaluationError(theEnv,TRUE);
break;
}
if (EvaluationData(theEnv)->EvaluationError)
{
for (i = 0; i < numArgs; i++)
{
if (arrayOfStrings[i] != NULL)
{ DecrementSymbolCount(theEnv,arrayOfStrings[i]); }
}
rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs);
return;
}
total += (int) strlen(ValueToString(arrayOfStrings[i - 1]));
}
/*=========================================================*/
/* Allocate the memory to store the concatenated string or */
/* symbol, then copy the values in the string array to the */
/* memory just allocated. */
/*=========================================================*/
theString = (char *) gm2(theEnv,(sizeof(char) * total));
j = 0;
for (i = 0 ; i < numArgs ; i++)
{
sprintf(&theString[j],"%s",ValueToString(arrayOfStrings[i]));
j += (int) strlen(ValueToString(arrayOfStrings[i]));
}
/*=========================================*/
/* Return the concatenated value and clean */
/* up the temporary memory used. */
/*=========================================*/
SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,theString));
rm(theEnv,theString,sizeof(char) * total);
for (i = 0; i < numArgs; i++)
{
if (arrayOfStrings[i] != NULL)
{ DecrementSymbolCount(theEnv,arrayOfStrings[i]); }
}
rm(theEnv,arrayOfStrings,sizeof(SYMBOL_HN *) * numArgs);
}
/***************************************************
NAME : DeallocateMarkedHandlers
DESCRIPTION : Removes any handlers from a class
that have been previously marked
for deletion.
INPUTS : The class
RETURNS : Nothing useful
SIDE EFFECTS : Marked handlers are deleted
NOTES : Assumes none of the handlers are
currently executing or have a
busy count != 0 for any reason
***************************************************/
globle void DeallocateMarkedHandlers(
void *theEnv,
EXEC_STATUS,
DEFCLASS *cls)
{
short count;
HANDLER *hnd,*nhnd;
unsigned *arr,*narr;
long i,j;
for (i = 0 , count = 0 ; i < cls->handlerCount ; i++)
{
hnd = &cls->handlers[i];
if (hnd->mark == 1)
{
count++;
DecrementSymbolCount(theEnv,execStatus,hnd->name);
ExpressionDeinstall(theEnv,execStatus,hnd->actions);
ReturnPackedExpression(theEnv,execStatus,hnd->actions);
ClearUserDataList(theEnv,execStatus,hnd->usrData);
if (hnd->ppForm != NULL)
rm(theEnv,execStatus,(void *) hnd->ppForm,
(sizeof(char) * (strlen(hnd->ppForm)+1)));
}
else
/* ============================================
Use the busy field to count how many
message-handlers are removed before this one
============================================ */
hnd->busy = count;
}
if (count == 0)
return;
if (count == cls->handlerCount)
{
rm(theEnv,execStatus,(void *) cls->handlers,(sizeof(HANDLER) * cls->handlerCount));
rm(theEnv,execStatus,(void *) cls->handlerOrderMap,(sizeof(unsigned) * cls->handlerCount));
cls->handlers = NULL;
cls->handlerOrderMap = NULL;
cls->handlerCount = 0;
}
else
{
count = (short) (cls->handlerCount - count);
hnd = cls->handlers;
arr = cls->handlerOrderMap;
nhnd = (HANDLER *) gm2(theEnv,execStatus,(sizeof(HANDLER) * count));
narr = (unsigned *) gm2(theEnv,execStatus,(sizeof(unsigned) * count));
for (i = 0 , j = 0 ; j < count ; i++)
{
if (hnd[arr[i]].mark == 0)
{
/* ==============================================================
The offsets in the map need to be decremented by the number of
preceding nodes which were deleted. Use the value of the busy
field set in the first loop.
============================================================== */
narr[j] = arr[i] - hnd[arr[i]].busy;
j++;
}
}
for (i = 0 , j = 0 ; j < count ; i++)
{
if (hnd[i].mark == 0)
{
hnd[i].busy = 0;
GenCopyMemory(HANDLER,1,&nhnd[j],&hnd[i]);
j++;
}
}
rm(theEnv,execStatus,(void *) hnd,(sizeof(HANDLER) * cls->handlerCount));
rm(theEnv,execStatus,(void *) arr,(sizeof(unsigned) * cls->handlerCount));
cls->handlers = nhnd;
cls->handlerOrderMap = narr;
cls->handlerCount = count;
}
}
globle void ReturnDefrule(
void *theEnv,
void *vWaste)
{
#if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theEnv,vWaste)
#endif
#if (! RUN_TIME) && (! BLOAD_ONLY)
struct defrule *waste = (struct defrule *) vWaste;
int first = TRUE;
struct defrule *nextPtr;
if (waste == NULL) return;
/*======================================*/
/* If a rule is redefined, then we want */
/* to save its breakpoint status. */
/*======================================*/
#if DEBUGGING_FUNCTIONS
DefruleData(theEnv)->DeletedRuleDebugFlags = 0;
if (waste->afterBreakpoint) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,0);
if (waste->watchActivation) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,1);
if (waste->watchFiring) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,2);
#endif
/*================================*/
/* Clear the agenda of all the */
/* activations added by the rule. */
/*================================*/
ClearRuleFromAgenda(theEnv,waste);
/*======================*/
/* Get rid of the rule. */
/*======================*/
while (waste != NULL)
{
/*================================================*/
/* Remove the rule's joins from the join network. */
/*================================================*/
DetachJoins(theEnv,waste,FALSE);
/*=============================================*/
/* If this is the first disjunct, get rid of */
/* the dynamic salience and pretty print form. */
/*=============================================*/
if (first)
{
#if DYNAMIC_SALIENCE
if (waste->dynamicSalience != NULL)
{
ExpressionDeinstall(theEnv,waste->dynamicSalience);
ReturnPackedExpression(theEnv,waste->dynamicSalience);
waste->dynamicSalience = NULL;
}
#endif
if (waste->header.ppForm != NULL)
{
rm(theEnv,waste->header.ppForm,strlen(waste->header.ppForm) + 1);
waste->header.ppForm = NULL;
}
first = FALSE;
}
/*===========================*/
/* Get rid of any user data. */
/*===========================*/
if (waste->header.usrData != NULL)
{ ClearUserDataList(theEnv,waste->header.usrData); }
/*===========================================*/
/* Decrement the count for the defrule name. */
/*===========================================*/
DecrementSymbolCount(theEnv,waste->header.name);
/*========================================*/
/* Get rid of the the rule's RHS actions. */
/*========================================*/
if (waste->actions != NULL)
{
ExpressionDeinstall(theEnv,waste->actions);
ReturnPackedExpression(theEnv,waste->actions);
}
/*===============================*/
/* Move on to the next disjunct. */
/*===============================*/
nextPtr = waste->disjunct;
rtn_struct(theEnv,defrule,waste);
waste = nextPtr;
}
/*==========================*/
/* Free up partial matches. */
/*==========================*/
if (EngineData(theEnv)->ExecutingRule == NULL) FlushGarbagePartialMatches(theEnv);
#endif
}
globle int LoadConstructsFromLogicalName(
void *theEnv,
char *readSource)
{
int constructFlag;
struct token theToken;
int noErrors = TRUE;
int foundConstruct;
/*=========================================*/
/* Reset the halt execution and evaluation */
/* error flags in preparation for parsing. */
/*=========================================*/
if (EvaluationData(theEnv)->CurrentEvaluationDepth == 0) SetHaltExecution(theEnv,FALSE);
SetEvaluationError(theEnv,FALSE);
/*========================================================*/
/* Find the beginning of the first construct in the file. */
/*========================================================*/
EvaluationData(theEnv)->CurrentEvaluationDepth++;
GetToken(theEnv,readSource,&theToken);
foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors);
/*==================================================*/
/* Parse the file until the end of file is reached. */
/*==================================================*/
while ((foundConstruct == TRUE) && (GetHaltExecution(theEnv) == FALSE))
{
/*===========================================================*/
/* Clear the pretty print buffer in preparation for parsing. */
/*===========================================================*/
FlushPPBuffer(theEnv);
/*======================*/
/* Parse the construct. */
/*======================*/
constructFlag = ParseConstruct(theEnv,ValueToString(theToken.value),readSource);
/*==============================================================*/
/* If an error occurred while parsing, then find the beginning */
/* of the next construct (but don't generate any more error */
/* messages--in effect, skip everything until another construct */
/* is found). */
/*==============================================================*/
if (constructFlag == 1)
{
EnvPrintRouter(theEnv,WERROR,"\nERROR:\n");
PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv));
EnvPrintRouter(theEnv,WERROR,"\n");
noErrors = FALSE;
GetToken(theEnv,readSource,&theToken);
foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,TRUE,&noErrors);
}
/*======================================================*/
/* Otherwise, find the beginning of the next construct. */
/*======================================================*/
else
{
GetToken(theEnv,readSource,&theToken);
foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors);
}
/*=====================================================*/
/* Yield time if necessary to foreground applications. */
/*=====================================================*/
if (foundConstruct)
{ IncrementSymbolCount(theToken.value); }
EvaluationData(theEnv)->CurrentEvaluationDepth--;
PeriodicCleanup(theEnv,FALSE,TRUE);
YieldTime(theEnv);
EvaluationData(theEnv)->CurrentEvaluationDepth++;
if (foundConstruct)
{ DecrementSymbolCount(theEnv,(SYMBOL_HN *) theToken.value); }
}
EvaluationData(theEnv)->CurrentEvaluationDepth--;
/*========================================================*/
/* Print a carriage return if a single character is being */
/* printed to indicate constructs are being processed. */
/*========================================================*/
#if DEBUGGING_FUNCTIONS
if ((EnvGetWatchItem(theEnv,"compilations") != TRUE) && GetPrintWhileLoading(theEnv))
#else
if (GetPrintWhileLoading(theEnv))
#endif
{ EnvPrintRouter(theEnv,WDIALOG,"\n"); }
/*=============================================================*/
/* Once the load is complete, destroy the pretty print buffer. */
/* This frees up any memory that was used to create the pretty */
/* print forms for constructs during parsing. Thus calls to */
/* the mem-used function will accurately reflect the amount of */
/* memory being used after a load command. */
/*=============================================================*/
DestroyPPBuffer(theEnv);
/*==========================================================*/
/* Return a boolean flag which indicates whether any errors */
/* were encountered while loading the constructs. */
/*==========================================================*/
return(noErrors);
}
/**************************************************************************
NAME : BuildCompositeFacets
DESCRIPTION : Composite slots are ones that get their facets
from more than one class. By default, the most
specific class in object's precedence list specifies
the complete set of facets for a slot. The composite
facet in a slot allows facets that are not overridden
by the most specific class to be obtained from other
classes.
Since all superclasses are predetermined before creating
a new class based on them, this routine need only
examine the immediately next most specific class for
extra facets. Even if that slot is also composite, the
other facets have already been filtered down. If the
slot is no-inherit, the next most specific class must
be examined.
INPUTS : 1) The slot descriptor
2) The class precedence list
3) The bitmap marking which facets were specified in
the original slot definition
RETURNS : Nothing useful
SIDE EFFECTS : Composite slot is updated to reflect facets from
a less specific class
NOTES : Assumes slot is composite
*************************************************************************/
static void BuildCompositeFacets(
void *theEnv,
EXEC_STATUS,
SLOT_DESC *sd,
PACKED_CLASS_LINKS *preclist,
char *specbits,
CONSTRAINT_PARSE_RECORD *parsedConstraint)
{
SLOT_DESC *compslot = NULL;
long i;
for (i = 1 ; i < preclist->classCount ; i++)
{
compslot = FindClassSlot(preclist->classArray[i],sd->slotName->name);
if ((compslot != NULL) ? (compslot->noInherit == 0) : FALSE)
break;
}
if (compslot != NULL)
{
if ((sd->defaultSpecified == 0) && (compslot->defaultSpecified == 1))
{
sd->dynamicDefault = compslot->dynamicDefault;
sd->noDefault = compslot->noDefault;
sd->defaultSpecified = 1;
if (compslot->defaultValue != NULL)
{
if (sd->dynamicDefault)
{
sd->defaultValue = (void *) PackExpression(theEnv,execStatus,(EXPRESSION *) compslot->defaultValue);
ExpressionInstall(theEnv,execStatus,(EXPRESSION *) sd->defaultValue);
}
else
{
sd->defaultValue = (void *) get_struct(theEnv,execStatus,dataObject);
GenCopyMemory(DATA_OBJECT,1,sd->defaultValue,compslot->defaultValue);
ValueInstall(theEnv,execStatus,(DATA_OBJECT *) sd->defaultValue);
}
}
}
if (TestBitMap(specbits,FIELD_BIT) == 0)
sd->multiple = compslot->multiple;
if (TestBitMap(specbits,STORAGE_BIT) == 0)
sd->shared = compslot->shared;
if (TestBitMap(specbits,ACCESS_BIT) == 0)
{
sd->noWrite = compslot->noWrite;
sd->initializeOnly = compslot->initializeOnly;
}
#if DEFRULE_CONSTRUCT
if (TestBitMap(specbits,MATCH_BIT) == 0)
sd->reactive = compslot->reactive;
#endif
if (TestBitMap(specbits,VISIBILITY_BIT) == 0)
sd->publicVisibility = compslot->publicVisibility;
if (TestBitMap(specbits,CREATE_ACCESSOR_BIT) == 0)
{
sd->createReadAccessor = compslot->createReadAccessor;
sd->createWriteAccessor = compslot->createWriteAccessor;
}
if ((TestBitMap(specbits,OVERRIDE_MSG_BIT) == 0) &&
compslot->overrideMessageSpecified)
{
DecrementSymbolCount(theEnv,execStatus,sd->overrideMessage);
sd->overrideMessage = compslot->overrideMessage;
IncrementSymbolCount(sd->overrideMessage);
sd->overrideMessageSpecified = TRUE;
}
OverlayConstraint(theEnv,execStatus,parsedConstraint,sd->constraint,compslot->constraint);
}
}
globle void ReturnDefrule(
void *theEnv,
void *vWaste)
{
#if (! RUN_TIME) && (! BLOAD_ONLY)
struct defrule *waste = (struct defrule *) vWaste;
int first = TRUE;
struct defrule *nextPtr, *tmpPtr;
if (waste == NULL) return;
/*======================================*/
/* If a rule is redefined, then we want */
/* to save its breakpoint status. */
/*======================================*/
#if DEBUGGING_FUNCTIONS
DefruleData(theEnv)->DeletedRuleDebugFlags = 0;
if (waste->afterBreakpoint) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,0);
if (waste->watchActivation) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,1);
if (waste->watchFiring) BitwiseSet(DefruleData(theEnv)->DeletedRuleDebugFlags,2);
#endif
/*================================*/
/* Clear the agenda of all the */
/* activations added by the rule. */
/*================================*/
ClearRuleFromAgenda(theEnv,waste);
/*======================*/
/* Get rid of the rule. */
/*======================*/
while (waste != NULL)
{
/*================================================*/
/* Remove the rule's joins from the join network. */
/*================================================*/
DetachJoinsDriver(theEnv,waste,FALSE);
/*=============================================*/
/* If this is the first disjunct, get rid of */
/* the dynamic salience and pretty print form. */
/*=============================================*/
if (first)
{
if (waste->dynamicSalience != NULL)
{
ExpressionDeinstall(theEnv,waste->dynamicSalience);
ReturnPackedExpression(theEnv,waste->dynamicSalience);
waste->dynamicSalience = NULL;
}
#if CERTAINTY_FACTORS /* changed 03-12-96 */
if (waste->dynamicCF != NULL)
{
ExpressionDeinstall(theEnv,waste->dynamicCF);
ReturnPackedExpression(theEnv,waste->dynamicCF);
waste->dynamicCF = NULL;
}
#endif
if (waste->header.ppForm != NULL)
{
rm(theEnv,(void *) waste->header.ppForm,strlen(waste->header.ppForm) + 1);
waste->header.ppForm = NULL;
/*=======================================================*/
/* All of the rule disjuncts share the same pretty print */
/* form, so we want to avoid deleting it again. */
/*=======================================================*/
for (tmpPtr = waste->disjunct; tmpPtr != NULL; tmpPtr = tmpPtr->disjunct)
{ tmpPtr->header.ppForm = NULL; }
}
first = FALSE;
}
/*===========================*/
/* Get rid of any user data. */
/*===========================*/
if (waste->header.usrData != NULL)
{ ClearUserDataList(theEnv,waste->header.usrData); }
/*===========================================*/
/* Decrement the count for the defrule name. */
/*===========================================*/
DecrementSymbolCount(theEnv,waste->header.name);
/*========================================*/
/* Get rid of the the rule's RHS actions. */
/*========================================*/
if (waste->actions != NULL)
{
ExpressionDeinstall(theEnv,waste->actions);
ReturnPackedExpression(theEnv,waste->actions);
}
/*===============================*/
/* Move on to the next disjunct. */
/*===============================*/
nextPtr = waste->disjunct;
#if FUZZY_DEFTEMPLATES
if (waste != EngineData(theEnv)->ExecutingRule)
{
if (waste->numberOfFuzzySlots > 0)
rm(theEnv,waste->pattern_fv_arrayPtr, sizeof(struct fzSlotLocator) * waste->numberOfFuzzySlots);
}
#endif
rtn_struct(theEnv,defrule,waste);
waste = nextPtr;
}
/*==========================*/
/* Free up partial matches. */
/*==========================*/
if (EngineData(theEnv)->ExecutingRule == NULL) FlushGarbagePartialMatches(theEnv);
#endif
}
/*******************************************************
NAME : UnmarkConstructHeader
DESCRIPTION : Releases any ephemerals (symbols, etc.)
of a construct header for removal
INPUTS : The construct header
RETURNS : Nothing useful
SIDE EFFECTS : Busy counts fo ephemerals decremented
NOTES : None
*******************************************************/
globle void UnmarkConstructHeader(
struct constructHeader *theConstruct)
{
DecrementSymbolCount(theConstruct->name);
}
