/***************************************************
  NAME         : DeleteSlots
  DESCRIPTION  : Deallocates a list of slots and
                   their values
  INPUTS       : The address of the slot list
  RETURNS      : Nothing useful
  SIDE EFFECTS : The slot list is destroyed
  NOTES        : None
 ***************************************************/
void DeleteSlots(
  Environment *theEnv,
  TEMP_SLOT_LINK *slots)
  {
   TEMP_SLOT_LINK *stmp;

   while (slots != NULL)
     {
      stmp = slots;
      slots = slots->nxt;
      DeleteSlotName(theEnv,stmp->desc->slotName);
      ReleaseLexeme(theEnv,stmp->desc->overrideMessage);
      RemoveConstraint(theEnv,stmp->desc->constraint);
      if (stmp->desc->dynamicDefault == 1)
        {
         ExpressionDeinstall(theEnv,(Expression *) stmp->desc->defaultValue);
         ReturnPackedExpression(theEnv,(Expression *) stmp->desc->defaultValue);
        }
      else if (stmp->desc->defaultValue != NULL)
        {
         ReleaseUDFV(theEnv,(UDFValue *) stmp->desc->defaultValue);
         rtn_struct(theEnv,udfValue,stmp->desc->defaultValue);
        }
      rtn_struct(theEnv,slotDescriptor,stmp->desc);
      rtn_struct(theEnv,tempSlotLink,stmp);
     }
  }

/***************************************************
  NAME         : DeleteSlots
  DESCRIPTION  : Deallocates a list of slots and
                   their values
  INPUTS       : The address of the slot list
  RETURNS      : Nothing useful
  SIDE EFFECTS : The slot list is destroyed
  NOTES        : None
 ***************************************************/
globle void DeleteSlots(
  void *theEnv,
  EXEC_STATUS,
  TEMP_SLOT_LINK *slots)
  {
   TEMP_SLOT_LINK *stmp;

   while (slots != NULL)
     {
      stmp = slots;
      slots = slots->nxt;
      DeleteSlotName(theEnv,execStatus,stmp->desc->slotName);
      DecrementSymbolCount(theEnv,execStatus,stmp->desc->overrideMessage);
      RemoveConstraint(theEnv,execStatus,stmp->desc->constraint);
      if (stmp->desc->dynamicDefault == 1)
        {
         ExpressionDeinstall(theEnv,execStatus,(EXPRESSION *) stmp->desc->defaultValue);
         ReturnPackedExpression(theEnv,execStatus,(EXPRESSION *) stmp->desc->defaultValue);
        }
      else if (stmp->desc->defaultValue != NULL)
        {
         ValueDeinstall(theEnv,execStatus,(DATA_OBJECT *) stmp->desc->defaultValue);
         rtn_struct(theEnv,execStatus,dataObject,stmp->desc->defaultValue);
        }
      rtn_struct(theEnv,execStatus,slotDescriptor,stmp->desc);
      rtn_struct(theEnv,execStatus,tempSlotLink,stmp);
     }
  }

globle int CloseStringSource(
  void *theEnv,
  char *name)
  {
   struct stringRouter *head, *last;

   last = NULL;
   head = StringRouterData(theEnv)->ListOfStringRouters;
   while (head != NULL)
     {
      if (strcmp(head->name,name) == 0)
        {
         if (last == NULL)
           {
            StringRouterData(theEnv)->ListOfStringRouters = head->next;
            rm(theEnv,head->name,strlen(head->name) + 1);
            rtn_struct(theEnv,stringRouter,head);
            return(1);
           }
         else
           {
            last->next = head->next;
            rm(theEnv,head->name,strlen(head->name) + 1);
            rtn_struct(theEnv,stringRouter,head);
            return(1);
           }
        }
      last = head;
      head = head->next;
     }

   return(0);
  }

