예제 #1
0
 void get_argument(void* env, int argposition, void *& value) {
   struct dataObject obj;
   EnvRtnUnknown(env, argposition, &obj);
   if (obj.type == EXTERNAL_ADDRESS) {
     value = (((struct externalAddressHashNode *) (obj.value))->externalAddress);
   }
 }
예제 #2
0
파일: argacces.c 프로젝트: femto/rbclips
globle char *GetLogicalName(
  void *theEnv,
  int whichArgument,
  char *defaultLogicalName)
  {
   char *logicalName;
   DATA_OBJECT result;

   EnvRtnUnknown(theEnv,whichArgument,&result);

   if ((GetType(result) == SYMBOL) ||
       (GetType(result) == STRING) ||
       (GetType(result) == INSTANCE_NAME))
     {
      logicalName = ValueToString(result.value);
      if ((strcmp(logicalName,"t") == 0) || (strcmp(logicalName,"T") == 0))
        { logicalName = defaultLogicalName; }
     }
   else if (GetType(result) == FLOAT)
     {
      logicalName = ValueToString(EnvAddSymbol(theEnv,FloatToString(theEnv,DOToDouble(result))));
     }
   else if (GetType(result) == INTEGER)
     {
      logicalName = ValueToString(EnvAddSymbol(theEnv,LongIntegerToString(theEnv,DOToLong(result))));
     }
   else
     { logicalName = NULL; }

   return(logicalName);
  }
예제 #3
0
globle int SetBetaMemoryResizingCommand(
  void *theEnv)
  {
   int oldValue;
   DATA_OBJECT argPtr;

   oldValue = EnvGetBetaMemoryResizing(theEnv);

   /*============================================*/
   /* Check for the correct number of arguments. */
   /*============================================*/

   if (EnvArgCountCheck(theEnv,"set-beta-memory-resizing",EXACTLY,1) == -1)
     { return(oldValue); }

   /*=================================================*/
   /* The symbol FALSE disables beta memory resizing. */
   /* Any other value enables beta memory resizing.   */
   /*=================================================*/

   EnvRtnUnknown(theEnv,1,&argPtr);

   if ((argPtr.value == EnvFalseSymbol(theEnv)) && (argPtr.type == SYMBOL))
     { EnvSetBetaMemoryResizing(theEnv,FALSE); }
   else
     { EnvSetBetaMemoryResizing(theEnv,TRUE); }

   /*=======================*/
   /* Return the old value. */
   /*=======================*/

   return(oldValue);
  }
예제 #4
0
 void get_argument(void* env, int argposition, void *& value) {
   struct dataObject obj;
   EnvRtnUnknown(env, argposition, &obj);
   if (obj.type == EXTERNAL_ADDRESS) {
     value = obj.value;
   }
 }
예제 #5
0
파일: incrrset.c 프로젝트: atrniv/CLIPS
globle int SetIncrementalResetCommand(
  void *theEnv,
  EXEC_STATUS)
  {
   int oldValue;
   DATA_OBJECT argPtr;
   struct defmodule *theModule;

   oldValue = EnvGetIncrementalReset(theEnv,execStatus);

   /*============================================*/
   /* Check for the correct number of arguments. */
   /*============================================*/

   if (EnvArgCountCheck(theEnv,execStatus,"set-incremental-reset",EXACTLY,1) == -1)
     { return(oldValue); }

   /*=========================================*/
   /* The incremental reset behavior can't be */
   /* changed when rules are loaded.          */
   /*=========================================*/

   SaveCurrentModule(theEnv,execStatus);

   for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,NULL);
        theModule != NULL;
        theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,theModule))
     {
      EnvSetCurrentModule(theEnv,execStatus,(void *) theModule);
      if (EnvGetNextDefrule(theEnv,execStatus,NULL) != NULL)
        {
         RestoreCurrentModule(theEnv,execStatus);
         PrintErrorID(theEnv,execStatus,"INCRRSET",1,FALSE);
         EnvPrintRouter(theEnv,execStatus,WERROR,"The incremental reset behavior cannot be changed with rules loaded.\n");
         SetEvaluationError(theEnv,execStatus,TRUE);
         return(oldValue);
        }
     }
     
   RestoreCurrentModule(theEnv,execStatus);

   /*==================================================*/
   /* The symbol FALSE disables incremental reset. Any */
   /* other value enables incremental reset.           */
   /*==================================================*/

   EnvRtnUnknown(theEnv,execStatus,1,&argPtr);

   if ((argPtr.value == EnvFalseSymbol(theEnv,execStatus)) && (argPtr.type == SYMBOL))
     { EnvSetIncrementalReset(theEnv,execStatus,FALSE); }
   else
     { EnvSetIncrementalReset(theEnv,execStatus,TRUE); }

   /*=======================*/
   /* Return the old value. */
   /*=======================*/

   return(oldValue);
  }
