}/******************************************************//* CreateMainModule: Creates the default MAIN module. *//******************************************************/globle void CreateMainModule(  void *theEnv)  {   struct defmodule *newDefmodule;   struct moduleItem *theItem;   int i;   struct defmoduleItemHeader *theHeader;   /*=======================================*/   /* Allocate the defmodule data structure */   /* and name it the MAIN module.          */   /*=======================================*/   newDefmodule = get_struct(theEnv,defmodule);   newDefmodule->name = (SYMBOL_HN *) EnvAddSymbol(theEnv,"MAIN");   IncrementSymbolCount(newDefmodule->name);   newDefmodule->next = NULL;   newDefmodule->ppForm = NULL;   newDefmodule->importList = NULL;   newDefmodule->exportList = NULL;   newDefmodule->bsaveID = 0L;   newDefmodule->usrData = NULL;   /*==================================*/   /* Initialize the array for storing */   /* the module's construct lists.    */   /*==================================*/   if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL;   else     {      newDefmodule->itemsArray = (struct defmoduleItemHeader **)                                 gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems);      for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems;           (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL);           i++, theItem = theItem->next)        {         if (theItem->allocateFunction == NULL)           { newDefmodule->itemsArray[i] = NULL; }         else           {            newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *)                                          (*theItem->allocateFunction)(theEnv);            theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i];            theHeader->theModule = newDefmodule;            theHeader->firstItem = NULL;            theHeader->lastItem = NULL;           }        }     }   /*=======================================*/   /* Add the module to the list of modules */   /* and make it the current module.       */   /*=======================================*/#if (! BLOAD_ONLY) && (! RUN_TIME) && DEFMODULE_CONSTRUCT   SetNumberOfDefmodules(theEnv,1L);#endif   DefmoduleData(theEnv)->LastDefmodule = newDefmodule;   DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule;   EnvSetCurrentModule(theEnv,(void *) newDefmodule);  }/*********************************************************************//* SetListOfDefmodules: Sets the list of defmodules to the specified *//*   value. Normally used when initializing a run-time module or     *//*   when bloading a binary file to install the list of defmodules.  *//*********************************************************************/globle void SetListOfDefmodules(  void *theEnv,  void *defmodulePtr)  {   DefmoduleData(theEnv)->ListOfDefmodules = (struct defmodule *) defmodulePtr;   DefmoduleData(theEnv)->LastDefmodule = DefmoduleData(theEnv)->ListOfDefmodules;   if (DefmoduleData(theEnv)->LastDefmodule == NULL) return;   while (DefmoduleData(theEnv)->LastDefmodule->next != NULL) DefmoduleData(theEnv)->LastDefmodule = DefmoduleData(theEnv)->LastDefmodule->next;  }/********************************************************************//* EnvGetNextDefmodule: If passed a NULL pointer, returns the first *//*   defmodule in the ListOfDefmodules. Otherwise returns the next  *//*   defmodule following the defmodule passed as an argument.       *//********************************************************************/globle void *EnvGetNextDefmodule(  void *theEnv,  void *defmodulePtr)  {   if (defmodulePtr == NULL)     { return((void *) DefmoduleData(theEnv)->ListOfDefmodules); }   else     { return((void *) (((struct defmodule *) defmodulePtr)->next)); }  }/*****************************************//* EnvGetDefmoduleName: Returns the name *//*   of the specified defmodule.         *//*****************************************/#if IBM_TBC#pragma argsused#endifgloble char *EnvGetDefmoduleName(  void *theEnv,  void *defmodulePtr)  { #if MAC_MCW || IBM_MCW || MAC_XCD#pragma unused(theEnv)#endif   return(ValueToString(((struct defmodule *) defmodulePtr)->name));   }/***************************************************//* EnvGetDefmodulePPForm: Returns the pretty print *//*   representation of the specified defmodule.    *//***************************************************/#if IBM_TBC#pragma argsused#endifgloble char *EnvGetDefmodulePPForm(  void *theEnv,  void *defmodulePtr)  { #if MAC_MCW || IBM_MCW || MAC_XCD#pragma unused(theEnv)#endif   return(((struct defmodule *) defmodulePtr)->ppForm);   }#if (! RUN_TIME)/***********************************************//* RemoveAllDefmodules: Removes all defmodules *//*   from the current environment.             *//***********************************************/globle void RemoveAllDefmodules(  void *theEnv)  {   struct defmodule *nextDefmodule;   while (DefmoduleData(theEnv)->ListOfDefmodules != NULL)     {      nextDefmodule = DefmoduleData(theEnv)->ListOfDefmodules->next;      ReturnDefmodule(theEnv,DefmoduleData(theEnv)->ListOfDefmodules,FALSE);      DefmoduleData(theEnv)->ListOfDefmodules = nextDefmodule;     }   DefmoduleData(theEnv)->CurrentModule = NULL;   DefmoduleData(theEnv)->LastDefmodule = NULL;  }/************************************************************//* ReturnDefmodule: Returns the data structures associated  *//*   with a defmodule construct to the pool of free memory. *//************************************************************/static void ReturnDefmodule(  void *theEnv,  struct defmodule *theDefmodule,  intBool environmentClear)  {   int i;   struct moduleItem *theItem;   struct portItem *theSpec, *nextSpec;   /*=====================================================*/   /* Set the current module to the module being deleted. */   /*=====================================================*/   if (theDefmodule == NULL) return;      if (! environmentClear)     { EnvSetCurrentModule(theEnv,(void *) theDefmodule); }   /*============================================*/   /* Call the free functions for the constructs */   /* belonging to this module.                  */   /*============================================*/   if (theDefmodule->itemsArray != NULL)     {      if (! environmentClear)        {         for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems;              (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL);              i++, theItem = theItem->next)           {            if (theItem->freeFunction != NULL)              { (*theItem->freeFunction)(theEnv,theDefmodule->itemsArray[i]); }           }        }      rm(theEnv,theDefmodule->itemsArray,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems);    }   /*======================================================*/   /* Decrement the symbol count for the defmodule's name. */   /*======================================================*/   if (! environmentClear)     { DecrementSymbolCount(theEnv,theDefmodule->name); }   /*====================================*/   /* Free the items in the import list. */   /*====================================*/   theSpec = theDefmodule->importList;   while (theSpec != NULL)     {      nextSpec = theSpec->next;      if (! environmentClear)        {         if (theSpec->moduleName != NULL) DecrementSymbolCount(theEnv,theSpec->moduleName);         if (theSpec->constructType != NULL) DecrementSymbolCount(theEnv,theSpec->constructType);         if (theSpec->constructName != NULL) DecrementSymbolCount(theEnv,theSpec->constructName);        }      rtn_struct(theEnv,portItem,theSpec);      theSpec = nextSpec;     }   /*====================================*/   /* Free the items in the export list. */   /*====================================*/   theSpec = theDefmodule->exportList;   while (theSpec != NULL)     {      nextSpec = theSpec->next;      if (! environmentClear)        {         if (theSpec->moduleName != NULL) DecrementSymbolCount(theEnv,theSpec->moduleName);         if (theSpec->constructType != NULL) DecrementSymbolCount(theEnv,theSpec->constructType);         if (theSpec->constructName != NULL) DecrementSymbolCount(theEnv,theSpec->constructName);        }      rtn_struct(theEnv,portItem,theSpec);      theSpec = nextSpec;     }   /*=========================================*/   /* Free the defmodule pretty print string. */   /*=========================================*/   if (theDefmodule->ppForm != NULL)     {      rm(theEnv,theDefmodule->ppForm,         (int) sizeof(char) * (strlen(theDefmodule->ppForm) + 1));     }        /*=======================*/   /* Return the user data. */   /*=======================*/   ClearUserDataList(theEnv,theDefmodule->usrData);      /*======================================*/   /* Return the defmodule data structure. */   /*======================================*/   rtn_struct(theEnv,defmodule,theDefmodule);  }#endif /* (! RUN_TIME) *//**********************************************************************//* EnvFindDefmodule: Searches for a defmodule in the list of defmodules. *//*   Returns a pointer to the defmodule if found, otherwise NULL.     *//**********************************************************************/globle void *EnvFindDefmodule(  void *theEnv,  char *defmoduleName)  {   struct defmodule *defmodulePtr;   SYMBOL_HN *findValue;   if ((findValue = (SYMBOL_HN *) FindSymbolHN(theEnv,defmoduleName)) == NULL) return(NULL);   defmodulePtr = DefmoduleData(theEnv)->ListOfDefmodules;   while (defmodulePtr != NULL)     {      if (defmodulePtr->name == findValue)        { return((void *) defmodulePtr); }      defmodulePtr = defmodulePtr->next;     }   return(NULL);  }/*************************************************//* GetCurrentModuleCommand: H/L access routine   *//*   for the get-current-module command.         *//*************************************************/globle void *GetCurrentModuleCommand(  void *theEnv)  {   struct defmodule *theModule;   EnvArgCountCheck(theEnv,"get-current-module",EXACTLY,0);   theModule = (struct defmodule *) EnvGetCurrentModule(theEnv);   if (theModule == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv));   return((SYMBOL_HN *) EnvAddSymbol(theEnv,ValueToString(theModule->name)));  }/*************************************************//* SetCurrentModuleCommand: H/L access routine   *//*   for the set-current-module command.         *//*************************************************/globle void *SetCurrentModuleCommand(  void *theEnv)  {   DATA_OBJECT argPtr;   char *argument;   struct defmodule *theModule;   SYMBOL_HN *defaultReturn;   /*=====================================================*/   /* Check for the correct number and type of arguments. */   /*=====================================================*/   theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));   if (theModule == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv));   defaultReturn = (SYMBOL_HN *) EnvAddSymbol(theEnv,ValueToString(((struct defmodule *) EnvGetCurrentModule(theEnv))->name));   if (EnvArgCountCheck(theEnv,"set-current-module",EXACTLY,1) == -1)     { return(defaultReturn); }   if (EnvArgTypeCheck(theEnv,"set-current-module",1,SYMBOL,&argPtr) == FALSE)     { return(defaultReturn); }   argument = DOToString(argPtr);   /*================================================*/   /* Set the current module to the specified value. */   /*================================================*/   theModule = (struct defmodule *) EnvFindDefmodule(theEnv,argument);   if (theModule == NULL)     {      CantFindItemErrorMessage(theEnv,"defmodule",argument);      return(defaultReturn);     }   EnvSetCurrentModule(theEnv,(void *) theModule);   /*================================*/   /* Return the new current module. */   /*================================*/   return((SYMBOL_HN *) defaultReturn);  }/*************************************************//* AddAfterModuleChangeFunction: Adds a function *//*   to the list of functions to be called after *//*   a module change occurs.                     *//*************************************************/globle void AddAfterModuleChangeFunction(  void *theEnv,  char *name,  void (*func)(void *),  int priority)  {   DefmoduleData(theEnv)->AfterModuleChangeFunctions =     AddFunctionToCallList(theEnv,name,priority,func,DefmoduleData(theEnv)->AfterModuleChangeFunctions,TRUE);  }/************************************************//* IllegalModuleSpecifierMessage: Error message *//*   for the illegal use of a module specifier. *//************************************************/globle void IllegalModuleSpecifierMessage(  void *theEnv)  {   PrintErrorID(theEnv,"MODULDEF",1,TRUE);   EnvPrintRouter(theEnv,WERROR,"Illegal use of the module specifier.\n");  }