module.c

Go to the documentation of this file.

/*

  Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.

  This program is free software; you can redistribute it and/or modify it
  under the terms of version 2 of the GNU General Public License as
  published by the Free Software Foundation.

  This program is distributed in the hope that it would be useful, but
  WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  

  Further, this software is distributed without any warranty that it is
  free of the rightful claim of any third person regarding infringement 
  or the like.  Any license provided herein, whether implied or 
  otherwise, applies only to this software file.  Patent licenses, if 
  any, provided herein do not apply to combinations of this program with 
  other software, or any other product whatsoever.  

  You should have received a copy of the GNU General Public License along
  with this program; if not, write the Free Software Foundation, Inc., 59
  Temple Place - Suite 330, Boston MA 02111-1307, USA.

  Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
  Mountain View, CA 94043, or:

  http://www.sgi.com

  For further information regarding this notice, see:

  http://oss.sgi.com/projects/GenInfo/NoticeExplan

*/


static char USMID[] = "\n@(#)5.0_pl/sources/module.c    5.17    09/30/99 15:47:54\n";

# include "defines.h"           /* Machine dependent ifdefs */

# include "host.m"              /* Host machine dependent macros.*/
# include "host.h"              /* Host machine dependent header.*/
# include "target.m"            /* Target machine dependent macros.*/
# include "target.h"            /* Target machine dependent header.*/

# include "globals.m"
# include "tokens.m"
# include "sytb.m"  
# include "p_globals.m"  
# include "debug.m"
# include "module.m"

# include "globals.h"
# include "tokens.h"
# include "sytb.h"
# include "p_globals.h"
# include "module.h"

# include <ar.h>

# include <sys/types.h>
# include <sys/stat.h>

# include <dirent.h>

# include <errno.h>

# if defined(GENERATE_WHIRL) && defined(_MODULE_TO_DOT_o)
# include <fcntl.h>
# include <libelf.h>
# include <sys/elf.h>

  /* These are the originator string and .note type this program removes  */
  /* from files.                                                          */

# define NOTE_ORIG_NAME  "Cray Research, Incorporated\0"
# define NOTE_ORGNAM_LEN 28
# define NOTE_TYPE        1

# elif defined(_TARGET_OS_SOLARIS) && defined(_MODULE_TO_DOT_o)
# include <fcntl.h>
# include <libelf.h>
# include <sys/elf_SPARC.h>

  /* These are the originator string and .note type this program removes  */
  /* from files.                                                          */

# define NOTE_ORIG_NAME  "Cray Research, Incorporated\0"
# define NOTE_ORGNAM_LEN 28
# define NOTE_TYPE        1
# endif

# if !defined(AR_HDR_SIZE)
# define        AR_HDR_SIZE     sizeof(ar_hdr_type)
# endif

/******************************************************************************\
|*                                                                            *|
|* Notes if a new field is added to the symbol tables.                        *|
|*                                                                            *|
|*   1) Add it to the appropriate set_mod_link_tbl_for ... routine            *|
|*      This routine sets the KEEP_ME and IDX flags in the mod link table     *|
|*      so that the table entry gets kept during compression.                 *|
|*                                                                            *|
|*   2) Add it to update_idxs_in_attr_entry or compress_tbls for non attr     *|
|*      fields.  These routines do the actual compression and reset the       *|
|*      fields.  compress_tbls calls update_idxs_in_attr_entry.               *|
|*                                                                            *|
|*   3) Add it to update_new_idxs_after_input.  This routine sets the indexes *|
|*      after a module is read in.  When a module is in a file, all the table *|
|*      indexes are 1 based.  When it is read in, each new table is           *|
|*      concatenated to the existing table, so all the indexs need the table  *|
|*      size before reading added to the index.  This is generally the        *|
|*      location to correct for symbol table changes.                         *|
|*                                                                            *|
\******************************************************************************/


/******************************************************************************\
|*                                                                            *|
|* Steps for compressing tables.  (Both partial and full compressions.)       *|
|*                                                                            *|
|*   These routines allow for full and partial compressions.  (See #2 to      *|
|*   set indexes for a partial compression.  A full compression is everything *|
|*   in a table.  A partial compression starts at a given index in a table    *|
|*   and goes to the end of a table.  These routines will not do a compression*|
|*   in the middle of a table.                                                *|
|*                                                                            *|
|*   1) Allocate the mod_link_tbl.  This table is allocated so that it is as  *|
|*      big as the largest symbol/ir table.  If between marking the entries   *|
|*      in the mod_link_tbl and the actual compression, any tables grow       *|
|*      always make sure the mod_link_tbl size is still big enough to cover   *|
|*      the new entries.  No matter what table is being compressed, the mod_  *|
|*      link_tbl must be allocated as large as the largest table.             *|
|*                                                                            *|
|*   2) Set the zeroth entries in the mod_link_tbl to one less than the       *|
|*      starting index for compression.  If this is a full compression, then  *|
|*      they should be set to 0.  Anything in a table past this index is      *|
|*      subject to compression.                                               *|
|*                                                                            *|
|*   3) Call set_mod_link_tbl_for_attr  each attr entry that needs to be kept.*|
|*      If this is a partial compression, this only needs to be called for    *|
|*      those attr entries in the part of the attr table to be compressed.    *|
|*      This routine calls set_mod_link_tbl routines for other tables.  If the*|
|*      local name table is to be compressed, these entries will have to be   *|
|*      marked.  (See create_mod_info_tbl for how this is done for a full     *|
|*      compression.)  This routine marks each table entry that needs to be   *|
|*      kept in the mod_link_tbl, with its current index.  That way if the    *|
|*      item being compressed points into a part of the table not being       *|
|*      compressed, it will get the correct index out of the mod_link_tbl.    *|
|*                                                                            *|
|*   4) Call assign_new_idxs.  It will start at the point of compression for  *|
|*      each table.  If the mod_link_tbl is set for that entry, it will be    *|
|*      given a new index.  (The new index for a table starts at the index    *|
|*      where compression starts and is incremented each time a table entry   *|
|*      is kept.)  The new index is put into the mod_link_tbl for the entry.  *|
|*                                                                            *|
|*   5) Call compress_tbls to move the table entries to their new index spots.*|
|*      This is where actual compression takes place.  As the entries are     *|
|*      being moved, all their links are updated with the correct links from  *|
|*      the mod_link_tbl.                                                     *|
|*                                                                            *|
|*   Example:  Compress the attr_tbl starting at index 65.  attr_tbl_idx = 70 *|
|*             Entries  66, 68 and 70 are to be kept.                         *|
|*             1) Allocate mod_link_tbl as large as the largest table.        *|
|*             2) ML_AT_IDX(0) = 64  (65 - one)                               *|
|*                The rest of the tables mod_link_tbl[0] entries are set to   *|
|*                the current table indexes so that no other table compresses.*|
|*             3) Call set_mod_link_tbl_for_attr for attr entries 66, 68 & 70.*|
|*             4) Call assign_new_idxs.       Old Idx        New Idx          *|
|*                                              66             65             *|
|*                                              68             66             *|
|*                                              70             67             *|
|*             5) Call compress_tbls which moves the attr tbl entries.        *|
|*                attr_tbl_idx is set to 67.                                  *|
|*                                                                            *|
|*   NOTE:  compress_tbls and assign_new_idxs will go through all the tables, *|
|*      so in the above example, any references to attrs 66, 68 and 70 will   *|
|*      be reset.  If there are references to attrs 67 or 69, these           *|
|*      references will be set to NULL_IDX.  This is where alot of bugs are   *|
|*      found during module processing.  Full compressions are done when      *|
|*      files are written out for modules or inlining.  Partial compressions  *|
|*      are done when files for module or inlining are read in and also for   *|
|*      interface block compression.                                          *|
|*                                                                            *|
|*                                                                            *|
\******************************************************************************/

extern  boolean is_directory(char *);

/*****************************************************************\
|* function prototypes of static functions declared in this file *|
\*****************************************************************/
static  void    allocate_mod_link_tbl (int);
static  void    assign_new_idxs (boolean);
static  void    assign_new_idxs_after_input (int);
static  void    check_ir_for_attrs (int);
static  void    check_il_for_attrs (int);
static  void    compress_tbls (int, boolean);
static  void    compress_type_tbl (int);
# if 0
static  void    create_module_list_from_str_pool (void);
# endif

# if defined(_TARGET_OS_SOLARIS) && defined(_MODULE_TO_DOT_o)
static  boolean do_elf_notes_section(Elf_Data *, int, int);
static  boolean do_elf_object(Elf *, Elf32_Ehdr *, int, int);
# endif

/* # if defined(_DEBUG) */
static  void    dump_pdt(FILE *);
static  void    print_mod_tbl(void);
/* # endif */

static  void    find_files_in_directory(int);
static  void    merge_interfaces (int, int);
static  void    not_visible_semantics (int, int, int);
static  int     ntr_file_in_fp_tbl(int, char *, int);
static  FILE   *open_module_file (int, int);
static  void    process_procs_for_inlining (int);
static  boolean read_in_module_tbl (int, int, FILE *, char *);
static  boolean read_module_tbl_header (int, int, FILE *);
static  boolean read_sytb_from_module_file(int, FILE *, char *);
static  boolean rename_only_semantics (int, boolean);
static  boolean resolve_attr(int);
static  void    resolve_all_components(int, int);
static  void    resolve_used_modules (int);
static  void    set_attr_flds_for_output (void);
static  void    set_mod_link_tbl_for_attr (int);
static  void    set_mod_link_tbl_for_bd (int);
static  void    set_mod_link_tbl_for_cn (int);
static  void    set_mod_link_tbl_for_ir (int);
static  void    set_mod_link_tbl_for_il (int);
static  void    set_mod_link_tbl_for_typ (int);
static  boolean srch_ar_file_for_module_tbl (int, int *, int, FILE *);
static  boolean srch_for_module_tbl (int, int *, int, int, FILE *);
static  void    update_idxs_in_attr_entry (int, int);
static  void    update_intrinsic (int);

# if defined(_TARGET_OS_SOLARIS) && defined(_MODULE_TO_DOT_o)
static  boolean srch_elf_file_for_module_tbl(int, int);
# endif

static char * module_suffix_fix = ".mod-whirl";


/***********************************\
|* Globals used only in this file  *|
\***********************************/

static  boolean alternate_entry;
static  boolean count_derived_types;
static  boolean only_update_new_tbl_entries;
static  boolean inline_search;
static  int     list_of_modules_in_module;
static  long    mod_file_end_offset;
static  long    num_module_derived_types;
static  int     save_const_pool_idx;
static  int     save_const_tbl_idx;
static  boolean search_for_duplicate_attrs;

