/**********************************************************************
NAME : SlotDefaultValueCommand
DESCRIPTION : Determines the default avlue for the specified slot
of the specified class
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : None
NOTES : H/L Syntax : (slot-default-value <class> <slot>)
**********************************************************************/
globle void SlotDefaultValueCommand(
void *theEnv,
DATA_OBJECT_PTR theValue)
{
DEFCLASS *theDefclass;
SLOT_DESC *sd;
SetpType(theValue,SYMBOL);
SetpValue(theValue,EnvFalseSymbol(theEnv));
sd = CheckSlotExists(theEnv,"slot-default-value",&theDefclass,TRUE,TRUE);
if (sd == NULL)
return;
if (sd->noDefault)
{
SetpType(theValue,SYMBOL);
SetpValue(theValue,EnvAddSymbol(theEnv,"?NONE"));
return;
}
if (sd->dynamicDefault)
EvaluateAndStoreInDataObject(theEnv,(int) sd->multiple,
(EXPRESSION *) sd->defaultValue,
theValue,TRUE);
else
GenCopyMemory(DATA_OBJECT,1,theValue,sd->defaultValue);
}
/*********************************************************
NAME : SlotDefaultValue
DESCRIPTION : Determines the default value for
the specified slot of the specified class
INPUTS : 1) The class
2) The slot name
RETURNS : TRUE if slot default value is set,
FALSE otherwise
SIDE EFFECTS : Slot default value evaluated - dynamic
defaults will cause any side effects
NOTES : None
*********************************************************/
globle intBool EnvSlotDefaultValue(
void *theEnv,
void *theDefclass,
char *slotName,
DATA_OBJECT_PTR theValue)
{
SLOT_DESC *sd;
SetpType(theValue,SYMBOL);
SetpValue(theValue,EnvFalseSymbol(theEnv));
if ((sd = LookupSlot(theEnv,(DEFCLASS *) theDefclass,slotName,TRUE)) == NULL)
return(FALSE);
if (sd->noDefault)
{
SetpType(theValue,SYMBOL);
SetpValue(theValue,EnvAddSymbol(theEnv,"?NONE"));
return(TRUE);
}
if (sd->dynamicDefault)
return(EvaluateAndStoreInDataObject(theEnv,(int) sd->multiple,
(EXPRESSION *) sd->defaultValue,
theValue,TRUE));
GenCopyMemory(DATA_OBJECT,1,theValue,sd->defaultValue);
return(TRUE);
}
/*********************************************************
NAME : SlotDefaultValue
DESCRIPTION : Determines the default value for
the specified slot of the specified class
INPUTS : 1) The class
2) The slot name
RETURNS : True if slot default value is set,
false otherwise
SIDE EFFECTS : Slot default value evaluated - dynamic
defaults will cause any side effects
NOTES : None
*********************************************************/
bool SlotDefaultValue(
Defclass *theDefclass,
const char *slotName,
CLIPSValue *theValue)
{
SlotDescriptor *sd;
bool rv;
UDFValue result;
UDFValue *tmpPtr;
Environment *theEnv = theDefclass->header.env;
theValue->value = FalseSymbol(theEnv);
if ((sd = LookupSlot(theEnv,theDefclass,slotName,true)) == NULL)
{ return false; }
if (sd->noDefault)
{
theValue->value = CreateSymbol(theEnv,"?NONE");
return true;
}
if (sd->dynamicDefault)
{
rv = EvaluateAndStoreInDataObject(theEnv,sd->multiple,
(Expression *) sd->defaultValue,
&result,true);
NormalizeMultifield(theEnv,&result);
theValue->value = result.value;
return rv;
}
tmpPtr = (UDFValue *) sd->defaultValue;
theValue->value = tmpPtr->value;
return true;
}
/**********************************************************************
NAME : SlotDefaultValueCommand
DESCRIPTION : Determines the default avlue for the specified slot
of the specified class
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : None
NOTES : H/L Syntax : (slot-default-value <class> <slot>)
**********************************************************************/
void SlotDefaultValueCommand(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
Defclass *theDefclass;
SlotDescriptor *sd;
returnValue->lexemeValue = FalseSymbol(theEnv);
sd = CheckSlotExists(context,"slot-default-value",&theDefclass,true,true);
if (sd == NULL)
return;
if (sd->noDefault)
{
returnValue->lexemeValue = CreateSymbol(theEnv,"?NONE");
return;
}
if (sd->dynamicDefault)
EvaluateAndStoreInDataObject(theEnv,sd->multiple,
(Expression *) sd->defaultValue,
returnValue,true);
else
GenCopyMemory(UDFValue,1,returnValue,sd->defaultValue);
}
/***********************************************************
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);
}
static void UpdateSlot(
void *buf,
long obji)
{
SLOT_DESC *sp;
BSAVE_SLOT_DESC *bsp;
sp = (SLOT_DESC *) &slotArray[obji];
bsp = (BSAVE_SLOT_DESC *) buf;
sp->dynamicDefault = bsp->dynamicDefault;
sp->noDefault = bsp->noDefault;
sp->shared = bsp->shared;
sp->multiple = bsp->multiple;
sp->composite = bsp->composite;
sp->noInherit = bsp->noInherit;
sp->noWrite = bsp->noWrite;
sp->initializeOnly = bsp->initializeOnly;
sp->reactive = bsp->reactive;
sp->publicVisibility = bsp->publicVisibility;
sp->createReadAccessor = bsp->createReadAccessor;
sp->createWriteAccessor = bsp->createWriteAccessor;
sp->cls = DefclassPointer(bsp->cls);
sp->slotName = SlotNamePointer(bsp->slotName);
sp->overrideMessage = SymbolPointer(bsp->overrideMessage);
IncrementSymbolCount(sp->overrideMessage);
if (bsp->defaultValue != -1L)
{
if (sp->dynamicDefault)
sp->defaultValue = (void *) ExpressionPointer(bsp->defaultValue);
else
{
sp->defaultValue = (void *) get_struct(dataObject);
EvaluateAndStoreInDataObject((int) sp->multiple,ExpressionPointer(bsp->defaultValue),
(DATA_OBJECT *) sp->defaultValue);
ValueInstall((DATA_OBJECT *) sp->defaultValue);
}
}
else
sp->defaultValue = NULL;
sp->constraint = ConstraintPointer(bsp->constraint);
sp->sharedCount = 0;
sp->sharedValue.value = NULL;
sp->bsaveIndex = 0L;
if (sp->shared)
{
sp->sharedValue.desc = sp;
sp->sharedValue.value = NULL;
}
}
/***************************************************
NAME : ObjectsRunTimeInitialize
DESCRIPTION : Initializes objects system lists
in a run-time module
INPUTS : 1) Pointer to new class hash table
2) Pointer to new slot name table
RETURNS : Nothing useful
SIDE EFFECTS : Global pointers set
NOTES : None
***************************************************/
globle void ObjectsRunTimeInitialize(
void *theEnv,
DEFCLASS *ctable[],
SLOT_NAME *sntable[],
DEFCLASS **cidmap,
unsigned mid)
{
DEFCLASS *cls;
void *tmpexp;
register unsigned int i,j;
if (DefclassData(theEnv)->ClassTable != NULL)
{
for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
{
for (i = 0 ; i < cls->slotCount ; i++)
{
/* =====================================================================
For static default values, the data object value needs to deinstalled
and deallocated, and the expression needs to be restored (which was
temporarily stored in the supplementalInfo field of the data object)
===================================================================== */
if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
{
tmpexp = ((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo;
ValueDeinstall(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue);
rtn_struct(theEnv,dataObject,cls->slots[i].defaultValue);
cls->slots[i].defaultValue = tmpexp;
}
}
}
}
InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL = FindSymbolHN(theEnv,QUERY_DELIMETER_STRING);
MessageHandlerData(theEnv)->INIT_SYMBOL = FindSymbolHN(theEnv,INIT_STRING);
MessageHandlerData(theEnv)->DELETE_SYMBOL = FindSymbolHN(theEnv,DELETE_STRING);
MessageHandlerData(theEnv)->CREATE_SYMBOL = FindSymbolHN(theEnv,CREATE_STRING);
DefclassData(theEnv)->ISA_SYMBOL = FindSymbolHN(theEnv,SUPERCLASS_RLN);
DefclassData(theEnv)->NAME_SYMBOL = FindSymbolHN(theEnv,NAME_RLN);
#if DEFRULE_CONSTRUCT
DefclassData(theEnv)->INITIAL_OBJECT_SYMBOL = FindSymbolHN(theEnv,INITIAL_OBJECT_NAME);
#endif
DefclassData(theEnv)->ClassTable = (DEFCLASS **) ctable;
DefclassData(theEnv)->SlotNameTable = (SLOT_NAME **) sntable;
DefclassData(theEnv)->ClassIDMap = (DEFCLASS **) cidmap;
DefclassData(theEnv)->MaxClassID = (unsigned short) mid;
DefclassData(theEnv)->PrimitiveClassMap[FLOAT] =
LookupDefclassByMdlOrScope(theEnv,FLOAT_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[INTEGER] =
LookupDefclassByMdlOrScope(theEnv,INTEGER_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[STRING] =
LookupDefclassByMdlOrScope(theEnv,STRING_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[SYMBOL] =
LookupDefclassByMdlOrScope(theEnv,SYMBOL_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[MULTIFIELD] =
LookupDefclassByMdlOrScope(theEnv,MULTIFIELD_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[EXTERNAL_ADDRESS] =
LookupDefclassByMdlOrScope(theEnv,EXTERNAL_ADDRESS_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[FACT_ADDRESS] =
LookupDefclassByMdlOrScope(theEnv,FACT_ADDRESS_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME] =
LookupDefclassByMdlOrScope(theEnv,INSTANCE_NAME_TYPE_NAME);
DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS] =
LookupDefclassByMdlOrScope(theEnv,INSTANCE_ADDRESS_TYPE_NAME);
for (j = 0 ; j < CLASS_TABLE_HASH_SIZE ; j++)
for (cls = DefclassData(theEnv)->ClassTable[j] ; cls != NULL ; cls = cls->nxtHash)
{
for (i = 0 ; i < cls->slotCount ; i++)
{
if ((cls->slots[i].defaultValue != NULL) && (cls->slots[i].dynamicDefault == 0))
{
tmpexp = cls->slots[i].defaultValue;
cls->slots[i].defaultValue = (void *) get_struct(theEnv,dataObject);
EvaluateAndStoreInDataObject(theEnv,(int) cls->slots[i].multiple,(EXPRESSION *) tmpexp,
(DATA_OBJECT *) cls->slots[i].defaultValue,TRUE);
ValueInstall(theEnv,(DATA_OBJECT *) cls->slots[i].defaultValue);
((DATA_OBJECT *) cls->slots[i].defaultValue)->supplementalInfo = tmpexp;
}
}
}
SearchForHashedPatternNodes(theEnv,ObjectReteData(theEnv)->ObjectPatternNetworkPointer);
}
/********************************************************************
NAME : EvaluateSlotDefaultValue
DESCRIPTION : Checks the default value against the slot
constraints and evaluates static default values
INPUTS : 1) The slot descriptor
2) The bitmap marking which facets were specified in
the original slot definition
RETURNS : TRUE if all OK, FALSE otherwise
SIDE EFFECTS : Static default value expressions deleted and
replaced with data object evaluation
NOTES : On errors, slot is marked as dynamix so that
DeleteSlots() will erase the slot expression
********************************************************************/
static intBool EvaluateSlotDefaultValue(
void *theEnv,
EXEC_STATUS,
SLOT_DESC *sd,
char *specbits)
{
DATA_OBJECT temp;
int oldce,olddcc,vCode;
/* ===================================================================
Slot default value expression is marked as dynamic until now so
that DeleteSlots() would erase in the event of an error. The delay
was so that the evaluation of a static default value could be
delayed until all the constraints were parsed.
=================================================================== */
if (TestBitMap(specbits,DEFAULT_DYNAMIC_BIT) == 0)
sd->dynamicDefault = 0;
if (sd->noDefault)
return(TRUE);
if (sd->dynamicDefault == 0)
{
if (TestBitMap(specbits,DEFAULT_BIT))
{
oldce = ExecutingConstruct(theEnv,execStatus);
SetExecutingConstruct(theEnv,execStatus,TRUE);
olddcc = EnvSetDynamicConstraintChecking(theEnv,execStatus,EnvGetStaticConstraintChecking(theEnv,execStatus));
vCode = EvaluateAndStoreInDataObject(theEnv,execStatus,(int) sd->multiple,
(EXPRESSION *) sd->defaultValue,&temp,TRUE);
if (vCode != FALSE)
vCode = ValidSlotValue(theEnv,execStatus,&temp,sd,NULL,"slot default value");
EnvSetDynamicConstraintChecking(theEnv,execStatus,olddcc);
SetExecutingConstruct(theEnv,execStatus,oldce);
if (vCode)
{
ExpressionDeinstall(theEnv,execStatus,(EXPRESSION *) sd->defaultValue);
ReturnPackedExpression(theEnv,execStatus,(EXPRESSION *) sd->defaultValue);
sd->defaultValue = (void *) get_struct(theEnv,execStatus,dataObject);
GenCopyMemory(DATA_OBJECT,1,sd->defaultValue,&temp);
ValueInstall(theEnv,execStatus,(DATA_OBJECT *) sd->defaultValue);
}
else
{
sd->dynamicDefault = 1;
return(FALSE);
}
}
else if (sd->defaultSpecified == 0)
{
sd->defaultValue = (void *) get_struct(theEnv,execStatus,dataObject);
DeriveDefaultFromConstraints(theEnv,execStatus,sd->constraint,
(DATA_OBJECT *) sd->defaultValue,(int) sd->multiple,TRUE);
ValueInstall(theEnv,execStatus,(DATA_OBJECT *) sd->defaultValue);
}
}
else if (EnvGetStaticConstraintChecking(theEnv,execStatus))
{
vCode = ConstraintCheckExpressionChain(theEnv,execStatus,(EXPRESSION *) sd->defaultValue,sd->constraint);
if (vCode != NO_VIOLATION)
{
PrintErrorID(theEnv,execStatus,"CSTRNCHK",1,FALSE);
EnvPrintRouter(theEnv,execStatus,WERROR,"Expression for ");
PrintSlot(theEnv,execStatus,WERROR,sd,NULL,"dynamic default value");
ConstraintViolationErrorMessage(theEnv,execStatus,NULL,NULL,0,0,NULL,0,
vCode,sd->constraint,FALSE);
return(FALSE);
}
}
return(TRUE);
}
/***************************************************
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);
}
/********************************************************************
NAME : EvaluateSlotDefaultValue
DESCRIPTION : Checks the default value against the slot
constraints and evaluates static default values
INPUTS : 1) The slot descriptor
2) The bitmap marking which facets were specified in
the original slot definition
RETURNS : True if all OK, false otherwise
SIDE EFFECTS : Static default value expressions deleted and
replaced with data object evaluation
NOTES : On errors, slot is marked as dynamix so that
DeleteSlots() will erase the slot expression
********************************************************************/
static bool EvaluateSlotDefaultValue(
Environment *theEnv,
SlotDescriptor *sd,
const char *specbits)
{
UDFValue temp;
bool oldce,olddcc, vPass;
ConstraintViolationType vCode;
/* ===================================================================
Slot default value expression is marked as dynamic until now so
that DeleteSlots() would erase in the event of an error. The delay
was so that the evaluation of a static default value could be
delayed until all the constraints were parsed.
=================================================================== */
if (! TestBitMap(specbits,DEFAULT_DYNAMIC_BIT))
sd->dynamicDefault = 0;
if (sd->noDefault)
return true;
if (sd->dynamicDefault == 0)
{
if (TestBitMap(specbits,DEFAULT_BIT))
{
oldce = ExecutingConstruct(theEnv);
SetExecutingConstruct(theEnv,true);
olddcc = SetDynamicConstraintChecking(theEnv,true);
vPass = EvaluateAndStoreInDataObject(theEnv,sd->multiple,
(Expression *) sd->defaultValue,&temp,true);
if (vPass != false)
vPass = (ValidSlotValue(theEnv,&temp,sd,NULL,"the 'default' facet") == PSE_NO_ERROR);
SetDynamicConstraintChecking(theEnv,olddcc);
SetExecutingConstruct(theEnv,oldce);
if (vPass)
{
ExpressionDeinstall(theEnv,(Expression *) sd->defaultValue);
ReturnPackedExpression(theEnv,(Expression *) sd->defaultValue);
sd->defaultValue = get_struct(theEnv,udfValue);
GenCopyMemory(UDFValue,1,sd->defaultValue,&temp);
RetainUDFV(theEnv,(UDFValue *) sd->defaultValue);
}
else
{
sd->dynamicDefault = 1;
return false;
}
}
else if (sd->defaultSpecified == 0)
{
sd->defaultValue = get_struct(theEnv,udfValue);
DeriveDefaultFromConstraints(theEnv,sd->constraint,
(UDFValue *) sd->defaultValue,sd->multiple,true);
RetainUDFV(theEnv,(UDFValue *) sd->defaultValue);
}
}
else
{
vCode = ConstraintCheckExpressionChain(theEnv,(Expression *) sd->defaultValue,sd->constraint);
if (vCode != NO_VIOLATION)
{
PrintErrorID(theEnv,"CSTRNCHK",1,false);
WriteString(theEnv,STDERR,"Expression for ");
PrintSlot(theEnv,STDERR,sd,NULL,"dynamic default value");
ConstraintViolationErrorMessage(theEnv,NULL,NULL,0,0,NULL,0,
vCode,sd->constraint,false);
return false;
}
}
return true;
}
/*********************************************************************
NAME : CheckMultifieldSlotModify
DESCRIPTION : For the functions slot-replace$, insert, & delete
as well as direct-slot-replace$, insert, & delete
this function gets the slot, index, and optional
field-value for these functions
INPUTS : 1) A code indicating the type of operation
INSERT (0) : Requires one index
REPLACE (1) : Requires two indices
DELETE_OP (2) : Requires two indices
2) Function name-string
3) Instance address
4) Argument expression chain
5) Caller's buffer for index (or beginning of range)
6) Caller's buffer for end of range
(can be NULL for INSERT)
7) Caller's new-field value buffer
(can be NULL for DELETE_OP)
RETURNS : The address of the instance-slot,
NULL on errors
SIDE EFFECTS : Caller's index buffer set
Caller's new-field value buffer set (if not NULL)
Will allocate an ephemeral segment to store more
than 1 new field value
EvaluationError set on errors
NOTES : Assume the argument chain is at least 2
expressions deep - slot, index, and optional values
*********************************************************************/
static INSTANCE_SLOT *CheckMultifieldSlotModify(
void *theEnv,
int code,
char *func,
INSTANCE_TYPE *ins,
EXPRESSION *args,
int *rb,
int *re,
DATA_OBJECT *newval)
{
DATA_OBJECT temp;
INSTANCE_SLOT *sp;
int start;
start = (args == GetFirstArgument()) ? 1 : 2;
EvaluationData(theEnv)->EvaluationError = FALSE;
EvaluateExpression(theEnv,args,&temp);
if (temp.type != SYMBOL)
{
ExpectedTypeError1(theEnv,func,start,"symbol");
SetEvaluationError(theEnv,TRUE);
return(NULL);
}
sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value);
if (sp == NULL)
{
SlotExistError(theEnv,ValueToString(temp.value),func);
return(NULL);
}
if (sp->desc->multiple == 0)
{
PrintErrorID(theEnv,"INSMULT",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"Function ");
EnvPrintRouter(theEnv,WERROR,func);
EnvPrintRouter(theEnv,WERROR," cannot be used on single-field slot ");
EnvPrintRouter(theEnv,WERROR,ValueToString(sp->desc->slotName->name));
EnvPrintRouter(theEnv,WERROR," in instance ");
EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
EnvPrintRouter(theEnv,WERROR,".\n");
SetEvaluationError(theEnv,TRUE);
return(NULL);
}
EvaluateExpression(theEnv,args->nextArg,&temp);
if (temp.type != INTEGER)
{
ExpectedTypeError1(theEnv,func,start+1,"integer");
SetEvaluationError(theEnv,TRUE);
return(NULL);
}
args = args->nextArg->nextArg;
*rb = ValueToInteger(temp.value);
if ((code == REPLACE) || (code == DELETE_OP))
{
EvaluateExpression(theEnv,args,&temp);
if (temp.type != INTEGER)
{
ExpectedTypeError1(theEnv,func,start+2,"integer");
SetEvaluationError(theEnv,TRUE);
return(NULL);
}
*re = ValueToInteger(temp.value);
args = args->nextArg;
}
if ((code == INSERT) || (code == REPLACE))
{
if (EvaluateAndStoreInDataObject(theEnv,1,args,newval) == FALSE)
return(NULL);
}
return(sp);
}
