prccode.c

VC嵌入式CLips专家系统,实现战场环境的目标识别

  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Stack popped and globals restored
  NOTES        : Assumes pstack != NULL
 ******************************************************************/
globle void PopProcParameters(
  void *theEnv)
  {
   register PROC_PARAM_STACK *ptmp;

   if (ProceduralPrimitiveData(theEnv)->ProcParamArray != NULL)
     rm(theEnv,(void *) ProceduralPrimitiveData(theEnv)->ProcParamArray,(sizeof(DATA_OBJECT) * ProceduralPrimitiveData(theEnv)->ProcParamArraySize));

#if DEFGENERIC_CONSTRUCT
   if (ProceduralPrimitiveData(theEnv)->ProcParamExpressions != NULL)
     rm(theEnv,(void *) ProceduralPrimitiveData(theEnv)->ProcParamExpressions,(sizeof(EXPRESSION) * ProceduralPrimitiveData(theEnv)->ProcParamArraySize));
#endif

   ptmp = ProceduralPrimitiveData(theEnv)->pstack;
   ProceduralPrimitiveData(theEnv)->pstack = ProceduralPrimitiveData(theEnv)->pstack->nxt;
   ProceduralPrimitiveData(theEnv)->ProcParamArray = ptmp->ParamArray;
   ProceduralPrimitiveData(theEnv)->ProcParamArraySize = ptmp->ParamArraySize;

#if DEFGENERIC_CONSTRUCT
   ProceduralPrimitiveData(theEnv)->ProcParamExpressions = ptmp->ParamExpressions;
#endif

   if (ProceduralPrimitiveData(theEnv)->WildcardValue != NULL)
     {
      MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value);
      if (ProceduralPrimitiveData(theEnv)->WildcardValue->value != ProceduralPrimitiveData(theEnv)->NoParamValue)
        AddToMultifieldList(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value);
      rtn_struct(theEnv,dataObject,ProceduralPrimitiveData(theEnv)->WildcardValue);
     }
   ProceduralPrimitiveData(theEnv)->WildcardValue = ptmp->WildcardValue;
   ProceduralPrimitiveData(theEnv)->ProcUnboundErrFunc = ptmp->UnboundErrFunc;
   rtn_struct(theEnv,ProcParamStack,ptmp);
  }

#if DEFGENERIC_CONSTRUCT

/***********************************************************
  NAME         : GetProcParamExpressions
  DESCRIPTION  : Forms an array of expressions equivalent to
                 the current procedure paramter array.  Used
                 to conveniently attach these parameters as
                 arguments to a H/L system function call
                 (used by the generic dispatch).
  INPUTS       : None
  RETURNS      : A pointer to an array of expressions
  SIDE EFFECTS : Expression array created
  NOTES        : None
 ***********************************************************/
globle EXPRESSION *GetProcParamExpressions(
  void *theEnv)
  {
   register int i;

   if ((ProceduralPrimitiveData(theEnv)->ProcParamArray == NULL) || (ProceduralPrimitiveData(theEnv)->ProcParamExpressions != NULL))
     return(ProceduralPrimitiveData(theEnv)->ProcParamExpressions);
   ProceduralPrimitiveData(theEnv)->ProcParamExpressions = (EXPRESSION *)
               gm2(theEnv,(sizeof(EXPRESSION) * ProceduralPrimitiveData(theEnv)->ProcParamArraySize));
   for (i = 0 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++)
     {
      ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i].type = ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type;
      if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type != MULTIFIELD)
        ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i].value = ProceduralPrimitiveData(theEnv)->ProcParamArray[i].value;
      else
        ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i].value = (void *) &ProceduralPrimitiveData(theEnv)->ProcParamArray[i];
      ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i].argList = NULL;
      ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i].nextArg =
        ((i + 1) != ProceduralPrimitiveData(theEnv)->ProcParamArraySize) ? &ProceduralPrimitiveData(theEnv)->ProcParamExpressions[i+1] : NULL;
     }
   return(ProceduralPrimitiveData(theEnv)->ProcParamExpressions);
  }

#endif

/***********************************************************
  NAME         : EvaluateProcActions
  DESCRIPTION  : Evaluates the actions of a deffunction,
                 generic function method or message-handler.
  INPUTS       : 1) The module where the actions should be
                    executed
                 2) The actions (linked by nextArg fields)
                 3) The number of local variables to reserve
                    space for.
                 4) A buffer to hold the result of evaluating
                    the actions.
                 5) A function which prints out the name of
                    the currently executing body for error
                    messages (can be NULL).
  RETURNS      : Nothing useful
  SIDE EFFECTS : Allocates and deallocates space for
                 local variable array.
  NOTES        : None
 ***********************************************************/
