/*
 * Copyright (C) 2007, 2008. PathScale, LLC. All Rights Reserved.
 */
/*
 *  Copyright (C) 2006. QLogic Corporation. All Rights Reserved.
 */

/*
 * Copyright 2004, 2005, 2006 PathScale, Inc.  All Rights Reserved.
 */

/*

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

   Path64 is free software; you can redistribute it and/or modify it
   under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2, or (at your option)
   any later version.

   Path64 is distributed in the hope that it will be useful, but WITHOUT
   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
   License for more details.

   You should have received a copy of the GNU General Public License
   along with Path64; see the file COPYING.  If not, write to the Free
   Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
   02110-1301, USA.

   Special thanks goes to SGI for their continued support to open source

*/



static char USMID[] = "\n@(#)5.0_pl/sources/debug.c	5.17	10/14/99 12:53:57\n";

#include <stdint.h>
# 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 "s_utils.m"
# include "globals.h"
# include "tokens.h"
# include "sytb.h"
# include "p_globals.h"
# include "debug.h"

static void build_fake_token	(char *);
static void chain_thru_sn_ntries(FILE *, int, boolean);
static void dump_al_ntry	(FILE *, int);
static void dump_at_ntry	(FILE *, int, boolean);
static void dump_blk_ntry	(FILE *, int);
static void dump_bd_ntry	(FILE *, int);
static void dump_cn_ntry        (FILE *, int);
static void dump_dv		(FILE *, int_dope_type *, boolean);
static void dump_ga_ntry	(FILE *, int);
static void dump_gb_ntry	(FILE *, int);
static void dump_gl_ntry	(FILE *, int);
static void dump_gn_ntry	(FILE *, int);
static void dump_gt_ntry	(FILE *, int);
static void dump_hn_ntry	(FILE *, int, boolean);
static void dump_il_ntry        (FILE *, int);
static void dump_ir_ntry        (FILE *, int, int);
static void dump_ln_ntry	(FILE *, int, boolean);
static void dump_fp_ntry	(FILE *, int, boolean);
static void dump_ml_ntry	(FILE *, int);
static void dump_ro_ntry	(FILE *, int);
static void dump_sb_ntry	(FILE *, int);
static void dump_scp_ntry	(FILE *, int, int, boolean, boolean);
static void dump_sn_ntry	(FILE *, int);
static void dump_eq_ntry	(FILE *, int);
static void dump_stmt_ntry	(FILE *, boolean);
static void dump_typ_ntry	(FILE *, int);
static void dump_trace_info     (FILE *, trace_type, char *, char *); 
static void loop_thru_sn_ntries (FILE *, int, boolean);
static void print_all_text      (boolean);
static char *print_at_name	(int);
static void print_attr_name     (FILE *, int, int);
static void print_const_entry   (FILE *, int, int);
static void print_list          (FILE *, int, int, int, boolean);
#ifdef KEY /* Bug 6845 */
static void print_Dv_Whole_Def_Opr          (FILE *, int, int, int, int);
#else /* KEY Bug 6845 */
static void print_Dv_Whole_Def_Opr          (FILE *, int, int, int);
#endif /* KEY Bug 6845 */
static void print_mp_dir_opr          (FILE *, int, int, int);
static void print_open_mp_dir_opr(FILE *, int, int, int);
static void print_expanded_stmt_for_scp(void);
static void print_expanded_ir	(int);
static void print_expanded_il	(int);
static void print_expanded_opnd	(opnd_type);
static void print_expanded_const(int);
static void print_fld_idx	(FILE *, char *, fld_type,int);
static char *print_global_type_f(int);
static void print_tbl_header	(char *);
static void dump_io_type_code_ntry(FILE *, long_type *, int);

static boolean	full_debug_dump;

    
/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      If this is a debug compiler, open the debug file to hold output.      *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

FILE * init_debug_file (void)

{
   if (debug_file == NULL) {
      full_debug_dump = TRUE;

      /* Set the name to cft90_dump, if this is called before or during */
      /* command line processing.  Usually this should be filename.l    */

      if (debug_file_name[0] == NULL_CHAR) {
         strcpy(debug_file_name, "cft90_dump");
      }

      debug_file = fopen(debug_file_name, "w");

      if (debug_file == NULL) {
         PRINTMSG(1, 17, Error, 0, debug_file_name);
         exit_compiler(RC_USER_ERROR);
      }
   }

   return(debug_file);

}  /* init_debug_file */

# ifdef _DEBUG


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	The following are routines to print full tables.  They are called     *|
|*	by using the -u commandline option with the table identifier.         *|
|*	The attr table is an exception.  It is called via -u sytb             *|
|*	With a few exceptions, there are no input parameters.  There are      *|
|*	no output parameters and these routines return nothing.               *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/


/******************************************************************************\
|*									      *|
|*	Print bounds table.                                                   *|
|*									      *|
\******************************************************************************/

void print_bd_tbl (void)

{
   int	bd_idx;


   print_tbl_header("Bounds Table");

   bd_idx = 1;

   while (bd_idx < bounds_tbl_idx) {
       dump_bd_ntry(debug_file, bd_idx);
       bd_idx += BD_NTRY_SIZE(bd_idx);
   }

   bd_idx = BD_NEXT_FREE_NTRY(BD_FREE_LIST_IDX);

   while (bd_idx != NULL_IDX) {
      dump_bd_ntry(debug_file, bd_idx);
      bd_idx = BD_NEXT_FREE_NTRY(bd_idx);
   }

   putc ('\n', debug_file);
   fflush(debug_file);
   return;

}  /* print_bd_tbl */


/******************************************************************************\
|*									      *|
|*	Print block stack.                                                    *|
|*									      *|
\******************************************************************************/

void print_blk_tbl (void)

{
   int		blk_idx;


   print_tbl_header("BLOCK STACK");

   for (blk_idx = 1;  blk_idx <= blk_stk_idx;	blk_idx++) {
       dump_blk_ntry(debug_file, blk_idx);
   }

   putc ('\n', debug_file);
   fflush (debug_file);
   return;

}  /* print_blk_tbl */


/******************************************************************************\
|*									      *|
|*	Print constant table                                                  *|
|*									      *|
\******************************************************************************/

void print_cn_tbl (void)

{
   int			cn_idx;	


   print_tbl_header("Constant Table");

   for (cn_idx = 1; cn_idx <= const_tbl_idx; cn_idx++) {
       dump_cn_ntry(debug_file, cn_idx);
   }

   putc ('\n', debug_file);
   fflush (debug_file);
   return;

}  /* print_cn_tbl */
    
/******************************************************************************\
|*									      *|
|*	Print equivalence table                                               *|
|*									      *|
\******************************************************************************/

void print_eq_tbl (void)
{
   int      next_group;
   int      next_item;


   if (SCP_FIRST_EQUIV_GRP(curr_scp_idx) == NULL_IDX) {
      print_tbl_header("Equivalence Table is empty");
   }
   else {
      print_tbl_header("Equivalence Table");

      next_group = SCP_FIRST_EQUIV_GRP(curr_scp_idx);

      while (next_group != NULL_IDX) {
         fprintf(debug_file, "%21s\n", "NEW EQUIVALENCE GROUP");
         next_item = next_group;

         while (next_item != NULL_IDX) {
            dump_eq_ntry(debug_file, next_item);
            next_item = EQ_NEXT_EQUIV_OBJ(next_item);
         }
         next_group = EQ_NEXT_EQUIV_GRP(next_group);
      }
   }

   putc ('\n', debug_file);
   fflush (debug_file);
   return;

}  /* print_eq_tbl */

    
/******************************************************************************\
|*									      *|
|*	Print file path table                                                 *|
|*									      *|
\******************************************************************************/

void print_fp_tbl (void)

{
   int		fp_idx;

   print_tbl_header("File Path Table");

   fprintf(debug_file, "%s\n\n", "Module paths:");

   fp_idx = module_path_idx;

   while (fp_idx != NULL_IDX) {
      dump_fp_ntry(debug_file, fp_idx, TRUE);
      fp_idx = FP_NEXT_FILE_IDX(fp_idx);
   }

#ifdef KEY /* Bug 5089 */
   fprintf(debug_file, "%s\n\n", "Intrinsic module paths:");

   fp_idx = intrinsic_module_path_idx;

   while (fp_idx != NULL_IDX) {
      dump_fp_ntry(debug_file, fp_idx, TRUE);
      fp_idx = FP_NEXT_FILE_IDX(fp_idx);
   }
#endif /* KEY Bug 5089 */

   fprintf(debug_file, "%s\n\n", "Implicit Use Module Paths:");

   fp_idx = cmd_line_flags.implicit_use_idx;

   while (fp_idx != NULL_IDX) {
      dump_fp_ntry(debug_file, fp_idx, TRUE);
      fp_idx = FP_NEXT_FILE_IDX(fp_idx);
   }

   fprintf(debug_file, "%s\n\n", "Inline paths:");

   fp_idx = inline_path_idx;

   while (fp_idx != NULL_IDX) {
      dump_fp_ntry(debug_file, fp_idx, TRUE);
      fp_idx = FP_NEXT_FILE_IDX(fp_idx);
   }

   fprintf(debug_file, "%s\n\n", "Include paths:");

   print_fp_includes();

   putc ('\n', debug_file);
   fflush(debug_file);
   return;

}  /* print_fp_tbl */
    
/******************************************************************************\
|*									      *|
|*	Print global bounds table                                             *|
|*									      *|
\******************************************************************************/

void print_gb_tbl (void)

{
   int	 gb_idx;

   
   print_tbl_header("Global Bounds Table");

   gb_idx	= 1;

   while (gb_idx != NULL_IDX && gb_idx <= global_bounds_tbl_idx) {
      dump_gb_ntry(debug_file, gb_idx);

      if (GB_ARRAY_SIZE(gb_idx) == Constant_Size &&
          GB_ARRAY_CLASS(gb_idx) == Explicit_Shape) {
         gb_idx	+= (GB_RANK(gb_idx) * 2);
      }
      else {
         gb_idx++;
      }
       
   }

   putc ('\n', debug_file);
   fflush (debug_file);
   return;

}  /* print_gb_tbl */

    
/******************************************************************************\
|*									      *|
|*	Print global line table                                               *|
|*									      *|
\******************************************************************************/

void print_gl_tbl (void)

{
   int	 gl_idx;

   
   print_tbl_header("Global Line Table");

   for (gl_idx = 1; gl_idx <= global_line_tbl_idx; gl_idx++) {
       dump_gl_ntry(debug_file, gl_idx);
   }

   fprintf(debug_file,"\n    %-22s= %-10d  %-20s= %-10d\n",
                      "num_prog_unit_err", num_prog_unit_errors,
                      "num_ansi", num_ansi);

   fprintf(debug_file,"    %-22s= %-10d  %-20s= %-10d\n",
                      "num_warnings", num_warnings,
                      "num_cautions", num_cautions);

   fprintf(debug_file,"    %-22s= %-10d  %-20s= %-10d\n",
                      "num_notes", num_notes,
                      "num_comments", num_comments);

   putc ('\n', debug_file);
   fflush (debug_file);
   return;

}  /* print_gl_tbl */

    
/******************************************************************************\
|*									      *|
|*	Print global name table                                               *|
|*									      *|
\******************************************************************************/

void print_gn_tbl (void)

{
   int	 gn_idx;
   int	 gt_idx;

   
   print_tbl_header("Global Name Table");

   for (gn_idx = 2; gn_idx < global_name_tbl_idx; gn_idx++) {
       fprintf(debug_file, "\n****************************************"
                           "****************************************\n");
       dump_gn_ntry(debug_file, gn_idx);
       dump_ga_ntry(debug_file, GN_ATTR_IDX(gn_idx));
   }
   fprintf(debug_file, "\n****************************************"
                       "****************************************\n");

   for (gt_idx = 1; gt_idx <= global_type_tbl_idx; gt_idx++) {

      if (GT_TYPE(gt_idx) == Structure) {
         dump_ga_ntry(debug_file, GT_STRUCT_IDX(gt_idx));
      }
   }

   putc ('\n', debug_file);
   fflush (debug_file);
   return;

}  /* print_gn_tbl */

    
/******************************************************************************\
|*									      *|
|*	Print global type table                                               *|
|*									      *|
\******************************************************************************/

void print_gt_tbl (void)

{
   int	 gt_idx;

   
   print_tbl_header("Global Type Table");

   for (gt_idx = 1; gt_idx <= global_type_tbl_idx; gt_idx++) {
       dump_gt_ntry(debug_file, gt_idx);
   }

   putc ('\n', debug_file);
   fflush (debug_file);
   return;

}  /* print_gt_tbl */
    
/******************************************************************************\
|*									      *|
|*	Print hidden name table                                               *|
|*									      *|
\******************************************************************************/

void print_hn_tbl()

{
   int          hn_idx;


   print_tbl_header("Hidden Name Table");

   for (hn_idx = SCP_HN_FW_IDX(curr_scp_idx) + 1; 
        hn_idx < SCP_HN_LW_IDX(curr_scp_idx); 
        hn_idx++) {
       dump_hn_ntry(debug_file, hn_idx, FALSE);        /* Don't print attrs */
   }

   putc ('\n', debug_file);
   fflush (debug_file);
   return;

}  /* print_hn_tbl */

    
/******************************************************************************\
|*									      *|
|*	Print local name table without attr entries.                          *|
|*									      *|
\******************************************************************************/

void print_ln_tbl()

{
   int          ln_idx;

   print_tbl_header("Local Name Table");

   for (ln_idx = SCP_LN_FW_IDX(curr_scp_idx) + 1; 
        ln_idx < SCP_LN_LW_IDX(curr_scp_idx); 
        ln_idx++) {
       dump_ln_ntry(debug_file, ln_idx, FALSE);        /* Don't print attrs */
   }

   putc ('\n', debug_file);
   fflush (debug_file);
   return;

}  /* print_ln_tbl */

    
/******************************************************************************\
|*									      *|
|*	Print module link table                                               *|
|*									      *|
\******************************************************************************/

void print_ml_tbl()

{
   int          ml_idx;


   print_tbl_header("Module Link Table");

   fprintf(debug_file, 
       "     NOTE:  Only print entries that have at least one nonzero index\n");

   for (ml_idx = 0; ml_idx <= mod_link_tbl_idx; ml_idx++) {

      if (ML_AT_IDX(ml_idx) != NULL_IDX ||
          ML_BD_IDX(ml_idx) != NULL_IDX ||
          ML_CN_IDX(ml_idx) != NULL_IDX ||
          ML_LN_IDX(ml_idx) != NULL_IDX ||
          ML_NP_IDX(ml_idx) != NULL_IDX ||
          ML_SB_IDX(ml_idx) != NULL_IDX ||
          ML_IL_IDX(ml_idx) != NULL_IDX ||
          ML_IR_IDX(ml_idx) != NULL_IDX ||
          ML_CP_IDX(ml_idx) != NULL_IDX ||
          ML_SH_IDX(ml_idx) != NULL_IDX ||
          ML_TYP_IDX(ml_idx) != NULL_IDX ||
          ML_SN_IDX(ml_idx) != NULL_IDX) {
         dump_ml_ntry(debug_file, ml_idx);
      }
   }

   putc ('\n', debug_file);
   fflush (debug_file);
   return;

}  /* print_ml_tbl */

    
/******************************************************************************\
|*									      *|
|*	Print rename only table                                               *|
|*									      *|
\******************************************************************************/

void print_ro_tbl (int ro_start_idx)

{
   int	ro_idx;


   print_tbl_header("Rename Only Table");

   ro_idx = ro_start_idx;

   while (ro_idx != NULL_IDX) {
       dump_ro_ntry(debug_file, ro_idx);
       ro_idx = RO_NEXT_IDX(ro_idx);
   }

   putc ('\n', debug_file);
   fflush(debug_file);
   return;

}  /* print_ro_tbl */

    
/******************************************************************************\
|*									      *|
|*	Print storage block table                                             *|
|*									      *|
\******************************************************************************/

void print_sb_tbl (void)

{
   int	sb_idx;


   print_tbl_header("Storage Block Table");

   for (sb_idx = 1; sb_idx <= stor_blk_tbl_idx; sb_idx++) {
       dump_sb_ntry(debug_file, sb_idx);
   }

   putc ('\n', debug_file);
   fflush(debug_file);
   return;

}  /* print_sb_tbl */

    
/******************************************************************************\
|*									      *|
|*	Print scope table                                                     *|
|*									      *|
\******************************************************************************/

void print_scp_tbl(void)

{
   print_tbl_header("Scope Table");

   dump_scp_ntry(debug_file, 0, 0, FALSE, TRUE);

   putc ('\n', debug_file);
   fflush (debug_file);
   return;

}  /* print_scp_tbl */

    
/******************************************************************************\
|*									      *|
|*	Print statement header table                                          *|
|*									      *|
|*      This procedure is the driver for printing all Statement Headers and   *|
|*      all their IR.  A separate driver is required, like the Semantics Pass *|
|*      driver, because the underlying routine is called recursively and      *|
|*      because we always want to start with the first SCP entry.             *|
|*                                                                            *|
\******************************************************************************/

void  print_sh_tbl (boolean	print_all_scps)

{
   int	save_curr_scp_idx;
   int  save_curr_stmt_sh_idx;


   print_tbl_header("Statement Header Table");

   if (print_all_scps) {
      save_curr_scp_idx     = curr_scp_idx;
      curr_scp_idx          = 1;
      save_curr_stmt_sh_idx = curr_stmt_sh_idx;

      print_all_text(TRUE);

      curr_scp_idx     = save_curr_scp_idx;
      curr_stmt_sh_idx = save_curr_stmt_sh_idx;
   }
   else {
      print_all_text(FALSE);		/* Just print current scope */
   }

   return;

}  /* print_sh_tbl */

    
/******************************************************************************\
|*									      *|
|*	Print type table                                                      *|
|*									      *|
\******************************************************************************/

void print_typ_tbl (void)

{
   int		type_idx;


   print_tbl_header("Type Table");

   for (type_idx = 1; type_idx <= type_tbl_idx; type_idx++) {
      dump_typ_ntry(debug_file, type_idx);
   }

   putc ('\n', debug_file);
   fflush(debug_file);
   return;

}  /* print_typ_tbl */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Print commandline information to debug_file.                          *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void print_cmd_tbl (void)

{
   extern	char	       *directive_str[];
   		int		dir_idx;
		boolean		first;
   		int		fp_idx;
		int		i,j;


   print_tbl_header("Commandline Flags");

   fprintf(debug_file, "  %-17s = %-s\n",
           "   source file", src_file);
   fprintf(debug_file, "  %-17s = %-s\n",
           "-b binary_output", (cmd_line_flags.binary_output)?bin_file:"NONE");
   fprintf(debug_file, "  %-17s= %-s\n",
           "-S assembly_output", (cmd_line_flags.assembly_output) ? 
                                                 assembly_file:"NONE");

   if (include_path_idx == NULL_IDX) {
      fprintf(debug_file, "  %-17s = %-s\n", "-I include paths", "NONE");
   }
   else {
      fprintf(debug_file, "  %-17s\n", "-I include paths");
      print_fp_includes();
   }

   if (module_path_idx == NULL_IDX) {
      fprintf(debug_file, "  %-17s = %-s\n", "-p module paths", "NONE");
   }
   else {
      fprintf(debug_file, "  %-17s\n", "-p module paths");
      fp_idx = module_path_idx;

      while (fp_idx != NULL_IDX) {
         fprintf(debug_file, "%4s%-s\n", " ", FP_NAME_PTR(fp_idx));
         fp_idx = FP_NEXT_FILE_IDX(fp_idx);
      }
   }
#ifdef KEY /* Bug 5089 */
   fprintf(debug_file, "  %-17s\n", "-intrinsic_module_path");
   fprintf(debug_file, "%4s%-s\n", " ", FP_NAME_PTR(intrinsic_module_path_idx));
#endif /* KEY Bug 5089 */
   fprintf(debug_file, "  %-17s = %-2s  %-18s = %-2s  %-18s = %-7s\n",
           "-align8", boolean_str[cmd_line_flags.align8],
           "-align16", boolean_str[cmd_line_flags.align16],
           "-align32", boolean_str[cmd_line_flags.align32]);

   fprintf(debug_file, "  %-17s = %-2s\n",
           "-align64", boolean_str[cmd_line_flags.align64]);

   fprintf(debug_file, "  %-17s = %-2s  %-18s = %-2s  %-18s = %-7s\n",
           "-a dalign", boolean_str[cmd_line_flags.dalign],
           "-a taskcommon", boolean_str[cmd_line_flags.taskcommon],
           "-f ", src_form_str[cmd_line_flags.src_form]);

   fprintf(debug_file, "  %-17s = %-27s  %-18s = %-7s\n",
           "-i ", integer_size_str[cmd_line_flags.integer_32],
           "-k solaris_profile", boolean_str[cmd_line_flags.solaris_profile]);

   fprintf(debug_file, "  %-17s = %-27s  %-18s = %-7s\n",
           "-m ", msg_lvl_str[cmd_line_flags.msg_lvl_suppressed],
           "-s float64", boolean_str[cmd_line_flags.s_float64]);

   fprintf(debug_file, "  %-17s = %-2s  %-18s = %-2s  %-18s = %-7s\n",
           "-s default64", boolean_str[cmd_line_flags.s_default64],
           "-s default32", boolean_str[cmd_line_flags.s_default32],
           "-s cf77types", boolean_str[cmd_line_flags.s_cf77types]);

   fprintf(debug_file, "  %-17s = %-2s  %-18s = %-2s  %-18s = %-7s\n",
           "-s integer8", boolean_str[cmd_line_flags.s_integer8],
           "-s logical8", boolean_str[cmd_line_flags.s_logical8],
           "-s real8", boolean_str[cmd_line_flags.s_real8]);


   fprintf(debug_file, "  %-17s = %-2s  %-18s = %-2s  %-18s = %-7s\n",
           "-s complex8", boolean_str[cmd_line_flags.s_complex8],
           "-s pointer8", boolean_str[cmd_line_flags.s_pointer8],
           "-s doublecomplex16", boolean_str[cmd_line_flags.s_doublecomplex16]);

   fprintf(debug_file, "  %-42s = %-2s\n",
           "-s doubleprecision16",
                     boolean_str[cmd_line_flags.s_doubleprecision16]);

   fprintf(debug_file, "  %-17s = %-2s  %-18s = %-s\n",
	   "-t truncate_bits", boolean_str[cmd_line_flags.truncate_bits],
           "-G ", debug_lvl_str[cmd_line_flags.debug_lvl]);

   fprintf(debug_file, "  %-17s = ", "-N line_size");

   if (cmd_line_flags.line_size_80) {
      fprintf(debug_file, "%-7d\n", 80);
   }
   else if (cmd_line_flags.line_size_132) {
      fprintf(debug_file, "%-7d\n", 132);
   }
   else {
      fprintf(debug_file, "%-7d\n", 72);
   }

   fprintf(debug_file, "  %-17s = %-2s  %-18s = %-2s  %-18s = %-7s\n",
           "-Ps small pic", boolean_str[(cmd_line_flags.small_pic_model)],
           "-Pl large pic", boolean_str[(cmd_line_flags.large_pic_model)],
           "-R a", boolean_str[cmd_line_flags.runtime_argument]);

   fprintf(debug_file, "  %-17s = %-2s  %-18s = %-2s  %-18s = %-7s\n",
           "-R b", boolean_str[cmd_line_flags.runtime_bounds],
           "-R c", boolean_str[cmd_line_flags.runtime_conformance],
           "-R C", boolean_str[cmd_line_flags.runtime_arg_call]);

   fprintf(debug_file, "  %-17s = %-2s  %-18s = %-2s  %-18s = %-7s\n",
           "-R E", boolean_str[cmd_line_flags.runtime_arg_entry],
           "-R s", boolean_str[cmd_line_flags.runtime_substring],
           "-R n", boolean_str[cmd_line_flags.runtime_arg_count_only]);

   fprintf(debug_file, "  %-17s = %-2s  %-18s = %-2s  %-18s = %-d\n",
           "-V verify_option", boolean_str[(cmd_line_flags.verify_option)],
           "-X m", boolean_str[(cmd_line_flags.malleable)],
           "-X npes", cmd_line_flags.MPP_num_pes);


   fprintf(debug_file, "\n%s On/Off Flags  (-e/-d)%s\n\n",
                       "  -------------------------- ",
                       "  -------------------------- ");

   fprintf(debug_file, "  %-26s = %-2s    %-26s = %-2s\n",
                       "a  abort_if_any_errors",
			  boolean_str[on_off_flags.abort_if_any_errors],
                       "e  ieee",
			  boolean_str[on_off_flags.ieee]);
   fprintf(debug_file, "  %-26s = %-2s    %-26s = %-2s\n",
                       "f  flowtrace_option",
			  boolean_str[on_off_flags.flowtrace_option],
                       "g  assembly_listing_file",
			  boolean_str[on_off_flags.assembly_listing_file]);
   fprintf(debug_file, "  %-26s = %-2s    %-26s = %-2s\n",
                       "i  indef_init",
			  boolean_str[on_off_flags.indef_init],
                       "j  exec_doloops_once",
			  boolean_str[on_off_flags.exec_doloops_once]);
   fprintf(debug_file, "  %-26s = %-2s    %-26s = %-2s\n",
                       "n  issue_ansi_messages",
			  boolean_str[on_off_flags.issue_ansi_messages],
                       "p  enable_double_precision",
			  boolean_str[on_off_flags.enable_double_precision]);
   fprintf(debug_file, "  %-26s = %-2s    %-26s = %-2s\n",
                       "q  abort_on_100_errors",
			  boolean_str[on_off_flags.abort_on_100_errors],
                       "r  round_mult_operations",
			  boolean_str[on_off_flags.round_mult_operations]);
   fprintf(debug_file, "  %-26s = %-2s    %-26s = %-2s\n",
                       "t  alloc_autos_on_stack",
			  boolean_str[on_off_flags.alloc_autos_on_stack],
                       "u  round_integer_divide",
			  boolean_str[on_off_flags.round_integer_divide]);
   fprintf(debug_file, "  %-26s = %-2s    %-26s = %-2s\n",
                       "u  reciprical_divide",
			  boolean_str[on_off_flags.reciprical_divide],
                       "v  save_all_vars",
			  boolean_str[on_off_flags.save_all_vars]);
   fprintf(debug_file, "  %-26s = %-2s    %-26s = %-2s\n",
                       "x  allow_leading_uscore",
			  boolean_str[on_off_flags.allow_leading_uscore],
                       "A  MPP_apprentice",
			  boolean_str[on_off_flags.MPP_apprentice]);
   fprintf(debug_file, "  %-26s = %-2s    %-26s = %-2s\n",
                       "B  binary_output",
			  boolean_str[on_off_flags.binary_output],
                       "C  shared_to_private_coer",
			  boolean_str[on_off_flags.shared_to_private_coer]);
   fprintf(debug_file, "  %-26s = %-2s    %-26s = %-2s\n",
                       "I  implicit_none",
			  boolean_str[on_off_flags.implicit_none],
                       "P  preprocess_only",
			  boolean_str[on_off_flags.preprocess_only]);
   fprintf(debug_file, "  %-26s = %-2s    %-26s = %-2s\n",
                       "Q  allow_leading_uscore",
			  boolean_str[on_off_flags.allow_leading_uscore],
                       "R  recursive",
			  boolean_str[on_off_flags.recursive]);
   fprintf(debug_file, "  %-26s = %-2s    %-26s = %-2s\n",
                       "S  assembly_output",
			  boolean_str[on_off_flags.assembly_output],
                       "U  upper_case_names",
			  boolean_str[on_off_flags.upper_case_names]);
   fprintf(debug_file, "  %-26s = %-2s    %-26s = %-2s\n",
                       "X  atexpert",
			  boolean_str[on_off_flags.atexpert],
                       "Z  save_dot_i",
			  boolean_str[on_off_flags.save_dot_i]);

   fprintf(debug_file, "\n%s Optimization Flags (-O)%s\n\n",
                       "  ------------------------- ",
                       "  ------------------------- ");

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s\n",
                       "aggress", boolean_str[opt_flags.aggress],
                       "bottom_load", boolean_str[opt_flags.bottom_load]);

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s  %-18s = %-2d\n",
                       "fusion", boolean_str[opt_flags.fusion],
                       "ieeeconform", boolean_str[opt_flags.ieeeconform],
                       "inline_lvl", opt_flags.inline_lvl);

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s  %-18s = %-2s\n",
                       "jump", boolean_str[opt_flags.jump],
                       "loopalign", boolean_str[opt_flags.loopalign],
                       "mark", boolean_str[opt_flags.mark]);

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s  %-18s = %-2s\n",
                       "modinline", boolean_str[opt_flags.modinline],
                       "msgs", boolean_str[opt_flags.msgs],
                       "neg_msgs", boolean_str[opt_flags.neg_msgs]);

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s  %-18s = %-2s\n",
                       "nointerchange", boolean_str[opt_flags.nointerchange],
                       "overindex", boolean_str[opt_flags.over_index],
                       "pattern", boolean_str[opt_flags.pattern]);

   fprintf(debug_file, "  %-17s = %-2d\n",
                       "pipeline", opt_flags.pipeline_lvl);

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2d  %-18s = %-2d\n",
                       "recurrence", boolean_str[opt_flags.recurrence],
                       "scalar", opt_flags.scalar_lvl,
                       "split", opt_flags.split_lvl);

   fprintf(debug_file, "  %-17s = %-2d   %-18s = %-2d  %-18s = %-2s\n",
                       "support_lvl", opt_flags.support_lvl,
                       "task", opt_flags.task_lvl,
                       "taskinner", boolean_str[opt_flags.taskinner]);

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s  %-18s = %-2d\n",
                       "threshold", boolean_str[opt_flags.threshold],
                       "vsearch", boolean_str[opt_flags.vsearch],
                       "unroll", opt_flags.unroll_lvl);

   fprintf(debug_file, "  %-17s = %-2d   %-18s = %-2s  %-18s = %-2s\n",
                       "vector", opt_flags.vector_lvl,
                       "vsearch", boolean_str[opt_flags.vsearch],
                       "zeroinc", boolean_str[opt_flags.zeroinc]);


   fprintf(debug_file, "\n%s Disregard Flags  (-x)%s\n\n",
                       "  -------------------------- ",
                       "  -------------------------- ");

   fprintf(debug_file, " ");

   /* 0 is Tok_Dir_Start - so skip it. */

   for (dir_idx = 1; (dir_idx < (Tok_Dir_End - Tok_Dir_Start -1)); dir_idx++) {
      fprintf(debug_file, "%-20s = %-2s ", directive_str[dir_idx], 
                          boolean_str[disregard_directive[dir_idx]]);

      if ((dir_idx%3) == 0) {
         fprintf(debug_file, "\n ");
      }
   }

   fprintf(debug_file, "\n\n%s Dump Flags (-u)%s\n\n",
                       "  ----------------------------- ",
                       "  ----------------------------- ");

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s  %-18s = %-2s\n",
                     "abort_ansi", boolean_str[dump_flags.abort_on_ansi],
                     "no_dim_pad", boolean_str[dump_flags.no_dimension_padding],
                     "no_mod_output", boolean_str[dump_flags.no_module_output]);

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s\n",
                     "bd", boolean_str[dump_flags.bd_tbl],
                     "blk", boolean_str[dump_flags.blk_stk]);

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s  %-18s = %-2s\n",
                       "cmd", boolean_str[dump_flags.cmd_line_tbls],
                       "cn", boolean_str[dump_flags.cn_tbl],
                       "defines", boolean_str[dump_flags.defines]);

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s  %-18s = %-2s\n",
                       "fortran", boolean_str[dump_flags.fort_out],
                       "fp", boolean_str[dump_flags.fp_tbl],
                       "ftrace", boolean_str[dump_flags.ftrace_info]);

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s  %-18s = %-2s\n",
                       "gl", boolean_str[dump_flags.gl_tbl],
                       "intrin", boolean_str[dump_flags.intrin_tbl],
                       "ir1", boolean_str[dump_flags.ir1_tbl]);

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s  %-18s = %-2s\n",
                       "ir2", boolean_str[dump_flags.ir2_tbl],
                       "ir3", boolean_str[dump_flags.ir3_tbl],
                       "ir4", boolean_str[dump_flags.ir4_tbl]);

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s  %-18s = %-2s\n",
                       "mem_report", boolean_str[dump_flags.mem_report],
                       "mtrace", boolean_str[dump_flags.mtrace_info],
                       "names", boolean_str[dump_flags.name_tbls]);

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s  %-18s = %-2s\n",
                       "pdg", boolean_str[dump_flags.pdgcs],
                       "pdt", boolean_str[dump_flags.pdt_dump],
                       "sb", boolean_str[dump_flags.sb_tbl]);

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s  %-18s = %-2s\n",
                       "scp", boolean_str[dump_flags.scp_tbl],
                       "src", boolean_str[dump_flags.src_dmp],
                       "stderr", boolean_str[dump_flags.std_err]);

   fprintf(debug_file, "  %-17s = %-2s   %-18s = %-2s  %-18s = %-2s\n",
                       "stmt", boolean_str[dump_flags.stmt_dmp],
                       "sytb", boolean_str[dump_flags.sytb],
                       "typ", boolean_str[dump_flags.typ_tbl]);

   fprintf(debug_file, "\n\n%s Message Options %s \n\n",
                       "  ----------------------------- ",
                       "  ----------------------------- ");

   first	= TRUE;

   for (i = 0;  i < MAX_MSG_SIZE;  ++i) {

      if (message_suppress_tbl[i] != 0) {

         for (j = i * HOST_BITS_PER_WORD; j < (i+1) * HOST_BITS_PER_WORD; ++j) {

            if (GET_MESSAGE_TBL(message_suppress_tbl, j)) {

               if (!first) {
                  first = FALSE;
                  fprintf(debug_file, ",");
               }
               fprintf(debug_file, "  %d", j);
            }
         }
      }

      if (message_warning_tbl[i] != 0) {

         for (j = i * HOST_BITS_PER_WORD; j < (i+1) * HOST_BITS_PER_WORD; ++j) {

            if (GET_MESSAGE_TBL(message_warning_tbl, j)) {

               if (!first) {
                  first = FALSE;
                  fprintf(debug_file, ",");
               }
               fprintf(debug_file, "  W%d", j);
            }
         }
      }

      if (message_error_tbl[i] != 0) {

         for (j = i * HOST_BITS_PER_WORD; j < (i+1) * HOST_BITS_PER_WORD; ++j) {

            if (GET_MESSAGE_TBL(message_error_tbl, j)) {

               if (!first) {
                  first = FALSE;
                  fprintf(debug_file, ",");
               }
               fprintf(debug_file, "  E%d", j);
            }
         }
      }
   }

   putc ('\n', debug_file);

   putc ('\n', debug_file);
   fflush (debug_file);
   return;

}  /* print_cmd_tbl */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Using the scope table to find the start and stop of the local name    *|
|*	table, print all the local name entries each scope.  Use dump_ln_ntry *|
|*	and have it print all the complete attr entries for each local name.  *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void print_sytb (int		scp_idx,
		 boolean	print_all_scps,
		 boolean	dump_all)

