static void DeallocateMessageHandlerData(
void *theEnv)
{
HANDLER_LINK *tmp, *mhead, *chead;
mhead = MessageHandlerData(theEnv)->TopOfCore;
while (mhead != NULL)
{
tmp = mhead;
mhead = mhead->nxt;
rtn_struct(theEnv,messageHandlerLink,tmp);
}
chead = MessageHandlerData(theEnv)->OldCore;
while (chead != NULL)
{
mhead = chead;
chead = chead->nxtInStack;
while (mhead != NULL)
{
tmp = mhead;
mhead = mhead->nxt;
rtn_struct(theEnv,messageHandlerLink,tmp);
}
}
}
/*****************************************************************
NAME : CheckCurrentMessage
DESCRIPTION : Makes sure that a message is available
and active for an internal message function
INPUTS : 1) The name of the function checking the message
2) A flag indicating whether the object must be
a class instance or not (it could be a
primitive type)
RETURNS : TRUE if all OK, FALSE otherwise
SIDE EFFECTS : EvaluationError set on errors
NOTES : None
*****************************************************************/
globle int CheckCurrentMessage(
void *theEnv,
EXEC_STATUS,
char *func,
int ins_reqd)
{
register DATA_OBJECT *activeMsgArg;
if (!MessageHandlerData(theEnv,execStatus)->CurrentCore || (MessageHandlerData(theEnv,execStatus)->CurrentCore->hnd->actions != ProceduralPrimitiveData(theEnv,execStatus)->CurrentProcActions))
{
PrintErrorID(theEnv,execStatus,"MSGFUN",4,FALSE);
EnvPrintRouter(theEnv,execStatus,WERROR,func);
EnvPrintRouter(theEnv,execStatus,WERROR," may only be called from within message-handlers.\n");
SetEvaluationError(theEnv,execStatus,TRUE);
return(FALSE);
}
activeMsgArg = GetNthMessageArgument(theEnv,execStatus,0);
if ((ins_reqd == TRUE) ? (activeMsgArg->type != INSTANCE_ADDRESS) : FALSE)
{
PrintErrorID(theEnv,execStatus,"MSGFUN",5,FALSE);
EnvPrintRouter(theEnv,execStatus,WERROR,func);
EnvPrintRouter(theEnv,execStatus,WERROR," operates only on instances.\n");
SetEvaluationError(theEnv,execStatus,TRUE);
return(FALSE);
}
if ((activeMsgArg->type == INSTANCE_ADDRESS) ?
(((INSTANCE_TYPE *) activeMsgArg->value)->garbage == 1) : FALSE)
{
StaleInstanceAddress(theEnv,execStatus,func,0);
SetEvaluationError(theEnv,execStatus,TRUE);
return(FALSE);
}
return(TRUE);
}
/***************************************************************
NAME : CheckHandlerArgCount
DESCRIPTION : Verifies that the current argument
list satisfies the current
handler's parameter count restriction
INPUTS : None
RETURNS : TRUE if all OK, FALSE otherwise
SIDE EFFECTS : EvaluationError set on errors
NOTES : Uses ProcParamArraySize and CurrentCore globals
***************************************************************/
globle int CheckHandlerArgCount(
void *theEnv,
EXEC_STATUS)
{
HANDLER *hnd;
hnd = MessageHandlerData(theEnv,execStatus)->CurrentCore->hnd;
if ((hnd->maxParams == -1) ? (ProceduralPrimitiveData(theEnv,execStatus)->ProcParamArraySize < hnd->minParams) :
(ProceduralPrimitiveData(theEnv,execStatus)->ProcParamArraySize != hnd->minParams))
{
SetEvaluationError(theEnv,execStatus,TRUE);
PrintErrorID(theEnv,execStatus,"MSGFUN",2,FALSE);
EnvPrintRouter(theEnv,execStatus,WERROR,"Message-handler ");
EnvPrintRouter(theEnv,execStatus,WERROR,ValueToString(hnd->name));
EnvPrintRouter(theEnv,execStatus,WERROR," ");
EnvPrintRouter(theEnv,execStatus,WERROR,MessageHandlerData(theEnv,execStatus)->hndquals[hnd->type]);
EnvPrintRouter(theEnv,execStatus,WERROR," in class ");
EnvPrintRouter(theEnv,execStatus,WERROR,EnvGetDefclassName(theEnv,execStatus,(void *) hnd->cls));
EnvPrintRouter(theEnv,execStatus,WERROR," expected ");
if (hnd->maxParams == -1)
EnvPrintRouter(theEnv,execStatus,WERROR,"at least ");
else
EnvPrintRouter(theEnv,execStatus,WERROR,"exactly ");
PrintLongInteger(theEnv,execStatus,WERROR,(long long) (hnd->minParams-1));
EnvPrintRouter(theEnv,execStatus,WERROR," argument(s).\n");
return(FALSE);
}
return(TRUE);
}
/*****************************************************
NAME : EnvGetDefmessageHandlerType
DESCRIPTION : Gets the type of a message-handler
INPUTS : 1) Pointer to a class
2) Array index of handler in class's
message-handler array (+1)
RETURNS : Type-string of message-handler
SIDE EFFECTS : None
NOTES : None
*****************************************************/
globle const char *EnvGetDefmessageHandlerType(
void *theEnv,
void *ptr,
int theIndex)
{
return(MessageHandlerData(theEnv)->hndquals[((DEFCLASS *) ptr)->handlers[theIndex-1].type]);
}
/********************************************************
NAME : UnboundHandlerErr
DESCRIPTION : Print out a synopis of the currently
executing handler for unbound variable
errors
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Error synopsis printed to WERROR
NOTES : None
********************************************************/
globle void UnboundHandlerErr(
void *theEnv,
EXEC_STATUS)
{
EnvPrintRouter(theEnv,execStatus,WERROR,"message-handler ");
PrintHandler(theEnv,execStatus,WERROR,MessageHandlerData(theEnv,execStatus)->CurrentCore->hnd,TRUE);
}
/***************************************************
NAME : InsertHandlerHeader
DESCRIPTION : Allocates a new handler header and
inserts it in the proper (sorted)
position in the class hnd array
INPUTS : 1) The class
2) The handler name
3) The handler type
RETURNS : The address of the new handler
header, NULL on errors
SIDE EFFECTS : Class handler array reallocated
and resorted
NOTES : Assumes handler does not exist
***************************************************/
globle HANDLER *InsertHandlerHeader(
void *theEnv,
EXEC_STATUS,
DEFCLASS *cls,
SYMBOL_HN *mname,
int mtype)
{
HANDLER *nhnd,*hnd;
unsigned *narr,*arr;
long i;
long j,ni = -1;
hnd = cls->handlers;
arr = cls->handlerOrderMap;
nhnd = (HANDLER *) gm2(theEnv,execStatus,(sizeof(HANDLER) * (cls->handlerCount+1)));
narr = (unsigned *) gm2(theEnv,execStatus,(sizeof(unsigned) * (cls->handlerCount+1)));
GenCopyMemory(HANDLER,cls->handlerCount,nhnd,hnd);
for (i = 0 , j = 0 ; i < cls->handlerCount ; i++ , j++)
{
if (ni == -1)
{
if ((hnd[arr[i]].name->bucket > mname->bucket) ? TRUE :
(hnd[arr[i]].name == mname))
{
ni = i;
j++;
}
}
narr[j] = arr[i];
}
if (ni == -1)
ni = (int) cls->handlerCount;
narr[ni] = cls->handlerCount;
nhnd[cls->handlerCount].system = 0;
nhnd[cls->handlerCount].type = mtype;
nhnd[cls->handlerCount].busy = 0;
nhnd[cls->handlerCount].mark = 0;
#if DEBUGGING_FUNCTIONS
nhnd[cls->handlerCount].trace = MessageHandlerData(theEnv,execStatus)->WatchHandlers;
#endif
nhnd[cls->handlerCount].name = mname;
nhnd[cls->handlerCount].cls = cls;
nhnd[cls->handlerCount].minParams = 0;
nhnd[cls->handlerCount].maxParams = 0;
nhnd[cls->handlerCount].localVarCount = 0;
nhnd[cls->handlerCount].actions = NULL;
nhnd[cls->handlerCount].ppForm = NULL;
nhnd[cls->handlerCount].usrData = NULL;
if (cls->handlerCount != 0)
{
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++;
return(&nhnd[cls->handlerCount-1]);
}
/***************************************************
NAME : PrintHandler
DESCRIPTION : Displays a handler synopsis
INPUTS : 1) Logical name of output
2) The handler
5) Flag indicating whether to
printout a terminating newline
RETURNS : Nothing useful
SIDE EFFECTS : None
NOTES : None
***************************************************/
globle void PrintHandler(
void *theEnv,
EXEC_STATUS,
char *logName,
HANDLER *theHandler,
int crtn)
{
EnvPrintRouter(theEnv,execStatus,logName,ValueToString(theHandler->name));
EnvPrintRouter(theEnv,execStatus,logName," ");
EnvPrintRouter(theEnv,execStatus,logName,MessageHandlerData(theEnv,execStatus)->hndquals[theHandler->type]);
EnvPrintRouter(theEnv,execStatus,logName," in class ");
PrintClassName(theEnv,execStatus,logName,theHandler->cls,crtn);
}
/***********************************************************
NAME : WatchMessage
DESCRIPTION : Prints a condensed description of a
message and its arguments
INPUTS : 1) The output logical name
2) BEGIN_TRACE or END_TRACE string
RETURNS : Nothing useful
SIDE EFFECTS : None
NOTES : Uses the global variables ProcParamArray
and CurrentMessageName
***********************************************************/
globle void WatchMessage(
void *theEnv,
EXEC_STATUS,
char *logName,
char *tstring)
{
EnvPrintRouter(theEnv,execStatus,logName,"MSG ");
EnvPrintRouter(theEnv,execStatus,logName,tstring);
EnvPrintRouter(theEnv,execStatus,logName," ");
EnvPrintRouter(theEnv,execStatus,logName,ValueToString(MessageHandlerData(theEnv,execStatus)->CurrentMessageName));
EnvPrintRouter(theEnv,execStatus,logName," ED:");
PrintLongInteger(theEnv,execStatus,logName,(long long) execStatus->CurrentEvaluationDepth);
PrintProcParamArray(theEnv,execStatus,logName);
}
/*******************************************************************************
NAME : PPDefmessageHandlerCommand
DESCRIPTION : Displays the pretty-print form (if any) for a handler
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : None
NOTES : H/L Syntax: (ppdefmessage-handler <class> <message> [<type>])
*******************************************************************************/
globle void PPDefmessageHandlerCommand(
void *theEnv)
{
DATA_OBJECT temp;
SYMBOL_HN *csym,*msym;
const char *tname;
DEFCLASS *cls = NULL;
unsigned mtype;
HANDLER *hnd;
if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",1,SYMBOL,&temp) == FALSE)
return;
csym = FindSymbolHN(theEnv,DOToString(temp));
if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",2,SYMBOL,&temp) == FALSE)
return;
msym = FindSymbolHN(theEnv,DOToString(temp));
if (EnvRtnArgCount(theEnv) == 3)
{
if (EnvArgTypeCheck(theEnv,"ppdefmessage-handler",3,SYMBOL,&temp) == FALSE)
return;
tname = DOToString(temp);
}
else
tname = MessageHandlerData(theEnv)->hndquals[MPRIMARY];
mtype = HandlerType(theEnv,"ppdefmessage-handler",tname);
if (mtype == MERROR)
{
EnvSetEvaluationError(theEnv,TRUE);
return;
}
if (csym != NULL)
cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(csym));
if (((cls == NULL) || (msym == NULL)) ? TRUE :
((hnd = FindHandlerByAddress(cls,msym,(unsigned) mtype)) == NULL))
{
PrintErrorID(theEnv,"MSGCOM",2,FALSE);
EnvPrintRouter(theEnv,WERROR,"Unable to find message-handler ");
EnvPrintRouter(theEnv,WERROR,ValueToString(msym));
EnvPrintRouter(theEnv,WERROR," ");
EnvPrintRouter(theEnv,WERROR,tname);
EnvPrintRouter(theEnv,WERROR," for class ");
EnvPrintRouter(theEnv,WERROR,ValueToString(csym));
EnvPrintRouter(theEnv,WERROR," in function ppdefmessage-handler.\n");
EnvSetEvaluationError(theEnv,TRUE);
return;
}
if (hnd->ppForm != NULL)
PrintInChunks(theEnv,WDISPLAY,hnd->ppForm);
}
/******************************************************************************
NAME : UndefmessageHandlerCommand
DESCRIPTION : Deletes a handler from a class
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Handler deleted if possible
NOTES : H/L Syntax: (undefmessage-handler <class> <handler> [<type>])
******************************************************************************/
globle void UndefmessageHandlerCommand(
void *theEnv)
{
#if RUN_TIME || BLOAD_ONLY
PrintErrorID(theEnv,"MSGCOM",3,FALSE);
EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n");
#else
SYMBOL_HN *mname;
const char *tname;
DATA_OBJECT tmp;
DEFCLASS *cls;
#if BLOAD || BLOAD_AND_BSAVE
if (Bloaded(theEnv))
{
PrintErrorID(theEnv,"MSGCOM",3,FALSE);
EnvPrintRouter(theEnv,WERROR,"Unable to delete message-handlers.\n");
return;
}
#endif
if (EnvArgTypeCheck(theEnv,"undefmessage-handler",1,SYMBOL,&tmp) == FALSE)
return;
cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp));
if ((cls == NULL) ? (strcmp(DOToString(tmp),"*") != 0) : FALSE)
{
ClassExistError(theEnv,"undefmessage-handler",DOToString(tmp));
return;
}
if (EnvArgTypeCheck(theEnv,"undefmessage-handler",2,SYMBOL,&tmp) == FALSE)
return;
mname = (SYMBOL_HN *) tmp.value;
if (EnvRtnArgCount(theEnv) == 3)
{
if (EnvArgTypeCheck(theEnv,"undefmessage-handler",3,SYMBOL,&tmp) == FALSE)
return;
tname = DOToString(tmp);
if (strcmp(tname,"*") == 0)
tname = NULL;
}
else
tname = MessageHandlerData(theEnv)->hndquals[MPRIMARY];
WildDeleteHandler(theEnv,cls,mname,tname);
#endif
}
/*****************************************************
NAME : HandlerType
DESCRIPTION : Determines type of message-handler
INPUTS : 1) Calling function string
2) String representing type
RETURNS : MAROUND (0) for "around"
MBEFORE (1) for "before"
MPRIMARY (2) for "primary"
MAFTER (3) for "after"
MERROR (4) on errors
SIDE EFFECTS : None
NOTES : None
*****************************************************/
globle unsigned HandlerType(
void *theEnv,
EXEC_STATUS,
char *func,
char *str)
{
register unsigned i;
for (i = MAROUND ; i <= MAFTER ; i++)
if (strcmp(str,MessageHandlerData(theEnv,execStatus)->hndquals[i]) == 0)
{
return(i);
}
PrintErrorID(theEnv,execStatus,"MSGFUN",7,FALSE);
EnvPrintRouter(theEnv,execStatus,"werror","Unrecognized message-handler type in ");
EnvPrintRouter(theEnv,execStatus,"werror",func);
EnvPrintRouter(theEnv,execStatus,"werror",".\n");
return(MERROR);
}
/***************************************************
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
}
/***************************************************
NAME : ObjectsRunTimeInitialize
DESCRIPTION : Initializes objects system lists
in a run-time module
INPUTS : 1) Pointer to new class hash table
2) Pointer to new slot name table
RETURNS : Nothing useful
SIDE EFFECTS : Global pointers set
NOTES : None
***************************************************/
globle void ObjectsRunTimeInitialize(
void *theEnv,
DEFCLASS *ctable[],
SLOT_NAME *sntable[],
DEFCLASS **cidmap,
unsigned mid)
{
DEFCLASS *cls;
void *tmpexp;
register unsigned int i,j;
if (DefclassData(theEnv)->ClassTable != NULL)
{
for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
{
for (i = 0 ; i < cls->slotCount ; i++)
{
/* =====================================================================
For static default values, the data object value needs to deinstalled
and deallocated, and the expression needs to be restored (which was
temporarily stored in the supplementalInfo field of the data object)
===================================================================== */
if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
{
tmpexp = ((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo;
ValueDeinstall(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue);
rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue);
cls->slots[i].defaultValue = tmpexp;
}
}
}
}
InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = FindSymbolHN(theEnv,QUERY_DELIMETER_STRING);
MessageHandlerData(theEnv)->INIT_SYMBOL = FindSymbolHN(theEnv,INIT_STRING);
MessageHandlerData(theEnv)->DELETE_SYMBOL = FindSymbolHN(theEnv,DELETE_STRING);
MessageHandlerData(theEnv)->CREATE_SYMBOL = FindSymbolHN(theEnv,CREATE_STRING);
DefclassData(theEnv)->ISA_SYMBOL = FindSymbolHN(theEnv,SUPERCLASS_RLN);
DefclassData(theEnv)->NAME_SYMBOL = FindSymbolHN(theEnv,NAME_RLN);
#if DEFRULE_CONSTRUCT
DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL = FindSymbolHN(theEnv,INITIAL_OBJECT_NAME);
#endif
DefclassData(theEnv)->ClassTable = (DEFCLASS **) ctable;
DefclassData(theEnv)->SlotNameTable = (SLOT_NAME **) sntable;
DefclassData(theEnv)->ClassIDMap = (DEFCLASS **) cidmap;
DefclassData(theEnv)->MaxClassID = (unsigned short) mid;
DefclassData(theEnv)->PrimitiveClassMap[FLOAT] =
LookupDefclassByMdlOrScope(theEnv,FLOAT_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[INTEGER] =
LookupDefclassByMdlOrScope(theEnv,INTEGER_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[STRING] =
LookupDefclassByMdlOrScope(theEnv,STRING_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[SYMBOL] =
LookupDefclassByMdlOrScope(theEnv,SYMBOL_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD] =
LookupDefclassByMdlOrScope(theEnv,MULTIFIELD_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS] =
LookupDefclassByMdlOrScope(theEnv,EXTERNAL_ADDRESS_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS] =
LookupDefclassByMdlOrScope(theEnv,FACT_ADDRESS_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME] =
LookupDefclassByMdlOrScope(theEnv,INSTANCE_NAME_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS] =
LookupDefclassByMdlOrScope(theEnv,INSTANCE_ADDRESS_TYPE_NAME);
for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
{
for (i = 0 ; i < cls->slotCount ; i++)
{
if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
{
tmpexp = cls->slots[i].defaultValue;
cls->slots[i].defaultValue = (void *) get_struct(theEnv,dataObject);
EvaluateAndStoreInDataObject(theEnv,(int) cls->slots[i].multiple,(EXPRESSION *) tmpexp,
(DATA_OBJECT *) cls->slots[i].defaultValue,TRUE);
ValueInstall(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue);
((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo = tmpexp;
}
}
}
SearchForHashedPatternNodes(theEnv,ObjectReteData(theEnv)->ObjectPatternNetworkPointer);
}
/************************************************************************
NAME : EnvGetDefmessageHandlerList
DESCRIPTION : Groups handler info for a class into a multifield value
for dynamic perusal
INPUTS : 1) Generic pointer to class (NULL to get handlers for
all classes)
2) Data object buffer to hold the handlers of the class
3) Include (1) or exclude (0) inherited handlers
RETURNS : Nothing useful
SIDE EFFECTS : Creates a multifield storing the names and types of
the message-handlers of the class
NOTES : None
************************************************************************/
globle void EnvGetDefmessageHandlerList(
void *theEnv,
void *clsptr,
DATA_OBJECT *result,
int inhp)
{
DEFCLASS *cls,*svcls,*svnxt,*supcls;
long j;
register int classi,classiLimit;
unsigned long i, sublen, len;
if (clsptr == NULL)
{
inhp = 0;
cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,NULL);
svnxt = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls);
}
else
{
cls = (DEFCLASS *) clsptr;
svnxt = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls);
SetNextDefclass((void *) cls,NULL);
}
for (svcls = cls , i = 0 ;
cls != NULL ;
cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls))
{
classiLimit = inhp ? cls->allSuperclasses.classCount : 1;
for (classi = 0 ; classi < classiLimit ; classi++)
i += cls->allSuperclasses.classArray[classi]->handlerCount;
}
len = i * 3;
result->type = MULTIFIELD;
SetpDOBegin(result,1);
SetpDOEnd(result,len);
result->value = (void *) EnvCreateMultifield(theEnv,len);
for (cls = svcls , sublen = 0 ;
cls != NULL ;
cls = (DEFCLASS *) EnvGetNextDefclass(theEnv,(void *) cls))
{
classiLimit = inhp ? cls->allSuperclasses.classCount : 1;
for (classi = 0 ; classi < classiLimit ; classi++)
{
supcls = cls->allSuperclasses.classArray[classi];
if (inhp == 0)
i = sublen + 1;
else
i = len - (supcls->handlerCount * 3) - sublen + 1;
for (j = 0 ; j < supcls->handlerCount ; j++)
{
SetMFType(result->value,i,SYMBOL);
SetMFValue(result->value,i++,GetDefclassNamePointer((void *) supcls));
SetMFType(result->value,i,SYMBOL);
SetMFValue(result->value,i++,supcls->handlers[j].name);
SetMFType(result->value,i,SYMBOL);
SetMFValue(result->value,i++,EnvAddSymbol(theEnv,MessageHandlerData(theEnv)->hndquals[supcls->handlers[j].type]));
}
sublen += supcls->handlerCount * 3;
}
}
if (svcls != NULL)
SetNextDefclass((void *) svcls,(void *) svnxt);
}
/***********************************************************************
NAME : ParseDefmessageHandler
DESCRIPTION : Parses a message-handler for a class of objects
INPUTS : The logical name of the input source
RETURNS : FALSE if successful parse, TRUE otherwise
SIDE EFFECTS : Handler allocated and inserted into class
NOTES : H/L Syntax:
(defmessage-handler <class> <name> [<type>] [<comment>]
(<params>)
<action>*)
<params> ::= <var>* | <var>* $?<name>
***********************************************************************/
globle int ParseDefmessageHandler(
void *theEnv,
char *readSource)
{
DEFCLASS *cls;
SYMBOL_HN *cname,*mname,*wildcard;
unsigned mtype = MPRIMARY;
int min,max,error,lvars;
EXPRESSION *hndParams,*actions;
HANDLER *hnd;
SetPPBufferStatus(theEnv,ON);
FlushPPBuffer(theEnv);
SetIndentDepth(theEnv,3);
SavePPBuffer(theEnv,"(defmessage-handler ");
#if BLOAD || BLOAD_AND_BSAVE
if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,"defmessage-handler");
return(TRUE);
}
#endif
cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defmessage-handler",
NULL,NULL,"~",TRUE,FALSE,DEFMODULE_CONSTRUCT);
if (cname == NULL)
return(TRUE);
cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(cname));
if (cls == NULL)
{
PrintErrorID(theEnv,"MSGPSR",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"A class must be defined before its message-handlers.\n");
return(TRUE);
}
if ((cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) ||
(cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) ||
(cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0]))
{
PrintErrorID(theEnv,"MSGPSR",8,FALSE);
EnvPrintRouter(theEnv,WERROR,"Message-handlers cannot be attached to the class ");
EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls));
EnvPrintRouter(theEnv,WERROR,".\n");
return(TRUE);
}
if (HandlersExecuting(cls))
{
PrintErrorID(theEnv,"MSGPSR",2,FALSE);
EnvPrintRouter(theEnv,WERROR,"Cannot (re)define message-handlers during execution of \n");
EnvPrintRouter(theEnv,WERROR," other message-handlers for the same class.\n");
return(TRUE);
}
if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
{
SyntaxErrorMessage(theEnv,"defmessage-handler");
return(TRUE);
}
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv," ");
SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
SavePPBuffer(theEnv," ");
mname = (SYMBOL_HN *) GetValue(DefclassData(theEnv)->ObjectParseToken);
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN)
{
SavePPBuffer(theEnv," ");
if (GetType(DefclassData(theEnv)->ObjectParseToken) != STRING)
{
if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
{
SyntaxErrorMessage(theEnv,"defmessage-handler");
return(TRUE);
}
mtype = HandlerType(theEnv,"defmessage-handler",DOToString(DefclassData(theEnv)->ObjectParseToken));
if (mtype == MERROR)
return(TRUE);
#if ! IMPERATIVE_MESSAGE_HANDLERS
if (mtype == MAROUND)
return(TRUE);
#endif
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING)
{
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
}
}
else
{
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
}
}
PPBackup(theEnv);
PPBackup(theEnv);
PPCRAndIndent(theEnv);
SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
hnd = FindHandlerByAddress(cls,mname,mtype);
if (GetPrintWhileLoading(theEnv) && GetCompilationsWatch(theEnv))
{
EnvPrintRouter(theEnv,WDIALOG," Handler ");
EnvPrintRouter(theEnv,WDIALOG,ValueToString(mname));
EnvPrintRouter(theEnv,WDIALOG," ");
EnvPrintRouter(theEnv,WDIALOG,MessageHandlerData(theEnv)->hndquals[mtype]);
EnvPrintRouter(theEnv,WDIALOG,(char *) ((hnd == NULL) ? " defined.\n" : " redefined.\n"));
}
if ((hnd != NULL) ? hnd->system : FALSE)
{
PrintErrorID(theEnv,"MSGPSR",3,FALSE);
EnvPrintRouter(theEnv,WERROR,"System message-handlers may not be modified.\n");
return(TRUE);
}
hndParams = GenConstant(theEnv,SYMBOL,(void *) MessageHandlerData(theEnv)->SELF_SYMBOL);
hndParams = ParseProcParameters(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,hndParams,
&wildcard,&min,&max,&error,IsParameterSlotReference);
if (error)
return(TRUE);
PPCRAndIndent(theEnv);
ExpressionData(theEnv)->ReturnContext = TRUE;
actions = ParseProcActions(theEnv,"message-handler",readSource,
&DefclassData(theEnv)->ObjectParseToken,hndParams,wildcard,
SlotReferenceVar,BindSlotReference,&lvars,
(void *) cls);
if (actions == NULL)
{
ReturnExpression(theEnv,hndParams);
return(TRUE);
}
if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
{
SyntaxErrorMessage(theEnv,"defmessage-handler");
ReturnExpression(theEnv,hndParams);
ReturnPackedExpression(theEnv,actions);
return(TRUE);
}
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
SavePPBuffer(theEnv,"\n");
/* ===================================================
If we're only checking syntax, don't add the
successfully parsed defmessage-handler to the KB.
=================================================== */
if (ConstructData(theEnv)->CheckSyntaxMode)
{
ReturnExpression(theEnv,hndParams);
ReturnPackedExpression(theEnv,actions);
return(FALSE);
}
if (hnd != NULL)
{
ExpressionDeinstall(theEnv,hnd->actions);
ReturnPackedExpression(theEnv,hnd->actions);
if (hnd->ppForm != NULL)
rm(theEnv,(void *) hnd->ppForm,
(sizeof(char) * (strlen(hnd->ppForm)+1)));
}
else
{
hnd = InsertHandlerHeader(theEnv,cls,mname,(int) mtype);
IncrementSymbolCount(hnd->name);
}
ReturnExpression(theEnv,hndParams);
hnd->minParams = min;
hnd->maxParams = max;
hnd->localVarCount = lvars;
hnd->actions = actions;
ExpressionInstall(theEnv,hnd->actions);
#if DEBUGGING_FUNCTIONS
/* ===================================================
Old handler trace status is automatically preserved
=================================================== */
if (EnvGetConserveMemory(theEnv) == FALSE)
hnd->ppForm = CopyPPBuffer(theEnv);
else
#endif
hnd->ppForm = NULL;
return(FALSE);
}