|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
00001 /* 00002 00003 Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved. 00004 00005 This program is free software; you can redistribute it and/or modify it 00006 under the terms of version 2 of the GNU General Public License as 00007 published by the Free Software Foundation. 00008 00009 This program is distributed in the hope that it would be useful, but 00010 WITHOUT ANY WARRANTY; without even the implied warranty of 00011 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00012 00013 Further, this software is distributed without any warranty that it is 00014 free of the rightful claim of any third person regarding infringement 00015 or the like. Any license provided herein, whether implied or 00016 otherwise, applies only to this software file. Patent licenses, if 00017 any, provided herein do not apply to combinations of this program with 00018 other software, or any other product whatsoever. 00019 00020 You should have received a copy of the GNU General Public License along 00021 with this program; if not, write the Free Software Foundation, Inc., 59 00022 Temple Place - Suite 330, Boston MA 02111-1307, USA. 00023 00024 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00025 Mountain View, CA 94043, or: 00026 00027 http://www.sgi.com 00028 00029 For further information regarding this notice, see: 00030 00031 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00032 00033 */ 00034 00035 00036 00037 static char USMID[] = "\n@(#)5.0_pl/sources/debug.c 5.17 10/14/99 12:53:57\n"; 00038 00039 # include "defines.h" /* Machine dependent ifdefs */ 00040 00041 # include "host.m" /* Host machine dependent macros.*/ 00042 # include "host.h" /* Host machine dependent header.*/ 00043 # include "target.m" /* Target machine dependent macros.*/ 00044 # include "target.h" /* Target machine dependent header.*/ 00045 # include "globals.m" 00046 # include "tokens.m" 00047 # include "sytb.m" 00048 # include "p_globals.m" 00049 # include "debug.m" 00050 # include "s_utils.m" 00051 # include "globals.h" 00052 # include "tokens.h" 00053 # include "sytb.h" 00054 # include "p_globals.h" 00055 # include "debug.h" 00056 00057 static void build_fake_token (char *); 00058 static void chain_thru_sn_ntries(FILE *, int, boolean); 00059 static void dump_al_ntry (FILE *, int); 00060 static void dump_at_ntry (FILE *, int, boolean); 00061 static void dump_blk_ntry (FILE *, int); 00062 static void dump_bd_ntry (FILE *, int); 00063 static void dump_cn_ntry (FILE *, int); 00064 static void dump_dv (FILE *, int_dope_type *, boolean); 00065 static void dump_ga_ntry (FILE *, int); 00066 static void dump_gb_ntry (FILE *, int); 00067 static void dump_gl_ntry (FILE *, int); 00068 static void dump_gn_ntry (FILE *, int); 00069 static void dump_gt_ntry (FILE *, int); 00070 static void dump_hn_ntry (FILE *, int, boolean); 00071 static void dump_il_ntry (FILE *, int); 00072 static void dump_ir_ntry (FILE *, int, int); 00073 static void dump_ln_ntry (FILE *, int, boolean); 00074 static void dump_fp_ntry (FILE *, int, boolean); 00075 static void dump_ml_ntry (FILE *, int); 00076 static void dump_ro_ntry (FILE *, int); 00077 static void dump_sb_ntry (FILE *, int); 00078 static void dump_scp_ntry (FILE *, int, int, boolean, boolean); 00079 static void dump_sn_ntry (FILE *, int); 00080 static void dump_eq_ntry (FILE *, int); 00081 static void dump_stmt_ntry (FILE *, boolean); 00082 static void dump_typ_ntry (FILE *, int); 00083 static void dump_trace_info (FILE *, trace_type, char *, char *); 00084 static void loop_thru_sn_ntries (FILE *, int, boolean); 00085 static void print_all_text (boolean); 00086 static char *print_at_name (int); 00087 static void print_attr_name (FILE *, int, int); 00088 static void print_const_entry (FILE *, int, int); 00089 static void print_list (FILE *, int, int, int, boolean); 00090 static void print_Dv_Whole_Def_Opr (FILE *, int, int, int); 00091 static void print_mp_dir_opr (FILE *, int, int, int); 00092 static void print_open_mp_dir_opr(FILE *, int, int, int); 00093 static void print_expanded_stmt_for_scp(void); 00094 static void print_expanded_ir (int); 00095 static void print_expanded_il (int); 00096 static void print_expanded_opnd (opnd_type); 00097 static void print_expanded_const(int); 00098 static void print_fld_idx (FILE *, char *, fld_type,int); 00099 static char *print_global_type_f(int); 00100 static void print_tbl_header (char *); 00101 static void dump_io_type_code_ntry(FILE *, long_type *, int); 00102 00103 static boolean full_debug_dump; 00104 00105 00106 /******************************************************************************\ 00107 |* *| 00108 |* Description: *| 00109 |* If this is a debug compiler, open the debug file to hold output. *| 00110 |* *| 00111 |* Input parameters: *| 00112 |* NONE *| 00113 |* *| 00114 |* Output parameters: *| 00115 |* NONE *| 00116 |* *| 00117 |* Returns: *| 00118 |* NOTHING *| 00119 |* *| 00120 \******************************************************************************/ 00121 00122 FILE * init_debug_file (void) 00123 00124 { 00125 if (debug_file == NULL) { 00126 full_debug_dump = TRUE; 00127 00128 /* Set the name to cft90_dump, if this is called before or during */ 00129 /* command line processing. Usually this should be filename.l */ 00130 00131 if (debug_file_name[0] == NULL_CHAR) { 00132 strcpy(debug_file_name, "cft90_dump"); 00133 } 00134 00135 debug_file = fopen(debug_file_name, "w"); 00136 00137 if (debug_file == NULL) { 00138 PRINTMSG(1, 17, Error, 0, debug_file_name); 00139 exit_compiler(RC_USER_ERROR); 00140 } 00141 } 00142 00143 return(debug_file); 00144 00145 } /* init_debug_file */ 00146 00147 # ifdef _DEBUG 00148 00149 00150 /******************************************************************************\ 00151 |* *| 00152 |* Description: *| 00153 |* The following are routines to print full tables. They are called *| 00154 |* by using the -u commandline option with the table identifier. *| 00155 |* The attr table is an exception. It is called via -u sytb *| 00156 |* With a few exceptions, there are no input parameters. There are *| 00157 |* no output parameters and these routines return nothing. *| 00158 |* *| 00159 |* Input parameters: *| 00160 |* NONE *| 00161 |* *| 00162 |* Output parameters: *| 00163 |* NONE *| 00164 |* *| 00165 |* Returns: *| 00166 |* NOTHING *| 00167 |* *| 00168 \******************************************************************************/ 00169 00170 00171 /******************************************************************************\ 00172 |* *| 00173 |* Print bounds table. *| 00174 |* *| 00175 \******************************************************************************/ 00176 00177 void print_bd_tbl (void) 00178 00179 { 00180 int bd_idx; 00181 00182 00183 print_tbl_header("Bounds Table"); 00184 00185 bd_idx = 1; 00186 00187 while (bd_idx < bounds_tbl_idx) { 00188 dump_bd_ntry(debug_file, bd_idx); 00189 bd_idx += BD_NTRY_SIZE(bd_idx); 00190 } 00191 00192 bd_idx = BD_NEXT_FREE_NTRY(BD_FREE_LIST_IDX); 00193 00194 while (bd_idx != NULL_IDX) { 00195 dump_bd_ntry(debug_file, bd_idx); 00196 bd_idx = BD_NEXT_FREE_NTRY(bd_idx); 00197 } 00198 00199 putc ('\n', debug_file); 00200 fflush(debug_file); 00201 return; 00202 00203 } /* print_bd_tbl */ 00204 00205 00206 /******************************************************************************\ 00207 |* *| 00208 |* Print block stack. *| 00209 |* *| 00210 \******************************************************************************/ 00211 00212 void print_blk_tbl (void) 00213 00214 { 00215 int blk_idx; 00216 00217 00218 print_tbl_header("BLOCK STACK"); 00219 00220 for (blk_idx = 1; blk_idx <= blk_stk_idx; blk_idx++) { 00221 dump_blk_ntry(debug_file, blk_idx); 00222 } 00223 00224 putc ('\n', debug_file); 00225 fflush (debug_file); 00226 return; 00227 00228 } /* print_blk_tbl */ 00229 00230 00231 /******************************************************************************\ 00232 |* *| 00233 |* Print constant table *| 00234 |* *| 00235 \******************************************************************************/ 00236 00237 void print_cn_tbl (void) 00238 00239 { 00240 int cn_idx; 00241 00242 00243 print_tbl_header("Constant Table"); 00244 00245 for (cn_idx = 1; cn_idx <= const_tbl_idx; cn_idx++) { 00246 dump_cn_ntry(debug_file, cn_idx); 00247 } 00248 00249 putc ('\n', debug_file); 00250 fflush (debug_file); 00251 return; 00252 00253 } /* print_cn_tbl */ 00254 00255 /******************************************************************************\ 00256 |* *| 00257 |* Print equivalence table *| 00258 |* *| 00259 \******************************************************************************/ 00260 00261 void print_eq_tbl (void) 00262 { 00263 int next_group; 00264 int next_item; 00265 00266 00267 if (SCP_FIRST_EQUIV_GRP(curr_scp_idx) == NULL_IDX) { 00268 print_tbl_header("Equivalence Table is empty"); 00269 } 00270 else { 00271 print_tbl_header("Equivalence Table"); 00272 00273 next_group = SCP_FIRST_EQUIV_GRP(curr_scp_idx); 00274 00275 while (next_group != NULL_IDX) { 00276 fprintf(debug_file, "%21s\n", "NEW EQUIVALENCE GROUP"); 00277 next_item = next_group; 00278 00279 while (next_item != NULL_IDX) { 00280 dump_eq_ntry(debug_file, next_item); 00281 next_item = EQ_NEXT_EQUIV_OBJ(next_item); 00282 } 00283 next_group = EQ_NEXT_EQUIV_GRP(next_group); 00284 } 00285 } 00286 00287 putc ('\n', debug_file); 00288 fflush (debug_file); 00289 return; 00290 00291 } /* print_eq_tbl */ 00292 00293 00294 /******************************************************************************\ 00295 |* *| 00296 |* Print file path table *| 00297 |* *| 00298 \******************************************************************************/ 00299 00300 void print_fp_tbl (void) 00301 00302 { 00303 int fp_idx; 00304 00305 print_tbl_header("File Path Table"); 00306 00307 fprintf(debug_file, "%s\n\n", "Module paths:"); 00308 00309 fp_idx = module_path_idx; 00310 00311 while (fp_idx != NULL_IDX) { 00312 dump_fp_ntry(debug_file, fp_idx, TRUE); 00313 fp_idx = FP_NEXT_FILE_IDX(fp_idx); 00314 } 00315 00316 fprintf(debug_file, "%s\n\n", "Implicit Use Module Paths:"); 00317 00318 fp_idx = cmd_line_flags.implicit_use_idx; 00319 00320 while (fp_idx != NULL_IDX) { 00321 dump_fp_ntry(debug_file, fp_idx, TRUE); 00322 fp_idx = FP_NEXT_FILE_IDX(fp_idx); 00323 } 00324 00325 fprintf(debug_file, "%s\n\n", "Inline paths:"); 00326 00327 fp_idx = inline_path_idx; 00328 00329 while (fp_idx != NULL_IDX) { 00330 dump_fp_ntry(debug_file, fp_idx, TRUE); 00331 fp_idx = FP_NEXT_FILE_IDX(fp_idx); 00332 } 00333 00334 fprintf(debug_file, "%s\n\n", "Include paths:"); 00335 00336 print_fp_includes(); 00337 00338 putc ('\n', debug_file); 00339 fflush(debug_file); 00340 return; 00341 00342 } /* print_fp_tbl */ 00343 00344 /******************************************************************************\ 00345 |* *| 00346 |* Print global bounds table *| 00347 |* *| 00348 \******************************************************************************/ 00349 00350 void print_gb_tbl (void) 00351 00352 { 00353 int gb_idx; 00354 00355 00356 print_tbl_header("Global Bounds Table"); 00357 00358 gb_idx = 1; 00359 00360 while (gb_idx != NULL_IDX && gb_idx <= global_bounds_tbl_idx) { 00361 dump_gb_ntry(debug_file, gb_idx); 00362 00363 if (GB_ARRAY_SIZE(gb_idx) == Constant_Size && 00364 GB_ARRAY_CLASS(gb_idx) == Explicit_Shape) { 00365 gb_idx += (GB_RANK(gb_idx) * 2); 00366 } 00367 else { 00368 gb_idx++; 00369 } 00370 00371 } 00372 00373 putc ('\n', debug_file); 00374 fflush (debug_file); 00375 return; 00376 00377 } /* print_gb_tbl */ 00378 00379 00380 /******************************************************************************\ 00381 |* *| 00382 |* Print global line table *| 00383 |* *| 00384 \******************************************************************************/ 00385 00386 void print_gl_tbl (void) 00387 00388 { 00389 int gl_idx; 00390 00391 00392 print_tbl_header("Global Line Table"); 00393 00394 for (gl_idx = 1; gl_idx <= global_line_tbl_idx; gl_idx++) { 00395 dump_gl_ntry(debug_file, gl_idx); 00396 } 00397 00398 fprintf(debug_file,"\n %-22s= %-10d %-20s= %-10d\n", 00399 "num_prog_unit_err", num_prog_unit_errors, 00400 "num_ansi", num_ansi); 00401 00402 fprintf(debug_file," %-22s= %-10d %-20s= %-10d\n", 00403 "num_warnings", num_warnings, 00404 "num_cautions", num_cautions); 00405 00406 fprintf(debug_file," %-22s= %-10d %-20s= %-10d\n", 00407 "num_notes", num_notes, 00408 "num_comments", num_comments); 00409 00410 putc ('\n', debug_file); 00411 fflush (debug_file); 00412 return; 00413 00414 } /* print_gl_tbl */ 00415 00416 00417 /******************************************************************************\ 00418 |* *| 00419 |* Print global name table *| 00420 |* *| 00421 \******************************************************************************/ 00422 00423 void print_gn_tbl (void) 00424 00425 { 00426 int gn_idx; 00427 int gt_idx; 00428 00429 00430 print_tbl_header("Global Name Table"); 00431 00432 for (gn_idx = 2; gn_idx < global_name_tbl_idx; gn_idx++) { 00433 fprintf(debug_file, "\n****************************************" 00434 "****************************************\n"); 00435 dump_gn_ntry(debug_file, gn_idx); 00436 dump_ga_ntry(debug_file, GN_ATTR_IDX(gn_idx)); 00437 } 00438 fprintf(debug_file, "\n****************************************" 00439 "****************************************\n"); 00440 00441 for (gt_idx = 1; gt_idx <= global_type_tbl_idx; gt_idx++) { 00442 00443 if (GT_TYPE(gt_idx) == Structure) { 00444 dump_ga_ntry(debug_file, GT_STRUCT_IDX(gt_idx)); 00445 } 00446 } 00447 00448 putc ('\n', debug_file); 00449 fflush (debug_file); 00450 return; 00451 00452 } /* print_gn_tbl */ 00453 00454 00455 /******************************************************************************\ 00456 |* *| 00457 |* Print global type table *| 00458 |* *| 00459 \******************************************************************************/ 00460 00461 void print_gt_tbl (void) 00462 00463 { 00464 int gt_idx; 00465 00466 00467 print_tbl_header("Global Type Table"); 00468 00469 for (gt_idx = 1; gt_idx <= global_type_tbl_idx; gt_idx++) { 00470 dump_gt_ntry(debug_file, gt_idx); 00471 } 00472 00473 putc ('\n', debug_file); 00474 fflush (debug_file); 00475 return; 00476 00477 } /* print_gt_tbl */ 00478 00479 /******************************************************************************\ 00480 |* *| 00481 |* Print hidden name table *| 00482 |* *| 00483 \******************************************************************************/ 00484 00485 void print_hn_tbl() 00486 00487 { 00488 int hn_idx; 00489 00490 00491 print_tbl_header("Hidden Name Table"); 00492 00493 for (hn_idx = SCP_HN_FW_IDX(curr_scp_idx) + 1; 00494 hn_idx < SCP_HN_LW_IDX(curr_scp_idx); 00495 hn_idx++) { 00496 dump_hn_ntry(debug_file, hn_idx, FALSE); /* Don't print attrs */ 00497 } 00498 00499 putc ('\n', debug_file); 00500 fflush (debug_file); 00501 return; 00502 00503 } /* print_hn_tbl */ 00504 00505 00506 /******************************************************************************\ 00507 |* *| 00508 |* Print local name table without attr entries. *| 00509 |* *| 00510 \******************************************************************************/ 00511 00512 void print_ln_tbl() 00513 00514 { 00515 int ln_idx; 00516 00517 print_tbl_header("Local Name Table"); 00518 00519 for (ln_idx = SCP_LN_FW_IDX(curr_scp_idx) + 1; 00520 ln_idx < SCP_LN_LW_IDX(curr_scp_idx); 00521 ln_idx++) { 00522 dump_ln_ntry(debug_file, ln_idx, FALSE); /* Don't print attrs */ 00523 } 00524 00525 putc ('\n', debug_file); 00526 fflush (debug_file); 00527 return; 00528 00529 } /* print_ln_tbl */ 00530 00531 00532 /******************************************************************************\ 00533 |* *| 00534 |* Print module link table *| 00535 |* *| 00536 \******************************************************************************/ 00537 00538 void print_ml_tbl() 00539 00540 { 00541 int ml_idx; 00542 00543 00544 print_tbl_header("Module Link Table"); 00545 00546 fprintf(debug_file, 00547 " NOTE: Only print entries that have at least one nonzero index\n"); 00548 00549 for (ml_idx = 0; ml_idx <= mod_link_tbl_idx; ml_idx++) { 00550 00551 if (ML_AT_IDX(ml_idx) != NULL_IDX || 00552 ML_BD_IDX(ml_idx) != NULL_IDX || 00553 ML_CN_IDX(ml_idx) != NULL_IDX || 00554 ML_LN_IDX(ml_idx) != NULL_IDX || 00555 ML_NP_IDX(ml_idx) != NULL_IDX || 00556 ML_SB_IDX(ml_idx) != NULL_IDX || 00557 ML_IL_IDX(ml_idx) != NULL_IDX || 00558 ML_IR_IDX(ml_idx) != NULL_IDX || 00559 ML_CP_IDX(ml_idx) != NULL_IDX || 00560 ML_SH_IDX(ml_idx) != NULL_IDX || 00561 ML_TYP_IDX(ml_idx) != NULL_IDX || 00562 ML_SN_IDX(ml_idx) != NULL_IDX) { 00563 dump_ml_ntry(debug_file, ml_idx); 00564 } 00565 } 00566 00567 putc ('\n', debug_file); 00568 fflush (debug_file); 00569 return; 00570 00571 } /* print_ml_tbl */ 00572 00573 00574 /******************************************************************************\ 00575 |* *| 00576 |* Print rename only table *| 00577 |* *| 00578 \******************************************************************************/ 00579 00580 void print_ro_tbl (ro_start_idx) 00581 00582 { 00583 int ro_idx; 00584 00585 00586 print_tbl_header("Rename Only Table"); 00587 00588 ro_idx = ro_start_idx; 00589 00590 while (ro_idx != NULL_IDX) { 00591 dump_ro_ntry(debug_file, ro_idx); 00592 ro_idx = RO_NEXT_IDX(ro_idx); 00593 } 00594 00595 putc ('\n', debug_file); 00596 fflush(debug_file); 00597 return; 00598 00599 } /* print_ro_tbl */ 00600 00601 00602 /******************************************************************************\ 00603 |* *| 00604 |* Print storage block table *| 00605 |* *| 00606 \******************************************************************************/ 00607 00608 void print_sb_tbl (void) 00609 00610 { 00611 int sb_idx; 00612 00613 00614 print_tbl_header("Storage Block Table"); 00615 00616 for (sb_idx = 1; sb_idx <= stor_blk_tbl_idx; sb_idx++) { 00617 dump_sb_ntry(debug_file, sb_idx); 00618 } 00619 00620 putc ('\n', debug_file); 00621 fflush(debug_file); 00622 return; 00623 00624 } /* print_sb_tbl */ 00625 00626 00627 /******************************************************************************\ 00628 |* *| 00629 |* Print scope table *| 00630 |* *| 00631 \******************************************************************************/ 00632 00633 void print_scp_tbl(void) 00634 00635 { 00636 print_tbl_header("Scope Table"); 00637 00638 dump_scp_ntry(debug_file, 0, 0, FALSE, TRUE); 00639 00640 putc ('\n', debug_file); 00641 fflush (debug_file); 00642 return; 00643 00644 } /* print_scp_tbl */ 00645 00646 00647 /******************************************************************************\ 00648 |* *| 00649 |* Print statement header table *| 00650 |* *| 00651 |* This procedure is the driver for printing all Statement Headers and *| 00652 |* all their IR. A separate driver is required, like the Semantics Pass *| 00653 |* driver, because the underlying routine is called recursively and *| 00654 |* because we always want to start with the first SCP entry. *| 00655 |* *| 00656 \******************************************************************************/ 00657 00658 void print_sh_tbl (boolean print_all_scps) 00659 00660 { 00661 int save_curr_scp_idx; 00662 int save_curr_stmt_sh_idx; 00663 00664 00665 print_tbl_header("Statement Header Table"); 00666 00667 if (print_all_scps) { 00668 save_curr_scp_idx = curr_scp_idx; 00669 curr_scp_idx = 1; 00670 save_curr_stmt_sh_idx = curr_stmt_sh_idx; 00671 00672 print_all_text(TRUE); 00673 00674 curr_scp_idx = save_curr_scp_idx; 00675 curr_stmt_sh_idx = save_curr_stmt_sh_idx; 00676 } 00677 else { 00678 print_all_text(FALSE); /* Just print current scope */ 00679 } 00680 00681 return; 00682 00683 } /* print_sh_tbl */ 00684 00685 00686 /******************************************************************************\ 00687 |* *| 00688 |* Print type table *| 00689 |* *| 00690 \******************************************************************************/ 00691 00692 void print_typ_tbl (void) 00693 00694 { 00695 int type_idx; 00696 00697 00698 print_tbl_header("Type Table"); 00699 00700 for (type_idx = 1; type_idx <= type_tbl_idx; type_idx++) { 00701 dump_typ_ntry(debug_file, type_idx); 00702 } 00703 00704 putc ('\n', debug_file); 00705 fflush(debug_file); 00706 return; 00707 00708 } /* print_typ_tbl */ 00709 00710 00711 /******************************************************************************\ 00712 |* *| 00713 |* Description: *| 00714 |* Print commandline information to debug_file. *| 00715 |* *| 00716 |* Input parameters: *| 00717 |* NONE *| 00718 |* *| 00719 |* Output parameters: *| 00720 |* NONE *| 00721 |* *| 00722 |* Returns: *| 00723 |* NOTHING *| 00724 |* *| 00725 \******************************************************************************/ 00726 00727 void print_cmd_tbl (void) 00728 00729 { 00730 extern char *directive_str[]; 00731 int dir_idx; 00732 boolean first; 00733 int fp_idx; 00734 int i,j; 00735 00736 00737 print_tbl_header("Commandline Flags"); 00738 00739 fprintf(debug_file, " %-17s = %-s\n", 00740 " source file", src_file); 00741 fprintf(debug_file, " %-17s = %-s\n", 00742 "-b binary_output", (cmd_line_flags.binary_output)?bin_file:"NONE"); 00743 fprintf(debug_file, " %-17s= %-s\n", 00744 "-S assembly_output", (cmd_line_flags.assembly_output) ? 00745 assembly_file:"NONE"); 00746 00747 if (include_path_idx == NULL_IDX) { 00748 fprintf(debug_file, " %-17s = %-s\n", "-I include paths", "NONE"); 00749 } 00750 else { 00751 fprintf(debug_file, " %-17s\n", "-I include paths"); 00752 print_fp_includes(); 00753 } 00754 00755 if (module_path_idx == NULL_IDX) { 00756 fprintf(debug_file, " %-17s = %-s\n", "-p module paths", "NONE"); 00757 } 00758 else { 00759 fprintf(debug_file, " %-17s\n", "-p module paths"); 00760 fp_idx = module_path_idx; 00761 00762 while (fp_idx != NULL_IDX) { 00763 fprintf(debug_file, "%4s%-s\n", " ", FP_NAME_PTR(fp_idx)); 00764 fp_idx = FP_NEXT_FILE_IDX(fp_idx); 00765 } 00766 } 00767 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-7s\n", 00768 "-align8", boolean_str[cmd_line_flags.align8], 00769 "-align16", boolean_str[cmd_line_flags.align16], 00770 "-align32", boolean_str[cmd_line_flags.align32]); 00771 00772 fprintf(debug_file, " %-17s = %-2s\n", 00773 "-align64", boolean_str[cmd_line_flags.align64]); 00774 00775 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-7s\n", 00776 "-a dalign", boolean_str[cmd_line_flags.dalign], 00777 "-a taskcommon", boolean_str[cmd_line_flags.taskcommon], 00778 "-f ", src_form_str[cmd_line_flags.src_form]); 00779 00780 fprintf(debug_file, " %-17s = %-27s %-18s = %-7s\n", 00781 "-i ", integer_size_str[cmd_line_flags.integer_32], 00782 "-k solaris_profile", boolean_str[cmd_line_flags.solaris_profile]); 00783 00784 fprintf(debug_file, " %-17s = %-27s %-18s = %-7s\n", 00785 "-m ", msg_lvl_str[cmd_line_flags.msg_lvl_suppressed], 00786 "-s float64", boolean_str[cmd_line_flags.s_float64]); 00787 00788 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-7s\n", 00789 "-s default64", boolean_str[cmd_line_flags.s_default64], 00790 "-s default32", boolean_str[cmd_line_flags.s_default32], 00791 "-s cf77types", boolean_str[cmd_line_flags.s_cf77types]); 00792 00793 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-7s\n", 00794 "-s integer8", boolean_str[cmd_line_flags.s_integer8], 00795 "-s logical8", boolean_str[cmd_line_flags.s_logical8], 00796 "-s real8", boolean_str[cmd_line_flags.s_real8]); 00797 00798 00799 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-7s\n", 00800 "-s complex8", boolean_str[cmd_line_flags.s_complex8], 00801 "-s pointer8", boolean_str[cmd_line_flags.s_pointer8], 00802 "-s doublecomplex16", boolean_str[cmd_line_flags.s_doublecomplex16]); 00803 00804 fprintf(debug_file, " %-42s = %-2s\n", 00805 "-s doubleprecision16", 00806 boolean_str[cmd_line_flags.s_doubleprecision16]); 00807 00808 fprintf(debug_file, " %-17s = %-2s %-18s = %-s\n", 00809 "-t truncate_bits", boolean_str[cmd_line_flags.truncate_bits], 00810 "-G ", debug_lvl_str[cmd_line_flags.debug_lvl]); 00811 00812 fprintf(debug_file, " %-17s = ", "-N line_size"); 00813 00814 if (cmd_line_flags.line_size_80) { 00815 fprintf(debug_file, "%-7d\n", 80); 00816 } 00817 else if (cmd_line_flags.line_size_132) { 00818 fprintf(debug_file, "%-7d\n", 132); 00819 } 00820 else { 00821 fprintf(debug_file, "%-7d\n", 72); 00822 } 00823 00824 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-7s\n", 00825 "-Ps small pic", boolean_str[(cmd_line_flags.small_pic_model)], 00826 "-Pl large pic", boolean_str[(cmd_line_flags.large_pic_model)], 00827 "-R a", boolean_str[cmd_line_flags.runtime_argument]); 00828 00829 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-7s\n", 00830 "-R b", boolean_str[cmd_line_flags.runtime_bounds], 00831 "-R c", boolean_str[cmd_line_flags.runtime_conformance], 00832 "-R C", boolean_str[cmd_line_flags.runtime_arg_call]); 00833 00834 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-7s\n", 00835 "-R E", boolean_str[cmd_line_flags.runtime_arg_entry], 00836 "-R s", boolean_str[cmd_line_flags.runtime_substring], 00837 "-R n", boolean_str[cmd_line_flags.runtime_arg_count_only]); 00838 00839 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-d\n", 00840 "-V verify_option", boolean_str[(cmd_line_flags.verify_option)], 00841 "-X m", boolean_str[(cmd_line_flags.malleable)], 00842 "-X npes", cmd_line_flags.MPP_num_pes); 00843 00844 00845 fprintf(debug_file, "\n%s On/Off Flags (-e/-d)%s\n\n", 00846 " -------------------------- ", 00847 " -------------------------- "); 00848 00849 fprintf(debug_file, " %-26s = %-2s %-26s = %-2s\n", 00850 "a abort_if_any_errors", 00851 boolean_str[on_off_flags.abort_if_any_errors], 00852 "e ieee", 00853 boolean_str[on_off_flags.ieee]); 00854 fprintf(debug_file, " %-26s = %-2s %-26s = %-2s\n", 00855 "f flowtrace_option", 00856 boolean_str[on_off_flags.flowtrace_option], 00857 "g assembly_listing_file", 00858 boolean_str[on_off_flags.assembly_listing_file]); 00859 fprintf(debug_file, " %-26s = %-2s %-26s = %-2s\n", 00860 "i indef_init", 00861 boolean_str[on_off_flags.indef_init], 00862 "j exec_doloops_once", 00863 boolean_str[on_off_flags.exec_doloops_once]); 00864 fprintf(debug_file, " %-26s = %-2s %-26s = %-2s\n", 00865 "n issue_ansi_messages", 00866 boolean_str[on_off_flags.issue_ansi_messages], 00867 "p enable_double_precision", 00868 boolean_str[on_off_flags.enable_double_precision]); 00869 fprintf(debug_file, " %-26s = %-2s %-26s = %-2s\n", 00870 "q abort_on_100_errors", 00871 boolean_str[on_off_flags.abort_on_100_errors], 00872 "r round_mult_operations", 00873 boolean_str[on_off_flags.round_mult_operations]); 00874 fprintf(debug_file, " %-26s = %-2s %-26s = %-2s\n", 00875 "t alloc_autos_on_stack", 00876 boolean_str[on_off_flags.alloc_autos_on_stack], 00877 "u round_integer_divide", 00878 boolean_str[on_off_flags.round_integer_divide]); 00879 fprintf(debug_file, " %-26s = %-2s %-26s = %-2s\n", 00880 "u reciprical_divide", 00881 boolean_str[on_off_flags.reciprical_divide], 00882 "v save_all_vars", 00883 boolean_str[on_off_flags.save_all_vars]); 00884 fprintf(debug_file, " %-26s = %-2s %-26s = %-2s\n", 00885 "x allow_leading_uscore", 00886 boolean_str[on_off_flags.allow_leading_uscore], 00887 "A MPP_apprentice", 00888 boolean_str[on_off_flags.MPP_apprentice]); 00889 fprintf(debug_file, " %-26s = %-2s %-26s = %-2s\n", 00890 "B binary_output", 00891 boolean_str[on_off_flags.binary_output], 00892 "C shared_to_private_coer", 00893 boolean_str[on_off_flags.shared_to_private_coer]); 00894 fprintf(debug_file, " %-26s = %-2s %-26s = %-2s\n", 00895 "I implicit_none", 00896 boolean_str[on_off_flags.implicit_none], 00897 "P preprocess_only", 00898 boolean_str[on_off_flags.preprocess_only]); 00899 fprintf(debug_file, " %-26s = %-2s %-26s = %-2s\n", 00900 "Q allow_leading_uscore", 00901 boolean_str[on_off_flags.allow_leading_uscore], 00902 "R recursive", 00903 boolean_str[on_off_flags.recursive]); 00904 fprintf(debug_file, " %-26s = %-2s %-26s = %-2s\n", 00905 "S assembly_output", 00906 boolean_str[on_off_flags.assembly_output], 00907 "U upper_case_names", 00908 boolean_str[on_off_flags.upper_case_names]); 00909 fprintf(debug_file, " %-26s = %-2s %-26s = %-2s\n", 00910 "X atexpert", 00911 boolean_str[on_off_flags.atexpert], 00912 "Z save_dot_i", 00913 boolean_str[on_off_flags.save_dot_i]); 00914 00915 fprintf(debug_file, "\n%s Optimization Flags (-O)%s\n\n", 00916 " ------------------------- ", 00917 " ------------------------- "); 00918 00919 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s\n", 00920 "aggress", boolean_str[opt_flags.aggress], 00921 "bottom_load", boolean_str[opt_flags.bottom_load]); 00922 00923 fprintf(debug_file, " %-17s = %-2s %-18s = %-2d %-18s = %-2d\n", 00924 "fusion", boolean_str[opt_flags.fusion], 00925 "ieeeconform", (int) boolean_str[opt_flags.ieeeconform], 00926 "inline_lvl", opt_flags.inline_lvl); 00927 00928 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-2s\n", 00929 "jump", boolean_str[opt_flags.jump], 00930 "loopalign", boolean_str[opt_flags.loopalign], 00931 "mark", boolean_str[opt_flags.mark]); 00932 00933 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-2s\n", 00934 "modinline", boolean_str[opt_flags.modinline], 00935 "msgs", boolean_str[opt_flags.msgs], 00936 "neg_msgs", boolean_str[opt_flags.neg_msgs]); 00937 00938 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-2s\n", 00939 "nointerchange", boolean_str[opt_flags.nointerchange], 00940 "overindex", boolean_str[opt_flags.over_index], 00941 "pattern", boolean_str[opt_flags.pattern]); 00942 00943 fprintf(debug_file, " %-17s = %-2d\n", 00944 "pipeline", opt_flags.pipeline_lvl); 00945 00946 fprintf(debug_file, " %-17s = %-2s %-18s = %-2d %-18s = %-2d\n", 00947 "recurrence", boolean_str[opt_flags.recurrence], 00948 "scalar", opt_flags.scalar_lvl, 00949 "split", opt_flags.split_lvl); 00950 00951 fprintf(debug_file, " %-17s = %-2d %-18s = %-2d %-18s = %-2s\n", 00952 "support_lvl", opt_flags.support_lvl, 00953 "task", opt_flags.task_lvl, 00954 "taskinner", boolean_str[opt_flags.taskinner]); 00955 00956 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-2d\n", 00957 "threshold", boolean_str[opt_flags.threshold], 00958 "vsearch", boolean_str[opt_flags.vsearch], 00959 "unroll", opt_flags.unroll_lvl); 00960 00961 fprintf(debug_file, " %-17s = %-2d %-18s = %-2s %-18s = %-2s\n", 00962 "vector", opt_flags.vector_lvl, 00963 "vsearch", boolean_str[opt_flags.vsearch], 00964 "zeroinc", boolean_str[opt_flags.zeroinc]); 00965 00966 00967 fprintf(debug_file, "\n%s Disregard Flags (-x)%s\n\n", 00968 " -------------------------- ", 00969 " -------------------------- "); 00970 00971 fprintf(debug_file, " "); 00972 00973 /* 0 is Tok_Dir_Start - so skip it. */ 00974 00975 for (dir_idx = 1; (dir_idx < (Tok_Dir_End - Tok_Dir_Start -1)); dir_idx++) { 00976 fprintf(debug_file, "%-20s = %-2s ", directive_str[dir_idx], 00977 boolean_str[disregard_directive[dir_idx]]); 00978 00979 if ((dir_idx%3) == 0) { 00980 fprintf(debug_file, "\n "); 00981 } 00982 } 00983 00984 fprintf(debug_file, "\n\n%s Dump Flags (-u)%s\n\n", 00985 " ----------------------------- ", 00986 " ----------------------------- "); 00987 00988 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-2s\n", 00989 "abort_ansi", boolean_str[dump_flags.abort_on_ansi], 00990 "no_dim_pad", boolean_str[dump_flags.no_dimension_padding], 00991 "no_mod_output", boolean_str[dump_flags.no_module_output]); 00992 00993 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s\n", 00994 "bd", boolean_str[dump_flags.bd_tbl], 00995 "blk", boolean_str[dump_flags.blk_stk]); 00996 00997 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-2s\n", 00998 "cmd", boolean_str[dump_flags.cmd_line_tbls], 00999 "cn", boolean_str[dump_flags.cn_tbl], 01000 "defines", boolean_str[dump_flags.defines]); 01001 01002 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-2s\n", 01003 "fortran", boolean_str[dump_flags.fort_out], 01004 "fp", boolean_str[dump_flags.fp_tbl], 01005 "ftrace", boolean_str[dump_flags.ftrace_info]); 01006 01007 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-2s\n", 01008 "gl", boolean_str[dump_flags.gl_tbl], 01009 "intrin", boolean_str[dump_flags.intrin_tbl], 01010 "ir1", boolean_str[dump_flags.ir1_tbl]); 01011 01012 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-2s\n", 01013 "ir2", boolean_str[dump_flags.ir2_tbl], 01014 "ir3", boolean_str[dump_flags.ir3_tbl], 01015 "ir4", boolean_str[dump_flags.ir4_tbl]); 01016 01017 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-2s\n", 01018 "mem_report", boolean_str[dump_flags.mem_report], 01019 "mtrace", boolean_str[dump_flags.mtrace_info], 01020 "names", boolean_str[dump_flags.name_tbls]); 01021 01022 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-2s\n", 01023 "pdg", boolean_str[dump_flags.pdgcs], 01024 "pdt", boolean_str[dump_flags.pdt_dump], 01025 "sb", boolean_str[dump_flags.sb_tbl]); 01026 01027 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-2s\n", 01028 "scp", boolean_str[dump_flags.scp_tbl], 01029 "src", boolean_str[dump_flags.src_dmp], 01030 "stderr", boolean_str[dump_flags.std_err]); 01031 01032 fprintf(debug_file, " %-17s = %-2s %-18s = %-2s %-18s = %-2s\n", 01033 "stmt", boolean_str[dump_flags.stmt_dmp], 01034 "sytb", boolean_str[dump_flags.sytb], 01035 "typ", boolean_str[dump_flags.typ_tbl]); 01036 01037 fprintf(debug_file, "\n\n%s Message Options %s \n\n", 01038 " ----------------------------- ", 01039 " ----------------------------- "); 01040 01041 first = TRUE; 01042 01043 for (i = 0; i < MAX_MSG_SIZE; ++i) { 01044 01045 if (message_suppress_tbl[i] != 0) { 01046 01047 for (j = i * HOST_BITS_PER_WORD; j < (i+1) * HOST_BITS_PER_WORD; ++j) { 01048 01049 if (GET_MESSAGE_TBL(message_suppress_tbl, j)) { 01050 01051 if (!first) { 01052 first = FALSE; 01053 fprintf(debug_file, ","); 01054 } 01055 fprintf(debug_file, " %d", j); 01056 } 01057 } 01058 } 01059 01060 if (message_warning_tbl[i] != 0) { 01061 01062 for (j = i * HOST_BITS_PER_WORD; j < (i+1) * HOST_BITS_PER_WORD; ++j) { 01063 01064 if (GET_MESSAGE_TBL(message_warning_tbl, j)) { 01065 01066 if (!first) { 01067 first = FALSE; 01068 fprintf(debug_file, ","); 01069 } 01070 fprintf(debug_file, " W%d", j); 01071 } 01072 } 01073 } 01074 01075 if (message_error_tbl[i] != 0) { 01076 01077 for (j = i * HOST_BITS_PER_WORD; j < (i+1) * HOST_BITS_PER_WORD; ++j) { 01078 01079 if (GET_MESSAGE_TBL(message_error_tbl, j)) { 01080 01081 if (!first) { 01082 first = FALSE; 01083 fprintf(debug_file, ","); 01084 } 01085 fprintf(debug_file, " E%d", j); 01086 } 01087 } 01088 } 01089 } 01090 01091 putc ('\n', debug_file); 01092 01093 putc ('\n', debug_file); 01094 fflush (debug_file); 01095 return; 01096 01097 } /* print_cmd_tbl */ 01098 01099 /******************************************************************************\ 01100 |* *| 01101 |* Description: *| 01102 |* Using the scope table to find the start and stop of the local name *| 01103 |* table, print all the local name entries each scope. Use dump_ln_ntry *| 01104 |* and have it print all the complete attr entries for each local name. *| 01105 |* *| 01106 |* Input parameters: *| 01107 |* NONE *| 01108 |* *| 01109 |* Output parameters: *| 01110 |* NONE *| 01111 |* *| 01112 |* Returns: *| 01113 |* NOTHING *| 01114 |* *| 01115 \******************************************************************************/ 01116 01117 void print_sytb (int scp_idx, 01118 boolean print_all_scps, 01119 boolean dump_all) 01120 01121 { 01122 int al_idx; 01123 char header[60]; 01124 int ln_idx; 01125 int save_scp_idx; 01126 01127 01128 PROCESS_SIBLING: 01129 01130 if (scp_idx == INTRINSIC_SCP_IDX) { /* Intrinsic scope */ 01131 print_tbl_header("Intrinsic Symbol Table Dump"); 01132 } 01133 else if (SCP_ATTR_IDX(scp_idx) != NULL_IDX) { 01134 header[0] = '\0'; 01135 strcat(header, AT_OBJ_NAME_PTR(SCP_ATTR_IDX(scp_idx))); 01136 print_tbl_header(strcat(header, " Symbol Table Dump")); 01137 } 01138 else { 01139 print_tbl_header("Unnamed Symbol Table Dump"); 01140 } 01141 01142 for (ln_idx = SCP_LN_FW_IDX(scp_idx)+1; ln_idx < SCP_LN_LW_IDX(scp_idx); 01143 ln_idx++) { 01144 fprintf(debug_file, "****************************************" 01145 "****************************************\n"); 01146 dump_ln_ntry(debug_file, ln_idx, dump_all); 01147 } 01148 01149 al_idx = SCP_ATTR_LIST(scp_idx); 01150 01151 while (al_idx != NULL_IDX) { 01152 fprintf(debug_file, "****************************************" 01153 "****************************************\n"); 01154 dump_at_ntry(debug_file, AL_ATTR_IDX(al_idx), dump_all); 01155 al_idx = AL_NEXT_IDX(al_idx); 01156 } 01157 01158 fprintf(debug_file, "****************************************" 01159 "****************************************\n"); 01160 01161 if (print_all_scps) { 01162 01163 if (SCP_FIRST_CHILD_IDX(scp_idx) != NULL_IDX) { 01164 save_scp_idx = scp_idx; 01165 scp_idx = SCP_FIRST_CHILD_IDX(scp_idx); 01166 print_sytb(scp_idx, TRUE, TRUE); 01167 scp_idx = save_scp_idx; 01168 } 01169 01170 if (SCP_SIBLING_IDX(scp_idx) != NULL_IDX) { 01171 scp_idx = SCP_SIBLING_IDX(scp_idx); 01172 goto PROCESS_SIBLING; 01173 } 01174 01175 #if 0 01176 fprintf(debug_file, "**name pool***************\n"); 01177 for(al_idx = 0; al_idx<=300;al_idx++) 01178 fprintf(debug_file,"%s\n",&name_pool[al_idx].name_char); 01179 #endif 01180 } 01181 01182 return; 01183 01184 } /* print_sytb */ 01185 01186 /******************************************************************************\ 01187 |* *| 01188 |* Description: *| 01189 |* Prints the compressed table. *| 01190 |* *| 01191 |* Input parameters: *| 01192 |* loc name tbl index to start. *| 01193 |* loc name tbl index for end. *| 01194 |* *| 01195 |* Output parameters: *| 01196 |* NONE *| 01197 |* *| 01198 |* Returns: *| 01199 |* NOTHING *| 01200 |* *| 01201 \******************************************************************************/ 01202 void print_compressed_sytb(int ln_start, 01203 int ln_end) 01204 { 01205 int ln_idx; 01206 01207 print_tbl_header("Compressed Symbol Table"); 01208 01209 for (ln_idx = ln_start; ln_idx <= ln_end; ln_idx++) { 01210 dump_ln_ntry(debug_file, ln_idx, TRUE); /* Print the attr too */ 01211 } 01212 01213 putc ('\n', debug_file); 01214 fflush (debug_file); 01215 01216 return; 01217 01218 } /* print_compressed_sytb */ 01219 01220 /******************************************************************************\ 01221 |* *| 01222 |* Description: *| 01223 |* The following set of utilities dump one entry to stderr. There is *| 01224 |* one for each table. Input is the table index to print. These are *| 01225 |* external routines so they may be called from the debugger or inserted *| 01226 |* in code as 'print' statements. *| 01227 |* *| 01228 |* Input parameters: *| 01229 |* Index of table entry to print. *| 01230 |* *| 01231 |* Output parameters: *| 01232 |* NONE *| 01233 |* *| 01234 |* Returns: *| 01235 |* NOTHING *| 01236 |* *| 01237 \******************************************************************************/ 01238 01239 /******************************************************************************\ 01240 |* *| 01241 |* Attribute list table *| 01242 |* *| 01243 \******************************************************************************/ 01244 01245 void print_al (int al_idx) 01246 01247 { 01248 if (al_idx <= attr_list_tbl_idx) { 01249 dump_al_ntry(stderr, al_idx); 01250 } 01251 else { 01252 fprintf(stderr, "\n*FE90-ERROR* Invalid Attribute List Table index.\n"); 01253 } 01254 01255 return; 01256 01257 } /* print_al */ 01258 01259 /******************************************************************************\ 01260 |* *| 01261 |* Attribute Table *| 01262 |* *| 01263 \******************************************************************************/ 01264 01265 void print_at(int at_idx) 01266 01267 { 01268 01269 if (at_idx <= attr_tbl_idx) { 01270 dump_at_ntry(stderr, at_idx, FALSE); 01271 } 01272 else { 01273 fprintf(stderr, "\n*FE90-ERROR* Invalid Attribute Table index.\n"); 01274 } 01275 01276 return; 01277 01278 } /* print_at */ 01279 01280 /******************************************************************************\ 01281 |* *| 01282 |* Attribute Table *| 01283 |* *| 01284 \******************************************************************************/ 01285 01286 void print_at_all(int at_idx) 01287 01288 { 01289 if (at_idx <= attr_tbl_idx) { 01290 dump_at_ntry(stderr, at_idx, TRUE); 01291 } 01292 else { 01293 fprintf(stderr, "\n*FE90-ERROR* Invalid Attribute Table index.\n"); 01294 } 01295 01296 return; 01297 01298 } /* print_at_all */ 01299 01300 /******************************************************************************\ 01301 |* *| 01302 |* Bounds table *| 01303 |* *| 01304 \******************************************************************************/ 01305 01306 void print_bd (int bd_idx) 01307 01308 { 01309 if (bd_idx <= bounds_tbl_idx) { 01310 dump_bd_ntry(stderr, bd_idx); 01311 } 01312 else { 01313 fprintf(stderr, "\n*FE90-ERROR* Invalid bounds table index.\n"); 01314 } 01315 01316 return; 01317 01318 } /* print_bd */ 01319 01320 /******************************************************************************\ 01321 |* *| 01322 |* Block stack *| 01323 |* *| 01324 \******************************************************************************/ 01325 01326 void print_blk (int blk_idx) 01327 01328 { 01329 if (blk_idx <= blk_stk_idx) { 01330 dump_blk_ntry(stderr, blk_idx); 01331 } 01332 else { 01333 fprintf(stderr, "\n*FE90-ERROR* Invalid block stack index.\n"); 01334 } 01335 01336 return; 01337 01338 } /* print_blk */ 01339 01340 /******************************************************************************\ 01341 |* *| 01342 |* Constant table *| 01343 |* *| 01344 \******************************************************************************/ 01345 01346 void print_cn (int cn_idx) 01347 01348 { 01349 if (cn_idx <= const_tbl_idx) { 01350 dump_cn_ntry(stderr, cn_idx); 01351 } 01352 else { 01353 fprintf(stderr, "\n*FE90-ERROR* Invalid constant table index.\n"); 01354 } 01355 01356 return; 01357 01358 } /* print_cn */ 01359 01360 /******************************************************************************\ 01361 |* *| 01362 |* Equivalence Table *| 01363 |* *| 01364 \******************************************************************************/ 01365 01366 void print_eq (int eq_idx) 01367 01368 { 01369 01370 if (eq_idx <= equiv_tbl_idx) { 01371 dump_eq_ntry(stderr, eq_idx); 01372 } 01373 else { 01374 fprintf(stderr, "\n*FE90-ERROR* Invalid equivalence table index.\n"); 01375 } 01376 01377 return; 01378 01379 } /* print_eq */ 01380 01381 /******************************************************************************\ 01382 |* *| 01383 |* file path table *| 01384 |* *| 01385 \******************************************************************************/ 01386 01387 void print_fp (int fp_idx) 01388 01389 { 01390 if (fp_idx <= file_path_tbl_idx) { 01391 dump_fp_ntry(stderr, fp_idx, FALSE); 01392 } 01393 else { 01394 fprintf(stderr, "\n*FE90-ERROR* Invalid file path table index.\n"); 01395 } 01396 01397 return; 01398 01399 } /* print_fp */ 01400 01401 /******************************************************************************\ 01402 |* *| 01403 |* Print a single list table entry. *| 01404 |* *| 01405 \******************************************************************************/ 01406 01407 void print_il (int il_idx) 01408 01409 { 01410 if (il_idx <= ir_list_tbl_idx) { 01411 dump_il_ntry(stderr, il_idx); 01412 } 01413 else { 01414 fprintf(stderr, "\n*FE90-ERROR* Invalid ir list table index %d.\n", 01415 il_idx); 01416 } 01417 01418 return; 01419 } 01420 01421 /******************************************************************************\ 01422 |* *| 01423 |* IR tree *| 01424 |* *| 01425 \******************************************************************************/ 01426 01427 void print_ir (int ir_idx) 01428 01429 { 01430 if (ir_idx <= ir_tbl_idx) { 01431 dump_ir_ntry(stderr, ir_idx, 1); 01432 } 01433 else { 01434 fprintf(stderr, "\n*FE90-ERROR* Invalid ir table index.\n"); 01435 } 01436 01437 return; 01438 01439 } /* print_ir */ 01440 01441 /******************************************************************************\ 01442 |* *| 01443 |* Global attr table *| 01444 |* *| 01445 \******************************************************************************/ 01446 01447 void print_ga (int ga_idx) 01448 01449 { 01450 if (ga_idx <= global_attr_tbl_idx) { 01451 dump_ga_ntry(stderr, ga_idx); 01452 } 01453 else { 01454 fprintf(stderr, "\n*FE90-ERROR* Invalid global attr table index.\n"); 01455 } 01456 01457 return; 01458 01459 } /* print_ga */ 01460 01461 /******************************************************************************\ 01462 |* *| 01463 |* Global bounds table *| 01464 |* *| 01465 \******************************************************************************/ 01466 01467 void print_gb (int gb_idx) 01468 01469 { 01470 if (gb_idx <= global_bounds_tbl_idx) { 01471 dump_gb_ntry(stderr, gb_idx); 01472 } 01473 else { 01474 fprintf(stderr, "\n*FE90-ERROR* Invalid global bounds table index.\n"); 01475 } 01476 01477 return; 01478 01479 } /* print_gb */ 01480 01481 /******************************************************************************\ 01482 |* *| 01483 |* Global line table *| 01484 |* *| 01485 \******************************************************************************/ 01486 01487 void print_gl (int gl_idx) 01488 01489 { 01490 if (gl_idx <= global_line_tbl_idx) { 01491 dump_gl_ntry(stderr, gl_idx); 01492 } 01493 else { 01494 fprintf(stderr, "\n*FE90-ERROR* Invalid global name table index.\n"); 01495 } 01496 01497 return; 01498 01499 } /* print_gl */ 01500 01501 /******************************************************************************\ 01502 |* *| 01503 |* Global name table *| 01504 |* *| 01505 \******************************************************************************/ 01506 01507 void print_gn (int gn_idx) 01508 01509 { 01510 if (gn_idx <= global_name_tbl_idx) { 01511 dump_gn_ntry(stderr, gn_idx); 01512 } 01513 else { 01514 fprintf(stderr, "\n*FE90-ERROR* Invalid global name table index.\n"); 01515 } 01516 01517 return; 01518 01519 } /* print_gn */ 01520 01521 /******************************************************************************\ 01522 |* *| 01523 |* Global type table *| 01524 |* *| 01525 \******************************************************************************/ 01526 01527 void print_gt (int gt_idx) 01528 01529 { 01530 if (gt_idx <= global_type_tbl_idx) { 01531 dump_gt_ntry(stderr, gt_idx); 01532 } 01533 else { 01534 fprintf(stderr, "\n*FE90-ERROR* Invalid global type table index.\n"); 01535 } 01536 01537 return; 01538 01539 } /* print_gt */ 01540 01541 /******************************************************************************\ 01542 |* *| 01543 |* Hidden name table *| 01544 |* *| 01545 \******************************************************************************/ 01546 01547 void print_hn (int hn_idx) 01548 { 01549 01550 if (hn_idx <= hidden_name_tbl_idx) { 01551 dump_hn_ntry(stderr, hn_idx, FALSE); /* Don't print attrs */ 01552 } 01553 else { 01554 fprintf(stderr, "\n*FE90-ERROR* Invalid hidden name table index.\n"); 01555 } 01556 01557 return; 01558 01559 } /* print_hn */ 01560 01561 /******************************************************************************\ 01562 |* *| 01563 |* Local name table *| 01564 |* *| 01565 \******************************************************************************/ 01566 01567 void print_ln (int ln_idx) 01568 { 01569 if (ln_idx <= loc_name_tbl_idx) { 01570 dump_ln_ntry(stderr, ln_idx, FALSE); /* Don't print attrs */ 01571 } 01572 else { 01573 fprintf(stderr, "\n*FE90-ERROR* Invalid local name table index.\n"); 01574 } 01575 01576 return; 01577 01578 } /* print_ln */ 01579 01580 /******************************************************************************\ 01581 |* *| 01582 |* Local name table *| 01583 |* *| 01584 \******************************************************************************/ 01585 01586 void print_lnr (int ln_idx, 01587 int end_idx) 01588 { 01589 while (ln_idx <= end_idx) { 01590 01591 if (ln_idx <= loc_name_tbl_idx) { 01592 dump_ln_ntry(stderr, ln_idx, FALSE); /* Don't print attrs */ 01593 } 01594 else { 01595 fprintf(stderr, "\n*FE90-ERROR* Invalid local name table index.\n"); 01596 } 01597 ++ln_idx; 01598 } 01599 01600 return; 01601 01602 } /* print_lnr */ 01603 01604 /******************************************************************************\ 01605 |* *| 01606 |* Module link table *| 01607 |* *| 01608 \******************************************************************************/ 01609 01610 void print_ml (int ml_idx) 01611 01612 { 01613 if (ml_idx <= mod_link_tbl_idx) { 01614 dump_ml_ntry(stderr, ml_idx); 01615 } 01616 else { 01617 fprintf(stderr, "\n*FE90-ERROR* Invalid module link table index.\n"); 01618 } 01619 01620 return; 01621 01622 } /* print_ml */ 01623 01624 /******************************************************************************\ 01625 |* *| 01626 |* Rename only table *| 01627 |* *| 01628 \******************************************************************************/ 01629 01630 void print_ro (int ro_idx) 01631 01632 { 01633 if (ro_idx <= rename_only_tbl_idx) { 01634 dump_ro_ntry(stderr, ro_idx); 01635 } 01636 else { 01637 fprintf(stderr, "\n*FE90-ERROR* Invalid rename only table index.\n"); 01638 } 01639 01640 return; 01641 01642 } /* print_ro */ 01643 01644 /******************************************************************************\ 01645 |* *| 01646 |* Storage Block Table *| 01647 |* *| 01648 \******************************************************************************/ 01649 01650 void print_sb (int sb_idx) 01651 01652 { 01653 if (sb_idx <= stor_blk_tbl_idx) { 01654 dump_sb_ntry(stderr, sb_idx); 01655 } 01656 else { 01657 fprintf(stderr, "\n*FE90-ERROR* Invalid Storage Block Table index.\n"); 01658 } 01659 01660 return; 01661 01662 } /* print_sb */ 01663 01664 /******************************************************************************\ 01665 |* *| 01666 |* Scope table (print_impl_tbl - if TRUE print implicit table) *| 01667 |* *| 01668 \******************************************************************************/ 01669 01670 void print_scp(int scp_idx, 01671 boolean print_impl_tbl) 01672 01673 { 01674 if (scp_idx <= scp_tbl_idx) { 01675 dump_scp_ntry(stderr, scp_idx, 0, print_impl_tbl, FALSE); 01676 } 01677 else { 01678 fprintf(stderr, "\n*FE90-ERROR* Invalid scope table index.\n"); 01679 } 01680 01681 return; 01682 01683 } /* print_scp */ 01684 01685 /******************************************************************************\ 01686 |* *| 01687 |* Print one statement and its IR. *| 01688 |* *| 01689 \******************************************************************************/ 01690 01691 void print_sh (int stmt_idx) 01692 01693 { 01694 int save_curr_stmt_sh_idx; 01695 01696 01697 if (stmt_idx <= sh_tbl_idx) { 01698 save_curr_stmt_sh_idx = curr_stmt_sh_idx; 01699 curr_stmt_sh_idx = stmt_idx; 01700 01701 dump_stmt_ntry(stderr, TRUE); /* Print IR for this statement */ 01702 01703 curr_stmt_sh_idx = save_curr_stmt_sh_idx; 01704 } 01705 else { 01706 fprintf(stderr, "\n*FE90-ERROR* Invalid statement header index.\n"); 01707 } 01708 01709 return; 01710 01711 } /* print_sh */ 01712 01713 /******************************************************************************\ 01714 |* *| 01715 |* Secondary Name Table *| 01716 |* *| 01717 \******************************************************************************/ 01718 01719 void print_sn (int sn_idx) 01720 01721 { 01722 dump_sn_ntry(stderr, sn_idx); 01723 01724 return; 01725 01726 } /* print_sn */ 01727 01728 /******************************************************************************\ 01729 |* *| 01730 |* Type table *| 01731 |* *| 01732 \******************************************************************************/ 01733 01734 void print_typ (int type_idx) 01735 01736 { 01737 dump_typ_ntry(stderr, type_idx); 01738 01739 return; 01740 01741 } /* print_typ */ 01742 01743 01744 /******************************************************************************\ 01745 |* *| 01746 |* Miscellaneous routines and utility routines. *| 01747 |* *| 01748 \******************************************************************************/ 01749 01750 /******************************************************************************\ 01751 |* *| 01752 |* Input parameters: *| 01753 |* address of internal dope vector. *| 01754 |* *| 01755 |* Output parameters: *| 01756 |* NONE *| 01757 |* *| 01758 |* Returns: *| 01759 |* NOTHING *| 01760 |* *| 01761 \******************************************************************************/ 01762 01763 void print_dv (int_dope_type *dv, 01764 boolean dump_it) 01765 01766 { 01767 dump_dv(stderr, dv, dump_it); 01768 01769 return; 01770 01771 } /* print_dv */ 01772 01773 /******************************************************************************\ 01774 |* *| 01775 |* Description: *| 01776 |* Given the name of a local entity, this procedure prints a single *| 01777 |* Local Name Table entry to stderr. Does not print the attr entry. *| 01778 |* *| 01779 |* Input parameters: *| 01780 |* NONE *| 01781 |* *| 01782 |* Output parameters: *| 01783 |* NONE *| 01784 |* *| 01785 |* Returns: *| 01786 |* NOTHING *| 01787 |* *| 01788 \******************************************************************************/ 01789 01790 void print_ln_by_name (void) 01791 01792 { 01793 char name_string[MAX_ID_LEN + 1]; 01794 int ln_tbl_idx; 01795 01796 01797 printf("Enter LOCAL name->"); 01798 gets(name_string); 01799 build_fake_token(name_string); 01800 01801 if (srch_sym_tbl(TOKEN_STR(fake_token), TOKEN_LEN(fake_token), 01802 &ln_tbl_idx) != NULL_IDX) { 01803 dump_ln_ntry(stderr, ln_tbl_idx, FALSE); 01804 } 01805 else { 01806 fprintf(stderr, "\n*FE90-ERROR* No such name in the current scope."); 01807 } 01808 return; 01809 01810 } /* print_ln_by_name */ 01811 01812 01813 /******************************************************************************\ 01814 |* *| 01815 |* Description: *| 01816 |* Given an entity name, this function prints the Attribute entry for *| 01817 |* the entity on standard output. *| 01818 |* *| 01819 |* Input parameters: *| 01820 |* The entity's name. *| 01821 |* NOTE: This function currently only knows how to dump the attribute *| 01822 |* entry for a simple name. It will need to be upgraded to break *| 01823 |* down qualified names later. The declaration for name_string *| 01824 |* will have to be expanded, the qualified name will have to be *| 01825 |* broken down, and srch_cpnt_name will have to be called to *| 01826 |* find the attribute entry for the rightmost component name. *| 01827 |* *| 01828 |* Output parameters: *| 01829 |* NONE *| 01830 |* *| 01831 |* Returns: *| 01832 |* NOTHING *| 01833 |* *| 01834 \******************************************************************************/ 01835 01836 void print_at_by_name(void) 01837 01838 { 01839 int attr_idx; 01840 int ln_tbl_idx; 01841 char name_string[MAX_ID_LEN + 1]; 01842 char reply; 01843 01844 printf("Entity name->"); 01845 gets(name_string); 01846 01847 /* This is where the code should go to break down a qualified name. */ 01848 01849 build_fake_token(name_string); 01850 attr_idx = srch_sym_tbl(TOKEN_STR(fake_token), TOKEN_LEN(fake_token), 01851 &ln_tbl_idx); 01852 01853 if (attr_idx != NULL_IDX) { 01854 dump_at_ntry(stderr, attr_idx, FALSE); 01855 } 01856 else { 01857 printf( 01858 "\n*POSSIBLE FE90-ERROR* No such entity name in the local scope.\n"); 01859 printf("Search host scope? (y) "); 01860 reply = getchar(); 01861 01862 if (reply == '\n' || reply == 'y') { 01863 01864 if (reply == 'y') { 01865 reply = getchar(); /* Get rid of newline char. */ 01866 } 01867 attr_idx = srch_host_sym_tbl(TOKEN_STR(fake_token), 01868 TOKEN_LEN(fake_token), 01869 &ln_tbl_idx, 01870 TRUE); 01871 01872 if (attr_idx != NULL_IDX) { 01873 dump_at_ntry(stderr, attr_idx, FALSE); 01874 } 01875 else { 01876 printf("\n*FE90-ERROR* No such entity name in the host either.\n"); 01877 } 01878 } 01879 else { 01880 reply = getchar(); /* Get rid of newline char. */ 01881 } 01882 } 01883 01884 return; 01885 01886 } /* print_at_by_name */ 01887 01888 01889 /******************************************************************************\ 01890 |* *| 01891 |* Description: *| 01892 |* Given a common block or module name, this function prints the Storage *| 01893 |* Block Table entry for the specified common block or module to stderr. *| 01894 |* *| 01895 |* Input parameters: *| 01896 |* The name of the common block or module. *| 01897 |* *| 01898 |* Output parameters: *| 01899 |* NONE *| 01900 |* *| 01901 |* Returns: *| 01902 |* NOTHING *| 01903 |* *| 01904 \******************************************************************************/ 01905 01906 void print_sb_by_name (void) 01907 01908 { 01909 int sb_idx; 01910 char name_string[MAX_ID_LEN + 1]; 01911 01912 printf("Enter common block or module name->"); 01913 gets(name_string); 01914 01915 if (strlen(name_string) > 0) { 01916 build_fake_token(name_string); 01917 } 01918 else { 01919 build_fake_token("//"); 01920 } 01921 01922 sb_idx = srch_stor_blk_tbl(TOKEN_STR(fake_token), 01923 TOKEN_LEN(fake_token), 01924 curr_scp_idx); 01925 01926 if (sb_idx != NULL_IDX) { 01927 dump_sb_ntry(stderr, sb_idx); 01928 } 01929 else { 01930 fprintf(stderr,"\n*FE90-ERROR* No such common block or module name.\n"); 01931 } 01932 01933 return; 01934 01935 } /* print_sb_by_name */ 01936 01937 /******************************************************************************\ 01938 |* *| 01939 |* Description: *| 01940 |* Prints an attr list to stderr. *| 01941 |* *| 01942 |* Input parameters: *| 01943 |* Index of attribute list entry to start printing with. *| 01944 |* *| 01945 |* Output parameters: *| 01946 |* NONE *| 01947 |* *| 01948 |* Returns: *| 01949 |* NOTHING *| 01950 |* *| 01951 \******************************************************************************/ 01952 01953 void print_al_list(FILE *out_file, 01954 int al_idx) 01955 01956 { 01957 01958 while (al_idx != NULL_IDX) { 01959 dump_al_ntry(out_file, al_idx); 01960 al_idx = AL_NEXT_IDX(al_idx); 01961 } 01962 01963 return; 01964 01965 } /* print_al_list */ 01966 01967 /******************************************************************************\ 01968 |* *| 01969 |* Description: *| 01970 |* Prints the Secondary Name table entries that belong to the indexed *| 01971 |* entity to stderr. *| 01972 |* *| 01973 |* Input parameters: *| 01974 |* Index of Attribute entry that should have Secondary Name table *| 01975 |* entries associated with it. *| 01976 |* *| 01977 |* Output parameters: *| 01978 |* NONE *| 01979 |* *| 01980 |* Returns: *| 01981 |* NOTHING *| 01982 |* *| 01983 \******************************************************************************/ 01984 01985 void print_sn_list (int attr_idx) 01986 01987 { 01988 if (attr_idx > attr_tbl_idx) { 01989 fprintf(stderr, 01990 "\n*FE90-ERROR* Attribute entry index [%d] is too large.\n", 01991 attr_idx); 01992 return; 01993 } 01994 01995 /* Dummy arguments and keyword names for an explicit interface are in a */ 01996 /* in a contiguous grouping. Procedure names in a generic or operator */ 01997 /* interface, namelist group members and component names are linked */ 01998 /* together (not necessarily contiguous). */ 01999 02000 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit && 02001 Pgm_Unknown < ATP_PGM_UNIT(attr_idx) < Program) { 02002 loop_thru_sn_ntries(stderr, attr_idx, FALSE); 02003 } 02004 else if (AT_OBJ_CLASS(attr_idx) == Interface || 02005 AT_OBJ_CLASS(attr_idx) == Namelist_Grp || 02006 AT_OBJ_CLASS(attr_idx) == Derived_Type) { 02007 chain_thru_sn_ntries(stderr, attr_idx, FALSE); 02008 } 02009 else { 02010 fprintf(stderr, 02011 "\n*FE90-ERROR* %s can not have Secondary Name table entries.\n", 02012 &name_pool[AT_NAME_IDX(attr_idx)].name_char); 02013 } 02014 return; 02015 02016 } /* print_sn_list */ 02017 02018 /******************************************************************************\ 02019 |* *| 02020 |* Description: *| 02021 |* Prints just include entries from the file path table. *| 02022 |* *| 02023 |* Input parameters: *| 02024 |* NONE *| 02025 |* *| 02026 |* Output parameters: *| 02027 |* NONE *| 02028 |* *| 02029 |* Returns: *| 02030 |* NOTHING *| 02031 |* *| 02032 \******************************************************************************/ 02033 02034 void print_fp_includes (void) 02035 02036 { 02037 int fp_idx; 02038 02039 fp_idx = include_path_idx; 02040 02041 while (fp_idx != NULL_IDX) { 02042 fprintf(debug_file, "%4s%-s\n", " ", FP_NAME_PTR(fp_idx)); 02043 02044 fp_idx = FP_NEXT_FILE_IDX(fp_idx); 02045 } 02046 02047 fflush(debug_file); 02048 02049 return; 02050 02051 } /* print_fp_includes */ 02052 02053 02054 /******************************************************************************\ 02055 |* *| 02056 |* Description: *| 02057 |* Prints just the name field of an Attr entry. Useful when you know *| 02058 |* the index of an Attr and you just want to know what identifier the *| 02059 |* Attr is for. *| 02060 |* *| 02061 |* Input parameters: *| 02062 |* idx : the Attr index *| 02063 |* *| 02064 |* Output parameters: *| 02065 |* NONE *| 02066 |* *| 02067 |* Returns: *| 02068 |* NOTHING *| 02069 |* *| 02070 \******************************************************************************/ 02071 void print_name(int idx) 02072 { 02073 02074 fprintf(stderr, "%d is %s\n", idx, AT_OBJ_NAME_PTR(idx)); 02075 02076 return; 02077 02078 } /* print_name */ 02079 02080 /******************************************************************************\ 02081 |* *| 02082 |* Description: *| 02083 |* Loops through a contiguous set of Secondary Name table entries and *| 02084 |* writes them to stderr or a dump file. *| 02085 |* *| 02086 |* Input parameters: *| 02087 |* - A pointer to the file to which the output is to be sent. *| 02088 |* - Index of Attribute entry that should have Secondary Name table *| 02089 |* entries associated with it. *| 02090 |* - A flag that indicates whether or not the Attribute entry for the *| 02091 |* Secondary Name table item should be output. *| 02092 |* *| 02093 |* Output parameters: *| 02094 |* NONE *| 02095 |* *| 02096 |* Returns: *| 02097 |* NOTHING *| 02098 |* *| 02099 \******************************************************************************/ 02100 02101 static void loop_thru_sn_ntries (FILE *out_file, 02102 int attr_idx, 02103 boolean output_attr) 02104 02105 { 02106 int count; 02107 int first_idx; 02108 int i; 02109 02110 02111 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit) { 02112 first_idx = ATP_FIRST_IDX(attr_idx); 02113 count = ATP_NUM_DARGS(attr_idx); 02114 02115 if (first_idx == NULL_IDX) { 02116 fprintf(out_file, "\n %s\n", 02117 " ** No Dummy Arguments - ATP_FIRST_IDX = 0."); 02118 return; 02119 } 02120 } 02121 else { 02122 first_idx = ATP_FIRST_IDX(attr_idx); 02123 count = ATP_NUM_DARGS(attr_idx); 02124 02125 if (first_idx == NULL_IDX) { 02126 fprintf(out_file, "\n %s\n", 02127 " ** No Dummy Arguments - ATP_FIRST_IDX = 0."); 02128 return; 02129 } 02130 } 02131 02132 fprintf(out_file, "\n %s %s:\n\n", 02133 "Dummy Arguments for", 02134 &name_pool[AT_NAME_IDX(attr_idx)].name_char); 02135 02136 for (i = first_idx; 02137 i < (first_idx + count); 02138 i++) { 02139 02140 dump_sn_ntry(out_file, i); 02141 02142 if (output_attr) { 02143 putc('\n', out_file); 02144 dump_at_ntry(out_file, SN_ATTR_IDX(i), FALSE); 02145 } 02146 else if (AT_OBJ_CLASS(SN_ATTR_IDX(i)) == Data_Obj && 02147 ATD_CLASS(SN_ATTR_IDX(i)) == Dummy_Argument) { 02148 02149 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8d\n", 02150 "ATD_ARRAY_IDX", ATD_ARRAY_IDX(SN_ATTR_IDX(i)), 02151 "ATD_POINTER", boolean_str[ATD_POINTER(SN_ATTR_IDX(i))], 02152 "ATD_TYPE_IDX", ATD_TYPE_IDX(SN_ATTR_IDX(i))); 02153 02154 # ifdef COARRAY_FORTRAN 02155 fprintf(out_file, " %-16s= %-7d \n", 02156 "ATD_PE_ARRAY_IDX", ATD_PE_ARRAY_IDX(SN_ATTR_IDX(i))); 02157 # endif 02158 02159 02160 putc('\n', out_file); 02161 } 02162 else if (AT_OBJ_CLASS(SN_ATTR_IDX(i)) == Pgm_Unit && 02163 ATP_PROC(SN_ATTR_IDX(i)) == Dummy_Proc) { 02164 fprintf(out_file, " %-25s\n", "Dummy_Proc"); 02165 putc('\n', out_file); 02166 } 02167 else { 02168 putc('\n', out_file); 02169 } 02170 } 02171 02172 fflush(out_file); 02173 02174 return; 02175 02176 } /* loop_thru_sn_ntries */ 02177 02178 /******************************************************************************\ 02179 |* *| 02180 |* Description: *| 02181 |* Chains through a set of Secondary Name table entries using *| 02182 |* SN_SIBLING_LINK and writes them to stderr or a dump file. *| 02183 |* *| 02184 |* Input parameters: *| 02185 |* - A pointer to the file to which the output is to be sent. *| 02186 |* - Index of Attribute entry that should have Secondary Name table *| 02187 |* entries associated with it. *| 02188 |* - A flag that indicates whether or not the Attribute entry for the *| 02189 |* Secondary Name table item should be output. *| 02190 |* *| 02191 |* Output parameters: *| 02192 |* NONE *| 02193 |* *| 02194 |* Returns: *| 02195 |* NOTHING *| 02196 |* *| 02197 \******************************************************************************/ 02198 02199 static void chain_thru_sn_ntries (FILE *out_file, 02200 int attr_idx, 02201 boolean output_attr) 02202 02203 { 02204 char conv_str[80]; 02205 int first_idx; 02206 int i; 02207 int idx; 02208 char str[80]; 02209 02210 02211 02212 if (AT_OBJ_CLASS(attr_idx) == Derived_Type) { 02213 first_idx = ATT_FIRST_CPNT_IDX(attr_idx); 02214 02215 if (first_idx == NULL_IDX) { 02216 fprintf(out_file, "\n %s\n", 02217 "** No Secondary Name table entries - ATT_FIRST_CPNT_IDX = 0"); 02218 return; 02219 } 02220 fprintf(out_file, "\n %s %s:\n\n", 02221 "Component entries for", 02222 &name_pool[AT_NAME_IDX(attr_idx)].name_char); 02223 } 02224 else if (AT_OBJ_CLASS(attr_idx) == Interface) { 02225 first_idx = ATI_FIRST_SPECIFIC_IDX(attr_idx); 02226 02227 if (first_idx == NULL_IDX) { 02228 fprintf(out_file, "\n %s\n", 02229 "** No Secondary Name table entries - ATI_FIRST_SPECIFIC_IDX = 0"); 02230 return; 02231 } 02232 fprintf(out_file, "\n %s %s:\n\n", 02233 "Interface bodies for", 02234 &name_pool[AT_NAME_IDX(attr_idx)].name_char); 02235 } 02236 else if (AT_OBJ_CLASS(attr_idx) == Namelist_Grp) { 02237 first_idx = ATN_FIRST_NAMELIST_IDX(attr_idx); 02238 02239 if (first_idx == NULL_IDX) { 02240 fprintf(out_file, "\n %s\n", 02241 " ** No Secondary Name table entries - ATN_FIRST_NAMELIST_IDX = 0"); 02242 return; 02243 } 02244 fprintf(out_file, "\n %s %s:\n\n", 02245 "Namelist objects for", 02246 &name_pool[AT_NAME_IDX(attr_idx)].name_char); 02247 } 02248 else { 02249 fprintf(out_file, "\n %s %s:\n\n", 02250 "Invalid attribute entry ", 02251 &name_pool[AT_NAME_IDX(attr_idx)].name_char); 02252 return; 02253 } 02254 02255 for (i = first_idx; i != NULL_IDX; i = SN_SIBLING_LINK(i)) { 02256 dump_sn_ntry(out_file, i); 02257 02258 if (output_attr) { 02259 putc('\n', out_file); 02260 dump_at_ntry(out_file, SN_ATTR_IDX(i), FALSE); 02261 02262 } 02263 else if (AT_OBJ_CLASS(attr_idx) == Interface && 02264 AT_OBJ_CLASS(SN_ATTR_IDX(i)) == Pgm_Unit) { 02265 02266 fprintf(out_file, " %-25s %-16s= %-7d %-16s= %-8d\n", 02267 atp_pgm_unit_str[ATP_PGM_UNIT(SN_ATTR_IDX(i))], 02268 "ATP_FIRST_IDX", ATP_FIRST_IDX(SN_ATTR_IDX(i)), 02269 "ATP_NUM_DARGS", ATP_NUM_DARGS(SN_ATTR_IDX(i))); 02270 02271 if (ATP_PGM_UNIT(SN_ATTR_IDX(i)) == Function) { 02272 idx = ATP_RSLT_IDX(SN_ATTR_IDX(i)); 02273 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8d\n", 02274 "ATD_ARRAY_IDX", ATD_ARRAY_IDX(idx), 02275 "ATD_POINTER", boolean_str[ATD_POINTER(idx)], 02276 "ATD_TYPE_IDX", ATD_TYPE_IDX(idx)); 02277 } 02278 02279 if (ATP_FIRST_IDX(SN_ATTR_IDX(i)) != NULL_IDX) { 02280 loop_thru_sn_ntries(out_file, SN_ATTR_IDX(i), FALSE); 02281 } 02282 02283 putc('\n', out_file); 02284 } 02285 else if (AT_OBJ_CLASS(SN_ATTR_IDX(i)) == Data_Obj && 02286 ATD_CLASS(SN_ATTR_IDX(i)) == Struct_Component) { 02287 02288 if (ATD_OFFSET_FLD(SN_ATTR_IDX(i)) == CN_Tbl_Idx || 02289 ATD_OFFSET_FLD(SN_ATTR_IDX(i)) == NO_Tbl_Idx) { 02290 sprintf(str, "(%10s)", convert_to_string( 02291 &CN_CONST(ATD_CPNT_OFFSET_IDX(SN_ATTR_IDX(i))), 02292 CN_TYPE_IDX(ATD_CPNT_OFFSET_IDX(SN_ATTR_IDX(i))), 02293 conv_str)); 02294 } 02295 else if (ATD_OFFSET_FLD(SN_ATTR_IDX(i)) == AT_Tbl_Idx) { 02296 sprintf(str, "(%10s)", 02297 AT_OBJ_NAME_PTR(ATD_CPNT_OFFSET_IDX(SN_ATTR_IDX(i)))); 02298 } 02299 else { 02300 sprintf(str,"%12s", " "); 02301 } 02302 02303 02304 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-7s\n", 02305 "ATD_ALIGNMENT", align_str[ATD_ALIGNMENT(SN_ATTR_IDX(i))], 02306 "ATD_ARRAY_IDX", ATD_ARRAY_IDX(SN_ATTR_IDX(i)), 02307 "AT_DCL_ERR", boolean_str[AT_DCL_ERR(SN_ATTR_IDX(i))]); 02308 02309 print_fld_idx(out_file, "ATD_CPNT_OFFSET_", 02310 ATD_OFFSET_FLD(SN_ATTR_IDX(i)), 02311 ATD_CPNT_OFFSET_IDX(SN_ATTR_IDX(i))); 02312 02313 fprintf(out_file, " %-16s= %-7s %-16s= %-7s \n", 02314 "ATD_IM_A_DOPE", boolean_str[ATD_IM_A_DOPE(SN_ATTR_IDX(i))], 02315 "ATD_POINTER", boolean_str[ATD_POINTER(SN_ATTR_IDX(i))]); 02316 02317 fprintf(out_file, " %-16s= %-7d %-s\n", 02318 "ATD_TYPE_IDX", ATD_TYPE_IDX(SN_ATTR_IDX(i)), 02319 print_type_f(ATD_TYPE_IDX(SN_ATTR_IDX(i)))); 02320 02321 if (ATD_CPNT_INIT_IDX(SN_ATTR_IDX(i)) != NULL_IDX) { 02322 print_fld_idx(out_file, "ATD_CPNT_INIT_ID", 02323 (fld_type) ATD_FLD(SN_ATTR_IDX(i)), 02324 ATD_CPNT_INIT_IDX(SN_ATTR_IDX(i))); 02325 02326 if (ATD_FLD(SN_ATTR_IDX(i)) == IR_Tbl_Idx) { 02327 dump_ir_ntry(out_file, ATD_CPNT_INIT_IDX(SN_ATTR_IDX(i)), 5); 02328 } 02329 else if (ATD_FLD(SN_ATTR_IDX(i)) == CN_Tbl_Idx) { 02330 dump_cn_ntry(out_file, ATD_CPNT_INIT_IDX(SN_ATTR_IDX(i))); 02331 } 02332 } 02333 02334 02335 putc('\n', out_file); 02336 } 02337 } 02338 02339 fflush(out_file); 02340 02341 return; 02342 02343 } /* chain_thru_sn_ntries */ 02344 02345 02346 /******************************************************************************\ 02347 |* *| 02348 |* Description: *| 02349 |* This function builds a fake token which may be used as an actual *| 02350 |* argument to a symbol table search function. This function is *| 02351 |* typically called by the routines that look up items in the symbol *| 02352 |* table by their names (rather than by an index into a table). *| 02353 |* *| 02354 |* Input parameters: *| 02355 |* A string containing the name of the item to be found. *| 02356 |* *| 02357 |* Output parameters: *| 02358 |* NONE *| 02359 |* *| 02360 |* Returns: *| 02361 |* NOTHING *| 02362 |* *| 02363 |* Note: This function builds the fake token in the file-global structure *| 02364 |* fake_token. *| 02365 |* *| 02366 \******************************************************************************/ 02367 02368 static void build_fake_token (char *name_string) 02369 02370 { 02371 int i; 02372 int len; 02373 02374 02375 /* Initialize the token string to all zeroes so the long word search */ 02376 /* used by the search routines will work correctly. */ 02377 02378 len = strlen(name_string); 02379 CREATE_ID(TOKEN_ID(fake_token), name_string, len); 02380 02381 TOKEN_LEN(fake_token) = len; 02382 02383 for (i = 0; i < len; i++) { 02384 TOKEN_STR(fake_token)[i] = toupper(TOKEN_STR(fake_token)[i]); 02385 } 02386 02387 return; 02388 02389 } /* build_fake_token */ 02390 02391 02392 /******************************************************************************\ 02393 |* *| 02394 |* Description: *| 02395 |* Used to trace entry and exit into a function. *| 02396 |* *| 02397 |* Input parameters: *| 02398 |* NONE *| 02399 |* *| 02400 |* Output parameters: *| 02401 |* NONE *| 02402 |* *| 02403 |* Returns: *| 02404 |* NOTHING *| 02405 |* *| 02406 \******************************************************************************/ 02407 02408 void dump_func_trace_info (trace_type trace, 02409 char *func_name, 02410 char *info) 02411 { 02412 02413 if (trace_file == NULL) { 02414 trace_file = fopen (trace_file_name, "w"); 02415 02416 if (trace_file == NULL) { 02417 PRINTMSG(1, 17, Error, 0, trace_file_name); 02418 exit_compiler(RC_USER_ERROR); 02419 } 02420 02421 fprintf (trace_file, "\nTRACE DUMP OF PROGRAM %s:\n\n", src_file); 02422 } 02423 02424 dump_trace_info(trace_file, trace, func_name, info); 02425 02426 return; 02427 02428 } /* dump_func_trace_info */ 02429 02430 02431 /******************************************************************************\ 02432 |* *| 02433 |* Description: *| 02434 |* Used to output a variety of information to the screen, the dump file, *| 02435 |* or the trace file. *| 02436 |* *| 02437 |* Input parameters: *| 02438 |* NONE *| 02439 |* *| 02440 |* Output parameters: *| 02441 |* NONE *| 02442 |* *| 02443 |* Returns: *| 02444 |* NOTHING *| 02445 |* *| 02446 \******************************************************************************/ 02447 02448 static void dump_trace_info (FILE *out_file, 02449 trace_type trace, 02450 char *func_name, 02451 char *info) 02452 { 02453 02454 int idx; 02455 char *indent_str; 02456 02457 02458 switch (trace) { 02459 02460 case Func_Entry: 02461 case Func_Exit: 02462 if (trace == Func_Exit) { 02463 trace_indent -= trace_indent_len; 02464 02465 if (trace_indent < 0) { 02466 trace_indent = 0; 02467 } 02468 } 02469 02470 indent_str = (char *) malloc (trace_indent+1); 02471 02472 for (idx = 0; idx < trace_indent; idx++) { 02473 indent_str[idx] = (idx % trace_indent_len == 0) ? '|' : BLANK; 02474 } 02475 02476 indent_str[idx] = NULL_CHAR; 02477 02478 if (trace == Func_Entry) { 02479 fprintf (out_file, "%sIN %s", indent_str, func_name); 02480 trace_indent += trace_indent_len; 02481 } 02482 else { 02483 fprintf (out_file, "%sOUT %s", indent_str, func_name); 02484 } 02485 if (info == NULL) { 02486 putc (NEWLINE, out_file); 02487 } 02488 else { 02489 fprintf (out_file, " (%s)\n", info); 02490 } 02491 02492 free (indent_str); 02493 indent_str = NULL; 02494 break; 02495 02496 case Syntax_Pass: 02497 fprintf(out_file, "\n> > > > > > > > > > B e g i n S y n t a x " 02498 " P a s s < < < < < < < < < <\n\n"); 02499 trace_indent = 0; 02500 break; 02501 02502 case Semantics_Pass: 02503 fprintf(out_file, "\n> > > > > > > > B e g i n S e m a n t i c s" 02504 " P a s s < < < < < < < <\n\n"); 02505 trace_indent = 0; 02506 break; 02507 02508 case PU_Start: 02509 if (info == NULL) { 02510 fprintf (out_file, "\n\n# NEW PROGRAM UNIT ########################" 02511 "####################################\n"); 02512 } 02513 else { 02514 fprintf (out_file, "\n\n# NEW PROGRAM UNIT # %s ##################" 02515 "#######\n", 02516 AT_OBJ_NAME_PTR(SCP_ATTR_IDX(curr_scp_idx))); 02517 02518 if (SCP_IN_ERR(curr_scp_idx)) { 02519 fprintf (out_file, 02520 "# # # SCP entry is marked in error # # #\n"); 02521 } 02522 } 02523 02524 break; 02525 02526 case Stmt_Start: 02527 if (info == NULL) { 02528 fprintf (out_file, "\n- NEW STMT ---------------------------" 02529 "-----------------------------------------\n"); 02530 } 02531 else { 02532 fprintf (out_file, "\n- %s%s - %d %s-------------------------" 02533 "-------------------------\n", 02534 (SH_COMPILER_GEN(curr_stmt_sh_idx)) ? "CG " : "", 02535 stmt_type_str[SH_STMT_TYPE(curr_stmt_sh_idx)], 02536 SH_GLB_LINE(curr_stmt_sh_idx), 02537 (SH_P2_SKIP_ME(curr_stmt_sh_idx)) ? "SKIP ME " : 02538 "--------"); 02539 02540 if (SH_ERR_FLG(curr_stmt_sh_idx)) { 02541 fprintf (out_file, 02542 "\n* * * Stmt Header is marked in error * * *\n"); 02543 } 02544 } 02545 02546 break; 02547 02548 } /* switch */ 02549 02550 return; 02551 02552 } /* dump_trace_info */ 02553 02554 02555 /******************************************************************************\ 02556 |* *| 02557 |* Description: *| 02558 |* Used to trace memory usage. *| 02559 |* *| 02560 |* Input parameters: *| 02561 |* NONE *| 02562 |* *| 02563 |* Output parameters: *| 02564 |* NONE *| 02565 |* *| 02566 |* Returns: *| 02567 |* NOTHING *| 02568 |* *| 02569 \******************************************************************************/ 02570 02571 void dump_mem_trace_info (trace_type trace, 02572 char *struct_name, 02573 void *new_struct_ptr, 02574 void *old_struct_ptr, 02575 long struct_bsize_or_num_used, 02576 int num_entries) 02577 { 02578 int idx; 02579 char *indent_str = NULL; 02580 02581 02582 if (trace_file == NULL) { 02583 trace_file = fopen (trace_file_name, "w"); 02584 02585 if (trace_file == NULL) { 02586 PRINTMSG(1, 17, Error, 0, trace_file_name); 02587 exit_compiler(RC_USER_ERROR); 02588 } 02589 02590 fprintf (trace_file, "\nTRACE DUMP OF PROGRAM %s:\n\n", src_file); 02591 } 02592 02593 if (trace_indent > 0) { 02594 indent_str = (char *) malloc (trace_indent+1); 02595 02596 for (idx = 0; idx < trace_indent; idx++) { 02597 indent_str[idx] = (idx % trace_indent_len == 0) ? '|' : BLANK; 02598 } 02599 02600 indent_str[idx] = NULL_CHAR; 02601 02602 fprintf (trace_file, "%s", indent_str); 02603 } 02604 02605 switch (trace) { 02606 case Mem_Alloc: 02607 fprintf (trace_file, "ALLOC %s (%#o) BSIZE=%ld(%d ENTRIES)\n", 02608 struct_name, (uint) new_struct_ptr, 02609 struct_bsize_or_num_used, num_entries); 02610 break; 02611 02612 case Mem_Realloc: 02613 if (new_struct_ptr == old_struct_ptr) { 02614 fprintf (trace_file, "REALLOC %s (%#o) BSIZE=%ld(%d ENTRIES)\n", 02615 struct_name, (uint) new_struct_ptr, 02616 struct_bsize_or_num_used, num_entries); 02617 } 02618 else { /* realloced with move */ 02619 fprintf (trace_file, "REALLOC/MOVE %s (%#o->%#o) " 02620 "BSIZE=%ld(%d ENTRIES)\n", 02621 struct_name, (uint) old_struct_ptr, (uint) new_struct_ptr, 02622 struct_bsize_or_num_used, num_entries); 02623 } 02624 break; 02625 02626 case Mem_Free: 02627 fprintf (trace_file, "FREE %s (%#o) (%d ENTRIES) " 02628 "(%ld USED ENTRIES)\n", 02629 struct_name, 02630 (uint) new_struct_ptr, 02631 num_entries, 02632 struct_bsize_or_num_used); 02633 break; 02634 02635 case Mem_Compress: 02636 fprintf (trace_file, "COMPRESS %s (%ld BEFORE ENTRIES) " 02637 "(%d AFTER ENTRIES)\n", 02638 struct_name, 02639 struct_bsize_or_num_used, 02640 num_entries); 02641 break; 02642 } /* switch */ 02643 02644 if (indent_str != NULL) { 02645 free (indent_str); 02646 indent_str = NULL; 02647 } 02648 02649 return; 02650 02651 } /* dump_mem_trace_info */ 02652 02653 /******************************************************************************\ 02654 |* *| 02655 |* Description: *| 02656 |* *| 02657 |* Input parameters: *| 02658 |* NONE *| 02659 |* *| 02660 |* Output parameters: *| 02661 |* NONE *| 02662 |* *| 02663 |* Returns: *| 02664 |* NOTHING *| 02665 |* *| 02666 \******************************************************************************/ 02667 02668 void print_mem_usage_report(char *name, 02669 int final_size, 02670 int largest_idx) 02671 02672 { 02673 02674 static boolean first_call = TRUE; 02675 02676 print_tbl_header("Memory Report"); 02677 02678 if (first_call == TRUE) { 02679 first_call = FALSE; 02680 02681 /* Dump initial size and increment for each table. */ 02682 02683 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02684 "attr_list_tbl", 02685 "init size", attr_list_tbl_init_size, 02686 "increment", attr_list_tbl_inc, 02687 "num words", attr_list_tbl_num_wds); 02688 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02689 "attr_tbl", 02690 "init size", attr_tbl_init_size, 02691 "increment", attr_tbl_inc, 02692 "num words", attr_tbl_num_wds); 02693 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02694 "blk_stk", 02695 "init size", blk_stk_init_size, 02696 "increment", blk_stk_inc, 02697 "num words", blk_stk_num_wds); 02698 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02699 "bounds_tbl", 02700 "init size", bounds_tbl_init_size, 02701 "increment", bounds_tbl_inc, 02702 "num words", bounds_tbl_num_wds); 02703 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02704 "const_tbl", 02705 "init size", const_tbl_init_size, 02706 "increment", const_tbl_inc, 02707 "num words", const_tbl_num_wds); 02708 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02709 "const_pool", 02710 "init size", const_pool_init_size, 02711 "increment", const_pool_inc, 02712 "num words", const_pool_num_wds); 02713 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02714 "equiv_tbl", 02715 "init size", equiv_tbl_init_size, 02716 "increment", equiv_tbl_inc, 02717 "num words", equiv_tbl_num_wds); 02718 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02719 "file_path_tbl", 02720 "init size", file_path_tbl_init_size, 02721 "increment", file_path_tbl_inc, 02722 "num words", file_path_tbl_num_wds); 02723 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02724 "global_line_tbl", 02725 "init size", global_line_tbl_init_size, 02726 "increment", global_line_tbl_inc, 02727 "num words", global_line_tbl_num_wds); 02728 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02729 "global_name_tbl", 02730 "init size", global_name_tbl_init_size, 02731 "increment", global_name_tbl_inc, 02732 "num words", global_name_tbl_num_wds); 02733 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02734 "hidden_name_tbl", 02735 "init size", hidden_name_tbl_init_size, 02736 "increment", hidden_name_tbl_inc, 02737 "num words", hidden_name_tbl_num_wds); 02738 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02739 "ir_tbl", 02740 "init size", ir_tbl_init_size, 02741 "increment", ir_tbl_inc, 02742 "num words", ir_tbl_num_wds); 02743 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02744 "ir_list_tbl", 02745 "init size", ir_list_tbl_init_size, 02746 "increment", ir_list_tbl_inc, 02747 "num words", ir_list_tbl_num_wds); 02748 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02749 "loc_name_tbl", 02750 "init size", loc_name_tbl_init_size, 02751 "increment", loc_name_tbl_inc, 02752 "num words", loc_name_tbl_num_wds); 02753 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02754 "mod_link_tbl", 02755 "init size", mod_link_tbl_init_size, 02756 "increment", mod_link_tbl_inc, 02757 "num words", mod_link_tbl_num_wds); 02758 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02759 "name_pool", 02760 "init size", name_pool_init_size, 02761 "increment", name_pool_inc, 02762 "num words", name_pool_num_wds); 02763 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02764 "rename_only_tbl", 02765 "init size", rename_only_tbl_init_size, 02766 "increment", rename_only_tbl_inc, 02767 "num words", rename_only_tbl_num_wds); 02768 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02769 "scp_tbl", 02770 "init size", scp_tbl_init_size, 02771 "increment", scp_tbl_inc, 02772 "num words", scp_tbl_num_wds); 02773 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02774 "sec_name_tbl", 02775 "init size", sec_name_tbl_init_size, 02776 "increment", sec_name_tbl_inc, 02777 "num words", sec_name_tbl_num_wds); 02778 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02779 "sh_tbl", 02780 "init size", sh_tbl_init_size, 02781 "increment", sh_tbl_inc, 02782 "num words", sh_tbl_num_wds); 02783 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02784 "stor_blk_tbl", 02785 "init size", stor_blk_tbl_init_size, 02786 "increment", stor_blk_tbl_inc, 02787 "num words", stor_blk_tbl_num_wds); 02788 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02789 "str_pool", 02790 "init size", str_pool_init_size, 02791 "increment", str_pool_inc, 02792 "num words", str_pool_num_wds); 02793 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 02794 "type_tbl", 02795 "init size", type_tbl_init_size, 02796 "increment", type_tbl_inc, 02797 "num words", type_tbl_num_wds); 02798 print_src_input_tbls(); 02799 } 02800 02801 02802 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d\n", 02803 name, 02804 "finalsize", final_size, 02805 "large idx", largest_idx); 02806 02807 fflush (debug_file); 02808 return; 02809 02810 } /* print_mem_usage_report */ 02811 02812 02813 /******************************************************************************\ 02814 |* *| 02815 |* Description: *| 02816 |* Print the defines that are set in this compiler. *| 02817 |* *| 02818 |* Input parameters: *| 02819 |* NONE *| 02820 |* *| 02821 |* Output parameters: *| 02822 |* NONE *| 02823 |* *| 02824 |* Returns: *| 02825 |* NOTHING *| 02826 |* *| 02827 \******************************************************************************/ 02828 02829 void print_defines(void) 02830 02831 { 02832 02833 print_tbl_header("Compiler Defines Dump"); 02834 02835 # ifdef _PVP_PVP 02836 fprintf(debug_file, "\t\t\t_PVP_PVP\n"); 02837 # endif 02838 02839 # ifdef _MPP_MPP 02840 fprintf(debug_file, "\t\t\t_MPP_MPP\n"); 02841 # endif 02842 02843 # ifdef _SOLARIS_SOLARIS 02844 fprintf(debug_file, "\t\t\t_SOLARIS_SOLARIS\n"); 02845 # endif 02846 02847 # ifdef _SOLARIS_MPP 02848 fprintf(debug_file, "\t\t\t_SOLARIS_MPP\n"); 02849 # endif 02850 02851 # ifdef _SOLARIS_PVP 02852 fprintf(debug_file, "\t\t\t_SOLARIS_PVP\n"); 02853 # endif 02854 02855 # ifdef _PVP_MPP 02856 fprintf(debug_file, "\t\t\t_PVP_MPP\n"); 02857 # endif 02858 02859 fprintf(debug_file, "\n"); 02860 02861 # ifdef _PDGCS 02862 fprintf(debug_file, "\t\t\t_PDGCS\n"); 02863 # endif 02864 02865 # ifdef _HOST32 02866 fprintf(debug_file, "\t\t\t_HOST32\n"); 02867 # endif 02868 02869 # ifdef _HOST64 02870 fprintf(debug_file, "\t\t\t_HOST64\n"); 02871 # endif 02872 02873 # ifdef _TARGET32 02874 fprintf(debug_file, "\t\t\t_TARGET32\n"); 02875 # endif 02876 02877 # ifdef _TARGET64 02878 fprintf(debug_file, "\t\t\t_TARGET64\n"); 02879 # endif 02880 02881 # if defined(_HOST_OS_IRIX) 02882 fprintf(debug_file, "\t\t\t_HOST_OS_IRIX\n"); 02883 # endif 02884 02885 # if defined(_HOST_OS_LINUX) 02886 fprintf(debug_file, "\t\t\t_HOST_OS_LINUX\n"); 02887 # endif 02888 02889 # ifdef _HOST_OS_MAX 02890 fprintf(debug_file, "\t\t\t_HOST_OS_MAX\n"); 02891 # endif 02892 02893 # ifdef _HOST_OS_SOLARIS 02894 fprintf(debug_file, "\t\t\t_HOST_OS_SOLARIS\n"); 02895 # endif 02896 02897 # ifdef _HOST_OS_UNICOS 02898 fprintf(debug_file, "\t\t\t_HOST_OS_UNICOS\n"); 02899 # endif 02900 02901 02902 # if defined(_TARGET_OS_IRIX) 02903 fprintf(debug_file, "\t\t\t_TARGET_OS_IRIX\n"); 02904 # endif 02905 02906 # if defined(_TARGET_OS_LINUX) 02907 fprintf(debug_file, "\t\t\t_TARGET_OS_LINUX\n"); 02908 # endif 02909 02910 # ifdef _TARGET_OS_MAX 02911 fprintf(debug_file, "\t\t\t_TARGET_OS_MAX\n"); 02912 # endif 02913 02914 # ifdef _TARGET_OS_SOLARIS 02915 fprintf(debug_file, "\t\t\t_TARGET_OS_SOLARIS\n"); 02916 # endif 02917 02918 # ifdef _TARGET_OS_UNICOS 02919 fprintf(debug_file, "\t\t\t_TARGET_OS_UNICOS\n"); 02920 # endif 02921 02922 # ifdef _TARGET_SV2 02923 fprintf(debug_file, "\t\t\t_TARGET_SV2\n"); 02924 # endif 02925 02926 # ifdef _TARGET_IEEE 02927 fprintf(debug_file, "\t\t\t_TARGET_IEEE\n"); 02928 # endif 02929 02930 # ifdef _TARGET_BYTE_ADDRESS 02931 fprintf(debug_file, "\t\t\t_TARGET_BYTE_ADDRESS\n"); 02932 # endif 02933 02934 # ifdef _TARGET_WORD_ADDRESS 02935 fprintf(debug_file, "\t\t\t_TARGET_WORD_ADDRESS\n"); 02936 # endif 02937 02938 # ifdef _HEAP_REQUEST_IN_BYTES 02939 fprintf(debug_file, "\t\t\t_HEAP_REQUEST_IN_BYTES\n"); 02940 # endif 02941 02942 # ifdef _HEAP_REQUEST_IN_WORDS 02943 fprintf(debug_file, "\t\t\t_HEAP_REQUEST_IN_WORDS\n"); 02944 # endif 02945 02946 # ifdef _MODULE_DOT_TO_o 02947 fprintf(debug_file, "\t\t\t_MODULE_DOT_TO_o\n"); 02948 # endif 02949 02950 # ifdef _MODULE_DOT_TO_M 02951 fprintf(debug_file, "\t\t\t_MODULE_DOT_TO_M\n"); 02952 # endif 02953 02954 # ifdef _MODULE_DOT_TO_mod 02955 fprintf(debug_file, "\t\t\t_MODULE_DOT_TO_mod\n"); 02956 # endif 02957 02958 # ifdef _ARITH_INPUT_CONV 02959 fprintf(debug_file, "\t\t\t_ARITH_INPUT_CONV\n"); 02960 # endif 02961 02962 # ifdef _ARITH_H 02963 fprintf(debug_file, "\t\t\t_ARITH_H\n"); 02964 # endif 02965 02966 # ifdef _ALLOCATE_IS_CALL 02967 fprintf(debug_file, "\t\t\t_ALLOCATE_IS_CALL\n"); 02968 # endif 02969 02970 # ifdef _SEPARATE_FUNCTION_RETURNS 02971 fprintf(debug_file, "\t\t\t_SEPARATE_FUNCTION_RETURNS\n"); 02972 # endif 02973 02974 # ifdef _TARGET_DOUBLE_ALIGN 02975 fprintf(debug_file, "\t\t\t_TARGET_DOUBLE_ALIGN\n"); 02976 # endif 02977 02978 # ifdef _ERROR_DUPLICATE_GLOBALS 02979 fprintf(debug_file, "\t\t\t_ERROR_DUPLICATE_GLOBALS\n"); 02980 # endif 02981 02982 02983 if (char_len_in_bytes) { 02984 fprintf(debug_file, "\t\t\t_CHAR_LEN_IN_BYTES\n"); 02985 } 02986 # ifdef _NO_BINARY_OUTPUT 02987 fprintf(debug_file, "\t\t\t_NO_BINARY_OUTPUT\n"); 02988 # endif 02989 02990 # ifdef _CHECK_MAX_MEMORY 02991 fprintf(debug_file, "\t\t\t_CHECK_MAX_MEMORY\n"); 02992 # endif 02993 02994 # ifdef _TASK_COMMON_EXTENSION 02995 fprintf(debug_file, "\t\t\t_TASK_COMMON_EXTENSION\n"); 02996 # endif 02997 02998 # ifdef _TWO_WORD_FCD 02999 fprintf(debug_file, "\t\t\t_TWO_WORD_FCD\n"); 03000 # endif 03001 03002 # ifdef _TRANSFORM_CHAR_SEQUENCE 03003 fprintf(debug_file, "\t\t\t_TRANSFORM_CHAR_SEQUENCE\n"); 03004 # endif 03005 03006 # ifdef _TMP_GIVES_COMMON_LENGTH 03007 fprintf(debug_file, "\t\t\t_TMP_GIVES_COMMON_LENGTH\n"); 03008 # endif 03009 03010 # ifdef _SPLIT_STATIC_STORAGE_2 03011 fprintf(debug_file, "\t\t\t_SPLIT_STATIC_STORAGE_2\n"); 03012 # endif 03013 03014 # ifdef _SPLIT_STATIC_STORAGE_3 03015 fprintf(debug_file, "\t\t\t_SPLIT_STATIC_STORAGE_3\n"); 03016 # endif 03017 03018 # ifdef _ALLOW_DATA_INIT_OF_COMMON 03019 fprintf(debug_file, "\t\t\t_ALLOW_DATA_INIT_OF_COMMON\n"); 03020 # endif 03021 03022 # ifdef _FRONTEND_CONDITIONAL_COMP 03023 fprintf(debug_file, "\t\t\t_FRONTEND_CONDITIONAL_COMP\n"); 03024 # endif 03025 03026 03027 fprintf(debug_file, "\n\n\t\t\tINTEGER_DEFAULT_TYPE\t%s\n", 03028 lin_type_str[INTEGER_DEFAULT_TYPE]); 03029 03030 fprintf(debug_file, "\t\t\tREAL_DEFAULT_TYPE\t%s\n", 03031 lin_type_str[REAL_DEFAULT_TYPE]); 03032 03033 fprintf(debug_file, "\t\t\tDOUBLE_DEFAULT_TYPE\t%s\n", 03034 lin_type_str[DOUBLE_DEFAULT_TYPE]); 03035 03036 fprintf(debug_file, "\t\t\tCOMPLEX_DEFAULT_TYPE\t%s\n", 03037 lin_type_str[COMPLEX_DEFAULT_TYPE]); 03038 03039 fprintf(debug_file, "\t\t\tLOGICAL_DEFAULT_TYPE\t%s\n", 03040 lin_type_str[LOGICAL_DEFAULT_TYPE]); 03041 03042 fprintf(debug_file, "\t\t\tTRUE_VALUE = %d\n", TRUE_VALUE); 03043 fprintf(debug_file, "\t\t\tFALSE_VALUE = %d\n", FALSE_VALUE); 03044 03045 if (target_triton) { 03046 fprintf(debug_file, "\n\t\t\ttarget_triton\n"); 03047 } 03048 03049 if (target_ieee) { 03050 fprintf(debug_file, "\n\t\t\ttarget_ieee\n"); 03051 } 03052 03053 if (char_len_in_bytes) { 03054 fprintf(debug_file, "\n\t\t\tchar_len_in_bytes\n"); 03055 } 03056 03057 putc ('\n', debug_file); 03058 fflush(debug_file); 03059 03060 return; 03061 03062 } /* print_defines */ 03063 03064 03065 /******************************************************************************\ 03066 |* *| 03067 |* Description: *| 03068 |* <description> *| 03069 |* *| 03070 |* Input parameters: *| 03071 |* NONE *| 03072 |* *| 03073 |* Output parameters: *| 03074 |* NONE *| 03075 |* *| 03076 |* Returns: *| 03077 |* NOTHING *| 03078 |* *| 03079 \******************************************************************************/ 03080 03081 static void dump_dv(FILE *out_file, 03082 int_dope_type *dv, 03083 boolean dump_it) 03084 03085 { 03086 long *lptr; 03087 int k; 03088 int i; 03089 int idx; 03090 int dec_len = 0; 03091 int dp_flag = 0; 03092 int dv_type; 03093 int int_len = 0; 03094 int kind_star = 0; 03095 int type_idx; 03096 int num_chars; 03097 char *char_ptr; 03098 03099 # if 0 03100 char str[80]; 03101 # endif 03102 03103 03104 if (dv == NULL) { 03105 fprintf(out_file, "\nDOPE VECTOR ADDRESS IS NULL\n\n"); 03106 return; 03107 } 03108 #if defined(_HOST32) && defined(_TARGET64) 03109 fprintf(out_file, "base_addr = 0x%x\n", dv->base_addr); 03110 fprintf(out_file, "el_len = %d\n", dv->el_len); 03111 #else 03112 fprintf(out_file, "base_addr = 0x%" LONG_TYPE_X_FMT "\n", dv->base_addr); 03113 fprintf(out_file, "el_len = %" LONG_TYPE_FMT "\n", dv->el_len); 03114 #endif 03115 fprintf(out_file, "assoc = %d\n", dv->assoc); 03116 fprintf(out_file, "ptr_alloc = %d\n", dv->ptr_alloc); 03117 fprintf(out_file, "p_or_a = %s\n", (dv->p_or_a == 2 ? "ALLOCATABLE" : 03118 (dv->p_or_a == 1 ? "POINTER" : "OTHER"))); 03119 fprintf(out_file, "a_contig = %s\n", 03120 (dv->a_contig == 1 ? "TRUE" : "FALSE")); 03121 fprintf(out_file, "unused_1 = %d\n", dv->unused_1); 03122 # if defined(_TARGET64) 03123 fprintf(out_file, "unused_2 = %d\n", dv->unused_2); 03124 # endif 03125 fprintf(out_file, "num_dims = %d\n", dv->num_dims); 03126 03127 # if 0 03128 dump_io_type_code_ntry(out_file, (long_type *)&(dv->type_code), 0); 03129 # endif 03130 03131 #if defined(_HOST32) && defined(_TARGET64) 03132 fprintf(out_file, "orig_base = 0x%x\n", dv->orig_base); 03133 fprintf(out_file, "orig_size = %d\n", dv->orig_size); 03134 03135 for(k = 0; k < (int)(dv->num_dims); k++) { 03136 fprintf(out_file, "low_bound[%d] = %d\n",k+1, 03137 dv->dim[k].low_bound); 03138 fprintf(out_file, "extent[%d] = %d\n", 03139 k+1, dv->dim[k].extent); 03140 fprintf(out_file, "stride_mult[%d] = %d\n\n",k+1, 03141 dv->dim[k].stride_mult); 03142 } 03143 #else 03144 fprintf(out_file, "orig_base = 0x%" LONG_TYPE_X_FMT "\n", dv->orig_base); 03145 fprintf(out_file, "orig_size = %" LONG_TYPE_FMT "\n", dv->orig_size); 03146 03147 for(k = 0; k < (int)(dv->num_dims); k++) { 03148 fprintf(out_file, "low_bound[%d] = %" LONG_TYPE_FMT "\n",k+1, 03149 dv->dim[k].low_bound); 03150 fprintf(out_file, "extent[%d] = %" LONG_TYPE_FMT "\n", 03151 k+1, dv->dim[k].extent); 03152 fprintf(out_file, "stride_mult[%d] = %" LONG_TYPE_FMT "\n\n",k+1, 03153 dv->dim[k].stride_mult); 03154 } 03155 #endif 03156 03157 03158 # if 0 03159 lptr = (long *)(dv->base_addr); 03160 03161 if (lptr != NULL && 03162 dv->num_dims == 1 && 03163 dump_it) { 03164 03165 /* this assumes that the array is contiguous */ 03166 03167 if (dv_type == DV_ASCII_CHAR) { 03168 03169 char_ptr = (char *)(dv->base_addr); 03170 03171 idx = 0; 03172 03173 for (k = 0; k < dv->dim[0].extent; k++) { 03174 fprintf(out_file,"\""); 03175 for (i = 0; i < num_chars; i++) { 03176 fprintf(out_file, "%c", char_ptr[idx]); 03177 idx++; 03178 } 03179 fprintf(out_file,"\" "); 03180 } 03181 fprintf(out_file, "\n"); 03182 } 03183 else { 03184 03185 for (k = 0; k < dv->dim[0].extent; k++) { 03186 #if 1 03187 fprintf(out_file, " %x ", 03188 lptr[num_host_wds[TYP_LINEAR(type_idx)] * k]); 03189 # else 03190 03191 fprintf(out_file, " %s ", 03192 convert_to_string(&(lptr[num_host_wds[TYP_LINEAR(type_idx)] * k]), 03193 type_idx, 03194 str)); 03195 # endif 03196 } 03197 fprintf(out_file, "\n"); 03198 } 03199 } 03200 # endif 03201 03202 return; 03203 03204 } /* dump_dv */ 03205 03206 /******************************************************************************\ 03207 |* *| 03208 |* Description: *| 03209 |* <description> *| 03210 |* *| 03211 |* Input parameters: *| 03212 |* NONE *| 03213 |* *| 03214 |* Output parameters: *| 03215 |* NONE *| 03216 |* *| 03217 |* Returns: *| 03218 |* NOTHING *| 03219 |* *| 03220 \******************************************************************************/ 03221 03222 void print_so (size_offset_type so) 03223 03224 { 03225 char str[80]; 03226 03227 switch(so.fld) { 03228 03229 case NO_Tbl_Idx: 03230 print_fld_idx(stderr, "Idx", (fld_type) so.fld, 0); 03231 fprintf(stderr, "Type = (%d) %s", so.type_idx, 03232 print_type_f(so.type_idx)); 03233 03234 switch (TYP_TYPE(so.type_idx)) { 03235 case Typeless: 03236 convert_to_string_fmt = Hex_Fmt; 03237 fprintf(stderr,"0x%s", 03238 convert_to_string((long_type *)&(so.constant), 03239 so.type_idx, str)); 03240 03241 if (TYP_BIT_LEN(so.type_idx) > TARGET_BITS_PER_WORD) { 03242 convert_to_string_fmt = Hex_Fmt; 03243 fprintf(stderr, " %s", 03244 convert_to_string((long_type *)&(so.constant[1]), 03245 so.type_idx, str)); 03246 } 03247 03248 break; 03249 03250 case Integer: 03251 fprintf(stderr,"%s", 03252 convert_to_string((long_type *)&(so.constant), 03253 so.type_idx, str)); 03254 break; 03255 03256 case Real: 03257 fprintf(stderr, "%s", 03258 convert_to_string((long_type *)&(so.constant), 03259 so.type_idx, str)); 03260 break; 03261 03262 case Character: 03263 break; 03264 03265 case Logical: 03266 fprintf(stderr, "%s", 03267 (THIS_IS_TRUE((long_type *)&(so.constant), so.type_idx) ? 03268 ".TRUE." : ".FALSE.")); 03269 break; 03270 03271 case Complex: 03272 fprintf(stderr, "%s", 03273 convert_to_string((long_type *)&(so.constant), 03274 so.type_idx, str)); 03275 break; 03276 } 03277 03278 fprintf(stderr,"\n"); 03279 break; 03280 03281 case CN_Tbl_Idx: 03282 print_fld_idx(stderr, "Idx", (fld_type) so.fld, so.idx); 03283 fprintf(stderr, "Constant = *Unset*\n"); 03284 03285 print_const_entry(stderr, so.idx, 0); 03286 break; 03287 03288 case AT_Tbl_Idx: 03289 print_fld_idx(stderr, "Idx", (fld_type) so.fld, so.idx); 03290 fprintf(stderr, "Constant = *Unset*\n"); 03291 print_attr_name(stderr, so.idx, 0); 03292 break; 03293 03294 case IR_Tbl_Idx: 03295 print_fld_idx(stderr, "Idx", (fld_type) so.fld, so.idx); 03296 fprintf(stderr, "Constant = *Unset*\n"); 03297 dump_ir_ntry(stderr, so.idx, 0); 03298 break; 03299 } 03300 03301 return; 03302 03303 } /* print_so */ 03304 03305 /******************************************************************************\ 03306 |* *| 03307 |* Description: *| 03308 |* Makes a field/index printable into a character string. *| 03309 |* *| 03310 |* Input parameters: *| 03311 |* fld -> Field describing index to print. *| 03312 |* idx -> Index to print. *| 03313 |* *| 03314 |* Output parameters: *| 03315 |* NONE *| 03316 |* *| 03317 |* Returns: *| 03318 |* Pointer to a character string of item to print. *| 03319 |* *| 03320 |* NOTE: This reuses the same output character area, so each successive *| 03321 |* call will clear out the previous returned value. *| 03322 |* *| 03323 \******************************************************************************/ 03324 03325 static void print_fld_idx(FILE *out_file, 03326 char *name, 03327 fld_type fld, 03328 int idx) 03329 03330 { 03331 static char str[80]; 03332 char conv_str[80]; 03333 03334 if (idx == NULL_IDX) { 03335 fprintf(out_file, " %-16s= %-7d %-9s\n", name, idx, field_str[fld]); 03336 } 03337 else { 03338 switch (fld) { 03339 03340 case CN_Tbl_Idx: 03341 sprintf(str,"( %-s )", 03342 convert_to_string(&CN_CONST(idx), CN_TYPE_IDX(idx), conv_str)); 03343 break; 03344 03345 case AT_Tbl_Idx: 03346 sprintf(str,"( %-s )", AT_OBJ_NAME_PTR(idx)); 03347 break; 03348 03349 case IR_Tbl_Idx: 03350 case IL_Tbl_Idx: 03351 case SH_Tbl_Idx: 03352 case SB_Tbl_Idx: 03353 sprintf(str,"%s", " "); 03354 break; 03355 03356 default: 03357 sprintf(str,"%s", " "); 03358 break; 03359 } 03360 03361 fprintf(out_file, " %-16s= %-7d %-9s%15s %-s\n", 03362 name, idx, 03363 field_str[fld], " ", 03364 str); 03365 } 03366 03367 return; 03368 03369 } /* print_fld_idx */ 03370 03371 /******************************************************************************\ 03372 |* *| 03373 |* Description: *| 03374 |* Should be inlined. Returns the name for an attr or ** NONE ** *| 03375 |* *| 03376 |* Input parameters: *| 03377 |* idx -> Attr index of name *| 03378 |* *| 03379 |* Output parameters: *| 03380 |* NONE *| 03381 |* *| 03382 |* Returns: *| 03383 |* Pointer to a character string of item to print. *| 03384 |* *| 03385 |* NOTE: This reuses the same output character area, so each successive *| 03386 |* call will clear out the previous returned value. *| 03387 |* *| 03388 \******************************************************************************/ 03389 03390 static char *print_at_name(int idx) 03391 03392 { 03393 static char str[1] = "0"; 03394 03395 03396 if (idx == NULL_IDX) { 03397 return(str); 03398 } 03399 else { 03400 return(AT_OBJ_NAME_PTR(idx)); 03401 } 03402 03403 } /* print_at_name */ 03404 03405 /******************************************************************************\ 03406 |* *| 03407 |* Description: *| 03408 |* Prints header for a table in the debug output. *| 03409 |* *| 03410 |* Input parameters: *| 03411 |* Table name to print *| 03412 |* *| 03413 \******************************************************************************/ 03414 03415 static void print_tbl_header (char *table_name) 03416 03417 { 03418 init_debug_file(); 03419 03420 fprintf(debug_file, "****************************************" 03421 "****************************************\n"); 03422 fprintf(debug_file, "\n\t\t\t%s\n\n", table_name); 03423 fprintf(debug_file, "****************************************" 03424 "****************************************\n"); 03425 return; 03426 03427 } /* print_tbl_header */ 03428 03429 /******************************************************************************\ 03430 |* *| 03431 |* Description: *| 03432 |* Print global type in a Fortran format. *| 03433 |* *| 03434 |* Input parameters: *| 03435 |* NONE *| 03436 |* *| 03437 |* Output parameters: *| 03438 |* NONE *| 03439 |* *| 03440 |* Returns: *| 03441 |* NOTHING *| 03442 |* *| 03443 \******************************************************************************/ 03444 03445 static char *print_global_type_f(int gt_idx) 03446 03447 { 03448 int kind; 03449 static char str[80]; 03450 char str1[80]; 03451 03452 03453 if (gt_idx == NULL_IDX) { 03454 sprintf(str, "NULL"); 03455 } 03456 else if (GT_TYPE(gt_idx) <= Last_Linear_Type) { 03457 03458 if (GT_DESC(gt_idx) == Star_Typed) { 03459 sprintf(str, "%s * %d", 03460 basic_type_str[GT_TYPE(gt_idx)], 03461 GT_DCL_VALUE(gt_idx)); 03462 } 03463 else if (GT_DESC(gt_idx) == Kind_Typed) { 03464 sprintf(str, "%s (kind=%d)", 03465 basic_type_str[GT_TYPE(gt_idx)], 03466 GT_DCL_VALUE(gt_idx)); 03467 } 03468 else { /* Default Typed */ 03469 03470 /* Print a kind type, so we know exactly what we've got. */ 03471 03472 switch (GT_LINEAR_TYPE(gt_idx)) { 03473 case Integer_1: 03474 case Logical_1: 03475 kind = 1; 03476 break; 03477 case Integer_2: 03478 case Logical_2: 03479 kind = 2; 03480 break; 03481 case Integer_4: 03482 case Logical_4: 03483 case Real_4: 03484 case Complex_4: 03485 kind = 4; 03486 break; 03487 case Integer_8: 03488 case Logical_8: 03489 case Real_8: 03490 case Complex_8: 03491 kind = 8; 03492 break; 03493 case Real_16: 03494 case Complex_16: 03495 kind = 16; 03496 break; 03497 default: 03498 kind = 0; 03499 break; 03500 } 03501 03502 if (kind == 0) { 03503 sprintf(str, "%s", basic_type_str[GT_TYPE(gt_idx)]); 03504 } 03505 else { 03506 sprintf(str, "%s (%d)", basic_type_str[GT_TYPE(gt_idx)], kind); 03507 } 03508 } 03509 } 03510 else if (GT_TYPE(gt_idx) == Typeless) { 03511 sprintf(str, "Typeless * %s", 03512 CONVERT_CVAL_TO_STR(&TYP_BIT_LEN(gt_idx), Integer_8, str1)); 03513 } 03514 else if (GT_TYPE(gt_idx) != Character) { 03515 sprintf(str, "type(%s)", GA_OBJ_NAME_PTR(GT_STRUCT_IDX(gt_idx))); 03516 } 03517 else if (GT_CHAR_CLASS(gt_idx) == Assumed_Size_Char) { 03518 sprintf(str, "CHARACTER*(*)"); 03519 } 03520 else if (GT_CHAR_CLASS(gt_idx) == Const_Len_Char) { 03521 sprintf(str, "CHARACTER*(Const_Len_Char)"); 03522 /* 07Dec00[sos] next line aborts (PV 802511) */ 03523 /* sprintf(str, "CHARACTER*(%s)", */ 03524 /* convert_to_string(GT_LENGTH(gt_idx), Integer_8, str1)"); */ 03525 } 03526 else { /* Variable or unknown length char - print (tmp_idx = idx) */ 03527 sprintf(str, "CHARACTER*(tmp)"); 03528 } 03529 03530 return(str); 03531 03532 } /* print_global_type_f */ 03533 03534 /******************************************************************************\ 03535 |* *| 03536 |* Utility routines specifically for the IR/IL dump. *| 03537 |* *| 03538 \******************************************************************************/ 03539 03540 /******************************************************************************\ 03541 |* *| 03542 |* Description: *| 03543 |* Print all the statements and all their IR. *| 03544 |* *| 03545 |* Input parameters: *| 03546 |* NONE *| 03547 |* *| 03548 |* Output parameters: *| 03549 |* NONE *| 03550 |* *| 03551 |* Returns: *| 03552 |* NOTHING *| 03553 |* *| 03554 \******************************************************************************/ 03555 03556 static void print_all_text (boolean print_all_scps) 03557 03558 { 03559 int save_curr_scp_idx; 03560 03561 03562 PROCESS_SIBLING: 03563 03564 init_debug_file(); 03565 03566 dump_trace_info (debug_file, PU_Start, NULL, "IR_dump"); 03567 03568 if (!SCP_IN_ERR(curr_scp_idx) ) { 03569 03570 curr_stmt_sh_idx = SCP_FIRST_SH_IDX(curr_scp_idx); 03571 03572 while (curr_stmt_sh_idx != NULL_IDX) { 03573 03574 dump_stmt_ntry(debug_file, TRUE); 03575 03576 if (SH_NEXT_IDX(curr_stmt_sh_idx) == curr_stmt_sh_idx) { 03577 03578 /* Turn off ir table dump, so this doesn't loop forever */ 03579 03580 dump_flags.ir1_tbl = FALSE; 03581 dump_flags.ir2_tbl = FALSE; 03582 dump_flags.ir3_tbl = FALSE; 03583 dump_flags.ir4_tbl = FALSE; 03584 dump_flags.sytb = FALSE; 03585 03586 PRINTMSG(SH_GLB_LINE(curr_stmt_sh_idx), 871, Internal, 03587 SH_COL_NUM(curr_stmt_sh_idx), "SH_NEXT_IDX", 03588 curr_stmt_sh_idx); 03589 } 03590 else if (SH_PREV_IDX(curr_stmt_sh_idx) == curr_stmt_sh_idx) { 03591 03592 /* Turn off ir table dump, so this doesn't loop forever */ 03593 03594 dump_flags.ir1_tbl = FALSE; 03595 dump_flags.ir2_tbl = FALSE; 03596 dump_flags.ir3_tbl = FALSE; 03597 dump_flags.ir4_tbl = FALSE; 03598 dump_flags.sytb = FALSE; 03599 03600 PRINTMSG(SH_GLB_LINE(curr_stmt_sh_idx), 871, Internal, 03601 SH_COL_NUM(curr_stmt_sh_idx), "SH_PREV_IDX", 03602 curr_stmt_sh_idx); 03603 } 03604 03605 curr_stmt_sh_idx = SH_NEXT_IDX(curr_stmt_sh_idx); 03606 } 03607 } 03608 03609 if (!print_all_scps) { 03610 return; 03611 } 03612 03613 if (SCP_FIRST_CHILD_IDX(curr_scp_idx) != NULL_IDX) { 03614 save_curr_scp_idx = curr_scp_idx; 03615 curr_scp_idx = SCP_FIRST_CHILD_IDX(curr_scp_idx); 03616 print_all_text(TRUE); 03617 curr_scp_idx = save_curr_scp_idx; 03618 } 03619 03620 if (SCP_SIBLING_IDX(curr_scp_idx) != NULL_IDX) { 03621 curr_scp_idx = SCP_SIBLING_IDX(curr_scp_idx); 03622 goto PROCESS_SIBLING; 03623 } 03624 03625 return; 03626 03627 } /* print_all_text */ 03628 03629 /******************************************************************************\ 03630 |* *| 03631 |* Description: *| 03632 |* prints list texts and what they point to that are from a *| 03633 |* Dv_Whole_Def_Opr. *| 03634 |* called by dump_ir_ntry *| 03635 |* *| 03636 |* Input parameters: *| 03637 |* NONE *| 03638 |* *| 03639 |* Output parameters: *| 03640 |* NONE *| 03641 |* *| 03642 |* Returns: *| 03643 |* NOTHING *| 03644 |* *| 03645 \******************************************************************************/ 03646 03647 static void print_Dv_Whole_Def_Opr(FILE *out_file, 03648 int idx, 03649 int indent, 03650 int cnt) 03651 03652 { 03653 int dim; 03654 char shift[80]; 03655 char n_shift[INDENT_SIZE + 1]; 03656 char str[16]; 03657 int i; 03658 03659 for (i = 0; i < INDENT_SIZE * indent; i++) { 03660 shift[i] = ' '; 03661 if (i == 79) 03662 break; 03663 } 03664 shift[i] = '\0'; 03665 for (i = 0; i < INDENT_SIZE; i++) { 03666 n_shift[i] = ' '; 03667 } 03668 n_shift[i] = '\0'; 03669 03670 dim = 0; 03671 03672 for (i = 0; i < cnt; i++) { 03673 03674 if (idx == NULL_IDX) { 03675 break; 03676 } 03677 03678 if (i < 10) { 03679 strcpy(str, dv_whole_def_str[i]); 03680 } 03681 else { 03682 if ((i - 10)%3 == 0) { 03683 dim++; 03684 } 03685 sprintf(str, dv_whole_def_str[i], dim); 03686 } 03687 03688 fprintf(out_file,"%s%-15s, idx = %d, %s",shift, str, idx, 03689 field_str[IL_FLD(idx)]); 03690 03691 if (i == DEBUG_STR_TYPE_CODE) { 03692 convert_to_string_fmt = Hex_Fmt; 03693 } 03694 03695 switch (IL_FLD(idx)) { 03696 case CN_Tbl_Idx : 03697 case AT_Tbl_Idx : 03698 fprintf(out_file," line = %d col = %d\n",IL_LINE_NUM(idx), 03699 IL_COL_NUM(idx)); 03700 break; 03701 case IL_Tbl_Idx : 03702 fprintf(out_file," list cnt = %d\n", IL_LIST_CNT(idx)); 03703 break; 03704 default : 03705 fprintf(out_file,"\n"); 03706 break; 03707 } 03708 03709 03710 switch (IL_FLD(idx)) { 03711 case NO_Tbl_Idx : 03712 break; 03713 case CN_Tbl_Idx : 03714 print_const_entry(out_file, IL_IDX(idx), indent + 1); 03715 break; 03716 case AT_Tbl_Idx : 03717 print_attr_name(out_file, IL_IDX(idx), indent + 1); 03718 break; 03719 case IR_Tbl_Idx : 03720 dump_ir_ntry(out_file, IL_IDX(idx), indent + 1); 03721 break; 03722 case IL_Tbl_Idx : 03723 print_list(out_file, IL_IDX(idx), 03724 indent + 1, IL_LIST_CNT(idx), FALSE); 03725 break; 03726 case SH_Tbl_Idx : 03727 fprintf(out_file, "%s%sstmt header idx = %d\n",shift,n_shift, 03728 IL_IDX(idx)); 03729 break; 03730 } 03731 idx = IL_NEXT_LIST_IDX(idx); 03732 } 03733 03734 return; 03735 03736 } /* print_Dv_Whole_Def_Opr */ 03737 03738 /******************************************************************************\ 03739 |* *| 03740 |* Description: *| 03741 |* prints list texts and what they point to that are from a *| 03742 |* mp directive opr. *| 03743 |* called by dump_ir_ntry *| 03744 |* *| 03745 |* Input parameters: *| 03746 |* NONE *| 03747 |* *| 03748 |* Output parameters: *| 03749 |* NONE *| 03750 |* *| 03751 |* Returns: *| 03752 |* NOTHING *| 03753 |* *| 03754 \******************************************************************************/ 03755 03756 static void print_mp_dir_opr(FILE *out_file, 03757 int idx, 03758 int indent, 03759 int cnt) 03760 03761 { 03762 char shift[80]; 03763 char n_shift[INDENT_SIZE + 1]; 03764 char str[80]; 03765 int i; 03766 03767 03768 for (i = 0; i < INDENT_SIZE * indent; i++) { 03769 shift[i] = ' '; 03770 if (i == 79) 03771 break; 03772 } 03773 shift[i] = '\0'; 03774 for (i = 0; i < INDENT_SIZE; i++) { 03775 n_shift[i] = ' '; 03776 } 03777 n_shift[i] = '\0'; 03778 03779 03780 for (i = 0; i < cnt; i++) { 03781 03782 if (idx == NULL_IDX) { 03783 break; 03784 } 03785 03786 strcpy(str, mp_dir_opr_str[i]); 03787 03788 fprintf(out_file,"%s%-15s, idx = %d, %s",shift, str, idx, 03789 field_str[IL_FLD(idx)]); 03790 03791 switch (IL_FLD(idx)) { 03792 case CN_Tbl_Idx : 03793 case AT_Tbl_Idx : 03794 fprintf(out_file," line = %d col = %d\n",IL_LINE_NUM(idx), 03795 IL_COL_NUM(idx)); 03796 break; 03797 case IL_Tbl_Idx : 03798 fprintf(out_file," list cnt = %d\n", IL_LIST_CNT(idx)); 03799 break; 03800 default : 03801 fprintf(out_file,"\n"); 03802 break; 03803 } 03804 03805 03806 switch (IL_FLD(idx)) { 03807 case NO_Tbl_Idx : 03808 break; 03809 case CN_Tbl_Idx : 03810 print_const_entry(out_file, IL_IDX(idx), indent + 1); 03811 break; 03812 case AT_Tbl_Idx : 03813 print_attr_name(out_file, IL_IDX(idx), indent + 1); 03814 break; 03815 case IR_Tbl_Idx : 03816 dump_ir_ntry(out_file, IL_IDX(idx), indent + 1); 03817 break; 03818 case IL_Tbl_Idx : 03819 print_list(out_file, IL_IDX(idx), 03820 indent + 1, IL_LIST_CNT(idx), FALSE); 03821 break; 03822 case SH_Tbl_Idx : 03823 fprintf(out_file, "%s%sstmt header idx = %d\n",shift,n_shift, 03824 IL_IDX(idx)); 03825 break; 03826 } 03827 idx = IL_NEXT_LIST_IDX(idx); 03828 } 03829 03830 return; 03831 03832 } /* print_mp_dir_opr */ 03833 03834 /******************************************************************************\ 03835 |* *| 03836 |* Description: *| 03837 |* prints list texts and what they point to that are from a *| 03838 |* open mp directive opr. *| 03839 |* called by dump_ir_ntry *| 03840 |* *| 03841 |* Input parameters: *| 03842 |* NONE *| 03843 |* *| 03844 |* Output parameters: *| 03845 |* NONE *| 03846 |* *| 03847 |* Returns: *| 03848 |* NOTHING *| 03849 |* *| 03850 \******************************************************************************/ 03851 03852 static void print_open_mp_dir_opr(FILE *out_file, 03853 int idx, 03854 int indent, 03855 int cnt) 03856 03857 { 03858 char shift[80]; 03859 char n_shift[INDENT_SIZE + 1]; 03860 char str[80]; 03861 int i; 03862 03863 03864 for (i = 0; i < INDENT_SIZE * indent; i++) { 03865 shift[i] = ' '; 03866 if (i == 79) 03867 break; 03868 } 03869 shift[i] = '\0'; 03870 for (i = 0; i < INDENT_SIZE; i++) { 03871 n_shift[i] = ' '; 03872 } 03873 n_shift[i] = '\0'; 03874 03875 for (i = 0; i < cnt; i++) { 03876 03877 if (idx == NULL_IDX) { 03878 break; 03879 } 03880 03881 strcpy(str, open_mp_dir_opr_str[i]); 03882 03883 fprintf(out_file,"%s%-15s, idx = %d, %s",shift, str, idx, 03884 field_str[IL_FLD(idx)]); 03885 03886 switch (IL_FLD(idx)) { 03887 case CN_Tbl_Idx : 03888 case AT_Tbl_Idx : 03889 fprintf(out_file," line = %d col = %d\n",IL_LINE_NUM(idx), 03890 IL_COL_NUM(idx)); 03891 break; 03892 case IL_Tbl_Idx : 03893 fprintf(out_file," list cnt = %d\n", IL_LIST_CNT(idx)); 03894 break; 03895 default : 03896 fprintf(out_file,"\n"); 03897 break; 03898 } 03899 03900 03901 switch (IL_FLD(idx)) { 03902 case NO_Tbl_Idx : 03903 break; 03904 case CN_Tbl_Idx : 03905 print_const_entry(out_file, IL_IDX(idx), indent + 1); 03906 break; 03907 case AT_Tbl_Idx : 03908 print_attr_name(out_file, IL_IDX(idx), indent + 1); 03909 break; 03910 case IR_Tbl_Idx : 03911 dump_ir_ntry(out_file, IL_IDX(idx), indent + 1); 03912 break; 03913 case IL_Tbl_Idx : 03914 print_list(out_file, IL_IDX(idx), 03915 indent + 1, IL_LIST_CNT(idx), FALSE); 03916 break; 03917 case SH_Tbl_Idx : 03918 fprintf(out_file, "%s%sstmt header idx = %d\n",shift,n_shift, 03919 IL_IDX(idx)); 03920 break; 03921 } 03922 idx = IL_NEXT_LIST_IDX(idx); 03923 } 03924 03925 return; 03926 03927 } /* print_open_mp_dir_opr */ 03928 03929 /******************************************************************************\ 03930 |* *| 03931 |* Description: *| 03932 |* prints attr name and index. *| 03933 |* Used by dump_ir_ntry *| 03934 |* *| 03935 |* Input parameters: *| 03936 |* NONE *| 03937 |* *| 03938 |* Output parameters: *| 03939 |* NONE *| 03940 |* *| 03941 |* Returns: *| 03942 |* NOTHING *| 03943 |* *| 03944 \******************************************************************************/ 03945 03946 static void print_attr_name(FILE *out_file, 03947 int idx, 03948 int indent) 03949 03950 { 03951 int i; 03952 char shift[80]; 03953 char str[80]; 03954 int type_idx; 03955 03956 03957 for (i = 0; i < INDENT_SIZE * indent; i++) { 03958 shift[i] = ' '; 03959 if (i == 79) 03960 break; 03961 } 03962 03963 shift[i] = '\0'; 03964 03965 fprintf(out_file,"%s%s idx = %d",shift, AT_OBJ_NAME_PTR(idx), idx); 03966 03967 if (AT_OBJ_CLASS(idx) == Data_Obj) { 03968 type_idx = ATD_TYPE_IDX(idx); 03969 03970 if (type_idx == NULL_IDX && AT_ATTR_LINK(idx) == NULL_IDX) { 03971 03972 /* Turn off ir table dump, so this doesn't loop forever */ 03973 03974 dump_flags.ir1_tbl = FALSE; 03975 dump_flags.ir2_tbl = FALSE; 03976 dump_flags.ir3_tbl = FALSE; 03977 dump_flags.ir4_tbl = FALSE; 03978 dump_flags.sytb = FALSE; 03979 03980 PRINTMSG(AT_DEF_LINE(idx), 891, Internal, AT_DEF_COLUMN(idx), 03981 idx, AT_OBJ_NAME_PTR(idx)); 03982 } 03983 03984 fprintf(out_file," %s * ", basic_type_str[TYP_TYPE(type_idx)]); 03985 03986 if (TYP_TYPE(type_idx) <= Last_Linear_Type) { 03987 fprintf(out_file, "%s ", lin_type_str[TYP_LINEAR(type_idx)]); 03988 } 03989 else if (TYP_TYPE(type_idx) == Typeless) { 03990 fprintf(out_file, "%s ", CONVERT_CVAL_TO_STR(&TYP_BIT_LEN(type_idx), 03991 Integer_8, 03992 str)); 03993 } 03994 else if (TYP_TYPE(type_idx) != Character) { 03995 fprintf(out_file, "%d ", TYP_IDX(type_idx)); 03996 } 03997 else if (TYP_CHAR_CLASS(type_idx) == Assumed_Size_Char) { 03998 fprintf(out_file, "(*) "); 03999 } 04000 else if (TYP_CHAR_CLASS(type_idx) == Const_Len_Char) { 04001 fprintf(out_file, "%s ", 04002 convert_to_string(&CN_CONST(TYP_IDX(type_idx)), 04003 CN_TYPE_IDX(TYP_IDX(type_idx)), 04004 str)); 04005 } 04006 else { /* Variable or unknown length char - print (tmp_idx = idx) */ 04007 fprintf(out_file, "(tmp_idx = %d) ", TYP_IDX(type_idx)); 04008 } 04009 } 04010 04011 if (AT_ATTR_LINK(idx)) { 04012 fprintf(out_file," AT_ATTR_LINK = %d\n",AT_ATTR_LINK(idx)); 04013 } 04014 else { 04015 fprintf(out_file,"\n"); 04016 } 04017 04018 return; 04019 } /* print_attr_name */ 04020 04021 04022 /******************************************************************************\ 04023 |* *| 04024 |* Description: *| 04025 |* prints list texts and what they point to. *| 04026 |* *| 04027 |* Input parameters: *| 04028 |* NONE *| 04029 |* *| 04030 |* Output parameters: *| 04031 |* NONE *| 04032 |* *| 04033 |* Returns: *| 04034 |* NOTHING *| 04035 |* *| 04036 \******************************************************************************/ 04037 04038 static void print_list(FILE *out_file, 04039 int idx, 04040 int indent, 04041 int cnt, 04042 boolean io_list) 04043 04044 { 04045 char shift[80]; 04046 char n_shift[INDENT_SIZE + 1]; 04047 int i; 04048 04049 for (i = 0; i < INDENT_SIZE * indent; i++) { 04050 shift[i] = ' '; 04051 if (i == 79) 04052 break; 04053 } 04054 shift[i] = '\0'; 04055 for (i = 0; i < INDENT_SIZE; i++) { 04056 n_shift[i] = ' '; 04057 } 04058 n_shift[i] = '\0'; 04059 04060 for (i = 0; i < cnt; i++) { 04061 04062 if (idx == NULL_IDX) { 04063 break; 04064 } 04065 04066 fprintf(out_file,"%slist item #%d, idx = %d, %s",shift, i + 1, idx, 04067 field_str[IL_FLD(idx)]); 04068 04069 if (IL_ARG_DESC_VARIANT(idx)) { 04070 fprintf(out_file, " IL_ARG_DESC_VARIANT "); 04071 } 04072 04073 switch (IL_ARG_MULTI_FLAGS(idx)) { 04074 case 1: 04075 fprintf(out_file, " PASS_ADDRESS "); 04076 break; 04077 04078 case 2: 04079 fprintf(out_file, " PASS_ADDRESS_FROM_DV "); 04080 break; 04081 04082 case 3: 04083 fprintf(out_file, " PASS_DV "); 04084 break; 04085 04086 case 4: 04087 fprintf(out_file, " PASS_DV_COPY "); 04088 break; 04089 04090 case 5: 04091 fprintf(out_file, " COPY_IN "); 04092 break; 04093 04094 case 6: 04095 fprintf(out_file, " COPY_IN_COPY_OUT "); 04096 break; 04097 04098 case 7: 04099 fprintf(out_file, " MAKE_DV "); 04100 break; 04101 04102 case 8: 04103 fprintf(out_file, " COPY_IN_MAKE_DV "); 04104 break; 04105 04106 case 9: 04107 fprintf(out_file, " MAKE_NEW_DV"); 04108 break; 04109 04110 case 10: 04111 fprintf(out_file, " PASS_SECTION_ADDRESS "); 04112 break; 04113 04114 case 11: 04115 fprintf(out_file, " CHECK_CONTIG_FLAG "); 04116 break; 04117 04118 default: 04119 04120 break; 04121 } 04122 04123 04124 if (io_list) { 04125 if (IL_HAS_FUNCTIONS(idx)) { 04126 fprintf(out_file, " IL_HAS_FUNCTIONS "); 04127 } 04128 04129 if (IL_MUST_FLATTEN(idx)) { 04130 fprintf(out_file, " IL_MUST_FLATTEN "); 04131 } 04132 04133 if (IL_MUST_BE_LOOP(idx)) { 04134 fprintf(out_file, " IL_MUST_BE_LOOP "); 04135 } 04136 } 04137 else { 04138 if (IL_VECTOR_SUBSCRIPT(idx)) { 04139 fprintf(out_file, " IL_VECTOR_SUBSCRIPT "); 04140 } 04141 04142 if (IL_CONSTANT_SUBSCRIPT(idx)) { 04143 fprintf(out_file, " IL_CONSTANT_SUBSCRIPT "); 04144 } 04145 04146 if (IL_PE_SUBSCRIPT(idx)) { 04147 fprintf(out_file, " IL_PE_SUBSCRIPT "); 04148 } 04149 } 04150 04151 if (IL_DISTRIBUTION_VARIANT(idx)) { 04152 fprintf(out_file, " %s ", distribution_str[IL_DISTRIBUTION(idx)]); 04153 } 04154 04155 switch (IL_FLD(idx)) { 04156 case CN_Tbl_Idx : 04157 case AT_Tbl_Idx : 04158 case SB_Tbl_Idx : 04159 fprintf(out_file," line = %d col = %d\n",IL_LINE_NUM(idx), 04160 IL_COL_NUM(idx)); 04161 break; 04162 case IL_Tbl_Idx : 04163 fprintf(out_file," list cnt = %d\n", IL_LIST_CNT(idx)); 04164 break; 04165 default : 04166 fprintf(out_file,"\n"); 04167 break; 04168 } 04169 04170 04171 switch (IL_FLD(idx)) { 04172 case NO_Tbl_Idx : 04173 break; 04174 case CN_Tbl_Idx : 04175 print_const_entry(out_file, IL_IDX(idx), indent + 1); 04176 break; 04177 case AT_Tbl_Idx : 04178 print_attr_name(out_file, IL_IDX(idx), indent + 1); 04179 break; 04180 case SB_Tbl_Idx : 04181 fprintf(out_file,"%s%s%s\n", shift, n_shift, 04182 SB_NAME_PTR(IL_IDX(idx))); 04183 break; 04184 case IR_Tbl_Idx : 04185 dump_ir_ntry(out_file, IL_IDX(idx), indent + 1); 04186 break; 04187 case IL_Tbl_Idx : 04188 print_list(out_file, IL_IDX(idx), 04189 indent + 1, IL_LIST_CNT(idx), io_list); 04190 break; 04191 case SH_Tbl_Idx : 04192 fprintf(out_file, "%s%sstmt header idx = %d\n",shift,n_shift, 04193 IL_IDX(idx)); 04194 break; 04195 } 04196 idx = IL_NEXT_LIST_IDX(idx); 04197 } 04198 04199 if (idx != NULL_IDX) { 04200 04201 /* Turn off symbol table dump, so this doesn't loop forever */ 04202 04203 dump_flags.sytb = FALSE; 04204 dump_flags.ir1_tbl = FALSE; 04205 dump_flags.ir2_tbl = FALSE; 04206 dump_flags.ir3_tbl = FALSE; 04207 dump_flags.ir4_tbl = FALSE; 04208 04209 PRINTMSG(1, 670, Internal, 0); 04210 } 04211 04212 return; 04213 04214 } /* print_list */ 04215 04216 /******************************************************************************\ 04217 |* *| 04218 |* Description: *| 04219 |* prints constant table entry. *| 04220 |* *| 04221 |* Input parameters: *| 04222 |* NONE *| 04223 |* *| 04224 |* Output parameters: *| 04225 |* NONE *| 04226 |* *| 04227 |* Returns: *| 04228 |* NOTHING *| 04229 |* *| 04230 \******************************************************************************/ 04231 04232 static void print_const_entry(FILE *out_file, 04233 int idx, 04234 int indent) 04235 04236 { 04237 long i; 04238 char shift[80]; 04239 int type_idx; 04240 char str[80]; 04241 04242 04243 if (idx == 0 || idx > const_tbl_idx) { 04244 fprintf(out_file, "\n*FE90-ERROR* CN index value [%d] is out of range.\n", 04245 idx); 04246 return; 04247 } 04248 04249 type_idx = CN_TYPE_IDX(idx); 04250 04251 for (i = 0; i < INDENT_SIZE * indent; i++) { 04252 shift[i] = ' '; 04253 if (i == 79) 04254 break; 04255 } 04256 04257 shift[i] = '\0'; 04258 fprintf(out_file,"%s", shift); 04259 print_const_f(out_file, idx); 04260 fprintf(out_file, " IDX = %d", idx); 04261 04262 if (TYP_TYPE(type_idx) == Character) { 04263 fprintf(out_file, " LEN = %s", 04264 convert_to_string(&CN_CONST(TYP_IDX(type_idx)), 04265 CG_INTEGER_DEFAULT_TYPE, 04266 str)); 04267 04268 } 04269 04270 if (TYP_TYPE(type_idx) == Typeless) { 04271 fprintf(out_file, " %s BIT LEN = %s\n", 04272 basic_type_str[TYP_TYPE(type_idx)], 04273 CONVERT_CVAL_TO_STR(&TYP_BIT_LEN(type_idx), 04274 Integer_8, 04275 str)); 04276 } 04277 else if (TYP_TYPE(type_idx) <= Last_Linear_Type) { 04278 fprintf(out_file, " %s * %s\n", 04279 basic_type_str[TYP_TYPE(type_idx)], 04280 lin_type_str[TYP_LINEAR(type_idx)]); 04281 } 04282 else { 04283 /* 27Nov00[sos} Was: */ 04284 /* fprintf(out_file, " %s*(%d)\n", basic_type_str[TYP_TYPE(type_idx)], */ 04285 /* TYP_IDX(type_idx)); */ 04286 fprintf(out_file, " %s\n", print_type_f(type_idx)); 04287 } 04288 04289 return; 04290 04291 } /* print_const_entry */ 04292 04293 /******************************************************************************\ 04294 |* *| 04295 |* This section contains routines to print an expanded IR/IL format. *| 04296 |* This format is FORTRAN like. *| 04297 |* *| 04298 \******************************************************************************/ 04299 04300 /******************************************************************************\ 04301 |* *| 04302 |* Description: *| 04303 |* NEED DESCRIPTION *| 04304 |* *| 04305 |* Input parameters: *| 04306 |* NONE *| 04307 |* *| 04308 |* Output parameters: *| 04309 |* NONE *| 04310 |* *| 04311 |* Returns: *| 04312 |* NOTHING *| 04313 |* *| 04314 \******************************************************************************/ 04315 04316 void print_expanded_stmt(void) 04317 { 04318 int save_curr_scp_idx; 04319 int save_curr_stmt_sh_idx; 04320 04321 save_curr_scp_idx = curr_scp_idx; 04322 curr_scp_idx = 1; 04323 save_curr_stmt_sh_idx = curr_stmt_sh_idx; 04324 04325 print_expanded_stmt_for_scp(); 04326 04327 curr_scp_idx = save_curr_scp_idx; 04328 curr_stmt_sh_idx = save_curr_stmt_sh_idx; 04329 04330 return; 04331 } 04332 04333 04334 /******************************************************************************\ 04335 |* *| 04336 |* Description: *| 04337 |* NEED DESCRIPTION *| 04338 |* *| 04339 |* Input parameters: *| 04340 |* NONE *| 04341 |* *| 04342 |* Output parameters: *| 04343 |* NONE *| 04344 |* *| 04345 |* Returns: *| 04346 |* NOTHING *| 04347 |* *| 04348 \******************************************************************************/ 04349 04350 static void print_expanded_stmt_for_scp(void) 04351 { 04352 int sh_idx; 04353 int save_curr_scp_idx; 04354 04355 init_debug_file(); 04356 04357 PROCESS_SIBLING: 04358 04359 fprintf(debug_file, "\n****************************************" 04360 "****************************************\n"); 04361 fprintf(debug_file, "\n\t\t\t EXPANDED IR FOR %s\n\n", 04362 AT_OBJ_NAME_PTR(SCP_ATTR_IDX(curr_scp_idx))); 04363 fprintf(debug_file, "****************************************" 04364 "****************************************\n\n"); 04365 04366 04367 sh_idx = SCP_FIRST_SH_IDX(curr_scp_idx); 04368 04369 while (sh_idx != NULL_IDX) { 04370 print_expanded_ir(SH_IR_IDX(sh_idx)); 04371 fprintf(debug_file, "\n"); 04372 sh_idx = SH_NEXT_IDX(sh_idx); 04373 } 04374 04375 fprintf(debug_file, "\n****************************************" 04376 "****************************************\n"); 04377 04378 if (SCP_FIRST_CHILD_IDX(curr_scp_idx) != NULL_IDX) { 04379 save_curr_scp_idx = curr_scp_idx; 04380 curr_scp_idx = SCP_FIRST_CHILD_IDX(curr_scp_idx); 04381 print_expanded_stmt_for_scp(); 04382 curr_scp_idx = save_curr_scp_idx; 04383 } 04384 04385 if (SCP_SIBLING_IDX(curr_scp_idx) != NULL_IDX) { 04386 curr_scp_idx = SCP_SIBLING_IDX(curr_scp_idx); 04387 goto PROCESS_SIBLING; 04388 } 04389 04390 return; 04391 } 04392 04393 04394 /******************************************************************************\ 04395 |* *| 04396 |* Description: *| 04397 |* NEED DESCRIPTION *| 04398 |* *| 04399 |* Input parameters: *| 04400 |* NONE *| 04401 |* *| 04402 |* Output parameters: *| 04403 |* NONE *| 04404 |* *| 04405 |* Returns: *| 04406 |* NOTHING *| 04407 |* *| 04408 \******************************************************************************/ 04409 04410 static void print_expanded_const(int idx) 04411 04412 { 04413 long64 i; 04414 int type_idx; 04415 char str[80]; 04416 04417 04418 type_idx = CN_TYPE_IDX(idx); 04419 04420 switch (TYP_TYPE(type_idx)) { 04421 case Typeless: 04422 convert_to_string_fmt = Hex_Fmt; 04423 fprintf(debug_file,"0x%s", 04424 convert_to_string(&CN_CONST(idx), type_idx, str)); 04425 04426 if (TYP_BIT_LEN(type_idx) > TARGET_BITS_PER_WORD) { 04427 04428 for (i = 1; 04429 i < (TYP_BIT_LEN(type_idx) + TARGET_BITS_PER_WORD - 1) / 04430 TARGET_BITS_PER_WORD; 04431 i++) { 04432 convert_to_string_fmt = Hex_Fmt; 04433 fprintf(debug_file, "%s", 04434 convert_to_string(&CP_CONSTANT(CN_POOL_IDX(idx)+i), 04435 type_idx, 04436 str)); 04437 } 04438 } 04439 break; 04440 04441 case Integer: 04442 fprintf(debug_file, "%s", convert_to_string(&CN_CONST(idx), 04443 type_idx, str)); 04444 break; 04445 04446 case Real: 04447 fprintf(debug_file, "%s", convert_to_string(&CN_CONST(idx), 04448 type_idx, str)); 04449 break; 04450 04451 case Character: 04452 fprintf(debug_file,"\"%s\"", (char *) &CN_CONST(idx)); 04453 break; 04454 04455 case Logical: 04456 fprintf(debug_file, "%s", (THIS_IS_TRUE(&(CN_CONST(idx)), 04457 CN_TYPE_IDX(idx)) ? 04458 ".TRUE." : ".FALSE.")); 04459 break; 04460 04461 case Complex: 04462 fprintf(debug_file, "%s", convert_to_string(&CN_CONST(idx), 04463 CN_TYPE_IDX(idx), 04464 str)); 04465 break; 04466 } 04467 04468 fprintf(debug_file, " "); 04469 04470 return; 04471 04472 } /* print_expanded_const */ 04473 04474 /******************************************************************************\ 04475 |* *| 04476 |* Description: *| 04477 |* NEED DESCRIPTION *| 04478 |* *| 04479 |* Input parameters: *| 04480 |* NONE *| 04481 |* *| 04482 |* Output parameters: *| 04483 |* NONE *| 04484 |* *| 04485 |* Returns: *| 04486 |* NOTHING *| 04487 |* *| 04488 \******************************************************************************/ 04489 04490 static void print_expanded_ir(int ir_idx) 04491 04492 { 04493 switch (IR_OPR(ir_idx)) { 04494 case Null_Opr: 04495 case Defined_Un_Opr: 04496 case Alloc_Opr: 04497 case SSD_Alloc_Opr: 04498 case Cvrt_Opr: 04499 case Dealloc_Opr: 04500 fprintf(debug_file, "%s ", opr_str[IR_OPR(ir_idx)]); 04501 break; 04502 04503 /* Unary operators - Opr Left */ 04504 04505 case Uplus_Opr: 04506 case Uminus_Opr: 04507 case Not_Opr: 04508 fprintf(debug_file, "%s ", opr_str[IR_OPR(ir_idx)]); 04509 print_expanded_opnd(IR_OPND_L(ir_idx)); 04510 break; 04511 04512 /* Binary operators - Left opr Right */ 04513 04514 case Power_Opr: 04515 case Mult_Opr: 04516 case Div_Opr: 04517 case Plus_Opr: 04518 case Minus_Opr: 04519 case Concat_Opr: 04520 case Eq_Opr: 04521 case Ne_Opr: 04522 case Lt_Opr: 04523 case Le_Opr: 04524 case Gt_Opr: 04525 case Ge_Opr: 04526 case And_Opr: 04527 case Or_Opr: 04528 case Eqv_Opr: 04529 case Neqv_Opr: 04530 case Asg_Opr: 04531 print_expanded_opnd(IR_OPND_L(ir_idx)); 04532 fprintf(debug_file, "%s ", opr_str[IR_OPR(ir_idx)]); 04533 print_expanded_opnd(IR_OPND_R(ir_idx)); 04534 break; 04535 04536 /* Call operators */ 04537 04538 case Bnot_Opr: 04539 case Bor_Opr: 04540 case Beqv_Opr: 04541 case Bneqv_Opr: 04542 04543 case Abs_Opr: 04544 case Cos_Opr: 04545 case Sin_Opr: 04546 case Log_E_Opr: 04547 case Log_10_Opr: 04548 case Tan_Opr: 04549 case Tanh_Opr: 04550 case Sinh_Opr: 04551 case Acos_Opr: 04552 case Asin_Opr: 04553 case Atan_Opr: 04554 case Cosh_Opr: 04555 case Atan2_Opr: 04556 case Aimag_Opr: 04557 case Sqrt_Opr: 04558 case Cot_Opr: 04559 case Exp_Opr: 04560 case Int_Opr: 04561 case Band_Opr: 04562 case Mod_Opr: 04563 case Anint_Opr: 04564 case Nint_Opr: 04565 case Sign_Opr: 04566 case Modulo_Opr: 04567 case Shift_Opr: 04568 case Shiftl_Opr: 04569 case Shiftr_Opr: 04570 case Leadz_Opr: 04571 case Popcnt_Opr: 04572 case Poppar_Opr: 04573 case Aint_Opr: 04574 case Dim_Opr: 04575 case Ranget_Opr: 04576 case Ranset_Opr: 04577 case Ranf_Opr: 04578 case Real_Opr: 04579 case Dble_Opr: 04580 case Mask_Opr: 04581 case Conjg_Opr: 04582 case Dprod_Opr: 04583 case Length_Opr: 04584 case Getpos_Opr: 04585 case Unit_Opr: 04586 case Cmplx_Opr: 04587 case Ichar_Opr: 04588 case Char_Opr: 04589 case Index_Opr: 04590 case Lge_Opr: 04591 case Lgt_Opr: 04592 case Lle_Opr: 04593 case Llt_Opr: 04594 case Fcd_Opr: 04595 case Numarg_Opr: 04596 case Rtc_Opr: 04597 case Cvmgp_Opr: 04598 case Cvmgm_Opr: 04599 case Cvmgz_Opr: 04600 case Cvmgn_Opr: 04601 case Cvmgt_Opr: 04602 case Csmg_Opr: 04603 case Adjustl_Opr: 04604 case Adjustr_Opr: 04605 case Ceiling_Opr: 04606 case Exponent_Opr: 04607 case Floor_Opr: 04608 case Fraction_Opr: 04609 case Spacing_Opr: 04610 case Logical_Opr: 04611 case Nearest_Opr: 04612 case Rrspacing_Opr: 04613 case Scale_Opr: 04614 case Scan_Opr: 04615 case Set_Exponent_Opr: 04616 case Verify_Opr: 04617 case Len_Trim_Opr: 04618 case Dshiftl_Opr: 04619 case Dshiftr_Opr: 04620 case Mmx_Opr: 04621 case Mldmx_Opr: 04622 case Mld_Opr: 04623 case Mul_Opr: 04624 case Mcbl_Opr: 04625 case Cshift_Opr: 04626 case Dot_Product_Opr: 04627 case Matmul_Opr: 04628 case Spread_Opr: 04629 case Transpose_Opr: 04630 case All_Opr: 04631 case Any_Opr: 04632 case Count_Opr: 04633 case Product_Opr: 04634 case Sum_Opr: 04635 case Eoshift_Opr: 04636 case Maxval_Opr: 04637 case Minval_Opr: 04638 case Maxloc_Opr: 04639 case Minloc_Opr: 04640 case Reshape_Opr: 04641 case SRK_Opr: 04642 case SIK_Opr: 04643 case Repeat_Opr: 04644 case Trim_Opr: 04645 case Transfer_Opr: 04646 # ifdef _TARGET_OS_MAX 04647 case My_Pe_Opr: 04648 # endif 04649 fprintf(debug_file, "%s ", opr_str[IR_OPR(ir_idx)]); 04650 print_expanded_opnd(IR_OPND_L(ir_idx)); 04651 print_expanded_opnd(IR_OPND_R(ir_idx)); 04652 fprintf(debug_file, ")"); 04653 break; 04654 04655 case Call_Opr: 04656 fprintf(debug_file, "%s ", opr_str[IR_OPR(ir_idx)]); 04657 print_expanded_opnd(IR_OPND_L(ir_idx)); 04658 fprintf(debug_file, "("); 04659 print_expanded_opnd(IR_OPND_R(ir_idx)); 04660 fprintf(debug_file, ")"); 04661 break; 04662 04663 case Defined_Bin_Opr: 04664 04665 case Alt_Return_Opr: 04666 case Case_Opr: 04667 case Allocate_Opr: 04668 case Deallocate_Opr: 04669 case End_Opr: 04670 case Entry_Opr: 04671 case Nullify_Opr: 04672 case Pause_Opr: 04673 case Ptr_Asg_Opr: 04674 case Flat_Array_Asg_Opr: 04675 case Return_Opr: 04676 case Select_Opr: 04677 case Stmt_Func_Call_Opr: 04678 case Stop_Opr: 04679 case Max_Opr: 04680 case Min_Opr: 04681 case Read_Formatted_Opr: 04682 case Read_Unformatted_Opr: 04683 case Read_Namelist_Opr: 04684 case Write_Formatted_Opr: 04685 case Write_Unformatted_Opr: 04686 case Write_Namelist_Opr: 04687 case Inquire_Iolength_Opr: 04688 case Dv_Whole_Copy_Opr: 04689 case Dv_Whole_Def_Opr: 04690 case Dv_Deref_Opr: 04691 case Dv_Access_Base_Addr: 04692 case Dv_Set_Base_Addr: 04693 case Dv_Access_El_Len: 04694 case Dv_Set_El_Len: 04695 case Dv_Access_Assoc: 04696 case Dv_Set_Assoc: 04697 case Dv_Access_Ptr_Alloc: 04698 case Dv_Set_Ptr_Alloc: 04699 case Dv_Access_P_Or_A: 04700 case Dv_Set_P_Or_A: 04701 case Dv_Access_A_Contig: 04702 case Dv_Set_A_Contig: 04703 case Dv_Access_N_Dim: 04704 case Dv_Set_N_Dim: 04705 case Dv_Access_Typ_Code: 04706 case Dv_Set_Typ_Code: 04707 case Dv_Access_Orig_Base: 04708 case Dv_Set_Orig_Base: 04709 case Dv_Access_Orig_Size: 04710 case Dv_Set_Orig_Size: 04711 case Dv_Access_Low_Bound: 04712 case Dv_Set_Low_Bound: 04713 case Dv_Access_Extent: 04714 case Dv_Set_Extent: 04715 case Dv_Access_Stride_Mult: 04716 case Dv_Set_Stride_Mult: 04717 case Br_Aif_Opr: 04718 case Br_Asg_Opr: 04719 case Br_Index_Opr: 04720 case Br_True_Opr: 04721 case Br_Uncond_Opr: 04722 case Case_Range_Opr: 04723 case Implied_Do_Opr: 04724 case Kwd_Opr: 04725 case Loc_Opr: 04726 case Aloc_Opr: 04727 case Const_Tmp_Loc_Opr: 04728 case Len_Opr: 04729 case Clen_Opr: 04730 case Paren_Opr: 04731 case Struct_Opr: 04732 case Struct_Construct_Opr: 04733 case Array_Construct_Opr: 04734 case Constant_Struct_Construct_Opr: 04735 case Constant_Array_Construct_Opr: 04736 case Subscript_Opr: 04737 case Whole_Subscript_Opr: 04738 case Section_Subscript_Opr: 04739 case Alloc_Obj_Opr: 04740 case Dealloc_Obj_Opr: 04741 case Substring_Opr: 04742 case Whole_Substring_Opr: 04743 case Triplet_Opr: 04744 case Label_Opr: 04745 case Loop_Info_Opr: 04746 case Loop_End_Opr: 04747 case Init_Opr: 04748 case Init_Reloc_Opr: 04749 case Use_Opr: 04750 case Where_Opr: 04751 case Real_Div_To_Int_Opr: 04752 case Suppress_Opr: 04753 case Cache_Bypass_Cdir_Opr: 04754 case Vector_Cdir_Opr: 04755 case Novector_Cdir_Opr: 04756 case Task_Cdir_Opr: 04757 case Notask_Cdir_Opr: 04758 case Bounds_Cdir_Opr: 04759 case Nobounds_Cdir_Opr: 04760 case Recurrence_Cdir_Opr: 04761 case Norecurrence_Cdir_Opr: 04762 case Vsearch_Cdir_Opr: 04763 case Novsearch_Cdir_Opr: 04764 case Bl_Cdir_Opr: 04765 case Nobl_Cdir_Opr: 04766 case Inline_Cdir_Opr: 04767 case Noinline_Cdir_Opr: 04768 case Ivdep_Cdir_Opr: 04769 case Nextscalar_Cdir_Opr: 04770 case Prefervector_Cdir_Opr: 04771 case Prefertask_Cdir_Opr: 04772 case Shortloop_Cdir_Opr: 04773 case Shortloop128_Cdir_Opr: 04774 case Cachealign_Cdir_Opr: 04775 case Nounroll_Cdir_Opr: 04776 case Unroll_Cdir_Opr: 04777 case Align_Cdir_Opr: 04778 case Case_Cmic_Opr: 04779 case Endcase_Cmic_Opr: 04780 case Continue_Cmic_Opr: 04781 case Cncall_Cmic_Opr: 04782 case Doall_Cmic_Opr: 04783 case Doparallel_Cmic_Opr: 04784 case Enddo_Cmic_Opr: 04785 case Guard_Cmic_Opr: 04786 case Endguard_Cmic_Opr: 04787 case Numcpus_Cmic_Opr: 04788 case Parallel_Cmic_Opr: 04789 case Endparallel_Cmic_Opr: 04790 case Permutation_Cmic_Opr: 04791 case Taskcommon_Cmic_Opr: 04792 case Wait_Cmic_Opr: 04793 case Send_Cmic_Opr: 04794 case The_Last_Opr: 04795 fprintf(debug_file, "%s ", opr_str[IR_OPR(ir_idx)]); 04796 print_expanded_opnd(IR_OPND_L(ir_idx)); 04797 print_expanded_opnd(IR_OPND_R(ir_idx)); 04798 break; 04799 04800 } 04801 return; 04802 } 04803 04804 04805 /******************************************************************************\ 04806 |* *| 04807 |* Description: *| 04808 |* NEED DESCRIPTION *| 04809 |* *| 04810 |* Input parameters: *| 04811 |* NONE *| 04812 |* *| 04813 |* Output parameters: *| 04814 |* NONE *| 04815 |* *| 04816 |* Returns: *| 04817 |* NOTHING *| 04818 |* *| 04819 \******************************************************************************/ 04820 04821 static void print_expanded_opnd(opnd_type the_opnd) 04822 04823 { 04824 switch(OPND_FLD(the_opnd)) { 04825 04826 case AT_Tbl_Idx: 04827 fprintf(debug_file, "%s ", AT_OBJ_NAME_PTR(OPND_IDX(the_opnd))); 04828 break; 04829 04830 case CN_Tbl_Idx: 04831 print_expanded_const(OPND_IDX(the_opnd)); 04832 break; 04833 04834 case IR_Tbl_Idx: 04835 print_expanded_ir(OPND_IDX(the_opnd)); 04836 break; 04837 04838 case IL_Tbl_Idx: 04839 print_expanded_il(OPND_IDX(the_opnd)); 04840 break; 04841 04842 } 04843 04844 return; 04845 } 04846 04847 04848 /******************************************************************************\ 04849 |* *| 04850 |* Description: *| 04851 |* NEED DESCRIPTION *| 04852 |* *| 04853 |* Input parameters: *| 04854 |* NONE *| 04855 |* *| 04856 |* Output parameters: *| 04857 |* NONE *| 04858 |* *| 04859 |* Returns: *| 04860 |* NOTHING *| 04861 |* *| 04862 \******************************************************************************/ 04863 04864 static void print_expanded_il(int il_idx) 04865 04866 { 04867 while (il_idx != NULL_IDX) { 04868 switch (IL_FLD(il_idx)) { 04869 case AT_Tbl_Idx: 04870 fprintf(debug_file, "%s ", AT_OBJ_NAME_PTR(IL_IDX(il_idx))); 04871 break; 04872 04873 case CN_Tbl_Idx: 04874 print_expanded_const(IL_IDX(il_idx)); 04875 break; 04876 04877 case IR_Tbl_Idx: 04878 print_expanded_ir(IL_IDX(il_idx)); 04879 break; 04880 04881 case IL_Tbl_Idx: 04882 print_expanded_il(IL_IDX(il_idx)); 04883 break; 04884 04885 case SH_Tbl_Idx: 04886 break; 04887 } 04888 il_idx = IL_NEXT_LIST_IDX(il_idx); 04889 04890 if (il_idx != NULL_IDX) { 04891 fprintf(debug_file, ", "); 04892 } 04893 } 04894 04895 return; 04896 04897 } /* print_expanded_il */ 04898 04899 /******************************************************************************\ 04900 |* *| 04901 |* The following are the actual dump routines for each table. Global variable*| 04902 |* full_debug_dump is used to control how much is dumped. If it is TRUE, all *| 04903 |* fields are printed in whatever routine is being called. If it is FALSE, *| 04904 |* fields are printed except for index fields. This is to allow for better *| 04905 |* comparisons. Default is FALSE. *| 04906 |* *| 04907 \******************************************************************************/ 04908 04909 /******************************************************************************\ 04910 |* *| 04911 |* Description: *| 04912 |* Prints one attr list table entry to the specified output file. *| 04913 |* *| 04914 |* Input parameters: *| 04915 |* FILE to print to - Should be debug_file, stderr, or stdout. *| 04916 |* Index of attribute list entry to print. *| 04917 |* *| 04918 |* Output parameters: *| 04919 |* NONE *| 04920 |* *| 04921 |* Returns: *| 04922 |* NOTHING *| 04923 |* *| 04924 \******************************************************************************/ 04925 static void dump_al_ntry (FILE *out_file, 04926 int al_idx) 04927 04928 { 04929 if (al_idx > attr_list_tbl_idx) { 04930 fprintf(out_file, "\n*FE90-ERROR* AL index value [%d] is out of range.\n", 04931 al_idx); 04932 return; 04933 } 04934 04935 if (AL_IDX_IS_EQ(al_idx)) { 04936 fprintf(out_file, " %-10s= %-6d %-5s= %-6d\n", 04937 "AL_EQ_IDX", AL_EQ_IDX(al_idx), 04938 "NEXT", AL_NEXT_IDX(al_idx)); 04939 } 04940 else if (AL_FREE(al_idx)) { 04941 fprintf(out_file, " %-10s= %-6s %-5s= %-6d\n", 04942 "AL_FREE", boolean_str[AL_FREE(al_idx)], 04943 "NEXT", AL_NEXT_IDX(al_idx)); 04944 } 04945 else { 04946 fprintf(out_file, " %-4s= %-6d %-4s= %-6d %-14s= %-6d %-s\n", 04947 "ATTR", AL_ATTR_IDX(al_idx), 04948 "NEXT", AL_NEXT_IDX(al_idx), 04949 "Special field", AL_ENTRY_COUNT(al_idx), 04950 AT_OBJ_NAME_PTR(AL_ATTR_IDX(al_idx))); 04951 } 04952 04953 return; 04954 04955 } /* dump_al_ntry */ 04956 04957 /******************************************************************************\ 04958 |* *| 04959 |* Description: *| 04960 |* Prints one attr table entry to the specified output file. *| 04961 |* *| 04962 |* Input parameters: *| 04963 |* FILE to print to - Should be debug_file, stderr, or stdout. *| 04964 |* Index of attribute entry to print. *| 04965 |* *| 04966 |* Output parameters: *| 04967 |* NONE *| 04968 |* *| 04969 |* Returns: *| 04970 |* NOTHING *| 04971 |* *| 04972 \******************************************************************************/ 04973 04974 static void dump_at_ntry (FILE *out_file, 04975 int at_idx, 04976 boolean dump_all) 04977 04978 { 04979 int il_idx; 04980 int ro_idx; 04981 char str[80]; 04982 char conv_str[80]; 04983 04984 04985 if (at_idx > attr_tbl_idx) { 04986 fprintf(out_file, "\n*FE90-ERROR* AT index value [%d] is out of range.\n", 04987 at_idx); 04988 return; 04989 } 04990 04991 /* Note that the fields are displayed in alphabetical order. */ 04992 04993 fprintf(out_file, "%-s\n", AT_OBJ_NAME_PTR(at_idx)); 04994 04995 fprintf(out_file, " %-25s %-25s %-16s= %-8d\n", 04996 obj_class_str[AT_OBJ_CLASS(at_idx)], 04997 reference_str[AT_REFERENCED(at_idx)], 04998 "IDX", at_idx); 04999 05000 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05001 "AT_ACCESS_SET", boolean_str[AT_ACCESS_SET(at_idx)], 05002 "AT_ACTUAL_ARG", boolean_str[AT_ACTUAL_ARG(at_idx)], 05003 "AT_ALT_DARG", boolean_str[AT_ALT_DARG(at_idx)]); 05004 05005 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8s\n", 05006 "AT_ARG_TO_KIND", boolean_str[AT_ARG_TO_KIND(at_idx)], 05007 "AT_ATTR_LINK", AT_ATTR_LINK(at_idx), 05008 "AT_CIF_DONE", boolean_str[AT_CIF_DONE(at_idx)]); 05009 05010 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8s\n", 05011 "AT_CIF_IN_USAGE_",boolean_str[AT_CIF_IN_USAGE_REC(at_idx)], 05012 "AT_CIF_SYMBOL_ID", AT_CIF_SYMBOL_ID(at_idx), 05013 "AT_CIF_USE_IN_BN", boolean_str[AT_CIF_USE_IN_BND(at_idx)]); 05014 05015 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8d\n", 05016 "AT_COMPILER_GEND", boolean_str[AT_COMPILER_GEND(at_idx)], 05017 "AT_DCL_ERR", boolean_str[AT_DCL_ERR(at_idx)], 05018 "AT_DEF_COLUMN", AT_DEF_COLUMN(at_idx)); 05019 05020 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 05021 "AT_DEF_LINE", AT_DEF_LINE(at_idx), 05022 "AT_DEF_IN_CHILD", boolean_str[AT_DEF_IN_CHILD(at_idx)], 05023 "AT_DEFINED", boolean_str[AT_DEFINED(at_idx)]); 05024 05025 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05026 "AT_ELEMENTAL_INT", boolean_str[AT_ELEMENTAL_INTRIN(at_idx)], 05027 "AT_HOST_ASSOCIAT",boolean_str[AT_HOST_ASSOCIATED(at_idx)], 05028 "AT_IGNORE_ATTR_L",boolean_str[AT_IGNORE_ATTR_LINK(at_idx)]); 05029 05030 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05031 "AT_IS_DARG", boolean_str[AT_IS_DARG(at_idx)], 05032 "AT_IS_INTRIN", boolean_str[AT_IS_INTRIN(at_idx)], 05033 "AT_LOCKED_IN", boolean_str[AT_LOCKED_IN(at_idx)]); 05034 05035 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8d\n", 05036 "AT_MODULE_IDX", AT_MODULE_IDX(at_idx), 05037 "AT_MODULE_OBJECT", boolean_str[AT_MODULE_OBJECT(at_idx)], 05038 "AT_NAME_LEN", AT_NAME_LEN(at_idx)); 05039 05040 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8d\n", 05041 "AT_NAMELIST_OBJ", boolean_str[AT_NAMELIST_OBJ(at_idx)], 05042 "AT_NOT_VISIBLE", boolean_str[AT_NOT_VISIBLE(at_idx)], 05043 "AT_ORIG_MODULE_I", AT_ORIG_MODULE_IDX(at_idx)); 05044 05045 fprintf(out_file, " %-16s= %-7d %-16s= %-s\n", 05046 "AT_ORIG_NAME_LEN", AT_ORIG_NAME_LEN(at_idx), 05047 "AT_ORIG_NAME_IDX", (AT_ORIG_NAME_IDX(at_idx) == NULL_IDX) 05048 ? "0": AT_ORIG_NAME_PTR(at_idx)); 05049 05050 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05051 "AT_OPTIONAL", boolean_str[AT_OPTIONAL(at_idx)], 05052 "AT_PRIVATE", access_str[AT_PRIVATE(at_idx)], 05053 "AT_REF_IN_CHILD", boolean_str[AT_REF_IN_CHILD(at_idx)]); 05054 05055 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05056 "AT_SEMANTICS_DON", boolean_str[AT_SEMANTICS_DONE(at_idx)], 05057 "AT_TYPED", boolean_str[AT_TYPED(at_idx)], 05058 "AT_USE_ASSOCIATE",boolean_str[AT_USE_ASSOCIATED(at_idx)]); 05059 05060 /* Note that the fields are displayed in alphabetical order. */ 05061 05062 switch (AT_OBJ_CLASS(at_idx)) { 05063 05064 case Data_Obj: 05065 05066 fprintf(out_file, " %-25s %-16s= %-7s %-16s= %-8s\n", 05067 atd_class_str[ATD_CLASS(at_idx)], 05068 "ATD_ALIGN_SYMBOL", boolean_str[ATD_ALIGN_SYMBOL(at_idx)], 05069 "ATD_ALIGNMENT", align_str[ATD_ALIGNMENT(at_idx)]); 05070 05071 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8s\n", 05072 "ATD_ALLOCATABLE", boolean_str[ATD_ALLOCATABLE(at_idx)], 05073 "ATD_ARRAY_IDX", ATD_ARRAY_IDX(at_idx), 05074 "ATD_AUTOMATIC", boolean_str[ATD_AUTOMATIC(at_idx)]); 05075 05076 if (ATD_AUTOMATIC(at_idx)) { 05077 fprintf(out_file, " %-16s= %-7d %-33s\n", 05078 "ATD_AUTO_BASE_ID", ATD_AUTO_BASE_IDX(at_idx), 05079 print_at_name(ATD_AUTO_BASE_IDX(at_idx))); 05080 } 05081 05082 if (ATD_CLASS(at_idx) == Variable) { 05083 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 05084 "ATD_ASSIGN_TMP_I", ATD_ASSIGN_TMP_IDX(at_idx), 05085 "ATD_AUXILIARY", boolean_str[ATD_AUXILIARY(at_idx)], 05086 "ATD_BOUNDS_CHECK", boolean_str[ATD_BOUNDS_CHECK(at_idx)]); 05087 05088 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05089 "ATD_CACHE_ALIGN", boolean_str[ATD_CACHE_ALIGN(at_idx)], 05090 "ATD_CACHE_BYPASS", boolean_str[ATD_CACHE_BYPASS_ARRAY(at_idx)], 05091 "ATD_CACHE_NOALLO", boolean_str[ATD_CACHE_NOALLOC(at_idx)]); 05092 05093 fprintf(out_file, " %-16s= %-7s\n", 05094 "ATD_CHAR_LEN_IN_", boolean_str[ATD_CHAR_LEN_IN_DV(at_idx)]); 05095 } 05096 else { 05097 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05098 "ATD_AUXILIARY", boolean_str[ATD_AUXILIARY(at_idx)], 05099 "ATD_BOUNDS_CHECK", boolean_str[ATD_BOUNDS_CHECK(at_idx)], 05100 "ATD_CACHE_BYPASS", boolean_str[ATD_CACHE_BYPASS_ARRAY(at_idx)]); 05101 05102 if (ATD_CLASS(at_idx) == Compiler_Tmp) { 05103 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8d\n", 05104 "ATD_CACHE_NOALLO", boolean_str[ATD_CACHE_NOALLOC(at_idx)], 05105 "ATD_CHAR_LEN_IN_", boolean_str[ATD_CHAR_LEN_IN_DV(at_idx)], 05106 "ATD_DEFINING_ATT", ATD_DEFINING_ATTR_IDX(at_idx)); 05107 } 05108 else { 05109 fprintf(out_file, " %-16s= %-7s %-16s= %-7s\n", 05110 "ATD_CACHE_NOALLO", boolean_str[ATD_CACHE_NOALLOC(at_idx)], 05111 "ATD_CHAR_LEN_IN_", boolean_str[ATD_CHAR_LEN_IN_DV(at_idx)]); 05112 } 05113 } 05114 05115 05116 if (ATD_CLASS(at_idx) == Struct_Component) { 05117 fprintf(out_file, " %-16s= %-7d \n", 05118 "ATD_DERIVED_TYPE", ATD_DERIVED_TYPE_IDX(at_idx)); 05119 05120 print_fld_idx(out_file, "ATD_CPNT_OFFSET_", 05121 ATD_OFFSET_FLD(at_idx), 05122 ATD_CPNT_OFFSET_IDX(at_idx)); 05123 05124 print_fld_idx(out_file, "ATD_CPNT_INIT_ID", 05125 (fld_type) ATD_FLD(at_idx), 05126 ATD_CPNT_INIT_IDX(at_idx)); 05127 05128 if (ATD_CPNT_INIT_IDX(at_idx) != NULL_IDX) { 05129 05130 if (ATD_FLD(at_idx) == IR_Tbl_Idx) { 05131 dump_ir_ntry(out_file, ATD_CPNT_INIT_IDX(at_idx), 5); 05132 } 05133 else if (ATD_FLD(at_idx) == CN_Tbl_Idx) { 05134 dump_cn_ntry(out_file, ATD_CPNT_INIT_IDX(at_idx)); 05135 } 05136 } 05137 } 05138 else if (ATD_CLASS(at_idx) == Constant) { 05139 print_fld_idx(out_file, "ATD_CONST_IDX", 05140 (fld_type) ATD_FLD(at_idx), 05141 ATD_CONST_IDX(at_idx)); 05142 } 05143 05144 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05145 "ATD_COPY_ASSUMED",boolean_str[ATD_COPY_ASSUMED_SHAPE(at_idx)], 05146 "ATD_DATA_INIT", boolean_str[ATD_DATA_INIT(at_idx)], 05147 "ATD_DCL_EQUIV", boolean_str[ATD_DCL_EQUIV(at_idx)]); 05148 05149 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 05150 "ATD_DISTRIBUTION", ATD_DISTRIBUTION_IDX(at_idx), 05151 "ATD_WAS_SCOPED", boolean_str[ATD_WAS_SCOPED(at_idx)], 05152 "ATD_DYNAMIC", boolean_str[ATD_DYNAMIC(at_idx)]); 05153 05154 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8d\n", 05155 "ATD_EQUIV", boolean_str[ATD_EQUIV(at_idx)], 05156 "ATD_EQUIV_IN_BND",boolean_str[ATD_EQUIV_IN_BNDS_EXPR(at_idx)], 05157 "ATD_EQUIV_LIST", ATD_EQUIV_LIST(at_idx)); 05158 05159 if (ATD_EQUIV_LIST(at_idx) != NULL_IDX) { 05160 print_al_list(out_file, ATD_EQUIV_LIST(at_idx)); 05161 } 05162 05163 # if defined(_EXPRESSION_EVAL) 05164 05165 if (cmd_line_flags.expression_eval_stmt || 05166 cmd_line_flags.expression_eval_expr) { 05167 fprintf(out_file, " %-16s= %-7s\n", 05168 "ATD_EXPR_EVAL_TMP", boolean_str[ATD_EXPR_EVAL_TMP(at_idx)]); 05169 } 05170 # endif 05171 05172 fprintf(out_file," %-16s= %-7s %-16s= %-7d %-16s= %-8s\n", 05173 "ATD_FILL_SYMBOL", boolean_str[ATD_FILL_SYMBOL(at_idx)], 05174 "ATD_FIRST_SEEN_I", ATD_FIRST_SEEN_IL_IDX(at_idx), 05175 "ATD_FORALL_INDEX",boolean_str[ATD_FORALL_INDEX(at_idx)]); 05176 05177 if (ATD_CLASS(at_idx) == Function_Result) { 05178 fprintf(out_file, " %-16s= %-s\n", 05179 "Function Name", print_at_name(ATD_FUNC_IDX(at_idx))); 05180 } 05181 else if (ATD_CLASS(at_idx) == Dummy_Argument) { 05182 fprintf(out_file," %-16s= %-7s %-16s= %-7s\n", 05183 "ATD_INTENT",intent_str[ATD_INTENT(at_idx)], 05184 "ATD_INTRIN_DARG", boolean_str[ATD_INTRIN_DARG(at_idx)]); 05185 05186 if (ATD_INTRIN_DARG(at_idx)) { 05187 fprintf(out_file," %-20s= %-22o\n", 05188 "ATD_INTRIN_DARG_TYPE", ATD_INTRIN_DARG_TYPE(at_idx)); 05189 } 05190 } 05191 05192 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05193 "ATD_IGNORE_TKR", boolean_str[ATD_IGNORE_TKR(at_idx)], 05194 "ATD_IM_A_DOPE", boolean_str[ATD_IM_A_DOPE(at_idx)], 05195 "ATD_IMP_DO_LCV", boolean_str[ATD_IMP_DO_LCV(at_idx)]); 05196 05197 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05198 "ATD_IN_ASSIGN", boolean_str[ATD_IN_ASSIGN(at_idx)], 05199 "ATD_IN_COMMON", boolean_str[ATD_IN_COMMON(at_idx)], 05200 "ATD_LCV_IS_CONST", boolean_str[ATD_LCV_IS_CONST(at_idx)]); 05201 05202 if (ATD_CLASS(at_idx) == Compiler_Tmp || 05203 ATD_CLASS(at_idx) == Dummy_Argument) { 05204 05205 if (ATD_NO_ENTRY_LIST(at_idx) != NULL_IDX) { 05206 fprintf(out_file,"\n"); 05207 print_al_list(out_file, ATD_NO_ENTRY_LIST(at_idx)); 05208 } 05209 } 05210 05211 if ((ATD_CLASS(at_idx) == Variable || 05212 ATD_CLASS(at_idx) == Compiler_Tmp) && 05213 ATD_IN_COMMON(at_idx)) { 05214 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8s\n", 05215 "ATD_LIVE_DO_VAR", boolean_str[ATD_LIVE_DO_VAR(at_idx)], 05216 "ATD_NEXT_MEMBER_", ATD_NEXT_MEMBER_IDX(at_idx), 05217 "ATD_NOBOUNDS_CHE",boolean_str[ATD_NOBOUNDS_CHECK(at_idx)]); 05218 05219 fprintf(out_file, " %-16s= %-7s %-16s= %-7s\n", 05220 "ATD_NOT_PT_UNIQU", boolean_str[ATD_NOT_PT_UNIQUE_MEM(at_idx)], 05221 "ATD_OFFSET_ASSIG",boolean_str[ATD_OFFSET_ASSIGNED(at_idx)]); 05222 } 05223 else { 05224 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-7s\n", 05225 "ATD_LIVE_DO_VAR", boolean_str[ATD_LIVE_DO_VAR(at_idx)], 05226 "ATD_NOBOUNDS_CHE",boolean_str[ATD_NOBOUNDS_CHECK(at_idx)], 05227 "ATD_NOT_PT_UNIQU", boolean_str[ATD_NOT_PT_UNIQUE_MEM(at_idx)]); 05228 05229 fprintf(out_file, " %-16s= %-7s\n", 05230 "ATD_OFFSET_ASSIG",boolean_str[ATD_OFFSET_ASSIGNED(at_idx)]); 05231 } 05232 05233 if ((ATD_CLASS(at_idx) == Variable && !ATD_AUTOMATIC(at_idx)) || 05234 ((ATD_CLASS(at_idx) == Dummy_Argument || 05235 ATD_CLASS(at_idx) == Compiler_Tmp) && 05236 ATD_OFFSET_ASSIGNED(at_idx)) || 05237 ATD_CLASS(at_idx) == Function_Result) { 05238 print_fld_idx(out_file, "ATD_OFFSET_IDX", 05239 ATD_OFFSET_FLD(at_idx), 05240 ATD_OFFSET_IDX(at_idx)); 05241 } 05242 else if (ATD_CLASS(at_idx) == CRI__Pointee) { 05243 fprintf(out_file," %-16s= %-7d %-s\n", 05244 "Pointer Name", ATD_PTR_IDX(at_idx), 05245 print_at_name(ATD_PTR_IDX(at_idx))); 05246 } 05247 05248 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8s\n", 05249 "ATD_PARENT_OBJEC",boolean_str[ATD_PARENT_OBJECT(at_idx)], 05250 "ATD_PE_ARRAY_IDX", ATD_PE_ARRAY_IDX(at_idx), 05251 "ATD_PERMUTATION", boolean_str[ATD_PERMUTATION(at_idx)]); 05252 05253 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05254 "ATD_POINTER", boolean_str[ATD_POINTER(at_idx)], 05255 "ATD_PTR_ASSIGNED", boolean_str[ATD_PTR_ASSIGNED(at_idx)], 05256 "ATD_PTR_HALF_WOR", boolean_str[ATD_PTR_HALF_WORD(at_idx)]); 05257 05258 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05259 "ATD_PTR_TYPE_SET",boolean_str[ATD_PTR_TYPE_SET(at_idx)], 05260 "ATD_PURE",boolean_str[ATD_PURE(at_idx)], 05261 "ATD_RESHAPE ARRA",boolean_str[ATD_RESHAPE_ARRAY_OPT(at_idx)]); 05262 05263 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 05264 "ATD_RESHAPE_IDX", ATD_RESHAPE_ARRAY_IDX(at_idx), 05265 "ATD_SAVED", boolean_str[ATD_SAVED(at_idx)], 05266 "ATD_SECTION_GP", boolean_str[ATD_SECTION_GP(at_idx)]); 05267 05268 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05269 "ATD_SECTION_NON_", boolean_str[ATD_SECTION_NON_GP(at_idx)], 05270 "ATD_SEEN_AS_LCV", boolean_str[ATD_SEEN_AS_LCV(at_idx)], 05271 "ATD_SEEN_AS_IO_", boolean_str[ATD_SEEN_AS_IO_LCV(at_idx)]); 05272 05273 05274 if (ATD_CLASS(at_idx) == Dummy_Argument) { 05275 05276 if (ATD_SF_DARG(at_idx)) { 05277 print_fld_idx(out_file, "ATD_SF_ARG_IDX", 05278 (fld_type) ATD_FLD(at_idx), 05279 ATD_SF_ARG_IDX(at_idx)); 05280 05281 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 05282 "ATD_SF_LINK", ATD_SF_LINK(at_idx), 05283 "ATD_SYMBOLIC_CON",boolean_str[ATD_SYMBOLIC_CONSTANT(at_idx)], 05284 "ATD_SYMMETRIC", boolean_str[ATD_SYMMETRIC(at_idx)]); 05285 } 05286 else { 05287 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05288 "ATD_SF_DARG", boolean_str[ATD_SF_DARG(at_idx)], 05289 "ATD_SYMBOLIC_CON",boolean_str[ATD_SYMBOLIC_CONSTANT(at_idx)], 05290 "ATD_SYMMETRIC", boolean_str[ATD_SYMMETRIC(at_idx)]); 05291 } 05292 05293 fprintf(out_file, " %-16s= %-7s\n", 05294 "ATD_SEEN_IN_IMP", boolean_str[ATD_SEEN_IN_IMP_DO(at_idx)]); 05295 } 05296 else { 05297 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05298 "ATD_SEEN_IN_IMP", boolean_str[ATD_SEEN_IN_IMP_DO(at_idx)], 05299 "ATD_SYMBOLIC_CON",boolean_str[ATD_SYMBOLIC_CONSTANT(at_idx)], 05300 "ATD_SYMMETRIC", boolean_str[ATD_SYMMETRIC(at_idx)]); 05301 } 05302 05303 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8d\n", 05304 "ATD_SEEN_OUTSID",boolean_str[ATD_SEEN_OUTSIDE_IMP_DO(at_idx)], 05305 "ATD_STACK", boolean_str[ATD_STACK(at_idx)], 05306 "ATD_STOR_BLK_IDX", ATD_STOR_BLK_IDX(at_idx)); 05307 05308 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05309 "ATD_TARGET", boolean_str[ATD_TARGET(at_idx)], 05310 "ATD_TASK_COPYIN", boolean_str[ATD_TASK_COPYIN(at_idx)], 05311 "ATD_TASK_FIRSTPR",boolean_str[ATD_TASK_FIRSTPRIVATE(at_idx)]); 05312 05313 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05314 "ATD_TASK_GETFIRS", boolean_str[ATD_TASK_GETFIRST(at_idx)], 05315 "ATD_TASK_LASTLOC",boolean_str[ATD_TASK_LASTLOCAL(at_idx)], 05316 "ATD_TASK_LASTPRI", boolean_str[ATD_TASK_LASTPRIVATE(at_idx)]); 05317 05318 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05319 "ATD_TASK_LASTTHR",boolean_str[ATD_TASK_LASTTHREAD(at_idx)], 05320 "ATD_TASK_PRIVATE", boolean_str[ATD_TASK_PRIVATE(at_idx)], 05321 "ATD_TASK_SHARED", boolean_str[ATD_TASK_SHARED(at_idx)]); 05322 05323 05324 if (ATD_CLASS(at_idx) == Compiler_Tmp) { 05325 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05326 "ATD_TMP_GEN_ZERO", boolean_str[ATD_TMP_GEN_ZERO(at_idx)], 05327 "ATD_TMP_HAS_CVRT", boolean_str[ATD_TMP_HAS_CVRT_OPR(at_idx)], 05328 "ATD_TMP_INIT_NOT",boolean_str[ATD_TMP_INIT_NOT_DONE(at_idx)]); 05329 05330 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s=%-7s\n", 05331 "ATD_TMP_NEEDS_CI",boolean_str[ATD_TMP_NEEDS_CIF(at_idx)], 05332 "ATD_TMP_SEMANTIC",boolean_str[ATD_TMP_SEMANTICS_DONE(at_idx)], 05333 "ATD_TOO_BIG_FOR_",boolean_str[ATD_TOO_BIG_FOR_DV(at_idx)]); 05334 05335 print_fld_idx(out_file, "ATD_TMP_IDX", 05336 (fld_type) ATD_FLD(at_idx), 05337 ATD_TMP_IDX(at_idx)); 05338 05339 if (ATD_SYMBOLIC_CONSTANT(at_idx) && ATD_FLD(at_idx) == IR_Tbl_Idx){ 05340 dump_ir_ntry(out_file, ATD_TMP_IDX(at_idx), 4); 05341 } 05342 05343 if (ATD_TMP_INIT_NOT_DONE(at_idx)) { /* dump tmp's constant */ 05344 fprintf(out_file, "\nCONSTANT FOR INIT\n"); 05345 05346 if (ATD_FLD(at_idx) == CN_Tbl_Idx) { 05347 dump_cn_ntry(out_file, ATD_TMP_IDX(at_idx)); 05348 } 05349 else { 05350 fprintf(out_file, "COUNT = \n"); 05351 dump_cn_ntry(out_file, IR_IDX_L(ATD_TMP_IDX(at_idx))); 05352 fprintf(out_file, "VALUE = \n"); 05353 dump_cn_ntry(out_file, IR_IDX_R(ATD_TMP_IDX(at_idx))); 05354 } 05355 05356 } 05357 } 05358 else { 05359 fprintf(out_file, " %-16s= %-7s\n", 05360 "ATD_TOO_BIG_FOR_",boolean_str[ATD_TOO_BIG_FOR_DV(at_idx)]); 05361 } 05362 05363 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-s\n", 05364 "ATD_VOLATILE",boolean_str[ATD_VOLATILE(at_idx)], 05365 "ATD_TYPE_IDX", ATD_TYPE_IDX(at_idx), 05366 print_type_f(ATD_TYPE_IDX(at_idx))); 05367 05368 if (ATD_CLASS(at_idx) == Variable) { 05369 fprintf(out_file," %-16s= %-7d\n", 05370 "ATD_VARIABLE_TMP", ATD_VARIABLE_TMP_IDX(at_idx)); 05371 } 05372 05373 if (dump_all && ATD_STOR_BLK_IDX(at_idx) != NULL_IDX) { 05374 fprintf(out_file, "\n"); 05375 dump_sb_ntry(out_file, ATD_STOR_BLK_IDX(at_idx)); 05376 } 05377 05378 if (dump_all && ATD_ARRAY_IDX(at_idx) != NULL_IDX) { 05379 fprintf(out_file, "\n"); 05380 dump_bd_ntry(out_file, ATD_ARRAY_IDX(at_idx)); 05381 } 05382 05383 if (dump_all && ATD_DISTRIBUTION_IDX(at_idx) != NULL_IDX) { 05384 fprintf(out_file, "\n"); 05385 fprintf(out_file, "ATD_DISTRIBUTION_IDX bounds table dump\n"); 05386 dump_bd_ntry(out_file, ATD_DISTRIBUTION_IDX(at_idx)); 05387 } 05388 05389 #ifdef COARRAY_FORTRAN 05390 if (dump_all && ATD_PE_ARRAY_IDX(at_idx) != NULL_IDX) { 05391 fprintf(out_file, "\n"); 05392 fprintf(out_file, "ATD_PE_ARRAY_IDX bounds table dump\n"); 05393 dump_bd_ntry(out_file, ATD_PE_ARRAY_IDX(at_idx)); 05394 } 05395 # endif 05396 05397 break; 05398 05399 05400 case Pgm_Unit: 05401 fprintf(out_file, " %-25s %-25s %-16s= %-8s\n", 05402 atp_pgm_unit_str[ATP_PGM_UNIT(at_idx)], 05403 atp_proc_str[ATP_PROC(at_idx)], 05404 "ATP_ALIGN", boolean_str[ATP_ALIGN(at_idx)]); 05405 05406 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05407 "ATP_ALL_INTENT_I", boolean_str[ATP_ALL_INTENT_IN(at_idx)], 05408 "ATP_ALT_ENTRY", boolean_str[ATP_ALT_ENTRY(at_idx)], 05409 "ATP_ARGCHCK_CALL", boolean_str[ATP_ARGCHCK_CALL(at_idx)]); 05410 05411 if (ATP_PGM_UNIT(at_idx) != Module) { 05412 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8d\n", 05413 "ATP_ARGCHCK_ENTR", boolean_str[ATP_ARGCHCK_ENTRY(at_idx)], 05414 "ATP_DCL_EXTERNAL", boolean_str[ATP_DCL_EXTERNAL(at_idx)], 05415 "ATP_DUPLICATE_IN", ATP_DUPLICATE_INTERFACE_IDX(at_idx)); 05416 05417 if (ATP_PROC(at_idx) == Dummy_Proc) { 05418 fprintf(out_file, " %-16s= %-7s %-16s= %-7d\n", 05419 "ATP_CIF_DARG_PRO", boolean_str[ATP_CIF_DARG_PROC(at_idx)], 05420 "ATP_DUMMY_PROC_L", ATP_DUMMY_PROC_LINK(at_idx)); 05421 } 05422 05423 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8s\n", 05424 "ATP_ELEMENTAL", boolean_str[ATP_ELEMENTAL(at_idx)], 05425 "ATP_ENTRY_LABEL_", ATP_ENTRY_LABEL_SH_IDX(at_idx), 05426 "ATP_EXPL_ITRFC", boolean_str[ATP_EXPL_ITRFC(at_idx)]); 05427 05428 fprintf(out_file, " %-16s= %-7d %-16s= %-7d %-s\n", 05429 "ATP_EXT_NAME_IDX", ATP_EXT_NAME_IDX(at_idx), 05430 "ATP_EXT_NAME_LEN", ATP_EXT_NAME_LEN(at_idx), 05431 ATP_EXT_NAME_PTR(at_idx)); 05432 05433 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8d\n", 05434 "ATP_EXTERNAL_INT",boolean_str[ATP_EXTERNAL_INTRIN(at_idx)], 05435 "ATP_EXTRA_DARG", boolean_str[ATP_EXTRA_DARG(at_idx)], 05436 "ATP_FIRST_IDX", ATP_FIRST_IDX(at_idx)); 05437 05438 if (ATP_PROC(at_idx) == Extern_Proc) { 05439 fprintf(out_file, " %-16s= %-7d %-16s= %-7d\n", 05440 "ATP_FIRST_SH_IDX", ATP_FIRST_SH_IDX(at_idx), 05441 "ATP_GLOBAL_ATTR_", ATP_GLOBAL_ATTR_IDX(at_idx)); 05442 } 05443 else { 05444 fprintf(out_file, " %-16s= %-7d\n", 05445 "ATP_GLOBAL_ATTR_", ATP_GLOBAL_ATTR_IDX(at_idx)); 05446 } 05447 05448 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05449 "ATP_HAS_ALT_RET", boolean_str[ATP_HAS_ALT_RETURN(at_idx)], 05450 "ATP_HAS_OVER_IND",boolean_str[ATP_HAS_OVER_INDEXING(at_idx)], 05451 "ATP_HAS_TASK_DIR", boolean_str[ATP_HAS_TASK_DIRS(at_idx)]); 05452 05453 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05454 "ATP_IN_INTERFACE",boolean_str[ATP_IN_INTERFACE_BLK(at_idx)], 05455 "ATP_IN_UNNAMED_I",boolean_str[ATP_IN_UNNAMED_INTERFACE(at_idx)], 05456 "ATP_INLINE_ALWAY",boolean_str[ATP_INLINE_ALWAYS(at_idx)]); 05457 05458 if (ATP_PROC(at_idx) == Intrin_Proc) { 05459 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8s\n", 05460 "ATP_INLINE_NEVER",boolean_str[ATP_INLINE_NEVER(at_idx)], 05461 "ATP_INTERFACE_ID", ATP_INTERFACE_IDX(at_idx), 05462 "ATP_INTRIN_ENUM", intrin_str[ATP_INTRIN_ENUM(at_idx)]); 05463 05464 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8d\n", 05465 "ATP_MAY_INLINE", boolean_str[ATP_MAY_INLINE(at_idx)], 05466 "ATP_NAME_IN_STON", boolean_str[ATP_NAME_IN_STONE(at_idx)], 05467 "ATP_NO_ENTRY_LIS", ATP_NO_ENTRY_LIST(at_idx)); 05468 05469 if (ATP_NO_ENTRY_LIST(at_idx) != NULL_IDX) { 05470 print_al_list(out_file, ATP_NO_ENTRY_LIST(at_idx)); 05471 } 05472 05473 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8d\n", 05474 "ATP_NON_ANSI_INT",boolean_str[ATP_NON_ANSI_INTRIN(at_idx)], 05475 "ATP_NOSIDE_EFFEC", boolean_str[ATP_NOSIDE_EFFECTS(at_idx)], 05476 "ATP_NUM_DARGS", ATP_NUM_DARGS(at_idx)); 05477 05478 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05479 "ATP_OPTIONAL_DIR",boolean_str[ATP_OPTIONAL_DIR(at_idx)], 05480 "ATP_PURE", boolean_str[ATP_PURE(at_idx)], 05481 "ATP_RECURSIVE", boolean_str[ATP_RECURSIVE(at_idx)]); 05482 } 05483 else { 05484 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05485 "ATP_INLINE_NEVER",boolean_str[ATP_INLINE_NEVER(at_idx)], 05486 "ATP_MAY_INLINE", boolean_str[ATP_MAY_INLINE(at_idx)], 05487 "ATP_NAME_IN_STON", boolean_str[ATP_NAME_IN_STONE(at_idx)]); 05488 05489 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 05490 "ATP_NO_ENTRY_LIS", ATP_NO_ENTRY_LIST(at_idx), 05491 "ATP_NON_ANSI_INT",boolean_str[ATP_NON_ANSI_INTRIN(at_idx)], 05492 "ATP_NOSIDE_EFFEC", boolean_str[ATP_NOSIDE_EFFECTS(at_idx)]); 05493 05494 if (ATP_NO_ENTRY_LIST(at_idx) != NULL_IDX) { 05495 print_al_list(out_file, ATP_NO_ENTRY_LIST(at_idx)); 05496 } 05497 05498 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8d\n", 05499 "ATP_NUM_DARGS", ATP_NUM_DARGS(at_idx), 05500 "ATP_OPTIONAL_DIR",boolean_str[ATP_OPTIONAL_DIR(at_idx)], 05501 "ATP_PARENT_IDX", ATP_PARENT_IDX(at_idx)); 05502 05503 fprintf(out_file, " %-16s= %-7s %-16s= %-7s\n", 05504 "ATP_PURE", boolean_str[ATP_PURE(at_idx)], 05505 "ATP_RECURSIVE", boolean_str[ATP_RECURSIVE(at_idx)]); 05506 } 05507 05508 if (ATP_RSLT_IDX(at_idx) != NULL_IDX) { 05509 fprintf(out_file, " %-16s= %-7s %-s\n", 05510 "ATP_RSLT_NAME", boolean_str[ATP_RSLT_NAME(at_idx)], 05511 AT_OBJ_NAME_PTR(ATP_RSLT_IDX(at_idx))); 05512 } 05513 05514 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 05515 "ATP_RSLT_IDX", ATP_RSLT_IDX(at_idx), 05516 "ATP_SAVE_ALL", boolean_str[ATP_SAVE_ALL(at_idx)], 05517 "ATP_SCP_ALIVE", boolean_str[ATP_SCP_ALIVE(at_idx)]); 05518 05519 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 05520 "ATP_SCP_IDX", ATP_SCP_IDX(at_idx), 05521 "ATP_SGI_RTN_INL", boolean_str[ATP_SGI_ROUTINE_INLINE(at_idx)], 05522 "ATP_SGI_RTN_NOIN",boolean_str[ATP_SGI_ROUTINE_NOINLINE(at_idx)]); 05523 05524 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05525 "ATP_SGI_GLB_INL",boolean_str[ATP_SGI_GLOBAL_INLINE(at_idx)], 05526 "ATP_SGI_GLB_NOIN",boolean_str[ATP_SGI_GLOBAL_NOINLINE(at_idx)], 05527 "ATP_SGI_LOC_INL", boolean_str[ATP_SGI_LOCAL_INLINE(at_idx)]); 05528 05529 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05530 "ATP_SGI_LOC_NOIN",boolean_str[ATP_SGI_LOCAL_NOINLINE(at_idx)], 05531 "ATP_STACK_DIR",boolean_str[ATP_STACK_DIR(at_idx)], 05532 "ATP_SYMMETRIC",boolean_str[ATP_SYMMETRIC(at_idx)]); 05533 05534 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05535 "ATP_TASK_SHARED",boolean_str[ATP_TASK_SHARED(at_idx)], 05536 "ATP_USES_EREGS",boolean_str[ATP_USES_EREGS(at_idx)], 05537 "ATP_VFUNCTION",boolean_str[ATP_VFUNCTION(at_idx)]); 05538 05539 /* FMZ added for cosubroutine cofunction */ 05540 fprintf(out_file, " %-22s= %-7s \n", "ATP_COARRAY_CONCURRENT", 05541 boolean_str[ATP_COARRAY_CONCURRENT(at_idx)]); 05542 05543 } 05544 else { /* MODULE */ 05545 05546 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8d\n", 05547 "ATP_ARGCHCK_ENTR", boolean_str[ATP_ARGCHCK_ENTRY(at_idx)], 05548 "ATP_DCL_EXTERNAL",boolean_str[ATP_DCL_EXTERNAL(at_idx)], 05549 "ATP_ENTRY_LABEL_", ATP_ENTRY_LABEL_SH_IDX(at_idx)); 05550 05551 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05552 "ATP_EXPL_ITRFC", boolean_str[ATP_EXPL_ITRFC(at_idx)], 05553 "ATP_EXTERNAL_INT",boolean_str[ATP_EXTERNAL_INTRIN(at_idx)], 05554 "ATP_EXTRA_DARG", boolean_str[ATP_EXTRA_DARG(at_idx)]); 05555 05556 fprintf(out_file, " %-16s= %-7d %-16s= %-7d %-s\n", 05557 "ATP_EXT_NAME_IDX", ATP_EXT_NAME_IDX(at_idx), 05558 "ATP_EXT_NAME_LEN", ATP_EXT_NAME_LEN(at_idx), 05559 ATP_EXT_NAME_PTR(at_idx)); 05560 05561 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 05562 "ATP_GLOBAL_ATTR_", ATP_GLOBAL_ATTR_IDX(at_idx), 05563 "ATP_HAS_ALT_RET", boolean_str[ATP_HAS_ALT_RETURN(at_idx)], 05564 "ATP_HAS_OVER_IND", boolean_str[ATP_HAS_OVER_INDEXING(at_idx)]); 05565 05566 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-7s\n", 05567 "ATP_HAS_TASK_DIR", boolean_str[ATP_HAS_TASK_DIRS(at_idx)], 05568 "ATP_IMPLICIT_USE", boolean_str[ATP_IMPLICIT_USE_MODULE(at_idx)], 05569 "ATP_INDIRECT_MOD", boolean_str[ATP_INDIRECT_MODULE(at_idx)]); 05570 05571 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05572 "ATP_IN_CURRENT_", boolean_str[ATP_IN_CURRENT_COMPILE(at_idx)], 05573 "ATP_IN_INTERFACE", boolean_str[ATP_IN_INTERFACE_BLK(at_idx)], 05574 "ATP_INLINE_ALWAY", boolean_str[ATP_INLINE_ALWAYS(at_idx)]); 05575 05576 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8d\n", 05577 "ATP_INLINE_NEVER", boolean_str[ATP_INLINE_NEVER(at_idx)], 05578 "ATP_MAY_INLINE", boolean_str[ATP_MAY_INLINE(at_idx)], 05579 "ATP_MODULE_STR_I", ATP_MODULE_STR_IDX(at_idx)); 05580 05581 if (ATP_MOD_PATH_IDX(at_idx) != NULL_IDX) { 05582 fprintf(out_file," %-16s= %-7d %-16s= %-s\n", 05583 "ATP_MOD_PATH_LEN", ATP_MOD_PATH_LEN(at_idx), 05584 "ATP_MOD_PATH_IDX", ATP_MOD_PATH_NAME_PTR(at_idx)); 05585 } 05586 05587 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05588 "ATP_NOSIDE_EFFEC", boolean_str[ATP_NOSIDE_EFFECTS(at_idx)], 05589 "ATP_RECURSIVE", boolean_str[ATP_RECURSIVE(at_idx)], 05590 "ATP_RSLT_NAME", boolean_str[ATP_RSLT_NAME(at_idx)]); 05591 05592 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8d\n", 05593 "ATP_SAVE_ALL", boolean_str[ATP_SAVE_ALL(at_idx)], 05594 "ATP_SCP_ALIVE", boolean_str[ATP_SCP_ALIVE(at_idx)], 05595 "ATP_SCP_IDX", ATP_SCP_IDX(at_idx)); 05596 05597 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05598 "ATP_STACK_DIR",boolean_str[ATP_STACK_DIR(at_idx)], 05599 "ATP_SYSTEM_MODUL", boolean_str[ATP_SYSTEM_MODULE(at_idx)], 05600 "ATP_TASK_SHARED",boolean_str[ATP_TASK_SHARED(at_idx)]); 05601 05602 fprintf(out_file, " %-16s= %-7d %-25s\n", 05603 "ATP_USE_LIST", ATP_USE_LIST(at_idx), 05604 use_type_str[ATP_USE_TYPE(at_idx)]); 05605 05606 fprintf(out_file, " %-16s= %-7s %-16s= %-7s\n", 05607 "ATP_USES_EREGS",boolean_str[ATP_USES_EREGS(at_idx)], 05608 "ATP_VFUNCTION",boolean_str[ATP_VFUNCTION(at_idx)]); 05609 05610 if (ATP_USE_LIST(at_idx) != NULL_IDX) { 05611 ro_idx = ATP_USE_LIST(at_idx); 05612 05613 while (ro_idx != NULL_IDX) { 05614 dump_ro_ntry(out_file, ro_idx); 05615 ro_idx = RO_NEXT_IDX(ro_idx); 05616 } 05617 } 05618 } 05619 05620 fprintf(out_file, "\n"); 05621 05622 if (dump_all) { 05623 05624 /* Note that the output_attr flag is set to FALSE because it */ 05625 /* produces quite a bit of output. The code is left in in case */ 05626 /* we find in future debugging sessions that also dumping the */ 05627 /* Attribute entry for the Secondary Name table item would be */ 05628 /* useful. */ 05629 05630 if (ATP_PGM_UNIT(at_idx) <= Subroutine) { 05631 05632 if (ATP_RSLT_IDX(at_idx) != NULL_IDX) { 05633 fprintf(out_file, "\n"); 05634 dump_at_ntry (out_file, ATP_RSLT_IDX(at_idx), dump_all); 05635 } 05636 05637 if (ATP_FIRST_IDX(at_idx) != NULL_IDX) { 05638 loop_thru_sn_ntries(out_file, at_idx, FALSE); 05639 } 05640 } 05641 } 05642 05643 break; 05644 05645 case Label: 05646 fprintf(out_file, " %-25s %-16s= %-7s %-16s= %-8s\n", 05647 atl_class_str[ATL_CLASS(at_idx)], 05648 "ATL_ALIGN", boolean_str[ATL_ALIGN(at_idx)], 05649 "ATL_AGGRESSIVEIN", 05650 boolean_str[ATL_AGGRESSIVEINNERLOOPFISSION(at_idx)]); 05651 05652 05653 if (ATL_CLASS(at_idx) <= Lbl_User) { 05654 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8d\n", 05655 "ATL_ASG_LBL_CHAI",ATL_ASG_LBL_CHAIN_START(at_idx), 05656 "ATL_BL", boolean_str[ATL_BL(at_idx)], 05657 "ATL_BLK_STMT_IDX", ATL_BLK_STMT_IDX(at_idx)); 05658 05659 fprintf(out_file, " %-16s= %-7s %-16s= %-7d\n", 05660 "ATL_CASE_LABEL", boolean_str[ATL_CASE_LABEL(at_idx)], 05661 "ATL_CMIC_BLK_STM", ATL_CMIC_BLK_STMT_IDX(at_idx)); 05662 } 05663 else { 05664 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 05665 "ATL_ASG_LBL_CHAI",ATL_ASG_LBL_CHAIN_START(at_idx), 05666 "ATL_BL", boolean_str[ATL_BL(at_idx)], 05667 "ATL_CASE_LABEL", boolean_str[ATL_CASE_LABEL(at_idx)]); 05668 } 05669 05670 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05671 "ATL_CNCALL", boolean_str[ATL_CNCALL(at_idx)], 05672 "ATL_CONSTRUCTOR_", boolean_str[ATL_CONSTRUCTOR_LOOP(at_idx)], 05673 "ATL_CYCLE_LBL", boolean_str[ATL_CYCLE_LBL(at_idx)]); 05674 05675 fprintf(out_file, " %-16s= %-33s %-16s= %-8d\n", 05676 "ATL_DEBUG_CLASS", atl_debug_class_str[ATL_DEBUG_CLASS(at_idx)], 05677 "ATL_DIRECTIVE_LI", ATL_DIRECTIVE_LIST(at_idx)); 05678 05679 if (ATL_DIRECTIVE_LIST(at_idx) != NULL_IDX) { 05680 il_idx = IL_IDX(ATL_DIRECTIVE_LIST(at_idx)) + Safevl_Dir_Idx; 05681 05682 fprintf(out_file, " %-16s= %-7s", "safevl", 05683 (IL_FLD(il_idx) == CN_Tbl_Idx) ? convert_to_string( 05684 &CN_CONST(IL_IDX(il_idx)), 05685 CN_TYPE_IDX(IL_IDX(il_idx)), 05686 conv_str) : "0"); 05687 05688 il_idx = IL_IDX(ATL_DIRECTIVE_LIST(at_idx)) + Unroll_Dir_Idx; 05689 05690 fprintf(out_file, " %-16s= %-7s", "unroll", 05691 (IL_FLD(il_idx) == CN_Tbl_Idx) ? convert_to_string( 05692 &CN_CONST(IL_IDX(il_idx)), 05693 CN_TYPE_IDX(IL_IDX(il_idx)), 05694 conv_str) : "0"); 05695 05696 il_idx = IL_IDX(ATL_DIRECTIVE_LIST(at_idx)) + Mark_Dir_Idx; 05697 05698 fprintf(out_file, " %-16s= %-s\n", "mark", 05699 (IL_FLD(il_idx) == CN_Tbl_Idx) ? 05700 (char *) &CN_CONST(IL_IDX(il_idx)) : " "); 05701 05702 il_idx = IL_IDX(ATL_DIRECTIVE_LIST(at_idx)) + Maxcpus_Dir_Idx; 05703 05704 fprintf(out_file, " %-16s= %-7d %-16s= %-25s\n", 05705 "maxcpus idx", IL_IDX(il_idx), 05706 "maxcpus fld", field_str[IL_FLD(il_idx)]); 05707 05708 il_idx = IL_IDX(ATL_DIRECTIVE_LIST(at_idx)) + Cache_Bypass_Dir_Idx; 05709 05710 if (IL_FLD(il_idx) == IL_Tbl_Idx) { /* Cache bypass */ 05711 il_idx = IL_IDX(il_idx); 05712 05713 while (il_idx != NULL_IDX) { 05714 fprintf(out_file, " %-16s= %-25s \n", 05715 "cache_bypass", AT_OBJ_NAME_PTR(IL_IDX(il_idx))); 05716 il_idx = IL_NEXT_LIST_IDX(il_idx); 05717 } 05718 } 05719 } 05720 05721 if (AT_DEFINED(at_idx)) { 05722 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 05723 "ATL_DEF_STMT_IDX", ATL_DEF_STMT_IDX(at_idx), 05724 "ATL_EXECUTABLE", boolean_str[ATL_EXECUTABLE(at_idx)], 05725 "ATL_FISSIONABLE", boolean_str[ATL_FISSIONABLE(at_idx)]); 05726 } 05727 else { 05728 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8s\n", 05729 "ATL_EXECUTABLE", boolean_str[ATL_EXECUTABLE(at_idx)], 05730 "ATL_FWD_REF_IDX", ATL_FWD_REF_IDX(at_idx), 05731 "ATL_FISSIONABLE", boolean_str[ATL_FISSIONABLE(at_idx)]); 05732 } 05733 05734 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-7s\n", 05735 "ATL_FUSABLE", boolean_str[ATL_FUSABLE(at_idx)], 05736 "ATL_FUSION", boolean_str[ATL_FUSION(at_idx)], 05737 "ATL_IN_ASSIGN", boolean_str[ATL_IN_ASSIGN(at_idx)]); 05738 05739 if (ATL_CLASS(at_idx) == Lbl_Format) { 05740 05741 if (ATL_FORMAT_TMP(at_idx) == NULL_IDX) { 05742 fprintf(out_file," %-16s= %-7d\n", 05743 "ATL_FORMAT_TM", ATL_FORMAT_TMP(at_idx)); 05744 } 05745 else { 05746 fprintf(out_file," %-16s= %-7d %-16s= \"%s\"\n\n", 05747 "ATL_FORMAT_TM", ATL_FORMAT_TMP(at_idx), 05748 "FORMAT CONSTANT", 05749 (char *)&CN_CONST(ATD_TMP_IDX(ATL_FORMAT_TMP(at_idx)))); 05750 } 05751 } 05752 05753 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05754 "ATL_IN_ASSIGN_LB",boolean_str[ATL_IN_ASSIGN_LBL_CHAIN(at_idx)], 05755 "ATL_INFORM_ONLY",boolean_str[ATL_INFORM_ONLY(at_idx)], 05756 "ATL_IVDEP",boolean_str[ATL_IVDEP(at_idx)]); 05757 05758 if (ATL_CLASS(at_idx) == Lbl_Internal) { 05759 fprintf(out_file, " %-16s= %-7d\n", 05760 "ATL_NEW_LBL_IDX", ATL_NEW_LBL_IDX(at_idx)); 05761 } 05762 05763 fprintf(out_file, " %-16s= %-7s %-16s %-7d %-16s= %-8s\n", 05764 "ATL_MAXCPUS",boolean_str[ATL_MAXCPUS(at_idx)], 05765 "ATL_NEXT_ASG_LBL", ATL_NEXT_ASG_LBL_IDX(at_idx), 05766 "ATL_NEXTSCALAR", boolean_str[ATL_NEXTSCALAR(at_idx)]); 05767 05768 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05769 "ATL_NOBLOCKING", boolean_str[ATL_NOBLOCKING(at_idx)], 05770 "ATL_NOFISSION", boolean_str[ATL_NOFISSION(at_idx)], 05771 "ATL_NOFUSION", boolean_str[ATL_NOFUSION(at_idx)]); 05772 05773 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05774 "ATL_NOINTERCHANG", boolean_str[ATL_NOINTERCHANGE(at_idx)], 05775 "ATL_NORECURRENCE", boolean_str[ATL_NORECURRENCE(at_idx)], 05776 "ATL_NOTASK",boolean_str[ATL_NOTASK(at_idx)]); 05777 05778 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05779 "ATL_NOVECTOR", boolean_str[ATL_NOVECTOR(at_idx)], 05780 "ATL_NOVSEARCH", boolean_str[ATL_NOVSEARCH(at_idx)], 05781 "ATL_PATTERN", boolean_str[ATL_PATTERN(at_idx)]); 05782 05783 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05784 "ATL_PERMUTATION", boolean_str[ATL_PERMUTATION(at_idx)], 05785 "ATL_PREFERSTREAM", boolean_str[ATL_PREFERSTREAM(at_idx)], 05786 "ATL_PREFER_NOCIN", boolean_str[ATL_PREFERSTREAM_NOCINV(at_idx)]); 05787 05788 fprintf(out_file, " %-16s= %-7s %-16s= %-7s\n", 05789 "ATL_PREFERTASK", boolean_str[ATL_PREFERTASK(at_idx)], 05790 "ATL_PREFERVECTOR", boolean_str[ATL_PREFERVECTOR(at_idx)]); 05791 05792 if (ATL_CLASS(at_idx) == Lbl_Format) { 05793 fprintf(out_file, " %-16s= %-7d\n", 05794 "ATL_PP_FORMAT_TM", ATL_PP_FORMAT_TMP(at_idx)); 05795 } 05796 05797 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05798 "ATL_SHORTLOOP", boolean_str[ATL_SHORTLOOP(at_idx)], 05799 "ATL_SHORTLOOP128", boolean_str[ATL_SHORTLOOP128(at_idx)], 05800 "ATL_SPLIT", boolean_str[ATL_SPLIT(at_idx)]); 05801 05802 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05803 "ATL_STREAM",boolean_str[ATL_STREAM(at_idx)], 05804 "ATL_TOP_OF_LOOP", boolean_str[ATL_TOP_OF_LOOP(at_idx)], 05805 "ATL_UNROLL_DIR", boolean_str[ATL_UNROLL_DIR(at_idx)]); 05806 05807 break; 05808 05809 case Derived_Type: 05810 05811 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05812 "ATT_CHAR_CPNT", boolean_str[ATT_CHAR_CPNT(at_idx)], 05813 "ATT_CHAR_SEQ", boolean_str[ATT_CHAR_SEQ(at_idx)], 05814 "ATT_ALIGNMENT", align_str[ATT_ALIGNMENT(at_idx)]); 05815 05816 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 05817 "ATT_CIF_DT_ID", ATT_CIF_DT_ID(at_idx), 05818 "ATT_DALIGN_ME", boolean_str[ATT_DALIGN_ME(at_idx)], 05819 "ATT_DCL_NUMERIC_", boolean_str[ATT_DCL_NUMERIC_SEQ(at_idx)]); 05820 05821 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8d\n", 05822 "ATT_DEFAULT_INIT", boolean_str[ATT_DEFAULT_INITIALIZED(at_idx)], 05823 "ATT_FIRST_CPNT_I", ATT_FIRST_CPNT_IDX(at_idx), 05824 "ATT_GLOBAL_TYPE_", ATT_GLOBAL_TYPE_IDX(at_idx)); 05825 05826 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8d\n", 05827 "ATT_LABEL_LIST_I", ATT_LABEL_LIST_IDX(at_idx), 05828 "ATT_NON_DEFAULT_", boolean_str[ATT_NON_DEFAULT_CPNT(at_idx)], 05829 "ATT_NUM_CPNTS", ATT_NUM_CPNTS(at_idx)); 05830 05831 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05832 "ATT_NUMERIC_CPNT", boolean_str[ATT_NUMERIC_CPNT(at_idx)], 05833 "ATT_POINTER_CPNT", boolean_str[ATT_POINTER_CPNT(at_idx)], 05834 "ATT_PRIVATE_CPNT", boolean_str[ATT_PRIVATE_CPNT(at_idx)]); 05835 05836 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8d\n", 05837 "ATT_SCP_IDX", ATT_SCP_IDX(at_idx), 05838 "ATT_SEQUENCE_SET", boolean_str[ATT_SEQUENCE_SET(at_idx)], 05839 "ATT_UNIQUE_ID", ATT_UNIQUE_ID(at_idx)); 05840 05841 if (ATT_STRUCT_BIT_LEN_IDX(at_idx) != NULL_IDX) { 05842 sprintf(str, "(%10s)", 05843 convert_to_string(&CN_CONST(ATT_STRUCT_BIT_LEN_IDX(at_idx)), 05844 CN_TYPE_IDX(ATT_STRUCT_BIT_LEN_IDX(at_idx)), 05845 conv_str)); 05846 } 05847 else { 05848 sprintf(str,"%12s", " "); 05849 } 05850 05851 fprintf(out_file, " %-16s= %-7d %-25s %-26s\n", 05852 "ATT_STRUCT_SIZE", ATT_STRUCT_BIT_LEN_IDX(at_idx), 05853 field_str[CN_Tbl_Idx], 05854 str); 05855 05856 /* Note that the output_attr flag is set to FALSE because it */ 05857 /* produces quite a bit of output. The code is left in in */ 05858 /* case we find in future debugging sessions that also dumping */ 05859 /* the Attribute entry for the Secondary Name table item */ 05860 /* would be useful. */ 05861 05862 if (dump_all) { 05863 chain_thru_sn_ntries(out_file, at_idx, FALSE); 05864 } 05865 05866 break; 05867 05868 05869 case Interface: 05870 05871 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 05872 "ATI_CIF_SCOPE_ID", ATI_CIF_SCOPE_ID(at_idx), 05873 "ATI_CIF_SEEN_IN_", boolean_str[ATI_CIF_SEEN_IN_CALL(at_idx)], 05874 "ATI_DCL_INTRINSI", boolean_str[ATI_DCL_INTRINSIC(at_idx)]); 05875 05876 fprintf(out_file, " %-16s= %-33s %-16s= %-8d\n", 05877 "ATI_DEFINED_OPR", operator_str[ATI_DEFINED_OPR(at_idx)], 05878 "ATI_FIRST_SPECIF", ATI_FIRST_SPECIFIC_IDX(at_idx)); 05879 05880 fprintf(out_file, " %-16s= %-7s %-16s= %-33s\n", 05881 "ATI_HAS_NON_MOD_", boolean_str[ATI_HAS_NON_MOD_PROC(at_idx)], 05882 "ATI_INTERFACE_CL", interface_str[ATI_INTERFACE_CLASS(at_idx)]); 05883 05884 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05885 "ATI_INLINE_ALWAY",boolean_str[ATI_INLINE_ALWAYS(at_idx)], 05886 "ATI_INLINE_NEVER",boolean_str[ATI_INLINE_NEVER(at_idx)], 05887 "ATI_INTRIN_PASSA", boolean_str[ATI_INTRIN_PASSABLE(at_idx)]); 05888 05889 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8d\n", 05890 "ATI_INTRIN_TBL_I", ATI_INTRIN_TBL_IDX(at_idx), 05891 "ATI_IPA_DIR_SPEC",boolean_str[ATI_IPA_DIR_SPECIFIED(at_idx)], 05892 "ATI_NUM_SPECIFIC", ATI_NUM_SPECIFICS(at_idx)); 05893 05894 fprintf(out_file, " %-16s= %-7s %-16s= %-7d\n", 05895 "ATI_GENERIC_INT", boolean_str[ATI_GENERIC_INTRINSIC(at_idx)], 05896 "ATI_PROC_IDX", ATI_PROC_IDX(at_idx)); 05897 05898 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 05899 "ATI_UNNAMED_INTE", boolean_str[ATI_UNNAMED_INTERFACE(at_idx)], 05900 "ATI_SGI_RTN_INLI", boolean_str[ATI_SGI_ROUTINE_INLINE(at_idx)], 05901 "ATI_SGI_RTN_NOIN", boolean_str[ATI_SGI_ROUTINE_NOINLINE(at_idx)]); 05902 05903 if (ATD_TYPE_IDX(at_idx) != NULL_IDX) { 05904 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-s\n", 05905 "ATI_USER_SPECIFI", boolean_str[ATI_USER_SPECIFIED(at_idx)], 05906 "ATD_TYPE_IDX", ATD_TYPE_IDX(at_idx), 05907 print_type_f(ATD_TYPE_IDX(at_idx))); 05908 } 05909 else { 05910 fprintf(out_file, " %-16s= %-7s %-16s= %-7d\n", 05911 "ATI_USER_SPECIFI", boolean_str[ATI_USER_SPECIFIED(at_idx)], 05912 "ATD_TYPE_IDX", ATD_TYPE_IDX(at_idx)); 05913 } 05914 05915 if (ATI_PROC_IDX(at_idx) != NULL_IDX) { 05916 fprintf(out_file, "\n"); 05917 dump_at_ntry(out_file, ATI_PROC_IDX(at_idx), dump_all); 05918 } 05919 05920 /* Note that the output_attr flag is set to FALSE because it */ 05921 /* produces quite a bit of output. The code is left in in */ 05922 /* case we find in future debugging sessions that also dumping */ 05923 /* the Attribute entry for the Secondary Name table item would */ 05924 /* be useful. */ 05925 05926 if (dump_all) { 05927 chain_thru_sn_ntries(out_file, at_idx, FALSE); 05928 } 05929 05930 break; 05931 05932 05933 case Namelist_Grp: 05934 05935 fprintf(out_file, " %-16s= %-7d %-16s= %-7d %-16s= %-8d\n", 05936 "ATN_FIRST_NAMELI", ATN_FIRST_NAMELIST_IDX(at_idx), 05937 "ATN_LAST_NAMELIS", ATN_LAST_NAMELIST_IDX(at_idx), 05938 "ATN_NUM_NAMELIST", ATN_NUM_NAMELIST(at_idx)); 05939 05940 fprintf(out_file, " %-16s= %-7d (%-s)\n", 05941 "ATN_NAMELIST_DES", ATN_NAMELIST_DESC(at_idx), 05942 ((ATN_NAMELIST_DESC(at_idx) == NULL_IDX) ? " " : 05943 AT_OBJ_NAME_PTR(ATN_NAMELIST_DESC(at_idx)))); 05944 05945 05946 /* Note that the output_attr flag is set to FALSE because it */ 05947 /* produces quite a bit of output. The code is left in in */ 05948 /* case we find in future debugging sessions that also dumping */ 05949 /* the Attribute entry for the Secondary Name table item would */ 05950 /* be useful. */ 05951 05952 if (dump_all) { 05953 chain_thru_sn_ntries(out_file, at_idx, FALSE); 05954 } 05955 break; 05956 05957 05958 case Stmt_Func: 05959 05960 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-s\n", 05961 "ATS_SF_ACTIVE", boolean_str[ATS_SF_ACTIVE(at_idx)], 05962 "ATP_FIRST_IDX", ATP_FIRST_IDX(at_idx), 05963 field_str[ATS_SF_FLD(at_idx)]); 05964 05965 fprintf(out_file, " %-16s= %-7d %-16s= %-7d %-16s= %-8s\n", 05966 "ATS_SF_IDX", ATS_SF_IDX(at_idx), 05967 "ATP_NUM_DARGS", ATP_NUM_DARGS(at_idx), 05968 "ATS_SF_SEMANTICS", boolean_str[ATS_SF_SEMANTICS_DONE(at_idx)]); 05969 05970 fprintf(out_file, " %-16s= %-7d %-s\n", 05971 "ATD_TYPE_IDX", ATD_TYPE_IDX(at_idx), 05972 print_type_f(ATD_TYPE_IDX(at_idx))); 05973 05974 if (dump_all && ATP_FIRST_IDX(at_idx) != NULL_IDX) { 05975 loop_thru_sn_ntries(out_file, at_idx, FALSE); 05976 } 05977 05978 if (ATS_SF_FLD(at_idx) == IR_Tbl_Idx) { 05979 dump_ir_ntry(out_file, ATS_SF_IDX(at_idx), 5); 05980 } 05981 05982 break; 05983 05984 } /* End switch */ 05985 05986 putc ('\n', out_file); 05987 fflush (out_file); 05988 05989 return; 05990 05991 } /* dump_at_ntry */ 05992 05993 /******************************************************************************\ 05994 |* *| 05995 |* Description: *| 05996 |* Prints one bounds table entry to the specified output file. *| 05997 |* *| 05998 |* Input parameters: *| 05999 |* FILE to print to - Should be debug_file, stderr, or stdout. *| 06000 |* Index of bounds entry to print. *| 06001 |* *| 06002 |* Output parameters: *| 06003 |* NONE *| 06004 |* *| 06005 |* Returns: *| 06006 |* NOTHING *| 06007 |* *| 06008 \******************************************************************************/ 06009 06010 static void dump_bd_ntry (FILE *out_file, 06011 int bd_idx) 06012 06013 { 06014 int i; 06015 06016 06017 if (bd_idx > bounds_tbl_idx) { 06018 fprintf(out_file, "\n*FE90-ERROR* BD index value [%d] is out of range.\n", 06019 bd_idx); 06020 goto EXIT; 06021 } 06022 06023 if (BD_DIST_NTRY(bd_idx)) { 06024 fprintf(out_file, " %-16s= %-7d %-16s= %-7d %-16s= %-8s\n", 06025 "BD_RANK", BD_RANK(bd_idx), 06026 "BD_COLUMN_NUM", BD_COLUMN_NUM(bd_idx), 06027 "BD_DISTRIBUTE_RE", 06028 boolean_str[BD_DISTRIBUTE_RESHAPE(bd_idx)]); 06029 06030 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8d\n", 06031 "BD_LINE_NUM", BD_LINE_NUM(bd_idx), 06032 "BD_RESOLVED", boolean_str[BD_RESOLVED(bd_idx)], 06033 "IDX", bd_idx); 06034 06035 for (i = 1; i <= BD_RANK(bd_idx); i++) { 06036 fprintf(out_file, " %-16s= %-7d %-16s= %-25s\n", 06037 "Dimension", i, 06038 "Distribution", 06039 distribution_str[BD_DISTRIBUTION(bd_idx,i)]); 06040 06041 if (BD_CYCLIC_FLD(bd_idx, i) != NO_Tbl_Idx) { 06042 print_fld_idx(out_file, 06043 " BD_CYCLIC_IDX", 06044 BD_CYCLIC_FLD(bd_idx, i), 06045 BD_CYCLIC_IDX(bd_idx, i)); 06046 } 06047 06048 if (BD_ONTO_FLD(bd_idx, i) != NO_Tbl_Idx) { 06049 print_fld_idx(out_file, 06050 " BD_ONTO_IDX", 06051 BD_ONTO_FLD(bd_idx, i), 06052 BD_ONTO_IDX(bd_idx, i)); 06053 } 06054 } 06055 goto EXIT; 06056 } 06057 06058 if (!BD_USED_NTRY(bd_idx)) { 06059 fprintf(out_file, " %-16s= %-7d %-16s= %-7d %-16s= %-8d\n", 06060 "IDX", bd_idx, 06061 "BD_NEXT_FREE_NTR", BD_NEXT_FREE_NTRY(bd_idx), 06062 "BD_NTRY_SIZE", BD_NTRY_SIZE(bd_idx)); 06063 goto EXIT; 06064 } 06065 06066 fprintf(out_file, " %-16s= %-7d %-25s %-26s\n", 06067 "BD_RANK", BD_RANK(bd_idx), 06068 bd_array_class_str[BD_ARRAY_CLASS(bd_idx)], 06069 bd_array_size_str[BD_ARRAY_SIZE(bd_idx)]); 06070 06071 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8d\n", 06072 "BD_COLUMN_NUM", BD_COLUMN_NUM(bd_idx), 06073 "BD_DCL_ERR", boolean_str[BD_DCL_ERR(bd_idx)], 06074 "BD_GLOBAL_IDX", BD_GLOBAL_IDX(bd_idx)); 06075 06076 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8d\n", 06077 "BD_LINE_NUM", BD_LINE_NUM(bd_idx), 06078 "BD_RESOLVED", boolean_str[BD_RESOLVED(bd_idx)], 06079 "IDX", bd_idx); 06080 06081 print_fld_idx(out_file, "BD_LEN_IDX", 06082 BD_LEN_FLD(bd_idx), 06083 BD_LEN_IDX(bd_idx)); 06084 06085 if (BD_ARRAY_CLASS(bd_idx) != Deferred_Shape) { 06086 06087 for (i = 1; i <= BD_RANK(bd_idx); i++) { 06088 fprintf(out_file, " %-16s= %-7d\n", "Dimension", i); 06089 06090 print_fld_idx(out_file, 06091 " BD_LB_IDX", 06092 BD_LB_FLD(bd_idx, i), 06093 BD_LB_IDX(bd_idx, i)); 06094 06095 print_fld_idx(out_file, 06096 " BD_UB_IDX", 06097 BD_UB_FLD(bd_idx, i), 06098 BD_UB_IDX(bd_idx, i)); 06099 06100 print_fld_idx(out_file, 06101 " BD_XT_IDX", 06102 BD_XT_FLD(bd_idx, i), 06103 BD_XT_IDX(bd_idx, i)); 06104 06105 print_fld_idx(out_file, 06106 " BD_SM_IDX", 06107 BD_SM_FLD(bd_idx, i), 06108 BD_SM_IDX(bd_idx, i)); 06109 } 06110 } 06111 06112 EXIT: 06113 06114 putc ('\n', out_file); 06115 06116 fflush (out_file); 06117 return; 06118 06119 } /* dump_bd_ntry */ 06120 06121 06122 /******************************************************************************\ 06123 |* *| 06124 |* Description: *| 06125 |* Prints the actual block entry. *| 06126 |* *| 06127 |* Input parameters: *| 06128 |* File to print entry to. *| 06129 |* Index of block entry to print. *| 06130 |* *| 06131 |* Output parameters: *| 06132 |* NONE *| 06133 |* *| 06134 |* Returns: *| 06135 |* NOTHING *| 06136 |* *| 06137 \******************************************************************************/ 06138 06139 static void dump_blk_ntry(FILE *out_file, 06140 int blk_idx) 06141 { 06142 06143 /* Sometimes when debugging, you really want to print a Block Stack */ 06144 /* entry that's been popped. But print a warning in case that's not what */ 06145 /* was intended. */ 06146 06147 if (blk_idx > blk_stk_idx) { 06148 fprintf(stderr, 06149 "\n*FE90-WARNING* Blk index value [%d] is out of range.\n", 06150 blk_idx); 06151 } 06152 06153 06154 fprintf(out_file,"\n%-32.32s ", blk_struct_str[BLK_TYPE(blk_idx)]); 06155 fprintf(out_file,"%-8s= %-7d", "IDX", blk_idx); 06156 06157 if (blk_idx == blk_stk_idx) { 06158 fprintf(out_file,"%4s%-20.20s\n", " ", "CURRENT BLOCK"); 06159 fprintf(out_file,"%4s%-19s= %-27s\n", " ", "curr_stmt_category", 06160 context_str[curr_stmt_category]); 06161 } 06162 else { 06163 fprintf(out_file,"\n"); 06164 } 06165 06166 if (BLK_NAME(blk_idx) != NULL_IDX) { 06167 fprintf(out_file,"%4s%-19s= (%d) %-32.32s\n", " ", 06168 "BLK_NAME", BLK_NAME(blk_idx),AT_OBJ_NAME_PTR(BLK_NAME(blk_idx))); 06169 } 06170 06171 fprintf(out_file, "%4s%-19s= %-29d %-16s= %-7d\n", " ", 06172 "BLK_DEF_LINE", BLK_DEF_LINE(blk_idx), 06173 "BLK_DEF_COLUMN", BLK_DEF_COLUMN(blk_idx)); 06174 06175 fprintf(out_file, "%4s%-19s= %-29d %-16s= %-7d\n", " ", 06176 "BLK_FIRST_SH_IDX", BLK_FIRST_SH_IDX(blk_idx), 06177 "BLK_LABEL", BLK_LABEL(blk_idx)); 06178 06179 fprintf(out_file, "%4s%-19s= %s %-16s= %s %-16s= %s\n", " ", 06180 "BLK_ERR", boolean_str[BLK_ERR(blk_idx)], 06181 "BLK_FND_DEFAULT", boolean_str[BLK_FND_DEFAULT(blk_idx)], 06182 "BLK_NO_EXEC", boolean_str[BLK_NO_EXEC(blk_idx)]); 06183 06184 if (BLK_TYPE(blk_idx) == Do_Blk) { 06185 06186 if (BLK_DO_TYPE(blk_idx) == Iterative_Loop) { 06187 fprintf(out_file, "%4sDO-var: Line= %-7d Col= %-3d Fld= %-10s\n", 06188 " ", 06189 BLK_DO_VAR_LINE_NUM(blk_idx), 06190 BLK_DO_VAR_COL_NUM(blk_idx), 06191 field_str[BLK_DO_VAR_FLD(blk_idx)]); 06192 06193 print_attr_name(out_file, BLK_DO_VAR_IDX(blk_idx), 4); 06194 } 06195 else if (BLK_DO_TYPE(blk_idx) == While_Loop) { 06196 fprintf(out_file, "%4sWHILE expr: Line= %-7d Col= %-3d Fld= %-10s", 06197 " ", 06198 BLK_DO_VAR_LINE_NUM(blk_idx), 06199 BLK_DO_VAR_COL_NUM(blk_idx), 06200 field_str[BLK_DO_VAR_FLD(blk_idx)]); 06201 06202 if (BLK_DO_VAR_FLD(blk_idx) == AT_Tbl_Idx) { 06203 fputc('\n', out_file); 06204 print_attr_name(out_file, BLK_DO_VAR_IDX(blk_idx), 4); 06205 } 06206 else { 06207 fprintf(out_file, " Idx= %d\n", BLK_DO_VAR_IDX(blk_idx)); 06208 } 06209 } 06210 06211 fprintf(out_file, "%4s%-18s= %-27s %-16s= %-7d\n", " ", 06212 "BLK_DO_TYPE", do_type_str[BLK_DO_TYPE(blk_idx)], 06213 "BLK_LOOP_NUM", BLK_LOOP_NUM(blk_idx)); 06214 06215 fprintf(out_file, "%4s%-18s= %-27s %-16s= %s\n", " ", 06216 "BLK_CYCLE_STMT", boolean_str[BLK_CYCLE_STMT(blk_idx)], 06217 "BLK_EXIT_STMT", boolean_str[BLK_EXIT_STMT(blk_idx)]); 06218 06219 fprintf(out_file, "%4s%-18s= %-27d %-16s= %-12d\n", " ", 06220 "BLK_TOP_LBL_IDX", BLK_TOP_LBL_IDX(blk_idx), 06221 "BLK_SKIP_LBL_IDX", BLK_SKIP_LBL_IDX(blk_idx)); 06222 06223 fprintf(out_file, "%4s%-19s= %s\n", " ", 06224 "BLK_IS_PARALLEL_REG", 06225 boolean_str[BLK_IS_PARALLEL_REGION(blk_idx)]); 06226 06227 if (BLK_DO_TYPE(blk_idx) == Iterative_Loop) { 06228 fprintf(out_file, "%4s%-18s= %-27d %-16s= %-12d\n", " ", 06229 "BLK_START_TEMP_IDX", BLK_START_TEMP_IDX(blk_idx), 06230 "BLK_INC_TEMP_IDX", BLK_INC_TEMP_IDX(blk_idx)); 06231 06232 fprintf(out_file, "%4s%-18s= %-27d %-16s= %-12d\n", " ", 06233 "BLK_INDUC_TEMP_IDX", BLK_INDUC_TEMP_IDX(blk_idx), 06234 "BLK_TC_TEMP_IDX", BLK_TC_TEMP_IDX(blk_idx)); 06235 06236 fprintf(out_file, "%4s%-26s= %-14s %-24s= %-9s\n", " ", 06237 "BLK_HAS_NESTED_LOOP", 06238 boolean_str[BLK_HAS_NESTED_LOOP(blk_idx)], 06239 "BLK_BLOCKABLE_NEST_OK ", 06240 boolean_str[BLK_BLOCKABLE_NEST_OK(blk_idx)]); 06241 06242 fprintf(out_file, "%4s%-26s= %-14d %-24s= %-9d\n", " ", 06243 "BLK_BLOCKABLE_DIR_SH_IDX", 06244 BLK_BLOCKABLE_DIR_SH_IDX(blk_idx), 06245 "BLK_BLOCKABLE_NUM_LCVS", 06246 BLK_BLOCKABLE_NUM_LCVS(blk_idx)); 06247 06248 fprintf(out_file, "%4s%-26s= %-14d %-24s= %-9d\n", " ", 06249 "BLK_INTERCHANGE_DIR_SH_IDX", 06250 BLK_INTERCHANGE_DIR_SH_IDX(blk_idx), 06251 "BLK_INTERCHANGE_NUM_LCVS", 06252 BLK_INTERCHANGE_NUM_LCVS(blk_idx)); 06253 06254 fprintf(out_file, "%4s%-26s= %-14d %-24s= %-9d\n", " ", 06255 "BLK_DIR_NEST_CHECK_SH_IDX", 06256 BLK_DIR_NEST_CHECK_SH_IDX(blk_idx), 06257 "BLK_DIR_NEST_CHECK_NUM_LCVS", 06258 BLK_DIR_NEST_CHECK_NUM_LCVS(blk_idx)); 06259 } 06260 } 06261 else if (BLK_TYPE(blk_idx) == Select_Blk) { 06262 fprintf(out_file, "%4s%-19s= %-29d\n", " ", 06263 "BLK_NUM_CASES", BLK_NUM_CASES(blk_idx)); 06264 06265 fprintf(out_file, "%4s%s%-9d %s%-3d %s %s%-7d\n", " ", 06266 "BLK_CASE_DEFAULT_LBL_OPND: line = ", 06267 BLK_CASE_DEFAULT_LBL_LINE_NUM(blk_idx), 06268 "col = ", BLK_CASE_DEFAULT_LBL_COL_NUM(blk_idx), 06269 field_str[BLK_CASE_DEFAULT_LBL_FLD(blk_idx)], 06270 "idx = ", BLK_CASE_DEFAULT_LBL_IDX(blk_idx)); 06271 } 06272 else if (cif_flags & BASIC_RECS) { 06273 fprintf(out_file, "%4s%-19s= %d\n", " ", 06274 "BLK_CIF_SCOPE_ID", BLK_CIF_SCOPE_ID(blk_idx)); 06275 } 06276 06277 if (BLK_TYPE(blk_idx) == Derived_Type_Blk) { 06278 fprintf(out_file, "%4s%-18s= %-27d \n", " ", 06279 "BLK_LAST_CPNT_IDX", BLK_LAST_CPNT_IDX(blk_idx)); 06280 } 06281 else if (BLK_TYPE(blk_idx) == Interface_Body_Blk) { 06282 fprintf(out_file, "%4s%-18s= %-27d %-16s= %-12d\n", " ", 06283 "BLK_AT_IDX", BLK_AT_IDX(blk_idx), 06284 "BLK_BD_IDX", BLK_BD_IDX(blk_idx)); 06285 fprintf(out_file, "%4s%-18s= %-27d %-16s= %-12d\n", " ", 06286 "BLK_CN_IDX", BLK_CN_IDX(blk_idx), 06287 "BLK_CP_IDX", BLK_CP_IDX(blk_idx)); 06288 fprintf(out_file, "%4s%-18s= %-27d %-16s= %-12d\n", " ", 06289 "BLK_NP_IDX", BLK_NP_IDX(blk_idx), 06290 "BLK_SB_IDX", BLK_SB_IDX(blk_idx)); 06291 fprintf(out_file, "%4s%-18s= %-27d %-16s= %-12d\n", " ", 06292 "BLK_SN_IDX", BLK_SN_IDX(blk_idx), 06293 "BLK_TYP_IDX", BLK_TYP_IDX(blk_idx)); 06294 } 06295 06296 fflush (out_file); 06297 06298 return; 06299 06300 } /* dump_blk_ntry */ 06301 06302 06303 /******************************************************************************\ 06304 |* *| 06305 |* Description: *| 06306 |* Prints one constant table entry to the specified output file. *| 06307 |* *| 06308 |* Input parameters: *| 06309 |* FILE to print to - Should be debug_file, stderr, or stdout. *| 06310 |* Index of constant entry to print. *| 06311 |* *| 06312 |* Output parameters: *| 06313 |* NONE *| 06314 |* *| 06315 |* Returns: *| 06316 |* NOTHING *| 06317 |* *| 06318 \******************************************************************************/ 06319 06320 static void dump_cn_ntry (FILE *out_file, 06321 int cn_idx) 06322 06323 { 06324 int type_idx; 06325 06326 06327 if (cn_idx > const_tbl_idx) { 06328 fprintf(out_file, "\n*FE90-ERROR* CN index value [%d] is out of range.\n", 06329 cn_idx); 06330 return; 06331 } 06332 06333 type_idx = CN_TYPE_IDX(cn_idx); 06334 06335 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8d\n", 06336 "CN_BOOLEAN_CONST", boolean_str[CN_BOOLEAN_CONSTANT(cn_idx)], 06337 "CN_BOZ_CONSTANT", boolean_str[CN_BOZ_CONSTANT(cn_idx)], 06338 "IDX", cn_idx); 06339 06340 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s\n", 06341 "CN_EXTRA_ZERO_WO", boolean_str[CN_EXTRA_ZERO_WORD(cn_idx)], 06342 "CN_POOL_IDX", CN_POOL_IDX(cn_idx), 06343 cn_hollerith_str[CN_HOLLERITH_ENDIAN(cn_idx)]); 06344 06345 # if defined(_TARGET_LITTLE_ENDIAN) 06346 fprintf(out_file, " %-16s= %-2s\n", 06347 "CN_HOLLERITH_END", boolean_str[CN_HOLLERITH_ENDIAN(cn_idx)]); 06348 # endif 06349 06350 fprintf(out_file, " %s%d] = %-s\n", 06351 "CN_TYPE_IDX[", CN_TYPE_IDX(cn_idx), 06352 print_type_f(type_idx)); 06353 06354 /* The old call was dump_typ_ntry(out_file, type_idx); */ 06355 06356 print_const_f(out_file, cn_idx); 06357 fprintf(out_file, "\n\n"); 06358 fflush (out_file); 06359 06360 return; 06361 06362 } /* dump_cn_ntry */ 06363 06364 /******************************************************************************\ 06365 |* *| 06366 |* Description: *| 06367 |* Prints a single Equivalence table entry. *| 06368 |* *| 06369 |* Input parameters: *| 06370 |* Index of Equivalence table entry to print. *| 06371 |* *| 06372 |* Output parameters: *| 06373 |* NONE *| 06374 |* *| 06375 |* Returns: *| 06376 |* NOTHING *| 06377 |* *| 06378 \******************************************************************************/ 06379 06380 static void dump_eq_ntry (FILE *out_file, 06381 int eq_idx) 06382 06383 { 06384 06385 if (eq_idx > equiv_tbl_idx) { 06386 fprintf(out_file, "\n*FE90-ERROR* EQ index value [%d] is out of range.\n", 06387 eq_idx); 06388 return; 06389 } 06390 06391 fprintf(out_file, "%-53.53s %-16s= %-8d\n", 06392 AT_OBJ_NAME_PTR(EQ_ATTR_IDX(eq_idx)), 06393 "IDX", eq_idx); 06394 06395 fprintf(out_file, " %-16s= %-7d %-16s= %-7d %-16s= %-8s\n", 06396 "EQ_ATTR_IDX", EQ_ATTR_IDX(eq_idx), 06397 "EQ_COLUMN_NUM", EQ_COLUMN_NUM(eq_idx), 06398 "EQ_DALIGN_ME", boolean_str[EQ_DALIGN_ME(eq_idx)]); 06399 06400 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 06401 "EQ_DALIGN_SHIFT", boolean_str[EQ_DALIGN_SHIFT(eq_idx)], 06402 "EQ_DO_NOT_DALIGN", boolean_str[EQ_DO_NOT_DALIGN(eq_idx)], 06403 "EQ_ERROR", boolean_str[EQ_ERROR(eq_idx)]); 06404 06405 fprintf(out_file, " %-16s= %-7d %-16s= %-7d %-16s= %-8d\n", 06406 "EQ_GRP_END_IDX", EQ_GRP_END_IDX(eq_idx), 06407 "EQ_GRP_IDX", EQ_GRP_IDX(eq_idx), 06408 "EQ_LINE_NUM", EQ_LINE_NUM(eq_idx)); 06409 06410 # if 0 06411 if (EQ_LIST_IDX(eq_idx) != NULL_IDX) { 06412 print_list(out_file, IL_IDX(EQ_LIST_IDX(eq_idx)), 4, 1, FALSE); 06413 } 06414 # endif 06415 06416 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8d\n", 06417 "EQ_LIST_IDX", EQ_LIST_IDX(eq_idx), 06418 "EQ_MERGED", boolean_str[EQ_MERGED(eq_idx)], 06419 "EQ_NEXT_EQUIV_GR", EQ_NEXT_EQUIV_GRP(eq_idx)); 06420 06421 print_fld_idx(out_file, "EQ_OFFSET_IDX", 06422 EQ_OFFSET_FLD(eq_idx), 06423 EQ_OFFSET_IDX(eq_idx)); 06424 06425 print_fld_idx(out_file, "EQ_OPND_IDX", 06426 EQ_OPND_FLD(eq_idx), 06427 EQ_OPND_IDX(eq_idx)); 06428 06429 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 06430 "EQ_NEXT_EQUIV_OB", EQ_NEXT_EQUIV_OBJ(eq_idx), 06431 "EQ_SEARCH_DONE", boolean_str[EQ_SEARCH_DONE(eq_idx)], 06432 "EQ_SUBSTRINGED", boolean_str[EQ_SUBSTRINGED(eq_idx)]); 06433 06434 putc ('\n', out_file); 06435 fflush(out_file); 06436 06437 return; 06438 06439 } /* dump_eq_ntry */ 06440 06441 06442 /******************************************************************************\ 06443 |* *| 06444 |* Description: *| 06445 |* *| 06446 |* Input parameters: *| 06447 |* FILE to print to - Should be debug_file, stderr, or stdout. *| 06448 |* Index of file path table entry to print. *| 06449 |* *| 06450 |* Output parameters: *| 06451 |* NONE *| 06452 |* *| 06453 |* Returns: *| 06454 |* NOTHING *| 06455 |* *| 06456 \******************************************************************************/ 06457 06458 static void dump_fp_ntry(FILE *out_file, 06459 int fp_idx, 06460 boolean print_list) 06461 06462 { 06463 06464 if (fp_idx > file_path_tbl_idx) { 06465 fprintf(out_file, "\n*FE90-ERROR* FP index value [%d] is out of range.\n", 06466 fp_idx); 06467 return; 06468 } 06469 06470 do { 06471 fprintf(out_file, "%-s\n\n", FP_NAME_PTR(fp_idx)); 06472 06473 fprintf(out_file, " %-16s= %-6d %-16s= %-s\n", 06474 "IDX", fp_idx, 06475 "FP_CLASS", file_path_str[FP_CLASS(fp_idx)]); 06476 06477 if (FP_FILE_IDX(fp_idx) != NULL_IDX && 06478 FP_NAME_IDX(FP_FILE_IDX(fp_idx)) != NULL_IDX) { 06479 fprintf(out_file, " %-16s= %-s\n", 06480 "FP_FILE_IDX", FP_NAME_PTR(FP_FILE_IDX(fp_idx))); 06481 } 06482 else { 06483 fprintf(out_file, " %-16s= %-s\n", "FP_FILE_IDX", "0"); 06484 } 06485 06486 if (FP_MODULE_IDX(fp_idx) != NULL_IDX && 06487 FP_NAME_IDX(FP_MODULE_IDX(fp_idx)) != NULL_IDX) { 06488 fprintf(out_file, " %-16s= %-s\n", 06489 "FP_MODULE_IDX", FP_NAME_PTR(FP_MODULE_IDX(fp_idx))); 06490 } 06491 else { 06492 fprintf(out_file, " %-16s= %-s\n", "FP_MODULE_IDX", "0"); 06493 } 06494 06495 if (FP_NEXT_FILE_IDX(fp_idx) != NULL_IDX && 06496 FP_NAME_IDX(FP_NEXT_FILE_IDX(fp_idx)) != NULL_IDX) { 06497 fprintf(out_file, " %-16s= %-6d (%-s)\n", 06498 "FP_NEXT_FILE_IDX", FP_NEXT_FILE_IDX(fp_idx), 06499 FP_NAME_PTR(FP_NEXT_FILE_IDX(fp_idx))); 06500 } 06501 else { 06502 fprintf(out_file, " %-16s= %-s\n", "FP_NEXT_FILE_IDX", "0"); 06503 } 06504 06505 fprintf(out_file, " %-16s= %-6d %-16s= %-7d %-16s= %-7s\n", 06506 "FP_MODULE_INLINE", FP_MODULE_INLINE_IDX(fp_idx), 06507 "FP_NAME_LEN", FP_NAME_LEN(fp_idx), 06508 "FP_OUTPUT_TO_O", boolean_str[FP_OUTPUT_TO_O(fp_idx)]); 06509 #if defined(_HOST32) && defined(_TARGET64) 06510 fprintf(out_file, " %-16s= %-20Ld \n", 06511 "FP_OFFSET", FP_OFFSET(fp_idx)); 06512 #else 06513 fprintf(out_file, " %-16s= %-20ld \n", 06514 "FP_OFFSET", FP_OFFSET(fp_idx)); 06515 #endif 06516 06517 fprintf(out_file, " %-16s= %-6s %-16s= %-7s %-16s= %-7s\n", 06518 "FP_SRCH_THE_FILE", boolean_str[FP_SRCH_THE_FILE(fp_idx)], 06519 "FP_SYSTEM_FILE", boolean_str[FP_SYSTEM_FILE(fp_idx)], 06520 "FP_TMP_FILE", boolean_str[FP_TMP_FILE(fp_idx)]); 06521 06522 fp_idx = FP_MODULE_IDX(fp_idx); 06523 } 06524 while (print_list && fp_idx != NULL_IDX); 06525 06526 fprintf(out_file, "\n"); 06527 06528 fflush (out_file); 06529 return; 06530 06531 } /* dump_fp_ntry */ 06532 06533 /******************************************************************************\ 06534 |* *| 06535 |* Description: *| 06536 |* Prints one global attr table entry to the specified output file. *| 06537 |* *| 06538 |* Input parameters: *| 06539 |* FILE to print to - Should be debug_file, stderr, or stdout. *| 06540 |* Index of global attr entry to print. *| 06541 |* *| 06542 |* Output parameters: *| 06543 |* NONE *| 06544 |* *| 06545 |* Returns: *| 06546 |* NOTHING *| 06547 |* *| 06548 \******************************************************************************/ 06549 06550 static void dump_ga_ntry (FILE *out_file, 06551 int ga_idx) 06552 06553 { 06554 char conv_str[80]; 06555 int ga_idx2; 06556 int i; 06557 06558 06559 if (ga_idx > global_attr_tbl_idx) { 06560 fprintf(out_file, "\n*FE90-ERROR* GA index value [%d] is out of range.\n", 06561 ga_idx); 06562 return; 06563 } 06564 06565 /* Note that the fields are displayed in alphabetical order. */ 06566 06567 fprintf(out_file, "%-s\n", GA_OBJ_NAME_PTR(ga_idx)); 06568 06569 if (GA_OBJ_CLASS(ga_idx) == Common_Block) { 06570 fprintf(out_file, " %-25s %-16s= %-7d %-16s= %-8d\n", 06571 "Common_Blk", 06572 "IDX", ga_idx, 06573 "GA_DEF_COLUMN", GA_DEF_COLUMN(ga_idx)); 06574 06575 fprintf(out_file, " %-16s= %-7d %-16s= %-7d %-s\n", 06576 "GA_DEF_LINE", GA_DEF_LINE(ga_idx), 06577 "GA_MODULE_IDX", GA_MODULE_IDX(ga_idx), 06578 (GA_MODULE_IDX(ga_idx) == NULL_IDX) ? " ": 06579 GA_OBJ_NAME_PTR(GA_MODULE_IDX(ga_idx))); 06580 06581 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 06582 "GA_NAME_LEN", GA_NAME_LEN(ga_idx), 06583 "GA_USE_ASSOCIATE",boolean_str[GA_USE_ASSOCIATED(ga_idx)], 06584 "GAC_AUXILIARY", boolean_str[GAC_AUXILIARY(ga_idx)]); 06585 06586 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 06587 "GAC_ALIGN_SYMBOL", boolean_str[GAC_ALIGN_SYMBOL(ga_idx)], 06588 "GAC_CACHE_ALIGN", boolean_str[GAC_CACHE_ALIGN(ga_idx)], 06589 "GAC_EQUIVALENCED", boolean_str[GAC_EQUIVALENCED(ga_idx)]); 06590 06591 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8s\n", 06592 "GAC_FILL_SYMBOL", boolean_str[GAC_FILL_SYMBOL(ga_idx)], 06593 "GAC_FIRST_MEMBER", GAC_FIRST_MEMBER_IDX(ga_idx), 06594 "GAC_FOUND_DIFFS", boolean_str[GAC_FOUND_DIFFS(ga_idx)]); 06595 06596 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 06597 "GAC_SECTION_GP", boolean_str[GAC_SECTION_GP(ga_idx)], 06598 "GAC_SECTION_NON_", boolean_str[GAC_SECTION_NON_GP(ga_idx)], 06599 "GAC_TASK_COMMON", boolean_str[GAC_TASK_COMMON(ga_idx)]); 06600 06601 ga_idx2 = GAC_FIRST_MEMBER_IDX(ga_idx); 06602 06603 while (ga_idx2 != NULL_IDX) { 06604 dump_ga_ntry(out_file, ga_idx2); 06605 ga_idx2 = GAD_NEXT_IDX(ga_idx2); 06606 } 06607 return; 06608 } 06609 06610 06611 fprintf(out_file, " %-25s %-16s= %-7s %-16s= %-8d\n", 06612 obj_class_str[GA_OBJ_CLASS(ga_idx)], 06613 "GA_REFERENCED", boolean_str[GA_REFERENCED(ga_idx)], 06614 "IDX", ga_idx); 06615 06616 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8d\n", 06617 "GA_COMPILER_GEND", boolean_str[GA_COMPILER_GEND(ga_idx)], 06618 "GA_DEF_COLUMN", GA_DEF_COLUMN(ga_idx), 06619 "GA_DEF_LINE", GA_DEF_LINE(ga_idx)); 06620 06621 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-s\n", 06622 "GA_DEFINED", boolean_str[GA_DEFINED(ga_idx)], 06623 "GA_MODULE_IDX", GA_MODULE_IDX(ga_idx), 06624 (GA_MODULE_IDX(ga_idx) == NULL_IDX) ? " ": 06625 GA_OBJ_NAME_PTR(GA_MODULE_IDX(ga_idx))); 06626 06627 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8d\n", 06628 "GA_NAME_LEN", GA_NAME_LEN(ga_idx), 06629 "GA_OPTIONAL", boolean_str[GA_OPTIONAL(ga_idx)], 06630 "GA_ORIG_NAME_LEN", GA_ORIG_NAME_LEN(ga_idx)); 06631 06632 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-s\n", 06633 "GA_USE_ASSOCIATE",boolean_str[GA_USE_ASSOCIATED(ga_idx)], 06634 "GA_ORIG_NAME_IDX", GA_ORIG_NAME_IDX(ga_idx), 06635 (GA_ORIG_NAME_IDX(ga_idx) == NULL_IDX) 06636 ? " ": GA_ORIG_NAME_PTR(ga_idx)); 06637 06638 06639 switch (GA_OBJ_CLASS(ga_idx)) { 06640 case Data_Obj: 06641 06642 fprintf(out_file, " %-25s %-16s= %-7s %-16s= %-8d\n", 06643 atd_class_str[GAD_CLASS(ga_idx)], 06644 "GAD_ARRAY_ELEMEN", boolean_str[GAD_ARRAY_ELEMENT_REF(ga_idx)], 06645 "GAD_ARRAY_IDX", GAD_ARRAY_IDX(ga_idx)); 06646 06647 if (GAD_CLASS(ga_idx) == Dummy_Argument) { 06648 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8d\n", 06649 "GAD_ASSUMED_SHAP", boolean_str[GAD_ASSUMED_SHAPE_ARRAY(ga_idx)], 06650 "GAD_INTENT", intent_str[GAD_INTENT(ga_idx)], 06651 "GAD_NEXT_IDX", GAD_NEXT_IDX(ga_idx)); 06652 } 06653 else if (GAD_CLASS(ga_idx) == Constant) { 06654 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-s\n", 06655 "GAD_ASSUMED_SHAP", boolean_str[GAD_ASSUMED_SHAPE_ARRAY(ga_idx)], 06656 "GAD_NEXT_IDX", GAD_NEXT_IDX(ga_idx), 06657 "GAD_HOLLERITH", cn_hollerith_str[GAD_HOLLERITH(ga_idx)]); 06658 } 06659 else { 06660 fprintf(out_file, " %-16s= %-7s %-16s= %-7d\n", 06661 "GAD_ASSUMED_SHAP", boolean_str[GAD_ASSUMED_SHAPE_ARRAY(ga_idx)], 06662 "GAD_NEXT_IDX", GAD_NEXT_IDX(ga_idx)); 06663 } 06664 06665 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8s\n", 06666 "GAD_POINTER", boolean_str[GAD_POINTER(ga_idx)], 06667 "GAD_RANK", GAD_RANK(ga_idx), 06668 "GAD_TARGET", boolean_str[GAD_TARGET(ga_idx)]); 06669 06670 fprintf(out_file, " %-16s= %-7d %-s\n", 06671 "GAD_TYPE_IDX", GAD_TYPE_IDX(ga_idx), 06672 print_global_type_f(GAD_TYPE_IDX(ga_idx))); 06673 06674 if (GAD_ARRAY_IDX(ga_idx) != NULL_IDX) { 06675 dump_gb_ntry(out_file, GAD_ARRAY_IDX(ga_idx)); 06676 } 06677 06678 break; 06679 06680 06681 case Pgm_Unit: 06682 06683 fprintf(out_file, " %-25s %-16s= %-7s %-16s= %-8d\n", 06684 atp_pgm_unit_str[GAP_PGM_UNIT(ga_idx)], 06685 "GAP_ELEMENTAL", boolean_str[GAP_ELEMENTAL(ga_idx)], 06686 "GAP_FIRST_IDX", GAP_FIRST_IDX(ga_idx)); 06687 06688 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 06689 "GAP_FP_IDX", GAP_FP_IDX(ga_idx), 06690 "GAP_GLOBAL_DIR", boolean_str[GAP_GLOBAL_DIR(ga_idx)], 06691 "GAP_IN_INTERFACE", boolean_str[GAP_IN_INTERFACE_BLK(ga_idx)]); 06692 06693 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8s\n", 06694 "GAP_NEEDS_EXPL_I", boolean_str[GAP_NEEDS_EXPL_ITRFC(ga_idx)], 06695 "GAP_NEXT_PGM_IDX", GAP_NEXT_PGM_UNIT_IDX(ga_idx), 06696 "GAP_NOSIDE_EFFEC", boolean_str[GAP_NOSIDE_EFFECTS(ga_idx)]); 06697 06698 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8s\n", 06699 "GAP_NUM_DARGS", GAP_NUM_DARGS(ga_idx), 06700 "GAP_PGM_UNIT_DEF", boolean_str[GAP_PGM_UNIT_DEFINED(ga_idx)], 06701 "GAP_PURE", boolean_str[GAP_PURE(ga_idx)]); 06702 06703 fprintf(out_file, " %-16s= %-7s %-16s= %-7s\n", 06704 "GAP_RECURSIVE", boolean_str[GAP_RECURSIVE(ga_idx)], 06705 "GAP_VFUNCTION",boolean_str[GAP_VFUNCTION(ga_idx)]); 06706 06707 if (GAP_RSLT_IDX(ga_idx) != NULL_IDX) { 06708 dump_ga_ntry(out_file, GAP_RSLT_IDX(ga_idx)); 06709 } 06710 06711 ga_idx2 = GAP_FIRST_IDX(ga_idx); 06712 06713 for (i = GAP_NUM_DARGS(ga_idx); i > 0; i--) { 06714 dump_ga_ntry(out_file, ga_idx2); 06715 ga_idx2++; 06716 } 06717 06718 break; 06719 06720 case Derived_Type: 06721 06722 fprintf(out_file, " %-16s= %-7d %-16s= %-7d %-16s= %-8s\n", 06723 "GAT_FIRST_CPNT_I", GAT_FIRST_CPNT_IDX(ga_idx), 06724 "GAT_NUM_CPNTS", GAT_NUM_CPNTS(ga_idx), 06725 "GAT_PRIVATE_CPNT", boolean_str[GAT_PRIVATE_CPNT(ga_idx)]); 06726 06727 #if ! (defined(_HOST32) && defined(_TARGET64)) 06728 /* 31Jan01[sos]: Following call to convert_to_string gets SIGSEGV w/PV 761865 */ 06729 /* fprintf(out_file, " %-16s= %-7s %-16s= %-33s\n", */ 06730 /* "GAT_SEQUENCE_SET", boolean_str[GAT_SEQUENCE_SET(ga_idx)], */ 06731 /* "GAT_STRUCT_BIT_L", */ 06732 /* convert_to_string(GAT_STRUCT_BIT_LEN(ga_idx), */ 06733 /* GAT_STRUCT_LIN_TYPE(ga_idx), conv_str)); */ 06734 /* Fix follows... */ 06735 fprintf(out_file, " %-16s= %-7s %-16s= %-33ld\n", 06736 "GAT_SEQUENCE_SET", boolean_str[GAT_SEQUENCE_SET(ga_idx)], 06737 "GAT_STRUCT_BIT_L", *GAT_STRUCT_BIT_LEN(ga_idx)); 06738 #else 06739 fprintf(out_file, " %-16s= %-7s %-16s= %-33Ld\n", 06740 "GAT_SEQUENCE_SET", boolean_str[GAT_SEQUENCE_SET(ga_idx)], 06741 "GAT_STRUCT_BIT_L", *GAT_STRUCT_BIT_LEN(ga_idx)); 06742 #endif 06743 06744 ga_idx2 = GAT_FIRST_CPNT_IDX(ga_idx); 06745 06746 for (i = GAT_NUM_CPNTS(ga_idx); i > 0; i--) { 06747 dump_ga_ntry(out_file, ga_idx2); 06748 ga_idx2++; 06749 } 06750 06751 break; 06752 06753 06754 default: 06755 break; 06756 06757 } /* End switch */ 06758 06759 putc ('\n', out_file); 06760 fflush (out_file); 06761 06762 return; 06763 06764 } /* dump_ga_ntry */ 06765 06766 /******************************************************************************\ 06767 |* *| 06768 |* Description: *| 06769 |* Prints one global bounds table entry to the specified output file. *| 06770 |* *| 06771 |* Input parameters: *| 06772 |* FILE to print to - Should be debug_file, stderr, or stdout. *| 06773 |* Index of global bound entry to print. *| 06774 |* *| 06775 |* Output parameters: *| 06776 |* NONE *| 06777 |* *| 06778 |* Returns: *| 06779 |* NOTHING *| 06780 |* *| 06781 \******************************************************************************/ 06782 06783 static void dump_gb_ntry (FILE *out_file, 06784 int gb_idx) 06785 06786 { 06787 char conv_str[80]; 06788 char conv_str2[80]; 06789 int i; 06790 06791 06792 if (gb_idx > global_bounds_tbl_idx) { 06793 fprintf(out_file, "\n*FE90-ERROR* GB index value [%d] is out of range.\n", 06794 gb_idx); 06795 goto EXIT; 06796 } 06797 06798 fprintf(out_file, " %-16s= %-7d %-15s %-25s %-4s= %d\n", 06799 "GB_RANK", GB_RANK(gb_idx), 06800 bd_array_class_str[GB_ARRAY_CLASS(gb_idx)], 06801 bd_array_size_str[GB_ARRAY_SIZE(gb_idx)], 06802 "IDX", gb_idx); 06803 06804 if (GB_ARRAY_CLASS(gb_idx) == Explicit_Shape && 06805 GB_ARRAY_SIZE(gb_idx) == Constant_Size) { 06806 06807 for (i = 1; i <= GB_RANK(gb_idx); i++) { 06808 fprintf(out_file, " %-16s= %-7d %-15s %-15s %-15s %-15s\n", 06809 "Dimension", i, 06810 convert_to_string(GB_LOWER_BOUND(gb_idx,i), 06811 GT_LINEAR_TYPE(GB_LB_TYPE(gb_idx,i)), 06812 conv_str), 06813 print_global_type_f(GB_LB_TYPE(gb_idx,i)), 06814 convert_to_string(GB_UPPER_BOUND(gb_idx,i), 06815 GT_LINEAR_TYPE(GB_UB_TYPE(gb_idx,i)), 06816 conv_str2), 06817 print_global_type_f(GB_UB_TYPE(gb_idx,i))); 06818 } 06819 } 06820 06821 putc ('\n', out_file); 06822 06823 EXIT: 06824 06825 fflush (out_file); 06826 return; 06827 06828 } /* dump_gb_ntry */ 06829 06830 /******************************************************************************\ 06831 |* *| 06832 |* Description: *| 06833 |* Prints a global line table entry. *| 06834 |* *| 06835 |* Input parameters: *| 06836 |* Index of global line table entry to print. *| 06837 |* *| 06838 \******************************************************************************/ 06839 06840 static void dump_gl_ntry(FILE *out_file, 06841 int gl_idx) 06842 06843 { 06844 if (gl_idx > global_line_tbl_idx) { 06845 fprintf(out_file, "\n*FE90-ERROR* GL index value [%d] is out of range.\n", 06846 gl_idx); 06847 return; 06848 } 06849 06850 fprintf(out_file,"%-s\n", GL_FILE_NAME_PTR(gl_idx)); 06851 fprintf(out_file,"%-s\n", GL_PATH_NAME_PTR(gl_idx)); 06852 06853 if (full_debug_dump) { 06854 fprintf(out_file," %-22s= %-10d\n", 06855 "IDX", gl_idx); 06856 06857 fprintf(out_file," %-22s= %-10d %-20s= %-10d\n", 06858 "GL_PATH_NAME_IDX", GL_PATH_NAME_IDX(gl_idx), 06859 "GL_FILE_NAME_IDX", GL_FILE_NAME_IDX(gl_idx)); 06860 } 06861 06862 fprintf(out_file," %-22s= %-10d %-20s= %-10d\n", 06863 "GL_CIF_FILE_ID", GL_CIF_FILE_ID(gl_idx), 06864 "GL_FILE_LINE", GL_FILE_LINE(gl_idx)); 06865 06866 fprintf(out_file," %-22s= %-10d %-20s= %-10d\n", 06867 "GL_FILE_NAME_LEN", GL_FILE_NAME_LEN(gl_idx), 06868 "GL_GLOBAL_LINE", GL_GLOBAL_LINE(gl_idx)); 06869 06870 fprintf(out_file," %-22s= %-10d %-20s= %-10d\n", 06871 "GL_INCLUDE_FILE_COL", GL_INCLUDE_FILE_COL(gl_idx), 06872 "GL_INCLUDE_FILE_LINE", GL_INCLUDE_FILE_LINE(gl_idx)); 06873 06874 06875 fprintf(out_file," %-22s= %-10d %-20s= %-10d\n", 06876 "GL_PATH_NAME_LEN", GL_PATH_NAME_LEN(gl_idx), 06877 "GL_SOURCE_LINES", GL_SOURCE_LINES(gl_idx)); 06878 06879 return; 06880 06881 } /* dump_gl_ntry */ 06882 06883 06884 /******************************************************************************\ 06885 |* *| 06886 |* Description: *| 06887 |* Prints a global name table entry. *| 06888 |* *| 06889 |* Input parameters: *| 06890 |* Index of global name table entry to print. *| 06891 |* *| 06892 \******************************************************************************/ 06893 static void dump_gn_ntry(FILE *out_file, 06894 int gn_idx) 06895 06896 { 06897 if (gn_idx > global_name_tbl_idx) { 06898 fprintf(out_file, "\n*FE90-ERROR* GN index value [%d] is out of range.\n", 06899 gn_idx); 06900 return; 06901 } 06902 06903 fprintf(out_file, "%-s\n", GN_NAME_PTR(gn_idx)); 06904 06905 fprintf(out_file, " %-16s= %-7d %-16s= %-7d \n", 06906 "IDX", gn_idx, 06907 "GN_ATTR_IDX", GN_ATTR_IDX(gn_idx)); 06908 06909 fprintf(out_file, " %-16s= %-7d %-16s= %-7d\n", 06910 "GN_NAME_IDX", GN_NAME_IDX(gn_idx), 06911 "GN_NAME_LEN", GN_NAME_LEN(gn_idx)); 06912 return; 06913 06914 } /* dump_gn_ntry */ 06915 06916 06917 /******************************************************************************\ 06918 |* *| 06919 |* Description: *| 06920 |* *| 06921 |* Input parameters: *| 06922 |* FILE to print to - Should be debug_file, stderr, or stdout. *| 06923 |* Index of type table entry to print. *| 06924 |* *| 06925 |* Output parameters: *| 06926 |* NONE *| 06927 |* *| 06928 |* Returns: *| 06929 |* NOTHING *| 06930 |* *| 06931 \******************************************************************************/ 06932 06933 static void dump_gt_ntry(FILE *out_file, 06934 int gt_idx) 06935 06936 { 06937 char conv_str[80]; 06938 06939 06940 if (gt_idx > global_type_tbl_idx) { 06941 fprintf(out_file,"\n*FE90-ERROR* GT index value [%d] is out of range.\n", 06942 gt_idx); 06943 return; 06944 } 06945 06946 fprintf(out_file," %-25s %-25s %-26s\n", 06947 basic_type_str[GT_TYPE(gt_idx)], 06948 lin_type_str[GT_LINEAR_TYPE(gt_idx)], 06949 type_desc_str[GT_DESC(gt_idx)]); 06950 06951 fprintf(out_file, " %-16s= %-7d %-16s= %-7d", 06952 "GT_DCL_VALUE", GT_DCL_VALUE(gt_idx), 06953 "IDX", gt_idx); 06954 06955 if (GT_TYPE(gt_idx) == Character) { 06956 fprintf(out_file," %-25s \n %-16s= %-s\n", 06957 type_char_class_str[GT_CHAR_CLASS(gt_idx)], 06958 "GT_LENGTH", 06959 convert_to_string(GT_LENGTH(gt_idx), 06960 GT_LENGTH_LIN_TYPE(gt_idx), 06961 conv_str)); 06962 } 06963 else if (GT_TYPE(gt_idx) == CRI_Ptr) { 06964 #if defined(_HOST32) && defined(_TARGET64) 06965 fprintf(out_file, " %-16s= %-7Ld\n", 06966 "GT_PTR_INCREMENT", GT_PTR_INCREMENT(gt_idx)); 06967 #else 06968 fprintf(out_file, " %-16s= %-7ld\n", 06969 "GT_PTR_INCREMENT", GT_PTR_INCREMENT(gt_idx)); 06970 #endif 06971 } 06972 else if (GT_TYPE(gt_idx) == Structure) { 06973 fprintf(out_file, " %-16s= %-7d\n", 06974 "GT_STRUCT_IDX", GT_STRUCT_IDX(gt_idx)); 06975 06976 dump_ga_ntry(out_file, GT_STRUCT_IDX(gt_idx)); 06977 } 06978 else { 06979 fprintf(out_file, " %-16s= %-33s\n", 06980 "GT_BIT_LEN", CONVERT_CVAL_TO_STR(>_BIT_LEN(gt_idx), 06981 Integer_8, 06982 conv_str)); 06983 } 06984 06985 putc ('\n', out_file); 06986 06987 fflush (out_file); 06988 return; 06989 06990 } /* dump_gt_ntry */ 06991 06992 06993 /******************************************************************************\ 06994 |* *| 06995 |* Description: *| 06996 |* Dumps a single Hidden Name Table entry to the specified file. *| 06997 |* *| 06998 |* Input parameters: *| 06999 |* Pointer to dump file. *| 07000 |* Index of Hidden Name Table entry to print. *| 07001 |* Flag to indicate whether to print the attr entry or not. If the attr *| 07002 |* entry is printed, it is a full attr entry dump. *| 07003 |* *| 07004 |* Output parameters: *| 07005 |* NONE *| 07006 |* *| 07007 |* Returns: *| 07008 |* NOTHING *| 07009 |* *| 07010 \******************************************************************************/ 07011 07012 static void dump_hn_ntry(FILE *out_file, 07013 int idx, 07014 boolean print_the_attr) 07015 07016 { 07017 07018 if (idx > hidden_name_tbl_idx) { 07019 fprintf(out_file, "\n*FE90-ERROR* HN index value [%d] is out of range.\n", 07020 idx); 07021 return; 07022 } 07023 07024 if (HN_ATTR_IDX(idx) != NULL_IDX) { 07025 07026 if (HN_NAME_IDX(idx) != NULL_IDX) { 07027 fprintf(out_file, "%-32.32s ",&name_pool[HN_NAME_IDX(idx)].name_char); 07028 } 07029 else { 07030 fprintf(out_file, "%-32.32s ", "**No name - HN_NAME_IDX is 0**"); 07031 } 07032 } 07033 else { 07034 fprintf(out_file, "%-32.32s ", "**Error** - HN_ATTR_IDX = 0**"); 07035 } 07036 07037 fprintf(out_file, "%-8s= %-7d %-16s= %-8d\n", 07038 "IDX", idx, 07039 "HN_ATTR_IDX", HN_ATTR_IDX(idx)); 07040 07041 fprintf(out_file, " %-16s= %-7d %-16s= %-8d\n", 07042 "HN_NAME_IDX", HN_NAME_IDX(idx), 07043 "HN_NAME_LEN", HN_NAME_LEN(idx)); 07044 07045 if (print_the_attr && HN_ATTR_IDX(idx) != NULL_IDX) { 07046 putc ('\n', out_file); 07047 dump_at_ntry(out_file, HN_ATTR_IDX(idx), TRUE); 07048 } 07049 07050 putc ('\n', out_file); 07051 07052 return; 07053 07054 } /* dump_hn_ntry */ 07055 07056 /******************************************************************************\ 07057 |* *| 07058 |* Description: *| 07059 |* Dumps a single List Table entry to the specified file. *| 07060 |* See also print_list (used to dump a chain of List entries when the *| 07061 |* length of the chain is known). *| 07062 |* *| 07063 |* Input parameters: *| 07064 |* Pointer to dump file. *| 07065 |* Index of List Table entry to print. *| 07066 |* *| 07067 |* Output parameters: *| 07068 |* NONE *| 07069 |* *| 07070 |* Returns: *| 07071 |* NOTHING *| 07072 |* *| 07073 \******************************************************************************/ 07074 07075 static void dump_il_ntry(FILE *out_file, 07076 int idx) 07077 07078 { 07079 if (idx > ir_list_tbl_idx) { 07080 fprintf(out_file, "\n*FE90-ERROR* IL index value [%d] is out of range.\n", 07081 idx); 07082 return; 07083 } 07084 07085 fprintf(out_file, "%s= %-8d", 07086 "IL_NEXT_LIST_IDX", IL_NEXT_LIST_IDX(idx)); 07087 07088 if (! IL_ARG_DESC_VARIANT(idx)) { 07089 fprintf(out_file, " %s= %-8d\n", 07090 "IL_PREV_LIST_IDX", IL_PREV_LIST_IDX(idx)); 07091 } 07092 else { 07093 fprintf(out_file, " %s= %-8d\n", 07094 "IL_ARG_DESC_IDX", IL_ARG_DESC_IDX(idx)); 07095 putc('\n', out_file); 07096 } 07097 07098 if (IL_FLD(idx) == IL_Tbl_Idx) { 07099 fprintf(out_file, "%s= %-8d ", 07100 "IL_LIST_CNT", IL_LIST_CNT(idx)); 07101 } 07102 else { 07103 fprintf(out_file, "%s= %-8d %s= %-3d ", 07104 "IL_LINE_NUM", IL_LINE_NUM(idx), 07105 "IL_COL_NUM", IL_COL_NUM(idx)); 07106 } 07107 07108 fprintf(out_file, "%s= %s %s= ", 07109 "IL_FLD", field_str[IL_FLD(idx)], "IL_IDX"); 07110 07111 if (IL_IDX(idx) != NULL_IDX) { 07112 fprintf(out_file, "%-8d\n", IL_IDX(idx)); 07113 } 07114 else { 07115 fprintf(out_file, "%s\n", "*NULL_IDX*"); 07116 } 07117 07118 putc ('\n', out_file); 07119 07120 } /* dump_il_ntry */ 07121 07122 /******************************************************************************\ 07123 |* *| 07124 |* Description: *| 07125 |* recursively prints ir text. Not intended for stmt headers. *| 07126 |* *| 07127 |* Input parameters: *| 07128 |* NONE *| 07129 |* *| 07130 |* Output parameters: *| 07131 |* NONE *| 07132 |* *| 07133 |* Returns: *| 07134 |* NOTHING *| 07135 |* *| 07136 \******************************************************************************/ 07137 07138 static void dump_ir_ntry(FILE *out_file, 07139 int idx, 07140 int indent) 07141 07142 { 07143 int i; 07144 boolean io_list = FALSE; 07145 char n_shift[INDENT_SIZE + 1]; 07146 char shift[80]; 07147 int type_idx; 07148 long_type io_type_code[2]; 07149 07150 07151 if (idx > ir_tbl_idx) { 07152 fprintf(out_file, "\n*FE90-ERROR* IR index value [%d] is out of range.\n", 07153 idx); 07154 return; 07155 } 07156 07157 for (i = 0; i < INDENT_SIZE * indent; i++) { 07158 shift[i] = ' '; 07159 if (i == 79) 07160 break; 07161 } 07162 shift[i] = '\0'; 07163 for (i = 0; i < INDENT_SIZE; i++) { 07164 n_shift[i] = ' '; 07165 } 07166 07167 n_shift[i] = '\0'; 07168 type_idx = IR_TYPE_IDX(idx); 07169 07170 fprintf(out_file, "%s%s idx = %d", shift, operator_str[IR_OPR(idx)], idx); 07171 07172 if (type_idx == NULL_IDX) { 07173 fprintf(out_file, " %s ", "NO TYPE"); 07174 } 07175 else { 07176 fprintf(out_file, " %s ", print_type_f(type_idx)); 07177 } 07178 07179 if (IR_OPR(idx) >= Dv_Whole_Copy_Opr && 07180 IR_OPR(idx) <= Dv_Set_Stride_Mult) { 07181 fprintf(out_file, " dim = %d", IR_DV_DIM(idx)); 07182 } 07183 # if defined(GENERATE_WHIRL) 07184 else if (IR_OPR(idx) == Call_Opr) { 07185 if (IR_INLINE_STATE(idx) == Inline_Sgi) { 07186 fprintf(out_file, " INLINE "); 07187 } 07188 else if (IR_INLINE_STATE(idx) == Noinline_Sgi) { 07189 fprintf(out_file, " NOINLINE "); 07190 } 07191 } 07192 # endif 07193 07194 if ((IR_OPR(idx) == Subscript_Opr || 07195 IR_OPR(idx) == Section_Subscript_Opr || 07196 IR_OPR(idx) == Substring_Opr) && 07197 IR_BOUNDS_DONE(idx)) { 07198 07199 fprintf(out_file, " BOUNDS DONE "); 07200 } 07201 07202 if (IR_OPR(idx) == Whole_Subscript_Opr && 07203 IR_CONTIG_ARRAY(idx)) { 07204 07205 fprintf(out_file, " CONTIGUOUS ARRAY "); 07206 } 07207 07208 if (IR_OPR(idx) == Subscript_Opr && 07209 IR_WHOLE_ARRAY(idx)) { 07210 07211 fprintf(out_file, " WHOLE ARRAY "); 07212 } 07213 07214 if (IR_OPR(idx) == Read_Formatted_Opr || 07215 IR_OPR(idx) == Read_Unformatted_Opr || 07216 IR_OPR(idx) == Read_Namelist_Opr || 07217 IR_OPR(idx) == Write_Formatted_Opr || 07218 IR_OPR(idx) == Write_Unformatted_Opr || 07219 IR_OPR(idx) == Write_Namelist_Opr || 07220 IR_OPR(idx) == Inquire_Iolength_Opr) { 07221 07222 io_list = TRUE; 07223 } 07224 07225 fprintf(out_file, " rank = %d;", IR_RANK(idx)); 07226 fprintf(out_file, " line = %d, col = %d\n", IR_LINE_NUM(idx), 07227 IR_COL_NUM(idx)); 07228 07229 if (IR_OPR(idx) == Dv_Whole_Def_Opr) { 07230 07231 fprintf(out_file, "%sLeft opnd is %s;", shift, field_str[IR_FLD_L(idx)]); 07232 07233 switch (IR_FLD_L(idx)) { 07234 case CN_Tbl_Idx : 07235 case AT_Tbl_Idx : 07236 fprintf(out_file," line = %d, col = %d\n",IR_LINE_NUM_L(idx), 07237 IR_COL_NUM_L(idx)); 07238 break; 07239 case IL_Tbl_Idx : 07240 fprintf(out_file," list cnt = %d\n", IR_LIST_CNT_L(idx)); 07241 break; 07242 default : 07243 fprintf(out_file,"\n"); 07244 break; 07245 } 07246 07247 print_Dv_Whole_Def_Opr(out_file, IR_IDX_L(idx), 07248 indent + 1, IR_LIST_CNT_L(idx)); 07249 } 07250 else if (IR_OPR(idx) == Doacross_Dollar_Opr || 07251 IR_OPR(idx) == Psection_Par_Opr || 07252 IR_OPR(idx) == Singleprocess_Par_Opr || 07253 IR_OPR(idx) == Parallel_Do_Par_Opr || 07254 IR_OPR(idx) == Parallel_Par_Opr || 07255 IR_OPR(idx) == Pdo_Par_Opr) { 07256 07257 07258 fprintf(out_file, "%sLeft opnd is %s;", shift, field_str[IR_FLD_L(idx)]); 07259 07260 switch (IR_FLD_L(idx)) { 07261 case CN_Tbl_Idx : 07262 case AT_Tbl_Idx : 07263 fprintf(out_file," line = %d, col = %d\n",IR_LINE_NUM_L(idx), 07264 IR_COL_NUM_L(idx)); 07265 break; 07266 case IL_Tbl_Idx : 07267 fprintf(out_file," list cnt = %d\n", IR_LIST_CNT_L(idx)); 07268 break; 07269 default : 07270 fprintf(out_file,"\n"); 07271 break; 07272 } 07273 07274 print_mp_dir_opr(out_file, IR_IDX_L(idx), 07275 indent + 1, IR_LIST_CNT_L(idx)); 07276 } 07277 else if (IR_OPR(idx) == Do_Open_Mp_Opr || 07278 IR_OPR(idx) == Parallel_Open_Mp_Opr || 07279 IR_OPR(idx) == Paralleldo_Open_Mp_Opr || 07280 IR_OPR(idx) == Parallelsections_Open_Mp_Opr || 07281 IR_OPR(idx) == Sections_Open_Mp_Opr || 07282 IR_OPR(idx) == Single_Open_Mp_Opr) { 07283 07284 07285 fprintf(out_file, "%sLeft opnd is %s;", shift, field_str[IR_FLD_L(idx)]); 07286 07287 switch (IR_FLD_L(idx)) { 07288 case CN_Tbl_Idx : 07289 case AT_Tbl_Idx : 07290 fprintf(out_file," line = %d, col = %d\n",IR_LINE_NUM_L(idx), 07291 IR_COL_NUM_L(idx)); 07292 break; 07293 case IL_Tbl_Idx : 07294 fprintf(out_file," list cnt = %d\n", IR_LIST_CNT_L(idx)); 07295 break; 07296 default : 07297 fprintf(out_file,"\n"); 07298 break; 07299 } 07300 07301 print_open_mp_dir_opr(out_file, IR_IDX_L(idx), 07302 indent + 1, IR_LIST_CNT_L(idx)); 07303 } 07304 else { 07305 07306 if (IR_OPR(idx) == Io_Item_Type_Code_Opr) { 07307 make_io_type_code(IR_TYPE_IDX(idx), io_type_code); 07308 dump_io_type_code_ntry(out_file, io_type_code, indent + 1); 07309 } 07310 07311 fprintf(out_file, "%sLeft opnd is %s;", shift, field_str[IR_FLD_L(idx)]); 07312 07313 switch (IR_FLD_L(idx)) { 07314 case CN_Tbl_Idx : 07315 case AT_Tbl_Idx : 07316 case SB_Tbl_Idx : 07317 fprintf(out_file," line = %d, col = %d\n",IR_LINE_NUM_L(idx), 07318 IR_COL_NUM_L(idx)); 07319 break; 07320 case IL_Tbl_Idx : 07321 fprintf(out_file," list cnt = %d\n", IR_LIST_CNT_L(idx)); 07322 break; 07323 default : 07324 fprintf(out_file,"\n"); 07325 break; 07326 } 07327 07328 switch (IR_FLD_L(idx)) { 07329 case NO_Tbl_Idx : 07330 break; 07331 case CN_Tbl_Idx : 07332 print_const_entry(out_file, IR_IDX_L(idx), indent + 1); 07333 break; 07334 case AT_Tbl_Idx : 07335 print_attr_name(out_file, IR_IDX_L(idx), indent + 1); 07336 break; 07337 case SB_Tbl_Idx : 07338 fprintf(out_file,"%s\n", SB_NAME_PTR(IR_IDX_L(idx))); 07339 break; 07340 case IR_Tbl_Idx : 07341 dump_ir_ntry(out_file, IR_IDX_L(idx), indent + 1); 07342 break; 07343 case IL_Tbl_Idx : 07344 if (IR_IDX_L(idx) != NULL_IDX && IR_LIST_CNT_L(idx) > 0) { 07345 print_list(out_file, IR_IDX_L(idx), 07346 indent + 1, IR_LIST_CNT_L(idx), io_list); 07347 } 07348 break; 07349 case SH_Tbl_Idx : 07350 fprintf(out_file, "%s%sStmt Header idx = %d\n", shift, 07351 n_shift, IR_IDX_L(idx)); 07352 break; 07353 } 07354 07355 fprintf(out_file,"%sRight operand is %s;", shift, 07356 field_str[IR_FLD_R(idx)]); 07357 07358 switch (IR_FLD_R(idx)) { 07359 case CN_Tbl_Idx : 07360 case AT_Tbl_Idx : 07361 case SB_Tbl_Idx : 07362 fprintf(out_file," line = %d, col = %d\n", 07363 IR_LINE_NUM_R(idx), IR_COL_NUM_R(idx)); 07364 break; 07365 case IL_Tbl_Idx : 07366 fprintf(out_file," list cnt = %d\n", IR_LIST_CNT_R(idx)); 07367 break; 07368 default : 07369 fprintf(out_file,"\n"); 07370 break; 07371 } 07372 07373 07374 switch (IR_FLD_R(idx)) { 07375 case NO_Tbl_Idx : 07376 break; 07377 case CN_Tbl_Idx : 07378 print_const_entry(out_file, IR_IDX_R(idx), indent + 1); 07379 break; 07380 case AT_Tbl_Idx : 07381 print_attr_name(out_file, IR_IDX_R(idx), indent + 1); 07382 break; 07383 case SB_Tbl_Idx : 07384 fprintf(out_file,"%s\n", SB_NAME_PTR(IR_IDX_R(idx))); 07385 break; 07386 case IR_Tbl_Idx : 07387 dump_ir_ntry(out_file, IR_IDX_R(idx), indent + 1); 07388 break; 07389 case IL_Tbl_Idx : 07390 if (IR_IDX_R(idx) != NULL_IDX && IR_LIST_CNT_R(idx) > 0) { 07391 print_list(out_file, IR_IDX_R(idx), 07392 indent + 1, IR_LIST_CNT_R(idx), io_list); 07393 } 07394 break; 07395 case SH_Tbl_Idx : 07396 fprintf(out_file, "%s%sStmt Header idx = %d\n", shift, 07397 n_shift, IR_IDX_R(idx)); 07398 break; 07399 } 07400 } 07401 07402 return; 07403 07404 } /* dump_ir_ntry */ 07405 07406 07407 /******************************************************************************\ 07408 |* *| 07409 |* Description: *| 07410 |* Dumps a single Local Name Table entry to the specified file. *| 07411 |* *| 07412 |* Input parameters: *| 07413 |* Pointer to dump file. *| 07414 |* Index of Local Name Table entry to print. *| 07415 |* Flag to indicate whether to print the attr entry or not. If the attr *| 07416 |* entry is printed, it is a full attr entry dump. *| 07417 |* *| 07418 |* Output parameters: *| 07419 |* NONE *| 07420 |* *| 07421 |* Returns: *| 07422 |* NOTHING *| 07423 |* *| 07424 \******************************************************************************/ 07425 07426 static void dump_ln_ntry(FILE *out_file, 07427 int idx, 07428 boolean print_the_attr) 07429 07430 { 07431 07432 if (idx > loc_name_tbl_idx) { 07433 fprintf(out_file, "\n*FE90-ERROR* LN index value [%d] is out of range.\n", 07434 idx); 07435 return; 07436 } 07437 07438 if (LN_ATTR_IDX(idx) != NULL_IDX) { 07439 07440 if (LN_NAME_IDX(idx) != NULL_IDX) { 07441 fprintf(out_file, "%-32.32s ",&name_pool[LN_NAME_IDX(idx)].name_char); 07442 } 07443 else { 07444 fprintf(out_file, "%-32.32s ", "**No name - LN_NAME_IDX is 0**"); 07445 } 07446 } 07447 else { 07448 fprintf(out_file, "%-32.32s ", "**Error** - LN_ATTR_IDX = 0**"); 07449 } 07450 07451 fprintf(out_file, "%-10s= %-7d %-16s= %-8d\n", 07452 "IDX", idx, 07453 "LN_ATTR_IDX", LN_ATTR_IDX(idx)); 07454 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8d\n", 07455 "LN_DEF_LOC", boolean_str[LN_DEF_LOC(idx)], 07456 "LN_NAME_LEN", LN_NAME_LEN(idx), 07457 "LN_NAME_IDX", LN_NAME_IDX(idx)); 07458 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 07459 "LN_IN_ONLY_LIST", boolean_str[LN_IN_ONLY_LIST(idx)], 07460 "LN_NEW_NAME", boolean_str[LN_NEW_NAME(idx)], 07461 "LN_RENAMED", boolean_str[LN_RENAMED(idx)]); 07462 07463 if (print_the_attr && LN_ATTR_IDX(idx) != NULL_IDX) { 07464 putc ('\n', out_file); 07465 dump_at_ntry(out_file, LN_ATTR_IDX(idx), TRUE); 07466 } 07467 07468 putc ('\n', out_file); 07469 07470 return; 07471 07472 } /* dump_ln_ntry */ 07473 07474 07475 /******************************************************************************\ 07476 |* *| 07477 |* Description: *| 07478 |* Dumps a single module link table entry to the specified file. *| 07479 |* *| 07480 |* Input parameters: *| 07481 |* Pointer to dump file. *| 07482 |* Index of module link table entry to print. *| 07483 |* *| 07484 |* Output parameters: *| 07485 |* NONE *| 07486 |* *| 07487 |* Returns: *| 07488 |* NOTHING *| 07489 |* *| 07490 \******************************************************************************/ 07491 07492 static void dump_ml_ntry(FILE *out_file, 07493 int idx) 07494 07495 { 07496 if (idx > mod_link_tbl_idx) { 07497 fprintf(out_file, "\n*FE90-ERROR* ML index value [%d] is out of range.\n", 07498 idx); 07499 return; 07500 } 07501 07502 fprintf(out_file, "%4s%-15s= %-2s %-15s= %-8d %-16s= %-9d\n", " ", 07503 "ML_AT_COMPRESSED_IDX", boolean_str[ML_AT_COMPRESSED_IDX(idx)], 07504 "ML_AT_IDX", ML_AT_IDX(idx), 07505 "IDX", idx); 07506 07507 fprintf(out_file, "%4s%-15s= %-2s %-15s= %-8s %-16s= %-9s\n", " ", 07508 "ML_AT_KEEP_ME", boolean_str[ML_AT_KEEP_ME(idx)], 07509 "ML_AT_LN_NAME", boolean_str[ML_AT_LN_NAME(idx)], 07510 "ML_AT_SEARCHED", boolean_str[ML_AT_SEARCHED(idx)]); 07511 07512 fprintf(out_file, "%4s%-15s= %-2s %-15s= %-8d\n", " ", 07513 "ML_BD_KEEP_ME", boolean_str[ML_BD_KEEP_ME(idx)], 07514 "ML_BD_IDX", ML_BD_IDX(idx)); 07515 07516 fprintf(out_file, "%4s%-15s= %-2s %-15s= %-8d %-16s= %-9s\n", " ", 07517 "ML_CN_KEEP_ME", boolean_str[ML_CN_KEEP_ME(idx)], 07518 "ML_CN_IDX", ML_CN_IDX(idx), 07519 "ML_CP_DALIGN_ME", boolean_str[ML_CP_DALIGN_ME(idx)]); 07520 07521 fprintf(out_file, "%4s%-15s= %-2s %-15s= %-8d %-16s= %-9d\n", " ", 07522 "ML_CP_KEEP_ME", boolean_str[ML_CP_KEEP_ME(idx)], 07523 "ML_CP_IDX", ML_CP_IDX(idx), 07524 "ML_CP_LEN", ML_CP_LEN(idx)); 07525 07526 fprintf(out_file, "%4s%-15s= %-2s %-15s= %-8d\n", " ", 07527 "ML_IL_KEEP_ME", boolean_str[ML_IL_KEEP_ME(idx)], 07528 "ML_IL_IDX", ML_IL_IDX(idx)); 07529 07530 fprintf(out_file, "%4s%-15s= %-2s %-15s= %-8d\n", " ", 07531 "ML_IR_KEEP_ME", boolean_str[ML_IR_KEEP_ME(idx)], 07532 "ML_IR_IDX", ML_IR_IDX(idx)); 07533 07534 fprintf(out_file, "%4s%-15s= %-2s %-15s= %-8d\n", " ", 07535 "ML_LN_KEEP_ME", boolean_str[ML_LN_KEEP_ME(idx)], 07536 "ML_LN_IDX", ML_LN_IDX(idx)); 07537 07538 fprintf(out_file, "%4s%-15s= %-2s %-15s= %-8d %-16s= %-9d\n", " ", 07539 "ML_NP_KEEP_ME", boolean_str[ML_NP_KEEP_ME(idx)], 07540 "ML_NP_IDX", ML_NP_IDX(idx), 07541 "ML_NP_LEN", ML_NP_LEN(idx)); 07542 07543 fprintf(out_file, "%4s%-15s= %-2s %-15s= %-8d\n", " ", 07544 "ML_SB_KEEP_ME", boolean_str[ML_SB_KEEP_ME(idx)], 07545 "ML_SB_IDX", ML_SB_IDX(idx)); 07546 07547 fprintf(out_file, "%4s%-15s= %-2s %-15s= %-8d\n", " ", 07548 "ML_SH_KEEP_ME", boolean_str[ML_SH_KEEP_ME(idx)], 07549 "ML_SH_IDX", ML_SH_IDX(idx)); 07550 07551 fprintf(out_file, "%4s%-15s= %-2s %-15s= %-8d\n", " ", 07552 "ML_SN_KEEP_ME", boolean_str[ML_SN_KEEP_ME(idx)], 07553 "ML_SN_IDX", ML_SN_IDX(idx)); 07554 07555 fprintf(out_file, "%4s%-15s= %-2s %-15s= %-8d\n", " ", 07556 "ML_TYP_KEEP_ME", boolean_str[ML_TYP_KEEP_ME(idx)], 07557 "ML_TYP_IDX", ML_TYP_IDX(idx)); 07558 07559 putc ('\n', out_file); 07560 07561 return; 07562 07563 } /* dump_ml_ntry */ 07564 07565 /******************************************************************************\ 07566 |* *| 07567 |* Description: *| 07568 |* Prints one Rename Only Table entry to the specified output file. *| 07569 |* *| 07570 |* Input parameters: *| 07571 |* FILE to print to - Should be debug_file, stderr, or stdout. *| 07572 |* Index of Rename Only Table entry to print. *| 07573 |* *| 07574 |* Output parameters: *| 07575 |* NONE *| 07576 |* *| 07577 |* Returns: *| 07578 |* NOTHING *| 07579 |* *| 07580 \******************************************************************************/ 07581 07582 static void dump_ro_ntry(FILE *out_file, 07583 int ro_idx) 07584 07585 { 07586 07587 if (ro_idx > rename_only_tbl_idx) { 07588 fprintf(out_file, "\n*FE90-ERROR* ML index value [%d] is out of range.\n", 07589 ro_idx); 07590 return; 07591 } 07592 07593 fprintf(out_file, "%4s%-32.32s", " ", RO_NAME_PTR(ro_idx)); 07594 07595 if (full_debug_dump) { 07596 fprintf(out_file, " %-4s= %-7d %-16s= %-9d\n", 07597 "IDX", ro_idx, 07598 "RO_NEXT_IDX", RO_NEXT_IDX(ro_idx)); 07599 } 07600 else { 07601 fprintf(out_file, "\n"); 07602 } 07603 07604 fprintf(out_file, "%4s%-16s= %-2d\n"," ", 07605 "RO_NAME_ATTR",RO_NAME_ATTR(ro_idx)); 07606 07607 07608 fprintf(out_file, "%4s%-16s= %-2d %-16s= %-7d %-16s= %-9d\n", " ", 07609 "RO_COLUMN_NUM", RO_COLUMN_NUM(ro_idx), 07610 "RO_LINE_NUM", RO_LINE_NUM(ro_idx), 07611 "RO_NAME_LEN", RO_NAME_LEN(ro_idx)); 07612 07613 if (RO_RENAME_IDX(ro_idx) != NULL_IDX) { 07614 ro_idx = RO_RENAME_IDX(ro_idx); 07615 07616 fprintf(out_file, "%4s%-16s %-2s %-16s= %-s\n", " ", 07617 "RENAMED", " ", 07618 "RO_NAME_PTR", RO_NAME_PTR(ro_idx)); 07619 07620 fprintf(out_file, "%4s%-16s= %-2d %-16s= %-7d %-16s= %-9d\n", " ", 07621 "RO_COLUMN_NUM", RO_COLUMN_NUM(ro_idx), 07622 "RO_LINE_NUM", RO_LINE_NUM(ro_idx), 07623 "RO_NAME_LEN", RO_NAME_LEN(ro_idx)); 07624 07625 07626 fprintf(out_file, "%4s%-16s= %-2s %-16s= %-7s\n", " ", 07627 "RO_RENAME_NAME", boolean_str[RO_RENAME_NAME(ro_idx)], 07628 "RO_DUPLICATE_REN", boolean_str[RO_DUPLICATE_RENAME(ro_idx)]); 07629 } 07630 07631 fflush (out_file); 07632 return; 07633 07634 } /* dump_ro_ntry */ 07635 07636 /******************************************************************************\ 07637 |* *| 07638 |* Description: *| 07639 |* Prints one Storage Block Table entry to the specified output file. *| 07640 |* *| 07641 |* Input parameters: *| 07642 |* FILE to print to - Should be debug_file, stderr, or stdout. *| 07643 |* Index of Storage Block Table entry to print. *| 07644 |* *| 07645 |* Output parameters: *| 07646 |* NONE *| 07647 |* *| 07648 |* Returns: *| 07649 |* NOTHING *| 07650 |* *| 07651 \******************************************************************************/ 07652 07653 static void dump_sb_ntry(FILE *out_file, 07654 int sb_idx) 07655 07656 { 07657 07658 07659 if (sb_idx > stor_blk_tbl_idx) { 07660 fprintf(out_file, "\n*FE90-ERROR* SB index value [%d] is out of range.\n", 07661 sb_idx); 07662 return; 07663 } 07664 07665 if (SB_NAME_IDX(sb_idx) != NULL_IDX) { 07666 fprintf(out_file, " %s\n", SB_NAME_PTR(sb_idx)); 07667 } 07668 07669 fprintf(out_file, " %-16s= %-33s %-16s= %-8d\n", 07670 "SB_BLK_TYPE", sb_blk_type_str[SB_BLK_TYPE(sb_idx)], 07671 "IDX", sb_idx); 07672 07673 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-7s\n", 07674 "SB_ALIGN_SYMBOL", boolean_str[SB_ALIGN_SYMBOL(sb_idx)], 07675 "SB_AUXILIARY", boolean_str[SB_AUXILIARY(sb_idx)], 07676 "SB_BLANK_COMMON", boolean_str[SB_BLANK_COMMON(sb_idx)]); 07677 07678 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8s\n", 07679 "SB_CACHE_ALIGN", boolean_str[SB_COMMON_NEEDS_OFFSET(sb_idx)], 07680 "SB_CIF_SYMBOL_ID", SB_CIF_SYMBOL_ID(sb_idx), 07681 "SB_COMMON_NEEDS_", boolean_str[SB_COMMON_NEEDS_OFFSET(sb_idx)]); 07682 07683 fprintf(out_file, " %-16s %-7s %-16s= %-7s %-16s= %-8s\n", 07684 " ", " ", 07685 "SB_DCL_COMMON_DI", boolean_str[SB_DCL_COMMON_DIR(sb_idx)], 07686 "SB_DCL_ERR", boolean_str[SB_DCL_ERR(sb_idx)]); 07687 07688 fprintf(out_file, " %-16s= %-7d %-16s= %-7d %-16s= %-8s\n", 07689 "SB_DEF_COLUMN", SB_DEF_COLUMN(sb_idx), 07690 "SB_DEF_LINE", SB_DEF_LINE(sb_idx), 07691 "SB_DEF_MULT_SCPS", boolean_str[SB_DEF_MULT_SCPS(sb_idx)]); 07692 07693 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8d\n", 07694 "SB_DUPLICATE_COM", boolean_str[SB_DUPLICATE_COMMON(sb_idx)], 07695 "SB_EQUIVALENCED", boolean_str[SB_EQUIVALENCED(sb_idx)], 07696 "SB_FIRST_ATTR_ID", SB_FIRST_ATTR_IDX(sb_idx)); 07697 07698 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 07699 "SB_HAS_RENAMES", boolean_str[SB_HAS_RENAMES(sb_idx)], 07700 "SB_HIDDEN", boolean_str[SB_HIDDEN(sb_idx)], 07701 "SB_HOST_ASSOCIAT", boolean_str[SB_HOST_ASSOCIATED(sb_idx)]); 07702 07703 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 07704 "SB_HOSTED_STACK", boolean_str[SB_HOSTED_STACK(sb_idx)], 07705 "SB_HOSTED_STATIC", boolean_str[SB_HOSTED_STATIC(sb_idx)], 07706 "SB_IS_COMMON", boolean_str[SB_IS_COMMON(sb_idx)]); 07707 07708 print_fld_idx(out_file, "SB_LEN_IDX", 07709 SB_LEN_FLD(sb_idx), SB_LEN_IDX(sb_idx)); 07710 07711 fprintf(out_file, " %-16s= %-7d %-16s= %-7d %-16s= %-8s\n", 07712 "SB_LAST_ATTR_LIS", SB_LAST_ATTR_LIST(sb_idx), 07713 "SB_MERGED_BLK_ID", SB_MERGED_BLK_IDX(sb_idx), 07714 "SB_MODULE", boolean_str[SB_MODULE(sb_idx)]); 07715 07716 if (SB_MODULE(sb_idx)) { 07717 07718 if (SB_MODULE_IDX(sb_idx) == NULL_IDX) { 07719 fprintf(out_file, " %-16s= %-7d\n", 07720 "SB_MODULE_IDX", SB_MODULE_IDX(sb_idx)); 07721 } 07722 else { 07723 fprintf(out_file, " %-16s= %-7d %-33s\n", 07724 "SB_MODULE_IDX", SB_MODULE_IDX(sb_idx), 07725 print_at_name(SB_MODULE_IDX(sb_idx))); 07726 } 07727 } 07728 07729 fprintf(out_file, " %-16s= %-7d %-16s= %-7d %-16s= %-8d\n", 07730 "SB_NAME_LEN", SB_NAME_LEN(sb_idx), 07731 "SB_ORIG_SCP_IDX", SB_ORIG_SCP_IDX(sb_idx), 07732 "SB_PAD_AMOUNT", SB_PAD_AMOUNT(sb_idx)); 07733 07734 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 07735 "SB_PAD_AMOUNT_SE", boolean_str[SB_PAD_AMOUNT_SET(sb_idx)], 07736 "SB_PAD_BLK", boolean_str[SB_PAD_BLK(sb_idx)], 07737 "SB_RUNTIME_INIT", boolean_str[SB_RUNTIME_INIT(sb_idx)]); 07738 07739 fprintf(out_file, " %-16s= %-7s %-16s= %-7d %-16s= %-8s\n", 07740 "SB_SAVED", boolean_str[SB_SAVED(sb_idx)], 07741 "SB_SCP_IDX", SB_SCP_IDX(sb_idx), 07742 "SB_SECTION_GP", boolean_str[SB_SECTION_GP(sb_idx)]); 07743 07744 fprintf(out_file, " %-16s= %-7s %-16s= %-7s %-16s= %-8s\n", 07745 "SB_SECTION_NON_", boolean_str[SB_SECTION_NON_GP(sb_idx)], 07746 "SB_SYMMETRIC", boolean_str[SB_SYMMETRIC(sb_idx)], 07747 "SB_USE_ASSOCIATE", boolean_str[SB_USE_ASSOCIATED(sb_idx)]); 07748 07749 fprintf(out_file, " %-16s= %-7s\n", 07750 "SB_VOLATILE", boolean_str[SB_VOLATILE(sb_idx)]); 07751 07752 putc ('\n', out_file); 07753 07754 fflush (out_file); 07755 return; 07756 07757 } /* dump_sb_ntry */ 07758 07759 07760 /******************************************************************************\ 07761 |* *| 07762 |* Description: *| 07763 |* Prints one scope stack entry to the specified output file. *| 07764 |* *| 07765 |* Input parameters: *| 07766 |* FILE to print to - Should be debug_file, stderr, or stdout. *| 07767 |* Index of scope stack entry to print. *| 07768 |* *| 07769 |* Output parameters: *| 07770 |* NONE *| 07771 |* *| 07772 |* Returns: *| 07773 |* NOTHING *| 07774 |* *| 07775 \******************************************************************************/ 07776 07777 static void dump_scp_ntry (FILE *out_file, 07778 int scp_idx, 07779 int shift_cnt, 07780 boolean print_impl_tbl, 07781 boolean print_all_children) 07782 07783 { 07784 char ch; 07785 int idx; 07786 int save_scp_idx; 07787 char shift[80]; 07788 07789 07790 PROCESS_SIBLING: 07791 07792 if (scp_idx > scp_tbl_idx) { 07793 fprintf(out_file,"\n*FE90-ERROR* SCP index value [%d] is out of range.\n", 07794 scp_idx); 07795 return; 07796 } 07797 07798 if (shift_cnt > 45) { 07799 fprintf(out_file, "\nFE90 - NESTING is too DEEP\n"); 07800 shift_cnt = 45; 07801 } 07802 07803 for (idx = 0; idx < shift_cnt; idx++) { 07804 shift[idx] = ' '; 07805 } 07806 shift[shift_cnt] = '\0'; 07807 07808 if (SCP_ATTR_IDX(scp_idx) != NULL_IDX) { 07809 fprintf(out_file, "%s%-32.32s", shift, 07810 AT_OBJ_NAME_PTR(SCP_ATTR_IDX(scp_idx))); 07811 } 07812 else if (scp_idx == INTRINSIC_SCP_IDX) { 07813 fprintf(out_file, "%s%-32.32s", shift, "*** INTRINSIC SCOPE ***"); 07814 } 07815 else { 07816 fprintf(out_file, "%s%-32.32s", shift, "*** scope has no name ***"); 07817 } 07818 07819 if (SCP_IN_ERR(scp_idx)) { 07820 fprintf(out_file, "%5s%s", " ", "*** SCOPE IN ERROR ***"); 07821 } 07822 07823 fprintf(out_file,"\n%18s%-20s= %-7d %-20s= %-9d\n", " ", 07824 "IDX", scp_idx, 07825 "SCP_ALT_ENTRY_CNT", SCP_ALT_ENTRY_CNT(scp_idx)); 07826 07827 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07828 "SCP_ASSIGN_LBL_CHAIN", SCP_ASSIGN_LBL_CHAIN(scp_idx), 07829 "SCP_ATTR_IDX", SCP_ATTR_IDX(scp_idx)); 07830 07831 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07832 "SCP_ATTR_LIST", SCP_ATTR_LIST(scp_idx), 07833 "SCP_ATTR_LIST_EN", SCP_ATTR_LIST_END(scp_idx)); 07834 07835 fprintf(out_file,"%18s%-20s= %-7d\n", " ", 07836 "SCP_CIF_ERR_LIST", SCP_CIF_ERR_LIST(scp_idx)); 07837 07838 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9s\n", " ", 07839 "SCP_CIF_ID", SCP_CIF_ID(scp_idx), 07840 "SCP_COPY_ASSUMED_SHA",boolean_str[SCP_COPY_ASSUMED_SHAPE(scp_idx)]); 07841 07842 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07843 "SCP_COPY_ASSUMED_LIS", SCP_COPY_ASSUMED_LIST(scp_idx), 07844 "SCP_DARG_LIST", SCP_DARG_LIST(scp_idx)); 07845 07846 # if 0 07847 fprintf(out_file,"%18s%-20s= %-7s %-20s= %-9s\n", " ", 07848 "SCP_DBG_PRINT_STMT", boolean_str[SCP_DBG_PRINT_STMT(scp_idx)], 07849 "SCP_DBG_PRINT_SYTB", boolean_str[SCP_DBG_PRINT_SYTB(scp_idx)]); 07850 # endif 07851 07852 fprintf(out_file,"%18s%-20s= %-27s\n", " ", 07853 "SCP_DEFAULT_STORAGE", 07854 sb_blk_type_str[SCP_DBG_PRINT_SYTB(scp_idx)]); 07855 07856 fprintf(out_file,"%18s%-20s= %-7s %-20s= %-9d\n", " ", 07857 "SCP_DOES_IO", boolean_str[SCP_DOES_IO(scp_idx)], 07858 "SCP_ENTRY_IDX", SCP_ENTRY_IDX(scp_idx)); 07859 07860 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07861 "SCP_EXIT_IR_SH_IDX", SCP_EXIT_IR_SH_IDX(scp_idx), 07862 "SCP_FILE_PATH_IDX", SCP_FILE_PATH_IDX(scp_idx)); 07863 07864 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07865 "SCP_FIRST_CHILD_IDX", SCP_FIRST_CHILD_IDX(scp_idx), 07866 "SCP_FIRST_EQUIV_GRP", SCP_FIRST_EQUIV_GRP(scp_idx)); 07867 07868 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9s\n", " ", 07869 "SCP_FIRST_SH_IDX", SCP_FIRST_SH_IDX(scp_idx), 07870 "SCP_HAS_CALLS", boolean_str[SCP_HAS_CALLS(scp_idx)]); 07871 07872 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07873 "SCP_HN_FW_IDX", SCP_HN_FW_IDX(scp_idx), 07874 "SCP_HN_LW_IDX", SCP_HN_LW_IDX(scp_idx)); 07875 07876 fprintf(out_file,"%18s%-20s= %-7s %-20s= %-9s\n", " ", 07877 "SCP_IGNORE_TKR", boolean_str[SCP_IGNORE_TKR(scp_idx)], 07878 "SCP_IMPL_NONE", boolean_str[SCP_IMPL_NONE(scp_idx)]); 07879 07880 fprintf(out_file,"%18s%-20s= %-7s %-20s= %-9s\n", " ", 07881 "SCP_IN_ERR", boolean_str[SCP_IN_ERR(scp_idx)], 07882 "SCP_IS_INTERFACE", boolean_str[SCP_IS_INTERFACE(scp_idx)]); 07883 07884 fprintf(out_file,"%18s%-20s= %-7s %-20s= %-9d\n", " ", 07885 "SCP_IS_USED_PROC", boolean_str[SCP_IS_USED_PROC(scp_idx)], 07886 "SCP_LAST_CHILD_IDX", SCP_LAST_CHILD_IDX(scp_idx)); 07887 07888 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07889 "SCP_LAST_SH_IDX", SCP_LAST_SH_IDX(scp_idx), 07890 "SCP_LEVEL", SCP_LEVEL(scp_idx)); 07891 07892 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07893 "SCP_LN_FW_IDX", SCP_LN_FW_IDX(scp_idx), 07894 "SCP_LN_LW_IDX", SCP_LN_LW_IDX(scp_idx)); 07895 07896 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07897 "SCP_NUM_CHILDREN", SCP_NUM_CHILDREN(scp_idx), 07898 "SCP_OPTIONAL_CHAR_TM", SCP_OPTIONAL_CHAR_TMP(scp_idx)); 07899 07900 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9s\n", " ", 07901 "SCP_PARENT_IDX", SCP_PARENT_IDX(scp_idx), 07902 "SCP_PARENT_NONE", boolean_str[SCP_PARENT_NONE(scp_idx)]); 07903 07904 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07905 "SCP_RETURN_LABEL", SCP_RETURN_LABEL(scp_idx), 07906 "SCP_SB_BASED_IDX", SCP_SB_BASED_IDX(scp_idx)); 07907 07908 07909 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07910 "SCP_SB_HOSTED_DATA", SCP_SB_HOSTED_DATA_IDX(scp_idx), 07911 "SCP_SB_HOSTED_STAC", SCP_SB_HOSTED_STACK_IDX(scp_idx)); 07912 07913 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07914 "SCP_SB_HOSTED_STAT", SCP_SB_HOSTED_STATIC_IDX(scp_idx), 07915 "SCP_SB_STACK_IDX", SCP_SB_STACK_IDX(scp_idx)); 07916 07917 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07918 "SCP_SB_STATIC_IDX", SCP_SB_STATIC_IDX(scp_idx), 07919 "SCP_SB_STATIC_INIT", SCP_SB_STATIC_INIT_IDX(scp_idx)); 07920 07921 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07922 "SCP_SB_STATIC_UNINIT", SCP_SB_STATIC_UNINIT_IDX(scp_idx), 07923 "SCP_SB_SYMMETRIC", SCP_SB_SYMMETRIC_IDX(scp_idx)); 07924 07925 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07926 "SCP_SIBLING_IDX", SCP_SIBLING_IDX(scp_idx), 07927 "SCP_RESHAPE_ARRA", SCP_RESHAPE_ARRAY_LIST(scp_idx)); 07928 07929 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07930 "SCP_TMP_FW_IDX", SCP_TMP_FW_IDX(scp_idx), 07931 "SCP_TMP_FW_IDX2", SCP_TMP_FW_IDX2(scp_idx)); 07932 07933 fprintf(out_file,"%18s%-20s= %-7d %-20s= %-9d\n", " ", 07934 "SCP_TMP_LIST", SCP_TMP_LIST(scp_idx), 07935 "SCP_USED_MODULE_LIST", SCP_USED_MODULE_LIST(scp_idx)); 07936 07937 07938 if (print_impl_tbl) { 07939 for (idx = 0; idx < MAX_IMPL_CHS; idx++) { 07940 ch = 'A' + idx; 07941 fprintf(out_file,"%18s%c %24s %-16s= %-9s\n", " ", 07942 ch, " ", "IM_SET", boolean_str[IM_SET(scp_idx, idx)]); 07943 dump_typ_ntry(out_file, IM_TYPE_IDX(scp_idx,idx)); 07944 fprintf(out_file,"%44s %-16s= %-9s\n", " ", 07945 "IM_STORAGE", implicit_storage_str[IM_STORAGE(scp_idx, idx)]); 07946 } 07947 } 07948 putc ('\n', out_file); 07949 07950 if (print_all_children) { 07951 07952 if (SCP_FIRST_CHILD_IDX(scp_idx) != NULL_IDX) { 07953 save_scp_idx = scp_idx; 07954 scp_idx = SCP_FIRST_CHILD_IDX(scp_idx); 07955 shift_cnt = shift_cnt + 5; 07956 dump_scp_ntry(out_file, 07957 scp_idx, 07958 shift_cnt, 07959 print_impl_tbl, 07960 TRUE); 07961 scp_idx = save_scp_idx; 07962 } 07963 07964 if (SCP_SIBLING_IDX(scp_idx) != NULL_IDX) { 07965 scp_idx = SCP_SIBLING_IDX(scp_idx); 07966 goto PROCESS_SIBLING; 07967 } 07968 } 07969 07970 fflush (out_file); 07971 return; 07972 07973 } /* dump_scp_ntry */ 07974 07975 07976 /******************************************************************************\ 07977 |* *| 07978 |* Description: *| 07979 |* Prints a single Secondary Name table entry. *| 07980 |* *| 07981 |* Input parameters: *| 07982 |* Index of Secondary Name table entry to print. *| 07983 |* *| 07984 |* Output parameters: *| 07985 |* NONE *| 07986 |* *| 07987 |* Returns: *| 07988 |* NOTHING *| 07989 |* *| 07990 \******************************************************************************/ 07991 07992 static void dump_sn_ntry (FILE *out_file, 07993 int sn_idx) 07994 07995 { 07996 if (sn_idx > sec_name_tbl_idx) { 07997 fprintf(out_file, "\n*FE90-ERROR* SN index value [%d] is out of range.\n", 07998 sn_idx); 07999 return; 08000 } 08001 08002 fprintf(out_file, " %-51s", &name_pool[SN_NAME_IDX(sn_idx)].name_char); 08003 08004 fprintf(out_file, " %-16s= %-8d\n", " IDX", sn_idx); 08005 08006 fprintf(out_file, " %-16s= %-7d %-16s= %-7d %-16s= %-8d\n", 08007 "SN_COLUMN_NUM", SN_COLUMN_NUM(sn_idx), 08008 "SN_LINE_NUM", SN_LINE_NUM(sn_idx), 08009 "SN_NAME_LEN", SN_NAME_LEN(sn_idx)); 08010 08011 /* Only generic interface, operator interface, and namelist group */ 08012 /* Secondary Name table entries are linked together via the */ 08013 /* SN_SIBLING_LINK field. */ 08014 08015 08016 if (comp_phase == Decl_Semantics) { 08017 fprintf(out_file, " %-16s= %-7s\n", 08018 "SN_MATCHED_DARG", boolean_str[SN_MATCHED_DARG(sn_idx)]); 08019 } 08020 08021 fprintf(out_file, " %-16s= %-7d %-16s= %-7d %-16s= %-8d\n", 08022 "SN_NAME_IDX", SN_NAME_IDX(sn_idx), 08023 "SN_ATTR_IDX", SN_ATTR_IDX(sn_idx), 08024 "SN_SIBLING_LINK", SN_SIBLING_LINK(sn_idx)); 08025 08026 fflush(out_file); 08027 08028 return; 08029 08030 } /* dump_sn_ntry */ 08031 08032 08033 /******************************************************************************\ 08034 |* *| 08035 |* Description: *| 08036 |* *| 08037 |* Input parameters: *| 08038 |* NONE *| 08039 |* *| 08040 |* Output parameters: *| 08041 |* NONE *| 08042 |* *| 08043 |* Returns: *| 08044 |* NOTHING *| 08045 |* *| 08046 \******************************************************************************/ 08047 08048 static void dump_stmt_ntry(FILE *out_file, 08049 boolean print_stmt_ir) 08050 { 08051 08052 dump_trace_info(out_file, Stmt_Start, NULL, "SH_dump"); 08053 08054 fprintf(out_file, "IDX = %-7d %s = %-7d %s = %d %s = %d\n", 08055 curr_stmt_sh_idx, 08056 "PREV SH IDX", SH_PREV_IDX(curr_stmt_sh_idx), 08057 "NEXT SH IDX", SH_NEXT_IDX(curr_stmt_sh_idx), 08058 "COL NUM", SH_COL_NUM(curr_stmt_sh_idx)); 08059 08060 if (SH_LABELED(curr_stmt_sh_idx) && 08061 ! (SH_COMPILER_GEN(curr_stmt_sh_idx) && 08062 SH_STMT_TYPE(curr_stmt_sh_idx) == Continue_Stmt)) { 08063 fprintf(out_file, " *Stmt is labeled*\n"); 08064 } 08065 08066 fprintf(out_file, "%16s%s = %-7d %-11s = %s %15s = %s\n", " ", 08067 "PARENT BLK IDX", SH_PARENT_BLK_IDX(curr_stmt_sh_idx), 08068 "LOOP END", boolean_str[SH_LOOP_END(curr_stmt_sh_idx)], 08069 "DOALL LOOP END", 08070 boolean_str[SH_DOALL_LOOP_END(curr_stmt_sh_idx)]); 08071 08072 if (print_stmt_ir && SH_IR_IDX(curr_stmt_sh_idx) != NULL_IDX) { 08073 dump_ir_ntry(out_file, SH_IR_IDX(curr_stmt_sh_idx), 1); 08074 } 08075 08076 return; 08077 08078 } /* dump_stmt_ntry */ 08079 08080 08081 /******************************************************************************\ 08082 |* *| 08083 |* Description: *| 08084 |* *| 08085 |* Input parameters: *| 08086 |* FILE to print to - Should be debug_file, stderr, or stdout. *| 08087 |* Index of module file table entry to print. *| 08088 |* *| 08089 |* Output parameters: *| 08090 |* NONE *| 08091 |* *| 08092 |* Returns: *| 08093 |* NOTHING *| 08094 |* *| 08095 \******************************************************************************/ 08096 08097 static void dump_typ_ntry(FILE *out_file, 08098 int type_idx) 08099 08100 { 08101 char conv_str[80]; 08102 08103 08104 if (type_idx > type_tbl_idx) { 08105 fprintf(out_file,"\n*FE90-ERROR* TYP index value [%d] is out of range.\n", 08106 type_idx); 08107 return; 08108 } 08109 08110 fprintf(out_file," %-25s %-25s %-26s\n", 08111 basic_type_str[TYP_TYPE(type_idx)], 08112 lin_type_str[TYP_LINEAR(type_idx)], 08113 type_desc_str[TYP_DESC(type_idx)]); 08114 08115 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8d\n", 08116 "TYP_DCL_VALUE", TYP_DCL_VALUE(type_idx), 08117 "TYP_DP_HIT_ME", boolean_str[TYP_DP_HIT_ME(type_idx)], 08118 "IDX", type_idx); 08119 08120 if (TYP_TYPE(type_idx) == Character) { 08121 08122 fprintf(out_file," %-25s %-16s= %-8s\n", 08123 type_char_class_str[TYP_CHAR_CLASS(type_idx)], 08124 "TYP_RESOLVED", boolean_str[TYP_RESOLVED(type_idx)]); 08125 08126 print_fld_idx(out_file, "TYP_IDX", 08127 TYP_FLD(type_idx), 08128 TYP_IDX(type_idx)); 08129 08130 if (TYP_ORIG_LEN_IDX(type_idx) != NULL_IDX) { 08131 print_fld_idx(out_file, "TYP_ORIG_LEN_IDX", 08132 TYP_FLD(type_idx), 08133 TYP_ORIG_LEN_IDX(type_idx)); 08134 } 08135 } 08136 else if (TYP_TYPE(type_idx) == CRI_Ptr) { 08137 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-8d\n", 08138 "TYP_IDX", TYP_IDX(type_idx), 08139 "TYP_RESOLVED", boolean_str[TYP_RESOLVED(type_idx)], 08140 "TYP_PTR_INCREMEN", (int) TYP_PTR_INCREMENT(type_idx)); 08141 } 08142 else { 08143 fprintf(out_file, " %-16s= %-7d %-16s= %-7s %-16s= %-7s\n", 08144 "TYP_IDX", TYP_IDX(type_idx), 08145 "TYP_KIND_CONST", boolean_str[TYP_KIND_CONST(type_idx)], 08146 "TYP_KIND_DOUBLE", boolean_str[TYP_KIND_DOUBLE(type_idx)]); 08147 08148 fprintf(out_file, " %-16s= %-7s %-16s= %-s\n", 08149 "TYP_RESOLVED", boolean_str[TYP_RESOLVED(type_idx)], 08150 "TYP_BIT_LEN", CONVERT_CVAL_TO_STR(&TYP_BIT_LEN(type_idx), 08151 Integer_8, 08152 conv_str)); 08153 } 08154 08155 putc ('\n', out_file); 08156 08157 fflush (out_file); 08158 return; 08159 08160 } /* dump_typ_ntry */ 08161 08162 /******************************************************************************\ 08163 |* *| 08164 |* Description: *| 08165 |* <description> *| 08166 |* *| 08167 |* Input parameters: *| 08168 |* NONE *| 08169 |* *| 08170 |* Output parameters: *| 08171 |* NONE *| 08172 |* *| 08173 |* Returns: *| 08174 |* NOTHING *| 08175 |* *| 08176 \******************************************************************************/ 08177 08178 static void dump_io_type_code_ntry(FILE *out_file, 08179 long_type *value, 08180 int indent) 08181 08182 { 08183 long_type dec_len = 0; 08184 int dp_flag = 0; 08185 int dv_type; 08186 long_type int_len = 0; 08187 int kind_star = 0; 08188 char shift[80]; 08189 int i; 08190 08191 f90_type_t *type_code; 08192 08193 TRACE (Func_Entry, "dump_io_type_code_ntry", NULL); 08194 08195 for (i = 0; i < INDENT_SIZE * indent; i++) { 08196 shift[i] = ' '; 08197 if (i == 79) 08198 break; 08199 } 08200 shift[i] = '\0'; 08201 08202 # ifdef _TYPE_CODE_64_BIT 08203 08204 type_code = (f90_type_t *)value; 08205 08206 08207 dv_type = type_code->type; 08208 08209 dp_flag = type_code->dpflag; 08210 08211 kind_star = type_code->kind_or_star; 08212 08213 int_len = type_code->int_len; 08214 08215 dec_len = type_code->int_len; 08216 # else 08217 08218 dv_type = ((*value) >> DV_TYPE_SHIFT) & 0xFF; 08219 08220 dp_flag = ((*value) >> DV_DP_SHIFT) & 1; 08221 08222 kind_star = ((*value) >> DV_KIND_STAR_SHIFT) & 07; 08223 08224 int_len = ((*value) >> DV_INT_LEN_SHIFT) & 0xFFF; 08225 08226 dec_len = ((*value) >> DV_DEC_LEN_SHIFT) & 0xFF; 08227 # endif 08228 08229 switch (dv_type) { 08230 case DV_TYPELESS: 08231 fprintf(out_file, "%sDV_TYPELESS ", shift); 08232 break; 08233 case DV_INTEGER: 08234 fprintf(out_file, "%sDV_INTEGER ", shift); 08235 break; 08236 case DV_REAL: 08237 fprintf(out_file, "%sDV_REAL ", shift); 08238 break; 08239 case DV_COMPLEX: 08240 fprintf(out_file, "%sDV_COMPLEX ", shift); 08241 break; 08242 case DV_LOGICAL: 08243 fprintf(out_file, "%sDV_LOGICAL ", shift); 08244 break; 08245 case DV_ASCII_CHAR: 08246 fprintf(out_file, "%sDV_ASCII_CHAR ", shift); 08247 break; 08248 case DV_ASCII_CHAR_SEQUENCE_STRUCT: 08249 fprintf(out_file, "%sDV_ASCII_CHAR_SEQUENCE_STRUCT ", shift); 08250 break; 08251 case DV_STRUCT: 08252 fprintf(out_file, "%sDV_STRUCT ", shift); 08253 break; 08254 case DV_BIT: 08255 fprintf(out_file, "%sDV_BIT ", shift); 08256 break; 08257 case DV_2_BYTE_CHAR: 08258 fprintf(out_file, "%sDV_2_BYTE_CHAR ", shift); 08259 break; 08260 case DV_2_BYTE_CHAR_SEQUENCE_STRUCT: 08261 fprintf(out_file, "%sDV_2_BYTE_CHAR_SEQUENCE_STRUCT ", shift); 08262 break; 08263 case DV_4_BYTE_CHAR: 08264 fprintf(out_file, "%sDV_4_BYTE_CHAR ", shift); 08265 break; 08266 case DV_4_BYTE_CHAR_SEQUENCE_STRUCT: 08267 fprintf(out_file, "%sDV_4_BYTE_CHAR_SEQUENCE_STRUCT ", shift); 08268 break; 08269 default: 08270 fprintf(out_file, "\n*FE90-ERROR* bad dv_type from io_type code\n"); 08271 break; 08272 } 08273 08274 if (dp_flag) { 08275 fprintf(out_file, "DP = 1 "); 08276 } 08277 else { 08278 fprintf(out_file, "DP = 0 "); 08279 } 08280 08281 switch (kind_star) { 08282 case DV_DEFAULT_TYPED : 08283 fprintf(out_file, "DEFAULT TYPED "); 08284 break; 08285 08286 case DV_KIND_TYPED : 08287 fprintf(out_file, "KIND_TYPED "); 08288 break; 08289 08290 case DV_STAR_TYPED : 08291 fprintf(out_file, "STAR_TYPED "); 08292 break; 08293 08294 case DV_KIND_CONST : 08295 fprintf(out_file, "KIND_CONST "); 08296 break; 08297 08298 case DV_KIND_DOUBLE : 08299 fprintf(out_file, "KIND_DOUBLE "); 08300 break; 08301 08302 08303 default : 08304 fprintf(out_file, "***INVALID*** "); 08305 break; 08306 08307 } 08308 08309 #if defined(_HOST32) && defined(_TARGET64) 08310 fprintf(out_file,"INT_LEN = %" LONG_TYPE_FMT " ", int_len); 08311 fprintf(out_file,"DEC_LEN = %" LONG_TYPE_FMT " ", dec_len); 08312 #else 08313 fprintf(out_file,"INT_LEN = %ld ", int_len); 08314 fprintf(out_file,"DEC_LEN = %ld ", dec_len); 08315 #endif 08316 08317 08318 fprintf(out_file, "\n"); 08319 08320 TRACE (Func_Exit, "dump_io_type_code_ntry", NULL); 08321 08322 return; 08323 08324 } /* dump_io_type_code_ntry */ 08325 08326 # endif
1.7.6.1 