{
   int	al_idx;
   char header[60];
   int	ln_idx;
   int	save_scp_idx;


PROCESS_SIBLING:

   if (scp_idx == INTRINSIC_SCP_IDX) {  /* Intrinsic scope */
      print_tbl_header("Intrinsic Symbol Table Dump");
   }
   else if (SCP_ATTR_IDX(scp_idx) != NULL_IDX) {
      header[0] = '\0';
      strcat(header, AT_OBJ_NAME_PTR(SCP_ATTR_IDX(scp_idx)));
      print_tbl_header(strcat(header, " Symbol Table Dump"));
   }
   else {
      print_tbl_header("Unnamed Symbol Table Dump");
   }

   for (ln_idx = SCP_LN_FW_IDX(scp_idx)+1; ln_idx < SCP_LN_LW_IDX(scp_idx);
                                                    ln_idx++) {
      fprintf(debug_file, "****************************************"
                          "****************************************\n");
      dump_ln_ntry(debug_file, ln_idx, dump_all);
   }

   al_idx = SCP_ATTR_LIST(scp_idx);

   while (al_idx != NULL_IDX) {
      fprintf(debug_file, "****************************************"
                          "****************************************\n");
      dump_at_ntry(debug_file, AL_ATTR_IDX(al_idx), dump_all);
      al_idx = AL_NEXT_IDX(al_idx);
   }

   fprintf(debug_file, "****************************************"
                       "****************************************\n");

   if (print_all_scps) {

      if (SCP_FIRST_CHILD_IDX(scp_idx) != NULL_IDX) {
         save_scp_idx	= scp_idx;
         scp_idx	= SCP_FIRST_CHILD_IDX(scp_idx);
         print_sytb(scp_idx, TRUE, TRUE);
         scp_idx	= save_scp_idx;
      }

      if (SCP_SIBLING_IDX(scp_idx) != NULL_IDX) {
         scp_idx	= SCP_SIBLING_IDX(scp_idx);
         goto PROCESS_SIBLING;
      }
   }

   return;

}  /* print_sytb */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints the compressed table.                                          *|
|*									      *|
|* Input parameters:							      *|
|*      loc name tbl index to start.                                          *|
|*	loc name tbl index for end.                                           *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/
void print_compressed_sytb(int	ln_start,
			   int	ln_end)
{
   int		ln_idx;

   print_tbl_header("Compressed Symbol Table");

   for (ln_idx = ln_start; ln_idx <= ln_end; ln_idx++) {
      dump_ln_ntry(debug_file, ln_idx, TRUE);  /* Print the attr too */
   }

   putc ('\n', debug_file);
   fflush (debug_file);

   return;

}  /* print_compressed_sytb */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	The following set of utilities dump one entry to stderr.  There is    *|
|*	one for each table.  Input is the table index to print.   These are   *|
|*	external routines so they may be called from the debugger or inserted *|
|*	in code as 'print' statements.                                        *|
|*									      *|
|* Input parameters:							      *|
|*	Index of table entry to print.					      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

/******************************************************************************\
|*									      *|
|* Attribute list table							      *|
|*									      *|
\******************************************************************************/

void	print_al (int	al_idx)

{
   if (al_idx <= attr_list_tbl_idx) {
      dump_al_ntry(stderr, al_idx);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid Attribute List Table index.\n");
   }

   return;

}  /* print_al */

/******************************************************************************\
|*									      *|
|* Attribute Table  							      *|
|*									      *|
\******************************************************************************/

void	print_at(int		at_idx)

{

   if (at_idx <= attr_tbl_idx) {
      dump_at_ntry(stderr, at_idx, FALSE);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid Attribute Table index.\n");
   }

   return;

}  /* print_at */

#ifdef KEY
/******************************************************************************\
|* Like print_at_all, but for entire table                                    *|
|* If "file" is null, use ".l" file                                           *|
\******************************************************************************/
void	print_at_table(FILE *file)
{
   init_debug_file();
   dump_trace_info (debug_file, PU_Start, NULL, "print_at_all");
   for (int i = 0; i < attr_tbl_idx; i += 1) {
      dump_at_ntry(debug_file, i, TRUE);
   }
}
#endif /* KEY */

/******************************************************************************\
|*									      *|
|* Attribute Table  							      *|
|*									      *|
\******************************************************************************/

void	print_at_all(int		at_idx)

{
   if (at_idx <= attr_tbl_idx) {
      dump_at_ntry(stderr, at_idx, TRUE);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid Attribute Table index.\n");
   }

   return;
}  /* print_at_all */

/******************************************************************************\
|*									      *|
|* Bounds table 							      *|
|*									      *|
\******************************************************************************/

void print_bd (int	bd_idx)

{
   if (bd_idx <= bounds_tbl_idx) {
      dump_bd_ntry(stderr, bd_idx);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid bounds table index.\n");
   }

   return;

}  /* print_bd */

/******************************************************************************\
|*									      *|
|* Block stack					          		      *|
|*									      *|
\******************************************************************************/

void	print_blk (int	blk_idx)

{
   if (blk_idx <= blk_stk_idx) {
      dump_blk_ntry(stderr, blk_idx);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid block stack index.\n");
   }

   return;

}  /* print_blk */

/******************************************************************************\
|*									      *|
|* Constant table							      *|
|*									      *|
\******************************************************************************/

void	print_cn (int	cn_idx)

{
   if (cn_idx <= const_tbl_idx) {
      dump_cn_ntry(stderr, cn_idx);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid constant table index.\n");
   }

   return;

}  /* print_cn */

/******************************************************************************\
|*                                                                            *|
|* Equivalence Table							      *|
|*                                                                            *|
\******************************************************************************/

void	print_eq (int	eq_idx)

{

   if (eq_idx <= equiv_tbl_idx) {
      dump_eq_ntry(stderr, eq_idx);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid equivalence table index.\n");
   }

   return;

}  /* print_eq */

/******************************************************************************\
|*									      *|
|* file path table      			 			      *|
|*									      *|
\******************************************************************************/

void	print_fp (int	fp_idx)

{
   if (fp_idx <= file_path_tbl_idx) {
      dump_fp_ntry(stderr, fp_idx, FALSE);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid file path table index.\n");
   }

   return;

}  /* print_fp */

/******************************************************************************\
|*                                                                            *|
|* Print a single list table entry.                                           *|
|*                                                                            *|
\******************************************************************************/

void	print_il (int	il_idx)

{
   if (il_idx <= ir_list_tbl_idx) {
      dump_il_ntry(stderr, il_idx);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid ir list table index %d.\n", 
                      il_idx);
   }

   return;
} 

/******************************************************************************\
|*                                                                            *|
|* IR tree								      *|
|*                                                                            *|
\******************************************************************************/

void  print_ir (int	ir_idx)

{
   if (ir_idx <= ir_tbl_idx) {
      dump_ir_ntry(stderr, ir_idx, 1);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid ir table index.\n");
   }

   return;

}  /* print_ir */

/******************************************************************************\
|*									      *|
|* Global attr table							      *|
|*									      *|
\******************************************************************************/

void	print_ga (int	ga_idx)

{
   if (ga_idx <= global_attr_tbl_idx) {
      dump_ga_ntry(stderr, ga_idx);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid global attr table index.\n");
   }

   return;

}  /* print_ga */

/******************************************************************************\
|*									      *|
|* Global bounds table							      *|
|*									      *|
\******************************************************************************/

void	print_gb (int	gb_idx)

{
   if (gb_idx <= global_bounds_tbl_idx) {
      dump_gb_ntry(stderr, gb_idx);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid global bounds table index.\n");
   }

   return;

}  /* print_gb */

/******************************************************************************\
|*									      *|
|* Global line table							      *|
|*									      *|
\******************************************************************************/

void	print_gl (int	gl_idx)

{
   if (gl_idx <= global_line_tbl_idx) {
      dump_gl_ntry(stderr, gl_idx);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid global name table index.\n");
   }

   return;

}  /* print_gl */

/******************************************************************************\
|*									      *|
|* Global name table							      *|
|*									      *|
\******************************************************************************/

void	print_gn (int	gn_idx)

{
   if (gn_idx <= global_name_tbl_idx) {
      dump_gn_ntry(stderr, gn_idx);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid global name table index.\n");
   }

   return;

}  /* print_gn */

/******************************************************************************\
|*									      *|
|* Global type table							      *|
|*									      *|
\******************************************************************************/

void	print_gt (int	gt_idx)

{
   if (gt_idx <= global_type_tbl_idx) {
      dump_gt_ntry(stderr, gt_idx);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid global type table index.\n");
   }

   return;

}  /* print_gt */

/******************************************************************************\
|*									      *|
|* Hidden name table							      *|
|*									      *|
\******************************************************************************/

void	print_hn (int	hn_idx)
{

   if (hn_idx <= hidden_name_tbl_idx) {
      dump_hn_ntry(stderr, hn_idx, FALSE);         /* Don't print attrs */
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid hidden name table index.\n");
   }

   return;
     
}  /* print_hn */

/******************************************************************************\
|*									      *|
|* Local name table							      *|
|*									      *|
\******************************************************************************/

void print_ln (int	ln_idx)
{
   if (ln_idx <= loc_name_tbl_idx) {
      dump_ln_ntry(stderr, ln_idx, FALSE);         /* Don't print attrs */
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid local name table index.\n");
   }

   return;
     
}  /* print_ln */

/******************************************************************************\
|*									      *|
|* Local name table							      *|
|*									      *|
\******************************************************************************/

void print_lnr (int	ln_idx,
		int	end_idx)
{
   while (ln_idx <= end_idx) {

      if (ln_idx <= loc_name_tbl_idx) {
         dump_ln_ntry(stderr, ln_idx, FALSE);         /* Don't print attrs */
      }
      else {
         fprintf(stderr, "\n*FE90-ERROR* Invalid local name table index.\n");
      }
      ++ln_idx;
   }

   return;
     
}  /* print_lnr */

/******************************************************************************\
|*									      *|
|* Module link table      			 			      *|
|*									      *|
\******************************************************************************/

void	print_ml (int	ml_idx)

{
   if (ml_idx <= mod_link_tbl_idx) {
      dump_ml_ntry(stderr, ml_idx);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid module link table index.\n");
   }

   return;
     
}  /* print_ml */

/******************************************************************************\
|*									      *|
|* Rename only table      			 			      *|
|*									      *|
\******************************************************************************/

void print_ro (int	ro_idx)

{
   if (ro_idx <= rename_only_tbl_idx) {
      dump_ro_ntry(stderr, ro_idx);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid rename only table index.\n");
   }

   return;

}  /* print_ro */

/******************************************************************************\
|*									      *|
|* Storage Block Table							      *|
|*									      *|
\******************************************************************************/

void	print_sb (int	sb_idx)

{
   if (sb_idx <= stor_blk_tbl_idx) {
      dump_sb_ntry(stderr, sb_idx);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid Storage Block Table index.\n");
   }

   return;

}  /* print_sb */

/******************************************************************************\
|*									      *|
|* Scope table  (print_impl_tbl - if TRUE print implicit table) 	      *|
|*									      *|
\******************************************************************************/

void	print_scp(int		scp_idx,
                  boolean	print_impl_tbl)

{
   if (scp_idx <= scp_tbl_idx) {
      dump_scp_ntry(stderr, scp_idx, 0, print_impl_tbl, FALSE);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid scope table index.\n");
   }

   return;

}  /* print_scp */

/******************************************************************************\
|*                                                                            *|
|*      Print one statement and its IR.                                       *|
|*                                                                            *|
\******************************************************************************/

void  print_sh (int	stmt_idx)

{
   int		save_curr_stmt_sh_idx;


   if (stmt_idx <= sh_tbl_idx) {
      save_curr_stmt_sh_idx = curr_stmt_sh_idx;
      curr_stmt_sh_idx      = stmt_idx;

      dump_stmt_ntry(stderr, TRUE);  /* Print  IR for this statement */

      curr_stmt_sh_idx = save_curr_stmt_sh_idx;
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* Invalid statement header index.\n");
   }

   return;

} /* print_sh */

/******************************************************************************\
|*									      *|
|* Secondary Name Table							      *|
|*									      *|
\******************************************************************************/

void	print_sn (int	sn_idx)

{
   dump_sn_ntry(stderr, sn_idx);

   return;

}  /* print_sn */

/******************************************************************************\
|*									      *|
|* Type table           			 			      *|
|*									      *|
\******************************************************************************/

void print_typ (int	type_idx)

{
   dump_typ_ntry(stderr, type_idx);

   return;

}  /* print_typ */


/******************************************************************************\
|*									      *|
|* Miscellaneous routines and utility routines.			 	      *|
|*									      *|
\******************************************************************************/

/******************************************************************************\
|*                                                                            *|
|* Input parameters:                                                          *|
|*      address of internal dope vector.                                      *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

void print_dv (int_dope_type    *dv,
               boolean          dump_it)

{
   dump_dv(stderr, dv, dump_it);

   return;

}  /* print_dv */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Given the name of a local entity, this procedure prints a single      *|
|*      Local Name Table entry to stderr.   Does not print the attr entry.    *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*                                         				      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void print_ln_by_name (void)      

{
   char		name_string[MAX_ID_LEN + 1];
   int  	ln_tbl_idx;


   printf("Enter LOCAL name->");
#ifdef KEY
   fgets(name_string, MAX_ID_LEN, stdin);
#else /* KEY */
   gets(name_string);
#endif /* KEY */
   build_fake_token(name_string);

   if (srch_sym_tbl(TOKEN_STR(fake_token), TOKEN_LEN(fake_token),
                                           &ln_tbl_idx) != NULL_IDX) {
      dump_ln_ntry(stderr, ln_tbl_idx, FALSE);
   }
   else {
      fprintf(stderr, "\n*FE90-ERROR* No such name in the current scope.");
   }
   return;

}  /* print_ln_by_name */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Given an entity name, this function prints the Attribute entry for    *|
|*      the entity on standard output.                                        *|
|*									      *|
|* Input parameters:							      *|
|*	The entity's name.                                                    *|
|*      NOTE:  This function currently only knows how to dump the attribute   *|
|*             entry for a simple name.  It will need to be upgraded to break *|
|*             down qualified names later.  The declaration for name_string   *|
|*             will have to be expanded, the qualified name will have to be   *|
|*             broken down, and srch_cpnt_name will have to be called to      *|
|*             find the attribute entry for the rightmost component name.     *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void print_at_by_name(void)

{
   int		attr_idx;
   int		ln_tbl_idx;
   char 	name_string[MAX_ID_LEN + 1];
   char		reply;

   printf("Entity name->");
#ifdef KEY
   fgets(name_string, MAX_ID_LEN, stdin);
#else /* KEY */
   gets(name_string);
#endif /* KEY */
   
   /* This is where the code should go to break down a qualified name.       */

   build_fake_token(name_string);
   attr_idx = srch_sym_tbl(TOKEN_STR(fake_token), TOKEN_LEN(fake_token),
                           &ln_tbl_idx);

   if (attr_idx != NULL_IDX) {
      dump_at_ntry(stderr, attr_idx, FALSE);
   }
   else {
      printf( 
           "\n*POSSIBLE FE90-ERROR* No such entity name in the local scope.\n");
      printf("Search host scope? (y) ");
      reply = getchar();

      if (reply == '\n'  ||  reply == 'y') {

         if (reply == 'y') {
            reply = getchar();    /* Get rid of newline char. */
         }
         attr_idx = srch_host_sym_tbl(TOKEN_STR(fake_token), 
                                      TOKEN_LEN(fake_token), 
                                      &ln_tbl_idx,
                                      TRUE);

         if (attr_idx != NULL_IDX) {
            dump_at_ntry(stderr, attr_idx, FALSE);
         }
         else {
            printf("\n*FE90-ERROR* No such entity name in the host either.\n");
         }
      }
      else {
         reply = getchar();       /* Get rid of newline char. */
      }
   }

   return;

}  /* print_at_by_name */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Given a common block or module name, this function prints the Storage *|
|*      Block Table entry for the specified common block or module to stderr. *|
|*									      *|
|* Input parameters:							      *|
|*	The name of the common block or module.                               *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void print_sb_by_name (void)

{
   int   		sb_idx;
   char 		name_string[MAX_ID_LEN + 1];

   printf("Enter common block or module name->");
#ifdef KEY
   fgets(name_string, MAX_ID_LEN, stdin);
#else /* KEY */
   gets(name_string);
#endif /* KEY */

   if (strlen(name_string) > 0) {
      build_fake_token(name_string);
   }
   else {
      build_fake_token("//");
   }

   sb_idx = srch_stor_blk_tbl(TOKEN_STR(fake_token),
                              TOKEN_LEN(fake_token),
                              curr_scp_idx);

   if (sb_idx != NULL_IDX) {
      dump_sb_ntry(stderr, sb_idx);
   }
   else {
      fprintf(stderr,"\n*FE90-ERROR* No such common block or module name.\n");
   }

   return;

}  /* print_sb_by_name */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints an attr list to stderr.		                              *|
|*									      *|
|* Input parameters:							      *|
|*	Index of attribute list entry to start printing with.                 *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void print_al_list(FILE		*out_file,
	  	   int		 al_idx)

{

   while (al_idx != NULL_IDX) {
      dump_al_ntry(out_file, al_idx);
      al_idx = AL_NEXT_IDX(al_idx);
   }

   return;

}  /* print_al_list */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints the Secondary Name table entries that belong to the indexed    *|
|*      entity to stderr.                                                     *|
|*									      *|
|* Input parameters:							      *|
|*	Index of Attribute entry that should have Secondary Name table        *|
|*        entries associated with it.                 			      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void print_sn_list (int 	attr_idx)

{
   if (attr_idx > attr_tbl_idx) {
      fprintf(stderr, 
              "\n*FE90-ERROR* Attribute entry index [%d] is too large.\n",
              attr_idx);
    return;
   }
  
   /* Dummy arguments and keyword names for an explicit interface are in a  */
   /* in a contiguous grouping.  Procedure names in a generic or operator   */
   /* interface, namelist group members and component names are linked      */
   /* together (not necessarily contiguous).   			            */

   if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit  &&
       Pgm_Unknown < ATP_PGM_UNIT(attr_idx) < Program) {
      loop_thru_sn_ntries(stderr, attr_idx, FALSE);
   }
   else if (AT_OBJ_CLASS(attr_idx) == Interface ||
            AT_OBJ_CLASS(attr_idx) == Namelist_Grp ||
            AT_OBJ_CLASS(attr_idx) == Derived_Type) {
      chain_thru_sn_ntries(stderr, attr_idx, FALSE);
   }
   else {
      fprintf(stderr,
              "\n*FE90-ERROR* %s can not have Secondary Name table entries.\n",
              &name_pool[AT_NAME_IDX(attr_idx)].name_char);
   }
   return;

}  /* print_sn_list */
    
/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints just include entries from the file path table.                 *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void print_fp_includes (void)

{
   int		fp_idx;

   fp_idx = include_path_idx;

   while (fp_idx != NULL_IDX) {
      fprintf(debug_file, "%4s%-s\n", " ", FP_NAME_PTR(fp_idx));

      fp_idx = FP_NEXT_FILE_IDX(fp_idx);
   }

   fflush(debug_file);
       
   return;

}  /* print_fp_includes */


/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Prints just the name field of an Attr entry.  Useful when you know    *|
|*      the index of an Attr and you just want to know what identifier the    *|
|*      Attr is for.                                                          *|
|*                                                                            *|
|* Input parameters:							      *|
|*      idx : the Attr index                                                  *|
|*									      *|
|* Output parameters:							      *|
|*      NONE								      *|
|*									      *|
|* Returns:								      *|
|*      NOTHING								      *|
|*									      *|
\******************************************************************************/
void  print_name(int   idx)
{

   fprintf(stderr, "%d is %s\n", idx, AT_OBJ_NAME_PTR(idx));

   return;

} /* print_name */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Loops through a contiguous set of Secondary Name table entries and    *|
|*      writes them to stderr or a dump file.                                 *|
|*									      *|
|* Input parameters:							      *|
|*    - A pointer to the file to which the output is to be sent.              *|
|*    - Index of Attribute entry that should have Secondary Name table        *|
|*        entries associated with it.                 			      *|
|*    - A flag that indicates whether or not the Attribute entry for the      *|
|*        Secondary Name table item should be output.                         *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void loop_thru_sn_ntries (FILE		*out_file,
                                 int    	attr_idx,
				 boolean        output_attr)

{
   int          count;
   int          first_idx;
   int		i;


   if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit) {
      first_idx = ATP_FIRST_IDX(attr_idx);
      count     = ATP_NUM_DARGS(attr_idx);

      if (first_idx == NULL_IDX) {
         fprintf(out_file, "\n  %s\n",
                 "  ** No Dummy Arguments - ATP_FIRST_IDX = 0.");
         return;
      }
   }
   else {
      first_idx = ATP_FIRST_IDX(attr_idx);
      count     = ATP_NUM_DARGS(attr_idx);

      if (first_idx == NULL_IDX) {
         fprintf(out_file, "\n  %s\n",
                 "  ** No Dummy Arguments - ATP_FIRST_IDX = 0.");
         return;
      }
   }

   fprintf(out_file, "\n  %s %s:\n\n",
                     "Dummy Arguments for",
                     &name_pool[AT_NAME_IDX(attr_idx)].name_char);

   for (i = first_idx;
        i < (first_idx + count);
        i++) {
 
      dump_sn_ntry(out_file, i);

      if (output_attr) {
         putc('\n', out_file);
         dump_at_ntry(out_file, SN_ATTR_IDX(i), FALSE);
      }
      else if (AT_OBJ_CLASS(SN_ATTR_IDX(i)) == Data_Obj &&
               ATD_CLASS(SN_ATTR_IDX(i)) == Dummy_Argument) {

         fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8d\n",
                "ATD_ARRAY_IDX", ATD_ARRAY_IDX(SN_ATTR_IDX(i)),
                "ATD_POINTER", boolean_str[ATD_POINTER(SN_ATTR_IDX(i))],
                "ATD_TYPE_IDX", ATD_TYPE_IDX(SN_ATTR_IDX(i)));

# ifdef _F_MINUS_MINUS
         fprintf(out_file, "  %-16s= %-7d \n",
                "ATD_PE_ARRAY_IDX", ATD_PE_ARRAY_IDX(SN_ATTR_IDX(i)));
# endif


         putc('\n', out_file);
      }
      else if (AT_OBJ_CLASS(SN_ATTR_IDX(i)) == Pgm_Unit &&
               ATP_PROC(SN_ATTR_IDX(i)) == Dummy_Proc) {
         fprintf(out_file, "  %-25s\n", "Dummy_Proc");
         putc('\n', out_file);
      }
      else {
         putc('\n', out_file);
      }
   }

   fflush(out_file);

   return;

}  /* loop_thru_sn_ntries */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Chains through a set of Secondary Name table entries using            *|
|*      SN_SIBLING_LINK and writes them to stderr or a dump file.             *|
|*									      *|
|* Input parameters:							      *|
|*    - A pointer to the file to which the output is to be sent.              *|
|*    - Index of Attribute entry that should have Secondary Name table        *|
|*        entries associated with it.                 			      *|
|*    - A flag that indicates whether or not the Attribute entry for the      *|
|*        Secondary Name table item should be output.                         *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void chain_thru_sn_ntries (FILE		*out_file,
         		          int	 	 attr_idx,
				  boolean        output_attr)
				 
{
   char		conv_str[80];
   int		first_idx;
   int		i;
   int		idx;
   char		str[80];



   if (AT_OBJ_CLASS(attr_idx) == Derived_Type) {
      first_idx = ATT_FIRST_CPNT_IDX(attr_idx);

      if (first_idx == NULL_IDX) {
         fprintf(out_file, "\n  %s\n",
                 "** No Secondary Name table entries - ATT_FIRST_CPNT_IDX = 0");
         return;
      }
      fprintf(out_file, "\n  %s %s:\n\n",
                        "Component entries for",
                        &name_pool[AT_NAME_IDX(attr_idx)].name_char);
   }
   else if (AT_OBJ_CLASS(attr_idx) == Interface) {
      first_idx = ATI_FIRST_SPECIFIC_IDX(attr_idx);

      if (first_idx == NULL_IDX) {
         fprintf(out_file, "\n  %s\n",
             "** No Secondary Name table entries - ATI_FIRST_SPECIFIC_IDX = 0");
         return;
      }
      fprintf(out_file, "\n  %s %s:\n\n",
                        "Interface bodies for",
                        &name_pool[AT_NAME_IDX(attr_idx)].name_char);
   }
   else if (AT_OBJ_CLASS(attr_idx) == Namelist_Grp) {
      first_idx = ATN_FIRST_NAMELIST_IDX(attr_idx);

      if (first_idx == NULL_IDX) {
         fprintf(out_file, "\n  %s\n",
            " ** No Secondary Name table entries - ATN_FIRST_NAMELIST_IDX = 0");
         return;
      }
      fprintf(out_file, "\n  %s %s:\n\n",
                        "Namelist objects for",
                        &name_pool[AT_NAME_IDX(attr_idx)].name_char);
   }
   else {
      fprintf(out_file, "\n  %s %s:\n\n",
                        "Invalid attribute entry ",
                        &name_pool[AT_NAME_IDX(attr_idx)].name_char);
      return;
   }

   for (i = first_idx;  i != NULL_IDX;  i = SN_SIBLING_LINK(i)) {
      dump_sn_ntry(out_file, i);

      if (output_attr) {
         putc('\n', out_file);
         dump_at_ntry(out_file, SN_ATTR_IDX(i), FALSE);

      }
      else if (AT_OBJ_CLASS(attr_idx) == Interface &&
               AT_OBJ_CLASS(SN_ATTR_IDX(i)) == Pgm_Unit) {

         fprintf(out_file, "  %-25s %-16s= %-7d %-16s= %-8d\n",
                atp_pgm_unit_str[ATP_PGM_UNIT(SN_ATTR_IDX(i))],
                "ATP_FIRST_IDX", ATP_FIRST_IDX(SN_ATTR_IDX(i)),
                "ATP_NUM_DARGS", ATP_NUM_DARGS(SN_ATTR_IDX(i)));

         if (ATP_PGM_UNIT(SN_ATTR_IDX(i)) == Function) {
            idx = ATP_RSLT_IDX(SN_ATTR_IDX(i));
            fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8d\n",
                   "ATD_ARRAY_IDX", ATD_ARRAY_IDX(idx),
                   "ATD_POINTER", boolean_str[ATD_POINTER(idx)],
                   "ATD_TYPE_IDX", ATD_TYPE_IDX(idx));
         }

         if (ATP_FIRST_IDX(SN_ATTR_IDX(i)) != NULL_IDX) {
            loop_thru_sn_ntries(out_file, SN_ATTR_IDX(i), FALSE);
         }

         putc('\n', out_file);
      }
      else if (AT_OBJ_CLASS(SN_ATTR_IDX(i)) == Data_Obj &&
               ATD_CLASS(SN_ATTR_IDX(i)) == Struct_Component) {

         if (ATD_OFFSET_FLD(SN_ATTR_IDX(i)) == CN_Tbl_Idx ||
                ATD_OFFSET_FLD(SN_ATTR_IDX(i)) == NO_Tbl_Idx) {
            sprintf(str, "(%10s)", convert_to_string(
                         &CN_CONST(ATD_CPNT_OFFSET_IDX(SN_ATTR_IDX(i))),
                         CN_TYPE_IDX(ATD_CPNT_OFFSET_IDX(SN_ATTR_IDX(i))),
                         conv_str));
         }
         else if (ATD_OFFSET_FLD(SN_ATTR_IDX(i)) == AT_Tbl_Idx) {
            sprintf(str, "(%10s)", 
                         AT_OBJ_NAME_PTR(ATD_CPNT_OFFSET_IDX(SN_ATTR_IDX(i))));
         }
         else {
            sprintf(str,"%12s", " ");
         }


         fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-7s\n",
                 "ATD_ALIGNMENT", align_str[ATD_ALIGNMENT(SN_ATTR_IDX(i))],
                "ATD_ARRAY_IDX", ATD_ARRAY_IDX(SN_ATTR_IDX(i)),
                "AT_DCL_ERR", boolean_str[AT_DCL_ERR(SN_ATTR_IDX(i))]);

         print_fld_idx(out_file, "ATD_CPNT_OFFSET_",
                       ATD_OFFSET_FLD(SN_ATTR_IDX(i)),
                       ATD_CPNT_OFFSET_IDX(SN_ATTR_IDX(i)));

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s \n",
                "ATD_IM_A_DOPE", boolean_str[ATD_IM_A_DOPE(SN_ATTR_IDX(i))],
                "ATD_POINTER", boolean_str[ATD_IM_A_DOPE(SN_ATTR_IDX(i))]);

         fprintf(out_file, "  %-16s= %-7d %-s\n",
                     "ATD_TYPE_IDX", ATD_TYPE_IDX(SN_ATTR_IDX(i)),
                      print_type_f(ATD_TYPE_IDX(SN_ATTR_IDX(i))));

	 if (TYP_LINEAR(ATD_TYPE_IDX(SN_ATTR_IDX(i))) == Proc_Ptr)
	     fprintf(out_file, "  %-16s= %-6d\n",
		     "ATD_PP_ATP", ATD_PP_ATP(SN_ATTR_IDX(i)));

         if (ATD_CPNT_INIT_IDX(SN_ATTR_IDX(i)) != NULL_IDX) {
            print_fld_idx(out_file, "ATD_CPNT_INIT_ID",
                          (fld_type) ATD_FLD(SN_ATTR_IDX(i)),
                          ATD_CPNT_INIT_IDX(SN_ATTR_IDX(i)));

            if (ATD_FLD(SN_ATTR_IDX(i)) == IR_Tbl_Idx) {
               dump_ir_ntry(out_file, ATD_CPNT_INIT_IDX(SN_ATTR_IDX(i)), 5);
            }
            else if (ATD_FLD(SN_ATTR_IDX(i)) == CN_Tbl_Idx) {
               dump_cn_ntry(out_file, ATD_CPNT_INIT_IDX(SN_ATTR_IDX(i)));
            }
         }


         putc('\n', out_file);
      }
   }

   fflush(out_file);

   return;

}  /* chain_thru_sn_ntries */


/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      This function builds a fake token which may be used as an actual      *|
|*      argument to a symbol table search function.  This function is         *|
|*      typically called by the routines that look up items in the symbol     *|
|*      table by their names (rather than by an index into a table).          *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      A string containing the name of the item to be found.                 *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
|* Note:  This function builds the fake token in the file-global structure    *|
|*        fake_token.                                                         *|
|*                                                                            *|
\******************************************************************************/

static void build_fake_token (char     *name_string)

{
   int		i;
   int		len;


   /* Initialize the token string to all zeroes so the long word search  */
   /* used by the search routines will work correctly.                   */

   len	= strlen(name_string);
   CREATE_ID(TOKEN_ID(fake_token), name_string, len);

   TOKEN_LEN(fake_token) = len;

   for (i = 0;  i < len;  i++) {
      TOKEN_STR(fake_token)[i] = toupper(TOKEN_STR(fake_token)[i]);
   }

   return;

}  /* build_fake_token */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Used to trace entry and exit into a function.			      *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void dump_func_trace_info (trace_type	 trace,
			   char		*func_name,
			   char		*info)
{

   if (trace_file == NULL) {
      trace_file = fopen (trace_file_name, "w");
      
      if (trace_file == NULL) {
         PRINTMSG(1, 17, Error, 0, trace_file_name);
	 exit_compiler(RC_USER_ERROR);
      }

      fprintf (trace_file, "\nTRACE DUMP OF PROGRAM %s:\n\n", src_file);
   }

   dump_trace_info(trace_file, trace, func_name, info);

   return;

}  /* dump_func_trace_info */


/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Used to output a variety of information to the screen, the dump file, *|
|*      or the trace file.						      *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void dump_trace_info (FILE	  *out_file,
			     trace_type    trace,
      		             char         *func_name,
                      	     char         *info)
{

   int	 idx;
   char *indent_str;


   switch (trace) {

      case Func_Entry:
      case Func_Exit:
	 if (trace == Func_Exit) { 
	    trace_indent -= trace_indent_len;

	    if (trace_indent < 0) {
	       trace_indent = 0;
	    }
	 }

	 indent_str = (char *) malloc (trace_indent+1);

	 for (idx = 0;	idx < trace_indent;  idx++) {
	    indent_str[idx] = (idx % trace_indent_len  ==  0)  ?  '|'  :  BLANK;
	 }

	 indent_str[idx] = NULL_CHAR;

	 if (trace == Func_Entry) { 
	    fprintf (out_file, "%sIN  %s", indent_str, func_name);
	    trace_indent += trace_indent_len;
	 } 
	 else { 
	    fprintf (out_file, "%sOUT %s", indent_str, func_name);
	 }
	 if (info == NULL) {
	    putc (NEWLINE, out_file);
	 }
	 else {
	    fprintf (out_file, " (%s)\n", info);
	 }

	 free (indent_str);
         indent_str = NULL;
	 break;

      case Syntax_Pass:
         fprintf(out_file, "\n> > > > > > > > > >   B e g i n   S y n t a x "
                           "  P a s s   < < < < < < < < < <\n\n");
         trace_indent = 0;
         break;

      case Semantics_Pass:
         fprintf(out_file, "\n> > > > > > > >   B e g i n   S e m a n t i c s"
                           "   P a s s   < < < < < < < <\n\n");
         trace_indent = 0;
         break;

      case PU_Start:
         if (info == NULL) {
	    fprintf (out_file, "\n\n# NEW PROGRAM UNIT ########################"
	   		       "####################################\n");
    	 }
         else {
            fprintf (out_file, "\n\n# NEW PROGRAM UNIT # %s ##################"
			       "#######\n",
			       AT_OBJ_NAME_PTR(SCP_ATTR_IDX(curr_scp_idx)));

            if (SCP_IN_ERR(curr_scp_idx)) {
               fprintf (out_file,
                        "# # #  SCP entry is marked in error  # # #\n");
            }
         }

	 break;

      case Stmt_Start:
         if (info == NULL) {
	    fprintf (out_file, "\n- NEW STMT ---------------------------"
       		               "-----------------------------------------\n");
         }
         else {
            fprintf (out_file, "\n- %s%s - %d %s-------------------------"
                               "-------------------------\n",
                               (SH_COMPILER_GEN(curr_stmt_sh_idx)) ? "CG " : "",
			       stmt_type_str[SH_STMT_TYPE(curr_stmt_sh_idx)],
			       SH_GLB_LINE(curr_stmt_sh_idx),
                               (SH_P2_SKIP_ME(curr_stmt_sh_idx)) ? "SKIP ME " :
                                                                   "--------");

            if (SH_ERR_FLG(curr_stmt_sh_idx)) {
               fprintf (out_file,
                        "\n* * *  Stmt Header is marked in error  * * *\n");
            }
         }

	 break;

   }  /* switch */

   return;

}  /* dump_trace_info */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Used to trace memory usage.                 			      *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void dump_mem_trace_info (trace_type	 trace,
			  char		*struct_name,
			  void		*new_struct_ptr,
			  void		*old_struct_ptr,
			  long		 struct_bsize_or_num_used,
			  int		 num_entries)
{
   int	 idx;
   char *indent_str	= NULL;


   if (trace_file == NULL) {
      trace_file = fopen (trace_file_name, "w");
      
      if (trace_file == NULL) {
         PRINTMSG(1, 17, Error, 0, trace_file_name);
	 exit_compiler(RC_USER_ERROR);
      }

      fprintf (trace_file, "\nTRACE DUMP OF PROGRAM %s:\n\n", src_file);
   }

   if (trace_indent > 0) {
      indent_str = (char *) malloc (trace_indent+1);

      for (idx = 0;  idx < trace_indent;  idx++) {
	 indent_str[idx] = (idx % trace_indent_len  ==	0)  ?  '|'  :  BLANK;
      }

      indent_str[idx] = NULL_CHAR;

      fprintf (trace_file, "%s", indent_str);
   }

   switch (trace) {
      case Mem_Alloc:
	 fprintf (trace_file, "ALLOC           %s (%#" INTPTR_TYPE_O_FMT ") BSIZE=%ld(%d ENTRIES)\n",
			      struct_name, (uintptr_t) new_struct_ptr,
			      struct_bsize_or_num_used, num_entries);
	 break;

      case Mem_Realloc:
	 if (new_struct_ptr == old_struct_ptr) {
	    fprintf (trace_file, "REALLOC      %s (%#" INTPTR_TYPE_O_FMT ") BSIZE=%ld(%d ENTRIES)\n",
				 struct_name, (uintptr_t) new_struct_ptr,
				 struct_bsize_or_num_used, num_entries);
	 }
	 else {			/* realloced with move */
	    fprintf (trace_file, "REALLOC/MOVE %s (%#" INTPTR_TYPE_O_FMT "->%#" INTPTR_TYPE_O_FMT ") "
				 "BSIZE=%ld(%d ENTRIES)\n",
				 struct_name, (uintptr_t) old_struct_ptr,
				 (uintptr_t) new_struct_ptr,
				 struct_bsize_or_num_used, num_entries);
	 }
	 break;

      case Mem_Free:
	 fprintf (trace_file, "FREE         %s (%#" INTPTR_TYPE_O_FMT ") (%d ENTRIES) "
                              "(%ld USED ENTRIES)\n", 
                              struct_name,
                              (uintptr_t) new_struct_ptr,
                              num_entries,
                              struct_bsize_or_num_used);
	 break;

      case Mem_Compress:
	 fprintf (trace_file, "COMPRESS     %s (%ld BEFORE ENTRIES) "
                              "(%d AFTER ENTRIES)\n", 
                              struct_name,
                              struct_bsize_or_num_used,
                              num_entries);
	 break;
   }  /* switch */

   if (indent_str != NULL) {
      free (indent_str);
      indent_str = NULL;
   }

   return;

}  /* dump_mem_trace_info */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void	print_mem_usage_report(char	*name,
				int	 final_size,
				int	 largest_idx)
 