static void DeallocateExternalFunctionData(
  void *theEnv)
  {
   struct FunctionHash *fhPtr, *nextFHPtr;
   int i;

#if ! RUN_TIME
   struct FunctionDefinition *tmpPtr, *nextPtr;

   tmpPtr = ExternalFunctionData(theEnv)->ListOfFunctions;
   while (tmpPtr != NULL)
     {
      nextPtr = tmpPtr->next;
      rtn_struct(theEnv,FunctionDefinition,tmpPtr);
      tmpPtr = nextPtr;
     }
#endif

   if (ExternalFunctionData(theEnv)->FunctionHashtable == NULL)
     { return; }
     
   for (i = 0; i < SIZE_FUNCTION_HASH; i++)
     {
      fhPtr = ExternalFunctionData(theEnv)->FunctionHashtable[i];
      while (fhPtr != NULL)
        {
         nextFHPtr = fhPtr->next;
         rtn_struct(theEnv,FunctionHash,fhPtr);
         fhPtr = nextFHPtr;
        }
     }
   
   genfree(theEnv,ExternalFunctionData(theEnv)->FunctionHashtable,
           (int) sizeof (struct FunctionHash *) * SIZE_FUNCTION_HASH);
  }

bool CloseStringBuilderDestination(
  Environment *theEnv,
  const char *name)
  {
   StringBuilderRouter *head, *last;

   last = NULL;
   head = StringRouterData(theEnv)->ListOfStringBuilderRouters;
   while (head != NULL)
     {
      if (strcmp(head->name,name) == 0)
        {
         if (last == NULL)
           {
            StringRouterData(theEnv)->ListOfStringBuilderRouters = head->next;
            rm(theEnv,(void *) head->name,strlen(head->name) + 1);
            rtn_struct(theEnv,stringBuilderRouter,head);
            return true;
           }
         else
           {
            last->next = head->next;
            rm(theEnv,(void *) head->name,strlen(head->name) + 1);
            rtn_struct(theEnv,stringBuilderRouter,head);
            return true;
           }
        }
      last = head;
      head = head->next;
     }

   return false;
  }

/***********************************************************************
  NAME         : PackSlots
  DESCRIPTION  : Groups class-slots into a contiguous array
                  "slots" field points to array
                  "slotCount" field set
  INPUTS       : 1) The class
                 2) The list of slots
  RETURNS      : Nothing useful
  SIDE EFFECTS : Temporary list deallocated, contiguous array allocated,
                   and nxt pointers linked
                 Class pointer set for slots
  NOTES        : Assumes class->slotCount == 0 && class->slots == NULL
 ***********************************************************************/
static void PackSlots(
  void *theEnv,
  DEFCLASS *cls,
  TEMP_SLOT_LINK *slots)
  {
   TEMP_SLOT_LINK *stmp,*sprv;
   long i;

   stmp = slots;
   while  (stmp != NULL)
     {
      stmp->desc->cls = cls;
      cls->slotCount++;
      stmp = stmp->nxt;
     }
   cls->slots = (SLOT_DESC *) gm2(theEnv,(sizeof(SLOT_DESC) * cls->slotCount));
   stmp = slots;
   for (i = 0 ; i < cls->slotCount ; i++)
     {
      sprv = stmp;
      stmp = stmp->nxt;
      GenCopyMemory(SLOT_DESC,1,&(cls->slots[i]),sprv->desc);
      cls->slots[i].sharedValue.desc = &(cls->slots[i]);
      cls->slots[i].sharedValue.value = NULL;
      rtn_struct(theEnv,slotDescriptor,sprv->desc);
      rtn_struct(theEnv,tempSlotLink,sprv);
     }
  }

static void DestroyDeftemplate(
  void *theEnv,
  void *vTheConstruct)
  {

   struct deftemplate *theConstruct = (struct deftemplate *) vTheConstruct;
#if (! BLOAD_ONLY) && (! RUN_TIME)
   struct templateSlot *slotPtr, *nextSlot;
#endif
   if (theConstruct == NULL) return;
  
#if (! BLOAD_ONLY) && (! RUN_TIME)
   slotPtr = theConstruct->slotList;

   while (slotPtr != NULL)
     {
      nextSlot = slotPtr->next;
      rtn_struct(theEnv,templateSlot,slotPtr);
      slotPtr = nextSlot;
     }
#endif

   DestroyFactPatternNetwork(theEnv,theConstruct->patternNetwork);
   
   /*==================================*/
   /* Free storage used by the header. */
   /*==================================*/

#if (! BLOAD_ONLY) && (! RUN_TIME)
   DeinstallConstructHeader(theEnv,&theConstruct->header);

   rtn_struct(theEnv,deftemplate,theConstruct);
#endif
  }