예제 #6
0
 void get_argument(void* env, int argposition, Value& value) {
   struct dataObject obj;
   EnvRtnUnknown(env, argposition, &obj);
   Values values = data_object_to_values(obj);
   if (values.size() > 0) {
     value = values[0];
   }
 }
예제 #7
0
globle intBool PointerpFunction(
  void *theEnv)
  {
   DATA_OBJECT item;

   if (EnvArgCountCheck(theEnv,"pointerp",EXACTLY,1) == -1) return(FALSE);

   EnvRtnUnknown(theEnv,1,&item);

   if (GetType(item) != EXTERNAL_ADDRESS) return(FALSE);

   return(TRUE);
  }
예제 #8
0
globle void ReturnFunction(
  void *theEnv,
  DATA_OBJECT_PTR result)
  {
   if (EnvRtnArgCount(theEnv) == 0)
     {
      result->type = RVOID;
      result->value = EnvFalseSymbol(theEnv);
     }
   else
     EnvRtnUnknown(theEnv,1,result);
   ProcedureFunctionData(theEnv)->ReturnFlag = TRUE;
  }
예제 #9
0
globle intBool FuzzyvaluepFunction(
  void *theEnv)
  {
   DATA_OBJECT valstruct;

   if (EnvArgCountCheck(theEnv,"fuzzyvaluep",EXACTLY,1) == -1) return(FALSE);

   EnvRtnUnknown(theEnv,1,&valstruct);

   if (GetType(valstruct) != FUZZY_VALUE) return(FALSE);

   return(TRUE);
  }
예제 #10
0
globle intBool MultifieldpFunction(
  void *theEnv)
  {
   DATA_OBJECT item;

   if (EnvArgCountCheck(theEnv,"multifieldp",EXACTLY,1) == -1) return(FALSE);

   EnvRtnUnknown(theEnv,1,&item);

   if (GetType(item) != MULTIFIELD) return(FALSE);

   return(TRUE);
  }
예제 #11
0
globle intBool IntegerpFunction(
  void *theEnv)
  {
   DATA_OBJECT item;

   if (EnvArgCountCheck(theEnv,"integerp",EXACTLY,1) == -1) return(FALSE);

   EnvRtnUnknown(theEnv,1,&item);

   if (GetType(item) != INTEGER) return(FALSE);

   return(TRUE);
  }
예제 #12
0
파일: factfun.c 프로젝트: noxdafox/clips
globle void GetFactListFunction(
  void *theEnv,
  DATA_OBJECT_PTR returnValue)
  {
   struct defmodule *theModule;
   DATA_OBJECT result;
   int numArgs;

   /*===========================================*/
   /* Determine if a module name was specified. */
   /*===========================================*/

   if ((numArgs = EnvArgCountCheck(theEnv,"get-fact-list",NO_MORE_THAN,1)) == -1)
     {
      EnvSetMultifieldErrorValue(theEnv,returnValue);
      return;
     }

   if (numArgs == 1)
     {
      EnvRtnUnknown(theEnv,1,&result);

      if (GetType(result) != SYMBOL)
        {
         EnvSetMultifieldErrorValue(theEnv,returnValue);
         ExpectedTypeError1(theEnv,"get-fact-list",1,"defmodule name");
         return;
        }

      if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL)
        {
         if (strcmp("*",DOToString(result)) != 0)
           {
            EnvSetMultifieldErrorValue(theEnv,returnValue);
            ExpectedTypeError1(theEnv,"get-fact-list",1,"defmodule name");
            return;
           }

         theModule = NULL;
        }
     }
   else
     { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); }

   /*=====================*/
   /* Get the constructs. */
   /*=====================*/

   EnvGetFactList(theEnv,returnValue,theModule);
  }
