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 // ==================================================================== 00038 // 00039 // 00040 // Revision history: 00041 // 16-Jul-96: Original Version 00042 // 00043 // Description: 00044 // Routines used in cloning of subroutines based on 00045 // the distribution of reshaped array arguments. 00046 // 00047 // ==================================================================== 00048 // ==================================================================== 00049 00050 #define ONST(x, y) (y) 00051 00052 #include <alloca.h> // alloca 00053 #include <unistd.h> // write 00054 00055 #include "pu_info.h" // PU_Info 00056 00057 #include "defs.h" // Standard definitions 00058 #include "wn.h" // WN 00059 #include "wn_map.h" // Current_Map_Tab 00060 #include "wn_util.h" // WN_INSERT_BlockAfter 00061 #include "symtab.h" 00062 #include "strtab.h" // Save_Str 00063 #include "mempool.h" // MEM_POOL 00064 #include "cxx_memory.h" // CXX_NEW 00065 #include "erbe.h" // EC_* 00066 #include "errors.h" // ErrMsg, ErrMsgSrcpos 00067 #include "dwarf_DST_mem.h" // DST_IDX 00068 #include "clone.h" // IPO_CLONE 00069 #include "clone_DST_utils.h" // DST_enter_cloned_subroutine 00070 #include "dra_demangle.h" // DRA_Demangle 00071 00072 #include "dra_internal.h" // Internal DRA interface 00073 00074 00075 00076 // ===================================================================== 00077 // 00078 // Local function prototypes 00079 // 00080 // ===================================================================== 00081 00082 static BOOL DRA_Clone_Initialize(void); 00083 00084 static BOOL DRA_Process_Requests(char *tir_names); 00085 00086 static BOOL DRA_Parse_Clone_Name(char *clone_name); 00087 00088 static void DRA_Clone_Instantiate(PU_Info *orig_pu, 00089 BOOL pu_has_feedback, 00090 STRING_LIST *tir_list, 00091 DRA_HASH_TABLE *dra_table); 00092 00093 static char* DRA_New_Clone_Sig(WN *pu_wn, 00094 char *clone_name, 00095 DRA_HASH_TABLE *dra_table); 00096 00097 static void DRA_Add_Clone (PU_Info *orig_pu, 00098 MEM_POOL *mem_pool, 00099 STR_IDX clone_name, 00100 char *arg_sig, 00101 BOOL pu_has_feedback); 00102 00103 static void DRA_Insert_Pragmas(WN *pu_wn, 00104 char *arg_sig); 00105 00106 static void DRA_Process_Commons(DRA_HASH_TABLE *dra_table, 00107 DRA_COMMON_HASH_TABLE*); 00108 00109 static void DRA_Collect_Commons(WN *pu, 00110 DRA_COMMON_HASH_TABLE *dra_common_ht); 00111 00112 static void DRA_Process_Globals(DRA_HASH_TABLE *dra_table); 00113 00114 static BOOL DRA_Info_Matches_Encoding(DRA_INFO *dra, 00115 char *arg_sig); 00116 00117 // ===================================================================== 00118 // 00119 // Exported variables 00120 // 00121 // ===================================================================== 00122 00123 BOOL Run_Dsm_Cloner = FALSE; 00124 00125 BOOL Run_Dsm_Common_Check = FALSE; 00126 00127 BOOL Run_Dsm_Check = FALSE; 00128 00129 NAME_ST_TABLE *DRA_func_table = NULL; 00130 00131 MEM_POOL DRA_name_pool, *DRA_name_pool_ptr = NULL; 00132 00133 DRA_GLOBAL_HASH_TABLE* dra_global = NULL; 00134 00135 // ===================================================================== 00136 // 00137 // File static variables 00138 // 00139 // ===================================================================== 00140 00141 static STRING_LIST_TABLE *DRA_clone_table; 00142 00143 static MEM_POOL DRA_clone_pool, *DRA_clone_pool_ptr = NULL; 00144 00145 static MEM_POOL DRA_check_pool, *DRA_check_pool_ptr = NULL; 00146 00147 00148 // ===================================================================== 00149 // 00150 // Exported function definitions 00151 // 00152 // ===================================================================== 00153 00154 00155 // ===================================================================== 00156 // 00157 // Function Name: Get_Orig_Type 00158 // 00159 // Description: Given an ST return the ST_type it originally had. 00160 // Same as ST_type, except when called on reshaped globals 00161 // whose type has been mangled. 00162 // 00163 // ===================================================================== 00164 00165 extern TY_IDX Get_Original_Type (ST* st) { 00166 00167 TY_IDX ty; 00168 00169 if (ST_class(st) != CLASS_VAR) return ST_type(st); 00170 00171 if (ONST(ST_is_global(st),ST_level(st) == GLOBAL_SYMTAB) && 00172 ST_is_reshaped(st)) { 00173 00174 DRA_GLOBAL_INFO* dgi = dra_global->Find(st); 00175 00176 if (dgi) { 00177 // has been seen before 00178 ty = dgi->Get_TY(); 00179 } 00180 else { 00181 // seeing it for the first time 00182 ty = ST_type(st); 00183 DRA_GLOBAL_INFO* dgi = CXX_NEW (DRA_GLOBAL_INFO(ty), Malloc_Mem_Pool); 00184 dra_global->Enter (st, dgi); 00185 } 00186 } 00187 else { 00188 ty = ST_type(st); 00189 } 00190 return ty; 00191 } 00192 00193 // ===================================================================== 00194 // 00195 // Function Name: Get_Array_Type 00196 // 00197 // Description: Given the ST for a distributed array, return the array TY. 00198 // 00199 // ===================================================================== 00200 00201 extern TY_IDX Get_Array_Type (ST* st) { 00202 00203 TY_IDX ty; 00204 00205 ty = Get_Original_Type (st); 00206 00207 if (TY_kind(ty) == KIND_POINTER && 00208 (ST_sclass(st) == SCLASS_FORMAL || 00209 ST_sclass(st) == SCLASS_AUTO || 00210 (ONST(ST_sclass(st)==SCLASS_BASED, ST_base_idx(st)==ST_st_idx(st)) && 00211 ST_sclass(ST_base(st)) == SCLASS_AUTO))) { 00212 ty = TY_pointed(ty); 00213 } 00214 00215 return ty; 00216 } 00217 00218 00219 extern "C" void 00220 DRA_Initialize(void) 00221 { 00222 DRA_Open_And_Map_File(); 00223 00224 if (Run_Dsm_Cloner && DRA_Clone_Initialize()) { 00225 Set_FILE_INFO_needs_lno (File_info); 00226 } 00227 00228 if (Run_Dsm_Common_Check) { 00229 MEM_POOL_Initialize (&DRA_check_pool, "DRA Common Check", TRUE); 00230 DRA_check_pool_ptr = &DRA_check_pool; 00231 DRA_Set_Write_Location(); 00232 } 00233 00234 if (Run_Dsm_Check) { 00235 DRA_EC_Declare_Types(); 00236 } 00237 00238 // information about globals must survive PUs 00239 dra_global = CXX_NEW (DRA_GLOBAL_HASH_TABLE(20, Malloc_Mem_Pool), 00240 Malloc_Mem_Pool); 00241 } 00242 00243 00244 00245 00246 // ===================================================================== 00247 // 00248 // Function Name: DRA_Finalize 00249 // 00250 // Description: Pop and Delete DRA_clone_pool if necessary 00251 // 00252 // ===================================================================== 00253 00254 extern "C" void 00255 DRA_Finalize (void) 00256 { 00257 ST *st; 00258 00259 // delete info about distributed globals 00260 // 00261 { 00262 HASH_TABLE_ITER<ST*, DRA_GLOBAL_INFO*> iter (dra_global); 00263 ST* st; 00264 DRA_GLOBAL_INFO* dgi; 00265 while (iter.Step (&st, &dgi)) { 00266 CXX_DELETE (dgi, Malloc_Mem_Pool); 00267 } 00268 CXX_DELETE (dra_global, Malloc_Mem_Pool); 00269 dra_global = NULL; 00270 } 00271 00272 // Make the symbols that are not used invisible 00273 // 00274 INT i; 00275 FOREACH_SYMBOL (GLOBAL_SYMTAB, st, i) { 00276 if (ST_is_not_used(st) && 00277 ST_class(st) == CLASS_FUNC && 00278 ST_sclass(st) == SCLASS_EXTERN && 00279 !PU_has_non_mangled_call(Pu_Table[ST_pu(*st)])) { 00280 Set_ST_export(st, EXPORT_LOCAL); 00281 Set_ST_sclass(st, SCLASS_TEXT); 00282 } 00283 } 00284 00285 // Emit type 'N' symbols for all cloned functions 00286 // that are referenced in the same file 00287 // 00288 if (DRA_func_table != NULL) { 00289 00290 NAME_ST_TABLE_ITER iter(DRA_func_table); 00291 STR_IDX func_name; 00292 MANGLED_FUNC *func_desc; 00293 00294 while (iter.Step(&func_name, &func_desc)) { 00295 00296 if (func_desc->is_clone && func_desc->is_called) { 00297 ST* aux_st = New_ST (GLOBAL_SYMTAB); 00298 ST_Init (aux_st, 00299 func_name, 00300 CLASS_NAME, 00301 SCLASS_UNKNOWN, 00302 EXPORT_LOCAL, 00303 (TY_IDX) NULL); 00304 Set_ST_is_not_used(aux_st); 00305 Set_ST_emit_symbol(aux_st); 00306 } 00307 } 00308 } 00309 00310 if (DRA_clone_pool_ptr != NULL) { 00311 MEM_POOL_Pop (DRA_clone_pool_ptr); 00312 MEM_POOL_Delete (DRA_clone_pool_ptr); 00313 DRA_clone_pool_ptr = NULL; 00314 } 00315 00316 if (DRA_check_pool_ptr != NULL) { 00317 MEM_POOL_Delete (DRA_check_pool_ptr); 00318 DRA_check_pool_ptr = NULL; 00319 } 00320 00321 DRA_Close_File(); 00322 } 00323 00324 00325 00326 00327 // ===================================================================== 00328 // 00329 // Function Name: DRA_Processing 00330 // 00331 // Description: Main driver for DRA related tasks - reading pragmas, 00332 // cloning, name mangling, and common block processing 00333 // 00334 // ===================================================================== 00335 00336 extern "C" void 00337 DRA_Processing(PU_Info *pu_info, 00338 WN* pu, 00339 BOOL pu_has_feedback) 00340 { 00341 STRING_LIST *clone_requests = NULL; 00342 DRA_HASH_TABLE *dra_table = NULL; 00343 00344 Set_Error_Phase("DRA Processing"); 00345 00346 if (Run_Dsm_Cloner) { 00347 clone_requests = DRA_clone_table->Find(ST_name_idx(WN_st(pu))); 00348 } 00349 00350 if (clone_requests != NULL || // we need to clone 00351 Run_Dsm_Common_Check || // we need to process commons 00352 ONST(SYMTAB_mp_needs_lno(Current_Symtab), // we need to mangle names 00353 PU_mp_needs_lno (Get_Current_PU()))) { 00354 00355 // Initialize and push DRA_name_pool to be used for DRA_HASH_TABLE 00356 // 00357 DRA_name_pool_ptr = &DRA_name_pool; 00358 MEM_POOL_Initialize (DRA_name_pool_ptr, "DRA Names", FALSE); 00359 MEM_POOL_Push (DRA_name_pool_ptr); 00360 00361 // Create dra_table that stores the info about all DRA's 00362 // 00363 dra_table = CXX_NEW(DRA_HASH_TABLE(31, DRA_name_pool_ptr), 00364 DRA_name_pool_ptr); 00365 00366 DRA_Read_Pragmas(pu, dra_table); 00367 } 00368 00369 if (clone_requests != NULL) { 00370 DRA_Clone_Instantiate(pu_info, pu_has_feedback, clone_requests, dra_table); 00371 } 00372 00373 if (Run_Dsm_Common_Check) { 00374 MEM_POOL_Push (DRA_check_pool_ptr); 00375 DRA_COMMON_HASH_TABLE 00376 *dra_common_ht = CXX_NEW (DRA_COMMON_HASH_TABLE(20, DRA_check_pool_ptr), 00377 DRA_check_pool_ptr); 00378 00379 DRA_Collect_Commons(pu, dra_common_ht); 00380 DRA_Process_Commons(dra_table, dra_common_ht); 00381 00382 CXX_DELETE (dra_common_ht, DRA_check_pool_ptr); 00383 MEM_POOL_Pop (DRA_check_pool_ptr); 00384 00385 // Also write out information about globals (C, C++) into rii_file 00386 // 00387 DRA_Process_Globals(dra_table); 00388 } 00389 00390 if (dra_table->Num_Entries() > 0) { 00391 DRA_Mangle_All(pu, dra_table, pu_info); 00392 Set_PU_no_inline(Pu_Table[ST_pu(WN_st(pu))]); 00393 } 00394 else { 00395 Set_PU_has_non_mangled_call(Pu_Table[ST_pu(WN_st(pu))]); 00396 Clear_ST_is_not_used(WN_st(pu)); 00397 } 00398 00399 if (Run_Dsm_Check) { 00400 DRA_EC_Array_Portion_Parms(pu, pu); 00401 00402 if (ONST(SYMTAB_has_altentry(Current_Symtab), 00403 PU_has_altentry (Get_Current_PU()))) { 00404 // Walk the tree and process alternate entry points 00405 // 00406 WN_ITER *wni; 00407 for (wni = WN_WALK_TreeIter(pu); wni; wni = WN_WALK_TreeNext(wni)) { 00408 if (WN_opcode(WN_ITER_wn(wni)) == OPC_ALTENTRY) { 00409 DRA_EC_Array_Portion_Parms(pu, WN_ITER_wn(wni)); 00410 } 00411 } 00412 } 00413 } 00414 00415 // Pop and Delete DRA_name_pool 00416 // 00417 if (DRA_name_pool_ptr != NULL) { 00418 MEM_POOL_Pop (DRA_name_pool_ptr); 00419 MEM_POOL_Delete (DRA_name_pool_ptr); 00420 DRA_name_pool_ptr = NULL; 00421 } 00422 } 00423 00424 00425 00426 00427 // ===================================================================== 00428 // 00429 // Local function definitions 00430 // 00431 // ===================================================================== 00432 00433 00434 // ===================================================================== 00435 // 00436 // Function Name: DRA_Clone_Initialize 00437 // 00438 // Description: Process .rii file and return TRUE if Template 00439 // Instatiation Requests (TIR's) have been found. 00440 // 00441 // ===================================================================== 00442 00443 static BOOL 00444 DRA_Clone_Initialize(void) 00445 { 00446 // Initialize DRA_clone_pool to be used for cloning 00447 // This MEM_POOL lives throughout the compilation of the file 00448 // 00449 MEM_POOL_Initialize (&DRA_clone_pool, "DRA Cloning", TRUE); 00450 DRA_clone_pool_ptr = &DRA_clone_pool; 00451 MEM_POOL_Push (DRA_clone_pool_ptr); 00452 00453 // From now on use DRA_file_mmap as a normal memory pointer 00454 // 00455 char *tir_names = strstr(DRA_file_mmap, DRA_FILE_SEPARATOR) 00456 + strlen(DRA_FILE_SEPARATOR); 00457 00458 // Allocate the TIR name table 00459 // Use DRA_clone_pool because the table must live across all PU's 00460 // 00461 DRA_clone_table = CXX_NEW(STRING_LIST_TABLE(31, DRA_clone_pool_ptr), 00462 DRA_clone_pool_ptr); 00463 00464 // and store all TIR names in it 00465 // 00466 BOOL needs_cloning = DRA_Process_Requests(tir_names); 00467 00468 // Allocate the global name/ST hash table used for resolving names 00469 // 00470 if (DRA_func_table == NULL) { 00471 DRA_func_table = CXX_NEW(NAME_ST_TABLE(31, &MEM_src_pool), 00472 &MEM_src_pool); 00473 } 00474 00475 DRA_Mem_Unmap_File(); 00476 00477 return needs_cloning; 00478 } 00479 00480 00481 00482 00483 // ===================================================================== 00484 // 00485 // Function Name: DRA_Process_Requests 00486 // 00487 // Description: Read the TIR names from .rii file and store them 00488 // into a hash table. Keys are the original names of 00489 // functions, while the entries represent linked lists 00490 // of the names that need to be instantiated. 00491 // 00492 // ===================================================================== 00493 00494 static BOOL 00495 DRA_Process_Requests(char *tir_name) 00496 { 00497 BOOL needs_cloning = FALSE; 00498 00499 // Replace "----" with the string terminator '\0' 00500 // 00501 char *end_tir_names = strstr(tir_name, DRA_FILE_SEPARATOR); 00502 if (end_tir_names != NULL) { 00503 *end_tir_names = '\0'; 00504 } 00505 00506 00507 char *end_of_line; 00508 for ( ; *tir_name; *end_of_line = '\n', tir_name = end_of_line+1) { 00509 00510 // find the of the line 00511 // 00512 if ((end_of_line = strchr(tir_name, '\n')) == NULL) { 00513 break; 00514 } 00515 00516 // replace eol with the string terminator 00517 // 00518 *end_of_line = '\0'; 00519 00520 // Parse tir_name for correctness 00521 // 00522 if (!DRA_Parse_Clone_Name(tir_name)) { 00523 (void) unlink(DRA_file_name); 00524 ErrMsg(EC_DRA_rii_file_format, DRA_file_name); 00525 return FALSE; 00526 } 00527 00528 char *orig_name = tir_name + DRA_MANGLE_SIG_LEN; 00529 char *postfix_sig = strstr(orig_name, DRA_MANGLE_SIG); 00530 00531 STR_IDX save_tir_name = Save_Str(tir_name); 00532 00533 *postfix_sig = '\0'; 00534 00535 STR_IDX save_orig_name = Save_Str(orig_name); 00536 00537 // restore original contents of overwritten location 00538 // 00539 *postfix_sig = DRA_MANGLE_SIG[0]; 00540 00541 00542 // Get the list of TIR's corresponding to the original function 00543 // 00544 STRING_LIST *tir_list = DRA_clone_table->Find(save_orig_name); 00545 00546 // If it has been created, do it now 00547 // 00548 if (tir_list == NULL) { 00549 tir_list = CXX_NEW(STRING_LIST(), DRA_clone_pool_ptr); 00550 DRA_clone_table->Enter(save_orig_name, tir_list); 00551 } 00552 00553 // Add the tir name to the list 00554 // 00555 STRING_NODE *tir_node = 00556 CXX_NEW(STRING_NODE(save_tir_name), DRA_clone_pool_ptr); 00557 tir_list->Append(tir_node); 00558 00559 needs_cloning = TRUE; 00560 } 00561 00562 00563 // restore original contents of overwritten locations 00564 // 00565 if (end_tir_names != NULL) { 00566 *end_tir_names = DRA_FILE_SEPARATOR[0]; 00567 } 00568 00569 return needs_cloning; 00570 } 00571 00572 00573 00574 00575 // ===================================================================== 00576 // 00577 // Function Name: DRA_Parse_Clone_Name 00578 // 00579 // Description: Parse the name read from .rii file to make sure 00580 // it can be used to generate meaningful pragmas, 00581 // 00582 // ===================================================================== 00583 00584 static BOOL 00585 DRA_Parse_Clone_Name(char *clone_name) 00586 { 00587 // Check for DRA mangling prefix 00588 // 00589 if (strncmp(clone_name, DRA_MANGLE_SIG, DRA_MANGLE_SIG_LEN) != 0) 00590 return FALSE; 00591 00592 char *arg_sig = strstr(clone_name + DRA_MANGLE_SIG_LEN, DRA_MANGLE_SIG); 00593 00594 // Check for DRA mangling suffix 00595 // 00596 if (arg_sig == NULL || *(arg_sig += DRA_MANGLE_SIG_LEN) == 0) 00597 return FALSE; 00598 00599 00600 // Check the parameter list 00601 // 00602 for ( ; *arg_sig; ) { 00603 00604 char *current; 00605 00606 // Check number of dimensions: 00607 // INT16; non-negative; if 0, it must be followed by _ 00608 // 00609 INT64 num_dims = (INT64) strtol(arg_sig, ¤t, 10); 00610 00611 if (current == arg_sig) 00612 return FALSE; 00613 00614 if (num_dims == 0) { 00615 if (*current++ != DRA_ARG_SEPARATOR) 00616 return FALSE; 00617 else { 00618 arg_sig = current; 00619 continue; 00620 } 00621 } 00622 00623 if (num_dims < 0 || num_dims > INT16_MAX) 00624 return FALSE; 00625 00626 // Check array element size: 00627 // INT64; positive; must be surrounded by D and E 00628 // 00629 if (*current++ != DRA_NDIMS_END) 00630 return FALSE; 00631 00632 arg_sig = current; 00633 00634 INT64 esize = (INT64) strtol(arg_sig, ¤t, 10); 00635 00636 if (current == arg_sig || esize <= 0 || *current++ != DRA_ESIZE_END) 00637 return FALSE; 00638 00639 arg_sig = current; 00640 00641 // Check distributions in all dimensions: 00642 // B, C, or S; C may be followed by a positive INT64 00643 // 00644 for (INT16 dim = 0; dim < num_dims; dim++) { 00645 00646 if (*arg_sig == DRA_BLOCK_CODE || *arg_sig == DRA_STAR_CODE) { 00647 arg_sig++; 00648 continue; 00649 } 00650 00651 else if (*arg_sig == DRA_CYCLIC_CODE) { 00652 00653 if (arg_sig[1] == DRA_BLOCK_CODE || 00654 arg_sig[1] == DRA_STAR_CODE || 00655 arg_sig[1] == DRA_CYCLIC_CODE || 00656 (arg_sig[1] == DRA_ARG_SEPARATOR && dim == num_dims-1)) { 00657 arg_sig++; 00658 continue; 00659 } 00660 00661 arg_sig++; 00662 00663 INT64 chunk = (INT64) strtol(arg_sig, ¤t, 10); 00664 00665 if (current == arg_sig || chunk <= 0) 00666 return FALSE; 00667 00668 arg_sig = current; 00669 } 00670 00671 else 00672 return FALSE; 00673 } 00674 00675 if (*arg_sig++ != DRA_ARG_SEPARATOR) 00676 return FALSE; 00677 } 00678 00679 return TRUE; 00680 } 00681 00682 00683 00684 00685 // ===================================================================== 00686 // 00687 // Function Name: DRA_Clone_Instantiate 00688 // 00689 // Description: Instantiate all the clones found in the TIR table 00690 // that correspond to the passed PU. 00691 // 00692 // ===================================================================== 00693 00694 static void 00695 DRA_Clone_Instantiate(PU_Info *orig_pu, 00696 BOOL pu_has_feedback, 00697 STRING_LIST *tir_list, 00698 DRA_HASH_TABLE *dra_table) 00699 { 00700 // The cloner cannot handle routines with alternate entry points 00701 // 00702 if (ONST(SYMTAB_has_altentry(Current_Symtab), 00703 PU_has_altentry(Get_Current_PU()))) { 00704 ErrMsgSrcpos(EC_DRA_clone_altentry, 00705 WN_Get_Linenum(PU_Info_tree_ptr(orig_pu))); 00706 return; 00707 } 00708 00709 // Iterate over the string list 00710 // 00711 STRING_ITER tir_iter(tir_list); 00712 STRING_NODE *n; 00713 00714 for (n = tir_iter.First(); !tir_iter.Is_Empty(); n = tir_iter.Next()) { 00715 00716 STR_IDX clone_name = n->String(); 00717 00718 // Get clone argument signature that ignores formal parameters 00719 // that already have DISTRIBUTE_RESHAPE specification. 00720 // 00721 char *arg_sig = DRA_New_Clone_Sig(PU_Info_tree_ptr(orig_pu), 00722 Index_To_Str(clone_name), 00723 dra_table); 00724 00725 // NULL signature is used to flag inconsistent cloning requests 00726 // 00727 if (arg_sig != NULL) { 00728 DRA_Add_Clone(orig_pu, 00729 DRA_clone_pool_ptr, 00730 clone_name, 00731 arg_sig, 00732 pu_has_feedback); 00733 } 00734 } 00735 } 00736 00737 00738 00739 00740 // ===================================================================== 00741 // 00742 // Function Name: DRA_New_Clone_Sig 00743 // 00744 // Description: Given a PU and an instantiation request, return the 00745 // clone argument signature that ignores formal parameters 00746 // that already have DISTRIBUTE_RESHAPE directive. In case 00747 // of errors, return NULL. 00748 // 00749 // ===================================================================== 00750 00751 static char* 00752 DRA_New_Clone_Sig(WN *pu_wn, 00753 char *clone_name, 00754 DRA_HASH_TABLE *dra_table) 00755 { 00756 Set_Error_Phase("Instantiating DRA Clones"); 00757 00758 FmtAssert(strncmp(clone_name, DRA_MANGLE_SIG, DRA_MANGLE_SIG_LEN) == 0, 00759 ("The name of a DRA clone does not have DRA_MANGLE_SIG prefix")); 00760 00761 char *arg_sig = strstr(clone_name + DRA_MANGLE_SIG_LEN, DRA_MANGLE_SIG); 00762 00763 FmtAssert(arg_sig != NULL, 00764 ("The name of a DRA clone does not have DRA_MANGLE_SIG postfix")); 00765 00766 arg_sig += DRA_MANGLE_SIG_LEN; 00767 00768 char *buf = CXX_NEW_ARRAY(char, strlen(arg_sig)+1, DRA_name_pool_ptr); 00769 char *bufptr = buf; 00770 00771 char *dim_sig; 00772 00773 00774 INT16 arg_pos; 00775 for ( arg_pos = 0; *arg_sig; arg_sig++, arg_pos++ ) { 00776 00777 ST *arg_st = WN_st(WN_kid(pu_wn, arg_pos)); 00778 00779 if (arg_st == NULL) { 00780 // This warning should be deleted once the testing is finished 00781 // 00782 ErrMsgSrcpos(EC_DRA_bad_clone_request, 00783 WN_Get_Linenum(pu_wn), 00784 DRA_Demangle(clone_name, DRA_DIMS_COLUMNWISE), 00785 "cannot be satisfied -- too many arguments passed or types mismatch"); 00786 // Do not clone in the presence of errors! 00787 // 00788 return NULL; 00789 } 00790 00791 // Extract the number of dimensions 00792 // 00793 TY_IDX arg_ty = Get_Array_Type(arg_st); 00794 DRA_INFO *dra = dra_table->Find(arg_st); 00795 INT16 num_dims = (INT16) strtol (arg_sig, &dim_sig, 10); 00796 00797 // Do some consistency checking 00798 // 00799 if (num_dims == 0) { 00800 if (dra != NULL) { 00801 // This warning should be deleted once the testing is finished 00802 // 00803 ErrMsgSrcpos(EC_DRA_bad_clone_request, 00804 WN_Get_Linenum(pu_wn), 00805 DRA_Demangle(clone_name, DRA_DIMS_COLUMNWISE), 00806 "cannot be satisfied -- non-reshaped argument passed to reshaped formal parameter"); 00807 // Do not clone in the presence of errors! 00808 // 00809 return NULL; 00810 } 00811 else { 00812 arg_sig = strchr(arg_sig, DRA_ARG_SEPARATOR); 00813 *bufptr++ = '0'; 00814 *bufptr++ = DRA_ARG_SEPARATOR; 00815 continue; 00816 } 00817 } 00818 00819 // From now on num_dims must be > 0 00820 // 00821 00822 if (TY_kind(arg_ty) != KIND_ARRAY) { 00823 // This warning should be deleted once the testing is finished 00824 // 00825 ErrMsgSrcpos(EC_DRA_bad_clone_request, 00826 WN_Get_Linenum(pu_wn), 00827 DRA_Demangle(clone_name, DRA_DIMS_COLUMNWISE), 00828 "cannot be satisfied -- reshaped argument passed to a non-array formal parameter"); 00829 // Do not clone in the presence of errors! 00830 // 00831 return NULL; 00832 } 00833 00834 if (num_dims != TY_AR_ndims(arg_ty) || 00835 (dra != NULL && num_dims != dra->Num_Dims())) { 00836 // This warning should be deleted once the testing is finished 00837 // 00838 ErrMsgSrcpos(EC_DRA_bad_clone_request, 00839 WN_Get_Linenum(pu_wn), 00840 DRA_Demangle(clone_name, DRA_DIMS_COLUMNWISE), 00841 "cannot be satisfied -- reshaped argument and matching formal parameter have different ranks"); 00842 // Do not clone in the presence of errors! 00843 // 00844 return NULL; 00845 } 00846 00847 00848 INT64 elem_size = (INT64) strtol(dim_sig+1, &dim_sig, 10); 00849 00850 if (elem_size != TY_size(TY_AR_etype(arg_ty)) || 00851 (dra != NULL && elem_size != dra->Element_Size())) { 00852 // This warning should be deleted once the testing is finished 00853 // 00854 ErrMsgSrcpos(EC_DRA_bad_clone_request, 00855 WN_Get_Linenum(pu_wn), 00856 DRA_Demangle(clone_name, DRA_DIMS_COLUMNWISE), 00857 "cannot be satisfied -- reshaped argument and matching formal parameter have different element sizes"); 00858 // Do not clone in the presence of errors! 00859 // 00860 return NULL; 00861 } 00862 00863 00864 if (dra != NULL) { 00865 // dim_sig points to 'D'; skip it to process element size first 00866 // 00867 if (!DRA_Info_Matches_Encoding(dra, dim_sig+1)) { 00868 // This warning should be deleted once the testing is finished 00869 // 00870 ErrMsgSrcpos(EC_DRA_bad_clone_request, 00871 WN_Get_Linenum(pu_wn), 00872 DRA_Demangle(clone_name, DRA_DIMS_COLUMNWISE), 00873 "cannot be satisfied -- reshaping distributions of arguments and formal parameters do not match"); 00874 // Do not clone in the presence of errors! 00875 // 00876 return NULL; 00877 } 00878 else { 00879 // Ignore this DRA because it's already specified 00880 // 00881 arg_sig = strchr(arg_sig, DRA_ARG_SEPARATOR); 00882 *bufptr++ = '0'; 00883 *bufptr++ = DRA_ARG_SEPARATOR; 00884 continue; 00885 } 00886 } 00887 00888 // dra is NULL, and we need to insert pragma for this parameter 00889 00890 // Copy ndims (digits before 'D') 00891 // 00892 while (*arg_sig != DRA_NDIMS_END) { 00893 *bufptr++ = *arg_sig++; 00894 } 00895 00896 // Skip D<esize>E 00897 // 00898 arg_sig++; 00899 while (*arg_sig++ != DRA_ESIZE_END); 00900 00901 // Copy distribution encodings 00902 // 00903 while (*arg_sig != DRA_ARG_SEPARATOR) { 00904 *bufptr++ = *arg_sig++; 00905 } 00906 *bufptr++ = DRA_ARG_SEPARATOR; 00907 } 00908 00909 // Do not clone if no new pragmas are needed 00910 // 00911 if (bufptr == buf) { 00912 return NULL; 00913 } 00914 00915 *bufptr = '\0'; 00916 00917 00918 // If the number of actual arguments is less than the number of 00919 // formal parameters, we still clone but also warn the user 00920 // 00921 if (arg_pos < WN_num_formals(pu_wn)) { 00922 ErrMsgSrcpos(EC_DRA_bad_clone_request, 00923 WN_Get_Linenum(pu_wn), 00924 DRA_Demangle(clone_name, DRA_DIMS_COLUMNWISE), 00925 "has incomplete argument list"); 00926 } 00927 00928 return buf; 00929 } 00930 00931 00932 00933 00934 // ===================================================================== 00935 // 00936 // Function Name: DRA_Add_Clone 00937 // 00938 // Description: Clone the PU whose PU_Info structure is passed in 00939 // and add it to the PU list. 00940 // 00941 // The assumption is that WT_SYMTAB, WT_TREE, and 00942 // WT_PROC_SYM sections of the orig_pu are in state 00943 // Subsect_InMem. 00944 // 00945 // Returned PU_Info structure is allocated in the 00946 // Malloc_Mem_Pool. 00947 // 00948 // Local objects that disappear after the cloning 00949 // is finished are allocated from MEM_local_pool. 00950 // 00951 // Everything else (tree, map tables, symtabs (?), 00952 // DSTs) is allocated from the mem_pool that is 00953 // passed in, and the client has control over its 00954 // life-time. 00955 // 00956 // ===================================================================== 00957 00958 static void 00959 DRA_Add_Clone (PU_Info *orig_pu, 00960 MEM_POOL *mem_pool, 00961 STR_IDX clone_name, 00962 char *arg_sig, 00963 BOOL pu_has_feedback) 00964 { 00965 // Save current pointers to standard memory pools and scope table 00966 // 00967 MEM_POOL *save_pu_pool_ptr = MEM_pu_pool_ptr; 00968 MEM_POOL *save_wn_pool_ptr = WN_mem_pool_ptr; 00969 00970 // Save local symbol table of the original PU, since 00971 // cloning will overwrite its Scope_tab entry 00972 // 00973 Set_PU_Info_symtab_ptr(orig_pu, NULL); 00974 Save_Local_Symtab(CURRENT_SYMTAB, orig_pu); 00975 00976 // Use the given mem_pool for WN, ST, etc. 00977 // 00978 MEM_pu_pool_ptr = mem_pool; 00979 WN_mem_pool_ptr = mem_pool; 00980 00981 // Define a new IPO_CLONE object 00982 // 00983 IPO_CLONE clone(PU_Info_tree_ptr(orig_pu), 00984 Scope_tab, 00985 CURRENT_SYMTAB, 00986 PU_Info_maptab(orig_pu), 00987 mem_pool, 00988 mem_pool); 00989 00990 ST* orig_st = ST_ptr(PU_Info_proc_sym(orig_pu)); 00991 00992 // Lookup the clone name in the table of mangled names 00993 // 00994 MANGLED_FUNC *clone_desc = DRA_func_table->Find(clone_name); 00995 00996 // If not found, the new ST entry should be created 00997 // 00998 if (clone_desc == NULL) { 00999 clone_desc = CXX_NEW(MANGLED_FUNC, &MEM_src_pool); 01000 01001 // Create a PU 01002 PU_IDX pu_idx; 01003 PU& pu = New_PU (pu_idx); 01004 Pu_Table[pu_idx] = Pu_Table[ST_pu(orig_st)]; 01005 01006 // Make an ST: add function to global symbol table 01007 clone_desc->st = New_ST (ST_level(orig_st)); 01008 ST_Init (clone_desc->st, 01009 clone_name, 01010 CLASS_FUNC, 01011 SCLASS_TEXT, 01012 ST_export(orig_st), 01013 pu_idx); 01014 01015 clone_desc->is_called = FALSE; 01016 DRA_func_table->Enter(clone_name, clone_desc); 01017 } 01018 01019 clone_desc->is_clone = TRUE; 01020 Set_ST_sclass (clone_desc->st, SCLASS_TEXT); 01021 if (Run_cg) { 01022 Set_ST_base (clone_desc->st, ST_base(orig_st)); 01023 } 01024 01025 // This performs actual cloning 01026 // 01027 clone.New_Clone(clone_desc->st); 01028 01029 // Set frequencies to be the same as in the original PU 01030 // 01031 if (pu_has_feedback) { 01032 DevWarn("Need to fix up feedback in DRA_Add_Clone\n"); 01033 } 01034 #if TODO 01035 FEEDBACK cloned_fb(clone.Get_Cloned_PU(), mem_pool); 01036 FB_IPA_Clone(Cur_PU_Feedback, clone_node()->Feedback, 01037 WN_func_body(Callee_Wn ()), clone.Get_Cloned_PU(), 01038 1.0f); 01039 #endif 01040 01041 // Set the current scope entry to point to the clone 01042 // 01043 Scope_tab[CURRENT_SYMTAB] = 01044 clone.Get_sym()->Get_cloned_scope_tab()[CURRENT_SYMTAB]; 01045 Scope_tab[CURRENT_SYMTAB].st = clone_desc->st; 01046 01047 // Insert DISTRIBUTE_RESHAPE pragmas based on the argument signature 01048 // 01049 DRA_Insert_Pragmas(clone.Get_Cloned_PU(), arg_sig); 01050 01051 // Generate DST information for the clone 01052 // 01053 Set_FILE_INFO_has_inlines (File_info); 01054 DST_IDX new_pu_dst = 01055 DST_enter_cloned_subroutine(DST_get_compile_unit(), 01056 PU_Info_pu_dst(orig_pu), 01057 clone.Get_Func_ST(), 01058 Current_DST, 01059 clone.Get_sym()); 01060 01061 // Alocate and initialize PU_Info structure for the clone 01062 // 01063 PU_Info *new_pu = CXX_NEW(PU_Info, Malloc_Mem_Pool); 01064 PU_Info_init(new_pu); 01065 01066 // Add new pu right after the original pu 01067 // 01068 PU_Info_next(new_pu) = PU_Info_next(orig_pu); 01069 PU_Info_next(orig_pu) = new_pu; 01070 01071 // Update the PU pointers and state information 01072 // 01073 Set_PU_Info_flags(new_pu, PU_IS_COMPILER_GENERATED); 01074 Set_PU_Info_flags(new_pu, PU_IS_DRA_CLONE); 01075 Set_PU_Info_pu_dst(new_pu, new_pu_dst); 01076 01077 Set_PU_Info_tree_ptr(new_pu, clone.Get_Cloned_PU()); 01078 PU_Info_proc_sym(new_pu) = ST_st_idx(clone.Get_Func_ST()); 01079 PU_Info_maptab(new_pu) = clone.Get_Cloned_maptab(); 01080 01081 Set_PU_Info_state(new_pu, WT_TREE, Subsect_InMem); 01082 Set_PU_Info_state(new_pu, WT_SYMTAB, Subsect_InMem); 01083 Set_PU_Info_state(new_pu, WT_PROC_SYM, Subsect_InMem); 01084 #if 0 01085 Set_PU_Info_state(new_pu, WT_DEPGRAPH, Subsect_InMem); 01086 Set_PU_Info_depgraph_ptr(new_pu, NULL); 01087 #endif 01088 01089 if (pu_has_feedback) { 01090 Set_PU_Info_state(new_pu, WT_FREQ, Subsect_InMem); 01091 } 01092 01093 // Mark that clone requires LNO processing 01094 // 01095 Set_PU_mp_needs_lno(PU_Info_pu(new_pu)); 01096 01097 // Restore Curent_Map_Tab and Current_Symtab to those of the original PU 01098 // 01099 Current_Map_Tab = PU_Info_maptab(orig_pu); 01100 01101 // Restore pointers to standard memory pools 01102 // 01103 MEM_pu_pool_ptr = save_pu_pool_ptr; 01104 WN_mem_pool_ptr = save_wn_pool_ptr; 01105 01106 // Save local symbol table of the clone 01107 // 01108 Set_PU_Info_symtab_ptr(new_pu, NULL); 01109 Save_Local_Symtab(CURRENT_SYMTAB, new_pu); 01110 01111 // Restore local symbol table of the original PU 01112 // 01113 Restore_Local_Symtab(orig_pu); 01114 } 01115 01116 01117 01118 // ===================================================================== 01119 // 01120 // Function Name: Find_Insertion_Point 01121 // 01122 // Description: Find the place in the PU where we should start 01123 // inserting distribute_reshape pragmas. Ordinarily 01124 // it would be after the preamble, but in C/C++ 01125 // there are assignments to __vla_bound variables 01126 // that can occur after the PREAMBLE. In which case the 01127 // insertion point must be after the STIDs to those variables. 01128 // 01129 // ===================================================================== 01130 01131 static WN* 01132 Find_Insertion_Point (WN *pu_wn, 01133 char *arg_sig) 01134 { 01135 WN *preamble_wn = Get_Preamble_End(pu_wn); 01136 01137 if (ONST (SYMTAB_src_lang(Current_Symtab) != SYMTAB_C_LANG && 01138 SYMTAB_src_lang(Current_Symtab) != SYMTAB_CXX_LANG, 01139 PU_src_lang(Get_Current_PU()) != PU_C_LANG && 01140 PU_src_lang(Get_Current_PU()) != PU_CXX_LANG)) { 01141 return preamble_wn; 01142 } 01143 01144 WN *current_wn = preamble_wn; 01145 01146 for (INT16 arg_pos = 0; *arg_sig; arg_sig++, arg_pos++ ) { 01147 01148 // Extract the number of dimensions 01149 // 01150 INT16 num_dims = (INT16) strtol (arg_sig, &arg_sig, 10); 01151 ST *arg_st = WN_st(WN_kid(pu_wn, arg_pos)); 01152 TY_IDX arg_ty = Get_Array_Type(arg_st); 01153 01154 for (INT16 dim = 0; dim < num_dims; dim++) { 01155 01156 if (*arg_sig++ == DRA_CYCLIC_CODE) { 01157 INT64 chunk = (INT64) strtol (arg_sig, &arg_sig, 10); 01158 } 01159 // For each dimension see if the bound is __vla_bound 01160 // 01161 if (!TY_AR_const_ubnd(arg_ty, num_dims-1-dim) && 01162 TY_AR_ubnd_val(arg_ty, num_dims-1-dim) && 01163 strcmp(ST_name(TY_AR_ubnd_var(arg_ty, num_dims-1-dim)), 01164 "__vla_bound") == 0) { 01165 01166 ST* vlabound_st = ONST(WN_st(TY_AR_ubnd_tree(arg_ty, dim)), 01167 &(St_Table[TY_AR_ubnd_var(arg_ty, num_dims-1-dim)])); 01168 01169 // simple LDID for upper bound of __vla_bound 01170 // Find the STID in the tree 01171 BOOL saw_preamble = FALSE; 01172 BOOL saw_current = FALSE; 01173 WN *wn = WN_first(WN_func_body(pu_wn)); 01174 01175 while (wn) { 01176 01177 if (WN_operator(wn) == OPR_PRAGMA && 01178 WN_pragma(wn) == WN_PRAGMA_PREAMBLE_END) { 01179 saw_preamble = TRUE; 01180 } 01181 if (wn == current_wn) saw_current = TRUE; 01182 01183 if (WN_operator(wn) == OPR_STID && 01184 WN_st(wn) == vlabound_st) { 01185 01186 if (saw_preamble && saw_current) { 01187 // we must move current_wn 01188 // 01189 current_wn = wn; 01190 01191 // see if we're followed by an XPRAGMA-COPYIN 01192 if (WN_next(wn) && 01193 WN_operator(WN_next(wn)) == OPR_XPRAGMA && 01194 WN_operator(WN_kid0(WN_next(wn)))==OPR_LDID && 01195 WN_st(WN_kid0(WN_next(wn))) == vlabound_st) { 01196 01197 current_wn = WN_next(wn); 01198 } 01199 } 01200 else { 01201 // don't need to do anything 01202 } 01203 break; 01204 } 01205 wn = WN_next(wn); 01206 } 01207 01208 FmtAssert (wn, 01209 ("Find_Insertion_Point: No STID vla_bound for %s\n", 01210 ST_name(arg_st))); 01211 } 01212 } 01213 } 01214 return current_wn; 01215 } 01216 01217 01218 // ===================================================================== 01219 // 01220 // Function Name: DRA_Insert_Pragmas 01221 // 01222 // Description: Insert DISTRIBUTE_RESHAPE pragmas into the passed tree 01223 // based on the argument signature given by arg_sig. 01224 // 01225 // ===================================================================== 01226 01227 static void 01228 DRA_Insert_Pragmas(WN *pu_wn, 01229 char *arg_sig) 01230 { 01231 // strtol (char *str, char *ptr, INT base) returns as a long integer 01232 // the value represented by the character string pointed to by str. 01233 // The string is scanned up to the first character inconsistent with 01234 // the base. If the value of ptr is not (char **)NULL, a pointer to 01235 // the character terminating the scan is returned in the location 01236 // pointed to by ptr. If no integer can be formed, that location is 01237 // set to str, and zero is returned. 01238 01239 WN *block = WN_func_body(pu_wn); 01240 // WN *current = Get_Preamble_End(pu_wn); 01241 WN *current = Find_Insertion_Point(pu_wn, arg_sig); 01242 01243 for (INT16 arg_pos = 0; *arg_sig; arg_sig++, arg_pos++ ) { 01244 01245 // Extract the number of dimensions 01246 // 01247 INT16 num_dims = (INT16) strtol (arg_sig, &arg_sig, 10); 01248 ST *arg_st = WN_st(WN_kid(pu_wn, arg_pos)); 01249 TY_IDX arg_ty = Get_Array_Type(arg_st); 01250 01251 for (INT16 dim = 0; dim < num_dims; dim++) { 01252 01253 // For each dimension create a pragma node 01254 // 01255 WN *pwn = WN_CreatePragma(WN_PRAGMA_DISTRIBUTE_RESHAPE, arg_st, 0, 0); 01256 WN_pragma_index(pwn) = dim; 01257 01258 WN_set_pragma_compiler_generated(pwn); 01259 WN_INSERT_BlockAfter(block, current, pwn); // Need to fix this 01260 current = pwn; 01261 01262 switch (*arg_sig++) { 01263 01264 case DRA_BLOCK_CODE: 01265 WN_pragma_distr_type(pwn) = DISTRIBUTE_BLOCK; 01266 break; 01267 01268 case DRA_STAR_CODE: 01269 WN_pragma_distr_type(pwn) = DISTRIBUTE_STAR; 01270 break; 01271 01272 case DRA_CYCLIC_CODE: 01273 { 01274 INT64 chunk = (INT64) strtol (arg_sig, &arg_sig, 10); 01275 if (chunk != 0) { 01276 WN_pragma_distr_type(pwn) = DISTRIBUTE_CYCLIC_CONST; 01277 WN_pragma_arg2(pwn) = chunk; 01278 } 01279 else { 01280 // For CYCLIC_EXPR create an additional XPRAGMA node 01281 // 01282 WN_pragma_distr_type(pwn) = DISTRIBUTE_CYCLIC_EXPR; 01283 WN *xpwn = WN_CreateXpragma(WN_PRAGMA_DISTRIBUTE_RESHAPE, 01284 arg_st, 1); 01285 WN_kid(xpwn, 0) = WN_Intconst(MTYPE_I8, 0); 01286 01287 WN_set_pragma_compiler_generated(xpwn); 01288 WN_INSERT_BlockAfter(block, current, xpwn); 01289 current = xpwn; 01290 } 01291 } 01292 break; 01293 01294 default: 01295 FmtAssert(FALSE, 01296 ("Unrecognized distribution in the mangled name")); 01297 } 01298 01299 // Finally, create an XPRAGMA node for array size 01300 // 01301 WN *xpwn = WN_CreateXpragma(WN_PRAGMA_DISTRIBUTE_RESHAPE, arg_st, 1); 01302 01303 INT16 st_dim = dim; 01304 01305 WN *lb; 01306 if (TY_AR_const_lbnd(arg_ty, st_dim)) { 01307 lb = WN_Intconst(MTYPE_I8, TY_AR_lbnd_val(arg_ty, st_dim)); 01308 } 01309 else { 01310 ST_IDX lb_st = TY_AR_lbnd_var(arg_ty, st_dim); 01311 TY_IDX lb_ty = ST_type(lb_st); 01312 lb = WN_CreateLdid(OPCODE_make_op(OPR_LDID, 01313 TY_mtype(lb_ty), 01314 TY_mtype(lb_ty)), 01315 0, 01316 lb_st, 01317 lb_ty); 01318 } 01319 01320 WN *ub; 01321 if (TY_AR_const_ubnd(arg_ty, st_dim)) { 01322 ub = WN_Intconst(MTYPE_I8, TY_AR_ubnd_val(arg_ty, st_dim)); 01323 } 01324 else { 01325 ST_IDX ub_st = TY_AR_ubnd_var(arg_ty, st_dim); 01326 TY_IDX ub_ty = ST_type(ub_st); 01327 ub = WN_CreateLdid(OPCODE_make_op(OPR_LDID, 01328 TY_mtype(ub_ty), 01329 TY_mtype(ub_ty)), 01330 0, 01331 ub_st, 01332 ub_ty); 01333 } 01334 01335 WN_kid(xpwn, 0) = WN_Add(MTYPE_I8, 01336 WN_Sub(MTYPE_I8, ub, lb), 01337 WN_Intconst(MTYPE_I8, 1)); 01338 01339 WN_set_pragma_compiler_generated(xpwn); 01340 WN_INSERT_BlockAfter(block, current, xpwn); 01341 current = xpwn; 01342 } 01343 } 01344 } 01345 01346 01347 01348 // ===================================================================== 01349 // 01350 // Function Name: DRA_Collect_Commons 01351 // 01352 // Description: Given a WHIRL tree and a hash-table, (recursively) collect all 01353 // the base COMMON STs referenced in the tree into the hash-table. 01354 // 01355 // ===================================================================== 01356 01357 static void 01358 DRA_Collect_Commons(WN *wn, DRA_COMMON_HASH_TABLE *dra_common_ht) 01359 { 01360 if (wn == NULL) return; 01361 01362 OPCODE opc = WN_opcode(wn); 01363 01364 ST *st = OPCODE_has_sym(opc) ? WN_st(wn) : NULL; 01365 01366 if (st && 01367 (ST_base(st) != st) && 01368 (ST_sclass(st) == SCLASS_COMMON || ST_sclass(st) == SCLASS_DGLOBAL) && 01369 (ST_class(ST_base(st)) == CLASS_VAR && 01370 TY_kind(ST_type(ST_base(st))) == KIND_STRUCT)) { 01371 // smells like a common 01372 dra_common_ht->Enter_If_Unique (ST_st_idx(ST_base(st)), TRUE); 01373 } 01374 01375 // recurse 01376 // 01377 if (opc == OPC_BLOCK) { 01378 WN *kid = WN_first(wn); 01379 while (kid) { 01380 DRA_Collect_Commons (kid, dra_common_ht); 01381 kid = WN_next(kid); 01382 } 01383 } 01384 else { 01385 for (INT i=0; i<WN_kid_count(wn); i++) { 01386 DRA_Collect_Commons (WN_kid(wn,i), dra_common_ht); 01387 } 01388 } 01389 } 01390 01391 01392 // ===================================================================== 01393 // 01394 // Function Name: DRA_Process_Commons 01395 // 01396 // Description: Write the information related to distribute-reshaped 01397 // arrays appearing in common blocks into .rii file that 01398 // will be consumed by the prelinker in order to do 01399 // consistency checks. 01400 // 01401 // ===================================================================== 01402 01403 static void 01404 DRA_Process_Commons(DRA_HASH_TABLE *dra_table, 01405 DRA_COMMON_HASH_TABLE *dra_common_ht) 01406 { 01407 BOOL seen_common = FALSE; 01408 BOOL new_common = FALSE; 01409 UINT bufsize = 1024; 01410 char *buf = (char *) alloca(bufsize); 01411 char *bufptr = buf; 01412 char *common_name = NULL; 01413 INT64 common_offset; 01414 INT64 non_dra_start = 0; 01415 INT64 non_dra_end = 0; 01416 ST *st; 01417 INT i; 01418 01419 /* COMMON blocks are now in global symtab */ 01420 FOREACH_SYMBOL (GLOBAL_SYMTAB, st, i) { 01421 01422 // Common blocks and their fields are listed consecutively in ST 01423 // 01424 ST_SCLASS st_sclass = ST_sclass(st); 01425 01426 if (st_sclass == SCLASS_COMMON && 01427 ST_st_idx(st) == ST_base_idx(st) && 01428 dra_common_ht->Find(ST_st_idx(st))) { 01429 01430 // COMMON and not based, so must be the base of the COMMON block 01431 01432 char *st_name = ST_name(st); 01433 01434 // Names of split commons: BaseName.BaseOffset (Try to find '.') 01435 // 01436 char *dot = strchr(st_name, '.'); 01437 01438 // Full common name 01439 // 01440 if (dot == NULL) { 01441 if (common_name == NULL || 01442 strcmp(st_name, common_name) != 0) { 01443 common_name = strcpy((char *) alloca(strlen(st_name)+1), 01444 st_name); 01445 new_common = TRUE; 01446 } 01447 common_offset = 0; 01448 } 01449 01450 // Split common name 01451 // 01452 else { 01453 if (common_name == NULL || 01454 strncmp(st_name, common_name, dot-st_name) != 0) { 01455 common_name = strncpy((char *) alloca(dot-st_name+1), 01456 st_name, dot-st_name); 01457 common_name[dot-st_name] = '\0'; 01458 new_common = TRUE; 01459 } 01460 common_offset = strtol(dot+1, NULL, 10); 01461 } 01462 01463 if (new_common) { 01464 01465 // Write the last chunk of the previous common (if it existed) 01466 // 01467 if (non_dra_end - non_dra_start > 0) { 01468 bufptr += sprintf(bufptr, " %lld\n", non_dra_end - non_dra_start); 01469 } 01470 else if (seen_common) { 01471 *bufptr++ = '\n'; 01472 } 01473 01474 // Write the name of the new common 01475 // 01476 INT name_len = strlen(common_name); 01477 01478 if (bufptr - buf + name_len + 21 >= bufsize) { 01479 bufsize *= 2; 01480 char *newbuf = (char *) alloca(bufsize); 01481 buf = strcpy(newbuf, buf); 01482 bufptr = buf + strlen(buf); 01483 } 01484 01485 (void) strcpy(bufptr, common_name); 01486 bufptr += name_len; 01487 01488 non_dra_end = non_dra_start = 0; 01489 new_common = FALSE; 01490 } 01491 01492 seen_common = TRUE; 01493 } 01494 01495 else if (ST_st_idx(st) != ST_base_idx(st) && 01496 ST_sclass(ST_base(st)) == SCLASS_COMMON && 01497 dra_common_ht->Find(ST_st_idx(ST_base(st)))) { 01498 01499 TY_IDX ty = ST_type(st); 01500 01501 DRA_INFO *dra = (dra_table ? dra_table->Find(st) : NULL); 01502 01503 if (dra != NULL) { // reshaped array 01504 01505 INT16 ndims = TY_AR_ndims(ty); 01506 01507 // Reallocate if necessary (double the buffer size) 01508 // We need space to write this reshaped array and 01509 // possibly a non-reshaped chunk size that follows it 01510 // 31 chars prefix: DRA_ndims(5)_esize(21) 01511 // 69 chars per dimension: _lb(22):ub(22):distr(1)chunk(21) 01512 // 21 chars for the next non-reshaped chunk 01513 // 01514 if (bufptr - buf + 31 + ndims*69 + 21 >= bufsize) { 01515 bufsize *= 2; 01516 char *newbuf = (char *) alloca(bufsize); 01517 buf = strcpy(newbuf, buf); 01518 bufptr = buf + strlen(buf); 01519 } 01520 01521 if (non_dra_end - non_dra_start > 0) { 01522 bufptr += sprintf(bufptr, " %lld", non_dra_end - non_dra_start); 01523 } 01524 non_dra_start = common_offset + ST_ofst(st) + TY_size(ty); 01525 non_dra_end = non_dra_start; 01526 01527 bufptr += 01528 sprintf(bufptr, " DRA_%lld_%d", TY_size(TY_AR_etype(ty)), ndims); 01529 01530 for (INT16 dim = 0; dim < ndims; ++dim) { 01531 01532 bufptr += sprintf(bufptr, 01533 "_%lld:%lld:", 01534 TY_AR_lbnd_val(ty, ndims-1-dim), 01535 TY_AR_ubnd_val(ty, ndims-1-dim)); 01536 01537 switch (dra->Distr_Type(dim)) { 01538 case DISTRIBUTE_STAR: 01539 *bufptr++ = DRA_STAR_CODE; 01540 break; 01541 case DISTRIBUTE_BLOCK: 01542 *bufptr++ = DRA_BLOCK_CODE; 01543 break; 01544 case DISTRIBUTE_CYCLIC_CONST: 01545 *bufptr++ = DRA_CYCLIC_CODE; 01546 bufptr += sprintf(bufptr, "%lld", dra->Chunk_Const_Val(dim)); 01547 break; 01548 case DISTRIBUTE_CYCLIC_EXPR: 01549 *bufptr++ = DRA_CYCLIC_CODE; 01550 break; 01551 } 01552 } 01553 } 01554 01555 else if (common_offset + ST_ofst(st) + TY_size(ty) > non_dra_end) { 01556 non_dra_end = common_offset + ST_ofst(st) + TY_size(ty); 01557 } 01558 } 01559 } 01560 01561 if (bufptr != buf) { 01562 if (non_dra_end - non_dra_start > 0) { 01563 bufptr += sprintf(bufptr, " %lld\n", non_dra_end - non_dra_start); 01564 } 01565 else { 01566 *bufptr++ = '\n'; 01567 } 01568 write(DRA_file_desc, (void*)buf, bufptr-buf); 01569 } 01570 } 01571 01572 01573 01574 // ===================================================================== 01575 // 01576 // Function Name: DRA_Process_Globals 01577 // 01578 // Description: Write the information related to distribute-reshaped 01579 // global arrays into .rii file that 01580 // will be consumed by the prelinker in order to do 01581 // consistency checks. 01582 // 01583 // ===================================================================== 01584 01585 static void 01586 DRA_Process_Globals(DRA_HASH_TABLE *dra_table) 01587 { 01588 UINT bufsize = 1024; 01589 char *buf = (char *) alloca(bufsize); 01590 char *bufptr = buf; 01591 ST *st; 01592 INT i; 01593 01594 { 01595 // process globals just once per file, not once per PU 01596 static BOOL done_globals = FALSE; 01597 if (done_globals) return; 01598 done_globals = TRUE; 01599 } 01600 01601 FOREACH_SYMBOL (GLOBAL_SYMTAB, st, i) { 01602 01603 if (ST_class(st) != CLASS_VAR) continue; 01604 01605 // skip commons. 01606 // 01607 if ((ST_sclass(st) == SCLASS_COMMON) || // common 01608 (ST_sclass(st) == SCLASS_DGLOBAL && // might be common 01609 // if this st or 01610 // the base is kind struct 01611 (TY_kind(ST_type(st)) == KIND_STRUCT || 01612 (ST_class(ST_base(st)) == CLASS_VAR && 01613 TY_kind(ST_type(ST_base(st))) == KIND_STRUCT)))) { 01614 continue; 01615 } 01616 01617 bufptr = buf; 01618 01619 // is it a global array? if so, write it out 01620 // 01621 TY_IDX ty = Get_Original_Type(st); 01622 if (ty && TY_kind(ty) == KIND_ARRAY) { 01623 01624 char* st_name = ST_name(st); 01625 INT name_len = strlen(st_name); 01626 01627 if (bufptr - buf + name_len + 21 >= bufsize) { 01628 bufsize *= 2; 01629 char *newbuf = (char *) alloca(bufsize); 01630 buf = strcpy(newbuf, buf); 01631 bufptr = buf + strlen(buf); 01632 } 01633 01634 strcpy (bufptr, st_name); 01635 bufptr += name_len; 01636 01637 DRA_INFO* dra = (dra_table ? dra_table->Find(st) : NULL); 01638 01639 if (dra != NULL) { 01640 // reshaped 01641 // 01642 01643 INT16 ndims = TY_AR_ndims(ty); 01644 01645 // Reallocate if necessary (double the buffer size) 01646 // We need space to write this reshaped array 01647 // 31 chars prefix: DRA_ndims(5)_esize(21) 01648 // 69 chars per dimension: _lb(22):ub(22):distr(1)chunk(21) 01649 // 01650 if (bufptr - buf + 31 + ndims*69 >= bufsize) { 01651 bufsize *= 2; 01652 char *newbuf = (char *) alloca(bufsize); 01653 buf = strcpy(newbuf, buf); 01654 bufptr = buf + strlen(buf); 01655 } 01656 01657 bufptr += 01658 sprintf(bufptr, " DRA_%lld_%d", TY_size(TY_AR_etype(ty)), ndims); 01659 01660 // emit dimensions consistently: i.e. stride-one dimension first 01661 // 01662 for (INT16 dim = 0; dim < ndims; ++dim) { 01663 01664 bufptr += sprintf(bufptr, 01665 "_%lld:%lld:", 01666 TY_AR_lbnd_val(ty, ndims-1-dim), 01667 TY_AR_ubnd_val(ty, ndims-1-dim)); 01668 01669 switch (dra->Distr_Type(dim)) { 01670 case DISTRIBUTE_STAR: 01671 *bufptr++ = DRA_STAR_CODE; 01672 break; 01673 case DISTRIBUTE_BLOCK: 01674 *bufptr++ = DRA_BLOCK_CODE; 01675 break; 01676 case DISTRIBUTE_CYCLIC_CONST: 01677 *bufptr++ = DRA_CYCLIC_CODE; 01678 bufptr += sprintf(bufptr, "%lld", dra->Chunk_Const_Val(dim)); 01679 break; 01680 case DISTRIBUTE_CYCLIC_EXPR: 01681 *bufptr++ = DRA_CYCLIC_CODE; 01682 break; 01683 } 01684 } 01685 *bufptr++ = '\n'; 01686 } 01687 else { 01688 // not reshaped 01689 // 01690 bufptr += sprintf (bufptr, " %lld", TY_size(ty)); 01691 *bufptr++ = '\n'; 01692 } 01693 write(DRA_file_desc, (void*)buf, bufptr-buf); 01694 } 01695 } 01696 } 01697 01698 01699 01700 // ===================================================================== 01701 // 01702 // Function Name: DRA_Info_Matches_Encoding 01703 // 01704 // Description: Check if the DISTRIBUTE_RESHAPE information from 01705 // DRA_INFO matches that of the encoded argument. 01706 // 01707 // ===================================================================== 01708 01709 static BOOL 01710 DRA_Info_Matches_Encoding(DRA_INFO *dra, 01711 char *arg_sig) 01712 { 01713 INT16 num_dims = dra->Num_Dims(); 01714 for (INT16 dim = 0; dim < num_dims; dim++) { 01715 01716 switch (*arg_sig++) { 01717 01718 case DRA_BLOCK_CODE: 01719 if (dra->Distr_Type(dim) != DISTRIBUTE_BLOCK) { 01720 return FALSE; 01721 } 01722 break; 01723 01724 case DRA_STAR_CODE: 01725 if (dra->Distr_Type(dim) != DISTRIBUTE_STAR) { 01726 return FALSE; 01727 } 01728 break; 01729 01730 case DRA_CYCLIC_CODE: 01731 { 01732 INT64 chunk = (INT64) strtol (arg_sig, &arg_sig, 10); 01733 if (chunk != 0) { 01734 if (dra->Distr_Type(dim) != DISTRIBUTE_CYCLIC_CONST || 01735 dra->Chunk_Const_Val(dim) != chunk) { 01736 return FALSE; 01737 } 01738 } 01739 else { 01740 if (dra->Distr_Type(dim) != DISTRIBUTE_CYCLIC_EXPR) { 01741 return FALSE; 01742 } 01743 } 01744 } 01745 break; 01746 01747 default: 01748 FmtAssert(FALSE, 01749 ("Uncrecognized distribution in the mangled name")); 01750 } 01751 } 01752 return TRUE; 01753 }