globle void FlushGarbagePartialMatches(
  void *theEnv)
  {
   struct partialMatch *pmPtr;
   struct alphaMatch *amPtr;

   /*===================================================*/
   /* Return the garbage partial matches collected from */
   /* the alpha memories of the pattern networks.       */
   /*===================================================*/

   while (EngineData(theEnv)->GarbageAlphaMatches != NULL)
     {
      amPtr = EngineData(theEnv)->GarbageAlphaMatches->next;
      rtn_struct(theEnv,alphaMatch,EngineData(theEnv)->GarbageAlphaMatches);
      EngineData(theEnv)->GarbageAlphaMatches = amPtr;
     }

   /*==============================================*/
   /* Return the garbage partial matches collected */
   /* from the beta memories of the join networks. */
   /*==============================================*/

   while (EngineData(theEnv)->GarbagePartialMatches != NULL)
     {
      /*=====================================================*/
      /* Remember the next garbage partial match to process. */
      /*=====================================================*/

      pmPtr = EngineData(theEnv)->GarbagePartialMatches->next;

      /*=======================================================*/
      /* If a "pseudo" data entity was created for the partial */
      /* match (i.e. a not CE was satisfied), then dispose of  */
      /* the pseudo data entity.                               */
      /*=======================================================*/

      if ((EngineData(theEnv)->GarbagePartialMatches->notOriginf) &&
          (EngineData(theEnv)->GarbagePartialMatches->counterf == FALSE))
        {
         if (EngineData(theEnv)->GarbagePartialMatches->binds[EngineData(theEnv)->GarbagePartialMatches->bcount - 1].gm.theMatch != NULL)
           {
            rtn_struct(theEnv,alphaMatch,
                       EngineData(theEnv)->GarbagePartialMatches->binds[EngineData(theEnv)->GarbagePartialMatches->bcount - 1].gm.theMatch);
           }
        }

      /*============================================*/
      /* Dispose of the garbage partial match being */
      /* examined and move on to the next one.      */
      /*============================================*/

      EngineData(theEnv)->GarbagePartialMatches->busy = FALSE;
      ReturnPartialMatch(theEnv,EngineData(theEnv)->GarbagePartialMatches);
      EngineData(theEnv)->GarbagePartialMatches = pmPtr;
     }
  }

static void DeallocateDefruleData(
  Environment *theEnv)
  {
   struct defruleModule *theModuleItem;
   Defmodule *theModule;
   Activation *theActivation, *tmpActivation;
   struct salienceGroup *theGroup, *tmpGroup;

#if BLOAD || BLOAD_AND_BSAVE
   if (Bloaded(theEnv))
     { return; }
#endif

   DoForAllConstructs(theEnv,DestroyDefruleAction,
                      DefruleData(theEnv)->DefruleModuleIndex,false,NULL);

   for (theModule = GetNextDefmodule(theEnv,NULL);
        theModule != NULL;
        theModule = GetNextDefmodule(theEnv,theModule))
     {
      theModuleItem = (struct defruleModule *)
                      GetModuleItem(theEnv,theModule,
                                    DefruleData(theEnv)->DefruleModuleIndex);

      theActivation = theModuleItem->agenda;
      while (theActivation != NULL)
        {
         tmpActivation = theActivation->next;

         rtn_struct(theEnv,activation,theActivation);

         theActivation = tmpActivation;
        }

      theGroup = theModuleItem->groupings;
      while (theGroup != NULL)
        {
         tmpGroup = theGroup->next;

         rtn_struct(theEnv,salienceGroup,theGroup);

         theGroup = tmpGroup;
        }

#if ! RUN_TIME
      rtn_struct(theEnv,defruleModule,theModuleItem);
#endif
     }

   rm(theEnv,DefruleData(theEnv)->AlphaMemoryTable,sizeof (ALPHA_MEMORY_HASH *) * ALPHA_MEMORY_HASH_SIZE);
  }

static void DeallocateDeffactsData(
  void *theEnv)
  {
#if ! RUN_TIME
   struct deffactsModule *theModuleItem;
   void *theModule;

#if BLOAD || BLOAD_AND_BSAVE
   if (Bloaded(theEnv)) return;
#endif

   DoForAllConstructs(theEnv,DestroyDeffactsAction,DeffactsData(theEnv)->DeffactsModuleIndex,FALSE,NULL); 

   for (theModule = EnvGetNextDefmodule(theEnv,NULL);
        theModule != NULL;
        theModule = EnvGetNextDefmodule(theEnv,theModule))
     {
      theModuleItem = (struct deffactsModule *)
                      GetModuleItem(theEnv,(struct defmodule *) theModule,
                                    DeffactsData(theEnv)->DeffactsModuleIndex);
      rtn_struct(theEnv,deffactsModule,theModuleItem);
     }
#else
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(theEnv)
#endif
#endif
  }