extern  char    compiler_gen_date[];

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      This routine enters a rename and/or only name for a USE statement     *|
|*      into the rename only table.  All entries are kept in sorted order.    *|
|*      Rename entries actually get two entries in the table.  The original   *|
|*      name entry is the sorted one.  The new name entry is indexed off the  *|
|*      original name entry.  The whole list of renames/only entries is       *|
|*      indexed by ATP_USE_LIST for the module.                               *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      module_idx - The attr index for the module specified in the use stmt. *|
|*      ro_idx     - The new name index if this is a rename entry.   (This    *|
|*                   routine is called to enter the new name first.  The ro   *|
|*                   index is returned.  Then it is called again with the     *|
|*                   original name and the ro index.  An entry is made for    *|
|*                   the original name and the rename entry is hung off of it.*|
|*      rename_entry -> TRUE if this is the new name.  It doesn't need to be  *|
|*                      sorted or added to the list.                          *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      ro_idx just entered.                                                  *|
|*                                                                            *|
\******************************************************************************/
int  make_ro_entry(int          module_idx,
                   int          ro_idx,
                   boolean      rename_entry)

{
   int          cmp_idx;
   int          matched;
   int          np_idx;
   int          prev_idx;


   TRACE (Func_Entry, "make_ro_entry", NULL);

   if (ro_idx == NULL_IDX) {
      ++rename_only_tbl_idx;
      CHECK_TBL_ALLOC_SIZE(rename_only_tbl, rename_only_tbl_idx);

      ro_idx = rename_only_tbl_idx;

      CLEAR_TBL_NTRY(rename_only_tbl, ro_idx);

      NTR_NAME_POOL(TOKEN_ID(token).words, TOKEN_LEN(token), np_idx);

      RO_LINE_NUM(ro_idx)       = TOKEN_LINE(token);
      RO_COLUMN_NUM(ro_idx)     = TOKEN_COLUMN(token);
      RO_NAME_LEN(ro_idx)       = TOKEN_LEN(token);
      RO_NAME_IDX(ro_idx)       = np_idx;
   }

   if (rename_entry) {   /* Do not sort - assume it is a rename entry */
      RO_RENAME_NAME(ro_idx)    = TRUE;
   }
   else {  /* Find a sorted spot for it */
      RO_RENAME_NAME(ro_idx)    = FALSE;

      if (ATP_USE_LIST(module_idx) == NULL_IDX) {
         ATP_USE_LIST(module_idx) = ro_idx;
      }
      else {
         cmp_idx        = ATP_USE_LIST(module_idx);
         prev_idx       = NULL_IDX;

         for (;;) {
            matched = compare_names(RO_NAME_LONG(cmp_idx),
                                    RO_NAME_LEN(cmp_idx),
                                    TOKEN_ID(token).words,
                                    TOKEN_LEN(token));

            if (matched >= 0) {  

               /* Name in table is same or greater than new name.  Add the */
               /* new name before the current index.                       */

               RO_NEXT_IDX(ro_idx) = cmp_idx;

               if (prev_idx == NULL_IDX) {
                  ATP_USE_LIST(module_idx) = ro_idx;
               }
               else {
                  RO_NEXT_IDX(prev_idx) = ro_idx;
               }
               break;
            }
            else {
               prev_idx = cmp_idx;
               cmp_idx  = RO_NEXT_IDX(cmp_idx);

               if (cmp_idx == NULL_IDX) {  /* Add at end */
                  RO_NEXT_IDX(prev_idx) = ro_idx;
                  break;
               }
            }
         }
      }
   }

   TRACE (Func_Exit, "make_ro_entry", NULL);

   return(ro_idx);

}   /* make_ro_entry */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Search the renames table to see if this new name exists already.      *|
|*      This would happen if the same name was used to rename something twice.*|
|*      If it is found, RO_DUPLICATE_RENAME is set for both entries.  Errors  *|
|*      will be issued during use_stmt_semantics.                             *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      rename_idx -> The ro index for the name to search for.                *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
void    check_for_duplicate_renames(int         rename_idx)

{
   int          ro_idx;


   TRACE (Func_Entry, "check_for_duplicate_renames", NULL);

   for (ro_idx = 1; ro_idx < rename_only_tbl_idx; ro_idx++) {

      if (RO_RENAME_NAME(ro_idx) &&
          (compare_names(RO_NAME_LONG(rename_idx),
                         RO_NAME_LEN(rename_idx),
                         RO_NAME_LONG(ro_idx),
                         RO_NAME_LEN(ro_idx)) == 0) && ro_idx != rename_idx) {
        //         RO_DUPLICATE_RENAME(rename_idx)      = TRUE;
        //         RO_DUPLICATE_RENAME(ro_idx)          = TRUE;
         break;
      }
   }

   TRACE (Func_Exit, "check_for_duplicate_renames", NULL);

   return;

}   /* check_for_duplicate_renames */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Allocate and clear the module link table.  This is used for table     *|
|*      compression.                                                          *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      size -> Size to allocate.  If this is zero, we will calculate the     *|
|*              size to allocate, by finding the largest table.               *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
static  void allocate_mod_link_tbl(int          size)

{
   long         *idx;
   long          new_size;


   TRACE (Func_Entry, "allocate_mod_link_tbl", NULL);

   if (size == 0) {

      /* Find the largest table and allocate the mod link table to this size. */

      new_size = (attr_tbl_idx > bounds_tbl_idx)? attr_tbl_idx : bounds_tbl_idx;
      new_size = (new_size > const_tbl_idx)     ? new_size : const_tbl_idx;
      new_size = (new_size > const_pool_idx)    ? new_size : const_pool_idx;
      new_size = (new_size > loc_name_tbl_idx)  ? new_size : loc_name_tbl_idx;
      new_size = (new_size > name_pool_idx)     ? new_size : name_pool_idx;
      new_size = (new_size > sec_name_tbl_idx)  ? new_size : sec_name_tbl_idx;
      new_size = (new_size > stor_blk_tbl_idx)  ? new_size : stor_blk_tbl_idx;
      new_size = (new_size > type_tbl_idx)      ? new_size : type_tbl_idx;
      new_size = (new_size > ir_tbl_idx)        ? new_size : ir_tbl_idx;
      new_size = (new_size > ir_list_tbl_idx)   ? new_size : ir_list_tbl_idx;
      new_size = (new_size > sh_tbl_idx)        ? new_size : sh_tbl_idx;
   }
   else {
      new_size  = size;
   }

   new_size++;          /* Do not use entry 0, so increase size by 1 */

   CHECK_TBL_ALLOC_SIZE(mod_link_tbl, new_size);
   mod_link_tbl_idx     = mod_link_tbl_size - 1;

   idx = ((long *) (&mod_link_tbl[0]));

   memset(idx, 0, mod_link_tbl_size * NUM_ML_WDS * TARGET_BYTES_PER_WORD);

   TRACE (Func_Exit, "allocate_mod_link_tbl", NULL);

   return;

}  /* allocate_mod_link_tbl */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
extern  void    create_mod_info_file(void)
{
                int              ga_idx=0;
                FILE            *fp_file_ptr;
                int              fp_idx                 = NULL_IDX;
                int              idx;
                int              length;
                long            *mod_idx;
                int              module_attr_idx;
                int              name_idx;
                long_type        offset;
   static       int              preinline_fp_idx       = NULL_IDX;
                long            *ptr;
                int              wd_len;

# if defined(_MODULE_TO_DOT_M) || defined(_MODULE_TO_DOT_o)
                char            *mod_name_ptr;
                char            *src_name_ptr;
# endif

# if defined(_MODULE_TO_DOT_M)
                FILE            *fp_file_ptr;
   static       int              m_file_fp_idx          = NULL_IDX;
# endif


   TRACE (Func_Entry, "create_mod_info_file", NULL);

   module_attr_idx = SCP_ATTR_IDX(MAIN_SCP_IDX);

   /* The module is a global name, so it was entered into the global name   */
   /* table during parse_module_stmt.  The global name table entry contains */
   /* an index to the file path entry for this module, so that if we have   */
   /* a USE statement referencing the module during this compilation, we    */
   /* can find it in the file quickly by using the offset in its file path  */
   /* table entry.  We can also use it to detect duplicate modules.         */

   if (!srch_global_name_tbl(AT_OBJ_NAME_PTR(module_attr_idx),
                             AT_NAME_LEN(module_attr_idx),
                             &name_idx)) {

      if (num_prog_unit_errors == 0) {
         PRINTMSG(AT_DEF_LINE(module_attr_idx), 1250, Internal,
                  AT_DEF_COLUMN(module_attr_idx),
                  AT_OBJ_NAME_PTR(module_attr_idx));
      }
      else if (ATP_PGM_UNIT(module_attr_idx) == Module ||
               !AT_DCL_ERR(module_attr_idx)) {
         ntr_global_name_tbl(module_attr_idx, NULL_IDX, name_idx);
      }
      else {  /* Error in attr for function name. - Bypass */
         ga_idx         = NULL_IDX;
         name_idx       = NULL_IDX;
      }
   }

   if (name_idx != NULL_IDX) {
      ga_idx    = GN_ATTR_IDX(name_idx);

      if (GA_OBJ_CLASS(ga_idx) == Common_Block) {
         ga_idx = GAC_PGM_UNIT_IDX(ga_idx);

         if (ga_idx == NULL_IDX && num_prog_unit_errors == 0) {
            PRINTMSG(AT_DEF_LINE(module_attr_idx), 1250, Internal,
                     AT_DEF_COLUMN(module_attr_idx),
                     AT_OBJ_NAME_PTR(module_attr_idx));
         }
         else {  /* Name must have been in error situation.  Make an entry. */
            ntr_global_name_tbl(module_attr_idx, NULL_IDX, name_idx);
            ga_idx      = GN_ATTR_IDX(name_idx);
         }
      }
   }

   if (num_prog_unit_errors > 0) {

      if (ga_idx != NULL_IDX && GAP_FP_IDX(ga_idx) != NULL_IDX) {

         /* We already have a module by this name and have created a mod */
         /* file for it.  Set SCP_IN_ERR so we don't write out a another */
         /* module table.  We would never find this one, because the     */
         /* search would always hit the first one.                       */

         SCP_IN_ERR(MAIN_SCP_IDX) = TRUE;
      }

      AT_DCL_ERR(module_attr_idx)    = TRUE;

      if (ATP_PGM_UNIT(module_attr_idx) == Module) {
         PRINTMSG(AT_DEF_LINE(module_attr_idx), 855, Error,
                  AT_DEF_COLUMN(module_attr_idx),
                  AT_OBJ_NAME_PTR(module_attr_idx));

         if (SCP_IN_ERR(MAIN_SCP_IDX)) {
            return;
         }
      }
      else {  /* Inline information file */
         PRINTMSG(AT_DEF_LINE(module_attr_idx), 1322, Error,
                  AT_DEF_COLUMN(module_attr_idx),
                  AT_OBJ_NAME_PTR(module_attr_idx));
      }
   }

   offset = 0;

   /* If we are in a preinline compile, everything goes out to the       */
   /* preinline_file including modules.                                  */

   if (dump_flags.preinline) {

      if (preinline_fp_idx != NULL_IDX) {
         fp_idx         = preinline_fp_idx;
         fp_file_ptr    = fopen(FP_NAME_PTR(fp_idx), "ab");
         offset         = ftell(fp_file_ptr);
         fclose(fp_file_ptr);
      }
      else {
         TBL_REALLOC_CK(file_path_tbl, 1);
         CLEAR_TBL_NTRY(file_path_tbl, file_path_tbl_idx);

         fp_idx                         = file_path_tbl_idx;      
         preinline_fp_idx               = fp_idx;
         FP_NAME_LEN(fp_idx)            = strlen(preinline_file);
         FP_NAME_IDX(fp_idx)            = str_pool_idx + 1;
         FP_SRCH_THE_FILE(fp_idx)       = FALSE;
         length                         = WORD_LEN(FP_NAME_LEN(fp_idx));

         /* We do not do inlining in a preinline   */
         /* compile, so this, can just be File_Fp. */

         FP_CLASS(fp_idx)               = File_Fp;

         TBL_REALLOC_CK(str_pool, length);

         ptr = (long *) (&str_pool[FP_NAME_IDX(fp_idx)].name_long);

         memset(ptr, 0, length * TARGET_BYTES_PER_WORD);

         strcpy(FP_NAME_PTR(fp_idx), preinline_file);

         /* We do not do inlining in a preinline compile so always    */
         /* put this on the module path in case it contains a module. */

         FP_NEXT_FILE_IDX(fp_idx) = module_path_idx;
      }
   }

   /* This creates a name for the module output file.  These are not     */
   /* true temp files because they need to last beyond the frontend.     */

   /* There are three naming schemes: _MODULE_TO_DOT_o, _MODULE_TO_DOT_M */
   /* and module to .mod (-em). If it is DOT_o, temp files are created   */
   /* for each module called .file.module.m.  The file names are passed  */
   /* thru the interface, where the backend puts the files where it      */
   /* wants.  If the file ends with .m, the backend must clean the file  */
   /* up.  If it ends with .mn, the frontend must remove the file.       */
   /* If DOT_M, the modules are all put in the same file.M file.  If     */
   /* .mod), the modules are each put to a file called modulename.mod.   */

   /* How the commandline option and defines work together:  If -dm is   */
   /* specified then either _MODULE_TO_DOT_M or _MODULE_TO_DOT_o         */
   /* is the default.                                                    */

   if (on_off_flags.module_to_mod) {

      if (fp_idx == NULL_IDX) {

         /* Create module.mod for the name. */
         /* Also, check to see if user specified a dir for the .mod files. */

         if (cmd_line_flags.mod_out_path) {
            strcpy(&(mod_file_name[0]), mod_out_path);
            strcat(mod_file_name, "/");
            strcat(mod_file_name, AT_OBJ_NAME_PTR(module_attr_idx));
         }
         else {
            strcpy(&(mod_file_name[0]), AT_OBJ_NAME_PTR(module_attr_idx));
         }
         strcat(mod_file_name, module_suffix_fix);
         TBL_REALLOC_CK(file_path_tbl, 1);
         CLEAR_TBL_NTRY(file_path_tbl, file_path_tbl_idx);

         fp_idx                   = file_path_tbl_idx;      
         FP_NEXT_FILE_IDX(fp_idx) = (ATP_PGM_UNIT(module_attr_idx) != Module) ? 
                                     inline_path_idx : module_path_idx;
         FP_NAME_LEN(fp_idx)      = strlen(mod_file_name);
         FP_NAME_IDX(fp_idx)      = str_pool_idx + 1;
         FP_SRCH_THE_FILE(fp_idx) = FALSE;
         length                   = WORD_LEN(FP_NAME_LEN(fp_idx));
         FP_CLASS(fp_idx)         = File_Fp;

         TBL_REALLOC_CK(str_pool, length);

         for (idx = FP_NAME_IDX(fp_idx); idx <= str_pool_idx; idx++) {        
            str_pool[idx].name_long = 0;
         }

         strcpy(FP_NAME_PTR(fp_idx), mod_file_name);
      }
   }
   else { /* Default to MODULE_TO_DOT_o or MODULE_TO_DOT_M */

# if defined(_MODULE_TO_DOT_o)

      if (fp_idx == NULL_IDX) {
         mod_file_name[0]       = '.';
         mod_name_ptr   = &(mod_file_name[1]);
         src_name_ptr   = strrchr (src_file, SLASH);
         src_name_ptr   = (src_name_ptr == NULL) ? src_file : src_name_ptr+1;

         while (*mod_name_ptr++ = *src_name_ptr++);

         /* This returns a pointer to the last */
         /* occurence of dot in the file name  */

         src_name_ptr = strrchr (mod_file_name, DOT);

         if (src_name_ptr != NULL && 
             (EQUAL_STRS(src_name_ptr, ".f") ||
              EQUAL_STRS(src_name_ptr, ".f90"))){
             src_name_ptr++;
         }
         else {                  /* Just append module.m on */
             strcpy(src_name_ptr, ".");
             src_name_ptr++;
         }

         TBL_REALLOC_CK(file_path_tbl, 1);

         strncpy(src_name_ptr, 
                 AT_OBJ_NAME_PTR(module_attr_idx), 
                 AT_NAME_LEN(module_attr_idx));

         src_name_ptr   += AT_NAME_LEN(module_attr_idx);

         /* KAY - Use for running the frontend alone. */

# if 0
         strcpy(src_name_ptr, ".m");      /* Backend will delete this. */
# endif

         strcpy(src_name_ptr, ".mn");     /* Backend will not delete this. */

         TBL_REALLOC_CK(file_path_tbl, 1);
         CLEAR_TBL_NTRY(file_path_tbl, file_path_tbl_idx);

         fp_idx                   = file_path_tbl_idx;      
         FP_NEXT_FILE_IDX(fp_idx) = (ATP_PGM_UNIT(module_attr_idx) != Module) ? 
                                     inline_path_idx : module_path_idx;
         FP_NAME_LEN(fp_idx)      = strlen(mod_file_name);
         FP_NAME_IDX(fp_idx)      = str_pool_idx + 1;
         FP_SRCH_THE_FILE(fp_idx) = FALSE;
         length                   = WORD_LEN(FP_NAME_LEN(fp_idx));
         FP_CLASS(fp_idx)         = File_Fp;

         /* This file will be read up and copied by the backend.  It will be  */
         /* deleted by the backend (if suffix is .m) or the frontend if       */
         /* suffix if the file name suffix is .mn.                            */

         FP_TMP_FILE(fp_idx)    = TRUE;

         TBL_REALLOC_CK(str_pool, length);

         ptr = (long *) (&str_pool[FP_NAME_IDX(fp_idx)].name_long);

         memset(ptr, 0, length * TARGET_BYTES_PER_WORD);

         strcpy(FP_NAME_PTR(fp_idx), mod_file_name);

         if (num_prog_unit_errors == 0 && !dump_flags.no_module_output) {

            /* Send file name through interface to be put into the .o file. */
   
            FP_OUTPUT_TO_O(fp_idx)      = cmd_line_flags.binary_output;
         }
      }

# elif defined(_MODULE_TO_DOT_M)

      if (fp_idx != NULL_IDX) {

         /* intentionally blank */

      }
      else if (m_file_fp_idx != NULL_IDX) {
         fp_idx         = m_file_fp_idx;
         fp_file_ptr    = fopen(FP_NAME_PTR(fp_idx), "ab");
         offset         = ftell(fp_file_ptr);
         fclose(fp_file_ptr);
      }
      else {
         mod_name_ptr   = &(mod_file_name[0]);
         src_name_ptr   = strrchr (src_file, SLASH);
         src_name_ptr   = (src_name_ptr == NULL) ? src_file : src_name_ptr+1;

         while (*mod_name_ptr++ = *src_name_ptr++);

         /* This returns a pointer to the last */
         /* occurence of dot in the file name  */

         src_name_ptr = strrchr (mod_file_name, DOT);

         if (src_name_ptr != NULL && 
             (EQUAL_STRS(src_name_ptr, ".f") ||
              EQUAL_STRS(src_name_ptr, ".f90"))){
            src_name_ptr++;
         }
         else {                  /* Just append module.m on */
            strcpy(src_name_ptr, ".");
            src_name_ptr++;
         }

         strcpy(src_name_ptr, "M");

         TBL_REALLOC_CK(file_path_tbl, 1);
         CLEAR_TBL_NTRY(file_path_tbl, file_path_tbl_idx);

         fp_idx                   = file_path_tbl_idx;      
         FP_NEXT_FILE_IDX(fp_idx) = (ATP_PGM_UNIT(module_attr_idx) != Module) ? 
                                   inline_path_idx : module_path_idx;
         FP_NAME_LEN(fp_idx)      = strlen(mod_file_name);
         FP_NAME_IDX(fp_idx)      = str_pool_idx + 1;
         FP_SRCH_THE_FILE(fp_idx) = FALSE;
         length                   = WORD_LEN(FP_NAME_LEN(fp_idx));
         FP_CLASS(fp_idx)         = File_Fp;

         TBL_REALLOC_CK(str_pool, length);

         for (idx = FP_NAME_IDX(fp_idx); idx <= str_pool_idx; idx++) {        
            str_pool[idx].name_long = 0;
         }

         strcpy(FP_NAME_PTR(fp_idx), mod_file_name);

         m_file_fp_idx  = fp_idx;
         fp_file_ptr    = fopen(mod_file_name, "wb");
         fclose(fp_file_ptr);
      }
# endif
   }

   /* Keep track of the file index for the first module written out.  This */
   /* will get updated with a directory listing all modules in this file.  */

   if (ATP_PGM_UNIT(module_attr_idx) == Module) {

      if (module_path_idx == NULL_IDX) {
         module_path_idx        = fp_idx;
      }
   }
   else if (inline_path_idx == NULL_IDX && !dump_flags.preinline) {
      inline_path_idx           = fp_idx;
   }

   /* Create an entry for the module being written out.  fp_idx  */
   /* is the file path table index for the file entry.           */

   TBL_REALLOC_CK(file_path_tbl, 1);
   CLEAR_TBL_NTRY(file_path_tbl, file_path_tbl_idx);

   /* Put this module at the top of the list. */

   FP_MODULE_IDX(file_path_tbl_idx)     = FP_MODULE_IDX(fp_idx);
   FP_MODULE_IDX(fp_idx)                = file_path_tbl_idx;

   FP_NAME_LEN(file_path_tbl_idx)       = AT_NAME_LEN(module_attr_idx);
   FP_NAME_IDX(file_path_tbl_idx)       = str_pool_idx + 1;
   FP_OFFSET(file_path_tbl_idx)         = offset;
   FP_FILE_IDX(file_path_tbl_idx)       = fp_idx;     /* Link to file entry */
   FP_CLASS(file_path_tbl_idx)          = Current_Compile_Fp;

   mod_idx                              = &(mit_header.wd[0]);

   for (idx=0; idx < sizeof(mit_header_type) / TARGET_BYTES_PER_WORD; idx++) {
      *mod_idx = 0;
       mod_idx++;
   }
   if (ga_idx != NULL_IDX) {
      GAP_FP_IDX(ga_idx)        = file_path_tbl_idx;
   }
   name_idx             = AT_NAME_IDX(module_attr_idx);
   wd_len               = WORD_LEN(AT_NAME_LEN(module_attr_idx));
   mod_idx              = MD_NAME_LONG;
   MD_NAME_LEN          = AT_NAME_LEN(module_attr_idx);

   TBL_REALLOC_CK(str_pool, wd_len);

   for (idx = FP_NAME_IDX(file_path_tbl_idx); idx <= str_pool_idx; idx++) {
      *mod_idx                  = name_pool[name_idx].name_long;
      str_pool[idx].name_long   = name_pool[name_idx].name_long;
      name_idx++;
      mod_idx++;
   }

   SCP_FILE_PATH_IDX(curr_scp_idx)      = fp_idx;

   TRACE (Func_Exit, "create_mod_info_file", NULL);

   return;

}  /* create_mod_info_file */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Create the module link table, which is used to output the module      *|
|*      information table.                                                    *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
void  create_mod_info_tbl(void)

{
   int          attr_idx;
   int          name_idx;


   TRACE (Func_Entry, "create_mod_info_tbl", NULL);

   if (dump_flags.preinline && num_prog_unit_errors > 0) {

      /* Do not write out any tables.  Just the mod header. */

      return;
   }

   allocate_mod_link_tbl(0);  /* Determine size from longest table. */

   /* global flag used to tell set_mod_link_tbl_for_attr */
   /* that it should check all attrs for duplicates.     */

   search_for_duplicate_attrs   = FALSE;  /* Do not search */

   for (name_idx = SCP_LN_FW_IDX(MAIN_SCP_IDX) + 1;
        name_idx < SCP_LN_LW_IDX(MAIN_SCP_IDX); 
        name_idx++) {

      attr_idx = LN_ATTR_IDX(name_idx);

      if (attr_idx == SCP_ATTR_IDX(MAIN_SCP_IDX)) {
         KEEP_ATTR(attr_idx);
         ML_LN_KEEP_ME(name_idx)        =  TRUE;
         ML_LN_IDX(name_idx)            =  name_idx;
      }
      else if (AT_PRIVATE(attr_idx) || AT_OBJ_CLASS(attr_idx) == Label) {

         /* If object is PRIVATE, the name must not go into the name table.  */
         /* Also, Labels do not go out for the module itself.                */

      }
      else if (IS_STMT_ENTITY(attr_idx)) {

         /* This item is only used as the loop control variable in    */
         /* an implied-do.  It is only in the scope of the implied-do */
         /* and should not be written out to the module file.         */
      }
      else if (AT_OBJ_CLASS(attr_idx) == Data_Obj &&
               ATD_SYMBOLIC_CONSTANT(attr_idx) &&
               ATD_CLASS(attr_idx) == Constant) {

         /* N$PES was specified as a constant.  Do not output the actual     */
         /* constant to the module.  It should have been replaced all over.  */
      }
      else if (AT_USE_ASSOCIATED(attr_idx) &&
               AT_OBJ_CLASS(attr_idx) == Pgm_Unit &&
               ATP_PGM_UNIT(attr_idx) == Module) {

         /* This module has been use associated into this scope.  We do not */
         /* want the name in the local name table, although we do want to   */
         /* have the attribute entry for the module go out.                 */
      }
      else if (!ML_AT_KEEP_ME(attr_idx)) {

         /* if ML_AT_KEEP_ME is set, this attr entry has been processed. */
         /* It got processed because it was indexed to by another attr.  */
         /* (For example:  A derived type.)  Check to see if we need to  */
         /* keep the local name or not in the next else clause.          */

         if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit &&
             ATP_PROC(attr_idx) == Module_Proc &&
             !AT_USE_ASSOCIATED(attr_idx)) {

            /* This is a module procedure declared during this       */
            /* compilation.  We need to resolve out any duplicate    */
            /* attrs that were used to describe the interface for    */
            /* the module procedure.  An example of a duplicate is   */
            /* if the same module is USEd in the module and the      */
            /* module procedure.  If a type from the module is used  */
            /* to describe the module procedure interface, then      */
            /* there will be duplicate attrs for the derived type.   */
            /* This mechanism resolves them to the same attr.        */

            search_for_duplicate_attrs  = TRUE;
         }

         KEEP_ATTR(attr_idx);
         ML_LN_KEEP_ME(name_idx)        = TRUE;
         ML_LN_IDX(name_idx)            = name_idx;
         search_for_duplicate_attrs     = FALSE;
      }
      else {
         ML_LN_KEEP_ME(name_idx)        = TRUE;
         ML_LN_IDX(name_idx)            = name_idx;

         /* This name gets included because of a link with another attr. */
         /* Can be a derived type, function result, CRI pointee, ect...  */
         /* Its attr_idx has already been marked as being needed.        */
      }
   }

   TRACE (Func_Exit, "create_mod_info_tbl", NULL);

   return;

}   /* create_mod_info_tbl */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Clear these fields in the attr entry, before it is written out to the *|
|*      module file.                                                          *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
static void  set_attr_flds_for_output()