예제 #13
0
globle intBool StringpFunction(
  void *theEnv)
  {
   DATA_OBJECT item;

   if (EnvArgCountCheck(theEnv,(char*)"stringp",EXACTLY,1) == -1) return(FALSE);

   EnvRtnUnknown(theEnv,1,&item);

   if (GetType(item) == STRING)
     { return(TRUE); }
   else
     { return(FALSE); }
  }
예제 #14
0
globle intBool FloatpFunction(
  void *theEnv)
  {
   DATA_OBJECT item;

   if (EnvArgCountCheck(theEnv,"floatp",EXACTLY,1) == -1) return(FALSE);

   EnvRtnUnknown(theEnv,1,&item);

   if (GetType(item) == FLOAT)
     { return(TRUE); }
   else
     { return(FALSE); }
  }
예제 #15
0
globle intBool NumberpFunction(
  void *theEnv)
  {
   DATA_OBJECT item;

   if (EnvArgCountCheck(theEnv,"numberp",EXACTLY,1) == -1) return(FALSE);

   EnvRtnUnknown(theEnv,1,&item);

   if ((GetType(item) == FLOAT) || (GetType(item) == INTEGER))
     { return(TRUE); }
   else
     { return(FALSE); }
  }
예제 #16
0
globle intBool LexemepFunction(
  void *theEnv)
  {
   DATA_OBJECT item;

   if (EnvArgCountCheck(theEnv,"lexemep",EXACTLY,1) == -1) return(FALSE);

   EnvRtnUnknown(theEnv,1,&item);

   if ((GetType(item) == SYMBOL) || (GetType(item) == STRING))
     { return(TRUE); }
   else
     { return(FALSE); }
  }
예제 #17
0
globle intBool SymbolpFunction(
  void *theEnv)
  {
   DATA_OBJECT item;

   if (EnvArgCountCheck(theEnv,"symbolp",EXACTLY,1) == -1) return(FALSE);

   EnvRtnUnknown(theEnv,1,&item);

   if (GetType(item) == SYMBOL)
     { return(TRUE); }
   else
     { return(FALSE); }
  }
예제 #18
0
파일: argacces.c 프로젝트: femto/rbclips
globle struct defmodule *GetModuleName(
  void *theEnv,
  char *functionName,
  int whichArgument,
  int *error)
  {
   DATA_OBJECT result;
   struct defmodule *theModule;

   *error = FALSE;

   /*========================*/
   /* Retrieve the argument. */
   /*========================*/

   EnvRtnUnknown(theEnv,whichArgument,&result);

   /*=================================*/
   /* A module name must be a symbol. */
   /*=================================*/

   if (GetType(result) != SYMBOL)
     {
      ExpectedTypeError1(theEnv,functionName,whichArgument,"defmodule name");
      *error = TRUE;
      return(NULL);
     }

   /*=======================================*/
   /* Check to see that the symbol actually */
   /* corresponds to a defined module.      */
   /*=======================================*/

   if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL)
     {
      if (strcmp("*",DOToString(result)) != 0)
        {
         ExpectedTypeError1(theEnv,functionName,whichArgument,"defmodule name");
         *error = TRUE;
        }
      return(NULL);
     }

   /*=================================*/
   /* Return a pointer to the module. */
   /*=================================*/

   return(theModule);
  }
예제 #19
0
파일: argacces.c 프로젝트: femto/rbclips
globle char *GetFileName(
  void *theEnv,
  char *functionName,
  int whichArgument)
  {
   DATA_OBJECT result;

   EnvRtnUnknown(theEnv,whichArgument,&result);
   if ((GetType(result) != STRING) && (GetType(result) != SYMBOL))
     {
      ExpectedTypeError1(theEnv,functionName,whichArgument,"file name");
      return(NULL);
     }

   return(DOToString(result));
  }
