classini.c

clips源代码

   ***************************************** */

/*********************************************************
  NAME         : SetupDefclasses
  DESCRIPTION  : Initializes Class Hash Table,
                   Function Parsers, and Data Structures
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS :
  NOTES        : None
 *********************************************************/
static void SetupDefclasses(
  void *theEnv)
  {
   InstallPrimitive(theEnv,&DefclassData(theEnv)->DefclassEntityRecord,DEFCLASS_PTR);

   DefclassData(theEnv)->DefclassModuleIndex =
                RegisterModuleItem(theEnv,"defclass",
#if (! RUN_TIME)
                                    AllocateModule,ReturnModule,
#else
                                    NULL,NULL,
#endif
#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
                                    BloadDefclassModuleReference,
#else
                                    NULL,
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
                                    DefclassCModuleReference,
#else
                                    NULL,
#endif
                                    EnvFindDefclass);

   DefclassData(theEnv)->DefclassConstruct =  AddConstruct(theEnv,"defclass","defclasses",
#if (! BLOAD_ONLY) && (! RUN_TIME)
                                     ParseDefclass,
#else
                                     NULL,
#endif
                                     EnvFindDefclass,
                                     GetConstructNamePointer,GetConstructPPForm,
                                     GetConstructModuleItem,EnvGetNextDefclass,
                                     SetNextConstruct,EnvIsDefclassDeletable,
                                     EnvUndefclass,
#if (! RUN_TIME)
                                     RemoveDefclass
#else
                                     NULL
#endif
                                     );

   AddClearReadyFunction(theEnv,"defclass",InstancesPurge,0);

#if ! RUN_TIME
   EnvAddClearFunction(theEnv,"defclass",CreateSystemClasses,0);
   InitializeClasses(theEnv);

#if ! BLOAD_ONLY
#if DEFMODULE_CONSTRUCT
   AddPortConstructItem(theEnv,"defclass",SYMBOL);
   AddAfterModuleDefinedFunction(theEnv,"defclass",UpdateDefclassesScope,0);
#endif
   EnvDefineFunction2(theEnv,"undefclass",'v',PTIEF UndefclassCommand,"UndefclassCommand","11w");

   AddSaveFunction(theEnv,"defclass",SaveDefclasses,10);
#endif

#if DEBUGGING_FUNCTIONS
   EnvDefineFunction2(theEnv,"list-defclasses",'v',PTIEF ListDefclassesCommand,"ListDefclassesCommand","01");
   EnvDefineFunction2(theEnv,"ppdefclass",'v',PTIEF PPDefclassCommand,"PPDefclassCommand","11w");
   EnvDefineFunction2(theEnv,"describe-class",'v',PTIEF DescribeClassCommand,"DescribeClassCommand","11w");
   EnvDefineFunction2(theEnv,"browse-classes",'v',PTIEF BrowseClassesCommand,"BrowseClassesCommand","01w");
#endif

   EnvDefineFunction2(theEnv,"get-defclass-list",'m',PTIEF GetDefclassListFunction,
                   "GetDefclassListFunction","01");
   EnvDefineFunction2(theEnv,"superclassp",'b',PTIEF SuperclassPCommand,"SuperclassPCommand","22w");
   EnvDefineFunction2(theEnv,"subclassp",'b',PTIEF SubclassPCommand,"SubclassPCommand","22w");
   EnvDefineFunction2(theEnv,"class-existp",'b',PTIEF ClassExistPCommand,"ClassExistPCommand","11w");
   EnvDefineFunction2(theEnv,"message-handler-existp",'b',
                   PTIEF MessageHandlerExistPCommand,"MessageHandlerExistPCommand","23w");
   EnvDefineFunction2(theEnv,"class-abstractp",'b',PTIEF ClassAbstractPCommand,"ClassAbstractPCommand","11w");
#if DEFRULE_CONSTRUCT
   EnvDefineFunction2(theEnv,"class-reactivep",'b',PTIEF ClassReactivePCommand,"ClassReactivePCommand","11w");
#endif
   EnvDefineFunction2(theEnv,"class-slots",'m',PTIEF ClassSlotsCommand,"ClassSlotsCommand","12w");
   EnvDefineFunction2(theEnv,"class-superclasses",'m',
                   PTIEF ClassSuperclassesCommand,"ClassSuperclassesCommand","12w");
   EnvDefineFunction2(theEnv,"class-subclasses",'m',
                   PTIEF ClassSubclassesCommand,"ClassSubclassesCommand","12w");
   EnvDefineFunction2(theEnv,"get-defmessage-handler-list",'m',
                   PTIEF GetDefmessageHandlersListCmd,"GetDefmessageHandlersListCmd","02w");
   EnvDefineFunction2(theEnv,"slot-existp",'b',PTIEF SlotExistPCommand,"SlotExistPCommand","23w");
   EnvDefineFunction2(theEnv,"slot-facets",'m',PTIEF SlotFacetsCommand,"SlotFacetsCommand","22w");
   EnvDefineFunction2(theEnv,"slot-sources",'m',PTIEF SlotSourcesCommand,"SlotSourcesCommand","22w");
   EnvDefineFunction2(theEnv,"slot-types",'m',PTIEF SlotTypesCommand,"SlotTypesCommand","22w");
   EnvDefineFunction2(theEnv,"slot-allowed-values",'m',PTIEF SlotAllowedValuesCommand,"SlotAllowedValuesCommand","22w");
   EnvDefineFunction2(theEnv,"slot-allowed-classes",'m',PTIEF SlotAllowedClassesCommand,"SlotAllowedClassesCommand","22w");
   EnvDefineFunction2(theEnv,"slot-range",'m',PTIEF SlotRangeCommand,"SlotRangeCommand","22w");
   EnvDefineFunction2(theEnv,"slot-cardinality",'m',PTIEF SlotCardinalityCommand,"SlotCardinalityCommand","22w");
   EnvDefineFunction2(theEnv,"slot-writablep",'b',PTIEF SlotWritablePCommand,"SlotWritablePCommand","22w");
   EnvDefineFunction2(theEnv,"slot-initablep",'b',PTIEF SlotInitablePCommand,"SlotInitablePCommand","22w");
   EnvDefineFunction2(theEnv,"slot-publicp",'b',PTIEF SlotPublicPCommand,"SlotPublicPCommand","22w");
   EnvDefineFunction2(theEnv,"slot-direct-accessp",'b',PTIEF SlotDirectAccessPCommand,
                   "SlotDirectAccessPCommand","22w");
   EnvDefineFunction2(theEnv,"slot-default-value",'u',PTIEF SlotDefaultValueCommand,
                   "SlotDefaultValueCommand","22w");
   EnvDefineFunction2(theEnv,"defclass-module",'w',PTIEF GetDefclassModuleCommand,
                   "GetDefclassModuleCommand","11w");
   EnvDefineFunction2(theEnv,"get-class-defaults-mode", 'w', PTIEF GetClassDefaultsModeCommand,  "GetClassDefaultsModeCommand", "00");
   EnvDefineFunction2(theEnv,"set-class-defaults-mode", 'w', PTIEF SetClassDefaultsModeCommand,  "SetClassDefaultsModeCommand", "11w");
#endif

#if DEBUGGING_FUNCTIONS
   AddWatchItem(theEnv,"instances",0,&DefclassData(theEnv)->WatchInstances,75,DefclassWatchAccess,DefclassWatchPrint);
   AddWatchItem(theEnv,"slots",1,&DefclassData(theEnv)->WatchSlots,74,DefclassWatchAccess,DefclassWatchPrint);
#endif
  }

