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 #include "wn.h" 00037 #include "stab.h" 00038 #include "strtab.h" 00039 #include "mtypes.h" 00040 #include "targ_const.h" 00041 #include "config_targ.h" 00042 #include "wn_util.h" 00043 #include "region_util.h" 00044 #include <alloca.h> 00045 #include "data_layout.h" 00046 00047 extern "C" { 00048 void Rewrite_Pragmas_On_Structs (WN* block_wn, WN* wn); 00049 } 00050 00051 static void Rewrite_Structs_In_MPRegion (WN* wn, 00052 WN* parent_wn, 00053 INT count, 00054 WN** rewrite_pwn, 00055 ST** rewrite_st, 00056 TYPE_ID* rewrite_rtype, 00057 TYPE_ID* rewrite_desc); 00058 static BOOL Tree_Equiv (WN *wn1, WN* wn2); 00059 00060 /*********************************************************************** 00061 * 00062 * Is the given wn an MP region? 00063 * 00064 ***********************************************************************/ 00065 static BOOL Is_Mp_Region(WN *wn) 00066 { 00067 return FALSE; 00068 } 00069 00070 /*********************************************************************** 00071 * 00072 * Given an XPRAGMA reduction, return TRUE if a weird array element, 00073 * i.e. an element of an array with a weird base (array itself a struct 00074 * element, F90 allocatable array, etc) 00075 * 00076 ***********************************************************************/ 00077 static BOOL Weird_Array_Element (WN *pwn) { 00078 Is_True (pwn && 00079 WN_operator(pwn) == OPR_XPRAGMA && 00080 WN_pragma(pwn) == WN_PRAGMA_REDUCTION, 00081 ("Weird_Array_Element called weirdly")); 00082 00083 if (WN_operator(WN_kid0(pwn)) != OPR_ARRAY) return FALSE; 00084 00085 WN *array_base = WN_array_base(WN_kid0(pwn)); 00086 OPERATOR opr = WN_operator(array_base); 00087 if ((opr == OPR_LDA && 00088 TY_kind(ST_type(WN_st(array_base))) == KIND_ARRAY) || 00089 (opr == OPR_LDID && 00090 TY_kind(ST_type(WN_st(array_base))) == KIND_POINTER && 00091 TY_kind(TY_pointed(ST_type(WN_st(array_base)))) == KIND_ARRAY)) 00092 { 00093 // This looks well-behaved; 00094 return FALSE; 00095 } 00096 return TRUE; 00097 } 00098 00099 /*********************************************************************** 00100 * 00101 * Given an XPRAGMA reduction, return TRUE if the reduction is on an 00102 * array element, with the element itself being a struct, so that the 00103 * reduction itself is on a field within the struct. This field offset 00104 * is given by WN_pragma_arg2 field within the XPRAGMA node. 00105 * 00106 * E.g. 00107 * struct { 00108 * int a; 00109 * int b; 00110 * } w[2], x, *y, *z[2]; 00111 * and with reduction on w[i].a (case 1) or on (&x)[0].a (case 2) or on 00112 * y[0].a (case 3) or on (*z)[i].a (case 4). 00113 * 00114 * Cases 1 and 4 result from straightforward parallelization of user code. 00115 * Cases 2 and 3 can come up sometimes as a result of converting pointer 00116 * expressions to array references to allow analysis by LNO. 00117 * 00118 ***********************************************************************/ 00119 static BOOL Array_Element_Then_Struct (WN *pwn) { 00120 00121 Is_True (pwn && 00122 WN_operator(pwn) == OPR_XPRAGMA && 00123 WN_pragma(pwn) == WN_PRAGMA_REDUCTION, 00124 ("Array_Element_Then_Struct called weirdly")); 00125 00126 if (WN_operator(WN_kid0(pwn)) != OPR_ARRAY) return FALSE; 00127 00128 WN *array_base = WN_array_base(WN_kid0(pwn)); 00129 OPERATOR opr = WN_operator(array_base); 00130 00131 if (opr == OPR_LDA) { 00132 TY_IDX ty = ST_type(WN_st(array_base)); 00133 00134 if (TY_kind(ty) == KIND_ARRAY && TY_kind(TY_etype(ty)) == KIND_STRUCT) 00135 return TRUE; // case 1 00136 00137 if (TY_kind(ty) == KIND_STRUCT) 00138 return TRUE; // case 2 00139 00140 } else if (opr == OPR_LDID) { 00141 TY_IDX ty = ST_type(WN_st(array_base)); 00142 00143 if (TY_kind(ty) == KIND_POINTER) { 00144 if (TY_kind(TY_pointed(ty)) == KIND_STRUCT) 00145 return TRUE; // case 3 00146 else if (TY_kind(TY_pointed(ty)) == KIND_ARRAY && 00147 TY_kind(TY_etype(TY_pointed(ty))) == KIND_STRUCT) 00148 return TRUE; // case 4 00149 } 00150 } 00151 00152 return FALSE; 00153 } 00154 00155 /*********************************************************************** 00156 * 00157 * Given a WHIRL tree in wn, and the block node containing it in block_wn, 00158 * find all compiler-generated local/firstprivate/lastlocal/reduction pragmas 00159 * on structure elements, and replace them with simple scalars. 00160 * 00161 * Note that as a temporary hack, PFA-generated XPRAGMA reductions use 00162 * WN_prefetch_flag to encode the offset, since WN_pragma_arg2 is already 00163 * taken up by the reduction operator. 00164 * 00165 * (block_wn is required coz we don't have parent pointers). 00166 * 00167 ***********************************************************************/ 00168 extern void Rewrite_Pragmas_On_Structs (WN* block_wn, WN* wn) { 00169 if (!wn) return; 00170 00171 if (Is_Mp_Region (wn)) { 00172 00173 FmtAssert (block_wn, ("Rewrite_Pragmas: missing BLOCK node")); 00174 /* 00175 * first count the number of rewrite entries 00176 */ 00177 WN* pwn = WN_first(WN_region_pragmas(wn)); 00178 INT count = 0; 00179 while (pwn) { 00180 Is_True (WN_operator(pwn) == OPR_PRAGMA || 00181 WN_operator(pwn) == OPR_XPRAGMA, 00182 ("Rewrite_Pragmas: Expected a pragma/xpragma node")); 00183 00184 ST* st = NULL; 00185 if (WN_operator(pwn) == OPR_PRAGMA) st = WN_st(pwn); 00186 00187 if (WN_operator(pwn) == OPR_PRAGMA && 00188 WN_pragma_compiler_generated(pwn) && 00189 (WN_pragma(pwn) == WN_PRAGMA_REDUCTION || 00190 WN_pragma(pwn) == WN_PRAGMA_LOCAL || 00191 WN_pragma(pwn) == WN_PRAGMA_FIRSTPRIVATE || 00192 WN_pragma(pwn) == WN_PRAGMA_LASTLOCAL) && 00193 (TY_kind(ST_type(st)) == KIND_STRUCT)) { 00194 00195 // compiler generated local/firstprivate/lastlocal/reduction 00196 // on a struct element 00197 count++; 00198 } 00199 else if (WN_operator(pwn) == OPR_XPRAGMA && 00200 WN_pragma_compiler_generated(pwn) && 00201 WN_pragma(pwn) == WN_PRAGMA_REDUCTION && 00202 WN_operator(WN_kid0(pwn)) == OPR_ARRAY) { 00203 00204 // this is an array-element reduction. 00205 // let regular Fortran array-element reductions go through, 00206 // but rewrite all the weird cases. 00207 00208 WN* array_base = WN_array_base(WN_kid0(pwn)); 00209 OPERATOR opr = WN_operator(array_base); 00210 00211 if (Array_Element_Then_Struct(pwn)) { 00212 // compiler generated reduction on an array element, where 00213 // the element type of the array is a struct. 00214 count++; 00215 00216 } else if (Weird_Array_Element(pwn)) { 00217 // compiler generated reduction on an array element, 00218 // but with a weird base (struct element, F90 allocatable array) 00219 count++; 00220 } 00221 00222 } 00223 pwn = WN_next(pwn); 00224 } 00225 00226 if (count) { 00227 /* ok, now we know how many symbols to rewrite. store them */ 00228 WN** rewrite_pwn = (WN**) alloca (count*sizeof(WN*)); 00229 ST** rewrite_st = (ST**) alloca (count*sizeof(ST*)); 00230 TYPE_ID* rewrite_rtype = (TYPE_ID*) alloca (count*sizeof(TYPE_ID)); 00231 TYPE_ID* rewrite_desc = (TYPE_ID*) alloca (count*sizeof(TYPE_ID)); 00232 INT i = 0; 00233 pwn = WN_first(WN_region_pragmas(wn)); 00234 while (pwn) { 00235 ST* st = NULL; 00236 if (WN_operator(pwn) == OPR_PRAGMA) st = WN_st(pwn); 00237 00238 if (WN_operator(pwn) == OPR_PRAGMA && 00239 WN_pragma_compiler_generated(pwn) && 00240 (WN_pragma(pwn) == WN_PRAGMA_REDUCTION || 00241 WN_pragma(pwn) == WN_PRAGMA_LOCAL || 00242 WN_pragma(pwn) == WN_PRAGMA_FIRSTPRIVATE || 00243 WN_pragma(pwn) == WN_PRAGMA_LASTLOCAL) && 00244 (TY_kind(ST_type(st)) == KIND_STRUCT)) { 00245 00246 /* 00247 * compiler generated local/firstprivate/lastlocal/reduction 00248 * on a struct element. 00249 * So do the rewrite. 00250 */ 00251 00252 FmtAssert (i<count, ("Rewrite_STs. counting error")); 00253 // check for duplicates 00254 BOOL duplicate = FALSE; 00255 for (INT j=0; j<i; j++) { 00256 if (WN_st(rewrite_pwn[j]) == WN_st(pwn) && 00257 WN_pragma_arg1(rewrite_pwn[j]) == WN_pragma_arg1(pwn)) { 00258 if (WN_pragma(rewrite_pwn[j]) == WN_pragma(pwn)) { 00259 duplicate = TRUE; 00260 // delete the redundant pragma 00261 WN* tmp_wn = pwn; 00262 pwn = WN_prev(pwn); 00263 WN_DELETE_FromBlock (WN_region_pragmas(wn), tmp_wn); 00264 break; 00265 } 00266 else { 00267 FmtAssert (FALSE, ("Rewrite_Pragmas: contradictory pragmas")); 00268 } 00269 } 00270 } 00271 if (!duplicate) { 00272 rewrite_pwn[i] = pwn; 00273 rewrite_st[i] = NULL; 00274 i++; 00275 } 00276 } 00277 else if (WN_operator(pwn) == OPR_XPRAGMA && 00278 WN_pragma_compiler_generated(pwn) && 00279 WN_pragma(pwn) == WN_PRAGMA_REDUCTION && 00280 WN_operator(WN_kid0(pwn)) == OPR_ARRAY) { 00281 00282 WN* array_base = WN_array_base(WN_kid0(pwn)); 00283 OPERATOR opr = WN_operator(array_base); 00284 00285 if (Array_Element_Then_Struct(pwn) || 00286 Weird_Array_Element(pwn)) { 00287 00288 // check for duplicates 00289 BOOL duplicate = FALSE; 00290 for (INT j=0; j<i; j++) { 00291 if (Tree_Equiv(rewrite_pwn[j], pwn)) { 00292 duplicate = TRUE; 00293 // delete the redundant pragma 00294 WN* tmp_wn = pwn; 00295 pwn = WN_prev(pwn); 00296 WN_DELETE_FromBlock (WN_region_pragmas(wn), tmp_wn); 00297 break; 00298 } 00299 } 00300 if (!duplicate) { 00301 rewrite_pwn[i] = pwn; 00302 rewrite_st[i] = NULL; 00303 i++; 00304 } 00305 } 00306 } 00307 pwn = WN_next(pwn); 00308 } 00309 00310 count = i; 00311 /* now rewrite all pragmas that need rewriting */ 00312 Rewrite_Structs_In_MPRegion (WN_region_body(wn), 00313 wn, 00314 count, 00315 rewrite_pwn, 00316 rewrite_st, 00317 rewrite_rtype, 00318 rewrite_desc); 00319 00320 /* now do the appropriate initialization etc */ 00321 for (i=0; i<count; i++) { 00322 00323 // if we didn't even find a reference to the variable in the 00324 // MP-region body, then we don't have to do anything. 00325 if (rewrite_st[i] == NULL) continue; 00326 00327 pwn = rewrite_pwn[i]; 00328 00329 if (WN_operator(pwn) == OPR_XPRAGMA) { 00330 // array reduction 00331 00332 /* initialization of new-symbol */ 00333 OPCODE opc = OPCODE_make_op(OPR_ILOAD, 00334 rewrite_rtype[i], 00335 rewrite_desc[i]); 00336 WN* iload_wn = WN_CreateIload (opc, WN_prefetch_flag(pwn), 00337 ST_type(rewrite_st[i]), 00338 Make_Pointer_Type(ST_type 00339 (rewrite_st[i]), 00340 FALSE), 00341 WN_COPY_Tree(WN_kid0(pwn))); 00342 00343 opc = OPCODE_make_op (OPR_STID, MTYPE_V, rewrite_desc[i]); 00344 WN* stid_wn = WN_CreateStid (opc, 0, rewrite_st[i], 00345 ST_type(rewrite_st[i]), 00346 iload_wn); 00347 WN_INSERT_BlockBefore (block_wn, wn, stid_wn); 00348 00349 /* finalization of new symbol */ 00350 opc = OPCODE_make_op(OPR_LDID, 00351 rewrite_rtype[i], 00352 rewrite_desc[i]); 00353 WN *ldid_wn = WN_CreateLdid (opc, 00354 0, 00355 rewrite_st[i], 00356 ST_type(rewrite_st[i])); 00357 opc = OPCODE_make_op (OPR_ISTORE, MTYPE_V, rewrite_desc[i]); 00358 WN* istore_wn = WN_CreateIstore (opc, WN_prefetch_flag(pwn), 00359 Make_Pointer_Type(ST_type 00360 (rewrite_st[i]), 00361 FALSE), 00362 ldid_wn, 00363 WN_COPY_Tree(WN_kid0(pwn))); 00364 WN_INSERT_BlockAfter (block_wn, wn, istore_wn); 00365 00366 // create a new pragma, delete the old one 00367 WN* pragma_wn = WN_CreatePragma (WN_PRAGMA_REDUCTION, 00368 rewrite_st[i], 0, 0); 00369 // PV 525199: need to copy over reduction operator 00370 WN_pragma_arg2(pragma_wn) = WN_pragma_arg2(pwn); 00371 WN_INSERT_BlockBefore (WN_region_pragmas(wn), pwn, pragma_wn); 00372 WN_DELETE_FromBlock (WN_region_pragmas(wn), pwn); 00373 continue; 00374 } 00375 else { 00376 ST* st = WN_st(pwn); 00377 00378 switch (WN_pragma(pwn)) { 00379 case WN_PRAGMA_REDUCTION: 00380 { 00381 /* initialization of new-symbol */ 00382 OPCODE opc = OPCODE_make_op(OPR_LDID, 00383 rewrite_rtype[i], 00384 rewrite_desc[i]); 00385 WN* ldid_wn = WN_CreateLdid (opc, 00386 WN_pragma_arg1(pwn), 00387 st, 00388 ST_type(rewrite_st[i])); 00389 opc = OPCODE_make_op (OPR_STID, MTYPE_V, rewrite_desc[i]); 00390 WN* stid_wn = WN_CreateStid (opc, 0, rewrite_st[i], 00391 ST_type(rewrite_st[i]), 00392 ldid_wn); 00393 WN_INSERT_BlockBefore (block_wn, wn, stid_wn); 00394 00395 /* finalization of new symbol */ 00396 opc = OPCODE_make_op(OPR_LDID, 00397 rewrite_rtype[i], 00398 rewrite_desc[i]); 00399 ldid_wn = WN_CreateLdid (opc, 00400 0, 00401 rewrite_st[i], 00402 ST_type(rewrite_st[i])); 00403 opc = OPCODE_make_op (OPR_STID, MTYPE_V, rewrite_desc[i]); 00404 stid_wn = WN_CreateStid (opc, WN_pragma_arg1(pwn), 00405 st, 00406 ST_type(rewrite_st[i]), 00407 ldid_wn); 00408 WN_INSERT_BlockAfter (block_wn, wn, stid_wn); 00409 00410 /* now we can rewrite the pragma */ 00411 WN_st_idx(pwn) = ST_st_idx(rewrite_st[i]); 00412 WN_pragma_arg1(pwn) = 0; 00413 break; 00414 } 00415 case WN_PRAGMA_LOCAL: 00416 { 00417 /* just rewrite the pragma */ 00418 WN_st_idx(pwn) = ST_st_idx(rewrite_st[i]); 00419 WN_pragma_arg1(pwn) = 0; 00420 break; 00421 } 00422 case WN_PRAGMA_FIRSTPRIVATE: 00423 { 00424 /* initialization of new symbol */ 00425 00426 // it is remotely possible that we saw only an STID, 00427 // but didn't see an LDID of the symbol at all. 00428 // And the symbol is live-out. 00429 // In which case rewrite_rtype will be void. 00430 // Just use rewrite_desc in that case. 00431 OPCODE opc = OPCODE_make_op(OPR_LDID, 00432 (rewrite_rtype[i] != MTYPE_V ? 00433 rewrite_rtype[i] : rewrite_desc[i]), 00434 rewrite_desc[i]); 00435 WN *ldid_wn = WN_CreateLdid (opc, 00436 WN_pragma_arg1(pwn), 00437 WN_st(pwn), 00438 ST_type(rewrite_st[i])); 00439 opc = OPCODE_make_op (OPR_STID, MTYPE_V, rewrite_desc[i]); 00440 WN* stid_wn = WN_CreateStid (opc, 00441 0, 00442 rewrite_st[i], 00443 ST_type(rewrite_st[i]), 00444 ldid_wn); 00445 00446 WN_INSERT_BlockFirst (WN_region_body(wn), stid_wn); 00447 00448 /* now we can rewrite the pragma */ 00449 WN_st_idx(pwn) = ST_st_idx (rewrite_st[i]); 00450 WN_pragma_arg1(pwn) = 0; 00451 break; 00452 } 00453 case WN_PRAGMA_LASTLOCAL: 00454 { 00455 /* finalization of new symbol */ 00456 00457 // it is remotely possible that we saw only an STID, 00458 // but didn't see an LDID of the symbol at all. 00459 // And the symbol is live-out. 00460 // In which case rewrite_rtype will be void. 00461 // Just use rewrite_desc in that case. 00462 OPCODE opc = OPCODE_make_op(OPR_LDID, 00463 (rewrite_rtype[i] != MTYPE_V ? 00464 rewrite_rtype[i] : rewrite_desc[i]), 00465 rewrite_desc[i]); 00466 WN* ldid_wn = WN_CreateLdid (opc, 00467 0, 00468 rewrite_st[i], 00469 ST_type(rewrite_st[i])); 00470 opc = OPCODE_make_op (OPR_STID, MTYPE_V, rewrite_desc[i]); 00471 WN* stid_wn = WN_CreateStid (opc, WN_pragma_arg1(pwn), 00472 st, 00473 ST_type(rewrite_st[i]), 00474 ldid_wn); 00475 WN_INSERT_BlockAfter (block_wn, wn, stid_wn); 00476 00477 /* now we can rewrite the pragma */ 00478 WN_st_idx(pwn) = ST_st_idx(rewrite_st[i]); 00479 WN_pragma_arg1(pwn) = 0; 00480 break; 00481 } 00482 default: 00483 { 00484 FmtAssert (FALSE, ("Rewrite_Pragmas: Unknown pragma type")); 00485 } 00486 } 00487 } 00488 } 00489 } 00490 } 00491 00492 if (WN_opcode(wn) == OPC_BLOCK) { 00493 WN* kid = WN_first(wn); 00494 while (kid) { 00495 Rewrite_Pragmas_On_Structs (wn, kid); 00496 kid = WN_next(kid); 00497 } 00498 } 00499 else { 00500 for (INT i=0; i<WN_kid_count(wn); i++) { 00501 Rewrite_Pragmas_On_Structs (NULL, WN_kid(wn,i)); 00502 } 00503 } 00504 } 00505 00506 /*********************************************************************** 00507 * 00508 * See if any of the pragmas in the rewrite_pwn pragma list matches 00509 * the given ST and ofst. If so, return its index, otherwise return -1. 00510 * 00511 ***********************************************************************/ 00512 static INT Find_Symbol (WN** rewrite_pwn, INT count, ST* st, WN_OFFSET ofst) { 00513 00514 for (INT i=0; i<count; i++) { 00515 ST* this_st = NULL; 00516 if (WN_operator(rewrite_pwn[i]) == OPR_PRAGMA) { 00517 this_st = WN_st(rewrite_pwn[i]); 00518 } 00519 00520 if (this_st == st && WN_pragma_arg1(rewrite_pwn[i]) == ofst) 00521 return i; 00522 } 00523 return -1; 00524 } 00525 00526 /*********************************************************************** 00527 * 00528 * Return true if the sub-trees wn1 and wn2 and "equiv" 00529 * (the equiv notion is similar to a recursive WN_Equiv). 00530 * 00531 ***********************************************************************/ 00532 static BOOL Tree_Equiv (WN *wn1, WN* wn2) { 00533 00534 if (!wn1 && !wn2) return TRUE; // both are NULL 00535 if (!wn1 || !wn2) return FALSE; // one (but not both) is NULL 00536 if (!WN_Equiv (wn1, wn2)) return FALSE; // not the same 00537 00538 // now examine the kids 00539 if (WN_opcode(wn1) == OPC_BLOCK) { 00540 WN *kid1 = WN_first(wn1); 00541 WN *kid2 = WN_first(wn2); 00542 while (1) { 00543 if (!Tree_Equiv (kid1, kid2)) return FALSE; 00544 if (kid1 == NULL) break; 00545 kid1 = WN_next (kid1); 00546 kid2 = WN_next (kid2); 00547 }; 00548 return TRUE; 00549 } 00550 else { 00551 // since the two nodes are equiv, they have the same # of children 00552 for (INT i=0; i<WN_kid_count(wn1); i++) 00553 if (!Tree_Equiv (WN_kid(wn1,i), WN_kid(wn2,i))) return FALSE; 00554 return TRUE; 00555 } 00556 } 00557 00558 /*********************************************************************** 00559 * 00560 * See if any of the Xpragmas in the rewrite_pwn pragma list match 00561 * the given array_wn. If so, return its index, otherwise return -1. 00562 * 00563 ***********************************************************************/ 00564 static INT Find_Reduction_Symbol (WN** rewrite_pwn, 00565 INT count, 00566 WN* array_wn, 00567 INT64 ofst) { 00568 00569 for (INT i=0; i<count; i++) { 00570 WN* pwn = rewrite_pwn[i]; 00571 if ((WN_operator(pwn) == OPR_XPRAGMA) && 00572 Tree_Equiv (WN_kid0(pwn), array_wn) && 00573 ofst == WN_prefetch_flag(pwn)) { 00574 return i; 00575 } 00576 } 00577 return -1; 00578 } 00579 00580 /*********************************************************************** 00581 * 00582 * Given a WHIRL tree in "wn", find all LDID/STID that refer to 00583 * a struct-symbol in rewrite_pwn. For each such ldid/stid, replace 00584 * it with a reference to the new st from rewrite_st. 00585 * 00586 * rewrite_rtype and rewrite_desc store the rtype and desc of the load/store. 00587 * 00588 ***********************************************************************/ 00589 static void Rewrite_Structs_In_MPRegion (WN* wn, 00590 WN* parent_wn, 00591 INT count, 00592 WN** rewrite_pwn, 00593 ST** rewrite_st, 00594 TYPE_ID* rewrite_rtype, 00595 TYPE_ID* rewrite_desc) { 00596 00597 if (!wn) return; 00598 00599 /* rewrite memory ops - only LDID/STIDs, since scalar struct 00600 * elements should never be referenced any other way. 00601 * Also, we don't need to examine pragmas, since lastlocal and reduction 00602 * can only appear on the PDO, not a PARALLEL region, and if there is a 00603 * LOCAL on the parallel region, then we won't have any pragma on the 00604 * nested PDO. (And even if we do, we can safely localize the struct element 00605 * for the entire parallel region and be correct. 00606 */ 00607 00608 OPERATOR opr = WN_operator(wn); 00609 00610 if (opr == OPR_LDID || opr == OPR_STID) { 00611 ST* st = WN_st(wn); 00612 00613 INT idx = Find_Symbol (rewrite_pwn, count, st, WN_offset(wn)); 00614 if (idx != -1) { 00615 if (rewrite_st[idx] == NULL) { 00616 /* create the replacement ST. Always create it on the stack */ 00617 00618 char* name = (char*) alloca(strlen(ST_name(st))+10); 00619 sprintf (name, "rewrite_%s", ST_name(st)); 00620 00621 ST* new_st = New_ST(CURRENT_SYMTAB); 00622 ST_Init (new_st, 00623 Save_Str(name), 00624 ST_class(st), 00625 SCLASS_AUTO, 00626 EXPORT_LOCAL, 00627 WN_ty(wn)); 00628 00629 rewrite_st[idx] = new_st; 00630 rewrite_desc[idx] = WN_desc(wn); 00631 rewrite_rtype[idx] = WN_rtype(wn); 00632 } 00633 // rtype may still be garbage if we saw a store first 00634 if (opr == OPR_LDID && rewrite_rtype[idx] == MTYPE_V) { 00635 rewrite_rtype[idx] = WN_rtype(wn); 00636 // update desc as well, to be consistent 00637 rewrite_desc[idx] = WN_desc(wn); 00638 } 00639 00640 WN_st_idx(wn) = ST_st_idx(rewrite_st[idx]); 00641 WN_offset(wn) = 0; 00642 } 00643 } 00644 00645 // now check for an array element reduction. 00646 // Handle ILOAD and ISTORE of the array, as well as just the ARRAY node 00647 // in the case when it's a parameter. (This case will arise when PFA 00648 // becomes able to parallelize inter-procedural reductions.) 00649 00650 if (opr == OPR_ILOAD || opr == OPR_ISTORE || 00651 (opr == OPR_ARRAY && 00652 WN_operator(parent_wn) != OPR_ILOAD && 00653 WN_operator(parent_wn) != OPR_ISTORE)) { 00654 00655 WN* array_wn = (opr == OPR_ARRAY ? wn : 00656 (opr == OPR_ILOAD ? WN_kid0(wn) : 00657 WN_kid1(wn))); 00658 00659 if (WN_operator(array_wn) == OPR_ARRAY) { 00660 00661 INT idx = Find_Reduction_Symbol (rewrite_pwn, 00662 count, 00663 array_wn, 00664 ((opr == OPR_ILOAD || OPR_ISTORE) ? 00665 WN_offset(wn) : 0)); 00666 if (idx != -1) { 00667 00668 #ifdef Is_True_On 00669 if (opr == OPR_ARRAY) { 00670 // any use of reduction ARRAY node other than load/store/ 00671 // pass as param. probably signals a bug in PFA 00672 Is_True(WN_operator(parent_wn) == OPR_PARM, 00673 ("Rewrite_Structs_In_MPRegion(): bad parent opr == %d", 00674 (INT) WN_operator(parent_wn))); 00675 } 00676 #endif 00677 00678 if (rewrite_st[idx] == NULL) { 00679 /* create the replacement ST. Always create it on the stack */ 00680 00681 char* name = (char*) alloca(20); 00682 sprintf (name, "rewrite_xreducn"); 00683 00684 ST* new_st = New_ST(CURRENT_SYMTAB); 00685 00686 TY_IDX new_ty_idx; 00687 if (opr == OPR_ISTORE) 00688 new_ty_idx = TY_pointed(WN_ty(wn)); 00689 else if (opr == OPR_ARRAY) 00690 new_ty_idx = WN_ty(parent_wn); 00691 else 00692 new_ty_idx = WN_ty(wn); 00693 00694 ST_Init (new_st, 00695 Save_Str(name), 00696 CLASS_VAR, 00697 SCLASS_AUTO, 00698 EXPORT_LOCAL, 00699 new_ty_idx); 00700 00701 rewrite_st[idx] = new_st; 00702 rewrite_desc[idx] = WN_desc(wn); 00703 rewrite_rtype[idx] = WN_rtype(wn); 00704 } 00705 if (opr == OPR_ILOAD && rewrite_rtype[idx] == MTYPE_V) { 00706 rewrite_rtype[idx] = WN_rtype(wn); 00707 } 00708 00709 // replace the iload/istore with ldid/stid of the new scalar 00710 switch (opr) { 00711 00712 case OPR_ILOAD: { 00713 OPCODE opc = OPCODE_make_op(OPR_LDID, 00714 rewrite_rtype[idx], 00715 rewrite_desc[idx]); 00716 WN *ldid_wn = WN_CreateLdid (opc, 0, rewrite_st[idx], 00717 ST_type(rewrite_st[idx])); 00718 FmtAssert (WN_opcode(parent_wn) != OPC_BLOCK, 00719 ("Rewrite_pragmas: iload under a BLOCK node")); 00720 INT kidno; 00721 for (kidno=0; kidno<WN_kid_count(parent_wn); kidno++) { 00722 if (WN_kid(parent_wn,kidno) == wn) break; 00723 } 00724 FmtAssert (kidno < WN_kid_count(parent_wn), 00725 ("Rewrite_Pragmas: Could not find kid in parent")); 00726 WN_DELETE_Tree (WN_kid(parent_wn, kidno)); 00727 WN_kid(parent_wn, kidno) = ldid_wn; 00728 wn = ldid_wn; 00729 break; 00730 } 00731 00732 case OPR_ISTORE: { 00733 OPCODE opc = OPCODE_make_op (OPR_STID, MTYPE_V, rewrite_desc[idx]); 00734 WN* stid_wn = WN_CreateStid (opc, 0, rewrite_st[idx], 00735 ST_type(rewrite_st[idx]), 00736 WN_COPY_Tree(WN_kid0(wn))); 00737 FmtAssert (WN_opcode(parent_wn) == OPC_BLOCK, 00738 ("Rewrite_pragmas: istore not under a BLOCK node")); 00739 WN_INSERT_BlockBefore (parent_wn, wn, stid_wn); 00740 WN_DELETE_FromBlock (parent_wn, wn); 00741 wn = stid_wn; 00742 break; 00743 } 00744 00745 case OPR_ARRAY: { 00746 OPCODE opc = OPCODE_make_op (OPR_LDA, Pointer_type, MTYPE_V); 00747 WN* lda_wn = 00748 WN_CreateLda (opc, 0, 00749 Make_Pointer_Type(ST_type(rewrite_st[idx]), FALSE), 00750 rewrite_st[idx]); 00751 FmtAssert (WN_opcode(parent_wn) != OPC_BLOCK, 00752 ("Rewrite_pragmas: array under a BLOCK node")); 00753 INT kidno; 00754 for (kidno=0; kidno<WN_kid_count(parent_wn); kidno++) { 00755 if (WN_kid(parent_wn,kidno) == wn) break; 00756 } 00757 FmtAssert (kidno < WN_kid_count(parent_wn), 00758 ("Rewrite_Pragmas: Could not find kid in parent")); 00759 WN_DELETE_Tree (WN_kid(parent_wn, kidno)); 00760 WN_kid(parent_wn, kidno) = lda_wn; 00761 wn = lda_wn; 00762 break; 00763 } 00764 } 00765 } 00766 } 00767 } 00768 00769 if (WN_opcode(wn) == OPC_BLOCK) { 00770 WN* kid = WN_first(wn); 00771 while (kid) { 00772 Rewrite_Structs_In_MPRegion (kid, 00773 wn, 00774 count, 00775 rewrite_pwn, 00776 rewrite_st, 00777 rewrite_rtype, 00778 rewrite_desc); 00779 kid = WN_next(kid); 00780 } 00781 } 00782 else { 00783 for (INT i=0; i<WN_kid_count(wn); i++) { 00784 Rewrite_Structs_In_MPRegion (WN_kid(wn,i), 00785 wn, 00786 count, 00787 rewrite_pwn, 00788 rewrite_st, 00789 rewrite_rtype, 00790 rewrite_desc); 00791 } 00792 } 00793 }