예제 #20
0
파일: factcom.c 프로젝트: noxdafox/clips
globle int SetFactDuplicationCommand(
    void *theEnv)
{
    int oldValue;
    DATA_OBJECT theValue;

    /*=====================================================*/
    /* Get the old value of the fact duplication behavior. */
    /*=====================================================*/

    oldValue = EnvGetFactDuplication(theEnv);

    /*============================================*/
    /* Check for the correct number of arguments. */
    /*============================================*/

    if (EnvArgCountCheck(theEnv,"set-fact-duplication",EXACTLY,1) == -1)
    {
        return(oldValue);
    }

    /*========================*/
    /* Evaluate the argument. */
    /*========================*/

    EnvRtnUnknown(theEnv,1,&theValue);

    /*===============================================================*/
    /* If the argument evaluated to FALSE, then the fact duplication */
    /* behavior is disabled, otherwise it is enabled.                */
    /*===============================================================*/

    if ((theValue.value == EnvFalseSymbol(theEnv)) && (theValue.type == SYMBOL))
    {
        EnvSetFactDuplication(theEnv,FALSE);
    }
    else
    {
        EnvSetFactDuplication(theEnv,TRUE);
    }

    /*========================================================*/
    /* Return the old value of the fact duplication behavior. */
    /*========================================================*/

    return(oldValue);
}
예제 #21
0
globle int SetIncrementalResetCommand(
  void *theEnv)
  {
   int oldValue;
   DATA_OBJECT argPtr;

   oldValue = EnvGetIncrementalReset(theEnv);

   /*============================================*/
   /* Check for the correct number of arguments. */
   /*============================================*/

   if (EnvArgCountCheck(theEnv,"set-incremental-reset",EXACTLY,1) == -1)
     { return(oldValue); }

   /*=========================================*/
   /* The incremental reset behavior can't be */
   /* changed when rules are loaded.          */
   /*=========================================*/

   if (EnvGetNextDefrule(theEnv,NULL) != NULL)
     {
      PrintErrorID(theEnv,"INCRRSET",1,FALSE);
      EnvPrintRouter(theEnv,WERROR,"The incremental reset behavior cannot be changed with rules loaded.\n");
      SetEvaluationError(theEnv,TRUE);
      return(oldValue);
     }

   /*==================================================*/
   /* The symbol FALSE disables incremental reset. Any */
   /* other value enables incremental reset.           */
   /*==================================================*/

   EnvRtnUnknown(theEnv,1,&argPtr);

   if ((argPtr.value == EnvFalseSymbol(theEnv)) && (argPtr.type == SYMBOL))
     { EnvSetIncrementalReset(theEnv,FALSE); }
   else
     { EnvSetIncrementalReset(theEnv,TRUE); }

   /*=======================*/
   /* Return the old value. */
   /*=======================*/

   return(oldValue);
  }
예제 #22
0
globle double TimerFunction(
    void *theEnv)
{
    int numa, i;
    double startTime;
    DATA_OBJECT returnValue;

    startTime = gentime();

    numa = EnvRtnArgCount(theEnv);

    i = 1;
    while ((i <= numa) && (GetHaltExecution(theEnv) != TRUE))
    {
        EnvRtnUnknown(theEnv,i,&returnValue);
        i++;
    }

    return(gentime() - startTime);
}
예제 #23
0
globle int SSCCommand(
  void *theEnv)
  {
   int oldValue;
   DATA_OBJECT arg_ptr;

   oldValue = EnvGetStaticConstraintChecking(theEnv);

   if (EnvArgCountCheck(theEnv,"set-static-constraint-checking",EXACTLY,1) == -1)
     { return(oldValue); }

   EnvRtnUnknown(theEnv,1,&arg_ptr);

   if ((arg_ptr.value == EnvFalseSymbol(theEnv)) && (arg_ptr.type == SYMBOL))
     { EnvSetStaticConstraintChecking(theEnv,FALSE); }
   else
     { EnvSetStaticConstraintChecking(theEnv,TRUE); }

   return(oldValue);
  }
