globle void ExitCommand(
void *theEnv)
{
int argCnt;
int status;
if ((argCnt = EnvArgCountCheck(theEnv,"exit",NO_MORE_THAN,1)) == -1) return;
if (argCnt == 0)
{ EnvExitRouter(theEnv,EXIT_SUCCESS); }
else
{
status = (int) EnvRtnLong(theEnv,1);
if (GetEvaluationError(theEnv)) return;
EnvExitRouter(theEnv,status);
}
return;
}
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);
}
globle void FuncallFunction(
void *theEnv,
DATA_OBJECT *returnValue)
{
int argCount, i, j;
DATA_OBJECT theValue;
FUNCTION_REFERENCE theReference;
char *name;
struct multifield *theMultifield;
struct expr *lastAdd = NULL, *nextAdd, *multiAdd;
/*==================================*/
/* Set up the default return value. */
/*==================================*/
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvFalseSymbol(theEnv));
/*=================================================*/
/* The funcall function has at least one argument: */
/* the name of the function being called. */
/*=================================================*/
if ((argCount = EnvArgCountCheck(theEnv,"funcall",AT_LEAST,1)) == -1) return;
/*============================================*/
/* Get the name of the function to be called. */
/*============================================*/
if (EnvArgTypeCheck(theEnv,"funcall",1,SYMBOL_OR_STRING,&theValue) == FALSE)
{
return;
}
/*====================*/
/* Find the function. */
/*====================*/
name = DOToString(theValue);
if (! GetFunctionReference(theEnv,name,&theReference))
{
ExpectedTypeError1(theEnv,"funcall",1,"function, deffunction, or generic function name");
return;
}
ExpressionInstall(theEnv,&theReference);
/*======================================*/
/* Add the arguments to the expression. */
/*======================================*/
for (i = 2; i <= argCount; i++)
{
EnvRtnUnknown(theEnv,i,&theValue);
if (GetEvaluationError(theEnv))
{
ExpressionDeinstall(theEnv,&theReference);
return;
}
switch(GetType(theValue))
{
case MULTIFIELD:
nextAdd = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$"));
if (lastAdd == NULL)
{
theReference.argList = nextAdd;
}
else
{
lastAdd->nextArg = nextAdd;
}
lastAdd = nextAdd;
multiAdd = NULL;
theMultifield = (struct multifield *) GetValue(theValue);
for (j = GetDOBegin(theValue); j <= GetDOEnd(theValue); j++)
{
nextAdd = GenConstant(theEnv,GetMFType(theMultifield,j),GetMFValue(theMultifield,j));
if (multiAdd == NULL)
{
lastAdd->argList = nextAdd;
}
else
{
multiAdd->nextArg = nextAdd;
}
multiAdd = nextAdd;
}
ExpressionInstall(theEnv,lastAdd);
break;
default:
nextAdd = GenConstant(theEnv,GetType(theValue),GetValue(theValue));
if (lastAdd == NULL)
{
theReference.argList = nextAdd;
}
else
{
lastAdd->nextArg = nextAdd;
}
lastAdd = nextAdd;
ExpressionInstall(theEnv,lastAdd);
break;
}
}
/*===========================================================*/
/* Verify a deffunction has the correct number of arguments. */
/*===========================================================*/
#if DEFFUNCTION_CONSTRUCT
if (theReference.type == PCALL)
{
if (CheckDeffunctionCall(theEnv,theReference.value,CountArguments(theReference.argList)) == FALSE)
{
PrintErrorID(theEnv,"MISCFUN",4,FALSE);
EnvPrintRouter(theEnv,WERROR,"Function funcall called with the wrong number of arguments for deffunction ");
EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,theReference.value));
EnvPrintRouter(theEnv,WERROR,"\n");
ExpressionDeinstall(theEnv,&theReference);
ReturnExpression(theEnv,theReference.argList);
return;
}
}
#endif
/*======================*/
/* Call the expression. */
/*======================*/
EvaluateExpression(theEnv,&theReference,returnValue);
/*========================================*/
/* Return the expression data structures. */
/*========================================*/
ExpressionDeinstall(theEnv,&theReference);
ReturnExpression(theEnv,theReference.argList);
}