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.a 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 * Description: contains routines to support directives, converting 00041 * from Cray IR to WHIRL. Entry points from 00042 * PDGCS layer are 00043 * 00044 * fei_task_var - called to process various vars in clauses 00045 * fei_parallel_region - CMIC$ parallel 00046 * fei_endparallel_region - CMIC$ end parallel 00047 * fei_doparallel - CMIC$ doparallel 00048 * fei_task_endloop - called at the end of a parallel loop 00049 * fei_doall - CMIC$ doall 00050 * fei_doacross - C$DOACROSS 00051 * fei_parallel - C$PAR parallel 00052 * fei_endparallel - C$PAR end parallel 00053 * fei_pdo - C$par pdo 00054 * fei_endpdo - C$PAR end pdo 00055 * fei_paralleldo - C$PAR PARALLEL DO 00056 * fei_singleprocess - C$PAR SINGLE PROCESS 00057 * fei_endsingleprocess - C$PAR END SINGLE PROCESS 00058 * fei_criticalsection - C$PAR CRITICAL SECTION 00059 * fei_endcriticalsection - C$PAR END CRITICAL SECTION 00060 * fei_barrier - C$PAR BARRIER 00061 * fei_section - C$PAR SECTION 00062 * fei_psection - C$PAR PSECTION 00063 * fei_endpsection - C$PAR END PSECTION 00064 * fei_copy_in - C$COPYIN 00065 * fei_dynamic 00066 * fei_redistribute 00067 * fei_interchange 00068 * fei_blockable 00069 * fei_fission 00070 * fei_fuse 00071 * fei_assert 00072 * fei_fill_symbol 00073 * fei_align_symbol 00074 * fei_unroll 00075 * fei_page_place 00076 * fei_prefetch_ref_disable 00077 * fei_prefetch_ref 00078 * fei_prefetch 00079 * fei_prefetch_manual 00080 * fei_regionbegin 00081 * fei_regionend 00082 * fei_section_gp 00083 * fei_section_nongp 00084 * fei_blocking_size 00085 * fei_purple_conditional 00086 * fei_purple_unconditional 00087 * fei_opaque 00088 * 00089 * ==================================================================== 00090 * ==================================================================== 00091 */ 00092 00093 static char *source_file = __FILE__; 00094 00095 /* sgi includes */ 00096 00097 #include "defs.h" 00098 #include "glob.h" 00099 #include "stab.h" 00100 #include "strtab.h" 00101 #include "errors.h" 00102 #include "targ_const.h" 00103 #include "config_targ.h" 00104 #include "const.h" 00105 #include "pu_info.h" 00106 #include "wn.h" 00107 #include "wn_util.h" 00108 #include "f90_utils.h" 00109 #include "targ_sim.h" 00110 00111 /* FE includes */ 00112 00113 #include "i_cvrt.h" 00114 00115 /* conversion includes */ 00116 00117 #include "cwh_defines.h" 00118 #include "cwh_addr.h" 00119 #include "cwh_expr.h" 00120 #include "cwh_stk.h" 00121 #include "cwh_block.h" 00122 #include "cwh_types.h" 00123 #include "cwh_preg.h" 00124 #include "cwh_stab.h" 00125 #include "cwh_auxst.h" 00126 #include "cwh_stmt.h" 00127 #include "cwh_directive.h" 00128 #include "cwh_directive.i" 00129 00130 static int task_var_count; /* count the number of private, shared, lastlocal */ 00131 static int task_nest_count; /* number of indexes in NEST clause */ 00132 static int task_lastthread_count; /* number of vars in LASTTHREAD */ 00133 static int task_affinity_count; /* number of indexes in AFFINITY */ 00134 00135 /*=============================================== 00136 * 00137 * fei_task_var 00138 * 00139 * Generate the pragma for a variable in a parallel directive 00140 * list (SHARED, PRIVATE, etc...) and push it onto the stack. 00141 * 00142 * The stack popped when processing a directive 00143 * 00144 *=============================================== 00145 */ 00146 extern INTPTR 00147 fei_task_var( INTPTR sym_idx, 00148 INT32 context) 00149 { 00150 STB_pkt *p; 00151 WN *wn; 00152 int op_code; 00153 ST *st; 00154 p = cast_to_STB(sym_idx); 00155 DevAssert((p->form == is_ST),("Odd object ref")); 00156 00157 st = (ST *)p->item; 00158 if (Has_Base_Block(st)) { 00159 ST * base = ST_base(st); 00160 if (ST_is_temp_var(base)) 00161 if (ST_sclass(base) == SCLASS_AUTO) 00162 if (!ST_is_return_var(base)) 00163 /* Do not generate a pragma for an automatic array */ 00164 /* The base var is also on the list, and that is the */ 00165 /* one that is needed. */ 00166 return(sym_idx); 00167 } 00168 00169 switch((CONTEXT_TYPE) context) { 00170 case Context_Omp_Private: 00171 case Context_Private: 00172 /* generate pragma for a LOCAL */ 00173 /* - these pragmas must be attached to the upcoming parallel region */ 00174 /* DLAI - what about the offset? */ 00175 wn = WN_CreatePragma(WN_PRAGMA_LOCAL, (ST *)p->item, 0, /* offset= */0); 00176 if ((CONTEXT_TYPE) context == Context_Omp_Private) 00177 WN_set_pragma_omp(wn); 00178 cwh_stk_push(wn, WN_item); 00179 task_var_count++; 00180 break; 00181 case Context_Omp_Shared: 00182 case Context_Shared: 00183 wn = WN_CreatePragma(WN_PRAGMA_SHARED, (ST *)p->item, 0, /*offset=*/0); 00184 if ((CONTEXT_TYPE) context == Context_Omp_Shared) 00185 WN_set_pragma_omp(wn); 00186 cwh_stk_push(wn, WN_item); 00187 task_var_count++; 00188 break; 00189 case Context_Omp_Lastprivate: 00190 case Context_Lastlocal: 00191 wn = WN_CreatePragma(WN_PRAGMA_LASTLOCAL, (ST *)p->item, 0, /*offset=*/0); 00192 if ((CONTEXT_TYPE) context == Context_Omp_Lastprivate) 00193 WN_set_pragma_omp(wn); 00194 cwh_stk_push(wn, WN_item); 00195 task_var_count++; 00196 break; 00197 case Context_Omp_Firstprivate: 00198 case Context_Getfirst: 00199 wn = WN_CreatePragma(WN_PRAGMA_FIRSTPRIVATE, (ST *)p->item, 0, /*offset=*/0); 00200 if ((CONTEXT_TYPE) context == Context_Omp_Firstprivate) 00201 WN_set_pragma_omp(wn); 00202 cwh_stk_push(wn, WN_item); 00203 task_var_count++; 00204 break; 00205 case Context_Affinity: 00206 case Context_Omp_Affinity: 00207 wn = WN_CreateXpragma( WN_PRAGMA_AFFINITY, (ST_IDX) NULL, 1); 00208 if ((CONTEXT_TYPE) context == Context_Omp_Affinity) 00209 WN_set_pragma_omp(wn); 00210 WN_kid0(wn) = cwh_addr_address_ST( (ST *)p->item, /* offset=*/ 0 ); 00211 cwh_stk_push(wn, WN_item); 00212 cwh_stk_push(WN_COPY_Tree(wn), WN_item); 00213 task_affinity_count++; 00214 break; 00215 case Context_Nest: 00216 case Context_Omp_Nest: 00217 /* for now throw away the nest var, we may want to make it lastlocal 00218 later - dlai */ 00219 task_nest_count++; 00220 break; 00221 case Context_Lastthread: 00222 wn = WN_CreatePragma(WN_PRAGMA_LASTTHREAD, (ST *)p->item, 0, /*offset=*/0); 00223 cwh_stk_push(wn, WN_item); 00224 task_lastthread_count++; 00225 break; 00226 case Context_Omp_Copyin: 00227 wn = WN_CreatePragma(WN_PRAGMA_COPYIN, (ST *)p->item, 0, /*offset=*/0); 00228 WN_set_pragma_omp(wn); 00229 cwh_stk_push(wn, WN_item); 00230 task_var_count++; 00231 break; 00232 case Context_Omp_Reduction_Max: 00233 case Context_Omp_Reduction_Min: 00234 case Context_Omp_Reduction_Band: 00235 case Context_Omp_Reduction_Bor: 00236 case Context_Omp_Reduction_Bneqv: 00237 case Context_Omp_Reduction_Plus: 00238 case Context_Omp_Reduction_Mult: 00239 case Context_Omp_Reduction_Minus: 00240 case Context_Omp_Reduction_And: 00241 case Context_Omp_Reduction_Or: 00242 case Context_Omp_Reduction_Eqv: 00243 case Context_Omp_Reduction_Neqv: 00244 switch((CONTEXT_TYPE) context) { 00245 case Context_Omp_Reduction_Max: 00246 op_code = OPR_MAX; 00247 break; 00248 case Context_Omp_Reduction_Min: 00249 op_code = OPR_MIN; 00250 break; 00251 case Context_Omp_Reduction_Band: 00252 op_code = OPR_BAND; 00253 break; 00254 case Context_Omp_Reduction_Bor: 00255 op_code = OPR_BIOR; 00256 break; 00257 case Context_Omp_Reduction_Bneqv: 00258 op_code = OPR_BXOR; 00259 break; 00260 case Context_Omp_Reduction_Plus: 00261 op_code = OPR_ADD; 00262 break; 00263 case Context_Omp_Reduction_Mult: 00264 op_code = OPR_MPY; 00265 break; 00266 case Context_Omp_Reduction_Minus: 00267 op_code = OPR_SUB; 00268 break; 00269 case Context_Omp_Reduction_And: 00270 op_code = OPR_LAND; 00271 break; 00272 case Context_Omp_Reduction_Or: 00273 op_code = OPR_LIOR; 00274 break; 00275 case Context_Omp_Reduction_Eqv: 00276 op_code = OPR_EQ; 00277 break; 00278 case Context_Omp_Reduction_Neqv: 00279 op_code = OPR_NE; 00280 break; 00281 } 00282 wn = WN_CreatePragma(WN_PRAGMA_REDUCTION, (ST *)p->item, 0, op_code); 00283 WN_set_pragma_omp(wn); 00284 cwh_stk_push(wn, WN_item); 00285 task_var_count++; 00286 break; 00287 case Context_Omp_Copyprivate: 00288 wn = WN_CreatePragma(WN_PRAGMA_COPYPRIVATE, (ST *)p->item, 0, /*offset=*/0); 00289 if ((CONTEXT_TYPE) context == Context_Omp_Copyprivate) 00290 WN_set_pragma_omp(wn); 00291 cwh_stk_push(wn, WN_item); 00292 task_var_count++; 00293 break; 00294 case Context_Omp_Flush: 00295 wn = WN_CreatePragma(WN_PRAGMA_FLUSH, (ST *)p->item, 0, /*offset=*/0); 00296 if ((CONTEXT_TYPE) context == Context_Omp_Flush) 00297 WN_set_pragma_omp(wn); 00298 cwh_stk_push(wn, WN_item); 00299 task_var_count++; 00300 break; 00301 00302 /* eraxxon: OpenAD directive */ 00303 case Context_OpenAD_Dependent: 00304 wn = WN_CreatePragma(WN_PRAGMA_OPENAD_DEPENDENT, 00305 (ST *)p->item, 0, /*offset=*/0); 00306 cwh_stk_push(wn, WN_item); 00307 task_var_count++; 00308 break; 00309 00310 case Context_OpenAD_Independent: 00311 wn = WN_CreatePragma(WN_PRAGMA_OPENAD_INDEPENDENT, 00312 (ST *)p->item, 0, /*offset=*/0); 00313 cwh_stk_push(wn, WN_item); 00314 task_var_count++; 00315 break; 00316 00317 default: 00318 DevAssert((0), ("Unimplemented fei_task_var type")); 00319 break; 00320 } 00321 return sym_idx; 00322 } /* fei_task_var */ 00323 00324 /*=============================================== 00325 * 00326 * cwh_region 00327 * 00328 * Uility to generate a REGION with the given ID. 00329 * enerates a REGION. The region is attached to 00330 * the current block, & pushed on the block stack. 00331 * The region pragmas are made the current block. 00332 * The body of the region is returned. 00333 * 00334 *=============================================== 00335 */ 00336 static WN * 00337 cwh_region(REGION_KIND kind) 00338 { 00339 WN *body,*pragmas,*exits,*region; 00340 00341 /* create region on current block */ 00342 00343 body = WN_CreateBlock (); 00344 pragmas = WN_CreateBlock (); 00345 exits = WN_CreateBlock (); 00346 region = WN_CreateRegion (kind, 00347 body, 00348 pragmas, 00349 exits, 00350 -1, 00351 0); 00352 cwh_block_append(region); 00353 00354 /* push the region on the block stack and */ 00355 /* make the region pragmas the current block*/ 00356 00357 cwh_block_push_region(region); 00358 cwh_block_set_current(pragmas); 00359 00360 return(body); 00361 } 00362 00363 /*=============================================== 00364 * 00365 * cwh_mp_region 00366 * 00367 * This generates a REGION and marks it as a mp region. These are 00368 * needed for each parallel loop or region. Also attaches all 00369 * collected pragmas and task vars to the region pragma list. 00370 * 00371 * wn_pragma_id - the pragma of the region (DOACROSS, PARALLEL, etc...) 00372 * threadcount,datacount - count of exprs on stack for affinity clause 00373 * ontocount, reductioncount, chunkcount - count of exprs on stack 00374 * 00375 * returns the region body block (which the caller should set as the 00376 * current block after all the pragmas are loaded into the region pragma 00377 * block 00378 * 00379 *=============================================== 00380 */ 00381 extern WN * 00382 cwh_mp_region( WN_PRAGMA_ID wn_pragma_id, 00383 int threadcount, 00384 int datacount, 00385 int ontocount, 00386 int reductioncount, 00387 int chunkcount, 00388 int is_omp) 00389 { 00390 00391 WN *body; 00392 WN *wn, *wn1; 00393 WN *affinity_block=NULL; 00394 00395 /* create region */ 00396 00397 body = cwh_region(REGION_KIND_MP); 00398 00399 /* now attach all applicable pragmas */ 00400 cwh_stmt_add_pragma(wn_pragma_id, is_omp,(ST_IDX) NULL, nested_do_descriptor.current, 00401 nested_do_descriptor.depth); 00402 00403 /* attach the chunk,reduction,onto,affinity exprs */ 00404 00405 if (chunkcount) { 00406 wn = cwh_expr_operand(NULL); 00407 cwh_stmt_add_xpragma(WN_PRAGMA_CHUNKSIZE,is_omp,wn); 00408 } 00409 00410 while (reductioncount) { /* pop the expressions */ 00411 00412 wn1 = cwh_expr_address(f_NONE); 00413 00414 if (WNOPR(wn1)==OPR_LDA) { 00415 cwh_stmt_add_pragma(WN_PRAGMA_REDUCTION,is_omp,WN_st(wn1),WN_lda_offset(wn1)); 00416 00417 } else if (WNOPR(wn1) == OPR_LDID) { 00418 cwh_stmt_add_pragma(WN_PRAGMA_REDUCTION,is_omp,WN_st(wn1),WN_load_offset(wn1)); 00419 00420 } else { /* an array */ 00421 00422 DevAssert((WN_operator(wn1)==OPR_ARRAY),("Odd reduction expression")); 00423 cwh_stmt_add_xpragma(WN_PRAGMA_REDUCTION,is_omp,wn1) ; 00424 } 00425 00426 reductioncount--; 00427 } 00428 if (ontocount) { 00429 /* onto expressions are popped off in reverse order, so we need to 00430 build the nodes in reverse before attaching */ 00431 WN *onto_block = WN_CreateBlock(); 00432 while (ontocount) { 00433 /* pop the expressions */ 00434 wn = WN_CreateXpragma( WN_PRAGMA_ONTO, (ST_IDX) NULL, 1); 00435 if (is_omp) WN_set_pragma_omp(wn); 00436 WN_kid0(wn) = cwh_expr_operand(NULL); 00437 WN_Set_Linenum (wn, USRCPOS_srcpos(current_srcpos) ); 00438 WN_INSERT_BlockFirst(onto_block, wn); 00439 ontocount--; 00440 } 00441 cwh_block_append(onto_block); 00442 } 00443 if (threadcount || datacount) { /* Set the Needs LNO bit for affinity */ 00444 00445 cwh_directive_set_LNO_flags(); 00446 } 00447 00448 while (threadcount) { 00449 /* pop the expressions and add to the affinty_block and the 00450 top_of_loop_additions block. The top_of_loop_additions 00451 is prepended to the next DO loop seen. This is because 00452 we need to duplicate the affinity pragma nodes for LNO */ 00453 if (affinity_block==NULL) affinity_block=WN_CreateBlock(); 00454 wn = WN_CreateXpragma( WN_PRAGMA_THREAD_AFFINITY, (ST_IDX) NULL, 1); 00455 if (is_omp) 00456 WN_set_pragma_omp(wn); 00457 WN_kid0(wn) = cwh_expr_operand(NULL); 00458 WN_Set_Linenum (wn, USRCPOS_srcpos(current_srcpos) ); 00459 WN_INSERT_BlockLast(affinity_block,wn); 00460 00461 wn = WN_CreateXpragma( WN_PRAGMA_THREAD_AFFINITY, (ST_IDX) NULL, 1); 00462 WN_kid0(wn) = cwh_expr_operand(NULL); 00463 cwh_directive_add_pragma_to_loop(wn,is_omp); 00464 threadcount--; 00465 } 00466 while (datacount) { 00467 /* pop the expressions and add to the affintiy_block and the 00468 top_of_loop_additions block. The top_of_loop_additions 00469 is prepended to the next DO loop seen. This is because 00470 we need to duplicate the affinity pragma nodes for LNO */ 00471 WN *array_exp; 00472 ST *st; 00473 PREG_det preg; 00474 if (affinity_block==NULL) affinity_block=WN_CreateBlock(); 00475 wn = WN_CreateXpragma( WN_PRAGMA_DATA_AFFINITY, (ST_IDX) NULL, 1); 00476 if (is_omp) WN_set_pragma_omp(wn); 00477 WN_kid0(wn) = cwh_expr_operand(NULL); 00478 WN_Set_Linenum (wn, USRCPOS_srcpos(current_srcpos) ); 00479 WN_INSERT_BlockLast(affinity_block,wn); 00480 00481 wn = WN_CreateXpragma( WN_PRAGMA_DATA_AFFINITY, (ST_IDX) NULL, 1); 00482 WN_kid0(wn) = array_exp = cwh_expr_operand(NULL); 00483 cwh_directive_add_pragma_to_loop(wn,is_omp); 00484 00485 /* for DATA affinity - we need the preg associated with the distributed 00486 array symbol, get the ST for the ARRAY expression */ 00487 DevAssert((WNOPR(array_exp)==OPR_ILOAD),("Odd expr in data affinity")); 00488 array_exp=WN_kid0(array_exp); 00489 DevAssert((WNOPR(array_exp)==OPR_ARRAY), ("Odd expr in data affinity")); 00490 wn = WN_kid0(array_exp); 00491 DevAssert((WNOPR(wn)==OPR_LDA || WNOPR(wn)==OPR_LDID),("Not a regular array in data affinity")); 00492 st = WN_st(wn); 00493 preg = cwh_auxst_distr_preg(st); 00494 /* do a load of the preg */ 00495 wn = WN_CreateXpragma( WN_PRAGMA_DATA_AFFINITY, (ST_IDX) NULL, 1); 00496 if (is_omp) WN_set_pragma_omp(wn); 00497 WN_kid0(wn) = WN_CreateLdid ( OPC_I4I4LDID, preg.preg, preg.preg_st, preg.preg_ty); 00498 WN_Set_Linenum (wn, USRCPOS_srcpos(current_srcpos) ); 00499 WN_INSERT_BlockLast(affinity_block,wn); 00500 00501 wn = WN_CreateXpragma( WN_PRAGMA_DATA_AFFINITY, (ST_IDX) NULL, 1); 00502 WN_kid0(wn) = WN_CreateLdid ( OPC_I4I4LDID, preg.preg, preg.preg_st, preg.preg_ty); 00503 cwh_directive_add_pragma_to_loop(wn,is_omp); 00504 datacount--; 00505 } 00506 #if 0 00507 while (ontocount) { 00508 /* pop the expressions */ 00509 wn = WN_CreateXpragma( WN_PRAGMA_ONTO, (ST_IDX) NULL, 1); 00510 if (is_omp) WN_set_pragma_omp(wn); 00511 WN_kid0(wn) = cwh_expr_operand(NULL); 00512 cwh_block_append(wn); 00513 ontocount--; 00514 } 00515 #endif 00516 /* pop off the affinity pragmas */ 00517 while(task_affinity_count) { 00518 wn = cwh_stk_pop_WN(); 00519 WN_Set_Linenum (wn, USRCPOS_srcpos(current_srcpos) ); 00520 WN_INSERT_BlockFirst(affinity_block,wn); 00521 wn = cwh_stk_pop_WN(); 00522 WN_Set_Linenum (wn, USRCPOS_srcpos(current_srcpos)); 00523 cwh_block_append_given_id(wn,Top_of_Loop_Block,TRUE); 00524 task_affinity_count--; 00525 } 00526 00527 /* now attach all task vars passed through fei_task_var */ 00528 00529 while (task_var_count) { 00530 wn = cwh_stk_pop_WN(); 00531 00532 if ((WN_operator(wn) == OPR_PRAGMA) && 00533 (WN_pragma(wn) == WN_PRAGMA_LOCAL && 00534 /* no idea why the clause is added to all enclosing regions, but it makes private disapear */ 00535 /* therefore we do not do this for OpenMP ([email protected]) */ 00536 ! WN_pragma_omp(wn))) 00537 cwh_block_add_to_enclosing_regions(WN_PRAGMA_LOCAL,WN_st(wn)); 00538 else 00539 cwh_block_append(wn); 00540 task_var_count--; 00541 } 00542 00543 /* and any lastthread var */ 00544 if (task_lastthread_count==1) { 00545 /* pop the pragma */ 00546 wn = cwh_stk_pop_WN(); 00547 cwh_block_append(wn); 00548 task_lastthread_count=0; 00549 } 00550 /* now put the affinity block (if any) */ 00551 if (affinity_block) { 00552 cwh_block_append(affinity_block); 00553 } 00554 00555 return(body); 00556 } /* cwh_mp_region */ 00557 00558 00559 /*=============================================== 00560 * 00561 * fei_parallel_region 00562 * 00563 * handles a CMIC$ parallel 00564 * 00565 * This generates a REGION and marks it as a mp region (cwh_mp_region 00566 * does all the work). IF and MAXCPUS clauses handled here. 00567 * 00568 * the return value is not relevant 00569 * 00570 *=============================================== 00571 */ 00572 extern int 00573 fei_parallel_region ( INT32 ifexpr, 00574 INT32 maxcpus, 00575 INT32 context_start, 00576 INT32 context_end, 00577 INT32 lineno, 00578 INT32 flags ) 00579 { 00580 /* generate a region and mark it as a parallel region. 00581 Attach pragmas for any of the arguments supplied as well 00582 as all task vars collected. 00583 */ 00584 WN *body; 00585 00586 nested_do_descriptor.depth = 0; 00587 body = cwh_mp_region(WN_PRAGMA_PARALLEL_BEGIN,0,0,0,0,0,0); 00588 00589 /* now attach all applicable pragmas */ 00590 /* autoscope not handled - DLAI */ 00591 00592 cwh_directive_load_value_pragma(ifexpr,WN_PRAGMA_IF); 00593 cwh_directive_load_value_pragma(maxcpus,WN_PRAGMA_NUMTHREADS); 00594 00595 cwh_directive_set_PU_flags(FALSE); 00596 00597 /* append statements to region body */ 00598 00599 cwh_block_set_current(body); 00600 return(context_start); /* return anything - its not used */ 00601 } 00602 00603 /*=============================================== 00604 * 00605 * fei_endparallel_region 00606 * 00607 * handles a CMIC$ end parallel 00608 * 00609 * pops the region so new statements will be 00610 * attached to the original body 00611 * 00612 *=============================================== 00613 */ 00614 extern void 00615 fei_endparallel_region ( INT32 task_x, 00616 INT32 lineno ) 00617 { 00618 cwh_directive_pop_and_nowait(FALSE,FALSE); 00619 } 00620 00621 /*=============================================== 00622 * 00623 * fei_doparallel 00624 * 00625 * handles the CMIC$ do parallel directive 00626 * 00627 * generates whirl like a C$PAR PDO, handles 00628 * translating the schedtype. Nest depth is 1, 00629 * because not doacross or pdo with a nest clause. 00630 * 00631 * the return value is not relevant 00632 * 00633 *=============================================== 00634 */ 00635 extern int 00636 fei_doparallel ( INT32 induc_symx, 00637 INT32 work_dist, 00638 INT32 work_dist_opnd, 00639 INT32 lineno ) 00640 { 00641 /* begin a new parallel region for the parallel loop */ 00642 WN *body; 00643 00644 /* Nest depth is 1 in pragma because not doacross */ 00645 /* or pdo with a nest clause */ 00646 00647 nested_do_descriptor.depth = 1; 00648 task_nest_count = 0; 00649 nested_do_descriptor.current = 0; 00650 nested_do_descriptor.explicit_end = TRUE; 00651 nested_do_descriptor.type = WN_PRAGMA_PDO_BEGIN; 00652 body = cwh_mp_region(WN_PRAGMA_PDO_BEGIN,0,0,0,0,0,0); 00653 00654 /* but set nest depth back to 0, so fei_enddo pops region*/ 00655 00656 nested_do_descriptor.depth = 0; 00657 00658 /* work distribution */ 00659 00660 cwh_directive_work_dist(work_dist,work_dist_opnd); 00661 00662 /* make region no-wait. A cmic$ enddo will alway be present for the barrier */ 00663 00664 cwh_stmt_add_pragma(WN_PRAGMA_NOWAIT); 00665 00666 /* append statements to region body */ 00667 cwh_block_set_current(body); 00668 /* mark next DO loop as a parallel loop */ 00669 parallel_do_count = 1; 00670 00671 cwh_directive_set_PU_flags(FALSE); 00672 00673 return(0); /* return anything - its not used */ 00674 } 00675 00676 /*=============================================== 00677 * 00678 * fei_task_endloop 00679 * 00680 * processes a CMIC$ END DO 00681 * 00682 * The end of the loop has terminated the parallel 00683 * region, but a barrier is added unless the ENDDO 00684 * is adjacent to an ENDPRARALLEL( implicit barrier). 00685 * (not implemented in yet, need flag from FE). 00686 * 00687 *=============================================== 00688 */ 00689 extern void 00690 fei_task_endloop ( INT32 taskloop_x, 00691 INT32 lineno, 00692 INT32 nowait ) 00693 { 00694 WN *wn ; 00695 00696 if (! nowait) { 00697 00698 wn = WN_CreatePragma(WN_PRAGMA_BARRIER,(ST_IDX) NULL,0,0); 00699 cwh_directive_barrier_insert(wn, 0); 00700 } 00701 } 00702 00703 /*=============================================== 00704 * 00705 * fei_doall 00706 * 00707 * processes a CMIC$ DOALL directive 00708 * 00709 * we translate this to a DOACROSS 00710 * - emit the MP region 00711 * - attach pragmas 00712 * - translate the work distribution 00713 * 00714 *=============================================== 00715 */ 00716 extern void 00717 fei_doall ( INT32 ifexpr, 00718 INT32 maxcpus, 00719 INT32 context_start, 00720 INT32 context_end, 00721 INT32 induc_symx, 00722 INT32 work_dist, 00723 INT32 work_dist_opnd, 00724 INT32 flags, 00725 INT32 lineno ) 00726 { 00727 WN *body; 00728 00729 nested_do_descriptor.depth = 1; /* DOALL can only have one nest */ 00730 task_nest_count = 0; 00731 nested_do_descriptor.current = 0; 00732 nested_do_descriptor.explicit_end = FALSE; 00733 nested_do_descriptor.type = WN_PRAGMA_DOACROSS; 00734 body = cwh_mp_region(WN_PRAGMA_DOACROSS,0,0,0,0,0,0); 00735 00736 /* now attach all applicable pragmas */ 00737 00738 cwh_directive_load_value_pragma(ifexpr,WN_PRAGMA_IF); 00739 cwh_directive_load_value_pragma(maxcpus,WN_PRAGMA_NUMTHREADS); 00740 cwh_directive_work_dist(work_dist,work_dist_opnd); 00741 00742 /* append statements to region body */ 00743 cwh_block_set_current(body); 00744 /* mark next DO loop as a DOALL loop */ 00745 parallel_do_count = 1; 00746 00747 cwh_directive_set_PU_flags(FALSE); 00748 } 00749 00750 /*=============================================== 00751 * 00752 * cwh_doacross 00753 * 00754 * handles a C$DOACROSS or C$PAR PARALLEL DO directive 00755 * 00756 * creates a MP region, attaches pragmas, and sets up the nesting 00757 * data structure. 00758 * 00759 *=============================================== 00760 */ 00761 static void 00762 cwh_doacross(int task_if_idx, 00763 int schedtype, 00764 int threadcount, 00765 int datacount, 00766 int ontocount, 00767 int reductioncount, 00768 int chunkcount, 00769 WN_PRAGMA_ID pragma_id, 00770 int is_omp) 00771 { 00772 WN *body; 00773 00774 nested_do_descriptor.depth = task_nest_count; 00775 task_nest_count = 0; 00776 nested_do_descriptor.current = 0; 00777 nested_do_descriptor.explicit_end = FALSE; 00778 nested_do_descriptor.type = pragma_id; 00779 body = cwh_mp_region(pragma_id,threadcount,datacount, 00780 ontocount,reductioncount,chunkcount,is_omp); 00781 00782 /* now attach all applicable pragmas */ 00783 00784 cwh_directive_load_value_pragma(task_if_idx,WN_PRAGMA_IF); 00785 00786 if (schedtype != WN_PRAGMA_SCHEDTYPE_UNKNOWN) { 00787 cwh_stmt_add_pragma(WN_PRAGMA_MPSCHEDTYPE, FALSE,(ST_IDX) NULL, schedtype); 00788 } 00789 00790 /* append statements to region body */ 00791 cwh_block_set_current(body); 00792 /* mark next n DO loops as a DOACROSS / PARALLELDO loop */ 00793 if (nested_do_descriptor.depth) { 00794 parallel_do_count =nested_do_descriptor.depth; 00795 } else { 00796 parallel_do_count = 1; 00797 } 00798 00799 cwh_directive_set_PU_flags((nested_do_descriptor.depth > 1)); 00800 } 00801 00802 /*=============================================== 00803 * 00804 * fei_doacross 00805 * 00806 * handles a C$DOACROSS directive 00807 * 00808 * calls cwh_doacross to do real work 00809 * 00810 *=============================================== 00811 */ 00812 extern void 00813 fei_doacross(int task_if_idx, 00814 int schedtype, 00815 int threadcount, 00816 int datacount, 00817 int ontocount, 00818 int reductioncount, 00819 int chunkcount) 00820 { 00821 cwh_doacross(task_if_idx,schedtype,threadcount,datacount,ontocount, 00822 reductioncount,chunkcount,WN_PRAGMA_DOACROSS,0); 00823 } 00824 00825 /*=============================================== 00826 * 00827 * fei_paralleldo 00828 * 00829 * handles a C$PAR PARALLEL DO directive 00830 * 00831 * calls cwh_doacross to do real work 00832 * 00833 *=============================================== 00834 */ 00835 extern void 00836 fei_paralleldo( int task_if_idx, 00837 int schedtype, 00838 int threadcount, 00839 int datacount, 00840 int ontocount, 00841 int reductioncount, 00842 int chunkcount ) 00843 { 00844 cwh_doacross(task_if_idx,schedtype,threadcount,datacount,ontocount, 00845 reductioncount,chunkcount,WN_PRAGMA_PARALLEL_DO,0); 00846 } 00847 00848 00849 /*=============================================== 00850 * 00851 * cwh_parallel 00852 * 00853 * process a C$PAR PARALLEL and C$OMP PARALLEL 00854 * 00855 * creates an MP region and attaches pragmas 00856 * 00857 *=============================================== 00858 */ 00859 static void 00860 cwh_parallel (int task_if_idx, 00861 int defaultt, 00862 int is_omp) 00863 { 00864 WN *body; 00865 00866 task_nest_count = 0; 00867 body = cwh_mp_region(WN_PRAGMA_PARALLEL_BEGIN,0,0,0,0,0,is_omp); 00868 00869 /* now attach all applicable pragmas */ 00870 00871 cwh_directive_load_value_pragma(task_if_idx,WN_PRAGMA_IF); 00872 00873 if (defaultt) { /* there is a DEFAULT clause */ 00874 00875 DevAssert((defaultt > 0 && defaultt < MAX_PRAGMA_DEFAULT),("Odd defaultt")); 00876 cwh_stmt_add_pragma(WN_PRAGMA_DEFAULT,FALSE,(ST_IDX) NULL,defaultt); 00877 } 00878 00879 /* append statements to region body */ 00880 cwh_block_set_current(body); 00881 00882 cwh_directive_set_PU_flags(FALSE); 00883 00884 } /* cwh_parallel */ 00885 00886 /*=============================================== 00887 * 00888 * fei_parallel 00889 * 00890 * process a C$PAR PARALLEL 00891 * 00892 * creates an MP region and attaches pragmas 00893 * 00894 *=============================================== 00895 */ 00896 extern void 00897 fei_parallel (int task_if_idx) 00898 { 00899 cwh_parallel (task_if_idx, 0, 0); 00900 } 00901 00902 /*=============================================== 00903 * 00904 * fei_endparallel 00905 * 00906 * processes a C$PAR END PARALLEL 00907 * 00908 * simply pops off the MP region 00909 * 00910 *=============================================== 00911 */ 00912 extern void 00913 fei_endparallel (void) 00914 { 00915 cwh_directive_pop_and_nowait(FALSE,FALSE); 00916 } 00917 00918 /*=============================================== 00919 * 00920 * fei_pdo 00921 * 00922 * processes a C$PAR PDO 00923 * 00924 * similar to fei_doacross 00925 * 00926 *=============================================== 00927 */ 00928 extern void 00929 fei_pdo ( int sched_type, 00930 int ordered, 00931 int thread_count, 00932 int data_count, 00933 int onto_count, 00934 int reduction_count, 00935 int chunk_count ) 00936 { 00937 /* begin a new parallel region for the parallel loop */ 00938 WN *body,*wn; 00939 00940 nested_do_descriptor.depth = task_nest_count; 00941 task_nest_count = 0; 00942 nested_do_descriptor.current = 0; 00943 nested_do_descriptor.explicit_end = TRUE; 00944 nested_do_descriptor.type = WN_PRAGMA_PDO_BEGIN; 00945 body = cwh_mp_region(WN_PRAGMA_PDO_BEGIN,thread_count,data_count, 00946 onto_count,reduction_count, chunk_count,0); 00947 /* schedtype */ 00948 if (sched_type != WN_PRAGMA_SCHEDTYPE_UNKNOWN) { 00949 cwh_stmt_add_pragma(WN_PRAGMA_MPSCHEDTYPE, FALSE,(ST_IDX) NULL, sched_type); 00950 } 00951 00952 if (ordered) { 00953 00954 wn = WN_CreatePragma(WN_PRAGMA_ORDERED, (ST_IDX) NULL, 0, 0); 00955 cwh_block_append(wn); 00956 } 00957 00958 /* append statements to region body */ 00959 cwh_block_set_current(body); 00960 /* mark next n DO loops nested loops */ 00961 if (nested_do_descriptor.depth) { 00962 parallel_do_count =nested_do_descriptor.depth; 00963 } else { 00964 parallel_do_count = 1; 00965 } 00966 00967 cwh_directive_set_PU_flags(nested_do_descriptor.depth > 1); 00968 00969 } /* fei_pdo */ 00970 00971 /*=============================================== 00972 * 00973 * fei_endpdo 00974 * 00975 * process a C$PAR END PDO [nowait] 00976 * 00977 * similar to ending any other parallel loop, but we may need to add 00978 * a NOWAIT pragma to the region pragma list. 00979 * 00980 *=============================================== 00981 */ 00982 extern void 00983 fei_endpdo ( int nowait ) 00984 { 00985 cwh_directive_pop_and_nowait(nowait,FALSE); 00986 } 00987 00988 /*=============================================== 00989 * 00990 * fei_singleprocess 00991 * 00992 * process a C$PAR SINGLE PROCESS 00993 * 00994 *=============================================== 00995 */ 00996 extern void 00997 fei_singleprocess( void ) 00998 { 00999 WN *body; 01000 01001 body = cwh_mp_region(WN_PRAGMA_SINGLE_PROCESS_BEGIN,0,0,0,0,0,0); 01002 01003 /* append statements to region body */ 01004 cwh_block_set_current(body); 01005 01006 /* set the MP and uplevel bits on the symtab */ 01007 01008 cwh_directive_set_PU_flags(FALSE); 01009 01010 } /* fei_singleprocess */ 01011 01012 /*=============================================== 01013 * 01014 * fei_endsingleprocess 01015 * 01016 * process a C$PAR END SINGLE PROCESS 01017 * 01018 *=============================================== 01019 */ 01020 extern void 01021 fei_endsingleprocess ( int nowait ) 01022 { 01023 cwh_directive_pop_and_nowait(nowait,FALSE); 01024 } 01025 01026 /*=============================================== 01027 * 01028 * fei_criticalsection 01029 * 01030 * process a C$PAR CRITICAL SECTION 01031 * 01032 * if there is a user variable, generate an Xpragma, otherwise generate 01033 * a pragma. Followed by a barrier. 01034 * 01035 *=============================================== 01036 */ 01037 extern void 01038 fei_criticalsection ( int var_count ) 01039 { 01040 WN *wn; 01041 01042 if (var_count==0) { 01043 cwh_stmt_add_pragma(WN_PRAGMA_CRITICAL_SECTION_BEGIN); 01044 01045 } else { 01046 01047 DevAssert((var_count==1),("too many critical section vars")); 01048 wn = cwh_expr_address(f_NONE); 01049 cwh_stmt_add_xpragma(WN_PRAGMA_CRITICAL_SECTION_BEGIN,FALSE,wn); 01050 } 01051 01052 wn = WN_CreateBarrier( FALSE, 0 ); 01053 cwh_block_append(wn); 01054 } 01055 01056 /*=============================================== 01057 * 01058 * fei_endcriticalsection 01059 * 01060 * handles a C$PAR END CRITICAL SECTION 01061 * 01062 * generates a barrier and a pragma 01063 * 01064 *=============================================== 01065 */ 01066 extern void 01067 fei_endcriticalsection ( void ) 01068 { 01069 WN *wn; 01070 wn = WN_CreateBarrier( TRUE, 0 ); 01071 cwh_block_append(wn); 01072 cwh_stmt_add_pragma(WN_PRAGMA_CRITICAL_SECTION_END); 01073 } 01074 01075 /*=============================================== 01076 * 01077 * fei_barrier 01078 * 01079 * handles a C$PAR BARRIER 01080 * 01081 * generates a barrier pragma surrounded by barriers 01082 * 01083 *=============================================== 01084 */ 01085 extern void 01086 fei_barrier ( void ) 01087 { 01088 WN *wn; 01089 01090 wn = WN_CreatePragma(WN_PRAGMA_BARRIER,(ST_IDX) NULL,0,0); 01091 cwh_directive_barrier_insert(wn, 0); 01092 } 01093 01094 /*=============================================== 01095 * 01096 * fei_section 01097 * 01098 * handles a C$PAR SECTION 01099 * 01100 * simply generates a WN_PRAGMA_SECTION pragma 01101 * 01102 *=============================================== 01103 */ 01104 extern void 01105 fei_section ( void ) 01106 { 01107 cwh_stmt_add_pragma(WN_PRAGMA_SECTION); 01108 } 01109 01110 /*=============================================== 01111 * 01112 * fei_psection 01113 * 01114 * handles a C$PAR PSECTION 01115 * 01116 * generates a WN_PRAGMA_PSECTION_BEGIN, 01117 * local vars may add additional pragmas. 01118 * Set current block to region body 01119 * 01120 *=============================================== 01121 */ 01122 extern void 01123 fei_psection ( void ) 01124 { 01125 WN *body; 01126 body = cwh_mp_region(WN_PRAGMA_PSECTION_BEGIN,0,0,0,0,0,0); 01127 01128 cwh_block_set_current(body); 01129 cwh_directive_set_PU_flags(FALSE); 01130 } 01131 01132 /*=============================================== 01133 * 01134 * fei_endpsection 01135 * 01136 * handles a C$PAR END PSECTION 01137 * 01138 * simply adds a WN_PRAGMA_PSECTION_END pragma 01139 * 01140 *=============================================== 01141 */ 01142 extern void 01143 fei_endpsection ( int nowait ) 01144 { 01145 cwh_directive_pop_and_nowait(nowait,FALSE); 01146 } 01147 01148 /*=============================================== 01149 * 01150 * fei_copy_in 01151 * 01152 * handles a C$COPYIN 01153 * 01154 * each argument is a ST on the stack, for common blocks we generate 01155 * a pragma, for common block members, we generate an Xpragma. 01156 * as a special case, split commons generate a pragma for each child 01157 * 01158 *=============================================== 01159 */ 01160 extern void 01161 fei_copy_in ( int list_count ) 01162 { 01163 int i; 01164 ST *st; 01165 WN *wn; 01166 BOOL create_xpragma; 01167 ITEM *split_st; 01168 01169 for(i=0; i< list_count; i++) { 01170 create_xpragma = TRUE; 01171 if (cwh_stk_get_class()==ST_item || cwh_stk_get_class() == ST_item_whole_array) { 01172 01173 /* may be a simple var or a common block */ 01174 st = cwh_stk_pop_ST(); 01175 01176 if (ST_sclass(st) == SCLASS_COMMON && ST_base_idx(st) == ST_st_idx(st)) { 01177 create_xpragma = FALSE; 01178 /* a common block, create a pragma for it */ 01179 /* if this common has been split, then we have to issue a 01180 pragma for each child. We can tell if the parent has been split 01181 by checking if the AUXST's splitlist is empty or not */ 01182 split_st=cwh_auxst_next_element(st,(ST_IDX) NULL,l_SPLITLIST); 01183 01184 if (split_st) { 01185 while(split_st) { 01186 cwh_stmt_add_pragma(WN_PRAGMA_COPYIN, FALSE, I_element(split_st)); 01187 split_st=cwh_auxst_next_element(st,split_st,l_SPLITLIST); 01188 } 01189 } else { /* this is a normal common (not split) */ 01190 cwh_stmt_add_pragma(WN_PRAGMA_COPYIN, FALSE, st); 01191 } 01192 } else { 01193 /* simple var - put it back */ 01194 cwh_stk_push(st,ST_item); 01195 } 01196 } 01197 /* at this point create_xpragma is TRUE if there is an expression on the stack to 01198 use for the Xpragma */ 01199 01200 if (create_xpragma) { 01201 wn = cwh_expr_address(f_NONE); 01202 cwh_stmt_add_xpragma(WN_PRAGMA_COPYIN,FALSE,wn); 01203 } 01204 } 01205 cwh_directive_set_PU_flags(FALSE); 01206 01207 } /* fei_copy_in */ 01208 01209 void 01210 fei_dynamic ( int list_count ) 01211 { 01212 int i; 01213 ST *st; 01214 for(i=0; i< list_count; i++) { 01215 st = cwh_stk_pop_ST(); 01216 cwh_stmt_add_pragma(WN_PRAGMA_DYNAMIC, FALSE,st); 01217 } 01218 } 01219 01220 void 01221 fei_redistribute ( int array, 01222 int dim, 01223 int distribution, 01224 int cyclic_exists, 01225 int onto_exists ) 01226 { 01227 /* for each distribution, build the pragma */ 01228 static WN *redistribute_block; /* holds the built up pragma list */ 01229 static int onto_count; /* counts # of onto exprs pushed */ 01230 INT cyclic_constant; /* the constant for cyclic if non-expr */ 01231 BOOL cyclic_is_constant; /* CYCLIC value is constant (or missing) */ 01232 ST *st; 01233 TY_IDX ty; 01234 STB_pkt *p; 01235 WN *wn, *wn1, *wn_for_cyclic_expr=NULL; 01236 WN *lb,*ub,*s1; 01237 PREG_det preg; 01238 01239 p = cast_to_STB(array); 01240 st = (ST *)p->item; 01241 ty = ST_type(st); 01242 /* we want the array type, if this is a pointer type, deref it to the 01243 array */ 01244 if (TY_kind(ty) == KIND_POINTER) { 01245 ty = TY_pointed(ty); 01246 } 01247 /* initialize if first dim */ 01248 if (dim==1) { 01249 onto_count=0; 01250 redistribute_block=WN_CreateBlock(); 01251 } 01252 /* generate the pragma for this dimension and add to the top of the 01253 block, the order should be distribution, extent, cyclic_expr (if any). 01254 Since we always add to the top of the block, we generate the pragmas 01255 in reverse. */ 01256 cyclic_constant = 1; /* default value if missing */ 01257 cyclic_is_constant=TRUE; 01258 if (cyclic_exists) { 01259 /* there is a cyclic expr or cyclic constant */ 01260 wn1 = cwh_expr_operand(NULL); 01261 if(WN_operator(wn1)==OPR_INTCONST) { 01262 cyclic_constant = WN_const_val(wn1); 01263 } else { 01264 /* an expression, build an Xpragma node */ 01265 cyclic_is_constant=FALSE; 01266 wn_for_cyclic_expr = WN_CreateXpragma(WN_PRAGMA_REDISTRIBUTE, st, 1); 01267 WN_kid0(wn_for_cyclic_expr) = wn1; 01268 } 01269 } 01270 /* build the XPragma representing the extent for this dimension */ 01271 lb = cwh_types_bound_WN(ty,dim-1,LOW); 01272 ub = cwh_types_bound_WN(ty,dim-1,UPPER); 01273 s1 = WN_Intconst(MTYPE_I4,1); 01274 wn = WN_CreateXpragma(WN_PRAGMA_REDISTRIBUTE, st, 1); 01275 WN_kid0(wn) = cwh_addr_extent(lb,ub,s1); 01276 WN_INSERT_BlockFirst(redistribute_block, wn); 01277 if (wn_for_cyclic_expr) { 01278 /* insert the cyclic expr */ 01279 WN_INSERT_BlockFirst(redistribute_block, wn_for_cyclic_expr); 01280 } 01281 01282 /* now build the Pragma for the distribute */ 01283 01284 wn = WN_CreatePragma (WN_PRAGMA_REDISTRIBUTE,st,0,0); 01285 WN_pragma_index(wn) = TY_AR_ndims(Ty_Table[ty])-dim; 01286 01287 switch(distribution) { 01288 case Block_Dist: 01289 WN_pragma_distr_type(wn)=DISTRIBUTE_BLOCK; 01290 break; 01291 case Star_Dist: 01292 WN_pragma_distr_type(wn)=DISTRIBUTE_STAR; 01293 break; 01294 case Cyclic_Dist: 01295 if (cyclic_is_constant) { 01296 WN_pragma_distr_type(wn)=DISTRIBUTE_CYCLIC_CONST; 01297 WN_pragma_preg(wn) = cyclic_constant; 01298 } else { 01299 WN_pragma_distr_type(wn)=DISTRIBUTE_CYCLIC_EXPR; 01300 } 01301 break; 01302 default: 01303 DevAssert((0),("fei_redistribute: unexpected distribution")); 01304 } 01305 WN_INSERT_BlockFirst(redistribute_block, wn); 01306 01307 /* leave the onto expressions stacked, they will be stacked so 01308 the last dimension is popped first. */ 01309 if (onto_exists) onto_count++; 01310 01311 /* if this is the last dimension, add the dummy preg stores to 01312 the end of the block, then add the ONTO exprs to the end of 01313 the block, then dump the entire block to the statement list */ 01314 01315 if (dim==TY_AR_ndims(Ty_Table[ty])) { 01316 01317 /* add the dummy preg stores */ 01318 preg = cwh_auxst_distr_preg(st); 01319 wn = cwh_load_distribute_temp(); 01320 wn = WN_CreateStid( OPC_I4STID, preg.preg, preg.preg_st, preg.preg_ty, wn); 01321 WN_INSERT_BlockLast(redistribute_block, wn); 01322 01323 /* create another write to the global preg for all distributed arrays */ 01324 if (preg_for_distribute.preg==-1) { 01325 preg_for_distribute=cwh_preg_next_preg(MTYPE_I4, NULL, NULL); 01326 } 01327 wn = cwh_load_distribute_temp(); 01328 wn = WN_CreateStid( OPC_I4STID, preg_for_distribute.preg, 01329 preg_for_distribute.preg_st, preg_for_distribute.preg_ty, wn); 01330 WN_INSERT_BlockLast(redistribute_block, wn); 01331 01332 /* add any ONTO exprs */ 01333 while(onto_count--) { 01334 wn1 = cwh_expr_operand(NULL); 01335 wn = WN_CreateXpragma(WN_PRAGMA_ONTO,st,1); 01336 WN_kid0(wn) = wn1; 01337 WN_INSERT_BlockLast(redistribute_block, wn); 01338 } 01339 01340 cwh_block_append(redistribute_block); 01341 cwh_directive_set_LNO_flags(); 01342 } 01343 } 01344 01345 static void 01346 cwh_reorder ( int expressions, WN_PRAGMA_ID wn_pragma_id ) 01347 { 01348 int *order; 01349 ST **st_list; 01350 int i; 01351 WN *wn; 01352 01353 order= (int *) malloc(sizeof(int)*expressions); 01354 st_list= (ST **)malloc(sizeof(ST *)*expressions); 01355 01356 /* pop constants off and set positions in the order array */ 01357 01358 for(i=expressions; i> 0; i--) /* reverse order */ { 01359 wn = cwh_expr_operand(NULL); 01360 DevAssert((WN_operator(wn)==OPR_INTCONST),("cwh_reorder: expected constant")); 01361 DevAssert((WN_const_val(wn)<=expressions),("cwh_reorder: constant out of bounds")); 01362 order[WN_const_val(wn)-1]=i; 01363 } 01364 01365 /* pop off ST's and save */ 01366 for(i=expressions-1; i>=0; i--) /* reverse order */ { 01367 st_list[i] = cwh_stk_pop_ST(); 01368 } 01369 01370 /* now generate whirl */ 01371 for(i=0; i<expressions; i++) { 01372 cwh_stmt_add_pragma(wn_pragma_id, FALSE,st_list[i], order[i],i+1); 01373 } 01374 free(order); 01375 free(st_list); 01376 } 01377 01378 void fei_interchange ( int expressions ) 01379 { 01380 cwh_reorder(expressions,WN_PRAGMA_INTERCHANGE); 01381 } 01382 01383 01384 void fei_blockable ( int expressions ) 01385 { 01386 cwh_reorder(expressions,WN_PRAGMA_BLOCKABLE); 01387 } 01388 01389 /*=============================================== 01390 * 01391 * fei_fission 01392 * 01393 *=============================================== 01394 */ 01395 void fei_fission ( void ) 01396 { 01397 WN *wn; 01398 wn = cwh_expr_operand(NULL); 01399 DevAssert((WN_operator(wn)==OPR_INTCONST),("fei_fission: expected constant")); 01400 cwh_stmt_add_pragma(WN_PRAGMA_FISSION,FALSE,(ST_IDX) NULL,WN_const_val(wn),0); 01401 01402 } /* fei_fission */ 01403 01404 /*=============================================== 01405 * 01406 * fei_flush 01407 * 01408 *=============================================== 01409 */ 01410 extern void 01411 fei_flush(int list_count) 01412 { 01413 WN *sync; 01414 01415 sync = WN_Create_Intrinsic(OPC_VINTRINSIC_CALL,INTRN_SYNCHRONIZE,0,NULL); 01416 cwh_directive_barrier_insert(sync,list_count) ; 01417 } 01418 01419 /*=============================================== 01420 * 01421 * fei_fuse 01422 * 01423 *=============================================== 01424 */ 01425 void 01426 fei_fuse (int level) 01427 { 01428 WN *wn; 01429 wn = cwh_expr_operand(NULL); 01430 DevAssert((WN_operator(wn)==OPR_INTCONST),("fei_fuse: expected constant")); 01431 cwh_stmt_add_pragma(WN_PRAGMA_FUSE,FALSE,(ST_IDX) NULL,WN_const_val(wn), level); 01432 } 01433 01434 /*=============================================== 01435 * 01436 * fei_assert 01437 * 01438 *=============================================== 01439 */ 01440 void 01441 fei_assert ( int assertion, int list_count ) 01442 { 01443 /* for now - the FE doesnt parse arguments to the assertions, so we 01444 only get the assertion code. When the FE is updated we would need 01445 to modify the code here to handle the arguments 01446 */ 01447 /* global asserts are not handled yet - DLAI */ 01448 WN *arg; 01449 01450 DevAssert((map_asserts[assertion].fe_enum == assertion), 01451 ("map_asserts table bad")); /* mismatch between map_asserts and globals.m */ 01452 01453 switch(assertion) { 01454 case MIPS_ASSERT_CONCURRENTCALL: 01455 case MIPS_ASSERT_NOCONCURRENTCALL: 01456 case MIPS_ASSERT_NOEQUIVALENCEHAZARD: 01457 case MIPS_ASSERT_BOUNDSVIOLATIONS: 01458 case MIPS_ASSERT_NOBOUNDSVIOLATIONS: 01459 case MIPS_ASSERT_EQUIVALENCEHAZARD: 01460 case MIPS_ASSERT_TEMPORARIESFORCONSTANTARGUMENTS: 01461 case MIPS_ASSERT_NOTEMPORARIESFORCONSTANTARGUMENTS: 01462 case MIPS_ASSERT_BENIGN: 01463 case MIPS_ASSERT_NOINTERCHANGE: 01464 case MIPS_ASSERT_USECOMPRESS: 01465 case MIPS_ASSERT_USEEXPAND: 01466 case MIPS_ASSERT_USECONTROLLEDSTORE: 01467 case MIPS_ASSERT_USEGATHER: 01468 case MIPS_ASSERT_USESCATTER: 01469 cwh_stmt_add_pragma(map_asserts[assertion].wn_pragma_id); 01470 break; 01471 01472 case MIPS_ASSERT_ARGUMENTALIASING: 01473 Set_PU_args_aliased (Pu_Table[ST_pu(Procedure_ST)]); 01474 cwh_stmt_add_pragma(map_asserts[assertion].wn_pragma_id); 01475 break; 01476 01477 case MIPS_ASSERT_NOARGUMENTALIASING: 01478 Clear_PU_args_aliased (Pu_Table[ST_pu(Procedure_ST)]); 01479 cwh_stmt_add_pragma(map_asserts[assertion].wn_pragma_id); 01480 break; 01481 01482 case MIPS_ASSERT_DO: 01483 case MIPS_ASSERT_DOPREFER: 01484 while (list_count) { 01485 arg = cwh_expr_operand(NULL); 01486 cwh_stmt_add_pragma(map_asserts[assertion].wn_pragma_id, 01487 FALSE, 01488 (ST_IDX) NULL, 01489 WN_const_val(arg)); 01490 list_count--; 01491 } 01492 break; 01493 01494 case MIPS_ASSERT_PERMUTATION: 01495 while (list_count) { 01496 arg = cwh_expr_address(f_NONE); 01497 cwh_stmt_add_pragma(map_asserts[assertion].wn_pragma_id, 01498 FALSE, 01499 WN_st(arg), 01500 WN_load_offset(arg)); 01501 list_count--; 01502 } 01503 break; 01504 01505 default: 01506 DevWarn("fei_assert: assertion not implemented"); 01507 while (list_count) { 01508 cwh_stk_pop_whatever(); 01509 list_count--; 01510 } 01511 break; 01512 } 01513 } /* fei_assert */ 01514 01515 /*=============================================== 01516 * 01517 * fei_fill_symbol 01518 * 01519 * handles c*$* fill_symbol. The stack contains 01520 * the ST's to be popped. 01521 * 01522 *=============================================== 01523 */ 01524 extern void 01525 fei_fill_symbol(INT32 count, INT32 C_value ) 01526 { 01527 cwh_directive_fill_align(count,C_value,WN_PRAGMA_FILL); 01528 } 01529 01530 /*=============================================== 01531 * 01532 * fei_align_symbol 01533 * 01534 * handles c*$* align_symbol. The stack contains 01535 * the ST's to be popped. They can be variables 01536 * or COMMON symbols. 01537 * 01538 *=============================================== 01539 */ 01540 extern void 01541 fei_align_symbol (INT32 count,INT32 C_value ) 01542 { 01543 cwh_directive_fill_align(count,C_value,WN_PRAGMA_ALIGN); 01544 } 01545 01546 /*=============================================== 01547 * 01548 * cwh_directive_fill_align 01549 * 01550 * Utility for fei_align/fill_symbol. 01551 * Pops the STs and adds the appropriate pragma 01552 * 01553 *=============================================== 01554 */ 01555 static void 01556 cwh_directive_fill_align(INT32 count,INT32 C_value, WN_PRAGMA_ID pragma ) 01557 { 01558 ST *st; 01559 PU & pu = Pu_Table[ST_pu(Procedure_ST)]; 01560 BOOL pu_is_l2 = (CURRENT_SYMTAB == 1+GLOBAL_SYMTAB) ; 01561 01562 while (count-- > 0) { 01563 01564 st = cwh_stk_pop_ST(); 01565 Set_ST_is_fill_align(st); 01566 01567 if ((ST_level(st) != GLOBAL_SYMTAB) || 01568 ((ST_level(st) == GLOBAL_SYMTAB) && pu_is_l2)) { 01569 01570 /* The PU needs fill-align lowering if the symbol is local, 01571 * or if the symbol is global and this is the first PU. 01572 */ 01573 Set_PU_needs_fill_align_lowering (pu); 01574 } 01575 cwh_stmt_add_pragma(pragma,FALSE,st,0,C_value); 01576 } 01577 } 01578 01579 void 01580 fei_unroll( void ) 01581 { 01582 WN *wn1; 01583 wn1 = cwh_expr_operand(NULL); 01584 DevAssert((WN_operator(wn1)==OPR_INTCONST),("fei_unroll: expected constant")); 01585 01586 if (WN_const_val(wn1) != 0) { 01587 cwh_stmt_add_pragma(WN_PRAGMA_UNROLL, FALSE,(ST_IDX) NULL, WN_const_val(wn1), -1); 01588 } 01589 WN_Delete(wn1); 01590 } 01591 01592 void 01593 fei_page_place( void ) 01594 { 01595 /* there are 3 operands on the stack */ 01596 01597 WN *wn1,*wn2,*wn3; 01598 wn3 = cwh_expr_operand(NULL); 01599 wn2 = cwh_expr_operand(NULL); 01600 wn1 = cwh_expr_address(f_NONE); 01601 01602 cwh_stmt_add_xpragma(WN_PRAGMA_PAGE_PLACE,FALSE,wn1); 01603 cwh_stmt_add_xpragma(WN_PRAGMA_PAGE_PLACE,FALSE,wn2); 01604 cwh_stmt_add_xpragma(WN_PRAGMA_PAGE_PLACE,FALSE,wn3); 01605 01606 cwh_directive_set_LNO_flags(); 01607 01608 } 01609 01610 void 01611 fei_prefetch_ref_disable ( int array, 01612 int size ) 01613 { 01614 STB_pkt *p; 01615 ST *st; 01616 01617 p = cast_to_STB(array); 01618 DevAssert((p->form == is_ST),("Odd object ref")); 01619 st = (ST *)p->item; 01620 if (size==-1) size=0; 01621 cwh_stmt_add_pragma(WN_PRAGMA_PREFETCH_REF_DISABLE,FALSE,st,0,size); 01622 } 01623 01624 01625 void 01626 fei_prefetch_ref ( int stride, 01627 int level, 01628 int kind, 01629 int size ) 01630 { 01631 INT lev1,lev2; 01632 INT str1,str2,itemp; 01633 WN * wn; 01634 WN * t; 01635 01636 /* Build the PREFETCH pragma */ 01637 if (size == -1) size = 0; 01638 cwh_stmt_add_pragma(WN_PRAGMA_PREFETCH_REF, 01639 FALSE, 01640 (ST_IDX) NULL, 01641 0, 01642 size); 01643 01644 /* Pick up the level numbers */ 01645 if (level == 2) { 01646 t = cwh_expr_operand(NULL); 01647 lev2 = WN_const_val(t); 01648 t = cwh_expr_operand(NULL); 01649 lev1 = WN_const_val(t); 01650 } else if (level == 1) { 01651 t = cwh_expr_operand(NULL); 01652 lev1 = WN_const_val(t); 01653 lev2 = 0; 01654 } else { 01655 lev1 = 2; 01656 lev2 = 0; 01657 } 01658 01659 /* Pick up the strides */ 01660 if (stride == 2) { 01661 t = cwh_expr_operand(NULL); 01662 str2 = WN_const_val(t); 01663 t = cwh_expr_operand(NULL); 01664 str1 = WN_const_val(t); 01665 } else if (stride == 1) { 01666 t = cwh_expr_operand(NULL); 01667 str1 = WN_const_val(t); 01668 str2 = 0; 01669 } else { 01670 str1 = 1; 01671 str2 = 0; 01672 } 01673 01674 if (lev1 == 2) { 01675 /* swap the two strides */ 01676 itemp = str1; 01677 str1 = str2; 01678 str2 = itemp; 01679 } 01680 01681 /* Get the ARRAY node */ 01682 wn = cwh_expr_address(f_NONE); 01683 wn = WN_CreatePrefetch ( 0, 0, wn ); 01684 WN_pf_set_confidence(wn, 3); 01685 WN_pf_set_manual(wn); 01686 if (kind == 0) { 01687 WN_pf_set_read(wn); 01688 } else { 01689 WN_pf_set_write(wn); 01690 } 01691 01692 WN_pf_set_stride_1L(wn, str1); 01693 WN_pf_set_stride_2L(wn, str2); 01694 01695 cwh_block_append(wn); 01696 } /* fei_prefetch_ref */ 01697 01698 01699 void 01700 fei_prefetch(int n1, 01701 int n2 ) 01702 { 01703 cwh_stmt_add_pragma(WN_PRAGMA_PREFETCH,FALSE,(ST_IDX) NULL,n1,n2); 01704 } 01705 01706 01707 void 01708 fei_prefetch_manual( int n ) 01709 { 01710 cwh_stmt_add_pragma(WN_PRAGMA_PREFETCH_MANUAL,FALSE,(ST_IDX) NULL,n,0); 01711 } 01712 01713 void 01714 fei_regionbegin ( void ) 01715 { 01716 WN *body = cwh_region(REGION_KIND_PRAGMA); 01717 cwh_block_set_current(body); 01718 } /* fei_regionbegin */ 01719 01720 void 01721 fei_regionend ( void ) 01722 { 01723 /* end the region */ 01724 (void) cwh_block_pop_region(); 01725 } /* fei_regionend */ 01726 01727 01728 void 01729 fei_section_gp ( int list_count ) 01730 { 01731 int i; 01732 ST *st; 01733 for (i=0; i<list_count; i++) { 01734 st = cwh_stk_pop_ST(); 01735 01736 if (Has_Base_Block(st) && (ST_sclass(ST_base(st))==SCLASS_COMMON)) { 01737 /* set flags on parent common */ 01738 st = ST_base(st); 01739 } 01740 Set_ST_gprel(st); 01741 } 01742 } /* fei_section_gp */ 01743 01744 void 01745 fei_section_nongp ( int list_count ) 01746 { 01747 int i; 01748 ST *st; 01749 for (i=0; i<list_count; i++) { 01750 st = cwh_stk_pop_ST(); 01751 01752 if (Has_Base_Block(st) && (ST_sclass(ST_base(st))==SCLASS_COMMON)) { 01753 /* set flags on parent common */ 01754 st = ST_base(st); 01755 } 01756 Set_ST_not_gprel(st); 01757 } 01758 } /* fei_section_nongp */ 01759 01760 void 01761 fei_blocking_size ( void ) 01762 { 01763 WN *wn1,*wn2; 01764 wn1 = cwh_expr_operand(NULL); 01765 wn2 = cwh_expr_operand(NULL); 01766 DevAssert((WN_operator(wn1)==OPR_INTCONST),("fei_blocking_size: expected constant")); 01767 DevAssert((WN_operator(wn2)==OPR_INTCONST),("fei_blocking_size: expected constant")); 01768 01769 cwh_stmt_add_pragma(WN_PRAGMA_BLOCKING_SIZE, 01770 FALSE, 01771 (ST_IDX) NULL, 01772 WN_const_val(wn2), 01773 WN_const_val(wn1)); 01774 01775 } /* fei_blocking_size */ 01776 01777 void 01778 fei_purple_conditional ( void ) 01779 { 01780 WN *save, *wn1; 01781 save = cwh_block_set_region_pragmas(); 01782 wn1 = cwh_expr_operand(NULL); 01783 cwh_stmt_add_xpragma(WN_PRAGMA_PURPLE_CONDITIONAL,FALSE,wn1); 01784 cwh_block_set_current(save); 01785 01786 } /* fei_purple_conditional */ 01787 01788 void 01789 fei_purple_unconditional ( void ) 01790 { 01791 WN *save ; 01792 save = cwh_block_set_region_pragmas(); 01793 cwh_stmt_add_pragma(WN_PRAGMA_PURPLE_UNCONDITIONAL); 01794 cwh_block_set_current(save); 01795 } /* fei_purple_unconditional */ 01796 01797 void 01798 fei_opaque ( void ) 01799 { 01800 WN *save ; 01801 save = cwh_block_set_region_pragmas(); 01802 cwh_stmt_add_pragma(WN_PRAGMA_OPAQUE); 01803 cwh_block_set_current(save); 01804 } /* fei_opaque */ 01805 01806 void 01807 fei_concurrentize ( int state ) 01808 { 01809 WN_PRAGMA_ID id; 01810 01811 if (state) { 01812 id = WN_PRAGMA_KAP_CONCURRENTIZE ; 01813 } 01814 else { 01815 id = WN_PRAGMA_KAP_NOCONCURRENTIZE; 01816 } 01817 cwh_stmt_add_pragma(id); 01818 } 01819 01820 int 01821 fei_par_case ( INT32 task_x, INT32 lineno ) 01822 { 01823 WN *body; 01824 01825 if (task_x == 0) { 01826 body = cwh_mp_region(WN_PRAGMA_PSECTION_BEGIN,0,0,0,0,0,0); 01827 01828 /* append statements to region body */ 01829 cwh_block_set_current(body); 01830 01831 cwh_directive_set_PU_flags(FALSE); 01832 01833 } else { 01834 cwh_stmt_add_pragma(WN_PRAGMA_SECTION); 01835 } 01836 return (1); 01837 } 01838 01839 01840 void 01841 fei_par_endcase ( INT32 task_x, INT32 lineno ) 01842 { 01843 (void) cwh_block_pop_region(); 01844 } 01845 01846 01847 /* TBD guard/endguard currently ignore the lock number. Do this for 7.2+ */ 01848 01849 int 01850 fei_guard ( INT32 guard_num, INT32 lineno ) 01851 { 01852 WN *wn; 01853 01854 cwh_stmt_add_pragma(WN_PRAGMA_CRITICAL_SECTION_BEGIN); 01855 01856 wn = WN_CreateBarrier (FALSE,0); 01857 cwh_block_append(wn); 01858 return (1); 01859 } 01860 01861 void 01862 fei_endguard (INT32 task_x, INT32 guard_num, INT32 lineno ) 01863 { 01864 WN *wn; 01865 wn = WN_CreateBarrier (TRUE,0); 01866 cwh_block_append(wn); 01867 01868 cwh_stmt_add_pragma(WN_PRAGMA_CRITICAL_SECTION_END); 01869 } 01870 01871 /*=============================================== 01872 * 01873 * 01874 * fei_parallelsections_open_mp 01875 * 01876 * 01877 *=============================================== 01878 */ 01879 void 01880 fei_parallelsections_open_mp(int task_if_idx, 01881 int defaultt) 01882 { 01883 WN *body; 01884 01885 task_nest_count = 0; 01886 body = cwh_mp_region(WN_PRAGMA_PARALLEL_SECTIONS,0,0,0,0,0,1); 01887 01888 /* now attach all applicable pragmas */ 01889 01890 cwh_directive_load_value_pragma(task_if_idx,WN_PRAGMA_IF,TRUE); 01891 01892 if (defaultt) { /* there is a DEFAULT clause */ 01893 01894 DevAssert((defaultt > 0 && defaultt < MAX_PRAGMA_DEFAULT),("Odd defaultt")); 01895 cwh_stmt_add_pragma(WN_PRAGMA_DEFAULT,TRUE,(ST_IDX) NULL,defaultt); 01896 } 01897 01898 /* append statements to region body */ 01899 01900 cwh_block_set_current(body); 01901 01902 cwh_directive_set_PU_flags(FALSE); 01903 } 01904 01905 /*=============================================== 01906 * 01907 * fei_paralleldo_open_mp 01908 * 01909 * 01910 *=============================================== 01911 */ 01912 void 01913 fei_paralleldo_open_mp (int task_if_idx, 01914 int defaultt, 01915 int ordered, 01916 int scheduletype, 01917 int schedulechunk, 01918 int threadcount, 01919 int datacount, 01920 int ontocount) 01921 { 01922 WN *body; 01923 01924 nested_do_descriptor.depth = task_nest_count; 01925 task_nest_count = 0; 01926 nested_do_descriptor.current = 0; 01927 nested_do_descriptor.explicit_end = TRUE; 01928 nested_do_descriptor.type = WN_PRAGMA_PARALLEL_DO; 01929 body = cwh_mp_region(WN_PRAGMA_PARALLEL_DO,threadcount,datacount,ontocount, 01930 0,0,1); 01931 01932 /* now attach all applicable pragmas */ 01933 01934 cwh_directive_load_value_pragma(task_if_idx,WN_PRAGMA_IF,TRUE); 01935 01936 if (defaultt) { /* there is a DEFAULT clause */ 01937 01938 DevAssert((defaultt > 0 && defaultt < MAX_PRAGMA_DEFAULT),("Odd defaultt")); 01939 cwh_stmt_add_pragma(WN_PRAGMA_DEFAULT,TRUE,(ST_IDX) NULL,defaultt); 01940 } 01941 01942 if (scheduletype != WN_PRAGMA_SCHEDTYPE_UNKNOWN) { 01943 01944 cwh_stmt_add_pragma(WN_PRAGMA_MPSCHEDTYPE, TRUE, (ST_IDX) NULL, scheduletype); 01945 cwh_directive_load_value_pragma(schedulechunk,WN_PRAGMA_CHUNKSIZE,TRUE); 01946 } 01947 01948 /* ordered */ 01949 01950 if (ordered) { 01951 cwh_stmt_add_pragma(WN_PRAGMA_ORDERED,TRUE); 01952 } 01953 01954 /* append statements to region body */ 01955 cwh_block_set_current(body); 01956 01957 /* mark next n DO loops nested loops */ 01958 if (nested_do_descriptor.depth) { 01959 parallel_do_count =nested_do_descriptor.depth; 01960 } else { 01961 parallel_do_count = 1; 01962 } 01963 01964 /* set the MP and uplevel bits on the symtab */ 01965 01966 cwh_directive_set_PU_flags(nested_do_descriptor.depth > 1); 01967 } 01968 01969 /*=============================================== 01970 * 01971 * 01972 * fei_parallelworkshare_open_mp 01973 * 01974 * 01975 *=============================================== 01976 */ 01977 void 01978 fei_parallelworkshare_open_mp(int task_if_idx, 01979 int defaultt) 01980 { 01981 WN *body; 01982 01983 task_nest_count = 0; 01984 body = cwh_mp_region(WN_PRAGMA_PARALLEL_WORKSHARE,0,0,0,0,0,1); 01985 01986 /* now attach all applicable pragmas */ 01987 01988 cwh_directive_load_value_pragma(task_if_idx,WN_PRAGMA_IF,TRUE); 01989 01990 if (defaultt) { /* there is a DEFAULT clause */ 01991 01992 DevAssert((defaultt > 0 && defaultt < MAX_PRAGMA_DEFAULT),("Odd defaultt")); 01993 cwh_stmt_add_pragma(WN_PRAGMA_DEFAULT,TRUE,(ST_IDX) NULL,defaultt); 01994 } 01995 01996 /* append statements to region body */ 01997 01998 cwh_block_set_current(body); 01999 02000 cwh_directive_set_PU_flags(FALSE); 02001 } 02002 02003 /*=============================================== 02004 * 02005 * fei_workshare_open_mp 02006 * 02007 * create a new region & make body current block 02008 * 02009 *=============================================== 02010 */ 02011 void 02012 fei_workshare_open_mp (void) 02013 { 02014 WN *body; 02015 02016 body = cwh_mp_region(WN_PRAGMA_WORKSHARE,0,0,0,0,0,1); 02017 02018 cwh_block_set_current(body); 02019 02020 cwh_directive_set_PU_flags(FALSE); 02021 } 02022 02023 /*=============================================== 02024 * 02025 * fei_single_open_mp 02026 * 02027 * create a new region & make body current block 02028 * 02029 *=============================================== 02030 */ 02031 void 02032 fei_single_open_mp (void) 02033 { 02034 WN *body; 02035 02036 body = cwh_mp_region(WN_PRAGMA_SINGLE_PROCESS_BEGIN,0,0,0,0,0,1); 02037 02038 cwh_block_set_current(body); 02039 02040 cwh_directive_set_PU_flags(FALSE); 02041 } 02042 02043 /*=============================================== 02044 * 02045 * fei_sections_open_mp 02046 * 02047 * create a new region & make body current block 02048 * 02049 *=============================================== 02050 */ 02051 void 02052 fei_sections_open_mp(void) 02053 { 02054 WN *body; 02055 body = cwh_mp_region(WN_PRAGMA_PSECTION_BEGIN,0,0,0,0,0,1); 02056 02057 cwh_block_set_current(body); 02058 02059 cwh_directive_set_PU_flags(FALSE); 02060 02061 } 02062 02063 /*=============================================== 02064 * 02065 * fei_do_open_mp 02066 * 02067 * 02068 *=============================================== 02069 */ 02070 void 02071 fei_do_open_mp (int ordered, 02072 int scheduletype, 02073 int schedulechunk, 02074 int threadcount, 02075 int datacount, 02076 int ontocount) 02077 { 02078 WN *body; 02079 02080 nested_do_descriptor.depth = task_nest_count; 02081 task_nest_count = 0; 02082 nested_do_descriptor.current = 0; 02083 nested_do_descriptor.explicit_end = TRUE; 02084 nested_do_descriptor.type = WN_PRAGMA_PDO_BEGIN; 02085 body = cwh_mp_region(WN_PRAGMA_PDO_BEGIN,threadcount,datacount,ontocount, 02086 0,0,1); 02087 02088 if (scheduletype != WN_PRAGMA_SCHEDTYPE_UNKNOWN) { 02089 02090 cwh_stmt_add_pragma(WN_PRAGMA_MPSCHEDTYPE, TRUE,(ST_IDX) NULL, scheduletype); 02091 cwh_directive_load_value_pragma(schedulechunk,WN_PRAGMA_CHUNKSIZE,TRUE); 02092 } 02093 02094 if (ordered) { 02095 cwh_stmt_add_pragma(WN_PRAGMA_ORDERED, TRUE); 02096 } 02097 02098 /* append statements to region body */ 02099 cwh_block_set_current(body); 02100 02101 /* mark next n DO loops nested loops */ 02102 if (nested_do_descriptor.depth) { 02103 parallel_do_count =nested_do_descriptor.depth; 02104 } else { 02105 parallel_do_count = 1; 02106 } 02107 02108 cwh_directive_set_PU_flags(nested_do_descriptor.depth > 1); 02109 } 02110 02111 /*=============================================== 02112 * 02113 * fei_parallel_open_mp 02114 * 02115 *=============================================== 02116 */ 02117 void 02118 fei_parallel_open_mp(int task_if_idx, 02119 int defaultt) 02120 { 02121 cwh_parallel (task_if_idx, defaultt, 1); 02122 } 02123 /*=============================================== 02124 * 02125 * cwh_create_str_st 02126 * 02127 * generate a ST to represent a character string 02128 * 02129 *=============================================== 02130 */ 02131 static ST * 02132 cwh_create_str_st(char *string) 02133 { 02134 TCON tcon; 02135 TY_IDX ty; 02136 ST *st; 02137 02138 tcon = Host_To_Targ_String ( MTYPE_STRING, 02139 string, 02140 strlen(string)); 02141 ty = Be_Type_Tbl(MTYPE_I1); 02142 st = Gen_String_Sym ( &tcon, ty, FALSE ); 02143 02144 return (st); 02145 } 02146 /*=============================================== 02147 * 02148 * fei_critical_open_mp 02149 * 02150 * 02151 *=============================================== 02152 */ 02153 extern void 02154 fei_critical_open_mp ( char *name ) 02155 { 02156 WN *wn; 02157 ST *st = NULL; 02158 02159 if (name != NULL) 02160 st = cwh_create_str_st(name); 02161 02162 cwh_stmt_add_pragma(WN_PRAGMA_CRITICAL_SECTION_BEGIN, TRUE, st); 02163 02164 wn = WN_CreateBarrier( FALSE, 0 ); 02165 WN_set_pragma_omp(wn); 02166 cwh_block_append(wn); 02167 02168 cwh_directive_set_PU_flags(FALSE); 02169 } 02170 02171 /*=============================================== 02172 * 02173 * fei_endcritical_open_mp 02174 * 02175 *=============================================== 02176 */ 02177 extern void 02178 fei_endcritical_open_mp ( char *name ) 02179 { 02180 WN *wn; 02181 ST *st; 02182 02183 wn = WN_CreateBarrier( TRUE, 0 ); 02184 WN_set_pragma_omp(wn); 02185 cwh_block_append(wn); 02186 02187 st = NULL; 02188 02189 if (name != NULL) 02190 st = cwh_create_str_st(name); 02191 02192 cwh_stmt_add_pragma(WN_PRAGMA_CRITICAL_SECTION_END, TRUE,st); 02193 } 02194 02195 /*=============================================== 02196 * 02197 * fei_barrier_open_mp 02198 * 02199 *=============================================== 02200 */ 02201 extern void 02202 fei_barrier_open_mp ( void ) 02203 { 02204 WN *wn; 02205 02206 wn = WN_CreatePragma(WN_PRAGMA_BARRIER,(ST_IDX) NULL,0,0); 02207 WN_set_pragma_omp(wn); 02208 cwh_directive_barrier_insert(wn, 0); 02209 } 02210 02211 /*=============================================== 02212 * 02213 * fei_section_open_mp 02214 * 02215 * handles a C$OMP SECTION 02216 * 02217 * simply generates a WN_PRAGMA_SECTION pragma 02218 * 02219 *=============================================== 02220 */ 02221 extern void 02222 fei_section_open_mp ( void ) 02223 { 02224 cwh_stmt_add_pragma(WN_PRAGMA_SECTION,TRUE); 02225 } 02226 02227 /*=============================================== 02228 * 02229 * fei_master_open_mp 02230 * 02231 * 02232 *=============================================== 02233 */ 02234 extern void 02235 fei_master_open_mp ( void ) 02236 { 02237 WN *body; 02238 02239 body = cwh_mp_region(WN_PRAGMA_MASTER_BEGIN,0,0,0,0,0,1); 02240 02241 /* Set current block to region body */ 02242 cwh_block_set_current(body); 02243 02244 /* set the MP and uplevel bits on the symtab */ 02245 02246 cwh_directive_set_PU_flags(FALSE); 02247 } 02248 02249 /*=============================================== 02250 * 02251 * fei_endmaster_open_mp 02252 * 02253 * 02254 *=============================================== 02255 */ 02256 extern void 02257 fei_endmaster_open_mp ( void ) 02258 { 02259 cwh_directive_pop_and_nowait(FALSE,TRUE); 02260 } 02261 02262 /*=============================================== 02263 * 02264 * fei_ordered_open_mp 02265 * 02266 * 02267 *=============================================== 02268 */ 02269 extern void 02270 fei_ordered_open_mp ( void ) 02271 { 02272 WN *wn; 02273 02274 cwh_stmt_add_pragma(WN_PRAGMA_ORDERED_BEGIN,TRUE); 02275 02276 wn = WN_CreateBarrier( FALSE, 0 ); 02277 WN_set_pragma_omp(wn); 02278 cwh_block_append(wn); 02279 } 02280 02281 /*=============================================== 02282 * 02283 * fei_endsingle_open_mp 02284 * 02285 * similar to ending any other parallel construct 02286 * 02287 *=============================================== 02288 */ 02289 extern void 02290 fei_endsingle_open_mp ( int nowait ) 02291 { 02292 cwh_directive_pop_and_nowait_or_copyprivate(nowait); 02293 } 02294 02295 /*=============================================== 02296 * 02297 * fei_enddo_open_mp 02298 * 02299 * similar to ending any other parallel loop, but we may need to add 02300 * a NOWAIT pragma to the region pragma list. 02301 * 02302 *=============================================== 02303 */ 02304 extern void 02305 fei_enddo_open_mp ( int nowait ) 02306 { 02307 cwh_directive_pop_and_nowait(nowait,TRUE); 02308 } 02309 02310 /*=============================================== 02311 * 02312 * fei_endsections_open_mp 02313 * 02314 * similar to ending any other parallel loop, but we may need to add 02315 * a NOWAIT pragma to the region pragma list. 02316 * 02317 *=============================================== 02318 */ 02319 extern void 02320 fei_endsections_open_mp ( int nowait ) 02321 { 02322 cwh_directive_pop_and_nowait(nowait,TRUE); 02323 } 02324 02325 /*=============================================== 02326 * 02327 * fei_endordered_open_mp 02328 * 02329 * 02330 *=============================================== 02331 */ 02332 extern void 02333 fei_endordered_open_mp ( void ) 02334 { 02335 WN *wn; 02336 02337 wn = WN_CreateBarrier( TRUE, 0 ); 02338 WN_set_pragma_omp(wn); 02339 cwh_block_append(wn); 02340 02341 cwh_stmt_add_pragma(WN_PRAGMA_ORDERED_END,TRUE); 02342 } 02343 02344 /*=============================================== 02345 * 02346 * fei_endparalleldo_open_mp 02347 * 02348 * 02349 *=============================================== 02350 */ 02351 extern void 02352 fei_endparalleldo_open_mp ( void ) 02353 { 02354 (void) cwh_block_pop_region(); 02355 } 02356 02357 /*=============================================== 02358 * 02359 * fei_endparallel_open_mp 02360 * 02361 * processes a C$OMP END PARALLEL 02362 * 02363 * simply pops off the MP region 02364 * 02365 *=============================================== 02366 */ 02367 extern void 02368 fei_endparallel_open_mp ( void ) 02369 { 02370 cwh_directive_pop_and_nowait(FALSE,TRUE); 02371 } 02372 02373 /*=============================================== 02374 * 02375 * fei_endparallelsections_open_mp 02376 * 02377 * 02378 *=============================================== 02379 */ 02380 extern void 02381 fei_endparallelsections_open_mp( void ) 02382 { 02383 cwh_directive_pop_and_nowait(FALSE,TRUE); 02384 } 02385 02386 /*=============================================== 02387 * 02388 * fei_endparallelworkshare_open_mp 02389 * 02390 * 02391 *=============================================== 02392 */ 02393 extern void 02394 fei_endparallelworkshare_open_mp( void ) 02395 { 02396 cwh_directive_pop_and_nowait(FALSE,TRUE); 02397 } 02398 02399 /*=============================================== 02400 * 02401 * fei_endworkshare_open_mp 02402 * 02403 * similar to ending any other parallel construct 02404 * 02405 *=============================================== 02406 */ 02407 extern void 02408 fei_endworkshare_open_mp ( int nowait ) 02409 { 02410 cwh_directive_pop_and_nowait(nowait,TRUE); 02411 } 02412 02413 /*=============================================== 02414 * 02415 * fei_flush_open_mp 02416 * 02417 * 02418 *=============================================== 02419 */ 02420 extern void 02421 fei_flush_open_mp(/*int list_count*/void) 02422 { 02423 WN *block, *pragma; 02424 02425 block = WN_CreateBlock (); 02426 pragma = WN_CreatePragma(WN_PRAGMA_FLUSH, (ST_IDX) NULL, 0, 0); 02427 WN_set_pragma_omp(pragma); 02428 cwh_block_append_given_block(pragma, block); 02429 02430 while (task_var_count) { 02431 cwh_block_append_given_block(cwh_stk_pop_WN(), block); 02432 task_var_count--; 02433 } 02434 02435 cwh_block_append(block); 02436 02437 // intrinsic calls produce errors 02438 // we do not translate FLUSH in an intrinsic call (within barriers) any more 02439 // instead we create a new WN region ([email protected]) 02440 // WN *sync; 02441 02442 // sync = WN_Create_Intrinsic(OPC_VINTRINSIC_CALL,INTRN_SYNCHRONIZE,0,NULL); 02443 // cwh_directive_barrier_insert(sync,list_count) ; 02444 } 02445 02446 02447 /*=============================================== 02448 * 02449 * fei_atomic_open_mp 02450 * 02451 * 02452 *=============================================== 02453 */ 02454 extern void 02455 fei_atomic_open_mp(void) 02456 { 02457 cwh_stmt_add_pragma(WN_PRAGMA_ATOMIC,TRUE); 02458 cwh_directive_set_PU_flags(FALSE); 02459 } 02460 02461 02462 /*=============================================== 02463 * 02464 * fei_xxx_openad 02465 * 02466 *=============================================== 02467 */ 02468 extern void 02469 fei_xxx_openad( char *str ) 02470 { 02471 /* This pragma has WN scope */ 02472 ST *st = NULL; 02473 02474 if (str != NULL) { 02475 st = cwh_create_str_st(str); 02476 } 02477 02478 cwh_stmt_add_pragma(WN_PRAGMA_OPENAD_XXX, FALSE, st); 02479 } 02480 02481 02482 /*=============================================== 02483 * 02484 * fei_dependent_independent_openad 02485 * 02486 * eraxxon: OpenAD directive 02487 * 02488 *=============================================== 02489 */ 02490 extern void 02491 fei_dependent_independent_openad(void) 02492 { 02493 /* These pragmas have PU scope */ 02494 while (task_var_count) { 02495 WN* pragma = cwh_stk_pop_WN(); 02496 cwh_stmt_add_to_preamble(pragma, block_pu, pu_pragma_placement_last); 02497 task_var_count--; 02498 } 02499 } 02500 02501 02502 /* 02503 *================================================================ 02504 * 02505 * cwh_directive_add_do_loop_directive 02506 * 02507 * Adds directive to the list of directives to be 02508 * inserted just before the next DO loop 02509 * 02510 *================================================================ 02511 */ 02512 extern void 02513 cwh_directive_add_do_loop_directive(WN *directive) 02514 { 02515 if (!do_loop_directive_block) { 02516 do_loop_directive_block = WN_CreateBlock(); 02517 } 02518 WN_INSERT_BlockLast(do_loop_directive_block,directive); 02519 } 02520 02521 /* 02522 *================================================================ 02523 * 02524 * cwh_directive_insert_do_loop_directives 02525 * 02526 * Inserts all the deferred DO loop directives. 02527 * 02528 *================================================================ 02529 */ 02530 02531 extern void 02532 cwh_directive_insert_do_loop_directives(void) 02533 { 02534 if (do_loop_directive_block) { 02535 cwh_block_append(do_loop_directive_block); 02536 do_loop_directive_block = NULL; 02537 } 02538 } 02539 02540 /*================================================================ 02541 * 02542 * cwh_directive_barrier_insert 02543 * 02544 * Insert a pragma eg: a barrier, and add to the 02545 * current block. The pragma ins, if any, is inserted 02546 * between forward and backward barriers. 02547 * 02548 * args is the number of STs (names) on the stack 02549 * to be added to the barriers. TOS is last kid.. 02550 * 02551 *================================================================ 02552 */ 02553 extern void 02554 cwh_directive_barrier_insert(WN *ins, int args) 02555 { 02556 WN *wn1; 02557 WN *wn2; 02558 ST *st; 02559 02560 wn1 = WN_CreateBarrier(TRUE, args); 02561 wn2 = WN_CreateBarrier(FALSE, args); 02562 if (args) { 02563 while(args--) { 02564 02565 st = cwh_stk_pop_ST(); 02566 02567 /* CAUTION: use of 'args' below is code trick to reverse 02568 the operands popped off the stack. Be careful if you hack with 02569 the code here */ 02570 02571 if (Barrier_Lvalues_On) { 02572 02573 WN_kid(wn1,args) = cwh_addr_address_ST(st, 0, 0); 02574 WN_kid(wn2,args) = cwh_addr_address_ST(st, 0, 0); 02575 } 02576 else { 02577 WN_kid(wn1,args) = WN_CreateIdname(0,st); 02578 WN_kid(wn2,args) = WN_CreateIdname(0,st); 02579 } 02580 } 02581 } 02582 cwh_block_append(wn1); 02583 if (ins != NULL) 02584 cwh_block_append(ins); 02585 cwh_block_append(wn2); 02586 } 02587 02588 /*================================================================ 02589 * 02590 * cwh_directive_pragma_to_region 02591 * 02592 * Add given pragma to the given region. The 02593 * region need not be the current block. 02594 * 02595 *================================================================ 02596 */ 02597 static void 02598 cwh_directive_pragma_to_region(WN * prag, WN * region) 02599 { 02600 WN * pr_blk ; 02601 WN * ol_blk ; 02602 02603 pr_blk = WN_region_pragmas(region); 02604 ol_blk = cwh_block_exchange_current(pr_blk); 02605 cwh_block_append(prag); 02606 02607 cwh_block_set_current(ol_blk); 02608 } 02609 02610 /*================================================================ 02611 * 02612 * cwh_directive_set_PU_flags 02613 * 02614 * Set MP & uplevel flags on current PU. 02615 * 02616 * If nested, set needs LNO 02617 * 02618 *================================================================ 02619 */ 02620 static void 02621 cwh_directive_set_PU_flags(BOOL nested) 02622 { 02623 Set_PU_has_mp (Get_Current_PU ()); 02624 Set_FILE_INFO_has_mp (File_info); 02625 Set_PU_uplevel (Get_Current_PU ()); 02626 02627 if (nested) 02628 cwh_directive_set_LNO_flags() ; 02629 } 02630 02631 /*================================================================ 02632 * 02633 * cwh_directive_set_LNO_flags 02634 * 02635 * Sets needs LNO on PU & file 02636 * 02637 *================================================================ 02638 */ 02639 static void 02640 cwh_directive_set_LNO_flags(void) 02641 { 02642 Set_PU_mp_needs_lno (Get_Current_PU()); 02643 Set_FILE_INFO_needs_lno (File_info); 02644 } 02645 02646 /*================================================================ 02647 * 02648 * cwh_directive_pop_and_nowait 02649 * 02650 * Pop the current region and issue a NOWAIT to the region 02651 * pragmas if required. If NOWAIT absent, issue an ENDMARKER, 02652 * to mark the line number at the end of the region. 02653 * 02654 *================================================================ 02655 */ 02656 static void 02657 cwh_directive_pop_and_nowait( BOOL nowait, BOOL is_omp) 02658 { 02659 WN *region, *wn ; 02660 WN_PRAGMA_ID p ; 02661 02662 region = cwh_block_pop_region(); 02663 02664 if (nowait) 02665 p = WN_PRAGMA_NOWAIT; 02666 else 02667 p = WN_PRAGMA_END_MARKER; 02668 02669 wn = WN_CreatePragma (p, (ST_IDX) NULL, 0, 0); 02670 02671 if (is_omp) 02672 WN_set_pragma_omp(wn); 02673 02674 cwh_directive_pragma_to_region(wn,region); 02675 } 02676 02677 02678 /*================================================================ 02679 * 02680 * cwh_directive_pop_and_nowait_or_copyprivate ([email protected]) 02681 * 02682 * Pop the current region and issue a COPYPRIVATE or NOWAIT to the region 02683 * pragmas if required. If both COPYPRIVATE and NOWAIT are absent, issue an ENDMARKER, 02684 * to mark the line number at the end of the region. 02685 * 02686 *================================================================ 02687 */ 02688 static void 02689 cwh_directive_pop_and_nowait_or_copyprivate( BOOL nowait) 02690 { 02691 WN *region; 02692 WN_PRAGMA_ID p ; 02693 BOOL copyprivate = FALSE; 02694 02695 region = cwh_block_pop_region(); 02696 02697 while (task_var_count) { 02698 cwh_directive_pragma_to_region(cwh_stk_pop_WN(), region); 02699 task_var_count--; 02700 copyprivate = TRUE; 02701 } 02702 02703 if (nowait) 02704 cwh_directive_pragma_to_region(WN_CreatePragma (WN_PRAGMA_NOWAIT, (ST_IDX) NULL, 0, 0),region); 02705 else if(! copyprivate) 02706 cwh_directive_pragma_to_region(WN_CreatePragma (WN_PRAGMA_END_MARKER, (ST_IDX) NULL, 0, 0),region); 02707 } 02708 02709 02710 /*================================================================ 02711 * 02712 * cwh_directive_add_to_loop 02713 * 02714 * Adds the given WN to the Top_of_Loop block. (to last) 02715 * 02716 *================================================================ 02717 */ 02718 static void 02719 cwh_directive_add_pragma_to_loop(WN * wn, BOOL is_omp) 02720 { 02721 if (is_omp) 02722 WN_set_pragma_omp(wn); 02723 WN_Set_Linenum (wn, USRCPOS_srcpos(current_srcpos)); 02724 cwh_block_append_given_id(wn,Top_of_Loop_Block,FALSE); 02725 } 02726 02727 /*================================================================ 02728 * 02729 * cwh_directive_work_dist 02730 * 02731 * Utility routine for work distribution in fei_doparallel 02732 * and fei_doall 02733 * 02734 *================================================================ 02735 */ 02736 static void 02737 cwh_directive_work_dist(INT32 work_dist, INT32 work_dist_opnd) 02738 { 02739 WN * wn1 ; 02740 STB_pkt *p; 02741 02742 switch(work_dist) { 02743 case 0: /* default: no need to do anything */ 02744 break; 02745 02746 case 1: /* single */ 02747 cwh_stmt_add_pragma(WN_PRAGMA_MPSCHEDTYPE,FALSE,(ST_IDX) NULL, WN_PRAGMA_SCHEDTYPE_DYNAMIC); 02748 wn1 = WN_CreateIntconst ( OPC_I4INTCONST, 1); 02749 cwh_stmt_add_xpragma(WN_PRAGMA_CHUNKSIZE,FALSE,wn1); 02750 break; 02751 02752 case 2: /* vector, not accepted, ignore */ 02753 break; 02754 02755 case 3: /* guided */ 02756 cwh_stmt_add_pragma(WN_PRAGMA_MPSCHEDTYPE, FALSE,(ST_IDX) NULL, WN_PRAGMA_SCHEDTYPE_GSS); 02757 break; 02758 02759 case 4: /* numchunks */ 02760 DevAssert((0), ("Unimplemented numchunks")); 02761 break; 02762 02763 case 5: /* chunksize */ 02764 DevAssert((work_dist_opnd!=0),("Expected chunk value")); 02765 cwh_directive_load_value_pragma(work_dist_opnd,WN_PRAGMA_CHUNKSIZE); 02766 break; 02767 02768 default: 02769 DevAssert((0), ("Unknown work distr")); 02770 break; 02771 } 02772 } 02773 02774 /*================================================================ 02775 * 02776 * cwh_directive_load_value_pragma 02777 * 02778 * Utility routine for maxcpus, if_expr etc. Given an item 02779 * packet, extracts the ST, loads the value and puts a pragma 02780 * with the load into the current block. 02781 * 02782 * Used in parallel region, doall etc. 02783 * 02784 *================================================================ 02785 */ 02786 static void 02787 cwh_directive_load_value_pragma(INT32 item, WN_PRAGMA_ID pragma, BOOL is_omp) 02788 { 02789 WN * wn1 ; 02790 STB_pkt *p; 02791 02792 if (item) { 02793 02794 p = cast_to_STB(item); 02795 DevAssert((p->form == is_ST),("Odd item")); 02796 02797 wn1 = cwh_addr_load_ST((ST *)p->item, 0, 0); 02798 cwh_stmt_add_xpragma(pragma,is_omp,wn1); 02799 } 02800 } 02801 02802 /*================================================================ 02803 * 02804 * fei_copyin_bound 02805 * 02806 * Generates the COPYIN_BOUND xpragma and appends it to the 02807 * current block. 02808 * 02809 * Used for bounds temps that are flow dependent. 02810 * 02811 *================================================================ 02812 */ 02813 02814 extern void 02815 fei_copyin_bound(INTPTR sym_idx) 02816 { 02817 STB_pkt *p; 02818 WN *wn; 02819 ST *st; 02820 02821 p = cast_to_STB(sym_idx); 02822 DevAssert((p->form == is_ST),("Odd object ref")); 02823 02824 st = cast_to_ST(p->item); 02825 02826 if (ST_sym_class(st) == CLASS_VAR && 02827 !ST_auxst_xpragma_copyin(st)) { 02828 02829 wn = WN_CreateXpragma ( WN_PRAGMA_COPYIN_BOUND, (ST_IDX) NULL, 1 ); 02830 WN_kid0(wn) = cwh_addr_load_ST(st,0,0); 02831 cwh_block_append(wn); 02832 Set_ST_auxst_xpragma_copyin(st,TRUE); 02833 } 02834 }