|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
00001 /* 00002 00003 Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved. 00004 00005 This program is free software; you can redistribute it and/or modify it 00006 under the terms of version 2 of the GNU General Public License as 00007 published by the Free Software Foundation. 00008 00009 This program is distributed in the hope that it would be useful, but 00010 WITHOUT ANY WARRANTY; without even the implied warranty of 00011 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00012 00013 Further, this software is distributed without any warranty that it is 00014 free of the rightful claim of any third person regarding infringement 00015 or the like. Any license provided herein, whether implied or 00016 otherwise, applies only to this software file. Patent licenses, if 00017 any, provided herein do not apply to combinations of this program with 00018 other software, or any other product whatsoever. 00019 00020 You should have received a copy of the GNU General Public License along 00021 with this program; if not, write the Free Software Foundation, Inc., 59 00022 Temple Place - Suite 330, Boston MA 02111-1307, USA. 00023 00024 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00025 Mountain View, CA 94043, or: 00026 00027 http://www.sgi.com 00028 00029 For further information regarding this notice, see: 00030 00031 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00032 00033 */ 00034 00035 00036 00037 static char USMID[] = "\n@(#)5.0_pl/sources/p_directiv.c 5.12 10/12/99 10:54:10\n"; 00038 00039 # include "defines.h" /* Machine dependent ifdefs */ 00040 00041 # include "host.m" /* Host machine dependent macros.*/ 00042 # include "host.h" /* Host machine dependent header.*/ 00043 # include "target.m" /* Target machine dependent macros.*/ 00044 # include "target.h" /* Target machine dependent header.*/ 00045 00046 # include "globals.m" 00047 # include "tokens.m" 00048 # include "sytb.m" 00049 # include "p_globals.m" 00050 # include "debug.m" 00051 00052 # include "globals.h" 00053 # include "tokens.h" 00054 # include "sytb.h" 00055 # include "p_globals.h" 00056 # include "s_globals.h" 00057 00058 # include "p_directiv.h" 00059 00060 /*****************************************************************\ 00061 |* function prototypes of static functions declared in this file *| 00062 \*****************************************************************/ 00063 00064 static void check_do_open_mp_nesting(void); 00065 static void check_ordered_open_mp_nesting(void); 00066 static boolean check_section_open_mp_context(void); 00067 static boolean directive_region_error(directive_stmt_type, int, int); 00068 static boolean parse_assert_directive(void); 00069 static void parse_auxiliary_dir(void); 00070 static void parse_cache_align_name_list(opnd_type *); 00071 static void parse_cache_bypass_dir(opnd_type *); 00072 static void parse_cache_noalloc(void); 00073 static void parse_common_dirs(sb_type_type); 00074 static void parse_copy_assumed_shape_dir(void); 00075 static void parse_dir_directives(void); 00076 static void parse_dir_var_list(void); 00077 static void parse_distribution_dir(boolean); 00078 static void parse_doall_cmic(void); 00079 static void parse_dollar_directives(void); 00080 static void parse_doparallel_cmic(void); 00081 static void parse_fill_align_symbol(void); 00082 static void parse_id_directive(void); 00083 static void parse_ignore_tkr(void); 00084 static void parse_inline_always_never(boolean); 00085 static void parse_int_or_star_list(opnd_type *); 00086 static void parse_mic_directives(void); 00087 static void parse_mp_directive(mp_directive_type); 00088 static void parse_name_dir(void); 00089 static void parse_nosideeffects_dir(void); 00090 static void parse_par_directives(void); 00091 static void parse_parallel_cmic(void); 00092 static void parse_permutation_mic(void); 00093 static void parse_prefetch_ref(void); 00094 static void parse_redistribute_dir(void); 00095 static void parse_reference_list(opnd_type *); 00096 static void parse_sgi_dir_inline(boolean); 00097 static void parse_slash_common_dirs(void); 00098 static void parse_star_directives(void); 00099 static void parse_star_dir_directives(void); 00100 static void parse_symmetric_dir(void); 00101 static void parse_var_common_list(opnd_type *, boolean); 00102 static boolean parse_var_name_list(opnd_type *, int maxlen); 00103 static void parse_vfunction_dir(void); 00104 static void parse_open_mp_directives(void); 00105 static void parse_open_mp_clauses(open_mp_directive_type); 00106 static void parse_openad_directives(void); /* eraxxon: OpenAD */ 00107 static char* get_openad_dir_xxx_string(void); /* eraxxon: OpenAD */ 00108 static void parse_openad_varlist(token_values_type); /* eraxxon: OpenAD */ 00109 static int update_fld_type(fld_type, int,int); 00110 00111 00112 /******************************************************************************\ 00113 |* *| 00114 |* Description: *| 00115 |* Set the defaults according to the command line arguments for all the *| 00116 |* cdir switches. This is called for every new compile unit. *| 00117 |* *| 00118 |* Input parameters: *| 00119 |* NONE *| 00120 |* *| 00121 |* Output parameters: *| 00122 |* NONE *| 00123 |* *| 00124 |* Returns: *| 00125 |* NOTHING *| 00126 |* *| 00127 \******************************************************************************/ 00128 00129 void init_directive(int pass) 00130 00131 { 00132 int attr_idx; 00133 int list_idx1; 00134 int list_idx2; 00135 int type_idx; 00136 00137 00138 TRACE (Func_Entry, "init_directive", NULL); 00139 00140 /* 0 means optimizer sets unroll count. 1 means no unrolling. If */ 00141 /* the default level is set to 2, then automatic unrolling happens. */ 00142 /* If the default level is set to 1, we only unroll those loops */ 00143 /* for which the user specifies the UNROLL directive. */ 00144 00145 cdir_switches.unroll_count_idx = (opt_flags.unroll_lvl == Unroll_Lvl_2) ? 00146 CN_INTEGER_ZERO_IDX : CN_INTEGER_ONE_IDX; 00147 cdir_switches.vector = (opt_flags.vector_lvl > Vector_Lvl_0); 00148 cdir_switches.task = (opt_flags.task_lvl > Task_Lvl_0); 00149 00150 cdir_switches.notask_region = FALSE; 00151 00152 /* Inline1 means recognize directives only. So cdir_switches.do_inline */ 00153 /* only gets specified if !DIR$ INLINE is see when level is inline_lvl_1. */ 00154 00155 cdir_switches.do_inline = FALSE; 00156 cdir_switches.noinline = FALSE; 00157 00158 /* If split level is set to 2, automatic splitting happens. If split */ 00159 /* level is 1, then it can only be turned on with directives. */ 00160 00161 cdir_switches.split = (opt_flags.split_lvl == Split_Lvl_2); 00162 00163 cdir_switches.align = FALSE; 00164 cdir_switches.bl = opt_flags.bottom_load; 00165 cdir_switches.bounds = cmd_line_flags.runtime_bounds; 00166 cdir_switches.concurrent = FALSE; 00167 cdir_switches.ivdep = FALSE; 00168 cdir_switches.mark = opt_flags.mark; 00169 cdir_switches.stream = (opt_flags.stream_lvl >=Stream_Lvl_1); 00170 cdir_switches.nextscalar = FALSE; 00171 cdir_switches.no_internal_calls = FALSE; 00172 cdir_switches.nointerchange = opt_flags.nointerchange; 00173 cdir_switches.pattern = opt_flags.pattern; 00174 cdir_switches.preferstream = FALSE; 00175 cdir_switches.preferstream_nocinv = FALSE; 00176 cdir_switches.prefertask = FALSE; 00177 cdir_switches.prefervector = FALSE; 00178 cdir_switches.recurrence = opt_flags.recurrence; 00179 cdir_switches.shortloop = FALSE; 00180 cdir_switches.shortloop128 = FALSE; 00181 cdir_switches.unroll_dir = FALSE; 00182 cdir_switches.vsearch = opt_flags.vsearch; 00183 00184 /* If maxcpus TRUE, then there is an opnd hanging */ 00185 /* off cdir_switches.maxcpu_opnd */ 00186 00187 cdir_switches.maxcpus = FALSE; 00188 cdir_switches.parallel_region = FALSE; 00189 cdir_switches.doall_region = FALSE; 00190 cdir_switches.casedir = FALSE; 00191 cdir_switches.guard = FALSE; 00192 cdir_switches.guard_has_flag = FALSE; 00193 cdir_switches.guard_in_par_reg = FALSE; 00194 cdir_switches.do_parallel = FALSE; 00195 cdir_switches.autoscope = FALSE; 00196 cdir_switches.safevl_idx = const_safevl_idx; 00197 cdir_switches.concurrent_idx = NULL_IDX; 00198 cdir_switches.blockable_sh_idx = NULL_IDX; 00199 cdir_switches.cache_bypass_ir_idx = NULL_IDX; 00200 cdir_switches.doall_sh_idx = NULL_IDX; 00201 cdir_switches.dir_nest_check_sh_idx = NULL_IDX; 00202 cdir_switches.doacross_sh_idx = NULL_IDX; 00203 cdir_switches.dopar_sh_idx = NULL_IDX; 00204 cdir_switches.getfirst_list_idx = NULL_IDX; 00205 cdir_switches.interchange_sh_idx = NULL_IDX; 00206 cdir_switches.lastlocal_list_idx = NULL_IDX; 00207 cdir_switches.lastthread_list_idx = NULL_IDX; 00208 cdir_switches.mark_dir_idx = NULL_IDX; 00209 cdir_switches.paralleldo_sh_idx = NULL_IDX; 00210 cdir_switches.pdo_sh_idx = NULL_IDX; 00211 cdir_switches.private_list_idx = NULL_IDX; 00212 cdir_switches.reduction_list_idx = NULL_IDX; 00213 cdir_switches.shared_list_idx = NULL_IDX; 00214 00215 cdir_switches.inline_here_sgi = FALSE; 00216 cdir_switches.noinline_here_sgi = FALSE; 00217 cdir_switches.inline_here_list_idx = NULL_IDX; 00218 cdir_switches.noinline_here_list_idx = NULL_IDX; 00219 00220 cdir_switches.firstprivate_list_idx = NULL_IDX; 00221 cdir_switches.copyin_list_idx = NULL_IDX; 00222 cdir_switches.copyprivate_list_idx = NULL_IDX; 00223 cdir_switches.lastprivate_list_idx = NULL_IDX; 00224 cdir_switches.flush_list_idx = NULL_IDX; 00225 cdir_switches.default_scope_list_idx = NULL_IDX; 00226 cdir_switches.do_omp_sh_idx = NULL_IDX; 00227 cdir_switches.paralleldo_omp_sh_idx = NULL_IDX; 00228 00229 cdir_switches.wait_list_idx = NULL_IDX; 00230 cdir_switches.send_list_idx = NULL_IDX; 00231 00232 cdir_switches.blockable_count = 0; 00233 cdir_switches.blockable_group = 0; 00234 cdir_switches.interchange_count = 0; 00235 cdir_switches.interchange_group = 0; 00236 cdir_switches.interchange_level = 0; 00237 00238 if (pass > 1) { 00239 list_idx1 = cdir_switches.bounds_il_list; 00240 00241 while (list_idx1) { 00242 attr_idx = IL_IDX(list_idx1); 00243 ATD_BOUNDS_CHECK(attr_idx) = FALSE; 00244 00245 list_idx2 = list_idx1; 00246 list_idx1 = IL_NEXT_LIST_IDX(list_idx1); 00247 FREE_IR_LIST_NODE(list_idx2); 00248 } 00249 00250 list_idx1 = cdir_switches.nobounds_il_list; 00251 00252 while (list_idx1) { 00253 attr_idx = IL_IDX(list_idx1); 00254 ATD_NOBOUNDS_CHECK(attr_idx) = FALSE; 00255 00256 list_idx2 = list_idx1; 00257 list_idx1 = IL_NEXT_LIST_IDX(list_idx1); 00258 FREE_IR_LIST_NODE(list_idx2); 00259 } 00260 } 00261 00262 cdir_switches.bounds_il_list = NULL_IDX; 00263 cdir_switches.nobounds_il_list = NULL_IDX; 00264 00265 cdir_switches.mp_schedtype_opnd = null_opnd; 00266 00267 if (global_schedtype_value >= 0) { 00268 OPND_LINE_NUM(cdir_switches.mp_schedtype_opnd) = global_schedtype_line; 00269 OPND_COL_NUM(cdir_switches.mp_schedtype_opnd) = global_schedtype_col; 00270 OPND_FLD(cdir_switches.mp_schedtype_opnd) = CN_Tbl_Idx; 00271 OPND_IDX(cdir_switches.mp_schedtype_opnd) = C_INT_TO_CN( 00272 CG_INTEGER_DEFAULT_TYPE, 00273 global_schedtype_value); 00274 } 00275 00276 cdir_switches.chunk_opnd = null_opnd; 00277 cdir_switches.first_sh_blk_stk = null_opnd; 00278 00279 directive_state = 0; 00280 00281 if (pass == 1) { 00282 cdir_switches.implicit_use_idx = cmd_line_flags.implicit_use_idx; 00283 cdir_switches.flow = on_off_flags.flowtrace_option; 00284 cdir_switches.code = FALSE; 00285 00286 if (!opt_flags.set_allfastint_option && 00287 !opt_flags.set_fastint_option && 00288 !opt_flags.set_nofastint_option) { 00289 # ifdef _TARGET_HAS_FAST_INTEGER 00290 opt_flags.set_fastint_option = TRUE; 00291 # endif 00292 } 00293 00294 if (opt_flags.mark && opt_flags.mark_name.string != NULL) { 00295 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX); 00296 TYP_CHAR_CLASS(TYP_WORK_IDX) = Const_Len_Char; 00297 TYP_TYPE(TYP_WORK_IDX) = Character; 00298 TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE; 00299 TYP_FLD(TYP_WORK_IDX) = CN_Tbl_Idx; 00300 TYP_IDX(TYP_WORK_IDX) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 00301 strlen(opt_flags.mark_name.string)); 00302 type_idx = ntr_type_tbl(); 00303 00304 cdir_switches.mark_cmdline_idx = ntr_const_tbl(type_idx, 00305 FALSE, 00306 (long_type *) &(opt_flags.mark_name.words)); 00307 } 00308 else { 00309 cdir_switches.mark_cmdline_idx = NULL_IDX; 00310 } 00311 } 00312 00313 TRACE (Func_Exit, "init_directive", NULL); 00314 00315 return; 00316 00317 } /* init_directive */ 00318 00319 /******************************************************************************\ 00320 |* *| 00321 |* Description: *| 00322 |* BRIEF DESCRIPTION OF THIS FUNCTION'S PURPOSE *| 00323 |* *| 00324 |* Input parameters: *| 00325 |* NONE *| 00326 |* *| 00327 |* Output parameters: *| 00328 |* NONE *| 00329 |* *| 00330 |* Returns: *| 00331 |* NONE *| 00332 |* *| 00333 \******************************************************************************/ 00334 void parse_directive_stmt (void) 00335 { 00336 00337 TRACE (Func_Entry, "parse_directive_stmt", NULL); 00338 00339 /***** NOTE: THE INPUT STREAM TO THIS POINT IS "CDIR$", "CDIR@", *****/ 00340 /***** NOTE: "!DIR$", "!DIR@", or "CMIC$", "!MIC$". THE SCANNER *****/ 00341 /***** NOTE: WILL RETURN Tok_Kwd_Dir FOR ANY OF THE ABOVE TOKENS.*****/ 00342 /***** NOTE: THIS ROUTINE MUST EXAMINE THE TOKEN STRING FIELD *****/ 00343 /***** NOTE: TO DISTINGUISH BETWEEN COMPILER DIRECTIVES AND *****/ 00344 /***** NOTE: MICRO TASKING DIRECTIVES. THE TOKEN STRING WILL *****/ 00345 /***** NOTE: NOT CONTAIN THE LEADING "C" OR "!" CHARACTERS. *****/ 00346 00347 /* If the first statement of the first program unit is being parsed, don't */ 00348 /* buffer up any message pertaining to directives that precede this first */ 00349 /* statement (they don't belong to the program unit). */ 00350 00351 /* set need_new_sh to false for all the directives that don't need a */ 00352 /* statement. */ 00353 00354 need_new_sh = FALSE; 00355 00356 if (cif_need_unit_rec && cif_first_pgm_unit) { 00357 c_i_f = cif_actual_file; 00358 } 00359 00360 if (TOKEN_STR(token)[0] == 'M') { 00361 00362 if (MATCHED_TOKEN_CLASS(Tok_Class_Mic_Kwd)) { 00363 00364 # if defined(_ACCEPT_TASK) 00365 00366 # if defined(GENERATE_WHIRL) 00367 if ((cdir_switches.task == FALSE || 00368 cmd_line_flags.disregard_all_mics) && 00369 TOKEN_VALUE(token) != Tok_Mic_Cncall && 00370 TOKEN_VALUE(token) != Tok_Mic_Permutation) { 00371 # else 00372 if (cdir_switches.task == FALSE || 00373 cmd_line_flags.disregard_all_mics) { 00374 # endif 00375 parse_err_flush(Find_EOS, NULL); 00376 NEXT_LA_CH; 00377 goto EXIT; 00378 } 00379 parse_mic_directives(); 00380 00381 # else 00382 PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token)); 00383 parse_err_flush(Find_EOS, NULL); 00384 NEXT_LA_CH; 00385 goto EXIT; 00386 # endif 00387 } 00388 else { 00389 PRINTMSG(TOKEN_LINE(token), 1356, Warning, TOKEN_COLUMN(token)); 00390 parse_err_flush(Find_EOS, NULL); 00391 NEXT_LA_CH; 00392 goto EXIT; 00393 } 00394 } 00395 else if (TOKEN_STR(token)[0] == '$' && 00396 TOKEN_STR(token)[1] == 'O' && 00397 TOKEN_STR(token)[2] == 'M' && 00398 TOKEN_STR(token)[3] == 'P') { 00399 00400 if (MATCHED_TOKEN_CLASS(Tok_Class_Open_Mp_Dir_Kwd)) { 00401 00402 # if defined(_TARGET_OS_MAX) 00403 PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token)); 00404 parse_err_flush(Find_EOS, NULL); 00405 NEXT_LA_CH; 00406 goto EXIT; 00407 # else 00408 00409 if (cmd_line_flags.disregard_all_omps) { 00410 00411 /* Do not attempt to recognize any omp directives. */ 00412 00413 parse_err_flush(Find_EOS, NULL); 00414 NEXT_LA_CH; 00415 goto EXIT; 00416 } 00417 00418 parse_open_mp_directives(); 00419 # endif 00420 } 00421 else { 00422 /* no error, just treat as comment */ 00423 parse_err_flush(Find_EOS, NULL); 00424 NEXT_LA_CH; 00425 goto EXIT; 00426 } 00427 } 00428 # if defined(GENERATE_WHIRL) 00429 else if (TOKEN_STR(token)[0] == '$' && 00430 TOKEN_STR(token)[1] == 'S' && 00431 TOKEN_STR(token)[2] == 'G' && 00432 TOKEN_STR(token)[3] == 'I') { 00433 00434 if (MATCHED_TOKEN_CLASS(Tok_Class_Open_Mp_Dir_Kwd)) { 00435 parse_open_mp_directives(); 00436 } 00437 else { 00438 /* no error, just treat as comment */ 00439 parse_err_flush(Find_EOS, NULL); 00440 NEXT_LA_CH; 00441 goto EXIT; 00442 } 00443 } 00444 else if (TOKEN_STR(token)[0] == '$' && 00445 TOKEN_STR(token)[1] == 'O' && 00446 TOKEN_STR(token)[2] == 'P' && 00447 TOKEN_STR(token)[3] == 'E' && 00448 TOKEN_STR(token)[4] == 'N' && 00449 TOKEN_STR(token)[5] == 'A' && 00450 TOKEN_STR(token)[6] == 'D') { 00451 /* eraxxon: OpenAD directive */ 00452 if (MATCHED_TOKEN_CLASS(Tok_Class_OpenAD_Dir_Kwd)) { 00453 if (cmd_line_flags.disregard_all_openads) { 00454 /* Do not attempt to recognize any OpenAD directives. */ 00455 parse_err_flush(Find_EOS, NULL); 00456 NEXT_LA_CH; 00457 goto EXIT; 00458 } 00459 00460 parse_openad_directives(); 00461 } 00462 else { 00463 /* no error, just treat as comment */ 00464 parse_err_flush(Find_EOS, NULL); 00465 NEXT_LA_CH; 00466 goto EXIT; 00467 } 00468 00469 00470 /* can we assume we won't go past the end of the token? */ 00471 } 00472 # endif 00473 else if (TOKEN_STR(token)[0] == '$') { 00474 00475 if (TOKEN_LEN(token) > 1 && TOKEN_STR(token)[1] == 'P') { 00476 00477 if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 00478 parse_par_directives(); 00479 } 00480 else { 00481 /* no error, just treat as comment */ 00482 parse_err_flush(Find_EOS, NULL); 00483 NEXT_LA_CH; 00484 goto EXIT; 00485 } 00486 } 00487 else if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 00488 parse_dollar_directives(); 00489 } 00490 else { 00491 /* no error, just treat as comment */ 00492 parse_err_flush(Find_EOS, NULL); 00493 NEXT_LA_CH; 00494 goto EXIT; 00495 } 00496 } 00497 else if (TOKEN_STR(token)[0] == '*') { 00498 00499 if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 00500 parse_star_directives(); 00501 } 00502 else { 00503 /* no error, just treat as comment */ 00504 parse_err_flush(Find_EOS, NULL); 00505 NEXT_LA_CH; 00506 goto EXIT; 00507 } 00508 } 00509 00510 # ifdef _DEBUG 00511 00512 else if (TOKEN_STR(token)[1] == 'B') { /* !DBG */ 00513 00514 if (!MATCHED_TOKEN_CLASS(Tok_Class_Dbg_Kwd)) { 00515 parse_err_flush(Find_EOS, NULL); 00516 NEXT_LA_CH; 00517 goto EXIT; 00518 } 00519 parse_dir_directives(); 00520 } 00521 00522 # endif 00523 00524 else if (MATCHED_TOKEN_CLASS(Tok_Class_Dir_Kwd)) { 00525 00526 if (cmd_line_flags.disregard_all_dirs) { 00527 00528 /* Do not attempt to recognize any dir$ directives. */ 00529 00530 parse_err_flush(Find_EOS, NULL); 00531 NEXT_LA_CH; 00532 goto EXIT; 00533 } 00534 parse_dir_directives(); 00535 } 00536 else { 00537 PRINTMSG(TOKEN_LINE(token), 1356, Warning, TOKEN_COLUMN(token)); 00538 parse_err_flush(Find_EOS, NULL); 00539 NEXT_LA_CH; 00540 goto EXIT; 00541 } 00542 00543 EXIT: 00544 00545 if (cif_need_unit_rec && cif_first_pgm_unit) { 00546 c_i_f = cif_tmp_file; 00547 } 00548 00549 TRACE (Func_Exit, "parse_directive_stmt", NULL); 00550 00551 return; 00552 00553 } /* parse_directive_stmt */ 00554 00555 /******************************************************************************\ 00556 |* *| 00557 |* Description: *| 00558 |* Generate the IR for directives. *| 00559 |* *| 00560 |* Input parameters: *| 00561 |* NONE *| 00562 |* *| 00563 |* Output parameters: *| 00564 |* NONE *| 00565 |* *| 00566 |* Returns: *| 00567 |* NOTHING *| 00568 |* *| 00569 \******************************************************************************/ 00570 00571 int gen_directive_ir(operator_type operator) 00572 00573 { 00574 int ir_idx; 00575 00576 00577 TRACE (Func_Entry, "gen_directive_ir", NULL); 00578 00579 need_new_sh = TRUE; 00580 00581 if (SH_IR_IDX(curr_stmt_sh_idx)) { 00582 SH_NEXT_IDX(curr_stmt_sh_idx) = ntr_sh_tbl(); 00583 SH_PREV_IDX(SH_NEXT_IDX(curr_stmt_sh_idx))= curr_stmt_sh_idx; 00584 curr_stmt_sh_idx = SH_NEXT_IDX(curr_stmt_sh_idx); 00585 SH_STMT_TYPE(curr_stmt_sh_idx) = Directive_Stmt; 00586 } 00587 00588 SH_GLB_LINE(curr_stmt_sh_idx)= TOKEN_LINE(token); 00589 SH_COL_NUM(curr_stmt_sh_idx) = TOKEN_COLUMN(token); 00590 00591 NTR_IR_TBL(ir_idx); 00592 IR_OPR(ir_idx) = operator; 00593 00594 /* must have a type idx */ 00595 00596 IR_TYPE_IDX(ir_idx) = TYPELESS_DEFAULT_TYPE; 00597 IR_LINE_NUM(ir_idx) = TOKEN_LINE(token); 00598 IR_COL_NUM(ir_idx) = TOKEN_COLUMN(token); 00599 00600 SH_IR_IDX(curr_stmt_sh_idx) = ir_idx; 00601 00602 TRACE (Func_Exit, "gen_directive_ir", NULL); 00603 00604 return(ir_idx); 00605 00606 } /* gen_directive_ir */ 00607 00608 00609 /******************************************************************************\ 00610 |* *| 00611 |* Description: *| 00612 |* This routine parses the CDIR$ COPY_ASSUMED_SHAPE line. *| 00613 |* *| 00614 |* Input parameters: *| 00615 |* NONE *| 00616 |* *| 00617 |* Output parameters: *| 00618 |* NONE *| 00619 |* *| 00620 |* Returns: *| 00621 |* NOTHING *| 00622 |* *| 00623 \******************************************************************************/ 00624 00625 static void parse_copy_assumed_shape_dir(void) 00626 00627 { 00628 int attr_idx; 00629 int head_list_idx = NULL_IDX; 00630 int list_idx; 00631 int name_idx; 00632 00633 00634 TRACE (Func_Entry, "parse_copy_assumed_shape_dir", NULL); 00635 00636 do { 00637 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 00638 attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token), 00639 &name_idx); 00640 00641 if (attr_idx == NULL_IDX) { 00642 attr_idx = ntr_sym_tbl(&token, name_idx); 00643 LN_DEF_LOC(name_idx) = TRUE; 00644 AT_OBJ_CLASS(attr_idx) = Data_Obj; 00645 SET_IMPL_TYPE(attr_idx); 00646 } 00647 else if (fnd_semantic_err(Obj_Copy_Assumed_Shape, 00648 TOKEN_LINE(token), 00649 TOKEN_COLUMN(token), 00650 attr_idx, 00651 TRUE)) { 00652 goto NEXT; 00653 } 00654 00655 if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) { 00656 AT_ATTR_LINK(attr_idx) = NULL_IDX; 00657 LN_DEF_LOC(name_idx) = TRUE; 00658 } 00659 00660 ATD_COPY_ASSUMED_SHAPE(attr_idx) = TRUE; 00661 00662 if (head_list_idx == NULL_IDX) { 00663 00664 /* place on the head list on scope */ 00665 00666 NTR_IR_LIST_TBL(head_list_idx); 00667 00668 IL_NEXT_LIST_IDX(head_list_idx)=SCP_COPY_ASSUMED_LIST(curr_scp_idx); 00669 00670 if (IL_NEXT_LIST_IDX(head_list_idx) != NULL_IDX) { 00671 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(head_list_idx))=head_list_idx; 00672 } 00673 00674 SCP_COPY_ASSUMED_LIST(curr_scp_idx) = head_list_idx; 00675 00676 IL_FLD(head_list_idx) = IL_Tbl_Idx; 00677 IL_LIST_CNT(head_list_idx) = 0; 00678 } 00679 00680 NTR_IR_LIST_TBL(list_idx); 00681 IL_NEXT_LIST_IDX(list_idx) = IL_IDX(head_list_idx); 00682 00683 if (IL_NEXT_LIST_IDX(list_idx) != NULL_IDX) { 00684 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 00685 } 00686 00687 IL_LIST_CNT(head_list_idx)++; 00688 IL_IDX(head_list_idx) = list_idx; 00689 IL_FLD(list_idx) = AT_Tbl_Idx; 00690 IL_IDX(list_idx) = attr_idx; 00691 IL_LINE_NUM(list_idx) = TOKEN_LINE(token); 00692 IL_COL_NUM(list_idx) = TOKEN_COLUMN(token); 00693 } 00694 else if (!parse_err_flush(Find_Comma, "variable name")) { 00695 break; /* Couldn't recover. Hit EOS */ 00696 } 00697 00698 NEXT: 00699 00700 if (LA_CH_VALUE == COMMA) { 00701 NEXT_LA_CH; 00702 } 00703 else if (LA_CH_VALUE == EOS || 00704 !parse_err_flush(Find_Comma, ", or "EOS_STR)) { 00705 break; 00706 } 00707 else { /* Issued error and recovered at a comma */ 00708 NEXT_LA_CH; 00709 } 00710 } 00711 while (TRUE); 00712 00713 NEXT_LA_CH; /* Pick up EOS */ 00714 00715 TRACE (Func_Exit, "parse_copy_assumed_shape_dir", NULL); 00716 00717 return; 00718 00719 } /* parse_copy_assumed_shape_dir */ 00720 00721 /******************************************************************************\ 00722 |* *| 00723 |* Description: *| 00724 |* This routine parses the !DIR$ IGNORE_TKR directive. *| 00725 |* *| 00726 |* Input parameters: *| 00727 |* NONE *| 00728 |* *| 00729 |* Output parameters: *| 00730 |* NONE *| 00731 |* *| 00732 |* Returns: *| 00733 |* NOTHING *| 00734 |* *| 00735 \******************************************************************************/ 00736 00737 static void parse_ignore_tkr(void) 00738 00739 { 00740 int attr_idx; 00741 int name_idx; 00742 00743 00744 TRACE (Func_Entry, "parse_ignore_tkr", NULL); 00745 00746 do { 00747 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 00748 attr_idx = srch_sym_tbl(TOKEN_STR(token), 00749 TOKEN_LEN(token), 00750 &name_idx); 00751 00752 if (attr_idx == NULL_IDX) { 00753 attr_idx = ntr_sym_tbl(&token, name_idx); 00754 LN_DEF_LOC(name_idx) = TRUE; 00755 AT_OBJ_CLASS(attr_idx) = Data_Obj; 00756 ATD_CLASS(attr_idx) = Dummy_Argument; 00757 ATD_IGNORE_TKR(attr_idx) = TRUE; 00758 SET_IMPL_TYPE(attr_idx); 00759 } 00760 else if (!fnd_semantic_err(Obj_Ignore_TKR, 00761 TOKEN_LINE(token), 00762 TOKEN_COLUMN(token), 00763 attr_idx, 00764 TRUE)) { 00765 00766 if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) { 00767 AT_ATTR_LINK(attr_idx) = NULL_IDX; 00768 LN_DEF_LOC(name_idx) = TRUE; 00769 } 00770 00771 ATD_CLASS(attr_idx) = Dummy_Argument; 00772 ATD_IGNORE_TKR(attr_idx) = TRUE; 00773 } 00774 } 00775 else if (!parse_err_flush(Find_Comma, "dummy-argument name")) { 00776 break; /* Couldn't recover. Hit EOS */ 00777 } 00778 00779 if (LA_CH_VALUE == COMMA) { 00780 NEXT_LA_CH; 00781 } 00782 else if (LA_CH_VALUE == EOS || 00783 !parse_err_flush(Find_Comma, ", or "EOS_STR)) { 00784 break; 00785 } 00786 else { /* Issued error and recovered at a comma */ 00787 NEXT_LA_CH; 00788 } 00789 } 00790 while (TRUE); 00791 00792 NEXT_LA_CH; /* Pick up EOS */ 00793 00794 TRACE (Func_Exit, "parse_ignore_tkr", NULL); 00795 00796 return; 00797 00798 } /* parse_ignore_tkr */ 00799 00800 /******************************************************************************\ 00801 |* *| 00802 |* Description: *| 00803 |* This routine parses the CDIR$ AUXILIARY line. *| 00804 |* *| 00805 |* Input parameters: *| 00806 |* NONE *| 00807 |* *| 00808 |* Output parameters: *| 00809 |* NONE *| 00810 |* *| 00811 |* Returns: *| 00812 |* NOTHING *| 00813 |* *| 00814 \******************************************************************************/ 00815 00816 static void parse_auxiliary_dir(void) 00817 00818 { 00819 int attr_idx; 00820 int name_idx; 00821 int sb_idx; 00822 00823 00824 TRACE (Func_Entry, "parse_auxiliary_dir", NULL); 00825 00826 do { 00827 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 00828 attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token), 00829 &name_idx); 00830 00831 if (attr_idx == NULL_IDX) { 00832 attr_idx = ntr_sym_tbl(&token, name_idx); 00833 LN_DEF_LOC(name_idx) = TRUE; 00834 ATD_AUXILIARY(attr_idx) = TRUE; 00835 SET_IMPL_TYPE(attr_idx); 00836 } 00837 else if (!fnd_semantic_err(Obj_Auxiliary, 00838 TOKEN_LINE(token), 00839 TOKEN_COLUMN(token), 00840 attr_idx, 00841 TRUE)) { 00842 00843 if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) { 00844 AT_ATTR_LINK(attr_idx) = NULL_IDX; 00845 LN_DEF_LOC(name_idx) = TRUE; 00846 } 00847 00848 ATD_AUXILIARY(attr_idx) = TRUE; 00849 00850 if (ATD_IN_COMMON(attr_idx)) { 00851 sb_idx = ATD_STOR_BLK_IDX(attr_idx); 00852 00853 if (SB_BLANK_COMMON(sb_idx)) { 00854 PRINTMSG(TOKEN_LINE(token), 534, Error, 00855 TOKEN_COLUMN(token), 00856 AT_OBJ_NAME_PTR(attr_idx)); 00857 } 00858 else if (SB_BLK_TYPE(sb_idx) == Task_Common) { 00859 PRINTMSG(TOKEN_LINE(token), 537, Error, 00860 TOKEN_COLUMN(token), 00861 AT_OBJ_NAME_PTR(attr_idx), 00862 SB_NAME_PTR(sb_idx)); 00863 } 00864 else { 00865 SB_AUXILIARY(sb_idx) = TRUE; 00866 } 00867 } 00868 } 00869 } 00870 else if (!parse_err_flush(Find_Comma, "variable name")) { 00871 break; /* Couldn't recover. Hit EOS */ 00872 } 00873 00874 if (LA_CH_VALUE == COMMA) { 00875 NEXT_LA_CH; 00876 } 00877 else if (LA_CH_VALUE == EOS || 00878 !parse_err_flush(Find_Comma, ", or "EOS_STR)) { 00879 break; 00880 } 00881 else { /* Issued error and recovered at a comma */ 00882 NEXT_LA_CH; 00883 } 00884 } 00885 while (TRUE); 00886 00887 NEXT_LA_CH; /* Pick up EOS */ 00888 00889 TRACE (Func_Exit, "parse_auxiliary_dir", NULL); 00890 00891 return; 00892 00893 } /* parse_auxiliary_dir */ 00894 00895 /******************************************************************************\ 00896 |* *| 00897 |* Description: *| 00898 |* This routine parses the CDIR$ CACHE_BYPASS line. *| 00899 |* *| 00900 |* Input parameters: *| 00901 |* NONE *| 00902 |* *| 00903 |* Output parameters: *| 00904 |* NONE *| 00905 |* *| 00906 |* Returns: *| 00907 |* NOTHING *| 00908 |* *| 00909 \******************************************************************************/ 00910 static void parse_cache_bypass_dir(opnd_type *opnd) 00911 00912 { 00913 int column; 00914 int line; 00915 int list_idx = NULL_IDX; 00916 opnd_type opnd2; 00917 00918 00919 TRACE (Func_Entry, "parse_cache_bypass_dir", NULL); 00920 00921 do { 00922 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 00923 00924 if (!parse_deref(&opnd2, NULL_IDX)) { 00925 parse_err_flush(Find_Comma, NULL); 00926 } 00927 else { 00928 find_opnd_line_and_column(&opnd2, &line, &column); 00929 00930 if (OPND_FLD(opnd2) != AT_Tbl_Idx) { 00931 PRINTMSG(line, 1319, Error, column); 00932 } 00933 else { 00934 00935 if (list_idx == NULL_IDX) { 00936 NTR_IR_LIST_TBL(list_idx); 00937 COPY_OPND(IL_OPND(list_idx), opnd2); 00938 OPND_FLD((*opnd)) = IL_Tbl_Idx; 00939 OPND_IDX((*opnd)) = list_idx; 00940 OPND_LIST_CNT((*opnd)) = 1; 00941 } 00942 else { 00943 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 00944 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 00945 (OPND_LIST_CNT((*opnd)))++; 00946 list_idx = IL_NEXT_LIST_IDX(list_idx); 00947 COPY_OPND(IL_OPND(list_idx), opnd2); 00948 } 00949 } 00950 } 00951 } 00952 else if (!parse_err_flush(Find_Comma, "array name")) { 00953 break; /* Couldn't recover. Hit EOS */ 00954 } 00955 00956 if (LA_CH_VALUE == COMMA) { 00957 NEXT_LA_CH; 00958 } 00959 else if (LA_CH_VALUE == EOS || 00960 !parse_err_flush(Find_Comma, ", or "EOS_STR)) { 00961 break; 00962 } 00963 else { /* Issued error and recovered at a comma */ 00964 NEXT_LA_CH; 00965 } 00966 } 00967 while (TRUE); 00968 00969 NEXT_LA_CH; /* Pick up EOS */ 00970 00971 TRACE (Func_Exit, "parse_cache_bypass_dir", NULL); 00972 00973 return; 00974 00975 } /* parse_cache_bypass_dir */ 00976 00977 /******************************************************************************\ 00978 |* *| 00979 |* Description: *| 00980 |* This routine parses the CDIR$ NO SIDE EFFECTS line. *| 00981 |* *| 00982 |* Input parameters: *| 00983 |* NONE *| 00984 |* *| 00985 |* Output parameters: *| 00986 |* NONE *| 00987 |* *| 00988 |* Returns: *| 00989 |* NOTHING *| 00990 |* *| 00991 \******************************************************************************/ 00992 static void parse_nosideeffects_dir(void) 00993 00994 { 00995 int attr_idx; 00996 int name_idx; 00997 00998 00999 TRACE (Func_Entry, "parse_nosideeffects_dir", NULL); 01000 01001 do { 01002 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 01003 attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token), 01004 &name_idx); 01005 01006 if (attr_idx == NULL_IDX) { 01007 attr_idx = ntr_sym_tbl(&token, name_idx); 01008 LN_DEF_LOC(name_idx) = TRUE; 01009 AT_OBJ_CLASS(attr_idx) = Pgm_Unit; 01010 ATP_NOSIDE_EFFECTS(attr_idx)= TRUE; 01011 MAKE_EXTERNAL_NAME(attr_idx, 01012 AT_NAME_IDX(attr_idx), 01013 AT_NAME_LEN(attr_idx)); 01014 ATP_PROC(attr_idx) = Extern_Proc; 01015 ATP_SCP_IDX(attr_idx) = curr_scp_idx; 01016 } 01017 else if (!fnd_semantic_err(Obj_No_Side_Effects, 01018 TOKEN_LINE(token), 01019 TOKEN_COLUMN(token), 01020 attr_idx, 01021 TRUE)) { 01022 01023 if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) { 01024 AT_ATTR_LINK(attr_idx) = NULL_IDX; 01025 LN_DEF_LOC(name_idx) = TRUE; 01026 } 01027 01028 if (AT_OBJ_CLASS(attr_idx) == Data_Obj) { 01029 01030 if (ATD_CLASS(attr_idx) == Function_Result) { 01031 attr_idx = ATD_FUNC_IDX(attr_idx); 01032 } 01033 else { 01034 chg_data_obj_to_pgm_unit(attr_idx, 01035 Pgm_Unknown, 01036 Extern_Proc); 01037 } 01038 } 01039 ATP_NOSIDE_EFFECTS(attr_idx)= TRUE; 01040 } 01041 } 01042 else if (!parse_err_flush(Find_Comma, "procedure name")) { 01043 break; /* Couldn't recover. Hit EOS */ 01044 } 01045 01046 if (LA_CH_VALUE == COMMA) { 01047 NEXT_LA_CH; 01048 } 01049 else if (LA_CH_VALUE == EOS || 01050 !parse_err_flush(Find_Comma, ", or "EOS_STR)) { 01051 break; 01052 } 01053 else { /* Issued error and recovered at a comma */ 01054 NEXT_LA_CH; 01055 } 01056 } 01057 while (TRUE); 01058 01059 NEXT_LA_CH; /* Pick up EOS */ 01060 01061 TRACE (Func_Exit, "parse_nosideeffects_dir", NULL); 01062 01063 return; 01064 01065 } /* parse_nosideeffects_dir */ 01066 01067 /******************************************************************************\ 01068 |* *| 01069 |* Description: *| 01070 |* This routine parses the CDIR$ VFUNCTION line. *| 01071 |* *| 01072 |* Input parameters: *| 01073 |* NONE *| 01074 |* *| 01075 |* Output parameters: *| 01076 |* NONE *| 01077 |* *| 01078 |* Returns: *| 01079 |* NOTHING *| 01080 |* *| 01081 \******************************************************************************/ 01082 static void parse_vfunction_dir(void) 01083 01084 { 01085 int attr_idx; 01086 int name_idx; 01087 int rslt_idx; 01088 01089 01090 TRACE (Func_Entry, "parse_vfunction_dir", NULL); 01091 01092 /* In cft77, vfunction acts just like it was an EXTERNAL statement. */ 01093 /* This implementation does the same thing. Vfunctions may not be */ 01094 /* specified for internal or module procedures. */ 01095 01096 do { 01097 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 01098 attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token), 01099 &name_idx); 01100 01101 if (attr_idx == NULL_IDX) { 01102 attr_idx = ntr_sym_tbl(&token, name_idx); 01103 LN_DEF_LOC(name_idx) = TRUE; 01104 AT_OBJ_CLASS(attr_idx) = Pgm_Unit; 01105 ATP_NOSIDE_EFFECTS(attr_idx)= TRUE; 01106 MAKE_EXTERNAL_NAME(attr_idx, 01107 AT_NAME_IDX(attr_idx), 01108 AT_NAME_LEN(attr_idx)); 01109 ATP_PROC(attr_idx) = Extern_Proc; 01110 ATP_PGM_UNIT(attr_idx) = Function; 01111 ATP_VFUNCTION(attr_idx) = TRUE; 01112 ATP_SCP_IDX(attr_idx) = curr_scp_idx; 01113 01114 CREATE_FUNC_RSLT(attr_idx, rslt_idx); 01115 SET_IMPL_TYPE(rslt_idx); 01116 } 01117 else if (!fnd_semantic_err(Obj_Vfunction, 01118 TOKEN_LINE(token), 01119 TOKEN_COLUMN(token), 01120 attr_idx, 01121 TRUE)) { 01122 01123 if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) { 01124 AT_ATTR_LINK(attr_idx) = NULL_IDX; 01125 LN_DEF_LOC(name_idx) = TRUE; 01126 } 01127 01128 if (AT_OBJ_CLASS(attr_idx) == Data_Obj) { /* Switch to Function*/ 01129 chg_data_obj_to_pgm_unit(attr_idx, 01130 Function, 01131 Extern_Proc); 01132 ATP_PGM_UNIT(attr_idx) = Function; 01133 ATP_VFUNCTION(attr_idx) = TRUE; 01134 } 01135 else if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit) { 01136 01137 if (ATP_PGM_UNIT(attr_idx) != Function) { 01138 ATP_PGM_UNIT(attr_idx) = Function; 01139 CREATE_FUNC_RSLT(attr_idx, rslt_idx); 01140 SET_IMPL_TYPE(rslt_idx); 01141 } 01142 ATP_PROC(attr_idx) = Extern_Proc; 01143 ATP_VFUNCTION(attr_idx) = TRUE; 01144 } 01145 } 01146 } 01147 else if (!parse_err_flush(Find_Comma, "procedure name")) { 01148 break; /* Couldn't recover. Hit EOS */ 01149 } 01150 01151 if (LA_CH_VALUE == COMMA) { 01152 NEXT_LA_CH; 01153 } 01154 else if (LA_CH_VALUE == EOS || 01155 !parse_err_flush(Find_Comma, ", or "EOS_STR)) { 01156 break; 01157 } 01158 else { /* Issued error and recovered at a comma */ 01159 NEXT_LA_CH; 01160 } 01161 } 01162 while (TRUE); 01163 01164 NEXT_LA_CH; /* Pick up EOS */ 01165 01166 TRACE (Func_Exit, "parse_vfunction_dir", NULL); 01167 01168 return; 01169 01170 } /* parse_vfunction_dir */ 01171 01172 /******************************************************************************\ 01173 |* *| 01174 |* Description: *| 01175 |* This routine parses !DIR$ TASKCOMMON, !DIR$ COMMON and *| 01176 |* !$OMP THREADPRIVATE *| 01177 |* *| 01178 |* Input parameters: *| 01179 |* Common means this is specified with the common directive. *| 01180 |* Task_Common means this is specified with the task common directive. *| 01181 |* *| 01182 |* Output parameters: *| 01183 |* NONE *| 01184 |* *| 01185 |* Returns: *| 01186 |* NOTHING *| 01187 |* *| 01188 \******************************************************************************/ 01189 static void parse_common_dirs(sb_type_type blk_type) 01190 01191 { 01192 int new_sb_idx; 01193 int sb_idx; 01194 01195 01196 TRACE (Func_Entry, "parse_common_dirs", NULL); 01197 01198 do { 01199 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 01200 sb_idx = srch_stor_blk_tbl(TOKEN_STR(token), 01201 TOKEN_LEN(token), 01202 curr_scp_idx); 01203 01204 if (sb_idx == NULL_IDX) { 01205 sb_idx = ntr_stor_blk_tbl(TOKEN_STR(token), 01206 TOKEN_LEN(token), 01207 TOKEN_LINE(token), 01208 TOKEN_COLUMN(token), 01209 blk_type); 01210 01211 SB_COMMON_NEEDS_OFFSET(sb_idx) = TRUE; 01212 } 01213 else if (SB_BLK_TYPE(sb_idx) == Threadprivate) { 01214 PRINTMSG(TOKEN_LINE(token), 1486, Error, TOKEN_COLUMN(token), 01215 SB_NAME_PTR(sb_idx)); 01216 } 01217 else if (SB_USE_ASSOCIATED(sb_idx) || SB_HOST_ASSOCIATED(sb_idx)) { 01218 01219 /* Common block has been use or host associated into this scope. */ 01220 /* Make an entry for this block and hide the associated block */ 01221 /* storage_blk_resolution will resolve the blocks. */ 01222 01223 new_sb_idx = ntr_stor_blk_tbl(TOKEN_STR(token), 01224 TOKEN_LEN(token), 01225 TOKEN_LINE(token), 01226 TOKEN_COLUMN(token), 01227 blk_type); 01228 01229 SB_COMMON_NEEDS_OFFSET(new_sb_idx) = TRUE; 01230 SB_MERGED_BLK_IDX(sb_idx) = new_sb_idx; 01231 SB_HIDDEN(sb_idx) = TRUE; 01232 SB_DEF_MULT_SCPS(sb_idx) = TRUE; 01233 sb_idx = new_sb_idx; 01234 } 01235 else { 01236 SB_BLK_TYPE(sb_idx) = blk_type; 01237 SB_RUNTIME_INIT(stor_blk_tbl_idx) = FALSE; 01238 } 01239 01240 /* Else block has been declared already. Mark block type */ 01241 01242 SB_IS_COMMON(sb_idx) = TRUE; 01243 01244 if (blk_type == Common) { 01245 SB_DCL_COMMON_DIR(sb_idx) = TRUE; 01246 } 01247 } 01248 else if (LA_CH_VALUE == SLASH) { 01249 NEXT_LA_CH; 01250 01251 if (LA_CH_VALUE == SLASH) { 01252 PRINTMSG(TOKEN_LINE(token), 1481, Error, TOKEN_COLUMN(token), 01253 TOKEN_STR(token), blk_type == Common ? "COMMON" : 01254 "TASK COMMON"); 01255 NEXT_LA_CH; 01256 } 01257 else { 01258 parse_err_flush(Find_Comma, "common block name"); 01259 } 01260 } 01261 else if (!parse_err_flush(Find_Comma, "common block name")) { 01262 break; /* Couldn't recover. Hit EOS */ 01263 } 01264 01265 if (LA_CH_VALUE == COMMA) { 01266 NEXT_LA_CH; 01267 } 01268 else if (LA_CH_VALUE == EOS || 01269 !parse_err_flush(Find_Comma, ", or "EOS_STR)) { 01270 break; 01271 } 01272 else { /* Issued error and recovered at a comma */ 01273 NEXT_LA_CH; 01274 } 01275 } 01276 while (TRUE); 01277 01278 NEXT_LA_CH; /* Pick up EOS */ 01279 01280 TRACE (Func_Exit, "parse_common_dirs", NULL); 01281 01282 return; 01283 01284 } /* parse_common_dirs */ 01285 01286 /******************************************************************************\ 01287 |* *| 01288 |* Description: *| 01289 |* This routine parses !$OMP THREADPRIVATE *| 01290 |* *| 01291 |* Input parameters: *| 01292 |* NONE *| 01293 |* *| 01294 |* Output parameters: *| 01295 |* NONE *| 01296 |* *| 01297 |* Returns: *| 01298 |* NOTHING *| 01299 |* *| 01300 \******************************************************************************/ 01301 static void parse_slash_common_dirs(void) 01302 01303 { 01304 int sb_idx; 01305 01306 01307 TRACE (Func_Entry, "parse_slash_common_dirs", NULL); 01308 01309 if (LA_CH_VALUE != LPAREN) { 01310 parse_err_flush(Find_EOS, "(/common-block-name/)"); 01311 return; 01312 } 01313 01314 NEXT_LA_CH; /* eat ( */ 01315 01316 do { 01317 01318 if (LA_CH_VALUE == SLASH) { /* must be common block */ 01319 NEXT_LA_CH; /* eat slash */ 01320 01321 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 01322 sb_idx = srch_stor_blk_tbl(TOKEN_STR(token), 01323 TOKEN_LEN(token), 01324 curr_scp_idx); 01325 01326 if (sb_idx == NULL_IDX) { 01327 sb_idx = ntr_stor_blk_tbl(TOKEN_STR(token), 01328 TOKEN_LEN(token), 01329 TOKEN_LINE(token), 01330 TOKEN_COLUMN(token), 01331 Threadprivate); 01332 01333 SB_COMMON_NEEDS_OFFSET(sb_idx) = TRUE; 01334 # if 0 01335 /* This is allowed now, but I'll leave the message in, */ 01336 /* just in case. BHJ */ 01337 01338 SB_DCL_ERR(sb_idx) = TRUE; 01339 01340 /* Must be specified in a common block before THREAD PRIVATE */ 01341 01342 PRINTMSG(TOKEN_LINE(token), 1479, Error, TOKEN_COLUMN(token), 01343 TOKEN_STR(token)); 01344 # endif 01345 } 01346 else if (SB_USE_ASSOCIATED(sb_idx)) { 01347 01348 if (SB_BLK_TYPE(sb_idx) != Threadprivate) { 01349 PRINTMSG(TOKEN_LINE(token), 1485, Error, TOKEN_COLUMN(token), 01350 SB_NAME_PTR(sb_idx)); 01351 } 01352 } 01353 else if (SB_HOST_ASSOCIATED(sb_idx)) { 01354 PRINTMSG(TOKEN_LINE(token), 1485, Error, TOKEN_COLUMN(token), 01355 SB_NAME_PTR(sb_idx)); 01356 } 01357 01358 if (SB_BLK_TYPE(sb_idx) != Common && 01359 SB_BLK_TYPE(sb_idx) != Threadprivate) { 01360 01361 /* Must be a common block - not taskcommon or auxiliary */ 01362 01363 PRINTMSG(TOKEN_LINE(token), 1486, Error, TOKEN_COLUMN(token), 01364 SB_NAME_PTR(sb_idx)); 01365 } 01366 else { /* Else block has been declared already. Mark block type */ 01367 SB_BLK_TYPE(sb_idx) = Threadprivate; 01368 SB_RUNTIME_INIT(sb_idx) = FALSE; 01369 SB_IS_COMMON(sb_idx) = TRUE; 01370 } 01371 01372 if (LA_CH_VALUE == SLASH) { 01373 NEXT_LA_CH; /* eat slash */ 01374 } 01375 else if (!parse_err_flush(Find_Comma_Slash, "/")) { 01376 break; 01377 } 01378 else if (LA_CH_VALUE == SLASH) { 01379 NEXT_LA_CH; 01380 } 01381 } 01382 else if (LA_CH_VALUE == SLASH) { 01383 NEXT_LA_CH; 01384 PRINTMSG(TOKEN_LINE(token), 1481, Error, TOKEN_COLUMN(token), 01385 TOKEN_STR(token), "THREADPRIVATE"); 01386 } 01387 else if (!parse_err_flush(Find_Comma_Rparen, "common-block-name")) { 01388 break; 01389 } 01390 } 01391 else if (!parse_err_flush(Find_Comma_Rparen, "/common-block-name/")) { 01392 break; 01393 } 01394 01395 if (LA_CH_VALUE == COMMA) { 01396 NEXT_LA_CH; 01397 } 01398 else { 01399 break; 01400 } 01401 } 01402 while (TRUE); 01403 01404 if (LA_CH_VALUE == RPAREN || parse_err_flush(Find_Rparen, ", or )")) { 01405 NEXT_LA_CH; 01406 } 01407 01408 if (LA_CH_VALUE != EOS) { 01409 parse_err_flush(Find_EOS, EOS_STR); 01410 } 01411 01412 TRACE (Func_Exit, "parse_slash_common_dirs", NULL); 01413 01414 return; 01415 01416 } /* parse_slash_common_dirs */ 01417 01418 /******************************************************************************\ 01419 |* *| 01420 |* Description: *| 01421 |* Parse the list following a suppress dir, if there is one. *| 01422 |* *| 01423 |* Input parameters: *| 01424 |* NONE *| 01425 |* *| 01426 |* Output parameters: *| 01427 |* NONE *| 01428 |* *| 01429 |* Returns: *| 01430 |* NOTHING *| 01431 |* *| 01432 \******************************************************************************/ 01433 01434 static void parse_dir_var_list(void) 01435 01436 { 01437 int ir_idx; 01438 int list_idx = NULL_IDX; 01439 opnd_type opnd; 01440 01441 01442 TRACE (Func_Entry, "parse_dir_var_list", NULL); 01443 01444 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 01445 01446 do { 01447 01448 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 01449 01450 if (! parse_deref(&opnd, NULL_IDX)) { 01451 parse_err_flush(Find_Comma, NULL); 01452 } 01453 else { 01454 01455 if (list_idx) { 01456 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 01457 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 01458 list_idx = IL_NEXT_LIST_IDX(list_idx); 01459 IR_LIST_CNT_L(ir_idx)++; 01460 } 01461 else { 01462 NTR_IR_LIST_TBL(list_idx); 01463 IR_IDX_L(ir_idx) = list_idx; 01464 IR_FLD_L(ir_idx) = IL_Tbl_Idx; 01465 IR_LIST_CNT_L(ir_idx) = 1; 01466 } 01467 01468 COPY_OPND(IL_OPND(list_idx), opnd); 01469 } 01470 } 01471 else if (!parse_err_flush(Find_Comma, "variable name")) { 01472 break; 01473 } 01474 01475 if (LA_CH_VALUE == COMMA) { 01476 NEXT_LA_CH; 01477 } 01478 else if (LA_CH_VALUE == EOS || 01479 !parse_err_flush(Find_Comma, ", or "EOS_STR)) { 01480 break; 01481 } 01482 else { /* Issued error and recovered at a comma */ 01483 NEXT_LA_CH; 01484 } 01485 } 01486 while (TRUE); 01487 01488 NEXT_LA_CH; /* Pick up EOS */ 01489 01490 TRACE (Func_Exit, "parse_dir_var_list", NULL); 01491 01492 return; 01493 01494 } /* parse_dir_var_list */ 01495 01496 /******************************************************************************\ 01497 |* *| 01498 |* Description: *| 01499 |* This routine parses the do all cmic. The ir it produces looks like .. *| 01500 |* *| 01501 |* (Doall_Cmic_Opr) *| 01502 |* / *| 01503 |* |- IF condition *| 01504 |* |- SHARED var list *| 01505 |* |- PRIVATE var list *| 01506 |* |- GETFIRST var list *| 01507 |* |- const one if AUTOSCOPE *| 01508 |* |- CONTROL var list *| 01509 |* |- const one if SAVELAST *| 01510 |* |- MAXCPUS value *| 01511 |* |- WORK DISTRIBUTION value (in const table) *| 01512 |* |- expression for work distribution *| 01513 |* *| 01514 |* Input parameters: *| 01515 |* NONE *| 01516 |* *| 01517 |* Output parameters: *| 01518 |* NONE *| 01519 |* *| 01520 |* Returns: *| 01521 |* NOTHING *| 01522 |* *| 01523 \******************************************************************************/ 01524 01525 static void parse_doall_cmic(void) 01526 01527 { 01528 int i; 01529 int ir_idx; 01530 int list_array[10]; 01531 int list_idx; 01532 opnd_type opnd; 01533 01534 01535 TRACE (Func_Entry, "parse_doall_cmic", NULL); 01536 01537 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 01538 01539 for (i = 0; i < 10; i++) { 01540 NTR_IR_LIST_TBL(list_array[i]); 01541 if (i >= 1) { 01542 IL_NEXT_LIST_IDX(list_array[i - 1]) = list_array[i]; 01543 IL_PREV_LIST_IDX(list_array[i]) = list_array[i - 1]; 01544 } 01545 } 01546 01547 IR_FLD_L(ir_idx) = IL_Tbl_Idx; 01548 IR_IDX_L(ir_idx) = list_array[0]; 01549 IR_LIST_CNT_L(ir_idx) = 10; 01550 01551 while (LA_CH_VALUE != EOS) { 01552 01553 if (MATCHED_TOKEN_CLASS(Tok_Class_Dir_Kwd)) { 01554 01555 switch (TOKEN_VALUE(token)) { 01556 01557 case Tok_Dir_If: 01558 01559 if (LA_CH_VALUE == LPAREN) { 01560 01561 if (IL_IDX(list_array[0]) != NULL_IDX) { 01562 PRINTMSG(LA_CH_LINE, 680, Error, LA_CH_COLUMN, 01563 "DOALL"); 01564 parse_err_flush(Find_EOS, NULL); 01565 goto EXIT; 01566 } 01567 01568 NEXT_LA_CH; 01569 parse_expr(&opnd); 01570 01571 COPY_OPND(IL_OPND(list_array[0]), opnd); 01572 01573 if (LA_CH_VALUE == RPAREN) { 01574 NEXT_LA_CH; 01575 } 01576 else { 01577 parse_err_flush(Find_EOS, ")"); 01578 goto EXIT; 01579 } 01580 } 01581 else { 01582 parse_err_flush(Find_EOS, "("); 01583 goto EXIT; 01584 } 01585 break; 01586 01587 case Tok_Dir_Shared: 01588 01589 if (LA_CH_VALUE == LPAREN) { 01590 NEXT_LA_CH; 01591 parse_var_name_list(&opnd, -1); 01592 01593 if (IL_IDX(list_array[1]) == NULL_IDX) { 01594 COPY_OPND(IL_OPND(list_array[1]), opnd); 01595 } 01596 else { 01597 /* find the end of list */ 01598 01599 list_idx = IL_IDX(list_array[1]); 01600 while (IL_NEXT_LIST_IDX(list_idx)) { 01601 list_idx = IL_NEXT_LIST_IDX(list_idx); 01602 } 01603 01604 /* append the new list */ 01605 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 01606 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 01607 IL_LIST_CNT(list_array[1]) += OPND_LIST_CNT(opnd); 01608 } 01609 01610 if (LA_CH_VALUE == RPAREN) { 01611 NEXT_LA_CH; 01612 } 01613 else { 01614 parse_err_flush(Find_EOS, ")"); 01615 goto EXIT; 01616 } 01617 } 01618 else { 01619 parse_err_flush(Find_EOS, "("); 01620 goto EXIT; 01621 } 01622 01623 break; 01624 01625 case Tok_Dir_Private: 01626 01627 if (LA_CH_VALUE == LPAREN) { 01628 NEXT_LA_CH; 01629 parse_var_name_list(&opnd, -1); 01630 01631 if (IL_IDX(list_array[2]) == NULL_IDX) { 01632 COPY_OPND(IL_OPND(list_array[2]), opnd); 01633 } 01634 else { 01635 /* find the end of list */ 01636 01637 list_idx = IL_IDX(list_array[2]); 01638 while (IL_NEXT_LIST_IDX(list_idx)) { 01639 list_idx = IL_NEXT_LIST_IDX(list_idx); 01640 } 01641 01642 /* append the new list */ 01643 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 01644 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 01645 IL_LIST_CNT(list_array[2]) += OPND_LIST_CNT(opnd); 01646 } 01647 01648 if (LA_CH_VALUE == RPAREN) { 01649 NEXT_LA_CH; 01650 } 01651 else { 01652 parse_err_flush(Find_EOS, ")"); 01653 goto EXIT; 01654 } 01655 } 01656 else { 01657 parse_err_flush(Find_EOS, "("); 01658 goto EXIT; 01659 } 01660 01661 break; 01662 01663 case Tok_Dir_Getfirst: 01664 01665 if (LA_CH_VALUE == LPAREN) { 01666 NEXT_LA_CH; 01667 parse_var_name_list(&opnd, -1); 01668 01669 if (IL_IDX(list_array[3]) == NULL_IDX) { 01670 COPY_OPND(IL_OPND(list_array[3]), opnd); 01671 } 01672 else { 01673 /* find the end of list */ 01674 01675 list_idx = IL_IDX(list_array[3]); 01676 while (IL_NEXT_LIST_IDX(list_idx)) { 01677 list_idx = IL_NEXT_LIST_IDX(list_idx); 01678 } 01679 01680 /* append the new list */ 01681 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 01682 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 01683 IL_LIST_CNT(list_array[3]) += OPND_LIST_CNT(opnd); 01684 } 01685 01686 if (LA_CH_VALUE == RPAREN) { 01687 NEXT_LA_CH; 01688 } 01689 else { 01690 parse_err_flush(Find_EOS, ")"); 01691 goto EXIT; 01692 } 01693 } 01694 else { 01695 parse_err_flush(Find_EOS, "("); 01696 goto EXIT; 01697 } 01698 01699 break; 01700 01701 case Tok_Dir_Autoscope: 01702 01703 # if defined(GENERATE_WHIRL) 01704 PRINTMSG(TOKEN_LINE(token), 1415, Error, TOKEN_COLUMN(token)); 01705 # else 01706 IL_FLD(list_array[4]) = CN_Tbl_Idx; 01707 IL_IDX(list_array[4]) = CN_INTEGER_ONE_IDX; 01708 IL_LINE_NUM(list_array[4]) = TOKEN_LINE(token); 01709 IL_COL_NUM(list_array[4]) = TOKEN_COLUMN(token); 01710 # endif 01711 01712 break; 01713 01714 case Tok_Dir_Control: 01715 01716 if (LA_CH_VALUE == LPAREN) { 01717 NEXT_LA_CH; 01718 parse_var_name_list(&opnd, -1); 01719 01720 if (IL_IDX(list_array[5]) == NULL_IDX) { 01721 COPY_OPND(IL_OPND(list_array[5]), opnd); 01722 } 01723 else { 01724 /* find the end of list */ 01725 01726 list_idx = IL_IDX(list_array[5]); 01727 while (IL_NEXT_LIST_IDX(list_idx)) { 01728 list_idx = IL_NEXT_LIST_IDX(list_idx); 01729 } 01730 01731 /* append the new list */ 01732 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 01733 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 01734 IL_LIST_CNT(list_array[5]) += OPND_LIST_CNT(opnd); 01735 } 01736 01737 if (LA_CH_VALUE == RPAREN) { 01738 NEXT_LA_CH; 01739 } 01740 else { 01741 parse_err_flush(Find_EOS, ")"); 01742 goto EXIT; 01743 } 01744 } 01745 else { 01746 parse_err_flush(Find_EOS, "("); 01747 goto EXIT; 01748 } 01749 01750 break; 01751 01752 case Tok_Dir_Savelast: 01753 01754 IL_FLD(list_array[6]) = CN_Tbl_Idx; 01755 IL_IDX(list_array[6]) = CN_INTEGER_ONE_IDX; 01756 IL_LINE_NUM(list_array[6]) = TOKEN_LINE(token); 01757 IL_COL_NUM(list_array[6]) = TOKEN_COLUMN(token); 01758 01759 break; 01760 01761 case Tok_Dir_Maxcpus: 01762 01763 # if defined(GENERATE_WHIRL) 01764 PRINTMSG(TOKEN_LINE(token), 1436, Warning, 01765 TOKEN_COLUMN(token), "MAXCPUS"); 01766 01767 # endif 01768 if (LA_CH_VALUE == LPAREN) { 01769 NEXT_LA_CH; 01770 parse_expr(&opnd); 01771 COPY_OPND(IL_OPND(list_array[7]), opnd); 01772 01773 if (LA_CH_VALUE == RPAREN) { 01774 NEXT_LA_CH; 01775 } 01776 else { 01777 parse_err_flush(Find_EOS, ")"); 01778 goto EXIT; 01779 } 01780 } 01781 else { 01782 parse_err_flush(Find_EOS, "("); 01783 goto EXIT; 01784 } 01785 # if defined(GENERATE_WHIRL) 01786 IL_OPND(list_array[7]) = null_opnd; 01787 # endif 01788 break; 01789 01790 case Tok_Dir_Single: 01791 01792 if (IL_FLD(list_array[8]) != NO_Tbl_Idx) { 01793 PRINTMSG(TOKEN_LINE(token), 800, Error, TOKEN_COLUMN(token)); 01794 parse_err_flush(Find_EOS, NULL); 01795 goto EXIT; 01796 } 01797 01798 IL_FLD(list_array[8]) = CN_Tbl_Idx; 01799 IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 01800 CMIC_WORK_DIST_SINGLE); 01801 IL_LINE_NUM(list_array[8]) = TOKEN_LINE(token); 01802 IL_COL_NUM(list_array[8]) = TOKEN_COLUMN(token); 01803 01804 break; 01805 01806 case Tok_Dir_Chunksize: 01807 01808 if (IL_FLD(list_array[8]) != NO_Tbl_Idx) { 01809 PRINTMSG(TOKEN_LINE(token), 800, Error, TOKEN_COLUMN(token)); 01810 parse_err_flush(Find_EOS, NULL); 01811 goto EXIT; 01812 } 01813 01814 IL_FLD(list_array[8]) = CN_Tbl_Idx; 01815 IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 01816 CMIC_WORK_DIST_CHUNKSIZE); 01817 IL_LINE_NUM(list_array[8]) = TOKEN_LINE(token); 01818 IL_COL_NUM(list_array[8]) = TOKEN_COLUMN(token); 01819 01820 if (LA_CH_VALUE == LPAREN) { 01821 NEXT_LA_CH; 01822 01823 if (parse_expr(&opnd)) { 01824 COPY_OPND(IL_OPND(list_array[9]), opnd); 01825 } 01826 01827 if (LA_CH_VALUE == RPAREN) { 01828 NEXT_LA_CH; 01829 } 01830 else { 01831 parse_err_flush(Find_EOS, ")"); 01832 goto EXIT; 01833 } 01834 } 01835 else { 01836 parse_err_flush(Find_EOS, "("); 01837 goto EXIT; 01838 } 01839 01840 01841 break; 01842 01843 case Tok_Dir_Numchunks: 01844 01845 # if defined(GENERATE_WHIRL) 01846 PRINTMSG(TOKEN_LINE(token), 1436, Warning, 01847 TOKEN_COLUMN(token), "NUMCHUNKS"); 01848 # endif 01849 01850 01851 if (IL_FLD(list_array[8]) != NO_Tbl_Idx) { 01852 PRINTMSG(TOKEN_LINE(token), 800, Error, TOKEN_COLUMN(token)); 01853 parse_err_flush(Find_EOS, NULL); 01854 goto EXIT; 01855 } 01856 01857 IL_FLD(list_array[8]) = CN_Tbl_Idx; 01858 IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 01859 CMIC_WORK_DIST_NUMCHUNKS); 01860 IL_LINE_NUM(list_array[8]) = TOKEN_LINE(token); 01861 IL_COL_NUM(list_array[8]) = TOKEN_COLUMN(token); 01862 01863 if (LA_CH_VALUE == LPAREN) { 01864 NEXT_LA_CH; 01865 01866 if (parse_expr(&opnd)) { 01867 COPY_OPND(IL_OPND(list_array[9]), opnd); 01868 } 01869 01870 if (LA_CH_VALUE == RPAREN) { 01871 NEXT_LA_CH; 01872 } 01873 else { 01874 parse_err_flush(Find_EOS, ")"); 01875 goto EXIT; 01876 } 01877 } 01878 else { 01879 parse_err_flush(Find_EOS, "("); 01880 goto EXIT; 01881 } 01882 01883 # if defined(GENERATE_WHIRL) 01884 IL_OPND(list_array[8]) = null_opnd; 01885 # endif 01886 break; 01887 01888 case Tok_Dir_Guided: 01889 01890 if (IL_FLD(list_array[8]) != NO_Tbl_Idx) { 01891 PRINTMSG(TOKEN_LINE(token), 800, Error, TOKEN_COLUMN(token)); 01892 parse_err_flush(Find_EOS, NULL); 01893 goto EXIT; 01894 } 01895 01896 IL_FLD(list_array[8]) = CN_Tbl_Idx; 01897 IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 01898 CMIC_WORK_DIST_GUIDED); 01899 IL_LINE_NUM(list_array[8]) = TOKEN_LINE(token); 01900 IL_COL_NUM(list_array[8]) = TOKEN_COLUMN(token); 01901 01902 if (LA_CH_VALUE == '(') { 01903 01904 if (parse_expr(&opnd)) { 01905 COPY_OPND(IL_OPND(list_array[9]), opnd); 01906 } 01907 } 01908 else { 01909 IL_FLD(list_array[9]) = CN_Tbl_Idx; 01910 IL_IDX(list_array[9]) = const_safevl_idx; 01911 IL_LINE_NUM(list_array[9]) = TOKEN_LINE(token); 01912 IL_COL_NUM(list_array[9]) = TOKEN_COLUMN(token); 01913 } 01914 01915 break; 01916 01917 case Tok_Dir_Vector: 01918 01919 if (IL_FLD(list_array[8]) != NO_Tbl_Idx) { 01920 PRINTMSG(TOKEN_LINE(token), 800, Error, TOKEN_COLUMN(token)); 01921 parse_err_flush(Find_EOS, NULL); 01922 goto EXIT; 01923 } 01924 01925 IL_FLD(list_array[8]) = CN_Tbl_Idx; 01926 IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 01927 CMIC_WORK_DIST_VECTOR); 01928 IL_LINE_NUM(list_array[8]) = TOKEN_LINE(token); 01929 IL_COL_NUM(list_array[8]) = TOKEN_COLUMN(token); 01930 01931 break; 01932 01933 case Tok_Dir_Ncpus_Chunks : 01934 01935 # ifdef _TARGET_OS_SOLARIS 01936 01937 if (IL_FLD(list_array[8]) != NO_Tbl_Idx) { 01938 PRINTMSG(TOKEN_LINE(token), 800, Error, TOKEN_COLUMN(token)); 01939 parse_err_flush(Find_EOS, NULL); 01940 goto EXIT; 01941 } 01942 01943 IL_FLD(list_array[8]) = CN_Tbl_Idx; 01944 IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 01945 CMIC_WORK_DIST_NCPUS_CHUNKS); 01946 IL_LINE_NUM(list_array[8]) = TOKEN_LINE(token); 01947 IL_COL_NUM(list_array[8]) = TOKEN_COLUMN(token); 01948 01949 # else 01950 PRINTMSG(TOKEN_LINE(token), 1140, Warning, TOKEN_COLUMN(token)); 01951 # endif 01952 break; 01953 01954 default: 01955 parse_err_flush(Find_EOS, NULL); 01956 PRINTMSG(TOKEN_LINE(token), 798, Error, TOKEN_COLUMN(token)); 01957 break; 01958 } 01959 } 01960 else { 01961 parse_err_flush(Find_EOS, "parameter"); 01962 } 01963 01964 if (LA_CH_VALUE == COMMA) { 01965 NEXT_LA_CH; 01966 } 01967 } 01968 01969 if (IL_FLD(list_array[8]) == NO_Tbl_Idx) { 01970 IL_FLD(list_array[8]) = CN_Tbl_Idx; 01971 01972 # ifdef _TARGET_OS_SOLARIS 01973 IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 01974 CMIC_WORK_DIST_NCPUS_CHUNKS); 01975 # elif defined(GENERATE_WHIRL) 01976 IL_IDX(list_array[8]) = CN_INTEGER_ZERO_IDX; 01977 # else 01978 IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 01979 CMIC_WORK_DIST_SINGLE); 01980 # endif 01981 IL_LINE_NUM(list_array[8]) = TOKEN_LINE(token); 01982 IL_COL_NUM(list_array[8]) = TOKEN_COLUMN(token); 01983 } 01984 01985 EXIT: 01986 01987 TRACE (Func_Exit, "parse_doall_cmic", NULL); 01988 01989 return; 01990 01991 } /* parse_doall_cmic */ 01992 01993 /******************************************************************************\ 01994 |* *| 01995 |* Description: *| 01996 |* This routine parses the variable lists that are possibly within *| 01997 |* paranthesis and have only variable names, not subobjects. *| 01998 |* *| 01999 |* Input parameters: *| 02000 |* NONE *| 02001 |* 'maxlen' is the maximum length of the list or -1 for infinite *| 02002 |* *| 02003 |* Output parameters: *| 02004 |* list_opnd - points to list of attrs. *| 02005 |* *| 02006 |* Returns: *| 02007 |* TRUE if no errors were encountered. *| 02008 |* *| 02009 \******************************************************************************/ 02010 02011 static boolean parse_var_name_list(opnd_type *list_opnd, int maxlen) 02012 02013 { 02014 int column; 02015 int line; 02016 int list_idx = NULL_IDX; 02017 opnd_type opnd; 02018 boolean result = TRUE; 02019 int curlen = 0; /* current length of the list so far */ 02020 02021 02022 TRACE (Func_Entry, "parse_var_name_list", NULL); 02023 02024 if (maxlen == 0) { 02025 return(result); 02026 } 02027 02028 while (TRUE) { 02029 02030 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 02031 curlen++; 02032 parse_deref(&opnd, NULL_IDX); 02033 02034 if (OPND_FLD(opnd) != AT_Tbl_Idx) { 02035 result = FALSE; 02036 find_opnd_line_and_column(&opnd, &line, &column); 02037 PRINTMSG(line, 1374, Error, column); 02038 } 02039 else { 02040 02041 if (list_idx == NULL_IDX) { 02042 NTR_IR_LIST_TBL(list_idx); 02043 OPND_FLD((*list_opnd)) = IL_Tbl_Idx; 02044 OPND_IDX((*list_opnd)) = list_idx; 02045 OPND_LIST_CNT((*list_opnd)) = 1; 02046 } 02047 else { 02048 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 02049 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 02050 (OPND_LIST_CNT((*list_opnd)))++; 02051 list_idx = IL_NEXT_LIST_IDX(list_idx); 02052 } 02053 02054 COPY_OPND(IL_OPND(list_idx), opnd); 02055 } 02056 } 02057 else { 02058 parse_err_flush(Find_Comma_Rparen, "IDENTIFIER"); 02059 result = FALSE; 02060 } 02061 02062 /* if we have processed the whole list, stop */ 02063 if (maxlen > 0 && curlen == maxlen) { 02064 break; 02065 } 02066 if (LA_CH_VALUE != COMMA) { 02067 break; 02068 } 02069 02070 NEXT_LA_CH; 02071 } 02072 02073 TRACE (Func_Exit, "parse_var_name_list", NULL); 02074 02075 return(result); 02076 02077 } /* parse_var_name_list */ 02078 # if 0 02079 02080 /* No one uses this routine */ 02081 02082 02083 /******************************************************************************\ 02084 |* *| 02085 |* Description: *| 02086 |* This routine parses a list of expressions seperated by commas. *| 02087 |* *| 02088 |* Input parameters: *| 02089 |* NONE *| 02090 |* *| 02091 |* Output parameters: *| 02092 |* opnd - points to list of expressions. *| 02093 |* *| 02094 |* Returns: *| 02095 |* NOTHING *| 02096 |* *| 02097 \******************************************************************************/ 02098 02099 static void parse_expr_list(opnd_type *list_opnd) 02100 02101 { 02102 int list_idx = NULL_IDX; 02103 boolean ok = TRUE; 02104 opnd_type opnd; 02105 02106 02107 TRACE (Func_Entry, "parse_expr_list", NULL); 02108 02109 while(TRUE) { 02110 02111 ok &= parse_expr(&opnd); 02112 02113 if (ok) { 02114 02115 if (list_idx == NULL_IDX) { 02116 NTR_IR_LIST_TBL(list_idx); 02117 OPND_FLD((*list_opnd)) = IL_Tbl_Idx; 02118 OPND_IDX((*list_opnd)) = list_idx; 02119 OPND_LIST_CNT((*list_opnd)) = 1; 02120 } 02121 else { 02122 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 02123 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 02124 (OPND_LIST_CNT((*list_opnd)))++; 02125 list_idx = IL_NEXT_LIST_IDX(list_idx); 02126 } 02127 COPY_OPND(IL_OPND(list_idx), opnd); 02128 } 02129 else { 02130 parse_err_flush(Find_Comma_Rparen, NULL); 02131 break; 02132 } 02133 02134 if (LA_CH_VALUE != COMMA) { 02135 break; 02136 } 02137 NEXT_LA_CH; 02138 } 02139 02140 TRACE (Func_Exit, "parse_expr_list", NULL); 02141 02142 return; 02143 02144 } /* parse_expr_list */ 02145 # endif 02146 02147 /******************************************************************************\ 02148 |* *| 02149 |* Description: *| 02150 |* This routine parses the arguments to the DO PARALLEL cmic *| 02151 |* *| 02152 |* (Doparallel_Cmic_Opr) *| 02153 |* / *| 02154 |* |- WORK DISTRIBUTION *| 02155 |* |- work distribution opnd *| 02156 |* *| 02157 |* *| 02158 |* Input parameters: *| 02159 |* NONE *| 02160 |* *| 02161 |* Output parameters: *| 02162 |* NONE *| 02163 |* *| 02164 |* Returns: *| 02165 |* NOTHING *| 02166 |* *| 02167 \******************************************************************************/ 02168 02169 static void parse_doparallel_cmic(void) 02170 02171 { 02172 int i; 02173 int ir_idx; 02174 int list_array[2]; 02175 opnd_type opnd; 02176 02177 02178 TRACE (Func_Entry, "parse_doparallel_cmic", NULL); 02179 02180 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 02181 02182 for (i = 0; i < 2; i++) { 02183 NTR_IR_LIST_TBL(list_array[i]); 02184 if (i >= 1) { 02185 IL_NEXT_LIST_IDX(list_array[i - 1]) = list_array[i]; 02186 IL_PREV_LIST_IDX(list_array[i]) = list_array[i - 1]; 02187 } 02188 } 02189 02190 IR_FLD_L(ir_idx) = IL_Tbl_Idx; 02191 IR_IDX_L(ir_idx) = list_array[0]; 02192 IR_LIST_CNT_L(ir_idx) = 2; 02193 02194 IL_OPND(list_array[0]) = null_opnd; 02195 02196 if (LA_CH_VALUE == EOS) { 02197 goto EXIT; 02198 } 02199 02200 if (MATCHED_TOKEN_CLASS(Tok_Class_Dir_Kwd)) { 02201 switch (TOKEN_VALUE(token)) { 02202 case Tok_Dir_Single: 02203 02204 if (IL_FLD(list_array[0]) != NO_Tbl_Idx) { 02205 PRINTMSG(TOKEN_LINE(token), 1139, Error, TOKEN_COLUMN(token)); 02206 parse_err_flush(Find_EOS, NULL); 02207 goto EXIT; 02208 } 02209 02210 IL_FLD(list_array[0]) = CN_Tbl_Idx; 02211 IL_IDX(list_array[0]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 02212 CMIC_WORK_DIST_SINGLE); 02213 IL_LINE_NUM(list_array[0]) = TOKEN_LINE(token); 02214 IL_COL_NUM(list_array[0]) = TOKEN_COLUMN(token); 02215 02216 break; 02217 02218 case Tok_Dir_Chunksize: 02219 02220 if (IL_FLD(list_array[0]) != NO_Tbl_Idx) { 02221 PRINTMSG(TOKEN_LINE(token), 1139, Error, TOKEN_COLUMN(token)); 02222 parse_err_flush(Find_EOS, NULL); 02223 goto EXIT; 02224 } 02225 02226 IL_FLD(list_array[0]) = CN_Tbl_Idx; 02227 IL_IDX(list_array[0]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 02228 CMIC_WORK_DIST_CHUNKSIZE); 02229 IL_LINE_NUM(list_array[0]) = TOKEN_LINE(token); 02230 IL_COL_NUM(list_array[0]) = TOKEN_COLUMN(token); 02231 02232 if (LA_CH_VALUE == LPAREN) { 02233 NEXT_LA_CH; 02234 02235 if (parse_expr(&opnd)) { 02236 COPY_OPND(IL_OPND(list_array[1]), opnd); 02237 } 02238 02239 if (LA_CH_VALUE == RPAREN) { 02240 NEXT_LA_CH; 02241 } 02242 else { 02243 parse_err_flush(Find_EOS, ")"); 02244 goto EXIT; 02245 } 02246 } 02247 else { 02248 parse_err_flush(Find_EOS, "("); 02249 goto EXIT; 02250 } 02251 02252 break; 02253 02254 case Tok_Dir_Numchunks: 02255 02256 # if defined(GENERATE_WHIRL) 02257 PRINTMSG(TOKEN_LINE(token), 1436, Warning, 02258 TOKEN_COLUMN(token), "NUMCHUNKS"); 02259 # endif 02260 02261 if (IL_FLD(list_array[0]) != NO_Tbl_Idx) { 02262 PRINTMSG(TOKEN_LINE(token), 1139, Error, TOKEN_COLUMN(token)); 02263 parse_err_flush(Find_EOS, NULL); 02264 goto EXIT; 02265 } 02266 02267 IL_FLD(list_array[0]) = CN_Tbl_Idx; 02268 IL_IDX(list_array[0]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 02269 CMIC_WORK_DIST_NUMCHUNKS); 02270 IL_LINE_NUM(list_array[0]) = TOKEN_LINE(token); 02271 IL_COL_NUM(list_array[0]) = TOKEN_COLUMN(token); 02272 02273 if (LA_CH_VALUE == LPAREN) { 02274 NEXT_LA_CH; 02275 02276 if (parse_expr(&opnd)) { 02277 COPY_OPND(IL_OPND(list_array[1]), opnd); 02278 } 02279 02280 if (LA_CH_VALUE == RPAREN) { 02281 NEXT_LA_CH; 02282 } 02283 else { 02284 parse_err_flush(Find_EOS, ")"); 02285 goto EXIT; 02286 } 02287 } 02288 else { 02289 parse_err_flush(Find_EOS, "("); 02290 goto EXIT; 02291 } 02292 02293 # if defined(GENERATE_WHIRL) 02294 IL_OPND(list_array[0]) = null_opnd; 02295 # endif 02296 break; 02297 02298 case Tok_Dir_Guided: 02299 02300 if (IL_FLD(list_array[0]) != NO_Tbl_Idx) { 02301 PRINTMSG(TOKEN_LINE(token), 1139, Error, TOKEN_COLUMN(token)); 02302 parse_err_flush(Find_EOS, NULL); 02303 goto EXIT; 02304 } 02305 02306 IL_FLD(list_array[0]) = CN_Tbl_Idx; 02307 IL_IDX(list_array[0]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 02308 CMIC_WORK_DIST_GUIDED); 02309 IL_LINE_NUM(list_array[0]) = TOKEN_LINE(token); 02310 IL_COL_NUM(list_array[0]) = TOKEN_COLUMN(token); 02311 02312 if (LA_CH_VALUE == '(') { 02313 if (parse_expr(&opnd)) { 02314 COPY_OPND(IL_OPND(list_array[1]), opnd); 02315 } 02316 } 02317 else { 02318 IL_FLD(list_array[1]) = CN_Tbl_Idx; 02319 IL_IDX(list_array[1]) = const_safevl_idx; 02320 IL_LINE_NUM(list_array[1]) = TOKEN_LINE(token); 02321 IL_COL_NUM(list_array[1]) = TOKEN_COLUMN(token); 02322 } 02323 02324 break; 02325 02326 case Tok_Dir_Vector: 02327 02328 if (IL_FLD(list_array[0]) != NO_Tbl_Idx) { 02329 PRINTMSG(TOKEN_LINE(token), 1139, Error, TOKEN_COLUMN(token)); 02330 parse_err_flush(Find_EOS, NULL); 02331 goto EXIT; 02332 } 02333 02334 IL_FLD(list_array[0]) = CN_Tbl_Idx; 02335 IL_IDX(list_array[0]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 02336 CMIC_WORK_DIST_VECTOR); 02337 IL_LINE_NUM(list_array[0]) = TOKEN_LINE(token); 02338 IL_COL_NUM(list_array[0]) = TOKEN_COLUMN(token); 02339 02340 break; 02341 02342 case Tok_Dir_Ncpus_Chunks : 02343 02344 # ifdef _TARGET_OS_SOLARIS 02345 02346 if (IL_FLD(list_array[0]) != NO_Tbl_Idx) { 02347 PRINTMSG(TOKEN_LINE(token), 1139, Error, TOKEN_COLUMN(token)); 02348 parse_err_flush(Find_EOS, NULL); 02349 goto EXIT; 02350 } 02351 02352 IL_FLD(list_array[0]) = CN_Tbl_Idx; 02353 IL_IDX(list_array[0]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 02354 CMIC_WORK_DIST_NCPUS_CHUNKS); 02355 IL_LINE_NUM(list_array[0]) = TOKEN_LINE(token); 02356 IL_COL_NUM(list_array[0]) = TOKEN_COLUMN(token); 02357 02358 # else 02359 PRINTMSG(TOKEN_LINE(token), 1140, Warning, TOKEN_COLUMN(token)); 02360 # endif 02361 break; 02362 02363 02364 default: 02365 parse_err_flush(Find_EOS, NULL); 02366 PRINTMSG(TOKEN_LINE(token), 808, Error, TOKEN_COLUMN(token)); 02367 break; 02368 } 02369 } 02370 else { 02371 parse_err_flush(Find_EOS, "parameter"); 02372 } 02373 02374 if (LA_CH_VALUE != EOS) { 02375 parse_err_flush(Find_EOS, EOS_STR); 02376 } 02377 02378 EXIT: 02379 02380 if (IL_FLD(list_array[0]) == NO_Tbl_Idx) { 02381 IL_FLD(list_array[0]) = CN_Tbl_Idx; 02382 02383 # if defined(GENERATE_WHIRL) 02384 IL_IDX(list_array[0]) = CN_INTEGER_ZERO_IDX; 02385 # else 02386 IL_IDX(list_array[0]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 02387 CMIC_WORK_DIST_SINGLE); 02388 # endif 02389 IL_LINE_NUM(list_array[0]) = TOKEN_LINE(token); 02390 IL_COL_NUM(list_array[0]) = TOKEN_COLUMN(token); 02391 } 02392 02393 TRACE (Func_Exit, "parse_doparallel_cmic", NULL); 02394 02395 return; 02396 02397 } /* parse_doparallel_cmic */ 02398 02399 /******************************************************************************\ 02400 |* *| 02401 |* Description: *| 02402 |* This routine parses the parameters for the PARALLEL cmic. *| 02403 |* *| 02404 |* (Parallel_Cmic_Opr) *| 02405 |* / *| 02406 |* |- IF condition *| 02407 |* |- SHARED var list *| 02408 |* |- PRIVATE var list *| 02409 |* |- GETFIRST var list *| 02410 |* |- const one if AUTOSCOPE *| 02411 |* |- CONTROL var list *| 02412 |* |- MAXCPUS value *| 02413 |* *| 02414 |* Input parameters: *| 02415 |* NONE *| 02416 |* *| 02417 |* Output parameters: *| 02418 |* NONE *| 02419 |* *| 02420 |* Returns: *| 02421 |* NOTHING *| 02422 |* *| 02423 \******************************************************************************/ 02424 02425 static void parse_parallel_cmic(void) 02426 02427 { 02428 int i; 02429 int ir_idx; 02430 int list_array[7]; 02431 int list_idx; 02432 opnd_type opnd; 02433 02434 02435 TRACE (Func_Entry, "parse_parallel_cmic", NULL); 02436 02437 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 02438 02439 for (i = 0; i < 7; i++) { 02440 NTR_IR_LIST_TBL(list_array[i]); 02441 if (i >= 1) { 02442 IL_NEXT_LIST_IDX(list_array[i - 1]) = list_array[i]; 02443 IL_PREV_LIST_IDX(list_array[i]) = list_array[i - 1]; 02444 } 02445 } 02446 02447 IR_FLD_L(ir_idx) = IL_Tbl_Idx; 02448 IR_IDX_L(ir_idx) = list_array[0]; 02449 IR_LIST_CNT_L(ir_idx) = 7; 02450 02451 while (LA_CH_VALUE != EOS) { 02452 02453 if (MATCHED_TOKEN_CLASS(Tok_Class_Dir_Kwd)) { 02454 02455 switch (TOKEN_VALUE(token)) { 02456 02457 case Tok_Dir_If: 02458 02459 if (LA_CH_VALUE == LPAREN) { 02460 02461 if (IL_IDX(list_array[0]) != NULL_IDX) { 02462 PRINTMSG(LA_CH_LINE, 680, Error, LA_CH_COLUMN, 02463 "PARALLEL"); 02464 parse_err_flush(Find_EOS, NULL); 02465 goto EXIT; 02466 } 02467 02468 NEXT_LA_CH; 02469 parse_expr(&opnd); 02470 COPY_OPND(IL_OPND(list_array[0]), opnd); 02471 02472 if (LA_CH_VALUE == RPAREN) { 02473 NEXT_LA_CH; 02474 } 02475 else { 02476 parse_err_flush(Find_EOS, ")"); 02477 goto EXIT; 02478 } 02479 } 02480 else { 02481 parse_err_flush(Find_EOS, "("); 02482 goto EXIT; 02483 } 02484 break; 02485 02486 case Tok_Dir_Shared: 02487 02488 if (LA_CH_VALUE == LPAREN) { 02489 NEXT_LA_CH; 02490 parse_var_name_list(&opnd, -1); 02491 02492 if (IL_IDX(list_array[1]) == NULL_IDX) { 02493 COPY_OPND(IL_OPND(list_array[1]), opnd); 02494 } 02495 else { 02496 /* find the end of list */ 02497 02498 list_idx = IL_IDX(list_array[1]); 02499 while (IL_NEXT_LIST_IDX(list_idx)) { 02500 list_idx = IL_NEXT_LIST_IDX(list_idx); 02501 } 02502 02503 /* append the new list */ 02504 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 02505 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 02506 IL_LIST_CNT(list_array[1]) += OPND_LIST_CNT(opnd); 02507 } 02508 02509 if (LA_CH_VALUE == RPAREN) { 02510 NEXT_LA_CH; 02511 } 02512 else { 02513 parse_err_flush(Find_EOS, ")"); 02514 goto EXIT; 02515 } 02516 } 02517 else { 02518 parse_err_flush(Find_EOS, "("); 02519 goto EXIT; 02520 } 02521 02522 break; 02523 02524 case Tok_Dir_Private: 02525 02526 if (LA_CH_VALUE == LPAREN) { 02527 NEXT_LA_CH; 02528 parse_var_name_list(&opnd, -1); 02529 02530 if (IL_IDX(list_array[2]) == NULL_IDX) { 02531 COPY_OPND(IL_OPND(list_array[2]), opnd); 02532 } 02533 else { 02534 /* find the end of list */ 02535 02536 list_idx = IL_IDX(list_array[2]); 02537 while (IL_NEXT_LIST_IDX(list_idx)) { 02538 list_idx = IL_NEXT_LIST_IDX(list_idx); 02539 } 02540 02541 /* append the new list */ 02542 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 02543 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 02544 IL_LIST_CNT(list_array[2]) += OPND_LIST_CNT(opnd); 02545 } 02546 02547 if (LA_CH_VALUE == RPAREN) { 02548 NEXT_LA_CH; 02549 } 02550 else { 02551 parse_err_flush(Find_EOS, ")"); 02552 goto EXIT; 02553 } 02554 } 02555 else { 02556 parse_err_flush(Find_EOS, "("); 02557 goto EXIT; 02558 } 02559 02560 break; 02561 02562 case Tok_Dir_Getfirst: 02563 02564 if (LA_CH_VALUE == LPAREN) { 02565 NEXT_LA_CH; 02566 parse_var_name_list(&opnd, -1); 02567 02568 if (IL_IDX(list_array[3]) == NULL_IDX) { 02569 COPY_OPND(IL_OPND(list_array[3]), opnd); 02570 } 02571 else { 02572 /* find the end of list */ 02573 02574 list_idx = IL_IDX(list_array[3]); 02575 while (IL_NEXT_LIST_IDX(list_idx)) { 02576 list_idx = IL_NEXT_LIST_IDX(list_idx); 02577 } 02578 02579 /* append the new list */ 02580 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 02581 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 02582 IL_LIST_CNT(list_array[3]) += OPND_LIST_CNT(opnd); 02583 } 02584 02585 if (LA_CH_VALUE == RPAREN) { 02586 NEXT_LA_CH; 02587 } 02588 else { 02589 parse_err_flush(Find_EOS, ")"); 02590 goto EXIT; 02591 } 02592 } 02593 else { 02594 parse_err_flush(Find_EOS, "("); 02595 goto EXIT; 02596 } 02597 02598 break; 02599 02600 case Tok_Dir_Autoscope: 02601 02602 # if defined(GENERATE_WHIRL) 02603 PRINTMSG(TOKEN_LINE(token), 1415, Error, TOKEN_COLUMN(token)); 02604 # else 02605 02606 IL_FLD(list_array[4]) = CN_Tbl_Idx; 02607 IL_IDX(list_array[4]) = CN_INTEGER_ONE_IDX; 02608 IL_LINE_NUM(list_array[4]) = TOKEN_LINE(token); 02609 IL_COL_NUM(list_array[4]) = TOKEN_COLUMN(token); 02610 02611 # endif 02612 break; 02613 02614 case Tok_Dir_Control: 02615 02616 if (LA_CH_VALUE == LPAREN) { 02617 NEXT_LA_CH; 02618 parse_var_name_list(&opnd, -1); 02619 02620 if (IL_IDX(list_array[5]) == NULL_IDX) { 02621 COPY_OPND(IL_OPND(list_array[5]), opnd); 02622 } 02623 else { 02624 /* find the end of list */ 02625 02626 list_idx = IL_IDX(list_array[5]); 02627 while (IL_NEXT_LIST_IDX(list_idx)) { 02628 list_idx = IL_NEXT_LIST_IDX(list_idx); 02629 } 02630 02631 /* append the new list */ 02632 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 02633 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 02634 IL_LIST_CNT(list_array[5]) += OPND_LIST_CNT(opnd); 02635 } 02636 02637 if (LA_CH_VALUE == RPAREN) { 02638 NEXT_LA_CH; 02639 } 02640 else { 02641 parse_err_flush(Find_EOS, ")"); 02642 goto EXIT; 02643 } 02644 } 02645 else { 02646 parse_err_flush(Find_EOS, "("); 02647 goto EXIT; 02648 } 02649 02650 break; 02651 02652 case Tok_Dir_Maxcpus: 02653 02654 if (LA_CH_VALUE == LPAREN) { 02655 NEXT_LA_CH; 02656 parse_expr(&opnd); 02657 COPY_OPND(IL_OPND(list_array[6]), opnd); 02658 02659 if (LA_CH_VALUE == RPAREN) { 02660 NEXT_LA_CH; 02661 } 02662 else { 02663 parse_err_flush(Find_EOS, ")"); 02664 goto EXIT; 02665 } 02666 } 02667 else { 02668 parse_err_flush(Find_EOS, "("); 02669 goto EXIT; 02670 } 02671 break; 02672 02673 default: 02674 parse_err_flush(Find_EOS, NULL); 02675 PRINTMSG(TOKEN_LINE(token), 809, Error, TOKEN_COLUMN(token)); 02676 break; 02677 } 02678 } 02679 else { 02680 parse_err_flush(Find_EOS, "parameter"); 02681 } 02682 02683 if (LA_CH_VALUE == COMMA) { 02684 NEXT_LA_CH; 02685 } 02686 } 02687 02688 EXIT: 02689 02690 TRACE (Func_Exit, "parse_parallel_cmic", NULL); 02691 02692 return; 02693 02694 } /* parse_parallel_cmic */ 02695 02696 /******************************************************************************\ 02697 |* *| 02698 |* Description: *| 02699 |* Tasking directive block checks for end and contains stmts. *| 02700 |* *| 02701 |* Input parameters: *| 02702 |* NONE *| 02703 |* *| 02704 |* Output parameters: *| 02705 |* NONE *| 02706 |* *| 02707 |* Returns: *| 02708 |* NOTHING *| 02709 |* *| 02710 \******************************************************************************/ 02711 02712 void do_cmic_blk_checks(void) 02713 02714 { 02715 02716 02717 TRACE (Func_Entry, "do_cmic_blk_checks", NULL); 02718 02719 if (cdir_switches.doall_sh_idx != NULL_IDX) { 02720 PRINTMSG(SH_GLB_LINE(cdir_switches.doall_sh_idx), 1219, Error, 02721 SH_COL_NUM(cdir_switches.doall_sh_idx), 02722 "DO ALL"); 02723 } 02724 02725 /* BHJ need new message here */ 02726 02727 if (cdir_switches.doacross_sh_idx != NULL_IDX) { 02728 PRINTMSG(SH_GLB_LINE(cdir_switches.doacross_sh_idx), 1219, Error, 02729 SH_COL_NUM(cdir_switches.doacross_sh_idx), 02730 "DOACROSS"); 02731 } 02732 02733 cdir_switches.no_internal_calls = FALSE; 02734 cdir_switches.parallel_region = FALSE; 02735 cdir_switches.doall_region = FALSE; 02736 cdir_switches.casedir = FALSE; 02737 cdir_switches.guard = FALSE; 02738 cdir_switches.guard_has_flag = FALSE; 02739 cdir_switches.guard_in_par_reg = FALSE; 02740 cdir_switches.do_parallel = FALSE; 02741 02742 cdir_switches.doall_sh_idx = NULL_IDX; 02743 cdir_switches.doacross_sh_idx = NULL_IDX; 02744 cdir_switches.dopar_sh_idx = NULL_IDX; 02745 02746 TRACE (Func_Exit, "do_cmic_blk_checks", NULL); 02747 02748 return; 02749 02750 } /* do_cmic_blk_checks */ 02751 02752 /******************************************************************************\ 02753 |* *| 02754 |* Description: *| 02755 |* This routine parses the variable and/or common block lists that are *| 02756 |* on a CACHE_ALIGN cdir. No subobjects are allowed. *| 02757 |* *| 02758 |* Input parameters: *| 02759 |* NONE *| 02760 |* *| 02761 |* Output parameters: *| 02762 |* opnd - points to list of attrs. *| 02763 |* *| 02764 |* Returns: *| 02765 |* NOTHING *| 02766 |* *| 02767 \******************************************************************************/ 02768 02769 static void parse_cache_align_name_list(opnd_type *list_opnd) 02770 02771 { 02772 int col; 02773 int line; 02774 int list_idx = NULL_IDX; 02775 opnd_type opnd; 02776 int sb_idx; 02777 02778 02779 TRACE (Func_Entry, "parse_cache_align_name_list", NULL); 02780 02781 while(TRUE) { 02782 if (LA_CH_VALUE == SLASH) { 02783 /* must be common block */ 02784 NEXT_LA_CH; /* eat slash */ 02785 02786 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 02787 02788 if (LA_CH_VALUE == SLASH) { 02789 NEXT_LA_CH; /* eat slash */ 02790 sb_idx = srch_stor_blk_tbl(TOKEN_STR(token), 02791 TOKEN_LEN(token), 02792 curr_scp_idx); 02793 02794 if (sb_idx == NULL_IDX) { 02795 sb_idx = ntr_stor_blk_tbl(TOKEN_STR(token), 02796 TOKEN_LEN(token), 02797 TOKEN_LINE(token), 02798 TOKEN_COLUMN(token), 02799 Common); 02800 SB_BLANK_COMMON(sb_idx) = FALSE; 02801 SB_COMMON_NEEDS_OFFSET(sb_idx) = TRUE; 02802 SB_IS_COMMON(sb_idx) = TRUE; 02803 } 02804 02805 if (SB_CACHE_ALIGN(sb_idx)) { 02806 /* already specified in CACHE_ALIGN cdir */ 02807 PRINTMSG(TOKEN_LINE(token), 1065, Error, 02808 TOKEN_COLUMN(token), SB_NAME_PTR(sb_idx)); 02809 } 02810 else { 02811 SB_CACHE_ALIGN(sb_idx) = TRUE; 02812 } 02813 } 02814 else { 02815 parse_err_flush(Find_EOS, "/"); 02816 } 02817 } 02818 else { 02819 parse_err_flush(Find_EOS, "common-block-name"); 02820 } 02821 } 02822 else if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 02823 parse_deref(&opnd, NULL_IDX); 02824 02825 if (OPND_FLD(opnd) != AT_Tbl_Idx) { 02826 find_opnd_line_and_column(&opnd, &line, &col); 02827 PRINTMSG(line, 1487, Error, col, "CACHE_ALIGN"); 02828 } 02829 else { 02830 if (list_idx == NULL_IDX) { 02831 NTR_IR_LIST_TBL(list_idx); 02832 OPND_FLD((*list_opnd)) = IL_Tbl_Idx; 02833 OPND_IDX((*list_opnd)) = list_idx; 02834 OPND_LIST_CNT((*list_opnd)) = 1; 02835 } 02836 else { 02837 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 02838 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 02839 (OPND_LIST_CNT((*list_opnd)))++; 02840 list_idx = IL_NEXT_LIST_IDX(list_idx); 02841 } 02842 COPY_OPND(IL_OPND(list_idx), opnd); 02843 } 02844 } 02845 else { 02846 parse_err_flush(Find_EOS, "IDENTIFIER"); 02847 } 02848 02849 if (LA_CH_VALUE != COMMA) { 02850 break; 02851 } 02852 NEXT_LA_CH; 02853 } 02854 02855 TRACE (Func_Exit, "parse_cache_align_name_list", NULL); 02856 02857 return; 02858 02859 } /* parse_cache_align_name_list */ 02860 02861 /******************************************************************************\ 02862 |* *| 02863 |* Description: *| 02864 |* This routine parses the CDIR$ NAME line. *| 02865 |* *| 02866 |* Input parameters: *| 02867 |* NONE *| 02868 |* *| 02869 |* Output parameters: *| 02870 |* NONE *| 02871 |* *| 02872 |* Returns: *| 02873 |* NOTHING *| 02874 |* *| 02875 \******************************************************************************/ 02876 static void parse_name_dir(void) 02877 02878 { 02879 int attr_idx; 02880 int column; 02881 int idx; 02882 long length; 02883 int line; 02884 char *name; 02885 int name_idx; 02886 opnd_type opnd; 02887 02888 02889 TRACE (Func_Entry, "parse_name_dir", NULL); 02890 02891 if (LA_CH_VALUE != LPAREN) { 02892 parse_err_flush(Find_EOS, "("); 02893 NEXT_LA_CH; /* pick up EOS */ 02894 return; 02895 } 02896 02897 NEXT_LA_CH; /* Pick up Lparen */ 02898 02899 do { 02900 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 02901 attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token), 02902 &name_idx); 02903 02904 if (attr_idx == NULL_IDX) { 02905 attr_idx = ntr_sym_tbl(&token, name_idx); 02906 LN_DEF_LOC(name_idx) = TRUE; 02907 AT_OBJ_CLASS(attr_idx) = Pgm_Unit; 02908 ATP_PROC(attr_idx) = Extern_Proc; 02909 ATP_NAME_IN_STONE(attr_idx) = TRUE; 02910 ATP_SCP_IDX(attr_idx) = curr_scp_idx; 02911 } 02912 else if (!fnd_semantic_err(Obj_Name, 02913 TOKEN_LINE(token), 02914 TOKEN_COLUMN(token), 02915 attr_idx, 02916 TRUE)) { 02917 02918 if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) { 02919 AT_ATTR_LINK(attr_idx) = NULL_IDX; 02920 LN_DEF_LOC(name_idx) = TRUE; 02921 } 02922 02923 if (AT_OBJ_CLASS(attr_idx) == Data_Obj) { 02924 chg_data_obj_to_pgm_unit(attr_idx, 02925 Pgm_Unknown, 02926 Extern_Proc); 02927 ATP_NAME_IN_STONE(attr_idx) = TRUE; 02928 } 02929 else if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit) { 02930 ATP_PROC(attr_idx) = Extern_Proc; 02931 ATP_NAME_IN_STONE(attr_idx) = TRUE; 02932 } 02933 } 02934 else { 02935 CREATE_ERR_ATTR(attr_idx, 02936 TOKEN_LINE(token), 02937 TOKEN_COLUMN(token), 02938 Pgm_Unit); 02939 ATP_PROC(attr_idx) = Extern_Proc; 02940 ATP_NAME_IN_STONE(attr_idx) = TRUE; 02941 } 02942 02943 if (LA_CH_VALUE == EQUAL) { 02944 NEXT_LA_CH; 02945 02946 if (LA_CH_VALUE == QUOTE || 02947 LA_CH_VALUE == DBL_QUOTE) { 02948 02949 if (parse_operand(&opnd)) { 02950 find_opnd_line_and_column(&opnd, &line, &column); 02951 02952 if (OPND_FLD(opnd)!= CN_Tbl_Idx || 02953 TYP_TYPE(CN_TYPE_IDX(OPND_IDX(opnd))) != Character) { 02954 PRINTMSG(line, 1111, Error, column); 02955 AT_DCL_ERR(attr_idx) = TRUE; 02956 ATP_EXT_NAME_LEN(attr_idx) = AT_NAME_LEN(attr_idx); 02957 ATP_EXT_NAME_IDX(attr_idx) = AT_NAME_IDX(attr_idx); 02958 } 02959 else { 02960 length = (long) CN_INT_TO_C(TYP_IDX( 02961 CN_TYPE_IDX(OPND_IDX(opnd)))); 02962 02963 NTR_NAME_POOL((long *) &(CN_CONST(OPND_IDX(opnd))), 02964 (int) length, name_idx); 02965 02966 ATP_EXT_NAME_IDX(attr_idx) = name_idx; 02967 ATP_EXT_NAME_LEN(attr_idx) = length; 02968 name = ATP_EXT_NAME_PTR(attr_idx); 02969 02970 for (idx = 0; 02971 idx < (WORD_LEN(length)*TARGET_BYTES_PER_WORD)-length; 02972 idx++) { 02973 *(name + length + idx) = '\0'; 02974 } 02975 } 02976 } 02977 else { 02978 parse_err_flush(Find_Rparen, NULL); 02979 AT_DCL_ERR(attr_idx) = TRUE; 02980 ATP_EXT_NAME_LEN(attr_idx) = AT_NAME_LEN(attr_idx); 02981 ATP_EXT_NAME_IDX(attr_idx) = AT_NAME_IDX(attr_idx); 02982 } 02983 } 02984 else { 02985 PRINTMSG(LA_CH_LINE, 1111, Error, LA_CH_COLUMN); 02986 parse_err_flush(Find_Rparen, NULL); 02987 AT_DCL_ERR(attr_idx) = TRUE; 02988 ATP_EXT_NAME_LEN(attr_idx) = AT_NAME_LEN(attr_idx); 02989 ATP_EXT_NAME_IDX(attr_idx) = AT_NAME_IDX(attr_idx); 02990 } 02991 } 02992 else { 02993 parse_err_flush(Find_Rparen, "="); 02994 AT_DCL_ERR(attr_idx) = TRUE; 02995 ATP_EXT_NAME_LEN(attr_idx) = AT_NAME_LEN(attr_idx); 02996 ATP_EXT_NAME_IDX(attr_idx) = AT_NAME_IDX(attr_idx); 02997 } 02998 } 02999 else if (!parse_err_flush(Find_Comma, "procedure name")) { 03000 break; /* Couldn't recover. Hit EOS */ 03001 } 03002 03003 if (LA_CH_VALUE == COMMA) { 03004 NEXT_LA_CH; 03005 } 03006 else { 03007 break; 03008 } 03009 } 03010 while (TRUE); 03011 03012 if (LA_CH_VALUE == RPAREN || parse_err_flush(Find_Rparen, ", or )")) { 03013 NEXT_LA_CH; 03014 } 03015 03016 if (LA_CH_VALUE != EOS) { 03017 parse_err_flush(Find_EOS, EOS_STR); 03018 } 03019 03020 NEXT_LA_CH; /* Pick up EOS */ 03021 03022 TRACE (Func_Exit, "parse_name_dir", NULL); 03023 03024 return; 03025 03026 } /* parse_name_dir */ 03027 03028 /******************************************************************************\ 03029 |* *| 03030 |* Description: *| 03031 |* This routine parses the CMIC$ PERMUTATION line. *| 03032 |* *| 03033 |* Input parameters: *| 03034 |* NONE *| 03035 |* *| 03036 |* Output parameters: *| 03037 |* NONE *| 03038 |* *| 03039 |* Returns: *| 03040 |* NOTHING *| 03041 |* *| 03042 \******************************************************************************/ 03043 static void parse_permutation_mic(void) 03044 03045 { 03046 int attr_idx; 03047 int name_idx; 03048 03049 # if defined(GENERATE_WHIRL) 03050 int ir_idx; 03051 int list_idx = NULL_IDX; 03052 # endif 03053 03054 03055 TRACE (Func_Entry, "parse_permutation_mic", NULL); 03056 03057 if (LA_CH_VALUE != LPAREN) { 03058 parse_err_flush(Find_EOS, "("); 03059 return; 03060 } 03061 03062 # if defined(GENERATE_WHIRL) 03063 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 03064 IR_OPR(ir_idx) = Assert_Star_Opr; 03065 03066 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 03067 IR_IDX_L(ir_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 03068 ASSERT_PERMUTATION); 03069 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx); 03070 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx); 03071 # endif 03072 03073 NEXT_LA_CH; /* Pick up Lparen */ 03074 03075 do { 03076 03077 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 03078 attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token), 03079 &name_idx); 03080 03081 if (attr_idx == NULL_IDX) { 03082 attr_idx = ntr_sym_tbl(&token, name_idx); 03083 LN_DEF_LOC(name_idx) = TRUE; 03084 AT_OBJ_CLASS(attr_idx) = Data_Obj; 03085 ATD_PERMUTATION(attr_idx) = TRUE; 03086 } 03087 else if (AT_OBJ_CLASS(attr_idx) != Data_Obj) { 03088 PRINTMSG(AT_DEF_LINE(attr_idx), 1126, Error, 03089 AT_DEF_COLUMN(attr_idx), 03090 AT_OBJ_NAME_PTR(attr_idx)); 03091 AT_DCL_ERR(attr_idx) = TRUE; 03092 } 03093 else { 03094 ATD_PERMUTATION(attr_idx) = TRUE; 03095 03096 if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) { 03097 AT_ATTR_LINK(attr_idx) = NULL_IDX; 03098 LN_DEF_LOC(name_idx) = TRUE; 03099 } 03100 } 03101 03102 # if defined(GENERATE_WHIRL) 03103 if (list_idx == NULL_IDX) { 03104 NTR_IR_LIST_TBL(list_idx); 03105 IR_FLD_R(ir_idx) = IL_Tbl_Idx; 03106 IR_IDX_R(ir_idx) = list_idx; 03107 IR_LIST_CNT_R(ir_idx) = 1; 03108 } 03109 else { 03110 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 03111 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 03112 list_idx = IL_NEXT_LIST_IDX(list_idx); 03113 (IR_LIST_CNT_R(ir_idx))++; 03114 } 03115 03116 IL_FLD(list_idx) = AT_Tbl_Idx; 03117 IL_IDX(list_idx) = attr_idx; 03118 IL_LINE_NUM(list_idx) = TOKEN_LINE(token); 03119 IL_COL_NUM(list_idx) = TOKEN_COLUMN(token); 03120 # endif 03121 } 03122 else if (!parse_err_flush(Find_Comma, "array name")) { 03123 break; /* Couldn't recover. Hit EOS */ 03124 } 03125 03126 if (LA_CH_VALUE == COMMA) { 03127 NEXT_LA_CH; 03128 } 03129 else { 03130 break; 03131 } 03132 } 03133 while (TRUE); 03134 03135 if (LA_CH_VALUE == RPAREN || parse_err_flush(Find_Rparen, ", or )")) { 03136 NEXT_LA_CH; 03137 } 03138 03139 if (LA_CH_VALUE != EOS) { 03140 parse_err_flush(Find_EOS, EOS_STR); 03141 } 03142 03143 TRACE (Func_Exit, "parse_permutation_mic", NULL); 03144 03145 return; 03146 03147 } /* parse_permutation_mic */ 03148 03149 /******************************************************************************\ 03150 |* *| 03151 |* Description: *| 03152 |* This routine parses the CDIR$ INLINE ALWAYS and INLINE NEVER line. *| 03153 |* *| 03154 |* Input parameters: *| 03155 |* NONE *| 03156 |* *| 03157 |* Output parameters: *| 03158 |* NONE *| 03159 |* *| 03160 |* Returns: *| 03161 |* NOTHING *| 03162 |* *| 03163 \******************************************************************************/ 03164 static void parse_inline_always_never(boolean always) 03165 03166 { 03167 boolean amb_ref; 03168 int attr_idx; 03169 int host_attr_idx; 03170 int host_name_idx; 03171 int name_idx; 03172 03173 03174 TRACE (Func_Entry, "parse_inline_always_never", NULL); 03175 03176 do { 03177 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 03178 amb_ref = FALSE; 03179 attr_idx = srch_sym_tbl(TOKEN_STR(token), 03180 TOKEN_LEN(token), 03181 &name_idx); 03182 03183 if (attr_idx != NULL_IDX) { 03184 host_attr_idx = attr_idx; 03185 03186 if (!LN_DEF_LOC(name_idx)) { 03187 amb_ref = TRUE; 03188 03189 while (AT_ATTR_LINK(host_attr_idx) != NULL_IDX) { 03190 host_attr_idx = AT_ATTR_LINK(host_attr_idx); 03191 } 03192 } 03193 } 03194 else { /* any other reference is ambiguous */ 03195 amb_ref = TRUE; 03196 host_attr_idx = srch_host_sym_tbl(TOKEN_STR(token), 03197 TOKEN_LEN(token), 03198 &host_name_idx, 03199 TRUE); 03200 03201 if (host_attr_idx != NULL_IDX) { 03202 03203 if (AT_IS_INTRIN(host_attr_idx) && 03204 ATI_FIRST_SPECIFIC_IDX(host_attr_idx) == NULL_IDX) { 03205 complete_intrinsic_definition(host_attr_idx); 03206 attr_idx = srch_sym_tbl(TOKEN_STR(token), 03207 TOKEN_LEN(token), 03208 &name_idx); 03209 } 03210 03211 /* copy the attr into the local scp */ 03212 03213 attr_idx = ntr_host_in_sym_tbl(&token, 03214 name_idx, 03215 host_attr_idx, 03216 host_name_idx, 03217 TRUE); 03218 03219 if (AT_IS_INTRIN(host_attr_idx)) { 03220 COPY_VARIANT_ATTR_INFO(host_attr_idx, 03221 attr_idx, 03222 Interface); 03223 03224 AT_IS_INTRIN(attr_idx) = TRUE; 03225 AT_ATTR_LINK(attr_idx) = NULL_IDX; 03226 AT_ELEMENTAL_INTRIN(attr_idx) = 03227 AT_ELEMENTAL_INTRIN(host_attr_idx); 03228 AT_DEF_LINE(attr_idx) = TOKEN_LINE(token); 03229 AT_DEF_COLUMN(attr_idx) = TOKEN_COLUMN(token); 03230 } 03231 else if (AT_OBJ_CLASS(attr_idx) != Interface) { 03232 AT_ATTR_LINK(attr_idx) = host_attr_idx; 03233 03234 while (AT_ATTR_LINK(host_attr_idx) != NULL_IDX) { 03235 host_attr_idx = AT_ATTR_LINK(host_attr_idx); 03236 } 03237 } 03238 } 03239 } 03240 03241 if (attr_idx == NULL_IDX) { 03242 attr_idx = ntr_sym_tbl(&token, name_idx); 03243 AT_OBJ_CLASS(attr_idx) = Pgm_Unit; 03244 ATP_PGM_UNIT(attr_idx) = Pgm_Unknown; 03245 ATP_SCP_IDX(attr_idx) = curr_scp_idx; 03246 ATP_PROC(attr_idx) = Unknown_Proc; 03247 MAKE_EXTERNAL_NAME(attr_idx, 03248 AT_NAME_IDX(attr_idx), 03249 AT_NAME_LEN(attr_idx)); 03250 } 03251 else if (!amb_ref) { 03252 03253 /* Allow the inline directive with user specified intrinsics */ 03254 /* We will check for user specified intrinsics in decl_sem */ 03255 03256 if (fnd_semantic_err(Obj_Inline, 03257 TOKEN_LINE(token), 03258 TOKEN_COLUMN(token), 03259 attr_idx, 03260 TRUE)) { 03261 03262 goto NEXT; 03263 } 03264 } 03265 03266 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit && 03267 (ATP_INLINE_ALWAYS(attr_idx) || ATP_INLINE_NEVER(attr_idx))) { 03268 03269 if ((always && ATP_INLINE_NEVER(attr_idx)) || 03270 (!always && ATP_INLINE_ALWAYS(attr_idx))) { 03271 PRINTMSG(AT_DEF_LINE(attr_idx), 1147, Error, 03272 AT_DEF_COLUMN(attr_idx), 03273 AT_OBJ_NAME_PTR(attr_idx)); 03274 } 03275 } 03276 else { 03277 03278 if (AT_OBJ_CLASS(attr_idx) == Interface) { 03279 03280 if (ATI_INLINE_ALWAYS(attr_idx) || ATI_INLINE_NEVER(attr_idx)) { 03281 03282 if ((always && ATI_INLINE_NEVER(attr_idx)) || 03283 (!always && ATI_INLINE_ALWAYS(attr_idx))) { 03284 PRINTMSG(AT_DEF_LINE(attr_idx), 1147, Error, 03285 AT_DEF_COLUMN(attr_idx), 03286 AT_OBJ_NAME_PTR(attr_idx)); 03287 } 03288 } 03289 else if (always) { 03290 ATI_INLINE_ALWAYS(attr_idx) = TRUE; 03291 } 03292 else { 03293 ATI_INLINE_NEVER(attr_idx) = TRUE; 03294 } 03295 } 03296 else { 03297 03298 if (AT_OBJ_CLASS(attr_idx) == Data_Obj) { /* Switch to Function*/ 03299 chg_data_obj_to_pgm_unit(attr_idx, Pgm_Unknown, Unknown_Proc); 03300 } 03301 03302 if (always) { 03303 ATP_INLINE_ALWAYS(attr_idx) = TRUE; 03304 } 03305 else { 03306 ATP_INLINE_NEVER(attr_idx) = TRUE; 03307 } 03308 } 03309 } 03310 } 03311 else if (!parse_err_flush(Find_Comma, "procedure name")) { 03312 break; /* Couldn't recover. Hit EOS */ 03313 } 03314 03315 NEXT: 03316 03317 if (LA_CH_VALUE == COMMA) { 03318 NEXT_LA_CH; 03319 } 03320 else if (LA_CH_VALUE == EOS || 03321 !parse_err_flush(Find_Comma, ", or "EOS_STR)) { 03322 break; 03323 } 03324 else { /* Issued error and recovered at a comma */ 03325 NEXT_LA_CH; 03326 } 03327 } 03328 while (TRUE); 03329 03330 NEXT_LA_CH; /* Pick up EOS */ 03331 03332 TRACE (Func_Exit, "parse_inline_always_never", NULL); 03333 03334 return; 03335 03336 } /* parse_inline_always_never */ 03337 03338 /******************************************************************************\ 03339 |* *| 03340 |* Description: *| 03341 |* Check an index to see if it needs a type update. *| 03342 |* *| 03343 |* Input parameters: *| 03344 |* NONE *| 03345 |* *| 03346 |* Output parameters: *| 03347 |* NONE *| 03348 |* *| 03349 |* Returns: *| 03350 |* NOTHING *| 03351 |* *| 03352 \******************************************************************************/ 03353 static int update_fld_type(fld_type fld, 03354 int idx, 03355 int new_type) 03356 03357 { 03358 int new_idx; 03359 long_type the_constant[MAX_WORDS_FOR_INTEGER]; 03360 int type_idx; 03361 03362 03363 TRACE (Func_Entry, "update_fld_type", NULL); 03364 03365 switch (fld) { 03366 case CN_Tbl_Idx: 03367 03368 if (CN_TYPE_IDX(idx) == INTEGER_DEFAULT_TYPE) { 03369 type_idx = new_type; 03370 03371 if (folder_driver((char *)CN_CONST(idx), 03372 INTEGER_DEFAULT_TYPE, 03373 NULL, 03374 NULL_IDX, 03375 the_constant, 03376 &type_idx, 03377 stmt_start_line, 03378 stmt_start_col, 03379 1, 03380 Cvrt_Opr)) { 03381 new_idx = ntr_const_tbl(new_type, 03382 FALSE, 03383 the_constant); 03384 } 03385 } 03386 break; 03387 03388 case AT_Tbl_Idx: 03389 03390 if (AT_OBJ_CLASS(idx) == Data_Obj) { 03391 03392 switch (ATD_CLASS(idx)) { 03393 case Constant: 03394 03395 if (ATD_TYPE_IDX(idx) == INTEGER_DEFAULT_TYPE) { 03396 new_idx = update_fld_type(CN_Tbl_Idx, 03397 ATD_CONST_IDX(idx), 03398 new_type); 03399 ATD_CONST_IDX(idx) = new_idx; 03400 } 03401 break; 03402 03403 case Function_Result: 03404 case Atd_Unknown: 03405 case Dummy_Argument: 03406 case CRI__Pointee: 03407 case Struct_Component: 03408 break; 03409 03410 case Compiler_Tmp: 03411 new_idx = update_fld_type((fld_type) ATD_FLD(idx), 03412 ATD_TMP_IDX(idx), 03413 new_type); 03414 03415 if (ATD_FLD(idx) == CN_Tbl_Idx) { 03416 ATD_TMP_IDX(idx) = new_idx; 03417 } 03418 break; 03419 } /* End switch */ 03420 03421 if (ATD_TYPE_IDX(idx) == INTEGER_DEFAULT_TYPE) { 03422 ATD_TYPE_IDX(idx) = new_type; 03423 } 03424 } 03425 else if (AT_OBJ_CLASS(idx) == Pgm_Unit && 03426 ATP_PGM_UNIT(idx) == Function && 03427 ATP_RSLT_IDX(idx) != NULL_IDX && 03428 ATD_TYPE_IDX(ATP_RSLT_IDX(idx)) == INTEGER_DEFAULT_TYPE) { 03429 ATD_TYPE_IDX(ATP_RSLT_IDX(idx)) = new_type; 03430 } 03431 new_idx = NULL_IDX; 03432 03433 break; 03434 03435 case IR_Tbl_Idx: 03436 03437 new_idx = update_fld_type(IR_FLD_L(idx), IR_IDX_L(idx), new_type); 03438 03439 if (IR_FLD_L(idx) == CN_Tbl_Idx) { 03440 IR_IDX_L(idx) = new_idx; 03441 } 03442 03443 new_idx = update_fld_type(IR_FLD_R(idx), IR_IDX_R(idx), new_type); 03444 03445 if (IR_FLD_R(idx) == CN_Tbl_Idx) { 03446 IR_IDX_R(idx) = new_idx; 03447 } 03448 03449 new_idx = NULL_IDX; 03450 03451 if (IR_TYPE_IDX(idx) == INTEGER_DEFAULT_TYPE) { 03452 IR_TYPE_IDX(idx) = new_type; 03453 } 03454 03455 break; 03456 03457 case IL_Tbl_Idx: 03458 03459 while (idx != NULL_IDX) { 03460 new_idx = update_fld_type(IL_FLD(idx), IL_IDX(idx), new_type); 03461 03462 if (IL_FLD(idx) == CN_Tbl_Idx) { 03463 IL_IDX(idx) = new_idx; 03464 } 03465 idx = IL_NEXT_LIST_IDX(idx); 03466 } 03467 new_idx = NULL_IDX; 03468 break; 03469 03470 case NO_Tbl_Idx: 03471 case SH_Tbl_Idx: 03472 new_idx = NULL_IDX; 03473 break; 03474 03475 } /* End switch */ 03476 03477 TRACE (Func_Exit, "update_fld_type", NULL); 03478 03479 return(new_idx); 03480 03481 } /* update_fld_type */ 03482 03483 /******************************************************************************\ 03484 |* *| 03485 |* Description: *| 03486 |* This routine parses the CDIR$ SYMMETRIC line. *| 03487 |* *| 03488 |* Input parameters: *| 03489 |* NONE *| 03490 |* *| 03491 |* Output parameters: *| 03492 |* NONE *| 03493 |* *| 03494 |* Returns: *| 03495 |* NOTHING *| 03496 |* *| 03497 \******************************************************************************/ 03498 static void parse_symmetric_dir(void) 03499 03500 { 03501 int attr_idx; 03502 int name_idx; 03503 03504 03505 TRACE (Func_Entry, "parse_symmetric_dir", NULL); 03506 03507 do { 03508 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 03509 attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token), 03510 &name_idx); 03511 03512 if (attr_idx == NULL_IDX) { 03513 attr_idx = ntr_sym_tbl(&token, name_idx); 03514 LN_DEF_LOC(name_idx) = TRUE; 03515 AT_OBJ_CLASS(attr_idx) = Data_Obj; 03516 ATD_SYMMETRIC(attr_idx) = TRUE; 03517 ATD_CLASS(attr_idx) = Variable; 03518 SET_IMPL_TYPE(attr_idx); 03519 } 03520 else if (!fnd_semantic_err(Obj_Symmetric, 03521 TOKEN_LINE(token), 03522 TOKEN_COLUMN(token), 03523 attr_idx, 03524 TRUE)) { 03525 03526 if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) { 03527 AT_ATTR_LINK(attr_idx) = NULL_IDX; 03528 LN_DEF_LOC(name_idx) = TRUE; 03529 } 03530 03531 ATD_SYMMETRIC(attr_idx) = TRUE; 03532 ATD_CLASS(attr_idx) = Variable; 03533 } 03534 } 03535 else if (!parse_err_flush(Find_Comma, "procedure name")) { 03536 break; /* Couldn't recover. Hit EOS */ 03537 } 03538 03539 if (LA_CH_VALUE == COMMA) { 03540 NEXT_LA_CH; 03541 } 03542 else if (LA_CH_VALUE == EOS || 03543 !parse_err_flush(Find_Comma, ", or "EOS_STR)) { 03544 break; 03545 } 03546 else { /* Issued error and recovered at a comma */ 03547 NEXT_LA_CH; 03548 } 03549 } 03550 while (TRUE); 03551 03552 NEXT_LA_CH; /* Pick up EOS */ 03553 03554 TRACE (Func_Exit, "parse_symmetric_dir", NULL); 03555 03556 return; 03557 03558 } /* parse_symmetric_dir */ 03559 03560 /******************************************************************************\ 03561 |* *| 03562 |* Description: *| 03563 |* This routine parses the !DIR$ directives on one line of source. *| 03564 |* *| 03565 |* Input parameters: *| 03566 |* NONE *| 03567 |* *| 03568 |* Output parameters: *| 03569 |* NONE *| 03570 |* *| 03571 |* Returns: *| 03572 |* NOTHING *| 03573 |* *| 03574 \******************************************************************************/ 03575 static void parse_dir_directives(void) 03576 { 03577 03578 int blk_idx; 03579 int buf_idx; 03580 int cdir_info_idx; 03581 int ir_idx; 03582 int label_idx; 03583 int list_idx; 03584 opnd_type opnd; 03585 operator_type opr; 03586 int stmt_num; 03587 int type_idx; 03588 03589 # if defined(GENERATE_WHIRL) 03590 int cvrt_idx; 03591 # endif 03592 03593 03594 TRACE (Func_Entry, "parse_dir_directives", NULL); 03595 03596 for (;;) { 03597 03598 if (TOKEN_VALUE(token) > Tok_Dir_Start && 03599 TOKEN_VALUE(token) < Tok_Dir_End && 03600 disregard_directive[TOKEN_VALUE(token) - Tok_Dir_Start]) { 03601 03602 /* Some CDIR$s have a list associated with them. In such a case, */ 03603 /* if the CDIR$ is being ignored, we can flush to the end of the */ 03604 /* line because no other CDIR$ can follow it on the line. In all */ 03605 /* other cases, we can only flush to the next comma so that a */ 03606 /* following CDIR$ can be processed (if one exists). */ 03607 03608 /* There are probably several more CDIR$s that need to be added to */ 03609 /* "list" group once we implement the MPP/CRAFT CDIR$s. */ 03610 03611 switch (TOKEN_VALUE(token)) { 03612 03613 case Tok_Dir_Auxiliary: 03614 case Tok_Dir_Blockable: 03615 case Tok_Dir_Blockingsize: 03616 case Tok_Dir_Bounds: 03617 case Tok_Dir_Cache_Align: 03618 case Tok_Dir_Cache_Noalloc: 03619 case Tok_Dir_Cncall: 03620 case Tok_Dir_Common: 03621 case Tok_Dir_Inline_Always: 03622 case Tok_Dir_Inline_Never: 03623 case Tok_Dir_Maxcpus: 03624 case Tok_Dir_Nobounds: 03625 case Tok_Dir_Numcpus: 03626 case Tok_Dir_Cache_Bypass: 03627 case Tok_Dir_Nosideeffects: 03628 case Tok_Dir_Permutation: 03629 case Tok_Dir_Suppress: 03630 case Tok_Dir_Symmetric: 03631 case Tok_Dir_Taskcommon: 03632 case Tok_Dir_Vfunction: 03633 parse_err_flush(Find_EOS, NULL); 03634 break; 03635 03636 default: 03637 parse_err_flush(Find_Comma, NULL); 03638 } 03639 03640 goto CONTINUE; 03641 } 03642 03643 if (TOKEN_VALUE(token) <= Tok_Dir_Start || 03644 TOKEN_VALUE(token) >= Tok_Dir_End) { 03645 PRINTMSG(TOKEN_LINE(token), 790, Warning, TOKEN_COLUMN(token)); 03646 parse_err_flush(Find_EOS, NULL); 03647 goto CONTINUE; /* Invalid token */ 03648 } 03649 03650 cdir_info_idx = TOKEN_VALUE(token) - Tok_Dir_Start; 03651 03652 /* The following determines if the directive is allowed on the */ 03653 /* platform that this compiler is built for. The table is in */ 03654 /* p_directiv.h and the target information is in target.m */ 03655 03656 if (!cdir_info[cdir_info_idx].on_platform) { 03657 PRINTMSG(TOKEN_LINE(token), cdir_info[cdir_info_idx].msg_num, Warning, 03658 TOKEN_COLUMN(token)); 03659 parse_err_flush(Find_EOS, NULL); 03660 goto CONTINUE; 03661 } 03662 03663 if (cdir_info[cdir_info_idx].issue_795 && 03664 curr_stmt_category < Dir_Integer_Stmt_Cat) { 03665 PRINTMSG(TOKEN_LINE(token), 795, Warning, 03666 TOKEN_COLUMN(token), cdir_info[cdir_info_idx].name); 03667 parse_err_flush(Find_EOS, NULL); 03668 goto CONTINUE; 03669 } 03670 03671 if (cdir_info[cdir_info_idx].issue_531 && 03672 curr_stmt_category >= Executable_Stmt_Cat) { 03673 PRINTMSG(TOKEN_LINE(token), 531, Error, 03674 TOKEN_COLUMN(token), cdir_info[cdir_info_idx].name); 03675 parse_err_flush(Find_EOS, NULL); 03676 goto CONTINUE; 03677 } 03678 03679 switch (TOKEN_VALUE(token)) { 03680 case Tok_Dir_Align: 03681 03682 if (opt_flags.scalar_lvl == Scalar_Lvl_0) { 03683 parse_err_flush(Find_Comma, NULL); 03684 } 03685 else { 03686 ir_idx = gen_directive_ir(Align_Cdir_Opr); 03687 } 03688 break; 03689 03690 03691 case Tok_Dir_Auxiliary: 03692 parse_auxiliary_dir(); 03693 goto EXIT; 03694 03695 03696 case Tok_Dir_Bl: 03697 03698 if (opt_flags.scalar_lvl == Scalar_Lvl_0 || !opt_flags.bottom_load) { 03699 parse_err_flush(Find_Comma, NULL); 03700 } 03701 else { 03702 cdir_switches.bl = TRUE; 03703 ir_idx = gen_directive_ir(Bl_Cdir_Opr); 03704 } 03705 break; 03706 03707 case Tok_Dir_Blockable: 03708 case Tok_Dir_Blockingsize: 03709 case Tok_Dir_Interchange: 03710 parse_star_dir_directives(); 03711 goto EXIT; 03712 03713 case Tok_Dir_Bounds: 03714 cdir_switches.bounds = TRUE; 03715 ir_idx = gen_directive_ir(Bounds_Cdir_Opr); 03716 03717 if (LA_CH_VALUE != EOS) { 03718 parse_var_name_list(&opnd, -1); 03719 COPY_OPND(IR_OPND_L(ir_idx), opnd); 03720 03721 if (LA_CH_VALUE != EOS) { 03722 parse_err_flush(Find_EOS, EOS_STR); 03723 } 03724 NEXT_LA_CH; /* pick up EOS */ 03725 } 03726 else { 03727 NEXT_LA_CH; /* pick up EOS */ 03728 } 03729 03730 goto EXIT; 03731 03732 03733 case Tok_Dir_Cache_Align: 03734 03735 ir_idx = gen_directive_ir(Cachealign_Cdir_Opr); 03736 03737 if (LA_CH_VALUE != EOS) { 03738 parse_cache_align_name_list(&opnd); 03739 COPY_OPND(IR_OPND_L(ir_idx), opnd); 03740 } 03741 else { 03742 parse_err_flush(Find_EOS, "IDENTIFIER"); 03743 } 03744 break; 03745 03746 03747 case Tok_Dir_Cache_Bypass: 03748 ir_idx = gen_directive_ir(Cache_Bypass_Cdir_Opr); 03749 parse_cache_bypass_dir(&opnd); 03750 COPY_OPND(IR_OPND_L(ir_idx), opnd); 03751 goto EXIT; 03752 03753 case Tok_Dir_Cache_Noalloc: 03754 parse_cache_noalloc(); 03755 goto EXIT; 03756 03757 03758 case Tok_Dir_Cncall: 03759 03760 /* this is duplicate code, taken from Tok_Mic_Cncall */ 03761 03762 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 03763 ir_idx = gen_directive_ir(Cncall_Cmic_Opr); 03764 03765 if (LA_CH_VALUE != EOS && LA_CH_VALUE != COMMA) { 03766 03767 /* Arguments are specified on the CNCALL line. Issue caution */ 03768 /* message and ignore the arguments. Because there is a list,*/ 03769 /* cncall must be the only directive on the line, so flush. */ 03770 03771 PRINTMSG(LA_CH_LINE, 1123, Caution, LA_CH_COLUMN); 03772 parse_err_flush(Find_EOS, NULL); 03773 } 03774 03775 break; 03776 03777 case Tok_Dir_Common: 03778 parse_common_dirs(Common); 03779 goto EXIT; 03780 03781 03782 case Tok_Dir_Concurrent: 03783 03784 if (LA_CH_VALUE != EOS && LA_CH_VALUE != COMMA) { 03785 buf_idx = LA_CH_BUF_IDX; 03786 stmt_num = LA_CH_STMT_NUM; 03787 03788 if (MATCHED_TOKEN_CLASS(Tok_Class_Id) && 03789 TOKEN_LEN(token) == 13 && 03790 strncmp("SAFE_DISTANCE", TOKEN_STR(token), 13) == IDENTICAL) { 03791 03792 ir_idx = gen_directive_ir(Concurrent_Cdir_Opr); 03793 03794 if (LA_CH_VALUE == EQUAL) { 03795 NEXT_LA_CH; 03796 03797 if (!parse_expr(&opnd)) { 03798 parse_err_flush(Find_EOS, NULL); 03799 } 03800 else { 03801 COPY_OPND(IR_OPND_L(ir_idx), opnd); 03802 } 03803 } 03804 else { 03805 parse_err_flush(Find_EOS, "="); 03806 } 03807 } 03808 else { 03809 reset_lex(buf_idx, stmt_num); 03810 parse_err_flush(Find_EOS, "SAFE_DISTANCE = "); 03811 } 03812 } 03813 else { 03814 ir_idx = gen_directive_ir(Concurrent_Cdir_Opr); 03815 } 03816 break; 03817 03818 03819 case Tok_Dir_Copy_Assumed_Shape: 03820 03821 if (LA_CH_VALUE != EOS) { 03822 parse_copy_assumed_shape_dir(); 03823 } 03824 else { /* set the global flag */ 03825 SCP_COPY_ASSUMED_SHAPE(curr_scp_idx) = TRUE; 03826 03827 if (SCP_COPY_ASSUMED_LIST(curr_scp_idx) == NULL_IDX) { 03828 NTR_IR_LIST_TBL(list_idx); 03829 IL_LINE_NUM(list_idx) = TOKEN_LINE(token); 03830 IL_COL_NUM(list_idx) = TOKEN_COLUMN(token); 03831 SCP_COPY_ASSUMED_LIST(curr_scp_idx) = list_idx; 03832 } 03833 03834 NEXT_LA_CH; /* Pick up EOS */ 03835 } 03836 03837 goto EXIT; 03838 03839 03840 case Tok_Dir_Eject: 03841 03842 if ((cif_flags & MISC_RECS) != 0) { 03843 cif_directive_rec(CIF_Eject, 03844 TOKEN_LINE(token), 03845 TOKEN_COLUMN(token)); 03846 } 03847 break; 03848 03849 03850 case Tok_Dir_Flow: 03851 cdir_switches.flow = TRUE; 03852 break; 03853 03854 03855 case Tok_Dir_Free: 03856 case Tok_Dir_Fixed: 03857 03858 /* all semantics are done in src_input.c */ 03859 /* context checks should be done here. */ 03860 03861 parse_err_flush(Find_EOS, NULL); 03862 break; 03863 03864 03865 case Tok_Dir_Id: 03866 parse_id_directive(); 03867 break; 03868 03869 03870 case Tok_Dir_Ignore_TKR: 03871 03872 if (LA_CH_VALUE != EOS) { 03873 parse_ignore_tkr(); 03874 } 03875 else { /* set the global flag */ 03876 SCP_IGNORE_TKR(curr_scp_idx) = TRUE; 03877 NEXT_LA_CH; 03878 } 03879 03880 goto EXIT; 03881 03882 03883 case Tok_Dir_Inline: 03884 case Tok_Dir_Inline_Always: 03885 case Tok_Dir_Inline_Never: 03886 03887 if (opt_flags.inline_lvl == Inline_Lvl_0 && !dump_flags.preinline) { 03888 parse_err_flush(Find_EOS, NULL); 03889 break; 03890 } 03891 03892 if (TOKEN_VALUE(token) == Tok_Dir_Inline) { 03893 cdir_switches.do_inline = TRUE; 03894 ir_idx = gen_directive_ir(Inline_Cdir_Opr); 03895 } 03896 else { 03897 parse_inline_always_never(TOKEN_VALUE(token) == 03898 Tok_Dir_Inline_Always); 03899 goto EXIT; 03900 } 03901 break; 03902 03903 03904 case Tok_Dir_Ivdep: 03905 03906 03907 # if defined(_ACCEPT_VECTOR) 03908 03909 /* On some non-vector platforms we accept IVDEP */ 03910 03911 if (!cdir_switches.vector) { 03912 parse_err_flush(Find_Comma, NULL); 03913 break; 03914 } 03915 # endif 03916 03917 if (LA_CH_VALUE != EOS && LA_CH_VALUE != COMMA) { 03918 buf_idx = LA_CH_BUF_IDX; 03919 stmt_num = LA_CH_STMT_NUM; 03920 03921 if (MATCHED_TOKEN_CLASS(Tok_Class_Id) && 03922 TOKEN_LEN(token) == 6 && 03923 strncmp("SAFEVL", TOKEN_STR(token), 6) == IDENTICAL) { 03924 03925 # if defined(_TARGET_OS_MAX) || (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) 03926 03927 /* If SAFEVL specified, issue warning and ignore ivdep */ 03928 03929 PRINTMSG(TOKEN_LINE(token), 1317,Warning,TOKEN_COLUMN(token)); 03930 # else 03931 ir_idx = gen_directive_ir(Ivdep_Cdir_Opr); 03932 # endif 03933 03934 if (LA_CH_VALUE == EQUAL) { 03935 NEXT_LA_CH; 03936 03937 if (!parse_expr(&opnd)) { 03938 parse_err_flush(Find_EOS, NULL); 03939 } 03940 else { 03941 03942 # if !defined(_TARGET_OS_MAX) && !(defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) 03943 COPY_OPND(IR_OPND_L(ir_idx), opnd); 03944 # endif 03945 } 03946 } 03947 else { 03948 parse_err_flush(Find_EOS, "="); 03949 } 03950 } 03951 else { 03952 reset_lex(buf_idx,stmt_num); 03953 03954 # if !defined(_TARGET_OS_MAX) 03955 parse_err_flush(Find_EOS, "SAFEVL = "); 03956 # endif 03957 } 03958 } 03959 else { 03960 ir_idx = gen_directive_ir(Ivdep_Cdir_Opr); 03961 } 03962 break; 03963 03964 03965 case Tok_Dir_List: 03966 03967 if ((cif_flags & MISC_RECS) != 0) { 03968 cif_directive_rec(CIF_List, 03969 TOKEN_LINE(token), 03970 TOKEN_COLUMN(token)); 03971 } 03972 break; 03973 03974 03975 case Tok_Dir_Mark: 03976 03977 if (!opt_flags.mark) { 03978 parse_err_flush(Find_Comma, NULL); 03979 break; 03980 } 03981 03982 cdir_switches.mark = TRUE; 03983 ir_idx = gen_directive_ir(Mark_Cdir_Opr); 03984 03985 if (LA_CH_VALUE == EQUAL) { 03986 NEXT_LA_CH; 03987 03988 if (!MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 03989 parse_err_flush(Find_EOS, NULL); 03990 NEXT_LA_CH; 03991 } 03992 else { 03993 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX); 03994 TYP_CHAR_CLASS(TYP_WORK_IDX) = Const_Len_Char; 03995 TYP_TYPE(TYP_WORK_IDX) = Character; 03996 TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE; 03997 TYP_FLD(TYP_WORK_IDX) = CN_Tbl_Idx; 03998 TYP_IDX(TYP_WORK_IDX) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 03999 TOKEN_LEN(token)); 04000 type_idx = ntr_type_tbl(); 04001 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 04002 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 04003 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 04004 IR_IDX_L(ir_idx) = ntr_const_tbl(type_idx, 04005 FALSE, 04006 (long_type *) &(TOKEN_ID(token).words)); 04007 } 04008 } 04009 else { 04010 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 04011 IR_IDX_L(ir_idx) = cdir_switches.mark_cmdline_idx; 04012 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 04013 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 04014 } 04015 break; 04016 04017 case Tok_Dir_Modinline: 04018 case Tok_Dir_Nomodinline: 04019 04020 if (!opt_flags.modinline) { 04021 parse_err_flush(Find_Comma, NULL); 04022 } 04023 else if (ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) != Module) { 04024 PRINTMSG(TOKEN_LINE(token), 1169, Warning, TOKEN_COLUMN(token)); 04025 } 04026 else { 04027 ATP_MAY_INLINE(SCP_ATTR_IDX(curr_scp_idx)) = 04028 TOKEN_VALUE(token) == Tok_Dir_Modinline; 04029 } 04030 break; 04031 04032 04033 case Tok_Dir_Name: 04034 parse_name_dir(); 04035 goto EXIT; 04036 04037 04038 case Tok_Dir_Nextscalar: 04039 04040 if (!cdir_switches.vector) { 04041 parse_err_flush(Find_Comma, NULL); 04042 } 04043 else { 04044 ir_idx = gen_directive_ir(Nextscalar_Cdir_Opr); 04045 } 04046 break; 04047 04048 04049 case Tok_Dir_Nobl: 04050 04051 if (opt_flags.scalar_lvl == Scalar_Lvl_0 || !opt_flags.bottom_load) { 04052 parse_err_flush(Find_Comma, NULL); 04053 } 04054 else { 04055 cdir_switches.bl = FALSE; 04056 ir_idx = gen_directive_ir(Nobl_Cdir_Opr); 04057 } 04058 break; 04059 04060 case Tok_Dir_Noblocking: 04061 ir_idx = gen_directive_ir(Noblocking_Dir_Opr); 04062 break; 04063 04064 case Tok_Dir_Nobounds: 04065 04066 cdir_switches.bounds = FALSE; 04067 ir_idx = gen_directive_ir(Nobounds_Cdir_Opr); 04068 04069 if (LA_CH_VALUE != EOS) { 04070 parse_var_name_list(&opnd, -1); 04071 COPY_OPND(IR_OPND_L(ir_idx), opnd); 04072 04073 if (LA_CH_VALUE != EOS) { 04074 parse_err_flush(Find_EOS, EOS_STR); 04075 } 04076 NEXT_LA_CH; /* pick up EOS */ 04077 } 04078 else { 04079 NEXT_LA_CH; /* pick up EOS */ 04080 } 04081 04082 goto EXIT; 04083 04084 04085 case Tok_Dir_Noflow: 04086 cdir_switches.flow = FALSE; 04087 break; 04088 04089 04090 case Tok_Dir_Noinline: 04091 04092 if (opt_flags.inline_lvl == Inline_Lvl_0 && !dump_flags.preinline) { 04093 parse_err_flush(Find_Comma, NULL); 04094 } 04095 else { 04096 cdir_switches.do_inline = FALSE; 04097 ir_idx = gen_directive_ir(Noinline_Cdir_Opr); 04098 } 04099 break; 04100 04101 04102 case Tok_Dir_Nointerchange: 04103 04104 /* Use the same operator for both the MIPS and Cray versions. */ 04105 04106 ir_idx = gen_directive_ir(Nointerchange_Dir_Opr); 04107 break; 04108 04109 04110 case Tok_Dir_Nolist: 04111 04112 if ((cif_flags & MISC_RECS) != 0) { 04113 cif_directive_rec(CIF_Nolist, 04114 TOKEN_LINE(token), 04115 TOKEN_COLUMN(token)); 04116 } 04117 break; 04118 04119 04120 case Tok_Dir_Nomark: 04121 04122 if (opt_flags.mark) { 04123 cdir_switches.mark = FALSE; 04124 ir_idx = gen_directive_ir(Nomark_Cdir_Opr); 04125 } 04126 else { 04127 parse_err_flush(Find_Comma, NULL); 04128 } 04129 break; 04130 04131 04132 case Tok_Dir_Nopattern: 04133 04134 if (!opt_flags.pattern) { 04135 parse_err_flush(Find_Comma, NULL); 04136 } 04137 else { 04138 cdir_switches.pattern = FALSE; 04139 ir_idx = gen_directive_ir(Nopattern_Cdir_Opr); 04140 } 04141 break; 04142 04143 04144 case Tok_Dir_Norecurrence: 04145 04146 if (!opt_flags.recurrence) { 04147 parse_err_flush(Find_Comma, NULL); 04148 } 04149 else { 04150 cdir_switches.recurrence = FALSE; 04151 ir_idx = gen_directive_ir(Norecurrence_Cdir_Opr); 04152 } 04153 break; 04154 04155 04156 case Tok_Dir_Nosideeffects: 04157 parse_nosideeffects_dir(); 04158 goto EXIT; 04159 04160 04161 case Tok_Dir_Nosplit: 04162 04163 if (opt_flags.split_lvl == Split_Lvl_0) { 04164 parse_err_flush(Find_Comma, NULL); 04165 } 04166 else { 04167 ir_idx = gen_directive_ir(Nosplit_Cdir_Opr); 04168 } 04169 break; 04170 04171 04172 case Tok_Dir_Nostream: 04173 04174 if (opt_flags.stream_lvl == Stream_Lvl_0) { 04175 parse_err_flush(Find_Comma, NULL); 04176 } 04177 else { 04178 cdir_switches.stream = FALSE; 04179 ir_idx = gen_directive_ir(Nostream_Dir_Opr); 04180 } 04181 break; 04182 04183 04184 case Tok_Dir_Notask: 04185 04186 # if !(defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) 04187 if (opt_flags.task_lvl == Task_Lvl_0) { 04188 parse_err_flush(Find_Comma, NULL); 04189 break; 04190 } 04191 # endif 04192 04193 cdir_switches.task = FALSE; 04194 cdir_switches.notask_region = TRUE; 04195 04196 /* check block stack for containing do loops */ 04197 04198 blk_idx = blk_stk_idx; 04199 04200 while (BLK_TYPE(blk_idx) >= Do_Blk && blk_idx > 0) { 04201 04202 if (BLK_TYPE(blk_idx) == Do_Blk) { 04203 ATL_NOTASK(BLK_TOP_LBL_IDX(blk_idx)) = TRUE; 04204 } 04205 04206 blk_idx--; 04207 } 04208 04209 ir_idx = gen_directive_ir(Notask_Cdir_Opr); 04210 break; 04211 04212 04213 case Tok_Dir_Nounroll: 04214 04215 if (opt_flags.unroll_lvl == Unroll_Lvl_0) { 04216 parse_err_flush(Find_Comma, NULL); 04217 } 04218 else { 04219 ir_idx = gen_directive_ir(Nounroll_Cdir_Opr); 04220 } 04221 break; 04222 04223 04224 case Tok_Dir_Novector: 04225 04226 if (opt_flags.vector_lvl == Vector_Lvl_0) { 04227 parse_err_flush(Find_Comma, NULL); 04228 break; 04229 } 04230 04231 cdir_switches.vector = FALSE; 04232 04233 /* check block stack for containing do loops */ 04234 04235 blk_idx = blk_stk_idx; 04236 04237 while (BLK_TYPE(blk_idx) >= Do_Blk && blk_idx > 0) { 04238 04239 if (BLK_TYPE(blk_idx) == Do_Blk) { 04240 ATL_NOVECTOR(BLK_TOP_LBL_IDX(blk_idx)) = TRUE; 04241 } 04242 04243 blk_idx--; 04244 } 04245 04246 ir_idx = gen_directive_ir(Novector_Cdir_Opr); 04247 break; 04248 04249 04250 case Tok_Dir_Novsearch: 04251 04252 if (!opt_flags.vsearch || !cdir_switches.vector) { 04253 parse_err_flush(Find_Comma, NULL); 04254 } 04255 else { 04256 cdir_switches.vsearch = FALSE; 04257 ir_idx = gen_directive_ir(Novsearch_Cdir_Opr); 04258 } 04259 break; 04260 04261 04262 case Tok_Dir_Numcpus: 04263 04264 /* this is duplicate code, taken from Tok_Mic_Numcpus */ 04265 04266 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 04267 ir_idx = gen_directive_ir(Numcpus_Cmic_Opr); 04268 04269 if (LA_CH_VALUE != LPAREN) { /* Expected value */ 04270 PRINTMSG(LA_CH_LINE, 1124, Error, LA_CH_COLUMN); 04271 parse_err_flush(Find_EOS, NULL); 04272 } 04273 else { 04274 NEXT_LA_CH; 04275 parse_expr(&opnd); 04276 COPY_OPND(IR_OPND_L(ir_idx), opnd); 04277 04278 if (LA_CH_VALUE != RPAREN) { 04279 parse_err_flush(Find_EOS, ")"); 04280 } 04281 else { 04282 NEXT_LA_CH; /* Pick up Rparen. */ 04283 } 04284 04285 # if defined(GENERATE_WHIRL) 04286 /* turn this into a call */ 04287 04288 COPY_OPND(IR_OPND_R(ir_idx), IR_OPND_L(ir_idx)); 04289 04290 if (glb_tbl_idx[Set_Numthreads_Attr_Idx] == NULL_IDX) { 04291 glb_tbl_idx[Set_Numthreads_Attr_Idx] = create_lib_entry_attr( 04292 SET_NUMTHREADS_ENTRY, 04293 SET_NUMTHREADS_NAME_LEN, 04294 IR_LINE_NUM(ir_idx), 04295 IR_COL_NUM(ir_idx)); 04296 } 04297 04298 ADD_ATTR_TO_LOCAL_LIST(glb_tbl_idx[Set_Numthreads_Attr_Idx]); 04299 04300 IR_FLD_L(ir_idx) = AT_Tbl_Idx; 04301 IR_IDX_L(ir_idx) = glb_tbl_idx[Set_Numthreads_Attr_Idx]; 04302 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx); 04303 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx); 04304 04305 NTR_IR_TBL(cvrt_idx); 04306 IR_OPR(cvrt_idx) = Cvrt_Opr; 04307 IR_TYPE_IDX(cvrt_idx) = Integer_4; 04308 IR_LINE_NUM(cvrt_idx) = IR_LINE_NUM(ir_idx); 04309 IR_COL_NUM(cvrt_idx) = IR_COL_NUM(ir_idx); 04310 04311 COPY_OPND(IR_OPND_L(cvrt_idx), IR_OPND_R(ir_idx)); 04312 04313 NTR_IR_LIST_TBL(list_idx); 04314 IR_FLD_R(ir_idx) = IL_Tbl_Idx; 04315 IR_IDX_R(ir_idx) = list_idx; 04316 IR_LIST_CNT_R(ir_idx) = 1; 04317 IL_FLD(list_idx) = IR_Tbl_Idx; 04318 IL_IDX(list_idx) = cvrt_idx; 04319 04320 SH_STMT_TYPE(curr_stmt_sh_idx) = Call_Stmt; 04321 IR_OPR(ir_idx) = Call_Opr; 04322 # endif 04323 } 04324 04325 break; 04326 04327 04328 case Tok_Dir_Pattern: 04329 04330 if (!opt_flags.pattern) { 04331 parse_err_flush(Find_Comma, NULL); 04332 } 04333 else { 04334 cdir_switches.pattern = TRUE; 04335 ir_idx = gen_directive_ir(Pattern_Cdir_Opr); 04336 } 04337 break; 04338 04339 case Tok_Dir_Permutation: 04340 04341 /* this is duplicate code, taken from Tok_Mic_Permutation */ 04342 04343 /* ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; */ 04344 ir_idx = gen_directive_ir(Permutation_Cmic_Opr); 04345 parse_permutation_mic(); 04346 break; 04347 04348 04349 case Tok_Dir_Preferstream: 04350 04351 if (!cdir_switches.stream) { 04352 parse_err_flush(Find_Comma, NULL); 04353 } 04354 else { 04355 cdir_switches.preferstream = TRUE; 04356 cdir_switches.preferstream_nocinv = FALSE; 04357 opr = Preferstream_Dir_Opr; 04358 04359 if (LA_CH_VALUE != EOS && LA_CH_VALUE != COMMA) { 04360 04361 if (MATCHED_TOKEN_CLASS(Tok_Class_Dir_Kwd) && 04362 TOKEN_VALUE(token) == Tok_Dir_Nocinv) { 04363 cdir_switches.preferstream_nocinv = TRUE; 04364 opr = Preferstream_Nocinv_Dir_Opr; 04365 } 04366 else { 04367 parse_err_flush(Find_EOS, "NOCINV"); 04368 } 04369 } 04370 ir_idx = gen_directive_ir(opr); 04371 } 04372 break; 04373 04374 04375 case Tok_Dir_Prefertask: 04376 04377 # if !(defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) 04378 04379 if (!cdir_switches.task) { 04380 parse_err_flush(Find_Comma, NULL); 04381 break; 04382 } 04383 # endif 04384 04385 cdir_switches.prefertask = TRUE; 04386 ir_idx = gen_directive_ir(Prefertask_Cdir_Opr); 04387 04388 # if defined(GENERATE_WHIRL) 04389 IR_OPR(ir_idx) = Assert_Star_Opr; 04390 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 04391 IR_IDX_L(ir_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 04392 ASSERT_DOPREFER); 04393 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx); 04394 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx); 04395 04396 IR_FLD_R(ir_idx) = CN_Tbl_Idx; 04397 IR_IDX_R(ir_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 04398 DOPREFER_CONCURRENT); 04399 IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx); 04400 IR_COL_NUM_R(ir_idx) = IR_COL_NUM(ir_idx); 04401 # endif 04402 break; 04403 04404 04405 case Tok_Dir_Prefervector: 04406 04407 if (!cdir_switches.vector) { 04408 parse_err_flush(Find_Comma, NULL); 04409 } 04410 else { 04411 cdir_switches.prefervector = TRUE; 04412 ir_idx = gen_directive_ir(Prefervector_Cdir_Opr); 04413 } 04414 break; 04415 04416 04417 case Tok_Dir_Recurrence: 04418 04419 if (LA_CH_VALUE != EOS && LA_CH_VALUE != COMMA) { 04420 buf_idx = LA_CH_BUF_IDX; 04421 stmt_num = LA_CH_STMT_NUM; 04422 04423 if (LA_CH_VALUE == '1') { 04424 NEXT_LA_CH; 04425 04426 if (LA_CH_VALUE == '2') { 04427 NEXT_LA_CH; 04428 04429 if (LA_CH_VALUE == '8') { 04430 NEXT_LA_CH; 04431 04432 if (LA_CH_VALUE == EOS) { 04433 PRINTMSG(TOKEN_LINE(token), 801, Warning, 04434 TOKEN_COLUMN(token)); 04435 parse_err_flush(Find_EOS, NULL); 04436 break; 04437 } 04438 } 04439 } 04440 } 04441 reset_lex(buf_idx,stmt_num); 04442 } 04443 04444 if (!opt_flags.recurrence) { 04445 parse_err_flush(Find_Comma, NULL); 04446 } 04447 else { 04448 cdir_switches.recurrence = TRUE; 04449 ir_idx = gen_directive_ir(Recurrence_Cdir_Opr); 04450 } 04451 break; 04452 04453 04454 case Tok_Dir_Shortloop: 04455 04456 if (!cdir_switches.vector) { 04457 parse_err_flush(Find_Comma, NULL); 04458 break; 04459 } 04460 04461 ir_idx = gen_directive_ir(Shortloop_Cdir_Opr); 04462 04463 if (LA_CH_VALUE != EOS && LA_CH_VALUE != COMMA) { 04464 buf_idx = LA_CH_BUF_IDX; 04465 stmt_num = LA_CH_STMT_NUM; 04466 04467 if (LA_CH_VALUE == '1') { 04468 NEXT_LA_CH; 04469 04470 if (LA_CH_VALUE == '2') { 04471 NEXT_LA_CH; 04472 04473 if (LA_CH_VALUE == '8') { 04474 NEXT_LA_CH; 04475 04476 if (LA_CH_VALUE == EOS) { 04477 04478 # if defined(_ACCEPT_DIR_SHORTLOOP128) 04479 IR_OPR(ir_idx) = Shortloop128_Cdir_Opr; 04480 cdir_switches.shortloop128 = TRUE; 04481 # else 04482 PRINTMSG(TOKEN_LINE(token), 801, Warning, 04483 TOKEN_COLUMN(token)); 04484 # endif 04485 break; 04486 } 04487 } 04488 } 04489 } 04490 reset_lex(buf_idx,stmt_num); 04491 parse_err_flush(Find_EOS, "128 or "EOS_STR); 04492 } 04493 else { 04494 cdir_switches.shortloop = TRUE; 04495 } 04496 break; 04497 04498 04499 case Tok_Dir_Split: 04500 04501 if (opt_flags.split_lvl == Split_Lvl_0) { 04502 parse_err_flush(Find_Comma, NULL); 04503 } 04504 else { 04505 ir_idx = gen_directive_ir(Split_Cdir_Opr); 04506 } 04507 break; 04508 04509 04510 case Tok_Dir_Stack: 04511 04512 if (CURR_BLK == Interface_Body_Blk || CURR_BLK == Interface_Blk) { 04513 04514 /* Illegal to specify directive in an interface */ 04515 04516 PRINTMSG(TOKEN_LINE(token), 1404, Warning, TOKEN_COLUMN(token)); 04517 parse_err_flush(Find_EOS, NULL); 04518 break; 04519 } 04520 04521 ATP_STACK_DIR(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 04522 04523 if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) == Module) { 04524 04525 /* Illegal to specify directive in a MODULE */ 04526 04527 PRINTMSG(TOKEN_LINE(token), 1405, Warning, TOKEN_COLUMN(token)); 04528 } 04529 04530 if (ATP_SAVE_ALL(SCP_ATTR_IDX(curr_scp_idx))) { 04531 04532 /* A SAVE with no save entity list has been specified in this */ 04533 /* program unit. SAVE overrides STACK. Issue warning. */ 04534 04535 PRINTMSG(TOKEN_LINE(token), 1144, Warning, TOKEN_COLUMN(token), 04536 "STACK"); 04537 ATP_STACK_DIR(SCP_ATTR_IDX(curr_scp_idx)) = FALSE; 04538 } 04539 break; 04540 04541 04542 case Tok_Dir_Stream: 04543 04544 if (opt_flags.stream_lvl > Stream_Lvl_0) { 04545 cdir_switches.stream = TRUE; 04546 ir_idx = gen_directive_ir(Stream_Dir_Opr); 04547 } 04548 break; 04549 04550 04551 case Tok_Dir_Suppress: 04552 04553 ir_idx = gen_directive_ir(Suppress_Opr); 04554 IR_LIST_CNT_L(ir_idx) = 0; 04555 04556 if (LA_CH_VALUE != EOS) { 04557 parse_dir_var_list(); 04558 } 04559 else { 04560 NEXT_LA_CH; /* pick up EOS */ 04561 } 04562 04563 label_idx = gen_internal_lbl(stmt_start_line); 04564 IR_FLD_R(ir_idx) = AT_Tbl_Idx; 04565 IR_IDX_R(ir_idx) = label_idx; 04566 IR_LINE_NUM_R(ir_idx) = stmt_start_line; 04567 IR_COL_NUM_R(ir_idx) = stmt_start_col; 04568 AT_DEFINED(label_idx) = TRUE; 04569 ATL_DEF_STMT_IDX(label_idx) = curr_stmt_sh_idx; 04570 goto EXIT; 04571 04572 04573 case Tok_Dir_Symmetric: 04574 04575 if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) == Module) { 04576 04577 /* Illegal to specify directive in a MODULE */ 04578 04579 PRINTMSG(TOKEN_LINE(token), 1233, Error, TOKEN_COLUMN(token), 04580 "SYMMETRIC"); 04581 parse_err_flush(Find_EOS, NULL); 04582 break; 04583 } 04584 04585 if (LA_CH_VALUE == EOS) { 04586 ATP_SYMMETRIC(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 04587 } 04588 else { 04589 parse_symmetric_dir(); 04590 goto EXIT; 04591 } 04592 break; 04593 04594 04595 case Tok_Dir_System_Module: 04596 04597 if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) != Module) { 04598 PRINTMSG(TOKEN_LINE(token), 1508, Error, 04599 TOKEN_COLUMN(token), "SYSTEM_MODULE"); 04600 } 04601 else { 04602 ATP_SYSTEM_MODULE(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 04603 SCP_IMPL_NONE(curr_scp_idx) = TRUE; 04604 } 04605 break; 04606 04607 04608 case Tok_Dir_Task: 04609 04610 # if !(defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) 04611 if (opt_flags.task_lvl == Task_Lvl_0) { 04612 parse_err_flush(Find_Comma, NULL); 04613 } 04614 else { 04615 cdir_switches.task = TRUE; 04616 ir_idx = gen_directive_ir(Task_Cdir_Opr); 04617 } 04618 # else 04619 cdir_switches.task = TRUE; 04620 cdir_switches.notask_region = FALSE; 04621 ir_idx = gen_directive_ir(Task_Cdir_Opr); 04622 # endif 04623 break; 04624 04625 04626 case Tok_Dir_Taskcommon: 04627 parse_common_dirs(Task_Common); 04628 goto EXIT; 04629 04630 04631 case Tok_Dir_Unroll: 04632 04633 if (opt_flags.unroll_lvl == Unroll_Lvl_0) { 04634 parse_err_flush(Find_Comma, NULL); 04635 break; 04636 } 04637 04638 /* If count is zero, the optimizer does automatic unrolling */ 04639 04640 ir_idx = gen_directive_ir(Unroll_Cdir_Opr); 04641 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 04642 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 04643 IR_FLD_L(ir_idx) = NO_Tbl_Idx; 04644 IR_IDX_L(ir_idx) = NULL_IDX; 04645 04646 if (LA_CH_VALUE != EOS) { 04647 04648 if (!parse_expr(&opnd)) { 04649 parse_err_flush(Find_EOS, NULL); 04650 } 04651 else { 04652 COPY_OPND(IR_OPND_L(ir_idx), opnd); 04653 } 04654 } 04655 break; 04656 04657 04658 case Tok_Dir_Uses_Eregs: 04659 04660 if (CURR_BLK == Interface_Body_Blk || CURR_BLK == Interface_Blk) { 04661 04662 /* Illegal to specify directive in an interface */ 04663 04664 PRINTMSG(TOKEN_LINE(token), 1404, Warning, TOKEN_COLUMN(token)); 04665 parse_err_flush(Find_EOS, NULL); 04666 break; 04667 } 04668 04669 ATP_USES_EREGS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 04670 04671 if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) == Module) { 04672 04673 /* Illegal to specify directive in a MODULE */ 04674 04675 PRINTMSG(TOKEN_LINE(token), 1405, Warning, TOKEN_COLUMN(token)); 04676 } 04677 break; 04678 04679 04680 case Tok_Dir_Vector: 04681 04682 if (opt_flags.vector_lvl == Vector_Lvl_0) { 04683 parse_err_flush(Find_Comma, NULL); 04684 } 04685 else { 04686 cdir_switches.vector = TRUE; 04687 ir_idx = gen_directive_ir(Vector_Cdir_Opr); 04688 } 04689 break; 04690 04691 04692 case Tok_Dir_Vfunction: 04693 parse_vfunction_dir(); 04694 goto EXIT; 04695 04696 04697 case Tok_Dir_Vsearch: 04698 04699 if (!opt_flags.vsearch || !cdir_switches.vector) { 04700 parse_err_flush(Find_Comma, NULL); 04701 } 04702 else { 04703 cdir_switches.vsearch = TRUE; 04704 ir_idx = gen_directive_ir(Vsearch_Cdir_Opr); 04705 } 04706 break; 04707 04708 /* Craft sprs - unsupported - skip if -xmpp specified. */ 04709 04710 case Tok_Dir_Doshared: 04711 case Tok_Dir_Endmaster: 04712 case Tok_Dir_Geometry: 04713 case Tok_Dir_Parallel_Only: 04714 case Tok_Dir_Pe_Resident: 04715 case Tok_Dir_Pe_Private: 04716 case Tok_Dir_Serial_Only: 04717 case Tok_Dir_Shared: 04718 case Tok_Dir_Unknown: 04719 case Tok_Dir_Unknown_Shared: 04720 parse_err_flush(Find_EOS, NULL); /* Flush - has comma list */ 04721 04722 /* Fall through */ 04723 04724 case Tok_Dir_Atomicupdate: 04725 case Tok_Dir_Barrier: 04726 case Tok_Dir_Critical: 04727 case Tok_Dir_Endcritical: 04728 case Tok_Dir_Master: 04729 case Tok_Dir_Nobarrier: 04730 04731 if (!cmd_line_flags.disregard_all_mpp_cdirs) { 04732 PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token)); 04733 parse_err_flush(Find_EOS, NULL); 04734 } 04735 04736 break; 04737 04738 # ifdef _DEBUG 04739 04740 case Tok_Dbg_Sytb: 04741 SCP_DBG_PRINT_SYTB(curr_scp_idx) = TRUE; 04742 break; 04743 04744 case Tok_Dbg_Stmt: 04745 SCP_DBG_PRINT_STMT(curr_scp_idx) = TRUE; 04746 break; 04747 # endif 04748 04749 default: 04750 04751 /* Intentionally blank */ 04752 break; 04753 04754 } /* end switch */ 04755 04756 CONTINUE: 04757 04758 if (LA_CH_VALUE == COMMA) { 04759 NEXT_LA_CH; 04760 04761 if (!MATCHED_TOKEN_CLASS(Tok_Class_Dir_Kwd)) { 04762 PRINTMSG(TOKEN_LINE(token), 1356, Warning, TOKEN_COLUMN(token)); 04763 parse_err_flush(Find_EOS, NULL); 04764 NEXT_LA_CH; 04765 break; 04766 } 04767 } 04768 else { 04769 break; 04770 } 04771 } /* End for */ 04772 04773 /* Flush past all unimplemented dirs */ 04774 04775 if (LA_CH_VALUE != EOS) { 04776 PRINTMSG(LA_CH_LINE, 790, Warning, LA_CH_COLUMN); 04777 parse_err_flush(Find_EOS, NULL); 04778 } 04779 04780 NEXT_LA_CH; 04781 04782 EXIT: 04783 04784 TRACE (Func_Exit, "parse_dir_directives", NULL); 04785 04786 return; 04787 04788 } /* parse_dir_directives */ 04789 04790 /******************************************************************************\ 04791 |* *| 04792 |* Description: *| 04793 |* This routine parses the !MIC$ directives on one line of source. *| 04794 |* *| 04795 |* Input parameters: *| 04796 |* NONE *| 04797 |* *| 04798 |* Output parameters: *| 04799 |* NONE *| 04800 |* *| 04801 |* Returns: *| 04802 |* NOTHING *| 04803 |* *| 04804 \******************************************************************************/ 04805 static void parse_mic_directives(void) 04806 04807 { 04808 int ir_idx; 04809 boolean ok = TRUE; 04810 opnd_type opnd; 04811 04812 # if defined(GENERATE_WHIRL) 04813 int cvrt_idx; 04814 int list_idx; 04815 # endif 04816 04817 # if (_ACCEPT_MIC_SEND) 04818 int blk_idx; 04819 int column; 04820 int do_blk_idx; 04821 boolean found_do; 04822 int line; 04823 opnd_type point_opnd; 04824 # endif 04825 04826 04827 TRACE (Func_Entry, "parse_mic_directives", NULL); 04828 04829 for (;;) { 04830 04831 if (TOKEN_VALUE(token) > Tok_Mic_Start && 04832 TOKEN_VALUE(token) < Tok_Mic_End && 04833 disregard_mics[TOKEN_VALUE(token) - Tok_Mic_Start]) { 04834 04835 switch (TOKEN_VALUE(token)) { 04836 04837 case Tok_Mic_Cncall: 04838 case Tok_Mic_Guard: 04839 case Tok_Mic_End_Guard: 04840 case Tok_Mic_Numcpus: 04841 case Tok_Mic_Permutation: 04842 case Tok_Mic_Send: 04843 case Tok_Mic_Wait: 04844 parse_err_flush(Find_EOS, NULL); 04845 break; 04846 04847 default: 04848 parse_err_flush(Find_Comma, NULL); 04849 } 04850 04851 goto CONTINUE; 04852 } 04853 04854 switch (TOKEN_VALUE(token)) { 04855 04856 case Tok_Mic_Case: 04857 04858 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 04859 ir_idx = gen_directive_ir(Case_Cmic_Opr); 04860 04861 if (! cdir_switches.parallel_region) { 04862 /* error .. not in parallel region */ 04863 PRINTMSG(IR_LINE_NUM(ir_idx), 785, Error, IR_COL_NUM(ir_idx), 04864 "CASE"); 04865 } 04866 else { 04867 04868 if (remove_do_parallel_blk(TRUE, "CASE", IR_LINE_NUM(ir_idx), 04869 IR_COL_NUM(ir_idx))) { 04870 } 04871 04872 SH_STMT_TYPE(curr_stmt_sh_idx) = Parallel_Case_Stmt; 04873 stmt_type = Parallel_Case_Stmt; 04874 04875 if (cdir_switches.casedir) { 04876 end_parallel_case_blk(FALSE); 04877 } 04878 04879 SET_DIRECTIVE_STATE(Case_Region); 04880 cdir_switches.casedir = TRUE; 04881 04882 PUSH_BLK_STK (Parallel_Case_Blk); 04883 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 04884 04885 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 04886 LINK_TO_PARENT_BLK; 04887 } 04888 04889 break; 04890 04891 04892 case Tok_Mic_End_Case: 04893 04894 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 04895 ir_idx = gen_directive_ir(Endcase_Cmic_Opr); 04896 04897 if (! cdir_switches.parallel_region) { 04898 /* error .. not in parallel region */ 04899 PRINTMSG(IR_LINE_NUM(ir_idx), 785, Error, IR_COL_NUM(ir_idx), 04900 "END CASE"); 04901 } 04902 else { 04903 04904 cdir_switches.casedir = FALSE; 04905 SH_STMT_TYPE(curr_stmt_sh_idx) = End_Parallel_Case_Stmt; 04906 stmt_type = End_Parallel_Case_Stmt; 04907 04908 end_parallel_case_blk(FALSE); 04909 } 04910 04911 CLEAR_DIRECTIVE_STATE(Case_Region); 04912 break; 04913 04914 04915 case Tok_Mic_Cncall: 04916 04917 /* this code is duplicated for Tok_Dir_Cncall */ 04918 04919 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 04920 ir_idx = gen_directive_ir(Cncall_Cmic_Opr); 04921 04922 if (LA_CH_VALUE != EOS && LA_CH_VALUE != COMMA) { 04923 04924 /* Arguments are specified on the CNCALL line. Issue caution */ 04925 /* message and ignore the arguments. Because there is a list,*/ 04926 /* cncall must be the only directive on the line, so flush. */ 04927 04928 PRINTMSG(LA_CH_LINE, 1123, Caution, LA_CH_COLUMN); 04929 parse_err_flush(Find_EOS, NULL); 04930 } 04931 04932 break; 04933 04934 04935 case Tok_Mic_Do_All: 04936 04937 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 04938 ir_idx = gen_directive_ir(Doall_Cmic_Opr); 04939 04940 parse_doall_cmic(); 04941 04942 if (cdir_switches.parallel_region || 04943 cdir_switches.guard_in_par_reg) { 04944 /* error .. already parallel region */ 04945 PRINTMSG(IR_LINE_NUM(ir_idx), 814, Error, IR_COL_NUM(ir_idx)); 04946 } 04947 else { 04948 SET_DIRECTIVE_STATE(Doall_Region); 04949 cdir_switches.doall_sh_idx = curr_stmt_sh_idx; 04950 } 04951 04952 break; 04953 04954 04955 case Tok_Mic_Do_Parallel: 04956 04957 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 04958 ir_idx = gen_directive_ir(Doparallel_Cmic_Opr); 04959 04960 parse_doparallel_cmic(); 04961 04962 if (! cdir_switches.parallel_region) { 04963 /* error .. not in parallel region */ 04964 PRINTMSG(IR_LINE_NUM(ir_idx), 785, Error, IR_COL_NUM(ir_idx), 04965 "DO PARALLEL"); 04966 } 04967 else if (cdir_switches.casedir) { 04968 /* error .. can't be inside parallel case */ 04969 PRINTMSG(IR_LINE_NUM(ir_idx), 1312, Error, IR_COL_NUM(ir_idx)); 04970 } 04971 else if (remove_do_parallel_blk(TRUE, "DO PARALLEL", 04972 IR_LINE_NUM(ir_idx), IR_COL_NUM(ir_idx))) { 04973 /* error issued by remove_do_parallel_blk */ 04974 } 04975 else { 04976 SET_DIRECTIVE_STATE(Do_Parallel_Region); 04977 cdir_switches.do_parallel = TRUE; 04978 cdir_switches.dopar_sh_idx = curr_stmt_sh_idx; 04979 } 04980 04981 break; 04982 04983 04984 case Tok_Mic_End_Do: 04985 04986 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 04987 ir_idx = gen_directive_ir(Enddo_Cmic_Opr); 04988 04989 if (! cdir_switches.parallel_region) { 04990 /* error .. not in parallel region */ 04991 PRINTMSG(IR_LINE_NUM(ir_idx), 785, Error, IR_COL_NUM(ir_idx), 04992 "END DO"); 04993 } 04994 else { 04995 04996 CLEAR_DIRECTIVE_STATE(Do_Parallel_Region); 04997 cdir_switches.do_parallel = FALSE; 04998 SH_STMT_TYPE(curr_stmt_sh_idx) = End_Do_Parallel_Stmt; 04999 stmt_type = End_Do_Parallel_Stmt; 05000 05001 end_do_parallel_blk(FALSE); 05002 } 05003 05004 break; 05005 05006 05007 case Tok_Mic_Guard: 05008 05009 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05010 ir_idx = gen_directive_ir(Guard_Cmic_Opr); 05011 05012 if (LA_CH_VALUE != EOS) { 05013 ok = parse_expr(&opnd); 05014 COPY_OPND(IR_OPND_L(ir_idx), opnd); 05015 cdir_switches.guard_has_flag = TRUE; 05016 05017 if (LA_CH_VALUE != EOS) { 05018 parse_err_flush(Find_EOS,EOS_STR); 05019 } 05020 } 05021 else { 05022 cdir_switches.guard_has_flag = FALSE; 05023 } 05024 05025 if (cdir_switches.guard) { 05026 /* error .. missing end guard */ 05027 PRINTMSG(IR_LINE_NUM(ir_idx), 815, Error, IR_COL_NUM(ir_idx)); 05028 } 05029 else { 05030 05031 SET_DIRECTIVE_STATE(Guard_Region); 05032 cdir_switches.guard = TRUE; 05033 cdir_switches.guard_in_par_reg = cdir_switches.parallel_region; 05034 cdir_switches.parallel_region = FALSE; 05035 05036 PUSH_BLK_STK (Guard_Blk); 05037 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 05038 05039 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 05040 LINK_TO_PARENT_BLK; 05041 } 05042 05043 break; 05044 05045 05046 case Tok_Mic_End_Guard: 05047 05048 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05049 ir_idx = gen_directive_ir(Endguard_Cmic_Opr); 05050 05051 ok = TRUE; 05052 05053 if (LA_CH_VALUE != EOS) { 05054 ok = parse_expr(&opnd); 05055 COPY_OPND(IR_OPND_L(ir_idx), opnd); 05056 05057 if (! cdir_switches.guard_has_flag) { 05058 /* error .. guards don't match */ 05059 PRINTMSG(IR_LINE_NUM(ir_idx), 816, Error, IR_COL_NUM(ir_idx)); 05060 ok = FALSE; 05061 } 05062 05063 if (LA_CH_VALUE != EOS) { 05064 parse_err_flush(Find_EOS,EOS_STR); 05065 } 05066 } 05067 else if (cdir_switches.guard_has_flag) { 05068 /* error .. guards don't match */ 05069 PRINTMSG(IR_LINE_NUM(ir_idx), 816, Error, IR_COL_NUM(ir_idx)); 05070 ok = FALSE; 05071 } 05072 05073 CLEAR_DIRECTIVE_STATE(Guard_Region); 05074 05075 if (ok) { 05076 05077 cdir_switches.guard = FALSE; 05078 cdir_switches.parallel_region = cdir_switches.guard_in_par_reg; 05079 cdir_switches.guard_in_par_reg = FALSE; 05080 05081 SH_STMT_TYPE(curr_stmt_sh_idx) = End_Guard_Stmt; 05082 stmt_type = End_Guard_Stmt; 05083 05084 end_guard_blk(FALSE); 05085 } 05086 05087 break; 05088 05089 case Tok_Mic_Numcpus: 05090 05091 /* this code is duplicated for Tok_Dir_Numcpus */ 05092 05093 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05094 ir_idx = gen_directive_ir(Numcpus_Cmic_Opr); 05095 05096 if (LA_CH_VALUE != LPAREN) { /* Expected value */ 05097 PRINTMSG(LA_CH_LINE, 1124, Error, LA_CH_COLUMN); 05098 parse_err_flush(Find_EOS, NULL); 05099 } 05100 else { 05101 NEXT_LA_CH; 05102 ok = parse_expr(&opnd); 05103 COPY_OPND(IR_OPND_L(ir_idx), opnd); 05104 05105 if (LA_CH_VALUE != RPAREN) { 05106 parse_err_flush(Find_EOS, ")"); 05107 } 05108 else { 05109 NEXT_LA_CH; /* Pick up Rparen. */ 05110 } 05111 05112 # if defined(GENERATE_WHIRL) 05113 /* turn this into a call */ 05114 05115 COPY_OPND(IR_OPND_R(ir_idx), IR_OPND_L(ir_idx)); 05116 05117 if (glb_tbl_idx[Set_Numthreads_Attr_Idx] == NULL_IDX) { 05118 glb_tbl_idx[Set_Numthreads_Attr_Idx] = create_lib_entry_attr( 05119 SET_NUMTHREADS_ENTRY, 05120 SET_NUMTHREADS_NAME_LEN, 05121 IR_LINE_NUM(ir_idx), 05122 IR_COL_NUM(ir_idx)); 05123 } 05124 05125 ADD_ATTR_TO_LOCAL_LIST(glb_tbl_idx[Set_Numthreads_Attr_Idx]); 05126 05127 IR_FLD_L(ir_idx) = AT_Tbl_Idx; 05128 IR_IDX_L(ir_idx) = glb_tbl_idx[Set_Numthreads_Attr_Idx]; 05129 IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx); 05130 IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx); 05131 05132 NTR_IR_TBL(cvrt_idx); 05133 IR_OPR(cvrt_idx) = Cvrt_Opr; 05134 IR_TYPE_IDX(cvrt_idx) = Integer_4; 05135 IR_LINE_NUM(cvrt_idx) = IR_LINE_NUM(ir_idx); 05136 IR_COL_NUM(cvrt_idx) = IR_COL_NUM(ir_idx); 05137 05138 COPY_OPND(IR_OPND_L(cvrt_idx), IR_OPND_R(ir_idx)); 05139 05140 NTR_IR_LIST_TBL(list_idx); 05141 IR_FLD_R(ir_idx) = IL_Tbl_Idx; 05142 IR_IDX_R(ir_idx) = list_idx; 05143 IR_LIST_CNT_R(ir_idx) = 1; 05144 IL_FLD(list_idx) = IR_Tbl_Idx; 05145 IL_IDX(list_idx) = cvrt_idx; 05146 05147 SH_STMT_TYPE(curr_stmt_sh_idx) = Call_Stmt; 05148 IR_OPR(ir_idx) = Call_Opr; 05149 # endif 05150 } 05151 05152 break; 05153 05154 05155 case Tok_Mic_Parallel: 05156 05157 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05158 ir_idx = gen_directive_ir(Parallel_Cmic_Opr); 05159 05160 parse_parallel_cmic(); 05161 05162 if (cdir_switches.parallel_region || 05163 cdir_switches.guard_in_par_reg) { 05164 /* error .. already in a parallel_region */ 05165 PRINTMSG(IR_LINE_NUM(ir_idx), 818, Error, IR_COL_NUM(ir_idx)); 05166 } 05167 else { 05168 SET_DIRECTIVE_STATE(Parallel_Region); 05169 cdir_switches.parallel_region = TRUE; 05170 PUSH_BLK_STK (Parallel_Blk); 05171 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 05172 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 05173 LINK_TO_PARENT_BLK; 05174 } 05175 05176 break; 05177 05178 05179 case Tok_Mic_End_Parallel: 05180 05181 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05182 ir_idx = gen_directive_ir(Endparallel_Cmic_Opr); 05183 05184 CLEAR_DIRECTIVE_STATE(Parallel_Region); 05185 cdir_switches.parallel_region = FALSE; 05186 cdir_switches.do_parallel = FALSE; 05187 cdir_switches.guard_in_par_reg = FALSE; 05188 05189 SH_STMT_TYPE(curr_stmt_sh_idx) = End_Parallel_Stmt; 05190 stmt_type = End_Parallel_Stmt; 05191 end_parallel_blk(FALSE); 05192 05193 break; 05194 05195 05196 case Tok_Mic_Permutation: 05197 05198 /* this code is duplicated for Tok_Dir_Permutation */ 05199 05200 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05201 ir_idx = gen_directive_ir(Permutation_Cmic_Opr); 05202 parse_permutation_mic(); 05203 break; 05204 05205 case Tok_Mic_Wait: 05206 05207 # if defined(_ACCEPT_MIC_WAIT) 05208 05209 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05210 05211 line = TOKEN_LINE(token); 05212 column = TOKEN_COLUMN(token); 05213 ir_idx = gen_directive_ir(Wait_Cmic_Opr); 05214 OPND_LINE_NUM(opnd) = LA_CH_LINE; 05215 OPND_COL_NUM(opnd) = LA_CH_COLUMN; 05216 OPND_FLD(opnd) = CN_Tbl_Idx; 05217 OPND_IDX(opnd) = CN_INTEGER_ONE_IDX; 05218 OPND_LINE_NUM(point_opnd) = LA_CH_LINE; 05219 OPND_COL_NUM(point_opnd) = LA_CH_COLUMN; 05220 point_opnd = null_opnd; 05221 05222 if (LA_CH_VALUE == EOS) { 05223 05224 /* Intentionally blank */ 05225 } 05226 else if (MATCHED_TOKEN_CLASS(Tok_Class_Mic_Kwd)) { 05227 05228 if (TOKEN_VALUE(token) == Tok_Mic_Point) { 05229 05230 if (LA_CH_VALUE == LPAREN) { 05231 NEXT_LA_CH; 05232 ok = parse_expr(&point_opnd); 05233 05234 if (LA_CH_VALUE != RPAREN) { 05235 parse_err_flush(Find_EOS, ")"); 05236 } 05237 else { 05238 NEXT_LA_CH; /* Pick up Rparen. */ 05239 } 05240 05241 if (LA_CH_VALUE != EOS) { 05242 05243 if (!MATCHED_TOKEN_CLASS(Tok_Class_Mic_Kwd) || 05244 TOKEN_VALUE(token) != Tok_Mic_Span) { 05245 parse_err_flush(Find_EOS, "SPAN or EOS"); 05246 } 05247 else if (LA_CH_VALUE == LPAREN) { 05248 NEXT_LA_CH; 05249 ok = parse_expr(&opnd); 05250 05251 if (LA_CH_VALUE != RPAREN) { 05252 parse_err_flush(Find_EOS, ")"); 05253 } 05254 else { 05255 NEXT_LA_CH; /* Pick up Rparen. */ 05256 } 05257 05258 if (LA_CH_VALUE != EOS) { 05259 parse_err_flush(Find_EOS, "EOS"); 05260 } 05261 } 05262 else { 05263 parse_err_flush(Find_EOS, "("); 05264 } 05265 } 05266 } 05267 else { 05268 parse_err_flush(Find_EOS, "("); 05269 } 05270 } 05271 else if (TOKEN_VALUE(token) == Tok_Mic_Span) { 05272 05273 if (LA_CH_VALUE == LPAREN) { 05274 NEXT_LA_CH; 05275 ok = parse_expr(&opnd); 05276 05277 if (LA_CH_VALUE != RPAREN) { 05278 parse_err_flush(Find_EOS, ")"); 05279 } 05280 else { 05281 NEXT_LA_CH; /* Pick up Rparen. */ 05282 } 05283 05284 if (LA_CH_VALUE != EOS) { 05285 parse_err_flush(Find_EOS, "EOS"); 05286 } 05287 } 05288 else { 05289 parse_err_flush(Find_EOS, "("); 05290 } 05291 } 05292 else { 05293 parse_err_flush(Find_EOS, "POINT, SPAN or EOS"); 05294 } 05295 } 05296 else { 05297 parse_err_flush(Find_EOS, "POINT, SPAN or EOS"); 05298 } 05299 05300 COPY_OPND(IR_OPND_L(ir_idx), point_opnd); 05301 COPY_OPND(IR_OPND_R(ir_idx), opnd); 05302 05303 /* This directive must be specified within a doall or doparallel */ 05304 /* region. Search the block stack to make sure one exists. */ 05305 05306 blk_idx = blk_stk_idx; 05307 do_blk_idx = NULL_IDX; 05308 found_do = FALSE; 05309 05310 while (blk_idx > 0) { 05311 05312 if (BLK_TYPE(blk_idx) == Do_Parallel_Blk || 05313 BLK_TYPE(blk_idx) == Doall_Blk) { 05314 do_blk_idx = blk_idx; 05315 break; 05316 } 05317 05318 if (BLK_TYPE(blk_idx) == Do_Blk) { 05319 found_do = TRUE; 05320 } 05321 05322 if (BLK_TYPE(blk_idx) == Case_Blk || 05323 BLK_TYPE(blk_idx) == Guard_Blk) { 05324 05325 /* Issue error. Wait cannot be specified within a CASE region */ 05326 /* or a GUARD region. Continue to check for doall/doparallel. */ 05327 05328 PRINTMSG(line, 1519, Error, column, 05329 (BLK_TYPE(blk_idx) == Case_Blk) ? "CASE" : "GUARD"); 05330 } 05331 blk_idx--; 05332 } 05333 05334 if (do_blk_idx == NULL_IDX) { /* Did not find the block */ 05335 05336 /* Issue error - Need to be in doparallel or doall region.*/ 05337 05338 PRINTMSG(line, 1520, Error, column, "WAIT"); 05339 } 05340 05341 if (!found_do) { /* Issue error - Need to be in a do block. */ 05342 PRINTMSG(line, 1385, Error, column, "WAIT"); 05343 } 05344 05345 # else 05346 PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token)); 05347 parse_err_flush(Find_EOS, NULL); 05348 # endif 05349 05350 break; 05351 05352 case Tok_Mic_Send: 05353 05354 # if (_ACCEPT_MIC_SEND) 05355 05356 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05357 05358 line = TOKEN_LINE(token); 05359 column = TOKEN_COLUMN(token); 05360 05361 ir_idx = gen_directive_ir(Send_Cmic_Opr); 05362 OPND_LINE_NUM(opnd) = LA_CH_LINE; 05363 OPND_COL_NUM(opnd) = LA_CH_COLUMN; 05364 opnd = null_opnd; 05365 OPND_LINE_NUM(point_opnd) = LA_CH_LINE; 05366 OPND_COL_NUM(point_opnd) = LA_CH_COLUMN; 05367 point_opnd = null_opnd; 05368 05369 if (LA_CH_VALUE == EOS) { 05370 05371 /* Intentionally blank */ 05372 } 05373 else if (MATCHED_TOKEN_CLASS(Tok_Class_Mic_Kwd)) { 05374 05375 if (TOKEN_VALUE(token) == Tok_Mic_Point) { 05376 05377 if (LA_CH_VALUE == LPAREN) { 05378 NEXT_LA_CH; 05379 ok = parse_expr(&point_opnd); 05380 05381 if (LA_CH_VALUE != RPAREN) { 05382 parse_err_flush(Find_EOS, ")"); 05383 } 05384 else { 05385 NEXT_LA_CH; /* Pick up Rparen. */ 05386 } 05387 05388 if (LA_CH_VALUE != EOS) { 05389 05390 if (!MATCHED_TOKEN_CLASS(Tok_Class_Mic_Kwd) || 05391 TOKEN_VALUE(token) != Tok_Mic_If) { 05392 reset_lex(TOKEN_BUF_IDX(token), TOKEN_STMT_NUM(token)); 05393 parse_err_flush(Find_EOS, "IF or EOS"); 05394 } 05395 else if (LA_CH_VALUE == LPAREN) { 05396 NEXT_LA_CH; 05397 ok = parse_expr(&opnd); 05398 05399 if (LA_CH_VALUE != RPAREN) { 05400 parse_err_flush(Find_EOS, ")"); 05401 } 05402 else { 05403 NEXT_LA_CH; /* Pick up Rparen. */ 05404 } 05405 05406 if (LA_CH_VALUE != EOS) { 05407 parse_err_flush(Find_EOS, "EOS"); 05408 } 05409 } 05410 else { 05411 parse_err_flush(Find_EOS, "("); 05412 } 05413 } 05414 } 05415 else { 05416 parse_err_flush(Find_EOS, "("); 05417 } 05418 } 05419 else if (TOKEN_VALUE(token) == Tok_Mic_If) { 05420 05421 if (LA_CH_VALUE == LPAREN) { 05422 NEXT_LA_CH; 05423 ok = parse_expr(&opnd); 05424 05425 if (LA_CH_VALUE != RPAREN) { 05426 parse_err_flush(Find_EOS, ")"); 05427 } 05428 else { 05429 NEXT_LA_CH; /* Pick up Rparen. */ 05430 } 05431 05432 if (LA_CH_VALUE != EOS) { 05433 parse_err_flush(Find_EOS, "EOS"); 05434 } 05435 } 05436 else { 05437 parse_err_flush(Find_EOS, "("); 05438 } 05439 } 05440 else { 05441 parse_err_flush(Find_EOS, "POINT, IF or EOS"); 05442 } 05443 } 05444 else { 05445 parse_err_flush(Find_EOS, "POINT, IF or EOS"); 05446 } 05447 05448 COPY_OPND(IR_OPND_L(ir_idx), point_opnd); 05449 COPY_OPND(IR_OPND_R(ir_idx), opnd); 05450 05451 /* This directive must be specified within a doall or doparallel */ 05452 /* region. Search the block stack to make sure one exists. */ 05453 /* SENDS's should have a wait, but this is checking in case */ 05454 /* there is a SEND without a WAIT that is not in a doparallel */ 05455 05456 blk_idx = blk_stk_idx; 05457 do_blk_idx = NULL_IDX; 05458 found_do = FALSE; 05459 05460 while (blk_idx > 0) { 05461 05462 if (BLK_TYPE(blk_idx) == Do_Parallel_Blk || 05463 BLK_TYPE(blk_idx) == Doall_Blk) { 05464 do_blk_idx = blk_idx; 05465 break; 05466 } 05467 05468 if (BLK_TYPE(blk_idx) == Do_Blk) { 05469 found_do = TRUE; 05470 } 05471 blk_idx--; 05472 } 05473 05474 if (do_blk_idx == NULL_IDX) { /* Did not find the block */ 05475 05476 /* Issue error - Need to be in doparallel or doall region.*/ 05477 05478 PRINTMSG(line, 1520, Error, column, "SEND"); 05479 } 05480 05481 if (!found_do) { /* Issue error - Need to be in a do block. */ 05482 PRINTMSG(line, 1385, Error, column, "SEND"); 05483 } 05484 05485 05486 # else 05487 PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token)); 05488 parse_err_flush(Find_EOS, NULL); 05489 # endif 05490 05491 break; 05492 05493 05494 case Tok_Mic_Continue: 05495 case Tok_Mic_Taskcommon: 05496 05497 PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token)); 05498 parse_err_flush(Find_EOS, NULL); 05499 break; 05500 05501 default: 05502 PRINTMSG(TOKEN_LINE(token), 790, Warning, TOKEN_COLUMN(token)); 05503 parse_err_flush(Find_EOS, NULL); 05504 05505 } /* end switch */ 05506 05507 CONTINUE: 05508 05509 if (LA_CH_VALUE == COMMA) { 05510 NEXT_LA_CH; 05511 05512 if (!MATCHED_TOKEN_CLASS(Tok_Class_Mic_Kwd)) { 05513 parse_err_flush(Find_EOS, NULL); 05514 NEXT_LA_CH; 05515 break; 05516 } 05517 } 05518 else { 05519 break; 05520 } 05521 } /* End for */ 05522 05523 /* Flush past all unimplemented dirs */ 05524 05525 if (LA_CH_VALUE != EOS) { 05526 PRINTMSG(LA_CH_LINE, 790, Warning, LA_CH_COLUMN); 05527 parse_err_flush(Find_EOS, NULL); 05528 } 05529 05530 NEXT_LA_CH; 05531 05532 TRACE (Func_Exit, "parse_mic_directives", NULL); 05533 05534 return; 05535 05536 } /* parse_mic_directives */ 05537 05538 /******************************************************************************\ 05539 |* *| 05540 |* Description: *| 05541 |* This routine parses the C$PAR directives on one line of source. *| 05542 |* *| 05543 |* Input parameters: *| 05544 |* NONE *| 05545 |* *| 05546 |* Output parameters: *| 05547 |* NONE *| 05548 |* *| 05549 |* Returns: *| 05550 |* NOTHING *| 05551 |* *| 05552 \******************************************************************************/ 05553 static void parse_par_directives(void) 05554 { 05555 int ir_idx; 05556 opnd_type opnd; 05557 boolean paren = FALSE; 05558 int sh_idx; 05559 05560 TRACE (Func_Entry, "parse_par_directives", NULL); 05561 05562 if (TOKEN_VALUE(token) > Tok_SGI_Dir_Start && 05563 TOKEN_VALUE(token) < Tok_SGI_Dir_End && 05564 disregard_mips[TOKEN_VALUE(token) - Tok_SGI_Dir_Start]) { 05565 goto EXIT; 05566 } 05567 05568 switch (TOKEN_VALUE(token)) { 05569 05570 case Tok_SGI_Dir_Parallel: 05571 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05572 ir_idx = gen_directive_ir(Parallel_Par_Opr); 05573 05574 parse_mp_directive(Parallel); 05575 05576 if (directive_region_error(Sgi_Parallel_Dir, 05577 IR_LINE_NUM(ir_idx), 05578 IR_COL_NUM(ir_idx))) { 05579 } 05580 else { 05581 SET_DIRECTIVE_STATE(Sgi_Parallel_Region); 05582 PUSH_BLK_STK (SGI_Parallel_Blk); 05583 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 05584 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 05585 LINK_TO_PARENT_BLK; 05586 } 05587 05588 break; 05589 05590 case Tok_SGI_Dir_Paralleldo: 05591 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05592 ir_idx = gen_directive_ir(Parallel_Do_Par_Opr); 05593 05594 parse_mp_directive(Parallel_Do); 05595 05596 if (directive_region_error(Parallel_Do_Dir, 05597 IR_LINE_NUM(ir_idx), 05598 IR_COL_NUM(ir_idx))) { 05599 } 05600 else { 05601 SET_DIRECTIVE_STATE(Parallel_Do_Region); 05602 cdir_switches.paralleldo_sh_idx = curr_stmt_sh_idx; 05603 } 05604 05605 break; 05606 05607 case Tok_SGI_Dir_Pdo: 05608 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05609 ir_idx = gen_directive_ir(Pdo_Par_Opr); 05610 05611 parse_mp_directive(Pdo); 05612 05613 if (directive_region_error(Pdo_Dir, 05614 IR_LINE_NUM(ir_idx), 05615 IR_COL_NUM(ir_idx))) { 05616 } 05617 else { 05618 SET_DIRECTIVE_STATE(Pdo_Region); 05619 cdir_switches.pdo_sh_idx = curr_stmt_sh_idx; 05620 } 05621 05622 break; 05623 05624 case Tok_SGI_Dir_Barrier: 05625 05626 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05627 ir_idx = gen_directive_ir(Barrier_Par_Opr); 05628 05629 if (directive_region_error(Barrier_Dir, 05630 IR_LINE_NUM(ir_idx), 05631 IR_COL_NUM(ir_idx))) { 05632 } 05633 05634 break; 05635 05636 05637 case Tok_SGI_Dir_Criticalsection: 05638 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05639 ir_idx = gen_directive_ir(Critical_Section_Par_Opr); 05640 05641 if (LA_CH_VALUE != EOS) { 05642 05643 if (LA_CH_VALUE == LPAREN) { 05644 paren = TRUE; 05645 NEXT_LA_CH; 05646 } 05647 05648 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 05649 05650 if (! parse_deref(&opnd, NULL_IDX)) { 05651 parse_err_flush(Find_Rparen, NULL); 05652 } 05653 else { 05654 COPY_OPND(IR_OPND_L(ir_idx), opnd); 05655 } 05656 } 05657 else { 05658 parse_err_flush(Find_Rparen, "IDENTIFIER"); 05659 } 05660 05661 if (paren) { 05662 if (LA_CH_VALUE == RPAREN) { 05663 NEXT_LA_CH; 05664 } 05665 else { 05666 parse_err_flush(Find_EOS, ")"); 05667 } 05668 } 05669 } 05670 05671 if (directive_region_error(Critical_Section_Dir, 05672 IR_LINE_NUM(ir_idx), 05673 IR_COL_NUM(ir_idx))) { 05674 } 05675 05676 SET_DIRECTIVE_STATE(Critical_Section_Region); 05677 PUSH_BLK_STK (SGI_Critical_Section_Blk); 05678 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 05679 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 05680 LINK_TO_PARENT_BLK; 05681 break; 05682 05683 case Tok_SGI_Dir_Endcriticalsection: 05684 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05685 ir_idx = gen_directive_ir(End_Critical_Section_Par_Opr); 05686 05687 if (directive_region_error(End_Critical_Section_Dir, 05688 IR_LINE_NUM(ir_idx), 05689 IR_COL_NUM(ir_idx))) { 05690 } 05691 05692 CLEAR_DIRECTIVE_STATE(Critical_Section_Region); 05693 SH_STMT_TYPE(curr_stmt_sh_idx) = SGI_End_Critical_Section_Stmt; 05694 stmt_type = SGI_End_Critical_Section_Stmt; 05695 end_critical_section_blk(FALSE); 05696 break; 05697 05698 case Tok_SGI_Dir_Singleprocess: 05699 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05700 ir_idx = gen_directive_ir(Singleprocess_Par_Opr); 05701 05702 parse_mp_directive(Singleprocess); 05703 05704 if (directive_region_error(Single_Process_Dir, 05705 IR_LINE_NUM(ir_idx), 05706 IR_COL_NUM(ir_idx))) { 05707 } 05708 05709 SET_DIRECTIVE_STATE(Single_Process_Region); 05710 PUSH_BLK_STK (SGI_Single_Process_Blk); 05711 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 05712 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 05713 LINK_TO_PARENT_BLK; 05714 break; 05715 05716 case Tok_SGI_Dir_Endsingleprocess: 05717 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05718 ir_idx = gen_directive_ir(End_Singleprocess_Par_Opr); 05719 05720 if (directive_region_error(End_Single_Process_Dir, 05721 IR_LINE_NUM(ir_idx), 05722 IR_COL_NUM(ir_idx))) { 05723 } 05724 05725 CLEAR_DIRECTIVE_STATE(Single_Process_Region); 05726 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 05727 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 05728 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 05729 05730 if (LA_CH_VALUE != EOS) { 05731 if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd) && 05732 TOKEN_VALUE(token) == Tok_SGI_Dir_Nowait) { 05733 05734 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX; 05735 } 05736 else { 05737 parse_err_flush(Find_EOS, EOS_STR); 05738 } 05739 } 05740 else { 05741 IR_IDX_L(ir_idx) = CN_INTEGER_ZERO_IDX; 05742 } 05743 05744 SH_STMT_TYPE(curr_stmt_sh_idx) = SGI_End_Single_Process_Stmt; 05745 stmt_type = SGI_End_Single_Process_Stmt; 05746 end_single_process_blk(FALSE); 05747 break; 05748 05749 05750 case Tok_SGI_Dir_Endpsections: 05751 case Tok_SGI_Dir_Endpsection: 05752 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05753 ir_idx = gen_directive_ir(End_Psection_Par_Opr); 05754 05755 if (directive_region_error(End_Psection_Dir, 05756 IR_LINE_NUM(ir_idx), 05757 IR_COL_NUM(ir_idx))) { 05758 } 05759 05760 CLEAR_DIRECTIVE_STATE(Parallel_Section_Region); 05761 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 05762 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 05763 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 05764 05765 if (LA_CH_VALUE != EOS) { 05766 if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd) && 05767 TOKEN_VALUE(token) == Tok_SGI_Dir_Nowait) { 05768 05769 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX; 05770 } 05771 else { 05772 parse_err_flush(Find_EOS, EOS_STR); 05773 } 05774 } 05775 else { 05776 IR_IDX_L(ir_idx) = CN_INTEGER_ZERO_IDX; 05777 } 05778 05779 SH_STMT_TYPE(curr_stmt_sh_idx) = SGI_End_Psection_Stmt; 05780 stmt_type = SGI_End_Psection_Stmt; 05781 end_psection_blk(FALSE); 05782 05783 break; 05784 05785 case Tok_SGI_Dir_Endparallel: 05786 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05787 ir_idx = gen_directive_ir(End_Parallel_Par_Opr); 05788 05789 if (directive_region_error(Sgi_End_Parallel_Dir, 05790 IR_LINE_NUM(ir_idx), 05791 IR_COL_NUM(ir_idx))) { 05792 } 05793 05794 CLEAR_DIRECTIVE_STATE(Sgi_Parallel_Region); 05795 SH_STMT_TYPE(curr_stmt_sh_idx) = SGI_End_Parallel_Stmt; 05796 stmt_type = SGI_End_Parallel_Stmt; 05797 end_SGI_parallel_blk(FALSE); 05798 break; 05799 05800 case Tok_SGI_Dir_Endpdo: 05801 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05802 ir_idx = gen_directive_ir(End_Pdo_Par_Opr); 05803 05804 if (LA_CH_VALUE != EOS) { 05805 if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd) && 05806 TOKEN_VALUE(token) == Tok_SGI_Dir_Nowait) { 05807 05808 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 05809 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 05810 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 05811 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX; 05812 } 05813 else { 05814 parse_err_flush(Find_EOS, EOS_STR); 05815 } 05816 } 05817 05818 SH_STMT_TYPE(curr_stmt_sh_idx) = SGI_End_Pdo_Stmt; 05819 05820 if (SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) != NULL_IDX && 05821 IR_OPR(SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))) == End_Pdo_Par_Opr && 05822 SH_COMPILER_GEN(SH_PREV_IDX(curr_stmt_sh_idx))) { 05823 05824 /* remove the CG end pdo */ 05825 sh_idx = SH_PREV_IDX(curr_stmt_sh_idx); 05826 COPY_OPND(IR_OPND_R(ir_idx), IR_OPND_R(SH_IR_IDX(sh_idx))); 05827 05828 SH_PREV_IDX(SH_NEXT_IDX(sh_idx)) = SH_PREV_IDX(sh_idx); 05829 SH_NEXT_IDX(SH_PREV_IDX(sh_idx)) = SH_NEXT_IDX(sh_idx); 05830 05831 FREE_IR_NODE(SH_IR_IDX(sh_idx)); 05832 FREE_SH_NODE(sh_idx); 05833 break; 05834 } 05835 05836 if (directive_region_error(End_Pdo_Dir, 05837 IR_LINE_NUM(ir_idx), 05838 IR_COL_NUM(ir_idx))) { 05839 } 05840 05841 CLEAR_DIRECTIVE_STATE(Pdo_Region); 05842 05843 stmt_type = SGI_End_Pdo_Stmt; 05844 end_pdo_blk(FALSE); 05845 05846 break; 05847 05848 05849 case Tok_SGI_Dir_Psection: 05850 case Tok_SGI_Dir_Psections: 05851 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05852 ir_idx = gen_directive_ir(Psection_Par_Opr); 05853 05854 if (directive_region_error(Psection_Dir, 05855 IR_LINE_NUM(ir_idx), 05856 IR_COL_NUM(ir_idx))) { 05857 } 05858 05859 parse_mp_directive(Psection); 05860 SET_DIRECTIVE_STATE(Parallel_Section_Region); 05861 PUSH_BLK_STK (SGI_Psection_Blk); 05862 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 05863 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 05864 LINK_TO_PARENT_BLK; 05865 break; 05866 05867 case Tok_SGI_Dir_Section: 05868 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 05869 ir_idx = gen_directive_ir(Section_Par_Opr); 05870 05871 if (directive_region_error(Section_Dir, 05872 IR_LINE_NUM(ir_idx), 05873 IR_COL_NUM(ir_idx))) { 05874 } 05875 05876 if (remove_pdo_blk(TRUE, "SECTION", IR_LINE_NUM(ir_idx), 05877 IR_COL_NUM(ir_idx))) { 05878 } 05879 05880 SH_STMT_TYPE(curr_stmt_sh_idx) = SGI_Section_Stmt; 05881 stmt_type = SGI_Section_Stmt; 05882 05883 if (CURR_BLK == SGI_Section_Blk) { 05884 end_psection_blk(FALSE); 05885 } 05886 05887 PUSH_BLK_STK (SGI_Section_Blk); 05888 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 05889 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 05890 LINK_TO_PARENT_BLK; 05891 break; 05892 05893 default: 05894 /* treat as comment */ 05895 parse_err_flush(Find_EOS, NULL); 05896 05897 } /* end switch */ 05898 05899 /* Flush past all unimplemented dirs */ 05900 05901 if (LA_CH_VALUE != EOS) { 05902 PRINTMSG(LA_CH_LINE, 790, Warning, LA_CH_COLUMN); 05903 parse_err_flush(Find_EOS, NULL); 05904 } 05905 05906 EXIT: 05907 05908 NEXT_LA_CH; 05909 05910 TRACE (Func_Exit, "parse_par_directives", NULL); 05911 05912 return; 05913 05914 } /* parse_par_directives */ 05915 05916 /******************************************************************************\ 05917 |* *| 05918 |* Description: *| 05919 |* This routine parses the C$ directives on one line of source. *| 05920 |* *| 05921 |* Input parameters: *| 05922 |* NONE *| 05923 |* *| 05924 |* Output parameters: *| 05925 |* NONE *| 05926 |* *| 05927 |* Returns: *| 05928 |* NOTHING *| 05929 |* *| 05930 \******************************************************************************/ 05931 static void parse_dollar_directives(void) 05932 { 05933 int ir_idx; 05934 int list_idx; 05935 opnd_type opnd; 05936 long the_constant; 05937 05938 05939 TRACE (Func_Entry, "parse_dollar_directives", NULL); 05940 05941 if (TOKEN_VALUE(token) > Tok_SGI_Dir_Start && 05942 TOKEN_VALUE(token) < Tok_SGI_Dir_End && 05943 disregard_mips[TOKEN_VALUE(token) - Tok_SGI_Dir_Start]) { 05944 goto EXIT; 05945 } 05946 05947 switch (TOKEN_VALUE(token)) { 05948 05949 case Tok_SGI_Dir_Distribute_Reshape: 05950 05951 if (dump_flags.dsm) { 05952 parse_distribution_dir(TRUE); 05953 } 05954 else { 05955 parse_err_flush(Find_EOS, NULL); 05956 } 05957 break; 05958 05959 case Tok_SGI_Dir_Distribute: 05960 05961 if (dump_flags.dsm) { 05962 parse_distribution_dir(FALSE); 05963 } 05964 else { 05965 parse_err_flush(Find_EOS, NULL); 05966 } 05967 break; 05968 05969 case Tok_SGI_Dir_Redistribute: 05970 if (dump_flags.dsm) { 05971 parse_redistribute_dir(); 05972 } 05973 else { 05974 parse_err_flush(Find_EOS, NULL); 05975 } 05976 break; 05977 05978 case Tok_SGI_Dir_Dynamic: 05979 if (dump_flags.dsm) { 05980 if (parse_var_name_list(&opnd, -1)) { 05981 ir_idx = gen_directive_ir(Dynamic_Dollar_Opr); 05982 COPY_OPND(IR_OPND_L(ir_idx), opnd); 05983 } 05984 } 05985 else { 05986 parse_err_flush(Find_EOS, NULL); 05987 } 05988 break; 05989 05990 case Tok_SGI_Dir_Page_Place: 05991 05992 if (dump_flags.dsm) { 05993 ir_idx = gen_directive_ir(Page_Place_Dollar_Opr); 05994 05995 NTR_IR_LIST_TBL(list_idx); 05996 IR_FLD_L(ir_idx) = IL_Tbl_Idx; 05997 IR_IDX_L(ir_idx) = list_idx; 05998 IR_LIST_CNT_L(ir_idx) = 3; 05999 06000 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 06001 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 06002 list_idx = IL_NEXT_LIST_IDX(list_idx); 06003 06004 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 06005 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 06006 06007 list_idx = IR_IDX_L(ir_idx); 06008 06009 if (LA_CH_VALUE == LPAREN) { 06010 NEXT_LA_CH; 06011 06012 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 06013 parse_deref(&opnd, NULL_IDX); 06014 COPY_OPND(IL_OPND(list_idx), opnd); 06015 } 06016 else { 06017 parse_err_flush(Find_EOS, "IDENTIFIER"); 06018 goto EXIT; 06019 } 06020 06021 if (LA_CH_VALUE == COMMA) { 06022 NEXT_LA_CH; 06023 } 06024 else { 06025 parse_err_flush(Find_EOS, ","); 06026 goto EXIT; 06027 } 06028 06029 list_idx = IL_NEXT_LIST_IDX(list_idx); 06030 06031 parse_expr(&opnd); 06032 06033 COPY_OPND(IL_OPND(list_idx), opnd); 06034 06035 if (LA_CH_VALUE == COMMA) { 06036 NEXT_LA_CH; 06037 } 06038 else { 06039 parse_err_flush(Find_EOS, ","); 06040 goto EXIT; 06041 } 06042 06043 list_idx = IL_NEXT_LIST_IDX(list_idx); 06044 06045 parse_expr(&opnd); 06046 06047 COPY_OPND(IL_OPND(list_idx), opnd); 06048 06049 if (LA_CH_VALUE == RPAREN) { 06050 NEXT_LA_CH; 06051 } 06052 else { 06053 parse_err_flush(Find_EOS, ")"); 06054 } 06055 } 06056 else { 06057 parse_err_flush(Find_EOS, "("); 06058 } 06059 } 06060 else { 06061 parse_err_flush(Find_EOS, NULL); 06062 } 06063 break; 06064 06065 case Tok_SGI_Dir_Copyin: 06066 06067 ir_idx = gen_directive_ir(Copyin_Dollar_Opr); 06068 06069 if (directive_region_error(Copyin_Dir, 06070 IR_LINE_NUM(ir_idx), 06071 IR_COL_NUM(ir_idx))) { 06072 } 06073 06074 parse_var_common_list(&opnd, TRUE); 06075 COPY_OPND(IR_OPND_L(ir_idx), opnd); 06076 break; 06077 06078 case Tok_SGI_Dir_Doacross: 06079 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 06080 ir_idx = gen_directive_ir(Doacross_Dollar_Opr); 06081 06082 parse_mp_directive(Doacross); 06083 06084 if (directive_region_error(Doacross_Dir, 06085 IR_LINE_NUM(ir_idx), 06086 IR_COL_NUM(ir_idx))) { 06087 } 06088 else { 06089 SET_DIRECTIVE_STATE(Doacross_Region); 06090 cdir_switches.doacross_sh_idx = curr_stmt_sh_idx; 06091 } 06092 06093 break; 06094 06095 06096 case Tok_SGI_Dir_Chunk: 06097 if (LA_CH_VALUE == EQUAL) { 06098 NEXT_LA_CH; 06099 06100 parse_expr(&opnd); 06101 COPY_OPND(cdir_switches.chunk_opnd, opnd); 06102 } 06103 else { 06104 parse_err_flush(Find_EOS, "="); 06105 goto EXIT; 06106 } 06107 break; 06108 06109 case Tok_SGI_Dir_Mp_Schedtype: 06110 06111 if (LA_CH_VALUE == EQUAL) { 06112 06113 NEXT_LA_CH; 06114 06115 if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 06116 06117 switch (TOKEN_VALUE(token)) { 06118 case Tok_SGI_Dir_Simple: 06119 the_constant = MP_SCHEDTYPE_SIMPLE; 06120 break; 06121 case Tok_SGI_Dir_Static: 06122 the_constant = MP_SCHEDTYPE_SIMPLE; 06123 break; 06124 case Tok_SGI_Dir_Dynamic: 06125 the_constant = MP_SCHEDTYPE_DYNAMIC; 06126 break; 06127 case Tok_SGI_Dir_Interleaved: 06128 the_constant = MP_SCHEDTYPE_INTERLEAVED; 06129 break; 06130 case Tok_SGI_Dir_Interleave: 06131 the_constant = MP_SCHEDTYPE_INTERLEAVED; 06132 break; 06133 case Tok_SGI_Dir_Runtime: 06134 the_constant = MP_SCHEDTYPE_RUNTIME; 06135 break; 06136 case Tok_SGI_Dir_Gss: 06137 the_constant = MP_SCHEDTYPE_GUIDED; 06138 break; 06139 case Tok_SGI_Dir_Guided: 06140 the_constant = MP_SCHEDTYPE_GUIDED; 06141 break; 06142 default: 06143 parse_err_flush(Find_EOS, "MP_SCHEDTYPE mode"); 06144 break; 06145 } 06146 06147 06148 OPND_LINE_NUM(cdir_switches.mp_schedtype_opnd) = TOKEN_LINE(token); 06149 OPND_COL_NUM(cdir_switches.mp_schedtype_opnd) = TOKEN_COLUMN(token); 06150 OPND_FLD(cdir_switches.mp_schedtype_opnd) = CN_Tbl_Idx; 06151 OPND_IDX(cdir_switches.mp_schedtype_opnd) = 06152 C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 06153 the_constant); 06154 06155 if (directives_are_global) { 06156 global_schedtype_value = the_constant; 06157 global_schedtype_line = TOKEN_LINE(token); 06158 global_schedtype_col = TOKEN_COLUMN(token); 06159 } 06160 } 06161 else { 06162 parse_err_flush(Find_EOS, "MP_SCHEDTYPE mode"); 06163 } 06164 06165 } 06166 else { 06167 parse_err_flush(Find_EOS, "="); 06168 goto EXIT; 06169 } 06170 break; 06171 06172 default: 06173 parse_err_flush(Find_EOS, NULL); 06174 06175 } /* end switch */ 06176 06177 /* Flush past all unimplemented dirs */ 06178 06179 if (LA_CH_VALUE != EOS) { 06180 PRINTMSG(LA_CH_LINE, 790, Warning, LA_CH_COLUMN); 06181 parse_err_flush(Find_EOS, NULL); 06182 } 06183 06184 EXIT: 06185 06186 NEXT_LA_CH; 06187 06188 TRACE (Func_Exit, "parse_dollar_directives", NULL); 06189 06190 return; 06191 06192 } /* parse_dollar_directives */ 06193 06194 06195 /******************************************************************************\ 06196 |* *| 06197 |* Description: *| 06198 |* This routine parses the C*$* directives on one line of source. *| 06199 |* *| 06200 |* Input parameters: *| 06201 |* NONE *| 06202 |* *| 06203 |* Output parameters: *| 06204 |* NONE *| 06205 |* *| 06206 |* Returns: *| 06207 |* NOTHING *| 06208 |* *| 06209 \******************************************************************************/ 06210 06211 static void parse_star_directives(void) 06212 { 06213 int attr_idx; 06214 int blk_idx; 06215 int column; 06216 int ir_idx; 06217 int line; 06218 boolean loop_dir = FALSE; 06219 int name_idx; 06220 opnd_type opnd; 06221 operator_type opr; 06222 int save_column_num; 06223 int save_line_num; 06224 06225 06226 TRACE (Func_Entry, "parse_star_directives", NULL); 06227 06228 if (TOKEN_VALUE(token) > Tok_SGI_Dir_Start && 06229 TOKEN_VALUE(token) < Tok_SGI_Dir_End && 06230 disregard_mips[TOKEN_VALUE(token) - Tok_SGI_Dir_Start]) { 06231 goto EXIT; 06232 } 06233 06234 switch (TOKEN_VALUE(token)) { 06235 06236 case Tok_SGI_Dir_Aggressiveinner: 06237 loop_dir = TRUE; 06238 opr = Aggressiveinnerloopfission_Opr; 06239 break; 06240 06241 case Tok_SGI_Dir_Blockingsize: 06242 parse_star_dir_directives(); 06243 goto EXIT; 06244 06245 case Tok_SGI_Dir_Assert: 06246 06247 if (! parse_assert_directive()) { 06248 goto EXIT; 06249 } 06250 break; 06251 06252 case Tok_SGI_Dir_Align_Symbol: 06253 06254 if (curr_stmt_category < Dir_Integer_Stmt_Cat) { 06255 PRINTMSG(TOKEN_LINE(token), 795, Warning, 06256 TOKEN_COLUMN(token), "ALIGN_SYMBOL"); 06257 parse_err_flush(Find_EOS, NULL); 06258 break; 06259 } 06260 06261 if (curr_stmt_category >= Executable_Stmt_Cat) { 06262 PRINTMSG(TOKEN_LINE(token), 531, Error, 06263 TOKEN_COLUMN(token), 06264 "ALIGN_SYMBOL"); 06265 parse_err_flush(Find_EOS, NULL); 06266 break; 06267 } 06268 06269 ir_idx = gen_directive_ir(Align_Symbol_Star_Opr); 06270 parse_fill_align_symbol(); 06271 break; 06272 06273 case Tok_SGI_Dir_Fill_Symbol: 06274 06275 if (curr_stmt_category < Dir_Integer_Stmt_Cat) { 06276 PRINTMSG(TOKEN_LINE(token), 795, Warning, 06277 TOKEN_COLUMN(token), "FILL_SYMBOL"); 06278 parse_err_flush(Find_EOS, NULL); 06279 break; 06280 } 06281 06282 if (curr_stmt_category >= Executable_Stmt_Cat) { 06283 PRINTMSG(TOKEN_LINE(token), 531, Error, 06284 TOKEN_COLUMN(token), 06285 "FILL_SYMBOL"); 06286 parse_err_flush(Find_EOS, NULL); 06287 break; 06288 } 06289 06290 ir_idx = gen_directive_ir(Fill_Symbol_Star_Opr); 06291 parse_fill_align_symbol(); 06292 break; 06293 06294 case Tok_SGI_Dir_Blockable: 06295 parse_star_dir_directives(); 06296 goto EXIT; 06297 06298 case Tok_SGI_Dir_Concurrentize: 06299 ir_idx = gen_directive_ir(Concurrentize_Star_Opr); 06300 06301 if (directives_are_global) { 06302 /* copy the assert into the global ir table */ 06303 gen_gl_sh(After, Directive_Stmt, IR_LINE_NUM(ir_idx), 06304 IR_COL_NUM(ir_idx), 06305 FALSE, FALSE, TRUE); 06306 GL_SH_IR_IDX(curr_gl_stmt_sh_idx) = copy_to_gl_subtree(ir_idx, 06307 IR_Tbl_Idx); 06308 } 06309 break; 06310 06311 case Tok_SGI_Dir_Fissionable: 06312 loop_dir = TRUE; 06313 opr = Fissionable_Star_Opr; 06314 break; 06315 06316 case Tok_SGI_Dir_Flush: 06317 ir_idx = gen_directive_ir(Flush_Star_Opr); 06318 06319 if (LA_CH_VALUE == LPAREN) { 06320 NEXT_LA_CH; 06321 06322 parse_var_name_list(&opnd, -1); 06323 COPY_OPND(IR_OPND_L(ir_idx), opnd); 06324 06325 if (LA_CH_VALUE == RPAREN) { 06326 NEXT_LA_CH; 06327 } 06328 else { 06329 parse_err_flush(Find_EOS, ")"); 06330 goto EXIT; 06331 } 06332 } 06333 break; 06334 06335 case Tok_SGI_Dir_Fusable: 06336 loop_dir = TRUE; 06337 opr = Fusable_Star_Opr; 06338 break; 06339 06340 case Tok_SGI_Dir_Fission: 06341 ir_idx = gen_directive_ir(Fission_Star_Opr); 06342 06343 if (LA_CH_VALUE == LPAREN) { 06344 NEXT_LA_CH; 06345 06346 parse_expr(&opnd); 06347 COPY_OPND(IR_OPND_L(ir_idx), opnd); 06348 06349 if (LA_CH_VALUE == RPAREN) { 06350 NEXT_LA_CH; 06351 } 06352 else { 06353 parse_err_flush(Find_EOS, ")"); 06354 goto EXIT; 06355 } 06356 } 06357 else { 06358 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 06359 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 06360 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 06361 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX; 06362 } 06363 break; 06364 06365 case Tok_SGI_Dir_Fuse: 06366 ir_idx = gen_directive_ir(Fuse_Star_Opr); 06367 06368 if (LA_CH_VALUE == LPAREN) { 06369 NEXT_LA_CH; 06370 06371 parse_expr(&opnd); 06372 COPY_OPND(IR_OPND_L(ir_idx), opnd); 06373 06374 if (LA_CH_VALUE == COMMA) { 06375 NEXT_LA_CH; 06376 06377 parse_expr(&opnd); 06378 COPY_OPND(IR_OPND_R(ir_idx), opnd); 06379 } 06380 else { 06381 /* default value is 0 for second arg */ 06382 06383 IR_LINE_NUM_R(ir_idx) = TOKEN_LINE(token); 06384 IR_COL_NUM_R(ir_idx) = TOKEN_COLUMN(token); 06385 IR_FLD_R(ir_idx) = CN_Tbl_Idx; 06386 IR_IDX_R(ir_idx) = CN_INTEGER_ZERO_IDX; 06387 } 06388 06389 if (LA_CH_VALUE == RPAREN) { 06390 NEXT_LA_CH; 06391 } 06392 else { 06393 parse_err_flush(Find_EOS, ")"); 06394 goto EXIT; 06395 } 06396 } 06397 else { 06398 /* defaults are 2 and 0 */ 06399 06400 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 06401 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 06402 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 06403 IR_IDX_L(ir_idx) = CN_INTEGER_TWO_IDX; 06404 06405 IR_LINE_NUM_R(ir_idx) = TOKEN_LINE(token); 06406 IR_COL_NUM_R(ir_idx) = TOKEN_COLUMN(token); 06407 IR_FLD_R(ir_idx) = CN_Tbl_Idx; 06408 IR_IDX_R(ir_idx) = CN_INTEGER_ZERO_IDX; 06409 } 06410 break; 06411 06412 case Tok_SGI_Dir_Inline: 06413 case Tok_SGI_Dir_Ipa: 06414 parse_sgi_dir_inline(TRUE); 06415 break; 06416 06417 case Tok_SGI_Dir_Noinline: 06418 case Tok_SGI_Dir_Noipa: 06419 parse_sgi_dir_inline(FALSE); 06420 break; 06421 06422 case Tok_SGI_Dir_Interchange: 06423 parse_star_dir_directives(); 06424 goto EXIT; 06425 06426 case Tok_SGI_Dir_Noblocking: 06427 loop_dir = TRUE; 06428 opr = Noblocking_Dir_Opr; 06429 break; 06430 06431 case Tok_SGI_Dir_Noconcurrentize: 06432 ir_idx = gen_directive_ir(Noconcurrentize_Star_Opr); 06433 06434 if (directives_are_global) { 06435 /* copy the assert into the global ir table */ 06436 gen_gl_sh(After, Directive_Stmt, IR_LINE_NUM(ir_idx), 06437 IR_COL_NUM(ir_idx), 06438 FALSE, FALSE, TRUE); 06439 GL_SH_IR_IDX(curr_gl_stmt_sh_idx) = copy_to_gl_subtree(ir_idx, 06440 IR_Tbl_Idx); 06441 } 06442 break; 06443 06444 case Tok_SGI_Dir_Nointerchange: 06445 loop_dir = TRUE; 06446 opr = Nointerchange_Dir_Opr; 06447 break; 06448 06449 case Tok_SGI_Dir_Nofission: 06450 loop_dir = TRUE; 06451 opr = Nofission_Star_Opr; 06452 break; 06453 06454 case Tok_SGI_Dir_Nofusion: 06455 loop_dir = TRUE; 06456 opr = Nofusion_Star_Opr; 06457 break; 06458 06459 case Tok_SGI_Dir_Opaque: 06460 loop_dir = TRUE; 06461 opr = Opaque_Star_Opr; 06462 06463 if (directive_region_error(Opaque_Dir, 06464 TOKEN_LINE(token), 06465 TOKEN_COLUMN(token))) { 06466 } 06467 break; 06468 06469 case Tok_SGI_Dir_Optional: 06470 06471 if (curr_stmt_category < Dir_Integer_Stmt_Cat) { 06472 PRINTMSG(TOKEN_LINE(token), 795, Warning, 06473 TOKEN_COLUMN(token), "OPTIONAL"); 06474 parse_err_flush(Find_EOS, NULL); 06475 break; 06476 } 06477 06478 if (directive_region_error(Optional_Dir, 06479 TOKEN_LINE(token), 06480 TOKEN_COLUMN(token))) { 06481 break; 06482 } 06483 06484 if (LA_CH_VALUE == LPAREN) { 06485 NEXT_LA_CH; 06486 06487 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 06488 attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token), 06489 &name_idx); 06490 06491 if (attr_idx == NULL_IDX) { 06492 attr_idx = ntr_sym_tbl(&token, name_idx); 06493 LN_DEF_LOC(name_idx) = TRUE; 06494 AT_OBJ_CLASS(attr_idx) = Pgm_Unit; 06495 MAKE_EXTERNAL_NAME(attr_idx, 06496 AT_NAME_IDX(attr_idx), 06497 AT_NAME_LEN(attr_idx)); 06498 ATP_PROC(attr_idx) = Extern_Proc; 06499 ATP_SCP_IDX(attr_idx) = curr_scp_idx; 06500 ATP_OPTIONAL_DIR(attr_idx) = TRUE; 06501 } 06502 else if (!fnd_semantic_err(Obj_Optional_Dir, 06503 TOKEN_LINE(token), 06504 TOKEN_COLUMN(token), 06505 attr_idx, 06506 TRUE)) { 06507 06508 if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) { 06509 AT_ATTR_LINK(attr_idx) = NULL_IDX; 06510 LN_DEF_LOC(name_idx) = TRUE; 06511 } 06512 06513 if (AT_OBJ_CLASS(attr_idx) == Data_Obj) { /* Switch to Function*/ 06514 chg_data_obj_to_pgm_unit(attr_idx, 06515 Function, 06516 Extern_Proc); 06517 ATP_OPTIONAL_DIR(attr_idx) = TRUE; 06518 } 06519 else if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit) { 06520 ATP_OPTIONAL_DIR(attr_idx) = TRUE; 06521 } 06522 } 06523 } 06524 else { 06525 parse_err_flush(Find_EOS, "procedure name"); 06526 goto EXIT; 06527 } 06528 06529 if (LA_CH_VALUE == RPAREN) { 06530 NEXT_LA_CH; 06531 } 06532 else { 06533 parse_err_flush(Find_EOS, ")"); 06534 goto EXIT; 06535 } 06536 } 06537 else { 06538 parse_err_flush(Find_EOS, "("); 06539 goto EXIT; 06540 } 06541 break; 06542 06543 case Tok_SGI_Dir_Purpleconditional: 06544 ir_idx = gen_directive_ir(Purpleconditional_Star_Opr); 06545 06546 if (directive_region_error(PurpleConditional_Dir, 06547 IR_LINE_NUM(ir_idx), 06548 IR_COL_NUM(ir_idx))) { 06549 } 06550 06551 if (LA_CH_VALUE == LPAREN) { 06552 NEXT_LA_CH; 06553 parse_expr(&opnd); 06554 06555 COPY_OPND(IR_OPND_L(ir_idx), opnd); 06556 06557 if (LA_CH_VALUE == RPAREN) { 06558 NEXT_LA_CH; 06559 } 06560 else { 06561 parse_err_flush(Find_EOS, ")"); 06562 goto EXIT; 06563 } 06564 } 06565 else { 06566 parse_err_flush(Find_EOS, "("); 06567 goto EXIT; 06568 } 06569 break; 06570 06571 case Tok_SGI_Dir_Purpleunconditional: 06572 loop_dir = TRUE; 06573 opr = Purpleunconditional_Star_Opr; 06574 06575 if (directive_region_error(PurpleUnconditional_Dir, 06576 TOKEN_LINE(token), 06577 TOKEN_COLUMN(token))) { 06578 } 06579 break; 06580 06581 case Tok_SGI_Dir_Regionbegin: 06582 ir_idx = gen_directive_ir(Regionbegin_Star_Opr); 06583 06584 if (directive_region_error(Regionbegin_Dir, 06585 IR_LINE_NUM(ir_idx), 06586 IR_COL_NUM(ir_idx))) { 06587 } 06588 06589 SET_DIRECTIVE_STATE(Region_Region); 06590 PUSH_BLK_STK (SGI_Region_Blk); 06591 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 06592 LINK_TO_PARENT_BLK; 06593 break; 06594 06595 case Tok_SGI_Dir_Regionend: 06596 ir_idx = gen_directive_ir(Regionend_Star_Opr); 06597 06598 if (directive_region_error(Regionend_Dir, 06599 IR_LINE_NUM(ir_idx), 06600 IR_COL_NUM(ir_idx))) { 06601 } 06602 06603 CLEAR_DIRECTIVE_STATE(Region_Region); 06604 SH_STMT_TYPE(curr_stmt_sh_idx) = SGI_Region_End_Stmt; 06605 stmt_type = SGI_Region_End_Stmt; 06606 end_region_blk(FALSE); 06607 break; 06608 06609 case Tok_SGI_Dir_Section_Non_Gp: 06610 06611 if (LA_CH_VALUE != LPAREN) { 06612 parse_err_flush(Find_EOS, "("); 06613 } 06614 else { 06615 NEXT_LA_CH; 06616 06617 ir_idx = gen_directive_ir(Section_Nongp_Star_Opr); 06618 06619 parse_var_common_list(&opnd, FALSE); 06620 06621 COPY_OPND(IR_OPND_L(ir_idx), opnd); 06622 06623 if (LA_CH_VALUE != RPAREN) { 06624 parse_err_flush(Find_EOS, ")"); 06625 } 06626 else { 06627 NEXT_LA_CH; 06628 } 06629 } 06630 break; 06631 06632 case Tok_SGI_Dir_Section_Gp: 06633 06634 if (LA_CH_VALUE != LPAREN) { 06635 parse_err_flush(Find_EOS, "("); 06636 } 06637 else { 06638 NEXT_LA_CH; 06639 06640 ir_idx = gen_directive_ir(Section_Gp_Star_Opr); 06641 06642 parse_var_common_list(&opnd, FALSE); 06643 06644 COPY_OPND(IR_OPND_L(ir_idx), opnd); 06645 06646 if (LA_CH_VALUE != RPAREN) { 06647 parse_err_flush(Find_EOS, ")"); 06648 } 06649 else { 06650 NEXT_LA_CH; 06651 } 06652 } 06653 06654 break; 06655 06656 06657 case Tok_SGI_Dir_Prefetch_Manual: 06658 ir_idx = gen_directive_ir(Prefetch_Manual_Star_Opr); 06659 06660 if (LA_CH_VALUE == LPAREN) { 06661 NEXT_LA_CH; 06662 06663 parse_expr(&opnd); 06664 COPY_OPND(IR_OPND_L(ir_idx), opnd); 06665 06666 if (LA_CH_VALUE == RPAREN) { 06667 NEXT_LA_CH; 06668 } 06669 else { 06670 parse_err_flush(Find_EOS, ")"); 06671 goto EXIT; 06672 } 06673 } 06674 else { 06675 parse_err_flush(Find_EOS, "("); 06676 goto EXIT; 06677 } 06678 break; 06679 06680 case Tok_SGI_Dir_Prefetch_Ref: 06681 ir_idx = gen_directive_ir(Prefetch_Ref_Star_Opr); 06682 parse_prefetch_ref(); 06683 break; 06684 06685 case Tok_SGI_Dir_Prefetch: 06686 ir_idx = gen_directive_ir(Prefetch_Star_Opr); 06687 06688 if (LA_CH_VALUE == LPAREN) { 06689 NEXT_LA_CH; 06690 06691 parse_expr(&opnd); 06692 COPY_OPND(IR_OPND_L(ir_idx), opnd); 06693 06694 if (LA_CH_VALUE == COMMA) { 06695 NEXT_LA_CH; 06696 06697 parse_expr(&opnd); 06698 COPY_OPND(IR_OPND_R(ir_idx), opnd); 06699 } 06700 else { 06701 /* the default value of -1 is set in s_directiv.c */ 06702 } 06703 06704 if (LA_CH_VALUE == RPAREN) { 06705 NEXT_LA_CH; 06706 } 06707 else { 06708 parse_err_flush(Find_EOS, ")"); 06709 goto EXIT; 06710 } 06711 } 06712 else { 06713 parse_err_flush(Find_EOS, "("); 06714 goto EXIT; 06715 } 06716 break; 06717 06718 case Tok_SGI_Dir_Prefetch_Ref_Disable: 06719 ir_idx = gen_directive_ir(Prefetch_Ref_Disable_Star_Opr); 06720 06721 if (LA_CH_VALUE == EQUAL) { 06722 NEXT_LA_CH; 06723 06724 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 06725 parse_deref(&opnd, NULL_IDX); 06726 06727 if (OPND_FLD(opnd) != AT_Tbl_Idx) { 06728 find_opnd_line_and_column(&opnd, &line, &column); 06729 PRINTMSG(line, 1374, Error, column); 06730 } 06731 else { 06732 COPY_OPND(IR_OPND_L(ir_idx), opnd); 06733 } 06734 } 06735 else { 06736 parse_err_flush(Find_EOS, "array name"); 06737 goto EXIT; 06738 } 06739 06740 if (LA_CH_VALUE == COMMA) { 06741 NEXT_LA_CH; 06742 06743 if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd) && 06744 TOKEN_VALUE(token) == Tok_SGI_Dir_Size) { 06745 06746 if (LA_CH_VALUE == EQUAL) { 06747 NEXT_LA_CH; 06748 06749 parse_expr(&opnd); 06750 COPY_OPND(IR_OPND_R(ir_idx), opnd); 06751 } 06752 else { 06753 parse_err_flush(Find_EOS, "="); 06754 goto EXIT; 06755 } 06756 } 06757 else { 06758 parse_err_flush(Find_EOS, "SIZE"); 06759 goto EXIT; 06760 } 06761 } 06762 } 06763 else { 06764 parse_err_flush(Find_EOS, "="); 06765 goto EXIT; 06766 } 06767 break; 06768 06769 case Tok_SGI_Dir_Unroll: 06770 ir_idx = gen_directive_ir(Unroll_Star_Opr); 06771 06772 if (LA_CH_VALUE == LPAREN) { 06773 NEXT_LA_CH; 06774 06775 parse_expr(&opnd); 06776 COPY_OPND(IR_OPND_L(ir_idx), opnd); 06777 06778 if (LA_CH_VALUE == COMMA) { 06779 NEXT_LA_CH; 06780 06781 /* parse, but ignore weight parameter ,n2 */ 06782 parse_expr(&opnd); 06783 } 06784 06785 if (LA_CH_VALUE == RPAREN) { 06786 NEXT_LA_CH; 06787 } 06788 else { 06789 parse_err_flush(Find_EOS, ")"); 06790 goto EXIT; 06791 } 06792 } 06793 else { 06794 parse_err_flush(Find_EOS, "("); 06795 goto EXIT; 06796 } 06797 break; 06798 06799 case Tok_SGI_Dir_Limit: 06800 case Tok_SGI_Dir_Minconcurrent: 06801 PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token)); 06802 parse_err_flush(Find_EOS, NULL); 06803 break; 06804 06805 default: 06806 /* treat as comment */ 06807 parse_err_flush(Find_EOS, NULL); 06808 06809 } /* end switch */ 06810 06811 if (loop_dir) { 06812 06813 if (curr_stmt_category < Dir_Integer_Stmt_Cat) { 06814 PRINTMSG(TOKEN_LINE(token), 795, Warning, TOKEN_COLUMN(token), 06815 TOKEN_STR(token)); 06816 parse_err_flush(Find_EOS, NULL); 06817 } 06818 else { 06819 ir_idx = gen_directive_ir(opr); 06820 } 06821 } 06822 06823 /* Flush past all unimplemented dirs */ 06824 06825 if (LA_CH_VALUE != EOS) { 06826 PRINTMSG(LA_CH_LINE, 790, Warning, LA_CH_COLUMN); 06827 parse_err_flush(Find_EOS, NULL); 06828 } 06829 06830 EXIT: 06831 06832 NEXT_LA_CH; 06833 06834 TRACE (Func_Exit, "parse_star_directives", NULL); 06835 06836 return; 06837 06838 } /* parse_star_directives */ 06839 06840 /******************************************************************************\ 06841 |* *| 06842 |* Description: *| 06843 |* This routine parses the PREFETCH_REF directive. *| 06844 |* The ir it produces looks like .. *| 06845 |* *| 06846 |* (Prefetch_Ref_Star_Opr) *| 06847 |* / *| 06848 |* |- array ref *| 06849 |* |- stride list (2) *| 06850 |* |- level list (2) *| 06851 |* |- kind *| 06852 |* |- size *| 06853 |* *| 06854 |* Input parameters: *| 06855 |* NONE *| 06856 |* *| 06857 |* Output parameters: *| 06858 |* NONE *| 06859 |* *| 06860 |* Returns: *| 06861 |* NOTHING *| 06862 |* *| 06863 \******************************************************************************/ 06864 06865 static void parse_prefetch_ref(void) 06866 06867 { 06868 int buf_idx; 06869 int column; 06870 int i; 06871 int ir_idx; 06872 int line; 06873 int list_array[5]; 06874 int list_idx; 06875 opnd_type opnd; 06876 int stmt_num; 06877 06878 06879 TRACE (Func_Entry, "parse_prefetch_ref", NULL); 06880 06881 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 06882 06883 for (i = 0; i < 5; i++) { 06884 NTR_IR_LIST_TBL(list_array[i]); 06885 if (i >= 1) { 06886 IL_NEXT_LIST_IDX(list_array[i - 1]) = list_array[i]; 06887 IL_PREV_LIST_IDX(list_array[i]) = list_array[i - 1]; 06888 } 06889 } 06890 06891 IR_FLD_L(ir_idx) = IL_Tbl_Idx; 06892 IR_IDX_L(ir_idx) = list_array[0]; 06893 IR_LIST_CNT_L(ir_idx) = 5; 06894 06895 if (LA_CH_VALUE == EQUAL) { 06896 NEXT_LA_CH; 06897 06898 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 06899 parse_deref(&opnd, NULL_IDX); 06900 COPY_OPND(IL_OPND(list_array[0]), opnd); 06901 } 06902 else { 06903 parse_err_flush(Find_EOS, "array name"); 06904 goto EXIT; 06905 } 06906 } 06907 else { 06908 parse_err_flush(Find_EOS, "="); 06909 goto EXIT; 06910 } 06911 06912 while (LA_CH_VALUE == COMMA) { 06913 NEXT_LA_CH; 06914 06915 if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 06916 06917 if (LA_CH_VALUE == EQUAL) { 06918 NEXT_LA_CH; 06919 } 06920 else { 06921 parse_err_flush(Find_EOS, "="); 06922 goto EXIT; 06923 } 06924 06925 switch (TOKEN_VALUE(token)) { 06926 case Tok_SGI_Dir_Stride: 06927 if (IL_IDX(list_array[1]) != NULL_IDX) { 06928 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 06929 "STRIDE", "PREFETCH_REF"); 06930 parse_err_flush(Find_EOS, NULL); 06931 goto EXIT; 06932 } 06933 06934 /* I assume I will get digits here */ 06935 parse_expr(&opnd); 06936 NTR_IR_LIST_TBL(list_idx); 06937 IL_FLD(list_array[1]) = IL_Tbl_Idx; 06938 IL_LIST_CNT(list_array[1]) = 1; 06939 IL_IDX(list_array[1]) = list_idx; 06940 06941 COPY_OPND(IL_OPND(list_idx), opnd); 06942 06943 if (LA_CH_VALUE == COMMA) { 06944 buf_idx = LA_CH_BUF_IDX; 06945 stmt_num = LA_CH_STMT_NUM; 06946 06947 NEXT_LA_CH; 06948 if (isdigit(LA_CH_VALUE)) { 06949 parse_expr(&opnd); 06950 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 06951 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 06952 list_idx = IL_NEXT_LIST_IDX(list_idx); 06953 IL_LIST_CNT(list_array[1]) += 1; 06954 COPY_OPND(IL_OPND(list_idx), opnd); 06955 } 06956 else { 06957 reset_lex(buf_idx, stmt_num); 06958 } 06959 } 06960 break; 06961 06962 case Tok_SGI_Dir_Level: 06963 if (IL_IDX(list_array[2]) != NULL_IDX) { 06964 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 06965 "LEVEL", "PREFETCH_REF"); 06966 parse_err_flush(Find_EOS, NULL); 06967 goto EXIT; 06968 } 06969 06970 /* I assume I will get digits here */ 06971 parse_expr(&opnd); 06972 NTR_IR_LIST_TBL(list_idx); 06973 IL_FLD(list_array[2]) = IL_Tbl_Idx; 06974 IL_LIST_CNT(list_array[2]) = 1; 06975 IL_IDX(list_array[2]) = list_idx; 06976 06977 COPY_OPND(IL_OPND(list_idx), opnd); 06978 06979 if (LA_CH_VALUE == COMMA) { 06980 buf_idx = LA_CH_BUF_IDX; 06981 stmt_num = LA_CH_STMT_NUM; 06982 06983 NEXT_LA_CH; 06984 if (isdigit(LA_CH_VALUE)) { 06985 parse_expr(&opnd); 06986 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 06987 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 06988 list_idx = IL_NEXT_LIST_IDX(list_idx); 06989 IL_LIST_CNT(list_array[2]) += 1; 06990 COPY_OPND(IL_OPND(list_idx), opnd); 06991 } 06992 else { 06993 reset_lex(buf_idx, stmt_num); 06994 } 06995 } 06996 break; 06997 06998 case Tok_SGI_Dir_Kind: 06999 if (IL_IDX(list_array[3]) != NULL_IDX) { 07000 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07001 "KIND", "PREFETCH_REF"); 07002 parse_err_flush(Find_EOS, NULL); 07003 goto EXIT; 07004 } 07005 07006 if (LA_CH_VALUE == 'R') { 07007 line = LA_CH_LINE; 07008 column = LA_CH_COLUMN; 07009 NEXT_LA_CH; 07010 if (LA_CH_VALUE == 'D') { 07011 NEXT_LA_CH; 07012 IL_FLD(list_array[3]) = CN_Tbl_Idx; 07013 IL_IDX(list_array[3]) = CN_INTEGER_ZERO_IDX; 07014 IL_LINE_NUM(list_array[3]) = line; 07015 IL_COL_NUM(list_array[3]) = column; 07016 } 07017 else { 07018 parse_err_flush(Find_EOS, "RD or WR"); 07019 goto EXIT; 07020 } 07021 } 07022 else if (LA_CH_VALUE == 'W') { 07023 line = LA_CH_LINE; 07024 column = LA_CH_COLUMN; 07025 NEXT_LA_CH; 07026 if (LA_CH_VALUE == 'R') { 07027 NEXT_LA_CH; 07028 IL_FLD(list_array[3]) = CN_Tbl_Idx; 07029 IL_IDX(list_array[3]) = CN_INTEGER_ONE_IDX; 07030 IL_LINE_NUM(list_array[3]) = line; 07031 IL_COL_NUM(list_array[3]) = column; 07032 } 07033 else { 07034 parse_err_flush(Find_EOS, "RD or WR"); 07035 goto EXIT; 07036 } 07037 } 07038 else { 07039 parse_err_flush(Find_EOS, "RD or WR"); 07040 goto EXIT; 07041 } 07042 break; 07043 07044 case Tok_SGI_Dir_Size: 07045 if (IL_IDX(list_array[4]) != NULL_IDX) { 07046 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07047 "SIZE", "PREFETCH_REF"); 07048 parse_err_flush(Find_EOS, NULL); 07049 goto EXIT; 07050 } 07051 07052 parse_expr(&opnd); 07053 COPY_OPND(IL_OPND(list_array[4]), opnd); 07054 break; 07055 07056 default: 07057 parse_err_flush(Find_EOS, "PREFETCH_REF clause"); 07058 goto EXIT; 07059 } 07060 } 07061 else { 07062 parse_err_flush(Find_EOS, "PREFETCH_REF clause"); 07063 goto EXIT; 07064 } 07065 } 07066 07067 line = IR_LINE_NUM(ir_idx); 07068 column = IR_COL_NUM(ir_idx); 07069 07070 if (IL_FLD(list_array[1]) == NO_Tbl_Idx) { 07071 NTR_IR_LIST_TBL(list_idx); 07072 IL_FLD(list_array[1]) = IL_Tbl_Idx; 07073 IL_LIST_CNT(list_array[1]) = 1; 07074 IL_IDX(list_array[1]) = list_idx; 07075 07076 IL_FLD(list_idx) = CN_Tbl_Idx; 07077 IL_IDX(list_idx) = CN_INTEGER_ONE_IDX; 07078 IL_LINE_NUM(list_idx) = line; 07079 IL_COL_NUM(list_idx) = column; 07080 } 07081 07082 if (IL_FLD(list_array[2]) == NO_Tbl_Idx) { 07083 NTR_IR_LIST_TBL(list_idx); 07084 IL_FLD(list_array[2]) = IL_Tbl_Idx; 07085 IL_LIST_CNT(list_array[2]) = 1; 07086 IL_IDX(list_array[2]) = list_idx; 07087 07088 IL_FLD(list_idx) = CN_Tbl_Idx; 07089 IL_IDX(list_idx) = CN_INTEGER_TWO_IDX; 07090 IL_LINE_NUM(list_idx) = line; 07091 IL_COL_NUM(list_idx) = column; 07092 } 07093 07094 if (IL_FLD(list_array[3]) == NO_Tbl_Idx) { 07095 IL_FLD(list_array[3]) = CN_Tbl_Idx; 07096 IL_IDX(list_array[3]) = CN_INTEGER_ONE_IDX; 07097 IL_LINE_NUM(list_array[3]) = line; 07098 IL_COL_NUM(list_array[3]) = column; 07099 } 07100 EXIT: 07101 07102 TRACE (Func_Exit, "parse_prefetch_ref", NULL); 07103 07104 return; 07105 07106 } /* parse_prefetch_ref */ 07107 07108 /******************************************************************************\ 07109 |* *| 07110 |* Description: *| 07111 |* This routine parses the mp directive. *| 07112 |* The ir it produces looks like .. *| 07113 |* *| 07114 |* (mp directive operator) *| 07115 |* / *| 07116 |* |- IF condition *| 07117 |* |- SHARE | SHARED var list *| 07118 |* |- LASTLOCAL var list *| 07119 |* |- REDUCTION var list *| 07120 |* |- MP_SCHEDTYPE value (in const table) *| 07121 |* |- CHUNK expression (also BLOCKED) *| 07122 |* |- AFFINITY index_var list *| 07123 |* |- IS THREAD constant (THREAD == 1, DATA == 0) *| 07124 |* |- THREAD/DATA list *| 07125 |* |- LOCAL | PRIVATE var list *| 07126 |* |- ONTO list *| 07127 |* |- NEST list *| 07128 |* |- LASTTHREAD opnd *| 07129 |* |- ORDERED constant (ORDERED == 1, else NO_Tbl_Idx) *| 07130 |* *| 07131 |* Input parameters: *| 07132 |* NONE *| 07133 |* *| 07134 |* Output parameters: *| 07135 |* NONE *| 07136 |* *| 07137 |* Returns: *| 07138 |* NOTHING *| 07139 |* *| 07140 \******************************************************************************/ 07141 07142 static void parse_mp_directive(mp_directive_type directive) 07143 07144 { 07145 int column; 07146 int i; 07147 int ir_idx; 07148 int line; 07149 int list_array[MP_DIR_LIST_CNT]; 07150 int list_idx; 07151 int list2_idx; 07152 opnd_type opnd; 07153 boolean seen_nest = FALSE; 07154 long the_constant; 07155 07156 07157 TRACE (Func_Entry, "parse_mp_directive", NULL); 07158 07159 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 07160 07161 for (i = 0; i < MP_DIR_LIST_CNT; i++) { 07162 NTR_IR_LIST_TBL(list_array[i]); 07163 if (i >= 1) { 07164 IL_NEXT_LIST_IDX(list_array[i - 1]) = list_array[i]; 07165 IL_PREV_LIST_IDX(list_array[i]) = list_array[i - 1]; 07166 } 07167 } 07168 07169 IR_FLD_L(ir_idx) = IL_Tbl_Idx; 07170 IR_IDX_L(ir_idx) = list_array[0]; 07171 IR_LIST_CNT_L(ir_idx) = MP_DIR_LIST_CNT; 07172 07173 while (LA_CH_VALUE != EOS) { 07174 07175 if (LA_CH_VALUE == LPAREN) { 07176 /* must be (ORDERED) */ 07177 NEXT_LA_CH; 07178 07179 if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 07180 07181 if (TOKEN_VALUE(token) == Tok_SGI_Dir_Ordered) { 07182 07183 if (! clause_allowed[directive][Ordered_Clause]) { 07184 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07185 "ORDERED", mp_dir_str[directive]); 07186 parse_err_flush(Find_EOS, NULL); 07187 goto EXIT; 07188 } 07189 07190 if (IL_IDX(list_array[MP_DIR_ORDERED_IDX]) != NULL_IDX) { 07191 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07192 "ORDERED", mp_dir_str[directive]); 07193 parse_err_flush(Find_EOS, NULL); 07194 goto EXIT; 07195 } 07196 07197 07198 IL_FLD(list_array[MP_DIR_ORDERED_IDX]) = CN_Tbl_Idx; 07199 IL_LINE_NUM(list_array[MP_DIR_ORDERED_IDX]) = TOKEN_LINE(token); 07200 IL_COL_NUM(list_array[MP_DIR_ORDERED_IDX]) = TOKEN_COLUMN(token); 07201 IL_IDX(list_array[MP_DIR_ORDERED_IDX]) = CN_INTEGER_ONE_IDX; 07202 07203 if (LA_CH_VALUE == RPAREN) { 07204 NEXT_LA_CH; 07205 } 07206 else { 07207 parse_err_flush(Find_EOS, ")"); 07208 } 07209 } 07210 else { 07211 parse_err_flush(Find_EOS, "ORDERED clause"); 07212 } 07213 } 07214 else { 07215 parse_err_flush(Find_EOS, "mp clause"); 07216 } 07217 } 07218 else if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 07219 07220 switch (TOKEN_VALUE(token)) { 07221 07222 case Tok_SGI_Dir_If: 07223 07224 if (! clause_allowed[directive][If_Clause]) { 07225 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07226 "IF", mp_dir_str[directive]); 07227 parse_err_flush(Find_EOS, NULL); 07228 goto EXIT; 07229 } 07230 07231 if (IL_IDX(list_array[MP_DIR_IF_IDX]) != NULL_IDX) { 07232 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07233 "IF", mp_dir_str[directive]); 07234 parse_err_flush(Find_EOS, NULL); 07235 goto EXIT; 07236 } 07237 07238 if (LA_CH_VALUE == LPAREN) { 07239 NEXT_LA_CH; 07240 parse_expr(&opnd); 07241 07242 COPY_OPND(IL_OPND(list_array[MP_DIR_IF_IDX]), opnd); 07243 07244 if (LA_CH_VALUE == RPAREN) { 07245 NEXT_LA_CH; 07246 } 07247 else { 07248 parse_err_flush(Find_EOS, ")"); 07249 goto EXIT; 07250 } 07251 } 07252 else { 07253 parse_err_flush(Find_EOS, "("); 07254 goto EXIT; 07255 } 07256 break; 07257 07258 case Tok_SGI_Dir_Share: 07259 case Tok_SGI_Dir_Shared: 07260 07261 if (! clause_allowed[directive][Share_Clause]) { 07262 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07263 "SHARE", mp_dir_str[directive]); 07264 parse_err_flush(Find_EOS, NULL); 07265 goto EXIT; 07266 } 07267 07268 if (LA_CH_VALUE == LPAREN) { 07269 NEXT_LA_CH; 07270 parse_var_name_list(&opnd, -1); 07271 07272 if (IL_IDX(list_array[MP_DIR_SHARE_IDX]) == NULL_IDX) { 07273 COPY_OPND(IL_OPND(list_array[MP_DIR_SHARE_IDX]), opnd); 07274 } 07275 else { 07276 /* find the end of list */ 07277 07278 list_idx = IL_IDX(list_array[MP_DIR_SHARE_IDX]); 07279 while (IL_NEXT_LIST_IDX(list_idx)) { 07280 list_idx = IL_NEXT_LIST_IDX(list_idx); 07281 } 07282 07283 /* append the new list */ 07284 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 07285 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 07286 IL_LIST_CNT(list_array[MP_DIR_SHARE_IDX]) += 07287 OPND_LIST_CNT(opnd); 07288 } 07289 07290 if (LA_CH_VALUE == RPAREN) { 07291 NEXT_LA_CH; 07292 } 07293 else { 07294 parse_err_flush(Find_EOS, ")"); 07295 goto EXIT; 07296 } 07297 } 07298 else { 07299 parse_err_flush(Find_EOS, "("); 07300 goto EXIT; 07301 } 07302 07303 break; 07304 07305 case Tok_SGI_Dir_Lastlocal: 07306 07307 if (! clause_allowed[directive][Lastlocal_Clause]) { 07308 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07309 "LASTLOCAL", mp_dir_str[directive]); 07310 parse_err_flush(Find_EOS, NULL); 07311 goto EXIT; 07312 } 07313 07314 if (LA_CH_VALUE == LPAREN) { 07315 NEXT_LA_CH; 07316 parse_var_name_list(&opnd, -1); 07317 07318 if (IL_IDX(list_array[MP_DIR_LASTLOCAL_IDX]) == NULL_IDX) { 07319 COPY_OPND(IL_OPND(list_array[MP_DIR_LASTLOCAL_IDX]), 07320 opnd); 07321 } 07322 else { 07323 /* find the end of list */ 07324 07325 list_idx = IL_IDX(list_array[MP_DIR_LASTLOCAL_IDX]); 07326 while (IL_NEXT_LIST_IDX(list_idx)) { 07327 list_idx = IL_NEXT_LIST_IDX(list_idx); 07328 } 07329 07330 /* append the new list */ 07331 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 07332 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 07333 IL_LIST_CNT(list_array[MP_DIR_LASTLOCAL_IDX]) += 07334 OPND_LIST_CNT(opnd); 07335 } 07336 07337 if (LA_CH_VALUE == RPAREN) { 07338 NEXT_LA_CH; 07339 } 07340 else { 07341 parse_err_flush(Find_EOS, ")"); 07342 goto EXIT; 07343 } 07344 } 07345 else { 07346 parse_err_flush(Find_EOS, "("); 07347 goto EXIT; 07348 } 07349 07350 break; 07351 07352 case Tok_SGI_Dir_Reduction: 07353 07354 if (! clause_allowed[directive][Reduction_Clause]) { 07355 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07356 "REDUCTION", mp_dir_str[directive]); 07357 parse_err_flush(Find_EOS, NULL); 07358 goto EXIT; 07359 } 07360 07361 if (LA_CH_VALUE == LPAREN) { 07362 NEXT_LA_CH; 07363 parse_reference_list(&opnd); 07364 07365 if (IL_IDX(list_array[MP_DIR_REDUCTION_IDX]) == NULL_IDX) { 07366 COPY_OPND(IL_OPND(list_array[MP_DIR_REDUCTION_IDX]), 07367 opnd); 07368 } 07369 else { 07370 /* find the end of list */ 07371 07372 list_idx = IL_IDX(list_array[MP_DIR_REDUCTION_IDX]); 07373 while (IL_NEXT_LIST_IDX(list_idx)) { 07374 list_idx = IL_NEXT_LIST_IDX(list_idx); 07375 } 07376 07377 /* append the new list */ 07378 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 07379 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 07380 IL_LIST_CNT(list_array[MP_DIR_REDUCTION_IDX]) += 07381 OPND_LIST_CNT(opnd); 07382 } 07383 07384 if (LA_CH_VALUE == RPAREN) { 07385 NEXT_LA_CH; 07386 } 07387 else { 07388 parse_err_flush(Find_EOS, ")"); 07389 goto EXIT; 07390 } 07391 } 07392 else { 07393 parse_err_flush(Find_EOS, "("); 07394 goto EXIT; 07395 } 07396 07397 break; 07398 07399 case Tok_SGI_Dir_Mp_Schedtype: 07400 07401 if (! clause_allowed[directive][Mp_Schedtype_Clause]) { 07402 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07403 "MP_SCHEDTYPE", mp_dir_str[directive]); 07404 parse_err_flush(Find_EOS, NULL); 07405 goto EXIT; 07406 } 07407 07408 if (IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) != NULL_IDX) { 07409 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07410 "MP_SCHEDTYPE", mp_dir_str[directive]); 07411 parse_err_flush(Find_EOS, NULL); 07412 goto EXIT; 07413 } 07414 07415 if (LA_CH_VALUE == EQUAL) { 07416 07417 NEXT_LA_CH; 07418 07419 if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 07420 07421 switch (TOKEN_VALUE(token)) { 07422 case Tok_SGI_Dir_Simple: 07423 the_constant = MP_SCHEDTYPE_SIMPLE; 07424 break; 07425 case Tok_SGI_Dir_Static: 07426 the_constant = MP_SCHEDTYPE_SIMPLE; 07427 break; 07428 case Tok_SGI_Dir_Dynamic: 07429 the_constant = MP_SCHEDTYPE_DYNAMIC; 07430 break; 07431 case Tok_SGI_Dir_Interleaved: 07432 the_constant = MP_SCHEDTYPE_INTERLEAVED; 07433 break; 07434 case Tok_SGI_Dir_Interleave: 07435 the_constant = MP_SCHEDTYPE_INTERLEAVED; 07436 break; 07437 case Tok_SGI_Dir_Runtime: 07438 the_constant = MP_SCHEDTYPE_RUNTIME; 07439 break; 07440 case Tok_SGI_Dir_Gss: 07441 the_constant = MP_SCHEDTYPE_GUIDED; 07442 break; 07443 case Tok_SGI_Dir_Guided: 07444 the_constant = MP_SCHEDTYPE_GUIDED; 07445 break; 07446 07447 default: 07448 parse_err_flush(Find_EOS, "MP_SCHEDTYPE mode"); 07449 break; 07450 } 07451 07452 07453 IL_LINE_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07454 TOKEN_LINE(token); 07455 IL_COL_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07456 TOKEN_COLUMN(token); 07457 IL_FLD(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07458 CN_Tbl_Idx; 07459 IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07460 C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 07461 the_constant); 07462 } 07463 else { 07464 parse_err_flush(Find_EOS, "MP_SCHEDTYPE mode"); 07465 } 07466 07467 } 07468 else { 07469 parse_err_flush(Find_EOS, "="); 07470 goto EXIT; 07471 } 07472 07473 break; 07474 07475 case Tok_SGI_Dir_Chunk: 07476 07477 if (! clause_allowed[directive][Chunk_Clause]) { 07478 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07479 "CHUNK", mp_dir_str[directive]); 07480 parse_err_flush(Find_EOS, NULL); 07481 goto EXIT; 07482 } 07483 07484 if (IL_IDX(list_array[MP_DIR_CHUNK_IDX]) != NULL_IDX) { 07485 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07486 "CHUNK or BLOCKED", mp_dir_str[directive]); 07487 parse_err_flush(Find_EOS, NULL); 07488 goto EXIT; 07489 } 07490 07491 if (LA_CH_VALUE == EQUAL) { 07492 NEXT_LA_CH; 07493 07494 parse_expr(&opnd); 07495 COPY_OPND(IL_OPND(list_array[MP_DIR_CHUNK_IDX]), 07496 opnd); 07497 } 07498 else { 07499 parse_err_flush(Find_EOS, "="); 07500 goto EXIT; 07501 } 07502 break; 07503 07504 case Tok_SGI_Dir_Blocked: 07505 07506 if (! clause_allowed[directive][Blocked_Clause]) { 07507 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07508 "BLOCKED", mp_dir_str[directive]); 07509 parse_err_flush(Find_EOS, NULL); 07510 goto EXIT; 07511 } 07512 07513 if (IL_IDX(list_array[MP_DIR_CHUNK_IDX]) != NULL_IDX) { 07514 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07515 "CHUNK or BLOCKED", mp_dir_str[directive]); 07516 parse_err_flush(Find_EOS, NULL); 07517 goto EXIT; 07518 } 07519 07520 if (LA_CH_VALUE == LPAREN) { 07521 NEXT_LA_CH; 07522 parse_expr(&opnd); 07523 COPY_OPND(IL_OPND(list_array[MP_DIR_CHUNK_IDX]), 07524 opnd); 07525 07526 if (LA_CH_VALUE == RPAREN) { 07527 NEXT_LA_CH; 07528 } 07529 else { 07530 parse_err_flush(Find_EOS, ")"); 07531 goto EXIT; 07532 } 07533 } 07534 else { 07535 parse_err_flush(Find_EOS, "("); 07536 goto EXIT; 07537 } 07538 break; 07539 07540 case Tok_SGI_Dir_Affinity: 07541 07542 if (! clause_allowed[directive][Affinity_Clause]) { 07543 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07544 "AFFINITY", mp_dir_str[directive]); 07545 parse_err_flush(Find_EOS, NULL); 07546 goto EXIT; 07547 } 07548 07549 if (IL_IDX(list_array[MP_DIR_AFFINITY_IDX]) != NULL_IDX) { 07550 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07551 "AFFINITY", mp_dir_str[directive]); 07552 parse_err_flush(Find_EOS, NULL); 07553 goto EXIT; 07554 } 07555 07556 if (LA_CH_VALUE == LPAREN) { 07557 NEXT_LA_CH; 07558 parse_var_name_list(&opnd, -1); 07559 07560 COPY_OPND(IL_OPND(list_array[MP_DIR_AFFINITY_IDX]), opnd); 07561 07562 if (LA_CH_VALUE == RPAREN) { 07563 NEXT_LA_CH; 07564 } 07565 else { 07566 parse_err_flush(Find_EOS, ")"); 07567 goto EXIT; 07568 } 07569 } 07570 else { 07571 parse_err_flush(Find_EOS, "("); 07572 goto EXIT; 07573 } 07574 07575 if (LA_CH_VALUE == EQUAL) { 07576 07577 NEXT_LA_CH; 07578 07579 if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 07580 07581 IL_FLD(list_array[MP_DIR_IS_THREAD_IDX]) = CN_Tbl_Idx; 07582 IL_LINE_NUM(list_array[MP_DIR_IS_THREAD_IDX]) = 07583 TOKEN_LINE(token); 07584 IL_COL_NUM(list_array[MP_DIR_IS_THREAD_IDX]) = 07585 TOKEN_COLUMN(token); 07586 07587 switch (TOKEN_VALUE(token)) { 07588 case Tok_SGI_Dir_Data: 07589 IL_IDX(list_array[MP_DIR_IS_THREAD_IDX]) = 07590 CN_INTEGER_ZERO_IDX; 07591 break; 07592 case Tok_SGI_Dir_Thread: 07593 IL_IDX(list_array[MP_DIR_IS_THREAD_IDX]) = 07594 CN_INTEGER_ONE_IDX; 07595 07596 break; 07597 07598 default: 07599 parse_err_flush(Find_EOS, "DATA or THREAD"); 07600 break; 07601 } 07602 07603 if (LA_CH_VALUE == LPAREN) { 07604 07605 NEXT_LA_CH; 07606 07607 parse_expr(&opnd); 07608 07609 COPY_OPND(IL_OPND(list_array[ 07610 MP_DIR_THREAD_DATA_IDX]), opnd); 07611 07612 if (LA_CH_VALUE == RPAREN) { 07613 NEXT_LA_CH; 07614 } 07615 else { 07616 parse_err_flush(Find_EOS, ")"); 07617 goto EXIT; 07618 } 07619 } 07620 else { 07621 parse_err_flush(Find_EOS, "("); 07622 goto EXIT; 07623 } 07624 } 07625 else { 07626 parse_err_flush(Find_EOS, "DATA or THREAD"); 07627 } 07628 07629 } 07630 else { 07631 parse_err_flush(Find_EOS, "="); 07632 goto EXIT; 07633 } 07634 07635 if (! dump_flags.dsm) { 07636 opnd = null_opnd; 07637 07638 COPY_OPND(IL_OPND(list_array[MP_DIR_AFFINITY_IDX]), 07639 opnd); 07640 COPY_OPND(IL_OPND(list_array[MP_DIR_THREAD_DATA_IDX]), 07641 opnd); 07642 COPY_OPND(IL_OPND(list_array[MP_DIR_IS_THREAD_IDX]), 07643 opnd); 07644 } 07645 break; 07646 07647 case Tok_SGI_Dir_Local: 07648 case Tok_SGI_Dir_Private: 07649 07650 if (! clause_allowed[directive][Local_Clause]) { 07651 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07652 "LOCAL or PRIVATE", mp_dir_str[directive]); 07653 parse_err_flush(Find_EOS, NULL); 07654 goto EXIT; 07655 } 07656 07657 if (LA_CH_VALUE == LPAREN) { 07658 NEXT_LA_CH; 07659 parse_var_name_list(&opnd, -1); 07660 07661 if (IL_IDX(list_array[MP_DIR_LOCAL_IDX]) == NULL_IDX) { 07662 COPY_OPND(IL_OPND(list_array[MP_DIR_LOCAL_IDX]), opnd); 07663 } 07664 else { 07665 /* find the end of list */ 07666 07667 list_idx = IL_IDX(list_array[MP_DIR_LOCAL_IDX]); 07668 while (IL_NEXT_LIST_IDX(list_idx)) { 07669 list_idx = IL_NEXT_LIST_IDX(list_idx); 07670 } 07671 07672 /* append the new list */ 07673 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 07674 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 07675 IL_LIST_CNT(list_array[MP_DIR_LOCAL_IDX]) += 07676 OPND_LIST_CNT(opnd); 07677 } 07678 07679 if (LA_CH_VALUE == RPAREN) { 07680 NEXT_LA_CH; 07681 } 07682 else { 07683 parse_err_flush(Find_EOS, ")"); 07684 goto EXIT; 07685 } 07686 } 07687 else { 07688 parse_err_flush(Find_EOS, "("); 07689 goto EXIT; 07690 } 07691 07692 break; 07693 07694 case Tok_SGI_Dir_Onto: 07695 if (! clause_allowed[directive][Onto_Clause]) { 07696 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07697 "ONTO", mp_dir_str[directive]); 07698 parse_err_flush(Find_EOS, NULL); 07699 goto EXIT; 07700 } 07701 07702 if (seen_nest) { 07703 07704 if (IL_IDX(list_array[MP_DIR_ONTO_IDX]) != NULL_IDX) { 07705 PRINTMSG(TOKEN_LINE(token), 1360, Error, 07706 TOKEN_COLUMN(token), 07707 "ONTO", mp_dir_str[directive]); 07708 parse_err_flush(Find_EOS, NULL); 07709 goto EXIT; 07710 } 07711 07712 if (LA_CH_VALUE == LPAREN) { 07713 NEXT_LA_CH; 07714 parse_int_or_star_list(&opnd); 07715 07716 COPY_OPND(IL_OPND(list_array[MP_DIR_ONTO_IDX]), opnd); 07717 07718 if (LA_CH_VALUE == RPAREN) { 07719 NEXT_LA_CH; 07720 } 07721 else { 07722 parse_err_flush(Find_EOS, ")"); 07723 goto EXIT; 07724 } 07725 } 07726 else { 07727 parse_err_flush(Find_EOS, "("); 07728 goto EXIT; 07729 } 07730 07731 list_idx = list_array[MP_DIR_ONTO_IDX]; 07732 07733 list2_idx = list_array[MP_DIR_NEST_IDX]; 07734 07735 if (IL_FLD(list2_idx) != IL_Tbl_Idx || 07736 IL_LIST_CNT(list2_idx) != IL_LIST_CNT(list_idx)) { 07737 07738 /* error, onto count must equal nest count */ 07739 07740 find_opnd_line_and_column(&IL_OPND(IL_IDX(list_idx)), 07741 &line, &column); 07742 07743 PRINTMSG(line, 1369, Error, column); 07744 } 07745 else if (IL_LIST_CNT(list2_idx) == 1) { 07746 /* error, onto count must equal nest count */ 07747 07748 find_opnd_line_and_column(&IL_OPND(IL_IDX(list_idx)), 07749 &line, &column); 07750 07751 PRINTMSG(line, 1377, Error, column); 07752 } 07753 } 07754 else { 07755 PRINTMSG(TOKEN_LINE(token), 1361, Error, TOKEN_COLUMN(token), 07756 mp_dir_str[directive]); 07757 parse_err_flush(Find_EOS, NULL); 07758 goto EXIT; 07759 } 07760 break; 07761 07762 case Tok_SGI_Dir_Nest: 07763 07764 if (! clause_allowed[directive][Nest_Clause]) { 07765 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07766 "NEST", mp_dir_str[directive]); 07767 parse_err_flush(Find_EOS, NULL); 07768 goto EXIT; 07769 } 07770 07771 if (seen_nest) { 07772 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07773 "NEST", mp_dir_str[directive]); 07774 parse_err_flush(Find_EOS, NULL); 07775 goto EXIT; 07776 } 07777 07778 seen_nest = TRUE; 07779 07780 if (LA_CH_VALUE == LPAREN) { 07781 NEXT_LA_CH; 07782 parse_var_name_list(&opnd, -1); 07783 07784 COPY_OPND(IL_OPND(list_array[MP_DIR_NEST_IDX]), opnd); 07785 07786 if (LA_CH_VALUE == RPAREN) { 07787 NEXT_LA_CH; 07788 } 07789 else { 07790 parse_err_flush(Find_EOS, ")"); 07791 goto EXIT; 07792 } 07793 } 07794 else { 07795 parse_err_flush(Find_EOS, "("); 07796 goto EXIT; 07797 } 07798 07799 break; 07800 07801 case Tok_SGI_Dir_Lastthread: 07802 07803 if (! clause_allowed[directive][Lastthread_Clause]) { 07804 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07805 "LASTTHREAD", mp_dir_str[directive]); 07806 parse_err_flush(Find_EOS, NULL); 07807 goto EXIT; 07808 } 07809 07810 if (IL_IDX(list_array[MP_DIR_LASTTHREAD_IDX]) != NULL_IDX) { 07811 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07812 "LASTTHREAD", mp_dir_str[directive]); 07813 parse_err_flush(Find_EOS, NULL); 07814 goto EXIT; 07815 } 07816 07817 if (LA_CH_VALUE == LPAREN) { 07818 NEXT_LA_CH; 07819 07820 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 07821 07822 if (! parse_deref(&opnd, NULL_IDX)) { 07823 parse_err_flush(Find_Rparen, NULL); 07824 } 07825 else if (OPND_FLD(opnd) != AT_Tbl_Idx) { 07826 find_opnd_line_and_column(&opnd, &line, &column); 07827 PRINTMSG(line, 1376, Error, column); 07828 } 07829 else { 07830 COPY_OPND(IL_OPND(list_array[MP_DIR_LASTTHREAD_IDX]), 07831 opnd); 07832 } 07833 } 07834 else { 07835 parse_err_flush(Find_Rparen, "IDENTIFIER"); 07836 } 07837 07838 if (LA_CH_VALUE == RPAREN) { 07839 NEXT_LA_CH; 07840 } 07841 else { 07842 parse_err_flush(Find_EOS, ")"); 07843 goto EXIT; 07844 } 07845 } 07846 else { 07847 parse_err_flush(Find_EOS, "("); 07848 goto EXIT; 07849 } 07850 break; 07851 07852 /* MODE clauses, same as MP_SCHEDTYPE */ 07853 07854 case Tok_SGI_Dir_Simple: 07855 if (! clause_allowed[directive][Mode_Clause]) { 07856 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07857 "MODE", mp_dir_str[directive]); 07858 parse_err_flush(Find_EOS, NULL); 07859 goto EXIT; 07860 } 07861 07862 if (IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) != NULL_IDX) { 07863 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07864 "MODE or MP_SCHEDTYPE", mp_dir_str[directive]); 07865 parse_err_flush(Find_EOS, NULL); 07866 goto EXIT; 07867 } 07868 07869 IL_LINE_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07870 TOKEN_LINE(token); 07871 IL_COL_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07872 TOKEN_COLUMN(token); 07873 IL_FLD(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = CN_Tbl_Idx; 07874 IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07875 C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 07876 MP_SCHEDTYPE_SIMPLE); 07877 07878 break; 07879 07880 case Tok_SGI_Dir_Static: 07881 if (! clause_allowed[directive][Mode_Clause]) { 07882 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07883 "MODE", mp_dir_str[directive]); 07884 parse_err_flush(Find_EOS, NULL); 07885 goto EXIT; 07886 } 07887 07888 if (IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) != NULL_IDX) { 07889 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07890 "MODE or MP_SCHEDTYPE", mp_dir_str[directive]); 07891 parse_err_flush(Find_EOS, NULL); 07892 goto EXIT; 07893 } 07894 07895 IL_LINE_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07896 TOKEN_LINE(token); 07897 IL_COL_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07898 TOKEN_COLUMN(token); 07899 IL_FLD(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = CN_Tbl_Idx; 07900 IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07901 C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 07902 MP_SCHEDTYPE_SIMPLE); 07903 07904 break; 07905 07906 case Tok_SGI_Dir_Dynamic: 07907 if (! clause_allowed[directive][Mode_Clause]) { 07908 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07909 "MODE", mp_dir_str[directive]); 07910 parse_err_flush(Find_EOS, NULL); 07911 goto EXIT; 07912 } 07913 07914 if (IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) != NULL_IDX) { 07915 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07916 "MODE or MP_SCHEDTYPE", mp_dir_str[directive]); 07917 parse_err_flush(Find_EOS, NULL); 07918 goto EXIT; 07919 } 07920 07921 IL_LINE_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07922 TOKEN_LINE(token); 07923 IL_COL_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07924 TOKEN_COLUMN(token); 07925 IL_FLD(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = CN_Tbl_Idx; 07926 IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07927 C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 07928 MP_SCHEDTYPE_DYNAMIC); 07929 07930 break; 07931 07932 case Tok_SGI_Dir_Interleaved: 07933 if (! clause_allowed[directive][Mode_Clause]) { 07934 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07935 "MODE", mp_dir_str[directive]); 07936 parse_err_flush(Find_EOS, NULL); 07937 goto EXIT; 07938 } 07939 07940 if (IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) != NULL_IDX) { 07941 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07942 "MODE or MP_SCHEDTYPE", mp_dir_str[directive]); 07943 parse_err_flush(Find_EOS, NULL); 07944 goto EXIT; 07945 } 07946 07947 IL_LINE_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07948 TOKEN_LINE(token); 07949 IL_COL_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07950 TOKEN_COLUMN(token); 07951 IL_FLD(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = CN_Tbl_Idx; 07952 IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07953 C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 07954 MP_SCHEDTYPE_INTERLEAVED); 07955 07956 break; 07957 07958 case Tok_SGI_Dir_Interleave: 07959 if (! clause_allowed[directive][Mode_Clause]) { 07960 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07961 "MODE", mp_dir_str[directive]); 07962 parse_err_flush(Find_EOS, NULL); 07963 goto EXIT; 07964 } 07965 07966 if (IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) != NULL_IDX) { 07967 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07968 "MODE or MP_SCHEDTYPE", mp_dir_str[directive]); 07969 parse_err_flush(Find_EOS, NULL); 07970 goto EXIT; 07971 } 07972 07973 IL_LINE_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07974 TOKEN_LINE(token); 07975 IL_COL_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07976 TOKEN_COLUMN(token); 07977 IL_FLD(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = CN_Tbl_Idx; 07978 IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 07979 C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 07980 MP_SCHEDTYPE_INTERLEAVED); 07981 07982 break; 07983 07984 case Tok_SGI_Dir_Runtime: 07985 if (! clause_allowed[directive][Mode_Clause]) { 07986 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 07987 "MODE", mp_dir_str[directive]); 07988 parse_err_flush(Find_EOS, NULL); 07989 goto EXIT; 07990 } 07991 07992 if (IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) != NULL_IDX) { 07993 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 07994 "MODE or MP_SCHEDTYPE", mp_dir_str[directive]); 07995 parse_err_flush(Find_EOS, NULL); 07996 goto EXIT; 07997 } 07998 07999 IL_LINE_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 08000 TOKEN_LINE(token); 08001 IL_COL_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 08002 TOKEN_COLUMN(token); 08003 IL_FLD(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = CN_Tbl_Idx; 08004 IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 08005 C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 08006 MP_SCHEDTYPE_RUNTIME); 08007 08008 break; 08009 08010 case Tok_SGI_Dir_Gss: 08011 if (! clause_allowed[directive][Mode_Clause]) { 08012 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 08013 "MODE", mp_dir_str[directive]); 08014 parse_err_flush(Find_EOS, NULL); 08015 goto EXIT; 08016 } 08017 08018 if (IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) != NULL_IDX) { 08019 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 08020 "MODE or MP_SCHEDTYPE", mp_dir_str[directive]); 08021 parse_err_flush(Find_EOS, NULL); 08022 goto EXIT; 08023 } 08024 08025 IL_LINE_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 08026 TOKEN_LINE(token); 08027 IL_COL_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 08028 TOKEN_COLUMN(token); 08029 IL_FLD(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = CN_Tbl_Idx; 08030 IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 08031 C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 08032 MP_SCHEDTYPE_GUIDED); 08033 08034 break; 08035 08036 case Tok_SGI_Dir_Guided: 08037 if (! clause_allowed[directive][Mode_Clause]) { 08038 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 08039 "MODE", mp_dir_str[directive]); 08040 parse_err_flush(Find_EOS, NULL); 08041 goto EXIT; 08042 } 08043 08044 if (IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) != NULL_IDX) { 08045 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 08046 "MODE or MP_SCHEDTYPE", mp_dir_str[directive]); 08047 parse_err_flush(Find_EOS, NULL); 08048 goto EXIT; 08049 } 08050 08051 IL_LINE_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 08052 TOKEN_LINE(token); 08053 IL_COL_NUM(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 08054 TOKEN_COLUMN(token); 08055 IL_FLD(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = CN_Tbl_Idx; 08056 IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) = 08057 C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 08058 MP_SCHEDTYPE_GUIDED); 08059 08060 break; 08061 08062 default: 08063 PRINTMSG(TOKEN_LINE(token), 1517, Error, TOKEN_COLUMN(token), 08064 "mp"); 08065 parse_err_flush(Find_EOS, NULL); 08066 break; 08067 } 08068 } 08069 else { 08070 parse_err_flush(Find_EOS, "mp clause"); 08071 } 08072 08073 if (LA_CH_VALUE == COMMA) { 08074 NEXT_LA_CH; 08075 } 08076 } 08077 08078 08079 if (clause_allowed[directive][Chunk_Clause] && 08080 IL_IDX(list_array[MP_DIR_CHUNK_IDX]) == NULL_IDX && 08081 OPND_FLD(cdir_switches.chunk_opnd) != NO_Tbl_Idx) { 08082 08083 COPY_OPND(IL_OPND(list_array[MP_DIR_CHUNK_IDX]), 08084 cdir_switches.chunk_opnd); 08085 } 08086 08087 if (clause_allowed[directive][Mp_Schedtype_Clause] && 08088 IL_IDX(list_array[MP_DIR_MP_SCHEDTYPE_IDX]) == NULL_IDX && 08089 OPND_FLD(cdir_switches.mp_schedtype_opnd) != NO_Tbl_Idx) { 08090 08091 COPY_OPND(IL_OPND(list_array[MP_DIR_MP_SCHEDTYPE_IDX]), 08092 cdir_switches.mp_schedtype_opnd); 08093 } 08094 08095 08096 EXIT: 08097 08098 TRACE (Func_Exit, "parse_mp_directive", NULL); 08099 08100 return; 08101 08102 } /* parse_mp_directive */ 08103 08104 /******************************************************************************\ 08105 |* *| 08106 |* Description: *| 08107 |* <description> *| 08108 |* *| 08109 |* Input parameters: *| 08110 |* NONE *| 08111 |* *| 08112 |* Output parameters: *| 08113 |* NONE *| 08114 |* *| 08115 |* Returns: *| 08116 |* NOTHING *| 08117 |* *| 08118 \******************************************************************************/ 08119 08120 static void parse_int_or_star_list(opnd_type *list_opnd) 08121 08122 { 08123 int list_idx = NULL_IDX; 08124 opnd_type opnd; 08125 08126 08127 TRACE (Func_Entry, "parse_int_or_star_list", NULL); 08128 08129 while(TRUE) { 08130 08131 if (LA_CH_VALUE == STAR) { 08132 OPND_FLD(opnd) = CN_Tbl_Idx; 08133 OPND_IDX(opnd) = CN_INTEGER_ZERO_IDX; 08134 OPND_LINE_NUM(opnd) = LA_CH_LINE; 08135 OPND_COL_NUM(opnd) = LA_CH_COLUMN; 08136 NEXT_LA_CH; 08137 } 08138 else { 08139 parse_expr(&opnd); 08140 } 08141 08142 if (list_idx == NULL_IDX) { 08143 NTR_IR_LIST_TBL(list_idx); 08144 OPND_FLD((*list_opnd)) = IL_Tbl_Idx; 08145 OPND_IDX((*list_opnd)) = list_idx; 08146 OPND_LIST_CNT((*list_opnd)) = 1; 08147 } 08148 else { 08149 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 08150 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 08151 (OPND_LIST_CNT((*list_opnd)))++; 08152 list_idx = IL_NEXT_LIST_IDX(list_idx); 08153 } 08154 COPY_OPND(IL_OPND(list_idx), opnd); 08155 08156 if (LA_CH_VALUE != COMMA) { 08157 break; 08158 } 08159 NEXT_LA_CH; 08160 } 08161 08162 08163 TRACE (Func_Exit, "parse_int_or_star_list", NULL); 08164 08165 return; 08166 08167 } /* parse_int_or_star_list */ 08168 08169 /******************************************************************************\ 08170 |* *| 08171 |* Description: *| 08172 |* This routine parses the variable lists that are possibly within *| 08173 |* paranthesis and have only variable refs, not expressions. *| 08174 |* *| 08175 |* Input parameters: *| 08176 |* NONE *| 08177 |* *| 08178 |* Output parameters: *| 08179 |* opnd - points to list of attrs. *| 08180 |* *| 08181 |* Returns: *| 08182 |* NOTHING *| 08183 |* *| 08184 \******************************************************************************/ 08185 08186 static void parse_reference_list(opnd_type *list_opnd) 08187 08188 { 08189 int list_idx = NULL_IDX; 08190 opnd_type opnd; 08191 08192 08193 TRACE (Func_Entry, "parse_reference_list", NULL); 08194 08195 while(TRUE) { 08196 08197 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 08198 parse_deref(&opnd, NULL_IDX); 08199 08200 if (list_idx == NULL_IDX) { 08201 NTR_IR_LIST_TBL(list_idx); 08202 OPND_FLD((*list_opnd)) = IL_Tbl_Idx; 08203 OPND_IDX((*list_opnd)) = list_idx; 08204 OPND_LIST_CNT((*list_opnd)) = 1; 08205 } 08206 else { 08207 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 08208 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 08209 (OPND_LIST_CNT((*list_opnd)))++; 08210 list_idx = IL_NEXT_LIST_IDX(list_idx); 08211 } 08212 COPY_OPND(IL_OPND(list_idx), opnd); 08213 } 08214 else { 08215 parse_err_flush(Find_Comma_Rparen, "IDENTIFIER"); 08216 } 08217 08218 if (LA_CH_VALUE != COMMA) { 08219 break; 08220 } 08221 NEXT_LA_CH; 08222 } 08223 08224 TRACE (Func_Exit, "parse_reference_list", NULL); 08225 08226 return; 08227 08228 } /* parse_reference_list */ 08229 08230 /******************************************************************************\ 08231 |* *| 08232 |* Description: *| 08233 |* <description> *| 08234 |* *| 08235 |* Input parameters: *| 08236 |* NONE *| 08237 |* *| 08238 |* Output parameters: *| 08239 |* NONE *| 08240 |* *| 08241 |* Returns: *| 08242 |* NOTHING *| 08243 |* *| 08244 \******************************************************************************/ 08245 08246 static void parse_var_common_list(opnd_type *list_opnd, 08247 boolean subobjects_allowed) 08248 08249 { 08250 int attr_idx; 08251 int column; 08252 int line; 08253 int list_idx = NULL_IDX; 08254 int name_idx; 08255 opnd_type opnd; 08256 int sb_idx; 08257 token_values_type token_value; 08258 08259 08260 TRACE (Func_Entry, "parse_var_common_list", NULL); 08261 08262 token_value = TOKEN_VALUE(token); 08263 08264 while(TRUE) { 08265 08266 if (LA_CH_VALUE == SLASH) { /* must be common block */ 08267 NEXT_LA_CH; /* eat slash */ 08268 08269 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 08270 08271 if (LA_CH_VALUE == SLASH) { 08272 NEXT_LA_CH; /* eat slash */ 08273 08274 sb_idx = srch_stor_blk_tbl(TOKEN_STR(token), 08275 TOKEN_LEN(token), 08276 curr_scp_idx); 08277 08278 if (sb_idx == NULL_IDX) { 08279 sb_idx = ntr_stor_blk_tbl(TOKEN_STR(token), 08280 TOKEN_LEN(token), 08281 TOKEN_LINE(token), 08282 TOKEN_COLUMN(token), 08283 Common); 08284 SB_COMMON_NEEDS_OFFSET(sb_idx) = TRUE; 08285 SB_IS_COMMON(sb_idx) = TRUE; 08286 } 08287 08288 switch (token_value) { 08289 case Tok_SGI_Dir_Section_Gp: 08290 SB_SECTION_GP(sb_idx) = TRUE; 08291 break; 08292 case Tok_SGI_Dir_Section_Non_Gp: 08293 SB_SECTION_NON_GP(sb_idx) = TRUE; 08294 break; 08295 } 08296 08297 if (list_idx == NULL_IDX) { 08298 NTR_IR_LIST_TBL(list_idx); 08299 OPND_FLD((*list_opnd)) = IL_Tbl_Idx; 08300 OPND_IDX((*list_opnd)) = list_idx; 08301 OPND_LIST_CNT((*list_opnd)) = 1; 08302 } 08303 else { 08304 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 08305 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 08306 (OPND_LIST_CNT((*list_opnd)))++; 08307 list_idx = IL_NEXT_LIST_IDX(list_idx); 08308 } 08309 08310 IL_IDX(list_idx) = sb_idx; 08311 IL_FLD(list_idx) = SB_Tbl_Idx; 08312 IL_LINE_NUM(list_idx) = TOKEN_LINE(token); 08313 IL_COL_NUM(list_idx) = TOKEN_COLUMN(token); 08314 } 08315 else { 08316 parse_err_flush(Find_Rparen, "/"); 08317 } 08318 } 08319 else { 08320 parse_err_flush(Find_Comma_Rparen, "common-block-name"); 08321 } 08322 } 08323 else if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 08324 OPND_LINE_NUM(opnd) = TOKEN_LINE(token); 08325 OPND_COL_NUM(opnd) = TOKEN_COLUMN(token); 08326 08327 if (token_value == Tok_SGI_Dir_Section_Gp) { 08328 attr_idx = srch_sym_tbl(TOKEN_STR(token), 08329 TOKEN_LEN(token), 08330 &name_idx); 08331 08332 if (attr_idx == NULL_IDX) { 08333 attr_idx = ntr_sym_tbl(&token, name_idx); 08334 LN_DEF_LOC(name_idx) = TRUE; 08335 AT_OBJ_CLASS(attr_idx) = Data_Obj; 08336 ATD_SECTION_GP(attr_idx) = TRUE; 08337 SET_IMPL_TYPE(attr_idx); 08338 OPND_IDX(opnd) = attr_idx; 08339 OPND_FLD(opnd) = AT_Tbl_Idx; 08340 } 08341 else if (fnd_semantic_err(Obj_Section_Gp, 08342 OPND_LINE_NUM(opnd), 08343 OPND_COL_NUM(opnd), 08344 attr_idx, 08345 TRUE)) { 08346 goto NEXT; 08347 } 08348 08349 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit && 08350 ATP_PGM_UNIT(attr_idx) == Module) { 08351 08352 /* Specifying just the module name means that the directive */ 08353 /* applies to the module's static storage. */ 08354 08355 if (attr_idx != SCP_ATTR_IDX(curr_scp_idx)) { 08356 08357 /* Must be the current module */ 08358 08359 PRINTMSG(TOKEN_LINE(token), 1491, Error, 08360 TOKEN_COLUMN(token), 08361 "SECTION_GP"); 08362 } 08363 else if (SB_SECTION_NON_GP(SCP_SB_STATIC_IDX(curr_scp_idx))) { 08364 PRINTMSG(TOKEN_LINE(token), 1490, Error, 08365 TOKEN_COLUMN(token), 08366 AT_OBJ_NAME_PTR(attr_idx), 08367 "SECTION_GP", "SECTION_NON_GP"); 08368 } 08369 else { 08370 SB_SECTION_GP(SCP_SB_STATIC_IDX(curr_scp_idx)) = TRUE; 08371 } 08372 08373 OPND_IDX(opnd) = SCP_SB_STATIC_IDX(curr_scp_idx); 08374 OPND_FLD(opnd) = SB_Tbl_Idx; 08375 } 08376 else { 08377 ATD_SECTION_GP(attr_idx) = TRUE; 08378 OPND_IDX(opnd) = attr_idx; 08379 OPND_FLD(opnd) = AT_Tbl_Idx; 08380 } 08381 } 08382 else if (token_value == Tok_SGI_Dir_Section_Non_Gp) { 08383 attr_idx = srch_sym_tbl(TOKEN_STR(token), 08384 TOKEN_LEN(token), 08385 &name_idx); 08386 08387 if (attr_idx == NULL_IDX) { 08388 attr_idx = ntr_sym_tbl(&token, name_idx); 08389 LN_DEF_LOC(name_idx) = TRUE; 08390 AT_OBJ_CLASS(attr_idx) = Data_Obj; 08391 ATD_SECTION_NON_GP(attr_idx) = TRUE; 08392 SET_IMPL_TYPE(attr_idx); 08393 OPND_IDX(opnd) = attr_idx; 08394 OPND_FLD(opnd) = AT_Tbl_Idx; 08395 } 08396 else if (fnd_semantic_err(Obj_Section_Non_Gp, 08397 OPND_LINE_NUM(opnd), 08398 OPND_COL_NUM(opnd), 08399 attr_idx, 08400 TRUE)) { 08401 goto NEXT; 08402 } 08403 08404 if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit && 08405 ATP_PGM_UNIT(attr_idx) == Module) { 08406 08407 /* Specifying just the module name means that the directive */ 08408 /* applies to the module's static storage. */ 08409 08410 if (attr_idx != SCP_ATTR_IDX(curr_scp_idx)) { 08411 08412 /* Must be the current module */ 08413 08414 PRINTMSG(TOKEN_LINE(token), 1491, Error, 08415 TOKEN_COLUMN(token), 08416 "SECTION_NON_GP"); 08417 } 08418 else if (SB_SECTION_GP(SCP_SB_STATIC_IDX(curr_scp_idx))) { 08419 PRINTMSG(TOKEN_LINE(token), 1490, Error, 08420 TOKEN_COLUMN(token), 08421 AT_OBJ_NAME_PTR(attr_idx), 08422 "SECTION_NON_GP", "SECTION_GP"); 08423 } 08424 else { 08425 SB_SECTION_NON_GP(SCP_SB_STATIC_IDX(curr_scp_idx)) = TRUE; 08426 } 08427 OPND_IDX(opnd) = SCP_SB_STATIC_IDX(curr_scp_idx); 08428 OPND_FLD(opnd) = SB_Tbl_Idx; 08429 } 08430 else { 08431 ATD_SECTION_NON_GP(attr_idx) = TRUE; 08432 OPND_IDX(opnd) = attr_idx; 08433 OPND_FLD(opnd) = AT_Tbl_Idx; 08434 } 08435 } 08436 else { 08437 parse_deref(&opnd, NULL_IDX); 08438 find_opnd_line_and_column(&opnd, &line, &column); 08439 08440 if (!subobjects_allowed && OPND_FLD(opnd) != AT_Tbl_Idx) { 08441 PRINTMSG(line, 802, Error, column); 08442 goto NEXT; 08443 } 08444 } 08445 08446 if (list_idx == NULL_IDX) { 08447 NTR_IR_LIST_TBL(list_idx); 08448 OPND_FLD((*list_opnd)) = IL_Tbl_Idx; 08449 OPND_IDX((*list_opnd)) = list_idx; 08450 OPND_LIST_CNT((*list_opnd)) = 1; 08451 } 08452 else { 08453 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 08454 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 08455 (OPND_LIST_CNT((*list_opnd)))++; 08456 list_idx = IL_NEXT_LIST_IDX(list_idx); 08457 } 08458 08459 COPY_OPND(IL_OPND(list_idx), opnd); 08460 } 08461 else { 08462 parse_err_flush(Find_Comma_Rparen, "IDENTIFIER"); 08463 } 08464 08465 NEXT: 08466 08467 if (LA_CH_VALUE != COMMA) { 08468 break; 08469 } 08470 NEXT_LA_CH; 08471 } 08472 08473 TRACE (Func_Exit, "parse_var_common_list", NULL); 08474 08475 return; 08476 08477 } /* parse_var_common_list */ 08478 08479 /******************************************************************************\ 08480 |* *| 08481 |* Description: *| 08482 |* <description> *| 08483 |* *| 08484 |* Input parameters: *| 08485 |* NONE *| 08486 |* *| 08487 |* Output parameters: *| 08488 |* NONE *| 08489 |* *| 08490 |* Returns: *| 08491 |* NOTHING *| 08492 |* *| 08493 \******************************************************************************/ 08494 08495 static void parse_fill_align_symbol(void) 08496 08497 { 08498 int align_symbol; 08499 int attr_idx; 08500 int ir_idx; 08501 int name_idx; 08502 opnd_type opnd; 08503 08504 08505 TRACE (Func_Entry, "parse_fill_align_symbol", NULL); 08506 08507 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 08508 align_symbol = (TOKEN_VALUE(token) == Tok_SGI_Dir_Align_Symbol); 08509 expr_mode = Specification_Expr; 08510 08511 if (LA_CH_VALUE == LPAREN) { 08512 NEXT_LA_CH; 08513 08514 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 08515 attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token), 08516 &name_idx); 08517 08518 if (attr_idx == NULL_IDX) { 08519 attr_idx = ntr_sym_tbl(&token, name_idx); 08520 LN_DEF_LOC(name_idx) = TRUE; 08521 AT_OBJ_CLASS(attr_idx) = Data_Obj; 08522 SET_IMPL_TYPE(attr_idx); 08523 08524 if (align_symbol) { 08525 ATD_ALIGN_SYMBOL(attr_idx) = TRUE; 08526 } 08527 else { 08528 ATD_FILL_SYMBOL(attr_idx) = TRUE; 08529 } 08530 08531 IR_IDX_L(ir_idx) = attr_idx; 08532 IR_FLD_L(ir_idx) = AT_Tbl_Idx; 08533 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 08534 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 08535 } 08536 else if (!fnd_semantic_err(align_symbol ? Obj_Align_Symbol : 08537 Obj_Fill_Symbol, 08538 TOKEN_LINE(token), 08539 TOKEN_COLUMN(token), 08540 attr_idx, 08541 TRUE)) { 08542 08543 if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) { 08544 AT_ATTR_LINK(attr_idx) = NULL_IDX; 08545 LN_DEF_LOC(name_idx) = TRUE; 08546 } 08547 08548 if (align_symbol) { 08549 ATD_ALIGN_SYMBOL(attr_idx) = TRUE; 08550 } 08551 else { 08552 ATD_FILL_SYMBOL(attr_idx) = TRUE; 08553 } 08554 08555 IR_IDX_L(ir_idx) = attr_idx; 08556 IR_FLD_L(ir_idx) = AT_Tbl_Idx; 08557 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 08558 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 08559 } 08560 08561 if (LA_CH_VALUE == LPAREN) { 08562 PRINTMSG(LA_CH_LINE, 1487, Error, LA_CH_COLUMN, 08563 align_symbol ? "ALIGN_SYMBOL": "FILL_SYMBOL"); 08564 parse_err_flush(Find_Rparen, NULL); 08565 08566 if (LA_CH_VALUE == RPAREN) { 08567 NEXT_LA_CH; 08568 } 08569 } 08570 } 08571 else { 08572 parse_err_flush(Find_EOS, "variable-name"); 08573 goto EXIT; 08574 } 08575 08576 if (LA_CH_VALUE == COMMA) { 08577 NEXT_LA_CH; 08578 08579 if (isdigit(LA_CH_VALUE)) { 08580 parse_expr(&opnd); 08581 COPY_OPND(IR_OPND_R(ir_idx), opnd); 08582 } 08583 else if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 08584 08585 switch (TOKEN_VALUE(token)) { 08586 case Tok_SGI_Dir_L1cacheline: 08587 IR_IDX_R(ir_idx) = CN_INTEGER_NEG_ONE_IDX; 08588 break; 08589 08590 case Tok_SGI_Dir_L2cacheline: 08591 IR_IDX_R(ir_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, -2); 08592 break; 08593 08594 case Tok_SGI_Dir_Page: 08595 IR_IDX_R(ir_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, -3); 08596 break; 08597 08598 default: 08599 parse_err_flush(Find_EOS, "L1cacheline, L2cacheline, or page"); 08600 IR_IDX_R(ir_idx) = CN_INTEGER_ZERO_IDX; 08601 break; 08602 } 08603 08604 IR_FLD_R(ir_idx) = CN_Tbl_Idx; 08605 IR_LINE_NUM_R(ir_idx) = TOKEN_LINE(token); 08606 IR_COL_NUM_R(ir_idx) = TOKEN_COLUMN(token); 08607 } 08608 else { 08609 parse_err_flush(Find_Rparen, "L1cacheline or L2cacheline or page"); 08610 } 08611 08612 if (LA_CH_VALUE == RPAREN) { 08613 NEXT_LA_CH; 08614 } 08615 else { 08616 parse_err_flush(Find_EOS, ")"); 08617 } 08618 } 08619 else { 08620 parse_err_flush(Find_EOS, ",L1cacheline or L2cacheline or page"); 08621 } 08622 } 08623 else { 08624 parse_err_flush(Find_EOS, "("); 08625 } 08626 08627 EXIT: 08628 08629 expr_mode = Regular_Expr; 08630 08631 TRACE (Func_Exit, "parse_fill_align_symbol", NULL); 08632 08633 return; 08634 08635 } /* parse_fill_align_symbol */ 08636 08637 /******************************************************************************\ 08638 |* *| 08639 |* Description: *| 08640 |* <description> *| 08641 |* *| 08642 |* Input parameters: *| 08643 |* NONE *| 08644 |* *| 08645 |* Output parameters: *| 08646 |* NONE *| 08647 |* *| 08648 |* Returns: *| 08649 |* NOTHING *| 08650 |* *| 08651 \******************************************************************************/ 08652 08653 static void parse_sgi_dir_inline(boolean turn_on) 08654 08655 { 08656 enum scope_entry { 08657 Here, 08658 Routine, 08659 Global 08660 }; 08661 08662 typedef enum scope_entry scope_type; 08663 08664 boolean amb_ref = FALSE; 08665 int attr_idx; 08666 int column; 08667 int host_attr_idx; 08668 int host_name_idx; 08669 boolean inline_dir = FALSE; 08670 int ir_idx; 08671 int line; 08672 int list_idx; 08673 int name_idx; 08674 scope_type scope = Here; 08675 08676 08677 TRACE (Func_Entry, "parse_sgi_dir_inline", NULL); 08678 08679 /* NOTE - Currently !*$* IPA and !*$* INLINE are treated the same and */ 08680 /* do the same things. The only difference in this routine is */ 08681 /* that we state the correct name when issuing semantic errors. */ 08682 08683 if (TOKEN_VALUE(token) == Tok_SGI_Dir_Inline || 08684 TOKEN_VALUE(token) == Tok_SGI_Dir_Noinline) { 08685 inline_dir = TRUE; 08686 } 08687 08688 if (LA_CH_VALUE != LPAREN) { 08689 08690 if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 08691 08692 switch (TOKEN_VALUE(token)) { 08693 case Tok_SGI_Dir_Here: 08694 scope = Here; 08695 break; 08696 08697 case Tok_SGI_Dir_Routine: 08698 scope = Routine; 08699 break; 08700 08701 case Tok_SGI_Dir_Global: 08702 scope = Global; 08703 break; 08704 08705 default: 08706 parse_err_flush(Find_EOS, "HERE, ROUTINE, or GLOBAL"); 08707 goto EXIT; 08708 } 08709 } 08710 } 08711 08712 if (scope == Here) { 08713 ir_idx = gen_directive_ir(turn_on ? Inline_Here_Star_Opr : 08714 Noinline_Here_Star_Opr); 08715 08716 /* set this so an End_Inline_Here_Star_Opr is generated after */ 08717 /* the next user statement. */ 08718 08719 cdir_switches.inline_here_sgi = TRUE; 08720 } 08721 else if (scope == Routine) { 08722 ir_idx = gen_directive_ir(turn_on ? Inline_Routine_Star_Opr : 08723 Noinline_Routine_Star_Opr); 08724 } 08725 else if (scope == Global) { 08726 ir_idx = gen_directive_ir(turn_on ? Inline_Global_Star_Opr : 08727 Noinline_Global_Star_Opr); 08728 } 08729 08730 if (LA_CH_VALUE == LPAREN) { 08731 NEXT_LA_CH; 08732 08733 while (TRUE) { /* have list */ 08734 08735 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 08736 line = TOKEN_LINE(token); 08737 column = TOKEN_COLUMN(token); 08738 08739 attr_idx = srch_sym_tbl(TOKEN_STR(token), 08740 TOKEN_LEN(token), 08741 &name_idx); 08742 08743 if (attr_idx != NULL_IDX) { 08744 host_attr_idx = attr_idx; 08745 08746 if (! LN_DEF_LOC(name_idx)) { 08747 amb_ref = TRUE; 08748 08749 while (AT_ATTR_LINK(host_attr_idx) != NULL_IDX) { 08750 host_attr_idx = AT_ATTR_LINK(host_attr_idx); 08751 } 08752 } 08753 } 08754 else { /* any other reference is ambiguous */ 08755 amb_ref = TRUE; 08756 host_attr_idx = srch_host_sym_tbl(TOKEN_STR(token), 08757 TOKEN_LEN(token), 08758 &host_name_idx, 08759 TRUE); 08760 08761 if (host_attr_idx != NULL_IDX) { 08762 08763 if (AT_IS_INTRIN(host_attr_idx) && 08764 ATI_FIRST_SPECIFIC_IDX(host_attr_idx) == NULL_IDX) { 08765 complete_intrinsic_definition(host_attr_idx); 08766 attr_idx = srch_sym_tbl(TOKEN_STR(token), 08767 TOKEN_LEN(token), 08768 &name_idx); 08769 } 08770 08771 attr_idx = ntr_host_in_sym_tbl(&token, 08772 name_idx, 08773 host_attr_idx, 08774 host_name_idx, 08775 TRUE); 08776 08777 if (AT_IS_INTRIN(host_attr_idx)) { 08778 COPY_VARIANT_ATTR_INFO(host_attr_idx, 08779 attr_idx, 08780 Interface); 08781 08782 AT_IS_INTRIN(attr_idx) = TRUE; 08783 AT_ATTR_LINK(attr_idx) = NULL_IDX; 08784 AT_ELEMENTAL_INTRIN(attr_idx) = 08785 AT_ELEMENTAL_INTRIN(host_attr_idx); 08786 AT_DEF_LINE(attr_idx) = TOKEN_LINE(token); 08787 AT_DEF_COLUMN(attr_idx) = TOKEN_COLUMN(token); 08788 } 08789 else if (AT_OBJ_CLASS(attr_idx) != Interface) { 08790 AT_ATTR_LINK(attr_idx) = host_attr_idx; 08791 08792 while (AT_ATTR_LINK(host_attr_idx) != NULL_IDX) { 08793 host_attr_idx = AT_ATTR_LINK(host_attr_idx); 08794 } 08795 } 08796 } 08797 } 08798 08799 if (attr_idx == NULL_IDX) { 08800 attr_idx = ntr_sym_tbl(&token, name_idx); 08801 AT_OBJ_CLASS(attr_idx) = Pgm_Unit; 08802 ATP_PGM_UNIT(attr_idx) = Pgm_Unknown; 08803 ATP_SCP_IDX(attr_idx) = curr_scp_idx; 08804 MAKE_EXTERNAL_NAME(attr_idx, 08805 AT_NAME_IDX(attr_idx), 08806 AT_NAME_LEN(attr_idx)); 08807 ATP_PROC(attr_idx) = Unknown_Proc; 08808 } 08809 else if (!amb_ref) { 08810 08811 /* Allow the inline directive with user specified intrinsics */ 08812 /* We will check for user specified intrinsics in decl_sem */ 08813 08814 08815 if (AT_OBJ_CLASS(attr_idx) == Interface && scope == Global) { 08816 08817 /* Allow the inline directive with generic */ 08818 /* interface. Do not allow with GLOBAL. */ 08819 08820 PRINTMSG(line, 1654, Error, column, 08821 AT_OBJ_NAME_PTR(attr_idx), 08822 (inline_dir) ? "INLINE" : "IPA"); 08823 parse_err_flush(Find_EOS, NULL); 08824 goto EXIT; 08825 } 08826 08827 if (fnd_semantic_err((inline_dir ? Obj_Inline : Obj_Ipa), 08828 line, 08829 column, 08830 attr_idx, 08831 TRUE)) { 08832 parse_err_flush(Find_EOS, NULL); 08833 goto EXIT; 08834 } 08835 } 08836 } 08837 08838 if (AT_OBJ_CLASS(attr_idx) == Data_Obj) { /* Switch to Function*/ 08839 chg_data_obj_to_pgm_unit(attr_idx, 08840 Pgm_Unknown, 08841 Unknown_Proc); 08842 } 08843 08844 if (AT_OBJ_CLASS(attr_idx) == Interface) { 08845 08846 /* Set on the interface for now. This will be */ 08847 /* set on the specifics in decl_semantics. */ 08848 08849 if (scope == Routine) { 08850 08851 if (turn_on) { 08852 ATI_SGI_ROUTINE_INLINE(attr_idx) = TRUE; 08853 ATI_SGI_ROUTINE_NOINLINE(attr_idx) = FALSE; 08854 } 08855 else { 08856 ATI_SGI_ROUTINE_NOINLINE(attr_idx) = TRUE; 08857 ATI_SGI_ROUTINE_INLINE(attr_idx) = FALSE; 08858 ATI_IPA_DIR_SPECIFIED(attr_idx) = TRUE; 08859 } 08860 } 08861 } 08862 else if (scope == Routine) { 08863 08864 if (turn_on) { 08865 ATP_SGI_ROUTINE_INLINE(attr_idx) = TRUE; 08866 ATP_SGI_ROUTINE_NOINLINE(attr_idx) = FALSE; 08867 } 08868 else { 08869 ATP_SGI_ROUTINE_NOINLINE(attr_idx) = TRUE; 08870 ATP_SGI_ROUTINE_INLINE(attr_idx) = FALSE; 08871 } 08872 } 08873 else if (scope == Global) { 08874 08875 /* clear any routine dirs we've seen so far */ 08876 08877 ATP_SGI_ROUTINE_INLINE(attr_idx) = FALSE; 08878 ATP_SGI_ROUTINE_NOINLINE(attr_idx) = FALSE; 08879 08880 if (turn_on) { 08881 ATP_SGI_GLOBAL_INLINE(attr_idx) = TRUE; 08882 ATP_SGI_GLOBAL_NOINLINE(attr_idx) = FALSE; 08883 } 08884 else { 08885 ATP_SGI_GLOBAL_NOINLINE(attr_idx) = TRUE; 08886 ATP_SGI_GLOBAL_INLINE(attr_idx) = FALSE; 08887 } 08888 08889 host_attr_idx = AT_ATTR_LINK(attr_idx); 08890 08891 while (host_attr_idx) { 08892 ATP_SGI_GLOBAL_INLINE(host_attr_idx) = 08893 ATP_SGI_GLOBAL_INLINE(attr_idx); 08894 ATP_SGI_GLOBAL_NOINLINE(host_attr_idx) = 08895 ATP_SGI_GLOBAL_NOINLINE(attr_idx); 08896 08897 ATP_SGI_ROUTINE_INLINE(host_attr_idx) = FALSE; 08898 ATP_SGI_ROUTINE_NOINLINE(host_attr_idx) = FALSE; 08899 08900 host_attr_idx = AT_ATTR_LINK(host_attr_idx); 08901 } 08902 } 08903 08904 /* add to list */ 08905 08906 NTR_IR_LIST_TBL(list_idx); 08907 08908 if (IR_FLD_L(ir_idx) == NO_Tbl_Idx) { 08909 IR_FLD_L(ir_idx) = IL_Tbl_Idx; 08910 IR_IDX_L(ir_idx) = list_idx; 08911 IR_LIST_CNT_L(ir_idx) = 1; 08912 } 08913 else { 08914 IL_NEXT_LIST_IDX(list_idx) = IR_IDX_L(ir_idx); 08915 IL_PREV_LIST_IDX(IR_IDX_L(ir_idx)) = list_idx; 08916 IR_IDX_L(ir_idx) = list_idx; 08917 IR_LIST_CNT_L(ir_idx) += 1; 08918 } 08919 08920 IL_FLD(list_idx) = AT_Tbl_Idx; 08921 IL_IDX(list_idx) = attr_idx; 08922 IL_LINE_NUM(list_idx) = line; 08923 IL_COL_NUM(list_idx) = column; 08924 08925 if (LA_CH_VALUE == COMMA) { 08926 NEXT_LA_CH; 08927 } 08928 else { 08929 break; 08930 } 08931 } 08932 08933 if (LA_CH_VALUE == RPAREN) { 08934 NEXT_LA_CH; 08935 } 08936 else { 08937 parse_err_flush(Find_EOS, ")"); 08938 goto EXIT; 08939 } 08940 } 08941 else if (scope == Global) { /* applies to all pgm units */ 08942 08943 if (turn_on) { 08944 inline_global_sgi = TRUE; 08945 noinline_global_sgi = FALSE; 08946 } 08947 else { 08948 noinline_global_sgi = TRUE; 08949 inline_global_sgi = FALSE; 08950 } 08951 } 08952 else if (scope == Routine) { 08953 08954 if (turn_on) { 08955 SCP_INLINE_SGI(curr_scp_idx) = TRUE; 08956 SCP_NOINLINE_SGI(curr_scp_idx) = FALSE; 08957 } 08958 else { 08959 SCP_NOINLINE_SGI(curr_scp_idx) = TRUE; 08960 SCP_INLINE_SGI(curr_scp_idx) = FALSE; 08961 } 08962 } 08963 08964 EXIT: 08965 08966 if (LA_CH_VALUE != EOS) { 08967 parse_err_flush(Find_EOS, EOS_STR); 08968 } 08969 08970 TRACE (Func_Exit, "parse_sgi_dir_inline", NULL); 08971 08972 return; 08973 08974 } /* parse_sgi_dir_inline */ 08975 08976 /******************************************************************************\ 08977 |* *| 08978 |* Description: *| 08979 |* <description> *| 08980 |* *| 08981 |* Input parameters: *| 08982 |* NONE *| 08983 |* *| 08984 |* Output parameters: *| 08985 |* NONE *| 08986 |* *| 08987 |* Returns: *| 08988 |* NOTHING *| 08989 |* *| 08990 \******************************************************************************/ 08991 08992 static void parse_distribution_dir(boolean reshape) 08993 08994 08995 { 08996 int attr_idx; 08997 int bd_idx; 08998 int name_idx; 08999 int onto_col; 09000 int onto_line; 09001 int onto_rank; 09002 opnd_type opnd; 09003 int rank; 09004 09005 09006 TRACE (Func_Entry, "parse_distribution_dir", NULL); 09007 09008 while (TRUE) { 09009 09010 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 09011 attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token), 09012 &name_idx); 09013 09014 if (attr_idx == NULL_IDX) { 09015 attr_idx = ntr_sym_tbl(&token, name_idx); 09016 LN_DEF_LOC(name_idx) = TRUE; 09017 SET_IMPL_TYPE(attr_idx); 09018 } 09019 else { 09020 09021 /* Do error checking */ 09022 09023 if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) { 09024 AT_ATTR_LINK(attr_idx) = NULL_IDX; 09025 LN_DEF_LOC(name_idx) = TRUE; 09026 } 09027 } 09028 09029 if (LA_CH_VALUE == LPAREN) { 09030 rank = 0; 09031 bd_idx = reserve_array_ntry(7); 09032 BD_LINE_NUM(bd_idx) = TOKEN_LINE(token); 09033 BD_COLUMN_NUM(bd_idx) = TOKEN_COLUMN(token); 09034 BD_DIST_NTRY(bd_idx) = TRUE; 09035 BD_DISTRIBUTE_RESHAPE(bd_idx) = reshape; 09036 09037 do { 09038 rank++; 09039 NEXT_LA_CH; 09040 09041 if (LA_CH_VALUE == STAR) { 09042 NEXT_LA_CH; /* Get star */ 09043 09044 BD_DISTRIBUTION(bd_idx, rank) = Star_Distribution; 09045 } 09046 else if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 09047 09048 if (TOKEN_VALUE(token) == Tok_SGI_Dir_Block) { 09049 BD_DISTRIBUTION(bd_idx, rank) = Block_Distribution; 09050 } 09051 else if (TOKEN_VALUE(token) == Tok_SGI_Dir_Cyclic) { 09052 BD_DISTRIBUTION(bd_idx, rank) = Cyclic_Distribution; 09053 09054 if (LA_CH_VALUE == LPAREN) { /* Have expression */ 09055 NEXT_LA_CH; 09056 09057 if (! parse_expr(&opnd)) { 09058 BD_DCL_ERR(bd_idx) = TRUE; 09059 parse_err_flush(Find_EOS, NULL); 09060 goto EXIT; 09061 } 09062 09063 BD_CYCLIC_FLD(bd_idx, rank) = OPND_FLD(opnd); 09064 BD_CYCLIC_IDX(bd_idx, rank) = OPND_IDX(opnd); 09065 09066 if (LA_CH_VALUE != RPAREN) { 09067 parse_err_flush(Find_EOS, ")"); 09068 BD_DCL_ERR(bd_idx) = TRUE; 09069 goto EXIT; 09070 } 09071 else { 09072 NEXT_LA_CH; 09073 } 09074 } 09075 } 09076 else { 09077 parse_err_flush(Find_EOS, "BLOCK, CYCLIC or *"); 09078 BD_DCL_ERR(bd_idx) = TRUE; 09079 goto EXIT; 09080 } 09081 } 09082 else { 09083 parse_err_flush(Find_EOS, "BLOCK, CYCLIC or *"); 09084 BD_DCL_ERR(bd_idx) = TRUE; 09085 goto EXIT; 09086 } 09087 } 09088 while (LA_CH_VALUE == COMMA); 09089 09090 if (LA_CH_VALUE != RPAREN) { 09091 parse_err_flush(Find_EOS, ")"); 09092 BD_DCL_ERR(bd_idx) = TRUE; 09093 goto EXIT; 09094 } 09095 else { 09096 NEXT_LA_CH; 09097 } 09098 09099 if (LA_CH_VALUE == COMMA) { 09100 /* intentionally blank */ 09101 } 09102 else if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd) && 09103 TOKEN_VALUE(token) == Tok_SGI_Dir_Onto) { 09104 09105 onto_line = TOKEN_LINE(token); 09106 onto_col = TOKEN_COLUMN(token); 09107 09108 if (LA_CH_VALUE == LPAREN) { 09109 onto_rank = 0; 09110 09111 do { 09112 onto_rank++; 09113 NEXT_LA_CH; 09114 09115 while (onto_rank <= rank && 09116 BD_DISTRIBUTION(bd_idx, onto_rank) == 09117 Star_Distribution) { 09118 /* no ONTO constants for Star_Distribution */ 09119 onto_rank++; 09120 } 09121 09122 if (onto_rank > rank) { 09123 /* too many ONTO values */ 09124 PRINTMSG(LA_CH_LINE, 1398, Error, LA_CH_COLUMN, 09125 "many"); 09126 parse_err_flush(Find_EOS, NULL); 09127 BD_DCL_ERR(bd_idx) = TRUE; 09128 goto EXIT; 09129 } 09130 09131 if (LA_CH_VALUE == STAR) { 09132 NEXT_LA_CH; 09133 BD_ONTO_FLD(bd_idx,onto_rank) = CN_Tbl_Idx; 09134 BD_ONTO_IDX(bd_idx,onto_rank) = CN_INTEGER_ZERO_IDX; 09135 } 09136 else { 09137 parse_expr(&opnd); 09138 BD_ONTO_FLD(bd_idx,onto_rank) = OPND_FLD(opnd); 09139 BD_ONTO_IDX(bd_idx,onto_rank) = OPND_IDX(opnd); 09140 } 09141 } 09142 while (LA_CH_VALUE == COMMA); 09143 09144 if (LA_CH_VALUE != RPAREN) { 09145 parse_err_flush(Find_EOS, ")"); 09146 BD_DCL_ERR(bd_idx) = TRUE; 09147 goto EXIT; 09148 } 09149 else { 09150 NEXT_LA_CH; 09151 } 09152 } 09153 else { 09154 parse_err_flush(Find_EOS, "("); 09155 BD_DCL_ERR(bd_idx) = TRUE; 09156 goto EXIT; 09157 } 09158 09159 while (onto_rank < rank) { 09160 onto_rank++; 09161 09162 if (BD_DISTRIBUTION(bd_idx, onto_rank) != 09163 Star_Distribution) { 09164 PRINTMSG(onto_line, 1398, Error, onto_col, "few"); 09165 parse_err_flush(Find_EOS, NULL); 09166 BD_DCL_ERR(bd_idx) = TRUE; 09167 goto EXIT; 09168 } 09169 } 09170 } 09171 else if (LA_CH_VALUE != EOS) { 09172 parse_err_flush(Find_EOS, "ONTO or EOS"); 09173 BD_DCL_ERR(bd_idx) = TRUE; 09174 goto EXIT; 09175 } 09176 09177 BD_RANK(bd_idx) = rank; 09178 ATD_DISTRIBUTION_IDX(attr_idx) = ntr_array_in_bd_tbl(bd_idx); 09179 } 09180 else { 09181 parse_err_flush(Find_EOS, "("); 09182 BD_DCL_ERR(bd_idx) = TRUE; 09183 goto EXIT; 09184 } 09185 } 09186 else { 09187 parse_err_flush(Find_EOS, "array name"); 09188 BD_DCL_ERR(bd_idx) = TRUE; 09189 goto EXIT; 09190 } 09191 09192 if (LA_CH_VALUE == COMMA) { 09193 NEXT_LA_CH; 09194 } 09195 else { 09196 break; 09197 } 09198 } 09199 09200 EXIT: 09201 09202 09203 TRACE (Func_Exit, "parse_distribution_dir", NULL); 09204 09205 return; 09206 09207 } /* parse_distribution_dir */ 09208 09209 /******************************************************************************\ 09210 |* *| 09211 |* Description: *| 09212 |* *| 09213 |* (Redistribute_Dollar_Opr) *| 09214 |* / \ *| 09215 |* attr_idx |-> Dist_Spec list *| 09216 |* | *| 09217 |* |-> Onto list *| 09218 |* *| 09219 |* *| 09220 |* One statement is created for each array specified. *| 09221 |* *| 09222 |* Keep this in synch with any changes to parse_distribution_dir. *| 09223 |* *| 09224 |* *| 09225 |* Input parameters: *| 09226 |* NONE *| 09227 |* *| 09228 |* Output parameters: *| 09229 |* NONE *| 09230 |* *| 09231 |* Returns: *| 09232 |* NOTHING *| 09233 |* *| 09234 \******************************************************************************/ 09235 09236 static void parse_redistribute_dir(void) 09237 09238 09239 { 09240 int attr_idx; 09241 int ir_idx; 09242 int list_idx; 09243 int list_idx2; 09244 int list_idx3; 09245 int name_idx; 09246 int onto_col; 09247 int onto_line; 09248 int onto_rank; 09249 opnd_type opnd; 09250 int rank; 09251 09252 09253 TRACE (Func_Entry, "parse_redistribute_dir", NULL); 09254 09255 while (TRUE) { 09256 09257 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 09258 ir_idx = gen_directive_ir(Redistribute_Dollar_Opr); 09259 09260 attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token), 09261 &name_idx); 09262 09263 if (attr_idx == NULL_IDX) { 09264 attr_idx = ntr_sym_tbl(&token, name_idx); 09265 LN_DEF_LOC(name_idx) = TRUE; 09266 SET_IMPL_TYPE(attr_idx); 09267 } 09268 else { 09269 09270 /* Do error checking */ 09271 09272 if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) { 09273 AT_ATTR_LINK(attr_idx) = NULL_IDX; 09274 LN_DEF_LOC(name_idx) = TRUE; 09275 } 09276 } 09277 09278 IR_FLD_L(ir_idx) = AT_Tbl_Idx; 09279 IR_IDX_L(ir_idx) = attr_idx; 09280 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 09281 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 09282 09283 NTR_IR_LIST_TBL(list_idx); 09284 IR_FLD_R(ir_idx) = IL_Tbl_Idx; 09285 IR_IDX_R(ir_idx) = list_idx; 09286 IR_LIST_CNT_R(ir_idx) = 1; 09287 09288 if (LA_CH_VALUE == LPAREN) { 09289 rank = 0; 09290 09291 do { 09292 09293 if (IL_FLD(list_idx) == NO_Tbl_Idx) { 09294 NTR_IR_LIST_TBL(list_idx2); 09295 IL_FLD(list_idx) = IL_Tbl_Idx; 09296 IL_IDX(list_idx) = list_idx2; 09297 IL_LIST_CNT(list_idx) = 1; 09298 } 09299 else { 09300 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx2)); 09301 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx2)) = list_idx2; 09302 list_idx2 = IL_NEXT_LIST_IDX(list_idx2); 09303 IL_LIST_CNT(list_idx) += 1; 09304 } 09305 09306 rank++; 09307 NEXT_LA_CH; 09308 09309 IL_DISTRIBUTION_VARIANT(list_idx2) = TRUE; 09310 09311 if (LA_CH_VALUE == STAR) { 09312 NEXT_LA_CH; /* Get star */ 09313 09314 IL_DISTRIBUTION(list_idx2) = Star_Distribution; 09315 } 09316 else if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 09317 09318 if (TOKEN_VALUE(token) == Tok_SGI_Dir_Block) { 09319 IL_DISTRIBUTION(list_idx2) = Block_Distribution; 09320 } 09321 else if (TOKEN_VALUE(token) == Tok_SGI_Dir_Cyclic) { 09322 IL_DISTRIBUTION(list_idx2) = Cyclic_Distribution; 09323 09324 if (LA_CH_VALUE == LPAREN) { /* Have expression */ 09325 NEXT_LA_CH; 09326 09327 if (! parse_expr(&opnd)) { 09328 parse_err_flush(Find_EOS, NULL); 09329 goto EXIT; 09330 } 09331 09332 COPY_OPND(IL_OPND(list_idx2), opnd); 09333 09334 if (LA_CH_VALUE != RPAREN) { 09335 parse_err_flush(Find_EOS, ")"); 09336 goto EXIT; 09337 } 09338 else { 09339 NEXT_LA_CH; 09340 } 09341 } 09342 } 09343 else { 09344 parse_err_flush(Find_EOS, "BLOCK, CYCLIC or *"); 09345 goto EXIT; 09346 } 09347 } 09348 else { 09349 parse_err_flush(Find_EOS, "BLOCK, CYCLIC or *"); 09350 goto EXIT; 09351 } 09352 } 09353 while (LA_CH_VALUE == COMMA); 09354 09355 if (LA_CH_VALUE != RPAREN) { 09356 parse_err_flush(Find_EOS, ")"); 09357 goto EXIT; 09358 } 09359 else { 09360 NEXT_LA_CH; 09361 } 09362 09363 if (LA_CH_VALUE == COMMA) { 09364 /* intentionally blank */ 09365 } 09366 else if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd) && 09367 TOKEN_VALUE(token) == Tok_SGI_Dir_Onto) { 09368 09369 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 09370 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 09371 list_idx2 = IL_IDX(list_idx); 09372 list_idx = IL_NEXT_LIST_IDX(list_idx); 09373 IR_LIST_CNT_R(ir_idx) = 2; 09374 09375 onto_line = TOKEN_LINE(token); 09376 onto_col = TOKEN_COLUMN(token); 09377 09378 if (LA_CH_VALUE == LPAREN) { 09379 onto_rank = 0; 09380 09381 do { 09382 09383 if (IL_FLD(list_idx) == NO_Tbl_Idx) { 09384 NTR_IR_LIST_TBL(list_idx3); 09385 IL_FLD(list_idx) = IL_Tbl_Idx; 09386 IL_IDX(list_idx) = list_idx3; 09387 IL_LIST_CNT(list_idx) = 1; 09388 } 09389 else { 09390 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx3)); 09391 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx3)) = 09392 list_idx3; 09393 list_idx3 = IL_NEXT_LIST_IDX(list_idx3); 09394 IL_LIST_CNT(list_idx) += 1; 09395 } 09396 09397 onto_rank++; 09398 NEXT_LA_CH; 09399 09400 while (onto_rank <= rank && 09401 list_idx2 != NULL_IDX && 09402 IL_DISTRIBUTION(list_idx2) == Star_Distribution) { 09403 /* no ONTO constants for Star_Distribution */ 09404 onto_rank++; 09405 09406 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx3)); 09407 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx3)) = 09408 list_idx3; 09409 list_idx3 = IL_NEXT_LIST_IDX(list_idx3); 09410 IL_LIST_CNT(list_idx) += 1; 09411 09412 if (list_idx2 != NULL_IDX) { 09413 list_idx2 = IL_NEXT_LIST_IDX(list_idx2); 09414 } 09415 } 09416 09417 if (onto_rank > rank) { 09418 /* too many ONTO values */ 09419 PRINTMSG(LA_CH_LINE, 1398, Error, LA_CH_COLUMN, 09420 "many"); 09421 parse_err_flush(Find_EOS, NULL); 09422 goto EXIT; 09423 } 09424 09425 if (LA_CH_VALUE == STAR) { 09426 IL_FLD(list_idx3) = CN_Tbl_Idx; 09427 IL_IDX(list_idx3) = CN_INTEGER_ZERO_IDX; 09428 IL_LINE_NUM(list_idx3) = LA_CH_LINE; 09429 IL_COL_NUM(list_idx3) = LA_CH_COLUMN; 09430 NEXT_LA_CH; 09431 } 09432 else { 09433 parse_expr(&opnd); 09434 COPY_OPND(IL_OPND(list_idx3), opnd); 09435 } 09436 09437 if (list_idx2 != NULL_IDX) { 09438 list_idx2 = IL_NEXT_LIST_IDX(list_idx2); 09439 } 09440 } 09441 while (LA_CH_VALUE == COMMA); 09442 09443 if (LA_CH_VALUE != RPAREN) { 09444 parse_err_flush(Find_EOS, ")"); 09445 goto EXIT; 09446 } 09447 else { 09448 NEXT_LA_CH; 09449 } 09450 } 09451 else { 09452 parse_err_flush(Find_EOS, "("); 09453 goto EXIT; 09454 } 09455 09456 while (onto_rank < rank) { 09457 onto_rank++; 09458 09459 if (IL_DISTRIBUTION(list_idx2) != Star_Distribution) { 09460 PRINTMSG(onto_line, 1398, Error, onto_col, "few"); 09461 parse_err_flush(Find_EOS, NULL); 09462 goto EXIT; 09463 } 09464 09465 if (list_idx2 != NULL_IDX) { 09466 list_idx2 = IL_NEXT_LIST_IDX(list_idx2); 09467 } 09468 } 09469 } 09470 else if (LA_CH_VALUE != EOS) { 09471 parse_err_flush(Find_EOS, "ONTO or EOS"); 09472 goto EXIT; 09473 } 09474 } 09475 else { 09476 parse_err_flush(Find_EOS, "("); 09477 goto EXIT; 09478 } 09479 } 09480 else { 09481 parse_err_flush(Find_EOS, "array name"); 09482 goto EXIT; 09483 } 09484 09485 if (LA_CH_VALUE == COMMA) { 09486 NEXT_LA_CH; 09487 } 09488 else { 09489 break; 09490 } 09491 } 09492 09493 EXIT: 09494 09495 09496 TRACE (Func_Exit, "parse_redistribute_dir", NULL); 09497 09498 return; 09499 09500 } /* parse_redistribute_dir */ 09501 09502 /******************************************************************************\ 09503 |* *| 09504 |* Description: *| 09505 |* <description> *| 09506 |* *| 09507 |* Input parameters: *| 09508 |* NONE *| 09509 |* *| 09510 |* Output parameters: *| 09511 |* NONE *| 09512 |* *| 09513 |* Returns: *| 09514 |* NOTHING *| 09515 |* *| 09516 \******************************************************************************/ 09517 09518 static boolean parse_assert_directive(void) 09519 09520 { 09521 int column; 09522 int ir_idx; 09523 int line; 09524 boolean ok = TRUE; 09525 opnd_type opnd; 09526 long the_constant; 09527 long the_constant2; 09528 09529 09530 TRACE (Func_Entry, "parse_assert_directive", NULL); 09531 09532 if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 09533 09534 ir_idx = gen_directive_ir(Assert_Star_Opr); 09535 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 09536 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 09537 line = TOKEN_LINE(token); 09538 column = TOKEN_COLUMN(token); 09539 09540 switch (TOKEN_VALUE(token)) { 09541 case Tok_SGI_Dir_Argumentaliasing: 09542 the_constant = ASSERT_ARGUMENTALIASING; 09543 break; 09544 09545 case Tok_SGI_Dir_Noargumentaliasing: 09546 the_constant = ASSERT_NOARGUMENTALIASING; 09547 break; 09548 09549 case Tok_SGI_Dir_Boundsviolations: 09550 the_constant = ASSERT_BOUNDSVIOLATIONS; 09551 break; 09552 09553 case Tok_SGI_Dir_Noboundsviolations: 09554 the_constant = ASSERT_NOBOUNDSVIOLATIONS; 09555 break; 09556 09557 case Tok_SGI_Dir_Concurrentcall: 09558 the_constant = ASSERT_CONCURRENTCALL; 09559 break; 09560 09561 case Tok_SGI_Dir_Noconcurrentcall: 09562 the_constant = ASSERT_NOCONCURRENTCALL; 09563 break; 09564 09565 case Tok_SGI_Dir_Norecurrence: 09566 the_constant = ASSERT_NORECURRENCE; 09567 09568 if (LA_CH_VALUE == LPAREN) { 09569 NEXT_LA_CH; 09570 09571 parse_var_name_list(&opnd, -1); 09572 COPY_OPND(IR_OPND_R(ir_idx), opnd); 09573 09574 if (LA_CH_VALUE == RPAREN) { 09575 NEXT_LA_CH; 09576 } 09577 else { 09578 parse_err_flush(Find_EOS, ")"); 09579 ok = FALSE; 09580 } 09581 } 09582 else { 09583 parse_err_flush(Find_EOS, "("); 09584 ok = FALSE; 09585 } 09586 09587 break; 09588 09589 case Tok_SGI_Dir_Doprefer: 09590 the_constant = ASSERT_DOPREFER; 09591 09592 if (LA_CH_VALUE == LPAREN) { 09593 NEXT_LA_CH; 09594 09595 if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 09596 switch (TOKEN_VALUE(token)) { 09597 case Tok_SGI_Dir_Concur: 09598 case Tok_SGI_Dir_Concurrent: 09599 the_constant2 = DOPREFER_CONCURRENT; 09600 break; 09601 09602 case Tok_SGI_Dir_Serial: 09603 the_constant2 = DOPREFER_SERIAL; 09604 break; 09605 09606 case Tok_SGI_Dir_Tile: 09607 case Tok_SGI_Dir_Vector: 09608 the_constant2 = DOPREFER_VECTOR; 09609 break; 09610 09611 default: 09612 the_constant2 = 0; 09613 parse_err_flush(Find_EOS, "PREFERENCE"); 09614 ok = FALSE; 09615 break; 09616 } 09617 09618 IR_LINE_NUM_R(ir_idx) = TOKEN_LINE(token); 09619 IR_COL_NUM_R(ir_idx) = TOKEN_COLUMN(token); 09620 IR_FLD_R(ir_idx) = CN_Tbl_Idx; 09621 IR_IDX_R(ir_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 09622 the_constant2); 09623 09624 if (LA_CH_VALUE != RPAREN) { 09625 parse_err_flush(Find_EOS, ")"); 09626 } 09627 else { 09628 NEXT_LA_CH; 09629 } 09630 09631 } 09632 else { 09633 parse_err_flush(Find_EOS, "PREFERENCE"); 09634 ok = FALSE; 09635 } 09636 } 09637 else { 09638 parse_err_flush(Find_EOS, "("); 09639 ok = FALSE; 09640 } 09641 break; 09642 09643 case Tok_SGI_Dir_Equivalencehazard: 09644 the_constant = ASSERT_EQUIVALENCEHAZARD; 09645 break; 09646 09647 case Tok_SGI_Dir_Noequivalencehazard: 09648 the_constant = ASSERT_NOEQUIVALENCEHAZARD; 09649 break; 09650 09651 case Tok_SGI_Dir_Lastvalueneeded: 09652 the_constant = ASSERT_LASTVALUENEEDED; 09653 PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token)); 09654 parse_err_flush(Find_EOS, NULL); 09655 break; 09656 09657 case Tok_SGI_Dir_Lastvaluesneeded: 09658 the_constant = ASSERT_LASTVALUESNEEDED; 09659 PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token)); 09660 parse_err_flush(Find_EOS, NULL); 09661 break; 09662 09663 case Tok_SGI_Dir_Nolastvalueneeded: 09664 the_constant = ASSERT_NOLASTVALUENEEDED; 09665 PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token)); 09666 parse_err_flush(Find_EOS, NULL); 09667 break; 09668 09669 case Tok_SGI_Dir_Nolastvaluesneeded: 09670 the_constant = ASSERT_NOLASTVALUESNEEDED; 09671 PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token)); 09672 parse_err_flush(Find_EOS, NULL); 09673 break; 09674 09675 case Tok_SGI_Dir_Permutation: 09676 the_constant = ASSERT_PERMUTATION; 09677 09678 if (LA_CH_VALUE == LPAREN) { 09679 NEXT_LA_CH; 09680 09681 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 09682 ok = parse_deref(&opnd, NULL_IDX); 09683 09684 if (OPND_FLD(opnd) != AT_Tbl_Idx) { 09685 ok = FALSE; 09686 find_opnd_line_and_column(&opnd, &line, &column); 09687 PRINTMSG(line, 1374, Error, column); 09688 } 09689 else { 09690 COPY_OPND(IR_OPND_R(ir_idx), opnd); 09691 } 09692 09693 if (LA_CH_VALUE == RPAREN) { 09694 NEXT_LA_CH; 09695 } 09696 else { 09697 parse_err_flush(Find_EOS, "("); 09698 ok = FALSE; 09699 } 09700 } 09701 else { 09702 parse_err_flush(Find_EOS, "IDENTIFIER"); 09703 ok = FALSE; 09704 } 09705 } 09706 else { 09707 parse_err_flush(Find_EOS, "("); 09708 ok = FALSE; 09709 } 09710 break; 09711 09712 case Tok_SGI_Dir_Relation: 09713 the_constant = ASSERT_RELATION; 09714 PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token)); 09715 parse_err_flush(Find_EOS, NULL); 09716 break; 09717 09718 case Tok_SGI_Dir_Nosync: 09719 the_constant = ASSERT_NOSYNC; 09720 PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token)); 09721 parse_err_flush(Find_EOS, NULL); 09722 break; 09723 09724 case Tok_SGI_Dir_Temporariesforconstantarguments: 09725 the_constant = ASSERT_TEMPORARIESFORCONSTANTARGUMENTS; 09726 break; 09727 09728 case Tok_SGI_Dir_Notemporariesforconstantarguments: 09729 the_constant = ASSERT_NOTEMPORARIESFORCONSTANTARGUMENTS; 09730 /* flush the remaining characters, the token is too long */ 09731 parse_err_flush(Find_EOS, NULL); 09732 break; 09733 09734 case Tok_SGI_Dir_Do: 09735 the_constant = ASSERT_DO; 09736 09737 if (LA_CH_VALUE == LPAREN) { 09738 NEXT_LA_CH; 09739 09740 if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) { 09741 switch (TOKEN_VALUE(token)) { 09742 case Tok_SGI_Dir_Concur: 09743 case Tok_SGI_Dir_Concurrent: 09744 the_constant2 = DOPREFER_CONCURRENT; 09745 break; 09746 09747 case Tok_SGI_Dir_Serial: 09748 the_constant2 = DOPREFER_SERIAL; 09749 break; 09750 09751 case Tok_SGI_Dir_Tile: 09752 case Tok_SGI_Dir_Vector: 09753 the_constant2 = DOPREFER_VECTOR; 09754 break; 09755 09756 default: 09757 the_constant2 = 0; 09758 parse_err_flush(Find_EOS, "PREFERENCE"); 09759 ok = FALSE; 09760 break; 09761 } 09762 09763 IR_LINE_NUM_R(ir_idx) = TOKEN_LINE(token); 09764 IR_COL_NUM_R(ir_idx) = TOKEN_COLUMN(token); 09765 IR_FLD_R(ir_idx) = CN_Tbl_Idx; 09766 IR_IDX_R(ir_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 09767 the_constant2); 09768 09769 if (LA_CH_VALUE != RPAREN) { 09770 parse_err_flush(Find_EOS, ")"); 09771 } 09772 else { 09773 NEXT_LA_CH; 09774 } 09775 09776 } 09777 else { 09778 parse_err_flush(Find_EOS, "PREFERENCE"); 09779 ok = FALSE; 09780 } 09781 } 09782 else { 09783 parse_err_flush(Find_EOS, "("); 09784 ok = FALSE; 09785 } 09786 break; 09787 09788 case Tok_SGI_Dir_Benign: 09789 the_constant = ASSERT_BENIGN; 09790 break; 09791 09792 case Tok_SGI_Dir_Dependence: 09793 the_constant = ASSERT_DEPENDENCE; 09794 break; 09795 09796 case Tok_SGI_Dir_Frequency: 09797 the_constant = ASSERT_FREQUENCY; 09798 break; 09799 09800 case Tok_SGI_Dir_Ignoreanydependences: 09801 the_constant = ASSERT_IGNOREANYDEPENDENCES; 09802 break; 09803 09804 case Tok_SGI_Dir_Ignoreanydependence: 09805 the_constant = ASSERT_IGNOREANYDEPENDENCE; 09806 break; 09807 09808 case Tok_SGI_Dir_Ignoreassumeddependences: 09809 the_constant = ASSERT_IGNOREASSUMEDDEPENDENCES; 09810 break; 09811 09812 case Tok_SGI_Dir_Ignoreassumeddependence: 09813 the_constant = ASSERT_IGNOREASSUMEDDEPENDENCE; 09814 break; 09815 09816 case Tok_SGI_Dir_Nointerchange: 09817 the_constant = ASSERT_NOINTERCHANGE; 09818 break; 09819 09820 case Tok_SGI_Dir_Usecompress: 09821 the_constant = ASSERT_USECOMPRESS; 09822 break; 09823 09824 case Tok_SGI_Dir_Useexpand: 09825 the_constant = ASSERT_USEEXPAND; 09826 break; 09827 09828 case Tok_SGI_Dir_Usecontrolledstore: 09829 the_constant = ASSERT_USECONTROLLEDSTORE; 09830 break; 09831 09832 case Tok_SGI_Dir_Usegather: 09833 the_constant = ASSERT_USEGATHER; 09834 break; 09835 09836 case Tok_SGI_Dir_Usescatter: 09837 the_constant = ASSERT_USESCATTER; 09838 break; 09839 09840 default: 09841 PRINTMSG(TOKEN_LINE(token), 1354, Warning, TOKEN_COLUMN(token), 09842 TOKEN_STR(token)); 09843 parse_err_flush(Find_EOS, NULL); 09844 ok = FALSE; 09845 goto EXIT; 09846 } 09847 09848 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 09849 IR_IDX_L(ir_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, the_constant); 09850 09851 if (directives_are_global) { 09852 /* copy the assert into the global ir table */ 09853 gen_gl_sh(After, Directive_Stmt, line, column, 09854 FALSE, FALSE, TRUE); 09855 GL_SH_IR_IDX(curr_gl_stmt_sh_idx) = copy_to_gl_subtree(ir_idx, 09856 IR_Tbl_Idx); 09857 } 09858 } 09859 else { 09860 parse_err_flush(Find_EOS, "ASSERTION"); 09861 ok = FALSE; 09862 } 09863 09864 EXIT: 09865 09866 TRACE (Func_Exit, "parse_assert_directive", NULL); 09867 09868 return(ok); 09869 09870 } /* parse_assert_directive */ 09871 09872 /******************************************************************************\ 09873 |* *| 09874 |* Description: *| 09875 |* <description> *| 09876 |* *| 09877 |* Input parameters: *| 09878 |* NONE *| 09879 |* *| 09880 |* Output parameters: *| 09881 |* NONE *| 09882 |* *| 09883 |* Returns: *| 09884 |* NOTHING *| 09885 |* *| 09886 \******************************************************************************/ 09887 09888 static boolean directive_region_error(directive_stmt_type dir, 09889 int line, 09890 int col) 09891 09892 { 09893 int count = 0; 09894 boolean error = FALSE; 09895 int region; 09896 long mask; 09897 char str[80]; 09898 char str2[80]; 09899 09900 TRACE (Func_Entry, "directive_region_error", NULL); 09901 09902 if ((directive_cant_be_in[dir] & directive_state) != 0) { 09903 mask = (directive_cant_be_in[dir] & directive_state); 09904 error = TRUE; 09905 09906 for (region = 0; region < Last_Region; region++) { 09907 if (((mask >> region) & 1) != 0) { 09908 break; 09909 } 09910 } 09911 09912 # ifdef _DEBUG 09913 if (region == Last_Region) { 09914 PRINTMSG(stmt_start_line, 626, Internal, stmt_start_col, 09915 "region error", "directive_region_error"); 09916 } 09917 # endif 09918 09919 PRINTMSG(line, 1411, Error, col, 09920 directive_stmt_str[dir], 09921 directive_region_str[region]); 09922 } 09923 else if (directive_must_be_in[dir] != 0 && 09924 (directive_must_be_in[dir] & directive_state) == 0) { 09925 error = TRUE; 09926 str[0] = '\0'; 09927 09928 for (region = 0; region < Last_Region; region++) { 09929 if (((directive_must_be_in[dir] >> region) & 1) != 0) { 09930 count++; 09931 if (count > 1) { 09932 sprintf(str2, ", or %s", directive_region_str[region]); 09933 } 09934 else { 09935 sprintf(str2, "%s", directive_region_str[region]); 09936 } 09937 strcat(str, str2); 09938 } 09939 } 09940 09941 PRINTMSG(line, 1412, Error, col, 09942 directive_stmt_str[dir], 09943 str); 09944 } 09945 09946 TRACE (Func_Exit, "directive_region_error", NULL); 09947 09948 return(error); 09949 09950 } /* directive_region_error */ 09951 09952 /******************************************************************************\ 09953 |* *| 09954 |* Description: *| 09955 |* <description> *| 09956 |* *| 09957 |* Input parameters: *| 09958 |* NONE *| 09959 |* *| 09960 |* Output parameters: *| 09961 |* NONE *| 09962 |* *| 09963 |* Returns: *| 09964 |* NOTHING *| 09965 |* *| 09966 \******************************************************************************/ 09967 09968 static void parse_id_directive(void) 09969 09970 { 09971 int column; 09972 int init_idx; 09973 size_offset_type length; 09974 int line; 09975 int list_idx; 09976 id_str_type name; 09977 opnd_type opnd; 09978 opnd_type opnd2; 09979 size_offset_type result; 09980 int sb_idx; 09981 int tmp_idx; 09982 09983 09984 TRACE (Func_Entry, "parse_id_directive", NULL); 09985 09986 if (parse_expr(&opnd)) { 09987 find_opnd_line_and_column(&opnd, &line, &column); 09988 09989 if (OPND_FLD(opnd)!= CN_Tbl_Idx || 09990 TYP_TYPE(CN_TYPE_IDX(OPND_IDX(opnd))) != Character) { 09991 PRINTMSG(line, 874, Error, column); 09992 } 09993 else { /* get temp, initialize, put in named static block */ 09994 tmp_idx = gen_compiler_tmp(line, column, Shared, TRUE); 09995 ATD_TYPE_IDX(tmp_idx) = CN_TYPE_IDX(OPND_IDX(opnd)); 09996 ATD_TMP_SEMANTICS_DONE(tmp_idx) = TRUE; 09997 09998 CREATE_ID(name, sb_name[What_Blk], sb_len[What_Blk]); 09999 10000 sb_idx = srch_stor_blk_tbl(name.string, sb_len[What_Blk],curr_scp_idx); 10001 10002 if (sb_idx == NULL_IDX) { 10003 sb_idx = ntr_stor_blk_tbl(name.string, 10004 sb_len[What_Blk], 10005 line, 10006 column, 10007 # if defined(GENERATE_WHIRL) 10008 Coment); /* different class on IRIX */ 10009 # else 10010 Static_Named); 10011 # endif 10012 SB_SAVED(sb_idx) = TRUE; 10013 } 10014 10015 ATD_STOR_BLK_IDX(tmp_idx) = sb_idx; 10016 10017 # if defined(GENERATE_WHIRL) 10018 /* Attach the string in CDIR$ ID "string" to the compiler temp. */ 10019 ATD_TMP_IDX(tmp_idx) = OPND_IDX(opnd); 10020 ATD_FLD(tmp_idx) = CN_Tbl_Idx; 10021 # endif 10022 10023 # if defined(_DEBUG) 10024 if (SB_LEN_FLD(sb_idx) != CN_Tbl_Idx) { 10025 PRINTMSG(line, 1201, Internal, column, SB_NAME_PTR(sb_idx)); 10026 } 10027 # endif 10028 ATD_OFFSET_ASSIGNED(tmp_idx) = TRUE; 10029 ATD_OFFSET_IDX(tmp_idx) = SB_LEN_IDX(sb_idx); 10030 ATD_OFFSET_FLD(tmp_idx) = SB_LEN_FLD(sb_idx); 10031 10032 /* 8 times number of chars to get bit length. */ 10033 10034 result.idx = CN_INTEGER_CHAR_BIT_IDX; 10035 result.fld = CN_Tbl_Idx; 10036 length.idx = TYP_IDX(ATD_TYPE_IDX(tmp_idx)); 10037 length.fld = TYP_FLD(ATD_TYPE_IDX(tmp_idx)); 10038 10039 if (!size_offset_binary_calc(&length, &result, Mult_Opr, &result)) { 10040 AT_DCL_ERR(tmp_idx) = TRUE; 10041 } 10042 10043 length.idx = SB_LEN_IDX(sb_idx); 10044 length.fld = SB_LEN_FLD(sb_idx); 10045 10046 if (!size_offset_binary_calc(&length, &result, Plus_Opr, &result)) { 10047 AT_DCL_ERR(tmp_idx) = TRUE; 10048 } 10049 10050 if (result.fld == NO_Tbl_Idx) { 10051 SB_LEN_FLD(sb_idx) = CN_Tbl_Idx; 10052 SB_LEN_IDX(sb_idx) = ntr_const_tbl(result.type_idx, 10053 FALSE, 10054 result.constant); 10055 } 10056 else { 10057 SB_LEN_IDX(sb_idx) = result.idx; 10058 SB_LEN_FLD(sb_idx) = result.fld; 10059 } 10060 10061 OPND_FLD(opnd2) = AT_Tbl_Idx; 10062 OPND_IDX(opnd2) = tmp_idx; 10063 OPND_LINE_NUM(opnd2) = line; 10064 OPND_COL_NUM(opnd2) = column; 10065 10066 gen_whole_substring(&opnd2, 0); 10067 10068 /* create data init stmt */ 10069 10070 NTR_IR_TBL(init_idx); 10071 IR_OPR(init_idx) = Init_Opr; 10072 # if defined(GENERATE_WHIRL) 10073 IR_OPR(init_idx) = Null_Opr; 10074 # endif 10075 10076 /* must have a type idx */ 10077 10078 IR_TYPE_IDX(init_idx) = ATD_TYPE_IDX(tmp_idx); 10079 IR_LINE_NUM(init_idx) = line; 10080 IR_COL_NUM(init_idx) = column; 10081 IR_LINE_NUM_R(init_idx) = line; 10082 IR_COL_NUM_R(init_idx) = column; 10083 COPY_OPND(IR_OPND_L(init_idx), opnd2); 10084 10085 NTR_IR_LIST_TBL(list_idx); 10086 IR_FLD_R(init_idx) = IL_Tbl_Idx; 10087 IR_IDX_R(init_idx) = list_idx; 10088 IR_LIST_CNT_R(init_idx) = 3; 10089 10090 COPY_OPND(IL_OPND(list_idx), opnd); 10091 10092 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 10093 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 10094 list_idx = IL_NEXT_LIST_IDX(list_idx); 10095 10096 IL_FLD(list_idx) = CN_Tbl_Idx; 10097 IL_IDX(list_idx) = CN_INTEGER_ONE_IDX; 10098 IL_LINE_NUM(list_idx) = line; 10099 IL_COL_NUM(list_idx) = column; 10100 10101 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 10102 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 10103 list_idx = IL_NEXT_LIST_IDX(list_idx); 10104 10105 IL_FLD(list_idx) = CN_Tbl_Idx; 10106 IL_IDX(list_idx) = CN_INTEGER_ZERO_IDX; 10107 IL_LINE_NUM(list_idx) = line; 10108 IL_COL_NUM(list_idx) = column; 10109 10110 gen_sh(Before, Assignment_Stmt, line, column, 10111 FALSE, FALSE, TRUE); 10112 SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) = init_idx; 10113 SH_P2_SKIP_ME(SH_PREV_IDX(curr_stmt_sh_idx)) = TRUE; 10114 } 10115 } 10116 else { 10117 parse_err_flush(Find_EOS, NULL); 10118 } 10119 10120 TRACE (Func_Exit, "parse_id_directive", NULL); 10121 10122 return; 10123 10124 } /* parse_id_directive */ 10125 10126 /******************************************************************************\ 10127 |* *| 10128 |* Description: *| 10129 |* <description> *| 10130 |* *| 10131 |* Input parameters: *| 10132 |* NONE *| 10133 |* *| 10134 |* Output parameters: *| 10135 |* NONE *| 10136 |* *| 10137 |* Returns: *| 10138 |* NOTHING *| 10139 |* *| 10140 \******************************************************************************/ 10141 10142 static void parse_open_mp_directives(void) 10143 10144 { 10145 int ir_idx; 10146 int list_idx; 10147 opnd_type opnd; 10148 int sh_idx; 10149 int type_idx; 10150 10151 10152 TRACE (Func_Entry, "parse_open_mp_directives", NULL); 10153 10154 if (TOKEN_VALUE(token) > Tok_Open_Mp_Dir_Start && 10155 TOKEN_VALUE(token) < Tok_Open_Mp_Dir_End && 10156 disregard_open_mp[TOKEN_VALUE(token) - Tok_Open_Mp_Dir_Start]) { 10157 parse_err_flush(Find_EOS, NULL); 10158 goto EXIT; 10159 } 10160 10161 switch (TOKEN_VALUE(token)) { 10162 case Tok_Open_Mp_Dir_Critical: 10163 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10164 ir_idx = gen_directive_ir(Critical_Open_Mp_Opr); 10165 10166 if (LA_CH_VALUE == LPAREN) { 10167 NEXT_LA_CH; 10168 10169 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 10170 10171 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX); 10172 TYP_TYPE(TYP_WORK_IDX) = Character; 10173 TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE; 10174 TYP_DESC(TYP_WORK_IDX) = Default_Typed; 10175 TYP_CHAR_CLASS(TYP_WORK_IDX)= Const_Len_Char; 10176 TYP_FLD(TYP_WORK_IDX) = CN_Tbl_Idx; 10177 TYP_IDX(TYP_WORK_IDX) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 10178 TOKEN_LEN(token)); 10179 type_idx = ntr_type_tbl(); 10180 10181 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 10182 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 10183 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 10184 IR_IDX_L(ir_idx) = ntr_const_tbl(type_idx, TRUE, NULL); 10185 10186 strcpy((char *)&CN_CONST(IR_IDX_L(ir_idx)), 10187 TOKEN_STR(token)); 10188 } 10189 else { 10190 parse_err_flush(Find_EOS, "IDENTIFIER"); 10191 } 10192 10193 if (LA_CH_VALUE == RPAREN) { 10194 NEXT_LA_CH; 10195 } 10196 else { 10197 parse_err_flush(Find_EOS, ")"); 10198 goto EXIT; 10199 } 10200 } 10201 else if (LA_CH_VALUE != EOS) { 10202 parse_err_flush(Find_EOS, "( or EOS"); 10203 } 10204 10205 if (directive_region_error(Critical_Open_Mp_Dir, 10206 IR_LINE_NUM(ir_idx), 10207 IR_COL_NUM(ir_idx))) { 10208 break; 10209 } 10210 10211 SET_DIRECTIVE_STATE(Open_Mp_Critical_Region); 10212 PUSH_BLK_STK (Open_Mp_Critical_Blk); 10213 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 10214 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 10215 LINK_TO_PARENT_BLK; 10216 break; 10217 10218 10219 case Tok_Open_Mp_Dir_Endcritical: 10220 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10221 ir_idx = gen_directive_ir(Endcritical_Open_Mp_Opr); 10222 10223 if (LA_CH_VALUE == LPAREN) { 10224 NEXT_LA_CH; 10225 10226 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 10227 10228 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX); 10229 TYP_TYPE(TYP_WORK_IDX) = Character; 10230 TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE; 10231 TYP_DESC(TYP_WORK_IDX) = Default_Typed; 10232 TYP_CHAR_CLASS(TYP_WORK_IDX)= Const_Len_Char; 10233 TYP_FLD(TYP_WORK_IDX) = CN_Tbl_Idx; 10234 TYP_IDX(TYP_WORK_IDX) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 10235 TOKEN_LEN(token)); 10236 type_idx = ntr_type_tbl(); 10237 10238 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 10239 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 10240 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 10241 IR_IDX_L(ir_idx) = ntr_const_tbl(type_idx, TRUE, NULL); 10242 10243 strcpy((char *)&CN_CONST(IR_IDX_L(ir_idx)), 10244 TOKEN_STR(token)); 10245 } 10246 else { 10247 parse_err_flush(Find_EOS, "IDENTIFIER"); 10248 } 10249 10250 if (LA_CH_VALUE == RPAREN) { 10251 NEXT_LA_CH; 10252 } 10253 else { 10254 parse_err_flush(Find_EOS, ")"); 10255 goto EXIT; 10256 } 10257 } 10258 else if (LA_CH_VALUE != EOS) { 10259 parse_err_flush(Find_EOS, "( or EOS"); 10260 } 10261 10262 if (directive_region_error(Endcritical_Open_Mp_Dir, 10263 IR_LINE_NUM(ir_idx), 10264 IR_COL_NUM(ir_idx))) { 10265 break; 10266 } 10267 10268 CLEAR_DIRECTIVE_STATE(Open_Mp_Critical_Region); 10269 SH_STMT_TYPE(curr_stmt_sh_idx) = Open_MP_End_Critical_Stmt; 10270 stmt_type = Open_MP_End_Critical_Stmt; 10271 10272 if (CURR_BLK == Open_Mp_Critical_Blk && 10273 IR_FLD_L(SH_IR_IDX(CURR_BLK_FIRST_SH_IDX)) == CN_Tbl_Idx) { 10274 10275 /* must be named */ 10276 if (IR_FLD_L(ir_idx) != CN_Tbl_Idx || 10277 strcmp((char *)&CN_CONST(IR_IDX_L(SH_IR_IDX( 10278 CURR_BLK_FIRST_SH_IDX))), 10279 (char *)&CN_CONST(IR_IDX_L(ir_idx))) != 0) { 10280 10281 PRINTMSG(IR_LINE_NUM(ir_idx), 1472, Error, IR_COL_NUM(ir_idx)); 10282 } 10283 } 10284 end_open_mp_critical_blk(FALSE); 10285 break; 10286 10287 10288 case Tok_Open_Mp_Dir_Do: 10289 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10290 ir_idx = gen_directive_ir(Do_Open_Mp_Opr); 10291 10292 parse_open_mp_clauses(Do_Omp); 10293 10294 if (directive_region_error(Do_Open_Mp_Dir, 10295 IR_LINE_NUM(ir_idx), 10296 IR_COL_NUM(ir_idx))) { 10297 break; 10298 } 10299 10300 cdir_switches.do_omp_sh_idx = curr_stmt_sh_idx; 10301 10302 check_do_open_mp_nesting(); 10303 10304 SET_DIRECTIVE_STATE(Open_Mp_Do_Region); 10305 /* blk is pushed in p_ctl_flow.c */ 10306 break; 10307 10308 case Tok_Open_Mp_Dir_Enddo: 10309 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10310 ir_idx = gen_directive_ir(Enddo_Open_Mp_Opr); 10311 10312 if (LA_CH_VALUE != EOS) { 10313 if (MATCHED_TOKEN_CLASS(Tok_Class_Open_Mp_Dir_Kwd)) { 10314 if (TOKEN_VALUE(token) == Tok_Open_Mp_Dir_Nowait) { 10315 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 10316 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX; 10317 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 10318 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 10319 } 10320 else { 10321 parse_err_flush(Find_EOS, "NOWAIT"); 10322 } 10323 } 10324 } 10325 10326 if (SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) != NULL_IDX && 10327 IR_OPR(SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))) == 10328 Enddo_Open_Mp_Opr && 10329 SH_COMPILER_GEN(SH_PREV_IDX(curr_stmt_sh_idx))) { 10330 10331 sh_idx = SH_PREV_IDX(curr_stmt_sh_idx); 10332 COPY_OPND(IR_OPND_R(ir_idx), 10333 IR_OPND_R(SH_IR_IDX(sh_idx))); 10334 10335 /* remove the CG end do */ 10336 10337 SH_PREV_IDX(SH_NEXT_IDX(sh_idx)) = SH_PREV_IDX(sh_idx); 10338 SH_NEXT_IDX(SH_PREV_IDX(sh_idx)) = SH_NEXT_IDX(sh_idx); 10339 10340 FREE_IR_NODE(SH_IR_IDX(sh_idx)); 10341 FREE_SH_NODE(sh_idx); 10342 break; 10343 } 10344 10345 if (directive_region_error(Enddo_Open_Mp_Dir, 10346 IR_LINE_NUM(ir_idx), 10347 IR_COL_NUM(ir_idx))) { 10348 break; 10349 } 10350 10351 CLEAR_DIRECTIVE_STATE(Open_Mp_Do_Region); 10352 SH_STMT_TYPE(curr_stmt_sh_idx) = Open_MP_End_Do_Stmt; 10353 stmt_type = Open_MP_End_Do_Stmt; 10354 end_open_mp_do_blk(FALSE); 10355 break; 10356 10357 case Tok_Open_Mp_Dir_Endparallel: 10358 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10359 ir_idx = gen_directive_ir(Endparallel_Open_Mp_Opr); 10360 10361 if (directive_region_error(Endparallel_Open_Mp_Dir, 10362 IR_LINE_NUM(ir_idx), 10363 IR_COL_NUM(ir_idx))) { 10364 break; 10365 } 10366 10367 CLEAR_DIRECTIVE_STATE(Open_Mp_Parallel_Region); 10368 SH_STMT_TYPE(curr_stmt_sh_idx) = Open_MP_End_Parallel_Stmt; 10369 stmt_type = Open_MP_End_Parallel_Stmt; 10370 end_open_mp_parallel_blk(FALSE); 10371 break; 10372 10373 case Tok_Open_Mp_Dir_Endparalleldo: 10374 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10375 ir_idx = gen_directive_ir(Endparalleldo_Open_Mp_Opr); 10376 10377 if (SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) != NULL_IDX && 10378 IR_OPR(SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))) == 10379 Endparalleldo_Open_Mp_Opr && 10380 SH_COMPILER_GEN(SH_PREV_IDX(curr_stmt_sh_idx))) { 10381 10382 /* remove the CG end do */ 10383 10384 sh_idx = SH_PREV_IDX(curr_stmt_sh_idx); 10385 COPY_OPND(IR_OPND_R(ir_idx), 10386 IR_OPND_R(SH_IR_IDX(sh_idx))); 10387 10388 SH_PREV_IDX(SH_NEXT_IDX(sh_idx)) = SH_PREV_IDX(sh_idx); 10389 SH_NEXT_IDX(SH_PREV_IDX(sh_idx)) = SH_NEXT_IDX(sh_idx); 10390 10391 FREE_IR_NODE(SH_IR_IDX(sh_idx)); 10392 FREE_SH_NODE(sh_idx); 10393 break; 10394 } 10395 10396 if (directive_region_error(Endparalleldo_Open_Mp_Dir, 10397 IR_LINE_NUM(ir_idx), 10398 IR_COL_NUM(ir_idx))) { 10399 break; 10400 } 10401 10402 CLEAR_DIRECTIVE_STATE(Open_Mp_Parallel_Do_Region); 10403 SH_STMT_TYPE(curr_stmt_sh_idx) = Open_MP_End_Parallel_Do_Stmt; 10404 stmt_type = Open_MP_End_Parallel_Do_Stmt; 10405 end_open_mp_parallel_do_blk(FALSE); 10406 break; 10407 10408 case Tok_Open_Mp_Dir_Endparallelsections: 10409 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10410 ir_idx = gen_directive_ir(Endparallelsections_Open_Mp_Opr); 10411 10412 if (directive_region_error(Endparallelsections_Open_Mp_Dir, 10413 IR_LINE_NUM(ir_idx), 10414 IR_COL_NUM(ir_idx))) { 10415 break; 10416 } 10417 10418 if (CURR_BLK == Open_Mp_Section_Blk) { 10419 end_open_mp_section_blk(FALSE); 10420 CLEAR_DIRECTIVE_STATE(Open_Mp_Section_Region); 10421 } 10422 10423 CLEAR_DIRECTIVE_STATE(Open_Mp_Parallel_Sections_Region); 10424 SH_STMT_TYPE(curr_stmt_sh_idx) = Open_MP_End_Parallel_Sections_Stmt; 10425 stmt_type = Open_MP_End_Parallel_Sections_Stmt; 10426 end_open_mp_parallel_sections_blk(FALSE); 10427 break; 10428 10429 case Tok_Open_Mp_Dir_Endparallelworkshare: 10430 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10431 ir_idx = gen_directive_ir(Endparallelworkshare_Open_Mp_Opr); 10432 10433 if (directive_region_error(Endparallelworkshare_Open_Mp_Dir, 10434 IR_LINE_NUM(ir_idx), 10435 IR_COL_NUM(ir_idx))) { 10436 break; 10437 } 10438 10439 CLEAR_DIRECTIVE_STATE(Open_Mp_Parallel_Workshare_Region); 10440 SH_STMT_TYPE(curr_stmt_sh_idx) = Open_MP_End_Parallel_Workshare_Stmt; 10441 stmt_type = Open_MP_End_Parallel_Workshare_Stmt; 10442 end_open_mp_parallel_workshare_blk(FALSE); 10443 break; 10444 10445 case Tok_Open_Mp_Dir_Endmaster: 10446 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10447 ir_idx = gen_directive_ir(Endmaster_Open_Mp_Opr); 10448 10449 if (directive_region_error(Endmaster_Open_Mp_Dir, 10450 IR_LINE_NUM(ir_idx), 10451 IR_COL_NUM(ir_idx))) { 10452 break; 10453 } 10454 10455 CLEAR_DIRECTIVE_STATE(Open_Mp_Master_Region); 10456 SH_STMT_TYPE(curr_stmt_sh_idx) = Open_MP_End_Master_Stmt; 10457 stmt_type = Open_MP_End_Master_Stmt; 10458 end_open_mp_master_blk(FALSE); 10459 break; 10460 10461 case Tok_Open_Mp_Dir_Endordered: 10462 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10463 ir_idx = gen_directive_ir(Endordered_Open_Mp_Opr); 10464 10465 if (directive_region_error(Endordered_Open_Mp_Dir, 10466 IR_LINE_NUM(ir_idx), 10467 IR_COL_NUM(ir_idx))) { 10468 break; 10469 } 10470 10471 CLEAR_DIRECTIVE_STATE(Open_Mp_Ordered_Region); 10472 SH_STMT_TYPE(curr_stmt_sh_idx) = Open_MP_End_Ordered_Stmt; 10473 stmt_type = Open_MP_End_Ordered_Stmt; 10474 end_open_mp_ordered_blk(FALSE); 10475 break; 10476 10477 case Tok_Open_Mp_Dir_Endsections: 10478 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10479 ir_idx = gen_directive_ir(Endsections_Open_Mp_Opr); 10480 10481 if (LA_CH_VALUE != EOS) { 10482 if (MATCHED_TOKEN_CLASS(Tok_Class_Open_Mp_Dir_Kwd)) { 10483 if (TOKEN_VALUE(token) == Tok_Open_Mp_Dir_Nowait) { 10484 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 10485 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX; 10486 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 10487 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 10488 } 10489 else { 10490 parse_err_flush(Find_EOS, "NOWAIT"); 10491 } 10492 } 10493 } 10494 10495 if (directive_region_error(Endsections_Open_Mp_Dir, 10496 IR_LINE_NUM(ir_idx), 10497 IR_COL_NUM(ir_idx))) { 10498 break; 10499 } 10500 10501 if (CURR_BLK == Open_Mp_Section_Blk) { 10502 end_open_mp_section_blk(FALSE); 10503 CLEAR_DIRECTIVE_STATE(Open_Mp_Section_Region); 10504 } 10505 10506 CLEAR_DIRECTIVE_STATE(Open_Mp_Sections_Region); 10507 SH_STMT_TYPE(curr_stmt_sh_idx) = Open_MP_End_Sections_Stmt; 10508 stmt_type = Open_MP_End_Sections_Stmt; 10509 end_open_mp_sections_blk(FALSE); 10510 break; 10511 10512 case Tok_Open_Mp_Dir_Endsingle: 10513 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10514 ir_idx = gen_directive_ir(Endsingle_Open_Mp_Opr); 10515 10516 if (LA_CH_VALUE != EOS) { 10517 if (MATCHED_TOKEN_CLASS(Tok_Class_Open_Mp_Dir_Kwd)) { 10518 if (TOKEN_VALUE(token) == Tok_Open_Mp_Dir_Nowait) { 10519 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 10520 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX; 10521 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 10522 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 10523 } 10524 else { 10525 /* rescan the token and check for COPYPRIVATE clause ([email protected]) */ 10526 /* nowait and copyprivate are exclusive */ 10527 reset_lex(TOKEN_BUF_IDX(token), TOKEN_STMT_NUM(token)); 10528 parse_open_mp_clauses(End_Single_Omp); 10529 /* parse_err_flush(Find_EOS, "NOWAIT"); */ 10530 } 10531 } 10532 } 10533 10534 if (directive_region_error(Endsingle_Open_Mp_Dir, 10535 IR_LINE_NUM(ir_idx), 10536 IR_COL_NUM(ir_idx))) { 10537 break; 10538 } 10539 10540 CLEAR_DIRECTIVE_STATE(Open_Mp_Single_Region); 10541 SH_STMT_TYPE(curr_stmt_sh_idx) = Open_MP_End_Single_Stmt; 10542 stmt_type = Open_MP_End_Single_Stmt; 10543 end_open_mp_single_blk(FALSE); 10544 break; 10545 10546 case Tok_Open_Mp_Dir_Endworkshare: 10547 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10548 ir_idx = gen_directive_ir(Endworkshare_Open_Mp_Opr); 10549 10550 if (LA_CH_VALUE != EOS) { 10551 if (MATCHED_TOKEN_CLASS(Tok_Class_Open_Mp_Dir_Kwd)) { 10552 if (TOKEN_VALUE(token) == Tok_Open_Mp_Dir_Nowait) { 10553 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 10554 IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX; 10555 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 10556 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 10557 } 10558 else { 10559 parse_err_flush(Find_EOS, "NOWAIT"); 10560 } 10561 } 10562 } 10563 10564 if (directive_region_error(Endworkshare_Open_Mp_Dir, 10565 IR_LINE_NUM(ir_idx), 10566 IR_COL_NUM(ir_idx))) { 10567 break; 10568 } 10569 10570 CLEAR_DIRECTIVE_STATE(Open_Mp_Workshare_Region); 10571 SH_STMT_TYPE(curr_stmt_sh_idx) = Open_MP_End_Workshare_Stmt; 10572 stmt_type = Open_MP_End_Workshare_Stmt; 10573 end_open_mp_workshare_blk(FALSE); 10574 break; 10575 10576 case Tok_Open_Mp_Dir_Master: 10577 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10578 ir_idx = gen_directive_ir(Master_Open_Mp_Opr); 10579 10580 if (directive_region_error(Master_Open_Mp_Dir, 10581 IR_LINE_NUM(ir_idx), 10582 IR_COL_NUM(ir_idx))) { 10583 break; 10584 } 10585 10586 SET_DIRECTIVE_STATE(Open_Mp_Master_Region); 10587 PUSH_BLK_STK (Open_Mp_Master_Blk); 10588 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 10589 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 10590 LINK_TO_PARENT_BLK; 10591 break; 10592 10593 case Tok_Open_Mp_Dir_Ordered: 10594 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10595 ir_idx = gen_directive_ir(Ordered_Open_Mp_Opr); 10596 10597 if (directive_region_error(Ordered_Open_Mp_Dir, 10598 IR_LINE_NUM(ir_idx), 10599 IR_COL_NUM(ir_idx))) { 10600 break; 10601 } 10602 10603 check_ordered_open_mp_nesting(); 10604 10605 SET_DIRECTIVE_STATE(Open_Mp_Ordered_Region); 10606 PUSH_BLK_STK (Open_Mp_Ordered_Blk); 10607 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 10608 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 10609 LINK_TO_PARENT_BLK; 10610 break; 10611 10612 case Tok_Open_Mp_Dir_Parallel: 10613 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10614 ir_idx = gen_directive_ir(Parallel_Open_Mp_Opr); 10615 10616 parse_open_mp_clauses(Parallel_Omp); 10617 10618 if (directive_region_error(Parallel_Open_Mp_Dir, 10619 IR_LINE_NUM(ir_idx), 10620 IR_COL_NUM(ir_idx))) { 10621 break; 10622 } 10623 10624 SET_DIRECTIVE_STATE(Open_Mp_Parallel_Region); 10625 PUSH_BLK_STK (Open_Mp_Parallel_Blk); 10626 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 10627 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 10628 LINK_TO_PARENT_BLK; 10629 break; 10630 10631 case Tok_Open_Mp_Dir_Paralleldo: 10632 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10633 ir_idx = gen_directive_ir(Paralleldo_Open_Mp_Opr); 10634 10635 parse_open_mp_clauses(Parallel_Do_Omp); 10636 10637 if (directive_region_error(Paralleldo_Open_Mp_Dir, 10638 IR_LINE_NUM(ir_idx), 10639 IR_COL_NUM(ir_idx))) { 10640 break; 10641 } 10642 10643 cdir_switches.paralleldo_omp_sh_idx = curr_stmt_sh_idx; 10644 10645 SET_DIRECTIVE_STATE(Open_Mp_Parallel_Do_Region); 10646 /* blk is pushed in p_ctl_flow.c */ 10647 break; 10648 10649 case Tok_Open_Mp_Dir_Parallelsections: 10650 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10651 ir_idx = gen_directive_ir(Parallelsections_Open_Mp_Opr); 10652 10653 parse_open_mp_clauses(Parallel_Sections_Omp); 10654 10655 if (directive_region_error(Parallelsections_Open_Mp_Dir, 10656 IR_LINE_NUM(ir_idx), 10657 IR_COL_NUM(ir_idx))) { 10658 break; 10659 } 10660 10661 SET_DIRECTIVE_STATE(Open_Mp_Parallel_Sections_Region); 10662 PUSH_BLK_STK (Open_Mp_Parallel_Sections_Blk); 10663 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 10664 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 10665 LINK_TO_PARENT_BLK; 10666 10667 /* push on a Section block */ 10668 SET_DIRECTIVE_STATE(Open_Mp_Section_Region); 10669 PUSH_BLK_STK (Open_Mp_Section_Blk); 10670 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 10671 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 10672 LINK_TO_PARENT_BLK; 10673 break; 10674 10675 10676 case Tok_Open_Mp_Dir_Parallelworkshare: 10677 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10678 ir_idx = gen_directive_ir(Parallelworkshare_Open_Mp_Opr); 10679 10680 parse_open_mp_clauses(Parallel_Workshare_Omp); 10681 10682 if (directive_region_error(Parallelworkshare_Open_Mp_Dir, 10683 IR_LINE_NUM(ir_idx), 10684 IR_COL_NUM(ir_idx))) { 10685 break; 10686 } 10687 10688 SET_DIRECTIVE_STATE(Open_Mp_Parallel_Workshare_Region); 10689 PUSH_BLK_STK (Open_Mp_Parallel_Workshare_Blk); 10690 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 10691 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 10692 LINK_TO_PARENT_BLK; 10693 break; 10694 10695 case Tok_Open_Mp_Dir_Section: 10696 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10697 ir_idx = gen_directive_ir(Section_Open_Mp_Opr); 10698 10699 if (directive_region_error(Section_Open_Mp_Dir, 10700 IR_LINE_NUM(ir_idx), 10701 IR_COL_NUM(ir_idx))) { 10702 break; 10703 } 10704 10705 if (! check_section_open_mp_context()) { 10706 break; 10707 } 10708 10709 if (CURR_BLK == Open_Mp_Section_Blk) { 10710 end_open_mp_section_blk(FALSE); 10711 CLEAR_DIRECTIVE_STATE(Open_Mp_Section_Region); 10712 } 10713 10714 SET_DIRECTIVE_STATE(Open_Mp_Section_Region); 10715 PUSH_BLK_STK (Open_Mp_Section_Blk); 10716 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 10717 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 10718 LINK_TO_PARENT_BLK; 10719 break; 10720 10721 case Tok_Open_Mp_Dir_Sections: 10722 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10723 ir_idx = gen_directive_ir(Sections_Open_Mp_Opr); 10724 10725 parse_open_mp_clauses(Sections_Omp); 10726 10727 if (directive_region_error(Sections_Open_Mp_Dir, 10728 IR_LINE_NUM(ir_idx), 10729 IR_COL_NUM(ir_idx))) { 10730 break; 10731 } 10732 10733 SET_DIRECTIVE_STATE(Open_Mp_Sections_Region); 10734 10735 check_do_open_mp_nesting(); 10736 10737 PUSH_BLK_STK (Open_Mp_Sections_Blk); 10738 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 10739 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 10740 LINK_TO_PARENT_BLK; 10741 10742 /* push on a Section block */ 10743 SET_DIRECTIVE_STATE(Open_Mp_Section_Region); 10744 PUSH_BLK_STK (Open_Mp_Section_Blk); 10745 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 10746 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 10747 LINK_TO_PARENT_BLK; 10748 break; 10749 10750 case Tok_Open_Mp_Dir_Single: 10751 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10752 ir_idx = gen_directive_ir(Single_Open_Mp_Opr); 10753 10754 parse_open_mp_clauses(Single_Omp); 10755 10756 if (directive_region_error(Single_Open_Mp_Dir, 10757 IR_LINE_NUM(ir_idx), 10758 IR_COL_NUM(ir_idx))) { 10759 break; 10760 } 10761 10762 SET_DIRECTIVE_STATE(Open_Mp_Single_Region); 10763 10764 check_do_open_mp_nesting(); 10765 10766 PUSH_BLK_STK (Open_Mp_Single_Blk); 10767 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 10768 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 10769 LINK_TO_PARENT_BLK; 10770 break; 10771 10772 case Tok_Open_Mp_Dir_Workshare: 10773 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10774 ir_idx = gen_directive_ir(Workshare_Open_Mp_Opr); 10775 10776 if (directive_region_error(Workshare_Open_Mp_Dir, 10777 IR_LINE_NUM(ir_idx), 10778 IR_COL_NUM(ir_idx))) { 10779 break; 10780 } 10781 10782 SET_DIRECTIVE_STATE(Open_Mp_Workshare_Region); 10783 PUSH_BLK_STK (Open_Mp_Workshare_Blk); 10784 BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE; 10785 CURR_BLK_FIRST_SH_IDX = curr_stmt_sh_idx; 10786 LINK_TO_PARENT_BLK; 10787 break; 10788 10789 case Tok_Open_Mp_Dir_Atomic: 10790 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10791 ir_idx = gen_directive_ir(Atomic_Open_Mp_Opr); 10792 10793 if (directive_region_error(Atomic_Open_Mp_Dir, 10794 IR_LINE_NUM(ir_idx), 10795 IR_COL_NUM(ir_idx))) { 10796 break; 10797 } 10798 10799 break; 10800 10801 case Tok_Open_Mp_Dir_Barrier: 10802 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10803 ir_idx = gen_directive_ir(Barrier_Open_Mp_Opr); 10804 10805 if (directive_region_error(Barrier_Open_Mp_Dir, 10806 IR_LINE_NUM(ir_idx), 10807 IR_COL_NUM(ir_idx))) { 10808 break; 10809 } 10810 10811 break; 10812 10813 case Tok_Open_Mp_Dir_Flush: 10814 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10815 ir_idx = gen_directive_ir(Flush_Open_Mp_Opr); 10816 10817 /* if a list of variables follows as agument, rescan FLUSH as clause ([email protected]) */ 10818 /* we introduce a fake clause FLUSH, to handle the directive similar to the others */ 10819 if (LA_CH_VALUE != EOS) { 10820 reset_lex(TOKEN_BUF_IDX(token), TOKEN_STMT_NUM(token)); 10821 parse_open_mp_clauses(Flush_Omp); 10822 } 10823 10824 if (directive_region_error(Flush_Open_Mp_Dir, 10825 IR_LINE_NUM(ir_idx), 10826 IR_COL_NUM(ir_idx))) { 10827 break; 10828 } 10829 break; 10830 10831 case Tok_Open_Mp_Dir_Threadprivate: 10832 10833 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 10834 10835 if (curr_stmt_category < Dir_Integer_Stmt_Cat) { 10836 PRINTMSG(TOKEN_LINE(token), 795, Warning, 10837 TOKEN_COLUMN(token), "THREADPRIVATE"); 10838 parse_err_flush(Find_EOS, NULL); 10839 break; 10840 } 10841 10842 if (curr_stmt_category >= Executable_Stmt_Cat) { 10843 PRINTMSG(TOKEN_LINE(token), 531, Error, 10844 TOKEN_COLUMN(token), 10845 "THREADPRIVATE"); 10846 parse_err_flush(Find_EOS, NULL); 10847 break; 10848 } 10849 10850 parse_slash_common_dirs(); 10851 break; 10852 10853 case Tok_Open_Mp_Dir_Distribute: 10854 if (! omp_extension_prefix(TOKEN_LINE(token))) { 10855 /* token not on !$sgi line */ 10856 PRINTMSG(TOKEN_LINE(token), 1518, Warning, 10857 TOKEN_COLUMN(token), 10858 "DISTRIBUTE directive", "!$SGI"); 10859 } 10860 10861 if (dump_flags.dsm) { 10862 parse_distribution_dir(FALSE); 10863 } 10864 else { 10865 parse_err_flush(Find_EOS, NULL); 10866 } 10867 break; 10868 10869 case Tok_Open_Mp_Dir_Distribute_Reshape: 10870 if (! omp_extension_prefix(TOKEN_LINE(token))) { 10871 /* token not on !$sgi line */ 10872 PRINTMSG(TOKEN_LINE(token), 1518, Warning, 10873 TOKEN_COLUMN(token), 10874 "DISTRIBUTE_RESHAPE directive", "!$SGI"); 10875 } 10876 10877 if (dump_flags.dsm) { 10878 parse_distribution_dir(TRUE); 10879 } 10880 else { 10881 parse_err_flush(Find_EOS, NULL); 10882 } 10883 break; 10884 10885 case Tok_Open_Mp_Dir_Dynamic: 10886 if (! omp_extension_prefix(TOKEN_LINE(token))) { 10887 /* token not on !$sgi line */ 10888 PRINTMSG(TOKEN_LINE(token), 1518, Warning, 10889 TOKEN_COLUMN(token), 10890 "DYNAMIC directive", "!$SGI"); 10891 } 10892 10893 if (dump_flags.dsm) { 10894 if (parse_var_name_list(&opnd, -1)) { 10895 ir_idx = gen_directive_ir(Dynamic_Dollar_Opr); 10896 COPY_OPND(IR_OPND_L(ir_idx), opnd); 10897 } 10898 } 10899 else { 10900 parse_err_flush(Find_EOS, NULL); 10901 } 10902 break; 10903 10904 case Tok_Open_Mp_Dir_Page_Place: 10905 if (! omp_extension_prefix(TOKEN_LINE(token))) { 10906 /* token not on !$sgi line */ 10907 PRINTMSG(TOKEN_LINE(token), 1518, Warning, 10908 TOKEN_COLUMN(token), 10909 "PAGE_PLACE directive", "!$SGI"); 10910 } 10911 10912 if (dump_flags.dsm) { 10913 ir_idx = gen_directive_ir(Page_Place_Dollar_Opr); 10914 10915 NTR_IR_LIST_TBL(list_idx); 10916 IR_FLD_L(ir_idx) = IL_Tbl_Idx; 10917 IR_IDX_L(ir_idx) = list_idx; 10918 IR_LIST_CNT_L(ir_idx) = 3; 10919 10920 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 10921 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 10922 list_idx = IL_NEXT_LIST_IDX(list_idx); 10923 10924 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 10925 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 10926 10927 list_idx = IR_IDX_L(ir_idx); 10928 10929 if (LA_CH_VALUE == LPAREN) { 10930 NEXT_LA_CH; 10931 10932 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 10933 parse_deref(&opnd, NULL_IDX); 10934 COPY_OPND(IL_OPND(list_idx), opnd); 10935 } 10936 else { 10937 parse_err_flush(Find_EOS, "IDENTIFIER"); 10938 goto EXIT; 10939 } 10940 10941 if (LA_CH_VALUE == COMMA) { 10942 NEXT_LA_CH; 10943 } 10944 else { 10945 parse_err_flush(Find_EOS, ","); 10946 goto EXIT; 10947 } 10948 10949 list_idx = IL_NEXT_LIST_IDX(list_idx); 10950 10951 parse_expr(&opnd); 10952 10953 COPY_OPND(IL_OPND(list_idx), opnd); 10954 10955 if (LA_CH_VALUE == COMMA) { 10956 NEXT_LA_CH; 10957 } 10958 else { 10959 parse_err_flush(Find_EOS, ","); 10960 goto EXIT; 10961 } 10962 10963 list_idx = IL_NEXT_LIST_IDX(list_idx); 10964 10965 parse_expr(&opnd); 10966 10967 COPY_OPND(IL_OPND(list_idx), opnd); 10968 10969 if (LA_CH_VALUE == RPAREN) { 10970 NEXT_LA_CH; 10971 } 10972 else { 10973 parse_err_flush(Find_EOS, ")"); 10974 } 10975 } 10976 else { 10977 parse_err_flush(Find_EOS, "("); 10978 } 10979 } 10980 else { 10981 parse_err_flush(Find_EOS, NULL); 10982 } 10983 break; 10984 10985 case Tok_Open_Mp_Dir_Redistribute: 10986 if (! omp_extension_prefix(TOKEN_LINE(token))) { 10987 /* token not on !$sgi line */ 10988 PRINTMSG(TOKEN_LINE(token), 1518, Warning, 10989 TOKEN_COLUMN(token), 10990 "REDISTRIBUTE directive", "!$SGI"); 10991 } 10992 10993 if (dump_flags.dsm) { 10994 parse_redistribute_dir(); 10995 } 10996 else { 10997 parse_err_flush(Find_EOS, NULL); 10998 } 10999 break; 11000 11001 11002 default: 11003 PRINTMSG(TOKEN_LINE(token), 790, Warning, TOKEN_COLUMN(token)); 11004 parse_err_flush(Find_EOS, NULL); 11005 break; 11006 } 11007 11008 if (LA_CH_VALUE != EOS) { 11009 parse_err_flush(Find_EOS, EOS_STR); 11010 } 11011 11012 EXIT: 11013 11014 NEXT_LA_CH; 11015 11016 TRACE (Func_Exit, "parse_open_mp_directives", NULL); 11017 11018 return; 11019 11020 } /* parse_open_mp_directives */ 11021 11022 /******************************************************************************\ 11023 |* *| 11024 |* Description: *| 11025 |* This routine parses the open mp directive. *| 11026 |* The ir it produces looks like .. *| 11027 |* *| 11028 |* (open mp directive operator) *| 11029 |* / *| 11030 |* |- IF condition *| 11031 |* |- PRIVATE var list *| 11032 |* |- SHARED var list *| 11033 |* |- FIRSTPRIVATE var list *| 11034 |* |- DEFAULT scope value (CN_Tbl_Idx) *| 11035 |* |- COPYIN var list *| 11036 |* |- REDUCTION opr | intrinsic list *| 11037 |* |- REDUCTION var list list *| 11038 |* |- LASTPRIVATE var list *| 11039 |* |- ORDERED constant (ORDERED == 1, else NO_Tbl_Idx) *| 11040 |* |- SCHEDULE type (CN_Tbl_Idx) *| 11041 |* |- SCHEDULE chunk (CN_Tbl_Idx) *| 11042 |* |- COPYPRIVATE var list *| 11043 |* |- AFFINITY index_var list *| 11044 |* |- IS THREAD constant (THREAD == 1, DATA == 0) *| 11045 |* |- THREAD/DATA list *| 11046 |* |- ONTO list *| 11047 |* |- NEST list *| 11048 |* |- FLUSH var list *| 11049 |* *| 11050 |* Input parameters: *| 11051 |* NONE *| 11052 |* *| 11053 |* Output parameters: *| 11054 |* NONE *| 11055 |* *| 11056 |* Returns: *| 11057 |* NOTHING *| 11058 |* *| 11059 \******************************************************************************/ 11060 11061 static void parse_open_mp_clauses(open_mp_directive_type directive) 11062 11063 { 11064 int i; 11065 int ir_idx; 11066 int list_array[OPEN_MP_LIST_CNT]; 11067 int list_idx; 11068 opnd_type opnd; 11069 int opr_ir_idx; 11070 long the_constant; 11071 11072 # if defined(GENERATE_WHIRL) 11073 int column; 11074 int line; 11075 int list2_idx; 11076 boolean seen_nest = FALSE; 11077 # endif 11078 11079 11080 TRACE (Func_Entry, "parse_open_mp_clauses", NULL); 11081 11082 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 11083 11084 for (i = 0; i < OPEN_MP_LIST_CNT; i++) { 11085 NTR_IR_LIST_TBL(list_array[i]); 11086 if (i >= 1) { 11087 IL_NEXT_LIST_IDX(list_array[i - 1]) = list_array[i]; 11088 IL_PREV_LIST_IDX(list_array[i]) = list_array[i - 1]; 11089 } 11090 } 11091 11092 IR_FLD_L(ir_idx) = IL_Tbl_Idx; 11093 IR_IDX_L(ir_idx) = list_array[0]; 11094 IR_LIST_CNT_L(ir_idx) = OPEN_MP_LIST_CNT; 11095 11096 while (LA_CH_VALUE != EOS) { 11097 11098 if (MATCHED_TOKEN_CLASS(Tok_Class_Open_Mp_Dir_Kwd)) { 11099 11100 switch (TOKEN_VALUE(token)) { 11101 11102 case Tok_Open_Mp_Dir_If: 11103 11104 if (! open_mp_clause_allowed[directive][If_Omp_Clause]) { 11105 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 11106 "IF", open_mp_dir_str[directive]); 11107 parse_err_flush(Find_EOS, NULL); 11108 goto EXIT; 11109 } 11110 11111 /* only one IF clause allowed */ 11112 11113 if (IL_IDX(list_array[OPEN_MP_IF_IDX]) != NULL_IDX) { 11114 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 11115 "IF", open_mp_dir_str[directive]); 11116 parse_err_flush(Find_EOS, NULL); 11117 goto EXIT; 11118 } 11119 11120 if (LA_CH_VALUE == LPAREN) { 11121 NEXT_LA_CH; 11122 parse_expr(&opnd); 11123 11124 COPY_OPND(IL_OPND(list_array[OPEN_MP_IF_IDX]), opnd); 11125 11126 if (LA_CH_VALUE == RPAREN) { 11127 NEXT_LA_CH; 11128 } 11129 else { 11130 parse_err_flush(Find_EOS, ")"); 11131 goto EXIT; 11132 } 11133 } 11134 else { 11135 parse_err_flush(Find_EOS, "("); 11136 goto EXIT; 11137 } 11138 break; 11139 11140 case Tok_Open_Mp_Dir_Private: 11141 11142 if (! open_mp_clause_allowed[directive][Private_Omp_Clause]) { 11143 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 11144 "PRIVATE", open_mp_dir_str[directive]); 11145 parse_err_flush(Find_EOS, NULL); 11146 goto EXIT; 11147 } 11148 11149 if (LA_CH_VALUE == LPAREN) { 11150 NEXT_LA_CH; 11151 parse_var_common_list(&opnd, FALSE); 11152 11153 if (IL_IDX(list_array[OPEN_MP_PRIVATE_IDX]) == NULL_IDX) { 11154 COPY_OPND(IL_OPND(list_array[OPEN_MP_PRIVATE_IDX]), opnd); 11155 } 11156 else { 11157 /* find the end of list */ 11158 11159 list_idx = IL_IDX(list_array[OPEN_MP_PRIVATE_IDX]); 11160 while (IL_NEXT_LIST_IDX(list_idx)) { 11161 list_idx = IL_NEXT_LIST_IDX(list_idx); 11162 } 11163 11164 /* append the new list */ 11165 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 11166 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 11167 IL_LIST_CNT(list_array[OPEN_MP_PRIVATE_IDX]) += 11168 OPND_LIST_CNT(opnd); 11169 } 11170 11171 if (LA_CH_VALUE == RPAREN) { 11172 NEXT_LA_CH; 11173 } 11174 else { 11175 parse_err_flush(Find_EOS, ")"); 11176 goto EXIT; 11177 } 11178 } 11179 else { 11180 parse_err_flush(Find_EOS, "("); 11181 goto EXIT; 11182 } 11183 11184 break; 11185 11186 case Tok_Open_Mp_Dir_Shared: 11187 11188 if (! open_mp_clause_allowed[directive][Shared_Omp_Clause]) { 11189 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 11190 "SHARED", open_mp_dir_str[directive]); 11191 parse_err_flush(Find_EOS, NULL); 11192 goto EXIT; 11193 } 11194 11195 if (LA_CH_VALUE == LPAREN) { 11196 NEXT_LA_CH; 11197 parse_var_name_list(&opnd, -1); 11198 11199 if (IL_IDX(list_array[OPEN_MP_SHARED_IDX]) == NULL_IDX) { 11200 COPY_OPND(IL_OPND(list_array[OPEN_MP_SHARED_IDX]), opnd); 11201 } 11202 else { 11203 /* find the end of list */ 11204 11205 list_idx = IL_IDX(list_array[OPEN_MP_SHARED_IDX]); 11206 while (IL_NEXT_LIST_IDX(list_idx)) { 11207 list_idx = IL_NEXT_LIST_IDX(list_idx); 11208 } 11209 11210 /* append the new list */ 11211 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 11212 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 11213 IL_LIST_CNT(list_array[OPEN_MP_SHARED_IDX]) += 11214 OPND_LIST_CNT(opnd); 11215 } 11216 11217 if (LA_CH_VALUE == RPAREN) { 11218 NEXT_LA_CH; 11219 } 11220 else { 11221 parse_err_flush(Find_EOS, ")"); 11222 goto EXIT; 11223 } 11224 } 11225 else { 11226 parse_err_flush(Find_EOS, "("); 11227 goto EXIT; 11228 } 11229 11230 break; 11231 11232 case Tok_Open_Mp_Dir_Firstprivate: 11233 11234 if (! open_mp_clause_allowed[directive] 11235 [Firstprivate_Omp_Clause]) { 11236 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 11237 "FIRSTPRIVATE", open_mp_dir_str[directive]); 11238 parse_err_flush(Find_EOS, NULL); 11239 goto EXIT; 11240 } 11241 11242 if (LA_CH_VALUE == LPAREN) { 11243 NEXT_LA_CH; 11244 parse_var_common_list(&opnd, FALSE); 11245 11246 if (IL_IDX(list_array[OPEN_MP_FIRSTPRIVATE_IDX]) == 11247 NULL_IDX) { 11248 11249 COPY_OPND(IL_OPND(list_array[OPEN_MP_FIRSTPRIVATE_IDX]), 11250 opnd); 11251 } 11252 else { 11253 /* find the end of list */ 11254 11255 list_idx = IL_IDX(list_array[OPEN_MP_FIRSTPRIVATE_IDX]); 11256 while (IL_NEXT_LIST_IDX(list_idx)) { 11257 list_idx = IL_NEXT_LIST_IDX(list_idx); 11258 } 11259 11260 /* append the new list */ 11261 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 11262 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 11263 IL_LIST_CNT(list_array[OPEN_MP_FIRSTPRIVATE_IDX]) += 11264 OPND_LIST_CNT(opnd); 11265 } 11266 11267 if (LA_CH_VALUE == RPAREN) { 11268 NEXT_LA_CH; 11269 } 11270 else { 11271 parse_err_flush(Find_EOS, ")"); 11272 goto EXIT; 11273 } 11274 } 11275 else { 11276 parse_err_flush(Find_EOS, "("); 11277 goto EXIT; 11278 } 11279 11280 break; 11281 11282 case Tok_Open_Mp_Dir_Default: 11283 11284 if (! open_mp_clause_allowed[directive][Default_Omp_Clause]) { 11285 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 11286 "DEFAULT", open_mp_dir_str[directive]); 11287 parse_err_flush(Find_EOS, NULL); 11288 goto EXIT; 11289 } 11290 11291 /* only one DEFAULT clause allowed */ 11292 11293 if (IL_IDX(list_array[OPEN_MP_DEFAULT_IDX]) != NULL_IDX) { 11294 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 11295 "DEFAULT", open_mp_dir_str[directive]); 11296 parse_err_flush(Find_EOS, NULL); 11297 goto EXIT; 11298 } 11299 11300 if (LA_CH_VALUE == LPAREN) { 11301 NEXT_LA_CH; 11302 11303 if (MATCHED_TOKEN_CLASS(Tok_Class_Open_Mp_Dir_Kwd)) { 11304 11305 switch (TOKEN_VALUE(token)) { 11306 case Tok_Open_Mp_Dir_Private: 11307 the_constant = OPEN_MP_DEFAULT_PRIVATE; 11308 break; 11309 11310 case Tok_Open_Mp_Dir_Shared: 11311 the_constant = OPEN_MP_DEFAULT_SHARED; 11312 break; 11313 11314 case Tok_Open_Mp_Dir_None: 11315 the_constant = OPEN_MP_DEFAULT_NONE; 11316 break; 11317 11318 default: 11319 parse_err_flush(Find_EOS, 11320 "PRIVATE, SHARED, or NONE"); 11321 goto EXIT; 11322 } 11323 11324 IL_FLD(list_array[OPEN_MP_DEFAULT_IDX]) = CN_Tbl_Idx; 11325 IL_IDX(list_array[OPEN_MP_DEFAULT_IDX]) = 11326 C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 11327 the_constant); 11328 11329 IL_LINE_NUM(list_array[OPEN_MP_DEFAULT_IDX]) = 11330 TOKEN_LINE(token); 11331 IL_COL_NUM(list_array[OPEN_MP_DEFAULT_IDX]) = 11332 TOKEN_COLUMN(token); 11333 11334 if (LA_CH_VALUE == RPAREN) { 11335 NEXT_LA_CH; 11336 } 11337 else { 11338 parse_err_flush(Find_EOS, ")"); 11339 goto EXIT; 11340 } 11341 } 11342 else { 11343 parse_err_flush(Find_EOS, "PRIVATE, SHARED, or NONE"); 11344 } 11345 } 11346 else { 11347 parse_err_flush(Find_EOS, "("); 11348 goto EXIT; 11349 } 11350 11351 break; 11352 11353 case Tok_Open_Mp_Dir_Copyin: 11354 11355 if (! open_mp_clause_allowed[directive][Copyin_Omp_Clause]) { 11356 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 11357 "COPYIN", open_mp_dir_str[directive]); 11358 parse_err_flush(Find_EOS, NULL); 11359 goto EXIT; 11360 } 11361 11362 if (LA_CH_VALUE == LPAREN) { 11363 NEXT_LA_CH; 11364 parse_var_common_list(&opnd, FALSE); 11365 11366 if (IL_IDX(list_array[OPEN_MP_COPYIN_IDX]) == NULL_IDX) { 11367 COPY_OPND(IL_OPND(list_array[OPEN_MP_COPYIN_IDX]), 11368 opnd); 11369 } 11370 else { 11371 /* find the end of list */ 11372 11373 list_idx = IL_IDX(list_array[OPEN_MP_COPYIN_IDX]); 11374 while (IL_NEXT_LIST_IDX(list_idx)) { 11375 list_idx = IL_NEXT_LIST_IDX(list_idx); 11376 } 11377 11378 /* append the new list */ 11379 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 11380 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 11381 IL_LIST_CNT(list_array[OPEN_MP_COPYIN_IDX]) += 11382 OPND_LIST_CNT(opnd); 11383 } 11384 11385 if (LA_CH_VALUE == RPAREN) { 11386 NEXT_LA_CH; 11387 } 11388 else { 11389 parse_err_flush(Find_EOS, ")"); 11390 goto EXIT; 11391 } 11392 } 11393 else { 11394 parse_err_flush(Find_EOS, "("); 11395 goto EXIT; 11396 } 11397 11398 break; 11399 11400 11401 case Tok_Open_Mp_Dir_Reduction: 11402 11403 if (! open_mp_clause_allowed[directive][Reduction_Omp_Clause]) { 11404 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 11405 "REDUCTION", open_mp_dir_str[directive]); 11406 parse_err_flush(Find_EOS, NULL); 11407 goto EXIT; 11408 } 11409 11410 if (LA_CH_VALUE == LPAREN) { 11411 NEXT_LA_CH; 11412 /* determine operator */ 11413 11414 NTR_IR_TBL(opr_ir_idx); 11415 IR_LINE_NUM(opr_ir_idx) = LA_CH_LINE; 11416 IR_COL_NUM(opr_ir_idx) = LA_CH_COLUMN; 11417 IR_TYPE_IDX(opr_ir_idx) = INTEGER_DEFAULT_TYPE; 11418 11419 if (LA_CH_CLASS == Ch_Class_Letter) { 11420 11421 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 11422 11423 if (TOKEN_STR(token)[0] == 'M') { 11424 if (strcmp(TOKEN_STR(token), "MAX") == 0) { 11425 IR_OPR(opr_ir_idx) = Max_Opr; 11426 } 11427 else if (strcmp(TOKEN_STR(token), "MIN") == 0) { 11428 IR_OPR(opr_ir_idx) = Min_Opr; 11429 } 11430 else { 11431 parse_err_flush(Find_EOS, 11432 "MAX, MIN, IAND, IOR, IEOR"); 11433 goto EXIT; 11434 } 11435 } 11436 else if (TOKEN_STR(token)[0] == 'I') { 11437 if (strcmp(TOKEN_STR(token), "IAND") == 0) { 11438 IR_OPR(opr_ir_idx) = Band_Opr; 11439 } 11440 else if (strcmp(TOKEN_STR(token), "IOR") == 0) { 11441 IR_OPR(opr_ir_idx) = Bor_Opr; 11442 } 11443 else if (strcmp(TOKEN_STR(token), "IEOR") == 0) { 11444 IR_OPR(opr_ir_idx) = Bneqv_Opr; 11445 } 11446 else { 11447 parse_err_flush(Find_EOS, 11448 "MAX, MIN, IAND, IOR, IEOR"); 11449 goto EXIT; 11450 } 11451 } 11452 else { 11453 parse_err_flush(Find_EOS, 11454 "MAX, MIN, IAND, IOR, IEOR"); 11455 goto EXIT; 11456 } 11457 } 11458 else { 11459 parse_err_flush(Find_EOS, 11460 "MAX, MIN, IAND, IOR, IEOR"); 11461 goto EXIT; 11462 } 11463 } 11464 else if (MATCHED_TOKEN_CLASS(Tok_Class_Op)) { 11465 switch (TOKEN_VALUE(token)) { 11466 case Tok_Op_Add: 11467 IR_OPR(opr_ir_idx) = Plus_Opr; 11468 break; 11469 11470 case Tok_Op_Sub: 11471 IR_OPR(opr_ir_idx) = Minus_Opr; 11472 break; 11473 11474 case Tok_Op_Mult: 11475 IR_OPR(opr_ir_idx) = Mult_Opr; 11476 break; 11477 11478 case Tok_Op_And: 11479 IR_OPR(opr_ir_idx) = And_Opr; 11480 break; 11481 11482 case Tok_Op_Or: 11483 IR_OPR(opr_ir_idx) = Or_Opr; 11484 break; 11485 11486 case Tok_Op_Eqv: 11487 IR_OPR(opr_ir_idx) = Eqv_Opr; 11488 break; 11489 11490 case Tok_Op_Neqv: 11491 IR_OPR(opr_ir_idx) = Neqv_Opr; 11492 break; 11493 11494 default: 11495 parse_err_flush(Find_EOS, 11496 "+, *, -, .AND., .OR., .EQV., or .NEQV."); 11497 goto EXIT; 11498 } 11499 } 11500 else { 11501 parse_err_flush(Find_EOS, "operator or intrinsic"); 11502 goto EXIT; 11503 } 11504 11505 if (IL_IDX(list_array[OPEN_MP_REDUCTION_OPR_IDX]) == 11506 NULL_IDX) { 11507 NTR_IR_LIST_TBL(list_idx); 11508 IL_FLD(list_array[OPEN_MP_REDUCTION_OPR_IDX]) = 11509 IL_Tbl_Idx; 11510 IL_IDX(list_array[OPEN_MP_REDUCTION_OPR_IDX]) = 11511 list_idx; 11512 IL_LIST_CNT(list_array[OPEN_MP_REDUCTION_OPR_IDX]) = 1; 11513 11514 } 11515 else { 11516 /* find the end of list */ 11517 11518 list_idx = IL_IDX(list_array[OPEN_MP_REDUCTION_OPR_IDX]); 11519 while (IL_NEXT_LIST_IDX(list_idx)) { 11520 list_idx = IL_NEXT_LIST_IDX(list_idx); 11521 } 11522 11523 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 11524 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 11525 list_idx = IL_NEXT_LIST_IDX(list_idx); 11526 IL_LIST_CNT(list_array[OPEN_MP_REDUCTION_OPR_IDX]) += 1; 11527 } 11528 11529 IL_FLD(list_idx) = IR_Tbl_Idx; 11530 IL_IDX(list_idx) = opr_ir_idx; 11531 11532 if (LA_CH_VALUE == COLON) { 11533 NEXT_LA_CH; 11534 } 11535 else { 11536 parse_err_flush(Find_EOS, ":"); 11537 goto EXIT; 11538 } 11539 11540 /* parse var list */ 11541 parse_var_name_list(&opnd, -1); 11542 11543 if (IL_IDX(list_array[OPEN_MP_REDUCTION_LIST_IDX]) == 11544 NULL_IDX) { 11545 NTR_IR_LIST_TBL(list_idx); 11546 IL_FLD(list_array[OPEN_MP_REDUCTION_LIST_IDX]) = 11547 IL_Tbl_Idx; 11548 IL_IDX(list_array[OPEN_MP_REDUCTION_LIST_IDX]) = 11549 list_idx; 11550 IL_LIST_CNT(list_array[OPEN_MP_REDUCTION_LIST_IDX]) = 1; 11551 11552 } 11553 else { 11554 /* find the end of list */ 11555 11556 list_idx = IL_IDX(list_array[OPEN_MP_REDUCTION_LIST_IDX]); 11557 while (IL_NEXT_LIST_IDX(list_idx)) { 11558 list_idx = IL_NEXT_LIST_IDX(list_idx); 11559 } 11560 11561 NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx)); 11562 IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx; 11563 list_idx = IL_NEXT_LIST_IDX(list_idx); 11564 IL_LIST_CNT(list_array[OPEN_MP_REDUCTION_LIST_IDX]) += 1; 11565 } 11566 11567 COPY_OPND(IL_OPND(list_idx), opnd); 11568 11569 if (LA_CH_VALUE == RPAREN) { 11570 NEXT_LA_CH; 11571 } 11572 else { 11573 parse_err_flush(Find_EOS, ")"); 11574 goto EXIT; 11575 } 11576 } 11577 else { 11578 parse_err_flush(Find_EOS, "("); 11579 goto EXIT; 11580 } 11581 11582 break; 11583 11584 case Tok_Open_Mp_Dir_Lastprivate: 11585 11586 if (! open_mp_clause_allowed[directive][Lastprivate_Omp_Clause]){ 11587 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 11588 "LASTPRIVATE", open_mp_dir_str[directive]); 11589 parse_err_flush(Find_EOS, NULL); 11590 goto EXIT; 11591 } 11592 11593 if (LA_CH_VALUE == LPAREN) { 11594 NEXT_LA_CH; 11595 parse_var_common_list(&opnd, FALSE); 11596 11597 if (IL_IDX(list_array[OPEN_MP_LASTPRIVATE_IDX]) == NULL_IDX) { 11598 COPY_OPND(IL_OPND(list_array[OPEN_MP_LASTPRIVATE_IDX]), 11599 opnd); 11600 } 11601 else { 11602 /* find the end of list */ 11603 11604 list_idx = IL_IDX(list_array[OPEN_MP_LASTPRIVATE_IDX]); 11605 while (IL_NEXT_LIST_IDX(list_idx)) { 11606 list_idx = IL_NEXT_LIST_IDX(list_idx); 11607 } 11608 11609 /* append the new list */ 11610 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 11611 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 11612 IL_LIST_CNT(list_array[OPEN_MP_LASTPRIVATE_IDX]) += 11613 OPND_LIST_CNT(opnd); 11614 } 11615 11616 if (LA_CH_VALUE == RPAREN) { 11617 NEXT_LA_CH; 11618 } 11619 else { 11620 parse_err_flush(Find_EOS, ")"); 11621 goto EXIT; 11622 } 11623 } 11624 else { 11625 parse_err_flush(Find_EOS, "("); 11626 goto EXIT; 11627 } 11628 11629 break; 11630 11631 case Tok_Open_Mp_Dir_Ordered: 11632 11633 if (! open_mp_clause_allowed[directive][Ordered_Omp_Clause]) { 11634 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 11635 "ORDERED", open_mp_dir_str[directive]); 11636 parse_err_flush(Find_EOS, NULL); 11637 goto EXIT; 11638 } 11639 11640 /* only one ORDERED clause allowed */ 11641 11642 if (IL_IDX(list_array[OPEN_MP_ORDERED_IDX]) != NULL_IDX) { 11643 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 11644 "ORDERED", open_mp_dir_str[directive]); 11645 parse_err_flush(Find_EOS, NULL); 11646 goto EXIT; 11647 } 11648 11649 IL_LINE_NUM(list_array[OPEN_MP_ORDERED_IDX]) = 11650 TOKEN_LINE(token); 11651 IL_COL_NUM(list_array[OPEN_MP_ORDERED_IDX]) = 11652 TOKEN_COLUMN(token); 11653 IL_FLD(list_array[OPEN_MP_ORDERED_IDX]) = CN_Tbl_Idx; 11654 11655 IL_IDX(list_array[OPEN_MP_ORDERED_IDX]) = CN_INTEGER_ONE_IDX; 11656 11657 break; 11658 11659 case Tok_Open_Mp_Dir_Schedule: 11660 11661 if (! open_mp_clause_allowed[directive][Schedule_Omp_Clause]) { 11662 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 11663 "SCHEDULE", open_mp_dir_str[directive]); 11664 parse_err_flush(Find_EOS, NULL); 11665 goto EXIT; 11666 } 11667 11668 /* only one SCHEDULE clause allowed */ 11669 11670 if (IL_IDX(list_array[OPEN_MP_SCHEDULE_TYPE_IDX]) != NULL_IDX) { 11671 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 11672 "SCHEDULE", open_mp_dir_str[directive]); 11673 parse_err_flush(Find_EOS, NULL); 11674 goto EXIT; 11675 } 11676 11677 if (LA_CH_VALUE == LPAREN) { 11678 NEXT_LA_CH; 11679 11680 if (MATCHED_TOKEN_CLASS(Tok_Class_Open_Mp_Dir_Kwd)) { 11681 11682 switch (TOKEN_VALUE(token)) { 11683 case Tok_Open_Mp_Dir_Static: 11684 the_constant = OPEN_MP_SCHEDULE_STATIC; 11685 break; 11686 11687 case Tok_Open_Mp_Dir_Dynamic: 11688 the_constant = OPEN_MP_SCHEDULE_DYNAMIC; 11689 break; 11690 11691 case Tok_Open_Mp_Dir_Guided: 11692 the_constant = OPEN_MP_SCHEDULE_GUIDED; 11693 break; 11694 11695 case Tok_Open_Mp_Dir_Runtime: 11696 the_constant = OPEN_MP_SCHEDULE_RUNTIME; 11697 break; 11698 11699 default: 11700 parse_err_flush(Find_EOS,"SCHEDULE type"); 11701 goto EXIT; 11702 } 11703 11704 IL_FLD(list_array[OPEN_MP_SCHEDULE_TYPE_IDX]) =CN_Tbl_Idx; 11705 IL_IDX(list_array[OPEN_MP_SCHEDULE_TYPE_IDX]) = 11706 C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 11707 the_constant); 11708 11709 IL_LINE_NUM(list_array[OPEN_MP_SCHEDULE_TYPE_IDX]) = 11710 TOKEN_LINE(token); 11711 IL_COL_NUM(list_array[OPEN_MP_SCHEDULE_TYPE_IDX]) = 11712 TOKEN_COLUMN(token); 11713 11714 if (LA_CH_VALUE == COMMA) { 11715 NEXT_LA_CH; 11716 parse_expr(&opnd); 11717 COPY_OPND(IL_OPND(list_array[ 11718 OPEN_MP_SCHEDULE_CHUNK_IDX]), opnd); 11719 } 11720 11721 if (LA_CH_VALUE == RPAREN) { 11722 NEXT_LA_CH; 11723 } 11724 else { 11725 parse_err_flush(Find_EOS, ")"); 11726 goto EXIT; 11727 } 11728 } 11729 else { 11730 parse_err_flush(Find_EOS, "SCHEDULE type"); 11731 goto EXIT; 11732 } 11733 } 11734 else { 11735 parse_err_flush(Find_EOS, "("); 11736 goto EXIT; 11737 } 11738 break; 11739 11740 case Tok_Open_Mp_Dir_Copyprivate: 11741 11742 if (! open_mp_clause_allowed[directive] 11743 [Copyprivate_Omp_Clause]) { 11744 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 11745 "COPYPRIVATE", open_mp_dir_str[directive]); 11746 parse_err_flush(Find_EOS, NULL); 11747 goto EXIT; 11748 } 11749 11750 if (LA_CH_VALUE == LPAREN) { 11751 NEXT_LA_CH; 11752 parse_var_common_list(&opnd, FALSE); 11753 11754 if (IL_IDX(list_array[OPEN_MP_COPYPRIVATE_IDX]) == 11755 NULL_IDX) { 11756 11757 COPY_OPND(IL_OPND(list_array[OPEN_MP_COPYPRIVATE_IDX]), 11758 opnd); 11759 } 11760 else { 11761 /* find the end of list */ 11762 11763 list_idx = IL_IDX(list_array[OPEN_MP_COPYPRIVATE_IDX]); 11764 while (IL_NEXT_LIST_IDX(list_idx)) { 11765 list_idx = IL_NEXT_LIST_IDX(list_idx); 11766 } 11767 11768 /* append the new list */ 11769 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 11770 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 11771 IL_LIST_CNT(list_array[OPEN_MP_COPYPRIVATE_IDX]) += 11772 OPND_LIST_CNT(opnd); 11773 } 11774 11775 if (LA_CH_VALUE == RPAREN) { 11776 NEXT_LA_CH; 11777 } 11778 else { 11779 parse_err_flush(Find_EOS, ")"); 11780 goto EXIT; 11781 } 11782 } 11783 else { 11784 parse_err_flush(Find_EOS, "("); 11785 goto EXIT; 11786 } 11787 11788 break; 11789 11790 # if defined(GENERATE_WHIRL) 11791 case Tok_Open_Mp_Dir_Affinity: 11792 11793 if (! open_mp_clause_allowed[directive][Affinity_Omp_Clause]) { 11794 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 11795 "AFFINITY", open_mp_dir_str[directive]); 11796 parse_err_flush(Find_EOS, NULL); 11797 goto EXIT; 11798 } 11799 11800 if (IL_IDX(list_array[OPEN_MP_AFFINITY_IDX]) != NULL_IDX) { 11801 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 11802 "AFFINITY", open_mp_dir_str[directive]); 11803 parse_err_flush(Find_EOS, NULL); 11804 goto EXIT; 11805 } 11806 11807 if (! omp_extension_prefix(TOKEN_LINE(token))) { 11808 /* token not on !$sgi line */ 11809 PRINTMSG(TOKEN_LINE(token), 1518, Warning, 11810 TOKEN_COLUMN(token), 11811 "AFFINITY clause", "!$SGI"); 11812 } 11813 11814 if (LA_CH_VALUE == LPAREN) { 11815 NEXT_LA_CH; 11816 parse_var_name_list(&opnd, -1); 11817 11818 COPY_OPND(IL_OPND(list_array[OPEN_MP_AFFINITY_IDX]), opnd); 11819 11820 if (LA_CH_VALUE == RPAREN) { 11821 NEXT_LA_CH; 11822 } 11823 else { 11824 parse_err_flush(Find_EOS, ")"); 11825 goto EXIT; 11826 } 11827 } 11828 else { 11829 parse_err_flush(Find_EOS, "("); 11830 goto EXIT; 11831 } 11832 11833 if (LA_CH_VALUE == EQUAL) { 11834 11835 NEXT_LA_CH; 11836 11837 if (MATCHED_TOKEN_CLASS(Tok_Class_Open_Mp_Dir_Kwd)) { 11838 11839 IL_FLD(list_array[OPEN_MP_IS_THREAD_IDX]) = CN_Tbl_Idx; 11840 IL_LINE_NUM(list_array[OPEN_MP_IS_THREAD_IDX]) = 11841 TOKEN_LINE(token); 11842 IL_COL_NUM(list_array[OPEN_MP_IS_THREAD_IDX]) = 11843 TOKEN_COLUMN(token); 11844 11845 switch (TOKEN_VALUE(token)) { 11846 case Tok_Open_Mp_Dir_Data: 11847 IL_IDX(list_array[OPEN_MP_IS_THREAD_IDX]) = 11848 CN_INTEGER_ZERO_IDX; 11849 break; 11850 case Tok_Open_Mp_Dir_Thread: 11851 IL_IDX(list_array[OPEN_MP_IS_THREAD_IDX]) = 11852 CN_INTEGER_ONE_IDX; 11853 11854 break; 11855 11856 default: 11857 parse_err_flush(Find_EOS, "DATA or THREAD"); 11858 break; 11859 } 11860 11861 if (LA_CH_VALUE == LPAREN) { 11862 11863 NEXT_LA_CH; 11864 11865 parse_expr(&opnd); 11866 11867 COPY_OPND(IL_OPND(list_array[ 11868 OPEN_MP_THREAD_DATA_IDX]), opnd); 11869 11870 if (LA_CH_VALUE == RPAREN) { 11871 NEXT_LA_CH; 11872 } 11873 else { 11874 parse_err_flush(Find_EOS, ")"); 11875 goto EXIT; 11876 } 11877 } 11878 else { 11879 parse_err_flush(Find_EOS, "("); 11880 goto EXIT; 11881 } 11882 } 11883 else { 11884 parse_err_flush(Find_EOS, "DATA or THREAD"); 11885 } 11886 11887 } 11888 else { 11889 parse_err_flush(Find_EOS, "="); 11890 goto EXIT; 11891 } 11892 11893 if (! dump_flags.dsm) { 11894 opnd = null_opnd; 11895 11896 COPY_OPND(IL_OPND(list_array[OPEN_MP_AFFINITY_IDX]), 11897 opnd); 11898 COPY_OPND(IL_OPND(list_array[OPEN_MP_THREAD_DATA_IDX]), 11899 opnd); 11900 COPY_OPND(IL_OPND(list_array[OPEN_MP_IS_THREAD_IDX]), 11901 opnd); 11902 } 11903 break; 11904 11905 case Tok_Open_Mp_Dir_Onto: 11906 if (! open_mp_clause_allowed[directive][Onto_Omp_Clause]) { 11907 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 11908 "ONTO", open_mp_dir_str[directive]); 11909 parse_err_flush(Find_EOS, NULL); 11910 goto EXIT; 11911 } 11912 11913 11914 if (! omp_extension_prefix(TOKEN_LINE(token))) { 11915 /* token not on !$sgi line */ 11916 PRINTMSG(TOKEN_LINE(token), 1518, Warning, 11917 TOKEN_COLUMN(token), 11918 "ONTO clause", "!$SGI"); 11919 } 11920 11921 if (seen_nest) { 11922 11923 if (IL_IDX(list_array[OPEN_MP_ONTO_IDX]) != NULL_IDX) { 11924 PRINTMSG(TOKEN_LINE(token), 1360, Error, 11925 TOKEN_COLUMN(token), 11926 "ONTO", open_mp_dir_str[directive]); 11927 parse_err_flush(Find_EOS, NULL); 11928 goto EXIT; 11929 } 11930 11931 if (LA_CH_VALUE == LPAREN) { 11932 NEXT_LA_CH; 11933 parse_int_or_star_list(&opnd); 11934 11935 COPY_OPND(IL_OPND(list_array[OPEN_MP_ONTO_IDX]), opnd); 11936 11937 if (LA_CH_VALUE == RPAREN) { 11938 NEXT_LA_CH; 11939 } 11940 else { 11941 parse_err_flush(Find_EOS, ")"); 11942 goto EXIT; 11943 } 11944 } 11945 else { 11946 parse_err_flush(Find_EOS, "("); 11947 goto EXIT; 11948 } 11949 11950 list_idx = list_array[OPEN_MP_ONTO_IDX]; 11951 11952 list2_idx = list_array[OPEN_MP_NEST_IDX]; 11953 11954 if (IL_FLD(list2_idx) != IL_Tbl_Idx || 11955 IL_LIST_CNT(list2_idx) != IL_LIST_CNT(list_idx)) { 11956 11957 /* error, onto count must equal nest count */ 11958 11959 find_opnd_line_and_column(&IL_OPND(IL_IDX(list_idx)), 11960 &line, &column); 11961 11962 PRINTMSG(line, 1369, Error, column); 11963 } 11964 else if (IL_LIST_CNT(list2_idx) == 1) { 11965 /* error, onto count must equal nest count */ 11966 11967 find_opnd_line_and_column(&IL_OPND(IL_IDX(list_idx)), 11968 &line, &column); 11969 11970 PRINTMSG(line, 1377, Error, column); 11971 } 11972 } 11973 else { 11974 PRINTMSG(TOKEN_LINE(token), 1361, Error, TOKEN_COLUMN(token), 11975 open_mp_dir_str[directive]); 11976 parse_err_flush(Find_EOS, NULL); 11977 goto EXIT; 11978 } 11979 break; 11980 11981 case Tok_Open_Mp_Dir_Nest: 11982 11983 if (! open_mp_clause_allowed[directive][Nest_Omp_Clause]) { 11984 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 11985 "NEST", open_mp_dir_str[directive]); 11986 parse_err_flush(Find_EOS, NULL); 11987 goto EXIT; 11988 } 11989 11990 if (seen_nest) { 11991 PRINTMSG(TOKEN_LINE(token), 1360, Error, TOKEN_COLUMN(token), 11992 "NEST", open_mp_dir_str[directive]); 11993 parse_err_flush(Find_EOS, NULL); 11994 goto EXIT; 11995 } 11996 11997 11998 if (! omp_extension_prefix(TOKEN_LINE(token))) { 11999 /* token not on !$sgi line */ 12000 PRINTMSG(TOKEN_LINE(token), 1518, Warning, 12001 TOKEN_COLUMN(token), 12002 "NEST clause", "!$SGI"); 12003 } 12004 12005 seen_nest = TRUE; 12006 12007 if (LA_CH_VALUE == LPAREN) { 12008 NEXT_LA_CH; 12009 parse_var_name_list(&opnd, -1); 12010 12011 COPY_OPND(IL_OPND(list_array[OPEN_MP_NEST_IDX]), opnd); 12012 12013 if (LA_CH_VALUE == RPAREN) { 12014 NEXT_LA_CH; 12015 } 12016 else { 12017 parse_err_flush(Find_EOS, ")"); 12018 goto EXIT; 12019 } 12020 } 12021 else { 12022 parse_err_flush(Find_EOS, "("); 12023 goto EXIT; 12024 } 12025 12026 break; 12027 # endif 12028 12029 /* there is no FLUSH clause in OpenMP ([email protected]) */ 12030 /* we fake this clause in order to treat FLUSH directive the same as the others */ 12031 case Tok_Open_Mp_Dir_Flush: 12032 12033 if (! open_mp_clause_allowed[directive][Flush_Omp_Clause]){ 12034 PRINTMSG(TOKEN_LINE(token), 1370, Error, TOKEN_COLUMN(token), 12035 "FLUSH", open_mp_dir_str[directive]); 12036 parse_err_flush(Find_EOS, NULL); 12037 goto EXIT; 12038 } 12039 12040 if (LA_CH_VALUE == LPAREN) { 12041 NEXT_LA_CH; 12042 parse_var_common_list(&opnd, FALSE); 12043 12044 if (IL_IDX(list_array[OPEN_MP_FLUSH_IDX]) == NULL_IDX) { 12045 COPY_OPND(IL_OPND(list_array[OPEN_MP_FLUSH_IDX]), 12046 opnd); 12047 } 12048 else { 12049 /* find the end of list */ 12050 12051 list_idx = IL_IDX(list_array[OPEN_MP_FLUSH_IDX]); 12052 while (IL_NEXT_LIST_IDX(list_idx)) { 12053 list_idx = IL_NEXT_LIST_IDX(list_idx); 12054 } 12055 12056 /* append the new list */ 12057 IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd); 12058 IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx; 12059 IL_LIST_CNT(list_array[OPEN_MP_FLUSH_IDX]) += 12060 OPND_LIST_CNT(opnd); 12061 } 12062 12063 if (LA_CH_VALUE == RPAREN) { 12064 NEXT_LA_CH; 12065 } 12066 else { 12067 parse_err_flush(Find_EOS, ")"); 12068 goto EXIT; 12069 } 12070 } 12071 else { 12072 parse_err_flush(Find_EOS, "("); 12073 goto EXIT; 12074 } 12075 12076 break; 12077 12078 default: 12079 PRINTMSG(TOKEN_LINE(token), 1517, Error, TOKEN_COLUMN(token), 12080 "OpenMP"); 12081 parse_err_flush(Find_EOS, NULL); 12082 goto EXIT; 12083 } 12084 } 12085 else { 12086 parse_err_flush(Find_EOS, "OpenMP clause"); 12087 } 12088 12089 if (LA_CH_VALUE == COMMA) { 12090 NEXT_LA_CH; 12091 } 12092 } 12093 12094 if (open_mp_clause_allowed[directive][Schedule_Omp_Clause] && 12095 IL_IDX(list_array[OPEN_MP_SCHEDULE_TYPE_IDX]) == NULL_IDX && 12096 OPND_FLD(cdir_switches.mp_schedtype_opnd) != NO_Tbl_Idx) { 12097 12098 COPY_OPND(IL_OPND(list_array[OPEN_MP_SCHEDULE_TYPE_IDX]), 12099 cdir_switches.mp_schedtype_opnd); 12100 } 12101 12102 EXIT: 12103 12104 TRACE (Func_Exit, "parse_open_mp_clauses", NULL); 12105 12106 return; 12107 12108 } /* parse_open_mp_clauses */ 12109 12110 /******************************************************************************\ 12111 |* *| 12112 |* Description: *| 12113 |* Check for nesting of DO, SECTIONS, and SINGLE open mp directives. *| 12114 |* *| 12115 |* Input parameters: *| 12116 |* NONE *| 12117 |* *| 12118 |* Output parameters: *| 12119 |* NONE *| 12120 |* *| 12121 |* Returns: *| 12122 |* NOTHING *| 12123 |* *| 12124 \******************************************************************************/ 12125 12126 static void check_do_open_mp_nesting(void) 12127 12128 { 12129 int blk_idx; 12130 int ir_idx; 12131 12132 TRACE (Func_Entry, "check_do_open_mp_nesting", NULL); 12133 12134 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 12135 12136 blk_idx = blk_stk_idx; 12137 12138 while (blk_idx > 0) { 12139 if (BLK_TYPE(blk_idx) == Open_Mp_Parallel_Blk) { 12140 break; 12141 } 12142 12143 if (BLK_TYPE(blk_idx) == Open_Mp_Do_Blk || 12144 BLK_TYPE(blk_idx) == Open_Mp_Parallel_Do_Blk) { 12145 12146 if (blk_idx < blk_stk_idx && 12147 BLK_TYPE(blk_idx + 1) == Do_Blk && 12148 BLK_DEF_LINE(blk_idx) == BLK_DEF_LINE(blk_idx + 1)) { 12149 12150 PRINTMSG(IR_LINE_NUM(ir_idx), 1474, Error, 12151 IR_COL_NUM(ir_idx)); 12152 break; 12153 } 12154 else { 12155 /* this is a block that should have been closed */ 12156 if (BLK_TYPE(blk_idx) == Open_Mp_Do_Blk) { 12157 CLEAR_DIRECTIVE_STATE(Open_Mp_Do_Region); 12158 } 12159 else { 12160 CLEAR_DIRECTIVE_STATE(Open_Mp_Parallel_Do_Region); 12161 } 12162 move_blk_to_end(blk_idx); 12163 POP_BLK_STK; 12164 } 12165 } 12166 else if (BLK_TYPE(blk_idx) == Open_Mp_Sections_Blk || 12167 BLK_TYPE(blk_idx) == Open_Mp_Single_Blk || 12168 BLK_TYPE(blk_idx) == Open_Mp_Parallel_Sections_Blk) { 12169 12170 PRINTMSG(IR_LINE_NUM(ir_idx), 1474, Error, 12171 IR_COL_NUM(ir_idx)); 12172 break; 12173 } 12174 blk_idx--; 12175 } 12176 12177 TRACE (Func_Exit, "check_do_open_mp_nesting", NULL); 12178 12179 return; 12180 12181 } /* check_do_open_mp_nesting */ 12182 12183 /******************************************************************************\ 12184 |* *| 12185 |* Description: *| 12186 |* <description> *| 12187 |* *| 12188 |* Input parameters: *| 12189 |* NONE *| 12190 |* *| 12191 |* Output parameters: *| 12192 |* NONE *| 12193 |* *| 12194 |* Returns: *| 12195 |* NOTHING *| 12196 |* *| 12197 \******************************************************************************/ 12198 12199 static void check_ordered_open_mp_nesting(void) 12200 12201 { 12202 int blk_idx; 12203 int i; 12204 int ir_idx; 12205 int list_idx; 12206 12207 TRACE (Func_Entry, "check_ordered_open_mp_nesting", NULL); 12208 12209 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 12210 12211 blk_idx = blk_stk_idx; 12212 12213 while (blk_idx > 0) { 12214 if (BLK_TYPE(blk_idx) == Open_Mp_Parallel_Blk || 12215 BLK_TYPE(blk_idx) == Open_Mp_Parallel_Sections_Blk) { 12216 12217 /* did not bind to a DO or PARALLEL DO */ 12218 PRINTMSG(IR_LINE_NUM(ir_idx), 1506, Error, 12219 IR_COL_NUM(ir_idx)); 12220 break; 12221 } 12222 12223 if (BLK_TYPE(blk_idx) == Open_Mp_Do_Blk || 12224 BLK_TYPE(blk_idx) == Open_Mp_Parallel_Do_Blk) { 12225 12226 /* check if ORDERED is specified. */ 12227 12228 list_idx = IR_IDX_L(SH_IR_IDX(BLK_FIRST_SH_IDX(blk_idx))); 12229 12230 for (i = 0; i < OPEN_MP_ORDERED_IDX; i++) { 12231 list_idx = IL_NEXT_LIST_IDX(list_idx); 12232 } 12233 12234 if (IL_FLD(list_idx) == NO_Tbl_Idx) { 12235 PRINTMSG(IR_LINE_NUM(ir_idx), 1507, Error, 12236 IR_COL_NUM(ir_idx)); 12237 } 12238 12239 break; 12240 } 12241 blk_idx--; 12242 } 12243 12244 TRACE (Func_Exit, "check_ordered_open_mp_nesting", NULL); 12245 12246 return; 12247 12248 } /* check_ordered_open_mp_nesting */ 12249 12250 /******************************************************************************\ 12251 |* *| 12252 |* Description: *| 12253 |* <description> *| 12254 |* *| 12255 |* Input parameters: *| 12256 |* NONE *| 12257 |* *| 12258 |* Output parameters: *| 12259 |* NONE *| 12260 |* *| 12261 |* Returns: *| 12262 |* NOTHING *| 12263 |* *| 12264 \******************************************************************************/ 12265 12266 static boolean check_section_open_mp_context(void) 12267 12268 { 12269 int blk_idx; 12270 int ir_idx; 12271 boolean ok = TRUE; 12272 12273 TRACE (Func_Entry, "check_section_open_mp_context", NULL); 12274 12275 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); 12276 12277 blk_idx = blk_stk_idx; 12278 12279 while (blk_idx > 0) { 12280 if (BLK_TYPE(blk_idx) == Open_Mp_Sections_Blk || 12281 BLK_TYPE(blk_idx) == Open_Mp_Parallel_Sections_Blk) { 12282 12283 goto FOUND; 12284 } 12285 blk_idx--; 12286 } 12287 12288 PRINTMSG(IR_LINE_NUM(ir_idx), 1412, Error, IR_COL_NUM(ir_idx), 12289 "C$OMP SECTION", 12290 "C$OMP PARALLEL SECTIONS region, or C$OMP SECTIONS region"); 12291 12292 ok = FALSE; 12293 12294 FOUND: 12295 12296 TRACE (Func_Exit, "check_section_open_mp_context", NULL); 12297 12298 return(ok); 12299 12300 } /* check_section_open_mp_context */ 12301 12302 /******************************************************************************\ 12303 |* *| 12304 |* Description: *| 12305 |* <description> *| 12306 |* *| 12307 |* Input parameters: *| 12308 |* NONE *| 12309 |* *| 12310 |* Output parameters: *| 12311 |* NONE *| 12312 |* *| 12313 |* Returns: *| 12314 |* NOTHING *| 12315 |* *| 12316 |* eraxxon: OpenAD directive *| 12317 |* *| 12318 \******************************************************************************/ 12319 12320 static void parse_openad_directives(void) 12321 12322 { 12323 int ir_idx; 12324 int list_idx; 12325 opnd_type opnd; 12326 int sh_idx; 12327 int type_idx; 12328 token_values_type tokval = TOKEN_VALUE(token); 12329 12330 TRACE (Func_Entry, "parse_openad_directives", NULL); 12331 12332 if (tokval > Tok_OpenAD_Dir_Start && tokval < Tok_OpenAD_Dir_End && 12333 disregard_openad[tokval - Tok_OpenAD_Dir_Start]) { 12334 parse_err_flush(Find_EOS, NULL); 12335 goto EXIT; 12336 } 12337 12338 switch (tokval) { 12339 case Tok_OpenAD_Dir_XXX: { 12340 char* str = NULL; 12341 12342 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 12343 ir_idx = gen_directive_ir(XXX_OpenAD_Opr); 12344 12345 if ( (str = get_openad_dir_xxx_string()) ) { 12346 12347 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX); 12348 TYP_TYPE(TYP_WORK_IDX) = Character; 12349 TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE; 12350 TYP_DESC(TYP_WORK_IDX) = Default_Typed; 12351 TYP_CHAR_CLASS(TYP_WORK_IDX)= Const_Len_Char; 12352 TYP_FLD(TYP_WORK_IDX) = CN_Tbl_Idx; 12353 TYP_IDX(TYP_WORK_IDX) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 12354 (strlen(str)+1)); 12355 type_idx = ntr_type_tbl(); 12356 12357 IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token); 12358 IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token); 12359 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 12360 IR_IDX_L(ir_idx) = ntr_const_tbl(type_idx, TRUE, NULL); 12361 12362 strcpy((char *)&CN_CONST(IR_IDX_L(ir_idx)), str); 12363 12364 free(str); 12365 str = NULL; 12366 } 12367 else { 12368 parse_err_flush(Find_EOS, "XXX STRING"); 12369 } 12370 12371 if (directive_region_error(XXX_OpenAD_Dir, 12372 IR_LINE_NUM(ir_idx), 12373 IR_COL_NUM(ir_idx))) { 12374 break; 12375 } 12376 break; 12377 } 12378 12379 case Tok_OpenAD_Dir_Dependent: 12380 case Tok_OpenAD_Dir_Independent: { 12381 directive_stmt_type dty = Dependent_OpenAD_Dir; 12382 operator_type op = Dependent_OpenAD_Opr; 12383 if (tokval == Tok_OpenAD_Dir_Independent) { 12384 dty = Independent_OpenAD_Dir; 12385 op = Independent_OpenAD_Opr; 12386 } 12387 12388 ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; 12389 ir_idx = gen_directive_ir(op); 12390 12391 parse_openad_varlist(tokval); 12392 12393 if (directive_region_error(dty, 12394 IR_LINE_NUM(ir_idx), 12395 IR_COL_NUM(ir_idx))) { 12396 break; 12397 } 12398 break; 12399 } 12400 12401 /* case Tok_OpenAD_Dir_Simple: OPENAD_FIXME */ 12402 /* case Tok_OpenAD_Dir_EndSimple: OPENAD_FIXME */ 12403 /* cf. Tok_Open_Mp_Dir_Do */ 12404 12405 default: 12406 PRINTMSG(TOKEN_LINE(token), 790, Warning, TOKEN_COLUMN(token)); 12407 parse_err_flush(Find_EOS, NULL); 12408 break; 12409 } 12410 12411 if (LA_CH_VALUE != EOS) { 12412 parse_err_flush(Find_EOS, EOS_STR); 12413 } 12414 12415 EXIT: 12416 12417 NEXT_LA_CH; 12418 12419 TRACE (Func_Exit, "parse_openad_directives", NULL); 12420 12421 return; 12422 12423 } /* parse_openad_directives */ 12424 12425 /******************************************************************************\ 12426 |* *| 12427 |* Description: *| 12428 |* This routine parses the string attached to an OpenAD XXX directive *| 12429 |* and returns a malloc'd copy or NULL on error. It does not change *| 12430 |* 'token'. *| 12431 |* *| 12432 |* Input parameters: *| 12433 |* NONE *| 12434 |* *| 12435 |* Output parameters: *| 12436 |* NONE *| 12437 |* *| 12438 |* Returns: *| 12439 |* NOTHING *| 12440 |* *| 12441 |* eraxxon: OpenAD directive *| 12442 |* *| 12443 \******************************************************************************/ 12444 12445 static char* get_openad_dir_xxx_string(void) 12446 12447 { 12448 char* str = NULL; 12449 int strLen = 132; /* length of string, not including terminator */ 12450 int i = -1; /* last index in string (before terminator) */ 12451 12452 int paren_lvl = 0; 12453 12454 str = (char*)malloc( (strLen + 1) * sizeof(char*) ); 12455 12456 /* The look-ahead points to a non-black character. Grab everything 12457 between it and and EOS as a literal */ 12458 while (LA_CH_VALUE != EOS) { 12459 i++; 12460 if (i > strLen) { 12461 strLen *= 2; 12462 str = (char*)realloc(str, (strLen + 1) * sizeof(char*) ); 12463 } 12464 str[i] = LA_CH_VALUE; 12465 NEXT_LA_CH_LITERAL; 12466 } 12467 str[i+1] = '\0'; 12468 12469 /* throw away any trailing blanks on the end of the string */ 12470 while (i >= 0 && str[i] == BLANK) { 12471 i--; 12472 } 12473 str[i+1] = '\0'; 12474 12475 return str; 12476 } 12477 12478 /******************************************************************************\ 12479 |* *| 12480 |* Description: *| 12481 |* This routine parses the openad var-list and attaches it to the *| 12482 |* left child of the current statement handle. *| 12483 |* *| 12484 |* Input parameters: *| 12485 |* NONE *| 12486 |* *| 12487 |* Output parameters: *| 12488 |* NONE *| 12489 |* *| 12490 |* Returns: *| 12491 |* NOTHING *| 12492 |* *| 12493 |* eraxxon: OpenAD directive *| 12494 |* *| 12495 \******************************************************************************/ 12496 12497 static void parse_openad_varlist(token_values_type tok) 12498 12499 { 12500 int i; 12501 int ir_idx; 12502 opnd_type opnd; 12503 12504 TRACE (Func_Entry, "parse_openad_varlist", NULL); 12505 12506 ir_idx = SH_IR_IDX(curr_stmt_sh_idx); /* directive stmt handle */ 12507 12508 if (LA_CH_VALUE == LPAREN) { 12509 NEXT_LA_CH; 12510 parse_var_name_list(&opnd, 1); 12511 12512 COPY_OPND(IR_OPND_L(ir_idx), opnd); /* set left hand child */ 12513 12514 if (LA_CH_VALUE == RPAREN) { 12515 NEXT_LA_CH; 12516 } 12517 else { 12518 parse_err_flush(Find_EOS, ")"); 12519 goto EXIT; 12520 } 12521 } 12522 else { 12523 parse_err_flush(Find_EOS, "("); 12524 goto EXIT; 12525 } 12526 12527 if (LA_CH_VALUE != EOS) { 12528 parse_err_flush(Find_EOS, "("); 12529 goto EXIT; 12530 } 12531 12532 12533 EXIT: 12534 TRACE (Func_Exit, "parse_openad_varlist", NULL); 12535 12536 return; 12537 12538 } /* parse_open_mp_clauses */ 12539 12540 /******************************************************************************\ 12541 |* *| 12542 |* Description: *| 12543 |* This routine parses the !DIR$ CACHE_NOALLOCATE *| 12544 |* *| 12545 |* Input parameters: *| 12546 |* NONE *| 12547 |* *| 12548 |* Output parameters: *| 12549 |* NONE *| 12550 |* *| 12551 |* Returns: *| 12552 |* NOTHING *| 12553 |* *| 12554 \******************************************************************************/ 12555 static void parse_cache_noalloc(void) 12556 12557 { 12558 int attr_idx; 12559 int name_idx; 12560 12561 12562 TRACE (Func_Entry, "parse_cache_noalloc", NULL); 12563 12564 do { 12565 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) { 12566 attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token), 12567 &name_idx); 12568 12569 if (attr_idx == NULL_IDX) { 12570 attr_idx = ntr_sym_tbl(&token, name_idx); 12571 LN_DEF_LOC(name_idx) = TRUE; 12572 AT_OBJ_CLASS(attr_idx) = Data_Obj; 12573 ATD_CACHE_NOALLOC(attr_idx) = TRUE; 12574 } 12575 else if (!fnd_semantic_err(Obj_No_Side_Effects, 12576 TOKEN_LINE(token), 12577 TOKEN_COLUMN(token), 12578 attr_idx, 12579 TRUE)) { 12580 12581 if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) { 12582 AT_ATTR_LINK(attr_idx) = NULL_IDX; 12583 LN_DEF_LOC(name_idx) = TRUE; 12584 } 12585 12586 } 12587 } 12588 else if (!parse_err_flush(Find_Comma, "procedure name")) { 12589 break; /* Couldn't recover. Hit EOS */ 12590 } 12591 12592 if (LA_CH_VALUE == COMMA) { 12593 NEXT_LA_CH; 12594 } 12595 else if (LA_CH_VALUE == EOS || 12596 !parse_err_flush(Find_Comma, ", or "EOS_STR)) { 12597 break; 12598 } 12599 else { /* Issued error and recovered at a comma */ 12600 NEXT_LA_CH; 12601 } 12602 } 12603 while (TRUE); 12604 12605 NEXT_LA_CH; /* Pick up EOS */ 12606 12607 TRACE (Func_Exit, "parse_cache_noalloc", NULL); 12608 12609 return; 12610 12611 } /* parse_cache_noalloc */ 12612 12613 12614 /******************************************************************************\ 12615 |* *| 12616 |* Description: *| 12617 |* This routine parses directives that are common to !DIR$ and !*$* *| 12618 |* *| 12619 |* Input parameters: *| 12620 |* NONE *| 12621 |* *| 12622 |* Output parameters: *| 12623 |* NONE *| 12624 |* *| 12625 |* Returns: *| 12626 |* NOTHING *| 12627 |* *| 12628 \******************************************************************************/ 12629 static void parse_star_dir_directives(void) 12630 12631 { 12632 int blk_idx; 12633 int ir_idx; 12634 opnd_type opnd; 12635 int save_line_num; 12636 int save_column_num; 12637 12638 12639 TRACE (Func_Exit, "parse_star_dir_directives", NULL); 12640 12641 switch (TOKEN_VALUE(token)) { 12642 case Tok_SGI_Dir_Blockingsize: 12643 case Tok_Dir_Blockingsize: 12644 12645 ir_idx = gen_directive_ir(Blockingsize_Dir_Opr); 12646 12647 if (LA_CH_VALUE == LPAREN) { 12648 NEXT_LA_CH; 12649 12650 if (LA_CH_VALUE != COMMA) { 12651 parse_expr(&opnd); 12652 COPY_OPND(IR_OPND_L(ir_idx), opnd); 12653 } 12654 else { 12655 IR_FLD_L(ir_idx) = CN_Tbl_Idx; 12656 IR_IDX_L(ir_idx) = CN_INTEGER_NEG_ONE_IDX; 12657 IR_LINE_NUM_L(ir_idx) = LA_CH_LINE; 12658 IR_COL_NUM_L(ir_idx) = LA_CH_COLUMN; 12659 } 12660 12661 if (LA_CH_VALUE == COMMA) { 12662 NEXT_LA_CH; 12663 12664 parse_expr(&opnd); 12665 COPY_OPND(IR_OPND_R(ir_idx), opnd); 12666 } 12667 else { 12668 IR_FLD_R(ir_idx) = CN_Tbl_Idx; 12669 IR_IDX_R(ir_idx) = CN_INTEGER_NEG_ONE_IDX; 12670 IR_LINE_NUM_R(ir_idx) = LA_CH_LINE; 12671 IR_COL_NUM_R(ir_idx) = LA_CH_COLUMN; 12672 } 12673 12674 if (LA_CH_VALUE == RPAREN) { 12675 NEXT_LA_CH; 12676 } 12677 else { 12678 parse_err_flush(Find_EOS, ")"); 12679 goto EXIT; 12680 } 12681 } 12682 else { 12683 parse_err_flush(Find_EOS, "("); 12684 goto EXIT; 12685 } 12686 break; 12687 12688 12689 case Tok_SGI_Dir_Blockable: 12690 case Tok_Dir_Blockable: 12691 12692 if (LA_CH_VALUE == LPAREN) { 12693 save_line_num = LA_CH_LINE; 12694 save_column_num = LA_CH_COLUMN; 12695 12696 NEXT_LA_CH; 12697 12698 if (parse_var_name_list(&opnd, -1)) { 12699 12700 if (LA_CH_VALUE == RPAREN) { 12701 12702 if (OPND_LIST_CNT(opnd) > 1) { 12703 12704 /* Check to see if the another (preceding) BLOCKABLE */ 12705 /* directive was already specified for the following (or */ 12706 /* current) loop nest. That is, if blockable_sh_idx is */ 12707 /* null, there could still be an BLOCKABLE directive on a */ 12708 /* containing loop so we have to look back through the Block*/ 12709 /* Stack to find out if this is true or not. If */ 12710 /* blockable_sh_idx is *not* null, it must mean we haven't */ 12711 /* encountered the outer DO yet; just another directive. */ 12712 12713 if (cdir_switches.blockable_sh_idx == NULL_IDX) { 12714 12715 for (blk_idx = blk_stk_idx; blk_idx > 1; --blk_idx) { 12716 12717 if (BLK_TYPE(blk_idx) == Do_Blk) { 12718 break; 12719 } 12720 } 12721 12722 if (blk_idx > 1 && 12723 SH_STMT_TYPE(BLK_FIRST_SH_IDX(blk_idx)) == 12724 Do_Iterative_Stmt && 12725 BLK_BLOCKABLE_NUM_LCVS(blk_idx) > 1) { 12726 12727 for ( ; blk_idx > 1; --blk_idx) { 12728 12729 if (BLK_BLOCKABLE_DIR_SH_IDX(blk_idx) != NULL_IDX) { 12730 PRINTMSG(stmt_start_line, 1387, Error, 0, 12731 "BLOCKABLE"); 12732 SH_ERR_FLG(BLK_BLOCKABLE_DIR_SH_IDX(blk_idx)) = 12733 TRUE; 12734 break; 12735 } 12736 } 12737 } 12738 else { 12739 ir_idx = gen_directive_ir(Blockable_Dir_Opr); 12740 COPY_OPND(IR_OPND_L(ir_idx), opnd); 12741 cdir_switches.blockable_sh_idx = curr_stmt_sh_idx; 12742 cdir_switches.blockable_group++; 12743 } 12744 } 12745 else { 12746 PRINTMSG(stmt_start_line, 1387, Error, 0, "BLOCKABLE"); 12747 SH_ERR_FLG(cdir_switches.blockable_sh_idx) = TRUE; 12748 } 12749 } 12750 else { 12751 PRINTMSG(save_line_num, 1375, Error, save_column_num); 12752 } 12753 } 12754 } 12755 else { 12756 parse_err_flush(Find_EOS, NULL); 12757 goto EXIT; 12758 } 12759 12760 if (LA_CH_VALUE == RPAREN) { 12761 NEXT_LA_CH; 12762 } 12763 else { 12764 parse_err_flush(Find_EOS, ", or )"); 12765 goto EXIT; 12766 } 12767 } 12768 else { 12769 parse_err_flush(Find_EOS, "("); 12770 goto EXIT; 12771 } 12772 break; 12773 12774 case Tok_SGI_Dir_Interchange: 12775 case Tok_Dir_Interchange: 12776 12777 if (LA_CH_VALUE == LPAREN) { 12778 save_line_num = LA_CH_LINE; 12779 save_column_num = LA_CH_COLUMN; 12780 12781 NEXT_LA_CH; 12782 12783 if (parse_var_name_list(&opnd, -1)) { 12784 12785 if (LA_CH_VALUE == RPAREN) { 12786 12787 if (OPND_LIST_CNT(opnd) > 1) { 12788 12789 /* Check to see if the another (preceding) INTERCHANGE */ 12790 /* directive was already specified for the following (or */ 12791 /* current) loop nest. That is, if interchange_sh_idx is */ 12792 /* null, there could still be an INTERCHANGE directive on a */ 12793 /* containing loop so we have to look back through the Block*/ 12794 /* stack to find out if this is true or not. If */ 12795 /* interchange_sh_idx is *not* null, it must mean we haven't*/ 12796 /* encountered the outer DO yet; just another directive. */ 12797 12798 if (cdir_switches.interchange_sh_idx == NULL_IDX) { 12799 12800 for (blk_idx = blk_stk_idx; blk_idx > 1; --blk_idx) { 12801 12802 if (BLK_TYPE(blk_idx) == Do_Blk) { 12803 break; 12804 } 12805 } 12806 12807 if (blk_idx > 1 && 12808 SH_STMT_TYPE(BLK_FIRST_SH_IDX(blk_idx)) == 12809 Do_Iterative_Stmt && 12810 BLK_INTERCHANGE_NUM_LCVS(blk_idx) > 1) { 12811 12812 for ( ; blk_idx > 1; --blk_idx) { 12813 12814 if (BLK_INTERCHANGE_DIR_SH_IDX(blk_idx) != 12815 NULL_IDX) { 12816 PRINTMSG(stmt_start_line, 1387, Error, 0, 12817 "INTERCHANGE"); 12818 SH_ERR_FLG(BLK_INTERCHANGE_DIR_SH_IDX(blk_idx)) = 12819 TRUE; 12820 break; 12821 } 12822 } 12823 } 12824 else { 12825 ir_idx = gen_directive_ir(Interchange_Dir_Opr); 12826 COPY_OPND(IR_OPND_L(ir_idx), opnd); 12827 cdir_switches.interchange_sh_idx = curr_stmt_sh_idx; 12828 cdir_switches.interchange_group++; 12829 } 12830 } 12831 else { 12832 PRINTMSG(stmt_start_line, 1387, Error, 0, "INTERCHANGE"); 12833 SH_ERR_FLG(cdir_switches.interchange_sh_idx) = TRUE; 12834 } 12835 } 12836 else { 12837 PRINTMSG(save_line_num, 1375, Error, save_column_num); 12838 } 12839 } 12840 } 12841 else { 12842 parse_err_flush(Find_EOS, NULL); 12843 goto EXIT; 12844 } 12845 12846 if (LA_CH_VALUE == RPAREN) { 12847 NEXT_LA_CH; 12848 } 12849 else { 12850 parse_err_flush(Find_EOS, ", or )"); 12851 goto EXIT; 12852 } 12853 } 12854 else { 12855 parse_err_flush(Find_EOS, "("); 12856 goto EXIT; 12857 } 12858 } 12859 12860 if (LA_CH_VALUE != EOS) { 12861 PRINTMSG(LA_CH_LINE, 790, Warning, LA_CH_COLUMN); 12862 parse_err_flush(Find_EOS, NULL); 12863 } 12864 12865 NEXT_LA_CH; 12866 12867 EXIT: 12868 12869 TRACE (Func_Exit, "parse_star_dir_directives", NULL); 12870 12871 return; 12872 12873 } /* parse_star_dir_directives */
1.7.6.1 
