/***********************************************************
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 : DynamicHandlerGetSlot
DESCRIPTION : Directly references a slot's value
(uses dynamic binding to lookup slot)
INPUTS : The caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : Caller's result buffer set
NOTES : H/L Syntax: (get <slot>)
*****************************************************/
globle void DynamicHandlerGetSlot(
DATA_OBJECT *result)
{
INSTANCE_SLOT *sp;
INSTANCE_TYPE *ins;
DATA_OBJECT temp;
result->type = SYMBOL;
result->value = FalseSymbol;
if (CheckCurrentMessage("dynamic-get",TRUE) == FALSE)
return;
EvaluateExpression(GetFirstArgument(),&temp);
if (temp.type != SYMBOL)
{
ExpectedTypeError1("dynamic-get",1,"symbol");
SetEvaluationError(TRUE);
return;
}
ins = GetActiveInstance();
sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value);
if (sp == NULL)
{
SlotExistError(ValueToString(temp.value),"dynamic-get");
return;
}
if ((sp->desc->publicVisibility == 0) &&
(CurrentCore->hnd->cls != sp->desc->cls))
{
SlotVisibilityViolationError(sp->desc,CurrentCore->hnd->cls);
SetEvaluationError(TRUE);
return;
}
result->type = sp->type;
result->value = sp->value;
if (sp->type == MULTIFIELD)
{
result->begin = 0;
result->end = GetInstanceSlotLength(sp) - 1;
}
}
/*********************************************************
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);
}