static struct dependency *DetachAssociatedDependencies(
  void *theEnv,
  struct dependency *theList,
  void *theEntity)
  {
   struct dependency *fdPtr, *nextPtr, *lastPtr = NULL;

   fdPtr = theList;

   while (fdPtr != NULL)
     {
      if (fdPtr->dPtr == theEntity)
        {
         nextPtr = fdPtr->next;
         if (lastPtr == NULL) theList = nextPtr;
         else lastPtr->next = nextPtr;
         rtn_struct(theEnv,dependency,fdPtr);
         fdPtr = nextPtr;
        }
      else
        {
         lastPtr = fdPtr;
         fdPtr = fdPtr->next;
        }
     }

   return(theList);
  }

/******************************************************************************
  NAME         : QueryDoForFact
  DESCRIPTION  : Finds the first set of facts which satisfy the query and
                   executes a user-action with that set
  INPUTS       : None
  RETURNS      : Caller's result buffer
  SIDE EFFECTS : The query template-expressions are evaluated once,
                   and the query boolean-expression is evaluated
                   zero or more times (depending on fact restrictions
                   and how early the expression evaulates to TRUE - if at all).
                   Also the action expression is executed zero or once.
                 Caller's result buffer holds result of user-action
  NOTES        : H/L Syntax : See ParseQueryAction()
 ******************************************************************************/
globle void QueryDoForFact(
  void *theEnv,
  DATA_OBJECT *result)
  {
   QUERY_TEMPLATE *qtemplates;
   unsigned rcnt;

   result->type = SYMBOL;
   result->value = EnvFalseSymbol(theEnv);
   qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg,
                                      "do-for-fact",&rcnt);
   if (qtemplates == NULL)
     return;
   PushQueryCore(theEnv);
   FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
   FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt));
   FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
   FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
   if (TestForFirstInChain(theEnv,qtemplates,0) == TRUE)
     EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,result);
   FactQueryData(theEnv)->AbortQuery = FALSE;
   ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
   rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt));
   rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
   PopQueryCore(theEnv);
   DeleteQueryTemplates(theEnv,qtemplates);
  }

globle struct callFunctionItem *RemoveFunctionFromCallList(
  void *theEnv,
  char *name,
  struct callFunctionItem *head,
  int *found)
  {
   struct callFunctionItem *currentPtr, *lastPtr;

   *found = FALSE;
   lastPtr = NULL;
   currentPtr = head;

   while (currentPtr != NULL)
     {
      if (strcmp(name,currentPtr->name) == 0)
        {
         *found = TRUE;
         if (lastPtr == NULL)
           { head = currentPtr->next; }
         else
           { lastPtr->next = currentPtr->next; }

         rtn_struct(theEnv,callFunctionItem,currentPtr);
         return(head);
        }

      lastPtr = currentPtr;
      currentPtr = currentPtr->next;
     }

   return(head);
  }

static void DeallocateDefglobalData(
  void *theEnv)
  {
#if ! RUN_TIME
   struct defglobalModule *theModuleItem;
   void *theModule;
   
#if BLOAD || BLOAD_AND_BSAVE
   if (Bloaded(theEnv)) return;
#endif

   DoForAllConstructs(theEnv,DestroyDefglobalAction,DefglobalData(theEnv)->DefglobalModuleIndex,FALSE,NULL); 

   for (theModule = EnvGetNextDefmodule(theEnv,NULL);
        theModule != NULL;
        theModule = EnvGetNextDefmodule(theEnv,theModule))
     {
      theModuleItem = (struct defglobalModule *)
                      GetModuleItem(theEnv,(struct defmodule *) theModule,
                                    DefglobalData(theEnv)->DefglobalModuleIndex);
      rtn_struct(theEnv,defglobalModule,theModuleItem);
     }
#else
   DoForAllConstructs(theEnv,DestroyDefglobalAction,DefglobalData(theEnv)->DefglobalModuleIndex,FALSE,NULL); 
#endif
  }