#if (! RUN_TIME)

/*********************************************************
  NAME         : AddSystemClass
  DESCRIPTION  : Performs all necessary allocations
                   for adding a system class
  INPUTS       : 1) The name-string of the system class
                 2) The address of the parent class
                    (NULL if none)
  RETURNS      : The address of the new system class
  SIDE EFFECTS : Allocations performed
  NOTES        : Assumes system-class name is unique
                 Also assumes SINGLE INHERITANCE for
                   system classes to simplify precedence
                   list determination
                 Adds classes to has table but NOT to
                  class list (this is responsibility
                  of caller)
 *********************************************************/
static DEFCLASS *AddSystemClass(
  void *theEnv,
  char *name,
  DEFCLASS *parent)
  {
   DEFCLASS *sys;
   long i;
   char defaultScopeMap[1];

   sys = NewClass(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,name));
   sys->abstract = 1;
#if DEFRULE_CONSTRUCT
   sys->reactive = 0;
#endif
   IncrementSymbolCount(sys->header.name);
   sys->installed = 1;
   sys->system = 1;
   sys->hashTableIndex = HashClass(sys->header.name);

   AddClassLink(theEnv,&sys->allSuperclasses,sys,-1);
   if (parent != NULL)
     {
      AddClassLink(theEnv,&sys->directSuperclasses,parent,-1);
      AddClassLink(theEnv,&parent->directSubclasses,sys,-1);
      AddClassLink(theEnv,&sys->allSuperclasses,parent,-1);
      for (i = 1 ; i < parent->allSuperclasses.classCount ; i++)
        AddClassLink(theEnv,&sys->allSuperclasses,parent->allSuperclasses.classArray[i],-1);
     }
   sys->nxtHash = DefclassData(theEnv)->ClassTable[sys->hashTableIndex];
   DefclassData(theEnv)->ClassTable[sys->hashTableIndex] = sys;

   /* =========================================
      Add default scope maps for a system class
      There is only one module (MAIN) so far -
      which has an id of 0
      ========================================= */
   ClearBitString((void *) defaultScopeMap,(int) sizeof(char));
   SetBitMap(defaultScopeMap,0);
