/*******************************************************/   /*      "C" Language Integrated Production System      */   /*                                                     */   /*               CLIPS Version 6.24  06/05/06          */   /*                                                     */   /*                                                     */   /*******************************************************//***************************************************************//* Purpose: Procedural Code Support Routines for Deffunctions, *//*          Generic Function Methods,Message-Handlers          *//*          and Rules                                          *//*                                                             *//* Principal Programmer(s):                                    *//*      Brian L. Donnell                                       *//*                                                             *//* Contributing Programmer(s):                                 *//*                                                             *//* Revision History:                                           *//*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859    *//*                                                             *//*            Changed name of variable log to logName          *//*            because of Unix compiler warnings of shadowed    *//*            definitions.                                     *//*                                                             *//*      6.24: Renamed BOOLEAN macro type to intBool.           *//*                                                             *//*            Added pragmas to remove compilation warnings.    *//*                                                             *//***************************************************************//* =========================================   *****************************************               EXTERNAL DEFINITIONS   =========================================   ***************************************** */#include "setup.h"#ifndef _STDIO_INCLUDED_#include <stdio.h>#define _STDIO_INCLUDED_#endif#include <stdlib.h>#include <ctype.h>#include "memalloc.h"#include "constant.h"#include "envrnmnt.h"#if DEFGLOBAL_CONSTRUCT#include "globlpsr.h"#endif#include "exprnpsr.h"#include "multifld.h"#if OBJECT_SYSTEM#include "object.h"#endif#include "prcdrpsr.h"#include "router.h"#include "utility.h"#define _PRCCODE_SOURCE_#include "prccode.h"/* =========================================   *****************************************               MACROS AND TYPES   =========================================   ***************************************** */typedef struct  {   unsigned firstFlag  : 1;   unsigned first      : 15;   unsigned secondFlag : 1;   unsigned second     : 15;  } PACKED_PROC_VAR;/* =========================================   *****************************************      INTERNALLY VISIBLE FUNCTION HEADERS   =========================================   ***************************************** */static void EvaluateProcParameters(void *,EXPRESSION *,int,char *,char *);static intBool RtnProcParam(void *,void *,DATA_OBJECT *);static intBool GetProcBind(void *,void *,DATA_OBJECT *);static intBool PutProcBind(void *,void *,DATA_OBJECT *);static intBool RtnProcWild(void *,void *,DATA_OBJECT *);static void DeallocateProceduralPrimitiveData(void *);static void ReleaseProcParameters(void *);#if (! BLOAD_ONLY) && (! RUN_TIME)static int FindProcParameter(SYMBOL_HN *,EXPRESSION *,SYMBOL_HN *);static int ReplaceProcBinds(void *,EXPRESSION *,                             int (*)(void *,EXPRESSION *,void *),void *);static EXPRESSION *CompactActions(void *,EXPRESSION *);#endif#if (! DEFFUNCTION_CONSTRUCT) || (! DEFGENERIC_CONSTRUCT)static intBool EvaluateBadCall(void *,void *,DATA_OBJECT *);#endif/* =========================================   *****************************************          EXTERNALLY VISIBLE FUNCTIONS   =========================================   ***************************************** *//****************************************************  NAME         : InstallProcedurePrimitives  DESCRIPTION  : Installs primitive function handlers                 for accessing parameters and local                 variables within the bodies of                 message-handlers, methods, rules and                 deffunctions.  INPUTS       : None  RETURNS      : Nothing useful  SIDE EFFECTS : Primitive entities installed  NOTES        : None ****************************************************/globle void InstallProcedurePrimitives(  void *theEnv)  {   ENTITY_RECORD procParameterInfo = { "PROC_PARAM", PROC_PARAM,0,1,0,NULL,NULL,NULL,                                           RtnProcParam,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL },                     procWildInfo =      { "PROC_WILD_PARAM", PROC_WILD_PARAM,0,1,0,NULL,NULL,NULL,                                           RtnProcWild,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL },                     procGetInfo =       { "PROC_GET_BIND", PROC_GET_BIND,0,1,0,NULL,NULL,NULL,                                           GetProcBind,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL },                     procBindInfo =      { "PROC_BIND", PROC_BIND,0,1,0,NULL,NULL,NULL,                                           PutProcBind,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL };#if ! DEFFUNCTION_CONSTRUCT   ENTITY_RECORD deffunctionEntityRecord =                     { "PCALL", PCALL,0,0,1,                       NULL,NULL,NULL,                       EvaluateBadCall,                       NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL };#endif#if ! DEFGENERIC_CONSTRUCT   ENTITY_RECORD genericEntityRecord =                     { "GCALL", GCALL,0,0,1,                       NULL,NULL,NULL,                       EvaluateBadCall,                       NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL };#endif   AllocateEnvironmentData(theEnv,PROCEDURAL_PRIMITIVE_DATA,sizeof(struct proceduralPrimitiveData),DeallocateProceduralPrimitiveData);   memcpy(&ProceduralPrimitiveData(theEnv)->ProcParameterInfo,&procParameterInfo,sizeof(struct entityRecord));     memcpy(&ProceduralPrimitiveData(theEnv)->ProcWildInfo,&procWildInfo,sizeof(struct entityRecord));     memcpy(&ProceduralPrimitiveData(theEnv)->ProcGetInfo,&procGetInfo,sizeof(struct entityRecord));     memcpy(&ProceduralPrimitiveData(theEnv)->ProcBindInfo,&procBindInfo,sizeof(struct entityRecord));     InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcParameterInfo,PROC_PARAM);   InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcWildInfo,PROC_WILD_PARAM);   InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcGetInfo,PROC_GET_BIND);   InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcBindInfo,PROC_BIND);   ProceduralPrimitiveData(theEnv)->Oldindex = -1;      /* ===============================================      Make sure a default evaluation function is      in place for deffunctions and generic functions      in the event that a binary image containing      these items is loaded into a configuration      that does not support them.      =============================================== */#if ! DEFFUNCTION_CONSTRUCT   memcpy(&ProceduralPrimitiveData(theEnv)->DeffunctionEntityRecord,&deffunctionEntityRecord,sizeof(struct entityRecord));     InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->DeffunctionEntityRecord,PCALL);#endif#if ! DEFGENERIC_CONSTRUCT   memcpy(&ProceduralPrimitiveData(theEnv)->GenericEntityRecord,&genericEntityRecord,sizeof(struct entityRecord));     InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->GenericEntityRecord,GCALL);#endif   /* =============================================      Install the special empty multifield to      let callers distinguish between no parameters      and zero-length multifield parameters      ============================================= */   ProceduralPrimitiveData(theEnv)->NoParamValue = CreateMultifield2(theEnv,0L);   MultifieldInstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->NoParamValue);  }/**************************************************************//* DeallocateProceduralPrimitiveData: Deallocates environment *//*    data for the procedural primitives functionality.       *//**************************************************************/static void DeallocateProceduralPrimitiveData(  void *theEnv)  {   ReturnMultifield(theEnv,(struct multifield *) ProceduralPrimitiveData(theEnv)->NoParamValue);   ReleaseProcParameters(theEnv);  }#if (! BLOAD_ONLY) && (! RUN_TIME)#if DEFFUNCTION_CONSTRUCT || OBJECT_SYSTEM/************************************************************  NAME         : ParseProcParameters  DESCRIPTION  : Parses a parameter list for a                  procedural routine, such as a                  deffunction or message-handler  INPUTS       : 1) The logical name of the input                 2) A buffer for scanned tokens                 3) The partial list of parameters so far                    (can be NULL)                 3) A buffer for a wildcard symbol (if any)                 4) A buffer for a minimum of parameters                 5) A buffer for a maximum of parameters                    (will be set to -1 if there is a wilcard)                 6) A buffer for an error flag                 7) The address of a function to do specialized                    checking on a parameter (can be NULL)                    The function should accept a string and                    return FALSE if the parameter is OK, TRUE                    otherwise.  RETURNS      : A list of expressions containing the                   parameter names  SIDE EFFECTS : Parameters parsed and expressions formed  NOTES        : None ************************************************************/globle EXPRESSION *ParseProcParameters(  void *theEnv,  char *readSource,  struct token *tkn,  EXPRESSION *parameterList,  SYMBOL_HN **wildcard,  int *min,  int *max,  int *error,  int (*checkfunc)(void *,char *))  {   EXPRESSION *nextOne,*lastOne,*check;   int paramprintp = 0;   *wildcard = NULL;   *min = 0;   *error = TRUE;   lastOne = nextOne = parameterList;   while (nextOne != NULL)     {      (*min)++;      lastOne = nextOne;      nextOne = nextOne->nextArg;     }   if (tkn->type != LPAREN)     {      SyntaxErrorMessage(theEnv,"parameter list");      ReturnExpression(theEnv,parameterList);      return(NULL);     }   GetToken(theEnv,readSource,tkn);   while ((tkn->type == SF_VARIABLE) || (tkn->type == MF_VARIABLE))     {      for (check = parameterList ; check != NULL ; check = check->nextArg)        if (check->value == tkn->value)         {          PrintErrorID(theEnv,"PRCCODE",7,FALSE);          EnvPrintRouter(theEnv,WERROR,"Duplicate parameter names not allowed.\n");          ReturnExpression(theEnv,parameterList);          return(NULL);         }      if (*wildcard != NULL)        {         PrintErrorID(theEnv,"PRCCODE",8,FALSE);         EnvPrintRouter(theEnv,WERROR,"No parameters allowed after wildcard parameter.\n");         ReturnExpression(theEnv,parameterList);         return(NULL);        }      if ((checkfunc != NULL) ? (*checkfunc)(theEnv,ValueToString(tkn->value)) : FALSE)        {         ReturnExpression(theEnv,parameterList);         return(NULL);        }      nextOne = GenConstant(theEnv,tkn->type,tkn->value);      if (tkn->type == MF_VARIABLE)        *wildcard = (SYMBOL_HN *) tkn->value;      else        (*min)++;      if (lastOne == NULL)        { parameterList = nextOne; }      else        { lastOne->nextArg = nextOne; }      lastOne = nextOne;      SavePPBuffer(theEnv," ");      paramprintp = 1;      GetToken(theEnv,readSource,tkn);     }   if (tkn->type != RPAREN)     {      SyntaxErrorMessage(theEnv,"parameter list");      ReturnExpression(theEnv,parameterList);      return(NULL);     }   if (paramprintp)     {      PPBackup(theEnv);      PPBackup(theEnv);      SavePPBuffer(theEnv,")");     }   *error = FALSE;   *max = (*wildcard != NULL) ? -1 : *min;   return(parameterList);  }#endif/*************************************************************************  NAME         : ParseProcActions  DESCRIPTION  : Parses the bodies of deffunctions, generic function                 methods and message-handlers.  Replaces parameter                 and local variable references with appropriate                 runtime access functions  INPUTS       : 1) The type of procedure body being parsed                 2) The logical name of the input                 3) A buffer for scanned tokens                 4) A list of expressions containing the names                    of the parameters                 5) The wilcard parameter symbol (NULL if none)                 6) A pointer to a function to parse variables not                    recognized by the standard parser                    The function should accept the variable                    expression and a generic pointer for special                    data (can be NULL) as arguments.  If the variable                    is recognized, the function should modify the                    expression to access this variable.  Return 1                    if recognized, 0 if not, -1 on errors                    This argument can be NULL.                 7) A pointer to a function to handle binds in a                    special way. The function should accept the                    bind function call expression as an argument.                    If the variable is recognized and treated specially,                    the function should modify the expression                    appropriately (including attaching/removing                    any necessary argument expressions).  Return 1                    if recognized, 0 if not, -1 on errors.                    This argument can be NULL.                 8) A buffer for holding the number of local vars                    used by this procedure body.                 9) Special user data buffer to pass to variable                    reference and bind replacement functionsRETURNS      : A packed expression containing the body, NULL on                   errors.SIDE EFFECTS : Variable references replaced with runtime calls                  to access the paramter and local variable arrayNOTES        : None*************************************************************************/globle EXPRESSION *ParseProcActions(  void *theEnv,  char *bodytype,  char *readSource,  struct token *tkn,  EXPRESSION *params,  SYMBOL_HN *wildcard,