{

   static	boolean		first_call	= TRUE;

   print_tbl_header("Memory Report");

   if (first_call == TRUE) {
      first_call = FALSE;

      /* Dump initial size and increment for each table. */

      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "attr_list_tbl",
                           "init size", attr_list_tbl_init_size,
                           "increment", attr_list_tbl_inc,
                           "num words", attr_list_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "attr_tbl",
                           "init size", attr_tbl_init_size,
                           "increment", attr_tbl_inc,
                           "num words", attr_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "blk_stk", 
                           "init size", blk_stk_init_size,
                           "increment", blk_stk_inc,
                           "num words", blk_stk_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "bounds_tbl",
                           "init size", bounds_tbl_init_size,
                           "increment", bounds_tbl_inc,
                           "num words", bounds_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "const_tbl",
                           "init size", const_tbl_init_size,
                           "increment", const_tbl_inc,
                           "num words", const_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "const_pool",
                           "init size", const_pool_init_size,
                           "increment", const_pool_inc,
                           "num words", const_pool_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "equiv_tbl",
                           "init size", equiv_tbl_init_size,
                           "increment", equiv_tbl_inc,
                           "num words", equiv_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "file_path_tbl",
                           "init size", file_path_tbl_init_size,
                           "increment", file_path_tbl_inc,
                           "num words", file_path_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "global_line_tbl",
                           "init size", global_line_tbl_init_size,
                           "increment", global_line_tbl_inc,
                           "num words", global_line_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "global_name_tbl",
                           "init size", global_name_tbl_init_size,
                           "increment", global_name_tbl_inc,
                           "num words", global_name_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "hidden_name_tbl",
                           "init size", hidden_name_tbl_init_size,
                           "increment", hidden_name_tbl_inc,
                           "num words", hidden_name_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "ir_tbl",
                           "init size", ir_tbl_init_size,
                           "increment", ir_tbl_inc,
                           "num words", ir_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "ir_list_tbl",
                           "init size", ir_list_tbl_init_size,
                           "increment", ir_list_tbl_inc,
                           "num words", ir_list_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "loc_name_tbl",
                           "init size", loc_name_tbl_init_size,
                           "increment", loc_name_tbl_inc,
                           "num words", loc_name_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "mod_link_tbl",
                           "init size", mod_link_tbl_init_size,
                           "increment", mod_link_tbl_inc,
                           "num words", mod_link_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "name_pool",
                           "init size", name_pool_init_size,
                           "increment", name_pool_inc,
                           "num words", name_pool_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "rename_only_tbl",
                           "init size", rename_only_tbl_init_size,
                           "increment", rename_only_tbl_inc,
                           "num words", rename_only_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "scp_tbl",
                           "init size", scp_tbl_init_size,
                           "increment", scp_tbl_inc,
                           "num words", scp_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "sec_name_tbl",
                           "init size", sec_name_tbl_init_size,
                           "increment", sec_name_tbl_inc,
                           "num words", sec_name_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "sh_tbl",
                           "init size", sh_tbl_init_size,
                           "increment", sh_tbl_inc,
                           "num words", sh_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "stor_blk_tbl",
                           "init size", stor_blk_tbl_init_size,
                           "increment", stor_blk_tbl_inc,
                           "num words", stor_blk_tbl_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "str_pool",
                           "init size", str_pool_init_size,
                           "increment", str_pool_inc,
                           "num words", str_pool_num_wds);
      fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d  %-9s= %-7d\n",
                           "type_tbl",
                           "init size", type_tbl_init_size,
                           "increment", type_tbl_inc,
                           "num words", type_tbl_num_wds);
      print_src_input_tbls();
   }


   fprintf (debug_file, "%-20s  %-9s= %-8d  %-9s= %-6d\n",
                        name,
                        "finalsize", final_size,
                        "large idx", largest_idx);

   fflush (debug_file);
   return;

}  /* print_mem_usage_report */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Print the defines that are set in this compiler.                      *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void	print_defines(void)

{

   print_tbl_header("Compiler Defines Dump");

# ifdef _PVP_PVP
   fprintf(debug_file, "\t\t\t_PVP_PVP\n");
# endif

# ifdef _MPP_MPP
   fprintf(debug_file, "\t\t\t_MPP_MPP\n");
# endif

# ifdef _SOLARIS_SOLARIS
   fprintf(debug_file, "\t\t\t_SOLARIS_SOLARIS\n");
# endif

# ifdef _SOLARIS_MPP
   fprintf(debug_file, "\t\t\t_SOLARIS_MPP\n");
# endif

# ifdef _SOLARIS_PVP
   fprintf(debug_file, "\t\t\t_SOLARIS_PVP\n");
# endif

# ifdef _PVP_MPP
   fprintf(debug_file, "\t\t\t_PVP_MPP\n");
# endif

   fprintf(debug_file, "\n");

# ifdef _PDGCS
   fprintf(debug_file, "\t\t\t_PDGCS\n");
# endif

# ifdef _HOST32
   fprintf(debug_file, "\t\t\t_HOST32\n");
# endif

# ifdef _HOST64
   fprintf(debug_file, "\t\t\t_HOST64\n");
# endif

# ifdef _TARGET32
   fprintf(debug_file, "\t\t\t_TARGET32\n");
# endif

# ifdef _TARGET64
   fprintf(debug_file, "\t\t\t_TARGET64\n");
# endif

# if defined(_HOST_OS_IRIX)
   fprintf(debug_file, "\t\t\t_HOST_OS_IRIX\n");
# endif

# if defined(_HOST_OS_LINUX)
   fprintf(debug_file, "\t\t\t_HOST_OS_LINUX\n");
# endif

# if defined(_HOST_OS_DARWIN)
   fprintf(debug_file, "\t\t\t_HOST_OS_DARWIN\n");
# endif

# ifdef _HOST_OS_MAX
   fprintf(debug_file, "\t\t\t_HOST_OS_MAX\n");
# endif

# ifdef _HOST_OS_SOLARIS
   fprintf(debug_file, "\t\t\t_HOST_OS_SOLARIS\n");
# endif

# ifdef _HOST_OS_UNICOS
   fprintf(debug_file, "\t\t\t_HOST_OS_UNICOS\n");
# endif


# if defined(_TARGET_OS_IRIX)
   fprintf(debug_file, "\t\t\t_TARGET_OS_IRIX\n");
# endif

# if defined(_TARGET_OS_LINUX)
   fprintf(debug_file, "\t\t\t_TARGET_OS_LINUX\n");
# endif

# if defined(_TARGET_OS_DARWIN)
   fprintf(debug_file, "\t\t\t_TARGET_OS_DARWIN\n");
# endif

# ifdef _TARGET_OS_MAX
   fprintf(debug_file, "\t\t\t_TARGET_OS_MAX\n");
# endif

# ifdef _TARGET_OS_SOLARIS
   fprintf(debug_file, "\t\t\t_TARGET_OS_SOLARIS\n");
# endif

# ifdef _TARGET_OS_UNICOS
   fprintf(debug_file, "\t\t\t_TARGET_OS_UNICOS\n");
# endif

# ifdef _TARGET_SV2
   fprintf(debug_file, "\t\t\t_TARGET_SV2\n");
# endif

# ifdef _TARGET_IEEE
   fprintf(debug_file, "\t\t\t_TARGET_IEEE\n");
# endif

# ifdef _TARGET_BYTE_ADDRESS
   fprintf(debug_file, "\t\t\t_TARGET_BYTE_ADDRESS\n");
# endif

# ifdef _TARGET_WORD_ADDRESS
   fprintf(debug_file, "\t\t\t_TARGET_WORD_ADDRESS\n");
# endif

# ifdef _HEAP_REQUEST_IN_BYTES
   fprintf(debug_file, "\t\t\t_HEAP_REQUEST_IN_BYTES\n");
# endif

# ifdef _HEAP_REQUEST_IN_WORDS
   fprintf(debug_file, "\t\t\t_HEAP_REQUEST_IN_WORDS\n");
# endif

# ifdef _MODULE_DOT_TO_o
   fprintf(debug_file, "\t\t\t_MODULE_DOT_TO_o\n");
# endif

# ifdef _MODULE_DOT_TO_M
   fprintf(debug_file, "\t\t\t_MODULE_DOT_TO_M\n");
# endif

# ifdef _MODULE_DOT_TO_mod
   fprintf(debug_file, "\t\t\t_MODULE_DOT_TO_mod\n");
# endif

# ifdef _ARITH_INPUT_CONV
   fprintf(debug_file, "\t\t\t_ARITH_INPUT_CONV\n");
# endif

# ifdef _ARITH_H
   fprintf(debug_file, "\t\t\t_ARITH_H\n");
# endif

# ifdef _ALLOCATE_IS_CALL
   fprintf(debug_file, "\t\t\t_ALLOCATE_IS_CALL\n");
# endif

# ifdef _SEPARATE_FUNCTION_RETURNS
   fprintf(debug_file, "\t\t\t_SEPARATE_FUNCTION_RETURNS\n");
# endif

# ifdef _TARGET_DOUBLE_ALIGN
   fprintf(debug_file, "\t\t\t_TARGET_DOUBLE_ALIGN\n");
# endif

# ifdef _ERROR_DUPLICATE_GLOBALS
   fprintf(debug_file, "\t\t\t_ERROR_DUPLICATE_GLOBALS\n");
# endif


   if (char_len_in_bytes) {
      fprintf(debug_file, "\t\t\t_CHAR_LEN_IN_BYTES\n");
   }
# ifdef _NO_BINARY_OUTPUT
   fprintf(debug_file, "\t\t\t_NO_BINARY_OUTPUT\n");
# endif

# ifdef _CHECK_MAX_MEMORY
   fprintf(debug_file, "\t\t\t_CHECK_MAX_MEMORY\n");
# endif

# ifdef _TASK_COMMON_EXTENSION
   fprintf(debug_file, "\t\t\t_TASK_COMMON_EXTENSION\n");
# endif

# ifdef _TWO_WORD_FCD
   fprintf(debug_file, "\t\t\t_TWO_WORD_FCD\n");
# endif

# ifdef _TRANSFORM_CHAR_SEQUENCE
   fprintf(debug_file, "\t\t\t_TRANSFORM_CHAR_SEQUENCE\n");
# endif

# ifdef _TMP_GIVES_COMMON_LENGTH
   fprintf(debug_file, "\t\t\t_TMP_GIVES_COMMON_LENGTH\n");
# endif

# ifdef _SPLIT_STATIC_STORAGE_2
   fprintf(debug_file, "\t\t\t_SPLIT_STATIC_STORAGE_2\n");
# endif

# ifdef _SPLIT_STATIC_STORAGE_3
   fprintf(debug_file, "\t\t\t_SPLIT_STATIC_STORAGE_3\n");
# endif

# ifdef _ALLOW_DATA_INIT_OF_COMMON
   fprintf(debug_file, "\t\t\t_ALLOW_DATA_INIT_OF_COMMON\n");
# endif

# ifdef _FRONTEND_CONDITIONAL_COMP
   fprintf(debug_file, "\t\t\t_FRONTEND_CONDITIONAL_COMP\n");
# endif


   fprintf(debug_file, "\n\n\t\t\tINTEGER_DEFAULT_TYPE\t%s\n",
                       lin_type_str[INTEGER_DEFAULT_TYPE]);

   fprintf(debug_file, "\t\t\tREAL_DEFAULT_TYPE\t%s\n",
                       lin_type_str[REAL_DEFAULT_TYPE]);

   fprintf(debug_file, "\t\t\tDOUBLE_DEFAULT_TYPE\t%s\n",
                       lin_type_str[DOUBLE_DEFAULT_TYPE]);

   fprintf(debug_file, "\t\t\tCOMPLEX_DEFAULT_TYPE\t%s\n",
                       lin_type_str[COMPLEX_DEFAULT_TYPE]);

   fprintf(debug_file, "\t\t\tLOGICAL_DEFAULT_TYPE\t%s\n",
                       lin_type_str[LOGICAL_DEFAULT_TYPE]);

   fprintf(debug_file, "\t\t\tTRUE_VALUE  = %d\n", TRUE_VALUE);
   fprintf(debug_file, "\t\t\tFALSE_VALUE = %d\n", FALSE_VALUE);

   if (target_triton) {
      fprintf(debug_file, "\n\t\t\ttarget_triton\n");
   }

   if (target_ieee) {
      fprintf(debug_file, "\n\t\t\ttarget_ieee\n");
   }

   if (char_len_in_bytes) {
      fprintf(debug_file, "\n\t\t\tchar_len_in_bytes\n");
   }

   putc ('\n', debug_file);
   fflush(debug_file);

   return;

}  /* print_defines */


/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      <description>                                                         *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void dump_dv(FILE                *out_file,
                    int_dope_type       *dv,
                    boolean             dump_it)

{
   long *lptr;
   int  k;
   int  i;
   int  idx;
   int  dec_len = 0;
   int  dp_flag = 0;
   int  dv_type;
   int  int_len = 0;
   int  kind_star = 0;
   int  type_idx;
   int  num_chars;
   char *char_ptr;

# if 0
   char str[80];
# endif


   if (dv == NULL) {
      fprintf(out_file, "\nDOPE VECTOR ADDRESS IS NULL\n\n");
      return;
   }
#if defined(_HOST32) && defined(_TARGET64)
   fprintf(out_file, "base_addr = 0x%x\n", dv->base_addr);
   fprintf(out_file, "el_len    = %d\n", dv->el_len);
#else
   fprintf(out_file, "base_addr = 0x%" LONG_TYPE_X_FMT "\n", dv->base_addr);
   fprintf(out_file, "el_len    = %" LONG_TYPE_FMT "\n", dv->el_len);
#endif
   fprintf(out_file, "assoc     = %d\n", dv->assoc);
   fprintf(out_file, "ptr_alloc = %d\n", dv->ptr_alloc);
   fprintf(out_file, "p_or_a    = %s\n", (dv->p_or_a == 2 ? "ALLOCATABLE" :
                                  (dv->p_or_a == 1 ? "POINTER" : "OTHER")));
   fprintf(out_file, "a_contig  = %s\n",
                          (dv->a_contig == 1 ? "TRUE" : "FALSE"));
   fprintf(out_file, "unused_1  = %d\n", dv->unused_1);
# if defined(_TARGET64)
   fprintf(out_file, "unused_2  = %d\n", dv->unused_2);
# endif
   fprintf(out_file, "num_dims  = %d\n", dv->num_dims);

# if 0
   dump_io_type_code_ntry(out_file, (long_type *)&(dv->type_code), 0);
# endif

#if defined(_HOST32) && defined(_TARGET64)
   fprintf(out_file, "orig_base = 0x%x\n", dv->orig_base);
   fprintf(out_file, "orig_size = %d\n", dv->orig_size);

   for(k = 0; k < (int)(dv->num_dims); k++) {
      fprintf(out_file, "low_bound[%d]   = %d\n",k+1,
                                          dv->dim[k].low_bound);
      fprintf(out_file, "extent[%d]      = %d\n",
                                            k+1, dv->dim[k].extent);
      fprintf(out_file, "stride_mult[%d] = %d\n\n",k+1,
                                          dv->dim[k].stride_mult);
   }
#else
   fprintf(out_file, "orig_base = 0x%" LONG_TYPE_X_FMT "\n", dv->orig_base);
   fprintf(out_file, "orig_size = %" LONG_TYPE_FMT "\n", dv->orig_size);

   for(k = 0; k < (int)(dv->num_dims); k++) {
      fprintf(out_file, "low_bound[%d]   = %" LONG_TYPE_FMT "\n",k+1,
                                          dv->dim[k].low_bound);
      fprintf(out_file, "extent[%d]      = %" LONG_TYPE_FMT "\n",
                                            k+1, dv->dim[k].extent);
      fprintf(out_file, "stride_mult[%d] = %" LONG_TYPE_FMT "\n\n",k+1,
                                          dv->dim[k].stride_mult);
   }
#endif


# if 0
   lptr = (long *)(dv->base_addr);

   if (lptr != NULL &&
       dv->num_dims == 1 &&
       dump_it) {

      /* this assumes that the array is contiguous */

      if (dv_type == DV_ASCII_CHAR) {

         char_ptr = (char *)(dv->base_addr);

         idx = 0;

         for (k = 0; k < dv->dim[0].extent; k++) {
            fprintf(out_file,"\"");
            for (i = 0; i < num_chars; i++) {
               fprintf(out_file, "%c", char_ptr[idx]);
               idx++;
            }
            fprintf(out_file,"\"  ");
         }
         fprintf(out_file, "\n");
      }
      else {

         for (k = 0; k < dv->dim[0].extent; k++) {
#if 1
            fprintf(out_file, "  %x  ", 
                              lptr[num_host_wds[TYP_LINEAR(type_idx)] * k]);
# else

            fprintf(out_file, "  %s  ",
             convert_to_string(&(lptr[num_host_wds[TYP_LINEAR(type_idx)] * k]),
                               type_idx,
                               str));
# endif
         }
         fprintf(out_file, "\n");
      }
   }
# endif

   return;

}  /* dump_dv */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	<description>							      *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void print_so (size_offset_type so)

{
   char		str[80];

   switch(so.fld) {

   case NO_Tbl_Idx:
      print_fld_idx(stderr, "Idx", (fld_type) so.fld, 0);
      fprintf(stderr, "Type = (%d)  %s",  so.type_idx, 
                                          print_type_f(so.type_idx));

      switch (TYP_TYPE(so.type_idx)) {
      case Typeless:
         convert_to_string_fmt = Hex_Fmt;
         fprintf(stderr,"0x%s", 
                 convert_to_string((long_type *)&(so.constant), 
                                     so.type_idx, str));

         if (TYP_BIT_LEN(so.type_idx) > TARGET_BITS_PER_WORD) {
            convert_to_string_fmt = Hex_Fmt;
            fprintf(stderr, "  %s",
                    convert_to_string((long_type *)&(so.constant[1]),
                                      so.type_idx, str));
         }

         break;

      case Integer:
         fprintf(stderr,"%s",
                 convert_to_string((long_type *)&(so.constant), 
                                    so.type_idx, str));
         break;
   
      case Real:
         fprintf(stderr, "%s",
                 convert_to_string((long_type *)&(so.constant), 
                                    so.type_idx, str));
         break;
         
      case Character:
         break;
         
      case Logical:
         fprintf(stderr, "%s",
                (THIS_IS_TRUE((long_type *)&(so.constant), so.type_idx) ?
                                             ".TRUE." : ".FALSE."));
         break;
         
      case Complex:
         fprintf(stderr, "%s", 
                 convert_to_string((long_type *)&(so.constant),
                                   so.type_idx, str));
         break;
      }

      fprintf(stderr,"\n");
      break;

   case CN_Tbl_Idx:
      print_fld_idx(stderr, "Idx", (fld_type) so.fld, so.idx);
      fprintf(stderr, "Constant = *Unset*\n");

      print_const_entry(stderr, so.idx, 0);
      break;

   case AT_Tbl_Idx:
      print_fld_idx(stderr, "Idx", (fld_type) so.fld, so.idx);
      fprintf(stderr, "Constant = *Unset*\n");
      print_attr_name(stderr, so.idx, 0);
      break;

   case IR_Tbl_Idx:
      print_fld_idx(stderr, "Idx", (fld_type) so.fld, so.idx);
      fprintf(stderr, "Constant = *Unset*\n");
      dump_ir_ntry(stderr, so.idx, 0);
      break;
   }

   return;

}  /* print_so */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Makes a field/index printable into a character string.                *|
|*									      *|
|* Input parameters:							      *|
|*	fld  ->  Field describing index to print.                             *|
|*	idx  ->  Index to print.                                              *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	Pointer to a character string of item to print.			      *|
|*									      *|
|*	NOTE:  This reuses the same output character area, so each successive *|
|*	       call will clear out the previous returned value.               *|
|*									      *|
\******************************************************************************/

static void	print_fld_idx(FILE		*out_file,
			      char		*name,
			      fld_type		 fld,
			      int		 idx)

{
   static	char		str[80];
   		char		conv_str[80];

   if (idx == NULL_IDX) {
      fprintf(out_file, "  %-16s= %-7d %-9s\n", name, idx, field_str[fld]);
   }
   else {
      switch (fld) {

      case CN_Tbl_Idx:
         sprintf(str,"( %-s )",
                 convert_to_string(&CN_CONST(idx), CN_TYPE_IDX(idx), conv_str));
         break;

      case AT_Tbl_Idx:
         sprintf(str,"( %-s )", AT_OBJ_NAME_PTR(idx));
         break;

      case IR_Tbl_Idx:
      case IL_Tbl_Idx:
      case SH_Tbl_Idx:
      case SB_Tbl_Idx:
         sprintf(str,"%s", " ");
         break;

      default:
         sprintf(str,"%s", " ");
         break;
      }

      fprintf(out_file, "  %-16s= %-7d %-9s%15s %-s\n",
             name, idx,
             field_str[fld], " ",
             str);
   }

   return;

}  /* print_fld_idx */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Should be inlined.  Returns the name for an attr or ** NONE **        *|
|*									      *|
|* Input parameters:							      *|
|*	idx  ->  Attr index of name                                           *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	Pointer to a character string of item to print.			      *|
|*									      *|
|*	NOTE:  This reuses the same output character area, so each successive *|
|*	       call will clear out the previous returned value.               *|
|*									      *|
\******************************************************************************/

static char *print_at_name(int		idx)

{
   static	char	str[1] = "0";


   if (idx == NULL_IDX) {
      return(str);
   }
   else {
      return(AT_OBJ_NAME_PTR(idx));
   }

}  /* print_at_name */
    
/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints header for a table in the debug output.                        *|
|*									      *|
|* Input parameters:							      *|
|*	Table name to print						      *|
|*									      *|
\******************************************************************************/

static	void print_tbl_header (char	*table_name)

{
   init_debug_file();

   fprintf(debug_file, "****************************************"
                       "****************************************\n");
   fprintf(debug_file, "\n\t\t\t%s\n\n", table_name);
   fprintf(debug_file, "****************************************"
                       "****************************************\n");
   return;

}  /* print_tbl_header */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Print global type in a Fortran format.                                *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static	char  *print_global_type_f(int	 gt_idx)

{
		int	kind;
   static	char	str[80];
  	 	char	str1[80];


   if (gt_idx == NULL_IDX) {
      sprintf(str, "NULL");
   }
   else if (GT_TYPE(gt_idx) < Last_Basic_Type) {

      if (GT_DESC(gt_idx) == Star_Typed) {
         sprintf(str, "%s * %d", 
                       basic_type_str[GT_TYPE(gt_idx)],
                       GT_DCL_VALUE(gt_idx));
      }
      else if (GT_DESC(gt_idx) == Kind_Typed) {
         sprintf(str, "%s (kind=%d)", 
                       basic_type_str[GT_TYPE(gt_idx)],
                       GT_DCL_VALUE(gt_idx));
      }
      else {  /* Default Typed */

         /* Print a kind type, so we know exactly what we've got. */

         switch (GT_LINEAR_TYPE(gt_idx)) {
         case Integer_1:
         case Logical_1:
            kind	= 1;
            break;
         case Integer_2:
         case Logical_2:
            kind	= 2;
            break;
         case Integer_4:
         case Logical_4:
         case Real_4:
         case Complex_4:
            kind	= 4;
            break;
         case Integer_8:
         case Logical_8:
         case Real_8:
         case Complex_8:
            kind	= 8;
            break;
         case Real_16:
         case Complex_16:
            kind	= 16;
            break;
         default:
            kind	= 0;
            break;
         }

         if (kind == 0) {
            sprintf(str, "%s", basic_type_str[GT_TYPE(gt_idx)]);
         }
         else {
            sprintf(str, "%s (%d)", basic_type_str[GT_TYPE(gt_idx)], kind);
         }
      }
   }
   else if (GT_TYPE(gt_idx) == Typeless) {
      sprintf(str, "Typeless * %s", 
                    CONVERT_CVAL_TO_STR(&TYP_BIT_LEN(gt_idx), Integer_8, str1));
   }
   else if (GT_TYPE(gt_idx) != Character) {
      sprintf(str, "type(%s)", GA_OBJ_NAME_PTR(GT_STRUCT_IDX(gt_idx)));
   }
   else if (GT_CHAR_CLASS(gt_idx) == Assumed_Size_Char) {
      sprintf(str, "CHARACTER*(*)");
   }
   else if (GT_CHAR_CLASS(gt_idx) == Const_Len_Char) {
      sprintf(str, "CHARACTER*(Const_Len_Char)");
      /* 07Dec00[sos] next line aborts  (PV 802511)                       */
      /* sprintf(str, "CHARACTER*(%s)",                                   */
      /*         convert_to_string(GT_LENGTH(gt_idx), Integer_8, str1)"); */
   }
   else {  /* Variable or unknown length char - print (tmp_idx = idx) */
      sprintf(str, "CHARACTER*(tmp)");
   }

   return(str);

} /* print_global_type_f */

/******************************************************************************\
|*                                                                            *|
|*      Utility routines specifically for the IR/IL dump.                     *|
|*                                                                            *|
\******************************************************************************/

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Print all the statements and all their IR.                            *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void  print_all_text (boolean	print_all_scps)

{
   int  save_curr_scp_idx;


PROCESS_SIBLING:

   init_debug_file();

   dump_trace_info (debug_file, PU_Start, NULL, "IR_dump");

   if (!SCP_IN_ERR(curr_scp_idx) ) {

      curr_stmt_sh_idx = SCP_FIRST_SH_IDX(curr_scp_idx);

      while (curr_stmt_sh_idx != NULL_IDX) {

         dump_stmt_ntry(debug_file, TRUE);

         if (SH_NEXT_IDX(curr_stmt_sh_idx) == curr_stmt_sh_idx) {

            /* Turn off ir table dump, so this doesn't loop forever */

            dump_flags.ir1_tbl	= FALSE;
            dump_flags.ir2_tbl	= FALSE;
            dump_flags.ir3_tbl	= FALSE;
            dump_flags.ir4_tbl	= FALSE;
            dump_flags.sytb 	= FALSE;

            PRINTMSG(SH_GLB_LINE(curr_stmt_sh_idx), 871, Internal,
                     SH_COL_NUM(curr_stmt_sh_idx), "SH_NEXT_IDX",
                     curr_stmt_sh_idx);
         }
         else if (SH_PREV_IDX(curr_stmt_sh_idx) == curr_stmt_sh_idx) {

            /* Turn off ir table dump, so this doesn't loop forever */

            dump_flags.ir1_tbl	= FALSE;
            dump_flags.ir2_tbl	= FALSE;
            dump_flags.ir3_tbl	= FALSE;
            dump_flags.ir4_tbl	= FALSE;
            dump_flags.sytb 	= FALSE;

            PRINTMSG(SH_GLB_LINE(curr_stmt_sh_idx), 871, Internal,
                     SH_COL_NUM(curr_stmt_sh_idx), "SH_PREV_IDX",
                     curr_stmt_sh_idx);
         }

         curr_stmt_sh_idx = SH_NEXT_IDX(curr_stmt_sh_idx);
      }
   }

   if (!print_all_scps) {
      return;
   }

   if (SCP_FIRST_CHILD_IDX(curr_scp_idx) != NULL_IDX) {
      save_curr_scp_idx = curr_scp_idx;
      curr_scp_idx = SCP_FIRST_CHILD_IDX(curr_scp_idx);
      print_all_text(TRUE);
      curr_scp_idx = save_curr_scp_idx;
   }

   if (SCP_SIBLING_IDX(curr_scp_idx) != NULL_IDX) {
      curr_scp_idx = SCP_SIBLING_IDX(curr_scp_idx);
      goto PROCESS_SIBLING;
   }

   fflush(debug_file);
   return;

} /* print_all_text */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      prints list texts and what they point to that are from a              *|
|*      Dv_Whole_Def_Opr.                                                     *|
|*      called by dump_ir_ntry                                                *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void  print_Dv_Whole_Def_Opr(FILE    *out_file,
                                    int      idx,
                                    int      indent,
                                    int      cnt,
#ifdef KEY /* Bug 6845 */
                                    int      n_dim
#endif /* KEY Bug 6845 */
				    )

{
   int	dim;
   char shift[80];
   char n_shift[INDENT_SIZE + 1];
   char str[16];
   int  i;

   for (i = 0; i < INDENT_SIZE * indent; i++) {
      shift[i] = ' ';
      if (i == 79)
         break;
   }
   shift[i] = '\0';
   for (i = 0; i < INDENT_SIZE; i++) {
      n_shift[i] = ' ';
   }
   n_shift[i] = '\0';

   dim = 0;

   for (i = 0; i < cnt; i++) {

      if (idx == NULL_IDX) {
         break;
      }

#ifdef KEY /* Bug 6845 */
      /* Print dope vector "header", then array bounds info if any, then
       * count and offsets for allocatable components if any */
      int first_bound =
        ((sizeof(dv_whole_def_str))/(sizeof(*dv_whole_def_str)));
      int first_alloc_cpnt = first_bound + 3 * n_dim;
      if (i < first_bound) {
         strcpy(str, dv_whole_def_str[i]);
      }
      else if (i < first_alloc_cpnt) {
         sprintf(str, dv_whole_def_bound_str[(i - first_bound) % 3],
	   (i - first_bound) / 3);
      }
      else {
         sprintf(str, dv_whole_def_alloc_cpnt_str, i - first_alloc_cpnt);
      }
#else /* KEY Bug 6845 */
      if (i < 10) {
         strcpy(str, dv_whole_def_str[i]);
      }
      else {
         if ((i - 10)%3 == 0) {
            dim++;
         }
         sprintf(str, dv_whole_def_str[i], dim);
      }
#endif /* KEY Bug 6845 */

      fprintf(out_file,"%s%-15s, idx = %d, %s",shift, str, idx,
                                         field_str[IL_FLD(idx)]);

      if (i == DEBUG_STR_TYPE_CODE) {
         convert_to_string_fmt = Hex_Fmt;
      }

      switch (IL_FLD(idx)) {
         case CN_Tbl_Idx :
         case AT_Tbl_Idx   :
                 fprintf(out_file," line = %d col = %d\n",IL_LINE_NUM(idx),
                                 IL_COL_NUM(idx));
                 break;
         case IL_Tbl_Idx  :
                 fprintf(out_file," list cnt = %d\n", IL_LIST_CNT(idx));
                 break;
         default         :
                 fprintf(out_file,"\n");
                 break;
      }


      switch (IL_FLD(idx)) {
         case NO_Tbl_Idx  :
                 break;
         case CN_Tbl_Idx :
                 print_const_entry(out_file, IL_IDX(idx), indent + 1);
                 break;
         case AT_Tbl_Idx   :
                 print_attr_name(out_file, IL_IDX(idx), indent + 1);
                 break;
         case IR_Tbl_Idx  :
                 dump_ir_ntry(out_file, IL_IDX(idx), indent + 1);
                 break;
         case IL_Tbl_Idx  :
                 print_list(out_file, IL_IDX(idx),
                            indent + 1, IL_LIST_CNT(idx), FALSE);
                 break;
         case SH_Tbl_Idx  :
                 fprintf(out_file, "%s%sstmt header idx = %d\n",shift,n_shift,
                         IL_IDX(idx));
                 break;
      }
      idx = IL_NEXT_LIST_IDX(idx);
   }

   return;

} /* print_Dv_Whole_Def_Opr */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      prints list texts and what they point to that are from a              *|
|*      mp directive opr.                                                     *|
|*      called by dump_ir_ntry                                                *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void  print_mp_dir_opr(FILE    *out_file,
                              int      idx,
                              int      indent,
                              int      cnt)

{
   char shift[80];
   char n_shift[INDENT_SIZE + 1];
   char str[80];
   int  i;


   for (i = 0; i < INDENT_SIZE * indent; i++) {
      shift[i] = ' ';
      if (i == 79)
         break;
   }
   shift[i] = '\0';
   for (i = 0; i < INDENT_SIZE; i++) {
      n_shift[i] = ' ';
   }
   n_shift[i] = '\0';


   for (i = 0; i < cnt; i++) {

      if (idx == NULL_IDX) {
         break;
      }

      strcpy(str, mp_dir_opr_str[i]);

      fprintf(out_file,"%s%-15s, idx = %d, %s",shift, str, idx,
                                         field_str[IL_FLD(idx)]);

      switch (IL_FLD(idx)) {
         case CN_Tbl_Idx :
         case AT_Tbl_Idx   :
                 fprintf(out_file," line = %d col = %d\n",IL_LINE_NUM(idx),
                                 IL_COL_NUM(idx));
                 break;
         case IL_Tbl_Idx  :
                 fprintf(out_file," list cnt = %d\n", IL_LIST_CNT(idx));
                 break;
         default         :
                 fprintf(out_file,"\n");
                 break;
      }


      switch (IL_FLD(idx)) {
         case NO_Tbl_Idx  :
                 break;
         case CN_Tbl_Idx :
                 print_const_entry(out_file, IL_IDX(idx), indent + 1);
                 break;
         case AT_Tbl_Idx   :
                 print_attr_name(out_file, IL_IDX(idx), indent + 1);
                 break;
         case IR_Tbl_Idx  :
                 dump_ir_ntry(out_file, IL_IDX(idx), indent + 1);
                 break;
         case IL_Tbl_Idx  :
                 print_list(out_file, IL_IDX(idx),
                            indent + 1, IL_LIST_CNT(idx), FALSE);
                 break;
         case SH_Tbl_Idx  :
                 fprintf(out_file, "%s%sstmt header idx = %d\n",shift,n_shift,
                         IL_IDX(idx));
                 break;
      }
      idx = IL_NEXT_LIST_IDX(idx);
   }

   return;

} /* print_mp_dir_opr */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      prints list texts and what they point to that are from a              *|
|*      open mp directive opr.                                                *|
|*      called by dump_ir_ntry                                                *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void  print_open_mp_dir_opr(FILE    *out_file,
                                   int      idx,
                                   int      indent,
                                   int      cnt)

