src/genrccom.c

   1    /*******************************************************/
   2    /*      "C" Language Integrated Production System      */
   3    /*                                                     */
   4    /*             CLIPS Version 6.30  02/05/15            */
   5    /*                                                     */
   6    /*                                                     */
   7    /*******************************************************/
   8
   9 /*************************************************************/
  10 /* Purpose: Generic Functions Interface Routines             */
  11 /*                                                           */
  12 /* Principal Programmer(s):                                  */
  13 /*      Brian L. Dantes                                      */
  14 /*                                                           */
  15 /* Contributing Programmer(s):                               */
  16 /*                                                           */
  17 /* Revision History:                                         */
  18 /*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
  19 /*                                                           */
  20 /*            Corrected compilation errors for files         */
  21 /*            generated by constructs-to-c. DR0861           */
  22 /*                                                           */
  23 /*            Changed name of variable log to logName        */
  24 /*            because of Unix compiler warnings of shadowed  */
  25 /*            definitions.                                   */
  26 /*                                                           */
  27 /*      6.24: Removed IMPERATIVE_METHODS compilation flag.   */
  28 /*                                                           */
  29 /*            Renamed BOOLEAN macro type to intBool.         */
  30 /*                                                           */
  31 /*            Corrected code to remove run-time program      */
  32 /*            compiler warning.                              */
  33 /*                                                           */
  34 /*      6.30: Removed conditional code for unsupported       */
  35 /*            compilers/operating systems (IBM_MCW,          */
  36 /*            MAC_MCW, and IBM_TBC).                         */
  37 /*                                                           */
  38 /*            Changed integer type/precision.                */
  39 /*                                                           */
  40 /*            Added const qualifiers to remove C++           */
  41 /*            deprecation warnings.                          */
  42 /*                                                           */
  43 /*            Converted API macros to function calls.        */
  44 /*                                                           */
  45 /*            Fixed linkage issue when DEBUGGING_FUNCTIONS   */
  46 /*            is set to 0 and PROFILING_FUNCTIONS is set to  */
  47 /*            1.                                             */
  48 /*                                                           */
  49 /*            Changed find construct functionality so that   */
  50 /*            imported modules are search when locating a    */
  51 /*            named construct.                               */
  52 /*                                                           */
  53 /*            Added code to keep track of pointers to        */
  54 /*            constructs that are contained externally to    */
  55 /*            to constructs, DanglingConstructs.             */
  56 /*                                                           */
  57 /*************************************************************/
  58
  59 /* =========================================
  60    *****************************************
  61                EXTERNAL DEFINITIONS
  62    =========================================
  63    ***************************************** */
  64 #include "setup.h"
  65
  66 #if DEFGENERIC_CONSTRUCT
  67
  68 #include <string.h>
  69
  70 #if DEFRULE_CONSTRUCT
  71 #include "network.h"
  72 #endif
  73
  74 #if BLOAD || BLOAD_AND_BSAVE
  75 #include "bload.h"
  76 #endif
  77
  78 #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
  79 #include "genrcbin.h"
  80 #endif
  81
  82 #if CONSTRUCT_COMPILER
  83 #include "genrccmp.h"
  84 #endif
  85
  86 #if (! BLOAD_ONLY) && (! RUN_TIME)
  87 #include "constrct.h"
  88 #include "genrcpsr.h"
  89 #endif
  90
  91 #if OBJECT_SYSTEM
  92 #include "classcom.h"
  93 #include "inscom.h"
  94 #endif
  95
  96 #if DEBUGGING_FUNCTIONS
  97 #include "watch.h"
  98 #endif
  99
 100 #include "argacces.h"
 101 #include "cstrcpsr.h"
 102 #include "envrnmnt.h"
 103 #include "extnfunc.h"
 104 #include "genrcexe.h"
 105 #include "memalloc.h"
 106 #include "modulpsr.h"
 107 #include "multifld.h"
 108 #include "router.h"
 109
 110 #define _GENRCCOM_SOURCE_
 111 #include "genrccom.h"
 112
 113 /* =========================================
 114    *****************************************
 115       INTERNALLY VISIBLE FUNCTION HEADERS
 116    =========================================
 117    ***************************************** */
 118
 119 static void PrintGenericCall(void *,const char *,void *);
 120 static intBool EvaluateGenericCall(void *,void *,DATA_OBJECT *);
 121 static void DecrementGenericBusyCount(void *,void *);
 122 static void IncrementGenericBusyCount(void *,void *);
 123 static void DeallocateDefgenericData(void *);
 124 #if ! RUN_TIME
 125 static void DestroyDefgenericAction(void *,struct constructHeader *,void *);
 126 #endif
 127
 128 #if (! BLOAD_ONLY) && (! RUN_TIME)
 129
 130 static void SaveDefgenerics(void *,void *,const char *);
 131 static void SaveDefmethods(void *,void *,const char *);
 132 static void SaveDefmethodsForDefgeneric(void *,struct constructHeader *,void *);
 133 static void RemoveDefgenericMethod(void *,DEFGENERIC *,long);
 134
 135 #endif
 136
 137 #if DEBUGGING_FUNCTIONS
 138 static long ListMethodsForGeneric(void *,const char *,DEFGENERIC *);
 139 static unsigned DefgenericWatchAccess(void *,int,unsigned,EXPRESSION *);
 140 static unsigned DefgenericWatchPrint(void *,const char *,int,EXPRESSION *);
 141 static unsigned DefmethodWatchAccess(void *,int,unsigned,EXPRESSION *);
 142 static unsigned DefmethodWatchPrint(void *,const char *,int,EXPRESSION *);
 143 static unsigned DefmethodWatchSupport(void *,const char *,const char *,unsigned,
 144                                      void (*)(void *,const char *,void *,long),
 145                                      void (*)(void *,unsigned,void *,long),
 146                                      EXPRESSION *);
 147 static void PrintMethodWatchFlag(void *,const char *,void *,long);
 148 #endif
 149
 150 /* =========================================
 151    *****************************************
 152           EXTERNALLY VISIBLE FUNCTIONS
 153    =========================================
 154    ***************************************** */
 155
 156 /***********************************************************
 157   NAME         : SetupGenericFunctions
 158   DESCRIPTION  : Initializes all generic function
 159                    data structures, constructs and functions
 160   INPUTS       : None
 161   RETURNS      : Nothing useful
 162   SIDE EFFECTS : Generic function H/L functions set up
 163   NOTES        : None
 164  ***********************************************************/
 165 globle void SetupGenericFunctions(
 166   void *theEnv)
 167   {
 168    ENTITY_RECORD genericEntityRecord =
 169                      { "GCALL", GCALL,0,0,1,
 170                        PrintGenericCall,PrintGenericCall,
 171                        NULL,EvaluateGenericCall,NULL,
 172                        DecrementGenericBusyCount,IncrementGenericBusyCount,
 173                        NULL,NULL,NULL,NULL,NULL };
 174
 175    AllocateEnvironmentData(theEnv,DEFGENERIC_DATA,sizeof(struct defgenericData),DeallocateDefgenericData);
 176    memcpy(&DefgenericData(theEnv)->GenericEntityRecord,&genericEntityRecord,sizeof(struct entityRecord));
 177
 178    InstallPrimitive(theEnv,&DefgenericData(theEnv)->GenericEntityRecord,GCALL);
 179
 180    DefgenericData(theEnv)->DefgenericModuleIndex =
 181                 RegisterModuleItem(theEnv,"defgeneric",
 182 #if (! RUN_TIME)
 183                                     AllocateDefgenericModule,FreeDefgenericModule,
 184 #else
 185                                     NULL,NULL,
 186 #endif
 187 #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
 188                                     BloadDefgenericModuleReference,
 189 #else
 190                                     NULL,
 191 #endif
 192 #if CONSTRUCT_COMPILER && (! RUN_TIME)
 193                                     DefgenericCModuleReference,
 194 #else
 195                                     NULL,
 196 #endif
 197                                     EnvFindDefgenericInModule);
 198
 199    DefgenericData(theEnv)->DefgenericConstruct =  AddConstruct(theEnv,"defgeneric","defgenerics",
 200 #if (! BLOAD_ONLY) && (! RUN_TIME)
 201                                        ParseDefgeneric,
 202 #else
 203                                        NULL,
 204 #endif
 205                                        EnvFindDefgeneric,
 206                                        GetConstructNamePointer,GetConstructPPForm,
 207                                        GetConstructModuleItem,EnvGetNextDefgeneric,
 208                                        SetNextConstruct,EnvIsDefgenericDeletable,
 209                                        EnvUndefgeneric,
 210 #if (! BLOAD_ONLY) && (! RUN_TIME)
 211                                        RemoveDefgeneric
 212 #else
 213                                        NULL
 214 #endif
 215                                        );
 216
 217 #if ! RUN_TIME
 218    AddClearReadyFunction(theEnv,"defgeneric",ClearDefgenericsReady,0);
 219
 220 #if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
 221    SetupGenericsBload(theEnv);
 222 #endif
 223
 224 #if CONSTRUCT_COMPILER
 225    SetupGenericsCompiler(theEnv);
 226 #endif
 227
 228 #if ! BLOAD_ONLY
 229 #if DEFMODULE_CONSTRUCT
 230    AddPortConstructItem(theEnv,"defgeneric",SYMBOL);
 231 #endif
 232    AddConstruct(theEnv,"defmethod","defmethods",ParseDefmethod,
 233                 NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
 234
 235   /* ================================================================
 236      Make sure defmethods are cleared last, for other constructs may
 237        be using them and need to be cleared first
 238
 239      Need to be cleared in two stages so that mutually dependent
 240        constructs (like classes) can be cleared
 241      ================================================================ */
 242    AddSaveFunction(theEnv,"defgeneric",SaveDefgenerics,1000);
 243    AddSaveFunction(theEnv,"defmethod",SaveDefmethods,-1000);
 244    EnvDefineFunction2(theEnv,"undefgeneric",'v',PTIEF UndefgenericCommand,"UndefgenericCommand","11w");
 245    EnvDefineFunction2(theEnv,"undefmethod",'v',PTIEF UndefmethodCommand,"UndefmethodCommand","22*wg");
 246 #endif
 247
 248    EnvDefineFunction2(theEnv,"call-next-method",'u',PTIEF CallNextMethod,"CallNextMethod","00");
 249    FuncSeqOvlFlags(theEnv,"call-next-method",TRUE,FALSE);
 250    EnvDefineFunction2(theEnv,"call-specific-method",'u',PTIEF CallSpecificMethod,
 251                    "CallSpecificMethod","2**wi");
 252    FuncSeqOvlFlags(theEnv,"call-specific-method",TRUE,FALSE);
 253    EnvDefineFunction2(theEnv,"override-next-method",'u',PTIEF OverrideNextMethod,
 254                    "OverrideNextMethod",NULL);
 255    FuncSeqOvlFlags(theEnv,"override-next-method",TRUE,FALSE);
 256    EnvDefineFunction2(theEnv,"next-methodp",'b',PTIEF NextMethodP,"NextMethodP","00");
 257    FuncSeqOvlFlags(theEnv,"next-methodp",TRUE,FALSE);
 258
 259    EnvDefineFunction2(theEnv,"(gnrc-current-arg)",'u',PTIEF GetGenericCurrentArgument,
 260                    "GetGenericCurrentArgument",NULL);
 261
 262 #if DEBUGGING_FUNCTIONS
 263    EnvDefineFunction2(theEnv,"ppdefgeneric",'v',PTIEF PPDefgenericCommand,"PPDefgenericCommand","11w");
 264    EnvDefineFunction2(theEnv,"list-defgenerics",'v',PTIEF ListDefgenericsCommand,"ListDefgenericsCommand","01");
 265    EnvDefineFunction2(theEnv,"ppdefmethod",'v',PTIEF PPDefmethodCommand,"PPDefmethodCommand","22*wi");
 266    EnvDefineFunction2(theEnv,"list-defmethods",'v',PTIEF ListDefmethodsCommand,"ListDefmethodsCommand","01w");
 267    EnvDefineFunction2(theEnv,"preview-generic",'v',PTIEF PreviewGeneric,"PreviewGeneric","1**w");
 268 #endif
 269
 270    EnvDefineFunction2(theEnv,"get-defgeneric-list",'m',PTIEF GetDefgenericListFunction,
 271                    "GetDefgenericListFunction","01");
 272    EnvDefineFunction2(theEnv,"get-defmethod-list",'m',PTIEF GetDefmethodListCommand,
 273                    "GetDefmethodListCommand","01w");
 274    EnvDefineFunction2(theEnv,"get-method-restrictions",'m',PTIEF GetMethodRestrictionsCommand,
 275                    "GetMethodRestrictionsCommand","22iw");
 276    EnvDefineFunction2(theEnv,"defgeneric-module",'w',PTIEF GetDefgenericModuleCommand,
 277                    "GetDefgenericModuleCommand","11w");
 278
 279 #if OBJECT_SYSTEM
 280    EnvDefineFunction2(theEnv,"type",'u',PTIEF ClassCommand,"ClassCommand","11u");
 281 #else
 282    EnvDefineFunction2(theEnv,"type",'u',PTIEF TypeCommand,"TypeCommand","11u");
 283 #endif
 284
 285 #endif
 286
 287 #if DEBUGGING_FUNCTIONS
 288    AddWatchItem(theEnv,"generic-functions",0,&DefgenericData(theEnv)->WatchGenerics,34,
 289                 DefgenericWatchAccess,DefgenericWatchPrint);
 290    AddWatchItem(theEnv,"methods",0,&DefgenericData(theEnv)->WatchMethods,33,
 291                 DefmethodWatchAccess,DefmethodWatchPrint);
 292 #endif
 293   }
 294
 295 /*****************************************************/
 296 /* DeallocateDefgenericData: Deallocates environment */
 297 /*    data for the defgeneric construct.             */
 298 /*****************************************************/
 299 static void DeallocateDefgenericData(
 300   void *theEnv)
 301   {
 302 #if ! RUN_TIME
 303    struct defgenericModule *theModuleItem;
 304    void *theModule;
 305
 306 #if BLOAD || BLOAD_AND_BSAVE
 307    if (Bloaded(theEnv)) return;
 308 #endif
 309
 310    DoForAllConstructs(theEnv,DestroyDefgenericAction,DefgenericData(theEnv)->DefgenericModuleIndex,FALSE,NULL);
 311
 312    for (theModule = EnvGetNextDefmodule(theEnv,NULL);
 313         theModule != NULL;
 314         theModule = EnvGetNextDefmodule(theEnv,theModule))
 315      {
 316       theModuleItem = (struct defgenericModule *)
 317                       GetModuleItem(theEnv,(struct defmodule *) theModule,
 318                                     DefgenericData(theEnv)->DefgenericModuleIndex);
 319
 320       rtn_struct(theEnv,defgenericModule,theModuleItem);
 321      }
 322 #else
 323 #if MAC_XCD
 324 #pragma unused(theEnv)
 325 #endif
 326 #endif
 327   }
 328
 329 #if ! RUN_TIME
 330 /****************************************************/
 331 /* DestroyDefgenericAction: Action used to remove   */
 332 /*   defgenerics as a result of DestroyEnvironment. */
 333 /****************************************************/
 334 static void DestroyDefgenericAction(
 335   void *theEnv,
 336   struct constructHeader *theConstruct,
 337   void *buffer)
 338   {
 339 #if MAC_XCD
 340 #pragma unused(buffer)
 341 #endif
 342 #if (! BLOAD_ONLY) && (! RUN_TIME)
 343    struct defgeneric *theDefgeneric = (struct defgeneric *) theConstruct;
 344    long i;
 345
 346    if (theDefgeneric == NULL) return;
 347
 348    for (i = 0 ; i < theDefgeneric->mcnt ; i++)
 349      { DestroyMethodInfo(theEnv,theDefgeneric,&theDefgeneric->methods[i]); }
 350
 351    if (theDefgeneric->mcnt != 0)
 352      rm(theEnv,(void *) theDefgeneric->methods,(sizeof(DEFMETHOD) * theDefgeneric->mcnt));
 353
 354    DestroyConstructHeader(theEnv,&theDefgeneric->header);
 355
 356    rtn_struct(theEnv,defgeneric,theDefgeneric);
 357 #else
 358 #if MAC_XCD
 359 #pragma unused(theEnv,theConstruct)
 360 #endif
 361 #endif
 362   }
 363 #endif
 364
 365 /***************************************************
 366   NAME         : EnvFindDefgeneric
 367   DESCRIPTION  : Searches for a generic
 368   INPUTS       : The name of the generic
 369                  (possibly including a module name)
 370   RETURNS      : Pointer to the generic if
 371                  found, otherwise NULL
 372   SIDE EFFECTS : None
 373   NOTES        : None
 374  ***************************************************/
 375 globle void *EnvFindDefgeneric(
 376   void *theEnv,
 377   const char *genericModuleAndName)
 378   {
 379    return(FindNamedConstructInModuleOrImports(theEnv,genericModuleAndName,DefgenericData(theEnv)->DefgenericConstruct));
 380   }
 381
 382 /***************************************************
 383   NAME         : EnvFindDefgenericInModule
 384   DESCRIPTION  : Searches for a generic
 385   INPUTS       : The name of the generic
 386                  (possibly including a module name)
 387   RETURNS      : Pointer to the generic if
 388                  found, otherwise NULL
 389   SIDE EFFECTS : None
 390   NOTES        : None
 391  ***************************************************/
 392 globle void *EnvFindDefgenericInModule(
 393   void *theEnv,
 394   const char *genericModuleAndName)
 395   {
 396    return(FindNamedConstructInModule(theEnv,genericModuleAndName,DefgenericData(theEnv)->DefgenericConstruct));
 397   }
 398
 399 /***************************************************
 400   NAME         : LookupDefgenericByMdlOrScope
 401   DESCRIPTION  : Finds a defgeneric anywhere (if
 402                  module is specified) or in current
 403                  or imported modules
 404   INPUTS       : The defgeneric name
 405   RETURNS      : The defgeneric (NULL if not found)
 406   SIDE EFFECTS : Error message printed on
 407                   ambiguous references
 408   NOTES        : None
 409  ***************************************************/
 410 globle DEFGENERIC *LookupDefgenericByMdlOrScope(
 411   void *theEnv,
 412   const char *defgenericName)
 413   {
 414    return((DEFGENERIC *) LookupConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,defgenericName,TRUE));
 415   }
 416
 417 /***************************************************
 418   NAME         : LookupDefgenericInScope
 419   DESCRIPTION  : Finds a defgeneric in current or
 420                    imported modules (module
 421                    specifier is not allowed)
 422   INPUTS       : The defgeneric name
 423   RETURNS      : The defgeneric (NULL if not found)
 424   SIDE EFFECTS : Error message printed on
 425                   ambiguous references
 426   NOTES        : None
 427  ***************************************************/
 428 globle DEFGENERIC *LookupDefgenericInScope(
 429   void *theEnv,
 430   const char *defgenericName)
 431   {
 432    return((DEFGENERIC *) LookupConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,defgenericName,FALSE));
 433   }
 434
 435 /***********************************************************
 436   NAME         : EnvGetNextDefgeneric
 437   DESCRIPTION  : Finds first or next generic function
 438   INPUTS       : The address of the current generic function
 439   RETURNS      : The address of the next generic function
 440                    (NULL if none)
 441   SIDE EFFECTS : None
 442   NOTES        : If ptr == NULL, the first generic function
 443                     is returned.
 444  ***********************************************************/
 445 globle void *EnvGetNextDefgeneric(
 446   void *theEnv,
 447   void *ptr)
 448   {
 449    return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) ptr,DefgenericData(theEnv)->DefgenericModuleIndex));
 450   }
 451
 452 /***********************************************************
 453   NAME         : EnvGetNextDefmethod
 454   DESCRIPTION  : Find the next method for a generic function
 455   INPUTS       : 1) The generic function address
 456                  2) The index of the current method
 457   RETURNS      : The index of the next method
 458                     (0 if none)
 459   SIDE EFFECTS : None
 460   NOTES        : If index == 0, the index of the first
 461                    method is returned
 462  ***********************************************************/
 463 globle long EnvGetNextDefmethod(
 464   void *theEnv,
 465   void *ptr,
 466   long theIndex)
 467   {
 468    DEFGENERIC *gfunc;
 469    long mi;
 470 #if MAC_XCD
 471 #pragma unused(theEnv)
 472 #endif
 473
 474    gfunc = (DEFGENERIC *) ptr;
 475    if (theIndex == 0)
 476      {
 477       if (gfunc->methods != NULL)
 478         return(gfunc->methods[0].index);
 479       return(0);
 480      }
 481    mi = FindMethodByIndex(gfunc,theIndex);
 482    if ((mi+1) == gfunc->mcnt)
 483      return(0);
 484    return(gfunc->methods[mi+1].index);
 485   }
 486
 487 /*****************************************************
 488   NAME         : GetDefmethodPointer
 489   DESCRIPTION  : Returns a pointer to a method
 490   INPUTS       : 1) Pointer to a defgeneric
 491                  2) Array index of method in generic's
 492                     method array (+1)
 493   RETURNS      : Pointer to the method.
 494   SIDE EFFECTS : None
 495   NOTES        : None
 496  *****************************************************/
 497 globle DEFMETHOD *GetDefmethodPointer(
 498   void *ptr,
 499   long theIndex)
 500   {
 501    return(&((DEFGENERIC *) ptr)->methods[theIndex-1]);
 502   }
 503
 504 /***************************************************
 505   NAME         : EnvIsDefgenericDeletable
 506   DESCRIPTION  : Determines if a generic function
 507                    can be deleted
 508   INPUTS       : Address of the generic function
 509   RETURNS      : TRUE if deletable, FALSE otherwise
 510   SIDE EFFECTS : None
 511   NOTES        : None
 512  ***************************************************/
 513 globle int EnvIsDefgenericDeletable(
 514   void *theEnv,
 515   void *ptr)
 516   {
 517    if (! ConstructsDeletable(theEnv))
 518      { return FALSE; }
 519
 520    return ((((DEFGENERIC *) ptr)->busy == 0) ? TRUE : FALSE);
 521   }
 522
 523 /***************************************************
 524   NAME         : EnvIsDefmethodDeletable
 525   DESCRIPTION  : Determines if a generic function
 526                    method can be deleted
 527   INPUTS       : 1) Address of the generic function
 528                  2) Index of the method
 529   RETURNS      : TRUE if deletable, FALSE otherwise
 530   SIDE EFFECTS : None
 531   NOTES        : None
 532  ***************************************************/
 533 globle int EnvIsDefmethodDeletable(
 534   void *theEnv,
 535   void *ptr,
 536   long theIndex)
 537   {
 538    if (! ConstructsDeletable(theEnv))
 539      { return FALSE; }
 540
 541    if (((DEFGENERIC *) ptr)->methods[FindMethodByIndex((DEFGENERIC *) ptr,theIndex)].system)
 542      return(FALSE);
 543
 544 #if (! BLOAD_ONLY) && (! RUN_TIME)
 545    return((MethodsExecuting((DEFGENERIC *) ptr) == FALSE) ? TRUE : FALSE);
 546 #else
 547    return FALSE;
 548 #endif
 549   }
 550
 551 /**********************************************************
 552   NAME         : UndefgenericCommand
 553   DESCRIPTION  : Deletes all methods for a generic function
 554   INPUTS       : None
 555   RETURNS      : Nothing useful
 556   SIDE EFFECTS : methods deallocated
 557   NOTES        : H/L Syntax: (undefgeneric <name> | *)
 558  **********************************************************/
 559 globle void UndefgenericCommand(
 560   void *theEnv)
 561   {
 562    UndefconstructCommand(theEnv,"undefgeneric",DefgenericData(theEnv)->DefgenericConstruct);
 563   }
 564
 565 /****************************************************************
 566   NAME         : GetDefgenericModuleCommand
 567   DESCRIPTION  : Determines to which module a defgeneric belongs
 568   INPUTS       : None
 569   RETURNS      : The symbolic name of the module
 570   SIDE EFFECTS : None
 571   NOTES        : H/L Syntax: (defgeneric-module <generic-name>)
 572  ****************************************************************/
 573 globle void *GetDefgenericModuleCommand(
 574   void *theEnv)
 575   {
 576    return(GetConstructModuleCommand(theEnv,"defgeneric-module",DefgenericData(theEnv)->DefgenericConstruct));
 577   }
 578
 579 /**************************************************************
 580   NAME         : UndefmethodCommand
 581   DESCRIPTION  : Deletes one method for a generic function
 582   INPUTS       : None
 583   RETURNS      : Nothing useful
 584   SIDE EFFECTS : methods deallocated
 585   NOTES        : H/L Syntax: (undefmethod <name> <index> | *)
 586  **************************************************************/
 587 globle void UndefmethodCommand(
 588   void *theEnv)
 589   {
 590    DATA_OBJECT temp;
 591    DEFGENERIC *gfunc;
 592    long mi;
 593
 594    if (EnvArgTypeCheck(theEnv,"undefmethod",1,SYMBOL,&temp) == FALSE)
 595      return;
 596    gfunc = LookupDefgenericByMdlOrScope(theEnv,DOToString(temp));
 597    if ((gfunc == NULL) ? (strcmp(DOToString(temp),"*") != 0) : FALSE)
 598      {
 599       PrintErrorID(theEnv,"GENRCCOM",1,FALSE);
 600       EnvPrintRouter(theEnv,WERROR,"No such generic function ");
 601       EnvPrintRouter(theEnv,WERROR,DOToString(temp));
 602       EnvPrintRouter(theEnv,WERROR," in function undefmethod.\n");
 603       return;
 604      }
 605    EnvRtnUnknown(theEnv,2,&temp);
 606    if (temp.type == SYMBOL)
 607      {
 608       if (strcmp(DOToString(temp),"*") != 0)
 609         {
 610          PrintErrorID(theEnv,"GENRCCOM",2,FALSE);
 611          EnvPrintRouter(theEnv,WERROR,"Expected a valid method index in function undefmethod.\n");
 612          return;
 613         }
 614       mi = 0;
 615      }
 616    else if (temp.type == INTEGER)
 617      {
 618       mi = (long) DOToLong(temp);
 619       if (mi == 0)
 620         {
 621          PrintErrorID(theEnv,"GENRCCOM",2,FALSE);
 622          EnvPrintRouter(theEnv,WERROR,"Expected a valid method index in function undefmethod.\n");
 623          return;
 624         }
 625      }
 626    else
 627      {
 628       PrintErrorID(theEnv,"GENRCCOM",2,FALSE);
 629       EnvPrintRouter(theEnv,WERROR,"Expected a valid method index in function undefmethod.\n");
 630       return;
 631      }
 632    EnvUndefmethod(theEnv,(void *) gfunc,mi);
 633   }
 634
 635 /**************************************************************
 636   NAME         : EnvUndefgeneric
 637   DESCRIPTION  : Deletes all methods for a generic function
 638   INPUTS       : The generic-function address (NULL for all)
 639   RETURNS      : TRUE if generic successfully deleted,
 640                  FALSE otherwise
 641   SIDE EFFECTS : methods deallocated
 642   NOTES        : None
 643  **************************************************************/
 644 globle intBool EnvUndefgeneric(
 645   void *theEnv,
 646   void *vptr)
 647   {
 648 #if RUN_TIME || BLOAD_ONLY
 649    return(FALSE);
 650 #else
 651    DEFGENERIC *gfunc;
 652    int success = TRUE;
 653
 654    gfunc = (DEFGENERIC *) vptr;
 655    if (gfunc == NULL)
 656      {
 657       if (ClearDefmethods(theEnv) == FALSE)
 658         success = FALSE;
 659       if (ClearDefgenerics(theEnv) == FALSE)
 660         success = FALSE;
 661       return(success);
 662      }
 663    if (EnvIsDefgenericDeletable(theEnv,vptr) == FALSE)
 664      return(FALSE);
 665    RemoveConstructFromModule(theEnv,(struct constructHeader *) vptr);
 666    RemoveDefgeneric(theEnv,gfunc);
 667    return(TRUE);
 668 #endif
 669   }
 670
 671 /**************************************************************
 672   NAME         : EnvUndefmethod
 673   DESCRIPTION  : Deletes one method for a generic function
 674   INPUTS       : 1) Address of generic function (can be NULL)
 675                  2) Method index (0 for all)
 676   RETURNS      : TRUE if method deleted successfully,
 677                  FALSE otherwise
 678   SIDE EFFECTS : methods deallocated
 679   NOTES        : None
 680  **************************************************************/
 681 globle intBool EnvUndefmethod(
 682   void *theEnv,
 683   void *vptr,
 684   long mi)
 685   {
 686    DEFGENERIC *gfunc;
 687
 688 #if RUN_TIME || BLOAD_ONLY
 689    gfunc = (DEFGENERIC *) vptr;
 690    PrintErrorID(theEnv,"PRNTUTIL",4,FALSE);
 691    EnvPrintRouter(theEnv,WERROR,"Unable to delete method ");
 692    if (gfunc != NULL)
 693      {
 694       PrintGenericName(theEnv,WERROR,gfunc);
 695       EnvPrintRouter(theEnv,WERROR," #");
 696       PrintLongInteger(theEnv,WERROR,(long long) mi);
 697      }
 698    else
 699      EnvPrintRouter(theEnv,WERROR,"*");
 700    EnvPrintRouter(theEnv,WERROR,".\n");
 701    return(FALSE);
 702 #else
 703    long nmi;
 704
 705    gfunc = (DEFGENERIC *) vptr;
 706 #if BLOAD || BLOAD_AND_BSAVE
 707    if (Bloaded(theEnv) == TRUE)
 708      {
 709       PrintErrorID(theEnv,"PRNTUTIL",4,FALSE);
 710       EnvPrintRouter(theEnv,WERROR,"Unable to delete method ");
 711       if (gfunc != NULL)
 712         {
 713          EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc));
 714          EnvPrintRouter(theEnv,WERROR," #");
 715          PrintLongInteger(theEnv,WERROR,(long long) mi);
 716         }
 717       else
 718         EnvPrintRouter(theEnv,WERROR,"*");
 719       EnvPrintRouter(theEnv,WERROR,".\n");
 720       return(FALSE);
 721      }
 722 #endif
 723    if (gfunc == NULL)
 724      {
 725       if (mi != 0)
 726         {
 727          PrintErrorID(theEnv,"GENRCCOM",3,FALSE);
 728          EnvPrintRouter(theEnv,WERROR,"Incomplete method specification for deletion.\n");
 729          return(FALSE);
 730         }
 731       return(ClearDefmethods(theEnv));
 732      }
 733    if (MethodsExecuting(gfunc))
 734      {
 735       MethodAlterError(theEnv,gfunc);
 736       return(FALSE);
 737      }
 738    if (mi == 0)
 739      RemoveAllExplicitMethods(theEnv,gfunc);
 740    else
 741      {
 742       nmi = CheckMethodExists(theEnv,"undefmethod",gfunc,mi);
 743       if (nmi == -1)
 744         return(FALSE);
 745       RemoveDefgenericMethod(theEnv,gfunc,nmi);
 746      }
 747    return(TRUE);
 748 #endif
 749   }
 750
 751 #if DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS
 752
 753 /*****************************************************
 754   NAME         : EnvGetDefmethodDescription
 755   DESCRIPTION  : Prints a synopsis of method parameter
 756                    restrictions into caller's buffer
 757   INPUTS       : 1) Caller's buffer
 758                  2) Buffer size (not including space
 759                     for terminating '\0')
 760                  3) Address of generic function
 761                  4) Index of method
 762   RETURNS      : Nothing useful
 763   SIDE EFFECTS : Caller's buffer written
 764   NOTES        : Terminating '\n' not written
 765  *****************************************************/
 766 globle void EnvGetDefmethodDescription(
 767   void *theEnv,
 768   char *buf,
 769   size_t buflen,
 770   void *ptr,
 771   long theIndex)
 772   {
 773    DEFGENERIC *gfunc;
 774    long mi;
 775 #if MAC_XCD
 776 #pragma unused(theEnv)
 777 #endif
 778
 779    gfunc = (DEFGENERIC *) ptr;
 780    mi = FindMethodByIndex(gfunc,theIndex);
 781    PrintMethod(theEnv,buf,buflen,&gfunc->methods[mi]);
 782   }
 783 #endif /* DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS */
 784
 785 #if DEBUGGING_FUNCTIONS
 786
 787 /*********************************************************
 788   NAME         : EnvGetDefgenericWatch
 789   DESCRIPTION  : Determines if trace messages are
 790                  gnerated when executing generic function
 791   INPUTS       : A pointer to the generic
 792   RETURNS      : TRUE if a trace is active,
 793                  FALSE otherwise
 794   SIDE EFFECTS : None
 795   NOTES        : None
 796  *********************************************************/
 797 globle unsigned EnvGetDefgenericWatch(
 798   void *theEnv,
 799   void *theGeneric)
 800   {
 801 #if MAC_XCD
 802 #pragma unused(theEnv)
 803 #endif
 804
 805    return(((DEFGENERIC *) theGeneric)->trace);
 806   }
 807
 808 /*********************************************************
 809   NAME         : EnvSetDefgenericWatch
 810   DESCRIPTION  : Sets the trace to ON/OFF for the
 811                  generic function
 812   INPUTS       : 1) TRUE to set the trace on,
 813                     FALSE to set it off
 814                  2) A pointer to the generic
 815   RETURNS      : Nothing useful
 816   SIDE EFFECTS : Watch flag for the generic set
 817   NOTES        : None
 818  *********************************************************/
 819 globle void EnvSetDefgenericWatch(
 820   void *theEnv,
 821   unsigned newState,
 822   void *theGeneric)
 823   {
 824 #if MAC_XCD
 825 #pragma unused(theEnv)
 826 #endif
 827
 828    ((DEFGENERIC *) theGeneric)->trace = newState;
 829   }
 830
 831 /*********************************************************
 832   NAME         : EnvGetDefmethodWatch
 833   DESCRIPTION  : Determines if trace messages for calls
 834                  to this method will be generated or not
 835   INPUTS       : 1) A pointer to the generic
 836                  2) The index of the method
 837   RETURNS      : TRUE if a trace is active,
 838                  FALSE otherwise
 839   SIDE EFFECTS : None
 840   NOTES        : None
 841  *********************************************************/
 842 globle unsigned EnvGetDefmethodWatch(
 843   void *theEnv,
 844   void *theGeneric,
 845   long theIndex)
 846   {
 847    DEFGENERIC *gfunc;
 848    long mi;
 849 #if MAC_XCD
 850 #pragma unused(theEnv)
 851 #endif
 852
 853    gfunc = (DEFGENERIC *) theGeneric;
 854    mi = FindMethodByIndex(gfunc,theIndex);
 855    return(gfunc->methods[mi].trace);
 856   }
 857
 858 /*********************************************************
 859   NAME         : EnvSetDefmethodWatch
 860   DESCRIPTION  : Sets the trace to ON/OFF for the
 861                  calling of the method
 862   INPUTS       : 1) TRUE to set the trace on,
 863                     FALSE to set it off
 864                  2) A pointer to the generic
 865                  3) The index of the method
 866   RETURNS      : Nothing useful
 867   SIDE EFFECTS : Watch flag for the method set
 868   NOTES        : None
 869  *********************************************************/
 870 globle void EnvSetDefmethodWatch(
 871   void *theEnv,
 872   unsigned newState,
 873   void *theGeneric,
 874   long theIndex)
 875   {
 876    DEFGENERIC *gfunc;
 877    long mi;
 878 #if MAC_XCD
 879 #pragma unused(theEnv)
 880 #endif
 881
 882    gfunc = (DEFGENERIC *) theGeneric;
 883    mi = FindMethodByIndex(gfunc,theIndex);
 884    gfunc->methods[mi].trace = newState;
 885   }
 886
 887
 888 /********************************************************
 889   NAME         : PPDefgenericCommand
 890   DESCRIPTION  : Displays the pretty-print form of
 891                   a generic function header
 892   INPUTS       : None
 893   RETURNS      : Nothing useful
 894   SIDE EFFECTS : None
 895   NOTES        : H/L Syntax: (ppdefgeneric <name>)
 896  ********************************************************/
 897 globle void PPDefgenericCommand(
 898   void *theEnv)
 899   {
 900    PPConstructCommand(theEnv,"ppdefgeneric",DefgenericData(theEnv)->DefgenericConstruct);
 901   }
 902
 903 /**********************************************************
 904   NAME         : PPDefmethodCommand
 905   DESCRIPTION  : Displays the pretty-print form of
 906                   a method
 907   INPUTS       : None
 908   RETURNS      : Nothing useful
 909   SIDE EFFECTS : None
 910   NOTES        : H/L Syntax: (ppdefmethod <name> <index>)
 911  **********************************************************/
 912 globle void PPDefmethodCommand(
 913   void *theEnv)
 914   {
 915    DATA_OBJECT temp;
 916    const char *gname;
 917    DEFGENERIC *gfunc;
 918    int gi;
 919
 920    if (EnvArgTypeCheck(theEnv,"ppdefmethod",1,SYMBOL,&temp) == FALSE)
 921      return;
 922    gname = DOToString(temp);
 923    if (EnvArgTypeCheck(theEnv,"ppdefmethod",2,INTEGER,&temp) == FALSE)
 924      return;
 925    gfunc = CheckGenericExists(theEnv,"ppdefmethod",gname);
 926    if (gfunc == NULL)
 927      return;
 928    gi = CheckMethodExists(theEnv,"ppdefmethod",gfunc,(long) DOToLong(temp));
 929    if (gi == -1)
 930      return;
 931    if (gfunc->methods[gi].ppForm != NULL)
 932      PrintInChunks(theEnv,WDISPLAY,gfunc->methods[gi].ppForm);
 933   }
 934
 935 /******************************************************
 936   NAME         : ListDefmethodsCommand
 937   DESCRIPTION  : Lists a brief description of methods
 938                    for a particular generic function
 939   INPUTS       : None
 940   RETURNS      : Nothing useful
 941   SIDE EFFECTS : None
 942   NOTES        : H/L Syntax: (list-defmethods <name>)
 943  ******************************************************/
 944 globle void ListDefmethodsCommand(
 945   void *theEnv)
 946   {
 947    DATA_OBJECT temp;
 948    DEFGENERIC *gfunc;
 949
 950    if (EnvRtnArgCount(theEnv) == 0)
 951      EnvListDefmethods(theEnv,WDISPLAY,NULL);
 952    else
 953      {
 954       if (EnvArgTypeCheck(theEnv,"list-defmethods",1,SYMBOL,&temp) == FALSE)
 955         return;
 956       gfunc = CheckGenericExists(theEnv,"list-defmethods",DOToString(temp));
 957       if (gfunc != NULL)
 958         EnvListDefmethods(theEnv,WDISPLAY,(void *) gfunc);
 959      }
 960   }
 961
 962 /***************************************************************
 963   NAME         : EnvGetDefmethodPPForm
 964   DESCRIPTION  : Getsa generic function method pretty print form
 965   INPUTS       : 1) Address of the generic function
 966                  2) Index of the method
 967   RETURNS      : Method ppform
 968   SIDE EFFECTS : None
 969   NOTES        : None
 970  ***************************************************************/
 971 globle const char *EnvGetDefmethodPPForm(
 972   void *theEnv,
 973   void *ptr,
 974   long theIndex)
 975   {
 976    DEFGENERIC *gfunc;
 977    int mi;
 978 #if MAC_XCD
 979 #pragma unused(theEnv)
 980 #endif
 981
 982    gfunc = (DEFGENERIC *) ptr;
 983    mi = FindMethodByIndex(gfunc,theIndex);
 984    return(gfunc->methods[mi].ppForm);
 985   }
 986
 987 /***************************************************
 988   NAME         : ListDefgenericsCommand
 989   DESCRIPTION  : Displays all defgeneric names
 990   INPUTS       : None
 991   RETURNS      : Nothing useful
 992   SIDE EFFECTS : Defgeneric names printed
 993   NOTES        : H/L Interface
 994  ***************************************************/
 995 globle void ListDefgenericsCommand(
 996   void *theEnv)
 997   {
 998    ListConstructCommand(theEnv,"list-defgenerics",DefgenericData(theEnv)->DefgenericConstruct);
 999   }
