/***************************************************
NAME : SetupMessageHandlers
DESCRIPTION : Sets up internal symbols and
fucntion definitions pertaining to
message-handlers. Also creates
system handlers
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Functions and data structures
initialized
NOTES : Should be called before
SetupInstanceModDupCommands() in
INSMODDP.C
***************************************************/
globle void SetupMessageHandlers()
{
InstallPrimitive(&HandlerGetInfo,HANDLER_GET);
InstallPrimitive(&HandlerPutInfo,HANDLER_PUT);
#if ! RUN_TIME
INIT_SYMBOL = (SYMBOL_HN *) AddSymbol(INIT_STRING);
IncrementSymbolCount(INIT_SYMBOL);
DELETE_SYMBOL = (SYMBOL_HN *) AddSymbol(DELETE_STRING);
IncrementSymbolCount(DELETE_SYMBOL);
AddClearFunction("defclass",CreateSystemHandlers,-100);
#if ! BLOAD_ONLY
SELF_SYMBOL = (SYMBOL_HN *) AddSymbol(SELF_STRING);
IncrementSymbolCount(SELF_SYMBOL);
AddConstruct("defmessage-handler","defmessage-handlers",
ParseDefmessageHandler,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
DefineFunction2("undefmessage-handler",'v',PTIF UndefmessageHandlerCommand,
"UndefmessageHandlerCommand","23w");
#endif
DefineFunction2("send",'u',PTIF SendCommand,"SendCommand","2*uuw");
#if DEBUGGING_FUNCTIONS
DefineFunction2("preview-send",'v',PTIF PreviewSendCommand,"PreviewSendCommand","22w");
DefineFunction2("ppdefmessage-handler",'v',PTIF PPDefmessageHandlerCommand,
"PPDefmessageHandlerCommand","23w");
DefineFunction2("list-defmessage-handlers",'v',PTIF ListDefmessageHandlersCommand,
"ListDefmessageHandlersCommand","02w");
#endif
#if IMPERATIVE_MESSAGE_HANDLERS
DefineFunction2("next-handlerp",'b',PTIF NextHandlerAvailable,"NextHandlerAvailable","00");
FuncSeqOvlFlags("next-handlerp",TRUE,FALSE);
DefineFunction2("call-next-handler",'u',
PTIF CallNextHandler,"CallNextHandler","00");
FuncSeqOvlFlags("call-next-handler",TRUE,FALSE);
DefineFunction2("override-next-handler",'u',
PTIF CallNextHandler,"CallNextHandler",NULL);
FuncSeqOvlFlags("override-next-handler",TRUE,FALSE);
#endif
DefineFunction2("dynamic-get",'u',PTIF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w");
DefineFunction2("dynamic-put",'u',PTIF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w");
DefineFunction2("get",'u',PTIF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w");
DefineFunction2("put",'u',PTIF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w");
#endif
#if DEBUGGING_FUNCTIONS
AddWatchItem("messages",0,&WatchMessages,36,NULL,NULL);
AddWatchItem("message-handlers",0,&WatchHandlers,35,
DefmessageHandlerWatchAccess,DefmessageHandlerWatchPrint);
#endif
}
/**********************************************************
NAME : SetupObjectSystem
DESCRIPTION : Initializes all COOL constructs, functions,
and data structures
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : COOL initialized
NOTES : Order of setup calls is important
**********************************************************/
globle void SetupObjectSystem(
void *theEnv)
{
ENTITY_RECORD defclassEntityRecord = { (char*)"DEFCLASS_PTR", DEFCLASS_PTR,1,0,0,
NULL,NULL,NULL,NULL,NULL,
DecrementDefclassBusyCount,
IncrementDefclassBusyCount,
NULL,NULL,NULL,NULL,NULL
};
AllocateEnvironmentData(theEnv,DEFCLASS_DATA,sizeof(struct defclassData),NULL);
AddEnvironmentCleanupFunction(theEnv,(char*)"defclasses",DeallocateDefclassData,-500);
memcpy(&DefclassData(theEnv)->DefclassEntityRecord,&defclassEntityRecord,sizeof(struct entityRecord));
#if ! RUN_TIME
DefclassData(theEnv)->ClassDefaultsMode = CONVENIENCE_MODE;
DefclassData(theEnv)->ISA_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,SUPERCLASS_RLN);
IncrementSymbolCount(DefclassData(theEnv)->ISA_SYMBOL);
DefclassData(theEnv)->NAME_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,NAME_RLN);
IncrementSymbolCount(DefclassData(theEnv)->NAME_SYMBOL);
#if DEFRULE_CONSTRUCT
DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,INITIAL_OBJECT_NAME);
IncrementSymbolCount(DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);
#endif
#endif
SetupDefclasses(theEnv);
SetupInstances(theEnv);
SetupMessageHandlers(theEnv);
#if DEFINSTANCES_CONSTRUCT
SetupDefinstances(theEnv);
#endif
#if INSTANCE_SET_QUERIES
SetupQuery(theEnv);
#endif
#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
SetupObjectsBload(theEnv);
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
SetupObjectsCompiler(theEnv);
#endif
#if DEFRULE_CONSTRUCT
SetupObjectPatternStuff(theEnv);
#endif
}
/**************************************************************
NAME : NewSlot
DESCRIPTION : Allocates and initalizes a new slot structure
INPUTS : The symbolic name of the new slot
RETURNS : The address of the new slot
SIDE EFFECTS : None
NOTES : Also adds symbols of the form get-<name> and
put-<name> for slot accessors
**************************************************************/
static SLOT_DESC *NewSlot(
void *theEnv,
EXEC_STATUS,
SYMBOL_HN *name)
{
SLOT_DESC *slot;
slot = get_struct(theEnv,execStatus,slotDescriptor);
slot->dynamicDefault = 1;
slot->defaultSpecified = 0;
slot->noDefault = 0;
#if DEFRULE_CONSTRUCT
slot->reactive = 1;
#endif
slot->noInherit = 0;
slot->noWrite = 0;
slot->initializeOnly = 0;
slot->shared = 0;
slot->multiple = 0;
slot->composite = 0;
slot->sharedCount = 0;
slot->publicVisibility = 0;
slot->createReadAccessor = FALSE;
slot->createWriteAccessor = FALSE;
slot->overrideMessageSpecified = 0;
slot->cls = NULL;
slot->defaultValue = NULL;
slot->constraint = GetConstraintRecord(theEnv,execStatus);
slot->slotName = AddSlotName(theEnv,execStatus,name,0,FALSE);
slot->overrideMessage = slot->slotName->putHandlerName;
IncrementSymbolCount(slot->overrideMessage);
return(slot);
}
/***************************************************
NAME : UpdateConstructHeader
DESCRIPTION : Determines field values for
construct header from binary-load
buffer
INPUTS : 1) The binary-load data for the
construct header
2) The actual construct header
3) The size of a defmodule item for
this construct
4) The array of all defmodule items
for this construct
5) The size of this construct
6) The array of these constructs
RETURNS : Nothing useful
SIDE EFFECTS : Header values set
NOTES : None
***************************************************/
LOCALE void UpdateConstructHeader(
struct bsaveConstructHeader *theBsaveConstruct,
struct constructHeader *theConstruct,
int itemModuleSize,
void *itemModuleArray,
int itemSize,
void *itemArray)
{
long moduleOffset, itemOffset;
moduleOffset = itemModuleSize * theBsaveConstruct->whichModule;
theConstruct->whichModule =
(struct defmoduleItemHeader *) &((char *) itemModuleArray)[moduleOffset];
theConstruct->name = SymbolPointer(theBsaveConstruct->name);
IncrementSymbolCount(theConstruct->name);
if (theBsaveConstruct->next != -1L)
{
itemOffset = itemSize * theBsaveConstruct->next;
theConstruct->next = (struct constructHeader *) &((char *) itemArray)[itemOffset];
}
else
theConstruct->next = NULL;
theConstruct->ppForm = NULL;
theConstruct->bsaveID = 0L;
theConstruct->usrData = NULL;
}
static void UpdateDeftemplateSlot(
void *theEnv,
void *buf,
long obji)
{
struct templateSlot *theSlot;
struct bsaveTemplateSlot *btsPtr;
btsPtr = (struct bsaveTemplateSlot *) buf;
theSlot = (struct templateSlot *) &DeftemplateBinaryData(theEnv)->SlotArray[obji];
theSlot->slotName = SymbolPointer(btsPtr->slotName);
IncrementSymbolCount(theSlot->slotName);
theSlot->defaultList = HashedExpressionPointer(btsPtr->defaultList);
theSlot->facetList = HashedExpressionPointer(btsPtr->facetList);
theSlot->constraints = ConstraintPointer(btsPtr->constraints);
theSlot->multislot = btsPtr->multislot;
theSlot->noDefault = btsPtr->noDefault;
theSlot->defaultPresent = btsPtr->defaultPresent;
theSlot->defaultDynamic = btsPtr->defaultDynamic;
if (btsPtr->next != -1L)
{ theSlot->next = (struct templateSlot *) &DeftemplateBinaryData(theEnv)->SlotArray[obji + 1]; }
else
{ theSlot->next = NULL; }
}
globle int DefineFunction2(
char *name,
int returnType,
int (*pointer)(void),
char *actualName,
char *restrictions)
{
struct FunctionDefinition *newFunction;
if ( (returnType != 'a') &&
(returnType != 'b') &&
(returnType != 'c') &&
(returnType != 'd') &&
(returnType != 'f') &&
(returnType != 'i') &&
(returnType != 'j') &&
(returnType != 'k') &&
(returnType != 'l') &&
(returnType != 'm') &&
(returnType != 'n') &&
#if OBJECT_SYSTEM
(returnType != 'o') &&
#endif
(returnType != 's') &&
(returnType != 'u') &&
(returnType != 'v') &&
#if OBJECT_SYSTEM
(returnType != 'x') &&
#endif
(returnType != 'w') )
{ return(0); }
newFunction = get_struct(FunctionDefinition);
newFunction->callFunctionName = (SYMBOL_HN *) AddSymbol(name);
newFunction->returnValueType = (char) returnType;
newFunction->functionPointer = pointer;
newFunction->next = GetFunctionList();
newFunction->actualFunctionName = actualName;
if (restrictions != NULL)
{
if (((int) (strlen(restrictions)) < 2) ? TRUE :
((! isdigit(restrictions[0]) && (restrictions[0] != '*')) ||
(! isdigit(restrictions[1]) && (restrictions[1] != '*'))))
restrictions = NULL;
}
newFunction->restrictions = restrictions;
newFunction->parser = NULL;
newFunction->overloadable = TRUE;
newFunction->sequenceuseok = TRUE;
newFunction->usrData = NULL;
IncrementSymbolCount(newFunction->callFunctionName);
ListOfFunctions = newFunction;
AddHashFunction(newFunction);
return(1);
}
static void UpdateSlotName(
void *buf,
long obji)
{
SLOT_NAME *snp;
BSAVE_SLOT_NAME *bsnp;
bsnp = (BSAVE_SLOT_NAME *) buf;
snp = (SLOT_NAME *) &slotNameArray[obji];
snp->id = bsnp->id;
snp->name = SymbolPointer(bsnp->name);
IncrementSymbolCount(snp->name);
snp->putHandlerName = SymbolPointer(bsnp->putHandlerName);
IncrementSymbolCount(snp->putHandlerName);
snp->hashTableIndex = bsnp->hashTableIndex;
snp->nxt = SlotNameTable[snp->hashTableIndex];
SlotNameTable[snp->hashTableIndex] = snp;
}
globle void InstallDeftemplate(
void *theEnv,
struct deftemplate *theDeftemplate)
{
struct templateSlot *slotPtr;
struct expr *tempExpr;
IncrementSymbolCount(theDeftemplate->header.name);
for (slotPtr = theDeftemplate->slotList;
slotPtr != NULL;
slotPtr = slotPtr->next)
{
IncrementSymbolCount(slotPtr->slotName);
tempExpr = AddHashedExpression(theEnv,slotPtr->defaultList);
ReturnExpression(theEnv,slotPtr->defaultList);
slotPtr->defaultList = tempExpr;
slotPtr->constraints = AddConstraint(theEnv,slotPtr->constraints);
}
}
static void UpdateDefmodule(
void *theEnv,
void *buf,
long obji)
{
struct bsaveDefmodule *bdp;
struct moduleItem *theItem;
int i;
bdp = (struct bsaveDefmodule *) buf;
DefmoduleData(theEnv)->DefmoduleArray[obji].name = SymbolPointer(bdp->name);
IncrementSymbolCount(DefmoduleData(theEnv)->DefmoduleArray[obji].name);
if (bdp->next != -1L)
{ DefmoduleData(theEnv)->DefmoduleArray[obji].next = (struct defmodule *) &DefmoduleData(theEnv)->DefmoduleArray[bdp->next]; }
else
{ DefmoduleData(theEnv)->DefmoduleArray[obji].next = NULL; }
if (GetNumberOfModuleItems(theEnv) == 0)
{ DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray = NULL; }
else
{
DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray =
(struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * GetNumberOfModuleItems(theEnv));
}
for (i = 0, theItem = GetListOfModuleItems(theEnv);
(i < GetNumberOfModuleItems(theEnv)) && (theItem != NULL) ;
i++, theItem = theItem->next)
{
if (theItem->bloadModuleReference == NULL)
{ DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray[i] = NULL; }
else
{
DefmoduleData(theEnv)->DefmoduleArray[obji].itemsArray[i] =
(struct defmoduleItemHeader *)
(*theItem->bloadModuleReference)(theEnv,obji);
}
}
DefmoduleData(theEnv)->DefmoduleArray[obji].ppForm = NULL;
if (bdp->importList != -1L)
{ DefmoduleData(theEnv)->DefmoduleArray[obji].importList = (struct portItem *) &DefmoduleData(theEnv)->PortItemArray[bdp->importList]; }
else
{ DefmoduleData(theEnv)->DefmoduleArray[obji].importList = NULL; }
if (bdp->exportList != -1L)
{ DefmoduleData(theEnv)->DefmoduleArray[obji].exportList = (struct portItem *) &DefmoduleData(theEnv)->PortItemArray[bdp->exportList]; }
else
{ DefmoduleData(theEnv)->DefmoduleArray[obji].exportList = NULL; }
DefmoduleData(theEnv)->DefmoduleArray[obji].bsaveID = bdp->bsaveID;
}
static void UpdatePortItem(
void *theEnv,
void *buf,
long obji)
{
struct bsavePortItem *bdp;
bdp = (struct bsavePortItem *) buf;
if (bdp->moduleName != -1L)
{
DefmoduleData(theEnv)->PortItemArray[obji].moduleName = SymbolPointer(bdp->moduleName);
IncrementSymbolCount(DefmoduleData(theEnv)->PortItemArray[obji].moduleName);
}
else
{ DefmoduleData(theEnv)->PortItemArray[obji].moduleName = NULL; }
if (bdp->constructType != -1L)
{
DefmoduleData(theEnv)->PortItemArray[obji].constructType = SymbolPointer(bdp->constructType);
IncrementSymbolCount(DefmoduleData(theEnv)->PortItemArray[obji].constructType);
}
else
{ DefmoduleData(theEnv)->PortItemArray[obji].constructType = NULL; }
if (bdp->constructName != -1L)
{
DefmoduleData(theEnv)->PortItemArray[obji].constructName = SymbolPointer(bdp->constructName);
IncrementSymbolCount(DefmoduleData(theEnv)->PortItemArray[obji].constructName);
}
else
{ DefmoduleData(theEnv)->PortItemArray[obji].constructName = NULL; }
if (bdp->next != -1L)
{ DefmoduleData(theEnv)->PortItemArray[obji].next = (struct portItem *) &DefmoduleData(theEnv)->PortItemArray[bdp->next]; }
else
{ DefmoduleData(theEnv)->PortItemArray[obji].next = NULL; }
}
static void UpdateSlot(
void *buf,
long obji)
{
SLOT_DESC *sp;
BSAVE_SLOT_DESC *bsp;
sp = (SLOT_DESC *) &slotArray[obji];
bsp = (BSAVE_SLOT_DESC *) buf;
sp->dynamicDefault = bsp->dynamicDefault;
sp->noDefault = bsp->noDefault;
sp->shared = bsp->shared;
sp->multiple = bsp->multiple;
sp->composite = bsp->composite;
sp->noInherit = bsp->noInherit;
sp->noWrite = bsp->noWrite;
sp->initializeOnly = bsp->initializeOnly;
sp->reactive = bsp->reactive;
sp->publicVisibility = bsp->publicVisibility;
sp->createReadAccessor = bsp->createReadAccessor;
sp->createWriteAccessor = bsp->createWriteAccessor;
sp->cls = DefclassPointer(bsp->cls);
sp->slotName = SlotNamePointer(bsp->slotName);
sp->overrideMessage = SymbolPointer(bsp->overrideMessage);
IncrementSymbolCount(sp->overrideMessage);
if (bsp->defaultValue != -1L)
{
if (sp->dynamicDefault)
sp->defaultValue = (void *) ExpressionPointer(bsp->defaultValue);
else
{
sp->defaultValue = (void *) get_struct(dataObject);
EvaluateAndStoreInDataObject((int) sp->multiple,ExpressionPointer(bsp->defaultValue),
(DATA_OBJECT *) sp->defaultValue);
ValueInstall((DATA_OBJECT *) sp->defaultValue);
}
}
else
sp->defaultValue = NULL;
sp->constraint = ConstraintPointer(bsp->constraint);
sp->sharedCount = 0;
sp->sharedValue.value = NULL;
sp->bsaveIndex = 0L;
if (sp->shared)
{
sp->sharedValue.desc = sp;
sp->sharedValue.value = NULL;
}
}
globle void AtomInstall(
int type,
void *vPtr)
{
switch (type)
{
case SYMBOL:
case STRING:
#if DEFGLOBAL_CONSTRUCT
case GBL_VARIABLE:
#endif
#if OBJECT_SYSTEM
case INSTANCE_NAME:
#endif
IncrementSymbolCount(vPtr);
break;
case FLOAT:
IncrementFloatCount(vPtr);
break;
case INTEGER:
IncrementIntegerCount(vPtr);
break;
case MULTIFIELD:
MultifieldInstall((struct multifield *) vPtr);
break;
#if FUZZY_DEFTEMPLATES
/* fuzzy values have a name which is a symbol */
case FUZZY_VALUE:
InstallFuzzyValue(vPtr);
break;
#endif
case RVOID:
break;
default:
if (PrimitivesArray[type] == NULL) break;
if (PrimitivesArray[type]->bitMap) IncrementBitMapCount(vPtr);
else if (PrimitivesArray[type]->incrementBusyCount)
{ (*PrimitivesArray[type]->incrementBusyCount)(vPtr); }
break;
}
}
globle void AtomInstall(
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
IncrementSymbolCount(vPtr);
break;
case FLOAT:
IncrementFloatCount(vPtr);
break;
case INTEGER:
IncrementIntegerCount(vPtr);
break;
case EXTERNAL_ADDRESS:
IncrementExternalAddressCount(vPtr);
break;
case MULTIFIELD:
MultifieldInstall(theEnv,(struct multifield *) vPtr);
break;
case RVOID:
break;
default:
if (EvaluationData(theEnv)->PrimitivesArray[type] == NULL) break;
if (EvaluationData(theEnv)->PrimitivesArray[type]->bitMap) IncrementBitMapCount(vPtr);
else if (EvaluationData(theEnv)->PrimitivesArray[type]->incrementBusyCount)
{ (*EvaluationData(theEnv)->PrimitivesArray[type]->incrementBusyCount)(theEnv,vPtr); }
break;
}
}
/*********************************************************
NAME : AddSystemClass
DESCRIPTION : Performs all necessary allocations
for adding a system class
INPUTS : 1) The name-string of the system class
2) The address of the parent class
(NULL if none)
RETURNS : The address of the new system class
SIDE EFFECTS : Allocations performed
NOTES : Assumes system-class name is unique
Also assumes SINGLE INHERITANCE for
system classes to simplify precedence
list determination
Adds classes to has table but NOT to
class list (this is responsibility
of caller)
*********************************************************/
static DEFCLASS *AddSystemClass(
void *theEnv,
char *name,
DEFCLASS *parent)
{
DEFCLASS *sys;
long i;
char defaultScopeMap[1];
sys = NewClass(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,name));
sys->abstract = 1;
#if DEFRULE_CONSTRUCT
sys->reactive = 0;
#endif
IncrementSymbolCount(sys->header.name);
sys->installed = 1;
sys->system = 1;
sys->hashTableIndex = HashClass(sys->header.name);
AddClassLink(theEnv,&sys->allSuperclasses,sys,-1);
if (parent != NULL)
{
AddClassLink(theEnv,&sys->directSuperclasses,parent,-1);
AddClassLink(theEnv,&parent->directSubclasses,sys,-1);
AddClassLink(theEnv,&sys->allSuperclasses,parent,-1);
for (i = 1 ; i < parent->allSuperclasses.classCount ; i++)
AddClassLink(theEnv,&sys->allSuperclasses,parent->allSuperclasses.classArray[i],-1);
}
sys->nxtHash = DefclassData(theEnv)->ClassTable[sys->hashTableIndex];
DefclassData(theEnv)->ClassTable[sys->hashTableIndex] = sys;
/* =========================================
Add default scope maps for a system class
There is only one module (MAIN) so far -
which has an id of 0
========================================= */
ClearBitString((void *) defaultScopeMap,(int) sizeof(char));
SetBitMap(defaultScopeMap,0);
#if DEFMODULE_CONSTRUCT
sys->scopeMap = (BITMAP_HN *) EnvAddBitMap(theEnv,(void *) defaultScopeMap,(int) sizeof(char));
IncrementBitMapCount(sys->scopeMap);
#endif
return(sys);
}
/****************************************************
NAME : SetupFactQuery
DESCRIPTION : Initializes fact query H/L
functions and parsers
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Sets up kernel functions and parsers
NOTES : None
****************************************************/
globle void SetupFactQuery(
void *theEnv)
{
AllocateEnvironmentData(theEnv,FACT_QUERY_DATA,sizeof(struct factQueryData),NULL);
#if RUN_TIME
FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = FindSymbolHN(theEnv,QUERY_DELIMETER_STRING);
#endif
#if ! RUN_TIME
FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,QUERY_DELIMETER_STRING);
IncrementSymbolCount(FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL);
EnvDefineFunction2(theEnv,"(query-fact)",'u',
PTIEF GetQueryFact,"GetQueryFact",NULL);
EnvDefineFunction2(theEnv,"(query-fact-slot)",'u',
PTIEF GetQueryFactSlot,"GetQueryFactSlot",NULL);
EnvDefineFunction2(theEnv,"any-factp",'b',PTIEF AnyFacts,"AnyFacts",NULL);
AddFunctionParser(theEnv,"any-factp",FactParseQueryNoAction);
EnvDefineFunction2(theEnv,"find-fact",'m',
PTIEF QueryFindFact,"QueryFindFact",NULL);
AddFunctionParser(theEnv,"find-fact",FactParseQueryNoAction);
EnvDefineFunction2(theEnv,"find-all-facts",'m',
PTIEF QueryFindAllFacts,"QueryFindAllFacts",NULL);
AddFunctionParser(theEnv,"find-all-facts",FactParseQueryNoAction);
EnvDefineFunction2(theEnv,"do-for-fact",'u',
PTIEF QueryDoForFact,"QueryDoForFact",NULL);
AddFunctionParser(theEnv,"do-for-fact",FactParseQueryAction);
EnvDefineFunction2(theEnv,"do-for-all-facts",'u',
PTIEF QueryDoForAllFacts,"QueryDoForAllFacts",NULL);
AddFunctionParser(theEnv,"do-for-all-facts",FactParseQueryAction);
EnvDefineFunction2(theEnv,"delayed-do-for-all-facts",'u',
PTIEF DelayedQueryDoForAllFacts,
"DelayedQueryDoForAllFacts",NULL);
AddFunctionParser(theEnv,"delayed-do-for-all-facts",FactParseQueryAction);
#endif
}
static void ClearDeffacts(
void *theEnv)
{
#if (! RUN_TIME) && (! BLOAD_ONLY)
struct expr *stub;
struct deffacts *newDeffacts;
/*=====================================*/
/* Create the data structures for the */
/* expression (assert (initial-fact)). */
/*=====================================*/
stub = GenConstant(theEnv,FCALL,FindFunction(theEnv,"assert"));
stub->argList = GenConstant(theEnv,DEFTEMPLATE_PTR,EnvFindDeftemplate(theEnv,"initial-fact"));
ExpressionInstall(theEnv,stub);
/*=============================================*/
/* Create a deffacts data structure to contain */
/* the expression and initialize it. */
/*=============================================*/
newDeffacts = get_struct(theEnv,deffacts);
newDeffacts->header.whichModule =
(struct defmoduleItemHeader *) GetDeffactsModuleItem(theEnv,NULL);
newDeffacts->header.name = (SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact");
IncrementSymbolCount(newDeffacts->header.name);
newDeffacts->assertList = PackExpression(theEnv,stub);
newDeffacts->header.next = NULL;
newDeffacts->header.ppForm = NULL;
newDeffacts->header.usrData = NULL;
ReturnExpression(theEnv,stub);
/*===========================================*/
/* Store the deffacts in the current module. */
/*===========================================*/
AddConstructToModule(&newDeffacts->header);
#else
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(theEnv)
#endif
#endif
}
static void UpdateHandler(
void *buf,
long obji)
{
HANDLER *hnd;
BSAVE_HANDLER *bhnd;
hnd = (HANDLER *) &handlerArray[obji];
bhnd = (BSAVE_HANDLER *) buf;
hnd->system = bhnd->system;
hnd->type = bhnd->type;
#if (! IMPERATIVE_MESSAGE_HANDLERS)
if (hnd->type == MAROUND)
{
PrintWarningID("OBJBIN",1,FALSE);
PrintRouter(WWARNING,"Around message-handlers are not\n");
PrintRouter(WWARNING," supported in this environment.");
}
#endif
#if (! AUXILIARY_MESSAGE_HANDLERS)
if ((hnd->type == MBEFORE) || (hnd->type == MAFTER))
{
PrintWarningID("OBJBIN",2,FALSE);
PrintRouter(WWARNING,"Before and after message-handlers are not\n");
PrintRouter(WWARNING," supported in this environment.");
}
#endif
hnd->minParams = bhnd->minParams;
hnd->maxParams = bhnd->maxParams;
hnd->localVarCount = bhnd->localVarCount;
hnd->cls = DefclassPointer(bhnd->cls);
hnd->name = SymbolPointer(bhnd->name);
IncrementSymbolCount(hnd->name);
hnd->actions = ExpressionPointer(bhnd->actions);
hnd->ppForm = NULL;
hnd->busy = 0;
hnd->mark = 0;
hnd->usrData = NULL;
#if DEBUGGING_FUNCTIONS
hnd->trace = WatchHandlers;
#endif
}
/********************************************************
NAME : CreateInitialDefinstances
DESCRIPTION : Makes the initial-object definstances
structure for creating an initial-object
which will match default object patterns
in defrules
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : initial-object definstances created
NOTES : None
********************************************************/
static void CreateInitialDefinstances(
void *theEnv)
{
EXPRESSION *tmp;
DEFINSTANCES *theDefinstances;
theDefinstances = get_struct(theEnv,definstances);
InitializeConstructHeader(theEnv,(char*)"definstances",(struct constructHeader *) theDefinstances,
DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);
theDefinstances->busy = 0;
tmp = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,(char*)"make-instance"));
tmp->argList = GenConstant(theEnv,INSTANCE_NAME,(void *) DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL);
tmp->argList->nextArg =
GenConstant(theEnv,DEFCLASS_PTR,(void *) LookupDefclassInScope(theEnv,INITIAL_OBJECT_CLASS_NAME));
theDefinstances->mkinstance = PackExpression(theEnv,tmp);
ReturnExpression(theEnv,tmp);
IncrementSymbolCount(GetDefinstancesNamePointer((void *) theDefinstances));
ExpressionInstall(theEnv,theDefinstances->mkinstance);
AddConstructToModule((struct constructHeader *) theDefinstances);
}
/****************************************************
NAME : SetupQuery
DESCRIPTION : Initializes instance query H/L
functions and parsers
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Sets up kernel functions and parsers
NOTES : None
****************************************************/
globle void SetupQuery(
void *theEnv,
EXEC_STATUS)
{
AllocateEnvironmentData(theEnv,execStatus,INSTANCE_QUERY_DATA,sizeof(struct instanceQueryData),NULL);
#if ! RUN_TIME
InstanceQueryData(theEnv,execStatus)->QUERY_DELIMETER_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,QUERY_DELIMETER_STRING);
IncrementSymbolCount(InstanceQueryData(theEnv,execStatus)->QUERY_DELIMETER_SYMBOL);
EnvDefineFunction2(theEnv,execStatus,"(query-instance)",'o',
PTIEF GetQueryInstance,"GetQueryInstance",NULL);
EnvDefineFunction2(theEnv,execStatus,"(query-instance-slot)",'u',
PTIEF GetQueryInstanceSlot,"GetQueryInstanceSlot",NULL);
EnvDefineFunction2(theEnv,execStatus,"any-instancep",'b',PTIEF AnyInstances,"AnyInstances",NULL);
AddFunctionParser(theEnv,execStatus,"any-instancep",ParseQueryNoAction);
EnvDefineFunction2(theEnv,execStatus,"find-instance",'m',
PTIEF QueryFindInstance,"QueryFindInstance",NULL);
AddFunctionParser(theEnv,execStatus,"find-instance",ParseQueryNoAction);
EnvDefineFunction2(theEnv,execStatus,"find-all-instances",'m',
PTIEF QueryFindAllInstances,"QueryFindAllInstances",NULL);
AddFunctionParser(theEnv,execStatus,"find-all-instances",ParseQueryNoAction);
EnvDefineFunction2(theEnv,execStatus,"do-for-instance",'u',
PTIEF QueryDoForInstance,"QueryDoForInstance",NULL);
AddFunctionParser(theEnv,execStatus,"do-for-instance",ParseQueryAction);
EnvDefineFunction2(theEnv,execStatus,"do-for-all-instances",'u',
PTIEF QueryDoForAllInstances,"QueryDoForAllInstances",NULL);
AddFunctionParser(theEnv,execStatus,"do-for-all-instances",ParseQueryAction);
EnvDefineFunction2(theEnv,execStatus,"delayed-do-for-all-instances",'u',
PTIEF DelayedQueryDoForAllInstances,
"DelayedQueryDoForAllInstances",NULL);
AddFunctionParser(theEnv,execStatus,"delayed-do-for-all-instances",ParseQueryAction);
#endif
}
/******************************************************************************
NAME : NewSystemHandler
DESCRIPTION : Adds a new system handler for a system class
The handler is assumed to be primary and of
the form:
(defmessage-handler <class> <handler> () (<func>))
INPUTS : 1) Name-string of the system class
2) Name-string of the system handler
3) Name-string of the internal H/L function to implement
this handler
4) The number of extra arguments (past the instance itself)
that the handler willl accept
RETURNS : Nothing useful
SIDE EFFECTS : Creates the new handler and inserts it in the system class's
handler array
On errors, generate a system error and exits.
NOTES : Does not check to see if handler already exists
*******************************************************************************/
globle void NewSystemHandler(
void *theEnv,
EXEC_STATUS,
char *cname,
char *mname,
char *fname,
int extraargs)
{
DEFCLASS *cls;
HANDLER *hnd;
cls = LookupDefclassInScope(theEnv,execStatus,cname);
hnd = InsertHandlerHeader(theEnv,execStatus,cls,(SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,mname),MPRIMARY);
IncrementSymbolCount(hnd->name);
hnd->system = 1;
hnd->minParams = hnd->maxParams = (short) (extraargs + 1);
hnd->localVarCount = 0;
hnd->actions = get_struct(theEnv,execStatus,expr);
hnd->actions->argList = NULL;
hnd->actions->type = FCALL;
hnd->actions->value = (void *) FindFunction(theEnv,execStatus,fname);
hnd->actions->nextArg = NULL;
}
/****************************************************
NAME : SetupQuery
DESCRIPTION : Initializes instance query H/L
functions and parsers
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Sets up kernel functions and parsers
NOTES : None
****************************************************/
globle void SetupQuery()
{
#if ! RUN_TIME
QUERY_DELIMETER_SYMBOL = (SYMBOL_HN *) AddSymbol(QUERY_DELIMETER_STRING);
IncrementSymbolCount(QUERY_DELIMETER_SYMBOL);
DefineFunction2("(query-instance)",'o',
PTIF GetQueryInstance,"GetQueryInstance",NULL);
DefineFunction2("(query-instance-slot)",'u',
PTIF GetQueryInstanceSlot,"GetQueryInstanceSlot",NULL);
DefineFunction2("any-instancep",'b',PTIF AnyInstances,"AnyInstances",NULL);
AddFunctionParser("any-instancep",ParseQueryNoAction);
DefineFunction2("find-instance",'m',
PTIF QueryFindInstance,"QueryFindInstance",NULL);
AddFunctionParser("find-instance",ParseQueryNoAction);
DefineFunction2("find-all-instances",'m',
PTIF QueryFindAllInstances,"QueryFindAllInstances",NULL);
AddFunctionParser("find-all-instances",ParseQueryNoAction);
DefineFunction2("do-for-instance",'u',
PTIF QueryDoForInstance,"QueryDoForInstance",NULL);
AddFunctionParser("do-for-instance",ParseQueryAction);
DefineFunction2("do-for-all-instances",'u',
PTIF QueryDoForAllInstances,"QueryDoForAllInstances",NULL);
AddFunctionParser("do-for-all-instances",ParseQueryAction);
DefineFunction2("delayed-do-for-all-instances",'u',
PTIF DelayedQueryDoForAllInstances,
"DelayedQueryDoForAllInstances",NULL);
AddFunctionParser("delayed-do-for-all-instances",ParseQueryAction);
#endif
}
globle int ParseDeffacts(
char *readSource)
{
#if (MAC_MPW || MAC_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(readSource)
#endif
#if (! RUN_TIME) && (! BLOAD_ONLY)
SYMBOL_HN *deffactsName;
struct expr *temp;
struct deffacts *newDeffacts;
int deffactsError;
struct token inputToken;
/*=========================*/
/* Parsing initialization. */
/*=========================*/
deffactsError = FALSE;
SetPPBufferStatus(ON);
FlushPPBuffer();
SetIndentDepth(3);
SavePPBuffer("(deffacts ");
/*==========================================================*/
/* Deffacts can not be added when a binary image is loaded. */
/*==========================================================*/
#if BLOAD || BLOAD_AND_BSAVE
if ((Bloaded() == TRUE) && (! CheckSyntaxMode))
{
CannotLoadWithBloadMessage("deffacts");
return(TRUE);
}
#endif
/*============================*/
/* Parse the deffacts header. */
/*============================*/
deffactsName = GetConstructNameAndComment(readSource,&inputToken,"deffacts",
FindDeffacts,Undeffacts,"$",TRUE,
TRUE,TRUE);
if (deffactsName == NULL) { return(TRUE); }
/*===============================================*/
/* Parse the list of facts in the deffacts body. */
/*===============================================*/
temp = BuildRHSAssert(readSource,&inputToken,&deffactsError,FALSE,FALSE,"deffacts");
if (deffactsError == TRUE) { return(TRUE); }
if (ExpressionContainsVariables(temp,FALSE))
{
LocalVariableErrorMessage("a deffacts construct");
ReturnExpression(temp);
return(TRUE);
}
SavePPBuffer("\n");
/*==============================================*/
/* If we're only checking syntax, don't add the */
/* successfully parsed deffacts to the KB. */
/*==============================================*/
if (CheckSyntaxMode)
{
ReturnExpression(temp);
return(FALSE);
}
/*==========================*/
/* Create the new deffacts. */
/*==========================*/
ExpressionInstall(temp);
newDeffacts = get_struct(deffacts);
newDeffacts->header.name = deffactsName;
IncrementSymbolCount(deffactsName);
newDeffacts->assertList = PackExpression(temp);
newDeffacts->header.whichModule = (struct defmoduleItemHeader *)
GetModuleItem(NULL,FindModuleItem("deffacts")->moduleIndex);
newDeffacts->header.next = NULL;
newDeffacts->header.usrData = NULL;
ReturnExpression(temp);
/*=======================================================*/
/* Save the pretty print representation of the deffacts. */
/*=======================================================*/
if (GetConserveMemory() == TRUE)
{ newDeffacts->header.ppForm = NULL; }
else
{ newDeffacts->header.ppForm = CopyPPBuffer(); }
/*=============================================*/
/* Add the deffacts to the appropriate module. */
/*=============================================*/
AddConstructToModule(&newDeffacts->header);
#endif /* (! RUN_TIME) && (! BLOAD_ONLY) */
/*================================================================*/
/* Return FALSE to indicate the deffacts was successfully parsed. */
/*================================================================*/
return(FALSE);
}
globle int ParseDefmodule(
void *theEnv,
char *readSource)
{
SYMBOL_HN *defmoduleName;
struct defmodule *newDefmodule;
struct token inputToken;
int i;
struct moduleItem *theItem;
struct portItem *portSpecs, *nextSpec;
struct defmoduleItemHeader *theHeader;
struct callFunctionItem *defineFunctions;
struct defmodule *redefiningMainModule = NULL;
int parseError;
struct portItem *oldImportList = NULL, *oldExportList = NULL;
short overwrite = FALSE;
/*================================================*/
/* Flush the buffer which stores the pretty print */
/* representation for a module. Add the already */
/* parsed keyword defmodule to this buffer. */
/*================================================*/
SetPPBufferStatus(theEnv,ON);
FlushPPBuffer(theEnv);
SetIndentDepth(theEnv,3);
SavePPBuffer(theEnv,"(defmodule ");
/*===============================*/
/* Modules cannot be loaded when */
/* a binary load is in effect. */
/*===============================*/
#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,"defmodule");
return(TRUE);
}
#endif
/*=====================================================*/
/* Parse the name and comment fields of the defmodule. */
/* Remove the defmodule if it already exists. */
/*=====================================================*/
defmoduleName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"defmodule",
EnvFindDefmodule,DeleteDefmodule,"+",
TRUE,TRUE,FALSE);
if (defmoduleName == NULL) { return(TRUE); }
if (strcmp(ValueToString(defmoduleName),"MAIN") == 0)
{ redefiningMainModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); }
/*==============================================*/
/* Create the defmodule structure if necessary. */
/*==============================================*/
if (redefiningMainModule == NULL)
{
newDefmodule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(defmoduleName));
if (newDefmodule)
{ overwrite = TRUE; }
else
{
newDefmodule = get_struct(theEnv,defmodule);
newDefmodule->name = defmoduleName;
newDefmodule->usrData = NULL;
newDefmodule->next = NULL;
}
}
else
{
overwrite = TRUE;
newDefmodule = redefiningMainModule;
}
if (overwrite)
{
oldImportList = newDefmodule->importList;
oldExportList = newDefmodule->exportList;
}
newDefmodule->importList = NULL;
newDefmodule->exportList = NULL;
/*===================================*/
/* Finish parsing the defmodule (its */
/* import/export specifications). */
/*===================================*/
parseError = ParsePortSpecifications(theEnv,readSource,&inputToken,newDefmodule);
/*====================================*/
/* Check for import/export conflicts. */
/*====================================*/
if (! parseError) parseError = FindMultiImportConflict(theEnv,newDefmodule);
/*======================================================*/
/* If an error occured in parsing or an import conflict */
/* was detected, abort the definition of the defmodule. */
/* If we're only checking syntax, then we want to exit */
/* at this point as well. */
/*======================================================*/
if (parseError || ConstructData(theEnv)->CheckSyntaxMode)
{
while (newDefmodule->importList != NULL)
{
nextSpec = newDefmodule->importList->next;
rtn_struct(theEnv,portItem,newDefmodule->importList);
newDefmodule->importList = nextSpec;
}
while (newDefmodule->exportList != NULL)
{
nextSpec = newDefmodule->exportList->next;
rtn_struct(theEnv,portItem,newDefmodule->exportList);
newDefmodule->exportList = nextSpec;
}
if ((redefiningMainModule == NULL) && (! overwrite))
{ rtn_struct(theEnv,defmodule,newDefmodule); }
if (overwrite)
{
newDefmodule->importList = oldImportList;
newDefmodule->exportList = oldExportList;
}
if (parseError) return(TRUE);
return(FALSE);
}
/*===============================================*/
/* Increment the symbol table counts for symbols */
/* used in the defmodule data structures. */
/*===============================================*/
if (redefiningMainModule == NULL)
{ IncrementSymbolCount(newDefmodule->name); }
else
{
if ((newDefmodule->importList != NULL) ||
(newDefmodule->exportList != NULL))
{ DefmoduleData(theEnv)->MainModuleRedefinable = FALSE; }
}
for (portSpecs = newDefmodule->importList; portSpecs != NULL; portSpecs = portSpecs->next)
{
if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName);
if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType);
if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName);
}
for (portSpecs = newDefmodule->exportList; portSpecs != NULL; portSpecs = portSpecs->next)
{
if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName);
if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType);
if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName);
}
/*====================================================*/
/* Allocate storage for the module's construct lists. */
/*====================================================*/
if (redefiningMainModule != NULL) { /* Do nothing */ }
else if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL;
else
{
newDefmodule->itemsArray = (struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems);
for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems;
(i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL);
i++, theItem = theItem->next)
{
if (theItem->allocateFunction == NULL)
{ newDefmodule->itemsArray[i] = NULL; }
else
{
newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *)
(*theItem->allocateFunction)(theEnv);
theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i];
theHeader->theModule = newDefmodule;
theHeader->firstItem = NULL;
theHeader->lastItem = NULL;
}
}
}
/*=======================================*/
/* Save the pretty print representation. */
/*=======================================*/
SavePPBuffer(theEnv,"\n");
if (EnvGetConserveMemory(theEnv) == TRUE)
{ newDefmodule->ppForm = NULL; }
else
{ newDefmodule->ppForm = CopyPPBuffer(theEnv); }
/*==============================================*/
/* Add the defmodule to the list of defmodules. */
/*==============================================*/
if (redefiningMainModule == NULL)
{
if (DefmoduleData(theEnv)->LastDefmodule == NULL) DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule;
else DefmoduleData(theEnv)->LastDefmodule->next = newDefmodule;
DefmoduleData(theEnv)->LastDefmodule = newDefmodule;
newDefmodule->bsaveID = DefmoduleData(theEnv)->NumberOfDefmodules++;
}
EnvSetCurrentModule(theEnv,(void *) newDefmodule);
/*=========================================*/
/* Call any functions required by other */
/* constructs when a new module is defined */
/*=========================================*/
for (defineFunctions = DefmoduleData(theEnv)->AfterModuleDefinedFunctions;
defineFunctions != NULL;
defineFunctions = defineFunctions->next)
{ (* (void (*)(void *)) defineFunctions->func)(theEnv); }
/*===============================================*/
/* Defmodule successfully parsed with no errors. */
/*===============================================*/
return(FALSE);
}
globle void CreateMainModule(
void *theEnv)
{
struct defmodule *newDefmodule;
struct moduleItem *theItem;
int i;
struct defmoduleItemHeader *theHeader;
/*=======================================*/
/* Allocate the defmodule data structure */
/* and name it the MAIN module. */
/*=======================================*/
newDefmodule = get_struct(theEnv,defmodule);
newDefmodule->name = (SYMBOL_HN *) EnvAddSymbol(theEnv,"MAIN");
IncrementSymbolCount(newDefmodule->name);
newDefmodule->next = NULL;
newDefmodule->ppForm = NULL;
newDefmodule->importList = NULL;
newDefmodule->exportList = NULL;
newDefmodule->bsaveID = 0L;
newDefmodule->usrData = NULL;
/*==================================*/
/* Initialize the array for storing */
/* the module's construct lists. */
/*==================================*/
if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL;
else
{
newDefmodule->itemsArray = (struct defmoduleItemHeader **)
gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems);
for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems;
(i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL);
i++, theItem = theItem->next)
{
if (theItem->allocateFunction == NULL)
{ newDefmodule->itemsArray[i] = NULL; }
else
{
newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *)
(*theItem->allocateFunction)(theEnv);
theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i];
theHeader->theModule = newDefmodule;
theHeader->firstItem = NULL;
theHeader->lastItem = NULL;
}
}
}
/*=======================================*/
/* Add the module to the list of modules */
/* and make it the current module. */
/*=======================================*/
#if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT
SetNumberOfDefmodules(theEnv,1L);
#endif
DefmoduleData(theEnv)->LastDefmodule = newDefmodule;
DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule;
EnvSetCurrentModule(theEnv,(void *) newDefmodule);
}
/****************************************************
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);
}
globle int DefineFunction3(
void *theEnv,
const char *name,
int returnType,
int (*pointer)(void *),
const char *actualName,
const char *restrictions,
intBool environmentAware,
void *context)
{
struct FunctionDefinition *newFunction;
if ( (returnType != 'a') &&
(returnType != 'b') &&
(returnType != 'c') &&
(returnType != 'd') &&
(returnType != 'f') &&
(returnType != 'g') &&
(returnType != 'i') &&
(returnType != 'j') &&
(returnType != 'k') &&
(returnType != 'l') &&
(returnType != 'm') &&
(returnType != 'n') &&
#if OBJECT_SYSTEM
(returnType != 'o') &&
#endif
(returnType != 's') &&
(returnType != 'u') &&
(returnType != 'v') &&
#if OBJECT_SYSTEM
(returnType != 'x') &&
#endif
(returnType != 'w') )
{ return(0); }
newFunction = FindFunction(theEnv,name);
if (newFunction == NULL)
{
newFunction = get_struct(theEnv,FunctionDefinition);
newFunction->callFunctionName = (SYMBOL_HN *) EnvAddSymbol(theEnv,name);
IncrementSymbolCount(newFunction->callFunctionName);
newFunction->next = GetFunctionList(theEnv);
ExternalFunctionData(theEnv)->ListOfFunctions = newFunction;
AddHashFunction(theEnv,newFunction);
}
newFunction->returnValueType = (char) returnType;
newFunction->functionPointer = (int (*)(void)) pointer;
newFunction->actualFunctionName = actualName;
if (restrictions != NULL)
{
if (((int) (strlen(restrictions)) < 2) ? TRUE :
((! isdigit(restrictions[0]) && (restrictions[0] != '*')) ||
(! isdigit(restrictions[1]) && (restrictions[1] != '*'))))
restrictions = NULL;
}
newFunction->restrictions = restrictions;
newFunction->parser = NULL;
newFunction->overloadable = TRUE;
newFunction->sequenceuseok = TRUE;
newFunction->environmentAware = (short) environmentAware;
newFunction->usrData = NULL;
newFunction->context = context;
return(1);
}
/***************************************************
NAME : SetupMessageHandlers
DESCRIPTION : Sets up internal symbols and
fucntion definitions pertaining to
message-handlers. Also creates
system handlers
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Functions and data structures
initialized
NOTES : Should be called before
SetupInstanceModDupCommands() in
INSMODDP.C
***************************************************/
globle void SetupMessageHandlers(
void *theEnv)
{
ENTITY_RECORD handlerGetInfo = { "HANDLER_GET", HANDLER_GET,0,1,1,
PrintHandlerSlotGetFunction,
PrintHandlerSlotGetFunction,NULL,
HandlerSlotGetFunction,
NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL },
handlerPutInfo = { "HANDLER_PUT", HANDLER_PUT,0,1,1,
PrintHandlerSlotPutFunction,
PrintHandlerSlotPutFunction,NULL,
HandlerSlotPutFunction,
NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL };
AllocateEnvironmentData(theEnv,MESSAGE_HANDLER_DATA,sizeof(struct messageHandlerData),DeallocateMessageHandlerData);
memcpy(&MessageHandlerData(theEnv)->HandlerGetInfo,&handlerGetInfo,sizeof(struct entityRecord));
memcpy(&MessageHandlerData(theEnv)->HandlerPutInfo,&handlerPutInfo,sizeof(struct entityRecord));
MessageHandlerData(theEnv)->hndquals[0] = "around";
MessageHandlerData(theEnv)->hndquals[1] = "before";
MessageHandlerData(theEnv)->hndquals[2] = "primary";
MessageHandlerData(theEnv)->hndquals[3] = "after";
InstallPrimitive(theEnv,&MessageHandlerData(theEnv)->HandlerGetInfo,HANDLER_GET);
InstallPrimitive(theEnv,&MessageHandlerData(theEnv)->HandlerPutInfo,HANDLER_PUT);
#if ! RUN_TIME
MessageHandlerData(theEnv)->INIT_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,INIT_STRING);
IncrementSymbolCount(MessageHandlerData(theEnv)->INIT_SYMBOL);
MessageHandlerData(theEnv)->DELETE_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,DELETE_STRING);
IncrementSymbolCount(MessageHandlerData(theEnv)->DELETE_SYMBOL);
MessageHandlerData(theEnv)->CREATE_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,CREATE_STRING);
IncrementSymbolCount(MessageHandlerData(theEnv)->CREATE_SYMBOL);
EnvAddClearFunction(theEnv,"defclass",CreateSystemHandlers,-100);
#if ! BLOAD_ONLY
MessageHandlerData(theEnv)->SELF_SYMBOL = (SYMBOL_HN *) EnvAddSymbol(theEnv,SELF_STRING);
IncrementSymbolCount(MessageHandlerData(theEnv)->SELF_SYMBOL);
AddConstruct(theEnv,"defmessage-handler","defmessage-handlers",
ParseDefmessageHandler,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
EnvDefineFunction2(theEnv,"undefmessage-handler",'v',PTIEF UndefmessageHandlerCommand,
"UndefmessageHandlerCommand","23w");
#endif
EnvDefineFunction2(theEnv,"send",'u',PTIEF SendCommand,"SendCommand","2*uuw");
#if DEBUGGING_FUNCTIONS
EnvDefineFunction2(theEnv,"preview-send",'v',PTIEF PreviewSendCommand,"PreviewSendCommand","22w");
EnvDefineFunction2(theEnv,"ppdefmessage-handler",'v',PTIEF PPDefmessageHandlerCommand,
"PPDefmessageHandlerCommand","23w");
EnvDefineFunction2(theEnv,"list-defmessage-handlers",'v',PTIEF ListDefmessageHandlersCommand,
"ListDefmessageHandlersCommand","02w");
#endif
EnvDefineFunction2(theEnv,"next-handlerp",'b',PTIEF NextHandlerAvailable,"NextHandlerAvailable","00");
FuncSeqOvlFlags(theEnv,"next-handlerp",TRUE,FALSE);
EnvDefineFunction2(theEnv,"call-next-handler",'u',
PTIEF CallNextHandler,"CallNextHandler","00");
FuncSeqOvlFlags(theEnv,"call-next-handler",TRUE,FALSE);
EnvDefineFunction2(theEnv,"override-next-handler",'u',
PTIEF CallNextHandler,"CallNextHandler",NULL);
FuncSeqOvlFlags(theEnv,"override-next-handler",TRUE,FALSE);
EnvDefineFunction2(theEnv,"dynamic-get",'u',PTIEF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w");
EnvDefineFunction2(theEnv,"dynamic-put",'u',PTIEF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w");
EnvDefineFunction2(theEnv,"get",'u',PTIEF DynamicHandlerGetSlot,"DynamicHandlerGetSlot","11w");
EnvDefineFunction2(theEnv,"put",'u',PTIEF DynamicHandlerPutSlot,"DynamicHandlerPutSlot","1**w");
#endif
#if DEBUGGING_FUNCTIONS
AddWatchItem(theEnv,"messages",0,&MessageHandlerData(theEnv)->WatchMessages,36,NULL,NULL);
AddWatchItem(theEnv,"message-handlers",0,&MessageHandlerData(theEnv)->WatchHandlers,35,
DefmessageHandlerWatchAccess,DefmessageHandlerWatchPrint);
#endif
}
static void AddDefglobal(
void *theEnv,
SYMBOL_HN *name,
DATA_OBJECT_PTR vPtr,
struct expr *ePtr)
{
struct defglobal *defglobalPtr;
intBool newGlobal = FALSE;
#if DEBUGGING_FUNCTIONS
int GlobalHadWatch = FALSE;
#endif
/*========================================================*/
/* If the defglobal is already defined, then use the old */
/* data structure and substitute new values. If it hasn't */
/* been defined, then create a new data structure. */
/*========================================================*/
defglobalPtr = QFindDefglobal(theEnv,name);
if (defglobalPtr == NULL)
{
newGlobal = TRUE;
defglobalPtr = get_struct(theEnv,defglobal);
}
else
{
DeinstallConstructHeader(theEnv,&defglobalPtr->header);
#if DEBUGGING_FUNCTIONS
GlobalHadWatch = defglobalPtr->watch;
#endif
}
/*===========================================*/
/* Remove the old values from the defglobal. */
/*===========================================*/
if (newGlobal == FALSE)
{
ValueDeinstall(theEnv,&defglobalPtr->current);
if (defglobalPtr->current.type == MULTIFIELD)
{ ReturnMultifield(theEnv,(struct multifield *) defglobalPtr->current.value); }
RemoveHashedExpression(theEnv,defglobalPtr->initial);
}
/*=======================================*/
/* Copy the new values to the defglobal. */
/*=======================================*/
defglobalPtr->current.type = vPtr->type;
if (vPtr->type != MULTIFIELD) defglobalPtr->current.value = vPtr->value;
else DuplicateMultifield(theEnv,&defglobalPtr->current,vPtr);
ValueInstall(theEnv,&defglobalPtr->current);
defglobalPtr->initial = AddHashedExpression(theEnv,ePtr);
ReturnExpression(theEnv,ePtr);
DefglobalData(theEnv)->ChangeToGlobals = TRUE;
/*=================================*/
/* Restore the old watch value to */
/* the defglobal if redefined. */
/*=================================*/
#if DEBUGGING_FUNCTIONS
defglobalPtr->watch = GlobalHadWatch ? TRUE : WatchGlobals;
#endif
/*======================================*/
/* Save the name and pretty print form. */
/*======================================*/
defglobalPtr->header.name = name;
defglobalPtr->header.usrData = NULL;
IncrementSymbolCount(name);
SavePPBuffer(theEnv,"\n");
if (EnvGetConserveMemory(theEnv) == TRUE)
{ defglobalPtr->header.ppForm = NULL; }
else
{ defglobalPtr->header.ppForm = CopyPPBuffer(theEnv); }
defglobalPtr->inScope = TRUE;
/*=============================================*/
/* If the defglobal was redefined, we're done. */
/*=============================================*/
if (newGlobal == FALSE) return;
/*===================================*/
/* Copy the defglobal variable name. */
/*===================================*/
defglobalPtr->busyCount = 0;
defglobalPtr->header.whichModule = (struct defmoduleItemHeader *)
GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defglobal")->moduleIndex);
/*=============================================*/
/* Add the defglobal to the list of defglobals */
/* for the current module. */
/*=============================================*/
AddConstructToModule(&defglobalPtr->header);
}
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);
}
static void InitializeKeywords(
void *theEnv)
{
#if (! RUN_TIME) && WINDOW_INTERFACE
void *ts;
/*====================*/
/* construct keywords */
/*====================*/
ts = EnvAddSymbol(theEnv,"defrule");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"defglobal");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"deftemplate");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"deffacts");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"deffunction");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"defmethod");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"defgeneric");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"defclass");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"defmessage-handler");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"definstances");
IncrementSymbolCount(ts);
/*=======================*/
/* set-strategy keywords */
/*=======================*/
ts = EnvAddSymbol(theEnv,"depth");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"breadth");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"lex");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"mea");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"simplicity");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"complexity");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"random");
IncrementSymbolCount(ts);
/*==================================*/
/* set-salience-evaluation keywords */
/*==================================*/
ts = EnvAddSymbol(theEnv,"when-defined");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"when-activated");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"every-cycle");
IncrementSymbolCount(ts);
/*======================*/
/* deftemplate keywords */
/*======================*/
ts = EnvAddSymbol(theEnv,"field");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"multifield");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"default");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"type");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"allowed-symbols");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"allowed-strings");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"allowed-numbers");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"allowed-integers");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"allowed-floats");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"allowed-values");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"min-number-of-elements");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"max-number-of-elements");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"NONE");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"VARIABLE");
IncrementSymbolCount(ts);
/*==================*/
/* defrule keywords */
/*==================*/
ts = EnvAddSymbol(theEnv,"declare");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"salience");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"test");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"or");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"and");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"not");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"logical");
IncrementSymbolCount(ts);
/*===============*/
/* COOL keywords */
/*===============*/
ts = EnvAddSymbol(theEnv,"is-a");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"role");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"abstract");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"concrete");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"pattern-match");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"reactive");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"non-reactive");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"slot");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"field");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"multiple");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"single");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"storage");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"shared");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"local");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"access");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"read");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"write");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"read-only");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"read-write");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"initialize-only");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"propagation");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"inherit");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"no-inherit");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"source");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"composite");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"exclusive");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"allowed-lexemes");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"allowed-instances");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"around");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"before");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"primary");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"after");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"of");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"self");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"visibility");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"override-message");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"private");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"public");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"create-accessor");
IncrementSymbolCount(ts);
/*================*/
/* watch keywords */
/*================*/
ts = EnvAddSymbol(theEnv,"compilations");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"deffunctions");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"globals");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"rules");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"activations");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"statistics");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"facts");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"generic-functions");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"methods");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"instances");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"slots");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"messages");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"message-handlers");
IncrementSymbolCount(ts);
ts = EnvAddSymbol(theEnv,"focus");
IncrementSymbolCount(ts);
#else
#if MAC_XCD
#pragma unused(theEnv)
#endif
#endif
}