{
   char shift[80];
   char n_shift[INDENT_SIZE + 1];
   char str[80];
   int  i;


   for (i = 0; i < INDENT_SIZE * indent; i++) {
      shift[i] = ' ';
      if (i == 79)
         break;
   }
   shift[i] = '\0';
   for (i = 0; i < INDENT_SIZE; i++) {
      n_shift[i] = ' ';
   }
   n_shift[i] = '\0';

   for (i = 0; i < cnt; i++) {

      if (idx == NULL_IDX) {
         break;
      }

      strcpy(str, open_mp_dir_opr_str[i]);

      fprintf(out_file,"%s%-15s, idx = %d, %s",shift, str, idx,
                                         field_str[IL_FLD(idx)]);

      switch (IL_FLD(idx)) {
         case CN_Tbl_Idx :
         case AT_Tbl_Idx   :
                 fprintf(out_file," line = %d col = %d\n",IL_LINE_NUM(idx),
                                 IL_COL_NUM(idx));
                 break;
         case IL_Tbl_Idx  :
                 fprintf(out_file," list cnt = %d\n", IL_LIST_CNT(idx));
                 break;
         default         :
                 fprintf(out_file,"\n");
                 break;
      }


      switch (IL_FLD(idx)) {
         case NO_Tbl_Idx  :
                 break;
         case CN_Tbl_Idx :
                 print_const_entry(out_file, IL_IDX(idx), indent + 1);
                 break;
         case AT_Tbl_Idx   :
                 print_attr_name(out_file, IL_IDX(idx), indent + 1);
                 break;
         case IR_Tbl_Idx  :
                 dump_ir_ntry(out_file, IL_IDX(idx), indent + 1);
                 break;
         case IL_Tbl_Idx  :
                 print_list(out_file, IL_IDX(idx),
                            indent + 1, IL_LIST_CNT(idx), FALSE);
                 break;
         case SH_Tbl_Idx  :
                 fprintf(out_file, "%s%sstmt header idx = %d\n",shift,n_shift,
                         IL_IDX(idx));
                 break;
      }
      idx = IL_NEXT_LIST_IDX(idx);
   }

   return;

} /* print_open_mp_dir_opr */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      prints attr name and index.                                           *|
|*      Used by dump_ir_ntry                                                  *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void  print_attr_name(FILE	*out_file,
			     int	 idx,
			     int         indent)

{
   int  i;
   char shift[80];
   char	str[80];
   int  type_idx;


   for (i = 0; i < INDENT_SIZE * indent; i++) {
      shift[i] = ' ';
      if (i == 79)
         break;
   }

   shift[i] = '\0';

   fprintf(out_file,"%s%s  idx = %d",shift, AT_OBJ_NAME_PTR(idx), idx);

   if (AT_OBJ_CLASS(idx) == Data_Obj) {
      type_idx	= ATD_TYPE_IDX(idx);

      if (type_idx == NULL_IDX && AT_ATTR_LINK(idx) == NULL_IDX) { 

         /* Turn off ir table dump, so this doesn't loop forever */

         dump_flags.ir1_tbl	= FALSE;
         dump_flags.ir2_tbl	= FALSE;
         dump_flags.ir3_tbl	= FALSE;
         dump_flags.ir4_tbl	= FALSE;
         dump_flags.sytb 	= FALSE;

         PRINTMSG(AT_DEF_LINE(idx), 891, Internal, AT_DEF_COLUMN(idx),
                  idx, AT_OBJ_NAME_PTR(idx));
      }

      fprintf(out_file,"  %s * ", basic_type_str[TYP_TYPE(type_idx)]);

      if (TYP_TYPE(type_idx) < Last_Basic_Type) {
         fprintf(out_file, "%s  ", lin_type_str[TYP_LINEAR(type_idx)]);
      }
      else if (TYP_TYPE(type_idx) == Typeless) {
         fprintf(out_file, "%s  ", CONVERT_CVAL_TO_STR(&TYP_BIT_LEN(type_idx),
                                                        Integer_8,
                                                        str));
      }
      else if (TYP_TYPE(type_idx) != Character) {
         fprintf(out_file, "%d  ", TYP_IDX(type_idx));
      }
      else if (TYP_CHAR_CLASS(type_idx) == Assumed_Size_Char) {
         fprintf(out_file, "(*)  ");
      }
      else if (TYP_CHAR_CLASS(type_idx) == Const_Len_Char) {
         fprintf(out_file, "%s  ",
                 convert_to_string(&CN_CONST(TYP_IDX(type_idx)),
                                    CN_TYPE_IDX(TYP_IDX(type_idx)),
                                    str));
      }
      else {  /* Variable or unknown length char - print (tmp_idx = idx) */
         fprintf(out_file, "(tmp_idx = %d)  ", TYP_IDX(type_idx));
      }
   }

   if (AT_ATTR_LINK(idx)) {
      fprintf(out_file,"  AT_ATTR_LINK = %d\n",AT_ATTR_LINK(idx));
   }
   else {
      fprintf(out_file,"\n");
   }

   return;
} /* print_attr_name */


/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      prints list texts and what they point to.                             *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void  print_list(FILE	*out_file,
		        int	 idx,
		        int	 indent,
			int      cnt,
			boolean  io_list)

{
   char shift[80];
   char n_shift[INDENT_SIZE + 1];
   int  i;

   for (i = 0; i < INDENT_SIZE * indent; i++) {
      shift[i] = ' ';
      if (i == 79)
         break;
   }
   shift[i] = '\0';
   for (i = 0; i < INDENT_SIZE; i++) {
      n_shift[i] = ' ';
   }
   n_shift[i] = '\0';

   for (i = 0; i < cnt; i++) {

      if (idx == NULL_IDX) {
         break;
      }

      fprintf(out_file,"%slist item #%d, idx = %d, %s",shift, i + 1, idx,
                                         field_str[IL_FLD(idx)]);

      if (IL_ARG_DESC_VARIANT(idx)) {
         fprintf(out_file, "  IL_ARG_DESC_VARIANT ");
      }

      if (io_list) {
         if (IL_HAS_FUNCTIONS(idx)) {
            fprintf(out_file, "  IL_HAS_FUNCTIONS ");
         }

         if (IL_MUST_FLATTEN(idx)) {
            fprintf(out_file, "  IL_MUST_FLATTEN ");
         }

         if (IL_MUST_BE_LOOP(idx)) {
            fprintf(out_file, "  IL_MUST_BE_LOOP ");
         }
      }
      else {
         if (IL_VECTOR_SUBSCRIPT(idx)) {
            fprintf(out_file, "  IL_VECTOR_SUBSCRIPT ");
         }

         if (IL_CONSTANT_SUBSCRIPT(idx)) {
            fprintf(out_file, "  IL_CONSTANT_SUBSCRIPT ");
         }

         if (IL_PE_SUBSCRIPT(idx)) {
            fprintf(out_file, "  IL_PE_SUBSCRIPT ");
         }
      }

      if (IL_DISTRIBUTION_VARIANT(idx)) {
         fprintf(out_file, " %s ", distribution_str[IL_DISTRIBUTION(idx)]);
      }

      switch (IL_FLD(idx)) {
         case CN_Tbl_Idx :
         case AT_Tbl_Idx   :
         case SB_Tbl_Idx :
                 fprintf(out_file," line = %d col = %d\n",IL_LINE_NUM(idx),
                                 IL_COL_NUM(idx));
                 break;
         case IL_Tbl_Idx  :
                 fprintf(out_file," list cnt = %d\n", IL_LIST_CNT(idx));
                 break;
         default         :
                 fprintf(out_file,"\n");
                 break;
      }


      switch (IL_FLD(idx)) {
         case NO_Tbl_Idx  :
                 break;
         case CN_Tbl_Idx :
                 print_const_entry(out_file, IL_IDX(idx), indent + 1);
                 break;
         case AT_Tbl_Idx   :
                 print_attr_name(out_file, IL_IDX(idx), indent + 1);
                 break;
         case SB_Tbl_Idx :
                 fprintf(out_file,"%s%s%s\n", shift, n_shift,
                         SB_NAME_PTR(IL_IDX(idx)));
                 break;
         case IR_Tbl_Idx  :
                 dump_ir_ntry(out_file, IL_IDX(idx), indent + 1);
                 break;
         case IL_Tbl_Idx  :
                 print_list(out_file, IL_IDX(idx), 
                            indent + 1, IL_LIST_CNT(idx), io_list);
                 break;
         case SH_Tbl_Idx  :
                 fprintf(out_file, "%s%sstmt header idx = %d\n",shift,n_shift,
                         IL_IDX(idx));
                 break;
      }
      idx = IL_NEXT_LIST_IDX(idx);
   }

   if (idx != NULL_IDX) {

      /* Turn off symbol table dump, so this doesn't loop forever */

      dump_flags.sytb		= FALSE;
      dump_flags.ir1_tbl	= FALSE;
      dump_flags.ir2_tbl	= FALSE;
      dump_flags.ir3_tbl	= FALSE;
      dump_flags.ir4_tbl	= FALSE;

      PRINTMSG(1, 670, Internal, 0);
   }

   return;
  
} /* print_list */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      prints constant table entry.                                          *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void  print_const_entry(FILE	*out_file,
		               int	 idx,
			       int      indent)

{
   long		i;
   char 	shift[80];
   int		type_idx;
   char		str[80];


   if (idx == 0 || idx > const_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* CN index value [%d] is out of range.\n",
              idx);
      return;
   }

   type_idx = CN_TYPE_IDX(idx);

   for (i = 0; i < INDENT_SIZE * indent; i++) {
      shift[i] = ' ';
      if (i == 79)
         break;
   }

   shift[i] = '\0';
   fprintf(out_file,"%s", shift);
   print_const_f(out_file, idx);
   fprintf(out_file, "  IDX = %d", idx);

   if (TYP_TYPE(type_idx) == Character) {
      fprintf(out_file, "   LEN = %s", 
              convert_to_string(&CN_CONST(TYP_IDX(type_idx)),
                                CG_INTEGER_DEFAULT_TYPE,
                                str));

   }

   if (TYP_TYPE(type_idx) == Typeless) {
      fprintf(out_file, "  %s  BIT LEN = %s\n",
                        basic_type_str[TYP_TYPE(type_idx)],
                        CONVERT_CVAL_TO_STR(&TYP_BIT_LEN(type_idx),
                                             Integer_8,
                                             str));
   }
   else if (TYP_TYPE(type_idx) < Last_Basic_Type) {
      fprintf(out_file, "  %s * %s\n",
                        basic_type_str[TYP_TYPE(type_idx)],
                        lin_type_str[TYP_LINEAR(type_idx)]);
   }
   else {
      /* 27Nov00[sos} Was:                                                      */
      /* fprintf(out_file, "  %s*(%d)\n", basic_type_str[TYP_TYPE(type_idx)],   */
      /*                                  TYP_IDX(type_idx));                   */
      fprintf(out_file, "  %s\n", print_type_f(type_idx));
   }

   return;

} /* print_const_entry */

/******************************************************************************\
|*									      *|
|*	This section contains routines to print an expanded IR/IL format.     *|
|*	This format is FORTRAN like.                                          *|
|*									      *|
\******************************************************************************/

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	NEED DESCRIPTION						      *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void	print_expanded_stmt(void)
{
   int  save_curr_scp_idx;
   int  save_curr_stmt_sh_idx;

   save_curr_scp_idx     = curr_scp_idx;
   curr_scp_idx          = 1;
   save_curr_stmt_sh_idx = curr_stmt_sh_idx;

   print_expanded_stmt_for_scp();

   curr_scp_idx     = save_curr_scp_idx;
   curr_stmt_sh_idx = save_curr_stmt_sh_idx;

   return;
}


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	NEED DESCRIPTION						      *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void	print_expanded_stmt_for_scp(void)
{
   int		sh_idx;
   int		save_curr_scp_idx;

   init_debug_file();

PROCESS_SIBLING:

   fprintf(debug_file, "\n****************************************"
                      "****************************************\n");
   fprintf(debug_file, "\n\t\t\t EXPANDED IR FOR %s\n\n",
          AT_OBJ_NAME_PTR(SCP_ATTR_IDX(curr_scp_idx)));
   fprintf(debug_file, "****************************************"
                      "****************************************\n\n");


   sh_idx = SCP_FIRST_SH_IDX(curr_scp_idx);

   while (sh_idx != NULL_IDX) {
      print_expanded_ir(SH_IR_IDX(sh_idx));
      fprintf(debug_file, "\n");
      sh_idx	= SH_NEXT_IDX(sh_idx);
   }

   fprintf(debug_file, "\n****************************************"
                      "****************************************\n");

   if (SCP_FIRST_CHILD_IDX(curr_scp_idx) != NULL_IDX) {
      save_curr_scp_idx = curr_scp_idx;
      curr_scp_idx = SCP_FIRST_CHILD_IDX(curr_scp_idx);
      print_expanded_stmt_for_scp();
      curr_scp_idx = save_curr_scp_idx;
   }

   if (SCP_SIBLING_IDX(curr_scp_idx) != NULL_IDX) {
      curr_scp_idx = SCP_SIBLING_IDX(curr_scp_idx);
      goto PROCESS_SIBLING;
   }

   return;
}


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	NEED DESCRIPTION						      *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void  print_expanded_const(int	 idx)

{
   long64	i;
   int		type_idx;
   char		str[80];


   type_idx = CN_TYPE_IDX(idx);

   switch (TYP_TYPE(type_idx)) {
   case Typeless:
      convert_to_string_fmt = Hex_Fmt;
      fprintf(debug_file,"0x%s",
              convert_to_string(&CN_CONST(idx), type_idx, str));

      if (TYP_BIT_LEN(type_idx) > TARGET_BITS_PER_WORD) {

         for (i = 1; 
              i < (TYP_BIT_LEN(type_idx) + TARGET_BITS_PER_WORD - 1) / 
                                           TARGET_BITS_PER_WORD;
              i++) {
            convert_to_string_fmt = Hex_Fmt;
            fprintf(debug_file, "%s",
                    convert_to_string(&CP_CONSTANT(CN_POOL_IDX(idx)+i),
                                       type_idx,
                                       str));
         }
      }
      break;

   case Integer:
      fprintf(debug_file, "%s", convert_to_string(&CN_CONST(idx), 
                                type_idx, str));
      break;

   case Real:
      fprintf(debug_file, "%s", convert_to_string(&CN_CONST(idx), 
                                type_idx, str));
      break;

   case Character:
      fprintf(debug_file,"\"%s\"", (char *) &CN_CONST(idx));
      break;

   case Logical:
      fprintf(debug_file, "%s", (THIS_IS_TRUE(&(CN_CONST(idx)),
                                              CN_TYPE_IDX(idx)) ? 
                                         ".TRUE." :  ".FALSE."));
      break;

   case Complex:
      fprintf(debug_file, "%s", convert_to_string(&CN_CONST(idx),
                                                   CN_TYPE_IDX(idx),
                                                   str));
      break;
   }

   fprintf(debug_file, " ");

   return;

} /* print_expanded_const */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	NEED DESCRIPTION						      *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static	void	print_expanded_ir(int	ir_idx)

{
   switch (IR_OPR(ir_idx)) {
      case Null_Opr:
      case Defined_Un_Opr:
      case Alloc_Opr:
      case SSD_Alloc_Opr:
      case Cvrt_Opr:
      case Dealloc_Opr:
         fprintf(debug_file, "%s ", opr_str[IR_OPR(ir_idx)]);
         break;

/* Unary operators - Opr Left */

      case Uplus_Opr:       
      case Uminus_Opr:
      case Not_Opr:
         fprintf(debug_file, "%s ", opr_str[IR_OPR(ir_idx)]);
         print_expanded_opnd(IR_OPND_L(ir_idx));
         break;

/* Binary operators - Left opr Right */

      case Power_Opr:
      case Mult_Opr:        
      case Div_Opr:
      case Plus_Opr:        
      case Minus_Opr:
      case Concat_Opr:
      case Eq_Opr:          
      case Ne_Opr:
      case Lt_Opr:          
      case Le_Opr:
      case Gt_Opr:          
      case Ge_Opr:
      case And_Opr:
      case Or_Opr:
      case Eqv_Opr:         
      case Neqv_Opr:       
      case Asg_Opr:
         print_expanded_opnd(IR_OPND_L(ir_idx));
         fprintf(debug_file, "%s ", opr_str[IR_OPR(ir_idx)]);
         print_expanded_opnd(IR_OPND_R(ir_idx));
         break;

/* Call operators */

      case Bnot_Opr:
      case Bor_Opr:
      case Beqv_Opr:         
      case Bneqv_Opr:       

      case Abs_Opr:
      case Cos_Opr:
      case Sin_Opr:
      case Log_E_Opr:
      case Log_10_Opr:
      case Gamma_Opr:
      case Log_Gamma_Opr:
      case Tan_Opr:
      case Tanh_Opr:
      case Sinh_Opr:
      case Acos_Opr:
      case Asin_Opr:
      case Atan_Opr:
      case Cosh_Opr:
      case Atan2_Opr:
      case Aimag_Opr:
      case Sqrt_Opr:
      case Cot_Opr:
      case Exp_Opr:
      case Int_Opr:
      case Band_Opr:
      case Mod_Opr:
      case Anint_Opr:
      case Nint_Opr:
      case Sign_Opr:
      case Modulo_Opr:
      case Shift_Opr:
      case Shiftl_Opr:
      case Shiftr_Opr:
      case Leadz_Opr:
      case Popcnt_Opr:
      case Poppar_Opr:
      case Aint_Opr:
      case Dim_Opr:
      case Ranget_Opr:
      case Ranset_Opr:
      case Ranf_Opr:
      case Real_Opr:
      case Dble_Opr:
      case Mask_Opr:
      case Conjg_Opr:
      case Dprod_Opr:
      case Length_Opr:
      case Getpos_Opr:
      case Unit_Opr:
      case Cmplx_Opr:
      case Ichar_Opr:
      case Char_Opr:
      case Index_Opr:
      case Lge_Opr:
      case Lgt_Opr:
      case Lle_Opr:
      case Llt_Opr:
      case Fcd_Opr:
      case Numarg_Opr:
      case Rtc_Opr:
      case Cvmgp_Opr:
      case Cvmgm_Opr:
      case Cvmgz_Opr:
      case Cvmgn_Opr:
      case Cvmgt_Opr:
      case Csmg_Opr:
      case Adjustl_Opr:
      case Adjustr_Opr:
      case Ceiling_Opr:
      case Exponent_Opr:
      case Floor_Opr:
      case Fraction_Opr:
      case Spacing_Opr:
      case Logical_Opr:
      case Nearest_Opr:
      case Rrspacing_Opr:
      case Scale_Opr:
      case Scan_Opr:
      case Set_Exponent_Opr:
      case Verify_Opr:
      case Len_Trim_Opr:
      case Dshiftl_Opr:
      case Dshiftr_Opr:
      case Mmx_Opr:
      case Mldmx_Opr:
      case Mld_Opr:
      case Mul_Opr:
      case Mcbl_Opr:
      case Cshift_Opr:
      case Dot_Product_Opr:
      case Matmul_Opr:
      case Spread_Opr:
      case Transpose_Opr:
      case All_Opr:
      case Any_Opr:
      case Count_Opr:
      case Product_Opr:
      case Sum_Opr:
      case Eoshift_Opr:
      case Maxval_Opr:
      case Minval_Opr:
      case Maxloc_Opr:
      case Minloc_Opr:
      case Reshape_Opr:
      case SRK_Opr:
      case SIK_Opr:
      case Repeat_Opr:
      case Trim_Opr:
      case Transfer_Opr:
#ifdef KEY /* Bug 1324 */
      case Erf_Opr:
      case Erfc_Opr:
#endif /* KEY Bug 1324 */
#ifdef KEY /* Bug 10410 */
      case Cselect_Opr:
#endif /* KEY Bug 10410 */
# ifdef _TARGET_OS_MAX
      case My_Pe_Opr:
# endif
         fprintf(debug_file, "%s ", opr_str[IR_OPR(ir_idx)]);
         print_expanded_opnd(IR_OPND_L(ir_idx));
         print_expanded_opnd(IR_OPND_R(ir_idx));
         fprintf(debug_file, ")");
         break;

      case Call_Opr:
         fprintf(debug_file, "%s ", opr_str[IR_OPR(ir_idx)]);
         print_expanded_opnd(IR_OPND_L(ir_idx));
         fprintf(debug_file, "(");
         print_expanded_opnd(IR_OPND_R(ir_idx));
         fprintf(debug_file, ")");
         break;

      case Defined_Bin_Opr:

      case Alt_Return_Opr:
      case Case_Opr:
      case Allocate_Opr:
      case Deallocate_Opr:
      case End_Opr:
      case Entry_Opr:
      case Nullify_Opr:
      case Pause_Opr:
      case Ptr_Asg_Opr:
      case ProcPtr_Asg_Opr:
      case Flat_Array_Asg_Opr:
      case Return_Opr:
      case Select_Opr:
      case Stmt_Func_Call_Opr:
      case Stop_Opr:
      case Max_Opr:
      case Min_Opr:
      case Read_Formatted_Opr:
      case Read_Unformatted_Opr:
      case Read_Namelist_Opr:
      case Write_Formatted_Opr:
      case Write_Unformatted_Opr:
      case Write_Namelist_Opr:
      case Inquire_Iolength_Opr:
      case Dv_Whole_Copy_Opr:
      case Dv_Whole_Def_Opr:
      case Dv_Deref_Opr:
      case Dv_Access_Base_Addr:
      case Dv_Set_Base_Addr:
      case Dv_Access_El_Len:
      case Dv_Set_El_Len:
      case Dv_Access_Assoc:
      case Dv_Set_Assoc:
      case Dv_Access_Ptr_Alloc:
      case Dv_Set_Ptr_Alloc:
      case Dv_Access_P_Or_A:
      case Dv_Set_P_Or_A:
      case Dv_Access_A_Contig:
      case Dv_Set_A_Contig:
      case Dv_Access_N_Dim:
      case Dv_Set_N_Dim:
      case Dv_Access_Typ_Code:
      case Dv_Set_Typ_Code:
      case Dv_Access_Orig_Base:
      case Dv_Set_Orig_Base:
      case Dv_Access_Orig_Size:
      case Dv_Set_Orig_Size:
      case Dv_Access_Low_Bound:
      case Dv_Set_Low_Bound:
      case Dv_Access_Extent:
      case Dv_Set_Extent:
      case Dv_Access_Stride_Mult:
      case Dv_Set_Stride_Mult:
      case Br_Aif_Opr:
      case Br_Asg_Opr:
      case Br_Index_Opr:
      case Br_True_Opr:
      case Br_Uncond_Opr:
      case Case_Range_Opr:
      case Implied_Do_Opr:
      case Kwd_Opr:
      case Loc_Opr:
      case Aloc_Opr:
      case Const_Tmp_Loc_Opr:
      case Len_Opr:
      case Clen_Opr:
      case Paren_Opr:
      case Struct_Opr:
      case Struct_Construct_Opr:
      case Array_Construct_Opr:
      case Constant_Struct_Construct_Opr:
      case Constant_Array_Construct_Opr:
      case Subscript_Opr:
      case Whole_Subscript_Opr:
      case Section_Subscript_Opr:
      case Alloc_Obj_Opr:
      case Dealloc_Obj_Opr:
      case Substring_Opr:
      case Whole_Substring_Opr:
      case Triplet_Opr:
      case Label_Opr:
      case Loop_Info_Opr:
      case Loop_End_Opr:
      case Init_Opr:
      case Init_Reloc_Opr:
      case Use_Opr:
      case Where_Opr:
      case Real_Div_To_Int_Opr:
      case Suppress_Opr:
      case Cache_Bypass_Cdir_Opr:
      case Vector_Cdir_Opr:
      case Novector_Cdir_Opr:
      case Task_Cdir_Opr:
      case Notask_Cdir_Opr:
      case Bounds_Cdir_Opr:
      case Nobounds_Cdir_Opr:
      case Recurrence_Cdir_Opr:
      case Norecurrence_Cdir_Opr:
      case Vsearch_Cdir_Opr:
      case Novsearch_Cdir_Opr:
      case Bl_Cdir_Opr:
      case Nobl_Cdir_Opr:
      case Inline_Cdir_Opr:
      case Noinline_Cdir_Opr:
      case Ivdep_Cdir_Opr:
      case Nextscalar_Cdir_Opr:
      case Prefervector_Cdir_Opr:
      case Prefertask_Cdir_Opr:
      case Shortloop_Cdir_Opr:
      case Shortloop128_Cdir_Opr:
      case Cachealign_Cdir_Opr:
      case Nounroll_Cdir_Opr:
      case Unroll_Cdir_Opr:
      case Align_Cdir_Opr:
      case Case_Cmic_Opr:
      case Endcase_Cmic_Opr:
      case Continue_Cmic_Opr:
      case Cncall_Cmic_Opr:
      case Doall_Cmic_Opr:
      case Doparallel_Cmic_Opr:
      case Enddo_Cmic_Opr:
      case Guard_Cmic_Opr:
      case Endguard_Cmic_Opr:
      case Numcpus_Cmic_Opr:
      case Parallel_Cmic_Opr:
      case Endparallel_Cmic_Opr:
      case Permutation_Cmic_Opr:
      case Taskcommon_Cmic_Opr:
      case Wait_Cmic_Opr:
      case Send_Cmic_Opr:
      case The_Last_Opr:
         fprintf(debug_file, "%s ", opr_str[IR_OPR(ir_idx)]);
         print_expanded_opnd(IR_OPND_L(ir_idx));
         print_expanded_opnd(IR_OPND_R(ir_idx));
         break;

      }
   return;
}


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	NEED DESCRIPTION						      *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static	void	print_expanded_opnd(opnd_type	the_opnd)

{
   switch(OPND_FLD(the_opnd)) {

   case AT_Tbl_Idx:
      fprintf(debug_file, "%s ", AT_OBJ_NAME_PTR(OPND_IDX(the_opnd)));
      break;

   case CN_Tbl_Idx:
      print_expanded_const(OPND_IDX(the_opnd));
      break;

   case IR_Tbl_Idx:
      print_expanded_ir(OPND_IDX(the_opnd));
      break;

   case IL_Tbl_Idx:
      print_expanded_il(OPND_IDX(the_opnd));
      break;

   }

   return;
}


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	NEED DESCRIPTION						      *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static	void	print_expanded_il(int	il_idx)

{
   while (il_idx != NULL_IDX) {
      switch (IL_FLD(il_idx)) {
      case AT_Tbl_Idx:
         fprintf(debug_file, "%s ", AT_OBJ_NAME_PTR(IL_IDX(il_idx)));
         break;

      case CN_Tbl_Idx:
         print_expanded_const(IL_IDX(il_idx));
         break;

      case IR_Tbl_Idx:
         print_expanded_ir(IL_IDX(il_idx));
         break;

      case IL_Tbl_Idx:
         print_expanded_il(IL_IDX(il_idx));
         break;

      case SH_Tbl_Idx:
         break;
      }
      il_idx = IL_NEXT_LIST_IDX(il_idx);

      if (il_idx != NULL_IDX) {
         fprintf(debug_file, ", ");
      }
   }

   return;

}  /* print_expanded_il */

/******************************************************************************\
|*									      *|
|* The following are the actual dump routines for each table.  Global variable*|
|* full_debug_dump is used to control how much is dumped.  If it is TRUE, all *|
|* fields are printed in whatever routine is being called.  If it is FALSE,   *|
|* fields are printed except for index fields.  This is to allow for better   *|
|* comparisons.  Default is FALSE.                                            *|
|*									      *|
\******************************************************************************/

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints one attr list table entry to the specified output file.        *|
|*									      *|
|* Input parameters:							      *|
|*	FILE to print to - Should be debug_file, stderr, or stdout.           *|
|*	Index of attribute list entry to print.                               *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/
static void dump_al_ntry (FILE		*out_file,
   		          int	 	 al_idx)

{
   if (al_idx > attr_list_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* AL index value [%d] is out of range.\n",
              al_idx);
      return;
   }

   if (AL_IDX_IS_EQ(al_idx)) {
      fprintf(out_file, " %-10s= %-6d  %-5s= %-6d\n",
              "AL_EQ_IDX", AL_EQ_IDX(al_idx),
              "NEXT", AL_NEXT_IDX(al_idx));
   }
   else if (AL_FREE(al_idx)) {
      fprintf(out_file, " %-10s= %-6s  %-5s= %-6d\n",
              "AL_FREE", boolean_str[AL_FREE(al_idx)],
              "NEXT", AL_NEXT_IDX(al_idx));
   }
   else {
      fprintf(out_file, " %-4s= %-6d %-4s= %-6d %-14s= %-6d %-s\n",
                        "ATTR", AL_ATTR_IDX(al_idx),
                        "NEXT", AL_NEXT_IDX(al_idx),
                        "Special field", AL_ENTRY_COUNT(al_idx),
                         AT_OBJ_NAME_PTR(AL_ATTR_IDX(al_idx)));
   }

   return;

}  /* dump_al_ntry */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints one attr table entry to the specified output file.             *|
|*									      *|
|* Input parameters:							      *|
|*	FILE to print to - Should be debug_file, stderr, or stdout.           *|
|*	Index of attribute entry to print.                                    *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_at_ntry (FILE		*out_file,
   		          int	 	 at_idx,
			  boolean	 dump_all)

{
   int		il_idx;
   int		ro_idx;
   char		str[80];
   char		conv_str[80];


   if (at_idx > attr_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* AT index value [%d] is out of range.\n",
              at_idx);
      return;
   }

   if (out_file == NULL)
       out_file = stdout;

   /* Note that the fields are displayed in alphabetical order.         */

   fprintf(out_file, "%s\n", AT_OBJ_NAME_PTR(at_idx));

   fprintf(out_file, "  %-25s %-25s %-16s= %-8d\n",
                     obj_class_str[AT_OBJ_CLASS(at_idx)],
                     reference_str[AT_REFERENCED(at_idx)],
                     "IDX", at_idx);

#ifdef KEY /* Bug 5091 */
   int at_is_darg = AT_IS_DARG(at_idx);
   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                     "AT_ACCESS_SET", boolean_str[AT_ACCESS_SET(at_idx)],
                     "AT_ACTUAL_ARG", boolean_str[AT_ACTUAL_ARG(at_idx)],
                     at_is_darg ? "AT_ALT_DARG" : "AT_PROTECTED",
		       boolean_str[at_is_darg ? AT_ALT_DARG(at_idx) :
		         AT_PROTECTED(at_idx)]);
#else /* KEY Bug 5091 */
   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                     "AT_ACCESS_SET", boolean_str[AT_ACCESS_SET(at_idx)],
                     "AT_ACTUAL_ARG", boolean_str[AT_ACTUAL_ARG(at_idx)],
                     "AT_ALT_DARG",   boolean_str[AT_ALT_DARG(at_idx)]);
