/*****************************************************************
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 : CheckMultifieldSlotInstance
DESCRIPTION : Gets the instance for the functions slot-replace$,
insert and delete
INPUTS : The function name
RETURNS : The instance address, NULL on errors
SIDE EFFECTS : None
NOTES : None
**********************************************************************/
static INSTANCE_TYPE *CheckMultifieldSlotInstance(
void *theEnv,
char *func)
{
INSTANCE_TYPE *ins;
DATA_OBJECT temp;
if (EnvArgTypeCheck(theEnv,func,1,INSTANCE_OR_INSTANCE_NAME,&temp) == FALSE)
{
SetEvaluationError(theEnv,TRUE);
return(NULL);
}
if (temp.type == INSTANCE_ADDRESS)
{
ins = (INSTANCE_TYPE *) temp.value;
if (ins->garbage == 1)
{
StaleInstanceAddress(theEnv,func,0);
SetEvaluationError(theEnv,TRUE);
return(NULL);
}
}
else
{
ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value);
if (ins == NULL)
NoInstanceError(theEnv,ValueToString(temp.value),func);
}
return(ins);
}
/***************************************************
NAME : HandlerSlotGetFunction
DESCRIPTION : Access function for handling the
statically-bound direct slot
references in message-handlers
INPUTS : 1) The bitmap expression
2) A data object buffer
RETURNS : TRUE if OK, FALSE
on errors
SIDE EFFECTS : Data object buffer gets value of
slot. On errors, buffer gets
symbol FALSE, EvaluationError
is set and error messages are
printed
NOTES : It is possible for a handler
(attached to a superclass of
the currently active instance)
containing these static references
to be called for an instance
which does not contain the slots
(e.g., an instance of a subclass
where the original slot was
no-inherit or the subclass
overrode the original slot)
***************************************************/
globle BOOLEAN HandlerSlotGetFunction(
void *theValue,
DATA_OBJECT *theResult)
{
HANDLER_SLOT_REFERENCE *theReference;
DEFCLASS *theDefclass;
INSTANCE_TYPE *theInstance;
INSTANCE_SLOT *sp;
unsigned instanceSlotIndex;
theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue);
theInstance = (INSTANCE_TYPE *) ProcParamArray[0].value;
theDefclass = ClassIDMap[theReference->classID];
if (theInstance->garbage)
{
StaleInstanceAddress("for slot get",0);
theResult->type = SYMBOL;
theResult->value = FalseSymbol;
SetEvaluationError(TRUE);
return(FALSE);
}
if (theInstance->cls == theDefclass)
{
instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
sp = theInstance->slotAddresses[instanceSlotIndex - 1];
}
else
{
if (theReference->slotID > theInstance->cls->maxSlotNameID)
goto HandlerGetError;
instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
if (instanceSlotIndex == 0)
goto HandlerGetError;
instanceSlotIndex--;
sp = theInstance->slotAddresses[instanceSlotIndex];
if (sp->desc->cls != theDefclass)
goto HandlerGetError;
}
theResult->type = sp->type;
theResult->value = sp->value;
if (sp->type == MULTIFIELD)
{
theResult->begin = 0;
theResult->end = GetInstanceSlotLength(sp) - 1;
}
return(TRUE);
HandlerGetError:
EarlySlotBindError(theInstance,theDefclass,theReference->slotID);
theResult->type = SYMBOL;
theResult->value = FalseSymbol;
SetEvaluationError(TRUE);
return(FALSE);
}
/*****************************************************
NAME : PerformMessage
DESCRIPTION : Calls core framework for a message
INPUTS : 1) Caller's result buffer
2) Message argument expressions
(including implicit object)
3) Message name
RETURNS : Nothing useful
SIDE EFFECTS : Any side-effects of message execution
and caller's result buffer set
NOTES : None
*****************************************************/
static void PerformMessage(
DATA_OBJECT *result,
EXPRESSION *args,
SYMBOL_HN *mname)
{
int oldce;
HANDLER_LINK *oldCore;
DEFCLASS *cls = NULL;
INSTANCE_TYPE *ins = NULL;
SYMBOL_HN *oldName;
#if PROFILING_FUNCTIONS
struct profileFrameInfo profileFrame;
#endif
result->type = SYMBOL;
result->value = FalseSymbol;
EvaluationError = FALSE;
if (HaltExecution)
return;
oldce = ExecutingConstruct();
SetExecutingConstruct(TRUE);
oldName = CurrentMessageName;
CurrentMessageName = mname;
CurrentEvaluationDepth++;
PushProcParameters(args,CountArguments(args),
ValueToString(CurrentMessageName),"message",
UnboundHandlerErr);
if (EvaluationError)
{
CurrentEvaluationDepth--;
CurrentMessageName = oldName;
PeriodicCleanup(FALSE,TRUE);
SetExecutingConstruct(oldce);
return;
}
if (ProcParamArray->type == INSTANCE_ADDRESS)
{
ins = (INSTANCE_TYPE *) ProcParamArray->value;
if (ins->garbage == 1)
{
StaleInstanceAddress("send",0);
SetEvaluationError(TRUE);
}
else if (DefclassInScope(ins->cls,(struct defmodule *) GetCurrentModule()) == FALSE)
NoInstanceError(ValueToString(ins->name),"send");
else
{
cls = ins->cls;
ins->busy++;
}
}
else if (ProcParamArray->type == INSTANCE_NAME)
{
ins = FindInstanceBySymbol((SYMBOL_HN *) ProcParamArray->value);
if (ins == NULL)
{
PrintErrorID("MSGPASS",2,FALSE);
PrintRouter(WERROR,"No such instance ");
PrintRouter(WERROR,ValueToString((SYMBOL_HN *) ProcParamArray->value));
PrintRouter(WERROR," in function send.\n");
SetEvaluationError(TRUE);
}
else
{
ProcParamArray->value = (void *) ins;
ProcParamArray->type = INSTANCE_ADDRESS;
cls = ins->cls;
ins->busy++;
}
}
else if ((cls = PrimitiveClassMap[ProcParamArray->type]) == NULL)
{
SystemError("MSGPASS",1);
ExitRouter(EXIT_FAILURE);
}
if (EvaluationError)
{
PopProcParameters();
CurrentEvaluationDepth--;
CurrentMessageName = oldName;
PeriodicCleanup(FALSE,TRUE);
SetExecutingConstruct(oldce);
return;
}
oldCore = TopOfCore;
TopOfCore = FindApplicableHandlers(cls,mname);
if (TopOfCore != NULL)
{
HANDLER_LINK *oldCurrent,*oldNext;
oldCurrent = CurrentCore;
oldNext = NextInCore;
#if IMPERATIVE_MESSAGE_HANDLERS
if (TopOfCore->hnd->type == MAROUND)
{
CurrentCore = TopOfCore;
NextInCore = TopOfCore->nxt;
#if DEBUGGING_FUNCTIONS
if (WatchMessages)
WatchMessage(WTRACE,BEGIN_TRACE);
if (CurrentCore->hnd->trace)
WatchHandler(WTRACE,CurrentCore,BEGIN_TRACE);
#endif
if (CheckHandlerArgCount())
{
#if PROFILING_FUNCTIONS
StartProfile(&profileFrame,
&CurrentCore->hnd->usrData,
ProfileConstructs);
#endif
EvaluateProcActions(CurrentCore->hnd->cls->header.whichModule->theModule,
CurrentCore->hnd->actions,
CurrentCore->hnd->localVarCount,
result,UnboundHandlerErr);
#if PROFILING_FUNCTIONS
EndProfile(&profileFrame);
#endif
}
#if DEBUGGING_FUNCTIONS
if (CurrentCore->hnd->trace)
WatchHandler(WTRACE,CurrentCore,END_TRACE);
if (WatchMessages)
WatchMessage(WTRACE,END_TRACE);
#endif
}
else
#endif /* IMPERATIVE_MESSAGE_HANDLERS */
{
CurrentCore = NULL;
NextInCore = TopOfCore;
#if DEBUGGING_FUNCTIONS
if (WatchMessages)
WatchMessage(WTRACE,BEGIN_TRACE);
#endif
CallHandlers(result);
#if DEBUGGING_FUNCTIONS
if (WatchMessages)
WatchMessage(WTRACE,END_TRACE);
#endif
}
DestroyHandlerLinks(TopOfCore);
CurrentCore = oldCurrent;
NextInCore = oldNext;
}
TopOfCore = oldCore;
ReturnFlag = FALSE;
if (ins != NULL)
ins->busy--;
/* ==================================
Restore the original calling frame
================================== */
PopProcParameters();
CurrentEvaluationDepth--;
CurrentMessageName = oldName;
PropagateReturnValue(result);
PeriodicCleanup(FALSE,TRUE);
SetExecutingConstruct(oldce);
if (EvaluationError)
{
result->type = SYMBOL;
result->value = FalseSymbol;
}
}
/***************************************************
NAME : HandlerSlotPutFunction
DESCRIPTION : Access function for handling the
statically-bound direct slot
bindings in message-handlers
INPUTS : 1) The bitmap expression
2) A data object buffer
RETURNS : TRUE if OK, FALSE
on errors
SIDE EFFECTS : Data object buffer gets symbol
TRUE and slot is set. On errors,
buffer gets symbol FALSE,
EvaluationError is set and error
messages are printed
NOTES : It is possible for a handler
(attached to a superclass of
the currently active instance)
containing these static references
to be called for an instance
which does not contain the slots
(e.g., an instance of a subclass
where the original slot was
no-inherit or the subclass
overrode the original slot)
***************************************************/
globle BOOLEAN HandlerSlotPutFunction(
void *theValue,
DATA_OBJECT *theResult)
{
HANDLER_SLOT_REFERENCE *theReference;
DEFCLASS *theDefclass;
INSTANCE_TYPE *theInstance;
INSTANCE_SLOT *sp;
unsigned instanceSlotIndex;
DATA_OBJECT theSetVal;
theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue);
theInstance = (INSTANCE_TYPE *) ProcParamArray[0].value;
theDefclass = ClassIDMap[theReference->classID];
if (theInstance->garbage)
{
StaleInstanceAddress("for slot put",0);
theResult->type = SYMBOL;
theResult->value = FalseSymbol;
SetEvaluationError(TRUE);
return(FALSE);
}
if (theInstance->cls == theDefclass)
{
instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
sp = theInstance->slotAddresses[instanceSlotIndex - 1];
}
else
{
if (theReference->slotID > theInstance->cls->maxSlotNameID)
goto HandlerPutError;
instanceSlotIndex = theInstance->cls->slotNameMap[theReference->slotID];
if (instanceSlotIndex == 0)
goto HandlerPutError;
instanceSlotIndex--;
sp = theInstance->slotAddresses[instanceSlotIndex];
if (sp->desc->cls != theDefclass)
goto HandlerPutError;
}
/* =======================================================
The slot has already been verified not to be read-only.
However, if it is initialize-only, we need to make sure
that we are initializing the instance (something we
could not verify at parse-time)
======================================================= */
if (sp->desc->initializeOnly && (!theInstance->initializeInProgress))
{
SlotAccessViolationError(ValueToString(sp->desc->slotName->name),
TRUE,(void *) theInstance);
goto HandlerPutError2;
}
/* ======================================
No arguments means to use the
special NoParamValue to reset the slot
to its default value
====================================== */
if (GetFirstArgument())
{
if (EvaluateAndStoreInDataObject((int) sp->desc->multiple,
GetFirstArgument(),&theSetVal) == FALSE)
goto HandlerPutError2;
}
else
{
SetDOBegin(theSetVal,1);
SetDOEnd(theSetVal,0);
SetType(theSetVal,MULTIFIELD);
SetValue(theSetVal,NoParamValue);
}
if (PutSlotValue(theInstance,sp,&theSetVal,theResult,NULL) == FALSE)
goto HandlerPutError2;
return(TRUE);
HandlerPutError:
EarlySlotBindError(theInstance,theDefclass,theReference->slotID);
HandlerPutError2:
theResult->type = SYMBOL;
theResult->value = FalseSymbol;
SetEvaluationError(TRUE);
return(FALSE);
}
