00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
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"
00040
00041 # include "host.m"
00042 # include "host.h"
00043 # include "target.m"
00044 # include "target.h"
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
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);
00107 static char* get_openad_dir_xxx_string(void);
00108 static void parse_openad_varlist(token_values_type);
00109 static int update_fld_type(fld_type, int,int);
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
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
00141
00142
00143
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
00153
00154
00155 cdir_switches.do_inline = FALSE;
00156 cdir_switches.noinline = FALSE;
00157
00158
00159
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
00185
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 }
00318
00319
00320
00321
00322
00323
00324
00325
00326
00327
00328
00329
00330
00331
00332
00333
00334 void parse_directive_stmt (void)
00335 {
00336
00337 TRACE (Func_Entry, "parse_directive_stmt", NULL);
00338
00339
00340
00341
00342
00343
00344
00345
00346
00347
00348
00349
00350
00351
00352
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
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
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
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
00452 if (MATCHED_TOKEN_CLASS(Tok_Class_OpenAD_Dir_Kwd)) {
00453 if (cmd_line_flags.disregard_all_openads) {
00454
00455 parse_err_flush(Find_EOS, NULL);
00456 NEXT_LA_CH;
00457 goto EXIT;
00458 }
00459
00460 parse_openad_directives();
00461 }
00462 else {
00463
00464 parse_err_flush(Find_EOS, NULL);
00465 NEXT_LA_CH;
00466 goto EXIT;
00467 }
00468
00469
00470
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
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
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
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') {
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
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 }
00554
00555
00556
00557
00558
00559
00560
00561
00562
00563
00564
00565
00566
00567
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
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 }
00607
00608
00609
00610
00611
00612
00613
00614
00615
00616
00617
00618
00619
00620
00621
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
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;
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 {
00708 NEXT_LA_CH;
00709 }
00710 }
00711 while (TRUE);
00712
00713 NEXT_LA_CH;
00714
00715 TRACE (Func_Exit, "parse_copy_assumed_shape_dir", NULL);
00716
00717 return;
00718
00719 }
00720
00721
00722
00723
00724
00725
00726
00727
00728
00729
00730
00731
00732
00733
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;
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 {
00787 NEXT_LA_CH;
00788 }
00789 }
00790 while (TRUE);
00791
00792 NEXT_LA_CH;
00793
00794 TRACE (Func_Exit, "parse_ignore_tkr", NULL);
00795
00796 return;
00797
00798 }
00799
00800
00801
00802
00803
00804
00805
00806
00807
00808
00809
00810
00811
00812
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;
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 {
00882 NEXT_LA_CH;
00883 }
00884 }
00885 while (TRUE);
00886
00887 NEXT_LA_CH;
00888
00889 TRACE (Func_Exit, "parse_auxiliary_dir", NULL);
00890
00891 return;
00892
00893 }
00894
00895
00896
00897
00898
00899
00900
00901
00902
00903
00904
00905
00906
00907
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;
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 {
00964 NEXT_LA_CH;
00965 }
00966 }
00967 while (TRUE);
00968
00969 NEXT_LA_CH;
00970
00971 TRACE (Func_Exit, "parse_cache_bypass_dir", NULL);
00972
00973 return;
00974
00975 }
00976
00977
00978
00979
00980
00981
00982
00983
00984
00985
00986
00987
00988
00989
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;
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 {
01054 NEXT_LA_CH;
01055 }
01056 }
01057 while (TRUE);
01058
01059 NEXT_LA_CH;
01060
01061 TRACE (Func_Exit, "parse_nosideeffects_dir", NULL);
01062
01063 return;
01064
01065 }
01066
01067
01068
01069
01070
01071
01072
01073
01074
01075
01076
01077
01078
01079
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
01093
01094
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) {
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;
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 {
01159 NEXT_LA_CH;
01160 }
01161 }
01162 while (TRUE);
01163
01164 NEXT_LA_CH;
01165
01166 TRACE (Func_Exit, "parse_vfunction_dir", NULL);
01167
01168 return;
01169
01170 }
01171
01172
01173
01174
01175
01176
01177
01178
01179
01180
01181
01182
01183
01184
01185
01186
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
01220
01221
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
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;
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 {
01273 NEXT_LA_CH;
01274 }
01275 }
01276 while (TRUE);
01277
01278 NEXT_LA_CH;
01279
01280 TRACE (Func_Exit, "parse_common_dirs", NULL);
01281
01282 return;
01283
01284 }
01285
01286
01287
01288
01289
01290
01291
01292
01293
01294
01295
01296
01297
01298
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;
01315
01316 do {
01317
01318 if (LA_CH_VALUE == SLASH) {
01319 NEXT_LA_CH;
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
01336
01337
01338 SB_DCL_ERR(sb_idx) = TRUE;
01339
01340
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
01362
01363 PRINTMSG(TOKEN_LINE(token), 1486, Error, TOKEN_COLUMN(token),
01364 SB_NAME_PTR(sb_idx));
01365 }
01366 else {
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;
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 }
01417
01418
01419
01420
01421
01422
01423
01424
01425
01426
01427
01428
01429
01430
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 {
01483 NEXT_LA_CH;
01484 }
01485 }
01486 while (TRUE);
01487
01488 NEXT_LA_CH;
01489
01490 TRACE (Func_Exit, "parse_dir_var_list", NULL);
01491
01492 return;
01493
01494 }
01495
01496
01497
01498
01499
01500
01501
01502
01503
01504
01505
01506
01507
01508
01509
01510
01511
01512
01513
01514
01515
01516
01517
01518
01519
01520
01521
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
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
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
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
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
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
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
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
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 }
01992
01993
01994
01995
01996
01997
01998
01999
02000
02001
02002
02003
02004
02005
02006
02007
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;
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
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 }
02078 # if 0
02079
02080
02081
02082
02083
02084
02085
02086
02087
02088
02089
02090
02091
02092
02093
02094
02095
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 }
02145 # endif
02146
02147
02148
02149
02150
02151
02152
02153
02154
02155
02156
02157
02158
02159
02160
02161
02162
02163
02164
02165
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 }
02398
02399
02400
02401
02402
02403
02404
02405
02406
02407
02408
02409
02410
02411
02412
02413
02414
02415
02416
02417
02418
02419
02420
02421
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
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
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
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
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
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
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
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
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 }
02695
02696
02697
02698
02699
02700
02701
02702
02703
02704
02705
02706
02707
02708
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
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 }
02751
02752
02753
02754
02755
02756
02757
02758
02759
02760
02761
02762
02763
02764
02765
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
02784 NEXT_LA_CH;
02785
02786 if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
02787
02788 if (LA_CH_VALUE == SLASH) {
02789 NEXT_LA_CH;
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
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 }
02860
02861
02862
02863
02864
02865
02866
02867
02868
02869
02870
02871
02872
02873
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;
02894 return;
02895 }
02896
02897 NEXT_LA_CH;
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;
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;
03021
03022 TRACE (Func_Exit, "parse_name_dir", NULL);
03023
03024 return;
03025
03026 }
03027
03028
03029
03030
03031
03032
03033
03034
03035
03036
03037
03038
03039
03040
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;
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;
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 }
03148
03149
03150
03151
03152
03153
03154
03155
03156
03157
03158
03159
03160
03161
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 {
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
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
03254
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) {
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;
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 {
03325 NEXT_LA_CH;
03326 }
03327 }
03328 while (TRUE);
03329
03330 NEXT_LA_CH;
03331
03332 TRACE (Func_Exit, "parse_inline_always_never", NULL);
03333
03334 return;
03335
03336 }
03337
03338
03339
03340
03341
03342
03343
03344
03345
03346
03347
03348
03349
03350
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 }
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 }
03476
03477 TRACE (Func_Exit, "update_fld_type", NULL);
03478
03479 return(new_idx);
03480
03481 }
03482
03483
03484
03485
03486
03487
03488
03489
03490
03491
03492
03493
03494
03495
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;
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 {
03547 NEXT_LA_CH;
03548 }
03549 }
03550 while (TRUE);
03551
03552 NEXT_LA_CH;
03553
03554 TRACE (Func_Exit, "parse_symmetric_dir", NULL);
03555
03556 return;
03557
03558 }
03559
03560
03561
03562
03563
03564
03565
03566
03567
03568
03569
03570
03571
03572
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
03603
03604
03605
03606
03607
03608
03609
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;
03648 }
03649
03650 cdir_info_idx = TOKEN_VALUE(token) - Tok_Dir_Start;
03651
03652
03653
03654
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(