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