globle void CommandLoop( void *theEnv) { int inchar; EnvPrintRouter(theEnv,WPROMPT,CommandLineData(theEnv)->BannerString); SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); PeriodicCleanup(theEnv,TRUE,FALSE); PrintPrompt(theEnv); RouterData(theEnv)->CommandBufferInputCount = 0; while (TRUE) { /*===================================================*/ /* If a batch file is active, grab the command input */ /* directly from the batch file, otherwise call the */ /* event function. */ /*===================================================*/ if (BatchActive(theEnv) == TRUE) { inchar = LLGetcBatch(theEnv,"stdin",TRUE); if (inchar == EOF) { (*CommandLineData(theEnv)->EventFunction)(theEnv); } else { ExpandCommandString(theEnv,(char) inchar); } } else { (*CommandLineData(theEnv)->EventFunction)(theEnv); } /*=================================================*/ /* If execution was halted, then remove everything */ /* from the command buffer. */ /*=================================================*/ if (GetHaltExecution(theEnv) == TRUE) { SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); FlushCommandString(theEnv); #if ! WINDOW_INTERFACE fflush(stdin); #endif EnvPrintRouter(theEnv,WPROMPT,"\n"); PrintPrompt(theEnv); } /*=========================================*/ /* If a complete command is in the command */ /* buffer, then execute it. */ /*=========================================*/ ExecuteIfCommandComplete(theEnv); } }
globle int ParseConstruct( void *theEnv, char *name, char *logicalName) { struct construct *currentPtr; int rv, ov; /*=================================*/ /* Look for a valid construct name */ /* (e.g. defrule, deffacts). */ /*=================================*/ currentPtr = FindConstruct(theEnv,name); if (currentPtr == NULL) return(-1); /*==================================*/ /* Prepare the parsing environment. */ /*==================================*/ ov = GetHaltExecution(theEnv); SetEvaluationError(theEnv,FALSE); SetHaltExecution(theEnv,FALSE); ClearParsedBindNames(theEnv); PushRtnBrkContexts(theEnv); ExpressionData(theEnv)->ReturnContext = FALSE; ExpressionData(theEnv)->BreakContext = FALSE; EvaluationData(theEnv)->CurrentEvaluationDepth++; /*=======================================*/ /* Call the construct's parsing routine. */ /*=======================================*/ ConstructData(theEnv)->ParsingConstruct = TRUE; rv = (*currentPtr->parseFunction)(theEnv,logicalName); ConstructData(theEnv)->ParsingConstruct = FALSE; /*===============================*/ /* Restore environment settings. */ /*===============================*/ EvaluationData(theEnv)->CurrentEvaluationDepth--; PopRtnBrkContexts(theEnv); ClearParsedBindNames(theEnv); SetPPBufferStatus(theEnv,OFF); SetHaltExecution(theEnv,ov); /*==============================*/ /* Return the status of parsing */ /* the construct. */ /*==============================*/ return(rv); }
globle char *EnvRtnLexeme( void *theEnv, int argumentPosition) { int count = 1; DATA_OBJECT result; struct expr *argPtr; /*=====================================================*/ /* Find the appropriate argument in the argument list. */ /*=====================================================*/ for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; (argPtr != NULL) && (count < argumentPosition); argPtr = argPtr->nextArg) { count++; } if (argPtr == NULL) { NonexistantError(theEnv,"RtnLexeme", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(NULL); } /*============================================*/ /* Return the value of the nth argument if it */ /* is a symbol, string, or instance name. */ /*============================================*/ EvaluateExpression(theEnv,argPtr,&result); if ((result.type == SYMBOL) || #if OBJECT_SYSTEM (result.type == INSTANCE_NAME) || #endif (result.type == STRING)) { return(ValueToString(result.value));} /*======================================================*/ /* Generate an error if the argument is the wrong type. */ /*======================================================*/ ExpectedTypeError3(theEnv,"RtnLexeme", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition,"symbol, string, or instance name"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(NULL); }
globle long EnvRtnLong( void *theEnv, int argumentPosition) { int count = 1; DATA_OBJECT result; struct expr *argPtr; /*=====================================================*/ /* Find the appropriate argument in the argument list. */ /*=====================================================*/ for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; (argPtr != NULL) && (count < argumentPosition); argPtr = argPtr->nextArg) { count++; } if (argPtr == NULL) { NonexistantError(theEnv,"RtnLong", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(1L); } /*======================================*/ /* Return the value of the nth argument */ /* if it is a float or integer. */ /*======================================*/ EvaluateExpression(theEnv,argPtr,&result); if (result.type == FLOAT) { return((long) ValueToDouble(result.value)); } else if (result.type == INTEGER) { return(ValueToLong(result.value)); } /*======================================================*/ /* Generate an error if the argument is the wrong type. */ /*======================================================*/ ExpectedTypeError3(theEnv,"RtnLong", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition,"number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(1L); }
globle int EnvArgRangeCheck( void *theEnv, char *functionName, int min, int max) { int numberOfArguments; numberOfArguments = EnvRtnArgCount(theEnv); if ((numberOfArguments < min) || (numberOfArguments > max)) { PrintErrorID(theEnv,"ARGACCES",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Function "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," expected at least "); PrintLongInteger(theEnv,WERROR,(long) min); EnvPrintRouter(theEnv,WERROR," and no more than "); PrintLongInteger(theEnv,WERROR,(long) max); EnvPrintRouter(theEnv,WERROR," arguments.\n"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(-1); } return(numberOfArguments); }
globle DATA_OBJECT_PTR EnvRtnUnknown( void *theEnv, int argumentPosition, DATA_OBJECT_PTR returnValue) { int count = 1; struct expr *argPtr; /*=====================================================*/ /* Find the appropriate argument in the argument list. */ /*=====================================================*/ for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList; (argPtr != NULL) && (count < argumentPosition); argPtr = argPtr->nextArg) { count++; } if (argPtr == NULL) { NonexistantError(theEnv,"RtnUnknown", ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)), argumentPosition); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(NULL); } /*=======================================*/ /* Return the value of the nth argument. */ /*=======================================*/ EvaluateExpression(theEnv,argPtr,returnValue); return(returnValue); }
static void _cdecl CatchCtrlC() { #if ALLOW_ENVIRONMENT_GLOBALS SetHaltExecution(GetCurrentEnvironment(),TRUE); CloseAllBatchSources(GetCurrentEnvironment()); #endif }
globle int FunctionCall2( FUNCTION_REFERENCE *theReference, char *args, DATA_OBJECT *result) { EXPRESSION *argexps; int error = FALSE; /*=============================================*/ /* Force periodic cleanup if the function call */ /* was executed from an embedded application. */ /*=============================================*/ if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) && (CurrentExpression == NULL)) { PeriodicCleanup(TRUE,FALSE); } /*========================*/ /* Reset the error state. */ /*========================*/ if (CurrentEvaluationDepth == 0) SetHaltExecution(FALSE); EvaluationError = FALSE; /*======================================*/ /* Initialize the default return value. */ /*======================================*/ result->type = SYMBOL; result->value = FalseSymbol; /*============================*/ /* Parse the argument string. */ /*============================*/ argexps = ParseConstantArguments(args,&error); if (error == TRUE) return(TRUE); /*====================*/ /* Call the function. */ /*====================*/ theReference->argList = argexps; error = EvaluateExpression(theReference,result); /*========================*/ /* Return the expression. */ /*========================*/ ReturnExpression(argexps); theReference->argList = NULL; /*==========================*/ /* Return the error status. */ /*==========================*/ return(error); }
static void CatchCtrlC( int sgnl) { #if ALLOW_ENVIRONMENT_GLOBALS SetHaltExecution(GetCurrentEnvironment(),TRUE); CloseAllBatchSources(GetCurrentEnvironment()); #endif signal(SIGINT,CatchCtrlC); }
globle void CommandLoopBatchDriver( void *theEnv) { int inchar; while (TRUE) { if (GetHaltCommandLoopBatch(theEnv) == TRUE) { CloseAllBatchSources(theEnv); SetHaltCommandLoopBatch(theEnv,FALSE); } /*===================================================*/ /* If a batch file is active, grab the command input */ /* directly from the batch file, otherwise call the */ /* event function. */ /*===================================================*/ if (BatchActive(theEnv) == TRUE) { inchar = LLGetcBatch(theEnv,"stdin",TRUE); if (inchar == EOF) { return; } else { ExpandCommandString(theEnv,(char) inchar); } } else { return; } /*=================================================*/ /* If execution was halted, then remove everything */ /* from the command buffer. */ /*=================================================*/ if (GetHaltExecution(theEnv) == TRUE) { SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); FlushCommandString(theEnv); #if ! WINDOW_INTERFACE fflush(stdin); #endif EnvPrintRouter(theEnv,WPROMPT,"\n"); PrintPrompt(theEnv); } /*=========================================*/ /* If a complete command is in the command */ /* buffer, then execute it. */ /*=========================================*/ ExecuteIfCommandComplete(theEnv); } }
globle void CommandLoopBatch( void *theEnv) { SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); PeriodicCleanup(theEnv,TRUE,FALSE); PrintPrompt(theEnv); RouterData(theEnv)->CommandBufferInputCount = 0; CommandLoopBatchDriver(theEnv); }
static void DomainErrorMessage( void *theEnv, const char *functionName) { PrintErrorID(theEnv,"EMATHFUN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Domain error for "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," function.\n"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); }
static void CatchCtrlC() { #if ALLOW_ENVIRONMENT_GLOBALS _XSTACK *sf; /* Real-mode interrupt handler stack frame. */ sf = (_XSTACK *) _get_stk_frame(); /* Get pointer to V86 _XSTACK frame. */ SetHaltExecution(GetCurrentEnvironment(),TRUE); /* Terminate execution and */ CloseAllBatchSources(GetCurrentEnvironment()); /* return to the command prompt. */ sf->opts |= _STK_NOINT; /* Set _ST_NOINT to prevent V86 call. */ #endif }
static void ArgumentOverflowErrorMessage( void *theEnv, const char *functionName) { PrintErrorID(theEnv,"EMATHFUN",2,FALSE); EnvPrintRouter(theEnv,WERROR,"Argument overflow for "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," function.\n"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); }
static void SingularityErrorMessage( void *theEnv, const char *functionName) { PrintErrorID(theEnv,"EMATHFUN",3,FALSE); EnvPrintRouter(theEnv,WERROR,"Singularity at asymptote in "); EnvPrintRouter(theEnv,WERROR,functionName); EnvPrintRouter(theEnv,WERROR," function.\n"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); }
globle void PrintDataObject( void *theEnv, const char *fileid, DATA_OBJECT_PTR argPtr) { switch(argPtr->type) { case RVOID: case SYMBOL: case STRING: case INTEGER: case FLOAT: case EXTERNAL_ADDRESS: case DATA_OBJECT_ARRAY: // TBD Remove with AddPrimitive case FACT_ADDRESS: #if OBJECT_SYSTEM case INSTANCE_NAME: case INSTANCE_ADDRESS: #endif PrintAtom(theEnv,fileid,argPtr->type,argPtr->value); break; case MULTIFIELD: PrintMultifield(theEnv,fileid,(struct multifield *) argPtr->value, argPtr->begin,argPtr->end,TRUE); break; default: if (EvaluationData(theEnv)->PrimitivesArray[argPtr->type] != NULL) { if (EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->longPrintFunction) { (*EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->longPrintFunction)(theEnv,fileid,argPtr->value); break; } else if (EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->shortPrintFunction) { (*EvaluationData(theEnv)->PrimitivesArray[argPtr->type]->shortPrintFunction)(theEnv,fileid,argPtr->value); break; } } EnvPrintRouter(theEnv,fileid,"<UnknownPrintType"); PrintLongInteger(theEnv,fileid,(long int) argPtr->type); EnvPrintRouter(theEnv,fileid,">"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); break; } }
globle void PrintDataObject( char *fileid, DATA_OBJECT_PTR argPtr) { switch(argPtr->type) { case RVOID: case SYMBOL: case STRING: case INTEGER: case FLOAT: case EXTERNAL_ADDRESS: case FACT_ADDRESS: #if OBJECT_SYSTEM case INSTANCE_NAME: case INSTANCE_ADDRESS: #endif #if FUZZY_DEFTEMPLATES case FUZZY_VALUE: #endif PrintAtom(fileid,argPtr->type,argPtr->value); break; case MULTIFIELD: PrintMultifield(fileid,(struct multifield *) argPtr->value, argPtr->begin,argPtr->end,TRUE); break; default: if (PrimitivesArray[argPtr->type] != NULL) { if (PrimitivesArray[argPtr->type]->longPrintFunction) { (*PrimitivesArray[argPtr->type]->longPrintFunction)(fileid,argPtr->value); break; } else if (PrimitivesArray[argPtr->type]->shortPrintFunction) { (*PrimitivesArray[argPtr->type]->shortPrintFunction)(fileid,argPtr->value); break; } } PrintRouter(fileid,"<UnknownPrintType"); PrintLongInteger(fileid,(long int) argPtr->type); PrintRouter(fileid,">"); SetHaltExecution(TRUE); SetEvaluationError(TRUE); break; } }
globle intBool ExecuteIfCommandComplete( void *theEnv) { if ((CompleteCommand(CommandLineData(theEnv)->CommandString) == 0) || (RouterData(theEnv)->CommandBufferInputCount <= 0)) { return FALSE; } FlushPPBuffer(theEnv); SetPPBufferStatus(theEnv,OFF); RouterData(theEnv)->CommandBufferInputCount = -1; RouteCommand(theEnv,CommandLineData(theEnv)->CommandString,TRUE); FlushPPBuffer(theEnv); SetHaltExecution(theEnv,FALSE); SetEvaluationError(theEnv,FALSE); FlushCommandString(theEnv); FlushBindList(theEnv); PeriodicCleanup(theEnv,TRUE,FALSE); PrintPrompt(theEnv); return TRUE; }
globle int EnvArgCountCheck( void *theEnv, char *functionName, int countRelation, int expectedNumber) { int numberOfArguments; /*==============================================*/ /* Get the number of arguments for the function */ /* currently being evaluated. */ /*==============================================*/ numberOfArguments = EnvRtnArgCount(theEnv); /*=========================================================*/ /* If the function satisfies expected number of arguments, */ /* constraint, then return the number of arguments found. */ /*=========================================================*/ if (countRelation == EXACTLY) { if (numberOfArguments == expectedNumber) return(numberOfArguments); } else if (countRelation == AT_LEAST) { if (numberOfArguments >= expectedNumber) return(numberOfArguments); } else if (countRelation == NO_MORE_THAN) { if (numberOfArguments <= expectedNumber) return(numberOfArguments); } /*================================================*/ /* The correct number of arguments was not found. */ /* Generate an error message and return -1. */ /*================================================*/ ExpectedCountError(theEnv,functionName,countRelation,expectedNumber); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(-1); }
globle double PowFunction( void *theEnv) { DATA_OBJECT value1, value2; if (EnvArgCountCheck(theEnv,"**",EXACTLY,2) == -1) return(0.0); if (EnvArgTypeCheck(theEnv,"**",1,FLOAT,&value1) == FALSE) return(0.0); if (EnvArgTypeCheck(theEnv,"**",2,FLOAT,&value2) == FALSE) return(0.0); if (((DOToDouble(value1) == 0.0) && (DOToDouble(value2) <= 0.0)) || ((DOToDouble(value1) < 0.0) && (dtrunc((double) DOToDouble(value2)) != DOToDouble(value2)))) { DomainErrorMessage(theEnv,"**"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(0.0); } return (pow(DOToDouble(value1),DOToDouble(value2))); }
static long long GetFactsArgument( void *theEnv, int whichOne, int argumentCount) { long long factIndex; DATA_OBJECT theValue; if (whichOne > argumentCount) return(UNSPECIFIED); if (EnvArgTypeCheck(theEnv,(char*)"facts",whichOne,INTEGER,&theValue) == FALSE) return(INVALID); factIndex = DOToLong(theValue); if (factIndex < 0) { ExpectedTypeError1(theEnv,(char*)"facts",whichOne,(char*)"positive number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(INVALID); } return(factIndex); }
globle int EnvArgTypeCheck( void *theEnv, char *functionName, int argumentPosition, int expectedType, DATA_OBJECT_PTR returnValue) { /*========================*/ /* Retrieve the argument. */ /*========================*/ EnvRtnUnknown(theEnv,argumentPosition,returnValue); if (EvaluationData(theEnv)->EvaluationError) return(FALSE); /*========================================*/ /* If the argument's type exactly matches */ /* the expected type, then return TRUE. */ /*========================================*/ if (returnValue->type == expectedType) return (TRUE); /*=============================================================*/ /* Some expected types encompass more than one primitive type. */ /* If the argument's type matches one of the primitive types */ /* encompassed by the expected type, then return TRUE. */ /*=============================================================*/ if ((expectedType == INTEGER_OR_FLOAT) && ((returnValue->type == INTEGER) || (returnValue->type == FLOAT))) { return(TRUE); } if ((expectedType == SYMBOL_OR_STRING) && ((returnValue->type == SYMBOL) || (returnValue->type == STRING))) { return(TRUE); } #if OBJECT_SYSTEM if (((expectedType == SYMBOL_OR_STRING) || (expectedType == SYMBOL)) && (returnValue->type == INSTANCE_NAME)) { return(TRUE); } if ((expectedType == INSTANCE_NAME) && ((returnValue->type == INSTANCE_NAME) || (returnValue->type == SYMBOL))) { return(TRUE); } if ((expectedType == INSTANCE_OR_INSTANCE_NAME) && ((returnValue->type == INSTANCE_ADDRESS) || (returnValue->type == INSTANCE_NAME) || (returnValue->type == SYMBOL))) { return(TRUE); } #endif /*===========================================================*/ /* If the expected type is float and the argument's type is */ /* integer (or vice versa), then convert the argument's type */ /* to match the expected type and then return TRUE. */ /*===========================================================*/ if ((returnValue->type == INTEGER) && (expectedType == FLOAT)) { returnValue->type = FLOAT; returnValue->value = (void *) EnvAddDouble(theEnv,(double) ValueToLong(returnValue->value)); return(TRUE); } if ((returnValue->type == FLOAT) && (expectedType == INTEGER)) { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,(long) ValueToDouble(returnValue->value)); return(TRUE); } /*=====================================================*/ /* The argument's type didn't match the expected type. */ /* Print an error message and return FALSE. */ /*=====================================================*/ if (expectedType == FLOAT) ExpectedTypeError1(theEnv,functionName,argumentPosition,"float"); else if (expectedType == INTEGER) ExpectedTypeError1(theEnv,functionName,argumentPosition,"integer"); else if (expectedType == SYMBOL) ExpectedTypeError1(theEnv,functionName,argumentPosition,"symbol"); else if (expectedType == STRING) ExpectedTypeError1(theEnv,functionName,argumentPosition,"string"); else if (expectedType == MULTIFIELD) ExpectedTypeError1(theEnv,functionName,argumentPosition,"multifield"); else if (expectedType == INTEGER_OR_FLOAT) ExpectedTypeError1(theEnv,functionName,argumentPosition,"integer or float"); else if (expectedType == SYMBOL_OR_STRING) ExpectedTypeError1(theEnv,functionName,argumentPosition,"symbol or string"); #if OBJECT_SYSTEM else if (expectedType == INSTANCE_NAME) ExpectedTypeError1(theEnv,functionName,argumentPosition,"instance name"); else if (expectedType == INSTANCE_ADDRESS) ExpectedTypeError1(theEnv,functionName,argumentPosition,"instance address"); else if (expectedType == INSTANCE_OR_INSTANCE_NAME) ExpectedTypeError1(theEnv,functionName,argumentPosition,"instance address or instance name"); #endif SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(FALSE); }
globle void DivisionFunction( void *theEnv, DATA_OBJECT_PTR returnValue) { double ftotal = 1.0; long ltotal = 1L; intBool useFloatTotal; EXPRESSION *theExpression; DATA_OBJECT theArgument; int pos = 1; useFloatTotal = BasicMathFunctionData(theEnv)->AutoFloatDividend; /*===================================================*/ /* Get the first argument. This number which will be */ /* the starting product from which all subsequent */ /* arguments will divide. If the auto float dividend */ /* feature is enable, then this number is converted */ /* to a float if it is an integer. */ /*===================================================*/ theExpression = GetFirstArgument(); if (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"/",&theArgument,useFloatTotal,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (theArgument.type == INTEGER) { ltotal = ValueToLong(theArgument.value); } else { ftotal = ValueToDouble(theArgument.value); useFloatTotal = TRUE; } pos++; } /*====================================================*/ /* Loop through each of the arguments dividing it */ /* into a running product. If a floating point number */ /* is encountered, then do all subsequent operations */ /* using floating point values. Each argument is */ /* checked to prevent a divide by zero error. */ /*====================================================*/ while (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"/",&theArgument,useFloatTotal,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if ((theArgument.type == INTEGER) ? (ValueToLong(theArgument.value) == 0L) : ((theArgument.type == FLOAT) ? ValueToDouble(theArgument.value) == 0.0 : FALSE)) { DivideByZeroErrorMessage(theEnv,"/"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); returnValue->type = FLOAT; returnValue->value = (void *) EnvAddDouble(theEnv,1.0); return; } if (useFloatTotal) { ftotal /= ValueToDouble(theArgument.value); } else { if (theArgument.type == INTEGER) { ltotal /= ValueToLong(theArgument.value); } else { ftotal = (double) ltotal / ValueToDouble(theArgument.value); useFloatTotal = TRUE; } } pos++; } /*======================================================*/ /* If a floating point number was in the argument list, */ /* then return a float, otherwise return an integer. */ /*======================================================*/ if (useFloatTotal) { returnValue->type = FLOAT; returnValue->value = (void *) EnvAddDouble(theEnv,ftotal); } else { returnValue->type = INTEGER; returnValue->value = (void *) EnvAddLong(theEnv,ltotal); } }
globle void FactsCommand( void *theEnv) { int argumentCount; long long start = UNSPECIFIED, end = UNSPECIFIED, max = UNSPECIFIED; struct defmodule *theModule; DATA_OBJECT theValue; int argOffset; /*=========================================================*/ /* Determine the number of arguments to the facts command. */ /*=========================================================*/ if ((argumentCount = EnvArgCountCheck(theEnv,(char*)"facts",NO_MORE_THAN,4)) == -1) return; /*==================================*/ /* The default module for the facts */ /* command is the current module. */ /*==================================*/ theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); /*==========================================*/ /* If no arguments were specified, then use */ /* the default values to list the facts. */ /*==========================================*/ if (argumentCount == 0) { EnvFacts(theEnv,WDISPLAY,theModule,start,end,max); return; } /*========================================================*/ /* Since there are one or more arguments, see if a module */ /* or start index was specified as the first argument. */ /*========================================================*/ EnvRtnUnknown(theEnv,1,&theValue); /*===============================================*/ /* If the first argument is a symbol, then check */ /* to see that a valid module was specified. */ /*===============================================*/ if (theValue.type == SYMBOL) { theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theValue.value)); if ((theModule == NULL) && (strcmp(ValueToString(theValue.value),"*") != 0)) { SetEvaluationError(theEnv,TRUE); CantFindItemErrorMessage(theEnv,(char*)"defmodule",ValueToString(theValue.value)); return; } if ((start = GetFactsArgument(theEnv,2,argumentCount)) == INVALID) return; argOffset = 1; } /*================================================*/ /* Otherwise if the first argument is an integer, */ /* check to see that a valid index was specified. */ /*================================================*/ else if (theValue.type == INTEGER) { start = DOToLong(theValue); if (start < 0) { ExpectedTypeError1(theEnv,(char*)"facts",1,(char*)"symbol or positive number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return; } argOffset = 0; } /*==========================================*/ /* Otherwise the first argument is invalid. */ /*==========================================*/ else { ExpectedTypeError1(theEnv,(char*)"facts",1,(char*)"symbol or positive number"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return; } /*==========================*/ /* Get the other arguments. */ /*==========================*/ if ((end = GetFactsArgument(theEnv,2 + argOffset,argumentCount)) == INVALID) return; if ((max = GetFactsArgument(theEnv,3 + argOffset,argumentCount)) == INVALID) return; /*=================*/ /* List the facts. */ /*=================*/ EnvFacts(theEnv,WDISPLAY,theModule,start,end,max); }
globle void CheckTemplateFact( struct fact *theFact) { struct field *sublist; int i; struct deftemplate *theDeftemplate; struct templateSlot *slotPtr; DATA_OBJECT theData; char thePlace[20]; int rv; if (! GetDynamicConstraintChecking()) return; sublist = theFact->theProposition.theFields; /*========================================================*/ /* If the deftemplate corresponding to the first field of */ /* of the fact cannot be found, then the fact cannot be */ /* checked against the deftemplate format. */ /*========================================================*/ theDeftemplate = theFact->whichDeftemplate; if (theDeftemplate == NULL) return; if (theDeftemplate->implied) return; /*=============================================*/ /* Check each of the slots of the deftemplate. */ /*=============================================*/ i = 0; for (slotPtr = theDeftemplate->slotList; slotPtr != NULL; slotPtr = slotPtr->next) { /*================================================*/ /* Store the slot value in the appropriate format */ /* for a call to the constraint checking routine. */ /*================================================*/ if (slotPtr->multislot == FALSE) { theData.type = sublist[i].type; theData.value = sublist[i].value; i++; } else { theData.type = MULTIFIELD; theData.value = (void *) sublist[i].value; theData.begin = 0; theData.end = ((struct multifield *) sublist[i].value)->multifieldLength-1; i++; } /*=============================================*/ /* Call the constraint checking routine to see */ /* if a constraint violation occurred. */ /*=============================================*/ rv = ConstraintCheckDataObject(&theData,slotPtr->constraints); if (rv != NO_VIOLATION) { sprintf(thePlace,"fact f-%-5ld ",theFact->factIndex); PrintErrorID("CSTRNCHK",1,TRUE); PrintRouter(WERROR,"Slot value "); PrintDataObject(WERROR,&theData); PrintRouter(WERROR," "); ConstraintViolationErrorMessage(NULL,thePlace,FALSE,0,slotPtr->slotName, 0,rv,slotPtr->constraints,TRUE); SetHaltExecution(TRUE); return; } } return; }
globle void Reset() { struct callFunctionItem *resetPtr; /*=====================================*/ /* The reset command can't be executed */ /* while a reset is in progress. */ /*=====================================*/ if (ResetInProgress) return; ResetInProgress = TRUE; ResetReadyInProgress = TRUE; /*================================================*/ /* If the reset is performed from the top level */ /* command prompt, reset the halt execution flag. */ /*================================================*/ if (CurrentEvaluationDepth == 0) SetHaltExecution(FALSE); /*=======================================================*/ /* Call the before reset function to determine if the */ /* reset should continue. [Used by the some of the */ /* windowed interfaces to query the user whether a */ /* reset should proceed with activations on the agenda.] */ /*=======================================================*/ if ((BeforeResetFunction != NULL) ? ((*BeforeResetFunction)() == FALSE) : FALSE) { ResetReadyInProgress = FALSE; ResetInProgress = FALSE; return; } ResetReadyInProgress = FALSE; /*===========================*/ /* Call each reset function. */ /*===========================*/ for (resetPtr = ListOfResetFunctions; (resetPtr != NULL) && (GetHaltExecution() == FALSE); resetPtr = resetPtr->next) { (*resetPtr->func)(); } /*============================================*/ /* Set the current module to the MAIN module. */ /*============================================*/ SetCurrentModule((void *) FindDefmodule("MAIN")); /*===========================================*/ /* Perform periodic cleanup if the reset was */ /* issued from an embedded controller. */ /*===========================================*/ if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) && (CurrentExpression == NULL)) { PeriodicCleanup(TRUE,FALSE); } /*===================================*/ /* A reset is no longer in progress. */ /*===================================*/ ResetInProgress = FALSE; }
bool BatchStar( Environment *theEnv, const char *fileName) { int inchar; bool done = false; FILE *theFile; char *theString = NULL; size_t position = 0; size_t maxChars = 0; #if (! RUN_TIME) && (! BLOAD_ONLY) char *oldParsingFileName; long oldLineCountValue; #endif /*======================*/ /* Open the batch file. */ /*======================*/ theFile = GenOpen(theEnv,fileName,"r"); if (theFile == NULL) { OpenErrorMessage(theEnv,"batch",fileName); return false; } /*======================================*/ /* Setup for capturing errors/warnings. */ /*======================================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) oldParsingFileName = CopyString(theEnv,GetParsingFileName(theEnv)); SetParsingFileName(theEnv,fileName); CreateErrorCaptureRouter(theEnv); oldLineCountValue = SetLineCount(theEnv,1); #endif /*=====================================*/ /* If embedded, clear the error flags. */ /*=====================================*/ if (EvaluationData(theEnv)->CurrentExpression == NULL) { ResetErrorFlags(theEnv); } /*=============================================*/ /* Evaluate commands from the file one by one. */ /*=============================================*/ while (! done) { inchar = getc(theFile); if (inchar == EOF) { inchar = '\n'; done = true; } theString = ExpandStringWithChar(theEnv,inchar,theString,&position, &maxChars,maxChars+80); if (CompleteCommand(theString) != 0) { FlushPPBuffer(theEnv); SetPPBufferStatus(theEnv,false); RouteCommand(theEnv,theString,false); FlushPPBuffer(theEnv); SetHaltExecution(theEnv,false); SetEvaluationError(theEnv,false); FlushBindList(theEnv,NULL); genfree(theEnv,theString,maxChars); theString = NULL; maxChars = 0; position = 0; #if (! RUN_TIME) && (! BLOAD_ONLY) FlushParsingMessages(theEnv); #endif } if ((inchar == '\r') || (inchar == '\n')) { IncrementLineCount(theEnv); } } if (theString != NULL) { genfree(theEnv,theString,maxChars); } /*=======================*/ /* Close the batch file. */ /*=======================*/ GenClose(theEnv,theFile); /*========================================*/ /* Cleanup for capturing errors/warnings. */ /*========================================*/ #if (! RUN_TIME) && (! BLOAD_ONLY) FlushParsingMessages(theEnv); DeleteErrorCaptureRouter(theEnv); SetLineCount(theEnv,oldLineCountValue); SetParsingFileName(theEnv,oldParsingFileName); DeleteString(theEnv,oldParsingFileName); #endif return true; }
globle long DivFunction( void *theEnv) { long total = 1L; EXPRESSION *theExpression; DATA_OBJECT theArgument; int pos = 1; long theNumber; /*===================================================*/ /* Get the first argument. This number which will be */ /* the starting product from which all subsequent */ /* arguments will divide. */ /*===================================================*/ theExpression = GetFirstArgument(); if (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"div",&theArgument,FALSE,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (theArgument.type == INTEGER) { total = ValueToLong(theArgument.value); } else { total = (long) ValueToDouble(theArgument.value); } pos++; } /*=====================================================*/ /* Loop through each of the arguments dividing it into */ /* a running product. Floats are converted to integers */ /* and each argument is checked to prevent a divide by */ /* zero error. */ /*=====================================================*/ while (theExpression != NULL) { if (! GetNumericArgument(theEnv,theExpression,"div",&theArgument,FALSE,pos)) theExpression = NULL; else theExpression = GetNextArgument(theExpression); if (theArgument.type == INTEGER) theNumber = ValueToLong(theArgument.value); else if (theArgument.type == FLOAT) theNumber = (long) ValueToDouble(theArgument.value); else theNumber = 1; if (theNumber == 0L) { DivideByZeroErrorMessage(theEnv,"div"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); return(1L); } if (theArgument.type == INTEGER) { total /= ValueToLong(theArgument.value); } else { total = total / (long) ValueToDouble(theArgument.value); } pos++; } /*======================================================*/ /* The result of the div function is always an integer. */ /*======================================================*/ return(total); }
globle void EnvReset( void *theEnv) { struct callFunctionItem *resetPtr; /*=====================================*/ /* The reset command can't be executed */ /* while a reset is in progress. */ /*=====================================*/ if (ConstructData(theEnv)->ResetInProgress) return; ConstructData(theEnv)->ResetInProgress = TRUE; ConstructData(theEnv)->ResetReadyInProgress = TRUE; /*================================================*/ /* If the reset is performed from the top level */ /* command prompt, reset the halt execution flag. */ /*================================================*/ if (UtilityData(theEnv)->CurrentGarbageFrame->topLevel) SetHaltExecution(theEnv,FALSE); /*=======================================================*/ /* Call the before reset function to determine if the */ /* reset should continue. [Used by the some of the */ /* windowed interfaces to query the user whether a */ /* reset should proceed with activations on the agenda.] */ /*=======================================================*/ if ((ConstructData(theEnv)->BeforeResetFunction != NULL) ? ((*ConstructData(theEnv)->BeforeResetFunction)(theEnv) == FALSE) : FALSE) { ConstructData(theEnv)->ResetReadyInProgress = FALSE; ConstructData(theEnv)->ResetInProgress = FALSE; return; } ConstructData(theEnv)->ResetReadyInProgress = FALSE; /*===========================*/ /* Call each reset function. */ /*===========================*/ for (resetPtr = ConstructData(theEnv)->ListOfResetFunctions; (resetPtr != NULL) && (GetHaltExecution(theEnv) == FALSE); resetPtr = resetPtr->next) { if (resetPtr->environmentAware) { (*resetPtr->func)(theEnv); } else { (* (void (*)(void)) resetPtr->func)(); } } /*============================================*/ /* Set the current module to the MAIN module. */ /*============================================*/ EnvSetCurrentModule(theEnv,(void *) EnvFindDefmodule(theEnv,"MAIN")); /*===========================================*/ /* Perform periodic cleanup if the reset was */ /* issued from an embedded controller. */ /*===========================================*/ if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) && (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0)) { CleanCurrentGarbageFrame(theEnv,NULL); CallPeriodicTasks(theEnv); } /*===================================*/ /* A reset is no longer in progress. */ /*===================================*/ ConstructData(theEnv)->ResetInProgress = FALSE; }
globle intBool GetNumericArgument( void *theEnv, struct expr *theArgument, char *functionName, DATA_OBJECT *result, intBool convertToFloat, int whichArgument) { unsigned short theType; void *theValue; /*==================================================================*/ /* Evaluate the expression (don't bother calling EvaluateExpression */ /* if the type is float or integer). */ /*==================================================================*/ switch(theArgument->type) { case FLOAT: case INTEGER: theType = theArgument->type; theValue = theArgument->value; break; default: EvaluateExpression(theEnv,theArgument,result); theType = result->type; theValue = result->value; break; } /*==========================================*/ /* If the argument is not float or integer, */ /* print an error message and return FALSE. */ /*==========================================*/ if ((theType != FLOAT) && (theType != INTEGER)) { ExpectedTypeError1(theEnv,functionName,whichArgument,"integer or float"); SetHaltExecution(theEnv,TRUE); SetEvaluationError(theEnv,TRUE); result->type = INTEGER; result->value = (void *) EnvAddLong(theEnv,0L); return(FALSE); } /*==========================================================*/ /* If the argument is an integer and the "convert to float" */ /* flag is TRUE, then convert the integer to a float. */ /*==========================================================*/ if ((convertToFloat) && (theType == INTEGER)) { theType = FLOAT; theValue = (void *) EnvAddDouble(theEnv,(double) ValueToLong(theValue)); } /*============================================================*/ /* The numeric argument was successfully retrieved. Store the */ /* argument in the user supplied DATA_OBJECT and return TRUE. */ /*============================================================*/ result->type = theType; result->value = theValue; return(TRUE); }