/****************************************************************************
NAME : SlotReferenceVar
DESCRIPTION : Replaces direct slot references in handler body
with special function calls to reference active instance
at run-time
The slot in in the class bound at parse-time is always
referenced (early binding).
Slot references of the form ?self:<name> directly reference
ProcParamArray[0] (the message object - ?self) to
find the specified slot at run-time
INPUTS : 1) Variable expression
2) The class of the handler being parsed
RETURNS : 0 if not recognized, 1 if so, -1 on errors
SIDE EFFECTS : Handler body SF_VARIABLE and MF_VARIABLE replaced with
direct slot access function
NOTES : Objects are allowed to directly access their own slots
without sending a message to themselves. Since the object
is "within the boundary of its internals", this does not
violate the encapsulation principle of OOP.
****************************************************************************/
static int SlotReferenceVar(
void *theEnv,
EXPRESSION *varexp,
void *userBuffer)
{
struct token itkn;
int oldpp;
SLOT_DESC *sd;
if ((varexp->type != SF_VARIABLE) && (varexp->type != MF_VARIABLE))
return(0);
if ((strncmp(ValueToString(varexp->value),SELF_STRING,SELF_LEN) == 0) ?
(ValueToString(varexp->value)[SELF_LEN] == SELF_SLOT_REF) : FALSE)
{
OpenStringSource(theEnv,"hnd-var",ValueToString(varexp->value) + SELF_LEN + 1,0);
oldpp = GetPPBufferStatus(theEnv);
SetPPBufferStatus(theEnv,OFF);
GetToken(theEnv,"hnd-var",&itkn);
SetPPBufferStatus(theEnv,oldpp);
CloseStringSource(theEnv,"hnd-var");
if (itkn.type != STOP)
{
sd = CheckSlotReference(theEnv,(DEFCLASS *) userBuffer,itkn.type,itkn.value,
FALSE,NULL);
if (sd == NULL)
return(-1);
GenHandlerSlotReference(theEnv,varexp,HANDLER_GET,sd);
return(1);
}
}
return(0);
}
/*************************************************************************
NAME : ReplaceSlotReference
DESCRIPTION : Replaces instance-set query function variable
references of the form: <instance-variable>:<slot-name>
with function calls to get these instance-slots at run
time
INPUTS : 1) The instance-set variable list
2) The expression containing the variable
3) The address of the instance slot access function
4) Nesting depth of query functions
RETURNS : Nothing useful
SIDE EFFECTS : If the variable is a slot reference, then it is replaced
with the appropriate function-call.
NOTES : None
*************************************************************************/
static void ReplaceSlotReference(
void *theEnv,
EXEC_STATUS,
EXPRESSION *vlist,
EXPRESSION *theExp,
struct FunctionDefinition *func,
int ndepth)
{
size_t len;
int posn,oldpp;
size_t i;
register char *str;
EXPRESSION *eptr;
struct token itkn;
str = ValueToString(theExp->value);
len = strlen(str);
if (len < 3)
return;
for (i = len-2 ; i >= 1 ; i--)
{
if ((str[i] == INSTANCE_SLOT_REF) ? (i >= 1) : FALSE)
{
eptr = vlist;
posn = 0;
while (eptr && ((i != strlen(ValueToString(eptr->value))) ||
strncmp(ValueToString(eptr->value),str,
(STD_SIZE) i)))
{
eptr = eptr->nextArg;
posn++;
}
if (eptr != NULL)
{
OpenStringSource(theEnv,execStatus,"query-var",str+i+1,0);
oldpp = GetPPBufferStatus(theEnv,execStatus);
SetPPBufferStatus(theEnv,execStatus,OFF);
GetToken(theEnv,execStatus,"query-var",&itkn);
SetPPBufferStatus(theEnv,execStatus,oldpp);
CloseStringSource(theEnv,execStatus,"query-var");
theExp->type = FCALL;
theExp->value = (void *) func;
theExp->argList = GenConstant(theEnv,execStatus,INTEGER,(void *) EnvAddLong(theEnv,execStatus,(long long) ndepth));
theExp->argList->nextArg =
GenConstant(theEnv,execStatus,INTEGER,(void *) EnvAddLong(theEnv,execStatus,(long long) posn));
theExp->argList->nextArg->nextArg = GenConstant(theEnv,execStatus,itkn.type,itkn.value);
break;
}
}
}
}
/****************************************************************************
NAME : BindSlotReference
DESCRIPTION : Replaces direct slot binds in handler body with special
function calls to reference active instance at run-time
The slot in in the class bound at parse-time is always
referenced (early binding).
Slot references of the form ?self:<name> directly reference
ProcParamArray[0] (the message object - ?self) to
find the specified slot at run-time
INPUTS : 1) Variable expression
2) The class for the message-handler being parsed
RETURNS : 0 if not recognized, 1 if so, -1 on errors
SIDE EFFECTS : Handler body "bind" call replaced with direct slot access
function
NOTES : Objects are allowed to directly access their own slots
without sending a message to themselves. Since the object
is "within the boundary of its internals", this does not
violate the encapsulation principle of OOP.
****************************************************************************/
static int BindSlotReference(
void *theEnv,
EXPRESSION *bindExp,
void *userBuffer)
{
char *bindName;
struct token itkn;
int oldpp;
SLOT_DESC *sd;
EXPRESSION *saveExp;
bindName = ValueToString(bindExp->argList->value);
if (strcmp(bindName,SELF_STRING) == 0)
{
PrintErrorID(theEnv,"MSGPSR",5,FALSE);
EnvPrintRouter(theEnv,WERROR,"Active instance parameter cannot be changed.\n");
return(-1);
}
if ((strncmp(bindName,SELF_STRING,SELF_LEN) == 0) ?
(bindName[SELF_LEN] == SELF_SLOT_REF) : FALSE)
{
OpenStringSource(theEnv,"hnd-var",bindName + SELF_LEN + 1,0);
oldpp = GetPPBufferStatus(theEnv);
SetPPBufferStatus(theEnv,OFF);
GetToken(theEnv,"hnd-var",&itkn);
SetPPBufferStatus(theEnv,oldpp);
CloseStringSource(theEnv,"hnd-var");
if (itkn.type != STOP)
{
saveExp = bindExp->argList->nextArg;
sd = CheckSlotReference(theEnv,(DEFCLASS *) userBuffer,itkn.type,itkn.value,
TRUE,saveExp);
if (sd == NULL)
return(-1);
GenHandlerSlotReference(theEnv,bindExp,HANDLER_PUT,sd);
bindExp->argList->nextArg = NULL;
ReturnExpression(theEnv,bindExp->argList);
bindExp->argList = saveExp;
return(1);
}
}
return(0);
}
globle int EnvEval(
void *theEnv,
char *theString,
DATA_OBJECT_PTR returnValue)
{
struct expr *top;
int ov;
static int depth = 0;
char logicalNameBuffer[20];
struct BindInfo *oldBinds;
/*======================================================*/
/* Evaluate the string. Create a different logical name */
/* for use each time the eval function is called. */
/*======================================================*/
depth++;
sprintf(logicalNameBuffer,"Eval-%d",depth);
if (OpenStringSource(theEnv,logicalNameBuffer,theString,0) == 0)
{
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvFalseSymbol(theEnv));
depth--;
return(FALSE);
}
/*================================================*/
/* Save the current parsing state before routines */
/* are called to parse the eval string. */
/*================================================*/
ov = GetPPBufferStatus(theEnv);
SetPPBufferStatus(theEnv,FALSE);
oldBinds = GetParsedBindNames(theEnv);
SetParsedBindNames(theEnv,NULL);
/*========================================================*/
/* Parse the string argument passed to the eval function. */
/*========================================================*/
top = ParseAtomOrExpression(theEnv,logicalNameBuffer,NULL);
/*============================*/
/* Restore the parsing state. */
/*============================*/
SetPPBufferStatus(theEnv,ov);
ClearParsedBindNames(theEnv);
SetParsedBindNames(theEnv,oldBinds);
/*===========================================*/
/* Return if an error occured while parsing. */
/*===========================================*/
if (top == NULL)
{
SetEvaluationError(theEnv,TRUE);
CloseStringSource(theEnv,logicalNameBuffer);
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvFalseSymbol(theEnv));
depth--;
return(FALSE);
}
/*==============================================*/
/* The sequence expansion operator must be used */
/* within the argument list of a function call. */
/*==============================================*/
if ((top->type == MF_GBL_VARIABLE) || (top->type == MF_VARIABLE))
{
PrintErrorID(theEnv,"MISCFUN",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"expand$ must be used in the argument list of a function call.\n");
SetEvaluationError(theEnv,TRUE);
CloseStringSource(theEnv,logicalNameBuffer);
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvFalseSymbol(theEnv));
ReturnExpression(theEnv,top);
depth--;
return(FALSE);
}
/*=======================================*/
/* The expression to be evaluated cannot */
/* contain any local variables. */
/*=======================================*/
if (ExpressionContainsVariables(top,FALSE))
{
PrintErrorID(theEnv,"STRNGFUN",2,FALSE);
EnvPrintRouter(theEnv,WERROR,"Some variables could not be accessed by the eval function.\n");
SetEvaluationError(theEnv,TRUE);
CloseStringSource(theEnv,logicalNameBuffer);
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvFalseSymbol(theEnv));
ReturnExpression(theEnv,top);
depth--;
return(FALSE);
}
/*====================================*/
/* Evaluate the expression and return */
/* the memory used to parse it. */
/*====================================*/
ExpressionInstall(theEnv,top);
EvaluateExpression(theEnv,top,returnValue);
ExpressionDeinstall(theEnv,top);
depth--;
ReturnExpression(theEnv,top);
CloseStringSource(theEnv,logicalNameBuffer);
if (GetEvaluationError(theEnv)) return(FALSE);
return(TRUE);
}