#endif /* KEY Bug 5091 */

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8s\n",
                     "AT_ARG_TO_KIND",   boolean_str[AT_ARG_TO_KIND(at_idx)],
                     "AT_ATTR_LINK",     AT_ATTR_LINK(at_idx),
                     "AT_CIF_DONE",      boolean_str[AT_CIF_DONE(at_idx)]);

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8s\n",
                    "AT_CIF_IN_USAGE_",boolean_str[AT_CIF_IN_USAGE_REC(at_idx)],
                    "AT_CIF_SYMBOL_ID", AT_CIF_SYMBOL_ID(at_idx),
                    "AT_CIF_USE_IN_BN", boolean_str[AT_CIF_USE_IN_BND(at_idx)]);

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8d\n",
                     "AT_COMPILER_GEND", boolean_str[AT_COMPILER_GEND(at_idx)], 
                     "AT_DCL_ERR", boolean_str[AT_DCL_ERR(at_idx)],
                     "AT_DEF_COLUMN", AT_DEF_COLUMN(at_idx));

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
                     "AT_DEF_LINE", AT_DEF_LINE(at_idx),
                     "AT_DEF_IN_CHILD", boolean_str[AT_DEF_IN_CHILD(at_idx)],
                     "AT_DEFINED", boolean_str[AT_DEFINED(at_idx)]);

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                   "AT_ELEMENTAL_INT", boolean_str[AT_ELEMENTAL_INTRIN(at_idx)],
                   "AT_HOST_ASSOCIAT",boolean_str[AT_HOST_ASSOCIATED(at_idx)],
                   "AT_IGNORE_ATTR_L",boolean_str[AT_IGNORE_ATTR_LINK(at_idx)]);

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                     "AT_IS_DARG", boolean_str[AT_IS_DARG(at_idx)],
                     "AT_IS_INTRIN", boolean_str[AT_IS_INTRIN(at_idx)],
                     "AT_LOCKED_IN", boolean_str[AT_LOCKED_IN(at_idx)]);

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8d\n",
                     "AT_MODULE_IDX", AT_MODULE_IDX(at_idx),
                     "AT_MODULE_OBJECT", boolean_str[AT_MODULE_OBJECT(at_idx)],
                     "AT_NAME_LEN", AT_NAME_LEN(at_idx));

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8d\n",
                     "AT_NAMELIST_OBJ", boolean_str[AT_NAMELIST_OBJ(at_idx)],
                     "AT_NOT_VISIBLE", boolean_str[AT_NOT_VISIBLE(at_idx)],
                     "AT_ORIG_MODULE_I", AT_ORIG_MODULE_IDX(at_idx));

   fprintf(out_file, "  %-16s= %-7d %-16s= %-s\n",
                     "AT_ORIG_NAME_LEN", AT_ORIG_NAME_LEN(at_idx),
                     "AT_ORIG_NAME_IDX", (AT_ORIG_NAME_IDX(at_idx) == NULL_IDX)
                                         ? "0": AT_ORIG_NAME_PTR(at_idx));

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                     "AT_OPTIONAL", boolean_str[AT_OPTIONAL(at_idx)],
                     "AT_PRIVATE", access_str[AT_PRIVATE(at_idx)],
                     "AT_REF_IN_CHILD", boolean_str[AT_REF_IN_CHILD(at_idx)]);

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                     "AT_SEMANTICS_DON", boolean_str[AT_SEMANTICS_DONE(at_idx)],
                     "AT_TYPED", boolean_str[AT_TYPED(at_idx)],
                     "AT_USE_ASSOCIATE",boolean_str[AT_USE_ASSOCIATED(at_idx)]);

   /* Note that the fields are displayed in alphabetical order.         */

   switch (AT_OBJ_CLASS(at_idx)) {

      case Data_Obj:

         fprintf(out_file, "  %-25s %-16s= %-7s %-16s= %-8s\n",
                 atd_class_str[ATD_CLASS(at_idx)],
                 "ATD_ALIGN_SYMBOL", boolean_str[ATD_ALIGN_SYMBOL(at_idx)],
                 "ATD_ALIGNMENT", align_str[ATD_ALIGNMENT(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8s\n",
                 "ATD_ALLOCATABLE", boolean_str[ATD_ALLOCATABLE(at_idx)],
                 "ATD_ARRAY_IDX", ATD_ARRAY_IDX(at_idx),
                 "ATD_AUTOMATIC", boolean_str[ATD_AUTOMATIC(at_idx)]);

         if (ATD_AUTOMATIC(at_idx)) {
            fprintf(out_file, "  %-16s= %-7d %-33s\n",
                   "ATD_AUTO_BASE_ID", ATD_AUTO_BASE_IDX(at_idx),
                   print_at_name(ATD_AUTO_BASE_IDX(at_idx)));
         }

#ifdef KEY /* Bug 14150 */
	 if (ATD_CLASS(at_idx) != Dummy_Argument) {
            fprintf(out_file, "  %-16s= %-7s\n",
                    "AT_BIND_ATTR", boolean_str[AT_BIND_ATTR(at_idx)]);
	 }
#endif /* KEY Bug 14150 */

         if (ATD_CLASS(at_idx) == Variable) {
            fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
                    "ATD_ASSIGN_TMP_I", ATD_ASSIGN_TMP_IDX(at_idx),
                    "ATD_AUXILIARY", boolean_str[ATD_AUXILIARY(at_idx)],
                    "ATD_BOUNDS_CHECK", boolean_str[ATD_BOUNDS_CHECK(at_idx)]);

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                "ATD_CACHE_ALIGN", boolean_str[ATD_CACHE_ALIGN(at_idx)],
                "ATD_CACHE_BYPASS", boolean_str[ATD_CACHE_BYPASS_ARRAY(at_idx)],
                "ATD_CACHE_NOALLO", boolean_str[ATD_CACHE_NOALLOC(at_idx)]);

            fprintf(out_file, "  %-16s= %-7s\n",
                "ATD_CHAR_LEN_IN_", boolean_str[ATD_CHAR_LEN_IN_DV(at_idx)]);
         }
         else {
            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
               "ATD_AUXILIARY", boolean_str[ATD_AUXILIARY(at_idx)],
               "ATD_BOUNDS_CHECK", boolean_str[ATD_BOUNDS_CHECK(at_idx)],
               "ATD_CACHE_BYPASS", boolean_str[ATD_CACHE_BYPASS_ARRAY(at_idx)]);

            if (ATD_CLASS(at_idx) == Compiler_Tmp) {
               fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8d\n",
                  "ATD_CACHE_NOALLO", boolean_str[ATD_CACHE_NOALLOC(at_idx)],
                  "ATD_CHAR_LEN_IN_", boolean_str[ATD_CHAR_LEN_IN_DV(at_idx)],
                  "ATD_DEFINING_ATT", ATD_DEFINING_ATTR_IDX(at_idx));
            }
            else {
               fprintf(out_file, "  %-16s= %-7s %-16s= %-7s\n",
                  "ATD_CACHE_NOALLO", boolean_str[ATD_CACHE_NOALLOC(at_idx)],
                  "ATD_CHAR_LEN_IN_", boolean_str[ATD_CHAR_LEN_IN_DV(at_idx)]);
            }
         }


         if (ATD_CLASS(at_idx) == Struct_Component) {
           fprintf(out_file, "  %-16s= %-7d \n",
                   "ATD_DERIVED_TYPE", ATD_DERIVED_TYPE_IDX(at_idx));

            print_fld_idx(out_file, "ATD_CPNT_OFFSET_",
                          ATD_OFFSET_FLD(at_idx),
                          ATD_CPNT_OFFSET_IDX(at_idx));

            print_fld_idx(out_file, "ATD_CPNT_INIT_ID",
                          (fld_type) ATD_FLD(at_idx),
                          ATD_CPNT_INIT_IDX(at_idx));

            if (ATD_CPNT_INIT_IDX(at_idx) != NULL_IDX) { 

               if (ATD_FLD(at_idx) == IR_Tbl_Idx) {
                  dump_ir_ntry(out_file, ATD_CPNT_INIT_IDX(at_idx), 5);
               }
               else if (ATD_FLD(at_idx) == CN_Tbl_Idx) {
                  dump_cn_ntry(out_file, ATD_CPNT_INIT_IDX(at_idx));
               }
            }
         }
         else if (ATD_CLASS(at_idx) == Constant) {
             print_fld_idx(out_file, "ATD_CONST_IDX",
                           (fld_type) ATD_FLD(at_idx),
                           ATD_CONST_IDX(at_idx));
         }

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATD_COPY_ASSUMED",boolean_str[ATD_COPY_ASSUMED_SHAPE(at_idx)],
                 "ATD_DATA_INIT", boolean_str[ATD_DATA_INIT(at_idx)],
                 "ATD_DCL_EQUIV", boolean_str[ATD_DCL_EQUIV(at_idx)]);

         fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
                 "ATD_DISTRIBUTION", ATD_DISTRIBUTION_IDX(at_idx),
                 "ATD_WAS_SCOPED", boolean_str[ATD_WAS_SCOPED(at_idx)],
                 "ATD_DYNAMIC", boolean_str[ATD_DYNAMIC(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8d\n",
                 "ATD_EQUIV", boolean_str[ATD_EQUIV(at_idx)],
                 "ATD_EQUIV_IN_BND",boolean_str[ATD_EQUIV_IN_BNDS_EXPR(at_idx)],
                 "ATD_EQUIV_LIST", ATD_EQUIV_LIST(at_idx));

         if (ATD_EQUIV_LIST(at_idx) != NULL_IDX) {
            print_al_list(out_file, ATD_EQUIV_LIST(at_idx));
         }

# if defined(_EXPRESSION_EVAL)

         if (cmd_line_flags.expression_eval_stmt || 
             cmd_line_flags.expression_eval_expr) {
            fprintf(out_file, "  %-16s= %-7s\n",
                   "ATD_EXPR_EVAL_TMP", boolean_str[ATD_EXPR_EVAL_TMP(at_idx)]);
         }
# endif

         fprintf(out_file,"  %-16s= %-7s %-16s= %-7d %-16s= %-8s\n",
                 "ATD_FILL_SYMBOL", boolean_str[ATD_FILL_SYMBOL(at_idx)],
                 "ATD_FIRST_SEEN_I", ATD_FIRST_SEEN_IL_IDX(at_idx),
                 "ATD_FORALL_INDEX",boolean_str[ATD_FORALL_INDEX(at_idx)]);

         if (ATD_CLASS(at_idx) == Function_Result) {
            fprintf(out_file, "  %-16s= %-s\n",
                    "Function Name", print_at_name(ATD_FUNC_IDX(at_idx)));
         }
         else if (ATD_CLASS(at_idx) == Dummy_Argument) {
#ifdef KEY /* Bug 14150 */
            fprintf(out_file,"  %-16s= %-7s %-16s= %-7s %-16s= %-7s\n",
                    "ATD_INTENT",intent_str[ATD_INTENT(at_idx)],
                    "ATD_INTRIN_DARG", boolean_str[ATD_INTRIN_DARG(at_idx)],
		    "ATD_VALUE_ATTR", boolean_str[ATD_VALUE_ATTR(at_idx)]
		    );
#else /* KEY Bug 14150 */
            fprintf(out_file,"  %-16s= %-7s %-16s= %-7s\n",
                    "ATD_INTENT",intent_str[ATD_INTENT(at_idx)],
                    "ATD_INTRIN_DARG", boolean_str[ATD_INTRIN_DARG(at_idx)]);
#endif /* KEY Bug 14150 */

            if (ATD_INTRIN_DARG(at_idx)) {
               fprintf(out_file,"  %-20s= %-22o\n",
                       "ATD_INTRIN_DARG_TYPE", ATD_INTRIN_DARG_TYPE(at_idx));
            }
         }

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
		 "ATD_IGNORE_TKR", boolean_str[ATD_IGNORE_TKR(at_idx)],
		 "ATD_IM_A_DOPE", boolean_str[ATD_IM_A_DOPE(at_idx)],
                 "ATD_IMP_DO_LCV", boolean_str[ATD_IMP_DO_LCV(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATD_IN_ASSIGN", boolean_str[ATD_IN_ASSIGN(at_idx)],
                 "ATD_IN_COMMON", boolean_str[ATD_IN_COMMON(at_idx)],
                 "ATD_LCV_IS_CONST", boolean_str[ATD_LCV_IS_CONST(at_idx)]);

         if (ATD_CLASS(at_idx) == Compiler_Tmp ||
             ATD_CLASS(at_idx) == Dummy_Argument) {

            if (ATD_NO_ENTRY_LIST(at_idx) != NULL_IDX) {
               fprintf(out_file,"\n");
               print_al_list(out_file, ATD_NO_ENTRY_LIST(at_idx));
            }
         }

         if ((ATD_CLASS(at_idx) == Variable ||
              ATD_CLASS(at_idx) == Compiler_Tmp) &&
              ATD_IN_COMMON(at_idx)) {
            fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8s\n",
                "ATD_LIVE_DO_VAR", boolean_str[ATD_LIVE_DO_VAR(at_idx)],
                "ATD_NEXT_MEMBER_", ATD_NEXT_MEMBER_IDX(at_idx),
                "ATD_NOBOUNDS_CHE",boolean_str[ATD_NOBOUNDS_CHECK(at_idx)]);

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s\n",
                "ATD_NOT_PT_UNIQU", boolean_str[ATD_NOT_PT_UNIQUE_MEM(at_idx)],
                 "ATD_OFFSET_ASSIG",boolean_str[ATD_OFFSET_ASSIGNED(at_idx)]);
         }
         else {
            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-7s\n",
                "ATD_LIVE_DO_VAR", boolean_str[ATD_LIVE_DO_VAR(at_idx)],
                "ATD_NOBOUNDS_CHE",boolean_str[ATD_NOBOUNDS_CHECK(at_idx)],
                "ATD_NOT_PT_UNIQU", boolean_str[ATD_NOT_PT_UNIQUE_MEM(at_idx)]);

            fprintf(out_file, "  %-16s= %-7s\n",
                "ATD_OFFSET_ASSIG",boolean_str[ATD_OFFSET_ASSIGNED(at_idx)]);
         }

         if ((ATD_CLASS(at_idx) == Variable && !ATD_AUTOMATIC(at_idx)) ||
             ((ATD_CLASS(at_idx) == Dummy_Argument ||
               ATD_CLASS(at_idx) == Compiler_Tmp) && 
               ATD_OFFSET_ASSIGNED(at_idx)) ||
             ATD_CLASS(at_idx) == Function_Result) {
            print_fld_idx(out_file, "ATD_OFFSET_IDX",
                          ATD_OFFSET_FLD(at_idx),
                          ATD_OFFSET_IDX(at_idx));
         }
         else if (ATD_CLASS(at_idx) == CRI__Pointee) {
            fprintf(out_file,"  %-16s= %-7d %-s\n",
                   "Pointer Name", ATD_PTR_IDX(at_idx),
                   print_at_name(ATD_PTR_IDX(at_idx)));
         }

	 if (TYP_LINEAR(ATD_TYPE_IDX(at_idx)) == Proc_Ptr &&
	     (ATD_CLASS(at_idx) == Variable ||
	      ATD_CLASS(at_idx) == Dummy_Argument ||
	      ATD_CLASS(at_idx) == Function_Result ||
	      ATD_CLASS(at_idx) == Struct_Component))
	     fprintf(out_file, "  %-16s= %-7d\n", "ATD_PP_ATP",
		     ATD_PP_ATP(at_idx));

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8s\n",
                 "ATD_PARENT_OBJEC",boolean_str[ATD_PARENT_OBJECT(at_idx)],
                 "ATD_PE_ARRAY_IDX", ATD_PE_ARRAY_IDX(at_idx),
                 "ATD_PERMUTATION", boolean_str[ATD_PERMUTATION(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATD_POINTER", boolean_str[ATD_POINTER(at_idx)],
                 "ATD_PTR_ASSIGNED", boolean_str[ATD_PTR_ASSIGNED(at_idx)],
                 "ATD_PTR_HALF_WOR", boolean_str[ATD_PTR_HALF_WORD(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATD_PTR_TYPE_SET",boolean_str[ATD_PTR_TYPE_SET(at_idx)],
                 "ATD_PURE",boolean_str[ATD_PURE(at_idx)],
                 "ATD_RESHAPE ARRA",boolean_str[ATD_RESHAPE_ARRAY_OPT(at_idx)]);

         fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
                 "ATD_RESHAPE_IDX", ATD_RESHAPE_ARRAY_IDX(at_idx),
                 "ATD_SAVED", boolean_str[ATD_SAVED(at_idx)],
                 "ATD_SECTION_GP", boolean_str[ATD_SECTION_GP(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATD_SECTION_NON_", boolean_str[ATD_SECTION_NON_GP(at_idx)],
                 "ATD_SEEN_AS_LCV", boolean_str[ATD_SEEN_AS_LCV(at_idx)],
                 "ATD_SEEN_AS_IO_", boolean_str[ATD_SEEN_AS_IO_LCV(at_idx)]);


         if (ATD_CLASS(at_idx) == Dummy_Argument) {

            if (ATD_SF_DARG(at_idx)) {
               print_fld_idx(out_file, "ATD_SF_ARG_IDX",
                             (fld_type) ATD_FLD(at_idx),
                             ATD_SF_ARG_IDX(at_idx));

               fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
                 "ATD_SF_LINK", ATD_SF_LINK(at_idx),
                 "ATD_SYMBOLIC_CON",boolean_str[ATD_SYMBOLIC_CONSTANT(at_idx)],
                 "ATD_SYMMETRIC", boolean_str[ATD_SYMMETRIC(at_idx)]);
            }
            else {
                fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                  "ATD_SF_DARG", boolean_str[ATD_SF_DARG(at_idx)],
                  "ATD_SYMBOLIC_CON",boolean_str[ATD_SYMBOLIC_CONSTANT(at_idx)],
                  "ATD_SYMMETRIC", boolean_str[ATD_SYMMETRIC(at_idx)]);
            }

            fprintf(out_file, "  %-16s= %-7s\n",
                   "ATD_SEEN_IN_IMP", boolean_str[ATD_SEEN_IN_IMP_DO(at_idx)]);
         }
         else {
             fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                  "ATD_SEEN_IN_IMP", boolean_str[ATD_SEEN_IN_IMP_DO(at_idx)],
                  "ATD_SYMBOLIC_CON",boolean_str[ATD_SYMBOLIC_CONSTANT(at_idx)],
                  "ATD_SYMMETRIC", boolean_str[ATD_SYMMETRIC(at_idx)]);
         }

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8d\n",
                 "ATD_SEEN_OUTSID",boolean_str[ATD_SEEN_OUTSIDE_IMP_DO(at_idx)],
                 "ATD_STACK", boolean_str[ATD_STACK(at_idx)],
                 "ATD_STOR_BLK_IDX", ATD_STOR_BLK_IDX(at_idx));

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATD_TARGET", boolean_str[ATD_TARGET(at_idx)],
                 "ATD_TASK_COPYIN", boolean_str[ATD_TASK_COPYIN(at_idx)],
                 "ATD_TASK_FIRSTPR",boolean_str[ATD_TASK_FIRSTPRIVATE(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATD_TASK_GETFIRS", boolean_str[ATD_TASK_GETFIRST(at_idx)],
                 "ATD_TASK_LASTLOC",boolean_str[ATD_TASK_LASTLOCAL(at_idx)],
                 "ATD_TASK_LASTPRI", boolean_str[ATD_TASK_LASTPRIVATE(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATD_TASK_LASTTHR",boolean_str[ATD_TASK_LASTTHREAD(at_idx)],
                 "ATD_TASK_PRIVATE", boolean_str[ATD_TASK_PRIVATE(at_idx)],
                 "ATD_TASK_SHARED", boolean_str[ATD_TASK_SHARED(at_idx)]);


         if (ATD_CLASS(at_idx) == Compiler_Tmp) {
            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATD_TMP_GEN_ZERO", boolean_str[ATD_TMP_GEN_ZERO(at_idx)],
                 "ATD_TMP_HAS_CVRT", boolean_str[ATD_TMP_HAS_CVRT_OPR(at_idx)],
                 "ATD_TMP_INIT_NOT",boolean_str[ATD_TMP_INIT_NOT_DONE(at_idx)]);

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s=%-7s\n",
                "ATD_TMP_NEEDS_CI",boolean_str[ATD_TMP_NEEDS_CIF(at_idx)],
                "ATD_TMP_SEMANTIC",boolean_str[ATD_TMP_SEMANTICS_DONE(at_idx)],
                "ATD_TOO_BIG_FOR_",boolean_str[ATD_TOO_BIG_FOR_DV(at_idx)]);

            print_fld_idx(out_file, "ATD_TMP_IDX",
                          (fld_type) ATD_FLD(at_idx),
                          ATD_TMP_IDX(at_idx));

            if (ATD_SYMBOLIC_CONSTANT(at_idx) && ATD_FLD(at_idx) == IR_Tbl_Idx){
               dump_ir_ntry(out_file, ATD_TMP_IDX(at_idx), 4);
            }

            if (ATD_TMP_INIT_NOT_DONE(at_idx)) { /* dump tmp's constant */
               fprintf(out_file, "\nCONSTANT FOR INIT\n");

               if (ATD_FLD(at_idx) == CN_Tbl_Idx) {
                  dump_cn_ntry(out_file, ATD_TMP_IDX(at_idx));
               }
               else {
                  fprintf(out_file, "COUNT = \n");
                  dump_cn_ntry(out_file, IR_IDX_L(ATD_TMP_IDX(at_idx)));
                  fprintf(out_file, "VALUE = \n");
                  dump_cn_ntry(out_file, IR_IDX_R(ATD_TMP_IDX(at_idx)));
               }

            }
         }
         else {
            fprintf(out_file, "  %-16s= %-7s\n",
                "ATD_TOO_BIG_FOR_",boolean_str[ATD_TOO_BIG_FOR_DV(at_idx)]);
         }

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-s\n",
                           "ATD_VOLATILE",boolean_str[ATD_VOLATILE(at_idx)],
                           "ATD_TYPE_IDX",  ATD_TYPE_IDX(at_idx),
                            print_type_f(ATD_TYPE_IDX(at_idx)));

         if (ATD_CLASS(at_idx) == Variable) {  
            fprintf(out_file,"  %-16s= %-7d\n",
                    "ATD_VARIABLE_TMP", ATD_VARIABLE_TMP_IDX(at_idx));
         }

         if (dump_all && ATD_STOR_BLK_IDX(at_idx) != NULL_IDX) {
            fprintf(out_file, "\n");
            dump_sb_ntry(out_file, ATD_STOR_BLK_IDX(at_idx));
         }

         if (dump_all && ATD_ARRAY_IDX(at_idx) != NULL_IDX) {
            fprintf(out_file, "\n");
            dump_bd_ntry(out_file, ATD_ARRAY_IDX(at_idx));
         }

	 if (0 && dump_all && AT_OBJ_CLASS(at_idx) == Data_Obj &&
	     TYP_LINEAR(ATD_TYPE_IDX(at_idx)) == Proc_Ptr &&
	     (ATD_CLASS(at_idx) == Variable ||
	      ATD_CLASS(at_idx) == Struct_Component) &&
	     ATD_PP_ATP(at_idx) != NULL_IDX) {
	     fprintf(out_file, "\n");
	     dump_at_ntry(out_file, ATD_PP_ATP(at_idx), dump_all);
	 }

         if (dump_all && ATD_DISTRIBUTION_IDX(at_idx) != NULL_IDX) {
            fprintf(out_file, "\n");
            fprintf(out_file, "ATD_DISTRIBUTION_IDX bounds table dump\n");
            dump_bd_ntry(out_file, ATD_DISTRIBUTION_IDX(at_idx));
         }

#ifdef _F_MINUS_MINUS
         if (dump_all && ATD_PE_ARRAY_IDX(at_idx) != NULL_IDX) {
            fprintf(out_file, "\n");
            fprintf(out_file, "ATD_PE_ARRAY_IDX bounds table dump\n");
            dump_bd_ntry(out_file, ATD_PE_ARRAY_IDX(at_idx));
         }
# endif

         break;


      case Pgm_Unit:
         fprintf(out_file, "  %-25s %-25s %-16s= %-8s\n",
                 atp_pgm_unit_str[ATP_PGM_UNIT(at_idx)],
                 atp_proc_str[ATP_PROC(at_idx)],
                 "ATP_ALIGN", boolean_str[ATP_ALIGN(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATP_ALL_INTENT_I", boolean_str[ATP_ALL_INTENT_IN(at_idx)],
                 "ATP_ALT_ENTRY", boolean_str[ATP_ALT_ENTRY(at_idx)],
                 "ATP_ARGCHCK_CALL", boolean_str[ATP_ARGCHCK_CALL(at_idx)]);

         if (ATP_PGM_UNIT(at_idx) != Module) {
            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8d\n",
                   "ATP_ARGCHCK_ENTR", boolean_str[ATP_ARGCHCK_ENTRY(at_idx)],
                   "ATP_DCL_EXTERNAL", boolean_str[ATP_DCL_EXTERNAL(at_idx)],
                   "ATP_DUPLICATE_IN", ATP_DUPLICATE_INTERFACE_IDX(at_idx));

#ifdef KEY /* Bug 14150 */
	    if (ATP_PGM_UNIT(at_idx) == Function ||
	      ATP_PGM_UNIT(at_idx) == Pgm_Unknown ||
	      ATP_PGM_UNIT(at_idx) == Subroutine) {
	       fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-7s\n",
                   "AT_BIND_ATTR", boolean_str[AT_BIND_ATTR(at_idx)],
		   "ATP_PP_ABSTRACT", boolean_str[ATP_PP_ABSTRACT(at_idx)],
		   "ATP_PP_PROTO", boolean_str[ATP_PP_PROTO(at_idx)]);
	    }
#endif /* KEY Bug 14150 */

            if (ATP_PROC(at_idx) == Dummy_Proc) {
               fprintf(out_file, "  %-16s= %-7s %-16s= %-7d\n",
                     "ATP_CIF_DARG_PRO", boolean_str[ATP_CIF_DARG_PROC(at_idx)],
                     "ATP_DUMMY_PROC_L", ATP_DUMMY_PROC_LINK(at_idx));
            }

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8s\n",
                    "ATP_ELEMENTAL", boolean_str[ATP_ELEMENTAL(at_idx)],
                    "ATP_ENTRY_LABEL_", ATP_ENTRY_LABEL_SH_IDX(at_idx),
                    "ATP_EXPL_ITRFC", boolean_str[ATP_EXPL_ITRFC(at_idx)]);

            fprintf(out_file, "  %-16s= %-7d %-16s= %-7d %-s\n",
                   "ATP_EXT_NAME_IDX", ATP_EXT_NAME_IDX(at_idx),
                   "ATP_EXT_NAME_LEN", ATP_EXT_NAME_LEN(at_idx),
                    ATP_EXT_NAME_PTR(at_idx));

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8d\n",
                    "ATP_EXTERNAL_INT",boolean_str[ATP_EXTERNAL_INTRIN(at_idx)],
                    "ATP_EXTRA_DARG", boolean_str[ATP_EXTRA_DARG(at_idx)],
                    "ATP_FIRST_IDX", ATP_FIRST_IDX(at_idx));

            if (ATP_PROC(at_idx) == Extern_Proc) {
               fprintf(out_file, "  %-16s= %-7d %-16s= %-7d\n",
                       "ATP_FIRST_SH_IDX", ATP_FIRST_SH_IDX(at_idx),
                       "ATP_GLOBAL_ATTR_", ATP_GLOBAL_ATTR_IDX(at_idx));
            }
            else {
               fprintf(out_file, "  %-16s= %-7d\n",
                       "ATP_GLOBAL_ATTR_", ATP_GLOBAL_ATTR_IDX(at_idx));
            }

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
               "ATP_HAS_ALT_RET", boolean_str[ATP_HAS_ALT_RETURN(at_idx)],
               "ATP_HAS_OVER_IND",boolean_str[ATP_HAS_OVER_INDEXING(at_idx)],
               "ATP_HAS_TASK_DIR", boolean_str[ATP_HAS_TASK_DIRS(at_idx)]);

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
               "ATP_IN_INTERFACE",boolean_str[ATP_IN_INTERFACE_BLK(at_idx)],
               "ATP_IN_UNNAMED_I",boolean_str[ATP_IN_UNNAMED_INTERFACE(at_idx)],
               "ATP_INLINE_ALWAY",boolean_str[ATP_INLINE_ALWAYS(at_idx)]);

            if (ATP_PROC(at_idx) == Intrin_Proc) {
               fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8s\n",
                    "ATP_INLINE_NEVER",boolean_str[ATP_INLINE_NEVER(at_idx)],
                    "ATP_INTERFACE_ID", ATP_INTERFACE_IDX(at_idx),
                    "ATP_INTRIN_ENUM", intrin_str[ATP_INTRIN_ENUM(at_idx)]);

               fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8d\n",
                     "ATP_MAY_INLINE", boolean_str[ATP_MAY_INLINE(at_idx)],
                     "ATP_NAME_IN_STON", boolean_str[ATP_NAME_IN_STONE(at_idx)],
                     "ATP_NO_ENTRY_LIS", ATP_NO_ENTRY_LIST(at_idx));

               if (ATP_NO_ENTRY_LIST(at_idx) != NULL_IDX) {
                  print_al_list(out_file, ATP_NO_ENTRY_LIST(at_idx));
               }

               fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8d\n",
                    "ATP_NON_ANSI_INT",boolean_str[ATP_NON_ANSI_INTRIN(at_idx)],
                    "ATP_NOSIDE_EFFEC", boolean_str[ATP_NOSIDE_EFFECTS(at_idx)],
                    "ATP_NUM_DARGS", ATP_NUM_DARGS(at_idx));

               fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                       "ATP_OPTIONAL_DIR",boolean_str[ATP_OPTIONAL_DIR(at_idx)],
                       "ATP_PURE", boolean_str[ATP_PURE(at_idx)],
                       "ATP_RECURSIVE", boolean_str[ATP_RECURSIVE(at_idx)]);
            }
            else {
               fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                    "ATP_INLINE_NEVER",boolean_str[ATP_INLINE_NEVER(at_idx)],
                    "ATP_MAY_INLINE", boolean_str[ATP_MAY_INLINE(at_idx)],
                    "ATP_NAME_IN_STON", boolean_str[ATP_NAME_IN_STONE(at_idx)]);

               fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
                   "ATP_NO_ENTRY_LIS", ATP_NO_ENTRY_LIST(at_idx),
                   "ATP_NON_ANSI_INT",boolean_str[ATP_NON_ANSI_INTRIN(at_idx)],
                   "ATP_NOSIDE_EFFEC", boolean_str[ATP_NOSIDE_EFFECTS(at_idx)]);

               if (ATP_NO_ENTRY_LIST(at_idx) != NULL_IDX) {
                  print_al_list(out_file, ATP_NO_ENTRY_LIST(at_idx));
               }

               fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8d\n",
                       "ATP_NUM_DARGS", ATP_NUM_DARGS(at_idx),
                       "ATP_OPTIONAL_DIR",boolean_str[ATP_OPTIONAL_DIR(at_idx)],
                       "ATP_PARENT_IDX", ATP_PARENT_IDX(at_idx));

               fprintf(out_file, "  %-16s= %-7s %-16s= %-7s\n",
                       "ATP_PURE", boolean_str[ATP_PURE(at_idx)],
                       "ATP_RECURSIVE", boolean_str[ATP_RECURSIVE(at_idx)]);
            }

            if (ATP_RSLT_IDX(at_idx) != NULL_IDX) {
               fprintf(out_file, "  %-16s= %-7s %-s\n",
                       "ATP_RSLT_NAME", boolean_str[ATP_RSLT_NAME(at_idx)],
                        AT_OBJ_NAME_PTR(ATP_RSLT_IDX(at_idx)));
            }

            fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
                    "ATP_RSLT_IDX", ATP_RSLT_IDX(at_idx),
                    "ATP_SAVE_ALL", boolean_str[ATP_SAVE_ALL(at_idx)],
                    "ATP_SCP_ALIVE", boolean_str[ATP_SCP_ALIVE(at_idx)]);

            fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
                    "ATP_SCP_IDX", ATP_SCP_IDX(at_idx),
              "ATP_SGI_RTN_INL", boolean_str[ATP_SGI_ROUTINE_INLINE(at_idx)],
              "ATP_SGI_RTN_NOIN",boolean_str[ATP_SGI_ROUTINE_NOINLINE(at_idx)]);

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                "ATP_SGI_GLB_INL",boolean_str[ATP_SGI_GLOBAL_INLINE(at_idx)],
                "ATP_SGI_GLB_NOIN",boolean_str[ATP_SGI_GLOBAL_NOINLINE(at_idx)],
                "ATP_SGI_LOC_INL", boolean_str[ATP_SGI_LOCAL_INLINE(at_idx)]);

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATP_SGI_LOC_NOIN",boolean_str[ATP_SGI_LOCAL_NOINLINE(at_idx)],
                 "ATP_STACK_DIR",boolean_str[ATP_STACK_DIR(at_idx)],
                 "ATP_SYMMETRIC",boolean_str[ATP_SYMMETRIC(at_idx)]);

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                    "ATP_TASK_SHARED",boolean_str[ATP_TASK_SHARED(at_idx)],
                    "ATP_USES_EREGS",boolean_str[ATP_USES_EREGS(at_idx)],
                    "ATP_VFUNCTION",boolean_str[ATP_VFUNCTION(at_idx)]);
         }
         else {  /* MODULE */

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8d\n",
                    "ATP_ARGCHCK_ENTR", boolean_str[ATP_ARGCHCK_ENTRY(at_idx)],
                    "ATP_DCL_EXTERNAL",boolean_str[ATP_DCL_EXTERNAL(at_idx)],
                    "ATP_ENTRY_LABEL_", ATP_ENTRY_LABEL_SH_IDX(at_idx));

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                    "ATP_EXPL_ITRFC", boolean_str[ATP_EXPL_ITRFC(at_idx)],
                    "ATP_EXTERNAL_INT",boolean_str[ATP_EXTERNAL_INTRIN(at_idx)],
                    "ATP_EXTRA_DARG", boolean_str[ATP_EXTRA_DARG(at_idx)]);

            fprintf(out_file, "  %-16s= %-7d %-16s= %-7d %-s\n",
                   "ATP_EXT_NAME_IDX", ATP_EXT_NAME_IDX(at_idx),
                   "ATP_EXT_NAME_LEN", ATP_EXT_NAME_LEN(at_idx),
                    ATP_EXT_NAME_PTR(at_idx));

            fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
                "ATP_GLOBAL_ATTR_", ATP_GLOBAL_ATTR_IDX(at_idx),
                "ATP_HAS_ALT_RET", boolean_str[ATP_HAS_ALT_RETURN(at_idx)],
                "ATP_HAS_OVER_IND", boolean_str[ATP_HAS_OVER_INDEXING(at_idx)]);

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-7s\n",
                 "ATP_HAS_TASK_DIR", boolean_str[ATP_HAS_TASK_DIRS(at_idx)],
               "ATP_IMPLICIT_USE", boolean_str[ATP_IMPLICIT_USE_MODULE(at_idx)],
               "ATP_INDIRECT_MOD", boolean_str[ATP_INDIRECT_MODULE(at_idx)]);

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATP_IN_CURRENT_", boolean_str[ATP_IN_CURRENT_COMPILE(at_idx)],
                 "ATP_IN_INTERFACE", boolean_str[ATP_IN_INTERFACE_BLK(at_idx)],
                 "ATP_INLINE_ALWAY", boolean_str[ATP_INLINE_ALWAYS(at_idx)]);

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8d\n",
                   "ATP_INLINE_NEVER", boolean_str[ATP_INLINE_NEVER(at_idx)],
                   "ATP_MAY_INLINE", boolean_str[ATP_MAY_INLINE(at_idx)],
                   "ATP_MODULE_STR_I", ATP_MODULE_STR_IDX(at_idx));

            if (ATP_MOD_PATH_IDX(at_idx) != NULL_IDX) {
               fprintf(out_file,"  %-16s= %-7d %-16s= %-s\n",
                       "ATP_MOD_PATH_LEN", ATP_MOD_PATH_LEN(at_idx),
                       "ATP_MOD_PATH_IDX", ATP_MOD_PATH_NAME_PTR(at_idx));
            }

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                    "ATP_NOSIDE_EFFEC", boolean_str[ATP_NOSIDE_EFFECTS(at_idx)],
                    "ATP_RECURSIVE", boolean_str[ATP_RECURSIVE(at_idx)],
                    "ATP_RSLT_NAME", boolean_str[ATP_RSLT_NAME(at_idx)]);

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8d\n",
                    "ATP_SAVE_ALL", boolean_str[ATP_SAVE_ALL(at_idx)],
                    "ATP_SCP_ALIVE", boolean_str[ATP_SCP_ALIVE(at_idx)],
                    "ATP_SCP_IDX", ATP_SCP_IDX(at_idx));

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                    "ATP_STACK_DIR",boolean_str[ATP_STACK_DIR(at_idx)],
                    "ATP_SYSTEM_MODUL", boolean_str[ATP_SYSTEM_MODULE(at_idx)],
                    "ATP_TASK_SHARED",boolean_str[ATP_TASK_SHARED(at_idx)]);

            fprintf(out_file, "  %-16s= %-7d %-25s\n",
                    "ATP_USE_LIST", ATP_USE_LIST(at_idx),
                    use_type_str[ATP_USE_TYPE(at_idx)]);

#ifdef KEY /* Bug 5089 */
            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-7s\n",
                    "ATP_USES_EREGS",boolean_str[ATP_USES_EREGS(at_idx)],
                    "ATP_VFUNCTION",boolean_str[ATP_VFUNCTION(at_idx)],
                    "ATT_NON_INTRIN",boolean_str[ATT_NON_INTRIN(at_idx)]);
            fprintf(out_file, "  %-16s= %-7s\n", "ATT_NO_MODULE_NA",
		    boolean_str[ATT_NO_MODULE_NATURE(at_idx)]);
#else /* KEY Bug 5089 */
            fprintf(out_file, "  %-16s= %-7s %-16s= %-7s\n",
                    "ATP_USES_EREGS",boolean_str[ATP_USES_EREGS(at_idx)],
                    "ATP_VFUNCTION",boolean_str[ATP_VFUNCTION(at_idx)]);