globle void EvaluateProcActions(
  void *theEnv,
  struct defmodule *theModule,
  EXPRESSION *actions,
  int lvarcnt,
  DATA_OBJECT *result,
  void (*crtproc)(void *))
  {
   DATA_OBJECT *oldLocalVarArray;
   register int i;
   struct defmodule *oldModule;
   EXPRESSION *oldActions;

   oldLocalVarArray = ProceduralPrimitiveData(theEnv)->LocalVarArray;
   ProceduralPrimitiveData(theEnv)->LocalVarArray = (lvarcnt == 0) ? NULL :
                   (DATA_OBJECT *) gm2(theEnv,(sizeof(DATA_OBJECT) * lvarcnt));
   for (i = 0 ; i < lvarcnt ; i++)
     ProceduralPrimitiveData(theEnv)->LocalVarArray[i].supplementalInfo = EnvFalseSymbol(theEnv);

   oldModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
   if (oldModule != theModule)
     EnvSetCurrentModule(theEnv,(void *) theModule);
   oldActions = ProceduralPrimitiveData(theEnv)->CurrentProcActions;
   ProceduralPrimitiveData(theEnv)->CurrentProcActions = actions;

   if (EvaluateExpression(theEnv,actions,result))
     {
      result->type = SYMBOL;
      result->value = EnvFalseSymbol(theEnv);
     }

   ProceduralPrimitiveData(theEnv)->CurrentProcActions = oldActions;
   if (oldModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
     EnvSetCurrentModule(theEnv,(void *) oldModule);
   if ((crtproc != NULL) ? EvaluationData(theEnv)->HaltExecution : FALSE)
     {
      PrintErrorID(theEnv,"PRCCODE",4,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Execution halted during the actions of ");
      (*crtproc)(theEnv);
     }
   if ((ProceduralPrimitiveData(theEnv)->WildcardValue != NULL) ? (result->value == ProceduralPrimitiveData(theEnv)->WildcardValue->value) : FALSE)
     {
      MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value);
      if (ProceduralPrimitiveData(theEnv)->WildcardValue->value != ProceduralPrimitiveData(theEnv)->NoParamValue)
        AddToMultifieldList(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value);
      rtn_struct(theEnv,dataObject,ProceduralPrimitiveData(theEnv)->WildcardValue);
      ProceduralPrimitiveData(theEnv)->WildcardValue = NULL;
     }

   if (lvarcnt != 0)
     {
      for (i = 0 ; i < lvarcnt ; i++)
        if (ProceduralPrimitiveData(theEnv)->LocalVarArray[i].supplementalInfo == EnvTrueSymbol(theEnv))
          ValueDeinstall(theEnv,&ProceduralPrimitiveData(theEnv)->LocalVarArray[i]);
      rm(theEnv,(void *) ProceduralPrimitiveData(theEnv)->LocalVarArray,(sizeof(DATA_OBJECT) * lvarcnt));
     }

   ProceduralPrimitiveData(theEnv)->LocalVarArray = oldLocalVarArray;
  }

/****************************************************
  NAME         : PrintProcParamArray
  DESCRIPTION  : Displays the contents of the
                 current procedure parameter array
  INPUTS       : The logical name of the output
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 ****************************************************/
globle void PrintProcParamArray(
  void *theEnv,
  char *logName)
  {
   register int i;

   EnvPrintRouter(theEnv,logName," (");
   for (i = 0 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++)
     {
      PrintDataObject(theEnv,logName,&ProceduralPrimitiveData(theEnv)->ProcParamArray[i]);
      if (i != ProceduralPrimitiveData(theEnv)->ProcParamArraySize-1)
        EnvPrintRouter(theEnv,logName," ");
     }
   EnvPrintRouter(theEnv,logName,")\n");
  }

/****************************************************************
  NAME         : GrabProcWildargs
  DESCRIPTION  : Groups a portion of the ProcParamArray
                   into a multi-field variable
  INPUTS       : 1) Starting index in ProcParamArray
                      for grouping of arguments into
                      multi-field variable
                 2) Caller's result value buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multi-field variable allocated and set
                   with corresponding values of ProcParamArray
  NOTES        : Multi-field is NOT on list of ephemeral segments
 ****************************************************************/
globle void GrabProcWildargs(
  void *theEnv,
  DATA_OBJECT *result,
  int theIndex)
  {
   register int i,j;
   long k; /* 6.04 Bug Fix */
   long size;
   DATA_OBJECT *val;

   result->type = MULTIFIELD;
   result->begin = 0;
   if (ProceduralPrimitiveData(theEnv)->WildcardValue == NULL)
     {
      ProceduralPrimitiveData(theEnv)->WildcardValue = get_struct(theEnv,dataObject);
      ProceduralPrimitiveData(theEnv)->WildcardValue->begin = 0;
     }
   else if (theIndex == ProceduralPrimitiveData(theEnv)->Oldindex)
     {
      result->end = ProceduralPrimitiveData(theEnv)->WildcardValue->end;
      result->value = ProceduralPrimitiveData(theEnv)->WildcardValue->value;
      return;
     }
   else
     {
      MultifieldDeinstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value);
      if (ProceduralPrimitiveData(theEnv)->WildcardValue->value != ProceduralPrimitiveData(theEnv)->NoParamValue)
        AddToMultifieldList(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value);
     }
   ProceduralPrimitiveData(theEnv)->Oldindex = theIndex;
   size = ProceduralPrimitiveData(theEnv)->ProcParamArraySize - theIndex + 1;
   if (size <= 0)
     {
      result->end = ProceduralPrimitiveData(theEnv)->WildcardValue->end = -1;
      result->value = ProceduralPrimitiveData(theEnv)->WildcardValue->value = ProceduralPrimitiveData(theEnv)->NoParamValue;
      MultifieldInstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value);
      return;
     }
   for (i = theIndex-1 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++)
     {
      if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == MULTIFIELD)
        size += ProceduralPrimitiveData(theEnv)->ProcParamArray[i].end - ProceduralPrimitiveData(theEnv)->ProcParamArray[i].begin;
     }
   result->end = ProceduralPrimitiveData(theEnv)->WildcardValue->end = size-1;
   result->value = ProceduralPrimitiveData(theEnv)->WildcardValue->value = (void *) CreateMultifield2(theEnv,(unsigned long) size);
   for (i = theIndex-1 , j = 1 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++)
     {
      if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type != MULTIFIELD)
        {
         SetMFType(result->value,j,(short) ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type);
         SetMFValue(result->value,j,ProceduralPrimitiveData(theEnv)->ProcParamArray[i].value);
         j++;
        }
      else
        {
         val = &ProceduralPrimitiveData(theEnv)->ProcParamArray[i];
         for (k = val->begin + 1 ; k <= val->end + 1 ; k++ , j++)
           {
            SetMFType(result->value,j,GetMFType(val->value,k));
            SetMFValue(result->value,j,GetMFValue(val->value,k));
           }
        }
     }
   MultifieldInstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->WildcardValue->value);
  }

