Open64: osprey/crayf90/fe90/p_directiv.c Source File

00001 /*
00002  *  Copyright (C) 2006. QLogic Corporation. All Rights Reserved.
00003  */
00004 
00005 /*
00006  * Copyright 2004, 2005, 2006 PathScale, Inc.  All Rights Reserved.
00007  */
00008 
00009 /*
00010 
00011   Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.
00012 
00013   This program is free software; you can redistribute it and/or modify it
00014   under the terms of version 2 of the GNU General Public License as
00015   published by the Free Software Foundation.
00016 
00017   This program is distributed in the hope that it would be useful, but
00018   WITHOUT ANY WARRANTY; without even the implied warranty of
00019   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  
00020 
00021   Further, this software is distributed without any warranty that it is
00022   free of the rightful claim of any third person regarding infringement 
00023   or the like.  Any license provided herein, whether implied or 
00024   otherwise, applies only to this software file.  Patent licenses, if 
00025   any, provided herein do not apply to combinations of this program with 
00026   other software, or any other product whatsoever.  
00027 
00028   You should have received a copy of the GNU General Public License along
00029   with this program; if not, write the Free Software Foundation, Inc., 59
00030   Temple Place - Suite 330, Boston MA 02111-1307, USA.
00031 
00032   Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
00033   Mountain View, CA 94043, or:
00034 
00035   http://www.sgi.com
00036 
00037   For further information regarding this notice, see:
00038 
00039   http://oss.sgi.com/projects/GenInfo/NoticeExplan
00040 
00041 */
00042 
00043 
00044 
00045 static char USMID[] = "\n@(#)5.0_pl/sources/p_directiv.c  5.12  10/12/99 10:54:10\n";
00046 
00047 # include "defines.h"   /* Machine dependent ifdefs */
00048 
00049 # include "host.m"    /* Host machine dependent macros.*/
00050 # include "host.h"    /* Host machine dependent header.*/
00051 # include "target.m"    /* Target machine dependent macros.*/
00052 # include "target.h"    /* Target machine dependent header.*/
00053 
00054 # include "globals.m"
00055 # include "tokens.m"
00056 # include "sytb.m"
00057 # include "p_globals.m"
00058 # include "debug.m"
00059 
00060 # include "globals.h"
00061 # include "tokens.h"
00062 # include "sytb.h"
00063 # include "p_globals.h"
00064 # include "s_globals.h"
00065 
00066 # include "p_directiv.h"
00067 
00068 /*****************************************************************\
00069 |* function prototypes of static functions declared in this file *|
00070 \*****************************************************************/
00071 
00072 static void check_do_open_mp_nesting(void);
00073 static void check_ordered_open_mp_nesting(void);
00074 static boolean  check_section_open_mp_context(void);
00075 static boolean  directive_region_error(directive_stmt_type, int, int);
00076 static boolean  parse_assert_directive(void);
00077 static void parse_auxiliary_dir(void);
00078 static void parse_cache_align_name_list(opnd_type *);
00079 static void parse_cache_bypass_dir(opnd_type *);
00080 static void parse_cache_noalloc(void);
00081 static void parse_common_dirs(sb_type_type);
00082 static void parse_copy_assumed_shape_dir(void);
00083 static void parse_dir_directives(void);
00084 static void parse_dir_var_list(void);
00085 static void parse_distribution_dir(boolean);
00086 static void parse_doall_cmic(void);
00087 static void parse_dollar_directives(void);
00088 static void parse_doparallel_cmic(void);
00089 static void parse_fill_align_symbol(void);
00090 static void parse_id_directive(void);
00091 static void parse_ignore_tkr(void);
00092 static void parse_inline_always_never(boolean);
00093 static void parse_int_or_star_list(opnd_type *);
00094 static void parse_mic_directives(void);
00095 static void parse_mp_directive(mp_directive_type);
00096 static void parse_name_dir(void);
00097 static void parse_nosideeffects_dir(void);
00098 static void parse_par_directives(void);
00099 static void parse_parallel_cmic(void);
00100 static void parse_permutation_mic(void);
00101 static void parse_prefetch_ref(void);
00102 static void parse_redistribute_dir(void);
00103 static void parse_reference_list(opnd_type *);
00104 static void parse_sgi_dir_inline(boolean);
00105 static void parse_slash_common_dirs(void);
00106 static void parse_star_directives(void);
00107 static void parse_star_dir_directives(void);
00108 static void parse_symmetric_dir(void);
00109 static void parse_var_common_list(opnd_type *, boolean);
00110 static boolean  parse_var_name_list(opnd_type *);
00111 static void parse_vfunction_dir(void);
00112 static void parse_open_mp_directives(void);
00113 static void parse_open_mp_clauses(open_mp_directive_type);
00114 static int  update_fld_type(fld_type, int,int);
00115 
00116 
00117 /******************************************************************************\
00118 |*                        *|
00119 |* Description:                     *|
00120 |*  Set the defaults according to the command line arguments for all the  *|
00121 |*      cdir switches. This is called for every new compile unit.             *|
00122 |*                        *|
00123 |* Input parameters:                    *|
00124 |*  NONE                      *|
00125 |*                        *|
00126 |* Output parameters:                   *|
00127 |*  NONE                      *|
00128 |*                        *|
00129 |* Returns:                     *|
00130 |*  NOTHING                     *|
00131 |*                        *|
00132 \******************************************************************************/
00133 
00134 void  init_directive(int  pass)
00135 
00136 {
00137    int    attr_idx;
00138    int    list_idx1;
00139    int    list_idx2;
00140    int    type_idx;
00141 
00142 
00143    TRACE (Func_Entry, "init_directive", NULL);
00144 
00145    /* 0 means optimizer sets unroll count.  1 means no unrolling.  If  */
00146    /* the default level is set to 2, then automatic unrolling happens. */
00147    /* If the default level is set to 1, we only unroll those loops     */
00148    /* for which the user specifies the UNROLL directive.               */
00149 
00150    cdir_switches.unroll_count_idx = (opt_flags.unroll_lvl == Unroll_Lvl_2) ? 
00151                                      CN_INTEGER_ZERO_IDX : CN_INTEGER_ONE_IDX;
00152    cdir_switches.vector     = (opt_flags.vector_lvl > Vector_Lvl_0); 
00153    cdir_switches.task     = (opt_flags.task_lvl > Task_Lvl_0);
00154 
00155    cdir_switches.notask_region    = FALSE;
00156 
00157    /* Inline1 means recognize directives only.  So cdir_switches.do_inline   */
00158    /* only gets specified if !DIR$ INLINE is see when level is inline_lvl_1. */
00159 
00160    cdir_switches.do_inline  = FALSE;
00161    cdir_switches.noinline = FALSE;
00162 
00163    /* If split level is set to 2, automatic splitting happens.  If split */
00164    /* level is 1, then it can only be turned on with directives.         */
00165 
00166    cdir_switches.split    = (opt_flags.split_lvl == Split_Lvl_2); 
00167 
00168    cdir_switches.align      = FALSE;
00169    cdir_switches.bl     = opt_flags.bottom_load;
00170    cdir_switches.bounds     = cmd_line_flags.runtime_bounds;
00171    cdir_switches.concurrent   = FALSE;
00172    cdir_switches.ivdep      = FALSE;
00173    cdir_switches.mark     = opt_flags.mark;
00174    cdir_switches.stream     = (opt_flags.stream_lvl >=Stream_Lvl_1);
00175    cdir_switches.nextscalar   = FALSE;
00176    cdir_switches.no_internal_calls  = FALSE;
00177    cdir_switches.nointerchange    = opt_flags.nointerchange;
00178    cdir_switches.pattern    = opt_flags.pattern;
00179    cdir_switches.preferstream   = FALSE;
00180    cdir_switches.preferstream_nocinv  = FALSE;
00181    cdir_switches.prefertask   = FALSE;
00182    cdir_switches.prefervector   = FALSE;
00183    cdir_switches.recurrence   = opt_flags.recurrence;
00184    cdir_switches.shortloop    = FALSE;
00185    cdir_switches.shortloop128   = FALSE;
00186    cdir_switches.unroll_dir   = FALSE;
00187    cdir_switches.vsearch    = opt_flags.vsearch;
00188 
00189    /* If maxcpus TRUE, then there is an opnd hanging */
00190    /* off cdir_switches.maxcpu_opnd                  */
00191 
00192    cdir_switches.maxcpus    = FALSE;
00193    cdir_switches.parallel_region  = FALSE;
00194    cdir_switches.doall_region   = FALSE;
00195    cdir_switches.casedir    = FALSE;
00196    cdir_switches.guard      = FALSE;
00197    cdir_switches.guard_has_flag   = FALSE;
00198    cdir_switches.guard_in_par_reg = FALSE;
00199    cdir_switches.do_parallel    = FALSE;
00200    cdir_switches.autoscope    = FALSE;
00201 #ifdef KEY /* Bug 10441 */
00202    cdir_switches.single                 = FALSE;
00203 #endif /* KEY Bug 10441 */
00204    cdir_switches.safevl_idx   = const_safevl_idx;
00205    cdir_switches.concurrent_idx   = NULL_IDX;
00206    cdir_switches.blockable_sh_idx = NULL_IDX;
00207    cdir_switches.cache_bypass_ir_idx  = NULL_IDX;
00208    cdir_switches.doall_sh_idx   = NULL_IDX;
00209    cdir_switches.dir_nest_check_sh_idx  = NULL_IDX;
00210    cdir_switches.doacross_sh_idx  = NULL_IDX;
00211    cdir_switches.dopar_sh_idx   = NULL_IDX;
00212    cdir_switches.getfirst_list_idx  = NULL_IDX;
00213    cdir_switches.interchange_sh_idx = NULL_IDX;
00214    cdir_switches.lastlocal_list_idx = NULL_IDX;
00215    cdir_switches.lastthread_list_idx  = NULL_IDX;
00216    cdir_switches.mark_dir_idx   = NULL_IDX;
00217    cdir_switches.paralleldo_sh_idx  = NULL_IDX;
00218    cdir_switches.pdo_sh_idx   = NULL_IDX;
00219    cdir_switches.private_list_idx = NULL_IDX;
00220    cdir_switches.reduction_list_idx = NULL_IDX;
00221    cdir_switches.shared_list_idx  = NULL_IDX;
00222 
00223    cdir_switches.inline_here_sgi  = FALSE;
00224    cdir_switches.noinline_here_sgi  = FALSE;
00225    cdir_switches.inline_here_list_idx = NULL_IDX;
00226    cdir_switches.noinline_here_list_idx = NULL_IDX;
00227 
00228    cdir_switches.firstprivate_list_idx  = NULL_IDX;
00229    cdir_switches.copyin_list_idx  = NULL_IDX;
00230    cdir_switches.copyprivate_list_idx = NULL_IDX; /* by jhs, 02/7/22 */
00231    cdir_switches.lastprivate_list_idx = NULL_IDX;
00232    cdir_switches.default_scope_list_idx = NULL_IDX;
00233    cdir_switches.do_omp_sh_idx    = NULL_IDX;
00234    cdir_switches.paralleldo_omp_sh_idx  = NULL_IDX;
00235 
00236    cdir_switches.wait_list_idx    = NULL_IDX;
00237    cdir_switches.send_list_idx    = NULL_IDX;
00238 
00239    cdir_switches.blockable_count  = 0;
00240    cdir_switches.blockable_group  = 0;
00241    cdir_switches.interchange_count  = 0;
00242    cdir_switches.interchange_group  = 0;
00243    cdir_switches.interchange_level  = 0;
00244 
00245    if (pass > 1) {
00246       list_idx1 = cdir_switches.bounds_il_list;
00247 
00248       while (list_idx1) {
00249          attr_idx = IL_IDX(list_idx1);
00250          ATD_BOUNDS_CHECK(attr_idx) = FALSE;
00251 
00252          list_idx2 = list_idx1;
00253          list_idx1 = IL_NEXT_LIST_IDX(list_idx1);
00254          FREE_IR_LIST_NODE(list_idx2);
00255       }
00256 
00257       list_idx1 = cdir_switches.nobounds_il_list;
00258 
00259       while (list_idx1) {
00260          attr_idx = IL_IDX(list_idx1);
00261          ATD_NOBOUNDS_CHECK(attr_idx) = FALSE;
00262 
00263          list_idx2 = list_idx1;
00264          list_idx1 = IL_NEXT_LIST_IDX(list_idx1);
00265          FREE_IR_LIST_NODE(list_idx2);
00266       }
00267    }
00268 
00269    cdir_switches.bounds_il_list    = NULL_IDX;
00270    cdir_switches.nobounds_il_list  = NULL_IDX;
00271 
00272    cdir_switches.mp_schedtype_opnd = null_opnd;
00273 
00274    if (global_schedtype_value >= 0) {
00275       OPND_LINE_NUM(cdir_switches.mp_schedtype_opnd) = global_schedtype_line;
00276       OPND_COL_NUM(cdir_switches.mp_schedtype_opnd) = global_schedtype_col;
00277       OPND_FLD(cdir_switches.mp_schedtype_opnd) = CN_Tbl_Idx;
00278       OPND_IDX(cdir_switches.mp_schedtype_opnd) = C_INT_TO_CN(
00279                                                         CG_INTEGER_DEFAULT_TYPE,
00280                                                         global_schedtype_value);
00281    }
00282 
00283    cdir_switches.chunk_opnd = null_opnd;
00284    cdir_switches.first_sh_blk_stk = null_opnd;
00285 
00286    directive_state = 0;
00287 
00288    if (pass == 1) {
00289       cdir_switches.implicit_use_idx  = cmd_line_flags.implicit_use_idx;
00290       cdir_switches.flow    = on_off_flags.flowtrace_option;
00291       cdir_switches.code    = FALSE;
00292 
00293       if (!opt_flags.set_allfastint_option &&
00294           !opt_flags.set_fastint_option &&
00295           !opt_flags.set_nofastint_option) {
00296 # ifdef _TARGET_HAS_FAST_INTEGER
00297          opt_flags.set_fastint_option = TRUE;
00298 # endif
00299       }
00300 
00301       if (opt_flags.mark && opt_flags.mark_name.string != NULL) {
00302          CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
00303          TYP_CHAR_CLASS(TYP_WORK_IDX) = Const_Len_Char;
00304          TYP_TYPE(TYP_WORK_IDX)   = Character;
00305          TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE;
00306          TYP_FLD(TYP_WORK_IDX)    = CN_Tbl_Idx;
00307          TYP_IDX(TYP_WORK_IDX)          = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
00308                                             strlen(opt_flags.mark_name.string));
00309          type_idx     = ntr_type_tbl();
00310 
00311          cdir_switches.mark_cmdline_idx = ntr_const_tbl(type_idx,
00312                                                         FALSE,
00313                                   (long_type *) &(opt_flags.mark_name.words));
00314       }
00315       else {
00316          cdir_switches.mark_cmdline_idx = NULL_IDX;
00317       }
00318    }
00319 
00320    TRACE (Func_Exit, "init_directive", NULL);
00321 
00322    return;
00323 
00324 }  /* init_directive */
00325 
00326 /******************************************************************************\
00327 |*                        *|
00328 |* Description:                     *|
00329 |*  BRIEF DESCRIPTION OF THIS FUNCTION'S PURPOSE            *|
00330 |*                        *|
00331 |* Input parameters:                    *|
00332 |*  NONE                      *|
00333 |*                        *|
00334 |* Output parameters:                   *|
00335 |*  NONE                      *|
00336 |*                        *|
00337 |* Returns:                     *|
00338 |*  NONE                      *|
00339 |*                        *|
00340 \******************************************************************************/
00341 void parse_directive_stmt (void)
00342 {
00343 
00344    TRACE (Func_Entry, "parse_directive_stmt", NULL);
00345 
00346    /*****  NOTE:  THE INPUT STREAM TO THIS POINT IS "CDIR$", "CDIR@", *****/
00347    /*****  NOTE:  "!DIR$", "!DIR@", or "CMIC$", "!MIC$".  THE SCANNER *****/
00348    /*****  NOTE:  WILL RETURN Tok_Kwd_Dir FOR ANY OF THE ABOVE TOKENS.*****/
00349    /*****  NOTE:  THIS ROUTINE MUST EXAMINE THE TOKEN STRING FIELD    *****/
00350    /*****  NOTE:  TO DISTINGUISH BETWEEN COMPILER DIRECTIVES AND      *****/
00351    /*****  NOTE:  MICRO TASKING DIRECTIVES.  THE TOKEN STRING WILL    *****/
00352    /*****  NOTE:  NOT CONTAIN THE LEADING "C" OR "!" CHARACTERS.      *****/
00353 
00354 #ifdef KEY /* Bug 4067 */
00355    if (cmd_line_flags.disregard_all_directives) {
00356        parse_err_flush(Find_EOS, NULL);
00357        NEXT_LA_CH;
00358        goto EXIT;
00359    }
00360 #endif /* KEY Bug 4067 */
00361 
00362    /* If the first statement of the first program unit is being parsed, don't */
00363    /* buffer up any message pertaining to directives that precede this first  */
00364    /* statement (they don't belong to the program unit).                      */
00365 
00366    /* set need_new_sh to false for all the directives that don't need a */
00367    /* statement.                                                        */
00368 
00369    need_new_sh = FALSE;
00370 
00371    if (cif_need_unit_rec  &&  cif_first_pgm_unit) {
00372       c_i_f = cif_actual_file;
00373    }
00374 
00375    if (TOKEN_STR(token)[0] == 'M') {
00376 
00377       if (MATCHED_TOKEN_CLASS(Tok_Class_Mic_Kwd)) {
00378 
00379 #        if defined(_ACCEPT_TASK)
00380 
00381 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
00382             if ((cdir_switches.task == FALSE || 
00383                  cmd_line_flags.disregard_all_mics) &&
00384                 TOKEN_VALUE(token) != Tok_Mic_Cncall &&
00385                 TOKEN_VALUE(token) != Tok_Mic_Permutation) {
00386 # else
00387             if (cdir_switches.task == FALSE || 
00388                 cmd_line_flags.disregard_all_mics) {
00389 # endif
00390                parse_err_flush(Find_EOS, NULL);
00391                NEXT_LA_CH;
00392                goto EXIT;
00393             }
00394             parse_mic_directives();
00395 
00396 #        else
00397             PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token));
00398             parse_err_flush(Find_EOS, NULL);
00399             NEXT_LA_CH;
00400             goto EXIT;
00401 #        endif
00402       }
00403       else {
00404          PRINTMSG(TOKEN_LINE(token), 1356, Warning, TOKEN_COLUMN(token));
00405          parse_err_flush(Find_EOS, NULL);
00406          NEXT_LA_CH;
00407          goto EXIT;
00408       }
00409    }
00410    else if (TOKEN_STR(token)[0] == '$' &&
00411             TOKEN_STR(token)[1] == 'O' &&
00412             TOKEN_STR(token)[2] == 'M' &&
00413             TOKEN_STR(token)[3] == 'P') {
00414 
00415       if (MATCHED_TOKEN_CLASS(Tok_Class_Open_Mp_Dir_Kwd)) {
00416 
00417 # if defined(_TARGET_OS_MAX)
00418          PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token));
00419          parse_err_flush(Find_EOS, NULL);
00420          NEXT_LA_CH;
00421          goto EXIT;
00422 # else
00423 
00424          if (cmd_line_flags.disregard_all_omps) {
00425 
00426             /* Do not attempt to recognize any omp directives. */
00427 
00428             parse_err_flush(Find_EOS, NULL);
00429             NEXT_LA_CH;
00430             goto EXIT;
00431          }
00432 
00433          parse_open_mp_directives();
00434 # endif
00435       }
00436       else {
00437          /* no error, just treat as comment */
00438          parse_err_flush(Find_EOS, NULL);
00439          NEXT_LA_CH;
00440          goto EXIT;
00441       }
00442    }
00443 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
00444    else if (TOKEN_STR(token)[0] == '$' &&
00445             TOKEN_STR(token)[1] == 'S' &&
00446             TOKEN_STR(token)[2] == 'G' &&
00447             TOKEN_STR(token)[3] == 'I') {
00448 
00449       if (MATCHED_TOKEN_CLASS(Tok_Class_Open_Mp_Dir_Kwd)) {
00450          parse_open_mp_directives();
00451       }
00452       else {
00453          /* no error, just treat as comment */
00454          parse_err_flush(Find_EOS, NULL);
00455          NEXT_LA_CH;
00456          goto EXIT;
00457       }
00458    }
00459 # endif
00460    else if (TOKEN_STR(token)[0] == '$') {
00461 
00462       if (TOKEN_LEN(token) > 1 && TOKEN_STR(token)[1] == 'P') {
00463 
00464          if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) {
00465             parse_par_directives();
00466          }
00467          else {
00468             /* no error, just treat as comment */
00469             parse_err_flush(Find_EOS, NULL);
00470             NEXT_LA_CH;
00471             goto EXIT;
00472          }
00473       }
00474       else if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) {
00475          parse_dollar_directives();
00476       }
00477       else {
00478          /* no error, just treat as comment */
00479          parse_err_flush(Find_EOS, NULL);
00480          NEXT_LA_CH;
00481          goto EXIT;
00482       }
00483    }
00484    else if (TOKEN_STR(token)[0] == '*') {
00485 
00486       if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) {
00487          parse_star_directives();
00488       }
00489       else {
00490          /* no error, just treat as comment */
00491          parse_err_flush(Find_EOS, NULL);
00492          NEXT_LA_CH;
00493          goto EXIT;
00494       }
00495    }
00496 
00497 # ifdef _DEBUG
00498 
00499    else if (TOKEN_STR(token)[1] == 'B') {   /* !DBG */
00500 
00501       if (!MATCHED_TOKEN_CLASS(Tok_Class_Dbg_Kwd)) {
00502          parse_err_flush(Find_EOS, NULL);
00503          NEXT_LA_CH;
00504          goto EXIT;
00505       }
00506       parse_dir_directives();
00507    }
00508 
00509 # endif
00510 
00511    else if (MATCHED_TOKEN_CLASS(Tok_Class_Dir_Kwd)) {
00512 
00513       if (cmd_line_flags.disregard_all_dirs) {
00514 
00515          /* Do not attempt to recognize any dir$ directives. */
00516 
00517          parse_err_flush(Find_EOS, NULL);
00518          NEXT_LA_CH;
00519          goto EXIT;
00520       }
00521       parse_dir_directives();
00522    }
00523    else {
00524       PRINTMSG(TOKEN_LINE(token), 1356, Warning, TOKEN_COLUMN(token));
00525       parse_err_flush(Find_EOS, NULL);
00526       NEXT_LA_CH;
00527       goto EXIT;
00528    }
00529 
00530 EXIT:
00531 
00532    if (cif_need_unit_rec  &&  cif_first_pgm_unit) {
00533       c_i_f = cif_tmp_file;
00534    }
00535    
00536    TRACE (Func_Exit, "parse_directive_stmt", NULL);
00537 
00538    return;
00539 
00540 }  /* parse_directive_stmt */
00541 
00542 /******************************************************************************\
00543 |*                        *|
00544 |* Description:                     *|
00545 |*  Generate the IR for directives.                                       *|
00546 |*                        *|
00547 |* Input parameters:                    *|
00548 |*  NONE                      *|
00549 |*                        *|
00550 |* Output parameters:                   *|
00551 |*  NONE                      *|
00552 |*                        *|
00553 |* Returns:                     *|
00554 |*  NOTHING                     *|
00555 |*                        *|
00556 \******************************************************************************/
00557 
00558 int gen_directive_ir(operator_type  operator)
00559 
00560 {
00561    int    ir_idx;
00562 //Bug# 1204
00563 #ifdef KEY
00564    int          tmp_ir_idx;
00565 #endif
00566 
00567 
00568    TRACE (Func_Entry, "gen_directive_ir", NULL);
00569 
00570    need_new_sh = TRUE;
00571 
00572    if (SH_IR_IDX(curr_stmt_sh_idx)) {
00573 #ifdef KEY
00574       tmp_ir_idx = SH_NEXT_IDX(curr_stmt_sh_idx);
00575 #endif
00576 #ifdef KEY /* Bug 7498 */
00577       /* ntr_sh_tbl() may change the value of sh_tbl, which is used inside
00578        * SH_NEXT_IDX(), so we need an ANSI C sequence point in between. */
00579       int new_stmt                              = ntr_sh_tbl();
00580       SH_NEXT_IDX(curr_stmt_sh_idx)   = new_stmt;
00581 #else /* KEY Bug 7498 */
00582       SH_NEXT_IDX(curr_stmt_sh_idx)   = ntr_sh_tbl();
00583 #endif /* KEY Bug 7498 */
00584       SH_PREV_IDX(SH_NEXT_IDX(curr_stmt_sh_idx))= curr_stmt_sh_idx;
00585       curr_stmt_sh_idx        = SH_NEXT_IDX(curr_stmt_sh_idx);
00586       SH_STMT_TYPE(curr_stmt_sh_idx)    = Directive_Stmt;
00587 #ifdef KEY
00588       SH_NEXT_IDX(curr_stmt_sh_idx) = tmp_ir_idx;
00589       SH_PREV_IDX(tmp_ir_idx) = curr_stmt_sh_idx;
00590 #endif
00591    }
00592 
00593    SH_GLB_LINE(curr_stmt_sh_idx)= TOKEN_LINE(token);
00594    SH_COL_NUM(curr_stmt_sh_idx) = TOKEN_COLUMN(token);
00595 
00596    NTR_IR_TBL(ir_idx);
00597    IR_OPR(ir_idx)   = operator;
00598 
00599    /* must have a type idx */
00600 
00601    IR_TYPE_IDX(ir_idx)    = TYPELESS_DEFAULT_TYPE;
00602    IR_LINE_NUM(ir_idx)    = TOKEN_LINE(token);
00603    IR_COL_NUM(ir_idx)   = TOKEN_COLUMN(token);
00604 
00605    SH_IR_IDX(curr_stmt_sh_idx)  = ir_idx;
00606 
00607    TRACE (Func_Exit, "gen_directive_ir", NULL);
00608 
00609    return(ir_idx);
00610 
00611 }  /* gen_directive_ir */
00612 
00613 
00614 /******************************************************************************\
00615 |*                                                                            *|
00616 |* Description:                                                               *|
00617 |*      This routine parses the CDIR$ COPY_ASSUMED_SHAPE line.                *|
00618 |*                                                                            *|
00619 |* Input parameters:                                                          *|
00620 |*      NONE                                                                  *|
00621 |*                                                                            *|
00622 |* Output parameters:                                                         *|
00623 |*      NONE                                                                  *|
00624 |*                                                                            *|
00625 |* Returns:                                                                   *|
00626 |*      NOTHING                                                               *|
00627 |*                                                                            *|
00628 \******************************************************************************/
00629 
00630 static void parse_copy_assumed_shape_dir(void)
00631 
00632 {
00633    int          attr_idx;
00634    int          head_list_idx = NULL_IDX;
00635    int          list_idx;
00636    int          name_idx;
00637 
00638 
00639    TRACE (Func_Entry, "parse_copy_assumed_shape_dir", NULL);
00640 
00641    do {
00642       if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
00643          attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token),
00644                                  &name_idx);
00645 
00646          if (attr_idx == NULL_IDX) {
00647             attr_idx                         = ntr_sym_tbl(&token, name_idx);
00648             LN_DEF_LOC(name_idx)             = TRUE;
00649             AT_OBJ_CLASS(attr_idx)       = Data_Obj;
00650             SET_IMPL_TYPE(attr_idx);
00651          }
00652          else if (fnd_semantic_err(Obj_Copy_Assumed_Shape,
00653                                    TOKEN_LINE(token),
00654                                    TOKEN_COLUMN(token),
00655                                    attr_idx,
00656                                    TRUE)) {
00657             goto NEXT;
00658          }
00659 
00660          if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) {
00661             AT_ATTR_LINK(attr_idx)   = NULL_IDX;
00662             LN_DEF_LOC(name_idx)     = TRUE;
00663          }
00664 
00665          ATD_COPY_ASSUMED_SHAPE(attr_idx) = TRUE;
00666 
00667          if (head_list_idx == NULL_IDX) {
00668 
00669             /* place on the head list on scope */
00670 
00671             NTR_IR_LIST_TBL(head_list_idx);
00672 
00673             IL_NEXT_LIST_IDX(head_list_idx)=SCP_COPY_ASSUMED_LIST(curr_scp_idx);
00674 
00675             if (IL_NEXT_LIST_IDX(head_list_idx) != NULL_IDX) {
00676                IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(head_list_idx))=head_list_idx;
00677             }
00678 
00679             SCP_COPY_ASSUMED_LIST(curr_scp_idx) = head_list_idx;
00680 
00681             IL_FLD(head_list_idx) = IL_Tbl_Idx;
00682             IL_LIST_CNT(head_list_idx)  = 0;
00683          }
00684 
00685          NTR_IR_LIST_TBL(list_idx);
00686          IL_NEXT_LIST_IDX(list_idx) = IL_IDX(head_list_idx);
00687 
00688          if (IL_NEXT_LIST_IDX(list_idx) != NULL_IDX) {
00689             IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
00690          }
00691 
00692          IL_LIST_CNT(head_list_idx)++;
00693          IL_IDX(head_list_idx)  = list_idx;
00694          IL_FLD(list_idx) = AT_Tbl_Idx;
00695          IL_IDX(list_idx) = attr_idx;
00696          IL_LINE_NUM(list_idx)  = TOKEN_LINE(token);
00697          IL_COL_NUM(list_idx) = TOKEN_COLUMN(token);
00698       }
00699       else if (!parse_err_flush(Find_Comma, "variable name")) {
00700          break;                 /* Couldn't recover.  Hit EOS */
00701       }
00702 
00703 NEXT:
00704 
00705       if (LA_CH_VALUE == COMMA) {
00706          NEXT_LA_CH;
00707       }
00708       else if (LA_CH_VALUE == EOS ||
00709                !parse_err_flush(Find_Comma, ", or "EOS_STR)) {
00710          break;
00711       }
00712       else {  /* Issued error and recovered at a comma */
00713          NEXT_LA_CH;
00714       }
00715    }
00716    while (TRUE);
00717 
00718    NEXT_LA_CH;          /* Pick up EOS */
00719 
00720    TRACE (Func_Exit, "parse_copy_assumed_shape_dir", NULL);
00721 
00722    return;
00723 
00724 }  /* parse_copy_assumed_shape_dir */
00725 
00726 /******************************************************************************\
00727 |*                                                                            *|
00728 |* Description:                                                               *|
00729 |*      This routine parses the !DIR$ IGNORE_TKR directive.         *|
00730 |*                                                                            *|
00731 |* Input parameters:                                                          *|
00732 |*      NONE                                                                  *|
00733 |*                                                                            *|
00734 |* Output parameters:                                                         *|
00735 |*      NONE                                                                  *|
00736 |*                                                                            *|
00737 |* Returns:                                                                   *|
00738 |*      NOTHING                                                               *|
00739 |*                                                                            *|
00740 \******************************************************************************/
00741 
00742 static void parse_ignore_tkr(void)
00743 
00744 {
00745    int          attr_idx;
00746    int          name_idx;
00747 
00748 
00749    TRACE (Func_Entry, "parse_ignore_tkr", NULL);
00750 
00751    do {
00752       if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
00753          attr_idx = srch_sym_tbl(TOKEN_STR(token),
00754                                  TOKEN_LEN(token),
00755                                 &name_idx);
00756 
00757          if (attr_idx == NULL_IDX) {
00758             attr_idx      = ntr_sym_tbl(&token, name_idx);
00759             LN_DEF_LOC(name_idx)  = TRUE;
00760             AT_OBJ_CLASS(attr_idx)  = Data_Obj;
00761             ATD_CLASS(attr_idx)   = Dummy_Argument;
00762             ATD_IGNORE_TKR(attr_idx)  = TRUE;
00763             SET_IMPL_TYPE(attr_idx);
00764          }
00765          else if (!fnd_semantic_err(Obj_Ignore_TKR,
00766                                     TOKEN_LINE(token),
00767                                     TOKEN_COLUMN(token),
00768                                     attr_idx,
00769                                     TRUE)) {
00770 
00771             if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) {
00772                AT_ATTR_LINK(attr_idx)   = NULL_IDX;
00773                LN_DEF_LOC(name_idx)     = TRUE;
00774             }
00775 
00776 #ifdef KEY /* Bug 14150 */
00777    /* Now that we allow ignore_tkr on a dummy argument, don't set class
00778     * if we already know it */
00779          if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit) {
00780    }
00781    else
00782 #endif /* KEY Bug 14150 */
00783             ATD_CLASS(attr_idx)   = Dummy_Argument;
00784             ATD_IGNORE_TKR(attr_idx)  = TRUE;
00785          }
00786       }
00787       else if (!parse_err_flush(Find_Comma, "dummy-argument name")) {
00788          break;                 /* Couldn't recover.  Hit EOS */
00789       }
00790 
00791       if (LA_CH_VALUE == COMMA) {
00792          NEXT_LA_CH;
00793       }
00794       else if (LA_CH_VALUE == EOS ||
00795                !parse_err_flush(Find_Comma, ", or "EOS_STR)) {
00796          break;
00797       }
00798       else {  /* Issued error and recovered at a comma */
00799          NEXT_LA_CH;
00800       }
00801    }
00802    while (TRUE);
00803 
00804    NEXT_LA_CH;          /* Pick up EOS */
00805 
00806    TRACE (Func_Exit, "parse_ignore_tkr", NULL);
00807 
00808    return;
00809 
00810 }  /* parse_ignore_tkr */
00811 
00812 /******************************************************************************\
00813 |*                        *|
00814 |* Description:                     *|
00815 |*  This routine parses the CDIR$ AUXILIARY line.                         *|
00816 |*                        *|
00817 |* Input parameters:                    *|
00818 |*  NONE                      *|
00819 |*                        *|
00820 |* Output parameters:                   *|
00821 |*  NONE                      *|
00822 |*                        *|
00823 |* Returns:                     *|
00824 |*  NOTHING                     *|
00825 |*                        *|
00826 \******************************************************************************/
00827 
00828 static void parse_auxiliary_dir(void)
00829 
00830 {
00831    int    attr_idx;
00832    int    name_idx;
00833    int    sb_idx;
00834 
00835 
00836    TRACE (Func_Entry, "parse_auxiliary_dir", NULL);
00837 
00838    do {
00839       if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
00840          attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token),
00841                                  &name_idx);
00842 
00843          if (attr_idx == NULL_IDX) {
00844             attr_idx      = ntr_sym_tbl(&token, name_idx);
00845             LN_DEF_LOC(name_idx)  = TRUE;
00846             ATD_AUXILIARY(attr_idx) = TRUE;
00847             SET_IMPL_TYPE(attr_idx);
00848          }
00849          else if (!fnd_semantic_err(Obj_Auxiliary, 
00850                                     TOKEN_LINE(token),
00851                                     TOKEN_COLUMN(token),
00852                                     attr_idx,
00853                                     TRUE)) {
00854 
00855             if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) {
00856                AT_ATTR_LINK(attr_idx) = NULL_IDX;
00857                LN_DEF_LOC(name_idx) = TRUE;
00858             }
00859 
00860             ATD_AUXILIARY(attr_idx) = TRUE;
00861 
00862             if (ATD_IN_COMMON(attr_idx)) {
00863                sb_idx = ATD_STOR_BLK_IDX(attr_idx);
00864 
00865                if (SB_BLANK_COMMON(sb_idx)) {
00866                   PRINTMSG(TOKEN_LINE(token), 534, Error,
00867                            TOKEN_COLUMN(token),
00868                            AT_OBJ_NAME_PTR(attr_idx));
00869                }
00870                else if (SB_BLK_TYPE(sb_idx) == Task_Common) {
00871                   PRINTMSG(TOKEN_LINE(token), 537, Error,
00872                            TOKEN_COLUMN(token),
00873                            AT_OBJ_NAME_PTR(attr_idx),
00874                            SB_NAME_PTR(sb_idx));
00875                }
00876                else {
00877                   SB_AUXILIARY(sb_idx) = TRUE;
00878                }
00879             }
00880          }
00881       }
00882       else if (!parse_err_flush(Find_Comma, "variable name")) {
00883          break;     /* Couldn't recover.  Hit EOS */
00884       }
00885 
00886       if (LA_CH_VALUE == COMMA) {
00887          NEXT_LA_CH;
00888       }
00889       else if (LA_CH_VALUE == EOS ||
00890                !parse_err_flush(Find_Comma, ", or "EOS_STR)) {
00891          break;
00892       }
00893       else {  /* Issued error and recovered at a comma */
00894          NEXT_LA_CH;
00895       }
00896    }
00897    while (TRUE);
00898 
00899    NEXT_LA_CH;    /* Pick up EOS */
00900 
00901    TRACE (Func_Exit, "parse_auxiliary_dir", NULL);
00902 
00903    return;
00904 
00905 }  /* parse_auxiliary_dir */
00906 
00907 /******************************************************************************\
00908 |*                        *|
00909 |* Description:                     *|
00910 |*  This routine parses the CDIR$ CACHE_BYPASS line.                      *|
00911 |*                        *|
00912 |* Input parameters:                    *|
00913 |*  NONE                      *|
00914 |*                        *|
00915 |* Output parameters:                   *|
00916 |*  NONE                      *|
00917 |*                        *|
00918 |* Returns:                     *|
00919 |*  NOTHING                     *|
00920 |*                        *|
00921 \******************************************************************************/
00922 static void parse_cache_bypass_dir(opnd_type  *opnd)
00923 
00924 {
00925    int    column;
00926    int    line;
00927    int    list_idx  = NULL_IDX;
00928    opnd_type  opnd2;
00929 
00930 
00931    TRACE (Func_Entry, "parse_cache_bypass_dir", NULL);
00932 
00933    do {
00934       if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
00935 
00936          if (!parse_deref(&opnd2, NULL_IDX)) {
00937             parse_err_flush(Find_Comma, NULL);
00938          }
00939          else {
00940             find_opnd_line_and_column(&opnd2, &line, &column);
00941 
00942             if (OPND_FLD(opnd2) != AT_Tbl_Idx) {
00943                PRINTMSG(line, 1319, Error, column);
00944             }
00945             else {
00946 
00947                if (list_idx == NULL_IDX) {
00948                   NTR_IR_LIST_TBL(list_idx);
00949                   COPY_OPND(IL_OPND(list_idx), opnd2);
00950                   OPND_FLD((*opnd))   = IL_Tbl_Idx;
00951                   OPND_IDX((*opnd))   = list_idx;
00952                   OPND_LIST_CNT((*opnd))  = 1;
00953                }
00954                else {
00955                   NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
00956                   IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
00957                   (OPND_LIST_CNT((*opnd)))++;
00958                   list_idx      = IL_NEXT_LIST_IDX(list_idx);
00959                   COPY_OPND(IL_OPND(list_idx), opnd2);
00960                }
00961             }
00962          }
00963       }
00964       else if (!parse_err_flush(Find_Comma, "array name")) {
00965          break;     /* Couldn't recover.  Hit EOS */
00966       }
00967 
00968       if (LA_CH_VALUE == COMMA) {
00969          NEXT_LA_CH;
00970       }
00971       else if (LA_CH_VALUE == EOS ||
00972                !parse_err_flush(Find_Comma, ", or "EOS_STR)) {
00973          break;
00974       }
00975       else {  /* Issued error and recovered at a comma */
00976          NEXT_LA_CH;
00977       }
00978    }
00979    while (TRUE);
00980 
00981    NEXT_LA_CH;    /* Pick up EOS */
00982 
00983    TRACE (Func_Exit, "parse_cache_bypass_dir", NULL);
00984 
00985    return;
00986 
00987 }  /* parse_cache_bypass_dir */
00988 
00989 /******************************************************************************\
00990 |*                        *|
00991 |* Description:                     *|
00992 |*  This routine parses the CDIR$ NO SIDE EFFECTS line.                   *|
00993 |*                        *|
00994 |* Input parameters:                    *|
00995 |*  NONE                      *|
00996 |*                        *|
00997 |* Output parameters:                   *|
00998 |*  NONE                      *|
00999 |*                        *|
01000 |* Returns:                     *|
01001 |*  NOTHING                     *|
01002 |*                        *|
01003 \******************************************************************************/
01004 static void parse_nosideeffects_dir(void)
01005 
01006 {
01007    int    attr_idx;
01008    int    name_idx;
01009 
01010 
01011    TRACE (Func_Entry, "parse_nosideeffects_dir", NULL);
01012 
01013    do {
01014       if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
01015          attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token),
01016                                  &name_idx);
01017 
01018          if (attr_idx == NULL_IDX) {
01019             attr_idx      = ntr_sym_tbl(&token, name_idx);
01020             LN_DEF_LOC(name_idx)  = TRUE;
01021             AT_OBJ_CLASS(attr_idx)  = Pgm_Unit;
01022             ATP_NOSIDE_EFFECTS(attr_idx)= TRUE;
01023             MAKE_EXTERNAL_NAME(attr_idx,
01024                                AT_NAME_IDX(attr_idx),
01025                                AT_NAME_LEN(attr_idx));
01026             ATP_PROC(attr_idx)    = Extern_Proc;
01027             ATP_SCP_IDX(attr_idx) = curr_scp_idx;
01028          }
01029          else if (!fnd_semantic_err(Obj_No_Side_Effects,
01030                                     TOKEN_LINE(token),
01031                                     TOKEN_COLUMN(token),
01032                                     attr_idx,
01033                                     TRUE)) {
01034 
01035             if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) {
01036                AT_ATTR_LINK(attr_idx) = NULL_IDX;
01037                LN_DEF_LOC(name_idx) = TRUE;
01038             }
01039 
01040             if (AT_OBJ_CLASS(attr_idx) == Data_Obj) { 
01041 
01042                if (ATD_CLASS(attr_idx) == Function_Result) {
01043                   attr_idx  = ATD_FUNC_IDX(attr_idx);
01044                }
01045                else {
01046                   chg_data_obj_to_pgm_unit(attr_idx, 
01047                                            Pgm_Unknown,
01048                                            Extern_Proc);
01049                }
01050             }
01051             ATP_NOSIDE_EFFECTS(attr_idx)= TRUE;
01052          }
01053       }
01054       else if (!parse_err_flush(Find_Comma, "procedure name")) {
01055          break;     /* Couldn't recover.  Hit EOS */
01056       }
01057 
01058       if (LA_CH_VALUE == COMMA) {
01059          NEXT_LA_CH;
01060       }
01061       else if (LA_CH_VALUE == EOS ||
01062                !parse_err_flush(Find_Comma, ", or "EOS_STR)) {
01063          break;
01064       }
01065       else {  /* Issued error and recovered at a comma */
01066          NEXT_LA_CH;
01067       }
01068    }
01069    while (TRUE);
01070 
01071    NEXT_LA_CH;    /* Pick up EOS */
01072 
01073    TRACE (Func_Exit, "parse_nosideeffects_dir", NULL);
01074 
01075    return;
01076 
01077 }  /* parse_nosideeffects_dir */
01078 
01079 /******************************************************************************\
01080 |*                        *|
01081 |* Description:                     *|
01082 |*  This routine parses the CDIR$ VFUNCTION line.                         *|
01083 |*                        *|
01084 |* Input parameters:                    *|
01085 |*  NONE                      *|
01086 |*                        *|
01087 |* Output parameters:                   *|
01088 |*  NONE                      *|
01089 |*                        *|
01090 |* Returns:                     *|
01091 |*  NOTHING                     *|
01092 |*                        *|
01093 \******************************************************************************/
01094 static void parse_vfunction_dir(void)
01095 
01096 {
01097    int    attr_idx;
01098    int    name_idx;
01099    int    rslt_idx;
01100 
01101 
01102    TRACE (Func_Entry, "parse_vfunction_dir", NULL);
01103 
01104    /* In cft77, vfunction acts just like it was an EXTERNAL statement.  */
01105    /* This implementation does the same thing.  Vfunctions may not be   */
01106    /* specified for internal or module procedures.                      */
01107 
01108    do {
01109       if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
01110          attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token),
01111                                  &name_idx);
01112 
01113          if (attr_idx == NULL_IDX) {
01114             attr_idx      = ntr_sym_tbl(&token, name_idx);
01115             LN_DEF_LOC(name_idx)  = TRUE;
01116             AT_OBJ_CLASS(attr_idx)  = Pgm_Unit;
01117             ATP_NOSIDE_EFFECTS(attr_idx)= TRUE;
01118             MAKE_EXTERNAL_NAME(attr_idx,
01119                                AT_NAME_IDX(attr_idx),
01120                                AT_NAME_LEN(attr_idx));
01121             ATP_PROC(attr_idx)    = Extern_Proc;
01122             ATP_PGM_UNIT(attr_idx)  = Function;
01123             ATP_VFUNCTION(attr_idx) = TRUE;
01124             ATP_SCP_IDX(attr_idx) = curr_scp_idx;
01125 
01126             CREATE_FUNC_RSLT(attr_idx, rslt_idx);
01127             SET_IMPL_TYPE(rslt_idx);
01128          }
01129          else if (!fnd_semantic_err(Obj_Vfunction,
01130                                     TOKEN_LINE(token),
01131                                     TOKEN_COLUMN(token),
01132                                     attr_idx,
01133                                     TRUE)) {
01134 
01135             if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) {
01136                AT_ATTR_LINK(attr_idx) = NULL_IDX;
01137                LN_DEF_LOC(name_idx) = TRUE;
01138             }
01139 
01140             if (AT_OBJ_CLASS(attr_idx) == Data_Obj) { /* Switch to Function*/
01141                chg_data_obj_to_pgm_unit(attr_idx,
01142                                         Function,
01143                                         Extern_Proc);
01144                ATP_PGM_UNIT(attr_idx) = Function;
01145                ATP_VFUNCTION(attr_idx)  = TRUE;
01146             }
01147             else if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit) {
01148 
01149                if (ATP_PGM_UNIT(attr_idx) != Function) {
01150                   ATP_PGM_UNIT(attr_idx)  = Function;
01151                   CREATE_FUNC_RSLT(attr_idx, rslt_idx);
01152                   SET_IMPL_TYPE(rslt_idx);
01153                }
01154                ATP_PROC(attr_idx) = Extern_Proc;
01155                ATP_VFUNCTION(attr_idx)  = TRUE;
01156             }
01157          }
01158       }
01159       else if (!parse_err_flush(Find_Comma, "procedure name")) {
01160          break;     /* Couldn't recover.  Hit EOS */
01161       }
01162 
01163       if (LA_CH_VALUE == COMMA) {
01164          NEXT_LA_CH;
01165       }
01166       else if (LA_CH_VALUE == EOS ||
01167                !parse_err_flush(Find_Comma, ", or "EOS_STR)) {
01168          break;
01169       }
01170       else {  /* Issued error and recovered at a comma */
01171          NEXT_LA_CH;
01172       }
01173    }
01174    while (TRUE);
01175 
01176    NEXT_LA_CH;    /* Pick up EOS */
01177 
01178    TRACE (Func_Exit, "parse_vfunction_dir", NULL);
01179 
01180    return;
01181 
01182 }  /* parse_vfunction_dir */
01183 
01184 /******************************************************************************\
01185 |*                        *|
01186 |* Description:                     *|
01187 |*  This routine parses !DIR$ TASKCOMMON, !DIR$ COMMON and                *|
01188 |*  !$OMP THREADPRIVATE                                                   *|
01189 |*                        *|
01190 |* Input parameters:                    *|
01191 |*  Common means this is specified with the common directive.             *|
01192 |*  Task_Common means this is specified with the task common directive.   *|
01193 |*                        *|
01194 |* Output parameters:                   *|
01195 |*  NONE                      *|
01196 |*                        *|
01197 |* Returns:                     *|
01198 |*  NOTHING                     *|
01199 |*                        *|
01200 \******************************************************************************/
01201 static void parse_common_dirs(sb_type_type  blk_type)
01202 
01203 {
01204    int    new_sb_idx;
01205    int    sb_idx;
01206 
01207 
01208    TRACE (Func_Entry, "parse_common_dirs", NULL);
01209 
01210    do {
01211       if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
01212          sb_idx = srch_stor_blk_tbl(TOKEN_STR(token),
01213                                     TOKEN_LEN(token),
01214                                     curr_scp_idx);
01215 
01216          if (sb_idx == NULL_IDX) {
01217             sb_idx = ntr_stor_blk_tbl(TOKEN_STR(token),
01218                                       TOKEN_LEN(token),
01219                                       TOKEN_LINE(token),
01220                                       TOKEN_COLUMN(token),
01221                                       blk_type);
01222 
01223             SB_COMMON_NEEDS_OFFSET(sb_idx)  = TRUE;
01224          }
01225          else if (SB_BLK_TYPE(sb_idx) == Threadprivate) {
01226             PRINTMSG(TOKEN_LINE(token), 1486, Error, TOKEN_COLUMN(token),
01227                      SB_NAME_PTR(sb_idx));
01228          }
01229          else if (SB_USE_ASSOCIATED(sb_idx) || SB_HOST_ASSOCIATED(sb_idx)) {
01230 
01231             /* Common block has been use or host associated into this scope. */
01232             /* Make an entry for this block and hide the associated block    */
01233             /* storage_blk_resolution will resolve the blocks.               */
01234 
01235             new_sb_idx = ntr_stor_blk_tbl(TOKEN_STR(token),
01236                                           TOKEN_LEN(token),
01237                                           TOKEN_LINE(token),
01238                                           TOKEN_COLUMN(token),
01239                                           blk_type);
01240 
01241             SB_COMMON_NEEDS_OFFSET(new_sb_idx)  = TRUE;
01242             SB_MERGED_BLK_IDX(sb_idx)   = new_sb_idx;
01243             SB_HIDDEN(sb_idx)     = TRUE;
01244             SB_DEF_MULT_SCPS(sb_idx)    = TRUE;
01245             sb_idx                        = new_sb_idx;
01246          }
01247          else {
01248             SB_BLK_TYPE(sb_idx)     = blk_type;
01249             SB_RUNTIME_INIT(stor_blk_tbl_idx) = FALSE;
01250          }
01251 
01252          /* Else block has been declared already.  Mark block type */
01253 
01254          SB_IS_COMMON(sb_idx)   = TRUE;
01255 
01256          if (blk_type == Common) {
01257             SB_DCL_COMMON_DIR(sb_idx) = TRUE;
01258          }
01259       }
01260       else if (LA_CH_VALUE == SLASH) {
01261          NEXT_LA_CH;
01262 
01263          if (LA_CH_VALUE == SLASH) {
01264             PRINTMSG(TOKEN_LINE(token), 1481, Error, TOKEN_COLUMN(token),
01265                      TOKEN_STR(token), blk_type == Common ? "COMMON" :
01266                                                             "TASK COMMON");
01267             NEXT_LA_CH;
01268          }
01269          else {
01270             parse_err_flush(Find_Comma, "common block name");
01271          }
01272       }
01273       else if (!parse_err_flush(Find_Comma, "common block name")) {
01274          break;     /* Couldn't recover.  Hit EOS */
01275       }
01276 
01277       if (LA_CH_VALUE == COMMA) {
01278          NEXT_LA_CH;
01279       }
01280       else if (LA_CH_VALUE == EOS ||
01281                !parse_err_flush(Find_Comma, ", or "EOS_STR)) {
01282          break;
01283       }
01284       else {  /* Issued error and recovered at a comma */
01285          NEXT_LA_CH;
01286       }
01287    }
01288    while (TRUE);
01289 
01290    NEXT_LA_CH;    /* Pick up EOS */
01291 
01292    TRACE (Func_Exit, "parse_common_dirs", NULL);
01293 
01294    return;
01295 
01296 }  /* parse_common_dirs */
01297 
01298 /******************************************************************************\
01299 |*                        *|
01300 |* Description:                     *|
01301 |*  This routine parses !$OMP THREADPRIVATE                               *|
01302 |*                        *|
01303 |* Input parameters:                    *|
01304 |*  NONE                      *|
01305 |*                        *|
01306 |* Output parameters:                   *|
01307 |*  NONE                      *|
01308 |*                        *|
01309 |* Returns:                     *|
01310 |*  NOTHING                     *|
01311 |*                        *|
01312 \******************************************************************************/
01313 static void parse_slash_common_dirs(void)
01314 
01315 {
01316    int    sb_idx;
01317    int    attr_idx;
01318    int    name_idx;
01319    token_values_type  token_value;
01320 
01321 
01322    TRACE (Func_Entry, "parse_slash_common_dirs", NULL);
01323 
01324    if (LA_CH_VALUE != LPAREN) {
01325       parse_err_flush(Find_EOS, "(/common-block-name/)");
01326       return;
01327    }
01328 
01329    NEXT_LA_CH;  /* eat ( */
01330 
01331    do {
01332 
01333       if (LA_CH_VALUE == SLASH) {        /* must be common block */
01334          NEXT_LA_CH;    /* eat slash */
01335 
01336          if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
01337             sb_idx = srch_stor_blk_tbl(TOKEN_STR(token),
01338                                        TOKEN_LEN(token),
01339                                        curr_scp_idx);
01340 
01341             if (sb_idx == NULL_IDX) {
01342                sb_idx = ntr_stor_blk_tbl(TOKEN_STR(token),
01343                                          TOKEN_LEN(token),
01344                                          TOKEN_LINE(token),
01345                                          TOKEN_COLUMN(token),
01346                                          Threadprivate);
01347 
01348                SB_COMMON_NEEDS_OFFSET(sb_idx) = TRUE;
01349          SB_IS_COMMON(sb_idx) = TRUE;
01350 # if 0
01351                /* This is allowed now, but I'll leave the message in, */
01352                /* just in case. BHJ                                   */
01353 
01354                SB_DCL_ERR(sb_idx)   = TRUE;
01355 
01356                /* Must be specified in a common block before THREAD PRIVATE */
01357 
01358                PRINTMSG(TOKEN_LINE(token), 1479, Error, TOKEN_COLUMN(token),
01359                         TOKEN_STR(token));
01360 # endif
01361             }
01362             else if (SB_USE_ASSOCIATED(sb_idx)) {
01363 
01364                if (SB_BLK_TYPE(sb_idx) != Threadprivate) {
01365                   PRINTMSG(TOKEN_LINE(token), 1485, Error, TOKEN_COLUMN(token),
01366                            SB_NAME_PTR(sb_idx));
01367                }
01368             }
01369             else if (SB_HOST_ASSOCIATED(sb_idx)) {
01370                PRINTMSG(TOKEN_LINE(token), 1485, Error, TOKEN_COLUMN(token),
01371                         SB_NAME_PTR(sb_idx));
01372             }
01373 
01374             if (SB_BLK_TYPE(sb_idx) != Common &&
01375                 SB_BLK_TYPE(sb_idx) != Threadprivate) {
01376 
01377                /* Must be a common block - not taskcommon or auxiliary */
01378 
01379                PRINTMSG(TOKEN_LINE(token), 1486, Error, TOKEN_COLUMN(token),
01380                         SB_NAME_PTR(sb_idx));
01381             }
01382             else { /* Else block has been declared already.  Mark block type */
01383                SB_BLK_TYPE(sb_idx)  = Threadprivate;
01384                SB_RUNTIME_INIT(sb_idx)  = FALSE;
01385                SB_IS_COMMON(sb_idx) = TRUE;
01386             }
01387 
01388             if (LA_CH_VALUE == SLASH) {
01389                NEXT_LA_CH;   /* eat slash */
01390             }
01391             else if (!parse_err_flush(Find_Comma_Slash, "/")) {
01392                break;
01393             }
01394             else if (LA_CH_VALUE == SLASH) {
01395                NEXT_LA_CH;
01396             }
01397          }
01398          else if (LA_CH_VALUE == SLASH) {
01399             NEXT_LA_CH;
01400             PRINTMSG(TOKEN_LINE(token), 1481, Error, TOKEN_COLUMN(token),
01401                      TOKEN_STR(token), "THREADPRIVATE");
01402          }
01403          else if (!parse_err_flush(Find_Comma_Rparen, "common-block-name")) {
01404             break;
01405          }
01406       }
01407       /* the following is added by jhs, 02.9.9 */
01408       else if(MATCHED_TOKEN_CLASS(Tok_Class_Id)){
01409    token_value = TOKEN_VALUE(token);
01410    attr_idx = srch_sym_tbl(TOKEN_STR(token),
01411           TOKEN_LEN(token),
01412               &name_idx);
01413    if(attr_idx == NULL_IDX){
01414       attr_idx = ntr_sym_tbl(&token, name_idx);
01415       LN_DEF_LOC(name_idx) = FALSE;
01416       AT_OBJ_CLASS(attr_idx) = Data_Obj;
01417       SET_IMPL_TYPE(attr_idx);
01418    }
01419 #ifdef KEY
01420          if (ATD_STOR_BLK_IDX(attr_idx) == NULL_IDX) {
01421             assign_storage_blk(attr_idx);
01422          }
01423          SB_BLK_TYPE(ATD_STOR_BLK_IDX(attr_idx)) = Threadprivate;
01424 #endif
01425 #ifdef KEY /* Bug 9029 */
01426    /* The current function (parse_slash_common_dirs) is called only if
01427     * the token is Tok_Open_Mp_Dir_Threadprivate, so none of the
01428     * following code is relevant, and calling fnd_semantic_err with
01429     * Obj_Section_Non_Gp causes spurious errors when the identifier is
01430     * a module variable or when it is allocatable. Probably we need to
01431     * add an Attr_Threadprivate to the enumerations used in nameres.h,
01432     * and then add the corresponding table entries, and thereby make
01433     * sure that the variable cited in the THREADPRIVATE directive is
01434     * allowed by the OpenMP spec (e.g. it must not be in common, it must
01435     * not be equivalenced, and it must either have the SAVE attribute
01436     * or be a module variable.
01437     * But for now, we just disable the fnd_semantic_err check without
01438     * adding a new, more correct check.
01439     */
01440 #else /* KEY Bug 9029 */
01441    if(!fnd_semantic_err((token_value == Tok_SGI_Dir_Section_Gp) ?
01442          Obj_Section_Gp : Obj_Section_Non_Gp,
01443          TOKEN_LINE(token),
01444          TOKEN_COLUMN(token),
01445          attr_idx,
01446          TRUE)){
01447       if(AT_OBJ_CLASS(attr_idx) == Pgm_Unit &&
01448         ATP_PGM_UNIT(attr_idx) == Module){
01449         if(token_value == Tok_SGI_Dir_Section_Gp){
01450           if(attr_idx != SCP_ATTR_IDX(curr_scp_idx)){
01451         PRINTMSG(TOKEN_LINE(token), 1491, Error,
01452           TOKEN_COLUMN(token),
01453            "SECTION_GP" );
01454     }
01455     else if(SB_SECTION_NON_GP(SCP_SB_STATIC_IDX(curr_scp_idx))){
01456         PRINTMSG(TOKEN_LINE(token), 1490, Error,
01457       TOKEN_COLUMN(token),
01458       AT_OBJ_NAME_PTR(attr_idx),
01459       "SECTION_GP", "SECTION_NON_GP");
01460     }
01461         }
01462         else if(token_value == Tok_SGI_Dir_Section_Non_Gp){
01463     if(attr_idx != SCP_ATTR_IDX(curr_scp_idx)){
01464         PRINTMSG(TOKEN_LINE(token), 1491, Error,
01465       TOKEN_COLUMN(token),
01466       "SECTION_NON_GP");
01467     }
01468     else if(SB_SECTION_GP(SCP_SB_STATIC_IDX(curr_scp_idx))){
01469         PRINTMSG(TOKEN_LINE(token), 1490, Error,
01470       TOKEN_COLUMN(token),
01471       AT_OBJ_NAME_PTR(attr_idx),
01472       "SECTION_NON_GP", "SECTION_GP");
01473     }
01474         }
01475       }
01476    
01477             if(token_value == Tok_SGI_Dir_Section_Gp)
01478         ATD_SECTION_GP(attr_idx) = TRUE;
01479       else if(token_value == Tok_SGI_Dir_Section_Non_Gp)
01480         ATD_SECTION_NON_GP(attr_idx) = TRUE;
01481     }
01482 #endif /* KEY Bug 9029 */
01483       }
01484       /* the above is added by jhs, 02.9.9 */
01485       else if (!parse_err_flush(Find_Comma_Rparen, "/common-block-name/ or identifier")) {
01486          break;
01487       }
01488 
01489       if (LA_CH_VALUE == COMMA) {
01490          NEXT_LA_CH;
01491       }
01492       else {
01493          break;
01494       }
01495    }
01496    while (TRUE);
01497 
01498    if (LA_CH_VALUE == RPAREN || parse_err_flush(Find_Rparen, ")")) {
01499       NEXT_LA_CH;
01500    }
01501 
01502    if (LA_CH_VALUE != EOS) {
01503       parse_err_flush(Find_EOS, EOS_STR);
01504    }
01505       
01506    TRACE (Func_Exit, "parse_slash_common_dirs", NULL);
01507 
01508    return;
01509 
01510 }  /* parse_slash_common_dirs */
01511 
01512 /******************************************************************************\
01513 |*                        *|
01514 |* Description:                     *|
01515 |*  Parse the list following a suppress dir, if there is one.             *|
01516 |*                        *|
01517 |* Input parameters:                    *|
01518 |*  NONE                      *|
01519 |*                        *|
01520 |* Output parameters:                   *|
01521 |*  NONE                      *|
01522 |*                        *|
01523 |* Returns:                     *|
01524 |*  NOTHING                     *|
01525 |*                        *|
01526 \******************************************************************************/
01527 
01528 static void parse_dir_var_list(void)
01529 
01530 {
01531    int    ir_idx;
01532    int    list_idx = NULL_IDX;
01533    opnd_type    opnd;
01534 
01535 
01536    TRACE (Func_Entry, "parse_dir_var_list", NULL);
01537 
01538    ir_idx = SH_IR_IDX(curr_stmt_sh_idx);
01539 
01540    do {
01541 
01542       if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
01543 
01544          if (! parse_deref(&opnd, NULL_IDX)) {
01545             parse_err_flush(Find_Comma, NULL);
01546          }
01547          else {
01548 
01549             if (list_idx) {
01550                NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
01551                IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
01552                list_idx = IL_NEXT_LIST_IDX(list_idx);
01553                IR_LIST_CNT_L(ir_idx)++;
01554             }
01555             else {
01556                NTR_IR_LIST_TBL(list_idx);
01557                IR_IDX_L(ir_idx) = list_idx;
01558                IR_FLD_L(ir_idx) = IL_Tbl_Idx;
01559                IR_LIST_CNT_L(ir_idx) = 1;
01560             }
01561 
01562             COPY_OPND(IL_OPND(list_idx), opnd);
01563          }
01564       }
01565       else if (!parse_err_flush(Find_Comma, "variable name")) {
01566          break;
01567       }
01568 
01569       if (LA_CH_VALUE == COMMA) {
01570          NEXT_LA_CH;
01571       }
01572       else if (LA_CH_VALUE == EOS ||
01573                !parse_err_flush(Find_Comma, ", or "EOS_STR)) {
01574          break;
01575       }
01576       else {  /* Issued error and recovered at a comma */
01577          NEXT_LA_CH;
01578       }
01579    }
01580    while (TRUE);
01581 
01582    NEXT_LA_CH;          /* Pick up EOS */
01583 
01584    TRACE (Func_Exit, "parse_dir_var_list", NULL);
01585 
01586    return;
01587 
01588 }  /* parse_dir_var_list */
01589 
01590 /******************************************************************************\
01591 |*                        *|
01592 |* Description:                     *|
01593 |*  This routine parses the do all cmic. The ir it produces looks like .. *|
01594 |*                                                                            *|
01595 |*                        (Doall_Cmic_Opr)                                    *|
01596 |*                       /                                                    *|
01597 |*                      |- IF condition                                       *|
01598 |*                      |- SHARED var list                                    *|
01599 |*                      |- PRIVATE var list                                   *|
01600 |*                      |- GETFIRST var list                                  *|
01601 |*                      |- const one if AUTOSCOPE                             *|
01602 |*                      |- CONTROL var list                                   *|
01603 |*                      |- const one if SAVELAST                              *|
01604 |*                      |- MAXCPUS value                                      *|
01605 |*                      |- WORK DISTRIBUTION value (in const table)           *|
01606 |*                      |- expression for work distribution                   *|
01607 |*                        *|
01608 |* Input parameters:                    *|
01609 |*  NONE                      *|
01610 |*                        *|
01611 |* Output parameters:                   *|
01612 |*  NONE                      *|
01613 |*                        *|
01614 |* Returns:                     *|
01615 |*  NOTHING                     *|
01616 |*                        *|
01617 \******************************************************************************/
01618 
01619 static void parse_doall_cmic(void)
01620 
01621 {
01622    int    i;
01623    int    ir_idx;
01624    int    list_array[10];
01625    int    list_idx;
01626    opnd_type    opnd;
01627 
01628 
01629    TRACE (Func_Entry, "parse_doall_cmic", NULL);
01630 
01631    ir_idx = SH_IR_IDX(curr_stmt_sh_idx);
01632 
01633    for (i = 0; i < 10; i++) {
01634       NTR_IR_LIST_TBL(list_array[i]);
01635       if (i >= 1) {
01636          IL_NEXT_LIST_IDX(list_array[i - 1]) = list_array[i];
01637          IL_PREV_LIST_IDX(list_array[i]) = list_array[i - 1];
01638       }
01639    }
01640 
01641    IR_FLD_L(ir_idx) = IL_Tbl_Idx;
01642    IR_IDX_L(ir_idx) = list_array[0];
01643    IR_LIST_CNT_L(ir_idx) = 10;
01644 
01645    while (LA_CH_VALUE != EOS) {
01646 
01647       if (MATCHED_TOKEN_CLASS(Tok_Class_Dir_Kwd)) {
01648 
01649          switch (TOKEN_VALUE(token)) {
01650 
01651             case Tok_Dir_If:
01652 
01653                if (LA_CH_VALUE == LPAREN) {
01654 
01655                   if (IL_IDX(list_array[0]) != NULL_IDX) {
01656                      PRINTMSG(LA_CH_LINE, 680, Error, LA_CH_COLUMN,
01657                               "DOALL");
01658                      parse_err_flush(Find_EOS, NULL);
01659                      goto EXIT;
01660                   }
01661 
01662                   NEXT_LA_CH;
01663                   parse_expr(&opnd);
01664 
01665                   COPY_OPND(IL_OPND(list_array[0]), opnd);
01666 
01667                   if (LA_CH_VALUE == RPAREN) {
01668                      NEXT_LA_CH;
01669                   }
01670                   else {
01671                      parse_err_flush(Find_EOS, ")");
01672                      goto EXIT;
01673                   }
01674                }
01675                else {
01676                   parse_err_flush(Find_EOS, "(");
01677                   goto EXIT;
01678                }
01679                break;
01680 
01681             case Tok_Dir_Shared:
01682 
01683                if (LA_CH_VALUE == LPAREN) {
01684                   NEXT_LA_CH;
01685                   parse_var_name_list(&opnd);
01686 
01687                   if (IL_IDX(list_array[1]) == NULL_IDX) {
01688                      COPY_OPND(IL_OPND(list_array[1]), opnd);
01689                   }
01690                   else {
01691                      /* find the end of list */
01692 
01693                      list_idx = IL_IDX(list_array[1]);
01694                      while (IL_NEXT_LIST_IDX(list_idx)) {
01695                         list_idx = IL_NEXT_LIST_IDX(list_idx);
01696                      }
01697 
01698                      /* append the new list */
01699                      IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd);
01700                      IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx;
01701                      IL_LIST_CNT(list_array[1]) += OPND_LIST_CNT(opnd);
01702                   }
01703 
01704                   if (LA_CH_VALUE == RPAREN) {
01705                      NEXT_LA_CH;
01706                   } 
01707                   else {
01708                      parse_err_flush(Find_EOS, ")");
01709                      goto EXIT;
01710                   }
01711                }
01712                else {
01713                   parse_err_flush(Find_EOS, "(");
01714                   goto EXIT;
01715                }
01716 
01717                break;
01718 
01719             case Tok_Dir_Private:
01720 
01721                if (LA_CH_VALUE == LPAREN) {
01722                   NEXT_LA_CH;
01723                   parse_var_name_list(&opnd);
01724 
01725                   if (IL_IDX(list_array[2]) == NULL_IDX) {
01726                      COPY_OPND(IL_OPND(list_array[2]), opnd);
01727                   }
01728                   else {
01729                      /* find the end of list */
01730 
01731                      list_idx = IL_IDX(list_array[2]);
01732                      while (IL_NEXT_LIST_IDX(list_idx)) {
01733                         list_idx = IL_NEXT_LIST_IDX(list_idx);
01734                      }
01735 
01736                      /* append the new list */
01737                      IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd);
01738                      IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx;
01739                      IL_LIST_CNT(list_array[2]) += OPND_LIST_CNT(opnd);
01740                   }
01741 
01742                   if (LA_CH_VALUE == RPAREN) {
01743                      NEXT_LA_CH;
01744                   }   
01745                   else {
01746                      parse_err_flush(Find_EOS, ")");
01747                      goto EXIT;
01748                   }
01749                }
01750                else {
01751                   parse_err_flush(Find_EOS, "(");
01752                   goto EXIT;
01753                }
01754 
01755                break;
01756 
01757             case Tok_Dir_Getfirst:
01758 
01759                if (LA_CH_VALUE == LPAREN) {
01760                   NEXT_LA_CH;
01761                   parse_var_name_list(&opnd);
01762 
01763                   if (IL_IDX(list_array[3]) == NULL_IDX) {
01764                      COPY_OPND(IL_OPND(list_array[3]), opnd);
01765                   }
01766                   else {
01767                      /* find the end of list */
01768 
01769                      list_idx = IL_IDX(list_array[3]);
01770                      while (IL_NEXT_LIST_IDX(list_idx)) {
01771                         list_idx = IL_NEXT_LIST_IDX(list_idx);
01772                      }
01773 
01774                      /* append the new list */
01775                      IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd);
01776                      IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx;
01777                      IL_LIST_CNT(list_array[3]) += OPND_LIST_CNT(opnd);
01778                   }
01779 
01780                   if (LA_CH_VALUE == RPAREN) {
01781                      NEXT_LA_CH;
01782                   }
01783                   else {
01784                      parse_err_flush(Find_EOS, ")");
01785                      goto EXIT;
01786                   }
01787                }
01788                else {
01789                   parse_err_flush(Find_EOS, "(");
01790                   goto EXIT;
01791                }
01792 
01793                break;
01794 
01795             case Tok_Dir_Autoscope:
01796 
01797 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
01798                PRINTMSG(TOKEN_LINE(token), 1415, Error, TOKEN_COLUMN(token));
01799 # else
01800                IL_FLD(list_array[4]) = CN_Tbl_Idx;
01801                IL_IDX(list_array[4]) = CN_INTEGER_ONE_IDX;
01802                IL_LINE_NUM(list_array[4]) = TOKEN_LINE(token);
01803                IL_COL_NUM(list_array[4])  = TOKEN_COLUMN(token);
01804 # endif
01805 
01806                break;
01807 
01808             case Tok_Dir_Control:
01809 
01810                if (LA_CH_VALUE == LPAREN) {
01811                   NEXT_LA_CH;
01812                   parse_var_name_list(&opnd);
01813 
01814                   if (IL_IDX(list_array[5]) == NULL_IDX) {
01815                      COPY_OPND(IL_OPND(list_array[5]), opnd);
01816                   }
01817                   else {
01818                      /* find the end of list */
01819 
01820                      list_idx = IL_IDX(list_array[5]);
01821                      while (IL_NEXT_LIST_IDX(list_idx)) {
01822                         list_idx = IL_NEXT_LIST_IDX(list_idx);
01823                      }
01824 
01825                      /* append the new list */
01826                      IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd);
01827                      IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx;
01828                      IL_LIST_CNT(list_array[5]) += OPND_LIST_CNT(opnd);
01829                   }
01830 
01831                   if (LA_CH_VALUE == RPAREN) {
01832                      NEXT_LA_CH;
01833                   }   
01834                   else {
01835                      parse_err_flush(Find_EOS, ")");
01836                      goto EXIT;
01837                   }
01838                }
01839                else {
01840                   parse_err_flush(Find_EOS, "(");
01841                   goto EXIT;
01842                }
01843 
01844                break;
01845 
01846             case Tok_Dir_Savelast:
01847 
01848                IL_FLD(list_array[6]) = CN_Tbl_Idx;
01849                IL_IDX(list_array[6]) = CN_INTEGER_ONE_IDX;
01850                IL_LINE_NUM(list_array[6]) = TOKEN_LINE(token);
01851                IL_COL_NUM(list_array[6])  = TOKEN_COLUMN(token);
01852 
01853                break;
01854 
01855             case Tok_Dir_Maxcpus:
01856 
01857 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
01858                PRINTMSG(TOKEN_LINE(token), 1436, Warning,
01859                         TOKEN_COLUMN(token), "MAXCPUS");
01860                
01861 # endif
01862                if (LA_CH_VALUE == LPAREN) {
01863                   NEXT_LA_CH;
01864                   parse_expr(&opnd);
01865                   COPY_OPND(IL_OPND(list_array[7]), opnd);
01866 
01867                   if (LA_CH_VALUE == RPAREN) {
01868                      NEXT_LA_CH;
01869                   }
01870                   else {
01871                      parse_err_flush(Find_EOS, ")");
01872                      goto EXIT;
01873                   }
01874                }
01875                else {
01876                   parse_err_flush(Find_EOS, "(");
01877                   goto EXIT;
01878                }
01879 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
01880                IL_OPND(list_array[7]) = null_opnd;
01881 # endif
01882                break;
01883 
01884             case Tok_Dir_Single:
01885 
01886                if (IL_FLD(list_array[8]) != NO_Tbl_Idx) {
01887                   PRINTMSG(TOKEN_LINE(token), 800, Error, TOKEN_COLUMN(token));
01888                   parse_err_flush(Find_EOS, NULL);
01889                   goto EXIT;
01890                }
01891 
01892                IL_FLD(list_array[8]) = CN_Tbl_Idx;
01893                IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
01894                                                    CMIC_WORK_DIST_SINGLE);
01895                IL_LINE_NUM(list_array[8]) = TOKEN_LINE(token);
01896                IL_COL_NUM(list_array[8])  = TOKEN_COLUMN(token);
01897 
01898                break;
01899 
01900             case Tok_Dir_Chunksize:
01901 
01902                if (IL_FLD(list_array[8]) != NO_Tbl_Idx) {
01903                   PRINTMSG(TOKEN_LINE(token), 800, Error, TOKEN_COLUMN(token));
01904                   parse_err_flush(Find_EOS, NULL);
01905                   goto EXIT;
01906                }
01907 
01908                IL_FLD(list_array[8]) = CN_Tbl_Idx;
01909                IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
01910                                                    CMIC_WORK_DIST_CHUNKSIZE);
01911                IL_LINE_NUM(list_array[8]) = TOKEN_LINE(token);
01912                IL_COL_NUM(list_array[8])  = TOKEN_COLUMN(token);
01913 
01914                if (LA_CH_VALUE == LPAREN) {
01915                   NEXT_LA_CH;
01916 
01917                   if (parse_expr(&opnd)) {
01918                      COPY_OPND(IL_OPND(list_array[9]), opnd);
01919                   }
01920 
01921                   if (LA_CH_VALUE == RPAREN) {
01922                      NEXT_LA_CH;
01923                   }
01924                   else {
01925                      parse_err_flush(Find_EOS, ")");
01926                      goto EXIT;
01927                   }
01928                }
01929                else {
01930                   parse_err_flush(Find_EOS, "(");
01931                   goto EXIT;
01932                }
01933                   
01934 
01935                break;
01936 
01937             case Tok_Dir_Numchunks:
01938 
01939 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
01940                PRINTMSG(TOKEN_LINE(token), 1436, Warning,
01941                         TOKEN_COLUMN(token), "NUMCHUNKS");
01942 # endif
01943 
01944 
01945                if (IL_FLD(list_array[8]) != NO_Tbl_Idx) {
01946                   PRINTMSG(TOKEN_LINE(token), 800, Error, TOKEN_COLUMN(token));
01947                   parse_err_flush(Find_EOS, NULL);
01948                   goto EXIT;
01949                }
01950 
01951                IL_FLD(list_array[8]) = CN_Tbl_Idx;
01952                IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
01953                                                    CMIC_WORK_DIST_NUMCHUNKS);
01954                IL_LINE_NUM(list_array[8]) = TOKEN_LINE(token);
01955                IL_COL_NUM(list_array[8])  = TOKEN_COLUMN(token);
01956 
01957                if (LA_CH_VALUE == LPAREN) {
01958                   NEXT_LA_CH;
01959 
01960                   if (parse_expr(&opnd)) {
01961                      COPY_OPND(IL_OPND(list_array[9]), opnd);
01962                   }
01963 
01964                   if (LA_CH_VALUE == RPAREN) {
01965                      NEXT_LA_CH;
01966                   }
01967                   else {
01968                      parse_err_flush(Find_EOS, ")");
01969                      goto EXIT;
01970                   }
01971                }  
01972                else {
01973                   parse_err_flush(Find_EOS, "(");
01974                   goto EXIT;
01975                }
01976 
01977 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
01978                IL_OPND(list_array[8]) = null_opnd;
01979 # endif
01980                break;
01981 
01982             case Tok_Dir_Guided:
01983 
01984                if (IL_FLD(list_array[8]) != NO_Tbl_Idx) {
01985                   PRINTMSG(TOKEN_LINE(token), 800, Error, TOKEN_COLUMN(token));
01986                   parse_err_flush(Find_EOS, NULL);
01987                   goto EXIT;
01988                }
01989 
01990                IL_FLD(list_array[8]) = CN_Tbl_Idx;
01991                IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
01992                                                    CMIC_WORK_DIST_GUIDED);
01993                IL_LINE_NUM(list_array[8]) = TOKEN_LINE(token);
01994                IL_COL_NUM(list_array[8])  = TOKEN_COLUMN(token);
01995 
01996                if (LA_CH_VALUE == '(') {
01997 
01998                   if (parse_expr(&opnd)) {
01999                      COPY_OPND(IL_OPND(list_array[9]), opnd);
02000                   }
02001                }
02002                else {
02003                   IL_FLD(list_array[9]) = CN_Tbl_Idx;
02004                   IL_IDX(list_array[9]) = const_safevl_idx;
02005                   IL_LINE_NUM(list_array[9]) = TOKEN_LINE(token);
02006                   IL_COL_NUM(list_array[9])  = TOKEN_COLUMN(token);
02007                }
02008 
02009                break;
02010 
02011             case Tok_Dir_Vector:
02012 
02013                if (IL_FLD(list_array[8]) != NO_Tbl_Idx) {
02014                   PRINTMSG(TOKEN_LINE(token), 800, Error, TOKEN_COLUMN(token));
02015                   parse_err_flush(Find_EOS, NULL);
02016                   goto EXIT;
02017                }
02018 
02019                IL_FLD(list_array[8]) = CN_Tbl_Idx;
02020                IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
02021                                                    CMIC_WORK_DIST_VECTOR);
02022                IL_LINE_NUM(list_array[8]) = TOKEN_LINE(token);
02023                IL_COL_NUM(list_array[8])  = TOKEN_COLUMN(token);
02024 
02025                break;
02026 
02027             case Tok_Dir_Ncpus_Chunks :
02028 
02029 # ifdef _TARGET_OS_SOLARIS
02030 
02031                if (IL_FLD(list_array[8]) != NO_Tbl_Idx) {
02032                   PRINTMSG(TOKEN_LINE(token), 800, Error, TOKEN_COLUMN(token));
02033                   parse_err_flush(Find_EOS, NULL);
02034                   goto EXIT;
02035                }
02036 
02037                IL_FLD(list_array[8]) = CN_Tbl_Idx;
02038                IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
02039                                                    CMIC_WORK_DIST_NCPUS_CHUNK);
02040                IL_LINE_NUM(list_array[8]) = TOKEN_LINE(token);
02041                IL_COL_NUM(list_array[8])  = TOKEN_COLUMN(token);
02042 
02043 # else
02044                PRINTMSG(TOKEN_LINE(token), 1140, Warning, TOKEN_COLUMN(token));
02045 # endif
02046                break;
02047 
02048             default:
02049                parse_err_flush(Find_EOS, NULL);
02050                PRINTMSG(TOKEN_LINE(token), 798, Error, TOKEN_COLUMN(token));
02051                break;
02052          }
02053       }
02054       else {
02055          parse_err_flush(Find_EOS, "parameter");
02056       }
02057 
02058       if (LA_CH_VALUE == COMMA) {
02059          NEXT_LA_CH;
02060       }
02061    }
02062 
02063    if (IL_FLD(list_array[8]) == NO_Tbl_Idx) {
02064       IL_FLD(list_array[8]) = CN_Tbl_Idx;
02065 
02066 # ifdef _TARGET_OS_SOLARIS
02067       IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
02068                                           CMIC_WORK_DIST_NCPUS_CHUNKS);
02069 # elif (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
02070       IL_IDX(list_array[8]) = CN_INTEGER_ZERO_IDX;
02071 # else
02072       IL_IDX(list_array[8]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
02073                                           CMIC_WORK_DIST_SINGLE);
02074 # endif
02075       IL_LINE_NUM(list_array[8]) = TOKEN_LINE(token);
02076       IL_COL_NUM(list_array[8])  = TOKEN_COLUMN(token);
02077    }
02078 
02079 EXIT:
02080 
02081    TRACE (Func_Exit, "parse_doall_cmic", NULL);
02082 
02083    return;
02084 
02085 }  /* parse_doall_cmic */
02086 
02087 /******************************************************************************\
02088 |*                        *|
02089 |* Description:                     *|
02090 |*  This routine parses the variable lists that are possibly within       *|
02091 |*      paranthesis and have only variable names, not subobjects.             *|
02092 |*                        *|
02093 |* Input parameters:                    *|
02094 |*  NONE                      *|
02095 |*                        *|
02096 |* Output parameters:                   *|
02097 |*  list_opnd - points to list of attrs.                                  *|
02098 |*                        *|
02099 |* Returns:                     *|
02100 |*  TRUE if no errors were encountered.             *|
02101 |*                        *|
02102 \******************************************************************************/
02103 
02104 static boolean parse_var_name_list(opnd_type   *list_opnd)
02105 
02106 {
02107    int    column;
02108    int    line;
02109    int    list_idx = NULL_IDX;
02110    opnd_type  opnd;
02111    boolean      result   = TRUE;
02112 
02113 
02114    TRACE (Func_Entry, "parse_var_name_list", NULL);
02115 
02116    while (TRUE) {
02117 
02118       if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
02119          parse_deref(&opnd, NULL_IDX);
02120 
02121          if (OPND_FLD(opnd) != AT_Tbl_Idx) {
02122             result = FALSE;
02123             find_opnd_line_and_column(&opnd, &line, &column);
02124             PRINTMSG(line, 1374, Error, column);
02125          }
02126          else {
02127 
02128             if (list_idx == NULL_IDX) {
02129                NTR_IR_LIST_TBL(list_idx);
02130                OPND_FLD((*list_opnd)) = IL_Tbl_Idx;
02131                OPND_IDX((*list_opnd)) = list_idx;
02132                OPND_LIST_CNT((*list_opnd)) = 1;
02133             }
02134             else {
02135                NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
02136                IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
02137                (OPND_LIST_CNT((*list_opnd)))++;
02138                list_idx = IL_NEXT_LIST_IDX(list_idx);
02139             }
02140 
02141             COPY_OPND(IL_OPND(list_idx), opnd);
02142          }
02143       }
02144       else {
02145          parse_err_flush(Find_Comma_Rparen, "IDENTIFIER");
02146          result = FALSE;
02147       }
02148 
02149       if (LA_CH_VALUE != COMMA) {
02150          break;
02151       }
02152 
02153       NEXT_LA_CH;
02154    }
02155 
02156    TRACE (Func_Exit, "parse_var_name_list", NULL);
02157 
02158    return(result);
02159 
02160 }  /* parse_var_name_list */
02161 # if 0
02162 
02163 /* No one uses this routine */
02164 
02165 
02166 /******************************************************************************\
02167 |*                        *|
02168 |* Description:                     *|
02169 |*  This routine parses a list of expressions seperated by commas.        *|
02170 |*                        *|
02171 |* Input parameters:                    *|
02172 |*  NONE                      *|
02173 |*                        *|
02174 |* Output parameters:                   *|
02175 |*  opnd - points to list of expressions.                                 *|
02176 |*                        *|
02177 |* Returns:                     *|
02178 |*  NOTHING                     *|
02179 |*                        *|
02180 \******************************************************************************/
02181 
02182 static void parse_expr_list(opnd_type *list_opnd)
02183 
02184 {
02185    int    list_idx = NULL_IDX;
02186    boolean      ok = TRUE;
02187    opnd_type  opnd;
02188 
02189 
02190    TRACE (Func_Entry, "parse_expr_list", NULL);
02191 
02192    while(TRUE) {
02193 
02194       ok &= parse_expr(&opnd);
02195 
02196       if (ok) {
02197 
02198          if (list_idx == NULL_IDX) {
02199             NTR_IR_LIST_TBL(list_idx);
02200             OPND_FLD((*list_opnd)) = IL_Tbl_Idx;
02201             OPND_IDX((*list_opnd)) = list_idx;
02202             OPND_LIST_CNT((*list_opnd)) = 1;
02203          }
02204          else {
02205             NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
02206             IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
02207             (OPND_LIST_CNT((*list_opnd)))++;
02208             list_idx = IL_NEXT_LIST_IDX(list_idx);
02209          }
02210          COPY_OPND(IL_OPND(list_idx), opnd);
02211       }
02212       else {
02213          parse_err_flush(Find_Comma_Rparen, NULL);
02214          break;
02215       }
02216 
02217       if (LA_CH_VALUE != COMMA) {
02218          break;
02219       }
02220       NEXT_LA_CH;
02221    }
02222 
02223    TRACE (Func_Exit, "parse_expr_list", NULL);
02224 
02225    return;
02226 
02227 }  /* parse_expr_list */
02228 # endif
02229 
02230 /******************************************************************************\
02231 |*                        *|
02232 |* Description:                     *|
02233 |*  This routine parses the arguments to the DO PARALLEL cmic             *|
02234 |*                                                                            *|
02235 |*                             (Doparallel_Cmic_Opr)                          *|
02236 |*                            /                                               *|
02237 |*                           |- WORK DISTRIBUTION                             *|
02238 |*                           |- work distribution opnd                        *|
02239 |*                                                                            *|
02240 |*                                                                            *|
02241 |* Input parameters:                    *|
02242 |*  NONE                      *|
02243 |*                        *|
02244 |* Output parameters:                   *|
02245 |*  NONE                      *|
02246 |*                        *|
02247 |* Returns:                     *|
02248 |*  NOTHING                     *|
02249 |*                        *|
02250 \******************************************************************************/
02251 
02252 static void parse_doparallel_cmic(void)
02253 
02254 {
02255    int          i;
02256    int          ir_idx;
02257    int          list_array[2];
02258    opnd_type    opnd;
02259 
02260 
02261    TRACE (Func_Entry, "parse_doparallel_cmic", NULL);
02262 
02263    ir_idx = SH_IR_IDX(curr_stmt_sh_idx);
02264 
02265    for (i = 0; i < 2; i++) {
02266       NTR_IR_LIST_TBL(list_array[i]);
02267       if (i >= 1) {
02268          IL_NEXT_LIST_IDX(list_array[i - 1]) = list_array[i];
02269          IL_PREV_LIST_IDX(list_array[i]) = list_array[i - 1];
02270       }
02271    }
02272 
02273    IR_FLD_L(ir_idx) = IL_Tbl_Idx;
02274    IR_IDX_L(ir_idx) = list_array[0];
02275    IR_LIST_CNT_L(ir_idx) = 2;
02276 
02277    IL_OPND(list_array[0]) = null_opnd;
02278 
02279    if (LA_CH_VALUE == EOS) {
02280       goto EXIT;
02281    }
02282 
02283    if (MATCHED_TOKEN_CLASS(Tok_Class_Dir_Kwd)) {
02284       switch (TOKEN_VALUE(token)) {
02285       case Tok_Dir_Single:
02286 
02287          if (IL_FLD(list_array[0]) != NO_Tbl_Idx) {
02288             PRINTMSG(TOKEN_LINE(token), 1139, Error, TOKEN_COLUMN(token));
02289             parse_err_flush(Find_EOS, NULL);
02290             goto EXIT;
02291          }
02292 
02293          IL_FLD(list_array[0]) = CN_Tbl_Idx;
02294          IL_IDX(list_array[0]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
02295                                              CMIC_WORK_DIST_SINGLE);
02296          IL_LINE_NUM(list_array[0]) = TOKEN_LINE(token);
02297          IL_COL_NUM(list_array[0])  = TOKEN_COLUMN(token);
02298 
02299          break;
02300 
02301       case Tok_Dir_Chunksize:
02302 
02303          if (IL_FLD(list_array[0]) != NO_Tbl_Idx) {
02304             PRINTMSG(TOKEN_LINE(token), 1139, Error, TOKEN_COLUMN(token));
02305             parse_err_flush(Find_EOS, NULL);
02306             goto EXIT;
02307          }
02308 
02309          IL_FLD(list_array[0]) = CN_Tbl_Idx;
02310          IL_IDX(list_array[0]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
02311                                              CMIC_WORK_DIST_CHUNKSIZE);
02312          IL_LINE_NUM(list_array[0]) = TOKEN_LINE(token);
02313          IL_COL_NUM(list_array[0])  = TOKEN_COLUMN(token);
02314 
02315          if (LA_CH_VALUE == LPAREN) {
02316             NEXT_LA_CH;
02317 
02318             if (parse_expr(&opnd)) {
02319                COPY_OPND(IL_OPND(list_array[1]), opnd);
02320             }
02321 
02322             if (LA_CH_VALUE == RPAREN) {
02323                NEXT_LA_CH;
02324             }
02325             else {
02326                parse_err_flush(Find_EOS, ")");
02327                goto EXIT;
02328             }
02329          }
02330          else {
02331             parse_err_flush(Find_EOS, "(");
02332             goto EXIT;
02333          }
02334 
02335          break;
02336 
02337       case Tok_Dir_Numchunks:
02338 
02339 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
02340          PRINTMSG(TOKEN_LINE(token), 1436, Warning,
02341                   TOKEN_COLUMN(token), "NUMCHUNKS");
02342 # endif
02343 
02344          if (IL_FLD(list_array[0]) != NO_Tbl_Idx) {
02345             PRINTMSG(TOKEN_LINE(token), 1139, Error, TOKEN_COLUMN(token));
02346             parse_err_flush(Find_EOS, NULL);
02347             goto EXIT;
02348          }
02349 
02350          IL_FLD(list_array[0]) = CN_Tbl_Idx;
02351          IL_IDX(list_array[0]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
02352                                              CMIC_WORK_DIST_NUMCHUNKS);
02353          IL_LINE_NUM(list_array[0]) = TOKEN_LINE(token);
02354          IL_COL_NUM(list_array[0])  = TOKEN_COLUMN(token);
02355 
02356          if (LA_CH_VALUE == LPAREN) {
02357             NEXT_LA_CH;
02358 
02359             if (parse_expr(&opnd)) {
02360                COPY_OPND(IL_OPND(list_array[1]), opnd);
02361             }
02362 
02363             if (LA_CH_VALUE == RPAREN) {
02364                NEXT_LA_CH;
02365             }
02366             else {
02367                parse_err_flush(Find_EOS, ")");
02368                goto EXIT;
02369             }
02370          }
02371          else {
02372             parse_err_flush(Find_EOS, "(");
02373             goto EXIT;
02374          }
02375 
02376 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
02377          IL_OPND(list_array[0]) = null_opnd;
02378 # endif
02379          break;
02380 
02381       case Tok_Dir_Guided:
02382 
02383          if (IL_FLD(list_array[0]) != NO_Tbl_Idx) {
02384             PRINTMSG(TOKEN_LINE(token), 1139, Error, TOKEN_COLUMN(token));
02385             parse_err_flush(Find_EOS, NULL);
02386             goto EXIT;
02387          }
02388 
02389          IL_FLD(list_array[0]) = CN_Tbl_Idx;
02390          IL_IDX(list_array[0]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
02391                                              CMIC_WORK_DIST_GUIDED);
02392          IL_LINE_NUM(list_array[0]) = TOKEN_LINE(token);
02393          IL_COL_NUM(list_array[0])  = TOKEN_COLUMN(token);
02394 
02395          if (LA_CH_VALUE == '(') {
02396             if (parse_expr(&opnd)) {
02397                COPY_OPND(IL_OPND(list_array[1]), opnd);
02398             }
02399          }
02400          else {
02401             IL_FLD(list_array[1]) = CN_Tbl_Idx;
02402             IL_IDX(list_array[1]) = const_safevl_idx;
02403             IL_LINE_NUM(list_array[1]) = TOKEN_LINE(token);
02404             IL_COL_NUM(list_array[1])  = TOKEN_COLUMN(token);
02405          }
02406 
02407          break;
02408 
02409       case Tok_Dir_Vector:
02410 
02411          if (IL_FLD(list_array[0]) != NO_Tbl_Idx) {
02412             PRINTMSG(TOKEN_LINE(token), 1139, Error, TOKEN_COLUMN(token));
02413             parse_err_flush(Find_EOS, NULL);
02414             goto EXIT;
02415          }
02416 
02417          IL_FLD(list_array[0]) = CN_Tbl_Idx;
02418          IL_IDX(list_array[0]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
02419                                              CMIC_WORK_DIST_VECTOR);
02420          IL_LINE_NUM(list_array[0]) = TOKEN_LINE(token);
02421          IL_COL_NUM(list_array[0])  = TOKEN_COLUMN(token);
02422 
02423          break;
02424 
02425       case Tok_Dir_Ncpus_Chunks :
02426 
02427 # ifdef _TARGET_OS_SOLARIS
02428 
02429          if (IL_FLD(list_array[0]) != NO_Tbl_Idx) {
02430             PRINTMSG(TOKEN_LINE(token), 1139, Error, TOKEN_COLUMN(token));
02431             parse_err_flush(Find_EOS, NULL);
02432             goto EXIT;
02433          }
02434 
02435          IL_FLD(list_array[0]) = CN_Tbl_Idx;
02436          IL_IDX(list_array[0]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
02437                                              CMIC_WORK_DIST_NCPUS_CHUNKS);
02438          IL_LINE_NUM(list_array[0]) = TOKEN_LINE(token);
02439          IL_COL_NUM(list_array[0])  = TOKEN_COLUMN(token);
02440 
02441 # else
02442          PRINTMSG(TOKEN_LINE(token), 1140, Warning, TOKEN_COLUMN(token));
02443 # endif
02444          break;
02445 
02446 
02447       default:
02448          parse_err_flush(Find_EOS, NULL);
02449          PRINTMSG(TOKEN_LINE(token), 808, Error, TOKEN_COLUMN(token));
02450          break;
02451       }
02452    }
02453    else {
02454       parse_err_flush(Find_EOS, "parameter");
02455    }
02456 
02457    if (LA_CH_VALUE != EOS) {
02458       parse_err_flush(Find_EOS, EOS_STR);
02459    }
02460 
02461 EXIT:
02462 
02463    if (IL_FLD(list_array[0]) == NO_Tbl_Idx) {
02464       IL_FLD(list_array[0]) = CN_Tbl_Idx;
02465 
02466 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
02467       IL_IDX(list_array[0]) = CN_INTEGER_ZERO_IDX;
02468 # else
02469       IL_IDX(list_array[0]) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
02470                                           CMIC_WORK_DIST_SINGLE);
02471 # endif
02472       IL_LINE_NUM(list_array[0]) = TOKEN_LINE(token);
02473       IL_COL_NUM(list_array[0])  = TOKEN_COLUMN(token);
02474    }
02475       
02476    TRACE (Func_Exit, "parse_doparallel_cmic", NULL);
02477 
02478    return;
02479 
02480 }  /* parse_doparallel_cmic */
02481 
02482 /******************************************************************************\
02483 |*                        *|
02484 |* Description:                     *|
02485 |*  This routine parses the parameters for the PARALLEL cmic.             *|
02486 |*                                                                            *|
02487 |*                        (Parallel_Cmic_Opr)                                 *|
02488 |*                       /                                                    *|
02489 |*                      |- IF condition                                       *|
02490 |*                      |- SHARED var list                                    *|
02491 |*                      |- PRIVATE var list                                   *|
02492 |*                      |- GETFIRST var list                                  *|
02493 |*                      |- const one if AUTOSCOPE                             *|
02494 |*                      |- CONTROL var list                                   *|
02495 |*                      |- MAXCPUS value                                      *|
02496 |*                        *|
02497 |* Input parameters:                    *|
02498 |*  NONE                      *|
02499 |*                        *|
02500 |* Output parameters:                   *|
02501 |*  NONE                      *|
02502 |*                        *|
02503 |* Returns:                     *|
02504 |*  NOTHING                     *|
02505 |*                        *|
02506 \******************************************************************************/
02507 
02508 static void parse_parallel_cmic(void)
02509 
02510 {
02511    int          i;
02512    int          ir_idx;
02513    int          list_array[7];
02514    int    list_idx;
02515    opnd_type    opnd;
02516 
02517 
02518    TRACE (Func_Entry, "parse_parallel_cmic", NULL);
02519 
02520    ir_idx = SH_IR_IDX(curr_stmt_sh_idx);
02521 
02522    for (i = 0; i < 7; i++) {
02523       NTR_IR_LIST_TBL(list_array[i]);
02524       if (i >= 1) {
02525          IL_NEXT_LIST_IDX(list_array[i - 1]) = list_array[i];
02526          IL_PREV_LIST_IDX(list_array[i]) = list_array[i - 1];
02527       }
02528    }
02529 
02530    IR_FLD_L(ir_idx) = IL_Tbl_Idx;
02531    IR_IDX_L(ir_idx) = list_array[0];
02532    IR_LIST_CNT_L(ir_idx) = 7;
02533 
02534    while (LA_CH_VALUE != EOS) {
02535 
02536       if (MATCHED_TOKEN_CLASS(Tok_Class_Dir_Kwd)) {
02537 
02538          switch (TOKEN_VALUE(token)) {
02539 
02540             case Tok_Dir_If:
02541 
02542                if (LA_CH_VALUE == LPAREN) {
02543 
02544                   if (IL_IDX(list_array[0]) != NULL_IDX) {
02545                      PRINTMSG(LA_CH_LINE, 680, Error, LA_CH_COLUMN,
02546                               "PARALLEL");
02547                      parse_err_flush(Find_EOS, NULL);
02548                      goto EXIT;
02549                   }
02550 
02551                   NEXT_LA_CH;
02552                   parse_expr(&opnd);
02553                   COPY_OPND(IL_OPND(list_array[0]), opnd);
02554 
02555                   if (LA_CH_VALUE == RPAREN) {
02556                      NEXT_LA_CH;
02557                   }
02558                   else {
02559                      parse_err_flush(Find_EOS, ")");
02560                      goto EXIT;
02561                   }
02562                }
02563                else {
02564                   parse_err_flush(Find_EOS, "(");
02565                   goto EXIT;
02566                }
02567                break;
02568 
02569             case Tok_Dir_Shared:
02570 
02571                if (LA_CH_VALUE == LPAREN) {
02572                   NEXT_LA_CH;
02573                   parse_var_name_list(&opnd);
02574 
02575                   if (IL_IDX(list_array[1]) == NULL_IDX) {
02576                      COPY_OPND(IL_OPND(list_array[1]), opnd);
02577                   }
02578                   else {
02579                      /* find the end of list */
02580 
02581                      list_idx = IL_IDX(list_array[1]);
02582                      while (IL_NEXT_LIST_IDX(list_idx)) {
02583                         list_idx = IL_NEXT_LIST_IDX(list_idx);
02584                      }
02585 
02586                      /* append the new list */
02587                      IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd);
02588                      IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx;
02589                      IL_LIST_CNT(list_array[1]) += OPND_LIST_CNT(opnd);
02590                   }
02591 
02592                   if (LA_CH_VALUE == RPAREN) {
02593                      NEXT_LA_CH;
02594                   }
02595                   else {
02596                      parse_err_flush(Find_EOS, ")");
02597                      goto EXIT;
02598                   }
02599                }
02600                else {
02601                   parse_err_flush(Find_EOS, "(");
02602                   goto EXIT;
02603                }
02604 
02605                break;
02606 
02607             case Tok_Dir_Private:
02608 
02609                if (LA_CH_VALUE == LPAREN) {
02610                   NEXT_LA_CH;
02611                   parse_var_name_list(&opnd);
02612 
02613                   if (IL_IDX(list_array[2]) == NULL_IDX) {
02614                      COPY_OPND(IL_OPND(list_array[2]), opnd);
02615                   }
02616                   else {
02617                      /* find the end of list */
02618 
02619                      list_idx = IL_IDX(list_array[2]);
02620                      while (IL_NEXT_LIST_IDX(list_idx)) {
02621                         list_idx = IL_NEXT_LIST_IDX(list_idx);
02622                      }
02623 
02624                      /* append the new list */
02625                      IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd);
02626                      IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx;
02627                      IL_LIST_CNT(list_array[2]) += OPND_LIST_CNT(opnd);
02628                   }
02629 
02630                   if (LA_CH_VALUE == RPAREN) {
02631                      NEXT_LA_CH;
02632                   }
02633                   else {
02634                      parse_err_flush(Find_EOS, ")");
02635                      goto EXIT;
02636                   }
02637                }
02638                else {
02639                   parse_err_flush(Find_EOS, "(");
02640                   goto EXIT;
02641                }
02642 
02643                break;
02644 
02645             case Tok_Dir_Getfirst:
02646 
02647                if (LA_CH_VALUE == LPAREN) {
02648                   NEXT_LA_CH;
02649                   parse_var_name_list(&opnd);
02650 
02651                   if (IL_IDX(list_array[3]) == NULL_IDX) {
02652                      COPY_OPND(IL_OPND(list_array[3]), opnd);
02653                   }
02654                   else {
02655                      /* find the end of list */
02656 
02657                      list_idx = IL_IDX(list_array[3]);
02658                      while (IL_NEXT_LIST_IDX(list_idx)) {
02659                         list_idx = IL_NEXT_LIST_IDX(list_idx);
02660                      }
02661 
02662                      /* append the new list */
02663                      IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd);
02664                      IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx;
02665                      IL_LIST_CNT(list_array[3]) += OPND_LIST_CNT(opnd);
02666                   }
02667 
02668                   if (LA_CH_VALUE == RPAREN) {
02669                      NEXT_LA_CH;
02670                   }
02671                   else {
02672                      parse_err_flush(Find_EOS, ")");
02673                      goto EXIT;
02674                   }
02675                }
02676                else {
02677                   parse_err_flush(Find_EOS, "(");
02678                   goto EXIT;
02679                }
02680 
02681                break;
02682 
02683             case Tok_Dir_Autoscope:
02684 
02685 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
02686                PRINTMSG(TOKEN_LINE(token), 1415, Error, TOKEN_COLUMN(token));
02687 # else
02688 
02689                IL_FLD(list_array[4]) = CN_Tbl_Idx;
02690                IL_IDX(list_array[4]) = CN_INTEGER_ONE_IDX;
02691                IL_LINE_NUM(list_array[4]) = TOKEN_LINE(token);
02692                IL_COL_NUM(list_array[4])  = TOKEN_COLUMN(token);
02693 
02694 # endif
02695                break;
02696 
02697             case Tok_Dir_Control:
02698 
02699                if (LA_CH_VALUE == LPAREN) {
02700                   NEXT_LA_CH;
02701                   parse_var_name_list(&opnd);
02702 
02703                   if (IL_IDX(list_array[5]) == NULL_IDX) {
02704                      COPY_OPND(IL_OPND(list_array[5]), opnd);
02705                   }
02706                   else {
02707                      /* find the end of list */
02708 
02709                      list_idx = IL_IDX(list_array[5]);
02710                      while (IL_NEXT_LIST_IDX(list_idx)) {
02711                         list_idx = IL_NEXT_LIST_IDX(list_idx);
02712                      }
02713 
02714                      /* append the new list */
02715                      IL_NEXT_LIST_IDX(list_idx) = OPND_IDX(opnd);
02716                      IL_PREV_LIST_IDX(OPND_IDX(opnd)) = list_idx;
02717                      IL_LIST_CNT(list_array[5]) += OPND_LIST_CNT(opnd);
02718                   }
02719 
02720                   if (LA_CH_VALUE == RPAREN) {
02721                      NEXT_LA_CH;
02722                   }
02723                   else {
02724                      parse_err_flush(Find_EOS, ")");
02725                      goto EXIT;
02726                   }
02727                }
02728                else {
02729                   parse_err_flush(Find_EOS, "(");
02730                   goto EXIT;
02731                }
02732 
02733                break;
02734 
02735             case Tok_Dir_Maxcpus:
02736 
02737                if (LA_CH_VALUE == LPAREN) {
02738                   NEXT_LA_CH;
02739                   parse_expr(&opnd);
02740                   COPY_OPND(IL_OPND(list_array[6]), opnd);
02741 
02742                   if (LA_CH_VALUE == RPAREN) {
02743                      NEXT_LA_CH;
02744                   }
02745                   else {
02746                      parse_err_flush(Find_EOS, ")");
02747                      goto EXIT;
02748                   }
02749                }
02750                else {
02751                   parse_err_flush(Find_EOS, "(");
02752                   goto EXIT;
02753                }
02754                break;
02755 
02756             default:
02757                parse_err_flush(Find_EOS, NULL);
02758                PRINTMSG(TOKEN_LINE(token), 809, Error, TOKEN_COLUMN(token));
02759                break;
02760          }
02761       }
02762       else {
02763          parse_err_flush(Find_EOS, "parameter");
02764       }
02765 
02766       if (LA_CH_VALUE == COMMA) {
02767          NEXT_LA_CH;
02768       }
02769    }
02770 
02771 EXIT:
02772 
02773    TRACE (Func_Exit, "parse_parallel_cmic", NULL);
02774 
02775    return;
02776 
02777 }  /* parse_parallel_cmic */
02778 
02779 /******************************************************************************\
02780 |*                        *|
02781 |* Description:                     *|
02782 |*  Tasking directive block checks for end and contains stmts.            *|
02783 |*                        *|
02784 |* Input parameters:                    *|
02785 |*  NONE                      *|
02786 |*                        *|
02787 |* Output parameters:                   *|
02788 |*  NONE                      *|
02789 |*                        *|
02790 |* Returns:                     *|
02791 |*  NOTHING                     *|
02792 |*                        *|
02793 \******************************************************************************/
02794 
02795 void do_cmic_blk_checks(void)
02796 
02797 {
02798 
02799 
02800    TRACE (Func_Entry, "do_cmic_blk_checks", NULL);
02801 
02802    if (cdir_switches.doall_sh_idx != NULL_IDX) {
02803       PRINTMSG(SH_GLB_LINE(cdir_switches.doall_sh_idx), 1219, Error,
02804                SH_COL_NUM(cdir_switches.doall_sh_idx),
02805                "DO ALL");
02806    }
02807 
02808    /* BHJ need new message here */
02809 
02810    if (cdir_switches.doacross_sh_idx != NULL_IDX) {
02811       PRINTMSG(SH_GLB_LINE(cdir_switches.doacross_sh_idx), 1219, Error,
02812                SH_COL_NUM(cdir_switches.doacross_sh_idx),
02813                "DOACROSS");
02814    }
02815 
02816    cdir_switches.no_internal_calls = FALSE;
02817    cdir_switches.parallel_region   = FALSE;
02818    cdir_switches.doall_region      = FALSE;
02819    cdir_switches.casedir           = FALSE;
02820    cdir_switches.guard             = FALSE;
02821    cdir_switches.guard_has_flag    = FALSE;
02822    cdir_switches.guard_in_par_reg  = FALSE;
02823    cdir_switches.do_parallel       = FALSE;
02824 
02825    cdir_switches.doall_sh_idx = NULL_IDX;
02826    cdir_switches.doacross_sh_idx = NULL_IDX;
02827    cdir_switches.dopar_sh_idx = NULL_IDX;
02828 
02829    TRACE (Func_Exit, "do_cmic_blk_checks", NULL);
02830 
02831    return;
02832 
02833 }  /* do_cmic_blk_checks */
02834 
02835 /******************************************************************************\
02836 |*                                                                            *|
02837 |* Description:                                                               *|
02838 |*      This routine parses the variable and/or common block lists that are   *|
02839 |*      on a CACHE_ALIGN cdir. No subobjects are allowed.                     *|
02840 |*                                                                            *|
02841 |* Input parameters:                                                          *|
02842 |*      NONE                                                                  *|
02843 |*                                                                            *|
02844 |* Output parameters:                                                         *|
02845 |*      opnd - points to list of attrs.                                       *|
02846 |*                                                                            *|
02847 |* Returns:                                                                   *|
02848 |*      NOTHING                                                               *|
02849 |*                                                                            *|
02850 \******************************************************************************/
02851 
02852 static void parse_cache_align_name_list(opnd_type *list_opnd)
02853 
02854 {
02855    int    col;
02856    int    line;
02857    int          list_idx = NULL_IDX;
02858    opnd_type    opnd;
02859    int          sb_idx;
02860 
02861 
02862    TRACE (Func_Entry, "parse_cache_align_name_list", NULL);
02863 
02864    while(TRUE) {
02865       if (LA_CH_VALUE == SLASH) {
02866          /* must be common block */
02867          NEXT_LA_CH;    /* eat slash */
02868 
02869          if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
02870 
02871             if (LA_CH_VALUE == SLASH) {
02872                NEXT_LA_CH;   /* eat slash */
02873                sb_idx = srch_stor_blk_tbl(TOKEN_STR(token),
02874                                           TOKEN_LEN(token),
02875                                           curr_scp_idx);
02876 
02877                if (sb_idx == NULL_IDX) {
02878                   sb_idx = ntr_stor_blk_tbl(TOKEN_STR(token),
02879                                             TOKEN_LEN(token),
02880                                             TOKEN_LINE(token),
02881                                             TOKEN_COLUMN(token),
02882                                             Common);
02883                   SB_BLANK_COMMON(sb_idx)        = FALSE;
02884                   SB_COMMON_NEEDS_OFFSET(sb_idx) = TRUE;
02885                   SB_IS_COMMON(sb_idx)           = TRUE;
02886                }
02887 
02888                if (SB_CACHE_ALIGN(sb_idx)) {
02889                   /* already specified in CACHE_ALIGN cdir */
02890                   PRINTMSG(TOKEN_LINE(token), 1065, Error,
02891                            TOKEN_COLUMN(token), SB_NAME_PTR(sb_idx));
02892                }
02893                else {
02894                   SB_CACHE_ALIGN(sb_idx) = TRUE;
02895                }
02896             }
02897             else {
02898                parse_err_flush(Find_EOS, "/");
02899             }
02900          }
02901          else {
02902             parse_err_flush(Find_EOS, "common-block-name");
02903          }
02904       }
02905       else if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
02906          parse_deref(&opnd, NULL_IDX);
02907 
02908          if (OPND_FLD(opnd) != AT_Tbl_Idx) {
02909             find_opnd_line_and_column(&opnd, &line, &col);
02910             PRINTMSG(line, 1487, Error, col, "CACHE_ALIGN");
02911          }
02912          else {
02913             if (list_idx == NULL_IDX) {
02914                NTR_IR_LIST_TBL(list_idx);
02915                OPND_FLD((*list_opnd)) = IL_Tbl_Idx;
02916                OPND_IDX((*list_opnd)) = list_idx;
02917                OPND_LIST_CNT((*list_opnd)) = 1;
02918             }
02919             else {
02920                NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
02921                IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
02922                (OPND_LIST_CNT((*list_opnd)))++;
02923                list_idx = IL_NEXT_LIST_IDX(list_idx);
02924             }
02925             COPY_OPND(IL_OPND(list_idx), opnd);
02926          }
02927       }
02928       else {
02929          parse_err_flush(Find_EOS, "IDENTIFIER");
02930       }
02931 
02932       if (LA_CH_VALUE != COMMA) {
02933          break;
02934       }
02935       NEXT_LA_CH;
02936    }
02937 
02938    TRACE (Func_Exit, "parse_cache_align_name_list", NULL);
02939 
02940    return;
02941 
02942 }  /* parse_cache_align_name_list */
02943 
02944 /******************************************************************************\
02945 |*                        *|
02946 |* Description:                     *|
02947 |*  This routine parses the CDIR$ NAME line.                        *|
02948 |*                        *|
02949 |* Input parameters:                    *|
02950 |*  NONE                      *|
02951 |*                        *|
02952 |* Output parameters:                   *|
02953 |*  NONE                      *|
02954 |*                        *|
02955 |* Returns:                     *|
02956 |*  NOTHING                     *|
02957 |*                        *|
02958 \******************************************************************************/
02959 static void parse_name_dir(void)
02960 
02961 {
02962    int    attr_idx;
02963    int    column;
02964    int    idx;
02965    long   length;
02966    int    line;
02967    char        *name;
02968    int    name_idx;
02969    opnd_type  opnd;
02970 
02971 
02972    TRACE (Func_Entry, "parse_name_dir", NULL);
02973 
02974    if (LA_CH_VALUE != LPAREN) {
02975       parse_err_flush(Find_EOS, "(");
02976       NEXT_LA_CH;  /* pick up EOS */
02977       return;
02978    }
02979 
02980    NEXT_LA_CH;  /* Pick up Lparen */
02981 
02982    do {
02983       if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
02984          attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token),
02985                                  &name_idx);
02986 
02987          if (attr_idx == NULL_IDX) {
02988             attr_idx      = ntr_sym_tbl(&token, name_idx);
02989             LN_DEF_LOC(name_idx)  = TRUE;
02990             AT_OBJ_CLASS(attr_idx)  = Pgm_Unit;
02991             ATP_PROC(attr_idx)    = Extern_Proc;
02992             ATP_NAME_IN_STONE(attr_idx) = TRUE;
02993             ATP_SCP_IDX(attr_idx) = curr_scp_idx;
02994          }
02995          else if (!fnd_semantic_err(Obj_Name,
02996                                     TOKEN_LINE(token),
02997                                     TOKEN_COLUMN(token),
02998                                     attr_idx,
02999                                     TRUE)) {
03000 
03001             if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) {
03002                AT_ATTR_LINK(attr_idx) = NULL_IDX;
03003                LN_DEF_LOC(name_idx) = TRUE;
03004             }
03005 
03006             if (AT_OBJ_CLASS(attr_idx) == Data_Obj) {
03007                chg_data_obj_to_pgm_unit(attr_idx,
03008                                         Pgm_Unknown,
03009                                         Extern_Proc);
03010                ATP_NAME_IN_STONE(attr_idx)  = TRUE;
03011             }
03012             else if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit) {
03013                ATP_PROC(attr_idx)   = Extern_Proc;
03014                ATP_NAME_IN_STONE(attr_idx)  = TRUE;
03015             }
03016          }
03017          else {
03018             CREATE_ERR_ATTR(attr_idx,
03019                             TOKEN_LINE(token),
03020                             TOKEN_COLUMN(token),
03021                             Pgm_Unit);
03022             ATP_PROC(attr_idx)    = Extern_Proc;
03023             ATP_NAME_IN_STONE(attr_idx) = TRUE;
03024          }
03025 
03026          if (LA_CH_VALUE == EQUAL) {
03027             NEXT_LA_CH;
03028 
03029             if (LA_CH_VALUE == QUOTE ||
03030                 LA_CH_VALUE == DBL_QUOTE) {
03031 
03032                if (parse_operand(&opnd)) {
03033                   find_opnd_line_and_column(&opnd, &line, &column);
03034 
03035                   if (OPND_FLD(opnd)!= CN_Tbl_Idx ||
03036                       TYP_TYPE(CN_TYPE_IDX(OPND_IDX(opnd))) != Character) {
03037                      PRINTMSG(line, 1111, Error, column);
03038                      AT_DCL_ERR(attr_idx)   = TRUE;
03039                      ATP_EXT_NAME_LEN(attr_idx) = AT_NAME_LEN(attr_idx);
03040                      ATP_EXT_NAME_IDX(attr_idx) = AT_NAME_IDX(attr_idx);
03041                   }
03042                   else {
03043                      length = (long) CN_INT_TO_C(TYP_IDX(
03044                                                  CN_TYPE_IDX(OPND_IDX(opnd))));
03045 
03046                      NTR_NAME_POOL((long *) &(CN_CONST(OPND_IDX(opnd))), 
03047                                    (int) length, name_idx);
03048 
03049                      ATP_EXT_NAME_IDX(attr_idx) = name_idx;
03050                      ATP_EXT_NAME_LEN(attr_idx) = length;
03051                      name     = ATP_EXT_NAME_PTR(attr_idx);
03052 
03053                      for (idx = 0; 
03054                           idx < (WORD_LEN(length)*TARGET_BYTES_PER_WORD)-length;
03055                           idx++) {
03056                         *(name + length + idx) = '\0';
03057                      }
03058                   }
03059                }
03060                else {
03061                   parse_err_flush(Find_Rparen, NULL);
03062                   AT_DCL_ERR(attr_idx)    = TRUE;
03063                   ATP_EXT_NAME_LEN(attr_idx)  = AT_NAME_LEN(attr_idx);
03064                   ATP_EXT_NAME_IDX(attr_idx)  = AT_NAME_IDX(attr_idx);
03065                }
03066             }
03067             else {
03068                PRINTMSG(LA_CH_LINE, 1111, Error, LA_CH_COLUMN);
03069                parse_err_flush(Find_Rparen, NULL);
03070                AT_DCL_ERR(attr_idx)   = TRUE;
03071                ATP_EXT_NAME_LEN(attr_idx) = AT_NAME_LEN(attr_idx);
03072                ATP_EXT_NAME_IDX(attr_idx) = AT_NAME_IDX(attr_idx);
03073             }
03074          }
03075          else { 
03076             parse_err_flush(Find_Rparen, "=");
03077             AT_DCL_ERR(attr_idx)  = TRUE;
03078             ATP_EXT_NAME_LEN(attr_idx)  = AT_NAME_LEN(attr_idx);
03079             ATP_EXT_NAME_IDX(attr_idx)  = AT_NAME_IDX(attr_idx);
03080          }
03081       }
03082       else if (!parse_err_flush(Find_Comma, "procedure name")) {
03083          break;     /* Couldn't recover.  Hit EOS */
03084       }
03085 
03086       if (LA_CH_VALUE == COMMA) {
03087          NEXT_LA_CH;
03088       }
03089       else {
03090          break;
03091       }
03092    }
03093    while (TRUE);
03094 
03095    if (LA_CH_VALUE == RPAREN || parse_err_flush(Find_Rparen, ", or )")) {
03096       NEXT_LA_CH;
03097    }
03098 
03099    if (LA_CH_VALUE != EOS) {
03100       parse_err_flush(Find_EOS, EOS_STR);
03101    }
03102       
03103    NEXT_LA_CH;    /* Pick up EOS */
03104 
03105    TRACE (Func_Exit, "parse_name_dir", NULL);
03106 
03107    return;
03108 
03109 }  /* parse_name_dir */
03110 
03111 /******************************************************************************\
03112 |*                        *|
03113 |* Description:                     *|
03114 |*  This routine parses the CMIC$ PERMUTATION line.                       *|
03115 |*                        *|
03116 |* Input parameters:                    *|
03117 |*  NONE                      *|
03118 |*                        *|
03119 |* Output parameters:                   *|
03120 |*  NONE                      *|
03121 |*                        *|
03122 |* Returns:                     *|
03123 |*  NOTHING                     *|
03124 |*                        *|
03125 \******************************************************************************/
03126 static void parse_permutation_mic(void)
03127 
03128 {
03129    int    attr_idx;
03130    int    name_idx;
03131 
03132 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
03133    int    ir_idx;
03134    int    list_idx = NULL_IDX;
03135 # endif
03136 
03137 
03138    TRACE (Func_Entry, "parse_permutation_mic", NULL);
03139 
03140    if (LA_CH_VALUE != LPAREN) {
03141       parse_err_flush(Find_EOS, "(");
03142       return;
03143    }
03144 
03145 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
03146    ir_idx = SH_IR_IDX(curr_stmt_sh_idx);
03147    IR_OPR(ir_idx) = Assert_Star_Opr;
03148 
03149    IR_FLD_L(ir_idx) = CN_Tbl_Idx;
03150    IR_IDX_L(ir_idx) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
03151                                   ASSERT_PERMUTATION);
03152    IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
03153    IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
03154 # endif
03155 
03156    NEXT_LA_CH;  /* Pick up Lparen */
03157 
03158    do {
03159 
03160       if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
03161          attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token),
03162                                  &name_idx);
03163 
03164          if (attr_idx == NULL_IDX) {
03165             attr_idx      = ntr_sym_tbl(&token, name_idx);
03166             LN_DEF_LOC(name_idx)  = TRUE;
03167             AT_OBJ_CLASS(attr_idx)  = Data_Obj;
03168             ATD_PERMUTATION(attr_idx) = TRUE;
03169          }
03170          else if (AT_OBJ_CLASS(attr_idx) != Data_Obj) {
03171             PRINTMSG(AT_DEF_LINE(attr_idx), 1126, Error, 
03172                      AT_DEF_COLUMN(attr_idx),
03173                      AT_OBJ_NAME_PTR(attr_idx));
03174             AT_DCL_ERR(attr_idx)  = TRUE;
03175          }
03176          else {
03177             ATD_PERMUTATION(attr_idx) = TRUE;
03178 
03179             if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) {
03180                AT_ATTR_LINK(attr_idx) = NULL_IDX;
03181                LN_DEF_LOC(name_idx) = TRUE;
03182             }
03183          }
03184 
03185 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
03186          if (list_idx == NULL_IDX) {
03187             NTR_IR_LIST_TBL(list_idx);
03188             IR_FLD_R(ir_idx) = IL_Tbl_Idx;
03189             IR_IDX_R(ir_idx) = list_idx;
03190             IR_LIST_CNT_R(ir_idx) = 1;
03191          }
03192          else {
03193             NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
03194             IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
03195             list_idx = IL_NEXT_LIST_IDX(list_idx);
03196             (IR_LIST_CNT_R(ir_idx))++;
03197          }
03198 
03199          IL_FLD(list_idx) = AT_Tbl_Idx;
03200          IL_IDX(list_idx) = attr_idx;
03201          IL_LINE_NUM(list_idx) = TOKEN_LINE(token);
03202          IL_COL_NUM(list_idx) = TOKEN_COLUMN(token);
03203 # endif
03204       }
03205       else if (!parse_err_flush(Find_Comma, "array name")) {
03206          break;     /* Couldn't recover.  Hit EOS */
03207       }
03208 
03209       if (LA_CH_VALUE == COMMA) {
03210          NEXT_LA_CH;
03211       }
03212       else {
03213          break;
03214       }
03215    }
03216    while (TRUE);
03217 
03218    if (LA_CH_VALUE == RPAREN || parse_err_flush(Find_Rparen, ", or )")) {
03219       NEXT_LA_CH;
03220    }
03221 
03222    if (LA_CH_VALUE != EOS) {
03223       parse_err_flush(Find_EOS, EOS_STR);
03224    }
03225 
03226    TRACE (Func_Exit, "parse_permutation_mic", NULL);
03227 
03228    return;
03229 
03230 }  /* parse_permutation_mic */
03231 
03232 /******************************************************************************\
03233 |*                        *|
03234 |* Description:                     *|
03235 |*  This routine parses the CDIR$ INLINE ALWAYS and INLINE NEVER line.    *|
03236 |*                        *|
03237 |* Input parameters:                    *|
03238 |*  NONE                      *|
03239 |*                        *|
03240 |* Output parameters:                   *|
03241 |*  NONE                      *|
03242 |*                        *|
03243 |* Returns:                     *|
03244 |*  NOTHING                     *|
03245 |*                        *|
03246 \******************************************************************************/
03247 static void parse_inline_always_never(boolean always)
03248 
03249 {
03250    boolean  amb_ref;
03251    int    attr_idx;
03252    int    host_attr_idx;
03253    int    host_name_idx;
03254    int    name_idx;
03255 
03256 
03257    TRACE (Func_Entry, "parse_inline_always_never", NULL);
03258 
03259    do {
03260       if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
03261          amb_ref  = FALSE;
03262          attr_idx = srch_sym_tbl(TOKEN_STR(token),
03263                                  TOKEN_LEN(token),
03264                                  &name_idx);
03265 
03266          if (attr_idx != NULL_IDX) {
03267             host_attr_idx = attr_idx;
03268 
03269             if (!LN_DEF_LOC(name_idx)) {
03270                amb_ref = TRUE;
03271 
03272                while (AT_ATTR_LINK(host_attr_idx) != NULL_IDX) {
03273                   host_attr_idx = AT_ATTR_LINK(host_attr_idx);
03274                }
03275             }
03276          }
03277          else { /* any other reference is ambiguous */
03278             amb_ref   = TRUE;
03279             host_attr_idx = srch_host_sym_tbl(TOKEN_STR(token),
03280                                                     TOKEN_LEN(token),
03281                                                     &host_name_idx,
03282                                                     TRUE);
03283 
03284             if (host_attr_idx != NULL_IDX) { 
03285 
03286                if (AT_IS_INTRIN(host_attr_idx) &&
03287                    ATI_FIRST_SPECIFIC_IDX(host_attr_idx) == NULL_IDX) {
03288                    complete_intrinsic_definition(host_attr_idx);
03289                    attr_idx = srch_sym_tbl(TOKEN_STR(token),
03290                                            TOKEN_LEN(token),
03291                                            &name_idx);
03292                }
03293 
03294                /* copy the attr into the local scp */
03295 
03296                attr_idx = ntr_host_in_sym_tbl(&token,
03297                                               name_idx,
03298                                               host_attr_idx,
03299                                               host_name_idx,
03300                                               TRUE);
03301 
03302                if (AT_IS_INTRIN(host_attr_idx)) {
03303                   COPY_VARIANT_ATTR_INFO(host_attr_idx,
03304                                          attr_idx,
03305                                          Interface);
03306 
03307                   AT_IS_INTRIN(attr_idx)  = TRUE;
03308                   AT_ATTR_LINK(attr_idx)  = NULL_IDX;
03309                   AT_ELEMENTAL_INTRIN(attr_idx) = 
03310                                            AT_ELEMENTAL_INTRIN(host_attr_idx);
03311                   AT_DEF_LINE(attr_idx)         = TOKEN_LINE(token);
03312                   AT_DEF_COLUMN(attr_idx)       = TOKEN_COLUMN(token);
03313                }
03314                else if (AT_OBJ_CLASS(attr_idx) != Interface) {
03315                   AT_ATTR_LINK(attr_idx) = host_attr_idx;
03316 
03317                   while (AT_ATTR_LINK(host_attr_idx) != NULL_IDX) {
03318                      host_attr_idx = AT_ATTR_LINK(host_attr_idx);
03319                   }
03320                }
03321             }
03322          }
03323 
03324          if (attr_idx == NULL_IDX) {
03325             attr_idx      = ntr_sym_tbl(&token, name_idx);
03326             AT_OBJ_CLASS(attr_idx)  = Pgm_Unit;
03327             ATP_PGM_UNIT(attr_idx)  = Pgm_Unknown;
03328             ATP_SCP_IDX(attr_idx) = curr_scp_idx;
03329             ATP_PROC(attr_idx)    = Unknown_Proc;
03330             MAKE_EXTERNAL_NAME(attr_idx,
03331                                AT_NAME_IDX(attr_idx),
03332                                AT_NAME_LEN(attr_idx));
03333          }
03334          else if (!amb_ref) {
03335 
03336             /* Allow the inline directive with user specified intrinsics */
03337             /* We will check for user specified intrinsics in decl_sem   */
03338 
03339             if (fnd_semantic_err(Obj_Inline,
03340                                  TOKEN_LINE(token),
03341                                  TOKEN_COLUMN(token),
03342                                  attr_idx,
03343                                  TRUE)) {
03344 
03345                goto NEXT;
03346             }
03347          }
03348 
03349          if (AT_OBJ_CLASS(attr_idx) == Pgm_Unit &&
03350              (ATP_INLINE_ALWAYS(attr_idx) || ATP_INLINE_NEVER(attr_idx))) {
03351 
03352             if ((always && ATP_INLINE_NEVER(attr_idx)) ||
03353                 (!always && ATP_INLINE_ALWAYS(attr_idx))) {
03354                PRINTMSG(AT_DEF_LINE(attr_idx), 1147, Error, 
03355                         AT_DEF_COLUMN(attr_idx),
03356                         AT_OBJ_NAME_PTR(attr_idx));
03357             }
03358          }
03359          else {
03360 
03361             if (AT_OBJ_CLASS(attr_idx) == Interface) {
03362 
03363                if (ATI_INLINE_ALWAYS(attr_idx) || ATI_INLINE_NEVER(attr_idx)) {
03364 
03365                   if ((always && ATI_INLINE_NEVER(attr_idx)) ||
03366                       (!always && ATI_INLINE_ALWAYS(attr_idx))) {
03367                      PRINTMSG(AT_DEF_LINE(attr_idx), 1147, Error, 
03368                               AT_DEF_COLUMN(attr_idx),
03369                               AT_OBJ_NAME_PTR(attr_idx));
03370                   }
03371                }
03372                else if (always) {
03373                   ATI_INLINE_ALWAYS(attr_idx) = TRUE;
03374                }
03375                else {
03376                   ATI_INLINE_NEVER(attr_idx)  = TRUE;
03377                }
03378             }
03379             else {
03380 
03381                if (AT_OBJ_CLASS(attr_idx) == Data_Obj) { /* Switch to Function*/
03382                   chg_data_obj_to_pgm_unit(attr_idx, Pgm_Unknown, Unknown_Proc);
03383                }
03384 
03385                if (always) {
03386                   ATP_INLINE_ALWAYS(attr_idx) = TRUE;
03387                }
03388                else {
03389                   ATP_INLINE_NEVER(attr_idx)  = TRUE;
03390                }
03391             }
03392          }
03393       }
03394       else if (!parse_err_flush(Find_Comma, "procedure name")) {
03395          break;     /* Couldn't recover.  Hit EOS */
03396       }
03397 
03398 NEXT:
03399 
03400       if (LA_CH_VALUE == COMMA) {
03401          NEXT_LA_CH;
03402       }
03403       else if (LA_CH_VALUE == EOS ||
03404                !parse_err_flush(Find_Comma, ", or "EOS_STR)) {
03405          break;
03406       }
03407       else {  /* Issued error and recovered at a comma */
03408          NEXT_LA_CH;
03409       }
03410    }
03411    while (TRUE);
03412 
03413    NEXT_LA_CH;    /* Pick up EOS */
03414 
03415    TRACE (Func_Exit, "parse_inline_always_never", NULL);
03416 
03417    return;
03418 
03419 }  /* parse_inline_always_never */
03420 
03421 /******************************************************************************\
03422 |*                        *|
03423 |* Description:                     *|
03424 |*  Check an index to see if it needs a type update.          *|
03425 |*                        *|
03426 |* Input parameters:                    *|
03427 |*  NONE                      *|
03428 |*                        *|
03429 |* Output parameters:                   *|
03430 |*  NONE                      *|
03431 |*                        *|
03432 |* Returns:                     *|
03433 |*  NOTHING                     *|
03434 |*                        *|
03435 \******************************************************************************/
03436 static int  update_fld_type(fld_type  fld,
03437         int   idx,
03438         int   new_type)
03439 
03440 {
03441    int    new_idx;
03442    long_type  the_constant[MAX_WORDS_FOR_INTEGER];
03443    int    type_idx;
03444 
03445 
03446    TRACE (Func_Entry, "update_fld_type", NULL);
03447 
03448    switch (fld) {
03449    case CN_Tbl_Idx:
03450 
03451       if (CN_TYPE_IDX(idx) == INTEGER_DEFAULT_TYPE) {
03452          type_idx = new_type;
03453 
03454          if (folder_driver((char *)CN_CONST(idx),
03455                            INTEGER_DEFAULT_TYPE,
03456                            NULL,
03457                            NULL_IDX,
03458                            the_constant,
03459                            &type_idx,
03460                            stmt_start_line,
03461                            stmt_start_col,
03462                            1,
03463                            Cvrt_Opr)) {
03464             new_idx = ntr_const_tbl(new_type,
03465                                     FALSE,
03466                                     the_constant);
03467          }
03468       }
03469       break;
03470 
03471    case AT_Tbl_Idx:
03472 
03473       if (AT_OBJ_CLASS(idx) == Data_Obj) {
03474 
03475          switch (ATD_CLASS(idx)) {
03476          case Constant:
03477 
03478             if (ATD_TYPE_IDX(idx) == INTEGER_DEFAULT_TYPE) {
03479                new_idx      = update_fld_type(CN_Tbl_Idx,
03480                                                     ATD_CONST_IDX(idx),
03481                                                     new_type);
03482                ATD_CONST_IDX(idx) = new_idx;
03483             }
03484             break;
03485 
03486          case Function_Result:
03487          case Atd_Unknown:
03488          case Dummy_Argument:
03489          case CRI__Pointee:
03490          case Struct_Component:
03491             break;
03492 
03493          case Compiler_Tmp:
03494             new_idx = update_fld_type((fld_type) ATD_FLD(idx),
03495                                       ATD_TMP_IDX(idx),
03496                                       new_type);
03497 
03498             if (ATD_FLD(idx) == CN_Tbl_Idx) {
03499                ATD_TMP_IDX(idx) = new_idx;
03500             }
03501             break;
03502          }  /* End switch */
03503 
03504          if (ATD_TYPE_IDX(idx) == INTEGER_DEFAULT_TYPE) {
03505             ATD_TYPE_IDX(idx) = new_type;
03506          }
03507       }
03508       else if (AT_OBJ_CLASS(idx) == Pgm_Unit &&
03509                ATP_PGM_UNIT(idx) == Function &&
03510                ATP_RSLT_IDX(idx) != NULL_IDX &&
03511                ATD_TYPE_IDX(ATP_RSLT_IDX(idx)) == INTEGER_DEFAULT_TYPE) {
03512          ATD_TYPE_IDX(ATP_RSLT_IDX(idx))  = new_type;
03513       }
03514       new_idx   = NULL_IDX;
03515 
03516       break;
03517 
03518    case IR_Tbl_Idx:
03519 
03520       new_idx = update_fld_type(IR_FLD_L(idx), IR_IDX_L(idx), new_type);
03521 
03522       if (IR_FLD_L(idx) == CN_Tbl_Idx) {
03523          IR_IDX_L(idx) = new_idx;
03524       }
03525 
03526       new_idx = update_fld_type(IR_FLD_R(idx), IR_IDX_R(idx), new_type);
03527 
03528       if (IR_FLD_R(idx) == CN_Tbl_Idx) {
03529          IR_IDX_R(idx) = new_idx;
03530       }
03531 
03532       new_idx = NULL_IDX;
03533 
03534       if (IR_TYPE_IDX(idx) == INTEGER_DEFAULT_TYPE) {
03535          IR_TYPE_IDX(idx) = new_type;
03536       }
03537      
03538       break;
03539 
03540    case IL_Tbl_Idx:
03541 
03542       while (idx != NULL_IDX) {
03543          new_idx = update_fld_type(IL_FLD(idx), IL_IDX(idx), new_type);
03544 
03545          if (IL_FLD(idx) == CN_Tbl_Idx) {
03546             IL_IDX(idx) = new_idx;
03547          }
03548          idx  = IL_NEXT_LIST_IDX(idx);
03549       }
03550       new_idx = NULL_IDX;
03551       break;
03552 
03553    case NO_Tbl_Idx:
03554    case SH_Tbl_Idx:
03555       new_idx = NULL_IDX;
03556       break;
03557 
03558    }  /* End switch */
03559 
03560    TRACE (Func_Exit, "update_fld_type", NULL);
03561 
03562    return(new_idx);
03563 
03564 }  /* update_fld_type */
03565 
03566 /******************************************************************************\
03567 |*                        *|
03568 |* Description:                     *|
03569 |*  This routine parses the CDIR$ SYMMETRIC line.                         *|
03570 |*                        *|
03571 |* Input parameters:                    *|
03572 |*  NONE                      *|
03573 |*                        *|
03574 |* Output parameters:                   *|
03575 |*  NONE                      *|
03576 |*                        *|
03577 |* Returns:                     *|
03578 |*  NOTHING                     *|
03579 |*                        *|
03580 \******************************************************************************/
03581 static void parse_symmetric_dir(void)
03582 
03583 {
03584    int    attr_idx;
03585    int    name_idx;
03586 
03587 
03588    TRACE (Func_Entry, "parse_symmetric_dir", NULL);
03589 
03590    do {
03591       if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
03592          attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token),
03593                                  &name_idx);
03594 
03595          if (attr_idx == NULL_IDX) {
03596             attr_idx      = ntr_sym_tbl(&token, name_idx);
03597             LN_DEF_LOC(name_idx)  = TRUE;
03598             AT_OBJ_CLASS(attr_idx)  = Data_Obj;
03599             ATD_SYMMETRIC(attr_idx) = TRUE;
03600             ATD_CLASS(attr_idx)   = Variable;
03601             SET_IMPL_TYPE(attr_idx);
03602          }
03603          else if (!fnd_semantic_err(Obj_Symmetric, 
03604                                     TOKEN_LINE(token),
03605                                     TOKEN_COLUMN(token),
03606                                     attr_idx,
03607                                     TRUE)) {
03608 
03609             if (AT_REFERENCED(attr_idx) == Char_Rslt_Bound_Ref) {
03610                AT_ATTR_LINK(attr_idx) = NULL_IDX;
03611                LN_DEF_LOC(name_idx) = TRUE;
03612             }
03613 
03614             ATD_SYMMETRIC(attr_idx) = TRUE;
03615             ATD_CLASS(attr_idx)   = Variable;
03616          }
03617       }
03618       else if (!parse_err_flush(Find_Comma, "procedure name")) {
03619          break;     /* Couldn't recover.  Hit EOS */
03620       }
03621 
03622       if (LA_CH_VALUE == COMMA) {
03623          NEXT_LA_CH;
03624       }
03625       else if (LA_CH_VALUE == EOS ||
03626                !parse_err_flush(Find_Comma, ", or "EOS_STR)) {
03627          break;
03628       }
03629       else {  /* Issued error and recovered at a comma */
03630          NEXT_LA_CH;
03631       }
03632    }
03633    while (TRUE);
03634 
03635    NEXT_LA_CH;    /* Pick up EOS */
03636 
03637    TRACE (Func_Exit, "parse_symmetric_dir", NULL);
03638 
03639    return;
03640 
03641 }  /* parse_symmetric_dir */
03642 
03643 /******************************************************************************\
03644 |*                        *|
03645 |* Description:                     *|
03646 |*  This routine parses the !DIR$ directives on one line of source.       *|
03647 |*                        *|
03648 |* Input parameters:                    *|
03649 |*  NONE                      *|
03650 |*                        *|
03651 |* Output parameters:                   *|
03652 |*  NONE                      *|
03653 |*                        *|
03654 |* Returns:                     *|
03655 |*  NOTHING                     *|
03656 |*                        *|
03657 \******************************************************************************/
03658 static void parse_dir_directives(void)
03659 {
03660 
03661    int      blk_idx;
03662    int      buf_idx;
03663    int      cdir_info_idx;
03664    int      ir_idx;
03665    int      label_idx;
03666    int      list_idx;
03667    opnd_type    opnd;
03668    operator_type  opr;
03669    int      stmt_num;
03670    int      type_idx;
03671 
03672 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
03673    int      cvrt_idx;
03674 # endif
03675 
03676 
03677    TRACE (Func_Entry, "parse_dir_directives", NULL);
03678 
03679    for (;;) {
03680 
03681       if (TOKEN_VALUE(token) > Tok_Dir_Start &&
03682           TOKEN_VALUE(token) < Tok_Dir_End &&
03683           disregard_directive[TOKEN_VALUE(token) - Tok_Dir_Start]) {
03684 
03685          /* Some CDIR$s have a list associated with them.  In such a case,    */
03686          /* if the CDIR$ is being ignored, we can flush to the end of the     */
03687          /* line because no other CDIR$ can follow it on the line.  In all    */
03688          /* other cases, we can only flush to the next comma so that a        */
03689          /* following CDIR$ can be processed (if one exists).         */
03690 
03691          /* There are probably several more CDIR$s that need to be added to   */
03692          /* "list" group once we implement the MPP/CRAFT CDIR$s.        */
03693     
03694          switch (TOKEN_VALUE(token)) {
03695 
03696             case Tok_Dir_Auxiliary:
03697             case Tok_Dir_Blockable:
03698             case Tok_Dir_Blockingsize:
03699             case Tok_Dir_Bounds:
03700             case Tok_Dir_Cache_Align:
03701             case Tok_Dir_Cache_Noalloc:
03702             case Tok_Dir_Cncall:
03703             case Tok_Dir_Common:
03704             case Tok_Dir_Inline_Always:
03705             case Tok_Dir_Inline_Never:
03706             case Tok_Dir_Maxcpus:
03707             case Tok_Dir_Nobounds:
03708             case Tok_Dir_Numcpus:
03709             case Tok_Dir_Cache_Bypass:
03710             case Tok_Dir_Nosideeffects:
03711             case Tok_Dir_Permutation:
03712             case Tok_Dir_Suppress:
03713             case Tok_Dir_Symmetric:
03714             case Tok_Dir_Taskcommon:
03715             case Tok_Dir_Vfunction:
03716                parse_err_flush(Find_EOS, NULL);
03717                break;
03718 
03719             default:
03720                parse_err_flush(Find_Comma, NULL);
03721          }
03722          
03723          goto CONTINUE;
03724       }
03725 
03726       if (TOKEN_VALUE(token) <= Tok_Dir_Start ||
03727           TOKEN_VALUE(token) >= Tok_Dir_End) {
03728          PRINTMSG(TOKEN_LINE(token), 790, Warning, TOKEN_COLUMN(token));
03729          parse_err_flush(Find_EOS, NULL);
03730          goto CONTINUE;  /* Invalid token */
03731       }
03732 
03733       cdir_info_idx = TOKEN_VALUE(token) - Tok_Dir_Start;
03734 
03735       /* The following determines if the directive is allowed on the */
03736       /* platform that this compiler is built for.  The table is in  */
03737       /* p_directiv.h and the target information is in target.m      */
03738 
03739       if (!cdir_info[cdir_info_idx].on_platform) {
03740          PRINTMSG(TOKEN_LINE(token), cdir_info[cdir_info_idx].msg_num, Warning, 
03741                   TOKEN_COLUMN(token));
03742          parse_err_flush(Find_EOS, NULL);
03743          goto CONTINUE;
03744       }
03745 
03746       if (cdir_info[cdir_info_idx].issue_795 &&
03747           curr_stmt_category < Dir_Integer_Stmt_Cat) {
03748          PRINTMSG(TOKEN_LINE(token), 795, Warning,
03749                   TOKEN_COLUMN(token), cdir_info[cdir_info_idx].name);
03750          parse_err_flush(Find_EOS, NULL);
03751          goto CONTINUE;
03752       }
03753 
03754       if (cdir_info[cdir_info_idx].issue_531 &&
03755           curr_stmt_category >= Executable_Stmt_Cat) {
03756          PRINTMSG(TOKEN_LINE(token), 531, Error,
03757                   TOKEN_COLUMN(token), cdir_info[cdir_info_idx].name);
03758          parse_err_flush(Find_EOS, NULL);
03759          goto CONTINUE;
03760       }
03761 
03762       switch (TOKEN_VALUE(token)) {
03763       case Tok_Dir_Align:
03764 
03765          if (opt_flags.scalar_lvl == Scalar_Lvl_0) {
03766             parse_err_flush(Find_Comma, NULL);
03767          }
03768          else {
03769             ir_idx = gen_directive_ir(Align_Cdir_Opr);
03770          }
03771          break;
03772 
03773 
03774       case Tok_Dir_Auxiliary:
03775          parse_auxiliary_dir();
03776          goto EXIT;
03777 
03778 
03779       case Tok_Dir_Bl:
03780 
03781          if (opt_flags.scalar_lvl == Scalar_Lvl_0 || !opt_flags.bottom_load) {
03782             parse_err_flush(Find_Comma, NULL);
03783          }
03784          else {
03785             cdir_switches.bl  = TRUE;
03786             ir_idx    = gen_directive_ir(Bl_Cdir_Opr);
03787          }
03788          break;
03789 
03790       case Tok_Dir_Blockable:
03791       case Tok_Dir_Blockingsize:
03792       case Tok_Dir_Interchange:
03793          parse_star_dir_directives();
03794          goto EXIT;
03795 
03796       case Tok_Dir_Bounds:
03797          cdir_switches.bounds = TRUE;
03798          ir_idx     = gen_directive_ir(Bounds_Cdir_Opr);
03799             
03800          if (LA_CH_VALUE != EOS) {
03801             parse_var_name_list(&opnd);
03802             COPY_OPND(IR_OPND_L(ir_idx), opnd);
03803 
03804             if (LA_CH_VALUE != EOS) {
03805                parse_err_flush(Find_EOS, EOS_STR);
03806             }
03807             NEXT_LA_CH; /* pick up EOS */
03808          }
03809          else {
03810             NEXT_LA_CH; /* pick up EOS */
03811          }
03812 
03813          goto EXIT;
03814    
03815 
03816       case Tok_Dir_Cache_Align:
03817 
03818          ir_idx = gen_directive_ir(Cachealign_Cdir_Opr);
03819 
03820          if (LA_CH_VALUE != EOS) {
03821             parse_cache_align_name_list(&opnd);
03822             COPY_OPND(IR_OPND_L(ir_idx), opnd);
03823          }
03824          else {
03825             parse_err_flush(Find_EOS, "IDENTIFIER");
03826          }
03827          break;
03828 
03829 
03830       case Tok_Dir_Cache_Bypass:
03831          ir_idx = gen_directive_ir(Cache_Bypass_Cdir_Opr);
03832          parse_cache_bypass_dir(&opnd);
03833          COPY_OPND(IR_OPND_L(ir_idx), opnd);
03834          goto EXIT;
03835 
03836       case Tok_Dir_Cache_Noalloc:
03837          parse_cache_noalloc();
03838          goto EXIT;
03839 
03840 
03841       case Tok_Dir_Cncall:
03842 
03843          /* this is duplicate code, taken from Tok_Mic_Cncall */
03844 
03845          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
03846          ir_idx                          = gen_directive_ir(Cncall_Cmic_Opr);
03847 
03848          if (LA_CH_VALUE != EOS && LA_CH_VALUE != COMMA) {
03849 
03850             /* Arguments are specified on the CNCALL line.  Issue caution */
03851             /* message and ignore the arguments.  Because there is a list,*/
03852             /* cncall must be the only directive on the line, so flush.   */
03853 
03854             PRINTMSG(LA_CH_LINE, 1123, Caution, LA_CH_COLUMN);
03855             parse_err_flush(Find_EOS, NULL);
03856          }
03857 
03858          break;
03859 
03860       case Tok_Dir_Common:
03861          parse_common_dirs(Common);
03862          goto EXIT;
03863 
03864 
03865       case Tok_Dir_Concurrent:
03866 
03867          if (LA_CH_VALUE != EOS && LA_CH_VALUE != COMMA) {
03868             buf_idx = LA_CH_BUF_IDX;
03869             stmt_num  = LA_CH_STMT_NUM;
03870    
03871             if (MATCHED_TOKEN_CLASS(Tok_Class_Id) &&
03872                 TOKEN_LEN(token) == 13 &&
03873                 strncmp("SAFE_DISTANCE", TOKEN_STR(token), 13) == IDENTICAL) {
03874 
03875                ir_idx = gen_directive_ir(Concurrent_Cdir_Opr);
03876 
03877                if (LA_CH_VALUE == EQUAL) {
03878                   NEXT_LA_CH;
03879                   
03880                   if (!parse_expr(&opnd)) {
03881                      parse_err_flush(Find_EOS, NULL);
03882                   }
03883                   else {
03884                      COPY_OPND(IR_OPND_L(ir_idx), opnd);
03885                   }
03886                }
03887                else {
03888                   parse_err_flush(Find_EOS, "=");
03889                }
03890             }
03891             else {
03892                reset_lex(buf_idx, stmt_num);
03893                parse_err_flush(Find_EOS, "SAFE_DISTANCE = ");
03894             }
03895          }
03896          else {
03897             ir_idx = gen_directive_ir(Concurrent_Cdir_Opr);
03898          }
03899          break;
03900 
03901 
03902       case Tok_Dir_Copy_Assumed_Shape:
03903 
03904          if (LA_CH_VALUE != EOS) {
03905             parse_copy_assumed_shape_dir();
03906          }
03907          else { /* set the global flag */
03908             SCP_COPY_ASSUMED_SHAPE(curr_scp_idx) = TRUE;
03909 
03910             if (SCP_COPY_ASSUMED_LIST(curr_scp_idx) == NULL_IDX) {
03911                NTR_IR_LIST_TBL(list_idx);
03912                IL_LINE_NUM(list_idx)      = TOKEN_LINE(token);
03913                IL_COL_NUM(list_idx)     = TOKEN_COLUMN(token);
03914                SCP_COPY_ASSUMED_LIST(curr_scp_idx)  = list_idx;
03915             }
03916 
03917             NEXT_LA_CH;          /* Pick up EOS */
03918          }
03919 
03920          goto EXIT;
03921 
03922 
03923       case Tok_Dir_Eject:
03924 
03925          if ((cif_flags & MISC_RECS) != 0) {
03926             cif_directive_rec(CIF_Eject, 
03927                               TOKEN_LINE(token),
03928                               TOKEN_COLUMN(token));
03929          }
03930          break;
03931 
03932 
03933       case Tok_Dir_Flow:
03934          cdir_switches.flow = TRUE;
03935          break;
03936 
03937 
03938       case Tok_Dir_Free:
03939       case Tok_Dir_Fixed:
03940 
03941          /* all semantics are done in src_input.c */
03942          /* context checks should be done here.   */
03943 
03944          parse_err_flush(Find_EOS, NULL);
03945          break;
03946    
03947    
03948       case Tok_Dir_Id:
03949          parse_id_directive();
03950          break;
03951 
03952 
03953       case Tok_Dir_Ignore_TKR:
03954 
03955          if (LA_CH_VALUE != EOS) {
03956             parse_ignore_tkr();
03957          }
03958          else { /* set the global flag */
03959             SCP_IGNORE_TKR(curr_scp_idx) = TRUE;
03960             NEXT_LA_CH;
03961          }
03962 
03963          goto EXIT;
03964 
03965 
03966       case Tok_Dir_Inline:
03967       case Tok_Dir_Inline_Always:
03968       case Tok_Dir_Inline_Never:
03969 
03970          if (opt_flags.inline_lvl == Inline_Lvl_0 && !dump_flags.preinline) {
03971             parse_err_flush(Find_EOS, NULL);
03972             break;
03973          }
03974 
03975          if (TOKEN_VALUE(token) == Tok_Dir_Inline) {
03976             cdir_switches.do_inline = TRUE;
03977             ir_idx      = gen_directive_ir(Inline_Cdir_Opr);
03978          }
03979          else {
03980             parse_inline_always_never(TOKEN_VALUE(token) == 
03981                                       Tok_Dir_Inline_Always);
03982             goto EXIT;
03983          }
03984          break;
03985    
03986 
03987       case Tok_Dir_Ivdep:
03988 
03989 
03990 #        if defined(_ACCEPT_VECTOR)
03991 
03992             /* On some non-vector platforms we accept IVDEP */
03993 
03994             if (!cdir_switches.vector) {
03995                parse_err_flush(Find_Comma, NULL);
03996                break;
03997             }
03998 #        endif
03999 
04000          if (LA_CH_VALUE != EOS && LA_CH_VALUE != COMMA) {
04001             buf_idx = LA_CH_BUF_IDX;
04002             stmt_num  = LA_CH_STMT_NUM;
04003    
04004             if (MATCHED_TOKEN_CLASS(Tok_Class_Id) &&
04005                 TOKEN_LEN(token) == 6 &&
04006                 strncmp("SAFEVL", TOKEN_STR(token), 6) == IDENTICAL) {
04007 
04008 #              if defined(_TARGET_OS_MAX) || (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
04009 
04010                   /* If SAFEVL specified, issue warning and ignore ivdep */
04011 
04012                   PRINTMSG(TOKEN_LINE(token), 1317,Warning,TOKEN_COLUMN(token));
04013 #              else
04014                   ir_idx = gen_directive_ir(Ivdep_Cdir_Opr);
04015 #              endif
04016 
04017                if (LA_CH_VALUE == EQUAL) {
04018                   NEXT_LA_CH;
04019                      
04020                   if (!parse_expr(&opnd)) {
04021                      parse_err_flush(Find_EOS, NULL);
04022                   }
04023                   else {
04024 
04025 #                    if !defined(_TARGET_OS_MAX) && !(defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX)) || defined(_TARGET_OS_DARWIN)
04026                         COPY_OPND(IR_OPND_L(ir_idx), opnd);
04027 #                    endif
04028                   }
04029                }
04030                else {
04031                   parse_err_flush(Find_EOS, "=");
04032                }
04033             }
04034             else {
04035                reset_lex(buf_idx,stmt_num);
04036 
04037 #              if !defined(_TARGET_OS_MAX)
04038                   parse_err_flush(Find_EOS, "SAFEVL = ");
04039 #              endif
04040             }
04041          }
04042          else {
04043             ir_idx = gen_directive_ir(Ivdep_Cdir_Opr);
04044          }
04045          break;
04046 
04047    
04048       case Tok_Dir_List:
04049 
04050          if ((cif_flags & MISC_RECS) != 0) {
04051             cif_directive_rec(CIF_List, 
04052                               TOKEN_LINE(token),
04053                               TOKEN_COLUMN(token));
04054          }
04055          break;
04056 
04057 
04058       case Tok_Dir_Mark:
04059 
04060          if (!opt_flags.mark) {
04061             parse_err_flush(Find_Comma, NULL);
04062             break;
04063          }
04064 
04065          cdir_switches.mark = TRUE;
04066          ir_idx     = gen_directive_ir(Mark_Cdir_Opr);
04067 
04068          if (LA_CH_VALUE == EQUAL) {
04069             NEXT_LA_CH;
04070 
04071             if (!MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
04072                parse_err_flush(Find_EOS, NULL);
04073                NEXT_LA_CH;
04074             }
04075             else {
04076                CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
04077                TYP_CHAR_CLASS(TYP_WORK_IDX) = Const_Len_Char;
04078                TYP_TYPE(TYP_WORK_IDX) = Character;
04079                TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE;
04080                TYP_FLD(TYP_WORK_IDX)  = CN_Tbl_Idx;
04081                TYP_IDX(TYP_WORK_IDX)  = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
04082                                                       TOKEN_LEN(token));
04083                type_idx     = ntr_type_tbl();
04084                IR_LINE_NUM_L(ir_idx)  = TOKEN_LINE(token);
04085                IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token);
04086                IR_FLD_L(ir_idx)   = CN_Tbl_Idx;
04087                IR_IDX_L(ir_idx)   = ntr_const_tbl(type_idx,
04088                                                         FALSE,
04089                                        (long_type *) &(TOKEN_ID(token).words));
04090             }
04091          }
04092          else {
04093             IR_FLD_L(ir_idx)    = CN_Tbl_Idx;
04094             IR_IDX_L(ir_idx)    = cdir_switches.mark_cmdline_idx;
04095             IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token);
04096             IR_COL_NUM_L(ir_idx)  = TOKEN_COLUMN(token);
04097          }
04098          break;
04099 
04100       case Tok_Dir_Modinline:
04101       case Tok_Dir_Nomodinline:
04102 
04103          if (!opt_flags.modinline) {
04104             parse_err_flush(Find_Comma, NULL);
04105          }
04106          else if (ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) != Module) {
04107             PRINTMSG(TOKEN_LINE(token), 1169, Warning, TOKEN_COLUMN(token));
04108          }
04109          else {
04110             ATP_MAY_INLINE(SCP_ATTR_IDX(curr_scp_idx)) =
04111                                     TOKEN_VALUE(token) == Tok_Dir_Modinline;
04112          }
04113          break;
04114 
04115 
04116       case Tok_Dir_Name:
04117          parse_name_dir();
04118          goto EXIT;
04119 
04120 
04121       case Tok_Dir_Nextscalar:
04122 
04123          if (!cdir_switches.vector) {
04124             parse_err_flush(Find_Comma, NULL);
04125          }
04126          else {
04127             ir_idx = gen_directive_ir(Nextscalar_Cdir_Opr);
04128          }
04129          break;
04130 
04131 
04132       case Tok_Dir_Nobl:
04133 
04134          if (opt_flags.scalar_lvl == Scalar_Lvl_0  || !opt_flags.bottom_load) {
04135             parse_err_flush(Find_Comma, NULL);
04136          }
04137          else {
04138             cdir_switches.bl  = FALSE;
04139             ir_idx    = gen_directive_ir(Nobl_Cdir_Opr);
04140          }
04141          break;
04142 
04143       case Tok_Dir_Noblocking:
04144          ir_idx = gen_directive_ir(Noblocking_Dir_Opr);
04145          break;
04146 
04147       case Tok_Dir_Nobounds:
04148 
04149          cdir_switches.bounds = FALSE;
04150          ir_idx     = gen_directive_ir(Nobounds_Cdir_Opr);
04151 
04152          if (LA_CH_VALUE != EOS) {
04153             parse_var_name_list(&opnd);
04154             COPY_OPND(IR_OPND_L(ir_idx), opnd);
04155 
04156             if (LA_CH_VALUE != EOS) {
04157                parse_err_flush(Find_EOS, EOS_STR);
04158             }
04159             NEXT_LA_CH; /* pick up EOS */
04160          }
04161          else {
04162             NEXT_LA_CH; /* pick up EOS */
04163          }
04164 
04165          goto EXIT;
04166 
04167    
04168       case Tok_Dir_Noflow:
04169          cdir_switches.flow = FALSE;
04170          break;
04171 
04172 
04173       case Tok_Dir_Noinline:
04174 
04175          if (opt_flags.inline_lvl == Inline_Lvl_0 && !dump_flags.preinline) {
04176             parse_err_flush(Find_Comma, NULL);
04177          }
04178          else {
04179             cdir_switches.do_inline = FALSE;
04180             ir_idx      = gen_directive_ir(Noinline_Cdir_Opr);
04181          }
04182          break;
04183 
04184 
04185       case Tok_Dir_Nointerchange:
04186 
04187          /* Use the same operator for both the MIPS and Cray versions. */
04188 
04189          ir_idx      = gen_directive_ir(Nointerchange_Dir_Opr);
04190          break;
04191 
04192 
04193       case Tok_Dir_Nolist:
04194 
04195          if ((cif_flags & MISC_RECS) != 0) {
04196             cif_directive_rec(CIF_Nolist, 
04197                               TOKEN_LINE(token),
04198                               TOKEN_COLUMN(token));
04199          }
04200          break;
04201 
04202 
04203       case Tok_Dir_Nomark:
04204 
04205          if (opt_flags.mark) {
04206             cdir_switches.mark  = FALSE;
04207             ir_idx    = gen_directive_ir(Nomark_Cdir_Opr);
04208          }
04209          else {
04210             parse_err_flush(Find_Comma, NULL);
04211          }
04212          break;
04213 
04214 
04215       case Tok_Dir_Nopattern:
04216 
04217          if (!opt_flags.pattern) {
04218             parse_err_flush(Find_Comma, NULL);
04219          }
04220          else {
04221             cdir_switches.pattern = FALSE;
04222             ir_idx      = gen_directive_ir(Nopattern_Cdir_Opr);
04223          }
04224          break;
04225 
04226 
04227       case Tok_Dir_Norecurrence:
04228 
04229          if (!opt_flags.recurrence) {
04230             parse_err_flush(Find_Comma, NULL);
04231          }
04232          else {
04233             cdir_switches.recurrence = FALSE;
04234             ir_idx          = gen_directive_ir(Norecurrence_Cdir_Opr);
04235          }
04236          break;
04237 
04238 
04239       case Tok_Dir_Nosideeffects:
04240          parse_nosideeffects_dir();
04241          goto EXIT;
04242    
04243    
04244       case Tok_Dir_Nosplit:
04245 
04246          if (opt_flags.split_lvl == Split_Lvl_0) {
04247             parse_err_flush(Find_Comma, NULL);
04248          }
04249          else {
04250             ir_idx = gen_directive_ir(Nosplit_Cdir_Opr);
04251          }
04252          break;
04253 
04254 
04255       case Tok_Dir_Nostream:
04256 
04257          if (opt_flags.stream_lvl == Stream_Lvl_0) {
04258             parse_err_flush(Find_Comma, NULL);
04259          }
04260          else {
04261             cdir_switches.stream  = FALSE;
04262             ir_idx      = gen_directive_ir(Nostream_Dir_Opr);
04263          }
04264          break;
04265 
04266 
04267       case Tok_Dir_Notask:
04268 
04269 # if !(defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
04270          if (opt_flags.task_lvl == Task_Lvl_0) {
04271             parse_err_flush(Find_Comma, NULL);
04272             break;
04273          }
04274 # endif
04275 
04276          cdir_switches.task = FALSE;
04277          cdir_switches.notask_region = TRUE;
04278 
04279          /* check block stack for containing do loops */
04280 
04281          blk_idx = blk_stk_idx;
04282 
04283          while (BLK_TYPE(blk_idx) >= Do_Blk && blk_idx > 0) {
04284 
04285             if (BLK_TYPE(blk_idx) == Do_Blk) {
04286                ATL_NOTASK(BLK_TOP_LBL_IDX(blk_idx)) = TRUE;
04287             }
04288 
04289             blk_idx--;
04290          }
04291 
04292          ir_idx = gen_directive_ir(Notask_Cdir_Opr);
04293          break;
04294 
04295 
04296       case Tok_Dir_Nounroll:
04297 
04298          if (opt_flags.unroll_lvl == Unroll_Lvl_0) {
04299             parse_err_flush(Find_Comma, NULL);
04300          }
04301          else {
04302             ir_idx = gen_directive_ir(Nounroll_Cdir_Opr);
04303          }
04304          break;
04305 
04306 
04307       case Tok_Dir_Novector:
04308 
04309          if (opt_flags.vector_lvl == Vector_Lvl_0) {
04310             parse_err_flush(Find_Comma, NULL);
04311             break;
04312          }
04313 
04314          cdir_switches.vector = FALSE;
04315 
04316          /* check block stack for containing do loops */
04317 
04318          blk_idx = blk_stk_idx;
04319 
04320          while (BLK_TYPE(blk_idx) >= Do_Blk && blk_idx > 0) {
04321 
04322             if (BLK_TYPE(blk_idx) == Do_Blk) {
04323                ATL_NOVECTOR(BLK_TOP_LBL_IDX(blk_idx)) = TRUE;
04324             }
04325 
04326             blk_idx--;
04327          }
04328    
04329          ir_idx = gen_directive_ir(Novector_Cdir_Opr);
04330          break;
04331 
04332 
04333       case Tok_Dir_Novsearch:
04334 
04335          if (!opt_flags.vsearch || !cdir_switches.vector) {
04336             parse_err_flush(Find_Comma, NULL);
04337          }
04338          else {
04339             cdir_switches.vsearch = FALSE;
04340             ir_idx      = gen_directive_ir(Novsearch_Cdir_Opr);
04341          }
04342          break;
04343 
04344 
04345       case Tok_Dir_Numcpus:
04346 
04347          /* this is duplicate code, taken from Tok_Mic_Numcpus */
04348 
04349          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
04350          ir_idx                          = gen_directive_ir(Numcpus_Cmic_Opr);
04351 
04352          if (LA_CH_VALUE != LPAREN) {  /* Expected value */
04353             PRINTMSG(LA_CH_LINE, 1124, Error, LA_CH_COLUMN);
04354             parse_err_flush(Find_EOS, NULL);
04355          }
04356          else {
04357             NEXT_LA_CH;
04358             parse_expr(&opnd);
04359             COPY_OPND(IR_OPND_L(ir_idx), opnd);
04360 
04361             if (LA_CH_VALUE != RPAREN) {
04362                parse_err_flush(Find_EOS, ")");
04363             }
04364             else {
04365                NEXT_LA_CH;  /* Pick up Rparen. */
04366             }
04367 
04368 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
04369             /* turn this into a call */
04370 
04371             COPY_OPND(IR_OPND_R(ir_idx), IR_OPND_L(ir_idx));
04372 
04373             if (glb_tbl_idx[Set_Numthreads_Attr_Idx] == NULL_IDX) {
04374                glb_tbl_idx[Set_Numthreads_Attr_Idx] = create_lib_entry_attr(
04375                                                         SET_NUMTHREADS_ENTRY,
04376                                                         SET_NUMTHREADS_NAME_LEN,
04377                                                         IR_LINE_NUM(ir_idx),
04378                                                         IR_COL_NUM(ir_idx));
04379             }
04380 
04381             ADD_ATTR_TO_LOCAL_LIST(glb_tbl_idx[Set_Numthreads_Attr_Idx]);
04382 
04383             IR_FLD_L(ir_idx) = AT_Tbl_Idx;
04384             IR_IDX_L(ir_idx) = glb_tbl_idx[Set_Numthreads_Attr_Idx];
04385             IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
04386             IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
04387 
04388             NTR_IR_TBL(cvrt_idx);
04389             IR_OPR(cvrt_idx) = Cvrt_Opr;
04390             IR_TYPE_IDX(cvrt_idx) = Integer_4;
04391             IR_LINE_NUM(cvrt_idx) = IR_LINE_NUM(ir_idx);
04392             IR_COL_NUM(cvrt_idx)  = IR_COL_NUM(ir_idx);
04393 
04394             COPY_OPND(IR_OPND_L(cvrt_idx), IR_OPND_R(ir_idx));
04395 
04396             NTR_IR_LIST_TBL(list_idx);
04397             IR_FLD_R(ir_idx) = IL_Tbl_Idx;
04398             IR_IDX_R(ir_idx) = list_idx;
04399             IR_LIST_CNT_R(ir_idx) = 1;
04400             IL_FLD(list_idx) = IR_Tbl_Idx;
04401             IL_IDX(list_idx) = cvrt_idx;
04402 
04403             SH_STMT_TYPE(curr_stmt_sh_idx) = Call_Stmt;
04404             IR_OPR(ir_idx) = Call_Opr;
04405 # endif
04406          }
04407 
04408          break;
04409 
04410 
04411       case Tok_Dir_Pattern:
04412 
04413          if (!opt_flags.pattern) {
04414             parse_err_flush(Find_Comma, NULL);
04415          }
04416          else {
04417             cdir_switches.pattern = TRUE;
04418             ir_idx      = gen_directive_ir(Pattern_Cdir_Opr);
04419          }
04420          break;
04421 
04422      case Tok_Dir_Permutation:
04423 
04424          /* this is duplicate code, taken from Tok_Mic_Permutation */
04425 
04426          /* ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE; */
04427          ir_idx = gen_directive_ir(Permutation_Cmic_Opr);
04428          parse_permutation_mic();
04429          break;
04430 
04431 
04432       case Tok_Dir_Preferstream:
04433 
04434          if (!cdir_switches.stream) {
04435             parse_err_flush(Find_Comma, NULL);
04436          }
04437          else {
04438             cdir_switches.preferstream    = TRUE;
04439             cdir_switches.preferstream_nocinv = FALSE;
04440             opr         = Preferstream_Dir_Opr;
04441 
04442             if (LA_CH_VALUE != EOS && LA_CH_VALUE != COMMA) {
04443 
04444                if (MATCHED_TOKEN_CLASS(Tok_Class_Dir_Kwd) &&
04445                    TOKEN_VALUE(token) == Tok_Dir_Nocinv) {
04446                   cdir_switches.preferstream_nocinv = TRUE;
04447                   opr = Preferstream_Nocinv_Dir_Opr;
04448                }
04449                else {
04450                   parse_err_flush(Find_EOS, "NOCINV");
04451                }
04452             }
04453             ir_idx = gen_directive_ir(opr);
04454          }
04455          break;
04456 
04457 
04458       case Tok_Dir_Prefertask:
04459 
04460 #        if !(defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
04461 
04462             if (!cdir_switches.task) {
04463                parse_err_flush(Find_Comma, NULL);
04464                break;
04465             }
04466 #        endif
04467    
04468          cdir_switches.prefertask = TRUE;
04469          ir_idx       = gen_directive_ir(Prefertask_Cdir_Opr);
04470 
04471 #        if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
04472             IR_OPR(ir_idx)  = Assert_Star_Opr;
04473             IR_FLD_L(ir_idx)  = CN_Tbl_Idx;
04474             IR_IDX_L(ir_idx)  = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
04475                                               ASSERT_DOPREFER);
04476             IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
04477             IR_COL_NUM_L(ir_idx)  = IR_COL_NUM(ir_idx);
04478 
04479             IR_FLD_R(ir_idx)  = CN_Tbl_Idx;
04480             IR_IDX_R(ir_idx)  = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
04481                                               DOPREFER_CONCURRENT);
04482             IR_LINE_NUM_R(ir_idx) = IR_LINE_NUM(ir_idx);
04483             IR_COL_NUM_R(ir_idx)  = IR_COL_NUM(ir_idx);
04484 #        endif
04485          break;
04486 
04487 
04488       case Tok_Dir_Prefervector:
04489 
04490          if (!cdir_switches.vector) {
04491             parse_err_flush(Find_Comma, NULL);
04492          }
04493          else {
04494             cdir_switches.prefervector = TRUE;
04495             ir_idx = gen_directive_ir(Prefervector_Cdir_Opr);
04496          }
04497          break;
04498 
04499 
04500       case Tok_Dir_Recurrence:
04501 
04502          if (LA_CH_VALUE != EOS && LA_CH_VALUE != COMMA) {
04503             buf_idx = LA_CH_BUF_IDX;
04504             stmt_num  = LA_CH_STMT_NUM;
04505    
04506             if (LA_CH_VALUE == '1') {
04507                NEXT_LA_CH;
04508 
04509                if (LA_CH_VALUE == '2') {
04510                   NEXT_LA_CH;
04511 
04512                   if (LA_CH_VALUE == '8') {
04513                      NEXT_LA_CH;
04514 
04515                      if (LA_CH_VALUE == EOS) {
04516                         PRINTMSG(TOKEN_LINE(token), 801, Warning,
04517                                  TOKEN_COLUMN(token));
04518                         parse_err_flush(Find_EOS, NULL);
04519                         break;
04520                      }
04521                   }
04522                }
04523             }
04524             reset_lex(buf_idx,stmt_num);
04525          }
04526      
04527          if (!opt_flags.recurrence) {
04528             parse_err_flush(Find_Comma, NULL);
04529          }
04530          else {
04531             cdir_switches.recurrence  = TRUE;
04532             ir_idx      = gen_directive_ir(Recurrence_Cdir_Opr);
04533          }
04534          break;
04535 
04536 
04537       case Tok_Dir_Shortloop:
04538 
04539          if (!cdir_switches.vector) {
04540             parse_err_flush(Find_Comma, NULL);
04541             break;
04542          }
04543    
04544          ir_idx = gen_directive_ir(Shortloop_Cdir_Opr);
04545 
04546          if (LA_CH_VALUE != EOS    && LA_CH_VALUE != COMMA) {
04547             buf_idx = LA_CH_BUF_IDX;
04548             stmt_num  = LA_CH_STMT_NUM;
04549    
04550             if (LA_CH_VALUE == '1') {
04551                NEXT_LA_CH;
04552 
04553                if (LA_CH_VALUE == '2') {
04554                   NEXT_LA_CH;
04555 
04556                   if (LA_CH_VALUE == '8') {
04557                      NEXT_LA_CH;
04558 
04559                      if (LA_CH_VALUE == EOS) {
04560 
04561 #                       if defined(_ACCEPT_DIR_SHORTLOOP128)
04562                            IR_OPR(ir_idx)   = Shortloop128_Cdir_Opr;
04563                            cdir_switches.shortloop128 = TRUE;
04564 #                 else
04565                            PRINTMSG(TOKEN_LINE(token), 801, Warning, 
04566                                     TOKEN_COLUMN(token));
04567 #                       endif
04568                         break;
04569                      }
04570                   }
04571                }
04572             }
04573             reset_lex(buf_idx,stmt_num);
04574             parse_err_flush(Find_EOS, "128 or "EOS_STR);
04575          }
04576          else {
04577             cdir_switches.shortloop = TRUE;
04578          }
04579          break;
04580 
04581 
04582       case Tok_Dir_Split:
04583 
04584          if (opt_flags.split_lvl == Split_Lvl_0) {
04585             parse_err_flush(Find_Comma, NULL);
04586          }
04587          else {
04588             ir_idx = gen_directive_ir(Split_Cdir_Opr);
04589          }
04590          break;
04591 
04592 
04593       case Tok_Dir_Stack:
04594 
04595          if (CURR_BLK == Interface_Body_Blk || CURR_BLK == Interface_Blk) {
04596 
04597             /* Illegal to specify directive in an interface */
04598 
04599             PRINTMSG(TOKEN_LINE(token), 1404, Warning, TOKEN_COLUMN(token));
04600             parse_err_flush(Find_EOS, NULL);
04601             break;
04602          }
04603 
04604          ATP_STACK_DIR(SCP_ATTR_IDX(curr_scp_idx))  = TRUE;
04605 
04606          if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) == Module) {
04607 
04608             /* Illegal to specify directive in a MODULE */
04609    
04610             PRINTMSG(TOKEN_LINE(token), 1405, Warning, TOKEN_COLUMN(token));
04611          }
04612 
04613          if (ATP_SAVE_ALL(SCP_ATTR_IDX(curr_scp_idx))) {
04614 
04615             /* A SAVE with no save entity list has been specified in this */
04616             /* program unit.  SAVE overrides STACK.  Issue warning.       */
04617 
04618             PRINTMSG(TOKEN_LINE(token), 1144, Warning, TOKEN_COLUMN(token),
04619                      "STACK");
04620             ATP_STACK_DIR(SCP_ATTR_IDX(curr_scp_idx)) = FALSE;
04621          }
04622          break;
04623 
04624 
04625       case Tok_Dir_Stream:
04626 
04627          if (opt_flags.stream_lvl > Stream_Lvl_0) {
04628             cdir_switches.stream  = TRUE;
04629             ir_idx      = gen_directive_ir(Stream_Dir_Opr);
04630          }
04631          break;
04632 
04633 
04634       case Tok_Dir_Suppress:
04635 
04636          ir_idx     = gen_directive_ir(Suppress_Opr);
04637          IR_LIST_CNT_L(ir_idx)  = 0;
04638 
04639          if (LA_CH_VALUE != EOS) {
04640             parse_dir_var_list();
04641          }
04642          else {
04643             NEXT_LA_CH;  /* pick up EOS */
04644          }
04645 
04646          label_idx      = gen_internal_lbl(stmt_start_line);
04647          IR_FLD_R(ir_idx)   = AT_Tbl_Idx;
04648          IR_IDX_R(ir_idx)   = label_idx;
04649          IR_LINE_NUM_R(ir_idx)    = stmt_start_line;
04650          IR_COL_NUM_R(ir_idx)   = stmt_start_col;
04651          AT_DEFINED(label_idx)    = TRUE;
04652          ATL_DEF_STMT_IDX(label_idx)  = curr_stmt_sh_idx;
04653          goto EXIT;
04654 
04655 
04656       case Tok_Dir_Symmetric:
04657 
04658          if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) == Module) {
04659 
04660             /* Illegal to specify directive in a MODULE */
04661 
04662             PRINTMSG(TOKEN_LINE(token), 1233, Error, TOKEN_COLUMN(token),
04663                      "SYMMETRIC");
04664             parse_err_flush(Find_EOS, NULL);
04665             break;
04666          }
04667 
04668          if (LA_CH_VALUE == EOS) {
04669             ATP_SYMMETRIC(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
04670          }
04671          else {
04672             parse_symmetric_dir();
04673             goto EXIT;
04674          }
04675          break;
04676 
04677 
04678       case Tok_Dir_System_Module:
04679 
04680          if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) != Module) {
04681             PRINTMSG(TOKEN_LINE(token), 1508, Error,
04682                      TOKEN_COLUMN(token), "SYSTEM_MODULE");
04683          }
04684          else {
04685             ATP_SYSTEM_MODULE(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
04686             SCP_IMPL_NONE(curr_scp_idx)       = TRUE;
04687          }
04688          break;
04689 
04690 
04691       case Tok_Dir_Task:
04692 
04693 # if !(defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
04694          if (opt_flags.task_lvl == Task_Lvl_0) {
04695             parse_err_flush(Find_Comma, NULL);
04696          }
04697          else {
04698             cdir_switches.task  = TRUE;
04699             ir_idx    = gen_directive_ir(Task_Cdir_Opr);
04700          }
04701 # else
04702          cdir_switches.task = TRUE;
04703          cdir_switches.notask_region  = FALSE;
04704          ir_idx   = gen_directive_ir(Task_Cdir_Opr);
04705 # endif
04706          break;
04707 
04708 
04709       case Tok_Dir_Taskcommon:
04710          parse_common_dirs(Task_Common);
04711          goto EXIT;
04712 
04713 
04714       case Tok_Dir_Unroll:
04715 
04716          if (opt_flags.unroll_lvl == Unroll_Lvl_0) {
04717             parse_err_flush(Find_Comma, NULL);
04718             break;
04719          }
04720 
04721          /* If count is zero, the optimizer does automatic unrolling */
04722 
04723          ir_idx     = gen_directive_ir(Unroll_Cdir_Opr);
04724          IR_LINE_NUM_L(ir_idx)  = TOKEN_LINE(token);
04725          IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token);
04726          IR_FLD_L(ir_idx) = NO_Tbl_Idx;
04727          IR_IDX_L(ir_idx) = NULL_IDX;
04728 
04729          if (LA_CH_VALUE != EOS) {
04730 
04731             if (!parse_expr(&opnd)) {
04732                parse_err_flush(Find_EOS, NULL);
04733             }
04734             else {
04735                COPY_OPND(IR_OPND_L(ir_idx), opnd);
04736             }
04737          }
04738          break;
04739 
04740 
04741       case Tok_Dir_Uses_Eregs:
04742 
04743          if (CURR_BLK == Interface_Body_Blk || CURR_BLK == Interface_Blk) {
04744 
04745             /* Illegal to specify directive in an interface */
04746 
04747             PRINTMSG(TOKEN_LINE(token), 1404, Warning, TOKEN_COLUMN(token));
04748             parse_err_flush(Find_EOS, NULL);
04749             break;
04750          }
04751 
04752          ATP_USES_EREGS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
04753 
04754          if (ATP_PGM_UNIT(SCP_ATTR_IDX(curr_scp_idx)) == Module) {
04755 
04756             /* Illegal to specify directive in a MODULE */
04757 
04758             PRINTMSG(TOKEN_LINE(token), 1405, Warning, TOKEN_COLUMN(token));
04759          }
04760          break;
04761 
04762 
04763       case Tok_Dir_Vector:
04764 
04765          if (opt_flags.vector_lvl == Vector_Lvl_0) {
04766             parse_err_flush(Find_Comma, NULL);
04767          }
04768          else {
04769             cdir_switches.vector = TRUE;
04770             ir_idx     = gen_directive_ir(Vector_Cdir_Opr);
04771          }
04772          break;
04773 
04774 
04775       case Tok_Dir_Vfunction:
04776          parse_vfunction_dir();
04777          goto EXIT;
04778 
04779 
04780       case Tok_Dir_Vsearch:
04781 
04782          if (!opt_flags.vsearch || !cdir_switches.vector) {
04783             parse_err_flush(Find_Comma, NULL);
04784          }
04785          else {
04786             cdir_switches.vsearch = TRUE;
04787             ir_idx      = gen_directive_ir(Vsearch_Cdir_Opr);
04788          }
04789          break;
04790 
04791      /* Craft sprs - unsupported - skip if -xmpp specified. */
04792 
04793       case Tok_Dir_Doshared:
04794       case Tok_Dir_Endmaster:
04795       case Tok_Dir_Geometry:
04796       case Tok_Dir_Parallel_Only:
04797       case Tok_Dir_Pe_Resident:
04798       case Tok_Dir_Pe_Private:
04799       case Tok_Dir_Serial_Only:
04800       case Tok_Dir_Shared:
04801       case Tok_Dir_Unknown:
04802       case Tok_Dir_Unknown_Shared:
04803             parse_err_flush(Find_EOS, NULL);  /* Flush - has comma list */
04804 
04805             /* Fall through */
04806 
04807       case Tok_Dir_Atomicupdate:
04808       case Tok_Dir_Barrier:
04809       case Tok_Dir_Critical:
04810       case Tok_Dir_Endcritical:
04811       case Tok_Dir_Master:
04812       case Tok_Dir_Nobarrier:
04813 
04814          if (!cmd_line_flags.disregard_all_mpp_cdirs) {
04815             PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token));
04816             parse_err_flush(Find_EOS, NULL);
04817          }
04818 
04819          break;
04820 
04821 # ifdef _DEBUG
04822 
04823       case Tok_Dbg_Sytb:
04824          SCP_DBG_PRINT_SYTB(curr_scp_idx) = TRUE;
04825          break;
04826 
04827       case Tok_Dbg_Stmt:
04828          SCP_DBG_PRINT_STMT(curr_scp_idx) = TRUE;
04829          break;
04830 # endif
04831 
04832       default:
04833 
04834          /* Intentionally blank */
04835          break;
04836 
04837       }  /* end switch */
04838 
04839 CONTINUE:
04840 
04841       if (LA_CH_VALUE == COMMA) {
04842          NEXT_LA_CH;
04843 
04844          if (!MATCHED_TOKEN_CLASS(Tok_Class_Dir_Kwd)) {
04845             PRINTMSG(TOKEN_LINE(token), 1356, Warning, TOKEN_COLUMN(token));
04846             parse_err_flush(Find_EOS, NULL);
04847             NEXT_LA_CH;
04848             break;
04849          }
04850       }
04851       else {
04852          break;
04853       }
04854    }  /* End for */
04855 
04856    /* Flush past all unimplemented dirs */
04857 
04858    if (LA_CH_VALUE != EOS) {
04859       PRINTMSG(LA_CH_LINE, 790, Warning, LA_CH_COLUMN);
04860       parse_err_flush(Find_EOS, NULL);
04861    }
04862 
04863    NEXT_LA_CH;
04864 
04865 EXIT:
04866 
04867    TRACE (Func_Exit, "parse_dir_directives", NULL);
04868 
04869    return;
04870 
04871 }  /* parse_dir_directives */
04872 
04873 /******************************************************************************\
04874 |*                        *|
04875 |* Description:                     *|
04876 |*  This routine parses the !MIC$ directives on one line of source.       *|
04877 |*                        *|
04878 |* Input parameters:                    *|
04879 |*  NONE                      *|
04880 |*                        *|
04881 |* Output parameters:                   *|
04882 |*  NONE                      *|
04883 |*                        *|
04884 |* Returns:                     *|
04885 |*  NOTHING                     *|
04886 |*                        *|
04887 \******************************************************************************/
04888 static void parse_mic_directives(void)
04889 
04890 {
04891    int    ir_idx;
04892    boolean  ok    = TRUE;
04893    opnd_type  opnd;
04894 
04895 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
04896    int    cvrt_idx;
04897    int    list_idx;
04898 # endif
04899 
04900 # if (_ACCEPT_MIC_SEND)
04901    int    blk_idx;
04902    int    column;
04903    int    do_blk_idx;
04904    boolean  found_do;
04905    int    line;
04906    opnd_type  point_opnd;
04907 # endif
04908 
04909 
04910    TRACE (Func_Entry, "parse_mic_directives", NULL);
04911 
04912    for (;;) {
04913 
04914       if (TOKEN_VALUE(token) > Tok_Mic_Start &&
04915           TOKEN_VALUE(token) < Tok_Mic_End &&
04916           disregard_mics[TOKEN_VALUE(token) - Tok_Mic_Start]) {
04917     
04918          switch (TOKEN_VALUE(token)) {
04919 
04920             case Tok_Mic_Cncall:
04921             case Tok_Mic_Guard:
04922             case Tok_Mic_End_Guard:
04923             case Tok_Mic_Numcpus:
04924             case Tok_Mic_Permutation:
04925             case Tok_Mic_Send:
04926             case Tok_Mic_Wait:
04927                parse_err_flush(Find_EOS, NULL);
04928                break;
04929 
04930             default:
04931                parse_err_flush(Find_Comma, NULL);
04932          }
04933          
04934          goto CONTINUE;
04935       }
04936 
04937       switch (TOKEN_VALUE(token)) {
04938 
04939       case Tok_Mic_Case:
04940 
04941          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
04942          ir_idx        = gen_directive_ir(Case_Cmic_Opr);
04943 
04944          if (! cdir_switches.parallel_region) {
04945             /* error .. not in parallel region */
04946             PRINTMSG(IR_LINE_NUM(ir_idx), 785, Error, IR_COL_NUM(ir_idx),
04947                      "CASE");
04948          }
04949          else {
04950 
04951             if (remove_do_parallel_blk(TRUE, "CASE", IR_LINE_NUM(ir_idx),
04952                                        IR_COL_NUM(ir_idx))) {
04953             }
04954 
04955             SH_STMT_TYPE(curr_stmt_sh_idx) = Parallel_Case_Stmt;
04956             stmt_type = Parallel_Case_Stmt;
04957 
04958             if (cdir_switches.casedir) {
04959                end_parallel_case_blk(FALSE);
04960             }
04961 
04962             SET_DIRECTIVE_STATE(Case_Region);
04963             cdir_switches.casedir = TRUE;
04964 
04965             PUSH_BLK_STK (Parallel_Case_Blk);
04966             BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE;
04967    
04968             CURR_BLK_FIRST_SH_IDX     = curr_stmt_sh_idx;
04969             LINK_TO_PARENT_BLK;
04970          }
04971 
04972          break;
04973 
04974 
04975       case Tok_Mic_End_Case:
04976 
04977          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
04978          ir_idx        = gen_directive_ir(Endcase_Cmic_Opr);
04979 
04980          if (! cdir_switches.parallel_region) {
04981             /* error .. not in parallel region */
04982             PRINTMSG(IR_LINE_NUM(ir_idx), 785, Error, IR_COL_NUM(ir_idx),
04983                      "END CASE");
04984          }
04985          else {
04986 
04987             cdir_switches.casedir = FALSE;
04988             SH_STMT_TYPE(curr_stmt_sh_idx) = End_Parallel_Case_Stmt;
04989             stmt_type = End_Parallel_Case_Stmt;
04990    
04991             end_parallel_case_blk(FALSE);
04992          }
04993 
04994          CLEAR_DIRECTIVE_STATE(Case_Region);
04995          break;
04996 
04997 
04998       case Tok_Mic_Cncall:
04999 
05000          /* this code is duplicated for Tok_Dir_Cncall */
05001 
05002          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05003          ir_idx        = gen_directive_ir(Cncall_Cmic_Opr);
05004 
05005          if (LA_CH_VALUE != EOS && LA_CH_VALUE != COMMA) {
05006 
05007             /* Arguments are specified on the CNCALL line.  Issue caution */
05008             /* message and ignore the arguments.  Because there is a list,*/
05009             /* cncall must be the only directive on the line, so flush.   */
05010 
05011             PRINTMSG(LA_CH_LINE, 1123, Caution, LA_CH_COLUMN);
05012             parse_err_flush(Find_EOS, NULL);
05013          }
05014 
05015          break;
05016 
05017 
05018       case Tok_Mic_Do_All:
05019 
05020          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05021          ir_idx        = gen_directive_ir(Doall_Cmic_Opr);
05022 
05023          parse_doall_cmic();
05024 
05025          if (cdir_switches.parallel_region ||
05026              cdir_switches.guard_in_par_reg) {
05027             /* error .. already parallel region */
05028             PRINTMSG(IR_LINE_NUM(ir_idx), 814, Error, IR_COL_NUM(ir_idx));
05029          }
05030          else {
05031             SET_DIRECTIVE_STATE(Doall_Region);
05032             cdir_switches.doall_sh_idx = curr_stmt_sh_idx;
05033          }
05034 
05035          break;
05036 
05037 
05038       case Tok_Mic_Do_Parallel:
05039 
05040          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05041          ir_idx = gen_directive_ir(Doparallel_Cmic_Opr);
05042 
05043          parse_doparallel_cmic();
05044 
05045          if (! cdir_switches.parallel_region) {
05046             /* error .. not in parallel region */
05047             PRINTMSG(IR_LINE_NUM(ir_idx), 785, Error, IR_COL_NUM(ir_idx),
05048                      "DO PARALLEL");
05049          }
05050          else if (cdir_switches.casedir) {
05051             /* error .. can't be inside parallel case */
05052             PRINTMSG(IR_LINE_NUM(ir_idx), 1312, Error, IR_COL_NUM(ir_idx));
05053          }
05054          else if (remove_do_parallel_blk(TRUE, "DO PARALLEL", 
05055                                    IR_LINE_NUM(ir_idx), IR_COL_NUM(ir_idx))) {
05056             /* error issued by remove_do_parallel_blk */
05057          }
05058          else {
05059             SET_DIRECTIVE_STATE(Do_Parallel_Region);
05060             cdir_switches.do_parallel = TRUE;
05061             cdir_switches.dopar_sh_idx = curr_stmt_sh_idx;
05062          }
05063 
05064          break;
05065 
05066 
05067       case Tok_Mic_End_Do:
05068 
05069          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05070          ir_idx        = gen_directive_ir(Enddo_Cmic_Opr);
05071 
05072          if (! cdir_switches.parallel_region) {
05073             /* error .. not in parallel region */
05074             PRINTMSG(IR_LINE_NUM(ir_idx), 785, Error, IR_COL_NUM(ir_idx),
05075                      "END DO");
05076          }
05077          else {
05078 
05079             CLEAR_DIRECTIVE_STATE(Do_Parallel_Region);
05080             cdir_switches.do_parallel = FALSE;
05081             SH_STMT_TYPE(curr_stmt_sh_idx) = End_Do_Parallel_Stmt;
05082             stmt_type = End_Do_Parallel_Stmt;
05083 
05084             end_do_parallel_blk(FALSE);
05085          }
05086 
05087          break;
05088 
05089 
05090       case Tok_Mic_Guard:
05091 
05092          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05093          ir_idx        = gen_directive_ir(Guard_Cmic_Opr);
05094 
05095          if (LA_CH_VALUE != EOS) {
05096             ok = parse_expr(&opnd);
05097             COPY_OPND(IR_OPND_L(ir_idx), opnd);
05098             cdir_switches.guard_has_flag = TRUE;
05099 
05100             if (LA_CH_VALUE != EOS) {
05101                parse_err_flush(Find_EOS,EOS_STR);
05102             }
05103          }
05104          else {
05105             cdir_switches.guard_has_flag = FALSE;
05106          }
05107 
05108          if (cdir_switches.guard) {
05109             /* error .. missing end guard */
05110             PRINTMSG(IR_LINE_NUM(ir_idx), 815, Error, IR_COL_NUM(ir_idx));
05111          }
05112          else {
05113             
05114             SET_DIRECTIVE_STATE(Guard_Region);
05115             cdir_switches.guard            = TRUE;
05116             cdir_switches.guard_in_par_reg = cdir_switches.parallel_region;
05117             cdir_switches.parallel_region  = FALSE;
05118 
05119             PUSH_BLK_STK (Guard_Blk);
05120             BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE;
05121 
05122             CURR_BLK_FIRST_SH_IDX     = curr_stmt_sh_idx;
05123             LINK_TO_PARENT_BLK;
05124          }
05125 
05126          break;
05127 
05128 
05129       case Tok_Mic_End_Guard:
05130 
05131          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05132          ir_idx        = gen_directive_ir(Endguard_Cmic_Opr);
05133 
05134          ok = TRUE;
05135 
05136          if (LA_CH_VALUE != EOS) {
05137             ok = parse_expr(&opnd);
05138             COPY_OPND(IR_OPND_L(ir_idx), opnd);
05139 
05140             if (! cdir_switches.guard_has_flag) {
05141                /* error .. guards don't match */
05142                PRINTMSG(IR_LINE_NUM(ir_idx), 816, Error, IR_COL_NUM(ir_idx));
05143                ok = FALSE;
05144             }
05145 
05146             if (LA_CH_VALUE != EOS) {
05147                parse_err_flush(Find_EOS,EOS_STR);
05148             }
05149          }
05150          else if (cdir_switches.guard_has_flag) {
05151             /* error .. guards don't match */
05152             PRINTMSG(IR_LINE_NUM(ir_idx), 816, Error, IR_COL_NUM(ir_idx));
05153             ok = FALSE;
05154          }
05155 
05156          CLEAR_DIRECTIVE_STATE(Guard_Region);
05157 
05158          if (ok) {
05159 
05160             cdir_switches.guard = FALSE;
05161             cdir_switches.parallel_region = cdir_switches.guard_in_par_reg;
05162             cdir_switches.guard_in_par_reg = FALSE;
05163   
05164             SH_STMT_TYPE(curr_stmt_sh_idx) = End_Guard_Stmt;
05165             stmt_type = End_Guard_Stmt;
05166 
05167             end_guard_blk(FALSE);
05168          }
05169 
05170          break;
05171    
05172       case Tok_Mic_Numcpus:
05173 
05174          /* this code is duplicated for Tok_Dir_Numcpus */
05175 
05176          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05177          ir_idx        = gen_directive_ir(Numcpus_Cmic_Opr);
05178 
05179          if (LA_CH_VALUE != LPAREN) {  /* Expected value */
05180             PRINTMSG(LA_CH_LINE, 1124, Error, LA_CH_COLUMN);
05181             parse_err_flush(Find_EOS, NULL);
05182          }
05183          else {
05184             NEXT_LA_CH;
05185             ok = parse_expr(&opnd);
05186             COPY_OPND(IR_OPND_L(ir_idx), opnd);
05187 
05188             if (LA_CH_VALUE != RPAREN) {
05189                parse_err_flush(Find_EOS, ")");
05190             }
05191             else {
05192                NEXT_LA_CH;  /* Pick up Rparen. */
05193             }
05194 
05195 # if (defined(_TARGET_OS_IRIX) || defined(_TARGET_OS_LINUX) || defined(_TARGET_OS_DARWIN))
05196             /* turn this into a call */
05197 
05198             COPY_OPND(IR_OPND_R(ir_idx), IR_OPND_L(ir_idx));
05199 
05200             if (glb_tbl_idx[Set_Numthreads_Attr_Idx] == NULL_IDX) {
05201                glb_tbl_idx[Set_Numthreads_Attr_Idx] = create_lib_entry_attr(
05202                                                         SET_NUMTHREADS_ENTRY,
05203                                                         SET_NUMTHREADS_NAME_LEN,
05204                                                         IR_LINE_NUM(ir_idx),
05205                                                         IR_COL_NUM(ir_idx));
05206             }
05207          
05208             ADD_ATTR_TO_LOCAL_LIST(glb_tbl_idx[Set_Numthreads_Attr_Idx]);
05209 
05210             IR_FLD_L(ir_idx) = AT_Tbl_Idx;
05211             IR_IDX_L(ir_idx) = glb_tbl_idx[Set_Numthreads_Attr_Idx];
05212             IR_LINE_NUM_L(ir_idx) = IR_LINE_NUM(ir_idx);
05213             IR_COL_NUM_L(ir_idx) = IR_COL_NUM(ir_idx);
05214 
05215             NTR_IR_TBL(cvrt_idx);
05216             IR_OPR(cvrt_idx) = Cvrt_Opr;
05217             IR_TYPE_IDX(cvrt_idx) = Integer_4;
05218             IR_LINE_NUM(cvrt_idx) = IR_LINE_NUM(ir_idx);
05219             IR_COL_NUM(cvrt_idx)  = IR_COL_NUM(ir_idx);
05220 
05221             COPY_OPND(IR_OPND_L(cvrt_idx), IR_OPND_R(ir_idx));
05222 
05223             NTR_IR_LIST_TBL(list_idx);
05224             IR_FLD_R(ir_idx) = IL_Tbl_Idx;
05225             IR_IDX_R(ir_idx) = list_idx;
05226             IR_LIST_CNT_R(ir_idx) = 1;
05227             IL_FLD(list_idx) = IR_Tbl_Idx;
05228             IL_IDX(list_idx) = cvrt_idx;
05229             
05230             SH_STMT_TYPE(curr_stmt_sh_idx) = Call_Stmt;
05231             IR_OPR(ir_idx) = Call_Opr;
05232 # endif
05233          }
05234 
05235          break;
05236 
05237 
05238       case Tok_Mic_Parallel:
05239 
05240          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05241          ir_idx        = gen_directive_ir(Parallel_Cmic_Opr);
05242 
05243          parse_parallel_cmic();
05244 
05245          if (cdir_switches.parallel_region ||
05246              cdir_switches.guard_in_par_reg) {
05247             /* error .. already in a parallel_region */
05248             PRINTMSG(IR_LINE_NUM(ir_idx), 818, Error, IR_COL_NUM(ir_idx));
05249          }
05250          else {
05251             SET_DIRECTIVE_STATE(Parallel_Region);
05252             cdir_switches.parallel_region   = TRUE;
05253             PUSH_BLK_STK (Parallel_Blk);
05254             BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE;
05255             CURR_BLK_FIRST_SH_IDX     = curr_stmt_sh_idx;
05256             LINK_TO_PARENT_BLK;
05257          }
05258 
05259          break;
05260 
05261 
05262       case Tok_Mic_End_Parallel:
05263 
05264          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05265          ir_idx = gen_directive_ir(Endparallel_Cmic_Opr);
05266 
05267          CLEAR_DIRECTIVE_STATE(Parallel_Region);
05268          cdir_switches.parallel_region   = FALSE;
05269          cdir_switches.do_parallel       = FALSE;
05270          cdir_switches.guard_in_par_reg  = FALSE;
05271 
05272          SH_STMT_TYPE(curr_stmt_sh_idx) = End_Parallel_Stmt;
05273          stmt_type = End_Parallel_Stmt;
05274          end_parallel_blk(FALSE);
05275 
05276          break;
05277 
05278 
05279       case Tok_Mic_Permutation:
05280 
05281          /* this code is duplicated for Tok_Dir_Permutation */
05282 
05283          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05284          ir_idx = gen_directive_ir(Permutation_Cmic_Opr);
05285          parse_permutation_mic();
05286          break;
05287 
05288       case Tok_Mic_Wait:
05289 
05290 # if defined(_ACCEPT_MIC_WAIT)
05291 
05292          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx))  = TRUE;
05293 
05294          line       = TOKEN_LINE(token);
05295          column       = TOKEN_COLUMN(token);
05296          ir_idx       = gen_directive_ir(Wait_Cmic_Opr);
05297          OPND_LINE_NUM(opnd)    = LA_CH_LINE;
05298          OPND_COL_NUM(opnd)   = LA_CH_COLUMN;
05299          OPND_FLD(opnd)     = CN_Tbl_Idx;
05300          OPND_IDX(opnd)     = CN_INTEGER_ONE_IDX;
05301          OPND_LINE_NUM(point_opnd)  = LA_CH_LINE;
05302          OPND_COL_NUM(point_opnd) = LA_CH_COLUMN;
05303          point_opnd     = null_opnd;
05304 
05305          if (LA_CH_VALUE == EOS) {
05306 
05307             /* Intentionally blank */
05308          }
05309          else if (MATCHED_TOKEN_CLASS(Tok_Class_Mic_Kwd)) {
05310 
05311             if (TOKEN_VALUE(token) == Tok_Mic_Point) {
05312 
05313                if (LA_CH_VALUE == LPAREN) {
05314                   NEXT_LA_CH;
05315                   ok = parse_expr(&point_opnd);
05316 
05317                   if (LA_CH_VALUE != RPAREN) {
05318                      parse_err_flush(Find_EOS, ")");
05319                   }
05320                   else {
05321                      NEXT_LA_CH;  /* Pick up Rparen. */
05322                   }
05323 
05324                   if (LA_CH_VALUE != EOS) {
05325 
05326                      if (!MATCHED_TOKEN_CLASS(Tok_Class_Mic_Kwd) ||
05327                          TOKEN_VALUE(token) != Tok_Mic_Span) {
05328                         parse_err_flush(Find_EOS, "SPAN or EOS");
05329                      }
05330                      else if (LA_CH_VALUE == LPAREN) {
05331                         NEXT_LA_CH;
05332                         ok = parse_expr(&opnd);
05333  
05334                         if (LA_CH_VALUE != RPAREN) {
05335                            parse_err_flush(Find_EOS, ")");
05336                         }
05337                         else {
05338                            NEXT_LA_CH;  /* Pick up Rparen. */
05339                         }
05340 
05341                         if (LA_CH_VALUE != EOS) {
05342                            parse_err_flush(Find_EOS, "EOS");
05343                         }
05344                      }
05345                      else {
05346                         parse_err_flush(Find_EOS, "(");
05347                      }
05348                   }
05349                }
05350                else {
05351                   parse_err_flush(Find_EOS, "(");
05352                }
05353             }
05354             else if (TOKEN_VALUE(token) == Tok_Mic_Span) {
05355 
05356                if (LA_CH_VALUE == LPAREN) {
05357                   NEXT_LA_CH;
05358                   ok = parse_expr(&opnd);
05359 
05360                   if (LA_CH_VALUE != RPAREN) {
05361                      parse_err_flush(Find_EOS, ")");
05362                   }
05363                   else {
05364                      NEXT_LA_CH;  /* Pick up Rparen. */
05365                   }
05366 
05367                   if (LA_CH_VALUE != EOS) {
05368                      parse_err_flush(Find_EOS, "EOS");
05369                   }
05370                }
05371                else {
05372                   parse_err_flush(Find_EOS, "(");
05373                }
05374             }
05375             else {
05376                parse_err_flush(Find_EOS, "POINT, SPAN or EOS");
05377             }
05378          }
05379          else {
05380             parse_err_flush(Find_EOS, "POINT, SPAN or EOS");
05381          }
05382 
05383          COPY_OPND(IR_OPND_L(ir_idx), point_opnd);
05384          COPY_OPND(IR_OPND_R(ir_idx), opnd);
05385 
05386          /* This directive must be specified within a doall or doparallel */
05387          /* region.  Search the block stack to make sure one exists.      */
05388 
05389          blk_idx  = blk_stk_idx;
05390          do_blk_idx = NULL_IDX;
05391          found_do = FALSE;
05392 
05393          while (blk_idx > 0) {
05394 
05395             if (BLK_TYPE(blk_idx) == Do_Parallel_Blk ||
05396                 BLK_TYPE(blk_idx) == Doall_Blk) {
05397                do_blk_idx = blk_idx;
05398                break;
05399             }
05400 
05401             if (BLK_TYPE(blk_idx) == Do_Blk) {
05402                found_do = TRUE;
05403             }
05404 
05405             if (BLK_TYPE(blk_idx) == Case_Blk || 
05406                 BLK_TYPE(blk_idx) == Guard_Blk) {
05407 
05408                /* Issue error.  Wait cannot be specified within a CASE region */
05409                /* or a GUARD region.  Continue to check for doall/doparallel. */
05410 
05411                PRINTMSG(line, 1519, Error, column,
05412                         (BLK_TYPE(blk_idx) == Case_Blk) ? "CASE" : "GUARD");
05413             }
05414             blk_idx--;
05415          }
05416 
05417          if (do_blk_idx == NULL_IDX) {  /* Did not find the block */
05418 
05419             /* Issue error - Need to be in doparallel or doall region.*/
05420 
05421             PRINTMSG(line, 1520, Error, column, "WAIT");
05422          }
05423 
05424          if (!found_do) {  /* Issue error - Need to be in a do block. */
05425             PRINTMSG(line, 1385, Error, column, "WAIT");
05426          }
05427 
05428 # else
05429          PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token));
05430          parse_err_flush(Find_EOS, NULL);
05431 # endif
05432 
05433          break;
05434 
05435       case Tok_Mic_Send:
05436 
05437 # if (_ACCEPT_MIC_SEND)
05438 
05439          ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05440 
05441          line = TOKEN_LINE(token);
05442          column = TOKEN_COLUMN(token);
05443 
05444          ir_idx       = gen_directive_ir(Send_Cmic_Opr);
05445          OPND_LINE_NUM(opnd)    = LA_CH_LINE;
05446          OPND_COL_NUM(opnd)   = LA_CH_COLUMN;
05447          opnd       = null_opnd;
05448          OPND_LINE_NUM(point_opnd)  = LA_CH_LINE;
05449          OPND_COL_NUM(point_opnd) = LA_CH_COLUMN;
05450          point_opnd     = null_opnd;
05451 
05452          if (LA_CH_VALUE == EOS) {
05453 
05454             /* Intentionally blank */
05455          }
05456          else if (MATCHED_TOKEN_CLASS(Tok_Class_Mic_Kwd)) {
05457 
05458             if (TOKEN_VALUE(token) == Tok_Mic_Point) {
05459 
05460                if (LA_CH_VALUE == LPAREN) {
05461                   NEXT_LA_CH;
05462                   ok = parse_expr(&point_opnd);
05463 
05464                   if (LA_CH_VALUE != RPAREN) {
05465                      parse_err_flush(Find_EOS, ")");
05466                   }
05467                   else {
05468                      NEXT_LA_CH;  /* Pick up Rparen. */
05469                   }
05470 
05471                   if (LA_CH_VALUE != EOS) {
05472 
05473                      if (!MATCHED_TOKEN_CLASS(Tok_Class_Mic_Kwd) ||
05474                          TOKEN_VALUE(token) != Tok_Mic_If) {
05475                         reset_lex(TOKEN_BUF_IDX(token), TOKEN_STMT_NUM(token));
05476                         parse_err_flush(Find_EOS, "IF or EOS");
05477                      }
05478                      else if (LA_CH_VALUE == LPAREN) {
05479                         NEXT_LA_CH;
05480                         ok = parse_expr(&opnd);
05481 
05482                         if (LA_CH_VALUE != RPAREN) {
05483                            parse_err_flush(Find_EOS, ")");
05484                         }
05485                         else {
05486                            NEXT_LA_CH;  /* Pick up Rparen. */
05487                         }
05488 
05489                         if (LA_CH_VALUE != EOS) {
05490                            parse_err_flush(Find_EOS, "EOS");
05491                         }
05492                      }
05493                      else {
05494                         parse_err_flush(Find_EOS, "(");
05495                      }
05496                   }
05497                }
05498                else {
05499                   parse_err_flush(Find_EOS, "(");
05500                }
05501             }
05502             else if (TOKEN_VALUE(token) == Tok_Mic_If) {
05503 
05504                if (LA_CH_VALUE == LPAREN) {
05505                   NEXT_LA_CH;
05506                   ok = parse_expr(&opnd);
05507 
05508                   if (LA_CH_VALUE != RPAREN) {
05509                      parse_err_flush(Find_EOS, ")");
05510                   }
05511                   else {
05512                      NEXT_LA_CH;  /* Pick up Rparen. */
05513                   }
05514 
05515                   if (LA_CH_VALUE != EOS) {
05516                      parse_err_flush(Find_EOS, "EOS");
05517                   }
05518                }
05519                else {
05520                   parse_err_flush(Find_EOS, "(");
05521                }
05522             }
05523             else {
05524                parse_err_flush(Find_EOS, "POINT, IF or EOS");
05525             }
05526          }
05527          else {
05528             parse_err_flush(Find_EOS, "POINT, IF or EOS");
05529          }
05530 
05531          COPY_OPND(IR_OPND_L(ir_idx), point_opnd);
05532          COPY_OPND(IR_OPND_R(ir_idx), opnd);
05533 
05534          /* This directive must be specified within a doall or doparallel */
05535          /* region.  Search the block stack to make sure one exists.      */
05536          /* SENDS's should have a wait, but this is checking in case      */
05537          /* there is a SEND without a WAIT that is not in a doparallel    */
05538 
05539          blk_idx  = blk_stk_idx;
05540          do_blk_idx = NULL_IDX;
05541          found_do = FALSE;
05542 
05543          while (blk_idx > 0) {
05544 
05545             if (BLK_TYPE(blk_idx) == Do_Parallel_Blk ||
05546                 BLK_TYPE(blk_idx) == Doall_Blk) {
05547                do_blk_idx = blk_idx;
05548                break;
05549             }
05550 
05551             if (BLK_TYPE(blk_idx) == Do_Blk) {
05552                found_do = TRUE;
05553             }
05554             blk_idx--;
05555          }
05556 
05557          if (do_blk_idx == NULL_IDX) {  /* Did not find the block */
05558 
05559             /* Issue error - Need to be in doparallel or doall region.*/
05560 
05561             PRINTMSG(line, 1520, Error, column, "SEND");
05562          }
05563 
05564          if (!found_do) {  /* Issue error - Need to be in a do block. */
05565             PRINTMSG(line, 1385, Error, column, "SEND");
05566          }
05567       
05568 
05569 # else
05570          PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token));
05571          parse_err_flush(Find_EOS, NULL);
05572 # endif
05573 
05574          break;
05575 
05576 
05577       case Tok_Mic_Continue:
05578       case Tok_Mic_Taskcommon:
05579 
05580          PRINTMSG(TOKEN_LINE(token), 801, Warning, TOKEN_COLUMN(token));
05581          parse_err_flush(Find_EOS, NULL);
05582          break;
05583 
05584       default:
05585          PRINTMSG(TOKEN_LINE(token), 790, Warning, TOKEN_COLUMN(token));
05586          parse_err_flush(Find_EOS, NULL);
05587 
05588       }  /* end switch */
05589 
05590 CONTINUE:
05591 
05592       if (LA_CH_VALUE == COMMA) {
05593          NEXT_LA_CH;
05594 
05595          if (!MATCHED_TOKEN_CLASS(Tok_Class_Mic_Kwd)) {
05596             parse_err_flush(Find_EOS, NULL);
05597             NEXT_LA_CH;
05598             break;
05599          }
05600       }
05601       else {
05602          break;
05603       }
05604    }  /* End for */
05605 
05606    /* Flush past all unimplemented dirs */
05607 
05608    if (LA_CH_VALUE != EOS) {
05609       PRINTMSG(LA_CH_LINE, 790, Warning, LA_CH_COLUMN);
05610       parse_err_flush(Find_EOS, NULL);
05611    }
05612 
05613    NEXT_LA_CH;
05614 
05615    TRACE (Func_Exit, "parse_mic_directives", NULL);
05616 
05617    return;
05618 
05619 }  /* parse_mic_directives */
05620 
05621 /******************************************************************************\
05622 |*                        *|
05623 |* Description:                     *|
05624 |*  This routine parses the C$PAR directives on one line of source.       *|
05625 |*                        *|
05626 |* Input parameters:                    *|
05627 |*  NONE                      *|
05628 |*                        *|
05629 |* Output parameters:                   *|
05630 |*  NONE                      *|
05631 |*                        *|
05632 |* Returns:                     *|
05633 |*  NOTHING                     *|
05634 |*                        *|
05635 \******************************************************************************/
05636 static void parse_par_directives(void)
05637 {
05638    int    ir_idx;
05639    opnd_type  opnd;
05640    boolean  paren = FALSE;
05641    int    sh_idx;
05642 
05643    TRACE (Func_Entry, "parse_par_directives", NULL);
05644 
05645    if (TOKEN_VALUE(token) > Tok_SGI_Dir_Start &&
05646        TOKEN_VALUE(token) < Tok_SGI_Dir_End &&
05647        disregard_mips[TOKEN_VALUE(token) - Tok_SGI_Dir_Start]) {
05648       goto EXIT;
05649    }
05650 
05651    switch (TOKEN_VALUE(token)) {
05652 
05653    case Tok_SGI_Dir_Parallel:
05654       ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05655       ir_idx = gen_directive_ir(Parallel_Par_Opr);
05656 
05657       parse_mp_directive(Parallel);
05658 
05659       if (directive_region_error(Sgi_Parallel_Dir,
05660                                  IR_LINE_NUM(ir_idx),
05661                                  IR_COL_NUM(ir_idx))) {
05662       }
05663       else {
05664          SET_DIRECTIVE_STATE(Sgi_Parallel_Region);
05665          PUSH_BLK_STK (SGI_Parallel_Blk);
05666          BLK_IS_PARALLEL_REGION(blk_stk_idx)  = TRUE;
05667          CURR_BLK_FIRST_SH_IDX     = curr_stmt_sh_idx;
05668          LINK_TO_PARENT_BLK;
05669       }
05670 
05671       break;
05672 
05673    case Tok_SGI_Dir_Paralleldo:
05674       ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05675       ir_idx = gen_directive_ir(Parallel_Do_Par_Opr);
05676 
05677       parse_mp_directive(Parallel_Do);
05678 
05679       if (directive_region_error(Parallel_Do_Dir,
05680                                  IR_LINE_NUM(ir_idx),
05681                                  IR_COL_NUM(ir_idx))) {
05682       }
05683       else {
05684          SET_DIRECTIVE_STATE(Parallel_Do_Region);
05685          cdir_switches.paralleldo_sh_idx = curr_stmt_sh_idx;
05686       }
05687 
05688       break;
05689 
05690    case Tok_SGI_Dir_Pdo:
05691       ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05692       ir_idx = gen_directive_ir(Pdo_Par_Opr);
05693 
05694       parse_mp_directive(Pdo);
05695 
05696       if (directive_region_error(Pdo_Dir,
05697                                  IR_LINE_NUM(ir_idx),
05698                                  IR_COL_NUM(ir_idx))) {
05699       }
05700       else {
05701          SET_DIRECTIVE_STATE(Pdo_Region);
05702          cdir_switches.pdo_sh_idx = curr_stmt_sh_idx;
05703       }
05704 
05705       break;
05706 
05707    case Tok_SGI_Dir_Barrier:
05708 
05709       ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05710       ir_idx = gen_directive_ir(Barrier_Par_Opr);
05711 
05712       if (directive_region_error(Barrier_Dir,
05713                                  IR_LINE_NUM(ir_idx),
05714                                  IR_COL_NUM(ir_idx))) {
05715       }
05716 
05717       break;
05718 
05719 
05720    case Tok_SGI_Dir_Criticalsection:
05721       ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05722       ir_idx = gen_directive_ir(Critical_Section_Par_Opr);
05723 
05724       if (LA_CH_VALUE != EOS) {
05725 
05726          if (LA_CH_VALUE == LPAREN) {
05727             paren = TRUE;
05728             NEXT_LA_CH;
05729          }
05730 
05731          if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
05732 
05733             if (! parse_deref(&opnd, NULL_IDX)) {
05734                parse_err_flush(Find_Rparen, NULL);
05735             }
05736             else {
05737                COPY_OPND(IR_OPND_L(ir_idx), opnd);
05738             }
05739          }
05740          else {
05741             parse_err_flush(Find_Rparen, "IDENTIFIER");
05742          }
05743 
05744          if (paren) {
05745             if (LA_CH_VALUE == RPAREN) {
05746                NEXT_LA_CH;
05747             }
05748             else {
05749                parse_err_flush(Find_EOS, ")");
05750             }
05751          }
05752       }
05753 
05754       if (directive_region_error(Critical_Section_Dir,
05755                                  IR_LINE_NUM(ir_idx),
05756                                  IR_COL_NUM(ir_idx))) {
05757       }
05758 
05759       SET_DIRECTIVE_STATE(Critical_Section_Region);
05760       PUSH_BLK_STK (SGI_Critical_Section_Blk);
05761       BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE;
05762       CURR_BLK_FIRST_SH_IDX     = curr_stmt_sh_idx;
05763       LINK_TO_PARENT_BLK;
05764       break;
05765 
05766    case Tok_SGI_Dir_Endcriticalsection:
05767       ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05768       ir_idx = gen_directive_ir(End_Critical_Section_Par_Opr);
05769 
05770       if (directive_region_error(End_Critical_Section_Dir,
05771                                  IR_LINE_NUM(ir_idx),
05772                                  IR_COL_NUM(ir_idx))) {
05773       }
05774 
05775       CLEAR_DIRECTIVE_STATE(Critical_Section_Region);
05776       SH_STMT_TYPE(curr_stmt_sh_idx) = SGI_End_Critical_Section_Stmt;
05777       stmt_type = SGI_End_Critical_Section_Stmt;
05778       end_critical_section_blk(FALSE);
05779       break;
05780 
05781    case Tok_SGI_Dir_Singleprocess:
05782       ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05783       ir_idx = gen_directive_ir(Singleprocess_Par_Opr);
05784 
05785       parse_mp_directive(Singleprocess);
05786 
05787       if (directive_region_error(Single_Process_Dir,
05788                                  IR_LINE_NUM(ir_idx),
05789                                  IR_COL_NUM(ir_idx))) {
05790       }
05791 
05792       SET_DIRECTIVE_STATE(Single_Process_Region);
05793       PUSH_BLK_STK (SGI_Single_Process_Blk);
05794       BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE;
05795       CURR_BLK_FIRST_SH_IDX     = curr_stmt_sh_idx;
05796       LINK_TO_PARENT_BLK;
05797       break;
05798 
05799    case Tok_SGI_Dir_Endsingleprocess:
05800       ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05801       ir_idx = gen_directive_ir(End_Singleprocess_Par_Opr);
05802 
05803       if (directive_region_error(End_Single_Process_Dir,
05804                                  IR_LINE_NUM(ir_idx),
05805                                  IR_COL_NUM(ir_idx))) {
05806       }
05807 
05808       CLEAR_DIRECTIVE_STATE(Single_Process_Region);
05809       IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token);
05810       IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token);
05811       IR_FLD_L(ir_idx) = CN_Tbl_Idx;
05812 
05813       if (LA_CH_VALUE != EOS) {
05814          if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd) &&
05815              TOKEN_VALUE(token) == Tok_SGI_Dir_Nowait) {
05816 
05817            IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX;
05818          }
05819          else {
05820             parse_err_flush(Find_EOS, EOS_STR);
05821          }
05822       }
05823       else {
05824         IR_IDX_L(ir_idx) = CN_INTEGER_ZERO_IDX;
05825       }
05826 
05827       SH_STMT_TYPE(curr_stmt_sh_idx) = SGI_End_Single_Process_Stmt;
05828       stmt_type = SGI_End_Single_Process_Stmt;
05829       end_single_process_blk(FALSE);
05830       break;
05831 
05832 
05833    case Tok_SGI_Dir_Endpsections:
05834    case Tok_SGI_Dir_Endpsection:
05835       ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05836       ir_idx = gen_directive_ir(End_Psection_Par_Opr);
05837 
05838       if (directive_region_error(End_Psection_Dir,
05839                                  IR_LINE_NUM(ir_idx),
05840                                  IR_COL_NUM(ir_idx))) {
05841       }
05842 
05843       CLEAR_DIRECTIVE_STATE(Parallel_Section_Region);
05844       IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token);
05845       IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token);
05846       IR_FLD_L(ir_idx) = CN_Tbl_Idx;
05847 
05848       if (LA_CH_VALUE != EOS) {
05849          if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd) &&
05850              TOKEN_VALUE(token) == Tok_SGI_Dir_Nowait) {
05851 
05852            IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX;
05853          }
05854          else {
05855             parse_err_flush(Find_EOS, EOS_STR);
05856          }
05857       }
05858       else {
05859         IR_IDX_L(ir_idx) = CN_INTEGER_ZERO_IDX;
05860       }
05861 
05862       SH_STMT_TYPE(curr_stmt_sh_idx) = SGI_End_Psection_Stmt;
05863       stmt_type = SGI_End_Psection_Stmt;
05864       end_psection_blk(FALSE);
05865 
05866       break;
05867 
05868    case Tok_SGI_Dir_Endparallel:
05869       ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05870       ir_idx = gen_directive_ir(End_Parallel_Par_Opr);
05871 
05872       if (directive_region_error(Sgi_End_Parallel_Dir,
05873                                  IR_LINE_NUM(ir_idx),
05874                                  IR_COL_NUM(ir_idx))) {
05875       }
05876 
05877       CLEAR_DIRECTIVE_STATE(Sgi_Parallel_Region);
05878       SH_STMT_TYPE(curr_stmt_sh_idx) = SGI_End_Parallel_Stmt;
05879       stmt_type = SGI_End_Parallel_Stmt;
05880       end_SGI_parallel_blk(FALSE);
05881       break;
05882 
05883    case Tok_SGI_Dir_Endpdo:
05884       ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05885       ir_idx = gen_directive_ir(End_Pdo_Par_Opr);
05886 
05887       if (LA_CH_VALUE != EOS) {
05888          if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd) &&
05889              TOKEN_VALUE(token) == Tok_SGI_Dir_Nowait) {
05890 
05891             IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token);
05892             IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token);
05893             IR_FLD_L(ir_idx) = CN_Tbl_Idx;
05894             IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX;
05895          }
05896          else {
05897             parse_err_flush(Find_EOS, EOS_STR);
05898          }
05899       }
05900 
05901       SH_STMT_TYPE(curr_stmt_sh_idx) = SGI_End_Pdo_Stmt;
05902 
05903       if (SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx)) != NULL_IDX &&
05904           IR_OPR(SH_IR_IDX(SH_PREV_IDX(curr_stmt_sh_idx))) == End_Pdo_Par_Opr &&
05905           SH_COMPILER_GEN(SH_PREV_IDX(curr_stmt_sh_idx))) {
05906 
05907          /* remove the CG end pdo */
05908          sh_idx = SH_PREV_IDX(curr_stmt_sh_idx);
05909          COPY_OPND(IR_OPND_R(ir_idx), IR_OPND_R(SH_IR_IDX(sh_idx)));
05910 
05911          SH_PREV_IDX(SH_NEXT_IDX(sh_idx)) = SH_PREV_IDX(sh_idx);
05912          SH_NEXT_IDX(SH_PREV_IDX(sh_idx)) = SH_NEXT_IDX(sh_idx);
05913 
05914          FREE_IR_NODE(SH_IR_IDX(sh_idx));
05915          FREE_SH_NODE(sh_idx);
05916          break;
05917       }
05918 
05919       if (directive_region_error(End_Pdo_Dir,
05920                                  IR_LINE_NUM(ir_idx),
05921                                  IR_COL_NUM(ir_idx))) {
05922       }
05923 
05924       CLEAR_DIRECTIVE_STATE(Pdo_Region);
05925 
05926       stmt_type = SGI_End_Pdo_Stmt;
05927       end_pdo_blk(FALSE);
05928 
05929       break;
05930 
05931 
05932    case Tok_SGI_Dir_Psection:
05933    case Tok_SGI_Dir_Psections:
05934       ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05935       ir_idx = gen_directive_ir(Psection_Par_Opr);
05936 
05937       if (directive_region_error(Psection_Dir,
05938                                  IR_LINE_NUM(ir_idx),
05939                                  IR_COL_NUM(ir_idx))) {
05940       }
05941 
05942       parse_mp_directive(Psection);
05943       SET_DIRECTIVE_STATE(Parallel_Section_Region);
05944       PUSH_BLK_STK (SGI_Psection_Blk);
05945       BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE;
05946       CURR_BLK_FIRST_SH_IDX     = curr_stmt_sh_idx;
05947       LINK_TO_PARENT_BLK;
05948       break;
05949 
05950    case Tok_SGI_Dir_Section:
05951       ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
05952       ir_idx = gen_directive_ir(Section_Par_Opr);
05953 
05954       if (directive_region_error(Section_Dir,
05955                                  IR_LINE_NUM(ir_idx),
05956                                  IR_COL_NUM(ir_idx))) {
05957       }
05958 
05959       if (remove_pdo_blk(TRUE, "SECTION", IR_LINE_NUM(ir_idx),
05960                                  IR_COL_NUM(ir_idx))) {
05961       }
05962 
05963       SH_STMT_TYPE(curr_stmt_sh_idx) = SGI_Section_Stmt;
05964       stmt_type = SGI_Section_Stmt;
05965 
05966       if (CURR_BLK == SGI_Section_Blk) {
05967          end_psection_blk(FALSE);
05968       }
05969 
05970       PUSH_BLK_STK (SGI_Section_Blk);
05971       BLK_IS_PARALLEL_REGION(blk_stk_idx) = TRUE;
05972       CURR_BLK_FIRST_SH_IDX     = curr_stmt_sh_idx;
05973       LINK_TO_PARENT_BLK;
05974       break;
05975 
05976    default:
05977       /* treat as comment */
05978       parse_err_flush(Find_EOS, NULL);
05979 
05980    }  /* end switch */
05981 
05982    /* Flush past all unimplemented dirs */
05983 
05984    if (LA_CH_VALUE != EOS) {
05985       PRINTMSG(LA_CH_LINE, 790, Warning, LA_CH_COLUMN);
05986       parse_err_flush(Find_EOS, NULL);
05987    }
05988 
05989 EXIT:
05990 
05991    NEXT_LA_CH;
05992 
05993    TRACE (Func_Exit, "parse_par_directives", NULL);
05994 
05995    return;
05996 
05997 }  /* parse_par_directives */
05998 
05999 /******************************************************************************\
06000 |*                        *|
06001 |* Description:                     *|
06002 |*  This routine parses the C$ directives on one line of source.          *|
06003 |*                        *|
06004 |* Input parameters:                    *|
06005 |*  NONE                      *|
06006 |*                        *|
06007 |* Output parameters:                   *|
06008 |*  NONE                      *|
06009 |*                        *|
06010 |* Returns:                     *|
06011 |*  NOTHING                     *|
06012 |*                        *|
06013 \******************************************************************************/
06014 static void parse_dollar_directives(void)
06015 {
06016    int    ir_idx;
06017    int    list_idx;
06018    opnd_type  opnd;
06019 #ifdef KEY /* Bug 10177 */
06020    long   the_constant = 0;
06021 #else /* KEY Bug 10177 */
06022    long   the_constant;
06023 #endif /* KEY Bug 10177 */
06024 
06025 
06026    TRACE (Func_Entry, "parse_dollar_directives", NULL);
06027 
06028    if (TOKEN_VALUE(token) > Tok_SGI_Dir_Start &&
06029        TOKEN_VALUE(token) < Tok_SGI_Dir_End &&
06030        disregard_mips[TOKEN_VALUE(token) - Tok_SGI_Dir_Start]) {
06031       goto EXIT;
06032    }
06033 
06034    switch (TOKEN_VALUE(token)) {
06035 
06036    case Tok_SGI_Dir_Distribute_Reshape:
06037 
06038       if (dump_flags.dsm) {
06039          parse_distribution_dir(TRUE);
06040       } 
06041       else {
06042          parse_err_flush(Find_EOS, NULL);
06043       }
06044       break;
06045 
06046    case Tok_SGI_Dir_Distribute:
06047 
06048       if (dump_flags.dsm) {
06049          parse_distribution_dir(FALSE);
06050       } 
06051       else {
06052          parse_err_flush(Find_EOS, NULL);
06053       }
06054       break;
06055 
06056    case Tok_SGI_Dir_Redistribute:
06057       if (dump_flags.dsm) {
06058          parse_redistribute_dir();
06059       }
06060       else {
06061          parse_err_flush(Find_EOS, NULL);
06062       }
06063       break;
06064 
06065    case Tok_SGI_Dir_Dynamic:
06066       if (dump_flags.dsm) {
06067          if (parse_var_name_list(&opnd)) {
06068             ir_idx = gen_directive_ir(Dynamic_Dollar_Opr);
06069             COPY_OPND(IR_OPND_L(ir_idx), opnd);
06070          }
06071       }
06072       else {
06073          parse_err_flush(Find_EOS, NULL);
06074       }
06075       break;
06076 
06077    case Tok_SGI_Dir_Page_Place:
06078 
06079       if (dump_flags.dsm) {
06080          ir_idx = gen_directive_ir(Page_Place_Dollar_Opr);
06081 
06082          NTR_IR_LIST_TBL(list_idx);
06083          IR_FLD_L(ir_idx) = IL_Tbl_Idx;
06084          IR_IDX_L(ir_idx) = list_idx;
06085          IR_LIST_CNT_L(ir_idx) = 3;
06086  
06087          NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
06088          IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
06089          list_idx = IL_NEXT_LIST_IDX(list_idx);
06090 
06091          NTR_IR_LIST_TBL(IL_NEXT_LIST_IDX(list_idx));
06092          IL_PREV_LIST_IDX(IL_NEXT_LIST_IDX(list_idx)) = list_idx;
06093 
06094          list_idx = IR_IDX_L(ir_idx);
06095 
06096          if (LA_CH_VALUE == LPAREN) {
06097             NEXT_LA_CH;
06098 
06099             if (MATCHED_TOKEN_CLASS(Tok_Class_Id)) {
06100                parse_deref(&opnd, NULL_IDX);
06101                COPY_OPND(IL_OPND(list_idx), opnd);
06102             }
06103             else {
06104                parse_err_flush(Find_EOS, "IDENTIFIER");
06105                goto EXIT;
06106             }
06107 
06108             if (LA_CH_VALUE == COMMA) {
06109                NEXT_LA_CH;
06110             }
06111             else {
06112                parse_err_flush(Find_EOS, ",");
06113                goto EXIT;
06114             }
06115 
06116             list_idx = IL_NEXT_LIST_IDX(list_idx);
06117 
06118             parse_expr(&opnd);
06119 
06120             COPY_OPND(IL_OPND(list_idx), opnd);
06121 
06122             if (LA_CH_VALUE == COMMA) {
06123                NEXT_LA_CH;
06124             }
06125             else {
06126                parse_err_flush(Find_EOS, ",");
06127                goto EXIT;
06128             }
06129 
06130             list_idx = IL_NEXT_LIST_IDX(list_idx);
06131 
06132             parse_expr(&opnd);
06133 
06134             COPY_OPND(IL_OPND(list_idx), opnd);
06135 
06136             if (LA_CH_VALUE == RPAREN) {
06137                NEXT_LA_CH;
06138             }
06139             else {
06140                parse_err_flush(Find_EOS, ")");
06141             }
06142          }
06143          else {
06144             parse_err_flush(Find_EOS, "(");
06145          }
06146       }
06147       else {
06148          parse_err_flush(Find_EOS, NULL);
06149       }
06150       break;
06151 
06152    case Tok_SGI_Dir_Copyin:
06153 
06154       ir_idx = gen_directive_ir(Copyin_Dollar_Opr);
06155 
06156       if (directive_region_error(Copyin_Dir,
06157                                  IR_LINE_NUM(ir_idx),
06158                                  IR_COL_NUM(ir_idx))) {
06159       }
06160 
06161       parse_var_common_list(&opnd, TRUE);
06162       COPY_OPND(IR_OPND_L(ir_idx), opnd);
06163       break;
06164 
06165    case Tok_SGI_Dir_Doacross:
06166       ATP_HAS_TASK_DIRS(SCP_ATTR_IDX(curr_scp_idx)) = TRUE;
06167       ir_idx = gen_directive_ir(Doacross_Dollar_Opr);
06168 
06169       parse_mp_directive(Doacross);
06170 
06171       if (directive_region_error(Doacross_Dir,
06172                                  IR_LINE_NUM(ir_idx),
06173                                  IR_COL_NUM(ir_idx))) {
06174       }
06175       else {
06176          SET_DIRECTIVE_STATE(Doacross_Region);
06177          cdir_switches.doacross_sh_idx = curr_stmt_sh_idx;
06178       }
06179 
06180       break;
06181 
06182 
06183    case Tok_SGI_Dir_Chunk:
06184       if (LA_CH_VALUE == EQUAL) {
06185          NEXT_LA_CH;
06186 
06187          parse_expr(&opnd);
06188          COPY_OPND(cdir_switches.chunk_opnd, opnd);
06189       }
06190       else {
06191          parse_err_flush(Find_EOS, "=");
06192          goto EXIT;
06193       }
06194       break;
06195 
06196    case Tok_SGI_Dir_Mp_Schedtype:
06197 
06198       if (LA_CH_VALUE == EQUAL) {
06199 
06200          NEXT_LA_CH;
06201 
06202          if (MATCHED_TOKEN_CLASS(Tok_Class_SGI_Dir_Kwd)) {
06203 
06204             switch (TOKEN_VALUE(token)) {
06205                case Tok_SGI_Dir_Simple:
06206                   the_constant = MP_SCHEDTYPE_SIMPLE;
06207                   break;
06208                case Tok_SGI_Dir_Static:
06209                   the_constant = MP_SCHEDTYPE_SIMPLE;
06210                   break;
06211                case Tok_SGI_Dir_Dynamic:
06212                   the_constant = MP_SCHEDTYPE_DYNAMIC;
06213                   break;
06214                case Tok_SGI_Dir_Interleaved:
06215                   the_constant = MP_SCHEDTYPE_INTERLEAVED;
06216                   break;
06217                case Tok_SGI_Dir_Interleave:
06218                   the_constant = MP_SCHEDTYPE_INTERLEAVED;
06219                   break;
06220                case Tok_SGI_Dir_Runtime:
06221                   the_constant = MP_SCHEDTYPE_RUNTIME;
06222                   break;
06223                case Tok_SGI_Dir_Gss:
06224                   the_constant = MP_SCHEDTYPE_GUIDED;
06225                   break;
06226                case Tok_SGI_Dir_Guided:
06227                   the_constant = MP_SCHEDTYPE_GUIDED;
06228                   break;
06229                default:
06230                   parse_err_flush(Find_EOS, "MP_SCHEDTYPE mode");
06231                   break;
06232             }
06233 
06234 
06235             OPND_LINE_NUM(cdir_switches.mp_schedtype_opnd) = TOKEN_LINE(token);
06236             OPND_COL_NUM(cdir_switches.mp_schedtype_opnd) = TOKEN_COLUMN(token);
06237             OPND_FLD(cdir_switches.mp_schedtype_opnd) = CN_Tbl_Idx;
06238             OPND_IDX(cdir_switches.mp_schedtype_opnd) =
06239                                            C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE,
06240                                                        the_constant);
06241 
06242             if (directives_are_global) {
06243                global_schedtype_value = the_constant;
06244                global_schedtype_line = TOKEN_LINE(token);
06245                global_schedtype_col = TOKEN_COLUMN(token);
06246             }
06247          }
06248          else {
06249             parse_err_flush(Find_EOS, "MP_SCHEDTYPE mode");
06250          }
06251 
06252       }
06253       else {
06254          parse_err_flush(Find_EOS, "=");
06255          goto EXIT;
06256       }
06257       break;
06258 
06259    default:
06260       parse_err_flush(Find_EOS, NULL);
06261 
06262    }  /* end switch */
06263 
06264    /* Flush past all unimplemented dirs */
06265 
06266    if (LA_CH_VALUE != EOS) {
06267       PRINTMSG(LA_CH_LINE, 790, Warning, LA_CH_COLUMN);
06268       parse_err_flush(Find_EOS, NULL);
06269    }
06270 
06271 EXIT:
06272 
06273    NEXT_LA_CH;
06274 
06275    TRACE (Func_Exit, "parse_dollar_directives", NULL);
06276 
06277    return;
06278 
06279 }  /* parse_dollar_directives */
06280 
06281 
06282 /******************************************************************************\
06283 |*                        *|
06284 |* Description:                     *|
06285 |*  This routine parses the C*$* directives on one line of source.        *|
06286 |*                        *|
06287 |* Input parameters:                    *|
06288 |*  NONE                      *|
06289 |*                        *|
06290 |* Output parameters:                   *|
06291 |*  NONE                      *|
06292 |*                        *|
06293 |* Returns:                     *|
06294 |*  NOTHING                     *|
06295 |*                        *|
06296 \******************************************************************************/
06297 
06298 static void parse_star_directives(void)
06299 {
06300    int      attr_idx;
06301    int      blk_idx;
06302    int      column;
06303    int      ir_idx;
06304    int      line;
06305    boolean    loop_dir  = FALSE;
06306    int      name_idx;
06307    opnd_type    opnd;
06308 #ifdef KEY /* Bug 10177 */
06309    operator_type  opr = Null_Opr;
06310 #else /* KEY Bug 10177 */
06311    operator_type  opr;
06312 #endif /* KEY Bug 10177 */
06313    int      save_column_num;
06314    int      save_line_num;
06315 
06316 
06317    TRACE (Func_Entry, "parse_star_directives", NULL);
06318 
06319    if (TOKEN_VALUE(token) > Tok_SGI_Dir_Start &&
06320        TOKEN_VALUE(token) < Tok_SGI_Dir_End &&
06321        disregard_mips[TOKEN_VALUE(token) - Tok_SGI_Dir_Start]) {
06322       goto EXIT;
06323    }
06324 
06325    switch (TOKEN_VALUE(token)) {
06326 
06327    case Tok_SGI_Dir_Aggressiveinner:
06328       loop_dir  = TRUE;
06329       opr = Aggressiveinnerloopfission_Opr;
06330       break;
06331 
06332    case Tok_SGI_Dir_Blockingsize:
06333       parse_star_dir_directives();
06334       goto EXIT;
06335 
06336    case Tok_SGI_Dir_Assert:
06337 
06338       if (! parse_assert_directive()) {
06339          goto EXIT;
06340       }
06341       break;
06342 
06343    case Tok_SGI_Dir_Align_Symbol:
06344 
06345       if (curr_stmt_category < Dir_Integer_Stmt_Cat) {
06346          PRINTMSG(TOKEN_LINE(token), 795, Warning,
06347                   TOKEN_COLUMN(token), "ALIGN_SYMBOL");
06348          parse_err_flush(Find_EOS, NULL);
06349          break;
06350       }
06351 
06352       if (curr_stmt_category >= Executable_Stmt_Cat) {
06353          PRINTMSG(TOKEN_LINE(token), 531, Error,
06354                   TOKEN_COLUMN(token), 
06355                   "ALIGN_SYMBOL");
06356          parse_err_flush(Find_EOS, NULL);
06357          break;
06358       }
06359 
06360       ir_idx = gen_directive_ir(Align_Symbol_Star_Opr);
06361       parse_fill_align_symbol();
06362       break;
06363 
06364    case Tok_SGI_Dir_Fill_Symbol:
06365 
06366       if (curr_stmt_category < Dir_Integer_Stmt_Cat) {
06367          PRINTMSG(TOKEN_LINE(token), 795, Warning,
06368                   TOKEN_COLUMN(token), "FILL_SYMBOL");
06369          parse_err_flush(Find_EOS, NULL);
06370          break;
06371       }
06372 
06373       if (curr_stmt_category >= Executable_Stmt_Cat) {
06374          PRINTMSG(TOKEN_LINE(token), 531, Error,
06375                   TOKEN_COLUMN(token), 
06376                   "FILL_SYMBOL");
06377          parse_err_flush(Find_EOS, NULL);
06378          break;
06379       }
06380 
06381       ir_idx = gen_directive_ir(Fill_Symbol_Star_Opr);
06382       parse_fill_align_symbol();
06383       break;
06384 
06385    case Tok_SGI_Dir_Blockable:
06386       parse_star_dir_directives();
06387       goto EXIT;
06388 
06389    case Tok_SGI_Dir_Concurrentize:
06390       ir_idx = gen_directive_ir(Concurrentize_Star_Opr);
06391 
06392       if (directives_are_global) {
06393          /* copy the assert into the global ir table */
06394          gen_gl_sh(After, Directive_Stmt, IR_LINE_NUM(ir_idx), 
06395                    IR_COL_NUM(ir_idx),
06396                    FALSE, FALSE, TRUE);
06397          GL_SH_IR_IDX(curr_gl_stmt_sh_idx) = copy_to_gl_subtree(ir_idx,
06398                                                                 IR_Tbl_Idx);
06399       }
06400       break;
06401 
06402    case Tok_SGI_Dir_Fissionable:
06403       loop_dir  = TRUE;
06404       opr = Fissionable_Star_Opr;
06405       break;
06406 
06407    case Tok_SGI_Dir_Flush:
06408       ir_idx = gen_directive_ir(Flush_Star_Opr);
06409 
06410       if (LA_CH_VALUE == LPAREN) {
06411          NEXT_LA_CH;
06412 
06413          parse_var_name_list(&opnd);
06414          COPY_OPND(IR_OPND_L(ir_idx), opnd);
06415 
06416          if (LA_CH_VALUE == RPAREN) {
06417             NEXT_LA_CH;
06418          }
06419          else {
06420             parse_err_flush(Find_EOS, ")");
06421             goto EXIT;
06422          }
06423       }
06424       break;
06425 
06426    case Tok_SGI_Dir_Fusable:
06427       loop_dir  = TRUE;
06428       opr       = Fusable_Star_Opr;
06429       break;
06430 
06431    case Tok_SGI_Dir_Fission:
06432       ir_idx = gen_directive_ir(Fission_Star_Opr);
06433 
06434       if (LA_CH_VALUE == LPAREN) {
06435          NEXT_LA_CH;
06436 
06437          parse_expr(&opnd);
06438          COPY_OPND(IR_OPND_L(ir_idx), opnd);
06439 
06440          if (LA_CH_VALUE == RPAREN) {
06441             NEXT_LA_CH;
06442          }
06443          else {
06444             parse_err_flush(Find_EOS, ")");
06445             goto EXIT;
06446          }
06447       }
06448       else {
06449          IR_LINE_NUM_L(ir_idx) = TOKEN_LINE(token);
06450          IR_COL_NUM_L(ir_idx) = TOKEN_COLUMN(token);
06451          IR_FLD_L(ir_idx) = CN_Tbl_Idx;
06452          IR_IDX_L(ir_idx) = CN_INTEGER_ONE_IDX;
06453       }
06454       break;
06455 
06456    case Tok_SGI_Dir_Fuse:
06457       ir_idx = gen_directive_ir(Fuse_Star_Opr);
06458 
06459       if (LA_CH_VALUE == LPAREN) {
06460          NEXT_LA_CH;
06461 
06462          parse_expr(&opnd);
06463          COPY_OPND(IR_OPND_L(ir_idx), opnd);
06464 
06465          if (LA_CH_VALUE == COMMA) {
06466             NEXT_LA_CH;
06467 
06468             parse_expr(&opnd);
06469             COPY_OPND(IR_OPND_R(ir_idx), opnd);
06470          }
06471          else {
06472             /* default value is 0 for second arg */
06473 
06474