clipsruby 0.0.2

data/ext/clipsruby/classinf.c

@@ -0,0 +1,1245 @@
+   /*******************************************************/
+   /*      "C" Language Integrated Production System      */
+   /*                                                     */
+   /*            CLIPS Version 6.40  08/25/16             */
+   /*                                                     */
+   /*        CLASS INFO PROGRAMMATIC ACCESS MODULE        */
+   /*******************************************************/
+
+/**************************************************************/
+/* Purpose: Class Information Interface Support Routines      */
+/*                                                            */
+/* Principal Programmer(s):                                   */
+/*      Brian L. Dantes                                       */
+/*                                                            */
+/* Contributing Programmer(s):                                */
+/*                                                            */
+/* Revision History:                                          */
+/*                                                            */
+/*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859   */
+/*                                                            */
+/*            Changed name of variable exp to theExp          */
+/*            because of Unix compiler warnings of shadowed   */
+/*            definitions.                                    */
+/*                                                            */
+/*      6.24: Added allowed-classes slot facet.               */
+/*                                                            */
+/*            Converted INSTANCE_PATTERN_MATCHING to          */
+/*            DEFRULE_CONSTRUCT.                              */
+/*                                                            */
+/*            Renamed BOOLEAN macro type to intBool.          */
+/*                                                            */
+/*      6.30: Borland C (IBM_TBC) and Metrowerks CodeWarrior  */
+/*            (MAC_MCW, IBM_MCW) are no longer supported.     */
+/*                                                            */
+/*            Changed integer type/precision.                 */
+/*                                                            */
+/*            Added const qualifiers to remove C++            */
+/*            deprecation warnings.                           */
+/*                                                            */
+/*            Converted API macros to function calls.         */
+/*                                                            */
+/*      6.40: Added Env prefix to GetEvaluationError and     */
+/*            SetEvaluationError functions.                  */
+/*                                                           */
+/*            Pragma once and other inclusion changes.       */
+/*                                                           */
+/*            Added support for booleans with <stdbool.h>.   */
+/*                                                           */
+/*            Removed use of void pointers for specific      */
+/*            data structures.                               */
+/*                                                           */
+/*            ALLOW_ENVIRONMENT_GLOBALS no longer supported. */
+/*                                                           */
+/*            UDF redesign.                                  */
+/*                                                           */
+/**************************************************************/
+
+/* =========================================
+   *****************************************
+               EXTERNAL DEFINITIONS
+   =========================================
+   ***************************************** */
+#include "setup.h"
+
+#if OBJECT_SYSTEM
+
+#include <stdio.h>
+#include <string.h>
+
+#include "argacces.h"
+#include "classcom.h"
+#include "classexm.h"
+#include "classfun.h"
+#include "classini.h"
+#include "envrnmnt.h"
+#include "memalloc.h"
+#include "insfun.h"
+#include "msgcom.h"
+#include "msgfun.h"
+#include "multifld.h"
+#include "prntutil.h"
+
+#include "classinf.h"
+
+/***************************************/
+/* LOCAL INTERNAL FUNCTION DEFINITIONS */
+/***************************************/
+
+   static void                    SlotInfoSupportFunction(UDFContext *,UDFValue *,const char *,bool (*)(Defclass *,const char *,CLIPSValue *));
+   static unsigned                CountSubclasses(Defclass *,bool,int);
+   static unsigned                StoreSubclasses(Multifield *,unsigned,Defclass *,int,int,bool);
+   static SlotDescriptor         *SlotInfoSlot(Environment *,UDFValue *,Defclass *,const char *,const char *);
+
+/*********************************************************************
+  NAME         : ClassAbstractPCommand
+  DESCRIPTION  : Determines if direct instances of a class can be made
+  INPUTS       : None
+  RETURNS      : True (1) if class is abstract, false (0) if concrete
+  SIDE EFFECTS : None
+  NOTES        : Syntax: (class-abstractp <class>)
+ *********************************************************************/
+void ClassAbstractPCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   UDFValue theArg;
+   Defclass *cls;
+
+   if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg))
+     { return; }
+
+   cls = LookupDefclassByMdlOrScope(theEnv,theArg.lexemeValue->contents);
+   if (cls == NULL)
+     {
+      ClassExistError(theEnv,"class-abstractp",theArg.lexemeValue->contents);
+      returnValue->lexemeValue = FalseSymbol(theEnv);
+      return;
+     }
+
+   returnValue->lexemeValue = CreateBoolean(theEnv,(ClassAbstractP(cls)));
+  }
+
+#if DEFRULE_CONSTRUCT
+
+/*****************************************************************
+  NAME         : ClassReactivePCommand
+  DESCRIPTION  : Determines if instances of a class can match rule
+                 patterns
+  INPUTS       : None
+  RETURNS      : True (1) if class is reactive, false (0)
+                 if non-reactive
+  SIDE EFFECTS : None
+  NOTES        : Syntax: (class-reactivep <class>)
+ *****************************************************************/
+void ClassReactivePCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   UDFValue theArg;
+   Defclass *cls;
+
+   if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg))
+     { return; }
+
+   cls = LookupDefclassByMdlOrScope(theEnv,theArg.lexemeValue->contents);
+   if (cls == NULL)
+     {
+      ClassExistError(theEnv,"class-reactivep",theArg.lexemeValue->contents);
+      returnValue->lexemeValue = FalseSymbol(theEnv);
+      return;
+     }
+
+   returnValue->lexemeValue = CreateBoolean(theEnv,ClassReactiveP(cls));
+  }
+
+#endif
+
+/***********************************************************
+  NAME         : ClassInfoFnxArgs
+  DESCRIPTION  : Examines arguments for:
+                   class-slots, get-defmessage-handler-list,
+                   class-superclasses and class-subclasses
+  INPUTS       : 1) Name of function
+                 2) A buffer to hold a flag indicating if
+                    the inherit keyword was specified
+  RETURNS      : Pointer to the class on success,
+                   NULL on errors
+  SIDE EFFECTS : inhp flag set
+                 error flag set
+  NOTES        : None
+ ***********************************************************/
+Defclass *ClassInfoFnxArgs(
+  UDFContext *context,
+  const char *fnx,
+  bool *inhp)
+  {
+   Defclass *clsptr;
+   UDFValue theArg;
+   Environment *theEnv = context->environment;
+
+   *inhp = false;
+
+   if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg))
+     { return NULL; }
+
+   clsptr = LookupDefclassByMdlOrScope(theEnv,theArg.lexemeValue->contents);
+   if (clsptr == NULL)
+     {
+      ClassExistError(theEnv,fnx,theArg.lexemeValue->contents);
+      return NULL;
+     }
+
+   if (UDFHasNextArgument(context))
+     {
+      if (! UDFNextArgument(context,SYMBOL_BIT,&theArg))
+        { return NULL; }
+
+      if (strcmp(theArg.lexemeValue->contents,"inherit") == 0)
+        { *inhp = true; }
+      else
+        {
+         SyntaxErrorMessage(theEnv,fnx);
+         SetEvaluationError(theEnv,true);
+         return NULL;
+        }
+     }
+
+   return clsptr;
+  }
+
+/********************************************************************
+  NAME         : ClassSlotsCommand
+  DESCRIPTION  : Groups slot info for a class into a multifield value
+                   for dynamic perusal
+  INPUTS       : Data object buffer to hold the slots of the class
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Creates a multifield storing the names of
+                    the slots of the class
+  NOTES        : Syntax: (class-slots <class> [inherit])
+ ********************************************************************/
+void ClassSlotsCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   bool inhp;
+   Defclass *clsptr;
+   CLIPSValue result;
+
+   clsptr = ClassInfoFnxArgs(context,"class-slots",&inhp);
+   if (clsptr == NULL)
+     {
+      SetMultifieldErrorValue(theEnv,returnValue);
+      return;
+     }
+   ClassSlots(clsptr,&result,inhp);
+   CLIPSToUDFValue(&result,returnValue);
+  }
+
+/************************************************************************
+  NAME         : ClassSuperclassesCommand
+  DESCRIPTION  : Groups superclasses for a class into a multifield value
+                   for dynamic perusal
+  INPUTS       : Data object buffer to hold the superclasses of the class
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Creates a multifield storing the names of
+                    the superclasses of the class
+  NOTES        : Syntax: (class-superclasses <class> [inherit])
+ ************************************************************************/
+void ClassSuperclassesCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   bool inhp;
+   Defclass *clsptr;
+   CLIPSValue result;
+
+   clsptr = ClassInfoFnxArgs(context,"class-superclasses",&inhp);
+   if (clsptr == NULL)
+     {
+      SetMultifieldErrorValue(theEnv,returnValue);
+      return;
+     }
+   ClassSuperclasses(clsptr,&result,inhp);
+   CLIPSToUDFValue(&result,returnValue);
+  }
+
+/************************************************************************
+  NAME         : ClassSubclassesCommand
+  DESCRIPTION  : Groups subclasses for a class into a multifield value
+                   for dynamic perusal
+  INPUTS       : Data object buffer to hold the subclasses of the class
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Creates a multifield storing the names of
+                    the subclasses of the class
+  NOTES        : Syntax: (class-subclasses <class> [inherit])
+ ************************************************************************/
+void ClassSubclassesCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   bool inhp;
+   Defclass *clsptr;
+   CLIPSValue result;
+
+   clsptr = ClassInfoFnxArgs(context,"class-subclasses",&inhp);
+   if (clsptr == NULL)
+     {
+      SetMultifieldErrorValue(theEnv,returnValue);
+      return;
+     }
+   ClassSubclasses(clsptr,&result,inhp);
+   CLIPSToUDFValue(&result,returnValue);
+  }
+
+/***********************************************************************
+  NAME         : GetDefmessageHandlersListCmd
+  DESCRIPTION  : Groups message-handlers for a class into a multifield
+                   value for dynamic perusal
+  INPUTS       : Data object buffer to hold the handlers of the class
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Creates a multifield storing the names of
+                    the message-handlers of the class
+  NOTES        : Syntax: (get-defmessage-handler-list <class> [inherit])
+ ***********************************************************************/
+void GetDefmessageHandlersListCmd(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   bool inhp;
+   Defclass *clsptr;
+   CLIPSValue result;
+
+   if (! UDFHasNextArgument(context))
+     {
+      GetDefmessageHandlerList(theEnv,NULL,&result,false);
+      CLIPSToUDFValue(&result,returnValue);
+     }
+   else
+     {
+      clsptr = ClassInfoFnxArgs(context,"get-defmessage-handler-list",&inhp);
+      if (clsptr == NULL)
+        {
+         SetMultifieldErrorValue(theEnv,returnValue);
+         return;
+        }
+        
+      GetDefmessageHandlerList(theEnv,clsptr,&result,inhp);
+      CLIPSToUDFValue(&result,returnValue);
+     }
+  }
+
+/*********************************
+ Slot Information Access Functions
+ *********************************/
+void SlotFacetsCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   SlotInfoSupportFunction(context,returnValue,"slot-facets",SlotFacets);
+  }
+
+void SlotSourcesCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   SlotInfoSupportFunction(context,returnValue,"slot-sources",SlotSources);
+  }
+
+void SlotTypesCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   SlotInfoSupportFunction(context,returnValue,"slot-types",SlotTypes);
+  }
+
+void SlotAllowedValuesCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   SlotInfoSupportFunction(context,returnValue,"slot-allowed-values",SlotAllowedValues);
+  }
+
+void SlotAllowedClassesCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   SlotInfoSupportFunction(context,returnValue,"slot-allowed-classes",SlotAllowedClasses);
+  }
+
+void SlotRangeCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   SlotInfoSupportFunction(context,returnValue,"slot-range",SlotRange);
+  }
+
+void SlotCardinalityCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   SlotInfoSupportFunction(context,returnValue,"slot-cardinality",SlotCardinality);
+  }
+
+/********************************************************************
+  NAME         : ClassAbstractP
+  DESCRIPTION  : Determines if a class is abstract or not
+  INPUTS       : Generic pointer to class
+  RETURNS      : 1 if class is abstract, 0 otherwise
+  SIDE EFFECTS : None
+  NOTES        : None
+ ********************************************************************/
+bool ClassAbstractP(
+  Defclass *theDefclass)
+  {
+   return theDefclass->abstract;
+  }
+
+#if DEFRULE_CONSTRUCT
+
+/********************************************************************
+  NAME         : ClassReactiveP
+  DESCRIPTION  : Determines if a class is reactive or not
+  INPUTS       : Generic pointer to class
+  RETURNS      : 1 if class is reactive, 0 otherwise
+  SIDE EFFECTS : None
+  NOTES        : None
+ ********************************************************************/
+bool ClassReactiveP(
+  Defclass *theDefclass)
+  {
+   return theDefclass->reactive;
+  }
+
+#endif
+
+/********************************************************************
+  NAME         : ClassSlots
+  DESCRIPTION  : Groups slot info for a class into a multifield value
+                   for dynamic perusal
+  INPUTS       : 1) Generic pointer to class
+                 2) Data object buffer to hold the slots of the class
+                 3) Include (1) or exclude (0) inherited slots
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Creates a multifield storing the names of
+                    the slots of the class
+  NOTES        : None
+ ********************************************************************/
+void ClassSlots(
+  Defclass *theDefclass,
+  CLIPSValue *returnValue,
+  bool inhp)
+  {
+   size_t size;
+   unsigned i;
+   Environment *theEnv = theDefclass->header.env;
+
+   size = inhp ? theDefclass->instanceSlotCount : theDefclass->slotCount;
+
+   returnValue->value = CreateMultifield(theEnv,size);
+
+   if (size == 0)
+     { return; }
+
+   if (inhp)
+     {
+      for (i = 0 ; i < theDefclass->instanceSlotCount ; i++)
+        {
+         returnValue->multifieldValue->contents[i].value =
+            theDefclass->instanceTemplate[i]->slotName->name;
+        }
+     }
+   else
+     {
+      for (i = 0 ; i < theDefclass->slotCount ; i++)
+        {
+         returnValue->multifieldValue->contents[i].value =
+            theDefclass->slots[i].slotName->name;
+        }
+     }
+  }
+
+/************************************************************************
+  NAME         : GetDefmessageHandlerList
+  DESCRIPTION  : Groups handler info for a class into a multifield value
+                   for dynamic perusal
+  INPUTS       : 1) Generic pointer to class (NULL to get handlers for
+                    all classes)
+                 2) Data object buffer to hold the handlers of the class
+                 3) Include (1) or exclude (0) inherited handlers
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Creates a multifield storing the names and types of
+                    the message-handlers of the class
+  NOTES        : None
+ ************************************************************************/
+void GetDefmessageHandlerList(
+  Environment *theEnv,
+  Defclass *theDefclass,
+  CLIPSValue *returnValue,
+  bool inhp)
+  {
+   Defclass *cls,*svcls,*svnxt,*supcls;
+   long j;
+   unsigned long classi, classiLimit;
+   unsigned long i, sublen, len;
+
+   if (theDefclass == NULL)
+     {
+      inhp = 0;
+      cls = GetNextDefclass(theEnv,NULL);
+      svnxt = GetNextDefclass(theEnv,cls);
+     }
+   else
+     {
+      cls = theDefclass;
+      svnxt = GetNextDefclass(theEnv,theDefclass);
+      SetNextDefclass(cls,NULL);
+     }
+
+   for (svcls = cls , i = 0 ;
+        cls != NULL ;
+        cls = GetNextDefclass(theEnv,cls))
+     {
+      classiLimit = inhp ? cls->allSuperclasses.classCount : 1;
+      for (classi = 0 ; classi < classiLimit ; classi++)
+        { i += cls->allSuperclasses.classArray[classi]->handlerCount; }
+     }
+
+   len = i * 3;
+
+   returnValue->value = CreateMultifield(theEnv,len);
+
+   for (cls = svcls , sublen = 0 ;
+        cls != NULL ;
+        cls = GetNextDefclass(theEnv,cls))
+     {
+      classiLimit = inhp ? cls->allSuperclasses.classCount : 1;
+      for (classi = 0 ; classi < classiLimit ; classi++)
+        {
+         supcls = cls->allSuperclasses.classArray[classi];
+
+         if (inhp == 0)
+           { i = sublen; }
+         else
+           { i = len - (supcls->handlerCount * 3) - sublen; }
+
+         for (j = 0 ; j < supcls->handlerCount ; j++)
+           {
+            returnValue->multifieldValue->contents[i++].value = GetDefclassNamePointer(supcls);
+            returnValue->multifieldValue->contents[i++].value = supcls->handlers[j].header.name;
+            returnValue->multifieldValue->contents[i++].value = CreateSymbol(theEnv,MessageHandlerData(theEnv)->hndquals[supcls->handlers[j].type]);
+           }
+
+         sublen += supcls->handlerCount * 3;
+        }
+     }
+
+   if (svcls != NULL)
+     { SetNextDefclass(svcls,svnxt); }
+  }
+
+/***************************************************************************
+  NAME         : ClassSuperclasses
+  DESCRIPTION  : Groups the names of superclasses into a multifield
+                   value for dynamic perusal
+  INPUTS       : 1) Generic pointer to class
+                 2) Data object buffer to hold the superclasses of the class
+                 3) Include (1) or exclude (0) indirect superclasses
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Creates a multifield storing the names of
+                    the superclasses of the class
+  NOTES        : None
+ ***************************************************************************/
+void ClassSuperclasses(
+  Defclass *theDefclass,
+  CLIPSValue *returnValue,
+  bool inhp)
+  {
+   PACKED_CLASS_LINKS *plinks;
+   unsigned offset;
+   unsigned long i, j;
+   Environment *theEnv = theDefclass->header.env;
+   
+   if (inhp)
+     {
+      plinks = &theDefclass->allSuperclasses;
+      offset = 1;
+     }
+   else
+     {
+      plinks = &theDefclass->directSuperclasses;
+      offset = 0;
+     }
+
+   returnValue->value = CreateMultifield(theEnv,(plinks->classCount - offset));
+
+   if (returnValue->multifieldValue->length == 0)
+     { return; }
+
+   for (i = offset, j = 0 ; i < plinks->classCount; i++, j++)
+     {
+      returnValue->multifieldValue->contents[j].value = GetDefclassNamePointer(plinks->classArray[i]);
+     }
+  }
+
+/**************************************************************************
+  NAME         : ClassSubclasses
+  DESCRIPTION  : Groups the names of subclasses for a class into a
+                   multifield value for dynamic perusal
+  INPUTS       : 1) Generic pointer to class
+                 2) Data object buffer to hold the sublclasses of the class
+                 3) Include (1) or exclude (0) indirect subclasses
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Creates a multifield storing the names
+                    the subclasses of the class
+  NOTES        : None
+ **************************************************************************/
+void ClassSubclasses(
+  Defclass *theDefclass,
+  CLIPSValue *returnValue,
+  bool inhp)
+  {
+   unsigned i;
+   int id;
+   Environment *theEnv = theDefclass->header.env;
+
+   if ((id = GetTraversalID(theEnv)) == -1)
+     { return; }
+
+   i = CountSubclasses(theDefclass,inhp,id);
+
+   ReleaseTraversalID(theEnv);
+
+   returnValue->value = CreateMultifield(theEnv,i);
+
+   if (i == 0)
+     { return; }
+
+   if ((id = GetTraversalID(theEnv)) == -1)
+     { return; }
+
+   StoreSubclasses(returnValue->multifieldValue,0,theDefclass,inhp,id,true);
+   ReleaseTraversalID(theEnv);
+  }
+
+/**************************************************************************
+  NAME         : ClassSubclassAddresses
+  DESCRIPTION  : Groups the class addresses of subclasses for a class into a
+                   multifield value for dynamic perusal
+  INPUTS       : 1) Generic pointer to class
+                 2) Data object buffer to hold the sublclasses of the class
+                 3) Include (1) or exclude (0) indirect subclasses
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Creates a multifield storing the subclass
+                    addresss of the class
+  NOTES        : None
+ **************************************************************************/
+void ClassSubclassAddresses(
+  Environment *theEnv,
+  Defclass *theDefclass,
+  UDFValue *returnValue,
+  bool inhp)
+  {
+   unsigned i;
+   int id;
+
+   if ((id = GetTraversalID(theEnv)) == -1)
+     { return; }
+
+   i = CountSubclasses(theDefclass,inhp,id);
+
+   ReleaseTraversalID(theEnv);
+
+   returnValue->begin = 0;
+   returnValue->range = i;
+   returnValue->value = CreateMultifield(theEnv,i);
+
+   if (i == 0)
+     { return; }
+
+   if ((id = GetTraversalID(theEnv)) == -1)
+     { return; }
+
+   StoreSubclasses(returnValue->multifieldValue,0,theDefclass,inhp,id,false);
+   ReleaseTraversalID(theEnv);
+  }
+/**************************************************************************
+  NAME         : Slot...  Slot information access functions
+  DESCRIPTION  : Groups the sources/facets/types/allowed-values/range or
+                   cardinality  of a slot for a class into a multifield
+                   value for dynamic perusal
+  INPUTS       : 1) Generic pointer to class
+                 2) Name of the slot
+                 3) Data object buffer to hold the attributes of the class
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Creates a multifield storing the attributes for the slot
+                   of the class
+  NOTES        : None
+ **************************************************************************/
+
+/**************/
+/* SlotFacets */
+/**************/
+bool SlotFacets(
+  Defclass *theDefclass,
+  const char *sname,
+  CLIPSValue *returnValue)
+  {
+   SlotDescriptor *sp;
+   UDFValue result;
+   Environment *theEnv = theDefclass->header.env;
+
+   if ((sp = SlotInfoSlot(theEnv,&result,theDefclass,sname,"slot-facets")) == NULL)
+     {
+      NormalizeMultifield(theEnv,&result);
+      returnValue->value = result.value;
+      return false;
+     }
+
+#if DEFRULE_CONSTRUCT
+   returnValue->value = CreateMultifield(theEnv,10L);
+#else
+   returnValue->value = CreateMultifield(theEnv,9L);
+#endif
+
+   if (sp->multiple)
+     { returnValue->multifieldValue->contents[0].lexemeValue = CreateSymbol(theEnv,"MLT"); }
+   else
+     { returnValue->multifieldValue->contents[0].lexemeValue = CreateSymbol(theEnv,"SGL"); }
+
+   if (sp->noDefault)
+     returnValue->multifieldValue->contents[1].lexemeValue = CreateSymbol(theEnv,"NIL");
+   else
+     {
+      if (sp->dynamicDefault)
+        { returnValue->multifieldValue->contents[1].lexemeValue = CreateSymbol(theEnv,"DYN"); }
+      else
+        { returnValue->multifieldValue->contents[1].lexemeValue = CreateSymbol(theEnv,"STC"); }
+     }
+
+   if (sp->noInherit)
+     returnValue->multifieldValue->contents[2].lexemeValue = CreateSymbol(theEnv,"NIL");
+   else
+     returnValue->multifieldValue->contents[2].lexemeValue = CreateSymbol(theEnv,"INH");
+
+   if (sp->initializeOnly)
+     returnValue->multifieldValue->contents[3].lexemeValue = CreateSymbol(theEnv,"INT");
+   else if (sp->noWrite)
+     returnValue->multifieldValue->contents[3].lexemeValue = CreateSymbol(theEnv,"R");
+   else
+     returnValue->multifieldValue->contents[3].lexemeValue = CreateSymbol(theEnv,"RW");
+
+   if (sp->shared)
+     returnValue->multifieldValue->contents[4].lexemeValue = CreateSymbol(theEnv,"SHR");
+   else
+     returnValue->multifieldValue->contents[4].lexemeValue = CreateSymbol(theEnv,"LCL");
+
+#if DEFRULE_CONSTRUCT
+   if (sp->reactive)
+     returnValue->multifieldValue->contents[5].lexemeValue = CreateSymbol(theEnv,"RCT");
+   else
+     returnValue->multifieldValue->contents[5].lexemeValue = CreateSymbol(theEnv,"NIL");
+
+   if (sp->composite)
+     returnValue->multifieldValue->contents[6].lexemeValue = CreateSymbol(theEnv,"CMP");
+   else
+     returnValue->multifieldValue->contents[6].lexemeValue = CreateSymbol(theEnv,"EXC");
+
+   if (sp->publicVisibility)
+     returnValue->multifieldValue->contents[7].lexemeValue = CreateSymbol(theEnv,"PUB");
+   else
+     returnValue->multifieldValue->contents[7].lexemeValue = CreateSymbol(theEnv,"PRV");
+
+   returnValue->multifieldValue->contents[8].lexemeValue = CreateSymbol(theEnv,GetCreateAccessorString(sp));
+   returnValue->multifieldValue->contents[9].lexemeValue = (sp->noWrite ? CreateSymbol(theEnv,"NIL") : sp->overrideMessage);
+#else
+   if (sp->composite)
+     returnValue->multifieldValue->contents[5].lexemeValue = CreateSymbol(theEnv,"CMP");
+   else
+     returnValue->multifieldValue->contents[5].lexemeValue = CreateSymbol(theEnv,"EXC");
+
+   if (sp->publicVisibility)
+     returnValue->multifieldValue->contents[6].lexemeValue = CreateSymbol(theEnv,"PUB");
+   else
+     returnValue->multifieldValue->contents[6].lexemeValue = CreateSymbol(theEnv,"PRV");
+
+   returnValue->multifieldValue->contents[7].lexemeValue = CreateSymbol(theEnv,GetCreateAccessorString(sp));
+   returnValue->multifieldValue->contents[8].lexemeValue = (sp->noWrite ? CreateSymbol(theEnv,"NIL") : sp->overrideMessage);
+#endif
+
+   return true;
+  }
+
+/***************/
+/* SlotSources */
+/***************/
+bool SlotSources(
+  Defclass *theDefclass,
+  const char *sname,
+  CLIPSValue *returnValue)
+  {
+   unsigned i;
+   unsigned classi;
+   SlotDescriptor *sp, *csp;
+   CLASS_LINK *ctop,*ctmp;
+   Defclass *cls;
+   UDFValue result;
+   Environment *theEnv = theDefclass->header.env;
+
+   if ((sp = SlotInfoSlot(theEnv,&result,theDefclass,sname,"slot-sources")) == NULL)
+     {
+      NormalizeMultifield(theEnv,&result);
+      returnValue->value = result.value;
+      return false;
+     }
+   i = 1;
+   ctop = get_struct(theEnv,classLink);
+   ctop->cls = sp->cls;
+   ctop->nxt = NULL;
+   if (sp->composite)
+     {
+      for (classi = 1 ; classi < sp->cls->allSuperclasses.classCount ; classi++)
+        {
+         cls = sp->cls->allSuperclasses.classArray[classi];
+         csp = FindClassSlot(cls,sp->slotName->name);
+         if ((csp != NULL) ? (csp->noInherit == 0) : false)
+           {
+            ctmp = get_struct(theEnv,classLink);
+            ctmp->cls = cls;
+            ctmp->nxt = ctop;
+            ctop = ctmp;
+            i++;
+            if (csp->composite == 0)
+              break;
+           }
+        }
+     }
+
+   returnValue->value = CreateMultifield(theEnv,i);
+   for (ctmp = ctop , i = 0 ; ctmp != NULL ; ctmp = ctmp->nxt , i++)
+     {
+      returnValue->multifieldValue->contents[i].value = GetDefclassNamePointer(ctmp->cls);
+     }
+   DeleteClassLinks(theEnv,ctop);
+   
+   return true;
+  }
+
+/*************/
+/* SlotTypes */
+/*************/
+bool SlotTypes(
+  Defclass *theDefclass,
+  const char *sname,
+  CLIPSValue *returnValue)
+  {
+   unsigned i,j;
+   SlotDescriptor *sp;
+   char typemap[2];
+   unsigned msize;
+   UDFValue result;
+   Environment *theEnv = theDefclass->header.env;
+   
+   if ((sp = SlotInfoSlot(theEnv,&result,theDefclass,sname,"slot-types")) == NULL)
+     {
+      NormalizeMultifield(theEnv,&result);
+      returnValue->value = result.value;
+      return false;
+     }
+     
+   if ((sp->constraint != NULL) ? sp->constraint->anyAllowed : true)
+     {
+      typemap[0] = typemap[1] = (char) 0xFF;
+      ClearBitMap(typemap,MULTIFIELD_TYPE);
+      msize = 8;
+     }
+   else
+     {
+      typemap[0] = typemap[1] = (char) 0x00;
+      msize = 0;
+      if (sp->constraint->symbolsAllowed)
+        {
+         msize++;
+         SetBitMap(typemap,SYMBOL_TYPE);
+        }
+      if (sp->constraint->stringsAllowed)
+        {
+         msize++;
+         SetBitMap(typemap,STRING_TYPE);
+        }
+      if (sp->constraint->floatsAllowed)
+        {
+         msize++;
+         SetBitMap(typemap,FLOAT_TYPE);
+        }
+      if (sp->constraint->integersAllowed)
+        {
+         msize++;
+         SetBitMap(typemap,INTEGER_TYPE);
+        }
+      if (sp->constraint->instanceNamesAllowed)
+        {
+         msize++;
+         SetBitMap(typemap,INSTANCE_NAME_TYPE);
+        }
+      if (sp->constraint->instanceAddressesAllowed)
+        {
+         msize++;
+         SetBitMap(typemap,INSTANCE_ADDRESS_TYPE);
+        }
+      if (sp->constraint->externalAddressesAllowed)
+        {
+         msize++;
+         SetBitMap(typemap,EXTERNAL_ADDRESS_TYPE);
+        }
+      if (sp->constraint->factAddressesAllowed)
+        {
+         msize++;
+         SetBitMap(typemap,FACT_ADDRESS_TYPE);
+        }
+     }
+
+   returnValue->value = CreateMultifield(theEnv,msize);
+   i = 0;
+   j = 0;
+   while (i < msize)
+     {
+      if (TestBitMap(typemap,j))
+       {
+        returnValue->multifieldValue->contents[i].value =
+                   GetDefclassNamePointer(DefclassData(theEnv)->PrimitiveClassMap[j]);
+        i++;
+       }
+      j++;
+     }
+     
+   return true;
+  }
+
+/*********************/
+/* SlotAllowedValues */
+/*********************/
+bool SlotAllowedValues(
+  Defclass *theDefclass,
+  const char *sname,
+  CLIPSValue *returnValue)
+  {
+   int i;
+   SlotDescriptor *sp;
+   Expression *theExp;
+   UDFValue result;
+   Environment *theEnv = theDefclass->header.env;
+
+   if ((sp = SlotInfoSlot(theEnv,&result,theDefclass,sname,"slot-allowed-values")) == NULL)
+     {
+      NormalizeMultifield(theEnv,&result);
+      returnValue->value = result.value;
+      return false;
+     }
+
+   if ((sp->constraint != NULL) ? (sp->constraint->restrictionList == NULL) : true)
+     {
+      returnValue->value = FalseSymbol(theEnv);
+      return true;
+     }
+
+   returnValue->value = CreateMultifield(theEnv,ExpressionSize(sp->constraint->restrictionList));
+   i = 0;
+   theExp = sp->constraint->restrictionList;
+   while (theExp != NULL)
+     {
+      returnValue->multifieldValue->contents[i].value = theExp->value;
+      theExp = theExp->nextArg;
+      i++;
+     }
+     
+   return true;
+  }
+
+/**********************/
+/* SlotAllowedClasses */
+/**********************/
+bool SlotAllowedClasses(
+  Defclass *theDefclass,
+  const char *sname,
+  CLIPSValue *returnValue)
+  {
+   int i;
+   SlotDescriptor *sp;
+   Expression *theExp;
+   UDFValue result;
+   Environment *theEnv = theDefclass->header.env;
+
+   if ((sp = SlotInfoSlot(theEnv,&result,theDefclass,sname,"slot-allowed-classes")) == NULL)
+     {
+      NormalizeMultifield(theEnv,&result);
+      returnValue->value = result.value;
+      return false;
+     }
+   if ((sp->constraint != NULL) ? (sp->constraint->classList == NULL) : true)
+     {
+      returnValue->value = FalseSymbol(theEnv);
+      return true;
+     }
+   returnValue->value = CreateMultifield(theEnv,ExpressionSize(sp->constraint->classList));
+   i = 0;
+   theExp = sp->constraint->classList;
+   while (theExp != NULL)
+     {
+      returnValue->multifieldValue->contents[i].value = theExp->value;
+      theExp = theExp->nextArg;
+      i++;
+     }
+     
+   return true;
+  }
+
+/*************/
+/* SlotRange */
+/*************/
+bool SlotRange(
+  Defclass *theDefclass,
+  const char *sname,
+  CLIPSValue *returnValue)
+  {
+   SlotDescriptor *sp;
+   UDFValue result;
+   Environment *theEnv = theDefclass->header.env;
+
+   if ((sp = SlotInfoSlot(theEnv,&result,theDefclass,sname,"slot-range")) == NULL)
+     {
+      NormalizeMultifield(theEnv,&result);
+      returnValue->value = result.value;
+      return false;
+     }
+   if ((sp->constraint == NULL) ? false :
+       (sp->constraint->anyAllowed || sp->constraint->floatsAllowed ||
+        sp->constraint->integersAllowed))
+     {
+      returnValue->value = CreateMultifield(theEnv,2L);
+      returnValue->multifieldValue->contents[0].value = sp->constraint->minValue->value;
+      returnValue->multifieldValue->contents[1].value = sp->constraint->maxValue->value;
+     }
+   else
+     {
+      returnValue->value = FalseSymbol(theEnv);
+     }
+   return true;
+  }
+
+/*******************/
+/* SlotCardinality */
+/*******************/
+bool SlotCardinality(
+  Defclass *theDefclass,
+  const char *sname,
+  CLIPSValue *returnValue)
+  {
+   SlotDescriptor *sp;
+   UDFValue result;
+   Environment *theEnv = theDefclass->header.env;
+     
+   if ((sp = SlotInfoSlot(theEnv,&result,theDefclass,sname,"slot-cardinality")) == NULL)
+     {
+      NormalizeMultifield(theEnv,&result);
+      returnValue->value = result.value;
+      return false;
+     }
+     
+   if (sp->multiple == 0)
+     {
+      returnValue->multifieldValue = CreateMultifield(theEnv,0L);
+      return true;
+     }
+
+   returnValue->value = CreateMultifield(theEnv,2L);
+   if (sp->constraint != NULL)
+     {
+      returnValue->multifieldValue->contents[0].value = sp->constraint->minFields->value;
+      returnValue->multifieldValue->contents[1].value = sp->constraint->maxFields->value;
+     }
+   else
+     {
+      returnValue->multifieldValue->contents[0].value = SymbolData(theEnv)->Zero;
+      returnValue->multifieldValue->contents[1].value = SymbolData(theEnv)->PositiveInfinity;
+     }
+     
+   return true;
+  }
+
+/* =========================================
+   *****************************************
+          INTERNALLY VISIBLE FUNCTIONS
+   =========================================
+   ***************************************** */
+
+/*****************************************************
+  NAME         : SlotInfoSupportFunction
+  DESCRIPTION  : Support routine for slot-sources,
+                   slot-facets, et. al.
+  INPUTS       : 1) Data object buffer
+                 2) Name of the H/L caller
+                 3) Pointer to support function to call
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Support function called and data
+                  object buffer set
+  NOTES        : None
+ *****************************************************/
+static void SlotInfoSupportFunction(
+  UDFContext *context,
+  UDFValue *returnValue,
+  const char *fnxname,
+  bool (*fnx)(Defclass *,const char *,CLIPSValue *))
+  {
+   CLIPSLexeme *ssym;
+   Defclass *cls;
+   CLIPSValue result;
+
+   ssym = CheckClassAndSlot(context,fnxname,&cls);
+   if (ssym == NULL)
+     {
+      SetMultifieldErrorValue(context->environment,returnValue);
+      return;
+     }
+   (*fnx)(cls,ssym->contents,&result);
+   CLIPSToUDFValue(&result,returnValue);
+  }
+
+/*****************************************************************
+  NAME         : CountSubclasses
+  DESCRIPTION  : Counts the number of direct or indirect
+                   subclasses for a class
+  INPUTS       : 1) Address of class
+                 2) Include (1) or exclude (0) indirect subclasses
+                 3) Traversal id
+  RETURNS      : The number of subclasses
+  SIDE EFFECTS : None
+  NOTES        : None
+ *****************************************************************/
+static unsigned CountSubclasses(
+  Defclass *cls,
+  bool inhp,
+  int tvid)
+  {
+   unsigned i, cnt;
+   Defclass *subcls;
+
+   for (cnt = 0 , i = 0 ; i < cls->directSubclasses.classCount ; i++)
+     {
+      subcls = cls->directSubclasses.classArray[i];
+      if (TestTraversalID(subcls->traversalRecord,tvid) == 0)
+        {
+         cnt++;
+         SetTraversalID(subcls->traversalRecord,tvid);
+         if (inhp && (subcls->directSubclasses.classCount != 0))
+           cnt += CountSubclasses(subcls,inhp,tvid);
+        }
+     }
+   return cnt;
+  }
+
+/*********************************************************************
+  NAME         : StoreSubclasses
+  DESCRIPTION  : Stores the names of direct or indirect
+                   subclasses for a class in a mutlifield
+  INPUTS       : 1) Caller's multifield buffer
+                 2) Starting index
+                 3) Address of the class
+                 4) Include (1) or exclude (0) indirect subclasses
+                 5) Traversal id
+  RETURNS      : The number of subclass names stored in the multifield
+  SIDE EFFECTS : Multifield set with subclass names
+  NOTES        : Assumes multifield is big enough to hold subclasses
+ *********************************************************************/
+static unsigned StoreSubclasses(
+  Multifield *mfval,
+  unsigned si,
+  Defclass *cls,
+  int inhp,
+  int tvid,
+  bool storeName)
+  {
+   unsigned i, classi;
+   Defclass *subcls;
+
+   for (i = si , classi = 0 ; classi < cls->directSubclasses.classCount ; classi++)
+     {
+      subcls = cls->directSubclasses.classArray[classi];
+      if (TestTraversalID(subcls->traversalRecord,tvid) == 0)
+        {
+         SetTraversalID(subcls->traversalRecord,tvid);
+         if (storeName)
+           {
+            mfval->contents[i++].value = GetDefclassNamePointer(subcls);
+           }
+         else
+           {
+            mfval->contents[i++].value = subcls;
+           }
+
+         if (inhp && (subcls->directSubclasses.classCount != 0))
+           i += StoreSubclasses(mfval,i,subcls,inhp,tvid,storeName);
+        }
+     }
+   return i - si;
+  }
+
+/*********************************************************
+  NAME         : SlotInfoSlot
+  DESCRIPTION  : Runtime support routine for slot-sources,
+                   slot-facets, et. al. which looks up
+                   a slot
+  INPUTS       : 1) Data object buffer
+                 2) Class pointer
+                 3) Name-string of slot to find
+                 4) The name of the calling function
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Support function called and data object
+                  buffer initialized
+  NOTES        : None
+ *********************************************************/
+static SlotDescriptor *SlotInfoSlot(
+  Environment *theEnv,
+  UDFValue *returnValue,
+  Defclass *cls,
+  const char *sname,
+  const char *fnxname)
+  {
+   CLIPSLexeme *ssym;
+   int i;
+
+   if ((ssym = FindSymbolHN(theEnv,sname,SYMBOL_BIT)) == NULL)
+     {
+      SetEvaluationError(theEnv,true);
+      SetMultifieldErrorValue(theEnv,returnValue);
+      return NULL;
+     }
+     
+   i = FindInstanceTemplateSlot(theEnv,cls,ssym);
+   if (i == -1)
+     {
+      SlotExistError(theEnv,sname,fnxname);
+      SetEvaluationError(theEnv,true);
+      SetMultifieldErrorValue(theEnv,returnValue);
+      return NULL;
+     }
+     
+   returnValue->begin = 0;
+   
+   return cls->instanceTemplate[i];
+  }
+
+#endif