clipsruby 0.0.2

data/ext/clipsruby/genrccom.c

@@ -0,0 +1,2017 @@
+   /*******************************************************/
+   /*      "C" Language Integrated Production System      */
+   /*                                                     */
+   /*            CLIPS Version 6.40  02/19/20             */
+   /*                                                     */
+   /*                                                     */
+   /*******************************************************/
+
+/*************************************************************/
+/* Purpose: Generic Functions Interface Routines             */
+/*                                                           */
+/* Principal Programmer(s):                                  */
+/*      Brian L. Dantes                                      */
+/*                                                           */
+/* 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.                              */
+/*                                                           */
+/*      6.30: Removed conditional code for unsupported       */
+/*            compilers/operating systems (IBM_MCW,          */
+/*            MAC_MCW, and IBM_TBC).                         */
+/*                                                           */
+/*            Changed integer type/precision.                */
+/*                                                           */
+/*            Added const qualifiers to remove C++           */
+/*            deprecation warnings.                          */
+/*                                                           */
+/*            Converted API macros to function calls.        */
+/*                                                           */
+/*            Fixed linkage issue when DEBUGGING_FUNCTIONS   */
+/*            is set to 0 and PROFILING_FUNCTIONS is set to  */
+/*            1.                                             */
+/*                                                           */
+/*            Changed find construct functionality so that   */
+/*            imported modules are search when locating a    */
+/*            named construct.                               */
+/*                                                           */
+/*            Added code to keep track of pointers to        */
+/*            constructs that are contained externally to    */
+/*            to constructs, DanglingConstructs.             */
+/*                                                           */
+/*      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.                                  */
+/*                                                           */
+/*            Pretty print functions accept optional logical */
+/*            name argument.                                 */
+/*                                                           */
+/*************************************************************/
+
+/* =========================================
+   *****************************************
+               EXTERNAL DEFINITIONS
+   =========================================
+   ***************************************** */
+#include "setup.h"
+
+#if DEFGENERIC_CONSTRUCT
+
+#include <string.h>
+
+#include "argacces.h"
+#if BLOAD || BLOAD_AND_BSAVE
+#include "bload.h"
+#endif
+#if OBJECT_SYSTEM
+#include "classcom.h"
+#include "inscom.h"
+#endif
+#include "constrct.h"
+#include "cstrccom.h"
+#include "cstrcpsr.h"
+#include "envrnmnt.h"
+#include "evaluatn.h"
+#include "extnfunc.h"
+#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
+#include "genrcbin.h"
+#endif
+#if CONSTRUCT_COMPILER
+#include "genrccmp.h"
+#endif
+#include "genrcexe.h"
+#if (! BLOAD_ONLY) && (! RUN_TIME)
+#include "genrcpsr.h"
+#endif
+#include "memalloc.h"
+#include "modulpsr.h"
+#include "modulutl.h"
+#include "multifld.h"
+#include "router.h"
+#include "strngrtr.h"
+#if DEBUGGING_FUNCTIONS
+#include "watch.h"
+#endif
+#include "prntutil.h"
+
+#include "genrccom.h"
+
+/* =========================================
+   *****************************************
+      INTERNALLY VISIBLE FUNCTION HEADERS
+   =========================================
+   ***************************************** */
+
+   static void                    PrintGenericCall(Environment *,const char *,Defgeneric *);
+   static bool                    EvaluateGenericCall(Environment *,Defgeneric *,UDFValue *);
+   static void                    DecrementGenericBusyCount(Environment *,Defgeneric *);
+   static void                    IncrementGenericBusyCount(Environment *,Defgeneric *);
+   static void                    DeallocateDefgenericData(Environment *);
+
+#if ! RUN_TIME
+   static void                    DestroyDefgenericAction(Environment *,ConstructHeader *,void *);
+#endif
+
+#if (! BLOAD_ONLY) && (! RUN_TIME)
+
+   static void                    SaveDefgenerics(Environment *,Defmodule *,const char *,void *);
+   static void                    SaveDefmethods(Environment *,Defmodule *,const char *,void *);
+   static void                    SaveDefmethodsForDefgeneric(Environment *,ConstructHeader *,void *);
+   static void                    RemoveDefgenericMethod(Environment *,Defgeneric *,unsigned short);
+
+#endif
+
+#if DEBUGGING_FUNCTIONS
+   static unsigned short          ListMethodsForGeneric(Environment *,const char *,Defgeneric *);
+   static bool                    DefgenericWatchAccess(Environment *,int,bool,Expression *);
+   static bool                    DefgenericWatchPrint(Environment *,const char *,int,Expression *);
+   static bool                    DefmethodWatchAccess(Environment *,int,bool,Expression *);
+   static bool                    DefmethodWatchPrint(Environment *,const char *,int,Expression *);
+   static bool                    DefmethodWatchSupport(Environment *,const char *,const char *,bool,
+                                                        void (*)(Environment *,const char *,Defgeneric *,unsigned short),
+                                                        void (*)(Defgeneric *,unsigned short,bool),
+                                                        Expression *);
+   static void                    PrintMethodWatchFlag(Environment *,const char *,Defgeneric *,unsigned short);
+#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
+ ***********************************************************/
+void SetupGenericFunctions(
+  Environment *theEnv)
+  {
+   EntityRecord genericEntityRecord =
+                     { "GCALL", GCALL,0,0,1,
+                       (EntityPrintFunction *) PrintGenericCall,
+                       (EntityPrintFunction *) PrintGenericCall,
+                       NULL,
+                       (EntityEvaluationFunction *) EvaluateGenericCall,
+                       NULL,
+                       (EntityBusyCountFunction *) DecrementGenericBusyCount,
+                       (EntityBusyCountFunction *) 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
+                                    (FindConstructFunction *) FindDefgenericInModule);
+
+   DefgenericData(theEnv)->DefgenericConstruct =  AddConstruct(theEnv,"defgeneric","defgenerics",
+#if (! BLOAD_ONLY) && (! RUN_TIME)
+                                       ParseDefgeneric,
+#else
+                                       NULL,
+#endif
+                                       (FindConstructFunction *) FindDefgeneric,
+                                       GetConstructNamePointer,GetConstructPPForm,
+                                       GetConstructModuleItem,
+                                       (GetNextConstructFunction *) GetNextDefgeneric,
+                                       SetNextConstruct,
+                                       (IsConstructDeletableFunction *) DefgenericIsDeletable,
+                                       (DeleteConstructFunction *) Undefgeneric,
+#if (! BLOAD_ONLY) && (! RUN_TIME)
+                                       (FreeConstructFunction *) RemoveDefgeneric
+#else
+                                       NULL
+#endif
+                                       );
+
+
+#if ! RUN_TIME
+   AddClearReadyFunction(theEnv,"defgeneric",ClearDefgenericsReady,0,NULL);
+
+#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_TOKEN);
+#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,NULL);
+   AddSaveFunction(theEnv,"defmethod",SaveDefmethods,-1000,NULL);
+   AddUDF(theEnv,"undefgeneric","v",1,1,"y",UndefgenericCommand,"UndefgenericCommand",NULL);
+   AddUDF(theEnv,"undefmethod","v",2,2,"*;y;ly",UndefmethodCommand,"UndefmethodCommand",NULL);
+#endif
+
+   AddUDF(theEnv,"call-next-method","*",0,0,NULL,CallNextMethod,"CallNextMethod",NULL);
+   FuncSeqOvlFlags(theEnv,"call-next-method",true,false);
+   AddUDF(theEnv,"call-specific-method","*",2,UNBOUNDED,"*;y;l",CallSpecificMethod,"CallSpecificMethod",NULL);
+   FuncSeqOvlFlags(theEnv,"call-specific-method",true,false);
+   AddUDF(theEnv,"override-next-method","*",0,UNBOUNDED,NULL,OverrideNextMethod,"OverrideNextMethod",NULL);
+   FuncSeqOvlFlags(theEnv,"override-next-method",true,false);
+   AddUDF(theEnv,"next-methodp","b",0,0,NULL,NextMethodPCommand,"NextMethodPCommand",NULL);
+   FuncSeqOvlFlags(theEnv,"next-methodp",true,false);
+
+   AddUDF(theEnv,"(gnrc-current-arg)","*",0,UNBOUNDED,NULL,GetGenericCurrentArgument,"GetGenericCurrentArgument",NULL);
+
+#if DEBUGGING_FUNCTIONS
+   AddUDF(theEnv,"ppdefgeneric","vs",1,2,";y;ldsyn",PPDefgenericCommand,"PPDefgenericCommand",NULL);
+   AddUDF(theEnv,"list-defgenerics","v",0,1,"y",ListDefgenericsCommand,"ListDefgenericsCommand",NULL);
+   AddUDF(theEnv,"ppdefmethod","v",2,3,"*;y;l;ldsyn",PPDefmethodCommand,"PPDefmethodCommand",NULL);
+   AddUDF(theEnv,"list-defmethods","v",0,1,"y",ListDefmethodsCommand,"ListDefmethodsCommand",NULL);
+   AddUDF(theEnv,"preview-generic","v",1,UNBOUNDED,"*;y",PreviewGeneric,"PreviewGeneric",NULL);
+#endif
+
+   AddUDF(theEnv,"get-defgeneric-list","m",0,1,"y",GetDefgenericListFunction,"GetDefgenericListFunction",NULL);
+   AddUDF(theEnv,"get-defmethod-list","m",0,1,"y",GetDefmethodListCommand,"GetDefmethodListCommand",NULL);
+   AddUDF(theEnv,"get-method-restrictions","m",2,2,"l;y",GetMethodRestrictionsCommand,"GetMethodRestrictionsCommand",NULL);
+   AddUDF(theEnv,"defgeneric-module","y",1,1,"y",GetDefgenericModuleCommand,"GetDefgenericModuleCommand",NULL);
+
+#if OBJECT_SYSTEM
+   AddUDF(theEnv,"type","*",1,1,"*",ClassCommand,"ClassCommand",NULL);
+#else
+   AddUDF(theEnv,"type","*",1,1,"*",TypeCommand,"TypeCommand",NULL);
+#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(
+  Environment *theEnv)
+  {
+#if ! RUN_TIME
+   struct defgenericModule *theModuleItem;
+   Defmodule *theModule;
+
+#if BLOAD || BLOAD_AND_BSAVE
+   if (Bloaded(theEnv)) return;
+#endif
+
+   DoForAllConstructs(theEnv,
+                      DestroyDefgenericAction,
+                      DefgenericData(theEnv)->DefgenericModuleIndex,false,NULL);
+
+   for (theModule = GetNextDefmodule(theEnv,NULL);
+        theModule != NULL;
+        theModule = GetNextDefmodule(theEnv,theModule))
+     {
+      theModuleItem = (struct defgenericModule *)
+                      GetModuleItem(theEnv,theModule,
+                                    DefgenericData(theEnv)->DefgenericModuleIndex);
+
+      rtn_struct(theEnv,defgenericModule,theModuleItem);
+     }
+#else
+#if MAC_XCD
+#pragma unused(theEnv)
+#endif
+#endif
+  }
+
+#if ! RUN_TIME
+/****************************************************/
+/* DestroyDefgenericAction: Action used to remove   */
+/*   defgenerics as a result of DestroyEnvironment. */
+/****************************************************/
+static void DestroyDefgenericAction(
+  Environment *theEnv,
+  ConstructHeader *theConstruct,
+  void *buffer)
+  {
+#if MAC_XCD
+#pragma unused(buffer)
+#endif
+#if (! BLOAD_ONLY) && (! RUN_TIME)
+   Defgeneric *theDefgeneric = (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,theDefgeneric->methods,(sizeof(Defmethod) * theDefgeneric->mcnt)); }
+
+   DestroyConstructHeader(theEnv,&theDefgeneric->header);
+
+   rtn_struct(theEnv,defgeneric,theDefgeneric);
+#else
+#if MAC_XCD
+#pragma unused(theEnv,theConstruct)
+#endif
+#endif
+  }
+#endif
+
+/***************************************************
+  NAME         : FindDefgeneric
+  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
+ ***************************************************/
+Defgeneric *FindDefgeneric(
+  Environment *theEnv,
+  const char *genericModuleAndName)
+  {
+   return (Defgeneric *) FindNamedConstructInModuleOrImports(theEnv,genericModuleAndName,DefgenericData(theEnv)->DefgenericConstruct);
+  }
+
+/***************************************************
+  NAME         : FindDefgenericInModule
+  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
+ ***************************************************/
+Defgeneric *FindDefgenericInModule(
+  Environment *theEnv,
+  const char *genericModuleAndName)
+  {
+   return (Defgeneric *) FindNamedConstructInModule(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
+ ***************************************************/
+Defgeneric *LookupDefgenericByMdlOrScope(
+  Environment *theEnv,
+  const char *defgenericName)
+  {
+   return (Defgeneric *) LookupConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,defgenericName,true);
+  }
+
+/***************************************************
+  NAME         : LookupDefgenericInScope
+  DESCRIPTION  : Finds a defgeneric in current or
+                   imported modules (module
+                   specifier is not allowed)
+  INPUTS       : The defgeneric name
+  RETURNS      : The defgeneric (NULL if not found)
+  SIDE EFFECTS : Error message printed on
+                  ambiguous references
+  NOTES        : None
+ ***************************************************/
+Defgeneric *LookupDefgenericInScope(
+  Environment *theEnv,
+  const char *defgenericName)
+  {
+   return (Defgeneric *) LookupConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,defgenericName,false);
+  }
+
+/***********************************************************
+  NAME         : GetNextDefgeneric
+  DESCRIPTION  : Finds first or next generic function
+  INPUTS       : The address of the current generic function
+  RETURNS      : The address of the next generic function
+                   (NULL if none)
+  SIDE EFFECTS : None
+  NOTES        : If ptr == NULL, the first generic function
+                    is returned.
+ ***********************************************************/
+Defgeneric *GetNextDefgeneric(
+  Environment *theEnv,
+  Defgeneric *theDefgeneric)
+  {
+   return (Defgeneric *) GetNextConstructItem(theEnv,&theDefgeneric->header,DefgenericData(theEnv)->DefgenericModuleIndex);
+  }
+
+/***********************************************************
+  NAME         : GetNextDefmethod
+  DESCRIPTION  : Find the next method for a generic function
+  INPUTS       : 1) The generic function address
+                 2) The index of the current method
+  RETURNS      : The index of the next method
+                    (0 if none)
+  SIDE EFFECTS : None
+  NOTES        : If index == 0, the index of the first
+                   method is returned
+ ***********************************************************/
+unsigned short GetNextDefmethod(
+  Defgeneric *theDefgeneric,
+  unsigned short theIndex)
+  {
+   unsigned short mi;
+
+   if (theIndex == 0)
+     {
+      if (theDefgeneric->methods != NULL)
+        { return theDefgeneric->methods[0].index; }
+        
+      return 0;
+     }
+     
+   mi = FindMethodByIndex(theDefgeneric,theIndex);
+   
+   if ((mi+1) == theDefgeneric->mcnt)
+     { return 0; }
+     
+   return theDefgeneric->methods[mi+1].index;
+  }
+
+/*****************************************************
+  NAME         : GetDefmethodPointer
+  DESCRIPTION  : Returns a pointer to a method
+  INPUTS       : 1) Pointer to a defgeneric
+                 2) Array index of method in generic's
+                    method array (+1)
+  RETURNS      : Pointer to the method.
+  SIDE EFFECTS : None
+  NOTES        : None
+ *****************************************************/
+Defmethod *GetDefmethodPointer(
+  Defgeneric *theDefgeneric,
+  long theIndex)
+  {
+   return &theDefgeneric->methods[theIndex-1];
+  }
+
+/***************************************************
+  NAME         : IsDefgenericDeletable
+  DESCRIPTION  : Determines if a generic function
+                   can be deleted
+  INPUTS       : Address of the generic function
+  RETURNS      : True if deletable, false otherwise
+  SIDE EFFECTS : None
+  NOTES        : None
+ ***************************************************/
+bool DefgenericIsDeletable(
+  Defgeneric *theDefgeneric)
+  {
+   Environment *theEnv = theDefgeneric->header.env;
+   
+   if (! ConstructsDeletable(theEnv))
+     { return false; }
+
+   return (theDefgeneric->busy == 0) ? true : false;
+  }
+
+/***************************************************
+  NAME         : DefmethodIsDeletable
+  DESCRIPTION  : Determines if a generic function
+                   method can be deleted
+  INPUTS       : 1) Address of the generic function
+                 2) Index of the method
+  RETURNS      : True if deletable, false otherwise
+  SIDE EFFECTS : None
+  NOTES        : None
+ ***************************************************/
+bool DefmethodIsDeletable(
+  Defgeneric *theDefgeneric,
+  unsigned short theIndex)
+  {
+   Environment *theEnv = theDefgeneric->header.env;
+   unsigned short mi;
+   
+   if (! ConstructsDeletable(theEnv))
+     { return false; }
+
+   mi = FindMethodByIndex(theDefgeneric,theIndex);
+   if (mi == METHOD_NOT_FOUND) return false;
+   
+   if (theDefgeneric->methods[mi].system)
+     return false;
+
+#if (! BLOAD_ONLY) && (! RUN_TIME)
+   return (MethodsExecuting(theDefgeneric) == false) ? true : false;
+#else
+   return false;
+#endif
+  }
+
+/**********************************************************
+  NAME         : UndefgenericCommand
+  DESCRIPTION  : Deletes all methods for a generic function
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : methods deallocated
+  NOTES        : H/L Syntax: (undefgeneric <name> | *)
+ **********************************************************/
+void UndefgenericCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   UndefconstructCommand(context,"undefgeneric",DefgenericData(theEnv)->DefgenericConstruct);
+  }
+
+/****************************************************************
+  NAME         : GetDefgenericModuleCommand
+  DESCRIPTION  : Determines to which module a defgeneric belongs
+  INPUTS       : None
+  RETURNS      : The symbolic name of the module
+  SIDE EFFECTS : None
+  NOTES        : H/L Syntax: (defgeneric-module <generic-name>)
+ ****************************************************************/
+void GetDefgenericModuleCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   returnValue->value = GetConstructModuleCommand(context,"defgeneric-module",DefgenericData(theEnv)->DefgenericConstruct);
+  }
+
+/**************************************************************
+  NAME         : UndefmethodCommand
+  DESCRIPTION  : Deletes one method for a generic function
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : methods deallocated
+  NOTES        : H/L Syntax: (undefmethod <name> <index> | *)
+ **************************************************************/
+void UndefmethodCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   UDFValue theArg;
+   Defgeneric *gfunc;
+   unsigned short mi;
+
+   if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg)) return;
+
+   gfunc = LookupDefgenericByMdlOrScope(theEnv,theArg.lexemeValue->contents);
+   if ((gfunc == NULL) ? (strcmp(theArg.lexemeValue->contents,"*") != 0) : false)
+     {
+      PrintErrorID(theEnv,"GENRCCOM",1,false);
+      WriteString(theEnv,STDERR,"No such generic function '");
+      WriteString(theEnv,STDERR,theArg.lexemeValue->contents);
+      WriteString(theEnv,STDERR,"' in function undefmethod.\n");
+      return;
+     }
+
+   if (! UDFNextArgument(context,ANY_TYPE_BITS,&theArg)) return;
+
+   if (CVIsType(&theArg,SYMBOL_BIT))
+     {
+      if (strcmp(theArg.lexemeValue->contents,"*") != 0)
+        {
+         PrintErrorID(theEnv,"GENRCCOM",2,false);
+         WriteString(theEnv,STDERR,"Expected a valid method index in function undefmethod.\n");
+         return;
+        }
+      mi = 0;
+     }
+   else if (CVIsType(&theArg,INTEGER_BIT))
+     {
+      mi = (unsigned short) theArg.integerValue->contents;
+      if (mi == 0)
+        {
+         PrintErrorID(theEnv,"GENRCCOM",2,false);
+         WriteString(theEnv,STDERR,"Expected a valid method index in function undefmethod.\n");
+         return;
+        }
+     }
+   else
+     {
+      PrintErrorID(theEnv,"GENRCCOM",2,false);
+      WriteString(theEnv,STDERR,"Expected a valid method index in function undefmethod.\n");
+      return;
+     }
+   Undefmethod(gfunc,mi,theEnv);
+  }
+
+/**************************************************************
+  NAME         : EnvUndefgeneric
+  DESCRIPTION  : Deletes all methods for a generic function
+  INPUTS       : The generic-function address (NULL for all)
+  RETURNS      : True if generic successfully deleted,
+                 false otherwise
+  SIDE EFFECTS : methods deallocated
+  NOTES        : None
+ **************************************************************/
+bool Undefgeneric(
+  Defgeneric *theDefgeneric,
+  Environment *allEnv)
+  {
+#if RUN_TIME || BLOAD_ONLY
+   return false;
+#else
+   Environment *theEnv;
+   bool success = true;
+   GCBlock gcb;
+
+   if (theDefgeneric == NULL)
+     { theEnv = allEnv; }
+   else
+     { theEnv = theDefgeneric->header.env; }
+     
+   GCBlockStart(theEnv,&gcb);
+   if (theDefgeneric == NULL)
+     {
+      if (ClearDefmethods(theEnv) == false)
+        success = false;
+      if (ClearDefgenerics(theEnv) == false)
+        success = false;
+        
+      GCBlockEnd(theEnv,&gcb);
+        
+      return success ;
+     }
+     
+   if (DefgenericIsDeletable(theDefgeneric) == false)
+     {
+      GCBlockEnd(theEnv,&gcb);
+      return false;
+     }
+      
+   RemoveConstructFromModule(theEnv,&theDefgeneric->header);
+   RemoveDefgeneric(theEnv,theDefgeneric);
+   
+   GCBlockEnd(theEnv,&gcb);
+
+   return true;
+#endif
+  }
+
+/**************************************************************
+  NAME         : Undefmethod
+  DESCRIPTION  : Deletes one method for a generic function
+  INPUTS       : 1) Address of generic function (can be NULL)
+                 2) Method index (0 for all)
+  RETURNS      : True if method deleted successfully,
+                 false otherwise
+  SIDE EFFECTS : methods deallocated
+  NOTES        : None
+ **************************************************************/
+bool Undefmethod(
+  Defgeneric *theDefgeneric,
+  unsigned short mi,
+  Environment *allEnv)
+  {
+   Environment *theEnv;
+#if (! RUN_TIME) && (! BLOAD_ONLY)
+   GCBlock gcb;
+#endif
+ 
+   if (theDefgeneric == NULL)
+     { theEnv = allEnv; }
+   else
+     { theEnv = theDefgeneric->header.env; }
+   
+#if RUN_TIME || BLOAD_ONLY
+   PrintErrorID(theEnv,"PRNTUTIL",4,false);
+   WriteString(theEnv,STDERR,"Unable to delete method ");
+   if (theDefgeneric != NULL)
+     {
+      WriteString(theEnv,STDERR,"'");
+      PrintGenericName(theEnv,STDERR,theDefgeneric);
+      WriteString(theEnv,STDERR,"'");
+      WriteString(theEnv,STDERR," #");
+      PrintUnsignedInteger(theEnv,STDERR,mi);
+     }
+   else
+     WriteString(theEnv,STDERR,"*");
+   WriteString(theEnv,STDERR,".\n");
+   return false;
+#else
+
+#if BLOAD || BLOAD_AND_BSAVE
+   if (Bloaded(theEnv) == true)
+     {
+      PrintErrorID(theEnv,"PRNTUTIL",4,false);
+      WriteString(theEnv,STDERR,"Unable to delete method ");
+      if (theDefgeneric != NULL)
+        {
+         WriteString(theEnv,STDERR,"'");
+         WriteString(theEnv,STDERR,DefgenericName(theDefgeneric));
+         WriteString(theEnv,STDERR,"'");
+         WriteString(theEnv,STDERR," #");
+         PrintUnsignedInteger(theEnv,STDERR,mi);
+        }
+      else
+        WriteString(theEnv,STDERR,"*");
+      WriteString(theEnv,STDERR,".\n");
+      return false;
+     }
+#endif
+
+   GCBlockStart(theEnv,&gcb);
+   if (theDefgeneric == NULL)
+     {
+      bool success;
+      
+      if (mi != 0)
+        {
+         PrintErrorID(theEnv,"GENRCCOM",3,false);
+         WriteString(theEnv,STDERR,"Incomplete method specification for deletion.\n");
+         GCBlockEnd(theEnv,&gcb);
+         return false;
+        }
+        
+      success = ClearDefmethods(theEnv);
+      GCBlockEnd(theEnv,&gcb);
+      return success;
+     }
+     
+   if (MethodsExecuting(theDefgeneric))
+     {
+      MethodAlterError(theEnv,theDefgeneric);
+      GCBlockEnd(theEnv,&gcb);
+      return false;
+     }
+     
+   if (mi == 0)
+     { RemoveAllExplicitMethods(theEnv,theDefgeneric); }
+   else
+     {
+      unsigned short nmi = CheckMethodExists(theEnv,"undefmethod",theDefgeneric,mi);
+      if (nmi == METHOD_NOT_FOUND)
+        {
+         GCBlockEnd(theEnv,&gcb);
+         return false;
+        }
+      RemoveDefgenericMethod(theEnv,theDefgeneric,nmi);
+     }
+     
+   GCBlockEnd(theEnv,&gcb);
+   return true;
+#endif
+  }
+
+#if DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS
+
+/*****************************************************
+  NAME         : DefmethodDescription
+  DESCRIPTION  : Prints a synopsis of method parameter
+                   restrictions into caller's buffer
+  INPUTS       : 1) Caller's buffer
+                 2) Buffer size (not including space
+                    for terminating '\0')
+                 3) Address of generic function
+                 4) Index of method
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Caller's buffer written
+  NOTES        : Terminating '\n' not written
+ *****************************************************/
+void DefmethodDescription(
+  Defgeneric *theDefgeneric,
+  unsigned short theIndex,
+  StringBuilder *theSB)
+  {
+   long mi;
+   Environment *theEnv = theDefgeneric->header.env;
+
+   mi = FindMethodByIndex(theDefgeneric,theIndex);
+
+   OpenStringBuilderDestination(theEnv,"MethodDescription",theSB);
+
+   if (mi != METHOD_NOT_FOUND)
+     { PrintMethod(theEnv,&theDefgeneric->methods[mi],theSB); }
+   
+   CloseStringBuilderDestination(theEnv,"MethodDescription");
+
+  }
+#endif /* DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS */
+
+#if DEBUGGING_FUNCTIONS
+
+/*********************************************************
+  NAME         : GetDefgenericWatch
+  DESCRIPTION  : Determines if trace messages are
+                 gnerated when executing generic function
+  INPUTS       : A pointer to the generic
+  RETURNS      : True if a trace is active,
+                 false otherwise
+  SIDE EFFECTS : None
+  NOTES        : None
+ *********************************************************/
+bool DefgenericGetWatch(
+  Defgeneric *theGeneric)
+  {
+   return theGeneric->trace;
+  }
+
+/*********************************************************
+  NAME         : SetDefgenericWatch
+  DESCRIPTION  : Sets the trace to ON/OFF for the
+                 generic function
+  INPUTS       : 1) True to set the trace on,
+                    False to set it off
+                 2) A pointer to the generic
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Watch flag for the generic set
+  NOTES        : None
+ *********************************************************/
+void DefgenericSetWatch(
+  Defgeneric *theGeneric,
+  bool newState)
+  {
+   theGeneric->trace = newState;
+  }
+
+/*********************************************************
+  NAME         : DefmethodGetWatch
+  DESCRIPTION  : Determines if trace messages for calls
+                 to this method will be generated or not
+  INPUTS       : 1) A pointer to the generic
+                 2) The index of the method
+  RETURNS      : True if a trace is active,
+                 false otherwise
+  SIDE EFFECTS : None
+  NOTES        : None
+ *********************************************************/
+bool DefmethodGetWatch(
+  Defgeneric *theGeneric,
+  unsigned short theIndex)
+  {
+   unsigned short mi;
+
+   mi = FindMethodByIndex(theGeneric,theIndex);
+   
+   if (mi != METHOD_NOT_FOUND)
+     { return theGeneric->methods[mi].trace; }
+     
+   return false;
+  }
+
+/*********************************************************
+  NAME         : DefmethodSetWatch
+  DESCRIPTION  : Sets the trace to ON/OFF for the
+                 calling of the method
+  INPUTS       : 1) True to set the trace on,
+                    false to set it off
+                 2) A pointer to the generic
+                 3) The index of the method
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Watch flag for the method set
+  NOTES        : None
+ *********************************************************/
+void DefmethodSetWatch(
+  Defgeneric *theGeneric,
+  unsigned short theIndex,
+  bool newState)
+  {
+   unsigned short mi;
+
+   mi = FindMethodByIndex(theGeneric,theIndex);
+   
+   if (mi != METHOD_NOT_FOUND)
+     { theGeneric->methods[mi].trace = newState; }
+  }
+
+
+/********************************************************
+  NAME         : PPDefgenericCommand
+  DESCRIPTION  : Displays the pretty-print form of
+                  a generic function header
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : None
+  NOTES        : H/L Syntax: (ppdefgeneric <name>)
+ ********************************************************/
+void PPDefgenericCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   PPConstructCommand(context,"ppdefgeneric",DefgenericData(theEnv)->DefgenericConstruct,returnValue);
+  }
+
+/**********************************************************
+  NAME         : PPDefmethodCommand
+  DESCRIPTION  : Displays the pretty-print form of
+                  a method
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : None
+  NOTES        : H/L Syntax: (ppdefmethod <name> <index>)
+ **********************************************************/
+void PPDefmethodCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   UDFValue theArg;
+   const char *gname;
+   const char *logicalName;
+   Defgeneric *gfunc;
+   unsigned short gi;
+
+   if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg)) return;
+   gname = theArg.lexemeValue->contents;
+
+   if (! UDFNextArgument(context,INTEGER_BIT,&theArg)) return;
+
+   if (UDFHasNextArgument(context))
+     {
+      logicalName = GetLogicalName(context,STDOUT);
+      if (logicalName == NULL)
+        {
+         IllegalLogicalNameMessage(theEnv,"ppdefmethod");
+         SetHaltExecution(theEnv,true);
+         SetEvaluationError(theEnv,true);
+         return;
+        }
+     }
+   else
+     { logicalName = STDOUT; }
+
+   gfunc = CheckGenericExists(theEnv,"ppdefmethod",gname);
+   if (gfunc == NULL)
+     return;
+
+   gi = CheckMethodExists(theEnv,"ppdefmethod",gfunc,(unsigned short) theArg.integerValue->contents);
+   if (gi == METHOD_NOT_FOUND)
+     return;
+     
+   if (strcmp(logicalName,"nil") == 0)
+     {
+      if (gfunc->methods[gi].header.ppForm != NULL)
+        { returnValue->lexemeValue = CreateString(theEnv,gfunc->methods[gi].header.ppForm); }
+      else
+        { returnValue->lexemeValue = CreateString(theEnv,""); }
+     }
+   else
+     {
+      if (gfunc->methods[gi].header.ppForm != NULL)
+        WriteString(theEnv,logicalName,gfunc->methods[gi].header.ppForm);
+     }
+  }
+
+/******************************************************
+  NAME         : ListDefmethodsCommand
+  DESCRIPTION  : Lists a brief description of methods
+                   for a particular generic function
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : None
+  NOTES        : H/L Syntax: (list-defmethods <name>)
+ ******************************************************/
+void ListDefmethodsCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   UDFValue theArg;
+   Defgeneric *gfunc;
+
+   if (! UDFHasNextArgument(context))
+     { ListDefmethods(theEnv,STDOUT,NULL); }
+   else
+     {
+      if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg)) return;
+
+      gfunc = CheckGenericExists(theEnv,"list-defmethods",theArg.lexemeValue->contents);
+      if (gfunc != NULL)
+        { ListDefmethods(theEnv,STDOUT,gfunc); }
+     }
+  }
+
+/***************************************************************
+  NAME         : DefmethodPPForm
+  DESCRIPTION  : Getsa generic function method pretty print form
+  INPUTS       : 1) Address of the generic function
+                 2) Index of the method
+  RETURNS      : Method ppform
+  SIDE EFFECTS : None
+  NOTES        : None
+ ***************************************************************/
+const char *DefmethodPPForm(
+  Defgeneric *theDefgeneric,
+  unsigned short theIndex)
+  {
+   unsigned short mi;
+
+   mi = FindMethodByIndex(theDefgeneric,theIndex);
+   
+   if (mi != METHOD_NOT_FOUND)
+     { return theDefgeneric->methods[mi].header.ppForm; }
+     
+   return "";
+  }
+
+/***************************************************
+  NAME         : ListDefgenericsCommand
+  DESCRIPTION  : Displays all defgeneric names
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Defgeneric names printed
+  NOTES        : H/L Interface
+ ***************************************************/
+void ListDefgenericsCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   ListConstructCommand(context,DefgenericData(theEnv)->DefgenericConstruct);
+  }
+
+/***************************************************
+  NAME         : ListDefgenerics
+  DESCRIPTION  : Displays all defgeneric names
+  INPUTS       : 1) The logical name of the output
+                 2) The module
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Defgeneric names printed
+  NOTES        : C Interface
+ ***************************************************/
+void ListDefgenerics(
+  Environment *theEnv,
+  const char *logicalName,
+  Defmodule *theModule)
+  {
+   ListConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,logicalName,theModule);
+  }
+
+/******************************************************
+  NAME         : ListDefmethods
+  DESCRIPTION  : Lists a brief description of methods
+                   for a particular generic function
+  INPUTS       : 1) The logical name of the output
+                 2) Generic function to list methods for
+                    (NULL means list all methods)
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : None
+  NOTES        : None
+ ******************************************************/
+void ListDefmethods(
+  Environment *theEnv,
+  const char *logicalName,
+  Defgeneric *theDefgeneric)
+  {
+   Defgeneric *gfunc;
+   unsigned long count;
+   if (theDefgeneric != NULL)
+     count = ListMethodsForGeneric(theEnv,logicalName,theDefgeneric);
+   else
+     {
+      count = 0;
+      for (gfunc = GetNextDefgeneric(theEnv,NULL) ;
+           gfunc != NULL ;
+           gfunc = GetNextDefgeneric(theEnv,gfunc))
+        {
+         count += ListMethodsForGeneric(theEnv,logicalName,gfunc);
+         if (GetNextDefgeneric(theEnv,gfunc) != NULL)
+           WriteString(theEnv,logicalName,"\n");
+        }
+     }
+   PrintTally(theEnv,logicalName,count,"method","methods");
+  }
+
+#endif /* DEBUGGING_FUNCTIONS */
+
+/***************************************************************
+  NAME         : GetDefgenericListFunction
+  DESCRIPTION  : Groups all defgeneric names into
+                 a multifield list
+  INPUTS       : A data object buffer to hold
+                 the multifield result
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Multifield allocated and filled
+  NOTES        : H/L Syntax: (get-defgeneric-list [<module>])
+ ***************************************************************/
+void GetDefgenericListFunction(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   GetConstructListFunction(context,returnValue,DefgenericData(theEnv)->DefgenericConstruct);
+  }
+
+/***************************************************************
+  NAME         : GetDefgenericList
+  DESCRIPTION  : Groups all defgeneric names into
+                 a multifield list
+  INPUTS       : 1) A data object buffer to hold
+                    the multifield result
+                 2) The module from which to obtain defgenerics
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Multifield allocated and filled
+  NOTES        : External C access
+ ***************************************************************/
+void GetDefgenericList(
+  Environment *theEnv,
+  CLIPSValue *returnValue,
+  Defmodule *theModule)
+  {
+   UDFValue result;
+   
+   GetConstructList(theEnv,&result,DefgenericData(theEnv)->DefgenericConstruct,theModule);
+   NormalizeMultifield(theEnv,&result);
+   returnValue->value = result.value;
+  }
+
+/***********************************************************
+  NAME         : GetDefmethodListCommand
+  DESCRIPTION  : Groups indices of all methdos for a generic
+                 function into a multifield variable
+                 (NULL means get methods for all generics)
+  INPUTS       : A data object buffer
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Multifield set to list of method indices
+  NOTES        : None
+ ***********************************************************/
+void GetDefmethodListCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   UDFValue theArg;
+   Defgeneric *gfunc;
+   CLIPSValue result;
+
+   if (! UDFHasNextArgument(context))
+     {
+      GetDefmethodList(theEnv,&result,NULL);
+      CLIPSToUDFValue(&result,returnValue);
+     }
+   else
+     {
+      if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg))
+        { return; }
+      gfunc = CheckGenericExists(theEnv,"get-defmethod-list",theArg.lexemeValue->contents);
+      if (gfunc != NULL)
+        {
+         GetDefmethodList(theEnv,&result,gfunc);
+         CLIPSToUDFValue(&result,returnValue);
+        }
+      else
+        { SetMultifieldErrorValue(theEnv,returnValue); }
+     }
+  }
+
+/***********************************************************
+  NAME         : GetDefmethodList
+  DESCRIPTION  : Groups indices of all methdos for a generic
+                 function into a multifield variable
+                 (NULL means get methods for all generics)
+  INPUTS       : 1) A pointer to a generic function
+                 2) A data object buffer
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Multifield set to list of method indices
+  NOTES        : None
+ ***********************************************************/
+void GetDefmethodList(
+  Environment *theEnv,
+  CLIPSValue *returnValue,
+  Defgeneric *theDefgeneric)
+  {
+   Defgeneric *gfunc, *svg, *svnxt;
+   long i,j;
+   unsigned long count;
+   Multifield *theList;
+
+   if (theDefgeneric != NULL)
+     {
+      gfunc = theDefgeneric;
+      svnxt = GetNextDefgeneric(theEnv,theDefgeneric);
+      SetNextDefgeneric(theDefgeneric,NULL);
+     }
+   else
+     {
+      gfunc = GetNextDefgeneric(theEnv,NULL);
+      svnxt = (gfunc != NULL) ? GetNextDefgeneric(theEnv,gfunc) : NULL;
+     }
+   count = 0;
+   for (svg = gfunc ;
+        gfunc != NULL ;
+        gfunc = GetNextDefgeneric(theEnv,gfunc))
+     count += gfunc->mcnt;
+   count *= 2;
+   theList = CreateMultifield(theEnv,count);
+   returnValue->value = theList;
+   for (gfunc = svg , i = 0 ;
+        gfunc != NULL ;
+        gfunc = GetNextDefgeneric(theEnv,gfunc))
+     {
+      for (j = 0 ; j < gfunc->mcnt ; j++)
+        {
+         theList->contents[i++].value = GetDefgenericNamePointer(gfunc);
+         theList->contents[i++].integerValue = CreateInteger(theEnv,(long long) gfunc->methods[j].index);
+        }
+     }
+   if (svg != NULL)
+     SetNextDefgeneric(svg,svnxt);
+  }
+
+/***********************************************************************************
+  NAME         : GetMethodRestrictionsCommand
+  DESCRIPTION  : Stores restrictions of a method in multifield
+  INPUTS       : A data object buffer to hold a multifield
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Multifield created (length zero on errors)
+  NOTES        : Syntax: (get-method-restrictions <generic-function> <method-index>)
+ ***********************************************************************************/
+void GetMethodRestrictionsCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   UDFValue theArg;
+   Defgeneric *gfunc;
+   CLIPSValue result;
+   unsigned short mi;
+
+   if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg))
+     { return; }
+   gfunc = CheckGenericExists(theEnv,"get-method-restrictions",theArg.lexemeValue->contents);
+   if (gfunc == NULL)
+     {
+      SetMultifieldErrorValue(theEnv,returnValue);
+      return;
+     }
+
+   if (! UDFNextArgument(context,INTEGER_BIT,&theArg))
+     { return; }
+
+   mi = (unsigned short) theArg.integerValue->contents;
+   
+   if (CheckMethodExists(theEnv,"get-method-restrictions",gfunc,mi) == METHOD_NOT_FOUND)
+     {
+      SetMultifieldErrorValue(theEnv,returnValue);
+      return;
+     }
+     
+   GetMethodRestrictions(gfunc,mi,&result);
+   CLIPSToUDFValue(&result,returnValue);
+  }
+
+/***********************************************************************
+  NAME         : GetMethodRestrictions
+  DESCRIPTION  : Stores restrictions of a method in multifield
+  INPUTS       : 1) Pointer to the generic function
+                 2) The method index
+                 3) A data object buffer to hold a multifield
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Multifield created (length zero on errors)
+  NOTES        : The restrictions are stored in the multifield
+                 in the following format:
+
+                 <min-number-of-arguments>
+                 <max-number-of-arguments> (-1 if wildcard allowed)
+                 <restriction-count>
+                 <index of 1st restriction>
+                       .
+                       .
+                 <index of nth restriction>
+                 <restriction 1>
+                     <query TRUE/FALSE>
+                     <number-of-classes>
+                     <class 1>
+                        .
+                        .
+                     <class n>
+                    .
+                    .
+                    .
+                  <restriction n>
+
+                  Thus, for the method
+                  (defmethod foo ((?a NUMBER SYMBOL_TYPE) (?b (= 1 1)) $?c))
+                  (get-method-restrictions foo 1) would yield
+
+                  (2 -1 3 7 11 13 FALSE 2 NUMBER SYMBOL_TYPE TRUE 0 FALSE 0)
+ ***********************************************************************/
+void GetMethodRestrictions(
+  Defgeneric *theDefgeneric,
+  unsigned short mi,
+  CLIPSValue *returnValue)
+  {
+   short i,j;
+   Defmethod *meth;
+   RESTRICTION *rptr;
+   size_t count;
+   int roffset,rstrctIndex;
+   Multifield *theList;
+   Environment *theEnv = theDefgeneric->header.env;
+
+   meth = theDefgeneric->methods + FindMethodByIndex(theDefgeneric,mi);
+   count = 3;
+   for (i = 0 ; i < meth->restrictionCount ; i++)
+     count += meth->restrictions[i].tcnt + 3;
+   theList = CreateMultifield(theEnv,count);
+
+   returnValue->value = theList;
+   if (meth->minRestrictions == RESTRICTIONS_UNBOUNDED)
+     { theList->contents[0].integerValue = CreateInteger(theEnv,-1); }
+   else
+     { theList->contents[0].integerValue = CreateInteger(theEnv,(long long) meth->minRestrictions); }
+   if (meth->maxRestrictions == RESTRICTIONS_UNBOUNDED)
+     { theList->contents[1].integerValue = CreateInteger(theEnv,-1); }
+   else
+     { theList->contents[1].integerValue = CreateInteger(theEnv,(long long) meth->maxRestrictions); }
+   theList->contents[2].integerValue = CreateInteger(theEnv,(long long) meth->restrictionCount);
+   roffset = 3 + meth->restrictionCount;
+   rstrctIndex = 3;
+   for (i = 0 ; i < meth->restrictionCount ; i++)
+     {
+      rptr = meth->restrictions + i;
+      theList->contents[rstrctIndex++].integerValue = CreateInteger(theEnv,(long long) roffset + 1);
+      theList->contents[roffset++].lexemeValue = (rptr->query != NULL) ? TrueSymbol(theEnv) : FalseSymbol(theEnv);
+      theList->contents[roffset++].integerValue = CreateInteger(theEnv,(long long) rptr->tcnt);
+      for (j = 0 ; j < rptr->tcnt ; j++)
+        {
+#if OBJECT_SYSTEM
+         theList->contents[roffset++].lexemeValue = CreateSymbol(theEnv,DefclassName((Defclass *) rptr->types[j]));
+#else
+         theList->contents[roffset++].lexemeValue = CreateSymbol(theEnv,TypeName(theEnv,((CLIPSInteger *) rptr->types[j])->contents));
+#endif
+        }
+     }
+  }
+
+/* =========================================
+   *****************************************
+          INTERNALLY VISIBLE FUNCTIONS
+   =========================================
+   ***************************************** */
+
+/***************************************************
+  NAME         : PrintGenericCall
+  DESCRIPTION  : PrintExpression() support function
+                 for generic function calls
+  INPUTS       : 1) The output logical name
+                 2) The generic function
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Call expression printed
+  NOTES        : None
+ ***************************************************/
+static void PrintGenericCall(
+  Environment *theEnv,
+  const char *logName,
+  Defgeneric *theDefgeneric)
+  {
+#if DEVELOPER
+
+   WriteString(theEnv,logName,"(");
+   WriteString(theEnv,logName,DefgenericName(theDefgeneric));
+   if (GetFirstArgument() != NULL)
+     {
+      WriteString(theEnv,logName," ");
+      PrintExpression(theEnv,logName,GetFirstArgument());
+     }
+   WriteString(theEnv,logName,")");
+#else
+#if MAC_XCD
+#pragma unused(theEnv)
+#pragma unused(logName)
+#pragma unused(theDefgeneric)
+#endif
+#endif
+  }
+
+/*******************************************************
+  NAME         : EvaluateGenericCall
+  DESCRIPTION  : Primitive support function for
+                 calling a generic function
+  INPUTS       : 1) The generic function
+                 2) A data object buffer to hold
+                    the evaluation result
+  RETURNS      : False if the generic function
+                 returns the symbol false,
+                 true otherwise
+  SIDE EFFECTS : Data obejct buffer set and any
+                 side-effects of calling the generic
+  NOTES        : None
+ *******************************************************/
+static bool EvaluateGenericCall(
+  Environment *theEnv,
+  Defgeneric *theDefgeneric,
+  UDFValue *returnValue)
+  {
+   GenericDispatch(theEnv,theDefgeneric,NULL,NULL,GetFirstArgument(),returnValue);
+   if ((returnValue->header->type == SYMBOL_TYPE) &&
+       (returnValue->value == FalseSymbol(theEnv)))
+     return false;
+   return true;
+  }
+
+/***************************************************
+  NAME         : DecrementGenericBusyCount
+  DESCRIPTION  : Lowers the busy count of a
+                 generic function construct
+  INPUTS       : The generic function
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Busy count decremented if a clear
+                 is not in progress (see comment)
+  NOTES        : None
+ ***************************************************/
+static void DecrementGenericBusyCount(
+  Environment *theEnv,
+  Defgeneric *theDefgeneric)
+  {
+   /* ==============================================
+      The generics to which expressions in other
+      constructs may refer may already have been
+      deleted - thus, it is important not to modify
+      the busy flag during a clear.
+      ============================================== */
+   if (! ConstructData(theEnv)->ClearInProgress)
+     { theDefgeneric->busy--; }
+  }
+
+/***************************************************
+  NAME         : IncrementGenericBusyCount
+  DESCRIPTION  : Raises the busy count of a
+                 generic function construct
+  INPUTS       : The generic function
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Busy count incremented
+  NOTES        : None
+ ***************************************************/
+static void IncrementGenericBusyCount(
+  Environment *theEnv,
+  Defgeneric *theDefgeneric)
+  {
+#if MAC_XCD
+#pragma unused(theEnv)
+#endif
+#if (! RUN_TIME) && (! BLOAD_ONLY)
+   if (! ConstructData(theEnv)->ParsingConstruct)
+     { ConstructData(theEnv)->DanglingConstructs++; }
+#endif
+
+   theDefgeneric->busy++;
+  }
+
+#if (! BLOAD_ONLY) && (! RUN_TIME)
+
+/**********************************************************************
+  NAME         : SaveDefgenerics
+  DESCRIPTION  : Outputs pretty-print forms of generic function headers
+  INPUTS       : The logical name of the output
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : None
+  NOTES        : None
+ **********************************************************************/
+static void SaveDefgenerics(
+  Environment *theEnv,
+  Defmodule *theModule,
+  const char *logName,
+  void *context)
+  {
+   SaveConstruct(theEnv,theModule,logName,DefgenericData(theEnv)->DefgenericConstruct);
+  }
+
+/**********************************************************************
+  NAME         : SaveDefmethods
+  DESCRIPTION  : Outputs pretty-print forms of generic function methods
+  INPUTS       : The logical name of the output
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : None
+  NOTES        : None
+ **********************************************************************/
+static void SaveDefmethods(
+  Environment *theEnv,
+  Defmodule *theModule,
+  const char *logName,
+  void *context)
+  {
+   DoForAllConstructsInModule(theEnv,theModule,
+                              SaveDefmethodsForDefgeneric,
+                              DefgenericData(theEnv)->DefgenericModuleIndex,
+                              false,(void *) logName);
+  }
+
+/***************************************************
+  NAME         : SaveDefmethodsForDefgeneric
+  DESCRIPTION  : Save the pretty-print forms of
+                 all methods for a generic function
+                 to a file
+  INPUTS       : 1) The defgeneric
+                 2) The logical name of the output
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : Methods written
+  NOTES        : None
+ ***************************************************/
+static void SaveDefmethodsForDefgeneric(
+  Environment *theEnv,
+  ConstructHeader *theDefgeneric,
+  void *userBuffer)
+  {
+   Defgeneric *gfunc = (Defgeneric *) theDefgeneric;
+   const char *logName = (const char *) userBuffer;
+   long i;
+
+   for (i = 0 ; i < gfunc->mcnt ; i++)
+     {
+      if (gfunc->methods[i].header.ppForm != NULL)
+        {
+         WriteString(theEnv,logName,gfunc->methods[i].header.ppForm);
+         WriteString(theEnv,logName,"\n");
+        }
+     }
+  }
+
+/****************************************************
+  NAME         : RemoveDefgenericMethod
+  DESCRIPTION  : Removes a generic function method
+                   from the array and removes the
+                   generic too if its the last method
+  INPUTS       : 1) The generic function
+                 2) The array index of the method
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : List adjusted
+                 Nodes deallocated
+  NOTES        : Assumes deletion is safe
+ ****************************************************/
+static void RemoveDefgenericMethod(
+  Environment *theEnv,
+  Defgeneric *gfunc,
+  unsigned short gi)
+  {
+   Defmethod *narr;
+   unsigned short b,e;
+
+   if (gfunc->methods[gi].system)
+     {
+      SetEvaluationError(theEnv,true);
+      PrintErrorID(theEnv,"GENRCCOM",4,false);
+      WriteString(theEnv,STDERR,"Cannot remove implicit system function method for generic function '");
+      WriteString(theEnv,STDERR,DefgenericName(gfunc));
+      WriteString(theEnv,STDERR,"'.\n");
+      return;
+     }
+   DeleteMethodInfo(theEnv,gfunc,&gfunc->methods[gi]);
+   if (gfunc->mcnt == 1)
+     {
+      rm(theEnv,gfunc->methods,sizeof(Defmethod));
+      gfunc->mcnt = 0;
+      gfunc->methods = NULL;
+     }
+   else
+     {
+      gfunc->mcnt--;
+      narr = (Defmethod *) gm2(theEnv,(sizeof(Defmethod) * gfunc->mcnt));
+      for (b = e = 0 ; b < gfunc->mcnt ; b++ , e++)
+        {
+         if (b == gi)
+           e++;
+         GenCopyMemory(Defmethod,1,&narr[b],&gfunc->methods[e]);
+        }
+      rm(theEnv,gfunc->methods,(sizeof(Defmethod) * (gfunc->mcnt+1)));
+      gfunc->methods = narr;
+     }
+  }
+
+#endif
+
+#if DEBUGGING_FUNCTIONS
+
+/******************************************************
+  NAME         : ListMethodsForGeneric
+  DESCRIPTION  : Lists a brief description of methods
+                   for a particular generic function
+  INPUTS       : 1) The logical name of the output
+                 2) Generic function to list methods for
+  RETURNS      : The number of methods printed
+  SIDE EFFECTS : None
+  NOTES        : None
+ ******************************************************/
+static unsigned short ListMethodsForGeneric(
+  Environment *theEnv,
+  const char *logicalName,
+  Defgeneric *gfunc)
+  {
+   unsigned short gi;
+   StringBuilder *theSB;
+   
+   theSB = CreateStringBuilder(theEnv,256);
+
+   for (gi = 0 ; gi < gfunc->mcnt ; gi++)
+     {
+      WriteString(theEnv,logicalName,DefgenericName(gfunc));
+      WriteString(theEnv,logicalName," #");
+      PrintMethod(theEnv,&gfunc->methods[gi],theSB);
+      WriteString(theEnv,logicalName,theSB->contents);
+      WriteString(theEnv,logicalName,"\n");
+     }
+     
+   SBDispose(theSB);
+   
+   return gfunc->mcnt;
+  }
+
+/******************************************************************
+  NAME         : DefgenericWatchAccess
+  DESCRIPTION  : Parses a list of generic names passed by
+                 AddWatchItem() and sets the traces accordingly
+  INPUTS       : 1) A code indicating which trace flag is to be set
+                    Ignored
+                 2) The value to which to set the trace flags
+                 3) A list of expressions containing the names
+                    of the generics for which to set traces
+  RETURNS      : True if all OK, false otherwise
+  SIDE EFFECTS : Watch flags set in specified generics
+  NOTES        : Accessory function for AddWatchItem()
+ ******************************************************************/
+static bool DefgenericWatchAccess(
+  Environment *theEnv,
+  int code,
+  bool newState,
+  Expression *argExprs)
+  {
+#if MAC_XCD
+#pragma unused(code)
+#endif
+
+   return(ConstructSetWatchAccess(theEnv,DefgenericData(theEnv)->DefgenericConstruct,newState,argExprs,
+                                  (ConstructGetWatchFunction *) DefgenericGetWatch,
+                                  (ConstructSetWatchFunction *) DefgenericSetWatch));
+  }
+
+/***********************************************************************
+  NAME         : DefgenericWatchPrint
+  DESCRIPTION  : Parses a list of generic names passed by
+                 AddWatchItem() and displays the traces accordingly
+  INPUTS       : 1) The logical name of the output
+                 2) A code indicating which trace flag is to be examined
+                    Ignored
+                 3) A list of expressions containing the names
+                    of the generics for which to examine traces
+  RETURNS      : True if all OK, false otherwise
+  SIDE EFFECTS : Watch flags displayed for specified generics
+  NOTES        : Accessory function for AddWatchItem()
+ ***********************************************************************/
+static bool DefgenericWatchPrint(
+  Environment *theEnv,
+  const char *logName,
+  int code,
+  Expression *argExprs)
+  {
+#if MAC_XCD
+#pragma unused(code)
+#endif
+
+   return(ConstructPrintWatchAccess(theEnv,DefgenericData(theEnv)->DefgenericConstruct,logName,argExprs,
+                                    (ConstructGetWatchFunction *) DefgenericGetWatch,
+                                    (ConstructSetWatchFunction *) DefgenericSetWatch));
+  }
+
+/******************************************************************
+  NAME         : DefmethodWatchAccess
+  DESCRIPTION  : Parses a list of methods passed by
+                 AddWatchItem() and sets the traces accordingly
+  INPUTS       : 1) A code indicating which trace flag is to be set
+                    Ignored
+                 2) The value to which to set the trace flags
+                 3) A list of expressions containing the methods
+                   for which to set traces
+  RETURNS      : True if all OK, false otherwise
+  SIDE EFFECTS : Watch flags set in specified methods
+  NOTES        : Accessory function for AddWatchItem()
+ ******************************************************************/
+static bool DefmethodWatchAccess(
+  Environment *theEnv,
+  int code,
+  bool newState,
+  Expression *argExprs)
+  {
+#if MAC_XCD
+#pragma unused(code)
+#endif
+   if (newState)
+     return(DefmethodWatchSupport(theEnv,"watch",NULL,newState,NULL,DefmethodSetWatch,argExprs));
+   else
+     return(DefmethodWatchSupport(theEnv,"unwatch",NULL,newState,NULL,DefmethodSetWatch,argExprs));
+  }
+
+/***********************************************************************
+  NAME         : DefmethodWatchPrint
+  DESCRIPTION  : Parses a list of methods passed by
+                 AddWatchItem() and displays the traces accordingly
+  INPUTS       : 1) The logical name of the output
+                 2) A code indicating which trace flag is to be examined
+                    Ignored
+                 3) A list of expressions containing the methods for
+                    which to examine traces
+  RETURNS      : True if all OK, false otherwise
+  SIDE EFFECTS : Watch flags displayed for specified methods
+  NOTES        : Accessory function for AddWatchItem()
+ ***********************************************************************/
+static bool DefmethodWatchPrint(
+  Environment *theEnv,
+  const char *logName,
+  int code,
+  Expression *argExprs)
+  {
+#if MAC_XCD
+#pragma unused(code)
+#endif
+   return(DefmethodWatchSupport(theEnv,"list-watch-items",logName,0,
+                                PrintMethodWatchFlag,NULL,argExprs));
+  }
+
+/*******************************************************
+  NAME         : DefmethodWatchSupport
+  DESCRIPTION  : Sets or displays methods specified
+  INPUTS       : 1) The calling function name
+                 2) The logical output name for displays
+                    (can be NULL)
+                 3) The new set state
+                 4) The print function (can be NULL)
+                 5) The trace function (can be NULL)
+                 6) The methods expression list
+  RETURNS      : True if all OK,
+                 false otherwise
+  SIDE EFFECTS : Method trace flags set or displayed
+  NOTES        : None
+ *******************************************************/
+static bool DefmethodWatchSupport(
+  Environment *theEnv,
+  const char *funcName,
+  const char *logName,
+  bool newState,
+  void (*printFunc)(Environment *,const char *,Defgeneric *,unsigned short),
+  void (*traceFunc)(Defgeneric *,unsigned short,bool),
+  Expression *argExprs)
+  {
+   Defgeneric *theGeneric = NULL;
+   unsigned short theMethod = 0;
+   unsigned int argIndex = 2;
+   UDFValue genericName, methodIndex;
+   Defmodule *theModule;
+
+   /* ==============================
+      If no methods are specified,
+      show the trace for all methods
+      in all generics
+      ============================== */
+   if (argExprs == NULL)
+     {
+      SaveCurrentModule(theEnv);
+      theModule = GetNextDefmodule(theEnv,NULL);
+      while (theModule != NULL)
+        {
+         SetCurrentModule(theEnv,theModule);
+         if (traceFunc == NULL)
+           {
+            WriteString(theEnv,logName,DefmoduleName(theModule));
+            WriteString(theEnv,logName,":\n");
+           }
+         theGeneric = GetNextDefgeneric(theEnv,NULL);
+         while (theGeneric != NULL)
+            {
+             theMethod = GetNextDefmethod(theGeneric,0);
+             while (theMethod != 0)
+               {
+                if (traceFunc != NULL)
+                  (*traceFunc)(theGeneric,theMethod,newState);
+                else
+                  {
+                   WriteString(theEnv,logName,"   ");
+                   (*printFunc)(theEnv,logName,theGeneric,theMethod);
+                  }
+                theMethod = GetNextDefmethod(theGeneric,theMethod);
+               }
+             theGeneric = GetNextDefgeneric(theEnv,theGeneric);
+            }
+         theModule = GetNextDefmodule(theEnv,theModule);
+        }
+      RestoreCurrentModule(theEnv);
+      return true;
+     }
+
+   /* =========================================
+      Set the traces for every method specified
+      ========================================= */
+   while (argExprs != NULL)
+     {
+      if (EvaluateExpression(theEnv,argExprs,&genericName))
+        return false;
+      if ((genericName.header->type != SYMBOL_TYPE) ? true :
+          ((theGeneric =
+              LookupDefgenericByMdlOrScope(theEnv,genericName.lexemeValue->contents)) == NULL))
+        {
+         ExpectedTypeError1(theEnv,funcName,argIndex,"'generic function name'");
+         return false;
+        }
+      if (GetNextArgument(argExprs) == NULL)
+        theMethod = 0;
+      else
+        {
+         argExprs = GetNextArgument(argExprs);
+         argIndex++;
+         if (EvaluateExpression(theEnv,argExprs,&methodIndex))
+           return false;
+         if ((methodIndex.header->type != INTEGER_TYPE) ? false :
+             ((methodIndex.integerValue->contents <= 0) ? false :
+              (FindMethodByIndex(theGeneric,theMethod) != METHOD_NOT_FOUND)))
+           theMethod = (unsigned short) methodIndex.integerValue->contents;
+         else
+           {
+            ExpectedTypeError1(theEnv,funcName,argIndex,"'method index'");
+            return false;
+           }
+        }
+      if (theMethod == 0)
+        {
+         theMethod = GetNextDefmethod(theGeneric,0);
+         while (theMethod != 0)
+           {
+            if (traceFunc != NULL)
+              (*traceFunc)(theGeneric,theMethod,newState);
+            else
+              (*printFunc)(theEnv,logName,theGeneric,theMethod);
+            theMethod = GetNextDefmethod(theGeneric,theMethod);
+           }
+        }
+      else
+        {
+         if (traceFunc != NULL)
+           (*traceFunc)(theGeneric,theMethod,newState);
+         else
+           (*printFunc)(theEnv,logName,theGeneric,theMethod);
+        }
+      argExprs = GetNextArgument(argExprs);
+      argIndex++;
+     }
+   return true;
+  }
+
+/***************************************************
+  NAME         : PrintMethodWatchFlag
+  DESCRIPTION  : Displays trace value for method
+  INPUTS       : 1) The logical name of the output
+                 2) The generic function
+                 3) The method index
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : None
+  NOTES        : None
+ ***************************************************/
+static void PrintMethodWatchFlag(
+  Environment *theEnv,
+  const char *logName,
+  Defgeneric *theGeneric,
+  unsigned short theMethod)
+  {
+   StringBuilder *theSB = CreateStringBuilder(theEnv,60);
+
+   WriteString(theEnv,logName,DefgenericName(theGeneric));
+   WriteString(theEnv,logName," ");
+   DefmethodDescription(theGeneric,theMethod,theSB);
+   WriteString(theEnv,logName,theSB->contents);
+   if (DefmethodGetWatch(theGeneric,theMethod))
+     WriteString(theEnv,logName," = on\n");
+   else
+     WriteString(theEnv,logName," = off\n");
+     
+   SBDispose(theSB);
+  }
+
+#endif
+
+#if ! OBJECT_SYSTEM
+
+/***************************************************
+  NAME         : TypeCommand
+  DESCRIPTION  : Works like "class" in COOL
+  INPUTS       : None
+  RETURNS      : Nothing useful
+  SIDE EFFECTS : None
+  NOTES        : H/L Syntax: (type <primitive>)
+ ***************************************************/
+void TypeCommand(
+  Environment *theEnv,
+  UDFContext *context,
+  UDFValue *returnValue)
+  {
+   UDFValue result;
+   
+   EvaluateExpression(theEnv,GetFirstArgument(),&result);
+
+   returnValue->lexemeValue = CreateSymbol(theEnv,TypeName(theEnv,result.header->type));
+  }
+
+#endif
+
+/*#############################*/
+/* Additional Access Functions */
+/*#############################*/
+
+void SetNextDefgeneric(
+  Defgeneric *theDefgeneric,
+  Defgeneric *targetDefgeneric)
+  {
+   SetNextConstruct(&theDefgeneric->header,
+                    &targetDefgeneric->header);
+  }
+
+/*##################################*/
+/* Additional Environment Functions */
+/*##################################*/
+
+const char *DefgenericModule(
+  Defgeneric *theDefgeneric)
+  {
+   return GetConstructModuleName(&theDefgeneric->header);
+  }
+
+const char *DefgenericName(
+  Defgeneric *theDefgeneric)
+  {
+   return GetConstructNameString(&theDefgeneric->header);
+  }
+
+const char *DefgenericPPForm(
+  Defgeneric *theDefgeneric)
+  {
+   return GetConstructPPForm(&theDefgeneric->header);
+  }
+
+CLIPSLexeme *GetDefgenericNamePointer(
+  Defgeneric *theDefgeneric)
+  {
+   return GetConstructNamePointer(&theDefgeneric->header);
+  }
+
+void SetDefgenericPPForm(
+  Environment *theEnv,
+  Defgeneric *theDefgeneric,
+  const char *thePPForm)
+  {
+   SetConstructPPForm(theEnv,&theDefgeneric->header,thePPForm);
+  }
+
+
+#endif /* DEFGENERIC_CONSTRUCT */
+