/*******************************************************/   /*      "C" Language Integrated Production System      */   /*                                                     */   /*             CLIPS Version 6.24  06/02/06            */   /*                                                     */   /*                                                     */   /*******************************************************//*************************************************************//* Purpose: Generic Functions Interface Routines             *//*                                                           *//* Principal Programmer(s):                                  *//*      Brian L. Donnell                                     *//*                                                           *//* Contributing Programmer(s):                               *//*                                                           *//* Revision History:                                         *//*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  *//*                                                           *//*            Corrected compilation errors for files         *//*            generated by constructs-to-c. DR0861           *//*                                                           *//*            Changed name of variable log to logName        *//*            because of Unix compiler warnings of shadowed  *//*            definitions.                                   *//*                                                           *//*      6.24: Removed IMPERATIVE_METHODS compilation flag.   *//*                                                           *//*            Renamed BOOLEAN macro type to intBool.         *//*                                                           *//*            Corrected code to remove run-time program      *//*            compiler warning.                              *//*                                                           *//*************************************************************//* =========================================   *****************************************               EXTERNAL DEFINITIONS   =========================================   ***************************************** */#include "setup.h"#if DEFGENERIC_CONSTRUCT#include <string.h>#if DEFRULE_CONSTRUCT#include "network.h"#endif#if BLOAD || BLOAD_AND_BSAVE#include "bload.h"#endif#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE#include "genrcbin.h"#endif#if CONSTRUCT_COMPILER#include "genrccmp.h"#endif#if (! BLOAD_ONLY) && (! RUN_TIME)#include "constrct.h"#include "genrcpsr.h"#endif#if OBJECT_SYSTEM#include "classcom.h"#include "inscom.h"#endif#if DEBUGGING_FUNCTIONS#include "watch.h"#endif#include "argacces.h"#include "cstrcpsr.h"#include "envrnmnt.h"#include "extnfunc.h"#include "genrcexe.h"#include "memalloc.h"#include "modulpsr.h"#include "multifld.h"#include "router.h"#define _GENRCCOM_SOURCE_#include "genrccom.h"/* =========================================   *****************************************      INTERNALLY VISIBLE FUNCTION HEADERS   =========================================   ***************************************** */static void PrintGenericCall(void *,char *,void *);static intBool EvaluateGenericCall(void *,void *,DATA_OBJECT *);static void DecrementGenericBusyCount(void *,void *);static void IncrementGenericBusyCount(void *,void *);static void DeallocateDefgenericData(void *);#if ! RUN_TIMEstatic void DestroyDefgenericAction(void *,struct constructHeader *,void *);#endif#if (! BLOAD_ONLY) && (! RUN_TIME)static void SaveDefgenerics(void *,void *,char *);static void SaveDefmethods(void *,void *,char *);static void SaveDefmethodsForDefgeneric(void *,struct constructHeader *,void *);static void RemoveDefgenericMethod(void *,DEFGENERIC *,long);#endif#if DEBUGGING_FUNCTIONSstatic long ListMethodsForGeneric(void *,char *,DEFGENERIC *);static unsigned DefgenericWatchAccess(void *,int,unsigned,EXPRESSION *);static unsigned DefgenericWatchPrint(void *,char *,int,EXPRESSION *);static unsigned DefmethodWatchAccess(void *,int,unsigned,EXPRESSION *);static unsigned DefmethodWatchPrint(void *,char *,int,EXPRESSION *);static unsigned DefmethodWatchSupport(void *,char *,char *,unsigned,                                     void (*)(void *,char *,void *,long),                                     void (*)(void *,unsigned,void *,long),                                     EXPRESSION *);static void PrintMethodWatchFlag(void *,char *,void *,long);#endif/* =========================================   *****************************************          EXTERNALLY VISIBLE FUNCTIONS   =========================================   ***************************************** *//***********************************************************  NAME         : SetupGenericFunctions  DESCRIPTION  : Initializes all generic function                   data structures, constructs and functions  INPUTS       : None  RETURNS      : Nothing useful  SIDE EFFECTS : Generic function H/L functions set up  NOTES        : None ***********************************************************/globle void SetupGenericFunctions(  void *theEnv)  {   ENTITY_RECORD genericEntityRecord =                     { "GCALL", GCALL,0,0,1,                       PrintGenericCall,PrintGenericCall,                       NULL,EvaluateGenericCall,NULL,                       DecrementGenericBusyCount,IncrementGenericBusyCount,                       NULL,NULL,NULL,NULL,NULL };      AllocateEnvironmentData(theEnv,DEFGENERIC_DATA,sizeof(struct defgenericData),DeallocateDefgenericData);   memcpy(&DefgenericData(theEnv)->GenericEntityRecord,&genericEntityRecord,sizeof(struct entityRecord));      InstallPrimitive(theEnv,&DefgenericData(theEnv)->GenericEntityRecord,GCALL);   DefgenericData(theEnv)->DefgenericModuleIndex =                RegisterModuleItem(theEnv,"defgeneric",#if (! RUN_TIME)                                    AllocateDefgenericModule,FreeDefgenericModule,#else                                    NULL,NULL,#endif#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY                                    BloadDefgenericModuleReference,#else                                    NULL,#endif#if CONSTRUCT_COMPILER && (! RUN_TIME)                                    DefgenericCModuleReference,#else                                    NULL,#endif                                    EnvFindDefgeneric);   DefgenericData(theEnv)->DefgenericConstruct =  AddConstruct(theEnv,"defgeneric","defgenerics",#if (! BLOAD_ONLY) && (! RUN_TIME)                                       ParseDefgeneric,#else                                       NULL,#endif                                       EnvFindDefgeneric,                                       GetConstructNamePointer,GetConstructPPForm,                                       GetConstructModuleItem,EnvGetNextDefgeneric,                                       SetNextConstruct,EnvIsDefgenericDeletable,                                       EnvUndefgeneric,#if (! BLOAD_ONLY) && (! RUN_TIME)                                       RemoveDefgeneric#else                                       NULL#endif                                       );#if ! RUN_TIME   AddClearReadyFunction(theEnv,"defgeneric",ClearDefgenericsReady,0);#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE   SetupGenericsBload(theEnv);#endif#if CONSTRUCT_COMPILER   SetupGenericsCompiler(theEnv);#endif#if ! BLOAD_ONLY#if DEFMODULE_CONSTRUCT   AddPortConstructItem(theEnv,"defgeneric",SYMBOL);#endif   AddConstruct(theEnv,"defmethod","defmethods",ParseDefmethod,                NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);  /* ================================================================     Make sure defmethods are cleared last, for other constructs may       be using them and need to be cleared first     Need to be cleared in two stages so that mutually dependent       constructs (like classes) can be cleared     ================================================================ */   AddSaveFunction(theEnv,"defgeneric",SaveDefgenerics,1000);   AddSaveFunction(theEnv,"defmethod",SaveDefmethods,-1000);   EnvDefineFunction2(theEnv,"undefgeneric",'v',PTIEF UndefgenericCommand,"UndefgenericCommand","11w");   EnvDefineFunction2(theEnv,"undefmethod",'v',PTIEF UndefmethodCommand,"UndefmethodCommand","22*wg");#endif   EnvDefineFunction2(theEnv,"call-next-method",'u',PTIEF CallNextMethod,"CallNextMethod","00");   FuncSeqOvlFlags(theEnv,"call-next-method",TRUE,FALSE);   EnvDefineFunction2(theEnv,"call-specific-method",'u',PTIEF CallSpecificMethod,                   "CallSpecificMethod","2**wi");   FuncSeqOvlFlags(theEnv,"call-specific-method",TRUE,FALSE);   EnvDefineFunction2(theEnv,"override-next-method",'u',PTIEF OverrideNextMethod,                   "OverrideNextMethod",NULL);   FuncSeqOvlFlags(theEnv,"override-next-method",TRUE,FALSE);   EnvDefineFunction2(theEnv,"next-methodp",'b',PTIEF NextMethodP,"NextMethodP","00");   FuncSeqOvlFlags(theEnv,"next-methodp",TRUE,FALSE);   EnvDefineFunction2(theEnv,"(gnrc-current-arg)",'u',PTIEF GetGenericCurrentArgument,                   "GetGenericCurrentArgument",NULL);#if DEBUGGING_FUNCTIONS   EnvDefineFunction2(theEnv,"ppdefgeneric",'v',PTIEF PPDefgenericCommand,"PPDefgenericCommand","11w");   EnvDefineFunction2(theEnv,"list-defgenerics",'v',PTIEF ListDefgenericsCommand,"ListDefgenericsCommand","01");   EnvDefineFunction2(theEnv,"ppdefmethod",'v',PTIEF PPDefmethodCommand,"PPDefmethodCommand","22*wi");   EnvDefineFunction2(theEnv,"list-defmethods",'v',PTIEF ListDefmethodsCommand,"ListDefmethodsCommand","01w");   EnvDefineFunction2(theEnv,"preview-generic",'v',PTIEF PreviewGeneric,"PreviewGeneric","1**w");#endif   EnvDefineFunction2(theEnv,"get-defgeneric-list",'m',PTIEF GetDefgenericListFunction,                   "GetDefgenericListFunction","01");   EnvDefineFunction2(theEnv,"get-defmethod-list",'m',PTIEF GetDefmethodListCommand,                   "GetDefmethodListCommand","01w");   EnvDefineFunction2(theEnv,"get-method-restrictions",'m',PTIEF GetMethodRestrictionsCommand,                   "GetMethodRestrictionsCommand","22iw");   EnvDefineFunction2(theEnv,"defgeneric-module",'w',PTIEF GetDefgenericModuleCommand,                   "GetDefgenericModuleCommand","11w");#if OBJECT_SYSTEM   EnvDefineFunction2(theEnv,"type",'u',PTIEF ClassCommand,"ClassCommand","11u");#else   EnvDefineFunction2(theEnv,"type",'u',PTIEF TypeCommand,"TypeCommand","11u");#endif#endif#if DEBUGGING_FUNCTIONS   AddWatchItem(theEnv,"generic-functions",0,&DefgenericData(theEnv)->WatchGenerics,34,                DefgenericWatchAccess,DefgenericWatchPrint);   AddWatchItem(theEnv,"methods",0,&DefgenericData(theEnv)->WatchMethods,33,                DefmethodWatchAccess,DefmethodWatchPrint);#endif  }  /*****************************************************//* DeallocateDefgenericData: Deallocates environment *//*    data for the defgeneric construct.             *//*****************************************************/static void DeallocateDefgenericData(  void *theEnv)  {#if ! RUN_TIME   struct defgenericModule *theModuleItem;   void *theModule;#if BLOAD || BLOAD_AND_BSAVE   if (Bloaded(theEnv)) return;#endif   DoForAllConstructs(theEnv,DestroyDefgenericAction,DefgenericData(theEnv)->DefgenericModuleIndex,FALSE,NULL);    for (theModule = EnvGetNextDefmodule(theEnv,NULL);        theModule != NULL;        theModule = EnvGetNextDefmodule(theEnv,theModule))     {      theModuleItem = (struct defgenericModule *)                      GetModuleItem(theEnv,(struct defmodule *) theModule,                                    DefgenericData(theEnv)->DefgenericModuleIndex);      rtn_struct(theEnv,defgenericModule,theModuleItem);     }#else#if MAC_MCW || IBM_MCW || MAC_XCD#pragma unused(theEnv)#endif#endif  }  #if ! RUN_TIME/****************************************************//* DestroyDefgenericAction: Action used to remove   *//*   defgenerics as a result of DestroyEnvironment. *//****************************************************/#if IBM_TBC#pragma argsused#endifstatic void DestroyDefgenericAction(  void *theEnv,  struct constructHeader *theConstruct,  void *buffer)  {#if MAC_MCW || IBM_MCW || MAC_XCD#pragma unused(buffer)#endif#if (! BLOAD_ONLY) && (! RUN_TIME)   struct defgeneric *theDefgeneric = (struct defgeneric *) theConstruct;   long i;      if (theDefgeneric == NULL) return;   for (i = 0 ; i < theDefgeneric->mcnt ; i++)     { DestroyMethodInfo(theEnv,theDefgeneric,&theDefgeneric->methods[i]); }   if (theDefgeneric->mcnt != 0)     rm(theEnv,(void *) theDefgeneric->methods,(sizeof(DEFMETHOD) * theDefgeneric->mcnt));   DestroyConstructHeader(theEnv,&theDefgeneric->header);   rtn_struct(theEnv,defgeneric,theDefgeneric);#else#if MAC_MCW || IBM_MCW || MAC_XCD#pragma unused(theEnv,theConstruct)#endif#endif  }#endif/***************************************************  NAME         : EnvFindDefgeneric  DESCRIPTION  : Searches for a generic  INPUTS       : The name of the generic                 (possibly including a module name)  RETURNS      : Pointer to the generic if                 found, otherwise NULL  SIDE EFFECTS : None  NOTES        : None ***************************************************/globle void *EnvFindDefgeneric(  void *theEnv,  char *genericModuleAndName)  {   return(FindNamedConstruct(theEnv,genericModuleAndName,DefgenericData(theEnv)->DefgenericConstruct));  }/***************************************************  NAME         : LookupDefgenericByMdlOrScope  DESCRIPTION  : Finds a defgeneric anywhere (if                 module is specified) or in current                 or imported modules  INPUTS       : The defgeneric name  RETURNS      : The defgeneric (NULL if not found)  SIDE EFFECTS : Error message printed on                  ambiguous references  NOTES        : None