globle int RemoveConstruct(
  void *theEnv,
  const char *name)
  {
   struct construct *currentPtr, *lastPtr = NULL;

   for (currentPtr = ConstructData(theEnv)->ListOfConstructs;
        currentPtr != NULL;
        currentPtr = currentPtr->next)
     {
      if (strcmp(name,currentPtr->constructName) == 0)
        {
         if (lastPtr == NULL)
           { ConstructData(theEnv)->ListOfConstructs = currentPtr->next; }
         else
           { lastPtr->next = currentPtr->next; }
         rtn_struct(theEnv,construct,currentPtr);
         return(TRUE);
        }

      lastPtr = currentPtr;
     }

   return(FALSE);
  }

globle void InstallFunctionList(
  void *theEnv,
  struct FunctionDefinition *value)
  {
   int i;
   struct FunctionHash *fhPtr, *nextPtr;

   if (ExternalFunctionData(theEnv)->FunctionHashtable != NULL)
     {
      for (i = 0; i < SIZE_FUNCTION_HASH; i++)
        {
         fhPtr = ExternalFunctionData(theEnv)->FunctionHashtable[i];
         while (fhPtr != NULL)
           {
            nextPtr = fhPtr->next;
            rtn_struct(theEnv,FunctionHash,fhPtr);
            fhPtr = nextPtr;
           }
         ExternalFunctionData(theEnv)->FunctionHashtable[i] = NULL;
        }
     }

   ExternalFunctionData(theEnv)->ListOfFunctions = value;

   while (value != NULL)
     {
      AddHashFunction(theEnv,value);
      value = value->next;
     }
  }

globle int UndefineFunction(
  void *theEnv,
  const char *functionName)
  {
   SYMBOL_HN *findValue;
   struct FunctionDefinition *fPtr, *lastPtr = NULL;

   findValue = (SYMBOL_HN *) FindSymbolHN(theEnv,functionName);

   for (fPtr = ExternalFunctionData(theEnv)->ListOfFunctions;
        fPtr != NULL;
        fPtr = fPtr->next)
     {
      if (fPtr->callFunctionName == findValue)
        {
         DecrementSymbolCount(theEnv,fPtr->callFunctionName);
         RemoveHashFunction(theEnv,fPtr);

         if (lastPtr == NULL)
           { ExternalFunctionData(theEnv)->ListOfFunctions = fPtr->next; }
         else
           { lastPtr->next = fPtr->next; }
           
         ClearUserDataList(theEnv,fPtr->usrData);
         rtn_struct(theEnv,FunctionDefinition,fPtr);
         return(TRUE);
        }

      lastPtr = fPtr;
     }

   return(FALSE);
  }

globle void RemovePMDependencies(
  void *theEnv,
  struct partialMatch *theBinds)
  {
   struct dependency *fdPtr, *nextPtr, *theList;
   struct patternEntity *theEntity;

   fdPtr = (struct dependency *) theBinds->binds[theBinds->bcount + theBinds->activationf].gm.theValue;

   while (fdPtr != NULL)
     {
      nextPtr = fdPtr->next;

      theEntity = (struct patternEntity *) fdPtr->dPtr;

      theList = (struct dependency *) theEntity->dependents;
      theList = DetachAssociatedDependencies(theEnv,theList,(void *) theBinds);
      theEntity->dependents = (void *) theList;

      rtn_struct(theEnv,dependency,fdPtr);
      fdPtr = nextPtr;
     }

   theBinds->binds[theBinds->bcount + theBinds->activationf].gm.theValue = NULL;
  }

static void DestroyDefglobal(
  Environment *theEnv,
  Defglobal *theDefglobal)
  {
   if (theDefglobal == NULL) return;

   /*====================================*/
   /* Return the global's current value. */
   /*====================================*/

   if (theDefglobal->current.header->type == MULTIFIELD_TYPE)
     {
      if (theDefglobal->current.multifieldValue->busyCount == 0)
        { ReturnMultifield(theEnv,theDefglobal->current.multifieldValue); }
      else
        { AddToMultifieldList(theEnv,theDefglobal->current.multifieldValue); }
     }

#if (! RUN_TIME)

   /*===============================*/
   /* Release items stored in the   */
   /* defglobal's construct header. */
   /*===============================*/

   DeinstallConstructHeader(theEnv,&theDefglobal->header);

   /*======================================*/
   /* Return the defglobal data structure. */
   /*======================================*/

   rtn_struct(theEnv,defglobal,theDefglobal);
#endif
  }

static void ReturnModule(
  Environment *theEnv,
  void *theItem)
  {
   FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefruleData(theEnv)->DefruleConstruct);
   rtn_struct(theEnv,defruleModule,theItem);
  }