genrccom.c

clips源代码

   /*******************************************************/
   /*      "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_TIME
static 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_FUNCTIONS
static 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
#endif
static 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