예제 #24
0
파일: factfun.c 프로젝트: noxdafox/clips
globle struct fact *GetFactAddressOrIndexArgument(
  void *theEnv,
  const char *theFunction,
  int position,
  int noFactError)
  {
   DATA_OBJECT item;
   long long factIndex;
   struct fact *theFact;
   char tempBuffer[20];

   EnvRtnUnknown(theEnv,position,&item);

   if (GetType(item) == FACT_ADDRESS)
     {
      if (((struct fact *) GetValue(item))->garbage) return(NULL);
      else return (((struct fact *) GetValue(item)));
     }
   else if (GetType(item) == INTEGER)
     {
      factIndex = ValueToLong(item.value);
      if (factIndex < 0)
        {
         ExpectedTypeError1(theEnv,theFunction,position,"fact-address or fact-index");
         return(NULL);
        }

      theFact = FindIndexedFact(theEnv,factIndex);
      if ((theFact == NULL) && noFactError)
        {
         gensprintf(tempBuffer,"f-%lld",factIndex);
         CantFindItemErrorMessage(theEnv,"fact",tempBuffer);
         return(NULL);
        }

      return(theFact);
     }

   ExpectedTypeError1(theEnv,theFunction,position,"fact-address or fact-index");
   return(NULL);
  }
예제 #25
0
globle long int LengthFunction(
    void *theEnv)
{
    DATA_OBJECT item;

    /*====================================================*/
    /* The length$ function expects exactly one argument. */
    /*====================================================*/

    if (EnvArgCountCheck(theEnv,"length$",EXACTLY,1) == -1) return(-1L);
    EnvRtnUnknown(theEnv,1,&item);

    /*====================================================*/
    /* If the argument is a string or symbol, then return */
    /* the number of characters in the argument.          */
    /*====================================================*/

    if ((GetType(item) == STRING) || (GetType(item) == SYMBOL))
    {
        return( (long) strlen(DOToString(item)));
    }

    /*====================================================*/
    /* If the argument is a multifield value, then return */
    /* the number of fields in the argument.              */
    /*====================================================*/

    if (GetType(item) == MULTIFIELD)
    {
        return ( (long) GetDOLength(item));
    }

    /*=============================================*/
    /* If the argument wasn't a string, symbol, or */
    /* multifield value, then generate an error.   */
    /*=============================================*/

    SetEvaluationError(theEnv,TRUE);
    ExpectedTypeError2(theEnv,"length$",1);
    return(-1L);
}
예제 #26
0
파일: argacces.c 프로젝트: femto/rbclips
globle char *GetConstructName(
  void *theEnv,
  char *functionName,
  char *constructType)
  {
   DATA_OBJECT result;

   if (EnvRtnArgCount(theEnv) != 1)
     {
      ExpectedCountError(theEnv,functionName,EXACTLY,1);
      return(NULL);
     }

   EnvRtnUnknown(theEnv,1,&result);

   if (GetType(result) != SYMBOL)
     {
      ExpectedTypeError1(theEnv,functionName,1,constructType);
      return(NULL);
     }

   return(DOToString(result));
  }
예제 #27
0
globle long long FactIndexFunction(
  void *theEnv)
  {
   DATA_OBJECT item;

   /*============================================*/
   /* Check for the correct number of arguments. */
   /*============================================*/

   if (EnvArgCountCheck(theEnv,(char*)"fact-index",EXACTLY,1) == -1) return(-1LL);

   /*========================*/
   /* Evaluate the argument. */
   /*========================*/

   EnvRtnUnknown(theEnv,1,&item);

   /*======================================*/
   /* The argument must be a fact address. */
   /*======================================*/

   if (GetType(item) != FACT_ADDRESS)
     {
      ExpectedTypeError1(theEnv,(char*)"fact-index",1,(char*)"fact-address");
      return(-1L);
     }

   /*================================================*/
   /* Return the fact index associated with the fact */
   /* address. If the fact has been retracted, then  */
   /* return -1 for the fact index.                  */
   /*================================================*/

   if (((struct fact *) GetValue(item))->garbage) return(-1LL);

   return (EnvFactIndex(theEnv,GetValue(item)));
  }