{
   int          attr_idx;


   TRACE (Func_Entry, "set_attr_flds_for_output", NULL);

   for (attr_idx = 1; attr_idx <= attr_tbl_idx; attr_idx++) {

      if (AT_ORIG_NAME_IDX(attr_idx) == NULL_IDX) {
         AT_ORIG_NAME_IDX(attr_idx) = AT_NAME_IDX(attr_idx);
         AT_ORIG_NAME_LEN(attr_idx) = AT_NAME_LEN(attr_idx);
      }

      switch (AT_OBJ_CLASS(attr_idx)) {
      case Data_Obj:

         if (ATD_CLASS(attr_idx) == Compiler_Tmp) {
            ATD_TMP_GEN_ZERO(attr_idx)          = FALSE;
         }

         if (ATD_CLASS(attr_idx) == Dummy_Argument && ATD_SF_DARG(attr_idx)) {
            ATD_SF_ARG_IDX(attr_idx)    = NULL_IDX;
            ATD_SF_LINK(attr_idx)       = NULL_IDX;
         }
         break;

      case Pgm_Unit:
         ATP_SCP_IDX(attr_idx)                  = NULL_IDX;

         if (ATP_PGM_UNIT(attr_idx) == Module) {
            ATP_MODULE_STR_IDX(attr_idx)        = NULL_IDX;
         }
         else if (ATP_PROC(attr_idx) == Intrin_Proc) {
            ATP_INTERFACE_IDX(attr_idx)         = NULL_IDX;
         }
         break;

      case Derived_Type:
         AT_DEFINED(attr_idx)                   = FALSE;
         ATT_CIF_DT_ID(attr_idx)                = 0;
         ATT_SCP_IDX(attr_idx)                  = NULL_IDX;
         break;

      case Label:  /* Do not clear AT_DEFINED here. */
         break;

      case Interface:
         ATI_HAS_NON_MOD_PROC(attr_idx)         = FALSE;
         break;

      case Stmt_Func:
      case Namelist_Grp:
         break;

      }  /* End switch */
   }  /* End for */


   TRACE (Func_Exit, "set_attr_flds_for_output", NULL);

   return;

}   /* set_attr_flds_for_output */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      All these attr entries must be included in the entries that will be   *|
|*      compressed.  Mark this attr and everything it links to, as being      *|
|*      saved during the compression.                                         *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      attr_idx   -> Index of attribute to process.                          *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
static  void  set_mod_link_tbl_for_attr(int     attr_idx)

{
   int          bd_idx;
   int          il_idx;
   int          save_duplicate_attr_flag;
   int          sb_idx;
   int          sh_idx;
   int          sn_idx;


   TRACE (Func_Entry, "set_mod_link_tbl_for_attr", NULL);

   if (ML_AT_KEEP_ME(attr_idx)) {

      /* All the links for this attr have been set, plus */
      /* resolve_attr has been called, if need be.       */

      return;
   }

   if ((ML_AT_SEARCH_ME(attr_idx) ||
       search_for_duplicate_attrs) && !ML_AT_SEARCHED(attr_idx)) {

      if (AT_MODULE_IDX(attr_idx) != NULL_IDX) {
         AT_REFERENCED(AT_MODULE_IDX(attr_idx)) = Referenced;
      }

      if (resolve_attr(attr_idx)) {

         /* If resolve_attr returns TRUE, this object is in this scope  */
         /* already.  Do not set any links for this attr.  We will use  */
         /* the attr that is already in this scope.  Mark the attr      */
         /* resolved to, so that it gets kept.                          */
       
         KEEP_ATTR(ML_AT_IDX(attr_idx));
         return;
      }
   }

   if (ML_AT_IDX(attr_idx) != NULL_IDX && ML_AT_IDX(attr_idx) != attr_idx) {

      /* This attr is being replaced by the attr in ML_AT_IDX.  */
      /* Keep the attr in ML_AT_IDX.                            */

      KEEP_ATTR(ML_AT_IDX(attr_idx));
      return;
   }

   ML_AT_KEEP_ME(attr_idx)              = TRUE;
   ML_AT_IDX(attr_idx)                  = attr_idx;
   ML_NP_KEEP_ME(AT_NAME_IDX(attr_idx)) = TRUE;
   ML_NP_IDX(AT_NAME_IDX(attr_idx))     = AT_NAME_IDX(attr_idx);
   ML_NP_LEN(AT_NAME_IDX(attr_idx))     = AT_NAME_LEN(attr_idx);

   if (AT_ORIG_NAME_IDX(attr_idx) != NULL_IDX) {
      ML_NP_KEEP_ME(AT_ORIG_NAME_IDX(attr_idx)) = TRUE;
      ML_NP_IDX(AT_ORIG_NAME_IDX(attr_idx))     = AT_ORIG_NAME_IDX(attr_idx);
      ML_NP_LEN(AT_ORIG_NAME_IDX(attr_idx))     = AT_ORIG_NAME_LEN(attr_idx);
   }

   if (AT_ATTR_LINK(attr_idx) != NULL_IDX && !AT_IGNORE_ATTR_LINK(attr_idx)) {
      KEEP_ATTR(AT_ATTR_LINK(attr_idx));
   }

   if (AT_MODULE_IDX(attr_idx) != NULL_IDX) {
      KEEP_ATTR(AT_MODULE_IDX(attr_idx));
   }

   switch (AT_OBJ_CLASS(attr_idx)) {
   case Data_Obj:

# if defined(COARRAY_FORTRAN)
      bd_idx    = ATD_PE_ARRAY_IDX(attr_idx);

      if (bd_idx != NULL_IDX && !ML_BD_KEEP_ME(bd_idx)) {
         set_mod_link_tbl_for_bd(bd_idx);
      }
# endif

      bd_idx    = ATD_RESHAPE_ARRAY_IDX(attr_idx);

      if (bd_idx != NULL_IDX && !ML_BD_KEEP_ME(bd_idx)) {
         set_mod_link_tbl_for_bd(bd_idx);
      }

      bd_idx    = ATD_ARRAY_IDX(attr_idx);
      sb_idx    = ATD_STOR_BLK_IDX(attr_idx);

      if (bd_idx != NULL_IDX && !ML_BD_KEEP_ME(bd_idx)) {
         set_mod_link_tbl_for_bd(bd_idx);
      }

      bd_idx    = ATD_DISTRIBUTION_IDX(attr_idx);

      if (bd_idx != NULL_IDX && !ML_BD_KEEP_ME(bd_idx)) {
         set_mod_link_tbl_for_bd(bd_idx);
      }

      if (sb_idx != NULL_IDX) {
         ML_SB_KEEP_ME(sb_idx)                  = TRUE;
         ML_SB_IDX(sb_idx)                      = sb_idx;
         ML_NP_KEEP_ME(SB_NAME_IDX(sb_idx))     = TRUE;
         ML_NP_IDX(SB_NAME_IDX(sb_idx))         = SB_NAME_IDX(sb_idx);
         ML_NP_LEN(SB_NAME_IDX(sb_idx))         = SB_NAME_LEN(sb_idx);

         if (SB_FIRST_ATTR_IDX(sb_idx) != NULL_IDX) {
            KEEP_ATTR(SB_FIRST_ATTR_IDX(sb_idx));
         }

         switch (SB_LEN_FLD(sb_idx)) {
         case AT_Tbl_Idx:
            KEEP_ATTR(SB_LEN_IDX(sb_idx));
            break;

         case CN_Tbl_Idx:
            KEEP_CN(SB_LEN_IDX(sb_idx));
            break;

         case IR_Tbl_Idx:
            KEEP_IR(SB_LEN_IDX(sb_idx));
            break;

         case IL_Tbl_Idx:
            set_mod_link_tbl_for_il(SB_LEN_IDX(sb_idx));
            break;
         }

         if (SB_MODULE_IDX(sb_idx) != NULL_IDX) {
            KEEP_ATTR(SB_MODULE_IDX(sb_idx));
         }
      }

      switch (ATD_CLASS(attr_idx)) {
      case CRI__Pointee:
         set_mod_link_tbl_for_typ(ATD_TYPE_IDX(attr_idx));
         KEEP_ATTR(ATD_PTR_IDX(attr_idx));
         break;

      case Dummy_Argument:

         if (!ATD_INTRIN_DARG(attr_idx)) {
            set_mod_link_tbl_for_typ(ATD_TYPE_IDX(attr_idx));
         }
         break;

      case Constant:
         set_mod_link_tbl_for_typ(ATD_TYPE_IDX(attr_idx));

         if (ATD_FLD(attr_idx) == CN_Tbl_Idx) {
            KEEP_CN(ATD_CONST_IDX(attr_idx));
         }
         else {

            /* If we are resolving attrs, we do not search for this tmp   */
            /* attr because its name is the same as the constant.  These  */
            /* two are a pair so we do not need to do a seperate search.  */

            ML_AT_SEARCHED(ATD_CONST_IDX(attr_idx))     = TRUE;
            KEEP_ATTR(ATD_CONST_IDX(attr_idx));
         }
         break;

      case Compiler_Tmp:

         if (ATD_NEXT_MEMBER_IDX(attr_idx) != NULL_IDX) {
            KEEP_ATTR(ATD_NEXT_MEMBER_IDX(attr_idx));
         }

         if (ATD_DEFINING_ATTR_IDX(attr_idx) != NULL_IDX) {
            KEEP_ATTR(ATD_DEFINING_ATTR_IDX(attr_idx));
         }

         if (ATD_AUTOMATIC(attr_idx)) {
            KEEP_ATTR(ATD_AUTO_BASE_IDX(attr_idx));
         }
         else if (ATD_OFFSET_ASSIGNED(attr_idx)) {

            switch (ATD_OFFSET_FLD(attr_idx)) {
            case AT_Tbl_Idx:
               KEEP_ATTR(ATD_OFFSET_IDX(attr_idx));
               break;
            case CN_Tbl_Idx:
               KEEP_CN(ATD_OFFSET_IDX(attr_idx));
               break;
            case IR_Tbl_Idx:
               KEEP_IR(ATD_OFFSET_IDX(attr_idx));
               break;
            case IL_Tbl_Idx:
               set_mod_link_tbl_for_il(ATD_OFFSET_IDX(attr_idx));
               break;
            }
         }

         set_mod_link_tbl_for_typ(ATD_TYPE_IDX(attr_idx));

         switch (ATD_FLD(attr_idx)) {
         case CN_Tbl_Idx:
            KEEP_CN(ATD_TMP_IDX(attr_idx));
            break;

         case AT_Tbl_Idx:
            KEEP_ATTR(ATD_TMP_IDX(attr_idx));
            break;

         case IL_Tbl_Idx:
            set_mod_link_tbl_for_il(ATD_TMP_IDX(attr_idx));
            break;

         case IR_Tbl_Idx:
            KEEP_IR(ATD_TMP_IDX(attr_idx));
            break;
         }
         break;

      case Function_Result:

         if (ATD_OFFSET_ASSIGNED(attr_idx)) {

            switch (ATD_OFFSET_FLD(attr_idx)) {
            case AT_Tbl_Idx:
               KEEP_ATTR(ATD_OFFSET_IDX(attr_idx));
               break;
            case CN_Tbl_Idx:
               KEEP_CN(ATD_OFFSET_IDX(attr_idx));
               break;
            case IR_Tbl_Idx:
               KEEP_IR(ATD_OFFSET_IDX(attr_idx));
               break;
            case IL_Tbl_Idx:
               set_mod_link_tbl_for_il(ATD_OFFSET_IDX(attr_idx));
               break;
            }
         }
         set_mod_link_tbl_for_typ(ATD_TYPE_IDX(attr_idx));
         break;
        

      case Struct_Component:

         switch (ATD_OFFSET_FLD(attr_idx)) {
         case AT_Tbl_Idx:
            KEEP_ATTR(ATD_CPNT_OFFSET_IDX(attr_idx));
            break;
         case CN_Tbl_Idx:
            KEEP_CN(ATD_CPNT_OFFSET_IDX(attr_idx));
            break;
         case IR_Tbl_Idx:
            KEEP_IR(ATD_CPNT_OFFSET_IDX(attr_idx));
            break;
         case IL_Tbl_Idx:
            set_mod_link_tbl_for_il(ATD_CPNT_OFFSET_IDX(attr_idx));
            break;
         }

         if (ATD_CPNT_INIT_IDX(attr_idx) != NULL_IDX) {

            switch (ATD_FLD(attr_idx)) {
            case AT_Tbl_Idx:
               KEEP_ATTR(ATD_CPNT_INIT_IDX(attr_idx));
               break;
            case CN_Tbl_Idx:
               KEEP_CN(ATD_CPNT_INIT_IDX(attr_idx));
               break;
            case IR_Tbl_Idx:
               KEEP_IR(ATD_CPNT_INIT_IDX(attr_idx));
               break;
            case IL_Tbl_Idx:
               set_mod_link_tbl_for_il(ATD_CPNT_INIT_IDX(attr_idx));
               break;
            }
         }

         set_mod_link_tbl_for_typ(ATD_TYPE_IDX(attr_idx));
         KEEP_ATTR(ATD_DERIVED_TYPE_IDX(attr_idx));
         break;

      case Variable:

         if (ATD_DATA_INIT(attr_idx)) {

            if (ATD_FLD(attr_idx) == NO_Tbl_Idx) {
               /* Intentionally blank */
            }
            else if (ATD_FLD(attr_idx) == AT_Tbl_Idx) {

               /* If we are resolving attrs, we do not search for this tmp   */
               /* attr because its name is the same as the variable.  These  */
               /* two are a pair so we do not need to do a seperate search.  */

               ML_AT_SEARCHED(ATD_VARIABLE_TMP_IDX(attr_idx))   = TRUE;
               KEEP_ATTR(ATD_VARIABLE_TMP_IDX(attr_idx));
            }
            else if (ATD_FLD(attr_idx) == IL_Tbl_Idx) {

               /* See previous note. */

               il_idx = ATD_VARIABLE_TMP_IDX(attr_idx);

               while (il_idx != NULL_IDX) {
   
                  if (IL_FLD(il_idx) == AT_Tbl_Idx) {
                     ML_AT_SEARCHED(IL_IDX(il_idx)) = TRUE;
                  }
                  il_idx = IL_NEXT_LIST_IDX(il_idx);
               }

               set_mod_link_tbl_for_il(ATD_VARIABLE_TMP_IDX(attr_idx));
            }
         }
         else if (ATD_FLD(attr_idx) == AT_Tbl_Idx) {
            KEEP_ATTR(ATD_VARIABLE_TMP_IDX(attr_idx));
         }

         if (ATD_NEXT_MEMBER_IDX(attr_idx) != NULL_IDX) {
            KEEP_ATTR(ATD_NEXT_MEMBER_IDX(attr_idx));
         }

         if (ATD_ASSIGN_TMP_IDX(attr_idx) != NULL_IDX) {
            KEEP_ATTR(ATD_ASSIGN_TMP_IDX(attr_idx));
         }

         if (ATD_AUTOMATIC(attr_idx)) {
            KEEP_ATTR(ATD_AUTO_BASE_IDX(attr_idx));
         }
         else if (ATD_OFFSET_ASSIGNED(attr_idx)) {

            switch (ATD_OFFSET_FLD(attr_idx)) {
            case AT_Tbl_Idx:
               KEEP_ATTR(ATD_OFFSET_IDX(attr_idx));
               break;
            case CN_Tbl_Idx:
               KEEP_CN(ATD_OFFSET_IDX(attr_idx));
               break;
            case IR_Tbl_Idx:
               KEEP_IR(ATD_OFFSET_IDX(attr_idx));
               break;
            case IL_Tbl_Idx:
               set_mod_link_tbl_for_il(ATD_OFFSET_IDX(attr_idx));
               break;
            }
         }

         /* Intentional fall through */

      default:

         set_mod_link_tbl_for_typ(ATD_TYPE_IDX(attr_idx));
         break;
      }
      break;


   case Pgm_Unit:

      ML_NP_KEEP_ME(ATP_EXT_NAME_IDX(attr_idx)) = TRUE;
      ML_NP_IDX(ATP_EXT_NAME_IDX(attr_idx))     = ATP_EXT_NAME_IDX(attr_idx);
      ML_NP_LEN(ATP_EXT_NAME_IDX(attr_idx))     = ATP_EXT_NAME_LEN(attr_idx);

      if (ATP_PGM_UNIT(attr_idx) == Module) {

         if (ATP_MOD_PATH_LEN(attr_idx) > 0) {
            ML_NP_KEEP_ME(ATP_MOD_PATH_IDX(attr_idx)) = TRUE;
            ML_NP_IDX(ATP_MOD_PATH_IDX(attr_idx)) = ATP_MOD_PATH_IDX(attr_idx);
            ML_NP_LEN(ATP_MOD_PATH_IDX(attr_idx)) = ATP_MOD_PATH_LEN(attr_idx);
         }
      }
      else {

         if (ATP_RSLT_IDX(attr_idx) != NULL_IDX) {
            KEEP_ATTR(ATP_RSLT_IDX(attr_idx));
         }

         if (ATP_NUM_DARGS(attr_idx) > 0) {

            for (sn_idx = ATP_FIRST_IDX(attr_idx); 
                 sn_idx < (ATP_FIRST_IDX(attr_idx) + ATP_NUM_DARGS(attr_idx));
                 sn_idx++) {

               ML_SN_KEEP_ME(sn_idx)    = TRUE;
               ML_SN_IDX(sn_idx)        = sn_idx;

               KEEP_ATTR(SN_ATTR_IDX(sn_idx));
            }
         }

         /* This flag works for all 3 uses of this routine.             */

         /* 1) It is called when a use statement is processed.          */
         /*    ATP_MAY_INLINE will be set for all procedures            */
         /*    coming from the module that carry IR/SH with them.       */
         /* 2) During interface processing, if there are any use        */
         /*    associated procedures, they will have the mod            */
         /*    inlinable flag set correctly.  If they are not, they     */
         /*    will not have the mod inlinable flag set.                */
         /* 3) During processing, to send module info out, only those   */
         /*    procedures that have the mod inlinable flag set, go out. */

         if (ATP_MAY_INLINE(attr_idx)) {

            /* This is the body of the module/internal procedure.  We   */
            /* do not want to search for duplicate attrs here.  If we   */
            /* do, we get things confused because of host association.  */

            save_duplicate_attr_flag    = search_for_duplicate_attrs;
            search_for_duplicate_attrs  = FALSE;
            sh_idx                      = ATP_FIRST_SH_IDX(attr_idx);

            while (sh_idx != NULL_IDX) {
               ML_SH_KEEP_ME(sh_idx)    = TRUE;
               ML_SH_IDX(sh_idx)        = sh_idx;

               if (SH_IR_IDX(sh_idx) != NULL_IDX) {
                  KEEP_IR(SH_IR_IDX(sh_idx));
               }
               sh_idx                   = SH_NEXT_IDX(sh_idx);
            }

            if (ATP_PROC(attr_idx) != Dummy_Proc &&
                ATP_PROC(attr_idx) != Intrin_Proc) {

               if (ATP_PARENT_IDX(attr_idx) != NULL_IDX) {
                  KEEP_ATTR(ATP_PARENT_IDX(attr_idx));
               }
            }
            search_for_duplicate_attrs  = save_duplicate_attr_flag;
         }
         else if (ATP_PROC(attr_idx) != Intrin_Proc) {
            ATP_FIRST_SH_IDX(attr_idx)  = NULL_IDX;
         }
      }
      break;

   case Label:

      if (ATL_CLASS(attr_idx) == Lbl_Format) {
         KEEP_ATTR(ATL_PP_FORMAT_TMP(attr_idx));
         KEEP_ATTR(ATL_FORMAT_TMP(attr_idx));
      }
      else if (ATL_DIRECTIVE_LIST(attr_idx) != NULL_IDX) {
         set_mod_link_tbl_for_il(ATL_DIRECTIVE_LIST(attr_idx));
      }

      if (ATL_NEXT_ASG_LBL_IDX(attr_idx) != NULL_IDX) {
         KEEP_ATTR(ATL_NEXT_ASG_LBL_IDX(attr_idx));
      }
      break;

   case Interface:
      set_mod_link_tbl_for_typ(ATD_TYPE_IDX(attr_idx));

      /* During resolve_attrs we do not search for interface names.  */
      /* We cannot gurantee they are the same because of merging.    */

      if (ATI_PROC_IDX(attr_idx) != NULL_IDX) {

         /* If we are resolving attrs, we do not search for this proc */
         /* attr because it has the same name as the interface name.  */

         ML_AT_SEARCHED(ATI_PROC_IDX(attr_idx)) = TRUE;
      }

      sn_idx = ATI_FIRST_SPECIFIC_IDX(attr_idx);

      while (sn_idx != NULL_IDX) {
         ML_SN_KEEP_ME(sn_idx)  = TRUE;
         ML_SN_IDX(sn_idx)      = sn_idx;
         KEEP_ATTR(SN_ATTR_IDX(sn_idx));
         sn_idx                 = SN_SIBLING_LINK(sn_idx);
      }
      break;

   case Derived_Type:

      switch (ATT_STRUCT_BIT_LEN_FLD(attr_idx)) {
      case AT_Tbl_Idx:
         KEEP_ATTR(ATT_STRUCT_BIT_LEN_IDX(attr_idx));
         break;

      case CN_Tbl_Idx:
         KEEP_CN(ATT_STRUCT_BIT_LEN_IDX(attr_idx));
         break;

      case IR_Tbl_Idx:
         KEEP_IR(ATT_STRUCT_BIT_LEN_IDX(attr_idx));
         break;

      case IL_Tbl_Idx:
         set_mod_link_tbl_for_il(ATT_STRUCT_BIT_LEN_IDX(attr_idx));
         break;
      }

      sn_idx                    = ATT_FIRST_CPNT_IDX(attr_idx);

      while (sn_idx != NULL_IDX) {
         ML_SN_KEEP_ME(sn_idx)  = TRUE;
         ML_SN_IDX(sn_idx)      = sn_idx;

         /* We do not resolve components, because the name are not unique. */

         ML_AT_SEARCHED(SN_ATTR_IDX(sn_idx)) = TRUE;
         KEEP_ATTR(SN_ATTR_IDX(sn_idx));
         sn_idx = SN_SIBLING_LINK(sn_idx);
      }
      break;

   case Namelist_Grp:
      sn_idx = ATN_FIRST_NAMELIST_IDX(attr_idx);

      while (sn_idx != NULL_IDX) {
         ML_SN_KEEP_ME(sn_idx)  = TRUE;
         ML_SN_IDX(sn_idx)      = sn_idx;
         KEEP_ATTR (SN_ATTR_IDX(sn_idx));
         sn_idx                 = SN_SIBLING_LINK(sn_idx);
      }

      if (ATN_NAMELIST_DESC(attr_idx) != NULL_IDX) {
         KEEP_ATTR(ATN_NAMELIST_DESC(attr_idx));
      }
      break;


   case Stmt_Func:
      set_mod_link_tbl_for_typ(ATD_TYPE_IDX(attr_idx));

      if (ATP_NUM_DARGS(attr_idx) > 0) {

         for (sn_idx = ATP_FIRST_IDX(attr_idx); 
              sn_idx < (ATP_FIRST_IDX(attr_idx) +ATP_NUM_DARGS(attr_idx));
              sn_idx++) {

            ML_SN_KEEP_ME(sn_idx)       = TRUE;
            ML_SN_IDX(sn_idx)           = sn_idx;
            KEEP_ATTR(SN_ATTR_IDX(sn_idx));
         }
      }

      switch (ATS_SF_FLD(attr_idx)) {
      case CN_Tbl_Idx:
         KEEP_CN(ATS_SF_IDX(attr_idx));
         break;

      case AT_Tbl_Idx:
         KEEP_ATTR(ATS_SF_IDX(attr_idx));
         break;

      case IL_Tbl_Idx:
         set_mod_link_tbl_for_il(ATS_SF_IDX(attr_idx));
         break;

      case IR_Tbl_Idx:
         KEEP_IR(ATS_SF_IDX(attr_idx));
         break;
      }
      break;

   }  /* End switch */

   TRACE (Func_Exit, "set_mod_link_tbl_for_attr ", NULL);

   return;

}   /* set_mod_link_tbl_for_attr  */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Set fields in the module link table for BD.                           *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      bd_idx      => Index to set link fields for.                          *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
static  void  set_mod_link_tbl_for_bd(int       bd_idx)

