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 for name mangling needed to support cloning 00045 // of routines that have distribute-reshaped array parameters. 00046 // 00047 // ==================================================================== 00048 // ==================================================================== 00049 00050 #include <alloca.h> // alloca 00051 #include <elf.h> 00052 00053 #include "defs.h" // standard definitions 00054 #include "wn.h" // WN 00055 #include "stab.h" // ST, TY 00056 #include "pu_info.h" // PU_Info 00057 00058 #include "opcode.h" // OPCODE_make_op 00059 #include "mempool.h" // MEM_POOL 00060 #include "cxx_memory.h" // CXX_NEW, CXX_DELETE 00061 #include "wn_pragmas.h" // WN_pragma 00062 #include "config_targ.h" // Pointer_Size 00063 #include "targ_sim.h" // Get_Return_Mtypes 00064 #include "erbe.h" // ErrMsgSrcpos 00065 #include "strtab.h" // Save_Str 00066 #include "wn_util.h" // WN_DELETE 00067 #include "dwarf_DST.h" // DST_IDX 00068 #include "config.h" // Run_ipl, Run_cg 00069 #include "dra_internal.h" // Internal DRA interface 00070 00071 00072 // ===================================================================== 00073 // 00074 // Local function prototypes 00075 // 00076 // ===================================================================== 00077 00078 static DRA_INFO* New_DRA (WN** pwn_addr, 00079 ST *array_st, 00080 TY_IDX array_ty, 00081 WN *block, 00082 WN *preamble); 00083 00084 static BOOL Array_TY_OK (TY_IDX array_ty); 00085 00086 static void Insert_Alloca(ST *array_st, 00087 INT16 ndims, 00088 INT64 esize, 00089 WN *dim_size_wn[], 00090 WN *block, 00091 WN *preamble); 00092 00093 static WN* Delete_Dist_Reshape_Pragmas (WN* pwn, 00094 WN* block); 00095 00096 static void DRA_Mangle_Entry(WN *entry_wn, 00097 INT16 num_formals, 00098 DRA_HASH_TABLE *dra_table, 00099 DST_ASSOC_INFO *assoc_info); 00100 00101 static void DRA_Mangle_Call_Site(WN *call_wn, 00102 OPERATOR call_oper, 00103 DRA_HASH_TABLE *dra_table); 00104 00105 static UINT DRA_Preprocess_Entry(WN *entry_wn, 00106 INT16 num_formals, 00107 DRA_HASH_TABLE *dra_table, 00108 BOOL *has_reshaped_formals); 00109 00110 static UINT DRA_Preprocess_Call_Site(WN *call_wn, 00111 INT16 num_args, 00112 DRA_HASH_TABLE *dra_table, 00113 BOOL *has_reshaped_args); 00114 00115 static char* DRA_Insert_Mangling_Sigs(char *orig_name, 00116 char mangled_buf[]); 00117 00118 static char* DRA_Encode_Parameter(ST *st, 00119 TY_IDX ty, 00120 char *buf, 00121 DRA_HASH_TABLE *dra_table); 00122 00123 00124 // ===================================================================== 00125 // 00126 // Exported function definitions 00127 // 00128 // ===================================================================== 00129 00130 // ===================================================================== 00131 // 00132 // Function Name: DRA_Read_Pragmas 00133 // 00134 // Description: Given the function tree, read all DISTRIBUTE_RESHAPE 00135 // pragmas and build up internal representations. 00136 // 00137 // ===================================================================== 00138 00139 00140 // Read pragmas in given WN block. Can be called recursively. 00141 static void 00142 DRA_Read_Pragmas_In_Block (WN *first, WN* block, WN *preamble, 00143 DRA_HASH_TABLE *dra_table) 00144 { 00145 WN *pwn = first; 00146 00147 // Walk the tree, processing pragma nodes 00148 // 00149 while (pwn) { 00150 00151 if (WN_opcode(pwn) == OPC_REGION) { 00152 // look inside regions 00153 DRA_Read_Pragmas_In_Block (WN_first(WN_region_body(pwn)), WN_region_body(pwn), preamble, dra_table); 00154 } 00155 00156 if (WN_opcode(pwn) == OPC_PRAGMA && 00157 WN_pragma(pwn) == WN_PRAGMA_DISTRIBUTE_RESHAPE) { 00158 00159 ST *array_st = WN_st(pwn); 00160 00161 if (array_st == NULL || ST_is_not_used(array_st)) { 00162 // Front end may discard ST entries for arrays that are never used 00163 // 00164 pwn = Delete_Dist_Reshape_Pragmas(pwn, block); 00165 } 00166 00167 else { 00168 00169 TY_IDX array_ty = Get_Array_Type(array_st); 00170 00171 if (TY_kind(array_ty) != KIND_ARRAY) { 00172 // This error will most likely be caught by FE 00173 // 00174 ErrMsgSrcpos(EC_DRA_unsupported_type, 00175 WN_Get_Linenum(pwn), 00176 "DISTRIBUTE_RESHAPE", 00177 ST_name(array_st), 00178 "Cannot reshape non-arrays"); 00179 00180 pwn = Delete_Dist_Reshape_Pragmas(pwn, block); 00181 } 00182 00183 else if (ST_is_equivalenced(array_st)) { 00184 // We don't support reshaping of equivalenced arrays 00185 // 00186 ErrMsgSrcpos(EC_DRA_unsupported_type, 00187 WN_Get_Linenum(pwn), 00188 "DISTRIBUTE_RESHAPE", 00189 ST_name(array_st), 00190 "Cannot reshape equivalenced arrays"); 00191 00192 pwn = Delete_Dist_Reshape_Pragmas(pwn, block); 00193 } 00194 00195 else if (ST_sclass(array_st) == SCLASS_DGLOBAL || 00196 ST_is_initialized(array_st)) { 00197 // Defined (initialized) C global data, allocated in this 00198 // module and initialized ST are for now not handled 00199 // 00200 ErrMsgSrcpos(EC_DRA_unsupported_type, 00201 WN_Get_Linenum(pwn), 00202 "DISTRIBUTE_RESHAPE", 00203 ST_name(array_st), 00204 "Cannot reshape initialized data"); 00205 00206 pwn = Delete_Dist_Reshape_Pragmas(pwn, block); 00207 } 00208 00209 else if (!Array_TY_OK (array_ty)) { 00210 ErrMsgSrcpos(EC_DRA_unsupported_type, 00211 WN_Get_Linenum(pwn), 00212 "DISTRIBUTE_RESHAPE", 00213 ST_name(array_st), 00214 "Cannot reshape assumed size arrays"); 00215 00216 pwn = Delete_Dist_Reshape_Pragmas(pwn, block); 00217 } 00218 00219 else { 00220 00221 FmtAssert (ST_class(array_st) == CLASS_VAR, 00222 ("Distributed array is not a variable")); 00223 00224 DRA_INFO* dra = New_DRA(&pwn, array_st, array_ty, block, preamble); 00225 00226 if (dra != NULL) { 00227 // Add dra to the hash table 00228 // 00229 dra_table->Enter(array_st, dra); 00230 } 00231 } 00232 } 00233 } 00234 00235 else { 00236 pwn = WN_next(pwn); 00237 } 00238 } 00239 } 00240 00241 void 00242 DRA_Read_Pragmas (WN* func_nd, 00243 DRA_HASH_TABLE *dra_table) 00244 { 00245 Set_Error_Phase("Processing DISTRIBUTE_RESHAPE pragmas"); 00246 00247 WN *block = WN_func_body(func_nd); 00248 WN *preamble = Get_Preamble_End(func_nd); 00249 00250 DRA_Read_Pragmas_In_Block (preamble, block, preamble, dra_table); 00251 } 00252 00253 00254 00255 00256 // ===================================================================== 00257 // 00258 // Function Name: DRA_Mangle_All 00259 // 00260 // Description: Mangle the name of the given PU if at least one of 00261 // its formal parameters is a distribute-reshaped array. 00262 // 00263 // For each call site in the PU, the name of the callee 00264 // is mangled if at least one of the actual arguments is 00265 // a distribute-reshaped array. 00266 // 00267 // ===================================================================== 00268 00269 void 00270 DRA_Mangle_All(WN *func_wn, 00271 DRA_HASH_TABLE *dra_table, 00272 PU_Info *pu_info) 00273 { 00274 // Allocate the global name/ST hash table used for resolving names 00275 // 00276 if (DRA_func_table == NULL) { 00277 DRA_func_table = CXX_NEW(NAME_ST_TABLE(31, &MEM_src_pool), &MEM_src_pool); 00278 } 00279 00280 DST_ASSOC_INFO* assoc_info = NULL; 00281 DST_IDX pu_idx = PU_Info_pu_dst(pu_info); 00282 if (!DST_IS_NULL(pu_idx)) { 00283 DST_INFO* info = DST_INFO_IDX_TO_PTR(pu_idx); 00284 DST_SUBPROGRAM* pu_attr = 00285 DST_ATTR_IDX_TO_PTR(DST_INFO_attributes(info), DST_SUBPROGRAM); 00286 assoc_info = &(DST_SUBPROGRAM_def_st(pu_attr)); 00287 } 00288 00289 // Process the function entry 00290 // 00291 DRA_Mangle_Entry(func_wn, WN_num_formals(func_wn), dra_table, assoc_info); 00292 00293 // Walk the tree and process alternate entry points and call sites 00294 // 00295 WN_ITER *wni; 00296 for (wni = WN_WALK_TreeIter(func_wn); wni; wni = WN_WALK_TreeNext(wni)) { 00297 00298 WN *stmt_wn = WN_ITER_wn(wni); 00299 00300 if (WN_opcode(stmt_wn) == OPC_ALTENTRY) { 00301 DST_ASSOC_INFO* assoc_info = NULL; 00302 DST_IDX dst_idx = DST_INFO_sibling(DST_INFO_IDX_TO_PTR(pu_idx)); 00303 while (!DST_IS_NULL(dst_idx)) { 00304 DST_INFO* info = DST_INFO_IDX_TO_PTR(dst_idx); 00305 if (DST_INFO_tag(info) == DW_TAG_entry_point) { 00306 DST_ENTRY_POINT* attr = 00307 DST_ATTR_IDX_TO_PTR(DST_INFO_attributes(info), DST_ENTRY_POINT); 00308 if (DST_ASSOC_INFO_st_index(DST_ENTRY_POINT_st(attr)) == 00309 ST_index(WN_st(stmt_wn))) { 00310 assoc_info = &(DST_ENTRY_POINT_st(attr)); 00311 break; 00312 } 00313 } 00314 dst_idx = DST_INFO_sibling(info); 00315 } 00316 00317 DRA_Mangle_Entry(stmt_wn, WN_kid_count(stmt_wn), dra_table, assoc_info); 00318 } 00319 00320 else { 00321 OPERATOR stmt_oper = WN_operator(stmt_wn); 00322 if (stmt_oper == OPR_CALL || stmt_oper == OPR_ICALL) { 00323 DRA_Mangle_Call_Site(stmt_wn, stmt_oper, dra_table); 00324 } 00325 } 00326 00327 } 00328 } 00329 00330 00331 00332 00333 // ===================================================================== 00334 // 00335 // Function Name: Get_Preamble_End 00336 // 00337 // Description: For a given entry, find the PREAMBLE_END pragma. 00338 // 00339 // ===================================================================== 00340 00341 WN* 00342 Get_Preamble_End(WN* entry_wn) 00343 { 00344 Is_True (WN_opcode(entry_wn) == OPC_FUNC_ENTRY || 00345 WN_opcode(entry_wn) == OPC_ALTENTRY, 00346 ("Get_Preamble_End: Expected FUNC_ENTRY or ALTENTRY node")); 00347 00348 WN* wn; 00349 if (WN_opcode(entry_wn) == OPC_FUNC_ENTRY) { 00350 wn = WN_entry_first(entry_wn); 00351 } 00352 else { 00353 wn = WN_next(entry_wn); 00354 } 00355 00356 while (wn != NULL && (WN_opcode(wn) != OPC_PRAGMA || 00357 WN_pragma(wn) != WN_PRAGMA_PREAMBLE_END)) { 00358 wn = WN_next(wn); 00359 } 00360 00361 Is_True (wn != NULL, ("Could not find the PREAMBLE_END pragma")); 00362 00363 return wn; 00364 } 00365 00366 00367 00368 00369 // ===================================================================== 00370 // 00371 // Function Name: Find_Return_Registers 00372 // 00373 // Description: Figure out which return registers are to be used 00374 // for returning an object of the given type. 00375 // 00376 // ===================================================================== 00377 00378 ST* 00379 Find_Return_Registers(TYPE_ID type, 00380 PREG_NUM *rreg1, 00381 PREG_NUM *rreg2) 00382 { 00383 TYPE_ID mtype1; 00384 TYPE_ID mtype2; 00385 00386 if (WHIRL_Return_Info_On) { 00387 00388 RETURN_INFO return_info = Get_Return_Info (Be_Type_Tbl(type), 00389 Use_Simulated); 00390 00391 if (RETURN_INFO_count(return_info) <= 2) { 00392 00393 *rreg1 = RETURN_INFO_preg (return_info, 0); 00394 *rreg2 = RETURN_INFO_preg (return_info, 1); 00395 } 00396 00397 else { 00398 00399 Fail_FmtAssertion ("Find_Return_Registers: more than 2 return registers"); 00400 return NULL; 00401 } 00402 } 00403 00404 else { 00405 00406 Get_Return_Mtypes(Be_Type_Tbl(type), Use_Simulated, &mtype1, &mtype2); 00407 Get_Return_Pregs(mtype1, mtype2, rreg1, rreg2); 00408 } 00409 00410 if (Preg_Offset_Is_Int(*rreg1)) { 00411 if (MTYPE_bit_size(type) == 32) { 00412 return Int32_Preg; 00413 } else { 00414 return Int64_Preg; 00415 } 00416 } else { 00417 if (MTYPE_bit_size(type) == 32) { 00418 return Float32_Preg; 00419 } else { 00420 return Float64_Preg; 00421 } 00422 } 00423 } 00424 00425 00426 00427 00428 00429 // ===================================================================== 00430 // 00431 // Local function definitions 00432 // 00433 // ===================================================================== 00434 00435 00436 // ===================================================================== 00437 // 00438 // Function Name: New_DRA 00439 // 00440 // Description: Given a pointer to the first pragma node, consume all 00441 // pragma nodes belonging to this DISTRIBUTE_RESHAPE pragma 00442 // and return a DRA_INFO. As a side effect, the pointer to 00443 // the pragma node in the caller is bumped up to point to 00444 // the node immediately following the last pragma node. 00445 // 00446 // ===================================================================== 00447 00448 static DRA_INFO* 00449 New_DRA (WN** pwn_addr, // address of the pragma node pointer 00450 ST *array_st, // ST entry for the array 00451 TY_IDX array_ty, // TY entry for the array 00452 WN *block, // block to which pragmas belong 00453 WN *preamble) // end of preamble code 00454 { 00455 TY& ty = Ty_Table[array_ty]; 00456 INT16 ndims = TY_AR_ndims(ty); 00457 INT64 esize = TY_size(TY_AR_etype(ty)); 00458 DRA_INFO *dra = CXX_NEW(DRA_INFO(ndims, esize, DRA_name_pool_ptr), 00459 DRA_name_pool_ptr); 00460 00461 WN *pwn = *pwn_addr; 00462 WN **dim_size_wn = (WN**) alloca(ndims*sizeof(WN*)); 00463 INT16 distr_dims = 0; 00464 00465 for (INT16 i = 0; i < ndims; i++) { 00466 00467 // Process ith dimension. pwn points to node for ith dimension 00468 // 00469 FmtAssert (WN_opcode(pwn) == OPC_PRAGMA, 00470 ("Distribute_Reshape_Pragma: expected a PRAGMA node\n")); 00471 00472 FmtAssert (WN_pragma(pwn) == WN_PRAGMA_DISTRIBUTE_RESHAPE, 00473 ("Distribute_Reshape_Pragma: unexpected PRAGMA type\n")); 00474 00475 switch (WN_pragma_distr_type(pwn)) { 00476 00477 case DISTRIBUTE_STAR: 00478 dra->Init (i, (DISTRIBUTE_TYPE) WN_pragma_distr_type(pwn)); 00479 break; 00480 00481 case DISTRIBUTE_BLOCK: 00482 distr_dims++; 00483 dra->Init (i, (DISTRIBUTE_TYPE) WN_pragma_distr_type(pwn)); 00484 break; 00485 00486 case DISTRIBUTE_CYCLIC_CONST: 00487 distr_dims++; 00488 dra->Init (i, (DISTRIBUTE_TYPE) WN_pragma_distr_type(pwn), 00489 (INT64) WN_pragma_arg2(pwn)); 00490 break; 00491 00492 case DISTRIBUTE_CYCLIC_EXPR: 00493 distr_dims++; 00494 dra->Init (i, (DISTRIBUTE_TYPE) WN_pragma_distr_type(pwn)); 00495 00496 pwn = WN_next(pwn); 00497 00498 FmtAssert (WN_opcode(pwn) == OPC_XPRAGMA, 00499 ("Distribute_Reshape_Pragma: expected an XPRAGMA node\n")); 00500 00501 FmtAssert (WN_pragma(pwn) == WN_PRAGMA_DISTRIBUTE_RESHAPE, 00502 ("Distribute_Reshape_Pragma: unexpected XPRAGMA type\n")); 00503 00504 break; 00505 00506 default: 00507 FmtAssert (FALSE, 00508 ("Distribute_Reshape_Pragma: strange distribute type\n")); 00509 break; 00510 } 00511 00512 pwn = WN_next(pwn); 00513 dim_size_wn[i] = WN_kid(pwn, 0); 00514 00515 FmtAssert (WN_opcode(pwn) == OPC_XPRAGMA, 00516 ("Distribute_Reshape_Pragma: expected an XPRAGMA node\n")); 00517 00518 FmtAssert (WN_pragma(pwn) == WN_PRAGMA_DISTRIBUTE_RESHAPE, 00519 ("Distribute_Reshape_Pragma: unexpected XPRAGMA type\n")); 00520 00521 pwn = WN_next(pwn); 00522 } 00523 00524 00525 if (distr_dims == 0) { 00526 00527 ErrMsgSrcpos(EC_DRA_all_stars, 00528 WN_Get_Linenum(*pwn_addr), 00529 ST_name(array_st)); 00530 00531 // Since LNO will not see this DRA pragma, we need 00532 // to generate ALLOCA for allocatable local arrays 00533 // 00534 if (ST_sclass(array_st) == SCLASS_AUTO && 00535 TY_kind(ST_type(array_st)) == KIND_POINTER) { 00536 00537 Insert_Alloca(array_st, ndims, esize, dim_size_wn, block, preamble); 00538 } 00539 00540 dra = NULL; 00541 pwn = Delete_Dist_Reshape_Pragmas (*pwn_addr, block); 00542 00543 } 00544 00545 *pwn_addr = pwn; 00546 00547 return dra; 00548 } 00549 00550 00551 00552 00553 // ===================================================================== 00554 // 00555 // Function Name: Array_TY_OK 00556 // 00557 // Description: Check that the array TY is kosher for data distribution. 00558 // 00559 // ===================================================================== 00560 static BOOL 00561 Array_TY_OK (TY_IDX array_ty) 00562 { 00563 const TY& ty = Ty_Table[array_ty]; 00564 00565 Is_True (TY_kind(ty) == KIND_ARRAY, 00566 ("Array_TY_OK called on a non-array")); 00567 00568 INT16 ndims = TY_AR_ndims(ty); 00569 00570 Is_True (ndims > 0, ("Array_TY_OK: array has 0 dimensions?")); 00571 00572 for (INT16 i = 0; i < ndims; i++) { 00573 // Each thing must be a constant or a WHIRL <expr> tree 00574 // 00575 if ((!TY_AR_const_lbnd(ty, i)) && 00576 (TY_AR_lbnd_val(ty, i) == 0)) { 00577 return FALSE; 00578 } 00579 00580 if ((!TY_AR_const_ubnd(ty, i)) && 00581 (TY_AR_ubnd_val(ty, i) == 0)) { 00582 return FALSE; 00583 } 00584 } 00585 00586 return TRUE; 00587 } 00588 00589 00590 00591 00592 // ===================================================================== 00593 // 00594 // Function Name: Insert_Alloca 00595 // 00596 // Description: Generate a call to ALLOCA for an allocatable local array 00597 // 00598 // ===================================================================== 00599 00600 static void 00601 Insert_Alloca(ST *array_st, 00602 INT16 ndims, 00603 INT64 esize, 00604 WN *dim_size_wn[], 00605 WN *block, 00606 WN *preamble) 00607 { 00608 WN* size_wn = WN_Intconst(MTYPE_I8, esize); 00609 for (INT16 i = 0; i < ndims; i++) { 00610 size_wn = WN_Mpy(MTYPE_I8, size_wn, WN_CopyNode(dim_size_wn[i])); 00611 } 00612 00613 OPCODE call_op = OPCODE_make_op(OPR_INTRINSIC_CALL, 00614 Pointer_type, 00615 MTYPE_V); 00616 WN *call_wn = WN_Create(call_op, 1); 00617 WN_intrinsic(call_wn) = 00618 (Pointer_Size == 8) ? INTRN_U8I8ALLOCA : INTRN_U4I4ALLOCA; 00619 00620 WN* parm_wn = WN_CreateParm (Pointer_type, 00621 size_wn, 00622 Be_Type_Tbl(Pointer_type), 00623 WN_PARM_BY_REFERENCE); 00624 WN_kid0(call_wn) = parm_wn; 00625 00626 // WN_Copy_Linenumber(dim_size_wn[0], call_wn); 00627 00628 // Insert call node 00629 // 00630 WN_INSERT_BlockBefore(block, preamble, call_wn); 00631 00632 00633 // Generate code to store the return values into the array 00634 // 00635 PREG_NUM rreg1, rreg2; 00636 ST* rst = Find_Return_Registers (Pointer_type, &rreg1, &rreg2); 00637 FmtAssert(rreg1 != 0 && rreg2 == 0, ("Bad pointer type ret regs")); 00638 00639 WN *ldid_wn = 00640 WN_CreateLdid (OPCODE_make_op(OPR_LDID, Pointer_type, Pointer_type), 00641 rreg1, 00642 rst, 00643 Be_Type_Tbl(Pointer_type)); 00644 00645 WN *stid_wn = 00646 WN_CreateStid (OPCODE_make_op(OPR_STID, MTYPE_V, Pointer_type), 00647 0, 00648 array_st, 00649 ST_type(array_st), 00650 ldid_wn); 00651 00652 // WN_Copy_Linenumber (dim_size_wn[0], stid_wn); 00653 00654 // Insert store node 00655 // 00656 WN_INSERT_BlockBefore(block, preamble, stid_wn); 00657 00658 Set_ST_pt_to_unique_mem(array_st); 00659 Set_PU_has_alloca (Get_Current_PU ()); 00660 } 00661 00662 00663 00664 00665 // ===================================================================== 00666 // 00667 // Function Name: Delete_Dist_Reshape_Pragmas 00668 // 00669 // Description: Delete all DISTRIBUTE_RESHAPE pragmas that are in the 00670 // same set as the given pragma node and return the 00671 // statement node following the last deleted pragma. 00672 // 00673 // ===================================================================== 00674 00675 static WN* 00676 Delete_Dist_Reshape_Pragmas (WN* pwn, 00677 WN *block) 00678 { 00679 FmtAssert (WN_opcode(pwn) == OPC_PRAGMA && 00680 WN_pragma(pwn) == WN_PRAGMA_DISTRIBUTE_RESHAPE, 00681 ("Delete_Dist_Reshape_Pragma: Wrong opcode and/or pragma\n")); 00682 00683 WN *current = pwn; 00684 WN *next; 00685 ST *st = WN_st(current); 00686 00687 while (current) { 00688 00689 // remember next statement 00690 // 00691 next = WN_next(current); 00692 00693 // delete current statement 00694 // 00695 WN_DELETE_FromBlock (block, current); 00696 // WN_DELETE_Tree(current); 00697 00698 // advance current statement pointer 00699 // 00700 current = next; 00701 00702 // Delete all DISTRIBUTE_RESHAPE [x]pragmas with the same ST pointer 00703 // 00704 if ((WN_opcode(current) != OPC_PRAGMA && 00705 WN_opcode(current) != OPC_XPRAGMA) || 00706 WN_pragma(current) != WN_PRAGMA_DISTRIBUTE_RESHAPE || 00707 WN_st(current) != st) { 00708 return current; 00709 } 00710 } 00711 00712 return NULL; // It should never get here 00713 } 00714 00715 00716 // ===================================================================== 00717 // 00718 // Function Name: Change_ST_Of_Current_PU 00719 // 00720 // Description: Change some globals to reflect mangling of ST for an entry 00721 // 00722 // ===================================================================== 00723 00724 static void 00725 Change_ST_Of_Current_PU(ST *new_entry_st) 00726 { 00727 // The idea is to change all the ST_IDX's in globals from the non- 00728 // mangled version of the PU to the mangled version, new_entry_st. 00729 // Hopefully we are catching all the global instances here. 00730 Current_PU_Info->proc_sym = ST_st_idx(new_entry_st); 00731 Scope_tab[CURRENT_SYMTAB].st = new_entry_st; 00732 } 00733 00734 00735 // ===================================================================== 00736 // 00737 // Function Name: DRA_Mangle_Entry 00738 // 00739 // Description: Mangle the name of a function entry point 00740 // 00741 // ===================================================================== 00742 00743 static void 00744 DRA_Mangle_Entry(WN* entry_wn, 00745 INT16 num_formals, 00746 DRA_HASH_TABLE* dra_table, 00747 DST_ASSOC_INFO* assoc_info) 00748 { 00749 BOOL has_reshaped_formals = FALSE; 00750 00751 UINT bufsize = DRA_Preprocess_Entry(entry_wn, 00752 num_formals, 00753 dra_table, 00754 &has_reshaped_formals); 00755 00756 if (has_reshaped_formals) { 00757 00758 // Allocate the buffer and insert mangling signature 00759 // 00760 char *mangled_buf = (char *) alloca(bufsize); 00761 char *entry_name = ST_name(WN_st(entry_wn)); 00762 char *mangled_ptr = DRA_Insert_Mangling_Sigs(entry_name, mangled_buf); 00763 00764 // Write the encoding of all formal parameters 00765 // 00766 for (INT16 formal = 0; formal < num_formals; ++formal) { 00767 00768 ST *formal_st = WN_st(WN_formal(entry_wn, formal)); 00769 TY_IDX formal_ty = Get_Array_Type(formal_st); 00770 00771 mangled_ptr = DRA_Encode_Parameter(formal_st, 00772 formal_ty, 00773 mangled_ptr, 00774 dra_table); 00775 *mangled_ptr++ = DRA_ARG_SEPARATOR; 00776 } 00777 00778 *mangled_ptr = '\0'; 00779 00780 00781 // Remember the old ST entry in order to make it undefined 00782 // 00783 ST *old_st = WN_st(entry_wn); 00784 ST *entry_st = old_st; 00785 00786 // Lookup the mangled name in the hash table 00787 // 00788 MANGLED_FUNC *entry_desc = DRA_func_table->Find(Save_Str(mangled_buf)); 00789 00790 if (entry_desc == NULL) { // name not found 00791 00792 if (strcmp(entry_name, mangled_buf) != 0) { 00793 00794 // For a new mangled name, create an ST entry 00795 // 00796 entry_st = Copy_ST(entry_st, TRUE); 00797 WN_st_idx(entry_wn) = ST_st_idx(entry_st); 00798 Set_ST_name(entry_st, Save_Str(mangled_buf)); 00799 Clear_ST_is_not_used(entry_st); 00800 } 00801 00802 // Enter the (name, ST-entry) pair in the hash table 00803 // 00804 entry_desc = CXX_NEW(MANGLED_FUNC, &MEM_src_pool); 00805 entry_desc->st = entry_st; 00806 entry_desc->is_clone = FALSE; 00807 entry_desc->is_called = FALSE; 00808 DRA_func_table->Enter(ST_name_idx(entry_st), entry_desc); 00809 } 00810 00811 else { // name found 00812 entry_st = entry_desc->st; 00813 WN_st_idx (entry_wn) = ST_st_idx (entry_st); 00814 Set_ST_sclass (entry_st, SCLASS_TEXT); 00815 // nenad, 05/06/98: 00816 // Must set the base index properly 00817 if (Run_cg) { 00818 Set_ST_base (entry_st, ST_base(old_st)); 00819 } 00820 } 00821 00822 // Update ST index in DST 00823 // 00824 if (assoc_info != NULL) { 00825 pDST_ASSOC_INFO_st_idx(assoc_info) = ST_st_idx(entry_st); 00826 } 00827 00828 // Make old ST entry undefined 00829 // 00830 if (entry_st != old_st) { 00831 Change_ST_Of_Current_PU(entry_st); 00832 Set_ST_sclass (old_st, SCLASS_EXTERN); 00833 if (!PU_has_non_mangled_call (Pu_Table[ST_pu (old_st)])) 00834 Set_ST_is_not_used (old_st); 00835 } 00836 } 00837 else { 00838 Set_PU_has_non_mangled_call(Pu_Table[ST_pu(WN_st(entry_wn))]); 00839 Clear_ST_is_not_used(WN_st(entry_wn)); 00840 } 00841 } 00842 00843 00844 00845 00846 // ===================================================================== 00847 // 00848 // Function Name: DRA_Mangle_Call_Site 00849 // 00850 // Description: Mangle the name of a fucntion/subroutine at a call site 00851 // 00852 // ===================================================================== 00853 00854 static void 00855 DRA_Mangle_Call_Site(WN *call_wn, 00856 OPERATOR call_oper, 00857 DRA_HASH_TABLE *dra_table) 00858 { 00859 // Don't mangle calls to DSM intrinsics 00860 // 00861 if (call_oper == OPR_CALL && 00862 strncmp(ST_name(WN_st(call_wn)), "dsm_", 4) == 0) { 00863 return; 00864 } 00865 00866 // Don't mangle calls to C IO routines 00867 // 00868 if (call_oper == OPR_CALL && 00869 (strcmp (ST_name(WN_st(call_wn)), "printf") == 0 || 00870 strcmp (ST_name(WN_st(call_wn)), "fprintf") == 0 || 00871 strcmp (ST_name(WN_st(call_wn)), "sprintf") == 0 || 00872 strcmp (ST_name(WN_st(call_wn)), "vprintf") == 0 || 00873 strcmp (ST_name(WN_st(call_wn)), "vfprintf") == 0 || 00874 strcmp (ST_name(WN_st(call_wn)), "vsprintf") == 0 || 00875 strcmp (ST_name(WN_st(call_wn)), "scanf") == 0 || 00876 strcmp (ST_name(WN_st(call_wn)), "sscanf") == 0 || 00877 strcmp (ST_name(WN_st(call_wn)), "fscanf") == 0)) { 00878 return; 00879 } 00880 00881 BOOL has_reshaped_args = FALSE; 00882 INT16 num_args = WN_num_actuals(call_wn); 00883 00884 UINT bufsize = DRA_Preprocess_Call_Site(call_wn, 00885 num_args, 00886 dra_table, 00887 &has_reshaped_args); 00888 00889 if (has_reshaped_args) { 00890 00891 // Indirect procedure calls are not allowed to 00892 // have distribute-reshaped array arguments 00893 // 00894 if (call_oper == OPR_ICALL) { 00895 ErrMsgSrcpos(EC_DRA_indirect_call, WN_Get_Linenum(call_wn)); 00896 return; 00897 } 00898 00899 // Allocate the buffer and insert mangling signature 00900 // 00901 char *mangled_buf = (char *) alloca(bufsize); 00902 char *call_name = ST_name(WN_st(call_wn)); 00903 char *mangled_ptr = DRA_Insert_Mangling_Sigs(call_name, mangled_buf); 00904 00905 // Write the encoding of the arguments 00906 // 00907 for (INT16 arg = 0; arg < num_args; ++arg) { 00908 00909 // Kid 0 of OPC_PARM is the actual argument 00910 // 00911 WN *arg_wn = WN_kid(WN_actual(call_wn,arg), 0); 00912 00913 if (WN_operator(arg_wn) == OPR_LDA || 00914 WN_operator(arg_wn) == OPR_LDID) { 00915 00916 ST *arg_st = WN_st(arg_wn); 00917 TY_IDX arg_ty = Get_Array_Type(arg_st); 00918 00919 mangled_ptr = DRA_Encode_Parameter(arg_st, 00920 arg_ty, 00921 mangled_ptr, 00922 dra_table); 00923 } 00924 else { 00925 // non-LDA arguments are expressions -- treat them as scalars 00926 // 00927 *mangled_ptr++ = '0'; 00928 } 00929 *mangled_ptr++ = DRA_ARG_SEPARATOR; 00930 } 00931 *mangled_ptr = '\0'; 00932 00933 00934 // Remember the old ST entry in order to mark it unused 00935 // 00936 ST *old_st = WN_st(call_wn); 00937 00938 // Lookup the mangled name in the hash table 00939 // 00940 MANGLED_FUNC *call_desc = DRA_func_table->Find(Save_Str(mangled_buf)); 00941 00942 if (call_desc == NULL) { // name not found 00943 00944 // If the mangled name is new, create new PU/ST entries 00945 // 00946 PU_IDX new_pu_idx; 00947 PU& new_pu = New_PU (new_pu_idx); 00948 Pu_Table[new_pu_idx] = Pu_Table[ST_pu(old_st)]; 00949 Set_PU_no_inline (new_pu); 00950 00951 ST *new_st = Copy_ST(old_st); 00952 WN_st_idx (call_wn) = ST_st_idx (new_st); 00953 Clear_ST_is_not_used (new_st); 00954 00955 // Set the PU index for the new ST 00956 // 00957 Set_ST_pu (new_st, new_pu_idx); 00958 00959 // Store the new (now mangled) name 00960 // 00961 Set_ST_name (new_st, Save_Str(mangled_buf)); 00962 00963 // Set the storage class to EXTERN (no definition yet) 00964 // 00965 Set_ST_sclass (new_st, SCLASS_EXTERN); 00966 00967 // Copy_ST may set base_idx to .text block, and 00968 // that's not allowed for EXTERN storage class 00969 Set_ST_base (new_st, new_st); 00970 Set_ST_ofst (new_st, 0); 00971 00972 // Remember the name in the local hash table 00973 // 00974 call_desc = CXX_NEW(MANGLED_FUNC, &MEM_src_pool); 00975 call_desc->st = new_st; 00976 call_desc->is_called = TRUE; 00977 DRA_func_table->Enter(ST_name_idx(new_st), call_desc); 00978 } else { 00979 // If the name is found, use its ST pointer 00980 // 00981 WN_st_idx (call_wn) = ST_st_idx (call_desc->st); 00982 call_desc->is_called = TRUE; 00983 } 00984 00985 // Mark old ST entry as unused if there were no other calls to it 00986 // 00987 if (!PU_has_non_mangled_call (Pu_Table[ST_pu (old_st)])) 00988 Set_ST_is_not_used (old_st); 00989 } 00990 00991 else { 00992 // No reshaped arrays are passed at this call 00993 // 00994 if (call_oper == OPR_CALL) { 00995 ST* st = WN_st (call_wn); 00996 Set_PU_has_non_mangled_call (Pu_Table[ST_pu (st)]); 00997 Clear_ST_is_not_used (st); 00998 } 00999 } 01000 } 01001 01002 01003 01004 01005 // ===================================================================== 01006 // 01007 // Function Name: DRA_Preprocess_Entry 01008 // 01009 // Description: Compute the mangling buffer size for a function entry 01010 // point and determine if it has reshaped formals 01011 // 01012 // ===================================================================== 01013 01014 static UINT 01015 DRA_Preprocess_Entry(WN *entry_wn, 01016 INT16 num_formals, 01017 DRA_HASH_TABLE *dra_table, 01018 BOOL *has_reshaped_formals) 01019 { 01020 UINT bufsize = strlen(ST_name(WN_st(entry_wn))) + 2*DRA_MANGLE_SIG_LEN + 1; 01021 01022 for (INT16 formal = 0; formal < num_formals; ++formal) { 01023 01024 ST *formal_st = WN_st(WN_formal(entry_wn, formal)); 01025 TY_IDX formal_ty = Get_Array_Type(formal_st); 01026 01027 if (TY_kind(formal_ty) != KIND_ARRAY) { 01028 bufsize += 2; 01029 } 01030 else { 01031 DRA_INFO *dra = dra_table->Find(formal_st); 01032 if (dra == NULL) { 01033 bufsize += 2; 01034 } 01035 else { 01036 *has_reshaped_formals = TRUE; 01037 01038 // For encoding a reshaped array argument, we need: 01039 // <ndims(5)>D<esize(21)>E<distributions(ndims x 22)> chars 01040 // 01041 bufsize += 28 + 22*TY_AR_ndims(Ty_Table[formal_ty]); 01042 } 01043 } 01044 } 01045 01046 return bufsize; 01047 } 01048 01049 01050 01051 01052 // ===================================================================== 01053 // 01054 // Function Name: DRA_Preprocess_Call_site 01055 // 01056 // Description: Compute the mangling buffer size for a call site 01057 // point and determine if it has reshaped arguments 01058 // 01059 // ===================================================================== 01060 01061 static UINT 01062 DRA_Preprocess_Call_Site(WN *call_wn, 01063 INT16 num_args, 01064 DRA_HASH_TABLE *dra_table, 01065 BOOL *has_reshaped_args) 01066 { 01067 UINT bufsize = 0; 01068 if (WN_operator(call_wn) == OPR_CALL) { 01069 bufsize = strlen(ST_name(WN_st(call_wn))) + 2*DRA_MANGLE_SIG_LEN + 1; 01070 } 01071 01072 for (INT16 arg = 0; arg < num_args; ++arg) { 01073 01074 // Kid 0 of OPC_PARM is the actual argument 01075 // 01076 WN *parm_wn = WN_actual(call_wn, arg); 01077 WN *arg_wn = WN_kid(parm_wn, 0); 01078 01079 if (WN_operator(arg_wn) == OPR_LDA || 01080 WN_operator(arg_wn) == OPR_LDID) { 01081 01082 ST *arg_st = WN_st(arg_wn); 01083 TY_IDX arg_ty = Get_Array_Type(arg_st); 01084 01085 if (TY_kind(arg_ty) != KIND_ARRAY) { 01086 bufsize += 2; 01087 } 01088 else { 01089 DRA_INFO *dra = dra_table->Find(arg_st); 01090 if (dra == NULL) { 01091 bufsize += 2; 01092 } 01093 else { 01094 *has_reshaped_args = TRUE; 01095 01096 // For encoding a reshaped array argument, we need: 01097 // <ndims(5)>D<esize(21)>E<distributions(ndims x 22)> chars 01098 // 01099 bufsize += 28 + 22*TY_AR_ndims(Ty_Table[arg_ty]); 01100 } 01101 } 01102 } 01103 else { 01104 bufsize += 2; 01105 } 01106 } 01107 01108 return bufsize; 01109 } 01110 01111 01112 01113 01114 // ===================================================================== 01115 // 01116 // Function Name: DRA_Insert_Mangling_Sigs 01117 // 01118 // Description: Insert DRA_MANGLE_SIG before and after the original 01119 // function name if that had not already been done 01120 // 01121 // ===================================================================== 01122 01123 static char* 01124 DRA_Insert_Mangling_Sigs(char *orig_name, 01125 char mangled_buf[]) 01126 { 01127 01128 if (strncmp(orig_name, DRA_MANGLE_SIG, DRA_MANGLE_SIG_LEN)) { 01129 // If the function name has not been mangled, do it now 01130 // 01131 (void) strcpy(mangled_buf, DRA_MANGLE_SIG); 01132 (void) strcpy(mangled_buf + DRA_MANGLE_SIG_LEN, orig_name); 01133 (void) strcpy(mangled_buf + DRA_MANGLE_SIG_LEN + strlen(orig_name), 01134 DRA_MANGLE_SIG); 01135 } 01136 else { 01137 // Otherwise, extract the sigs and the original function name 01138 // 01139 INT name_len = strstr(orig_name+1, DRA_MANGLE_SIG) 01140 + DRA_MANGLE_SIG_LEN - orig_name; 01141 (void) strncpy(mangled_buf, orig_name, name_len); 01142 mangled_buf[name_len] = '\0'; 01143 } 01144 01145 return (mangled_buf + strlen(mangled_buf)); 01146 } 01147 01148 01149 01150 01151 // ===================================================================== 01152 // 01153 // Function Name: DRA_Encode_Parameter 01154 // 01155 // Description: Encode a function parameter into mangled name 01156 // Scalars and non-reshaped arrays: 0 01157 // Distribute-reshaped arrays: <ndims>D<esize>E{S|B|C[chunk]}* 01158 // 01159 // ===================================================================== 01160 01161 static char* 01162 DRA_Encode_Parameter(ST *st, // ST pointer for the parameter 01163 TY_IDX ty_idx, // TY pointer for the parameter 01164 char *buf, // encoding buffer 01165 DRA_HASH_TABLE *dra_table) 01166 { 01167 TY& ty = Ty_Table[ty_idx]; 01168 // Encoding for all non-arrays is '0' 01169 // 01170 if (TY_kind(ty) != KIND_ARRAY) { 01171 *buf++ = '0'; 01172 return buf; 01173 } 01174 01175 DRA_INFO *dra = dra_table->Find(st); 01176 01177 // Encoding for non-reshaped arrays is '0' 01178 // 01179 if (dra == NULL) { 01180 *buf++ = '0'; 01181 return buf; 01182 } 01183 01184 // Now encode reshaped array 01185 // 01186 INT16 ndims = ARB_dimension (TY_arb(ty)); 01187 UINT64 size = TY_size (TY_etype(ty)); 01188 buf += sprintf(buf, "%d%c", ndims, DRA_NDIMS_END); 01189 buf += sprintf(buf, "%lld%c", size, DRA_ESIZE_END); 01190 01191 for (INT16 dim = 0; dim < ndims; ++dim) { 01192 01193 switch (dra->Distr_Type(dim)) { 01194 01195 case DISTRIBUTE_STAR: 01196 *buf++ = DRA_STAR_CODE; 01197 break; 01198 01199 case DISTRIBUTE_BLOCK: 01200 *buf++ = DRA_BLOCK_CODE; 01201 break; 01202 01203 case DISTRIBUTE_CYCLIC_CONST: 01204 *buf++ = DRA_CYCLIC_CODE; 01205 buf += sprintf(buf, "%lld", dra->Chunk_Const_Val(dim)); 01206 break; 01207 01208 case DISTRIBUTE_CYCLIC_EXPR: 01209 *buf++ = DRA_CYCLIC_CODE; 01210 break; 01211 } 01212 } 01213 01214 return buf; 01215 }