************************************************************************/globle DEFMETHOD *AddMethod(  void *theEnv,  DEFGENERIC *gfunc,  DEFMETHOD *meth,  int mposn,  short mi,  EXPRESSION *params,  int rcnt,  int lvars,  SYMBOL_HN *wildcard,  EXPRESSION *actions,  char *ppForm,  int copyRestricts)  {   RESTRICTION *rptr,*rtmp;   register int i,j;   int mai;   SaveBusyCount(gfunc);   if (meth == NULL)     {      mai = (mi != 0) ? FindMethodByIndex(gfunc,mi) : -1;      if (mai == -1)        meth = AddGenericMethod(theEnv,gfunc,mposn,mi);      else        {         DeleteMethodInfo(theEnv,gfunc,&gfunc->methods[mai]);         if (mai < mposn)           {            mposn--;            for (i = mai+1 ; i <= mposn ; i++)              GenCopyMemory(DEFMETHOD,1,&gfunc->methods[i-1],&gfunc->methods[i]);           }         else           {            for (i = mai-1 ; i >= mposn ; i--)              GenCopyMemory(DEFMETHOD,1,&gfunc->methods[i+1],&gfunc->methods[i]);           }         meth = &gfunc->methods[mposn];         meth->index = mi;        }     }   else     {      /* ================================         The old trace state is preserved         ================================ */      ExpressionDeinstall(theEnv,meth->actions);      ReturnPackedExpression(theEnv,meth->actions);      if (meth->ppForm != NULL)        rm(theEnv,(void *) meth->ppForm,(sizeof(char) * (strlen(meth->ppForm)+1)));     }   meth->system = 0;   meth->actions = actions;   ExpressionInstall(theEnv,meth->actions);   meth->ppForm = ppForm;   if (mposn == -1)     {      RestoreBusyCount(gfunc);      return(meth);     }   meth->localVarCount = lvars;   meth->restrictionCount = rcnt;   if (wildcard != NULL)     {      meth->minRestrictions = rcnt-1;      meth->maxRestrictions = -1;     }   else     meth->minRestrictions = meth->maxRestrictions = rcnt;   if (rcnt != 0)     meth->restrictions = (RESTRICTION *)                          gm2(theEnv,(sizeof(RESTRICTION) * rcnt));   else     meth->restrictions = NULL;   for (i = 0 ; i < rcnt ; i++)     {      rptr = &meth->restrictions[i];      rtmp = (RESTRICTION *) params->argList;      rptr->query = PackExpression(theEnv,rtmp->query);      rptr->tcnt = rtmp->tcnt;      if (copyRestricts)        {         if (rtmp->types != NULL)           {            rptr->types = (void **) gm2(theEnv,(rptr->tcnt * sizeof(void *)));            GenCopyMemory(void *,rptr->tcnt,rptr->types,rtmp->types);           }         else           rptr->types = NULL;        }      else        {         rptr->types = rtmp->types;         /* =====================================================            Make sure the types-array is not deallocated when the              temporary restriction nodes are            ===================================================== */         rtmp->tcnt = 0;         rtmp->types = NULL;        }      ExpressionInstall(theEnv,rptr->query);      for (j = 0 ; j < rptr->tcnt ; j++)#if OBJECT_SYSTEM        IncrementDefclassBusyCount(theEnv,rptr->types[j]);#else        IncrementIntegerCount((INTEGER_HN *) rptr->types[j]);#endif      params = params->nextArg;     }   RestoreBusyCount(gfunc);   return(meth);  }/*****************************************************  NAME         : PackRestrictionTypes  DESCRIPTION  : Takes the restriction type list                   and packs it into a contiguous                   array of void *.  INPUTS       : 1) The restriction structure                 2) The types expression list  RETURNS      : Nothing useful  SIDE EFFECTS : Array allocated & expressions freed  NOTES        : None *****************************************************/globle void PackRestrictionTypes(  void *theEnv,  RESTRICTION *rptr,  EXPRESSION *types)  {   EXPRESSION *tmp;   long i;   rptr->tcnt = 0;   for (tmp = types ; tmp != NULL ; tmp = tmp->nextArg)     rptr->tcnt++;   if (rptr->tcnt != 0)     rptr->types = (void **) gm2(theEnv,(sizeof(void *) * rptr->tcnt));   else     rptr->types = NULL;   for (i = 0 , tmp = types ; i < rptr->tcnt ; i++ , tmp = tmp->nextArg)     rptr->types[i] = (void *) tmp->value;   ReturnExpression(theEnv,types);  }/***************************************************  NAME         : DeleteTempRestricts  DESCRIPTION  : Deallocates the method                   temporary parameter list  INPUTS       : The head of the list  RETURNS      : Nothing useful  SIDE EFFECTS : List deallocated  NOTES        : None ***************************************************/globle void DeleteTempRestricts(  void *theEnv,  EXPRESSION *phead)  {   EXPRESSION *ptmp;   RESTRICTION *rtmp;   while (phead != NULL)     {      ptmp = phead;      phead = phead->nextArg;      rtmp = (RESTRICTION *) ptmp->argList;      rtn_struct(theEnv,expr,ptmp);      ReturnExpression(theEnv,rtmp->query);      if (rtmp->tcnt != 0)        rm(theEnv,(void *) rtmp->types,(sizeof(void *) * rtmp->tcnt));      rtn_struct(theEnv,restriction,rtmp);     }  }/**********************************************************  NAME         : FindMethodByRestrictions  DESCRIPTION  : See if a method for the specified                   generic satsifies the given restrictions  INPUTS       : 1) Generic function                 2) Parameter/restriction expression list                 3) Number of restrictions                 4) Wildcard symbol (can be NULL)                 5) Caller's buffer for holding array posn                      of where to add new generic method                      (-1 if method already present)  RETURNS      : The address of the found method, NULL if                    not found  SIDE EFFECTS : Sets the caller's buffer to the index of                   where to place the new method, -1 if                   already present  NOTES        : None **********************************************************/globle DEFMETHOD *FindMethodByRestrictions(  DEFGENERIC *gfunc,  EXPRESSION *params,  int rcnt,  SYMBOL_HN *wildcard,  int *posn)  {   register int i,cmp;   int min,max;   if (wildcard != NULL)     {      min = rcnt-1;      max = -1;     }   else     min = max = rcnt;   for (i = 0 ; i < gfunc->mcnt ; i++)     {      cmp = RestrictionsCompare(params,rcnt,min,max,&gfunc->methods[i]);      if (cmp == IDENTICAL)        {         *posn = -1;         return(&gfunc->methods[i]);        }      else if (cmp == HIGHER_PRECEDENCE)        {         *posn = i;         return(NULL);        }     }   *posn = i;   return(NULL);  }/* =========================================   *****************************************          INTERNALLY VISIBLE FUNCTIONS   =========================================   ***************************************** *//***********************************************************  NAME         : ValidGenericName  DESCRIPTION  : Determines if a particular function name                    can be overloaded  INPUTS       : The name  RETURNS      : TRUE if OK, FALSE otherwise  SIDE EFFECTS : Error message printed  NOTES        : GetConstructNameAndComment() (called before                 this function) ensures that the defgeneric                 name does not conflict with one from                 another module ***********************************************************/static intBool ValidGenericName(  void *theEnv,  char *theDefgenericName)  {   struct constructHeader *theDefgeneric;#if DEFFUNCTION_CONSTRUCT   struct defmodule *theModule;   struct constructHeader *theDeffunction;#endif   struct FunctionDefinition *systemFunction;   /* ============================================      A defgeneric cannot be named the same as a      construct type, e.g, defclass, defrule, etc.      ============================================ */   if (FindConstruct(theEnv,theDefgenericName) != NULL)     {      PrintErrorID(theEnv,"GENRCPSR",3,FALSE);      EnvPrintRouter(theEnv,WERROR,"Defgenerics are not allowed to replace constructs.\n");      return(FALSE);     }#if DEFFUNCTION_CONSTRUCT   /* ========================================      A defgeneric cannot be named the same as      a defffunction (either in this module or      imported from another)      ======================================== */   theDeffunction =      (struct constructHeader *) LookupDeffunctionInScope(theEnv,theDefgenericName);   if (theDeffunction != NULL)     {      theModule = GetConstructModuleItem(theDeffunction)->theModule;      if (theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))        {         PrintErrorID(theEnv,"GENRCPSR",4,FALSE);         EnvPrintRouter(theEnv,WERROR,"Deffunction ");         EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,(void *) theDeffunction));         EnvPrintRouter(theEnv,WERROR," imported from module ");         EnvPrintRouter(theEnv,WERROR,EnvGetDefmoduleName(theEnv,(void *) theModule));         EnvPrintRouter(theEnv,WERROR," conflicts with this defgeneric.\n");         return(FALSE);        }      else        {         PrintErrorID(theEnv,"GENRCPSR",5,FALSE);         EnvPrintRouter(theEnv,WERROR,"Defgenerics are not allowed to replace deffunctions.\n");        }      return(FALSE);     }#endif   /* =========================================      See if the defgeneric already exists in      this module (or is imported from another)      ========================================= */   theDefgeneric = (struct constructHeader *) EnvFindDefgeneric(theEnv,theDefgenericName);   if (theDefgeneric != NULL)     {      /* ===========================================         And the redefinition of a defgeneric in         the current module is only valid if none         of its methods are executing         =========================================== */      if (MethodsExecuting((DEFGENERIC *) theDefgeneric))        {         MethodAlterError(theEnv,(DEFGENERIC *) theDefgeneric);         return(FALSE);        }     }   /* =======================================      Only certain specific system functions      may be overloaded by generic functions      ======================================= */   systemFunction = FindFunction(theEnv,theDefgenericName);   if ((systemFunction != NULL) ?       (systemFunction->overloadable == FALSE) : FALSE)     {      PrintErrorID(theEnv,"GENRCPSR",16,FALSE);      EnvPrintRouter(theEnv,WERROR,"The system function ");      EnvPrintRouter(theEnv,WERROR,theDefgenericName);      EnvPrintRouter(theEnv,WERROR," cannot be overloaded.\n");      return(FALSE);     }   return(TRUE);  }#if DEBUGGING_FUNCTIONS/***************************************************  NAME         : CreateDefaultGenericPPForm  DESCRIPTION  : Adds a default pretty-print form                 for a gneric function when it is                 impliciylt created by the defn                 of its first method  INPUTS       : The generic function  RETURNS      : Nothing useful  SIDE EFFECTS : Pretty-print form created and                 attached.  NOTES        : None ***************************************************/static void CreateDefaultGenericPPForm(  void *theEnv,  DEFGENERIC *gfunc)  {   char *moduleName,*genericName,*buf;   moduleName = EnvGetDefmoduleName(theEnv,(void *) ((struct defmodule *) EnvGetCurrentModule(theEnv)));   genericName = EnvGetDefgenericName(theEnv,(void *) gfunc);   buf = (char *) gm2(theEnv,(sizeof(char) * (strlen(moduleName) + strlen(genericName) + 17)));   gensprintf(buf,"(defgeneric %s::%s)\n",moduleName,genericName);   SetDefgenericPPForm((void *) gfunc,buf);  }#endif/*******************************************************  NAME         : ParseMethodNameAndIndex  DESCRIPTION  : Parses the name of the method and                   optional method index  INPUTS       : 1) The logical name of the input source                 2) Caller's buffer for method index                    (0 if not specified)  RETURNS      : The symbolic name of the method  SIDE EFFECTS : None  NOTES        : Assumes "(defmethod " already parsed *******************************************************/static SYMBOL_HN *ParseMethodNameAndIndex(  void *theEnv,  char *readSource,  int *theIndex)  {   SYMBOL_HN *gname;   *theIndex = 0;   gname = GetConstructNameAndComment(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken,"defgeneric",                                      EnvFindDefgeneric,NULL,"&",TRUE,FALSE,TRUE);