{
   int          dim;


   TRACE (Func_Entry, "set_mod_link_tbl_for_bd ", NULL);

   ML_BD_KEEP_ME(bd_idx)        = TRUE;
   ML_BD_IDX(bd_idx)            = bd_idx;

   if (BD_DIST_NTRY(bd_idx)) {

      for (dim = 1; dim <= BD_RANK(bd_idx); dim++) {

         if (BD_CYCLIC_FLD(bd_idx, dim) == CN_Tbl_Idx) {
            KEEP_CN(BD_CYCLIC_IDX(bd_idx, dim));
         }
         else if (BD_CYCLIC_FLD(bd_idx, dim) == AT_Tbl_Idx) {
            KEEP_ATTR(BD_CYCLIC_IDX(bd_idx, dim));
         }

         if (BD_ONTO_FLD(bd_idx, dim) == CN_Tbl_Idx) {
            KEEP_CN(BD_ONTO_IDX(bd_idx, dim));
         }
         else if (BD_ONTO_FLD(bd_idx, dim) == AT_Tbl_Idx) {
            KEEP_ATTR(BD_ONTO_IDX(bd_idx, dim));
         }
      }
   }
   else if (BD_ARRAY_CLASS(bd_idx) != Deferred_Shape) {

      if (BD_LEN_FLD(bd_idx) == CN_Tbl_Idx) {
         KEEP_CN(BD_LEN_IDX(bd_idx));
      }
      else if (BD_LEN_FLD(bd_idx) == AT_Tbl_Idx) {
         KEEP_ATTR(BD_LEN_IDX(bd_idx));
      }

      for (dim = 1; dim <= BD_RANK(bd_idx); dim++) {

         if (BD_LB_FLD(bd_idx, dim) == CN_Tbl_Idx) {
            KEEP_CN(BD_LB_IDX(bd_idx, dim));
         }
         else if (BD_LB_FLD(bd_idx, dim) == AT_Tbl_Idx) {
            KEEP_ATTR(BD_LB_IDX(bd_idx, dim));
         }

         if (BD_UB_FLD(bd_idx, dim) == CN_Tbl_Idx) {
            KEEP_CN(BD_UB_IDX(bd_idx, dim));
         }
         else if (BD_UB_FLD(bd_idx, dim) == AT_Tbl_Idx) {
            KEEP_ATTR(BD_UB_IDX(bd_idx, dim));
         }

         if (BD_XT_FLD(bd_idx, dim) == CN_Tbl_Idx) {
            if (BD_XT_IDX(bd_idx, dim)) {
              KEEP_CN(BD_XT_IDX(bd_idx, dim));
            }
         }
         else if (BD_XT_FLD(bd_idx, dim) == AT_Tbl_Idx) {
            KEEP_ATTR(BD_XT_IDX(bd_idx, dim));
         }

         if (BD_SM_FLD(bd_idx, dim) == CN_Tbl_Idx) {
            KEEP_CN(BD_SM_IDX(bd_idx, dim));
         }
         else if (BD_SM_FLD(bd_idx, dim) == AT_Tbl_Idx) {
            KEEP_ATTR(BD_SM_IDX(bd_idx, dim));
         }
      }
   }

   TRACE (Func_Exit, "set_mod_link_tbl_for_bd ", NULL);

   return;

}   /* set_mod_link_tbl_for_bd  */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Set fields in the module link table for IR.                           *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      ir_idx      => Index to set link fields for.                          *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
static  void  set_mod_link_tbl_for_ir(int       ir_idx)

{

   TRACE (Func_Entry, "set_mod_link_tbl_for_ir", NULL);

   if (ML_IR_KEEP_ME(ir_idx)) {
      return;
   }

   ML_IR_KEEP_ME(ir_idx)        = TRUE;
   ML_IR_IDX(ir_idx)            = ir_idx;

   set_mod_link_tbl_for_typ(IR_TYPE_IDX(ir_idx));

   switch (IR_FLD_L(ir_idx)) {
   case CN_Tbl_Idx:
      KEEP_CN(IR_IDX_L(ir_idx));
      break;

   case AT_Tbl_Idx:
      KEEP_ATTR(IR_IDX_L(ir_idx));
      break;

   case IR_Tbl_Idx:
      KEEP_IR(IR_IDX_L(ir_idx));
      break;

   case IL_Tbl_Idx:
      set_mod_link_tbl_for_il(IR_IDX_L(ir_idx));
      break;

   case NO_Tbl_Idx:
   case SH_Tbl_Idx:
      break;
   }

   switch (IR_FLD_R(ir_idx)) {
   case CN_Tbl_Idx:
      KEEP_CN(IR_IDX_R(ir_idx));
      break;

   case AT_Tbl_Idx:
      KEEP_ATTR(IR_IDX_R(ir_idx));
      break;

   case IR_Tbl_Idx:
      KEEP_IR(IR_IDX_R(ir_idx));
      break;

   case IL_Tbl_Idx:
      set_mod_link_tbl_for_il(IR_IDX_R(ir_idx));
      break;

   case NO_Tbl_Idx:
   case SH_Tbl_Idx:
      break;
   }
   
   TRACE (Func_Exit, "set_mod_link_tbl_for_ir", NULL);

   return;

}   /* set_mod_link_tbl_for_ir */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Set fields in the module link table for IL.                           *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      list_idx    => Index to set link fields for.                          *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
static  void  set_mod_link_tbl_for_il(int       list_idx)

{

   TRACE (Func_Entry, "set_mod_link_tbl_for_il", NULL);

   if (ML_IL_KEEP_ME(list_idx)) {
      return;
   }

   while (list_idx != NULL_IDX) {
      ML_IL_KEEP_ME(list_idx)   = TRUE;
      ML_IL_IDX(list_idx)       = list_idx;

      switch (IL_FLD(list_idx)) {
         case CN_Tbl_Idx:
            KEEP_CN(IL_IDX(list_idx));
            break;

         case AT_Tbl_Idx:
            KEEP_ATTR(IL_IDX(list_idx));
            break;

         case IR_Tbl_Idx:
            KEEP_IR(IL_IDX(list_idx));
            break;

         case IL_Tbl_Idx:
            set_mod_link_tbl_for_il(IL_IDX(list_idx));
            break;

         case NO_Tbl_Idx:
         case SH_Tbl_Idx:
            break;
      }
      list_idx = IL_NEXT_LIST_IDX(list_idx);
   }
   
   TRACE (Func_Exit, "set_mod_link_tbl_for_il", NULL);

   return;

}   /* set_mod_link_tbl_for_il */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Set fields in the module link table for a constant table entry.       *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      cn_idx => Index of constant table entry to have links set.            *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
static  void  set_mod_link_tbl_for_cn(int       cn_idx)

{
   size_offset_type     len;
   long                 length;
   int                  type_idx;


   TRACE (Func_Entry, "set_mod_link_tbl_for_cn", NULL);

   /* KAY - TEMPORARY - REPLACE WITH INTERNAL ERROR               */
   /*       If cn_idx is NULL, it should be an internal situation */

   if (cn_idx == NULL_IDX) {
      PRINTMSG(stmt_start_line, 626, Internal, stmt_start_col,
               "non zero cn_idx",
               "set_mod_link_tbl_for_cn");
   }

   if (!ML_CN_KEEP_ME(cn_idx)) {
      ML_CN_KEEP_ME(cn_idx)     = TRUE;
      ML_CN_IDX(cn_idx)         = cn_idx;
      type_idx                  = CN_TYPE_IDX(cn_idx);

      set_mod_link_tbl_for_typ(type_idx);

      switch (TYP_TYPE(type_idx)) {
      case Typeless:
         length = (long) (CN_EXTRA_ZERO_WORD(cn_idx) ?
                              STORAGE_WORD_SIZE(TYP_BIT_LEN(type_idx)) + 1 :
                              STORAGE_WORD_SIZE(TYP_BIT_LEN(type_idx)));
         break;

      case Character:
         len.idx        = TYP_IDX(type_idx);
         len.fld        = CN_Tbl_Idx;

         BYTES_TO_WORDS(len, TARGET_BITS_PER_WORD);

         if (len.fld == CN_Tbl_Idx) {
            length = (long) CN_INT_TO_C(len.idx);  /* KAYKAY */
         }
         else {
            length = (long) F_INT_TO_C(len.constant, TYP_LINEAR(len.type_idx));
         }
         length = CN_EXTRA_ZERO_WORD(cn_idx) ? length + 1: length;
         break;

# if defined(_TARGET_OS_MAX)
      case Complex:
         if (TYP_LINEAR(type_idx) == Complex_4) {

            /* Complex_4 constants are stored in two words on t3e */

            length = 2;
         }
         else {
            length = TARGET_BITS_TO_WORDS(
                  storage_bit_size_tbl[TYP_LINEAR(CN_TYPE_IDX(cn_idx))]);
         }
         break;
# endif

      default:
         length = TARGET_BITS_TO_WORDS(
                  storage_bit_size_tbl[TYP_LINEAR(CN_TYPE_IDX(cn_idx))]);
         break;
      }

      ML_CP_LEN(CN_POOL_IDX(cn_idx))            = length;
      ML_CP_KEEP_ME(CN_POOL_IDX(cn_idx))        = TRUE;
      ML_CP_IDX(CN_POOL_IDX(cn_idx))            = CN_POOL_IDX(cn_idx);

# if defined(_HOST32) 

      if (DALIGN_TEST_CONDITION(type_idx)) {
          ML_CP_DALIGN_ME(CN_POOL_IDX(cn_idx))  = TRUE;
      }

# endif
   }

   TRACE (Func_Exit, "set_mod_link_tbl_for_cn", NULL);

   return;

}   /* set_mod_link_tbl_for_cn */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Set fields in the module link table for TYP.                          *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      typ_idx     => Index to set link fields for.                          *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
static  void  set_mod_link_tbl_for_typ(int      typ_idx)

{
   int          attr_idx;


   TRACE (Func_Entry, "set_mod_link_tbl_for_typ", NULL);

   if (typ_idx != NULL_IDX && !ML_TYP_KEEP_ME(typ_idx)) {
      ML_TYP_KEEP_ME(typ_idx)   = TRUE;
      ML_TYP_IDX(typ_idx)       = typ_idx;

      if (TYP_TYPE(typ_idx) == Character) {

         if (TYP_FLD(typ_idx) == CN_Tbl_Idx) {
            KEEP_CN(TYP_IDX(typ_idx));
         }
         else if (TYP_FLD(typ_idx) == AT_Tbl_Idx) {
            KEEP_ATTR(TYP_IDX(typ_idx));
         }
      }
      else if (TYP_TYPE(typ_idx) == Structure) {
         attr_idx = TYP_IDX(typ_idx);
   
         while (AT_ATTR_LINK(attr_idx) != NULL_IDX) {
            attr_idx = AT_ATTR_LINK(attr_idx);
         }
   
         TYP_IDX(typ_idx) = attr_idx;

         KEEP_ATTR(attr_idx);
      }
   }

   TRACE (Func_Exit, "set_mod_link_tbl_for_typ", NULL);

   return;

}  /* set_mod_link_tbl_for_typ */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Go through the module link table, assigning new indexes to all        *|
|*      entries that must be left in the compressed tables.                   *|
|*      The zeroth entry of the mod link table contains the index to start    *|
|*      for each of the tables.  This is the mod link index to start with     *|
|*      and the tbl index to start assigning with.                            *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
static void  assign_new_idxs(boolean    resolving_duplicates)

