/***********************************************************
NAME : DynamicHandlerPutSlot
DESCRIPTION : Directly puts a slot's value
(uses dynamic binding to lookup slot)
INPUTS : Data obejct buffer for holding slot value
RETURNS : Nothing useful
SIDE EFFECTS : Slot modified - and caller's buffer set
to value (or symbol FALSE on errors)
NOTES : H/L Syntax: (put <slot> <value>*)
***********************************************************/
globle void DynamicHandlerPutSlot(
DATA_OBJECT *theResult)
{
INSTANCE_SLOT *sp;
INSTANCE_TYPE *ins;
DATA_OBJECT temp;
theResult->type = SYMBOL;
theResult->value = FalseSymbol;
if (CheckCurrentMessage("dynamic-put",TRUE) == FALSE)
return;
EvaluateExpression(GetFirstArgument(),&temp);
if (temp.type != SYMBOL)
{
ExpectedTypeError1("dynamic-put",1,"symbol");
SetEvaluationError(TRUE);
return;
}
ins = GetActiveInstance();
sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value);
if (sp == NULL)
{
SlotExistError(ValueToString(temp.value),"dynamic-put");
return;
}
if ((sp->desc->noWrite == 0) ? FALSE :
((sp->desc->initializeOnly == 0) || (!ins->initializeInProgress)))
{
SlotAccessViolationError(ValueToString(sp->desc->slotName->name),
TRUE,(void *) ins);
SetEvaluationError(TRUE);
return;
}
if ((sp->desc->publicVisibility == 0) &&
(CurrentCore->hnd->cls != sp->desc->cls))
{
SlotVisibilityViolationError(sp->desc,CurrentCore->hnd->cls);
SetEvaluationError(TRUE);
return;
}
if (GetFirstArgument()->nextArg)
{
if (EvaluateAndStoreInDataObject((int) sp->desc->multiple,
GetFirstArgument()->nextArg,&temp) == FALSE)
return;
}
else
{
SetpDOBegin(&temp,1);
SetpDOEnd(&temp,0);
SetpType(&temp,MULTIFIELD);
SetpValue(&temp,NoParamValue);
}
PutSlotValue(ins,sp,&temp,theResult,NULL);
}
/*********************************************************
NAME : CheckSlotReference
DESCRIPTION : Examines a ?self:<slot-name> reference
If the reference is a single-field or
global variable, checking and evaluation
is delayed until run-time. If the
reference is a symbol, this routine
verifies that the slot is a legal
slot for the reference (i.e., it exists
in the class to which the message-handler
is being attached, it is visible and it
is writable for write reference)
INPUTS : 1) A buffer holding the class
of the handler being parsed
2) The type of the slot reference
3) The value of the slot reference
4) A flag indicating if this is a read
or write access
5) Value expression for write
RETURNS : Class slot on success, NULL on errors
SIDE EFFECTS : Messages printed on errors.
NOTES : For static references, this function
insures that the slot is either
publicly visible or that the handler
is being attached to the same class in
which the private slot is defined.
*********************************************************/
static SLOT_DESC *CheckSlotReference(
void *theEnv,
DEFCLASS *theDefclass,
int theType,
void *theValue,
CLIPS_BOOLEAN writeFlag,
EXPRESSION *writeExpression)
{
int slotIndex;
SLOT_DESC *sd;
int vCode;
if (theType != SYMBOL)
{
PrintErrorID(theEnv,"MSGPSR",7,FALSE);
EnvPrintRouter(theEnv,WERROR,"Illegal value for ?self reference.\n");
return(NULL);
}
slotIndex = FindInstanceTemplateSlot(theEnv,theDefclass,(SYMBOL_HN *) theValue);
if (slotIndex == -1)
{
PrintErrorID(theEnv,"MSGPSR",6,FALSE);
EnvPrintRouter(theEnv,WERROR,"No such slot ");
EnvPrintRouter(theEnv,WERROR,ValueToString(theValue));
EnvPrintRouter(theEnv,WERROR," in class ");
EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) theDefclass));
EnvPrintRouter(theEnv,WERROR," for ?self reference.\n");
return(NULL);
}
sd = theDefclass->instanceTemplate[slotIndex];
if ((sd->publicVisibility == 0) && (sd->cls != theDefclass))
{
SlotVisibilityViolationError(theEnv,sd,theDefclass);
return(NULL);
}
if (! writeFlag)
return(sd);
/* =================================================
If a slot is initialize-only, the WithinInit flag
still needs to be checked at run-time, for the
handler could be called out of the context of
an init.
================================================= */
if (sd->noWrite && (sd->initializeOnly == 0))
{
SlotAccessViolationError(theEnv,ValueToString(theValue),
FALSE,(void *) theDefclass);
return(NULL);
}
if (EnvGetStaticConstraintChecking(theEnv))
{
vCode = ConstraintCheckExpressionChain(theEnv,writeExpression,sd->constraint);
if (vCode != NO_VIOLATION)
{
PrintErrorID(theEnv,"CSTRNCHK",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"Expression for ");
PrintSlot(theEnv,WERROR,sd,NULL,"direct slot write");
ConstraintViolationErrorMessage(theEnv,NULL,NULL,0,0,NULL,0,
vCode,sd->constraint,FALSE);
return(NULL);
}
}
return(sd);
}
/***************************************************
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);
}
