argacces.c

来自「clips源代码」· C语言 代码 · 共 1,029 行 · 第 1/3 页

   return(-1);
  }

/****************************************************************/
/* EnvArgRangeCheck: Checks that the number of arguments passed */
/*   to a function falls within a specified minimum and maximum */
/*   range. The number of arguments passed to the function is   */
/*   returned if no error occurs, otherwise -1 is returned.     */
/****************************************************************/
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);
  }

/*************************************************************/
/* EnvArgTypeCheck: Retrieves the nth argument passed to the */
/*   function call currently being evaluated and determines  */
/*   if it matches a specified type. Returns TRUE if the     */
/*   argument was successfully retrieved and is of the       */
/*   appropriate type, otherwise returns FALSE.              */
/*************************************************************/
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 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);
  }

/******************************************************************/
/* GetNumericArgument: Evaluates an expression to yield a numeric */
/*  argument. This provides quicker retrieval than using some of  */
/*  the other argument access routines. The numeric argument is   */
/*  returned in a DATA_OBJECT supplied by the calling function.   */
/*  TRUE is returned if a numeric argument was successfully       */
/*  retrieved, otherwise FALSE is returned.                       */
/******************************************************************/
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,0LL);
      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);
  }

/*********************************************************************/
/* GetLogicalName: Retrieves the nth argument passed to the function */
/*   call currently being evaluated and determines if it is a valid  */
/*   logical name. If valid, the logical name is returned, otherwise */
/*   NULL is returned.                                               */
/*********************************************************************/
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);
  }

/************************************************************/
/* GetFileName: Retrieves the nth argument passed to the    */
/*   function call currently being evaluated and determines */
/*   if it is a valid file name. If valid, the file name is */
/*   returned, otherwise NULL is returned.                  */
/************************************************************/
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));
  }

/******************************************************************/
/* OpenErrorMessage: Generalized error message for opening files. */
/******************************************************************/
globle void OpenErrorMessage(
  void *theEnv,
  char *functionName,
  char *fileName)
  {
   PrintErrorID(theEnv,"ARGACCES",2,FALSE);
   EnvPrintRouter(theEnv,WERROR,"Function ");
   EnvPrintRouter(theEnv,WERROR,functionName);
   EnvPrintRouter(theEnv,WERROR," was unable to open file ");
   EnvPrintRouter(theEnv,WERROR,fileName);
   EnvPrintRouter(theEnv,WERROR,".\n");
  }

/************************************************************/
/* GetModuleName: Retrieves the nth argument passed to the  */
/*   function call currently being evaluated and determines */
/*   if it is a valid module name. If valid, the module     */
/*   name is returned or NULL is returned to indicate all   */
/*   modules.                                               */
/************************************************************/
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. */