{
   int          at_new_tbl_idx  = ML_AT_IDX(0) + 1;
   int          bd_new_tbl_idx  = ML_BD_IDX(0) + 1;
   int          cn_new_tbl_idx  = ML_CN_IDX(0) + 1;
   int          cp_new_tbl_idx  = ML_CP_IDX(0) + 1;
   int          end_idx;
   int          idx;
   int          il_new_tbl_idx  = ML_IL_IDX(0) + 1;
   int          ir_new_tbl_idx  = ML_IR_IDX(0) + 1;
   int          ln_new_tbl_idx  = ML_LN_IDX(0) + 1;
   int          mod_idx;
   int          new_idx;
   int          np_new_tbl_idx  = ML_NP_IDX(0) + 1;
   int          sb_new_tbl_idx  = ML_SB_IDX(0) + 1;
   int          sh_new_tbl_idx  = ML_SH_IDX(0) + 1;
   int          sn_new_tbl_idx  = ML_SN_IDX(0) + 1;
   int          typ_new_tbl_idx = ML_TYP_IDX(0)+ 1;


   /* All the ML_xx_IDX(0) are the last used indexes for the tables */


   TRACE (Func_Entry, "assign_new_idxs", NULL);

   if (save_const_tbl_idx != NULL_IDX) {

      /* We are processing an incoming module.  We have left room */
      /* for a copy of the full constant table and constant pool. */

      end_idx           = const_tbl_idx;
      const_tbl_idx     = save_const_tbl_idx;
      const_pool_idx    = save_const_pool_idx;

  Pragma("_CRI ivdep")        

      for (mod_idx = 1; mod_idx < cn_new_tbl_idx; mod_idx++) {
         ML_CN_IDX(mod_idx)     = mod_idx;
      }

  Pragma("_CRI ivdep")        

      for (mod_idx = 1; mod_idx < cp_new_tbl_idx; mod_idx++) {
         ML_CP_IDX(mod_idx)     = mod_idx;
      }

      for (mod_idx = cn_new_tbl_idx; mod_idx <= end_idx; mod_idx++) {

         if (ML_CN_KEEP_ME(mod_idx)) {
            new_idx             = ntr_const_tbl(CN_TYPE_IDX(mod_idx),
                                                CN_EXTRA_ZERO_WORD(mod_idx),
                                                &CN_CONST(mod_idx));
            ML_CN_IDX(mod_idx)  = new_idx;
         }
      }

      ML_CN_IDX(0)      = const_tbl_idx;
      ML_CP_IDX(0)      = const_pool_idx;
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = 1; mod_idx < at_new_tbl_idx; mod_idx++) {
      ML_AT_IDX(mod_idx)                = mod_idx;
      ML_AT_COMPRESSED_IDX(mod_idx)     = TRUE;
      ML_AT_KEEP_ME(mod_idx)            = TRUE;
   }

   if (resolving_duplicates) {

      for (mod_idx = at_new_tbl_idx; mod_idx <= attr_tbl_idx; mod_idx++) {

         if (ML_AT_KEEP_ME(mod_idx)) {
            ML_AT_IDX(mod_idx)                  = at_new_tbl_idx;
            ML_AT_COMPRESSED_IDX(mod_idx)       = TRUE;
            at_new_tbl_idx++;
         }
         else if (ML_AT_IDX(mod_idx) != mod_idx && 
                  ML_AT_IDX(mod_idx) != NULL_IDX) {

            /* This attr has been resolved to another attr.  Find out if    */
            /* any attr in this chain needs to be kept.  If the attr does   */
            /* not need to be kept, just skip to the next attr.             */

            idx = mod_idx;

            /* Search until we find the attr that gets kept in this chain.  */
            /* If ML_AT_KEEP_ME is set, we've found the attr that gets kept */
            /* in the chain.  If ML_AT_COMPRESSED_IDX is set, this attr in  */
            /* the chain has already been changed to index to its new       */
            /* compressed index.  Following is an example of how this can   */
            /* happen:     ML_AT_IDX(344) = 1268.  ML_AT_KEEP_ME(1268) = T  */
            /* We enter this code with 344.  After this code sequence,      */
            /* ML_AT_IDX(1268) = 344, ML_AT_KEEP_ME(1268) = FALSE.          */
            /* ML_AT_IDX(344) = 20 (The new compressed index.)              */
            /* ML_AT_KEEP_ME(344) = TRUE.  ML_AT_COMPRESSED_IDX(344) = TRUE.*/
            /*                                                              */
            /* We enter this code with 1268.  After this code sequence,     */
            /* ML_AT_IDX(1268) = 20 and ML_AT_COMPRESSED_IDX(1268) = TRUE.  */
            /*                                                              */
            /* Now, suppose we also have ML_AT_IDX(3000) = 1268.            */
            /* We enter this code with 3000.  We will do the following loop,*/
            /* but will stop at 1268, because it already has its compressed */
            /* index.  We will then use that index.  So in conclusion,      */
            /* attrs 3000, 1268 and 344 are all the same.  What we want is  */
            /* just one copy of this attr at index 20, when compression is  */
            /* finished.                                                    */

            while (idx != NULL_IDX &&
                   !ML_AT_KEEP_ME(idx) &&
                   !ML_AT_COMPRESSED_IDX(idx)) {
               idx = ML_AT_IDX(idx);
            }

            if (idx > mod_idx) {

               /* The duplicate attr being kept has not been assigned a new */
               /* index yet.  Switch the attrs that are being kept, since   */
               /* we are ready to assign a new index to this attr.          */

               /* Since these are the same thing - switch the actual info   */
               /* in the attr, so that all information about which entries  */
               /* in which tables should be kept will remain okay.          */

               COPY_ATTR_NTRY(AT_WORK_IDX, mod_idx);
               COPY_ATTR_NTRY(mod_idx, idx);
               COPY_ATTR_NTRY(idx, AT_WORK_IDX);

               ML_AT_KEEP_ME(idx)       = FALSE;
               ML_AT_KEEP_ME(mod_idx)   = TRUE;

               /* Set the higher duplicate attr ML_AT_IDX to lower duplicate */
               /* attr index.  When the higher duplicate attr comes up, it   */
               /* will fall through here but take the else clause instead of */
               /* this clause.  That will get its ML_AT_IDX set correctly.   */
               /* We cannot set ML_AT_IDX directly, because when the higher  */
               /* attr comes through, it won't know that its ML_AT_IDX has   */
               /* already been adjusted.                                     */

               ML_AT_IDX(idx)                   = mod_idx;
               ML_AT_IDX(mod_idx)               = at_new_tbl_idx;
               ML_AT_COMPRESSED_IDX(mod_idx)    = TRUE;
               at_new_tbl_idx++;
            }
            else if (idx != NULL_IDX) {
               ML_AT_IDX(mod_idx)               = ML_AT_IDX(idx);
               ML_AT_COMPRESSED_IDX(mod_idx)    = TRUE;
            }
         }
      }
   }
   else {

  Pragma("_CRI ivdep")        
      for (mod_idx = at_new_tbl_idx; mod_idx <= attr_tbl_idx; mod_idx++) {

         if (ML_AT_KEEP_ME(mod_idx)) {
            ML_AT_IDX(mod_idx)  = at_new_tbl_idx;
            at_new_tbl_idx++;
         }
      }
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = 1; mod_idx < bd_new_tbl_idx; mod_idx++) {
      ML_BD_IDX(mod_idx)        = mod_idx;
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = bd_new_tbl_idx; mod_idx <= bounds_tbl_idx; mod_idx++) {

      if (ML_BD_KEEP_ME(mod_idx)) {
         ML_BD_IDX(mod_idx)     = bd_new_tbl_idx;
         bd_new_tbl_idx         = bd_new_tbl_idx + BD_NTRY_SIZE(mod_idx);
      }
   }

   if (save_const_tbl_idx == NULL_IDX) {

  Pragma("_CRI ivdep")        
      for (mod_idx = 1; mod_idx < cn_new_tbl_idx; mod_idx++) {
         ML_CN_IDX(mod_idx)     = mod_idx;
      }
   
  Pragma("_CRI ivdep")        
      for (mod_idx = cn_new_tbl_idx; mod_idx <= const_tbl_idx; mod_idx++) {
   
         if (ML_CN_KEEP_ME(mod_idx)) {
            ML_CN_IDX(mod_idx)  = cn_new_tbl_idx;
            cn_new_tbl_idx++;
         }
      }

  Pragma("_CRI ivdep")        
      for (mod_idx = 1; mod_idx < cp_new_tbl_idx; mod_idx++) {
         ML_CP_IDX(mod_idx)     = mod_idx;
      }

      end_idx = const_pool_idx;

      for (mod_idx = cp_new_tbl_idx; mod_idx <= end_idx; mod_idx++) {

         if (ML_CP_KEEP_ME(mod_idx)) {

# if defined(_HOST32)
   
            if (ML_CP_DALIGN_ME(mod_idx)) {

               while ((((long)&const_pool[cp_new_tbl_idx]) % 8) != 0) {
                  cp_new_tbl_idx++;
                  TBL_REALLOC_CK(const_pool, 1);
               }
   
               if (const_pool_idx > mod_link_tbl_idx) {
                  idx = mod_link_tbl_idx;
                  TBL_REALLOC_CK(mod_link_tbl, const_pool_idx);
   
                  for (; idx <= mod_link_tbl_idx; idx++) {
                     CLEAR_TBL_NTRY(mod_link_tbl, idx);
                  }
               }
   
            }
   
# endif
            ML_CP_IDX(mod_idx)  = cp_new_tbl_idx;
            cp_new_tbl_idx              += ML_CP_LEN(mod_idx);
         }
      }
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = 1; mod_idx < il_new_tbl_idx; mod_idx++) {
      ML_IL_IDX(mod_idx)        = mod_idx;
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = il_new_tbl_idx; mod_idx <= ir_list_tbl_idx; mod_idx++) {

      if (ML_IL_KEEP_ME(mod_idx)) {
         ML_IL_IDX(mod_idx) = il_new_tbl_idx;
         il_new_tbl_idx++;
      }
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = 1; mod_idx < ir_new_tbl_idx; mod_idx++) {
      ML_IR_IDX(mod_idx)        = mod_idx;
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = ir_new_tbl_idx; mod_idx <= ir_tbl_idx; mod_idx++) {

      if (ML_IR_KEEP_ME(mod_idx)) {
         ML_IR_IDX(mod_idx) = ir_new_tbl_idx;
         ir_new_tbl_idx++;
      }
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = 1; mod_idx < ln_new_tbl_idx; mod_idx++) {
      ML_LN_IDX(mod_idx)        = mod_idx;
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = ln_new_tbl_idx; mod_idx <= loc_name_tbl_idx; mod_idx++) {

      if (ML_LN_KEEP_ME(mod_idx)) {
         ML_LN_IDX(mod_idx) = ln_new_tbl_idx;
         ln_new_tbl_idx++;
      }
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = 1; mod_idx < np_new_tbl_idx; mod_idx++) {
      ML_NP_IDX(mod_idx)        = mod_idx;
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = np_new_tbl_idx; mod_idx <= name_pool_idx; mod_idx++) {

      if (ML_NP_KEEP_ME(mod_idx)) {
         ML_NP_IDX(mod_idx)     = np_new_tbl_idx;
         ML_NP_LEN(mod_idx)     = WORD_LEN(ML_NP_LEN(mod_idx));
         np_new_tbl_idx         += ML_NP_LEN(mod_idx);
      }
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = 1; mod_idx < sb_new_tbl_idx; mod_idx++) {
      ML_SB_IDX(mod_idx)        = mod_idx;
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = sb_new_tbl_idx; mod_idx <= stor_blk_tbl_idx; mod_idx++) {

      if (ML_SB_KEEP_ME(mod_idx)) {
         ML_SB_IDX(mod_idx)     = sb_new_tbl_idx;
         sb_new_tbl_idx++;
      }
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = 1; mod_idx < sn_new_tbl_idx; mod_idx++) {
      ML_SN_IDX(mod_idx)        = mod_idx;
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = sn_new_tbl_idx; mod_idx <= sec_name_tbl_idx; mod_idx++) {

      if (ML_SN_KEEP_ME(mod_idx)) {
         ML_SN_IDX(mod_idx)     = sn_new_tbl_idx;
         sn_new_tbl_idx++;
      }
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = 1; mod_idx < sh_new_tbl_idx; mod_idx++) {
      ML_SH_IDX(mod_idx)        = mod_idx;
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = sh_new_tbl_idx; mod_idx <= sh_tbl_idx; mod_idx++) {

      if (ML_SH_KEEP_ME(mod_idx)) {
         ML_SH_IDX(mod_idx)     = sh_new_tbl_idx;
         sh_new_tbl_idx++;
      }
   }

  Pragma("_CRI ivdep")        
   for (mod_idx = 1; mod_idx < typ_new_tbl_idx; mod_idx++) {
      ML_TYP_IDX(mod_idx)       = mod_idx;
   }

   /* Assigning typ indexes is handled in compress_typ_table */

   TRACE (Func_Exit, "assign_new_idxs", NULL);

   return;

}   /* assign_new_idxs */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      This moves the tables, writing over entries that should be compressed *|
|*      out.                                                                  *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      al_idx -> Index to start checking attr_list_tbl for updating the      *|
|*                AL_ATTR_IDX.                                                *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
static void  compress_tbls(int          al_idx,
                           boolean      from_interface)
{
   int          at_idx;
   int          bd_idx;
   int          cn_idx;
   int          cp_idx;
   int          dim;
   int          end_idx;
   int          idx;
   int          il_idx;
   int          ir_idx;
   int          ln_idx;
   int          mod_idx;
   int          np_idx;
   int          sb_idx;
   int          sh_idx;
   int          sn_idx;
   int          start_idx;
   int          typ_idx;

# if 0
   int          end_old_idx;
   int          start_old_idx;
# endif


   TRACE (Func_Entry, "compress_tbls", NULL);

   /* The zeroth entry in the module link table contains the starting index   */
   /* for each table.  This allows partial compression at the end of tables.  */
   /* After this field is saved, clear these entries.  They must be NULL_IDX  */
   /* so that if a field has NULL_IDX in it, it will not change.   All other  */
   /* fields are required to be set correctly or they will end up NULL.       */

   at_idx = ML_AT_IDX(0);
   bd_idx = ML_BD_IDX(0);
   cn_idx = ML_CN_IDX(0);
   cp_idx = ML_CP_IDX(0);
   il_idx = ML_IL_IDX(0);
   ir_idx = ML_IR_IDX(0);
   ln_idx = ML_LN_IDX(0);
   np_idx = ML_NP_IDX(0);
   sb_idx = ML_SB_IDX(0);
   sh_idx = ML_SH_IDX(0);
   sn_idx = ML_SN_IDX(0);
   typ_idx= ML_TYP_IDX(0);

   CLEAR_TBL_NTRY(mod_link_tbl, NULL_IDX);

   /* Compresses the type table, by sharing duplicate entries */
   /* and collapsing out unneeded type entries.               */

   compress_type_tbl(typ_idx);

   if (!only_update_new_tbl_entries) {
      update_idxs_in_attr_entry(1,at_idx);
   }

   start_idx    = at_idx+1;

# if 0
   mod_idx      = start_idx;

   do {

      while (mod_idx <= attr_tbl_idx && !ML_AT_KEEP_ME(mod_idx)) {
         mod_idx++;
      }

      if (mod_idx <= attr_tbl_idx) {
         start_old_idx  = mod_idx;

         while (mod_idx <= attr_tbl_idx && ML_AT_KEEP_ME(mod_idx)) {
            mod_idx++;
         }

         end_old_idx    = mod_idx - 1;
         ++at_idx;

         if (start_old_idx != at_idx) {
            (void) memmove ((void *) &attr_tbl[at_idx],
                            (void *) &attr_tbl[start_old_idx],
                            (end_old_idx - start_old_idx +1) * NUM_AT_WDS * 8);
         }
         at_idx        += end_old_idx - start_old_idx;
                         
         /* The last one checked is either too high   */
         /* or has !ML_AT_KEEP_ME set.  Skip past it. */

         ++mod_idx;
      }
   }
   while (mod_idx <= attr_tbl_idx);

# endif

   for (mod_idx = start_idx; mod_idx <= attr_tbl_idx; mod_idx++) {

      if (ML_AT_KEEP_ME(mod_idx)) {
         ++at_idx;
         COPY_ATTR_NTRY(at_idx, mod_idx);
      }
   }

   update_idxs_in_attr_entry(start_idx, at_idx);

   if (count_derived_types) {

      for (mod_idx = start_idx; mod_idx <= at_idx; mod_idx++) {
         if (AT_OBJ_CLASS(mod_idx) == Derived_Type) {
            num_module_derived_types++;
         }
      }
   }

   /* mod_idx   = (only_update_new_tbl_entries) ? bd_idx + 1 : 1; */
   mod_idx      = 1;

   while (mod_idx <= bd_idx && BD_NTRY_SIZE(mod_idx)!= 0) {

/* for some reason some deferred shape array BD_NTRY_SIZE(mod_idx)
   is 0; need to read the code
   fzhao
 */

      if (!BD_USED_NTRY(mod_idx)) {  /* Entry from the free list */
         BD_NEXT_FREE_NTRY(mod_idx)     = ML_BD_IDX(BD_NEXT_FREE_NTRY(mod_idx));
         mod_idx = mod_idx + BD_NTRY_SIZE(mod_idx);
      }
      else if (BD_DIST_NTRY(mod_idx)) {

         for (dim = 1; dim <= BD_RANK(mod_idx); dim++) {

            if (BD_CYCLIC_FLD(mod_idx, dim) == CN_Tbl_Idx) {
               BD_CYCLIC_IDX(mod_idx, dim) = 
                                  ML_CN_IDX(BD_CYCLIC_IDX(mod_idx, dim));
            }
            else if (BD_CYCLIC_FLD(mod_idx, dim) == AT_Tbl_Idx) {
               BD_CYCLIC_IDX(mod_idx, dim) = 
                                  ML_AT_IDX(BD_CYCLIC_IDX(mod_idx, dim));
            }

            if (BD_ONTO_FLD(mod_idx, dim) == CN_Tbl_Idx) {
               BD_ONTO_IDX(mod_idx, dim) = 
                                  ML_CN_IDX(BD_ONTO_IDX(mod_idx, dim));
            }
            else if (BD_ONTO_FLD(mod_idx, dim) == AT_Tbl_Idx) {
               BD_ONTO_IDX(mod_idx, dim) = 
                                  ML_AT_IDX(BD_ONTO_IDX(mod_idx, dim));
            }
         }
         mod_idx = mod_idx + BD_RANK(mod_idx) + 1;  /* 1 for header */
      }
      else if (BD_ARRAY_CLASS(mod_idx) != Deferred_Shape) {

         if (BD_LEN_FLD(mod_idx) == CN_Tbl_Idx) {
            BD_LEN_IDX(mod_idx) = ML_CN_IDX(BD_LEN_IDX(mod_idx));
         }
         else if (BD_LEN_FLD(mod_idx) == AT_Tbl_Idx) {
            BD_LEN_IDX(mod_idx) = ML_AT_IDX(BD_LEN_IDX(mod_idx));
         }

         for (dim = 1; dim <= BD_RANK(mod_idx); dim++) {

            if (BD_LB_FLD(mod_idx, dim) == CN_Tbl_Idx) {
               BD_LB_IDX(mod_idx, dim) = ML_CN_IDX(BD_LB_IDX(mod_idx, dim));
            }
            else if (BD_LB_FLD(mod_idx, dim) == AT_Tbl_Idx) {
               BD_LB_IDX(mod_idx, dim) = ML_AT_IDX(BD_LB_IDX(mod_idx, dim));
            }

            if (BD_UB_FLD(mod_idx, dim) == CN_Tbl_Idx) {
               BD_UB_IDX(mod_idx, dim) = ML_CN_IDX(BD_UB_IDX(mod_idx, dim));
            }
            else if (BD_UB_FLD(mod_idx, dim) == AT_Tbl_Idx) {
               BD_UB_IDX(mod_idx, dim) = ML_AT_IDX(BD_UB_IDX(mod_idx, dim));
            }

            if (BD_XT_FLD(mod_idx, dim) == CN_Tbl_Idx) {
               BD_XT_IDX(mod_idx, dim) = ML_CN_IDX(BD_XT_IDX(mod_idx, dim));
            }
            else if (BD_XT_FLD(mod_idx, dim) == AT_Tbl_Idx) {
               BD_XT_IDX(mod_idx, dim) = ML_AT_IDX(BD_XT_IDX(mod_idx, dim));
            }

            if (BD_SM_FLD(mod_idx, dim) == CN_Tbl_Idx) {
               BD_SM_IDX(mod_idx, dim) = ML_CN_IDX(BD_SM_IDX(mod_idx, dim));
            }
            else if (BD_SM_FLD(mod_idx, dim) == AT_Tbl_Idx) {
               BD_SM_IDX(mod_idx, dim) = ML_AT_IDX(BD_SM_IDX(mod_idx, dim));
            }
         }
         mod_idx = mod_idx + BD_RANK(mod_idx) + 1;  /* 1 for header */
      }
      else {
        if (BD_NTRY_SIZE(mod_idx) == 0) {
           /* eraxxon & fzhao: fix for bug #76 */
           mod_idx = mod_idx + BD_RANK(mod_idx) + 1;
        }
        else {
           mod_idx++;
        }
      }
   }

   start_idx    = bd_idx+1;

   for (mod_idx = start_idx; mod_idx <= bounds_tbl_idx; mod_idx++) {

      if (ML_BD_KEEP_ME(mod_idx)) {
         ++bd_idx;
         COPY_BD_NTRY(bd_idx, mod_idx);

         if (BD_DIST_NTRY(bd_idx) ||
             BD_ARRAY_CLASS(bd_idx) != Deferred_Shape) {

            bd_idx = bd_idx + BD_RANK(bd_idx);
         }
      }
   }

   for (mod_idx = start_idx; mod_idx <= bd_idx; mod_idx++) {

      if (BD_DIST_NTRY(mod_idx)) {

         for (dim = 1; dim <= BD_RANK(mod_idx); dim++) {

            if (BD_CYCLIC_FLD(mod_idx, dim) == CN_Tbl_Idx) {
               BD_CYCLIC_IDX(mod_idx, dim) =
                                  ML_CN_IDX(BD_CYCLIC_IDX(mod_idx, dim));
            }
            else if (BD_CYCLIC_FLD(mod_idx, dim) == AT_Tbl_Idx) {
               BD_CYCLIC_IDX(mod_idx, dim) =
                                  ML_AT_IDX(BD_CYCLIC_IDX(mod_idx, dim));
            }

            if (BD_ONTO_FLD(mod_idx, dim) == CN_Tbl_Idx) {
               BD_ONTO_IDX(mod_idx, dim) =
                                  ML_CN_IDX(BD_ONTO_IDX(mod_idx, dim));
            }
            else if (BD_ONTO_FLD(mod_idx, dim) == AT_Tbl_Idx) {
               BD_ONTO_IDX(mod_idx, dim) =
                                  ML_AT_IDX(BD_ONTO_IDX(mod_idx, dim));
            }
         }
         mod_idx = mod_idx + BD_RANK(mod_idx);
      }
      else if (BD_ARRAY_CLASS(mod_idx) != Deferred_Shape) {

         if (BD_LEN_FLD(mod_idx) == CN_Tbl_Idx) {
            BD_LEN_IDX(mod_idx) = ML_CN_IDX(BD_LEN_IDX(mod_idx));
         }
         else if (BD_LEN_FLD(mod_idx) == AT_Tbl_Idx) {
            BD_LEN_IDX(mod_idx) = ML_AT_IDX(BD_LEN_IDX(mod_idx));
         }

         for (dim = 1; dim <= BD_RANK(mod_idx); dim++) {

            if (BD_LB_FLD(mod_idx, dim) == CN_Tbl_Idx) {
               BD_LB_IDX(mod_idx, dim) = ML_CN_IDX(BD_LB_IDX(mod_idx, dim));
            }
            else if (BD_LB_FLD(mod_idx, dim) == AT_Tbl_Idx) {
               BD_LB_IDX(mod_idx, dim) = ML_AT_IDX(BD_LB_IDX(mod_idx, dim));
            }

            if (BD_UB_FLD(mod_idx, dim) == CN_Tbl_Idx) {
               BD_UB_IDX(mod_idx, dim) = ML_CN_IDX(BD_UB_IDX(mod_idx, dim));
            }
            else if (BD_UB_FLD(mod_idx, dim) == AT_Tbl_Idx) {
               BD_UB_IDX(mod_idx, dim) = ML_AT_IDX(BD_UB_IDX(mod_idx, dim));
            }

            if (BD_XT_FLD(mod_idx, dim) == CN_Tbl_Idx) {
               BD_XT_IDX(mod_idx, dim) = ML_CN_IDX(BD_XT_IDX(mod_idx, dim));
            }
            else if (BD_XT_FLD(mod_idx, dim) == AT_Tbl_Idx) {
               BD_XT_IDX(mod_idx, dim) = ML_AT_IDX(BD_XT_IDX(mod_idx, dim));
            }

            if (BD_SM_FLD(mod_idx, dim) == CN_Tbl_Idx) {
               BD_SM_IDX(mod_idx, dim) = ML_CN_IDX(BD_SM_IDX(mod_idx, dim));
            }
            else if (BD_SM_FLD(mod_idx, dim) == AT_Tbl_Idx) {
               BD_SM_IDX(mod_idx, dim) = ML_AT_IDX(BD_SM_IDX(mod_idx, dim));
            }
         }
         mod_idx = mod_idx + BD_RANK(mod_idx);
      }
   }

   start_idx    = cn_idx+1;

  Pragma("_CRI ivdep")        
   for (mod_idx = cn_idx+1; mod_idx <= const_tbl_idx; mod_idx++) {

      if (ML_CN_KEEP_ME(mod_idx)) {
         const_tbl[++cn_idx]    = const_tbl[mod_idx];
      }
   }

# if defined(_DEBUG)
   for (mod_idx = 1; mod_idx <= const_tbl_idx; mod_idx++) {

      if (CN_POOL_IDX(mod_idx) == NULL_IDX) {
         PRINTMSG(stmt_start_line, 1349, Internal, 0, mod_idx);
      }
   }
# endif


   for (mod_idx = 1; mod_idx <= cn_idx; mod_idx++) {
      CN_TYPE_IDX(mod_idx)      = ML_TYP_IDX(CN_TYPE_IDX(mod_idx));
      CN_POOL_IDX(mod_idx)      = ML_CP_IDX(CN_POOL_IDX(mod_idx));
   }

   for (mod_idx = cp_idx+1; mod_idx <= const_pool_idx; mod_idx++) {

      if (ML_CP_KEEP_ME(mod_idx)) {

# if defined(_HOST32) 

         if (ML_CP_DALIGN_ME(mod_idx)) {
            cp_idx = ML_CP_IDX(mod_idx) - 1;
         }
# endif

         for (idx = 0; idx < ML_CP_LEN(mod_idx); idx++) {
            const_pool[++cp_idx]        = const_pool[mod_idx+idx];
         }
      }
   }

   for (mod_idx = (from_interface || !only_update_new_tbl_entries) ?
                  1 : (il_idx+1); mod_idx <= il_idx; mod_idx++) {
      IL_NEXT_LIST_IDX(mod_idx) = ML_IL_IDX(IL_NEXT_LIST_IDX(mod_idx));

      if (!IL_ARG_DESC_VARIANT(mod_idx)) {
         IL_PREV_LIST_IDX(mod_idx) = ML_IL_IDX(IL_PREV_LIST_IDX(mod_idx));
      }

      switch (IL_FLD(mod_idx)) {
      case CN_Tbl_Idx:
         IL_IDX(mod_idx) = ML_CN_IDX(IL_IDX(mod_idx));
         break;

      case AT_Tbl_Idx:
         IL_IDX(mod_idx) = ML_AT_IDX(IL_IDX(mod_idx));
         break;
      
      case IL_Tbl_Idx:
         IL_IDX(mod_idx) = ML_IL_IDX(IL_IDX(mod_idx));
         break;

      case IR_Tbl_Idx:
         IL_IDX(mod_idx) = ML_IR_IDX(IL_IDX(mod_idx));
         break;
      }
   }

   start_idx    = il_idx + 1;

   for (mod_idx = start_idx; mod_idx <= ir_list_tbl_idx; mod_idx++) {

      if (ML_IL_KEEP_ME(mod_idx)) {
         ir_list_tbl[++il_idx]          = ir_list_tbl[mod_idx];
      }
   }

   for (mod_idx = start_idx; mod_idx <= il_idx; mod_idx++) {
      IL_NEXT_LIST_IDX(mod_idx) = ML_IL_IDX(IL_NEXT_LIST_IDX(mod_idx));

      if (!IL_ARG_DESC_VARIANT(mod_idx)) {
         IL_PREV_LIST_IDX(mod_idx) = ML_IL_IDX(IL_PREV_LIST_IDX(mod_idx));
      }

      switch (IL_FLD(mod_idx)) {
      case CN_Tbl_Idx:
         IL_IDX(mod_idx) = ML_CN_IDX(IL_IDX(mod_idx));
         break;

      case AT_Tbl_Idx:
         IL_IDX(mod_idx) = ML_AT_IDX(IL_IDX(mod_idx));
         break;
      
      case IL_Tbl_Idx:
         IL_IDX(mod_idx) = ML_IL_IDX(IL_IDX(mod_idx));
         break;

      case IR_Tbl_Idx:
         IL_IDX(mod_idx) = ML_IR_IDX(IL_IDX(mod_idx));
         break;
      }
   }

   for (mod_idx = (from_interface || !only_update_new_tbl_entries) ?
                  1 : (ir_idx + 1); mod_idx <= ir_idx; mod_idx++) {
      IR_TYPE_IDX(mod_idx)      = ML_TYP_IDX(IR_TYPE_IDX(mod_idx));

      switch (IR_FLD_L(mod_idx)) {
      case CN_Tbl_Idx:
         IR_IDX_L(mod_idx) = ML_CN_IDX(IR_IDX_L(mod_idx));
         break;

      case AT_Tbl_Idx:
         IR_IDX_L(mod_idx) = ML_AT_IDX(IR_IDX_L(mod_idx));
         break;
         
      case IL_Tbl_Idx:
         IR_IDX_L(mod_idx) = ML_IL_IDX(IR_IDX_L(mod_idx));
         break;

      case IR_Tbl_Idx:
         IR_IDX_L(mod_idx) = ML_IR_IDX(IR_IDX_L(mod_idx));
         break;
      }

      switch (IR_FLD_R(mod_idx)) {
      case CN_Tbl_Idx:
         IR_IDX_R(mod_idx) = ML_CN_IDX(IR_IDX_R(mod_idx));
         break;

      case AT_Tbl_Idx:
         IR_IDX_R(mod_idx) = ML_AT_IDX(IR_IDX_R(mod_idx));
         break;
         
      case IL_Tbl_Idx:
         IR_IDX_R(mod_idx) = ML_IL_IDX(IR_IDX_R(mod_idx));
         break;

      case IR_Tbl_Idx:
         IR_IDX_R(mod_idx) = ML_IR_IDX(IR_IDX_R(mod_idx));
         break;
      }
   }

   start_idx = ir_idx+1;

   for (mod_idx = start_idx; mod_idx <= ir_tbl_idx; mod_idx++) {

      if (ML_IR_KEEP_ME(mod_idx)) {
         ir_tbl[++ir_idx]       = ir_tbl[mod_idx];
      }
   }

   for (mod_idx = start_idx; mod_idx <= ir_idx; mod_idx++) {
      IR_TYPE_IDX(mod_idx)      = ML_TYP_IDX(IR_TYPE_IDX(mod_idx));

      switch (IR_FLD_L(mod_idx)) {
      case CN_Tbl_Idx:
         IR_IDX_L(mod_idx) = ML_CN_IDX(IR_IDX_L(mod_idx));
         break;

      case AT_Tbl_Idx:
         IR_IDX_L(mod_idx) = ML_AT_IDX(IR_IDX_L(mod_idx));
         break;
      
      case IL_Tbl_Idx:
         IR_IDX_L(mod_idx) = ML_IL_IDX(IR_IDX_L(mod_idx));
         break;

      case IR_Tbl_Idx:
         IR_IDX_L(mod_idx) = ML_IR_IDX(IR_IDX_L(mod_idx));
         break;
      }

      switch (IR_FLD_R(mod_idx)) {
      case CN_Tbl_Idx:
         IR_IDX_R(mod_idx) = ML_CN_IDX(IR_IDX_R(mod_idx));
         break;

      case AT_Tbl_Idx:
         IR_IDX_R(mod_idx) = ML_AT_IDX(IR_IDX_R(mod_idx));
         break;
      
      case IL_Tbl_Idx:
         IR_IDX_R(mod_idx) = ML_IL_IDX(IR_IDX_R(mod_idx));
         break;

      case IR_Tbl_Idx:
         IR_IDX_R(mod_idx) = ML_IR_IDX(IR_IDX_R(mod_idx));
         break;
      }
   }

   start_idx    = ln_idx+1;

   for (mod_idx = start_idx; mod_idx <= loc_name_tbl_idx; mod_idx++) {

      if (ML_LN_KEEP_ME(mod_idx)) {
         loc_name_tbl[++ln_idx] = loc_name_tbl[mod_idx];
      }
   }

   for (mod_idx = start_idx; mod_idx <= ln_idx; mod_idx++) {

     if (LN_ATTR_IDX(mod_idx) != NULL_IDX) {
        LN_ATTR_IDX(mod_idx)    = ML_AT_IDX(LN_ATTR_IDX(mod_idx));
        LN_NAME_IDX(mod_idx)    = AT_NAME_IDX(LN_ATTR_IDX(mod_idx));
        LN_NAME_LEN(mod_idx)    = AT_NAME_LEN(LN_ATTR_IDX(mod_idx));
     }
     else {
        LN_NAME_IDX(mod_idx)    = ML_NP_IDX(LN_NAME_IDX(mod_idx));
     }
   }

   for (mod_idx = np_idx+1; mod_idx <= name_pool_idx; mod_idx++) {

      if (ML_NP_KEEP_ME(mod_idx)) {

         for (idx = 0; idx < ML_NP_LEN(mod_idx); idx++) {
            name_pool[++np_idx].name_long = name_pool[mod_idx+idx].name_long;
         }
      }
   }

   /* for (mod_idx = (only_update_new_tbl_entries) ? (sb_idx + 1) : 1; */
   for (mod_idx = 1; mod_idx <= sb_idx; mod_idx++) {
      SB_NAME_IDX(mod_idx)              = ML_NP_IDX(SB_NAME_IDX(mod_idx));
      SB_MODULE_IDX(mod_idx)            = ML_AT_IDX(SB_MODULE_IDX(mod_idx));

      if (SB_FIRST_ATTR_IDX(mod_idx) != NULL_IDX) {
         SB_FIRST_ATTR_IDX(mod_idx) = ML_AT_IDX(SB_FIRST_ATTR_IDX(mod_idx));
      }

      switch (SB_LEN_FLD(mod_idx)) {
      case AT_Tbl_Idx:
         SB_LEN_IDX(mod_idx)            = ML_AT_IDX(SB_LEN_IDX(mod_idx));
         break;
     
      case CN_Tbl_Idx:
         SB_LEN_IDX(mod_idx)            = ML_CN_IDX(SB_LEN_IDX(mod_idx));
         break;

      case IL_Tbl_Idx:
         SB_LEN_IDX(mod_idx)            = ML_IL_IDX(SB_LEN_IDX(mod_idx));
         break;

      case IR_Tbl_Idx:
         SB_LEN_IDX(mod_idx)            = ML_IR_IDX(SB_LEN_IDX(mod_idx));
         break;
      }
   }

   start_idx = sb_idx + 1;

   for (mod_idx = start_idx; mod_idx <= stor_blk_tbl_idx; mod_idx++) {

      if (ML_SB_KEEP_ME(mod_idx)) {
         stor_blk_tbl[++sb_idx]         = stor_blk_tbl[mod_idx];
      }
   }

   for (mod_idx = start_idx; mod_idx <= sb_idx; mod_idx++) {
      SB_NAME_IDX(mod_idx)              = ML_NP_IDX(SB_NAME_IDX(mod_idx));
      SB_MODULE_IDX(mod_idx)            = ML_AT_IDX(SB_MODULE_IDX(mod_idx));

      if (SB_FIRST_ATTR_IDX(mod_idx) != NULL_IDX) {
         SB_FIRST_ATTR_IDX(mod_idx) = ML_AT_IDX(SB_FIRST_ATTR_IDX(mod_idx));
      }

      switch (SB_LEN_FLD(mod_idx)) {
      case AT_Tbl_Idx:
         SB_LEN_IDX(mod_idx)            = ML_AT_IDX(SB_LEN_IDX(mod_idx));
         break;
     
      case CN_Tbl_Idx:
         SB_LEN_IDX(mod_idx)            = ML_CN_IDX(SB_LEN_IDX(mod_idx));
         break;

      case IL_Tbl_Idx:
         SB_LEN_IDX(mod_idx)            = ML_IL_IDX(SB_LEN_IDX(mod_idx));
         break;

      case IR_Tbl_Idx:
         SB_LEN_IDX(mod_idx)            = ML_IR_IDX(SB_LEN_IDX(mod_idx));
         break;
      }
   }

   for (mod_idx = (from_interface || !only_update_new_tbl_entries) ?
                  1 : (sh_idx + 1); mod_idx <= sh_idx; mod_idx++) {
      SH_NEXT_IDX(mod_idx)              = ML_SH_IDX(SH_NEXT_IDX(mod_idx));
      SH_PREV_IDX(mod_idx)              = ML_SH_IDX(SH_PREV_IDX(mod_idx));
      SH_IR_IDX(mod_idx)                = ML_IR_IDX(SH_IR_IDX(mod_idx));

      if (SH_STMT_TYPE(mod_idx) != Statement_Num_Stmt) {
         SH_PARENT_BLK_IDX(mod_idx)     = ML_SH_IDX(SH_PARENT_BLK_IDX(mod_idx));
      }
   }

   start_idx = sh_idx + 1;

   for (mod_idx = start_idx; mod_idx <= sh_tbl_idx; mod_idx++) {

      if (ML_SH_KEEP_ME(mod_idx)) {
         sh_tbl[++sh_idx]               = sh_tbl[mod_idx];
      }
   }


   for (mod_idx = start_idx; mod_idx <= sh_idx; mod_idx++) {
      SH_NEXT_IDX(mod_idx)              = ML_SH_IDX(SH_NEXT_IDX(mod_idx));
      SH_PREV_IDX(mod_idx)              = ML_SH_IDX(SH_PREV_IDX(mod_idx));
      SH_IR_IDX(mod_idx)                = ML_IR_IDX(SH_IR_IDX(mod_idx));

      if (SH_STMT_TYPE(mod_idx) != Statement_Num_Stmt) {
         SH_PARENT_BLK_IDX(mod_idx)     = ML_SH_IDX(SH_PARENT_BLK_IDX(mod_idx));
      }
   }

   /* Need SN_NAME_LEN because of renames situations. */

   /* for (mod_idx = (only_update_new_tbl_entries) ? (sn_idx+1) : 1;  */
   for (mod_idx = 1; mod_idx <= sn_idx; mod_idx++) {
      SN_ATTR_IDX(mod_idx)      = ML_AT_IDX(SN_ATTR_IDX(mod_idx));
      SN_NAME_IDX(mod_idx)      = AT_NAME_IDX(SN_ATTR_IDX(mod_idx));
      SN_NAME_LEN(mod_idx)      = AT_NAME_LEN(SN_ATTR_IDX(mod_idx));
      SN_SIBLING_LINK(mod_idx)  = ML_SN_IDX(SN_SIBLING_LINK(mod_idx));
   }

   start_idx = sn_idx + 1;

   for (mod_idx = start_idx; mod_idx <= sec_name_tbl_idx; mod_idx++) {

      if (ML_SN_KEEP_ME(mod_idx)) {
         sec_name_tbl[++sn_idx]         = sec_name_tbl[mod_idx];
      }
   }

   for (mod_idx = start_idx; mod_idx <= sec_name_tbl_idx; mod_idx++) {
      SN_ATTR_IDX(mod_idx)              = ML_AT_IDX(SN_ATTR_IDX(mod_idx));
      SN_NAME_IDX(mod_idx)              = AT_NAME_IDX(SN_ATTR_IDX(mod_idx));
      SN_NAME_LEN(mod_idx)              = AT_NAME_LEN(SN_ATTR_IDX(mod_idx));
      SN_SIBLING_LINK(mod_idx)          = ML_SN_IDX(SN_SIBLING_LINK(mod_idx));
   }

   attr_tbl_idx         = at_idx;
   attr_aux_tbl_idx     = at_idx;
   bounds_tbl_idx       = bd_idx;
   const_tbl_idx        = cn_idx;
   const_pool_idx       = cp_idx;
   loc_name_tbl_idx     = ln_idx;
   ir_list_tbl_idx      = il_idx;
   ir_tbl_idx           = ir_idx;
   name_pool_idx        = np_idx;
   stor_blk_tbl_idx     = sb_idx;
   sec_name_tbl_idx     = sn_idx;
   sh_tbl_idx           = sh_idx;

   /* If this is a partial compression, the only entries added to the */
   /* attr_list_tbl must point to new attributes coming in during USE */
   /* processing.                                                     */

   for (mod_idx = al_idx+1; mod_idx <= attr_list_tbl_idx; mod_idx++) {
      
# if defined(_DEBUG)
     end_idx    = ML_AT_IDX(AL_ATTR_IDX(mod_idx));

     if (!AL_FREE(mod_idx) &&
          AL_ATTR_IDX(mod_idx) != NULL_IDX &&
         !ML_AT_KEEP_ME(AL_ATTR_IDX(mod_idx)) &&
         !ML_AT_COMPRESSED_IDX(AL_ATTR_IDX(mod_idx))) {


        /* This attr is not being kept.  It should have been cleared. */

        PRINTMSG(stmt_start_line, 1321, Internal, 0, mod_idx, 
                 AL_ATTR_IDX(mod_idx));
     }

# endif

      AL_ATTR_IDX(mod_idx) = ML_AT_IDX(AL_ATTR_IDX(mod_idx));
   }

   mod_idx = SCP_HN_FW_IDX(curr_scp_idx) + 1;
   end_idx = SCP_HN_LW_IDX(curr_scp_idx);

   while (mod_idx < end_idx) {

      if (!ML_AT_KEEP_ME(HN_ATTR_IDX(mod_idx))) {

         if (!ML_AT_COMPRESSED_IDX(HN_ATTR_IDX(mod_idx))) {
            remove_hidden_name_ntry(mod_idx);
            end_idx = SCP_HN_LW_IDX(curr_scp_idx);
         }
      }
      mod_idx++;
   }


   for (mod_idx = SCP_HN_FW_IDX(curr_scp_idx) + 1;
        mod_idx < SCP_HN_LW_IDX(curr_scp_idx); mod_idx++) {
      HN_ATTR_IDX(mod_idx)      = ML_AT_IDX(HN_ATTR_IDX(mod_idx));
      HN_NAME_IDX(mod_idx)      = ML_NP_IDX(HN_NAME_IDX(mod_idx));
   }

   /* This updates the scp attr index, but be careful, because        */
   /* everything else in the scope table could be bad pointers.       */

   SCP_ATTR_IDX(curr_scp_idx) = ML_AT_IDX(SCP_ATTR_IDX(curr_scp_idx));

   TRACE (Func_Exit, "compress_tbls", NULL);

   return;

}   /* compress_tbls */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
static  void  update_idxs_in_attr_entry(int     start_idx,
                                        int     end_idx)
{
   int          at_idx;


   TRACE (Func_Entry, "update_idxs_in_attr_entry", NULL);

   for (at_idx  = start_idx; at_idx <= end_idx; at_idx++) {

   if (!AT_IGNORE_ATTR_LINK(at_idx)) {
       AT_ATTR_LINK(at_idx)     = ML_AT_IDX(AT_ATTR_LINK(at_idx));
   }

   AT_NAME_IDX(at_idx)          = ML_NP_IDX(AT_NAME_IDX(at_idx));
   AT_ORIG_NAME_IDX(at_idx)     = ML_NP_IDX(AT_ORIG_NAME_IDX(at_idx));
   AT_MODULE_IDX(at_idx)        = ML_AT_IDX(AT_MODULE_IDX(at_idx));

   switch (AT_OBJ_CLASS(at_idx)) {
   case Data_Obj:
      ATD_ARRAY_IDX(at_idx)        = ML_BD_IDX(ATD_ARRAY_IDX(at_idx));
      ATD_DISTRIBUTION_IDX(at_idx) = ML_BD_IDX(ATD_DISTRIBUTION_IDX(at_idx));
      ATD_STOR_BLK_IDX(at_idx)     = ML_SB_IDX(ATD_STOR_BLK_IDX(at_idx));
      ATD_RESHAPE_ARRAY_IDX(at_idx)= ML_BD_IDX(ATD_RESHAPE_ARRAY_IDX(at_idx));

# if defined(COARRAY_FORTRAN)
      ATD_PE_ARRAY_IDX(at_idx)     = ML_BD_IDX(ATD_PE_ARRAY_IDX(at_idx));
# endif

      switch (ATD_CLASS(at_idx)) {
      case Function_Result:

         if (ATD_OFFSET_ASSIGNED(at_idx)) {

            switch (ATD_OFFSET_FLD(at_idx)) {
            case AT_Tbl_Idx:
               ATD_OFFSET_IDX(at_idx) = ML_AT_IDX(ATD_OFFSET_IDX(at_idx));
               break;

            case CN_Tbl_Idx:
               ATD_OFFSET_IDX(at_idx) = ML_CN_IDX(ATD_OFFSET_IDX(at_idx));
               break;

            case IR_Tbl_Idx:
               ATD_OFFSET_IDX(at_idx) = ML_IR_IDX(ATD_OFFSET_IDX(at_idx));
               break;

            case IL_Tbl_Idx:
               ATD_OFFSET_IDX(at_idx) = ML_IL_IDX(ATD_OFFSET_IDX(at_idx));
               break;
            }
         }

         ATD_TYPE_IDX(at_idx)   = ML_TYP_IDX(ATD_TYPE_IDX(at_idx));
         ATD_FUNC_IDX(at_idx)   = ML_AT_IDX(ATD_FUNC_IDX(at_idx));
         break;


      case Constant:

         ATD_TYPE_IDX(at_idx)   = ML_TYP_IDX(ATD_TYPE_IDX(at_idx));

         switch (ATD_FLD(at_idx)) {
         case AT_Tbl_Idx:
            ATD_CONST_IDX(at_idx) = ML_AT_IDX(ATD_CONST_IDX(at_idx));
            break;
 
         default:
            ATD_CONST_IDX(at_idx) = ML_CN_IDX(ATD_CONST_IDX(at_idx));
            break;
         }
         break;


      case CRI__Pointee:
         ATD_TYPE_IDX(at_idx)   = ML_TYP_IDX(ATD_TYPE_IDX(at_idx));
         ATD_PTR_IDX(at_idx)    = ML_AT_IDX(ATD_PTR_IDX(at_idx));
         break;

      case Compiler_Tmp:

         ATD_NEXT_MEMBER_IDX(at_idx)  = ML_AT_IDX(ATD_NEXT_MEMBER_IDX(at_idx));
         ATD_DEFINING_ATTR_IDX(at_idx)=ML_AT_IDX(ATD_DEFINING_ATTR_IDX(at_idx));

         if (ATD_AUTOMATIC(at_idx)) {
            ATD_AUTO_BASE_IDX(at_idx) = ML_AT_IDX(ATD_AUTO_BASE_IDX(at_idx));
         }
         else if (ATD_OFFSET_ASSIGNED(at_idx)) {

            switch (ATD_OFFSET_FLD(at_idx)) {
            case AT_Tbl_Idx:
               ATD_OFFSET_IDX(at_idx) = ML_AT_IDX(ATD_OFFSET_IDX(at_idx));
               break;

            case CN_Tbl_Idx:
               ATD_OFFSET_IDX(at_idx) = ML_CN_IDX(ATD_OFFSET_IDX(at_idx));
               break;

            case IR_Tbl_Idx:
               ATD_OFFSET_IDX(at_idx) = ML_IR_IDX(ATD_OFFSET_IDX(at_idx));
               break;

            case IL_Tbl_Idx:
               ATD_OFFSET_IDX(at_idx) = ML_IL_IDX(ATD_OFFSET_IDX(at_idx));
               break;
            }
         }

         ATD_TYPE_IDX(at_idx)   = ML_TYP_IDX(ATD_TYPE_IDX(at_idx));

         switch (ATD_FLD(at_idx)) {
         case CN_Tbl_Idx:
            ATD_TMP_IDX(at_idx)   = ML_CN_IDX(ATD_TMP_IDX(at_idx));
            break;

         case AT_Tbl_Idx:
            ATD_TMP_IDX(at_idx)   = ML_AT_IDX(ATD_TMP_IDX(at_idx));
            break;

         case IR_Tbl_Idx:
            ATD_TMP_IDX(at_idx)   = ML_IR_IDX(ATD_TMP_IDX(at_idx));
            break;

         case IL_Tbl_Idx:
            ATD_TMP_IDX(at_idx)   = ML_IL_IDX(ATD_TMP_IDX(at_idx));
            break;
         }
         break;


      case Dummy_Argument:

         if (!ATD_INTRIN_DARG(at_idx)) {
            ATD_TYPE_IDX(at_idx)        = ML_TYP_IDX(ATD_TYPE_IDX(at_idx));
         }
         break;


      case Struct_Component:

         switch (ATD_OFFSET_FLD(at_idx)) {
         case AT_Tbl_Idx:
            ATD_CPNT_OFFSET_IDX(at_idx) =ML_AT_IDX(ATD_CPNT_OFFSET_IDX(at_idx));
            break;

         case CN_Tbl_Idx:
            ATD_CPNT_OFFSET_IDX(at_idx) =ML_CN_IDX(ATD_CPNT_OFFSET_IDX(at_idx));
            break;

         case IR_Tbl_Idx:
            ATD_CPNT_OFFSET_IDX(at_idx) =ML_IR_IDX(ATD_CPNT_OFFSET_IDX(at_idx));
            break;

         case IL_Tbl_Idx:
            ATD_CPNT_OFFSET_IDX(at_idx) =ML_IL_IDX(ATD_CPNT_OFFSET_IDX(at_idx));
            break;
         }

         switch (ATD_FLD(at_idx)) {
         case AT_Tbl_Idx:
            ATD_CPNT_INIT_IDX(at_idx)   = ML_AT_IDX(ATD_CPNT_INIT_IDX(at_idx));
            break;

         case CN_Tbl_Idx:
            ATD_CPNT_INIT_IDX(at_idx)   = ML_CN_IDX(ATD_CPNT_INIT_IDX(at_idx));
            break;

         case IR_Tbl_Idx:
            ATD_CPNT_INIT_IDX(at_idx)   = ML_IR_IDX(ATD_CPNT_INIT_IDX(at_idx));
            break;

         case IL_Tbl_Idx:
            ATD_CPNT_INIT_IDX(at_idx)   = ML_IL_IDX(ATD_CPNT_INIT_IDX(at_idx));
            break;
         }
         ATD_TYPE_IDX(at_idx)         = ML_TYP_IDX(ATD_TYPE_IDX(at_idx));
         ATD_DERIVED_TYPE_IDX(at_idx) = ML_AT_IDX(ATD_DERIVED_TYPE_IDX(at_idx));
         break;


      case Variable:

         switch (ATD_FLD(at_idx)) {
         case AT_Tbl_Idx:
            ATD_VARIABLE_TMP_IDX(at_idx) =
                         ML_AT_IDX(ATD_VARIABLE_TMP_IDX(at_idx));
            break;

         case IL_Tbl_Idx:
            ATD_VARIABLE_TMP_IDX(at_idx) =
                         ML_IL_IDX(ATD_VARIABLE_TMP_IDX(at_idx));
            break;
         }

         ATD_ASSIGN_TMP_IDX(at_idx)   = ML_AT_IDX(ATD_ASSIGN_TMP_IDX(at_idx));
         ATD_NEXT_MEMBER_IDX(at_idx)  = ML_AT_IDX(ATD_NEXT_MEMBER_IDX(at_idx));

         if (ATD_AUTOMATIC(at_idx)) {
            ATD_AUTO_BASE_IDX(at_idx) = ML_AT_IDX(ATD_AUTO_BASE_IDX(at_idx));
         }
         else if (ATD_OFFSET_ASSIGNED(at_idx)) {

            switch (ATD_OFFSET_FLD(at_idx)) {
            case AT_Tbl_Idx:
               ATD_OFFSET_IDX(at_idx) = ML_AT_IDX(ATD_OFFSET_IDX(at_idx));
               break;

            case CN_Tbl_Idx:
               ATD_OFFSET_IDX(at_idx) = ML_CN_IDX(ATD_OFFSET_IDX(at_idx));
               break;

            case IR_Tbl_Idx:
               ATD_OFFSET_IDX(at_idx) = ML_IR_IDX(ATD_OFFSET_IDX(at_idx));
               break;

            case IL_Tbl_Idx:
               ATD_OFFSET_IDX(at_idx) = ML_IL_IDX(ATD_OFFSET_IDX(at_idx));
               break;
            }
         }

         /* Intentional fall through */

      default:
         ATD_TYPE_IDX(at_idx)   = ML_TYP_IDX(ATD_TYPE_IDX(at_idx));
         break;

      }  /* End switch */
      break;

   case Pgm_Unit:

      if (ATP_PGM_UNIT(at_idx) == Module) {
         ATP_MOD_PATH_IDX(at_idx) = ML_NP_IDX(ATP_MOD_PATH_IDX(at_idx));
      }
      else {
         ATP_RSLT_IDX(at_idx)   = ML_AT_IDX(ATP_RSLT_IDX(at_idx));
         ATP_FIRST_IDX(at_idx)  = ML_SN_IDX(ATP_FIRST_IDX(at_idx));

         if (ATP_PROC(at_idx) != Intrin_Proc && ATP_PROC(at_idx) != Dummy_Proc){
            ATP_FIRST_SH_IDX(at_idx)= ML_SH_IDX(ATP_FIRST_SH_IDX(at_idx));
            ATP_PARENT_IDX(at_idx)  = ML_AT_IDX(ATP_PARENT_IDX(at_idx));
         }
      }

      ATP_EXT_NAME_IDX(at_idx)  = ML_NP_IDX(ATP_EXT_NAME_IDX(at_idx));
      break;

   case Label:

      ATL_NEXT_ASG_LBL_IDX(at_idx) = ML_AT_IDX(ATL_NEXT_ASG_LBL_IDX(at_idx));

      if (AT_DEFINED(at_idx)) {
         ATL_DEF_STMT_IDX(at_idx)  = ML_SH_IDX(ATL_DEF_STMT_IDX(at_idx));
      }

      if (ATL_CLASS(at_idx) == Lbl_Format) {
         ATL_PP_FORMAT_TMP(at_idx) = ML_AT_IDX(ATL_PP_FORMAT_TMP(at_idx));
         ATL_FORMAT_TMP(at_idx)    = ML_AT_IDX(ATL_FORMAT_TMP(at_idx));
      }
      else {
         ATL_DIRECTIVE_LIST(at_idx)= ML_IL_IDX(ATL_DIRECTIVE_LIST(at_idx));

         if (ATL_CLASS(at_idx) == Lbl_User) {
            ATL_BLK_STMT_IDX(at_idx)  = ML_SH_IDX(ATL_BLK_STMT_IDX(at_idx));
         }
      }
      break;


   case Derived_Type:

      if (ATT_STRUCT_BIT_LEN_IDX(at_idx) != NULL_IDX) {

         switch (ATT_STRUCT_BIT_LEN_FLD(at_idx)) {
         case CN_Tbl_Idx:
            ATT_STRUCT_BIT_LEN_IDX(at_idx) = 
                                 ML_CN_IDX(ATT_STRUCT_BIT_LEN_IDX(at_idx));
            break;

         case AT_Tbl_Idx:
            ATT_STRUCT_BIT_LEN_IDX(at_idx) = 
                                 ML_AT_IDX(ATT_STRUCT_BIT_LEN_IDX(at_idx));
            break;

         case IL_Tbl_Idx:
            ATT_STRUCT_BIT_LEN_IDX(at_idx) = 
                                 ML_IL_IDX(ATT_STRUCT_BIT_LEN_IDX(at_idx));
            break;

         case IR_Tbl_Idx:
            ATT_STRUCT_BIT_LEN_IDX(at_idx) = 
                                 ML_IR_IDX(ATT_STRUCT_BIT_LEN_IDX(at_idx));
            break;

         case NO_Tbl_Idx:
            ATT_STRUCT_BIT_LEN_FLD(at_idx) = CN_Tbl_Idx;
            ATT_STRUCT_BIT_LEN_IDX(at_idx) = 
                                 ML_CN_IDX(ATT_STRUCT_BIT_LEN_IDX(at_idx));
            break;
         }
      }

      ATT_FIRST_CPNT_IDX(at_idx)        = ML_SN_IDX(ATT_FIRST_CPNT_IDX(at_idx));
      break;

   case Interface:

      ATI_FIRST_SPECIFIC_IDX(at_idx) =ML_SN_IDX(ATI_FIRST_SPECIFIC_IDX(at_idx));
      ATI_PROC_IDX(at_idx)              = ML_AT_IDX(ATI_PROC_IDX(at_idx));
      ATD_TYPE_IDX(at_idx)              = ML_TYP_IDX(ATD_TYPE_IDX(at_idx));
      break;

   case Namelist_Grp:

      ATN_FIRST_NAMELIST_IDX(at_idx) =ML_SN_IDX(ATN_FIRST_NAMELIST_IDX(at_idx));
      ATN_LAST_NAMELIST_IDX(at_idx)  = ML_SN_IDX(ATN_LAST_NAMELIST_IDX(at_idx));

      if (ATN_NAMELIST_DESC(at_idx) != NULL_IDX) {
         ATN_NAMELIST_DESC(at_idx)   = ML_AT_IDX(ATN_NAMELIST_DESC(at_idx));
      }
      break;

   case Stmt_Func:

      ATD_TYPE_IDX(at_idx) = ML_TYP_IDX(ATD_TYPE_IDX(at_idx));
      ATP_FIRST_IDX(at_idx) = ML_SN_IDX(ATP_FIRST_IDX(at_idx));

      switch (ATS_SF_FLD(at_idx)) {
      case CN_Tbl_Idx:
         ATS_SF_IDX(at_idx) = ML_CN_IDX(ATS_SF_IDX(at_idx));
         break;

      case AT_Tbl_Idx:
         ATS_SF_IDX(at_idx) = ML_AT_IDX(ATS_SF_IDX(at_idx));
         break;

      case IR_Tbl_Idx:
         ATS_SF_IDX(at_idx) = ML_IR_IDX(ATS_SF_IDX(at_idx));
         break;

      case IL_Tbl_Idx:
         ATS_SF_IDX(at_idx) = ML_IL_IDX(ATS_SF_IDX(at_idx));
         break;
      }
      break;
   }  /* End switch */
   }  /* End For */

   TRACE (Func_Exit, "update_idxs_in_attr_entry", NULL);

   return;

}   /* update_idxs_in_attr_entry */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
extern  void  output_mod_info_file(void)