1000
1001 /***************************************************
1002   NAME         : EnvListDefgenerics
1003   DESCRIPTION  : Displays all defgeneric names
1004   INPUTS       : 1) The logical name of the output
1005                  2) The module
1006   RETURNS      : Nothing useful
1007   SIDE EFFECTS : Defgeneric names printed
1008   NOTES        : C Interface
1009  ***************************************************/
1010 globle void EnvListDefgenerics(
1011   void *theEnv,
1012   const char *logicalName,
1013   struct defmodule *theModule)
1014   {
1015    ListConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,logicalName,theModule);
1016   }
1017
1018 /******************************************************
1019   NAME         : EnvListDefmethods
1020   DESCRIPTION  : Lists a brief description of methods
1021                    for a particular generic function
1022   INPUTS       : 1) The logical name of the output
1023                  2) Generic function to list methods for
1024                     (NULL means list all methods)
1025   RETURNS      : Nothing useful
1026   SIDE EFFECTS : None
1027   NOTES        : None
1028  ******************************************************/
1029 globle void EnvListDefmethods(
1030   void *theEnv,
1031   const char *logicalName,
1032   void *vptr)
1033   {
1034    DEFGENERIC *gfunc;
1035    long count;
1036    if (vptr != NULL)
1037      count = ListMethodsForGeneric(theEnv,logicalName,(DEFGENERIC *) vptr);
1038    else
1039      {
1040       count = 0L;
1041       for (gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL) ;
1042            gfunc != NULL ;
1043            gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc))
1044         {
1045          count += ListMethodsForGeneric(theEnv,logicalName,gfunc);
1046          if (EnvGetNextDefgeneric(theEnv,(void *) gfunc) != NULL)
1047            EnvPrintRouter(theEnv,logicalName,"\n");
1048         }
1049      }
1050    PrintTally(theEnv,logicalName,count,"method","methods");
1051   }
1052
1053 #endif /* DEBUGGING_FUNCTIONS */
1054
1055 /***************************************************************
1056   NAME         : GetDefgenericListFunction
1057   DESCRIPTION  : Groups all defgeneric names into
1058                  a multifield list
1059   INPUTS       : A data object buffer to hold
1060                  the multifield result
1061   RETURNS      : Nothing useful
1062   SIDE EFFECTS : Multifield allocated and filled
1063   NOTES        : H/L Syntax: (get-defgeneric-list [<module>])
1064  ***************************************************************/
1065 globle void GetDefgenericListFunction(
1066   void *theEnv,
1067   DATA_OBJECT*returnValue)
1068   {
1069    GetConstructListFunction(theEnv,"get-defgeneric-list",returnValue,DefgenericData(theEnv)->DefgenericConstruct);
1070   }
1071
1072 /***************************************************************
1073   NAME         : EnvGetDefgenericList
1074   DESCRIPTION  : Groups all defgeneric names into
1075                  a multifield list
1076   INPUTS       : 1) A data object buffer to hold
1077                     the multifield result
1078                  2) The module from which to obtain defgenerics
1079   RETURNS      : Nothing useful
1080   SIDE EFFECTS : Multifield allocated and filled
1081   NOTES        : External C access
1082  ***************************************************************/
1083 globle void EnvGetDefgenericList(
1084   void *theEnv,
1085   DATA_OBJECT *returnValue,
1086   struct defmodule *theModule)
1087   {
1088    GetConstructList(theEnv,returnValue,DefgenericData(theEnv)->DefgenericConstruct,theModule);
1089   }
1090
1091 /***********************************************************
1092   NAME         : GetDefmethodListCommand
1093   DESCRIPTION  : Groups indices of all methdos for a generic
1094                  function into a multifield variable
1095                  (NULL means get methods for all generics)
1096   INPUTS       : A data object buffer
1097   RETURNS      : Nothing useful
1098   SIDE EFFECTS : Multifield set to list of method indices
1099   NOTES        : None
1100  ***********************************************************/
1101 globle void GetDefmethodListCommand(
1102   void *theEnv,
1103   DATA_OBJECT_PTR returnValue)
1104   {
1105    DATA_OBJECT temp;
1106    DEFGENERIC *gfunc;
1107
1108    if (EnvRtnArgCount(theEnv) == 0)
1109      EnvGetDefmethodList(theEnv,NULL,returnValue);
1110    else
1111      {
1112       if (EnvArgTypeCheck(theEnv,"get-defmethod-list",1,SYMBOL,&temp) == FALSE)
1113         {
1114          EnvSetMultifieldErrorValue(theEnv,returnValue);
1115          return;
1116         }
1117       gfunc = CheckGenericExists(theEnv,"get-defmethod-list",DOToString(temp));
1118       if (gfunc != NULL)
1119         EnvGetDefmethodList(theEnv,(void *) gfunc,returnValue);
1120       else
1121         EnvSetMultifieldErrorValue(theEnv,returnValue);
1122      }
1123   }
1124
1125 /***********************************************************
1126   NAME         : EnvGetDefmethodList
1127   DESCRIPTION  : Groups indices of all methdos for a generic
1128                  function into a multifield variable
1129                  (NULL means get methods for all generics)
1130   INPUTS       : 1) A pointer to a generic function
1131                  2) A data object buffer
1132   RETURNS      : Nothing useful
1133   SIDE EFFECTS : Multifield set to list of method indices
1134   NOTES        : None
1135  ***********************************************************/
1136 globle void EnvGetDefmethodList(
1137   void *theEnv,
1138   void *vgfunc,
1139   DATA_OBJECT_PTR returnValue)
1140   {
1141    DEFGENERIC *gfunc,*svg,*svnxt;
1142    long i,j;
1143    unsigned long count;
1144    MULTIFIELD_PTR theList;
1145
1146    if (vgfunc != NULL)
1147      {
1148       gfunc = (DEFGENERIC *) vgfunc;
1149       svnxt = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,vgfunc);
1150       SetNextDefgeneric(vgfunc,NULL);
1151      }
1152    else
1153      {
1154       gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL);
1155       svnxt = (gfunc != NULL) ? (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc) : NULL;
1156      }
1157    count = 0;
1158    for (svg = gfunc ;
1159         gfunc != NULL ;
1160         gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc))
1161      count += (unsigned long) gfunc->mcnt;
1162    count *= 2;
1163    SetpType(returnValue,MULTIFIELD);
1164    SetpDOBegin(returnValue,1);
1165    SetpDOEnd(returnValue,count);
1166    theList = (MULTIFIELD_PTR) EnvCreateMultifield(theEnv,count);
1167    SetpValue(returnValue,theList);
1168    for (gfunc = svg , i = 1 ;
1169         gfunc != NULL ;
1170         gfunc = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,(void *) gfunc))
1171      {
1172       for (j = 0 ; j < gfunc->mcnt ; j++)
1173         {
1174          SetMFType(theList,i,SYMBOL);
1175          SetMFValue(theList,i++,GetDefgenericNamePointer((void *) gfunc));
1176          SetMFType(theList,i,INTEGER);
1177          SetMFValue(theList,i++,EnvAddLong(theEnv,(long long) gfunc->methods[j].index));
1178         }
1179      }
1180    if (svg != NULL)
1181      SetNextDefgeneric((void *) svg,(void *) svnxt);
1182   }
1183
1184 /***********************************************************************************
1185   NAME         : GetMethodRestrictionsCommand
1186   DESCRIPTION  : Stores restrictions of a method in multifield
1187   INPUTS       : A data object buffer to hold a multifield
1188   RETURNS      : Nothing useful
1189   SIDE EFFECTS : Multifield created (length zero on errors)
1190   NOTES        : Syntax: (get-method-restrictions <generic-function> <method-index>)
1191  ***********************************************************************************/
1192 globle void GetMethodRestrictionsCommand(
1193   void *theEnv,
1194   DATA_OBJECT *result)
1195   {
1196    DATA_OBJECT temp;
1197    DEFGENERIC *gfunc;
1198
1199    if (EnvArgTypeCheck(theEnv,"get-method-restrictions",1,SYMBOL,&temp) == FALSE)
1200      {
1201       EnvSetMultifieldErrorValue(theEnv,result);
1202       return;
1203      }
1204    gfunc = CheckGenericExists(theEnv,"get-method-restrictions",DOToString(temp));
1205    if (gfunc == NULL)
1206      {
1207       EnvSetMultifieldErrorValue(theEnv,result);
1208       return;
1209      }
1210    if (EnvArgTypeCheck(theEnv,"get-method-restrictions",2,INTEGER,&temp) == FALSE)
1211      {
1212       EnvSetMultifieldErrorValue(theEnv,result);
1213       return;
1214      }
1215    if (CheckMethodExists(theEnv,"get-method-restrictions",gfunc,(long) DOToLong(temp)) == -1)
1216      {
1217       EnvSetMultifieldErrorValue(theEnv,result);
1218       return;
1219      }
1220    EnvGetMethodRestrictions(theEnv,(void *) gfunc,(unsigned) DOToLong(temp),result);
1221   }
1222
1223 /***********************************************************************
1224   NAME         : EnvGetMethodRestrictions
1225   DESCRIPTION  : Stores restrictions of a method in multifield
1226   INPUTS       : 1) Pointer to the generic function
1227                  2) The method index
1228                  3) A data object buffer to hold a multifield
1229   RETURNS      : Nothing useful
1230   SIDE EFFECTS : Multifield created (length zero on errors)
1231   NOTES        : The restrictions are stored in the multifield
1232                  in the following format:
1233
1234                  <min-number-of-arguments>
1235                  <max-number-of-arguments> (-1 if wildcard allowed)
1236                  <restriction-count>
1237                  <index of 1st restriction>
1238                        .
1239                        .
1240                  <index of nth restriction>
1241                  <restriction 1>
1242                      <query TRUE/FALSE>
1243                      <number-of-classes>
1244                      <class 1>
1245                         .
1246                         .
1247                      <class n>
1248                     .
1249                     .
1250                     .
1251                   <restriction n>
1252
1253                   Thus, for the method
1254                   (defmethod foo ((?a NUMBER SYMBOL) (?b (= 1 1)) $?c))
1255                   (get-method-restrictions foo 1) would yield
1256
1257                   (2 -1 3 7 11 13 FALSE 2 NUMBER SYMBOL TRUE 0 FALSE 0)
1258  ***********************************************************************/
1259 globle void EnvGetMethodRestrictions(
1260   void *theEnv,
1261   void *vgfunc,
1262   long mi,
1263   DATA_OBJECT *result)
1264   {
1265    short i,j;
1266    register DEFMETHOD *meth;
1267    register RESTRICTION *rptr;
1268    long count;
1269    int roffset,rstrctIndex;
1270    MULTIFIELD_PTR theList;
1271
1272    meth = ((DEFGENERIC *) vgfunc)->methods + FindMethodByIndex((DEFGENERIC *) vgfunc,mi);
1273    count = 3;
1274    for (i = 0 ; i < meth->restrictionCount ; i++)
1275      count += meth->restrictions[i].tcnt + 3;
1276    theList = (MULTIFIELD_PTR) EnvCreateMultifield(theEnv,count);
1277    SetpType(result,MULTIFIELD);
1278    SetpValue(result,theList);
1279    SetpDOBegin(result,1);
1280    SetpDOEnd(result,count);
1281    SetMFType(theList,1,INTEGER);
1282    SetMFValue(theList,1,EnvAddLong(theEnv,(long long) meth->minRestrictions));
1283    SetMFType(theList,2,INTEGER);
1284    SetMFValue(theList,2,EnvAddLong(theEnv,(long long) meth->maxRestrictions));
1285    SetMFType(theList,3,INTEGER);
1286    SetMFValue(theList,3,EnvAddLong(theEnv,(long long) meth->restrictionCount));
1287    roffset = 3 + meth->restrictionCount + 1;
1288    rstrctIndex = 4;
1289    for (i = 0 ; i < meth->restrictionCount ; i++)
1290      {
1291       rptr = meth->restrictions + i;
1292       SetMFType(theList,rstrctIndex,INTEGER);
1293       SetMFValue(theList,rstrctIndex++,EnvAddLong(theEnv,(long long) roffset));
1294       SetMFType(theList,roffset,SYMBOL);
1295       SetMFValue(theList,roffset++,(rptr->query != NULL) ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv));
1296       SetMFType(theList,roffset,INTEGER);
1297       SetMFValue(theList,roffset++,EnvAddLong(theEnv,(long long) rptr->tcnt));
1298       for (j = 0 ; j < rptr->tcnt ; j++)
1299         {
1300          SetMFType(theList,roffset,SYMBOL);
1301 #if OBJECT_SYSTEM
1302          SetMFValue(theList,roffset++,EnvAddSymbol(theEnv,EnvGetDefclassName(theEnv,rptr->types[j])));
1303 #else
1304          SetMFValue(theList,roffset++,EnvAddSymbol(theEnv,TypeName(theEnv,ValueToInteger(rptr->types[j]))));
1305 #endif
1306         }
1307      }
1308   }
1309
1310 /* =========================================
1311    *****************************************
1312           INTERNALLY VISIBLE FUNCTIONS
1313    =========================================
1314    ***************************************** */
1315
1316 /***************************************************
1317   NAME         : PrintGenericCall
1318   DESCRIPTION  : PrintExpression() support function
1319                  for generic function calls
1320   INPUTS       : 1) The output logical name
1321                  2) The generic function
1322   RETURNS      : Nothing useful
1323   SIDE EFFECTS : Call expression printed
1324   NOTES        : None
1325  ***************************************************/
1326 static void PrintGenericCall(
1327   void *theEnv,
1328   const char *logName,
1329   void *value)
1330   {
1331 #if DEVELOPER
1332
1333    EnvPrintRouter(theEnv,logName,"(");
1334    EnvPrintRouter(theEnv,logName,EnvGetDefgenericName(theEnv,value));
1335    if (GetFirstArgument() != NULL)
1336      {
1337       EnvPrintRouter(theEnv,logName," ");
1338       PrintExpression(theEnv,logName,GetFirstArgument());
1339      }
1340    EnvPrintRouter(theEnv,logName,")");
1341 #else
1342 #if MAC_XCD
1343 #pragma unused(theEnv)
1344 #pragma unused(logName)
1345 #pragma unused(value)
1346 #endif
1347 #endif
1348   }
1349
1350 /*******************************************************
1351   NAME         : EvaluateGenericCall
1352   DESCRIPTION  : Primitive support function for
1353                  calling a generic function
1354   INPUTS       : 1) The generic function
1355                  2) A data object buffer to hold
1356                     the evaluation result
1357   RETURNS      : FALSE if the generic function
1358                  returns the symbol FALSE,
1359                  TRUE otherwise
1360   SIDE EFFECTS : Data obejct buffer set and any
1361                  side-effects of calling the generic
1362   NOTES        : None
1363  *******************************************************/
1364 static intBool EvaluateGenericCall(
1365   void *theEnv,
1366   void *value,
1367   DATA_OBJECT *result)
1368   {
1369    GenericDispatch(theEnv,(DEFGENERIC *) value,NULL,NULL,GetFirstArgument(),result);
1370    if ((GetpType(result) == SYMBOL) &&
1371        (GetpValue(result) == EnvFalseSymbol(theEnv)))
1372      return(FALSE);
1373    return(TRUE);
1374   }
1375
1376 /***************************************************
1377   NAME         : DecrementGenericBusyCount
1378   DESCRIPTION  : Lowers the busy count of a
1379                  generic function construct
1380   INPUTS       : The generic function
1381   RETURNS      : Nothing useful
1382   SIDE EFFECTS : Busy count decremented if a clear
1383                  is not in progress (see comment)
1384   NOTES        : None
1385  ***************************************************/
1386 static void DecrementGenericBusyCount(
1387   void *theEnv,
1388   void *value)
1389   {
1390    /* ==============================================
1391       The generics to which expressions in other
1392       constructs may refer may already have been
1393       deleted - thus, it is important not to modify
1394       the busy flag during a clear.
1395       ============================================== */
1396    if (! ConstructData(theEnv)->ClearInProgress)
1397      ((DEFGENERIC *) value)->busy--;
1398   }
1399
1400 /***************************************************
1401   NAME         : IncrementGenericBusyCount
1402   DESCRIPTION  : Raises the busy count of a
1403                  generic function construct
1404   INPUTS       : The generic function
1405   RETURNS      : Nothing useful
1406   SIDE EFFECTS : Busy count incremented
1407   NOTES        : None
1408  ***************************************************/
1409 static void IncrementGenericBusyCount(
1410   void *theEnv,
1411   void *value)
1412   {
1413 #if MAC_XCD
1414 #pragma unused(theEnv)
1415 #endif
1416 #if (! RUN_TIME) && (! BLOAD_ONLY)
1417    if (! ConstructData(theEnv)->ParsingConstruct)
1418      { ConstructData(theEnv)->DanglingConstructs++; }
1419 #endif
1420
1421    ((DEFGENERIC *) value)->busy++;
1422   }
1423
1424 #if (! BLOAD_ONLY) && (! RUN_TIME)
1425
1426 /**********************************************************************
1427   NAME         : SaveDefgenerics
1428   DESCRIPTION  : Outputs pretty-print forms of generic function headers
1429   INPUTS       : The logical name of the output
1430   RETURNS      : Nothing useful
1431   SIDE EFFECTS : None
1432   NOTES        : None
1433  **********************************************************************/
1434 static void SaveDefgenerics(
1435   void *theEnv,
1436   void *theModule,
1437   const char *logName)
1438   {
1439    SaveConstruct(theEnv,theModule,logName,DefgenericData(theEnv)->DefgenericConstruct);
1440   }
1441
1442 /**********************************************************************
1443   NAME         : SaveDefmethods
1444   DESCRIPTION  : Outputs pretty-print forms of generic function methods
1445   INPUTS       : The logical name of the output
1446   RETURNS      : Nothing useful
1447   SIDE EFFECTS : None
1448   NOTES        : None
1449  **********************************************************************/
1450 static void SaveDefmethods(
1451   void *theEnv,
1452   void *theModule,
1453   const char *logName)
1454   {
1455    DoForAllConstructsInModule(theEnv,theModule,SaveDefmethodsForDefgeneric,
1456                               DefgenericData(theEnv)->DefgenericModuleIndex,
1457                               FALSE,(void *) logName);
1458   }
1459
1460 /***************************************************
1461   NAME         : SaveDefmethodsForDefgeneric
1462   DESCRIPTION  : Save the pretty-print forms of
1463                  all methods for a generic function
1464                  to a file
1465   INPUTS       : 1) The defgeneric
1466                  2) The logical name of the output
1467   RETURNS      : Nothing useful
1468   SIDE EFFECTS : Methods written
1469   NOTES        : None
1470  ***************************************************/
1471 static void SaveDefmethodsForDefgeneric(
1472   void *theEnv,
1473   struct constructHeader *theDefgeneric,
1474   void *userBuffer)
1475   {
1476    DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric;
1477    const char *logName = (const char *) userBuffer;
1478    long i;
1479
1480    for (i = 0 ; i < gfunc->mcnt ; i++)
1481      {
1482       if (gfunc->methods[i].ppForm != NULL)
1483         {
1484          PrintInChunks(theEnv,logName,gfunc->methods[i].ppForm);
1485          EnvPrintRouter(theEnv,logName,"\n");
1486         }
1487      }
1488   }
1489
1490 /****************************************************
1491   NAME         : RemoveDefgenericMethod
1492   DESCRIPTION  : Removes a generic function method
1493                    from the array and removes the
1494                    generic too if its the last method
1495   INPUTS       : 1) The generic function
1496                  2) The array index of the method
1497   RETURNS      : Nothing useful
1498   SIDE EFFECTS : List adjusted
1499                  Nodes deallocated
1500   NOTES        : Assumes deletion is safe
1501  ****************************************************/
1502 static void RemoveDefgenericMethod(
1503   void *theEnv,
1504   DEFGENERIC *gfunc,
1505   long gi)
1506   {
1507    DEFMETHOD *narr;
1508    long b,e;
1509
1510    if (gfunc->methods[gi].system)
1511      {
1512       SetEvaluationError(theEnv,TRUE);
1513       PrintErrorID(theEnv,"GENRCCOM",4,FALSE);
1514       EnvPrintRouter(theEnv,WERROR,"Cannot remove implicit system function method for generic function ");
1515       EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc));
1516       EnvPrintRouter(theEnv,WERROR,".\n");
1517       return;
1518      }
1519    DeleteMethodInfo(theEnv,gfunc,&gfunc->methods[gi]);
1520    if (gfunc->mcnt == 1)
1521      {
1522       rm(theEnv,(void *) gfunc->methods,(int) sizeof(DEFMETHOD));
1523       gfunc->mcnt = 0;
1524       gfunc->methods = NULL;
1525      }
1526    else
1527      {
1528       gfunc->mcnt--;
1529       narr = (DEFMETHOD *) gm2(theEnv,(sizeof(DEFMETHOD) * gfunc->mcnt));
1530       for (b = e = 0 ; b < gfunc->mcnt ; b++ , e++)
1531         {
1532          if (((int) b) == gi)
1533            e++;
1534          GenCopyMemory(DEFMETHOD,1,&narr[b],&gfunc->methods[e]);
1535         }
1536       rm(theEnv,(void *) gfunc->methods,(sizeof(DEFMETHOD) * (gfunc->mcnt+1)));
1537       gfunc->methods = narr;
1538      }
1539   }
1540
1541 #endif
1542
1543 #if DEBUGGING_FUNCTIONS
1544
1545 /******************************************************
1546   NAME         : ListMethodsForGeneric
1547   DESCRIPTION  : Lists a brief description of methods
1548                    for a particular generic function
1549   INPUTS       : 1) The logical name of the output
1550                  2) Generic function to list methods for
1551   RETURNS      : The number of methods printed
1552   SIDE EFFECTS : None
1553   NOTES        : None
1554  ******************************************************/
1555 static long ListMethodsForGeneric(
1556   void *theEnv,
1557   const char *logicalName,
1558   DEFGENERIC *gfunc)
1559   {
1560    long gi;
1561    char buf[256];
1562
1563    for (gi = 0 ; gi < gfunc->mcnt ; gi++)
1564      {
1565       EnvPrintRouter(theEnv,logicalName,EnvGetDefgenericName(theEnv,(void *) gfunc));
1566       EnvPrintRouter(theEnv,logicalName," #");
1567       PrintMethod(theEnv,buf,255,&gfunc->methods[gi]);
1568       EnvPrintRouter(theEnv,logicalName,buf);
1569       EnvPrintRouter(theEnv,logicalName,"\n");
1570      }
1571    return((long) gfunc->mcnt);
1572   }
1573
1574 /******************************************************************
1575   NAME         : DefgenericWatchAccess
1576   DESCRIPTION  : Parses a list of generic names passed by
1577                  AddWatchItem() and sets the traces accordingly
1578   INPUTS       : 1) A code indicating which trace flag is to be set
1579                     Ignored
1580                  2) The value to which to set the trace flags
1581                  3) A list of expressions containing the names
1582                     of the generics for which to set traces
1583   RETURNS      : TRUE if all OK, FALSE otherwise
1584   SIDE EFFECTS : Watch flags set in specified generics
1585   NOTES        : Accessory function for AddWatchItem()
1586  ******************************************************************/
1587 static unsigned DefgenericWatchAccess(
1588   void *theEnv,
1589   int code,
1590   unsigned newState,
1591   EXPRESSION *argExprs)
1592   {
1593 #if MAC_XCD
1594 #pragma unused(code)
1595 #endif
1596
1597    return(ConstructSetWatchAccess(theEnv,DefgenericData(theEnv)->DefgenericConstruct,newState,argExprs,
1598                                     EnvGetDefgenericWatch,EnvSetDefgenericWatch));
1599   }
1600
1601 /***********************************************************************
1602   NAME         : DefgenericWatchPrint
1603   DESCRIPTION  : Parses a list of generic names passed by
1604                  AddWatchItem() and displays the traces accordingly
1605   INPUTS       : 1) The logical name of the output
1606                  2) A code indicating which trace flag is to be examined
1607                     Ignored
1608                  3) A list of expressions containing the names
1609                     of the generics for which to examine traces
1610   RETURNS      : TRUE if all OK, FALSE otherwise
1611   SIDE EFFECTS : Watch flags displayed for specified generics
1612   NOTES        : Accessory function for AddWatchItem()
1613  ***********************************************************************/
1614 static unsigned DefgenericWatchPrint(
1615   void *theEnv,
1616   const char *logName,
1617   int code,
1618   EXPRESSION *argExprs)
1619   {
1620 #if MAC_XCD
1621 #pragma unused(code)
1622 #endif
1623
1624    return(ConstructPrintWatchAccess(theEnv,DefgenericData(theEnv)->DefgenericConstruct,logName,argExprs,
1625                                     EnvGetDefgenericWatch,EnvSetDefgenericWatch));
1626   }
1627
1628 /******************************************************************
1629   NAME         : DefmethodWatchAccess
1630   DESCRIPTION  : Parses a list of methods passed by
1631                  AddWatchItem() and sets the traces accordingly
1632   INPUTS       : 1) A code indicating which trace flag is to be set
1633                     Ignored
1634                  2) The value to which to set the trace flags
1635                  3) A list of expressions containing the methods
1636                    for which to set traces
1637   RETURNS      : TRUE if all OK, FALSE otherwise
1638   SIDE EFFECTS : Watch flags set in specified methods
1639   NOTES        : Accessory function for AddWatchItem()
1640  ******************************************************************/
1641 static unsigned DefmethodWatchAccess(
1642   void *theEnv,
1643   int code,
1644   unsigned newState,
1645   EXPRESSION *argExprs)
1646   {
1647 #if MAC_XCD
1648 #pragma unused(code)
1649 #endif
1650    if (newState)
1651      return(DefmethodWatchSupport(theEnv,"watch",NULL,newState,NULL,EnvSetDefmethodWatch,argExprs));
1652    else
1653      return(DefmethodWatchSupport(theEnv,"unwatch",NULL,newState,NULL,EnvSetDefmethodWatch,argExprs));
1654   }
1655
1656 /***********************************************************************
1657   NAME         : DefmethodWatchPrint
1658   DESCRIPTION  : Parses a list of methods passed by
1659                  AddWatchItem() and displays the traces accordingly
1660   INPUTS       : 1) The logical name of the output
1661                  2) A code indicating which trace flag is to be examined
1662                     Ignored
1663                  3) A list of expressions containing the methods for
1664                     which to examine traces
1665   RETURNS      : TRUE if all OK, FALSE otherwise
1666   SIDE EFFECTS : Watch flags displayed for specified methods
1667   NOTES        : Accessory function for AddWatchItem()
1668  ***********************************************************************/
1669 static unsigned DefmethodWatchPrint(
1670   void *theEnv,
1671   const char *logName,
1672   int code,
1673   EXPRESSION *argExprs)
1674   {
1675 #if MAC_XCD
1676 #pragma unused(code)
1677 #endif
1678    return(DefmethodWatchSupport(theEnv,"list-watch-items",logName,0,
1679                                 PrintMethodWatchFlag,NULL,argExprs));
1680   }
1681
1682 /*******************************************************
1683   NAME         : DefmethodWatchSupport
1684   DESCRIPTION  : Sets or displays methods specified
1685   INPUTS       : 1) The calling function name
1686                  2) The logical output name for displays
1687                     (can be NULL)
1688                  3) The new set state
1689                  4) The print function (can be NULL)
1690                  5) The trace function (can be NULL)
1691                  6) The methods expression list
1692   RETURNS      : TRUE if all OK,
1693                  FALSE otherwise
1694   SIDE EFFECTS : Method trace flags set or displayed
1695   NOTES        : None
1696  *******************************************************/
1697 static unsigned DefmethodWatchSupport(
1698   void *theEnv,
1699   const char *funcName,
1700   const char *logName,
1701   unsigned newState,
1702   void (*printFunc)(void *,const char *,void *,long),
1703   void (*traceFunc)(void *,unsigned,void *,long),
1704   EXPRESSION *argExprs)
1705   {
1706    void *theGeneric;
1707    unsigned long theMethod = 0;
1708    int argIndex = 2;
1709    DATA_OBJECT genericName,methodIndex;
1710    struct defmodule *theModule;
1711
1712    /* ==============================
1713       If no methods are specified,
1714       show the trace for all methods
1715       in all generics
1716       ============================== */
1717    if (argExprs == NULL)
1718      {
1719       SaveCurrentModule(theEnv);
1720       theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
1721       while (theModule != NULL)
1722         {
1723          EnvSetCurrentModule(theEnv,(void *) theModule);
1724          if (traceFunc == NULL)
1725            {
1726             EnvPrintRouter(theEnv,logName,EnvGetDefmoduleName(theEnv,(void *) theModule));
1727             EnvPrintRouter(theEnv,logName,":\n");
1728            }
1729          theGeneric = EnvGetNextDefgeneric(theEnv,NULL);
1730          while (theGeneric != NULL)
1731             {
1732              theMethod = EnvGetNextDefmethod(theEnv,theGeneric,0);
1733              while (theMethod != 0)
1734                {
1735                 if (traceFunc != NULL)
1736                   (*traceFunc)(theEnv,newState,theGeneric,theMethod);
1737                 else
1738                   {
1739                    EnvPrintRouter(theEnv,logName,"   ");
1740                    (*printFunc)(theEnv,logName,theGeneric,theMethod);
1741                   }
1742                 theMethod = EnvGetNextDefmethod(theEnv,theGeneric,theMethod);
1743                }
1744              theGeneric = EnvGetNextDefgeneric(theEnv,theGeneric);
1745             }
1746          theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,(void *) theModule);
1747         }
1748       RestoreCurrentModule(theEnv);
1749       return(TRUE);
1750      }
1751
1752    /* =========================================
1753       Set the traces for every method specified
1754       ========================================= */
1755    while (argExprs != NULL)
1756      {
1757       if (EvaluateExpression(theEnv,argExprs,&genericName))
1758         return(FALSE);
1759       if ((genericName.type != SYMBOL) ? TRUE :
1760           ((theGeneric = (void *)
1761               LookupDefgenericByMdlOrScope(theEnv,DOToString(genericName))) == NULL))
1762         {
1763          ExpectedTypeError1(theEnv,funcName,argIndex,"generic function name");
1764          return(FALSE);
1765         }
1766       if (GetNextArgument(argExprs) == NULL)
1767         theMethod = 0;
1768       else
1769         {
1770          argExprs = GetNextArgument(argExprs);
1771          argIndex++;
1772          if (EvaluateExpression(theEnv,argExprs,&methodIndex))
1773            return(FALSE);
1774          if ((methodIndex.type != INTEGER) ? FALSE :
1775              ((DOToLong(methodIndex) <= 0) ? FALSE :
1776               (FindMethodByIndex((DEFGENERIC *) theGeneric,theMethod) != -1)))
1777            theMethod = (long) DOToLong(methodIndex);
1778          else
1779            {
1780             ExpectedTypeError1(theEnv,funcName,argIndex,"method index");
1781             return(FALSE);
1782            }
1783         }
1784       if (theMethod == 0)
1785         {
1786          theMethod = EnvGetNextDefmethod(theEnv,theGeneric,0);
1787          while (theMethod != 0)
1788            {
1789             if (traceFunc != NULL)
1790               (*traceFunc)(theEnv,newState,theGeneric,theMethod);
1791             else
1792               (*printFunc)(theEnv,logName,theGeneric,theMethod);
1793             theMethod = EnvGetNextDefmethod(theEnv,theGeneric,theMethod);
1794            }
1795         }
1796       else
1797         {
1798          if (traceFunc != NULL)
1799            (*traceFunc)(theEnv,newState,theGeneric,theMethod);
1800          else
1801            (*printFunc)(theEnv,logName,theGeneric,theMethod);
1802         }
1803       argExprs = GetNextArgument(argExprs);
1804       argIndex++;
1805      }
1806    return(TRUE);
1807   }
1808
1809 /***************************************************
1810   NAME         : PrintMethodWatchFlag
1811   DESCRIPTION  : Displays trace value for method
1812   INPUTS       : 1) The logical name of the output
1813                  2) The generic function
1814                  3) The method index
1815   RETURNS      : Nothing useful
1816   SIDE EFFECTS : None
1817   NOTES        : None
1818  ***************************************************/
1819 static void PrintMethodWatchFlag(
1820   void *theEnv,
1821   const char *logName,
1822   void *theGeneric,
1823   long theMethod)
1824   {
1825    char buf[60];
1826
1827    EnvPrintRouter(theEnv,logName,EnvGetDefgenericName(theEnv,theGeneric));
1828    EnvPrintRouter(theEnv,logName," ");
1829    EnvGetDefmethodDescription(theEnv,buf,59,theGeneric,theMethod);
1830    EnvPrintRouter(theEnv,logName,buf);
1831    if (EnvGetDefmethodWatch(theEnv,theGeneric,theMethod))
1832      EnvPrintRouter(theEnv,logName," = on\n");
1833    else
1834      EnvPrintRouter(theEnv,logName," = off\n");
1835   }
1836
1837 #endif
1838
1839 #if ! OBJECT_SYSTEM
1840
1841 /***************************************************
1842   NAME         : TypeCommand
1843   DESCRIPTION  : Works like "class" in COOL
1844   INPUTS       : None
1845   RETURNS      : Nothing useful
1846   SIDE EFFECTS : None
1847   NOTES        : H/L Syntax: (type <primitive>)
1848  ***************************************************/
1849 globle void TypeCommand(
1850   void *theEnv,
1851   DATA_OBJECT *result)
1852   {
1853    EvaluateExpression(theEnv,GetFirstArgument(),result);
1854    result->value = (void *) EnvAddSymbol(theEnv,TypeName(theEnv,result->type));
1855    result->type = SYMBOL;
1856   }
1857
1858 #endif
1859
1860 /*#############################*/
1861 /* Additional Access Functions */
1862 /*#############################*/
1863
1864 globle SYMBOL_HN *GetDefgenericNamePointer(
1865   void *theDefgeneric)
1866   {
1867    return GetConstructNamePointer((struct constructHeader *) theDefgeneric);
1868   }
1869
1870 globle void SetNextDefgeneric(
1871   void *theDefgeneric,
1872   void *targetDefgeneric)
1873   {
1874    SetNextConstruct((struct constructHeader *) theDefgeneric,
1875                     (struct constructHeader *) targetDefgeneric);
1876   }
1877
1878 /*##################################*/
1879 /* Additional Environment Functions */
1880 /*##################################*/
1881
1882 globle const char *EnvDefgenericModule(
1883   void *theEnv,
1884   void *theDefgeneric)
1885   {
1886    return GetConstructModuleName((struct constructHeader *) theDefgeneric);
1887   }
1888
1889 globle const char *EnvGetDefgenericName(
1890   void *theEnv,
1891   void *theDefgeneric)
1892   {
1893    return GetConstructNameString((struct constructHeader *) theDefgeneric);
1894   }
1895
1896 globle const char *EnvGetDefgenericPPForm(
1897   void *theEnv,
1898   void *theDefgeneric)
1899   {
1900    return GetConstructPPForm(theEnv,(struct constructHeader *) theDefgeneric);
1901   }
1902
1903 globle SYMBOL_HN *EnvGetDefgenericNamePointer(
1904   void *theEnv,
1905   void *theDefgeneric)
1906   {
1907    return GetConstructNamePointer((struct constructHeader *) theDefgeneric);
1908   }
1909
1910 globle void EnvSetDefgenericPPForm(
1911   void *theEnv,
1912   void *theDefgeneric,
1913   const char *thePPForm)
1914   {
1915    SetConstructPPForm(theEnv,(struct constructHeader *) theDefgeneric,thePPForm);
1916   }
1917
1918 /*#####################################*/
1919 /* ALLOW_ENVIRONMENT_GLOBALS Functions */
1920 /*#####################################*/
1921
1922 #if ALLOW_ENVIRONMENT_GLOBALS
1923
1924 globle void SetDefgenericPPForm(
1925   void *theDefgeneric,
1926   const char *thePPForm)
1927   {
1928    EnvSetDefgenericPPForm(GetCurrentEnvironment(),theDefgeneric,thePPForm);
1929   }
1930
1931 globle const char *DefgenericModule(
1932   void *theDefgeneric)
1933   {
1934    return EnvDefgenericModule(GetCurrentEnvironment(),theDefgeneric);
1935   }
1936
1937 globle void *FindDefgeneric(
1938   const char *genericModuleAndName)
1939   {
1940    return EnvFindDefgeneric(GetCurrentEnvironment(),genericModuleAndName);
1941   }
1942
1943 globle void GetDefgenericList(
1944   DATA_OBJECT *returnValue,
1945   struct defmodule *theModule)
1946   {
1947    EnvGetDefgenericList(GetCurrentEnvironment(),returnValue,theModule);
1948   }
1949
1950 globle const char *GetDefgenericName(
1951   void *theDefgeneric)
1952   {
1953    return EnvGetDefgenericName(GetCurrentEnvironment(),theDefgeneric);
1954   }
1955
1956 globle const char *GetDefgenericPPForm(
1957   void *theDefgeneric)
1958   {
1959    return EnvGetDefgenericPPForm(GetCurrentEnvironment(),theDefgeneric);
1960   }
1961
1962 globle void *GetNextDefgeneric(
1963   void *ptr)
1964   {
1965    return EnvGetNextDefgeneric(GetCurrentEnvironment(),ptr);
1966   }
1967
1968 globle int IsDefgenericDeletable(
1969   void *ptr)
1970   {
1971    return EnvIsDefgenericDeletable(GetCurrentEnvironment(),ptr);
1972   }
1973
1974 globle intBool Undefgeneric(
1975   void *vptr)
1976   {
1977    return EnvUndefgeneric(GetCurrentEnvironment(),vptr);
1978   }
1979
1980 globle void GetDefmethodList(
1981   void *vgfunc,
1982   DATA_OBJECT_PTR returnValue)
1983   {
1984    EnvGetDefmethodList(GetCurrentEnvironment(),vgfunc,returnValue);
1985   }
1986
1987 globle void GetMethodRestrictions(
1988   void *vgfunc,
1989   long mi,
1990   DATA_OBJECT *result)
1991   {
1992    EnvGetMethodRestrictions(GetCurrentEnvironment(),vgfunc,mi,result);
1993   }
1994
1995 globle long GetNextDefmethod(
1996   void *ptr,
1997   long theIndex)
1998   {
1999    return EnvGetNextDefmethod(GetCurrentEnvironment(),ptr,theIndex);
2000   }
2001
2002 globle int IsDefmethodDeletable(
2003   void *ptr,
2004   long theIndex)
2005   {
2006    return EnvIsDefmethodDeletable(GetCurrentEnvironment(),ptr,theIndex);
2007   }
2008
2009 globle intBool Undefmethod(
2010   void *vptr,
2011   long mi)
2012   {
2013   return EnvUndefmethod(GetCurrentEnvironment(),vptr,mi);
2014   }
2015
2016 #if DEBUGGING_FUNCTIONS
2017
2018 globle unsigned GetDefgenericWatch(
2019   void *theGeneric)
2020   {
2021    return EnvGetDefgenericWatch(GetCurrentEnvironment(),theGeneric);
2022   }
2023
2024 globle void ListDefgenerics(
2025   const char *logicalName,
2026   struct defmodule *theModule)
2027   {
2028    EnvListDefgenerics(GetCurrentEnvironment(),logicalName,theModule);
2029   }
2030
2031 globle void SetDefgenericWatch(
2032   unsigned newState,
2033   void *theGeneric)
2034   {
2035    EnvSetDefgenericWatch(GetCurrentEnvironment(),newState,theGeneric);
2036   }
2037
2038 globle const char *GetDefmethodPPForm(
2039   void *ptr,
2040   long theIndex)
2041   {
2042    return EnvGetDefmethodPPForm(GetCurrentEnvironment(),ptr,theIndex);
2043   }
2044
2045 globle unsigned GetDefmethodWatch(
2046   void *theGeneric,
2047   long theIndex)
2048   {
2049    return EnvGetDefmethodWatch(GetCurrentEnvironment(),theGeneric,theIndex);
2050   }
2051
2052 globle void ListDefmethods(
2053   const char *logicalName,
2054   void *vptr)
2055   {
2056    EnvListDefmethods(GetCurrentEnvironment(),logicalName,vptr);
2057   }
2058
2059 globle void SetDefmethodWatch(
2060   unsigned newState,
2061   void *theGeneric,
2062   long theIndex)
2063   {
2064    EnvSetDefmethodWatch(GetCurrentEnvironment(),newState,theGeneric,theIndex);
2065   }
2066
2067 #endif /* DEBUGGING_FUNCTIONS */
2068
2069 #if DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS
2070
2071 globle void GetDefmethodDescription(
2072   char *buf,
2073   int buflen,
2074   void *ptr,
2075   long theIndex)
2076   {
2077    EnvGetDefmethodDescription(GetCurrentEnvironment(),buf,buflen,ptr,theIndex);
2078   }
2079
2080 #endif /* DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS */
2081
2082 #endif /* ALLOW_ENVIRONMENT_GLOBALS */
2083
2084 #endif /* DEFGENERIC_CONSTRUCT */
2085