#endif /* KEY Bug 5089 */

            if (ATP_USE_LIST(at_idx) != NULL_IDX) {
               ro_idx = ATP_USE_LIST(at_idx);

               while (ro_idx != NULL_IDX) {
                  dump_ro_ntry(out_file, ro_idx);
                  ro_idx = RO_NEXT_IDX(ro_idx);
               }
            }
         }

         fprintf(out_file, "\n");

	 if (dump_all) {

            /* Note that the output_attr flag is set to FALSE because it      */
            /* produces quite a bit of output.  The code is left in in case   */
            /* we find in future debugging sessions that also dumping the     */
            /* Attribute entry for the Secondary Name table item would be     */
            /* useful.                                                        */

            if (ATP_PGM_UNIT(at_idx) <= Subroutine) {

	       if (ATP_RSLT_IDX(at_idx) != NULL_IDX) {
                  fprintf(out_file, "\n");
                  dump_at_ntry (out_file, ATP_RSLT_IDX(at_idx), dump_all);
      	       }

               if (ATP_FIRST_IDX(at_idx) != NULL_IDX) {
                  loop_thru_sn_ntries(out_file, at_idx, FALSE);
	       }
	    }
	 }

         break;

      case Label:
         fprintf(out_file, "  %-25s %-16s= %-7s %-16s= %-8s\n",
                 atl_class_str[ATL_CLASS(at_idx)],
                 "ATL_ALIGN", boolean_str[ATL_ALIGN(at_idx)],
                 "ATL_AGGRESSIVEIN", 
                      boolean_str[ATL_AGGRESSIVEINNERLOOPFISSION(at_idx)]);


         if (ATL_CLASS(at_idx) <= Lbl_User) {
            fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8d\n",
                    "ATL_ASG_LBL_CHAI",ATL_ASG_LBL_CHAIN_START(at_idx),
                    "ATL_BL", boolean_str[ATL_BL(at_idx)],
                    "ATL_BLK_STMT_IDX", ATL_BLK_STMT_IDX(at_idx));

            fprintf(out_file, "  %-16s= %-7s %-16s= %-7d\n",
                    "ATL_CASE_LABEL", boolean_str[ATL_CASE_LABEL(at_idx)],
                    "ATL_CMIC_BLK_STM", ATL_CMIC_BLK_STMT_IDX(at_idx));
         }
         else {
            fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
                    "ATL_ASG_LBL_CHAI",ATL_ASG_LBL_CHAIN_START(at_idx),
                    "ATL_BL", boolean_str[ATL_BL(at_idx)],
                    "ATL_CASE_LABEL", boolean_str[ATL_CASE_LABEL(at_idx)]);
         }

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATL_CNCALL", boolean_str[ATL_CNCALL(at_idx)],
                 "ATL_CONSTRUCTOR_", boolean_str[ATL_CONSTRUCTOR_LOOP(at_idx)],
                 "ATL_CYCLE_LBL", boolean_str[ATL_CYCLE_LBL(at_idx)]);

         fprintf(out_file, "  %-16s= %-33s %-16s= %-8d\n",
                "ATL_DEBUG_CLASS", atl_debug_class_str[ATL_DEBUG_CLASS(at_idx)],
                "ATL_DIRECTIVE_LI", ATL_DIRECTIVE_LIST(at_idx));

         if (ATL_DIRECTIVE_LIST(at_idx) != NULL_IDX) {
            il_idx = IL_IDX(ATL_DIRECTIVE_LIST(at_idx)) + Safevl_Dir_Idx;

            fprintf(out_file, "  %-16s= %-7s", "safevl",
                    (IL_FLD(il_idx) == CN_Tbl_Idx) ? convert_to_string(
                                                   &CN_CONST(IL_IDX(il_idx)),
                                                    CN_TYPE_IDX(IL_IDX(il_idx)),
                                                    conv_str) : "0");

            il_idx = IL_IDX(ATL_DIRECTIVE_LIST(at_idx)) + Unroll_Dir_Idx;

            fprintf(out_file, "  %-16s= %-7s", "unroll",
                    (IL_FLD(il_idx) == CN_Tbl_Idx) ? convert_to_string(
                                                    &CN_CONST(IL_IDX(il_idx)),
                                                    CN_TYPE_IDX(IL_IDX(il_idx)),
                                                    conv_str) : "0");

            il_idx = IL_IDX(ATL_DIRECTIVE_LIST(at_idx)) + Mark_Dir_Idx;

            fprintf(out_file, " %-16s= %-s\n", "mark",
                    (IL_FLD(il_idx) == CN_Tbl_Idx) ?
                                      (char *) &CN_CONST(IL_IDX(il_idx)) : " ");

            il_idx = IL_IDX(ATL_DIRECTIVE_LIST(at_idx)) + Maxcpus_Dir_Idx;

            fprintf(out_file, "  %-16s= %-7d %-16s= %-25s\n", 
                    "maxcpus idx", IL_IDX(il_idx),
                    "maxcpus fld", field_str[IL_FLD(il_idx)]);

            il_idx = IL_IDX(ATL_DIRECTIVE_LIST(at_idx)) + Cache_Bypass_Dir_Idx;

            if (IL_FLD(il_idx) == IL_Tbl_Idx) {  /* Cache bypass */
               il_idx                 = IL_IDX(il_idx);

               while (il_idx != NULL_IDX) {
                  fprintf(out_file, "  %-16s= %-25s \n", 
                  "cache_bypass", AT_OBJ_NAME_PTR(IL_IDX(il_idx)));
                  il_idx = IL_NEXT_LIST_IDX(il_idx);
               }
            }
         }

         if (AT_DEFINED(at_idx)) {
            fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
                    "ATL_DEF_STMT_IDX", ATL_DEF_STMT_IDX(at_idx),
                    "ATL_EXECUTABLE", boolean_str[ATL_EXECUTABLE(at_idx)],
                    "ATL_FISSIONABLE", boolean_str[ATL_FISSIONABLE(at_idx)]);
         }
         else {
            fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8s\n",
                    "ATL_EXECUTABLE", boolean_str[ATL_EXECUTABLE(at_idx)],
                    "ATL_FWD_REF_IDX", ATL_FWD_REF_IDX(at_idx),
                    "ATL_FISSIONABLE", boolean_str[ATL_FISSIONABLE(at_idx)]);
         }

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-7s\n",
                 "ATL_FUSABLE", boolean_str[ATL_FUSABLE(at_idx)],
                 "ATL_FUSION", boolean_str[ATL_FUSION(at_idx)],
                 "ATL_IN_ASSIGN", boolean_str[ATL_IN_ASSIGN(at_idx)]);

         if (ATL_CLASS(at_idx) == Lbl_Format) {

            if (ATL_FORMAT_TMP(at_idx) == NULL_IDX)  {
                fprintf(out_file,"  %-16s= %-7d\n",
                        "ATL_FORMAT_TM", ATL_FORMAT_TMP(at_idx));
            }
            else {
                fprintf(out_file,"  %-16s= %-7d %-16s= \"%s\"\n\n",
                        "ATL_FORMAT_TM", ATL_FORMAT_TMP(at_idx),
                        "FORMAT CONSTANT",
                        (char *)&CN_CONST(ATD_TMP_IDX(ATL_FORMAT_TMP(at_idx))));
            }
         }

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                "ATL_IN_ASSIGN_LB",boolean_str[ATL_IN_ASSIGN_LBL_CHAIN(at_idx)],
                "ATL_INFORM_ONLY",boolean_str[ATL_INFORM_ONLY(at_idx)],
                "ATL_IVDEP",boolean_str[ATL_IVDEP(at_idx)]);

         if (ATL_CLASS(at_idx) == Lbl_Internal) {
            fprintf(out_file, "  %-16s= %-7d\n",
                   "ATL_NEW_LBL_IDX", ATL_NEW_LBL_IDX(at_idx));
         }

         fprintf(out_file, "  %-16s= %-7s %-16s  %-7d %-16s= %-8s\n",
                "ATL_MAXCPUS",boolean_str[ATL_MAXCPUS(at_idx)],
                "ATL_NEXT_ASG_LBL", ATL_NEXT_ASG_LBL_IDX(at_idx),
                "ATL_NEXTSCALAR", boolean_str[ATL_NEXTSCALAR(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                "ATL_NOBLOCKING", boolean_str[ATL_NOBLOCKING(at_idx)],
                "ATL_NOFISSION", boolean_str[ATL_NOFISSION(at_idx)],
                "ATL_NOFUSION", boolean_str[ATL_NOFUSION(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                "ATL_NOINTERCHANG", boolean_str[ATL_NOINTERCHANGE(at_idx)],
                "ATL_NORECURRENCE", boolean_str[ATL_NORECURRENCE(at_idx)],
		"ATL_NOTASK",boolean_str[ATL_NOTASK(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                "ATL_NOVECTOR", boolean_str[ATL_NOVECTOR(at_idx)],
                "ATL_NOVSEARCH", boolean_str[ATL_NOVSEARCH(at_idx)],
                "ATL_PATTERN", boolean_str[ATL_PATTERN(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
              "ATL_PERMUTATION", boolean_str[ATL_PERMUTATION(at_idx)],
              "ATL_PREFERSTREAM", boolean_str[ATL_PREFERSTREAM(at_idx)],
              "ATL_PREFER_NOCIN", boolean_str[ATL_PREFERSTREAM_NOCINV(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s\n",
                "ATL_PREFERTASK", boolean_str[ATL_PREFERTASK(at_idx)],
                "ATL_PREFERVECTOR", boolean_str[ATL_PREFERVECTOR(at_idx)]);

         if (ATL_CLASS(at_idx) == Lbl_Format) {
            fprintf(out_file, " %-16s= %-7d\n",
                    "ATL_PP_FORMAT_TM", ATL_PP_FORMAT_TMP(at_idx));
         }

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATL_SHORTLOOP", boolean_str[ATL_SHORTLOOP(at_idx)],
                 "ATL_SHORTLOOP128", boolean_str[ATL_SHORTLOOP128(at_idx)],
                 "ATL_SPLIT", boolean_str[ATL_SPLIT(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATL_STREAM",boolean_str[ATL_STREAM(at_idx)],
                 "ATL_TOP_OF_LOOP", boolean_str[ATL_TOP_OF_LOOP(at_idx)],
                 "ATL_UNROLL_DIR", boolean_str[ATL_UNROLL_DIR(at_idx)]);

         break;

      case Derived_Type:

#ifdef KEY /* Bug 14150 */
         fprintf(out_file, "  %-16s= %-7s\n",
                 "AT_BIND_ATTR", boolean_str[AT_BIND_ATTR(at_idx)]);
#endif /* KEY Bug 14150 */

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATT_CHAR_CPNT", boolean_str[ATT_CHAR_CPNT(at_idx)],
                 "ATT_CHAR_SEQ", boolean_str[ATT_CHAR_SEQ(at_idx)],
                 "ATT_ALIGNMENT", align_str[ATT_ALIGNMENT(at_idx)]);

         fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
                 "ATT_CIF_DT_ID", ATT_CIF_DT_ID(at_idx),
                 "ATT_DALIGN_ME", boolean_str[ATT_DALIGN_ME(at_idx)],
                 "ATT_DCL_NUMERIC_", boolean_str[ATT_DCL_NUMERIC_SEQ(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8d\n",
               "ATT_DEFAULT_INIT", boolean_str[ATT_DEFAULT_INITIALIZED(at_idx)],
               "ATT_FIRST_CPNT_I", ATT_FIRST_CPNT_IDX(at_idx),
               "ATT_GLOBAL_TYPE_", ATT_GLOBAL_TYPE_IDX(at_idx));

         fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8d\n",
                 "ATT_LABEL_LIST_I", ATT_LABEL_LIST_IDX(at_idx),
                 "ATT_NON_DEFAULT_", boolean_str[ATT_NON_DEFAULT_CPNT(at_idx)],
                 "ATT_NUM_CPNTS", ATT_NUM_CPNTS(at_idx));

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATT_NUMERIC_CPNT", boolean_str[ATT_NUMERIC_CPNT(at_idx)],
                 "ATT_POINTER_CPNT", boolean_str[ATT_POINTER_CPNT(at_idx)],
                 "ATT_PRIVATE_CPNT", boolean_str[ATT_PRIVATE_CPNT(at_idx)]);

#ifdef KEY /* Bug 6845 */
         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s\n",
                 "ATT_ALLOCAT_CPNT", boolean_str[ATT_ALLOCATABLE_CPNT(at_idx)],
		 "ATT_DOPE_CPNT",    boolean_str[ATT_DOPE_CPNT(at_idx)]);
#endif /* KEY Bug 6845 */

         fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8d\n",
                 "ATT_SCP_IDX", ATT_SCP_IDX(at_idx),
                 "ATT_SEQUENCE_SET", boolean_str[ATT_SEQUENCE_SET(at_idx)],
                 "ATT_UNIQUE_ID", ATT_UNIQUE_ID(at_idx));

	 fprintf(out_file, "  %-16s= %-7d\n",
		 "ATT_PARENT_TYPE", ATT_PARENT_TYPE(at_idx));

         if (ATT_STRUCT_BIT_LEN_IDX(at_idx) != NULL_IDX) {
            sprintf(str, "(%10s)",
                 convert_to_string(&CN_CONST(ATT_STRUCT_BIT_LEN_IDX(at_idx)),
                                    CN_TYPE_IDX(ATT_STRUCT_BIT_LEN_IDX(at_idx)),
                                    conv_str));
         }
         else {
            sprintf(str,"%12s", " ");
         }

         fprintf(out_file, "  %-16s= %-7d %-25s %-26s\n",
                 "ATT_STRUCT_SIZE", ATT_STRUCT_BIT_LEN_IDX(at_idx),
                 field_str[CN_Tbl_Idx],
                 str);

         /* Note that the output_attr flag is set to FALSE because it   */
         /* produces quite a bit of output.  The code is left in in     */
         /* case we find in future debugging sessions that also dumping */
         /* the Attribute entry for the Secondary Name table item       */
         /* would be useful.                                            */

         if (dump_all) {
            chain_thru_sn_ntries(out_file, at_idx, FALSE);
         }

         break;


      case Interface:

         fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
                "ATI_CIF_SCOPE_ID", ATI_CIF_SCOPE_ID(at_idx),
                "ATI_CIF_SEEN_IN_", boolean_str[ATI_CIF_SEEN_IN_CALL(at_idx)],
                "ATI_DCL_INTRINSI", boolean_str[ATI_DCL_INTRINSIC(at_idx)]);

         fprintf(out_file, "  %-16s= %-33s %-16s= %-8d\n",
                "ATI_DEFINED_OPR", operator_str[ATI_DEFINED_OPR(at_idx)],
                "ATI_FIRST_SPECIF", ATI_FIRST_SPECIFIC_IDX(at_idx));

         fprintf(out_file, "  %-16s= %-7s %-16s= %-33s\n",
                "ATI_HAS_NON_MOD_", boolean_str[ATI_HAS_NON_MOD_PROC(at_idx)],
                "ATI_INTERFACE_CL", interface_str[ATI_INTERFACE_CLASS(at_idx)]);

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                 "ATI_INLINE_ALWAY",boolean_str[ATI_INLINE_ALWAYS(at_idx)],
                 "ATI_INLINE_NEVER",boolean_str[ATI_INLINE_NEVER(at_idx)],
                 "ATI_INTRIN_PASSA", boolean_str[ATI_INTRIN_PASSABLE(at_idx)]);

         fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8d\n",
                 "ATI_INTRIN_TBL_I", ATI_INTRIN_TBL_IDX(at_idx),
                 "ATI_IPA_DIR_SPEC",boolean_str[ATI_IPA_DIR_SPECIFIED(at_idx)],
                 "ATI_NUM_SPECIFIC", ATI_NUM_SPECIFICS(at_idx));

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7d\n",
                "ATI_GENERIC_INT", boolean_str[ATI_GENERIC_INTRINSIC(at_idx)],
		"ATI_PROC_IDX", ATI_PROC_IDX(at_idx));

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
             "ATI_UNNAMED_INTE", boolean_str[ATI_UNNAMED_INTERFACE(at_idx)],
             "ATI_SGI_RTN_INLI", boolean_str[ATI_SGI_ROUTINE_INLINE(at_idx)],
             "ATI_SGI_RTN_NOIN", boolean_str[ATI_SGI_ROUTINE_NOINLINE(at_idx)]);
 
         if (ATD_TYPE_IDX(at_idx) != NULL_IDX) {
            fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-s\n",
                   "ATI_USER_SPECIFI", boolean_str[ATI_USER_SPECIFIED(at_idx)],
                   "ATD_TYPE_IDX", ATD_TYPE_IDX(at_idx),
                    print_type_f(ATD_TYPE_IDX(at_idx)));
         }
         else {
            fprintf(out_file, "  %-16s= %-7s %-16s= %-7d\n",
                   "ATI_USER_SPECIFI", boolean_str[ATI_USER_SPECIFIED(at_idx)],
                   "ATD_TYPE_IDX", ATD_TYPE_IDX(at_idx));
         }

         if (ATI_PROC_IDX(at_idx) != NULL_IDX) {
            fprintf(out_file, "\n");
            dump_at_ntry(out_file, ATI_PROC_IDX(at_idx), dump_all);
         }

         /* Note that the output_attr flag is set to FALSE because it   */
         /* produces quite a bit of output.  The code is left in in     */
         /* case we find in future debugging sessions that also dumping */
         /* the Attribute entry for the Secondary Name table item would */
         /* be useful.                                                  */

         if (dump_all) {
            chain_thru_sn_ntries(out_file, at_idx, FALSE);
         }

         break;


      case Namelist_Grp:

         fprintf(out_file, "  %-16s= %-7d %-16s= %-7d %-16s= %-8d\n",
                 "ATN_FIRST_NAMELI", ATN_FIRST_NAMELIST_IDX(at_idx),
                 "ATN_LAST_NAMELIS", ATN_LAST_NAMELIST_IDX(at_idx),
                 "ATN_NUM_NAMELIST", ATN_NUM_NAMELIST(at_idx));

         fprintf(out_file, "  %-16s= %-7d (%-s)\n",
                 "ATN_NAMELIST_DES", ATN_NAMELIST_DESC(at_idx),
                 ((ATN_NAMELIST_DESC(at_idx) == NULL_IDX) ? " " :
                  AT_OBJ_NAME_PTR(ATN_NAMELIST_DESC(at_idx))));


         /* Note that the output_attr flag is set to FALSE because it   */
         /* produces quite a bit of output.  The code is left in in     */
         /* case we find in future debugging sessions that also dumping */
         /* the Attribute entry for the Secondary Name table item would */
         /* be useful.                                                  */

         if (dump_all) {
            chain_thru_sn_ntries(out_file, at_idx, FALSE);
         }
         break;


      case Stmt_Func:

         fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-s\n",
                 "ATS_SF_ACTIVE", boolean_str[ATS_SF_ACTIVE(at_idx)],
                 "ATP_FIRST_IDX", ATP_FIRST_IDX(at_idx),
                 field_str[ATS_SF_FLD(at_idx)]);

         fprintf(out_file, "  %-16s= %-7d %-16s= %-7d %-16s= %-8s\n",
                "ATS_SF_IDX", ATS_SF_IDX(at_idx),
                "ATP_NUM_DARGS", ATP_NUM_DARGS(at_idx),
                "ATS_SF_SEMANTICS", boolean_str[ATS_SF_SEMANTICS_DONE(at_idx)]);

         fprintf(out_file, "  %-16s= %-7d %-s\n",
                           "ATD_TYPE_IDX", ATD_TYPE_IDX(at_idx),
                            print_type_f(ATD_TYPE_IDX(at_idx)));

         if (dump_all && ATP_FIRST_IDX(at_idx) != NULL_IDX) {
            loop_thru_sn_ntries(out_file, at_idx, FALSE);
         }

         if (ATS_SF_FLD(at_idx) == IR_Tbl_Idx) {
            dump_ir_ntry(out_file, ATS_SF_IDX(at_idx), 5);
         }

         break;

   }  /* End switch */

   putc ('\n', out_file);
   fflush (out_file);

   return;

}  /* dump_at_ntry */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints one bounds table entry to the specified output file.           *|
|*									      *|
|* Input parameters:							      *|
|*	FILE to print to - Should be debug_file, stderr, or stdout.           *|
|*	Index of bounds entry to print.                                       *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_bd_ntry (FILE	*out_file,
   		          int	 bd_idx)

{
   int		i;


   if (bd_idx > bounds_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* BD index value [%d] is out of range.\n",
              bd_idx);
      goto EXIT;
   }

   if (BD_DIST_NTRY(bd_idx)) {
      fprintf(out_file, "  %-16s= %-7d %-16s= %-7d %-16s= %-8s\n",
                        "BD_RANK", BD_RANK(bd_idx),
                        "BD_COLUMN_NUM", BD_COLUMN_NUM(bd_idx),
                        "BD_DISTRIBUTE_RE",
                            boolean_str[BD_DISTRIBUTE_RESHAPE(bd_idx)]);

      fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8d\n",
                        "BD_LINE_NUM", BD_LINE_NUM(bd_idx),
                        "BD_RESOLVED", boolean_str[BD_RESOLVED(bd_idx)],
                        "IDX", bd_idx);

      for (i = 1; i <=  BD_RANK(bd_idx); i++) {
         fprintf(out_file, "  %-16s= %-7d %-16s= %-25s\n",
                           "Dimension", i,
                           "Distribution", 
                              distribution_str[BD_DISTRIBUTION(bd_idx,i)]);

         if (BD_CYCLIC_FLD(bd_idx, i) != NO_Tbl_Idx) {
            print_fld_idx(out_file,
                          "   BD_CYCLIC_IDX",
                           BD_CYCLIC_FLD(bd_idx, i),
                           BD_CYCLIC_IDX(bd_idx, i));
         }

         if (BD_ONTO_FLD(bd_idx, i) != NO_Tbl_Idx) {
            print_fld_idx(out_file,
                          "   BD_ONTO_IDX",
                           BD_ONTO_FLD(bd_idx, i),
                           BD_ONTO_IDX(bd_idx, i));
         }
      }
      goto EXIT;
   }

   if (!BD_USED_NTRY(bd_idx)) {
      fprintf(out_file, "  %-16s= %-7d %-16s= %-7d %-16s= %-8d\n",
                        "IDX", bd_idx, 
                        "BD_NEXT_FREE_NTR", BD_NEXT_FREE_NTRY(bd_idx),
                        "BD_NTRY_SIZE", BD_NTRY_SIZE(bd_idx));
      goto EXIT;
   }

   fprintf(out_file, "  %-16s= %-7d %-25s %-26s\n",
                     "BD_RANK", BD_RANK(bd_idx),
                                bd_array_class_str[BD_ARRAY_CLASS(bd_idx)],
                                bd_array_size_str[BD_ARRAY_SIZE(bd_idx)]);

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8d\n",
                     "BD_COLUMN_NUM", BD_COLUMN_NUM(bd_idx),
                     "BD_DCL_ERR", boolean_str[BD_DCL_ERR(bd_idx)],
                     "BD_GLOBAL_IDX", BD_GLOBAL_IDX(bd_idx));

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8d\n",
                     "BD_LINE_NUM", BD_LINE_NUM(bd_idx),
                     "BD_RESOLVED", boolean_str[BD_RESOLVED(bd_idx)],
                     "IDX", bd_idx);

   print_fld_idx(out_file, "BD_LEN_IDX",
                 BD_LEN_FLD(bd_idx),
                 BD_LEN_IDX(bd_idx));

   if (BD_ARRAY_CLASS(bd_idx) != Deferred_Shape) {

      for (i = 1; i <=  BD_RANK(bd_idx); i++) {
         fprintf(out_file, "  %-16s= %-7d\n", "Dimension", i);

         print_fld_idx(out_file,
                       "   BD_LB_IDX",
                        BD_LB_FLD(bd_idx, i),
                        BD_LB_IDX(bd_idx, i));

         print_fld_idx(out_file,
                       "   BD_UB_IDX",
                        BD_UB_FLD(bd_idx, i),
                        BD_UB_IDX(bd_idx, i));

         print_fld_idx(out_file,
                       "   BD_XT_IDX",
                        BD_XT_FLD(bd_idx, i),
                        BD_XT_IDX(bd_idx, i));

         print_fld_idx(out_file,
                       "   BD_SM_IDX",
                        BD_SM_FLD(bd_idx, i),
                        BD_SM_IDX(bd_idx, i));
      }
   }

   EXIT:

   putc ('\n', out_file);

   fflush (out_file);
   return;

}  /* dump_bd_ntry */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints the actual block entry.                                        *|
|*									      *|
|* Input parameters:							      *|
|*	File to print entry to.       	 				      *|
|*	Index of block entry to print.					      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_blk_ntry(FILE	*out_file,
   		          int 	 blk_idx)
{

   /* Sometimes when debugging, you really want to print a Block Stack        */
   /* entry that's been popped.  But print a warning in case that's not what  */
   /* was intended.							      */

   if (blk_idx > blk_stk_idx) {
      fprintf(stderr,
              "\n*FE90-WARNING* Blk index value [%d] is out of range.\n",
              blk_idx);
   }


   fprintf(out_file,"\n%-32.32s  ", blk_struct_str[BLK_TYPE(blk_idx)]);
   fprintf(out_file,"%-8s= %-7d", "IDX", blk_idx);

   if (blk_idx == blk_stk_idx) {
      fprintf(out_file,"%4s%-20.20s\n", " ", "CURRENT BLOCK");
      fprintf(out_file,"%4s%-19s= %-27s\n", " ", "curr_stmt_category",
                                          context_str[curr_stmt_category]);
   }
   else {
      fprintf(out_file,"\n");
   }

   if (BLK_NAME(blk_idx) != NULL_IDX) {
      fprintf(out_file,"%4s%-19s= (%d)  %-32.32s\n", " ",
              "BLK_NAME", BLK_NAME(blk_idx),AT_OBJ_NAME_PTR(BLK_NAME(blk_idx)));
   }

   fprintf(out_file, "%4s%-19s= %-29d  %-16s= %-7d\n", " ",
                     "BLK_DEF_LINE",   BLK_DEF_LINE(blk_idx),
                     "BLK_DEF_COLUMN", BLK_DEF_COLUMN(blk_idx));

   fprintf(out_file, "%4s%-19s= %-29d  %-16s= %-7d\n", " ",
                     "BLK_FIRST_SH_IDX", BLK_FIRST_SH_IDX(blk_idx),
                     "BLK_LABEL",        BLK_LABEL(blk_idx));

   fprintf(out_file, "%4s%-19s= %s     %-16s= %s      %-16s= %s\n", " ",
                     "BLK_ERR",          boolean_str[BLK_ERR(blk_idx)],
                     "BLK_FND_DEFAULT",  boolean_str[BLK_FND_DEFAULT(blk_idx)],
                     "BLK_NO_EXEC",      boolean_str[BLK_NO_EXEC(blk_idx)]);

   if (BLK_TYPE(blk_idx) == Do_Blk) {

      if (BLK_DO_TYPE(blk_idx) == Iterative_Loop) {
         fprintf(out_file, "%4sDO-var: Line= %-7d  Col= %-3d  Fld= %-10s\n",
                           " ",
                           BLK_DO_VAR_LINE_NUM(blk_idx),
                           BLK_DO_VAR_COL_NUM(blk_idx),
                           field_str[BLK_DO_VAR_FLD(blk_idx)]);

         print_attr_name(out_file, BLK_DO_VAR_IDX(blk_idx), 4);
      }
      else if (BLK_DO_TYPE(blk_idx) == While_Loop) {
         fprintf(out_file, "%4sWHILE expr: Line= %-7d  Col= %-3d  Fld= %-10s",
                           " ", 
                           BLK_DO_VAR_LINE_NUM(blk_idx),
                           BLK_DO_VAR_COL_NUM(blk_idx),
                           field_str[BLK_DO_VAR_FLD(blk_idx)]);

         if (BLK_DO_VAR_FLD(blk_idx) == AT_Tbl_Idx) {
            fputc('\n', out_file);
            print_attr_name(out_file, BLK_DO_VAR_IDX(blk_idx), 4);
         }
         else {
            fprintf(out_file, "  Idx= %d\n", BLK_DO_VAR_IDX(blk_idx));
         }
      }

      fprintf(out_file, "%4s%-18s= %-27s  %-16s= %-7d\n", " ",
                        "BLK_DO_TYPE",	   do_type_str[BLK_DO_TYPE(blk_idx)],
                        "BLK_LOOP_NUM",    BLK_LOOP_NUM(blk_idx));

      fprintf(out_file, "%4s%-18s= %-27s  %-16s= %s\n", " ",
                        "BLK_CYCLE_STMT",  boolean_str[BLK_CYCLE_STMT(blk_idx)],
                        "BLK_EXIT_STMT",   boolean_str[BLK_EXIT_STMT(blk_idx)]);
                        
      fprintf(out_file, "%4s%-18s= %-27d  %-16s= %-12d\n", " ",
                        "BLK_TOP_LBL_IDX",    BLK_TOP_LBL_IDX(blk_idx),
                        "BLK_SKIP_LBL_IDX",   BLK_SKIP_LBL_IDX(blk_idx));

      fprintf(out_file, "%4s%-19s= %s\n", " ",
                        "BLK_IS_PARALLEL_REG",     
                        boolean_str[BLK_IS_PARALLEL_REGION(blk_idx)]);

      if (BLK_DO_TYPE(blk_idx) == Iterative_Loop) { 
         fprintf(out_file, "%4s%-18s= %-27d  %-16s= %-12d\n", " ",
                           "BLK_START_TEMP_IDX", BLK_START_TEMP_IDX(blk_idx),
                           "BLK_INC_TEMP_IDX",   BLK_INC_TEMP_IDX(blk_idx)); 

         fprintf(out_file, "%4s%-18s= %-27d  %-16s= %-12d\n", " ",
                           "BLK_INDUC_TEMP_IDX", BLK_INDUC_TEMP_IDX(blk_idx),
                           "BLK_TC_TEMP_IDX",    BLK_TC_TEMP_IDX(blk_idx));

         fprintf(out_file, "%4s%-26s= %-14s  %-24s= %-9s\n", " ",
                           "BLK_HAS_NESTED_LOOP",
			      boolean_str[BLK_HAS_NESTED_LOOP(blk_idx)],
                           "BLK_BLOCKABLE_NEST_OK ",
			      boolean_str[BLK_BLOCKABLE_NEST_OK(blk_idx)]);
                           
         fprintf(out_file, "%4s%-26s= %-14d  %-24s= %-9d\n", " ",
                           "BLK_BLOCKABLE_DIR_SH_IDX",
                              BLK_BLOCKABLE_DIR_SH_IDX(blk_idx),
                           "BLK_BLOCKABLE_NUM_LCVS",
                              BLK_BLOCKABLE_NUM_LCVS(blk_idx));
                           
         fprintf(out_file, "%4s%-26s= %-14d  %-24s= %-9d\n", " ",
                           "BLK_INTERCHANGE_DIR_SH_IDX",
                              BLK_INTERCHANGE_DIR_SH_IDX(blk_idx),
                           "BLK_INTERCHANGE_NUM_LCVS",
                              BLK_INTERCHANGE_NUM_LCVS(blk_idx));
                           
         fprintf(out_file, "%4s%-26s= %-14d  %-24s= %-9d\n", " ",
                           "BLK_DIR_NEST_CHECK_SH_IDX",
                              BLK_DIR_NEST_CHECK_SH_IDX(blk_idx),
                           "BLK_DIR_NEST_CHECK_NUM_LCVS",
                              BLK_DIR_NEST_CHECK_NUM_LCVS(blk_idx));
      }
   }
   else if (BLK_TYPE(blk_idx) == Select_Blk) {
      fprintf(out_file, "%4s%-19s= %-29d\n", " ",
                        "BLK_NUM_CASES", BLK_NUM_CASES(blk_idx));

      fprintf(out_file, "%4s%s%-9d   %s%-3d   %s   %s%-7d\n", " ",
                        "BLK_CASE_DEFAULT_LBL_OPND:  line = ", 
                        BLK_CASE_DEFAULT_LBL_LINE_NUM(blk_idx),
                        "col = ",  BLK_CASE_DEFAULT_LBL_COL_NUM(blk_idx),
                        field_str[BLK_CASE_DEFAULT_LBL_FLD(blk_idx)],
                        "idx = ", BLK_CASE_DEFAULT_LBL_IDX(blk_idx));
   }
   else if (cif_flags & BASIC_RECS) {
      fprintf(out_file, "%4s%-19s= %d\n", " ",
                        "BLK_CIF_SCOPE_ID", BLK_CIF_SCOPE_ID(blk_idx));
   }

   if (BLK_TYPE(blk_idx) == Derived_Type_Blk) {
      fprintf(out_file, "%4s%-18s= %-27d  \n", " ",
                        "BLK_LAST_CPNT_IDX",   BLK_LAST_CPNT_IDX(blk_idx));
   }
   else if (BLK_TYPE(blk_idx) == Interface_Body_Blk) {
      fprintf(out_file, "%4s%-18s= %-27d  %-16s= %-12d\n", " ",
                        "BLK_AT_IDX",   BLK_AT_IDX(blk_idx),
                        "BLK_BD_IDX",   BLK_BD_IDX(blk_idx));
      fprintf(out_file, "%4s%-18s= %-27d  %-16s= %-12d\n", " ",
                        "BLK_CN_IDX",   BLK_CN_IDX(blk_idx),
                        "BLK_CP_IDX",   BLK_CP_IDX(blk_idx));
      fprintf(out_file, "%4s%-18s= %-27d  %-16s= %-12d\n", " ",
                        "BLK_NP_IDX",   BLK_NP_IDX(blk_idx),
                        "BLK_SB_IDX",   BLK_SB_IDX(blk_idx));
      fprintf(out_file, "%4s%-18s= %-27d  %-16s= %-12d\n", " ",
                        "BLK_SN_IDX",   BLK_SN_IDX(blk_idx),
                        "BLK_TYP_IDX",   BLK_TYP_IDX(blk_idx));
   }

   fflush (out_file);

   return;

}  /* dump_blk_ntry */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints one constant table entry to the specified output file.         *|
|*									      *|
|* Input parameters:							      *|
|*	FILE to print to - Should be debug_file, stderr, or stdout.           *|
|*	Index of constant entry to print.                                     *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_cn_ntry (FILE	*out_file,
   		          int	 cn_idx)

{
   int		type_idx;


   if (cn_idx > const_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* CN index value [%d] is out of range.\n",
              cn_idx);
      return;
   }

   type_idx = CN_TYPE_IDX(cn_idx);

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8d\n",
                   "CN_BOOLEAN_CONST", boolean_str[CN_BOOLEAN_CONSTANT(cn_idx)],
                   "CN_BOZ_CONSTANT", boolean_str[CN_BOZ_CONSTANT(cn_idx)],
                   "IDX", cn_idx);
                     
   fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s\n",
               "CN_EXTRA_ZERO_WO", boolean_str[CN_EXTRA_ZERO_WORD(cn_idx)],
               "CN_POOL_IDX", CN_POOL_IDX(cn_idx),
                cn_hollerith_str[CN_HOLLERITH_TYPE(cn_idx)]);

# if defined(_TARGET_LITTLE_ENDIAN)
   fprintf(out_file, "  %-16s= %-2s\n",
               "CN_HOLLERITH_END", boolean_str[CN_HOLLERITH_ENDIAN(cn_idx)]);
# endif

   fprintf(out_file, "  %s%d] = %-s\n",
                     "CN_TYPE_IDX[", CN_TYPE_IDX(cn_idx),
                     print_type_f(type_idx));

   /* The old call was     dump_typ_ntry(out_file, type_idx); */

   print_const_f(out_file, cn_idx);
   fprintf(out_file, "\n\n");
   fflush (out_file);

   return;

}  /* dump_cn_ntry */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Prints a single Equivalence table entry.                              *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      Index of Equivalence table entry to print.                            *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void dump_eq_ntry (FILE  *out_file,
                          int    eq_idx)

{

   if (eq_idx > equiv_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* EQ index value [%d] is out of range.\n",
              eq_idx);
      return;
   }

   fprintf(out_file, "%-53.53s %-16s= %-8d\n",
                      AT_OBJ_NAME_PTR(EQ_ATTR_IDX(eq_idx)),
                     "IDX", eq_idx);

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7d %-16s= %-8s\n",
                     "EQ_ATTR_IDX", EQ_ATTR_IDX(eq_idx),
                     "EQ_COLUMN_NUM", EQ_COLUMN_NUM(eq_idx),
                     "EQ_DALIGN_ME", boolean_str[EQ_DALIGN_ME(eq_idx)]);

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                     "EQ_DALIGN_SHIFT", boolean_str[EQ_DALIGN_SHIFT(eq_idx)],
                     "EQ_DO_NOT_DALIGN", boolean_str[EQ_DO_NOT_DALIGN(eq_idx)],
                     "EQ_ERROR", boolean_str[EQ_ERROR(eq_idx)]);

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7d %-16s= %-8d\n",
                     "EQ_GRP_END_IDX", EQ_GRP_END_IDX(eq_idx),
                     "EQ_GRP_IDX", EQ_GRP_IDX(eq_idx),
                     "EQ_LINE_NUM", EQ_LINE_NUM(eq_idx));

# if 0
   if (EQ_LIST_IDX(eq_idx) != NULL_IDX) {
      print_list(out_file, IL_IDX(EQ_LIST_IDX(eq_idx)), 4, 1, FALSE);
   }
# endif

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8d\n",
                     "EQ_LIST_IDX", EQ_LIST_IDX(eq_idx),
                     "EQ_MERGED", boolean_str[EQ_MERGED(eq_idx)],
                     "EQ_NEXT_EQUIV_GR", EQ_NEXT_EQUIV_GRP(eq_idx));

   print_fld_idx(out_file, "EQ_OFFSET_IDX",
                 EQ_OFFSET_FLD(eq_idx),
                 EQ_OFFSET_IDX(eq_idx));

   print_fld_idx(out_file, "EQ_OPND_IDX",
                 EQ_OPND_FLD(eq_idx),
                 EQ_OPND_IDX(eq_idx));

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
                     "EQ_NEXT_EQUIV_OB", EQ_NEXT_EQUIV_OBJ(eq_idx),
                     "EQ_SEARCH_DONE", boolean_str[EQ_SEARCH_DONE(eq_idx)],
                     "EQ_SUBSTRINGED", boolean_str[EQ_SUBSTRINGED(eq_idx)]);

   putc ('\n', out_file);
   fflush(out_file);

   return;

}  /* dump_eq_ntry */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*									      *|
|* Input parameters:							      *|
|*	FILE to print to - Should be debug_file, stderr, or stdout.           *|
|*	Index of file path table entry to print.                              *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_fp_ntry(FILE	*out_file,
   		         int	 fp_idx,
			 boolean print_list)
 
