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