/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

/*******************************************************************
  NAME         : EvaluateProcParameters
  DESCRIPTION  : Given a list of parameter expressions,
                   this function evaluates each expression
                   and stores the results in a contiguous
                   array of DATA_OBJECTS.  Used in creating a new
                   ProcParamArray for the execution of a
                   procedure
  INPUTS       : 1) The paramter expression list
                 2) The number of parameters in the list
                 3) The name of the procedure for which
                    these parameters are being evaluated
                 4) The type of procedure
  RETURNS      : Nothing useful
  SIDE EFFECTS : Any side-effects of the evaluation of the
                   parameter expressions
                 DATA_OBJECT array allocated (deallocated on errors)
                 ProcParamArray set
  NOTES        : EvaluationError set on errors
 *******************************************************************/
static void EvaluateProcParameters(
  void *theEnv,
  EXPRESSION *parameterList,
  int numberOfParameters,
  char *pname,
  char *bodytype)
  {
   DATA_OBJECT *rva,temp;
   int i = 0;

   if (numberOfParameters == 0)
     {
      ProceduralPrimitiveData(theEnv)->ProcParamArray = NULL;
      ProceduralPrimitiveData(theEnv)->ProcParamArraySize = 0;
      return;
     }

   rva = (DATA_OBJECT *) gm2(theEnv,(sizeof(DATA_OBJECT) * numberOfParameters));
   while (parameterList != NULL)
     {
      if ((EvaluateExpression(theEnv,parameterList,&temp) == TRUE) ? TRUE :
          (temp.type == RVOID))
        {
         if (temp.type == RVOID)
           {
            PrintErrorID(theEnv,"PRCCODE",2,FALSE);
            EnvPrintRouter(theEnv,WERROR,"Functions without a return value are illegal as ");
            EnvPrintRouter(theEnv,WERROR,bodytype);
            EnvPrintRouter(theEnv,WERROR," arguments.\n");
            SetEvaluationError(theEnv,TRUE);
           }
         PrintErrorID(theEnv,"PRCCODE",6,FALSE);
         EnvPrintRouter(theEnv,WERROR,"This error occurred while evaluating arguments ");
         EnvPrintRouter(theEnv,WERROR,"for the ");
         EnvPrintRouter(theEnv,WERROR,bodytype);
         EnvPrintRouter(theEnv,WERROR," ");
         EnvPrintRouter(theEnv,WERROR,pname);
         EnvPrintRouter(theEnv,WERROR,".\n");
         rm(theEnv,(void *) rva,(sizeof(DATA_OBJECT) * numberOfParameters));
         return;
        }
      rva[i].type = temp.type;
      rva[i].value = temp.value;
      rva[i].begin = temp.begin;
      rva[i].end = temp.end;
      parameterList = parameterList->nextArg;
      i++;
     }
   ProceduralPrimitiveData(theEnv)->ProcParamArraySize = numberOfParameters;
   ProceduralPrimitiveData(theEnv)->ProcParamArray = rva;
  }

/***************************************************
  NAME         : RtnProcParam
  DESCRIPTION  : Internal function for getting the