{

   if (fp_idx > file_path_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* FP index value [%d] is out of range.\n",
              fp_idx);
      return;
   }

   do {
      fprintf(out_file, "%-s\n\n", FP_NAME_PTR(fp_idx));

      fprintf(out_file, "  %-16s= %-6d  %-16s= %-s\n",
              "IDX", fp_idx,
              "FP_CLASS", file_path_str[FP_CLASS(fp_idx)]);

      if (FP_FILE_IDX(fp_idx) != NULL_IDX &&
           FP_NAME_IDX(FP_FILE_IDX(fp_idx)) != NULL_IDX) {
         fprintf(out_file, "  %-16s= %-s\n",
                 "FP_FILE_IDX", FP_NAME_PTR(FP_FILE_IDX(fp_idx)));
      }
      else {
         fprintf(out_file, "  %-16s= %-s\n", "FP_FILE_IDX", "0");
      }

      if (FP_MODULE_IDX(fp_idx) != NULL_IDX &&
           FP_NAME_IDX(FP_MODULE_IDX(fp_idx)) != NULL_IDX) {
         fprintf(out_file, "  %-16s= %-s\n",
                 "FP_MODULE_IDX", FP_NAME_PTR(FP_MODULE_IDX(fp_idx)));
      }
      else {
         fprintf(out_file, "  %-16s= %-s\n", "FP_MODULE_IDX", "0");
      }

      if (FP_NEXT_FILE_IDX(fp_idx) != NULL_IDX &&
           FP_NAME_IDX(FP_NEXT_FILE_IDX(fp_idx)) != NULL_IDX) {
         fprintf(out_file, "  %-16s= %-6d  (%-s)\n",
                 "FP_NEXT_FILE_IDX", FP_NEXT_FILE_IDX(fp_idx),
                                     FP_NAME_PTR(FP_NEXT_FILE_IDX(fp_idx)));
      }
      else {
         fprintf(out_file, "  %-16s= %-s\n", "FP_NEXT_FILE_IDX", "0");
      }

      fprintf(out_file, "  %-16s= %-6d  %-16s= %-7d  %-16s= %-7s\n",
              "FP_MODULE_INLINE", FP_MODULE_INLINE_IDX(fp_idx),
              "FP_NAME_LEN", FP_NAME_LEN(fp_idx),
              "FP_OUTPUT_TO_O", boolean_str[FP_OUTPUT_TO_O(fp_idx)]);
#if defined(_HOST32) && defined(_TARGET64)
      fprintf(out_file, "  %-16s= %-20Ld \n",
              "FP_OFFSET", FP_OFFSET(fp_idx));
#else
      fprintf(out_file, "  %-16s= %-20ld \n",
              "FP_OFFSET", FP_OFFSET(fp_idx));
#endif

      fprintf(out_file, "  %-16s= %-6s  %-16s= %-7s  %-16s= %-7s\n",
              "FP_SRCH_THE_FILE", boolean_str[FP_SRCH_THE_FILE(fp_idx)],
              "FP_SYSTEM_FILE", boolean_str[FP_SYSTEM_FILE(fp_idx)],
              "FP_TMP_FILE", boolean_str[FP_TMP_FILE(fp_idx)]);

      fp_idx = FP_MODULE_IDX(fp_idx);
   }
   while (print_list && fp_idx != NULL_IDX);

   fprintf(out_file, "\n");

   fflush (out_file);
   return;

}  /* dump_fp_ntry */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints one global attr table entry to the specified output file.      *|
|*									      *|
|* Input parameters:							      *|
|*	FILE to print to - Should be debug_file, stderr, or stdout.           *|
|*	Index of global attr entry to print.                                  *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_ga_ntry (FILE		*out_file,
   		          int	 	 ga_idx)

{
   char		conv_str[80];
   int		ga_idx2;
   int		i;


   if (ga_idx > global_attr_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* GA index value [%d] is out of range.\n",
              ga_idx);
      return;
   }

   /* Note that the fields are displayed in alphabetical order.         */

   fprintf(out_file, "%-s\n", GA_OBJ_NAME_PTR(ga_idx));

   if (GA_OBJ_CLASS(ga_idx) == Common_Block) {
      fprintf(out_file, "  %-25s %-16s= %-7d %-16s= %-8d\n",
                     "Common_Blk",
                     "IDX", ga_idx,
                     "GA_DEF_COLUMN", GA_DEF_COLUMN(ga_idx));

      fprintf(out_file, "  %-16s= %-7d %-16s= %-7d %-s\n",
                        "GA_DEF_LINE", GA_DEF_LINE(ga_idx),
                        "GA_MODULE_IDX", GA_MODULE_IDX(ga_idx),
                        (GA_MODULE_IDX(ga_idx) == NULL_IDX) ? " ":
                                       GA_OBJ_NAME_PTR(GA_MODULE_IDX(ga_idx)));

      fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
                      "GA_NAME_LEN", GA_NAME_LEN(ga_idx),
                      "GA_USE_ASSOCIATE",boolean_str[GA_USE_ASSOCIATED(ga_idx)],
                      "GAC_AUXILIARY", boolean_str[GAC_AUXILIARY(ga_idx)]);

      fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                     "GAC_ALIGN_SYMBOL", boolean_str[GAC_ALIGN_SYMBOL(ga_idx)],
                     "GAC_CACHE_ALIGN", boolean_str[GAC_CACHE_ALIGN(ga_idx)],
                     "GAC_EQUIVALENCED", boolean_str[GAC_EQUIVALENCED(ga_idx)]);

      fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8s\n",
                      "GAC_FILL_SYMBOL", boolean_str[GAC_FILL_SYMBOL(ga_idx)],
                      "GAC_FIRST_MEMBER", GAC_FIRST_MEMBER_IDX(ga_idx),
                      "GAC_FOUND_DIFFS", boolean_str[GAC_FOUND_DIFFS(ga_idx)]);

      fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
                    "GAC_SECTION_GP", boolean_str[GAC_SECTION_GP(ga_idx)],
                    "GAC_SECTION_NON_", boolean_str[GAC_SECTION_NON_GP(ga_idx)],
                    "GAC_TASK_COMMON", boolean_str[GAC_TASK_COMMON(ga_idx)]);
#ifdef KEY /* Bug 14150 */
      const char *bl = GA_BINDING_LABEL(ga_idx);
      fprintf(out_file, "  %-16s= %-7s %-16s= %-s\n",
		    "GA_BIND_ATTR",boolean_str[GA_BIND_ATTR(ga_idx)],
		    "GA_BIND_LABEL", (bl ? bl : ""));
#endif /* KEY Bug 14150 */

      ga_idx2	= GAC_FIRST_MEMBER_IDX(ga_idx);

      while (ga_idx2 != NULL_IDX) {
         dump_ga_ntry(out_file, ga_idx2);
         ga_idx2 = GAD_NEXT_IDX(ga_idx2);
      }
      return;
   }


   fprintf(out_file, "  %-25s %-16s= %-7s %-16s= %-8d\n",
                     obj_class_str[GA_OBJ_CLASS(ga_idx)],
                     "GA_REFERENCED", boolean_str[GA_REFERENCED(ga_idx)],
                     "IDX", ga_idx);

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8d\n",
                     "GA_COMPILER_GEND", boolean_str[GA_COMPILER_GEND(ga_idx)],
                     "GA_DEF_COLUMN", GA_DEF_COLUMN(ga_idx),
                     "GA_DEF_LINE", GA_DEF_LINE(ga_idx));

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-s\n",
                     "GA_DEFINED", boolean_str[GA_DEFINED(ga_idx)],
                     "GA_MODULE_IDX", GA_MODULE_IDX(ga_idx),
                     (GA_MODULE_IDX(ga_idx) == NULL_IDX) ? " ":
                                       GA_OBJ_NAME_PTR(GA_MODULE_IDX(ga_idx)));

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8d\n",
                     "GA_NAME_LEN", GA_NAME_LEN(ga_idx),
                     "GA_OPTIONAL", boolean_str[GA_OPTIONAL(ga_idx)],
                     "GA_ORIG_NAME_LEN", GA_ORIG_NAME_LEN(ga_idx));

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-s\n",
                     "GA_USE_ASSOCIATE",boolean_str[GA_USE_ASSOCIATED(ga_idx)],
                     "GA_ORIG_NAME_IDX", GA_ORIG_NAME_IDX(ga_idx),
                              (GA_ORIG_NAME_IDX(ga_idx) == NULL_IDX)
                                         ? " ": GA_ORIG_NAME_PTR(ga_idx));


   switch (GA_OBJ_CLASS(ga_idx)) {
   case Data_Obj:

      fprintf(out_file, "  %-25s %-16s= %-7s %-16s= %-8d\n",
              atd_class_str[GAD_CLASS(ga_idx)],
              "GAD_ARRAY_ELEMEN", boolean_str[GAD_ARRAY_ELEMENT_REF(ga_idx)],
              "GAD_ARRAY_IDX", GAD_ARRAY_IDX(ga_idx));

      if (GAD_CLASS(ga_idx) == Dummy_Argument) {
         fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8d\n",
               "GAD_ASSUMED_SHAP", boolean_str[GAD_ASSUMED_SHAPE_ARRAY(ga_idx)],
               "GAD_INTENT", intent_str[GAD_INTENT(ga_idx)],
               "GAD_NEXT_IDX", GAD_NEXT_IDX(ga_idx));
      }
      else if (GAD_CLASS(ga_idx) == Constant) {
         fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-s\n",
               "GAD_ASSUMED_SHAP", boolean_str[GAD_ASSUMED_SHAPE_ARRAY(ga_idx)],
               "GAD_NEXT_IDX", GAD_NEXT_IDX(ga_idx),
               "GAD_HOLLERITH", cn_hollerith_str[GAD_HOLLERITH(ga_idx)]);
      }
      else {
         fprintf(out_file, "  %-16s= %-7s %-16s= %-7d\n",
               "GAD_ASSUMED_SHAP", boolean_str[GAD_ASSUMED_SHAPE_ARRAY(ga_idx)],
               "GAD_NEXT_IDX", GAD_NEXT_IDX(ga_idx));
      }

      fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8s\n",
              "GAD_POINTER", boolean_str[GAD_POINTER(ga_idx)],
              "GAD_RANK", GAD_RANK(ga_idx),
              "GAD_TARGET", boolean_str[GAD_TARGET(ga_idx)]);

#ifdef KEY /* Bug 14110 */
      fprintf(out_file, "  %-16s= %-7s\n",
	      "GAD_VOLATILE", boolean_str[GAD_VOLATILE(ga_idx)]);
#endif /* KEY /* Bug 14110 */

      fprintf(out_file, "  %-16s= %-7d %-s\n",
              "GAD_TYPE_IDX",  GAD_TYPE_IDX(ga_idx),
               print_global_type_f(GAD_TYPE_IDX(ga_idx)));

      if (GAD_ARRAY_IDX(ga_idx) != NULL_IDX) {
         dump_gb_ntry(out_file, GAD_ARRAY_IDX(ga_idx));
      }

      break;


   case Pgm_Unit:

      fprintf(out_file, "  %-25s %-16s= %-7s %-16s= %-8d\n",
              atp_pgm_unit_str[GAP_PGM_UNIT(ga_idx)],
              "GAP_ELEMENTAL", boolean_str[GAP_ELEMENTAL(ga_idx)],
              "GAP_FIRST_IDX", GAP_FIRST_IDX(ga_idx));

      fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
              "GAP_FP_IDX", GAP_FP_IDX(ga_idx),
              "GAP_GLOBAL_DIR", boolean_str[GAP_GLOBAL_DIR(ga_idx)],
              "GAP_IN_INTERFACE", boolean_str[GAP_IN_INTERFACE_BLK(ga_idx)]);

      fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8s\n",
              "GAP_NEEDS_EXPL_I", boolean_str[GAP_NEEDS_EXPL_ITRFC(ga_idx)],
              "GAP_NEXT_PGM_IDX", GAP_NEXT_PGM_UNIT_IDX(ga_idx),
              "GAP_NOSIDE_EFFEC", boolean_str[GAP_NOSIDE_EFFECTS(ga_idx)]);

      fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8s\n",
              "GAP_NUM_DARGS", GAP_NUM_DARGS(ga_idx),
              "GAP_PGM_UNIT_DEF", boolean_str[GAP_PGM_UNIT_DEFINED(ga_idx)],
              "GAP_PURE", boolean_str[GAP_PURE(ga_idx)]);

#ifdef KEY /* Bug 14150 */
      fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
              "GAP_RECURSIVE", boolean_str[GAP_RECURSIVE(ga_idx)],
              "GAP_VFUNCTION",boolean_str[GAP_VFUNCTION(ga_idx)],
	      "GA_BIND_ATTR",boolean_str[GA_BIND_ATTR(ga_idx)]);
      const char *bl = GA_BINDING_LABEL(ga_idx);
      fprintf(out_file, "  %-16s= %-s\n",
      	      "GA_BIND_LABEL", (bl ? bl : ""));
#else /* KEY */
      fprintf(out_file, "  %-16s= %-7s %-16s= %-7s\n",
              "GAP_RECURSIVE", boolean_str[GAP_RECURSIVE(ga_idx)],
              "GAP_VFUNCTION",boolean_str[GAP_VFUNCTION(ga_idx)]);
#endif /* KEY Bug 14150 */

      if (GAP_RSLT_IDX(ga_idx) != NULL_IDX) {
         dump_ga_ntry(out_file, GAP_RSLT_IDX(ga_idx));
      }

      ga_idx2	= GAP_FIRST_IDX(ga_idx);

      for (i = GAP_NUM_DARGS(ga_idx); i > 0; i--) {
         dump_ga_ntry(out_file, ga_idx2);
         ga_idx2++;
      }

      break;

   case Derived_Type:

      fprintf(out_file, "  %-16s= %-7d %-16s= %-7d %-16s= %-8s\n",
              "GAT_FIRST_CPNT_I", GAT_FIRST_CPNT_IDX(ga_idx),
              "GAT_NUM_CPNTS", GAT_NUM_CPNTS(ga_idx),
              "GAT_PRIVATE_CPNT", boolean_str[GAT_PRIVATE_CPNT(ga_idx)]);

#if ! (defined(_HOST32) && defined(_TARGET64))
      /* 31Jan01[sos]: Following call to convert_to_string gets SIGSEGV w/PV 761865 */
      /* fprintf(out_file, "  %-16s= %-7s %-16s= %-33s\n",                          */
      /*         "GAT_SEQUENCE_SET", boolean_str[GAT_SEQUENCE_SET(ga_idx)],         */
      /*         "GAT_STRUCT_BIT_L",                                                */
      /*              convert_to_string(GAT_STRUCT_BIT_LEN(ga_idx),                 */
      /*                                GAT_STRUCT_LIN_TYPE(ga_idx), conv_str));    */
      /* Fix follows...                                                             */
      fprintf(out_file, "  %-16s= %-7s %-16s= %-33ld\n",
              "GAT_SEQUENCE_SET", boolean_str[GAT_SEQUENCE_SET(ga_idx)],
              "GAT_STRUCT_BIT_L", *GAT_STRUCT_BIT_LEN(ga_idx));
#else
      fprintf(out_file, "  %-16s= %-7s %-16s= %-33Ld\n",
              "GAT_SEQUENCE_SET", boolean_str[GAT_SEQUENCE_SET(ga_idx)],
              "GAT_STRUCT_BIT_L", *GAT_STRUCT_BIT_LEN(ga_idx));
#endif

      ga_idx2	= GAT_FIRST_CPNT_IDX(ga_idx);

      for (i = GAT_NUM_CPNTS(ga_idx); i > 0; i--) {
         dump_ga_ntry(out_file, ga_idx2);
         ga_idx2++;
      }

      break;


   default:
      break;

   }  /* End switch */

   putc ('\n', out_file);
   fflush (out_file);

   return;

}  /* dump_ga_ntry */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints one global bounds table entry to the specified output file.    *|
|*									      *|
|* Input parameters:							      *|
|*	FILE to print to - Should be debug_file, stderr, or stdout.           *|
|*	Index of global bound entry to print.                                 *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_gb_ntry (FILE		*out_file,
   		          int	 	 gb_idx)

{
   char		conv_str[80];
   char		conv_str2[80];
   int		i;


   if (gb_idx > global_bounds_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* GB index value [%d] is out of range.\n",
              gb_idx);
      goto EXIT;
   }

   fprintf(out_file, "  %-16s= %-7d %-15s %-25s %-4s= %d\n",
                     "GB_RANK", GB_RANK(gb_idx),
                                bd_array_class_str[GB_ARRAY_CLASS(gb_idx)],
                                bd_array_size_str[GB_ARRAY_SIZE(gb_idx)],
                     "IDX", gb_idx);

   if (GB_ARRAY_CLASS(gb_idx) == Explicit_Shape && 
       GB_ARRAY_SIZE(gb_idx) == Constant_Size) {

      for (i = 1; i <=  GB_RANK(gb_idx); i++) {
         fprintf(out_file, "  %-16s= %-7d %-15s %-15s %-15s %-15s\n",
                           "Dimension", i,
                            convert_to_string(GB_LOWER_BOUND(gb_idx,i),
                                       GT_LINEAR_TYPE(GB_LB_TYPE(gb_idx,i)),
                                       conv_str),
                            print_global_type_f(GB_LB_TYPE(gb_idx,i)),
                            convert_to_string(GB_UPPER_BOUND(gb_idx,i),
                                       GT_LINEAR_TYPE(GB_UB_TYPE(gb_idx,i)),
                                       conv_str2),
                            print_global_type_f(GB_UB_TYPE(gb_idx,i)));
      }
   }

   putc ('\n', out_file);

EXIT:

   fflush (out_file);
   return;

}  /* dump_gb_ntry */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints a global line table entry.                                     *|
|*									      *|
|* Input parameters:							      *|
|*	Index of global line table entry to print.                            *|
|*									      *|
\******************************************************************************/

static	void dump_gl_ntry(FILE		*out_file,
			  int		 gl_idx)

{
   if (gl_idx > global_line_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* GL index value [%d] is out of range.\n",
              gl_idx);
      return;
   }

   fprintf(out_file,"%-s\n", GL_FILE_NAME_PTR(gl_idx));
   fprintf(out_file,"%-s\n", GL_PATH_NAME_PTR(gl_idx));

   if (full_debug_dump) {
      fprintf(out_file,"    %-22s= %-10d\n",
              "IDX", gl_idx);

      fprintf(out_file,"    %-22s= %-10d  %-20s= %-10d\n",
              "GL_PATH_NAME_IDX", GL_PATH_NAME_IDX(gl_idx),
              "GL_FILE_NAME_IDX", GL_FILE_NAME_IDX(gl_idx));
   }

   fprintf(out_file,"    %-22s= %-10d  %-20s= %-10d\n",
           "GL_CIF_FILE_ID", GL_CIF_FILE_ID(gl_idx),
           "GL_FILE_LINE",   GL_FILE_LINE(gl_idx));

   fprintf(out_file,"    %-22s= %-10d  %-20s= %-10d\n",
           "GL_FILE_NAME_LEN", GL_FILE_NAME_LEN(gl_idx),
           "GL_GLOBAL_LINE",   GL_GLOBAL_LINE(gl_idx));

   fprintf(out_file,"    %-22s= %-10d  %-20s= %-10d\n",
           "GL_INCLUDE_FILE_COL", GL_INCLUDE_FILE_COL(gl_idx),
           "GL_INCLUDE_FILE_LINE", GL_INCLUDE_FILE_LINE(gl_idx));


   fprintf(out_file,"    %-22s= %-10d  %-20s= %-10d\n",
           "GL_PATH_NAME_LEN", GL_PATH_NAME_LEN(gl_idx),
           "GL_SOURCE_LINES", GL_SOURCE_LINES(gl_idx));

   return;

}  /* dump_gl_ntry */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints a global name table entry.                                     *|
|*									      *|
|* Input parameters:							      *|
|*	Index of global name table entry to print.                            *|
|*									      *|
\******************************************************************************/
static	void dump_gn_ntry(FILE		*out_file,
			  int		 gn_idx)

{
   if (gn_idx > global_name_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* GN index value [%d] is out of range.\n",
              gn_idx);
      return;
   }

   fprintf(out_file, "%-s\n", GN_NAME_PTR(gn_idx));

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7d \n",
           "IDX", gn_idx,
           "GN_ATTR_IDX", GN_ATTR_IDX(gn_idx));

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7d\n",
           "GN_NAME_IDX", GN_NAME_IDX(gn_idx),
           "GN_NAME_LEN", GN_NAME_LEN(gn_idx));
   return;

}  /* dump_gn_ntry */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*									      *|
|* Input parameters:							      *|
|*	FILE to print to - Should be debug_file, stderr, or stdout.           *|
|*	Index of type table entry to print.                                   *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_gt_ntry(FILE	*out_file,
   		         int	 gt_idx)
 
{
   char		conv_str[80];


   if (gt_idx > global_type_tbl_idx) {
      fprintf(out_file,"\n*FE90-ERROR* GT index value [%d] is out of range.\n",
              gt_idx);
      return;
   }

   fprintf(out_file,"  %-25s %-25s %-26s\n",
           basic_type_str[GT_TYPE(gt_idx)],
           lin_type_str[GT_LINEAR_TYPE(gt_idx)],
           type_desc_str[GT_DESC(gt_idx)]);

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7d",
           "GT_DCL_VALUE", GT_DCL_VALUE(gt_idx),
           "IDX", gt_idx);

   if (GT_TYPE(gt_idx) == Character) {
      fprintf(out_file," %-25s \n  %-16s= %-s\n",
              type_char_class_str[GT_CHAR_CLASS(gt_idx)],
              "GT_LENGTH",
              convert_to_string(GT_LENGTH(gt_idx),
                                GT_LENGTH_LIN_TYPE(gt_idx),
                                conv_str));
   }
   else if (GT_TYPE(gt_idx) == CRI_Ptr) {
#if defined(_HOST32) && defined(_TARGET64)
      fprintf(out_file, " %-16s= %-7Ld\n",
           "GT_PTR_INCREMENT", GT_PTR_INCREMENT(gt_idx));
#else
      fprintf(out_file, " %-16s= %-7ld\n",
           "GT_PTR_INCREMENT", GT_PTR_INCREMENT(gt_idx));
#endif
   }
   else if (GT_TYPE(gt_idx) == Structure) {
      fprintf(out_file, " %-16s= %-7d\n",
                        "GT_STRUCT_IDX", GT_STRUCT_IDX(gt_idx));

      dump_ga_ntry(out_file, GT_STRUCT_IDX(gt_idx));
   }
   else {
      fprintf(out_file, " %-16s= %-33s\n",
              "GT_BIT_LEN", CONVERT_CVAL_TO_STR(&GT_BIT_LEN(gt_idx),
                                                 Integer_8,
                                                 conv_str));
   }

   putc ('\n', out_file);

   fflush (out_file);
   return;

}  /* dump_gt_ntry */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Dumps a single Hidden Name Table entry to the specified file.         *|
|*									      *|
|* Input parameters:							      *|
|*      Pointer to dump file.						      *|
|*	Index of Hidden Name Table entry to print.                            *|
|*      Flag to indicate whether to print the attr entry or not.  If the attr *|
|*         entry is printed, it is a full attr entry dump.                    *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_hn_ntry(FILE		*out_file,
			 int		idx,
                         boolean	print_the_attr)

{

   if (idx > hidden_name_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* HN index value [%d] is out of range.\n",
              idx);
      return;
   }

   if (HN_ATTR_IDX(idx) != NULL_IDX) {

      if (HN_NAME_IDX(idx) != NULL_IDX) {
         fprintf(out_file, "%-32.32s  ",&name_pool[HN_NAME_IDX(idx)].name_char);
      }
      else {
         fprintf(out_file, "%-32.32s  ", "**No name - HN_NAME_IDX is 0**");
      }
   }
   else {
      fprintf(out_file, "%-32.32s  ", "**Error** - HN_ATTR_IDX = 0**");
   }

   fprintf(out_file, "%-8s= %-7d %-16s= %-8d\n",
           "IDX", idx, 
           "HN_ATTR_IDX", HN_ATTR_IDX(idx));

   fprintf(out_file, "  %-16s= %-7d %-16s= %-8d\n",
           "HN_NAME_IDX", HN_NAME_IDX(idx),
           "HN_NAME_LEN", HN_NAME_LEN(idx));

   if (print_the_attr && HN_ATTR_IDX(idx) != NULL_IDX) {
      putc ('\n', out_file);
      dump_at_ntry(out_file, HN_ATTR_IDX(idx), TRUE);
   }

   putc ('\n', out_file);

   return;

}  /* dump_hn_ntry */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      Dumps a single List Table entry to the specified file.                *|
|*      See also print_list (used to dump a chain of List entries when the    *|
|*        length of the chain is known).                                      *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      Pointer to dump file.                                                 *|
|*      Index of List Table entry to print.                                   *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void dump_il_ntry(FILE         *out_file,
                         int          idx)

{
   if (idx > ir_list_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* IL index value [%d] is out of range.\n",
              idx);
      return;
   }

   fprintf(out_file, "%s= %-8d",
           "IL_NEXT_LIST_IDX", IL_NEXT_LIST_IDX(idx));

   if (! IL_ARG_DESC_VARIANT(idx)) {
      fprintf(out_file, "    %s= %-8d\n",
              "IL_PREV_LIST_IDX", IL_PREV_LIST_IDX(idx));
   }
   else {
      fprintf(out_file, "    %s= %-8d\n",
              "IL_ARG_DESC_IDX", IL_ARG_DESC_IDX(idx));
      putc('\n', out_file);
   }

   if (IL_FLD(idx) == IL_Tbl_Idx) {
      fprintf(out_file, "%s= %-8d   ",
              "IL_LIST_CNT", IL_LIST_CNT(idx));
   }
   else {
      fprintf(out_file, "%s= %-8d   %s= %-3d   ",
              "IL_LINE_NUM", IL_LINE_NUM(idx),
              "IL_COL_NUM",  IL_COL_NUM(idx));
   }

   fprintf(out_file, "%s= %s   %s= ",
           "IL_FLD", field_str[IL_FLD(idx)], "IL_IDX");

   if (IL_IDX(idx) != NULL_IDX) {
      fprintf(out_file, "%-8d\n", IL_IDX(idx));
   }
   else {
      fprintf(out_file, "%s\n", "*NULL_IDX*");
   }

   putc ('\n', out_file);

}  /* dump_il_ntry */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      recursively prints ir text. Not intended for stmt headers.            *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void dump_ir_ntry(FILE 	*out_file,
                         int	 idx,
		         int	 indent)

{
   int  	i;
   boolean	io_list = FALSE;
   char 	n_shift[INDENT_SIZE + 1];
   char		shift[80];
   int  	type_idx;
   long_type	io_type_code[2];


   if (idx > ir_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* IR index value [%d] is out of range.\n",
              idx);
      return;
   }

   for (i = 0; i < INDENT_SIZE * indent; i++) {
      shift[i] = ' ';
      if (i == 79)
         break;
   }
   shift[i] = '\0';
   for (i = 0; i < INDENT_SIZE; i++) {
      n_shift[i] = ' ';
   }

   n_shift[i]	= '\0';
   type_idx	= IR_TYPE_IDX(idx);

   fprintf(out_file, "%s%s  idx = %d", shift, operator_str[IR_OPR(idx)], idx);

   if (type_idx == NULL_IDX) {
      fprintf(out_file, "  %s  ", "NO TYPE");
   }
   else {
      fprintf(out_file, "  %s  ", print_type_f(type_idx));
   }

   if (IR_OPR(idx) >= Dv_Whole_Copy_Opr && 
       IR_OPR(idx) <= Dv_Set_Stride_Mult) {
      fprintf(out_file, " dim = %d", IR_DV_DIM(idx));
   }
# if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
   else if (IR_OPR(idx) == Call_Opr) {
      if (IR_INLINE_STATE(idx) == Inline_Sgi) {
         fprintf(out_file, " INLINE ");
      }
      else if (IR_INLINE_STATE(idx) == Noinline_Sgi) {
         fprintf(out_file, " NOINLINE ");
      }
   }
# endif

   if ((IR_OPR(idx) == Subscript_Opr ||
        IR_OPR(idx) == Section_Subscript_Opr ||
        IR_OPR(idx) == Substring_Opr) &&
       IR_BOUNDS_DONE(idx)) {

      fprintf(out_file, " BOUNDS DONE ");
   }

   if (IR_OPR(idx) == Whole_Subscript_Opr &&
       IR_CONTIG_ARRAY(idx)) {

     fprintf(out_file, " CONTIGUOUS ARRAY ");
   }

   if (IR_OPR(idx) == Subscript_Opr &&
       IR_WHOLE_ARRAY(idx)) {

     fprintf(out_file, " WHOLE ARRAY ");
   }

   if (IR_OPR(idx) == Read_Formatted_Opr ||
       IR_OPR(idx) == Read_Unformatted_Opr ||
       IR_OPR(idx) == Read_Namelist_Opr ||
       IR_OPR(idx) == Write_Formatted_Opr ||
       IR_OPR(idx) == Write_Unformatted_Opr ||
       IR_OPR(idx) == Write_Namelist_Opr ||
       IR_OPR(idx) == Inquire_Iolength_Opr) {

      io_list = TRUE;
   }

   fprintf(out_file, " rank = %d;", IR_RANK(idx));
   fprintf(out_file, " line = %d, col = %d\n", IR_LINE_NUM(idx),
                                                IR_COL_NUM(idx));

   if (IR_OPR(idx) == Dv_Whole_Def_Opr) {

      fprintf(out_file, "%sLeft opnd is %s;", shift, field_str[IR_FLD_L(idx)]);

      switch (IR_FLD_L(idx)) {
         case CN_Tbl_Idx :
         case AT_Tbl_Idx   :
                 fprintf(out_file,"  line = %d, col = %d\n",IR_LINE_NUM_L(idx),
                                 IR_COL_NUM_L(idx));
                 break;
         case IL_Tbl_Idx  :
                 fprintf(out_file,"  list cnt = %d\n", IR_LIST_CNT_L(idx));
                 break;
         default         :
                 fprintf(out_file,"\n");
                 break;
      }

#ifdef KEY /* Bug 6845 */
      print_Dv_Whole_Def_Opr(out_file, IR_IDX_L(idx),
                            indent + 1, IR_LIST_CNT_L(idx), IR_DV_DIM(idx));
#else /* KEY Bug 6845 */
      print_Dv_Whole_Def_Opr(out_file, IR_IDX_L(idx),
                            indent + 1, IR_LIST_CNT_L(idx));
#endif /* KEY Bug 6845 */
   }
   else if (IR_OPR(idx) == Doacross_Dollar_Opr ||
            IR_OPR(idx) == Psection_Par_Opr ||
            IR_OPR(idx) == Singleprocess_Par_Opr ||
            IR_OPR(idx) == Parallel_Do_Par_Opr ||
            IR_OPR(idx) == Parallel_Par_Opr ||
            IR_OPR(idx) == Pdo_Par_Opr) {


      fprintf(out_file, "%sLeft opnd is %s;", shift, field_str[IR_FLD_L(idx)]);

      switch (IR_FLD_L(idx)) {
         case CN_Tbl_Idx :
         case AT_Tbl_Idx   :
                 fprintf(out_file,"  line = %d, col = %d\n",IR_LINE_NUM_L(idx),
                                 IR_COL_NUM_L(idx));
                 break;
         case IL_Tbl_Idx  :
                 fprintf(out_file,"  list cnt = %d\n", IR_LIST_CNT_L(idx));
                 break;
         default         :
                 fprintf(out_file,"\n");
                 break;
      }

      print_mp_dir_opr(out_file, IR_IDX_L(idx),
                            indent + 1, IR_LIST_CNT_L(idx));
   }
   else if (IR_OPR(idx) == Do_Open_Mp_Opr ||
            IR_OPR(idx) == Parallel_Open_Mp_Opr ||
            IR_OPR(idx) == Paralleldo_Open_Mp_Opr ||
            IR_OPR(idx) == Parallelsections_Open_Mp_Opr ||
            IR_OPR(idx) == Sections_Open_Mp_Opr ||
            IR_OPR(idx) == Single_Open_Mp_Opr) {


      fprintf(out_file, "%sLeft opnd is %s;", shift, field_str[IR_FLD_L(idx)]);

      switch (IR_FLD_L(idx)) {
         case CN_Tbl_Idx :
         case AT_Tbl_Idx   :
                 fprintf(out_file,"  line = %d, col = %d\n",IR_LINE_NUM_L(idx),
                                 IR_COL_NUM_L(idx));
                 break;
         case IL_Tbl_Idx  :
                 fprintf(out_file,"  list cnt = %d\n", IR_LIST_CNT_L(idx));
                 break;
         default         :
                 fprintf(out_file,"\n");
                 break;
      }

      print_open_mp_dir_opr(out_file, IR_IDX_L(idx),
                            indent + 1, IR_LIST_CNT_L(idx));
   }
   else {

      if (IR_OPR(idx) == Io_Item_Type_Code_Opr) {
         make_io_type_code(IR_TYPE_IDX(idx), io_type_code);
         dump_io_type_code_ntry(out_file, io_type_code, indent + 1);
      }

      fprintf(out_file, "%sLeft opnd is %s;", shift, field_str[IR_FLD_L(idx)]);

      switch (IR_FLD_L(idx)) {
         case CN_Tbl_Idx :
         case AT_Tbl_Idx   :
         case SB_Tbl_Idx   :
                 fprintf(out_file,"  line = %d, col = %d\n",IR_LINE_NUM_L(idx),
                                 IR_COL_NUM_L(idx));
                 break;
         case IL_Tbl_Idx  :
                 fprintf(out_file,"  list cnt = %d\n", IR_LIST_CNT_L(idx));
                 break;
         default         :
                 fprintf(out_file,"\n");
                 break;
      }

      switch (IR_FLD_L(idx)) {
         case NO_Tbl_Idx :
                 break;
         case CN_Tbl_Idx : 
                 print_const_entry(out_file, IR_IDX_L(idx), indent + 1);
                 break;
         case AT_Tbl_Idx : 
                 print_attr_name(out_file, IR_IDX_L(idx), indent + 1);
                 break;
         case SB_Tbl_Idx : 
                 fprintf(out_file,"%s\n", SB_NAME_PTR(IR_IDX_L(idx)));
                 break;
         case IR_Tbl_Idx :
                 dump_ir_ntry(out_file, IR_IDX_L(idx), indent + 1);
                 break;
         case IL_Tbl_Idx :
                 if (IR_IDX_L(idx) != NULL_IDX && IR_LIST_CNT_L(idx) > 0) {
                    print_list(out_file, IR_IDX_L(idx), 
                            indent + 1, IR_LIST_CNT_L(idx), io_list);
                 }
                 break;
         case SH_Tbl_Idx :
                 fprintf(out_file, "%s%sStmt Header idx = %d\n", shift, 
                         n_shift, IR_IDX_L(idx));
                 break;
      }
   
      fprintf(out_file,"%sRight operand is %s;", shift,
                                                 field_str[IR_FLD_R(idx)]);
   
      switch (IR_FLD_R(idx)) {
         case CN_Tbl_Idx :
         case AT_Tbl_Idx :
         case SB_Tbl_Idx :
                 fprintf(out_file,"  line = %d, col = %d\n",
                         IR_LINE_NUM_R(idx), IR_COL_NUM_R(idx));
                 break;
         case IL_Tbl_Idx  :
                 fprintf(out_file,"  list cnt = %d\n", IR_LIST_CNT_R(idx));
                 break;
         default         :
                 fprintf(out_file,"\n");
                 break;
      }
   
   
      switch (IR_FLD_R(idx)) {
         case NO_Tbl_Idx  :
                 break;
         case CN_Tbl_Idx :
                 print_const_entry(out_file, IR_IDX_R(idx), indent + 1);
                 break;
         case AT_Tbl_Idx   :
                 print_attr_name(out_file, IR_IDX_R(idx), indent + 1);
                 break;
         case SB_Tbl_Idx : 
                 fprintf(out_file,"%s\n", SB_NAME_PTR(IR_IDX_R(idx)));
                 break;
         case IR_Tbl_Idx  :
                 dump_ir_ntry(out_file, IR_IDX_R(idx), indent + 1);
                 break;
         case IL_Tbl_Idx  :
                 if (IR_IDX_R(idx) != NULL_IDX && IR_LIST_CNT_R(idx) > 0) {
                    print_list(out_file, IR_IDX_R(idx),
                            indent + 1, IR_LIST_CNT_R(idx), io_list);
                 }
                 break;
         case SH_Tbl_Idx  :
                 fprintf(out_file, "%s%sStmt Header idx = %d\n", shift, 
                         n_shift, IR_IDX_R(idx));
                 break;
      }
   }

   return;

} /* dump_ir_ntry */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Dumps a single Local Name Table entry to the specified file.          *|
|*									      *|
|* Input parameters:							      *|
|*      Pointer to dump file.						      *|
|*	Index of Local Name Table entry to print.                             *|
|*      Flag to indicate whether to print the attr entry or not.  If the attr *|
|*         entry is printed, it is a full attr entry dump.                    *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_ln_ntry(FILE		*out_file,
			 int		idx,
                         boolean	print_the_attr)

