/***************************************************************************
NAME : GetQueryInstanceSlot
DESCRIPTION : Internal function for referring to slots of instances in
instance array on instance-queries
INPUTS : The caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : Caller's result buffer set appropriately
NOTES : H/L Syntax : ((query-instance-slot) <index> <slot-name>)
**************************************************************************/
globle void GetQueryInstanceSlot(
void *theEnv,
DATA_OBJECT *result)
{
INSTANCE_TYPE *ins;
INSTANCE_SLOT *sp;
DATA_OBJECT temp;
QUERY_CORE *core;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv);
core = FindQueryCore(theEnv,ValueToInteger(GetpValue(GetFirstArgument())));
ins = core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))];
EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&temp);
if (temp.type != SYMBOL)
{
ExpectedTypeError1(theEnv,"get",1,"symbol");
EnvSetEvaluationError(theEnv,TRUE);
return;
}
sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value);
if (sp == NULL)
{
SlotExistError(theEnv,ValueToString(temp.value),"instance-set query");
return;
}
result->type = (unsigned short) sp->type;
result->value = sp->value;
if (sp->type == MULTIFIELD)
{
result->begin = 0;
SetpDOEnd(result,GetInstanceSlotLength(sp));
}
}
/***************************************************************************
NAME : GetQueryInstanceSlot
DESCRIPTION : Internal function for referring to slots of instances in
instance array on instance-queries
INPUTS : The caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : Caller's result buffer set appropriately
NOTES : H/L Syntax : ((query-instance-slot) <index> <slot-name>)
**************************************************************************/
globle void GetQueryInstanceSlot(
DATA_OBJECT *result)
{
INSTANCE_TYPE *ins;
INSTANCE_SLOT *sp;
DATA_OBJECT temp;
QUERY_CORE *core;
result->type = SYMBOL;
result->value = FalseSymbol;
core = FindQueryCore(DOPToInteger(GetFirstArgument()));
ins = core->solns[DOPToInteger(GetFirstArgument()->nextArg)];
EvaluateExpression(GetFirstArgument()->nextArg->nextArg,&temp);
if (temp.type != SYMBOL)
{
ExpectedTypeError1("get",1,"symbol");
SetEvaluationError(TRUE);
return;
}
sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value);
if (sp == NULL)
{
SlotExistError(ValueToString(temp.value),"instance-set query");
return;
}
result->type = sp->type;
result->value = sp->value;
if (sp->type == MULTIFIELD)
{
result->begin = 0;
result->end = GetInstanceSlotLength(sp) - 1;
}
}
/***************************************************
NAME : AssignSlotToDataObject
DESCRIPTION : Assigns the value of a multifield
slot to a data object
INPUTS : 1) The data object buffer
2) The instance slot
RETURNS : Nothing useful
SIDE EFFECTS : Data object fields set
NOTES : Assumes slot is a multislot
***************************************************/
static void AssignSlotToDataObject(
DATA_OBJECT *theDataObject,
INSTANCE_SLOT *theSlot)
{
theDataObject->type = (unsigned short) theSlot->type;
theDataObject->value = theSlot->value;
theDataObject->begin = 0;
SetpDOEnd(theDataObject,GetInstanceSlotLength(theSlot));
}
/***************************************************
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 : 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;
}
}