{
   int           al_idx;
   int           idx;
   int           module_attr_idx;
   FILE         *mod_file_ptr           = NULL;
   long         *mod_idx;
   int           name_idx;
   int           sb_idx;
   int           wd_len;


   TRACE (Func_Entry, "output_mod_info_file", NULL);

   module_attr_idx      = SCP_ATTR_IDX(curr_scp_idx);

   if (dump_flags.preinline) {  /* Append these files */
      mod_file_ptr = fopen(FP_NAME_PTR(SCP_FILE_PATH_IDX(curr_scp_idx)), "ab");
   }
   else if (on_off_flags.module_to_mod) {
      mod_file_ptr = fopen(FP_NAME_PTR(SCP_FILE_PATH_IDX(curr_scp_idx)), "wb");
   }
   else {

#     if defined(_MODULE_TO_DOT_M)      /* These are all appended */
         mod_file_ptr = fopen(FP_NAME_PTR(SCP_FILE_PATH_IDX(curr_scp_idx)),
                              "ab");
#     else
         mod_file_ptr = fopen(FP_NAME_PTR(SCP_FILE_PATH_IDX(curr_scp_idx)),
                              "wb");
#     endif
   }

   SCP_FILE_PATH_IDX(curr_scp_idx) = NULL_IDX;

   if (ATP_PGM_UNIT(module_attr_idx) == Module) {
      ATP_MOD_PATH_IDX(module_attr_idx) = NULL_IDX;
      ATP_MOD_PATH_LEN(module_attr_idx) = 0;
   }

   if (mod_file_ptr == NULL) {
      PRINTMSG(AT_DEF_LINE(module_attr_idx), 1665, Error,
               AT_DEF_COLUMN(module_attr_idx),
               AT_OBJ_NAME_PTR(module_attr_idx),
               FP_NAME_PTR(SCP_FILE_PATH_IDX(curr_scp_idx)));
      goto EXIT;
   }

   MD_PDT_HDR_TYPE              = COMPILER_INFO_TABLE_TYPE;
   MD_VERSION_NUM               = MD_CURRENT_VERSION;
   MD_TARGET                    = target_os;
   MD_ENABLE_DOUBLE_PRECISION   = on_off_flags.enable_double_precision;
   MD_DEFAULT_INTEGER_TYPE      = INTEGER_DEFAULT_TYPE;
   MD_HAS_ERRORS                = (num_prog_unit_errors > 0);
   MD_DALIGN                    = cmd_line_flags.dalign;
   MD_CF77TYPES                 = cmd_line_flags.s_cf77types;
   MD_DEFAULT32                 = cmd_line_flags.s_default32;
   MD_DEFAULT64                 = cmd_line_flags.s_default64;
   MD_FLOAT64                   = cmd_line_flags.s_float64;

   MD_NEW_CONST_TBL             = TRUE;

   /* At this point, if we're outputing for inlining we need to check for   */
   /* alternate entries.  If they exist, an md_header_descriptor is written */
   /* out for each.  The actual tables for the alternate entry follow in    */
   /* main entry and can can be found by reading the 026 table until the    */
   /* next main entry is found.                                             */

   if (ATP_MAY_INLINE(SCP_ATTR_IDX(MAIN_SCP_IDX)) && 
       SCP_ENTRY_IDX(MAIN_SCP_IDX) != NULL_IDX) {
      al_idx            = SCP_ENTRY_IDX(MAIN_SCP_IDX);
      MD_ALTERNATE_ENTRY= TRUE;
      MD_PDT_HDR_LEN    = sizeof(mit_header_type)/TARGET_BYTES_PER_WORD;

# if defined(_HOST32) && defined(_TARGET64)

      /* PDT size must be in 64 bit increment sizes. */

      MD_PDT_HDR_LEN = (MD_PDT_HDR_LEN + 1) / 2;
# endif

      while (al_idx != NULL_IDX) {
         name_idx       = AT_NAME_IDX(AL_ATTR_IDX(al_idx));
         MD_NAME_LEN    = AT_NAME_LEN(AL_ATTR_IDX(al_idx));
         wd_len         = WORD_LEN(MD_NAME_LEN);
         mod_idx        = MD_NAME_LONG;

         for (idx = 0; idx < wd_len; idx++) {
            *mod_idx    = name_pool[name_idx].name_long;
            name_idx++;
            mod_idx++;
         }

         fwrite(&mit_header, sizeof(mit_header_type), 1, mod_file_ptr);
         al_idx         = AL_NEXT_IDX(al_idx);
      }

      /* Reset the original name in the header. */

      name_idx          = AT_NAME_IDX(module_attr_idx);
      MD_NAME_LEN       = AT_NAME_LEN(module_attr_idx);
      wd_len            = WORD_LEN(MD_NAME_LEN);
      mod_idx           = MD_NAME_LONG;

      for (idx = 0; idx < wd_len; idx++) {
         *mod_idx       = name_pool[name_idx].name_long;
         name_idx++;
         mod_idx++;
      }
   }

   MD_ALTERNATE_ENTRY           = FALSE;

   if (dump_flags.preinline && num_prog_unit_errors > 0) {

      /* Do not write out any tables.  Just a header with error set. */

      attr_tbl_idx      = NULL_IDX;
      attr_aux_tbl_idx  = NULL_IDX;
      bounds_tbl_idx    = NULL_IDX;
      const_tbl_idx     = NULL_IDX;
      const_pool_idx    = NULL_IDX;
      ir_tbl_idx        = NULL_IDX;
      ir_list_tbl_idx   = NULL_IDX;
      loc_name_tbl_idx  = NULL_IDX;
      name_pool_idx     = NULL_IDX;
      sec_name_tbl_idx  = NULL_IDX;
      stor_blk_tbl_idx  = NULL_IDX;
      type_tbl_idx      = NULL_IDX;
      sh_tbl_idx        = NULL_IDX;
   }
   else {

      /* Do not write out any tables.  Just the mod header. */

      /* In error situations, module_attr_idx may not be in the local name    */
      /* table so it has to be specifically included for output.  This module */
      /* output is only used to finish this compilation because of errors.    */

      ML_AT_IDX(module_attr_idx)        = module_attr_idx;

      /* assign_new_idxs needs to have ML_AT_IDX(0) = NULL_IDX, ML_BD_IDX(0)  */
      /* = NULL_IDX -  ect..  The zeroth entry of the mod link table contains */
      /* the index to start compression at for each table.  When compressing  */
      /* tables for module output, everything gets compressed, so the zeroth  */
      /* entry should be all zeros to signify that everything gets compressed.*/
      /* The zeroth entry is set to all NULL_IDX's when the table is allocated*/

      /* Resolve duplicate attr idxs in mod link table.         */

      save_const_pool_idx       = NULL_IDX;
      save_const_tbl_idx        = NULL_IDX;

      /* If we're not creating a preinline file and if MODINLINE is not on    */
      /* for this module, then we will not be writing out the SH table, so    */
      /* set ML_SH_IDX equal to sh_tbl_idx, so we do nothing in assign_new..  */
      /* Then clear sh_tbl_idx and ML_SH_IDX so we do nothing in compress_..  */

      if (!ATP_MAY_INLINE(SCP_ATTR_IDX(MAIN_SCP_IDX))) {
         ML_SH_IDX(0)   = sh_tbl_idx;  /* SH table not needed.  */
         assign_new_idxs(TRUE);
         ML_SH_IDX(0)   = NULL_IDX;
         sh_tbl_idx     = NULL_IDX;
      }
      else {
         assign_new_idxs(TRUE);
      }

      /* Do table compression, but do not update the attribute entries in the */
      /* attr_list_tbl.  Stop updating from happening, by passing the last    */
      /* used index in attr_list_tbl.  compress_tbls goes through the attr    */
      /* list table starting at the entry past the entry passed in.           */

      num_module_derived_types  = 0;  /* Not used - clear to prevent overflow */
      count_derived_types       = FALSE;
      compress_tbls(attr_list_tbl_idx, FALSE); 

      /* module_attr_idx may have been moved during compression. */

      module_attr_idx           = ML_AT_IDX(module_attr_idx);

      /* Certain flds in the attr table need to be cleared, such as line      */
      /* numbers cif ids, the referenced flag ect..                           */
      /* Also, if alternate entries, reset ATP_FIRST_SH_IDX to the main       */
      /* entry's ATP_FIRST                                                    */

      set_attr_flds_for_output();

      /* Any bounds table free list is destroyed. */

      BD_NEXT_FREE_NTRY(BD_FREE_LIST_IDX)       = NULL_IDX;

      /* Set ATP_SCP_ALIVE for the module attr, so that it can be recognized  */
      /* when the module is read in again.  ATP_SCP_ALIVE is turned off for   */
      /* everything after the semantic pass in s_driver.                      */

      ATP_SCP_ALIVE(module_attr_idx)    = TRUE;

      for (sb_idx       = 1; sb_idx <= stor_blk_tbl_idx; sb_idx++) {
         SB_CIF_SYMBOL_ID(sb_idx)    = NULL_IDX;
      }
   }

   /* Note on table sizes.  tbl_idx is the last used item in the table.       */
   /* The 0th entry should not be written out to the module info table,       */
   /* so using tbl_idx as the size of the table to write out is correct.      */
   /* That is also why when the tables are written they start at [1].         */

   MD_TBL_TYPE(Attr_Tbl)        = Attr_Tbl;
   MD_NUM_ENTRIES(Attr_Tbl)     = attr_tbl_idx;
   MD_TBL_TYPE(Bounds_Tbl)      = Bounds_Tbl;
   MD_NUM_ENTRIES(Bounds_Tbl)   = bounds_tbl_idx;
   MD_TBL_TYPE(Const_Tbl)       = Const_Tbl;
   MD_NUM_ENTRIES(Const_Tbl)    = const_tbl_idx;
   MD_TBL_TYPE(Const_Pool)      = Const_Pool;
   MD_NUM_ENTRIES(Const_Pool)   = const_pool_idx;
   MD_TBL_TYPE(Ir_Tbl)          = Ir_Tbl;
   MD_NUM_ENTRIES(Ir_Tbl)       = ir_tbl_idx;
   MD_TBL_TYPE(Ir_List_Tbl)     = Ir_List_Tbl;
   MD_NUM_ENTRIES(Ir_List_Tbl)  = ir_list_tbl_idx;
   MD_TBL_TYPE(Loc_Name_Tbl)    = Loc_Name_Tbl;
   MD_NUM_ENTRIES(Loc_Name_Tbl) = loc_name_tbl_idx;
   MD_TBL_TYPE(Name_Pool)       = Name_Pool;
   MD_NUM_ENTRIES(Name_Pool)    = name_pool_idx;
   MD_TBL_TYPE(Sec_Name_Tbl)    = Sec_Name_Tbl;
   MD_NUM_ENTRIES(Sec_Name_Tbl) = sec_name_tbl_idx;
   MD_TBL_TYPE(Stor_Blk_Tbl)    = Stor_Blk_Tbl;
   MD_NUM_ENTRIES(Stor_Blk_Tbl) = stor_blk_tbl_idx;
   MD_TBL_TYPE(Type_Tbl)        = Type_Tbl;
   MD_NUM_ENTRIES(Type_Tbl)     = type_tbl_idx;
   MD_TBL_TYPE(Sh_Tbl)          = Sh_Tbl;
   MD_NUM_ENTRIES(Sh_Tbl)       = sh_tbl_idx;

   MD_PDT_HDR_LEN               = (attr_tbl_idx * NUM_AT_WDS) +
                                  (bounds_tbl_idx * NUM_BD_WDS) +
                                  (const_tbl_idx * NUM_CN_WDS) +
                                  (const_pool_idx * NUM_CP_WDS) +
                                  (ir_list_tbl_idx * NUM_IL_WDS) +
                                  (ir_tbl_idx * NUM_IR_WDS) +
                                  (loc_name_tbl_idx * NUM_LN_WDS) +
                                  (name_pool_idx * NUM_NP_WDS) +
                                  (sec_name_tbl_idx * NUM_SN_WDS) +
                                  (stor_blk_tbl_idx * NUM_SB_WDS) +
                                  (type_tbl_idx * NUM_TYP_WDS) +
                                  (sh_tbl_idx * NUM_SH_WDS) +
                                  (MD_TBL_BYTE_SIZE/TARGET_BYTES_PER_WORD) +
                                  ((sizeof(mit_descriptor_type) / 
                                      TARGET_BYTES_PER_WORD) * Num_Of_Tbls);

/* KAY */

   /* PDT size must be in 64 bit increment sizes. */

# if defined(_HOST32) && defined(_TARGET64)
   MD_PDT_HDR_LEN = (MD_PDT_HDR_LEN + 1) / 2;
# endif

   fwrite(&mit_header, sizeof(mit_header_type), 1, mod_file_ptr);

   fwrite(&mit_descriptor[1], 
          sizeof(mit_descriptor_type),
          Num_Of_Tbls,
          mod_file_ptr);

   OUTPUT_TBL_TO_MODULE(mod_file_ptr, module_attr_idx, name_pool);
   OUTPUT_TBL_TO_MODULE(mod_file_ptr, module_attr_idx, loc_name_tbl);
   OUTPUT_TBL_TO_MODULE(mod_file_ptr, module_attr_idx, attr_tbl);
   OUTPUT_TBL_TO_MODULE(mod_file_ptr, module_attr_idx, bounds_tbl);
   OUTPUT_TBL_TO_MODULE(mod_file_ptr, module_attr_idx, const_tbl);
   OUTPUT_TBL_TO_MODULE(mod_file_ptr, module_attr_idx, const_pool);
   OUTPUT_TBL_TO_MODULE(mod_file_ptr, module_attr_idx, sec_name_tbl);
   OUTPUT_TBL_TO_MODULE(mod_file_ptr, module_attr_idx, stor_blk_tbl);
   OUTPUT_TBL_TO_MODULE(mod_file_ptr, module_attr_idx, type_tbl);
   OUTPUT_TBL_TO_MODULE(mod_file_ptr, module_attr_idx, ir_tbl);
   OUTPUT_TBL_TO_MODULE(mod_file_ptr, module_attr_idx, ir_list_tbl);
   OUTPUT_TBL_TO_MODULE(mod_file_ptr, module_attr_idx, sh_tbl);

   fflush(mod_file_ptr);
   fclose(mod_file_ptr);

   const_tbl_idx++;  /* Adjust so it is set to next available index */

EXIT:

   TBL_FREE(mod_link_tbl);

   TRACE (Func_Exit, "output_mod_info_file", NULL);

   return;

}  /* output_mod_info_file */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/
void    use_stmt_semantics(void)
                                