#if DEFMODULE_CONSTRUCT
   sys->scopeMap = (BITMAP_HN *) AddBitMap(theEnv,(void *) defaultScopeMap,(int) sizeof(char));
   IncrementBitMapCount(sys->scopeMap);
#endif
   return(sys);
  }

/*****************************************************
  NAME         : AllocateModule
  DESCRIPTION  : Creates and initializes a
                 list of deffunctions for a new module
  INPUTS       : None
  RETURNS      : The new deffunction module
  SIDE EFFECTS : Deffunction module created
  NOTES        : None
 *****************************************************/
static void *AllocateModule(
  void *theEnv)
  {
   return((void *) get_struct(theEnv,defclassModule));
  }

/***************************************************
  NAME         : ReturnModule
  DESCRIPTION  : Removes a deffunction module and
                 all associated deffunctions
  INPUTS       : The deffunction module
  RETURNS      : Nothing useful
  SIDE EFFECTS : Module and deffunctions deleted
  NOTES        : None
 ***************************************************/
static void ReturnModule(
  void *theEnv,
  void *theItem)
  {
   FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefclassData(theEnv)->DefclassConstruct);
   DeleteSlotName(theEnv,FindIDSlotNameHash(theEnv,ISA_ID));
   DeleteSlotName(theEnv,FindIDSlotNameHash(theEnv,NAME_ID));
   rtn_struct(theEnv,defclassModule,theItem);
  }

#endif

#if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT

/***************************************************
  NAME         : UpdateDefclassesScope
  DESCRIPTION  : This function updates the scope
                 bitmaps for existing classes when
                 a new module is defined
  INPUTS       : None
  RETURNS      : Nothing
  SIDE EFFECTS : Class scope bitmaps are updated
  NOTES        : None
 ***************************************************/
static void UpdateDefclassesScope(
  void *theEnv)
  {
   register unsigned i;
   DEFCLASS *theDefclass;
   int newModuleID,count;
   char *newScopeMap;
   unsigned newScopeMapSize;
   char *className;
   struct defmodule *matchModule;

   newModuleID = (int) ((struct defmodule *) EnvGetCurrentModule(theEnv))->bsaveID;
   newScopeMapSize = (sizeof(char) * ((GetNumberOfDefmodules(theEnv) / BITS_PER_BYTE) + 1));
   newScopeMap = (char *) gm2(theEnv,newScopeMapSize);
   for (i = 0 ; i < CLASS_TABLE_HASH_SIZE ; i++)
     for (theDefclass = DefclassData(theEnv)->ClassTable[i] ;
          theDefclass != NULL ;
          theDefclass = theDefclass->nxtHash)
       {
        matchModule = theDefclass->header.whichModule->theModule;
        className = ValueToString(theDefclass->header.name);
        ClearBitString((void *) newScopeMap,newScopeMapSize);
        GenCopyMemory(char,theDefclass->scopeMap->size,
                   newScopeMap,ValueToBitMap(theDefclass->scopeMap));
        DecrementBitMapCount(theEnv,theDefclass->scopeMap);
        if (theDefclass->system)
          SetBitMap(newScopeMap,newModuleID);
        else if (FindImportedConstruct(theEnv,"defclass",matchModule,
                                       className,&count,TRUE,NULL) != NULL)
          SetBitMap(newScopeMap,newModuleID);
        theDefclass->scopeMap = (BITMAP_HN *) AddBitMap(theEnv,(void *) newScopeMap,newScopeMapSize);
        IncrementBitMapCount(theDefclass->scopeMap);
       }
   rm(theEnv,(void *) newScopeMap,newScopeMapSize);
  }

#endif

#endif