{

   if (idx > loc_name_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* LN index value [%d] is out of range.\n",
              idx);
      return;
   }

   if (LN_ATTR_IDX(idx) != NULL_IDX) {

      if (LN_NAME_IDX(idx) != NULL_IDX) {
         fprintf(out_file, "%-32.32s  ",&name_pool[LN_NAME_IDX(idx)].name_char);
      }
      else {
         fprintf(out_file, "%-32.32s  ", "**No name - LN_NAME_IDX is 0**");
      }
   }
   else {
      fprintf(out_file, "%-32.32s  ", "**Error** - LN_ATTR_IDX = 0**");
   }

   fprintf(out_file, "%-10s= %-7d %-16s= %-8d\n",
           "IDX", idx, 
           "LN_ATTR_IDX", LN_ATTR_IDX(idx));
   fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8d\n",
           "LN_DEF_LOC", boolean_str[LN_DEF_LOC(idx)],
           "LN_NAME_LEN", LN_NAME_LEN(idx),
           "LN_NAME_IDX", LN_NAME_IDX(idx));
   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
           "LN_IN_ONLY_LIST", boolean_str[LN_IN_ONLY_LIST(idx)],
           "LN_NEW_NAME", boolean_str[LN_NEW_NAME(idx)],
           "LN_RENAMED", boolean_str[LN_RENAMED(idx)]);

   if (print_the_attr && LN_ATTR_IDX(idx) != NULL_IDX) {
      putc ('\n', out_file);
      dump_at_ntry(out_file, LN_ATTR_IDX(idx), TRUE);
   }

   putc ('\n', out_file);

   return;

}  /* dump_ln_ntry */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Dumps a single module link table entry to the specified file.         *|
|*									      *|
|* Input parameters:							      *|
|*      Pointer to dump file.						      *|
|*	Index of module link table entry to print.                            *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_ml_ntry(FILE		*out_file,
			 int		idx)

{
   if (idx > mod_link_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* ML index value [%d] is out of range.\n",
              idx);
      return;
   }

   fprintf(out_file, "%4s%-15s= %-2s  %-15s= %-8d  %-16s= %-9d\n", " ",
           "ML_AT_COMPRESSED_IDX", boolean_str[ML_AT_COMPRESSED_IDX(idx)],
           "ML_AT_IDX", ML_AT_IDX(idx),
           "IDX",	idx);

   fprintf(out_file, "%4s%-15s= %-2s  %-15s= %-8s  %-16s= %-9s\n", " ",
           "ML_AT_KEEP_ME", boolean_str[ML_AT_KEEP_ME(idx)],
           "ML_AT_LN_NAME", boolean_str[ML_AT_LN_NAME(idx)],
           "ML_AT_SEARCHED", boolean_str[ML_AT_SEARCHED(idx)]);

   fprintf(out_file, "%4s%-15s= %-2s  %-15s= %-8d\n", " ",
           "ML_BD_KEEP_ME", boolean_str[ML_BD_KEEP_ME(idx)],
           "ML_BD_IDX", ML_BD_IDX(idx));

   fprintf(out_file, "%4s%-15s= %-2s  %-15s= %-8d  %-16s= %-9s\n", " ",
           "ML_CN_KEEP_ME", boolean_str[ML_CN_KEEP_ME(idx)],
           "ML_CN_IDX", ML_CN_IDX(idx),
           "ML_CP_DALIGN_ME", boolean_str[ML_CP_DALIGN_ME(idx)]);

   fprintf(out_file, "%4s%-15s= %-2s  %-15s= %-8d  %-16s= %-9d\n", " ",
           "ML_CP_KEEP_ME", boolean_str[ML_CP_KEEP_ME(idx)],
           "ML_CP_IDX", ML_CP_IDX(idx),
           "ML_CP_LEN", ML_CP_LEN(idx));

   fprintf(out_file, "%4s%-15s= %-2s  %-15s= %-8d\n", " ",
           "ML_IL_KEEP_ME", boolean_str[ML_IL_KEEP_ME(idx)],
           "ML_IL_IDX", ML_IL_IDX(idx));

   fprintf(out_file, "%4s%-15s= %-2s  %-15s= %-8d\n", " ",
           "ML_IR_KEEP_ME", boolean_str[ML_IR_KEEP_ME(idx)],
           "ML_IR_IDX", ML_IR_IDX(idx));

   fprintf(out_file, "%4s%-15s= %-2s  %-15s= %-8d\n", " ",
           "ML_LN_KEEP_ME", boolean_str[ML_LN_KEEP_ME(idx)],
           "ML_LN_IDX", ML_LN_IDX(idx));

   fprintf(out_file, "%4s%-15s= %-2s  %-15s= %-8d  %-16s= %-9d\n", " ",
           "ML_NP_KEEP_ME", boolean_str[ML_NP_KEEP_ME(idx)],
           "ML_NP_IDX", ML_NP_IDX(idx),
           "ML_NP_LEN", ML_NP_LEN(idx));

   fprintf(out_file, "%4s%-15s= %-2s  %-15s= %-8d\n", " ",
           "ML_SB_KEEP_ME", boolean_str[ML_SB_KEEP_ME(idx)],
           "ML_SB_IDX", ML_SB_IDX(idx));

   fprintf(out_file, "%4s%-15s= %-2s  %-15s= %-8d\n", " ",
           "ML_SH_KEEP_ME", boolean_str[ML_SH_KEEP_ME(idx)],
           "ML_SH_IDX", ML_SH_IDX(idx));

   fprintf(out_file, "%4s%-15s= %-2s  %-15s= %-8d\n", " ",
           "ML_SN_KEEP_ME", boolean_str[ML_SN_KEEP_ME(idx)],
           "ML_SN_IDX", ML_SN_IDX(idx));

   fprintf(out_file, "%4s%-15s= %-2s  %-15s= %-8d\n", " ",
           "ML_TYP_KEEP_ME", boolean_str[ML_TYP_KEEP_ME(idx)],
           "ML_TYP_IDX", ML_TYP_IDX(idx));

   putc ('\n', out_file);

   return;

}  /* dump_ml_ntry */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints one Rename Only Table entry to the specified output file.      *|
|*									      *|
|* Input parameters:							      *|
|*	FILE to print to - Should be debug_file, stderr, or stdout.           *|
|*	Index of Rename Only Table entry to print.                            *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_ro_ntry(FILE	*out_file,
   		         int	 ro_idx)
 
{

   if (ro_idx > rename_only_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* ML index value [%d] is out of range.\n",
              ro_idx);
      return;
   }

   fprintf(out_file, "%4s%-32.32s", " ", RO_NAME_PTR(ro_idx));

   if (full_debug_dump) {
      fprintf(out_file, "  %-4s= %-7d  %-16s= %-9d\n",
              "IDX", ro_idx,
              "RO_NEXT_IDX", RO_NEXT_IDX(ro_idx));
   }
   else {
      fprintf(out_file, "\n");
   }

   fprintf(out_file, "%4s%-16s= %-2d  %-16s= %-7d  %-16s= %-9d\n", " ",
           "RO_COLUMN_NUM", RO_COLUMN_NUM(ro_idx),
           "RO_LINE_NUM", RO_LINE_NUM(ro_idx),
           "RO_NAME_LEN", RO_NAME_LEN(ro_idx));

   if (RO_RENAME_IDX(ro_idx) != NULL_IDX) {
      ro_idx = RO_RENAME_IDX(ro_idx);

      fprintf(out_file, "%4s%-16s  %-2s  %-16s= %-s\n", " ",
              "RENAMED", " ",
              "RO_NAME_PTR", RO_NAME_PTR(ro_idx));

      fprintf(out_file, "%4s%-16s= %-2d  %-16s= %-7d  %-16s= %-9d\n", " ",
              "RO_COLUMN_NUM", RO_COLUMN_NUM(ro_idx),
              "RO_LINE_NUM", RO_LINE_NUM(ro_idx),
              "RO_NAME_LEN", RO_NAME_LEN(ro_idx));

      fprintf(out_file, "%4s%-16s= %-2s  %-16s= %-7s\n", " ",
              "RO_RENAME_NAME", boolean_str[RO_RENAME_NAME(ro_idx)],
              "RO_DUPLICATE_REN", boolean_str[RO_DUPLICATE_RENAME(ro_idx)]);
   }

   fflush (out_file);
   return;

}  /* dump_ro_ntry */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints one Storage Block Table entry to the specified output file.    *|
|*									      *|
|* Input parameters:							      *|
|*	FILE to print to - Should be debug_file, stderr, or stdout.           *|
|*	Index of Storage Block Table entry to print.                          *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_sb_ntry(FILE	*out_file,
   		         int	 sb_idx)
 
{


   if (sb_idx > stor_blk_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* SB index value [%d] is out of range.\n",
              sb_idx);
      return;
   }

   if (SB_NAME_IDX(sb_idx) != NULL_IDX) {
      fprintf(out_file, "  %s\n", SB_NAME_PTR(sb_idx));
   }

   fprintf(out_file, "  %-16s= %-33s %-16s= %-8d\n",
           "SB_BLK_TYPE", sb_blk_type_str[SB_BLK_TYPE(sb_idx)],
           "IDX", sb_idx);

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-7s\n",
           "SB_ALIGN_SYMBOL", boolean_str[SB_ALIGN_SYMBOL(sb_idx)],
           "SB_AUXILIARY", boolean_str[SB_AUXILIARY(sb_idx)],
           "SB_BLANK_COMMON", boolean_str[SB_BLANK_COMMON(sb_idx)]);

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8s\n",
           "SB_CACHE_ALIGN", boolean_str[SB_COMMON_NEEDS_OFFSET(sb_idx)],
           "SB_CIF_SYMBOL_ID", SB_CIF_SYMBOL_ID(sb_idx),
           "SB_COMMON_NEEDS_", boolean_str[SB_COMMON_NEEDS_OFFSET(sb_idx)]);

   fprintf(out_file,
#ifdef KEY /* Bug 14150 */
           "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
	   "SB_BIND_ATTR", boolean_str[SB_BIND_ATTR(sb_idx)],
#else /* KEY Bug 14150 */
           "  %-16s  %-7s %-16s= %-7s %-16s= %-8s\n",
           " ", " ",
#endif /* KEY Bug 14150 */
           "SB_DCL_COMMON_DI", boolean_str[SB_DCL_COMMON_DIR(sb_idx)],
           "SB_DCL_ERR", boolean_str[SB_DCL_ERR(sb_idx)]);

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7d %-16s= %-8s\n",
           "SB_DEF_COLUMN", SB_DEF_COLUMN(sb_idx),
           "SB_DEF_LINE", SB_DEF_LINE(sb_idx),
           "SB_DEF_MULT_SCPS", boolean_str[SB_DEF_MULT_SCPS(sb_idx)]);

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8d\n",
           "SB_DUPLICATE_COM", boolean_str[SB_DUPLICATE_COMMON(sb_idx)],
           "SB_EQUIVALENCED", boolean_str[SB_EQUIVALENCED(sb_idx)],
           "SB_FIRST_ATTR_ID", SB_FIRST_ATTR_IDX(sb_idx));

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
           "SB_HAS_RENAMES", boolean_str[SB_HAS_RENAMES(sb_idx)],
           "SB_HIDDEN", boolean_str[SB_HIDDEN(sb_idx)],
           "SB_HOST_ASSOCIAT", boolean_str[SB_HOST_ASSOCIATED(sb_idx)]);

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
           "SB_HOSTED_STACK", boolean_str[SB_HOSTED_STACK(sb_idx)],
           "SB_HOSTED_STATIC", boolean_str[SB_HOSTED_STATIC(sb_idx)],
           "SB_IS_COMMON", boolean_str[SB_IS_COMMON(sb_idx)]);

   print_fld_idx(out_file, "SB_LEN_IDX",
                 SB_LEN_FLD(sb_idx), SB_LEN_IDX(sb_idx));

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7d %-16s= %-8s\n",
           "SB_LAST_ATTR_LIS", SB_LAST_ATTR_LIST(sb_idx),
           "SB_MERGED_BLK_ID", SB_MERGED_BLK_IDX(sb_idx),
           "SB_MODULE", boolean_str[SB_MODULE(sb_idx)]);

   if (SB_MODULE(sb_idx)) {

      if (SB_MODULE_IDX(sb_idx) == NULL_IDX) {
         fprintf(out_file, "  %-16s= %-7d\n",
                 "SB_MODULE_IDX", SB_MODULE_IDX(sb_idx));
      }
      else {
         fprintf(out_file, "  %-16s= %-7d %-33s\n",
                 "SB_MODULE_IDX", SB_MODULE_IDX(sb_idx),
                 print_at_name(SB_MODULE_IDX(sb_idx)));
      }
   }

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7d %-16s= %-8d\n",
           "SB_NAME_LEN", SB_NAME_LEN(sb_idx),
           "SB_ORIG_SCP_IDX", SB_ORIG_SCP_IDX(sb_idx),
#ifdef KEY /* Bug 14150 */
           "SB_EXT_NAME_IDX", SB_EXT_NAME_IDX(sb_idx)
#else /* KEY Bug 14150 */
           "SB_PAD_AMOUNT", SB_PAD_AMOUNT(sb_idx)
#endif /* KEY Bug 14150 */
	   );
#ifdef KEY /* Bug 14150 */
   if (SB_EXT_NAME_IDX(sb_idx)) {
     fprintf(out_file, "  %-16s= %-7d %-16s= %-16s\n",
       "SB_EXT_NAME_LEN", SB_EXT_NAME_LEN(sb_idx),
       "SB_EXT_NAME", SB_EXT_NAME_PTR(sb_idx));
   }
#endif /* KEY Bug 14150 */

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
           "SB_PAD_AMOUNT_SE", boolean_str[SB_PAD_AMOUNT_SET(sb_idx)],
           "SB_PAD_BLK", boolean_str[SB_PAD_BLK(sb_idx)],
           "SB_RUNTIME_INIT", boolean_str[SB_RUNTIME_INIT(sb_idx)]);

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7d %-16s= %-8s\n",
           "SB_SAVED", boolean_str[SB_SAVED(sb_idx)],
           "SB_SCP_IDX", SB_SCP_IDX(sb_idx),
           "SB_SECTION_GP", boolean_str[SB_SECTION_GP(sb_idx)]);

   fprintf(out_file, "  %-16s= %-7s %-16s= %-7s %-16s= %-8s\n",
           "SB_SECTION_NON_", boolean_str[SB_SECTION_NON_GP(sb_idx)],
           "SB_SYMMETRIC", boolean_str[SB_SYMMETRIC(sb_idx)],
           "SB_USE_ASSOCIATE", boolean_str[SB_USE_ASSOCIATED(sb_idx)]);

   fprintf(out_file, "  %-16s= %-7s\n",
           "SB_VOLATILE", boolean_str[SB_VOLATILE(sb_idx)]);

   putc ('\n', out_file);

   fflush (out_file);
   return;

}  /* dump_sb_ntry */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints one scope stack entry to the specified output file.            *|
|*									      *|
|* Input parameters:							      *|
|*	FILE to print to - Should be debug_file, stderr, or stdout.           *|
|*	Index of scope stack entry to print.                                  *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_scp_ntry (FILE		*out_file,
   		    	   int		scp_idx,
	                   int		shift_cnt,
		    	   boolean	print_impl_tbl,
			   boolean	print_all_children)

{
   char		ch;
   int		idx;
   int		save_scp_idx;
   char		shift[80];


PROCESS_SIBLING:

   if (scp_idx > scp_tbl_idx) {
      fprintf(out_file,"\n*FE90-ERROR* SCP index value [%d] is out of range.\n",
              scp_idx);
      return;
   }

   if (shift_cnt > 45) {
      fprintf(out_file, "\nFE90 - NESTING is too DEEP\n");
      shift_cnt = 45;
   }

   for (idx = 0; idx < shift_cnt; idx++) {
      shift[idx] = ' ';
   }
   shift[shift_cnt] = '\0';

   if (SCP_ATTR_IDX(scp_idx) != NULL_IDX) {
      fprintf(out_file, "%s%-32.32s", shift,
              AT_OBJ_NAME_PTR(SCP_ATTR_IDX(scp_idx)));
   }
   else if (scp_idx == INTRINSIC_SCP_IDX) {
      fprintf(out_file, "%s%-32.32s", shift, "*** INTRINSIC SCOPE ***");
   }
   else {
      fprintf(out_file, "%s%-32.32s", shift, "*** scope has no name ***");
   }

   if (SCP_IN_ERR(scp_idx)) {
      fprintf(out_file, "%5s%s", " ", "*** SCOPE IN ERROR ***");
   }

   fprintf(out_file,"\n%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "IDX", scp_idx,
           "SCP_ALT_ENTRY_CNT", SCP_ALT_ENTRY_CNT(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_ASSIGN_LBL_CHAIN", SCP_ASSIGN_LBL_CHAIN(scp_idx),
           "SCP_ATTR_IDX", SCP_ATTR_IDX(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_ATTR_LIST", SCP_ATTR_LIST(scp_idx),
           "SCP_ATTR_LIST_EN", SCP_ATTR_LIST_END(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d\n", " ",
           "SCP_CIF_ERR_LIST", SCP_CIF_ERR_LIST(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9s\n", " ",
           "SCP_CIF_ID", SCP_CIF_ID(scp_idx),
           "SCP_COPY_ASSUMED_SHA",boolean_str[SCP_COPY_ASSUMED_SHAPE(scp_idx)]);

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_COPY_ASSUMED_LIS", SCP_COPY_ASSUMED_LIST(scp_idx),
           "SCP_DARG_LIST", SCP_DARG_LIST(scp_idx));

# if 0
   fprintf(out_file,"%18s%-20s= %-7s  %-20s= %-9s\n", " ",
           "SCP_DBG_PRINT_STMT", boolean_str[SCP_DBG_PRINT_STMT(scp_idx)],
           "SCP_DBG_PRINT_SYTB", boolean_str[SCP_DBG_PRINT_SYTB(scp_idx)]);
# endif

   fprintf(out_file,"%18s%-20s= %-27s\n", " ",
           "SCP_DEFAULT_STORAGE", 
           sb_blk_type_str[SCP_DBG_PRINT_SYTB(scp_idx)]);

   fprintf(out_file,"%18s%-20s= %-7s  %-20s= %-9d\n", " ",
           "SCP_DOES_IO", boolean_str[SCP_DOES_IO(scp_idx)],
           "SCP_ENTRY_IDX", SCP_ENTRY_IDX(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_EXIT_IR_SH_IDX", SCP_EXIT_IR_SH_IDX(scp_idx),
           "SCP_FILE_PATH_IDX", SCP_FILE_PATH_IDX(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_FIRST_CHILD_IDX", SCP_FIRST_CHILD_IDX(scp_idx),
           "SCP_FIRST_EQUIV_GRP", SCP_FIRST_EQUIV_GRP(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9s\n", " ",
           "SCP_FIRST_SH_IDX", SCP_FIRST_SH_IDX(scp_idx),
           "SCP_HAS_CALLS", boolean_str[SCP_HAS_CALLS(scp_idx)]);

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_HN_FW_IDX", SCP_HN_FW_IDX(scp_idx),
           "SCP_HN_LW_IDX", SCP_HN_LW_IDX(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7s  %-20s= %-9s\n", " ",
           "SCP_IGNORE_TKR", boolean_str[SCP_IGNORE_TKR(scp_idx)],
           "SCP_IMPL_NONE", boolean_str[SCP_IMPL_NONE(scp_idx)]);

   fprintf(out_file,"%18s%-20s= %-7s  %-20s= %-9s\n", " ",
           "SCP_IN_ERR", boolean_str[SCP_IN_ERR(scp_idx)],
           "SCP_IS_INTERFACE", boolean_str[SCP_IS_INTERFACE(scp_idx)]);

   fprintf(out_file,"%18s%-20s= %-7s  %-20s= %-9d\n", " ",
           "SCP_IS_USED_PROC", boolean_str[SCP_IS_USED_PROC(scp_idx)],
           "SCP_LAST_CHILD_IDX", SCP_LAST_CHILD_IDX(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_LAST_SH_IDX", SCP_LAST_SH_IDX(scp_idx),
           "SCP_LEVEL", SCP_LEVEL(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_LN_FW_IDX", SCP_LN_FW_IDX(scp_idx),
           "SCP_LN_LW_IDX", SCP_LN_LW_IDX(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_NUM_CHILDREN", SCP_NUM_CHILDREN(scp_idx),
           "SCP_OPTIONAL_CHAR_TM", SCP_OPTIONAL_CHAR_TMP(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9s\n", " ",
           "SCP_PARENT_IDX", SCP_PARENT_IDX(scp_idx),
           "SCP_PARENT_NONE", boolean_str[SCP_PARENT_NONE(scp_idx)]);

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_RETURN_LABEL", SCP_RETURN_LABEL(scp_idx),
           "SCP_SB_BASED_IDX", SCP_SB_BASED_IDX(scp_idx));


   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_SB_HOSTED_DATA", SCP_SB_HOSTED_DATA_IDX(scp_idx),
           "SCP_SB_HOSTED_STAC", SCP_SB_HOSTED_STACK_IDX(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_SB_HOSTED_STAT", SCP_SB_HOSTED_STATIC_IDX(scp_idx),
           "SCP_SB_STACK_IDX", SCP_SB_STACK_IDX(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_SB_STATIC_IDX", SCP_SB_STATIC_IDX(scp_idx),
           "SCP_SB_STATIC_INIT", SCP_SB_STATIC_INIT_IDX(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_SB_STATIC_UNINIT", SCP_SB_STATIC_UNINIT_IDX(scp_idx),
           "SCP_SB_SYMMETRIC", SCP_SB_SYMMETRIC_IDX(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_SIBLING_IDX", SCP_SIBLING_IDX(scp_idx),
           "SCP_RESHAPE_ARRA", SCP_RESHAPE_ARRAY_LIST(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_TMP_FW_IDX", SCP_TMP_FW_IDX(scp_idx),
           "SCP_TMP_FW_IDX2", SCP_TMP_FW_IDX2(scp_idx));

   fprintf(out_file,"%18s%-20s= %-7d  %-20s= %-9d\n", " ",
           "SCP_TMP_LIST", SCP_TMP_LIST(scp_idx),
           "SCP_USED_MODULE_LIST", SCP_USED_MODULE_LIST(scp_idx));
#ifdef KEY /* Bug 5089 */
   fprintf(out_file,"%18s%-20s= %-7s\n", " ",
           "SCP_USES_IEEE", boolean_str[SCP_USES_IEEE(scp_idx)]);
#endif /* KEY Bug 5089 */


   if (print_impl_tbl) {
      for (idx = 0; idx < MAX_IMPL_CHS; idx++) {
         ch = 'A' + idx;
         fprintf(out_file,"%18s%c %24s %-16s= %-9s\n", " ",
  	            ch, " ", "IM_SET", boolean_str[IM_SET(scp_idx, idx)]);
         dump_typ_ntry(out_file, IM_TYPE_IDX(scp_idx,idx));
         fprintf(out_file,"%44s %-16s= %-9s\n", " ",
                 "IM_STORAGE", implicit_storage_str[IM_STORAGE(scp_idx, idx)]);
      }
   }
   putc ('\n', out_file);

   if (print_all_children) {

      if (SCP_FIRST_CHILD_IDX(scp_idx) != NULL_IDX) {
         save_scp_idx	= scp_idx;
         scp_idx	= SCP_FIRST_CHILD_IDX(scp_idx);
         shift_cnt	= shift_cnt + 5;
         dump_scp_ntry(out_file, 
                       scp_idx,
                       shift_cnt,
                       print_impl_tbl,
                       TRUE);
         scp_idx = save_scp_idx;
      }

      if (SCP_SIBLING_IDX(scp_idx) != NULL_IDX) {
         scp_idx = SCP_SIBLING_IDX(scp_idx);
         goto PROCESS_SIBLING;
      }
   }

   fflush (out_file);
   return;

}  /* dump_scp_ntry */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Prints a single Secondary Name table entry.                           *|
|*									      *|
|* Input parameters:							      *|
|*	Index of Secondary Name table entry to print.                         *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_sn_ntry (FILE 	*out_file,
			  int 	 sn_idx)

{
   if (sn_idx > sec_name_tbl_idx) {
      fprintf(out_file, "\n*FE90-ERROR* SN index value [%d] is out of range.\n",
              sn_idx);
      return;
   }

   fprintf(out_file, "  %-51s", &name_pool[SN_NAME_IDX(sn_idx)].name_char); 

   fprintf(out_file, " %-16s= %-8d\n", "            IDX", sn_idx);

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7d %-16s= %-8d\n",
           "SN_COLUMN_NUM", SN_COLUMN_NUM(sn_idx),
           "SN_LINE_NUM",   SN_LINE_NUM(sn_idx),
           "SN_NAME_LEN",   SN_NAME_LEN(sn_idx));

  /* Only generic interface, operator interface, and namelist group   */
  /* Secondary Name table entries are linked together via the         */
  /* SN_SIBLING_LINK field.                                           */


   if (comp_phase == Decl_Semantics) {
      fprintf(out_file, "  %-16s= %-7s\n",
        "SN_MATCHED_DARG", boolean_str[SN_MATCHED_DARG(sn_idx)]);
   }

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7d %-16s= %-8d\n",
        "SN_NAME_IDX",     SN_NAME_IDX(sn_idx),
        "SN_ATTR_IDX",     SN_ATTR_IDX(sn_idx),
        "SN_SIBLING_LINK", SN_SIBLING_LINK(sn_idx));

   fflush(out_file);

   return;

}  /* dump_sn_ntry */


/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void dump_stmt_ntry(FILE		*out_file,
			   boolean	 print_stmt_ir)
{
  
   dump_trace_info(out_file, Stmt_Start, NULL, "SH_dump");

   fprintf(out_file, "IDX = %-7d   %s = %-7d     %s = %d   %s = %d\n",
                     curr_stmt_sh_idx,
                     "PREV SH IDX", SH_PREV_IDX(curr_stmt_sh_idx),
                     "NEXT SH IDX", SH_NEXT_IDX(curr_stmt_sh_idx),
                     "COL NUM",     SH_COL_NUM(curr_stmt_sh_idx));

   if (SH_LABELED(curr_stmt_sh_idx)  && 
       ! (SH_COMPILER_GEN(curr_stmt_sh_idx)  &&
          SH_STMT_TYPE(curr_stmt_sh_idx) == Continue_Stmt)) {
      fprintf(out_file, "   *Stmt is labeled*\n");
   }

   fprintf(out_file, "%16s%s = %-7d  %-11s = %s  %15s = %s\n", " ",
                     "PARENT BLK IDX", SH_PARENT_BLK_IDX(curr_stmt_sh_idx),
                     "LOOP END", boolean_str[SH_LOOP_END(curr_stmt_sh_idx)],
                     "DOALL LOOP END", 
                     boolean_str[SH_DOALL_LOOP_END(curr_stmt_sh_idx)]);

   if (print_stmt_ir  &&  SH_IR_IDX(curr_stmt_sh_idx) != NULL_IDX) {
      dump_ir_ntry(out_file, SH_IR_IDX(curr_stmt_sh_idx), 1);
   }

   return;

} /* dump_stmt_ntry */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*									      *|
|* Input parameters:							      *|
|*	FILE to print to - Should be debug_file, stderr, or stdout.           *|
|*	Index of module file table entry to print.                            *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void dump_typ_ntry(FILE	*out_file,
   		          int	 type_idx)
 
{
   char		conv_str[80];


   if (type_idx > type_tbl_idx) {
      fprintf(out_file,"\n*FE90-ERROR* TYP index value [%d] is out of range.\n",
              type_idx);
      return;
   }

   fprintf(out_file,"  %-25s %-25s %-26s\n",
           basic_type_str[TYP_TYPE(type_idx)],
           lin_type_str[TYP_LINEAR(type_idx)],
           type_desc_str[TYP_DESC(type_idx)]);

   fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8d\n",
           "TYP_DCL_VALUE", TYP_DCL_VALUE(type_idx),
           "TYP_DP_HIT_ME", boolean_str[TYP_DP_HIT_ME(type_idx)],
           "IDX", type_idx);

   if (TYP_TYPE(type_idx) == Character) {

      fprintf(out_file,"  %-25s %-16s= %-8s\n",
              type_char_class_str[TYP_CHAR_CLASS(type_idx)],
              "TYP_RESOLVED", boolean_str[TYP_RESOLVED(type_idx)]);

      print_fld_idx(out_file, "TYP_IDX",
                    TYP_FLD(type_idx),
                    TYP_IDX(type_idx));

      if (TYP_ORIG_LEN_IDX(type_idx) != NULL_IDX) {
         print_fld_idx(out_file, "TYP_ORIG_LEN_IDX",
                       TYP_FLD(type_idx),
                       TYP_ORIG_LEN_IDX(type_idx));
      }
   }
   else if (TYP_TYPE(type_idx) == CRI_Ptr) {
      fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-8d\n",
           "TYP_IDX", TYP_IDX(type_idx),
           "TYP_RESOLVED", boolean_str[TYP_RESOLVED(type_idx)],
           "TYP_PTR_INCREMEN", (int) TYP_PTR_INCREMENT(type_idx));
   }
   else {
      fprintf(out_file, "  %-16s= %-7d %-16s= %-7s %-16s= %-7s\n",
              "TYP_IDX", TYP_IDX(type_idx),
              "TYP_KIND_CONST", boolean_str[TYP_KIND_CONST(type_idx)],
              "TYP_KIND_DOUBLE", boolean_str[TYP_KIND_DOUBLE(type_idx)]);

      fprintf(out_file, "  %-16s= %-7s %-16s= %-s\n",
              "TYP_RESOLVED", boolean_str[TYP_RESOLVED(type_idx)],
              "TYP_BIT_LEN", CONVERT_CVAL_TO_STR(&TYP_BIT_LEN(type_idx),
                                                  Integer_8,
                                                  conv_str));
   }

   putc ('\n', out_file);

   fflush (out_file);
   return;

}  /* dump_typ_ntry */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      <description>                                                         *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void dump_io_type_code_ntry(FILE         *out_file,
                                   long_type    *value,
                                   int          indent)

{
   long_type    dec_len = 0;
   int          dp_flag = 0;
   int          dv_type;
   long_type    int_len = 0;
   int          kind_star = 0;
   char         shift[80];
   int          i;

   f90_type_t   *type_code;

   TRACE (Func_Entry, "dump_io_type_code_ntry", NULL);

   for (i = 0; i < INDENT_SIZE * indent; i++) {
      shift[i] = ' ';
      if (i == 79)
         break;
   }
   shift[i] = '\0';

# ifdef _TYPE_CODE_64_BIT

   type_code = (f90_type_t *)value;


   dv_type = type_code->type;

   dp_flag = type_code->dpflag;

   kind_star = type_code->kind_or_star;

   int_len = type_code->int_len;

   dec_len = type_code->int_len;
# else

   dv_type = ((*value) >> DV_TYPE_SHIFT) & 0xFF;

   dp_flag = ((*value) >> DV_DP_SHIFT) & 1;

   kind_star = ((*value) >> DV_KIND_STAR_SHIFT) & 07;

   int_len = ((*value) >> DV_INT_LEN_SHIFT) & 0xFFF;

   dec_len = ((*value) >> DV_DEC_LEN_SHIFT) & 0xFF;
# endif

   switch (dv_type) {
   case DV_TYPELESS:
      fprintf(out_file, "%sDV_TYPELESS  ", shift);
      break;
   case DV_INTEGER:
      fprintf(out_file, "%sDV_INTEGER  ", shift);
      break;
   case DV_REAL:
      fprintf(out_file, "%sDV_REAL  ", shift);
      break;
   case DV_COMPLEX:
      fprintf(out_file, "%sDV_COMPLEX  ", shift);
      break;
   case DV_LOGICAL:
      fprintf(out_file, "%sDV_LOGICAL  ", shift);
      break;
   case DV_ASCII_CHAR:
      fprintf(out_file, "%sDV_ASCII_CHAR  ", shift);
      break;
   case DV_ASCII_CHAR_SEQUENCE_STRUCT:
      fprintf(out_file, "%sDV_ASCII_CHAR_SEQUENCE_STRUCT  ", shift);
      break;
   case DV_STRUCT:
      fprintf(out_file, "%sDV_STRUCT  ", shift);
      break;
   case DV_BIT:
      fprintf(out_file, "%sDV_BIT  ", shift);
      break;
   case DV_2_BYTE_CHAR:
      fprintf(out_file, "%sDV_2_BYTE_CHAR  ", shift);
      break;
   case DV_2_BYTE_CHAR_SEQUENCE_STRUCT:
      fprintf(out_file, "%sDV_2_BYTE_CHAR_SEQUENCE_STRUCT  ", shift);
      break;
   case DV_4_BYTE_CHAR:
      fprintf(out_file, "%sDV_4_BYTE_CHAR  ", shift);
      break;
   case DV_4_BYTE_CHAR_SEQUENCE_STRUCT:
      fprintf(out_file, "%sDV_4_BYTE_CHAR_SEQUENCE_STRUCT  ", shift);
      break;
   default:
      fprintf(out_file, "\n*FE90-ERROR* bad dv_type from io_type code\n");
      break;
   }

   if (dp_flag) {
      fprintf(out_file, "DP = 1 ");
   }
   else {
      fprintf(out_file, "DP = 0 ");
   }

   switch (kind_star) {
   case DV_DEFAULT_TYPED :
      fprintf(out_file, "DEFAULT TYPED ");
      break;

   case DV_KIND_TYPED :
      fprintf(out_file, "KIND_TYPED ");
      break;

   case DV_STAR_TYPED :
      fprintf(out_file, "STAR_TYPED ");
      break;

   case DV_KIND_CONST :
      fprintf(out_file, "KIND_CONST ");
      break;

   case DV_KIND_DOUBLE :
      fprintf(out_file, "KIND_DOUBLE ");
      break;


   default :
      fprintf(out_file, "***INVALID*** ");
      break;

   }

#if defined(_HOST32) && defined(_TARGET64)
   fprintf(out_file,"INT_LEN = %" LONG_TYPE_FMT " ", int_len);
   fprintf(out_file,"DEC_LEN = %" LONG_TYPE_FMT " ", dec_len);
#else
   fprintf(out_file,"INT_LEN = %ld ", int_len);
   fprintf(out_file,"DEC_LEN = %ld ", dec_len);
#endif


   fprintf(out_file, "\n");

   TRACE (Func_Exit, "dump_io_type_code_ntry", NULL);

   return;

}  /* dump_io_type_code_ntry */

#ifdef KEY
void debug_to_stderr() {
  debug_file = stderr;
}
#endif /* KEY */

# endif
