/*******************************************************/   /*      "C" Language Integrated Production System      */   /*                                                     */   /*               CLIPS Version 6.24  05/17/06          */   /*                                                     */   /*                                                     */   /*******************************************************//*************************************************************//* Purpose: Generic Functions Internal Routines              *//*                                                           *//* Principal Programmer(s):                                  *//*      Brian L. Donnell                                     *//*                                                           *//* Contributing Programmer(s):                               *//*                                                           *//* Revision History:                                         *//*      6.23: 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.         *//*                                                           *//*************************************************************//* =========================================   *****************************************               EXTERNAL DEFINITIONS   =========================================   ***************************************** */#include "setup.h"#if DEFGENERIC_CONSTRUCT#if BLOAD || BLOAD_AND_BSAVE#include "bload.h"#endif#if OBJECT_SYSTEM#include "classcom.h"#include "classfun.h"#endif#include "argacces.h"#include "constrct.h"#include "cstrcpsr.h"#include "envrnmnt.h"#include "genrccom.h"#include "genrcexe.h"#include "memalloc.h"#include "prccode.h"#include "router.h"#include "sysdep.h"#define _GENRCFUN_SOURCE_#include "genrcfun.h"/* =========================================   *****************************************      INTERNALLY VISIBLE FUNCTION HEADERS   =========================================   ***************************************** */#if DEBUGGING_FUNCTIONSstatic void DisplayGenericCore(void *,DEFGENERIC *);#endif/* =========================================   *****************************************          EXTERNALLY VISIBLE FUNCTIONS   =========================================   ***************************************** */#if ! RUN_TIME/***************************************************  NAME         : ClearDefgenericsReady  DESCRIPTION  : Determines if it is safe to                 remove all defgenerics                 Assumes *all* constructs will be                 deleted - only checks to see if                 any methods are currently                 executing  INPUTS       : None  RETURNS      : TRUE if no methods are                 executing, FALSE otherwise  SIDE EFFECTS : None  NOTES        : Used by (clear) and (bload) ***************************************************/globle intBool ClearDefgenericsReady(  void *theEnv)  {   return((DefgenericData(theEnv)->CurrentGeneric != NULL) ? FALSE : TRUE);  }/*****************************************************  NAME         : AllocateDefgenericModule  DESCRIPTION  : Creates and initializes a                 list of defgenerics for a new module  INPUTS       : None  RETURNS      : The new deffunction module  SIDE EFFECTS : Deffunction module created  NOTES        : None *****************************************************/globle void *AllocateDefgenericModule(  void *theEnv)  {   return((void *) get_struct(theEnv,defgenericModule));  }/***************************************************  NAME         : FreeDefgenericModule  DESCRIPTION  : Removes a deffunction module and                 all associated deffunctions  INPUTS       : The deffunction module  RETURNS      : Nothing useful  SIDE EFFECTS : Module and deffunctions deleted  NOTES        : None ***************************************************/globle void FreeDefgenericModule(  void *theEnv,  void *theItem)  {#if (! BLOAD_ONLY)   FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefgenericData(theEnv)->DefgenericConstruct);#endif   rtn_struct(theEnv,defgenericModule,theItem);  }#endif#if (! BLOAD_ONLY) && (! RUN_TIME)/************************************************************  NAME         : ClearDefmethods  DESCRIPTION  : Deletes all defmethods - generic headers                   are left intact  INPUTS       : None  RETURNS      : TRUE if all methods deleted, FALSE otherwise  SIDE EFFECTS : Defmethods deleted  NOTES        : Clearing generic functions is done in                   two stages                 1) Delete all methods (to clear any                    references to other constructs)                 2) Delete all generic headers                 This allows other constructs which                   mutually refer to generic functions                   to be cleared ************************************************************/globle int ClearDefmethods(  void *theEnv)  {   register DEFGENERIC *gfunc;   int success = TRUE;#if BLOAD || BLOAD_AND_BSAVE   if (Bloaded(theEnv) == TRUE) return(FALSE);#endif   gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL);   while (gfunc != NULL)     {      if (RemoveAllExplicitMethods(theEnv,gfunc) == FALSE)        success = FALSE;      gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc);     }   return(success);  }/*****************************************************************  NAME         : RemoveAllExplicitMethods  DESCRIPTION  : Deletes all explicit defmethods - generic headers                   are left intact (as well as a method for an                   overloaded system function)  INPUTS       : None  RETURNS      : TRUE if all methods deleted, FALSE otherwise  SIDE EFFECTS : Explicit defmethods deleted  NOTES        : None *****************************************************************/globle int RemoveAllExplicitMethods(  void *theEnv,  DEFGENERIC *gfunc)  {   long i,j;   unsigned systemMethodCount = 0;   DEFMETHOD *narr;   if (MethodsExecuting(gfunc) == FALSE)     {      for (i = 0 ; i < gfunc->mcnt ; i++)        {         if (gfunc->methods[i].system)           systemMethodCount++;         else           DeleteMethodInfo(theEnv,gfunc,&gfunc->methods[i]);        }      if (systemMethodCount != 0)        {         narr = (DEFMETHOD *) gm2(theEnv,(systemMethodCount * sizeof(DEFMETHOD)));         i = 0;         j = 0;         while (i < gfunc->mcnt)           {            if (gfunc->methods[i].system)              GenCopyMemory(DEFMETHOD,1,&narr[j++],&gfunc->methods[i]);            i++;           }         rm(theEnv,(void *) gfunc->methods,(sizeof(DEFMETHOD) * gfunc->mcnt));         gfunc->mcnt = systemMethodCount;         gfunc->methods = narr;        }      else        {         if (gfunc->mcnt != 0)           rm(theEnv,(void *) gfunc->methods,(sizeof(DEFMETHOD) * gfunc->mcnt));         gfunc->mcnt = 0;         gfunc->methods = NULL;        }      return(TRUE);     }   return(FALSE);  }/**************************************************  NAME         : RemoveDefgeneric  DESCRIPTION  : Removes a generic function node                   from the generic list along with                   all its methods  INPUTS       : The generic function  RETURNS      : Nothing useful  SIDE EFFECTS : List adjusted                 Nodes deallocated  NOTES        : Assumes generic is not in use!!! **************************************************/globle void RemoveDefgeneric(  void *theEnv,  void *vgfunc)  {   DEFGENERIC *gfunc = (DEFGENERIC *) vgfunc;   long i;   for (i = 0 ; i < gfunc->mcnt ; i++)     DeleteMethodInfo(theEnv,gfunc,&gfunc->methods[i]);   if (gfunc->mcnt != 0)     rm(theEnv,(void *) gfunc->methods,(sizeof(DEFMETHOD) * gfunc->mcnt));   DecrementSymbolCount(theEnv,GetDefgenericNamePointer((void *) gfunc));   SetDefgenericPPForm((void *) gfunc,NULL);   ClearUserDataList(theEnv,gfunc->header.usrData);   rtn_struct(theEnv,defgeneric,gfunc);  }/****************************************************************  NAME         : ClearDefgenerics  DESCRIPTION  : Deletes all generic headers  INPUTS       : None  RETURNS      : TRUE if all methods deleted, FALSE otherwise  SIDE EFFECTS : Generic headers deleted (and any implicit system                  function methods)  NOTES        : None ****************************************************************/globle int ClearDefgenerics(  void *theEnv)  {   register DEFGENERIC *gfunc,*gtmp;   int success = TRUE;#if BLOAD || BLOAD_AND_BSAVE   if (Bloaded(theEnv) == TRUE) return(FALSE);#endif   gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL);   while (gfunc != NULL)     {      gtmp = gfunc;      gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc);      if (RemoveAllExplicitMethods(theEnv,gtmp) == FALSE)        {         CantDeleteItemErrorMessage(theEnv,"generic function",EnvGetDefgenericName(theEnv,gtmp));         success = FALSE;        }      else        {         RemoveConstructFromModule(theEnv,(struct constructHeader *) gtmp);         RemoveDefgeneric(theEnv,(void *) gtmp);        }     }   return(success);  }/********************************************************  NAME         : MethodAlterError  DESCRIPTION  : Prints out an error message reflecting                   that a generic function's methods                   cannot be altered while any of them                   are executing  INPUTS       : The generic function  RETURNS      : Nothing useful  SIDE EFFECTS : None  NOTES        : None ********************************************************/globle void MethodAlterError(  void *theEnv,  DEFGENERIC *gfunc)  {   PrintErrorID(theEnv,"GENRCFUN",1,FALSE);   EnvPrintRouter(theEnv,WERROR,"Defgeneric ");   EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc));   EnvPrintRouter(theEnv,WERROR," cannot be modified while one of its methods is executing.\n");  }/***************************************************  NAME         : DeleteMethodInfo  DESCRIPTION  : Deallocates all the data associated                  w/ a method but does not release                  the method structure itself  INPUTS       : 1) The generic function address                 2) The method address  RETURNS      : Nothing useful  SIDE EFFECTS : Nodes deallocated  NOTES        : None ***************************************************/globle void DeleteMethodInfo(  void *theEnv,  DEFGENERIC *gfunc,  DEFMETHOD *meth)  {   short j,k;   RESTRICTION *rptr;   SaveBusyCount(gfunc);   ExpressionDeinstall(theEnv,meth->actions);   ReturnPackedExpression(theEnv,meth->actions);   ClearUserDataList(theEnv,meth->usrData);   if (meth->ppForm != NULL)     rm(theEnv,(void *) meth->ppForm,(sizeof(char) * (strlen(meth->ppForm)+1)));   for (j = 0 ; j < meth->restrictionCount ; j++)     {      rptr = &meth->restrictions[j];      for (k = 0 ; k < rptr->tcnt ; k++)#if OBJECT_SYSTEM        DecrementDefclassBusyCount(theEnv,rptr->types[k]);#else        DecrementIntegerCount(theEnv,(INTEGER_HN *) rptr->types[k]);#endif      if (rptr->types != NULL)        rm(theEnv,(void *) rptr->types,(sizeof(void *) * rptr->tcnt));      ExpressionDeinstall(theEnv,rptr->query);      ReturnPackedExpression(theEnv,rptr->query);     }   if (meth->restrictions != NULL)     rm(theEnv,(void *) meth->restrictions,        (sizeof(RESTRICTION) * meth->restrictionCount));   RestoreBusyCount(gfunc);  }  /***************************************************  NAME         : DestroyMethodInfo  DESCRIPTION  : Deallocates all the data associated                  w/ a method but does not release                  the method structure itself  INPUTS       : 1) The generic function address                 2) The method address  RETURNS      : Nothing useful  SIDE EFFECTS : Nodes deallocated  NOTES        : None ***************************************************/#if IBM_TBC#pragma argsused#endifgloble void DestroyMethodInfo(  void *theEnv,  DEFGENERIC *gfunc,  DEFMETHOD *meth)  {   register int j;   register RESTRICTION *rptr;#if MAC_MCW || IBM_MCW || MAC_XCD#pragma unused(gfunc)#endif   ReturnPackedExpression(theEnv,meth->actions);      ClearUserDataList(theEnv,meth->usrData);   if (meth->ppForm != NULL)     rm(theEnv,(void *) meth->ppForm,(sizeof(char) * (strlen(meth->ppForm)+1)));   for (j = 0 ; j < meth->restrictionCount ; j++)     {      rptr = &meth->restrictions[j];      if (rptr->types != NULL)        rm(theEnv,(void *) rptr->types,(sizeof(void *) * rptr->tcnt));      ReturnPackedExpression(theEnv,rptr->query);     }   if (meth->restrictions != NULL)     rm(theEnv,(void *) meth->restrictions,        (sizeof(RESTRICTION) * meth->restrictionCount));  }