/***********************************************************
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 : DirectMVInsertCommand
DESCRIPTION : Directly inserts a slot's value
INPUTS : None
RETURNS : TRUE if put OK, FALSE otherwise
SIDE EFFECTS : Slot modified
NOTES : H/L Syntax: (direct-slot-insert$ <slot> <index> <value>)
************************************************************************/
globle BOOLEAN DirectMVInsertCommand(
void *theEnv)
{
INSTANCE_SLOT *sp;
INSTANCE_TYPE *ins;
int theIndex;
DATA_OBJECT newval,newseg,oldseg;
if (CheckCurrentMessage(theEnv,"direct-slot-insert$",TRUE) == FALSE)
return(FALSE);
ins = GetActiveInstance(theEnv);
sp = CheckMultifieldSlotModify(theEnv,INSERT,"direct-slot-insert$",ins,
GetFirstArgument(),&theIndex,NULL,&newval);
if (sp == NULL)
return(FALSE);
AssignSlotToDataObject(&oldseg,sp);
if (InsertMultiValueField(theEnv,&newseg,&oldseg,theIndex,&newval,"direct-slot-insert$")
== FALSE)
return(FALSE);
if (PutSlotValue(theEnv,ins,sp,&newseg,&newval,"function direct-slot-insert$"))
return(TRUE);
return(FALSE);
}
/*****************************************************************
NAME : DirectMVDeleteCommand
DESCRIPTION : Directly deletes a slot's value
INPUTS : None
RETURNS : TRUE if put OK, FALSE otherwise
SIDE EFFECTS : Slot modified
NOTES : H/L Syntax: (direct-slot-delete$ <slot>
<range-begin> <range-end>)
*****************************************************************/
globle BOOLEAN DirectMVDeleteCommand(
void *theEnv)
{
INSTANCE_SLOT *sp;
INSTANCE_TYPE *ins;
int rb,re;
DATA_OBJECT newseg,oldseg;
if (CheckCurrentMessage(theEnv,"direct-slot-delete$",TRUE) == FALSE)
return(FALSE);
ins = GetActiveInstance(theEnv);
sp = CheckMultifieldSlotModify(theEnv,DELETE_OP,"direct-slot-delete$",ins,
GetFirstArgument(),&rb,&re,NULL);
if (sp == NULL)
return(FALSE);
AssignSlotToDataObject(&oldseg,sp);
if (DeleteMultiValueField(theEnv,&newseg,&oldseg,rb,re,"direct-slot-delete$")
== FALSE)
return(FALSE);
if (PutSlotValue(theEnv,ins,sp,&newseg,&oldseg,"function direct-slot-delete$"))
return(TRUE);
return(FALSE);
}
/*****************************************************************
NAME : DirectMVReplaceCommand
DESCRIPTION : Directly replaces a slot's value
INPUTS : None
RETURNS : TRUE if put OK, FALSE otherwise
SIDE EFFECTS : Slot modified
NOTES : H/L Syntax: (direct-slot-replace$ <slot>
<range-begin> <range-end> <value>)
*****************************************************************/
globle intBool DirectMVReplaceCommand(
void *theEnv)
{
INSTANCE_SLOT *sp;
INSTANCE_TYPE *ins;
long rb,re;
DATA_OBJECT newval,newseg,oldseg;
if (CheckCurrentMessage(theEnv,(char*)"direct-slot-replace$",TRUE) == FALSE)
return(FALSE);
ins = GetActiveInstance(theEnv);
sp = CheckMultifieldSlotModify(theEnv,REPLACE,(char*)"direct-slot-replace$",ins,
GetFirstArgument(),&rb,&re,&newval);
if (sp == NULL)
return(FALSE);
AssignSlotToDataObject(&oldseg,sp);
if (ReplaceMultiValueField(theEnv,&newseg,&oldseg,rb,re,&newval,(char*)"direct-slot-replace$")
== FALSE)
return(FALSE);
if (PutSlotValue(theEnv,ins,sp,&newseg,&newval,(char*)"function direct-slot-replace$"))
return(TRUE);
return(FALSE);
}