예제 #28
0
파일: bmathfun.c 프로젝트: femto/rbclips
globle int SetAutoFloatDividendCommand(
  void *theEnv)
  {
   int oldValue;
   DATA_OBJECT theArgument;

   /*===============================*/
   /* Remember the present setting. */
   /*===============================*/

   oldValue = BasicMathFunctionData(theEnv)->AutoFloatDividend;

   /*============================================*/
   /* Check for the correct number of arguments. */
   /*============================================*/

   if (EnvArgCountCheck(theEnv,"set-auto-float-dividend",EXACTLY,1) == -1)
     { return(oldValue); }

   EnvRtnUnknown(theEnv,1,&theArgument);

   /*============================================================*/
   /* The symbol FALSE disables the auto float dividend feature. */
   /*============================================================*/

   if ((theArgument.value == EnvFalseSymbol(theEnv)) && (theArgument.type == SYMBOL))
     { BasicMathFunctionData(theEnv)->AutoFloatDividend = FALSE; }
   else
     { BasicMathFunctionData(theEnv)->AutoFloatDividend = TRUE; }

   /*======================================*/
   /* Return the old value of the feature. */
   /*======================================*/

   return(oldValue);
  }
예제 #29
0
파일: globlcom.c 프로젝트: femto/rbclips
globle int SetResetGlobalsCommand(
  void *theEnv)
  {
   int oldValue;
   DATA_OBJECT arg_ptr;

   /*===========================================*/
   /* Remember the old value of this attribute. */
   /*===========================================*/

   oldValue = EnvGetResetGlobals(theEnv);

   /*============================================*/
   /* Check for the correct number of arguments. */
   /*============================================*/

   if (EnvArgCountCheck(theEnv,"set-reset-globals",EXACTLY,1) == -1)
     { return(oldValue); }

   /*===========================================*/
   /* Determine the new value of the attribute. */
   /*===========================================*/

   EnvRtnUnknown(theEnv,1,&arg_ptr);

   if ((arg_ptr.value == EnvFalseSymbol(theEnv)) && (arg_ptr.type == SYMBOL))
     { EnvSetResetGlobals(theEnv,FALSE); }
   else
     { EnvSetResetGlobals(theEnv,TRUE); }

   /*========================================*/
   /* Return the old value of the attribute. */
   /*========================================*/

   return(oldValue);
  }
예제 #30
0
파일: factfun.c 프로젝트: noxdafox/clips
globle void PPFactFunction(
  void *theEnv)
  {
   struct fact *theFact;
   int numberOfArguments;
   const char *logicalName = NULL;      /* Avoids warning */
   int ignoreDefaults = FALSE;
   DATA_OBJECT theArg;

   if ((numberOfArguments = EnvArgRangeCheck(theEnv,"ppfact",1,3)) == -1) return;

   theFact = GetFactAddressOrIndexArgument(theEnv,"ppfact",1,TRUE);
   if (theFact == NULL) return;

   /*===============================================================*/
   /* Determine the logical name to which the fact will be printed. */
   /*===============================================================*/

   if (numberOfArguments == 1)
     { logicalName = STDOUT; }
   else
     {
      logicalName = GetLogicalName(theEnv,2,STDOUT);
      if (logicalName == NULL)
        {
         IllegalLogicalNameMessage(theEnv,"ppfact");
         EnvSetHaltExecution(theEnv,TRUE);
         EnvSetEvaluationError(theEnv,TRUE);
         return;
        }
     }
     
   /*=========================================*/
   /* Should slot values be printed if they   */
   /* are the same as the default slot value. */
   /*=========================================*/
   
   if (numberOfArguments == 3)
     {
      EnvRtnUnknown(theEnv,3,&theArg);

      if ((theArg.value == EnvFalseSymbol(theEnv)) && (theArg.type == SYMBOL))
        { ignoreDefaults = FALSE; }
      else
        { ignoreDefaults = TRUE; }
     }
   
   /*============================================================*/
   /* Determine if any router recognizes the output destination. */
   /*============================================================*/

   if (strcmp(logicalName,"nil") == 0)
     { return; }
   else if (QueryRouters(theEnv,logicalName) == FALSE)
     {
      UnrecognizedRouterMessage(theEnv,logicalName);
      return;
     }

   EnvPPFact(theEnv,theFact,logicalName,ignoreDefaults);
  }