/***********************************************************
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 : 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);
}
/***************************************************
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);
}