{
   int           al_idx;
   int           attr_idx;
   int           attr_list_free_list;
   int           bd_idx;
   int           host_attr_idx;
   int           host_name_idx;
   int           interface_list;
   int           ln_idx;  
   int           match;
   int           module_attr_idx;
   int           module_list_idx;
   int           name_idx;
   int           new_name_idx;
   int           new_sn_idx;
   int           save_attr_list_tbl_idx;
   int           srch_attr_idx;
   int           start_ln_idx;
   boolean       use_only;
   int           use_ir_idx;
   int           ro_idx;
   boolean       error_break=0;

   TRACE (Func_Entry, "use_stmt_semantics", NULL);

   /* global flag used to tell set_mod_link_tbl_for_attr */
   /* that it should check all attrs for duplicates.     */
   /* This refers to search_for_duplicate_attrs          */

   list_of_modules_in_module    = NULL_IDX;
   module_list_idx              = SCP_USED_MODULE_LIST(curr_scp_idx);
   attr_list_free_list          = AL_NEXT_IDX(NULL_IDX);
   interface_list               = NULL_IDX;

   keep_module_procs = (opt_flags.inline_lvl > Inline_Lvl_0) ||
                        ATP_MAY_INLINE(SCP_ATTR_IDX(MAIN_SCP_IDX));

   /* Find the last module on the list.  This is really the first module   */
   /* specified on a USE list.  This way we get the ordering correct, plus */
   /* since we are backing up the list and the list is extended at the     */
   /* bottom, we don't end up trying to process the newly added indirectly */
   /* referenced modules.  The list is extended in resolve_used_modules.   */
   /* All modules that are indirectly brought in during USE association    */
   /* are added to this list.  This helps get messages issued correctly    */
   /* and keeps CIF happy.  See resolve_used_modules for more details.     */
   /* All the modules specified on the USE statement are specifed on this  */
   /* list first, because these are the attr indexes we want to use.       */

   while (AL_NEXT_IDX(module_list_idx) != NULL_IDX) {
      module_list_idx   = AL_NEXT_IDX(module_list_idx);
   }

   while (module_list_idx != NULL_IDX) {
      error_break=0;  
      module_attr_idx                   = AL_ATTR_IDX(module_list_idx);
      only_update_new_tbl_entries       = TRUE;

      /* For next iteration */

      module_list_idx   = AL_PREV_MODULE_IDX(module_list_idx); 

      if (ATP_IMPLICIT_USE_MODULE(module_attr_idx)) {

         /* Need to generate the Use_Opr - Have a curr_stmt_sh - use it */

        /* Generate IR for this USE statement.  Need to keep the attr so that */
        /* it can be passed thru the PDGCS interface during IR conversion.    */
        /* Do not need pass2 semantics for this statement.                    */

        NTR_IR_TBL(use_ir_idx);
        IR_OPR(use_ir_idx)              = Use_Opr;
        IR_TYPE_IDX(use_ir_idx)         = TYPELESS_DEFAULT_TYPE;
        IR_LINE_NUM(use_ir_idx)         = stmt_start_line;
        IR_COL_NUM(use_ir_idx)          = stmt_start_col;
        IR_IDX_L(use_ir_idx)            = module_attr_idx;
        IR_FLD_L(use_ir_idx)            = AT_Tbl_Idx;
        IR_LINE_NUM_L(use_ir_idx)       = stmt_start_line;
        IR_COL_NUM_L(use_ir_idx)        = stmt_start_col;

        gen_sh(Before,
               Use_Stmt,
               stmt_start_line,
               stmt_start_col,
               FALSE,
               FALSE,
               TRUE); /* Compiler gen'd */

        SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx))    = TRUE;
        SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))        = use_ir_idx;
      }

      if (on_off_flags.issue_ansi_messages ||
          GET_MESSAGE_TBL(message_warning_tbl, 953) ||
          GET_MESSAGE_TBL(message_error_tbl, 953)) {

         /* Non standard to let a module have the same name as a local */
         /* entity in a parent scope.  Don't issue if the entity in    */
         /* parent scope is a module.  This means we are using the     */
         /* module in several scopes and is legal and standard.        */

         srch_attr_idx = srch_host_sym_tbl(AT_OBJ_NAME_PTR(module_attr_idx),
                                           AT_NAME_LEN(module_attr_idx),
                                           &name_idx,
                                           FALSE);

         if (srch_attr_idx !=