/*
 *  Copyright (C) 2006. QLogic Corporation. All Rights Reserved.
 */

/*
 * Copyright 2004, 2005, 2006 PathScale, Inc.  All Rights Reserved.
 */

/*

  Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.

   Path64 is free software; you can redistribute it and/or modify it
   under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2, or (at your option)
   any later version.

   Path64 is distributed in the hope that it will be useful, but WITHOUT
   ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
   or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
   License for more details.

   You should have received a copy of the GNU General Public License
   along with Path64; see the file COPYING.  If not, write to the Free
   Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
   02110-1301, USA.

   Special thanks goes to SGI for their continued support to open source

*/



static char USMID[] = "\n@(#)5.0_pl/sources/lex.c	5.8	08/23/99 17:26:51\n";

# include "defines.h"		/* Machine dependent ifdefs */

# include "host.m"		/* Host machine dependent macros.*/
# include "host.h"		/* Host machine dependent header.*/
# include "target.m"		/* Target machine dependent macros.*/
# include "target.h"		/* Target machine dependent header.*/

# include "globals.m"
# include "tokens.m"
# include "sytb.m"
# include "lex.m"
# include "debug.m"

# ifdef _ARITH_H
# include "arith.h"
# endif

# include "globals.h"
# include "tokens.h"
# include "sytb.h"
# include "p_globals.h"
# include "lex.h"
# include <errno.h>

/*****************************************************************\
|* function prototypes of static functions declared in this file *|
\*****************************************************************/

static boolean  convert_const(void);
static boolean	fixed_get_keyword (void);
static boolean	free_get_keyword (void);
static boolean	get_directive (void);
static boolean	get_format_str (void);
static boolean	get_label (void);
static boolean	get_micro_directive (void);
static boolean get_open_mp_directive (void);
static boolean	get_sgi_directive (void);
static boolean	get_operand_digit (void);
static boolean	get_operand_dot (void);
static boolean	get_operand_letter (void);
static boolean	get_operand_quote (void);
static boolean	get_operator (void);
static boolean	get_operator_dot (void);
static boolean	get_program_str (void);
static boolean	get_punctuator (void);
static void     convert_octal_literal (boolean);
static void 	convert_hex_literal(boolean);
static void 	convert_binary_literal(boolean);
static void	set_up_letter_idx_table(int *,kwd_type *, int);

# ifdef _DEBUG
static boolean	get_debug_directive (void);
# endif


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Init_lex is called by the main compiler driver to initialize the look *|
|*	ahead character to the first charcter of the first source input line. *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void init_lex (void)

{
   int word;


   TRACE (Func_Entry, "init_lex", NULL);

   /* set function pointers for getting next char based on source form */

   if (source_form == Fixed_Form) {
      get_char	       = fixed_get_char;
      get_char_literal = fixed_get_char_literal;
   }
   else {
      get_char	       = free_get_char;
      get_char_literal = free_get_char_literal;
   }


   /* get first look ahead char of source */

   NEXT_LA_CH;


   /* Set N$PES sighting flag.						      */

   havent_issued_ndollarpes_ansi = TRUE;


   /* initialize initial_token used to initialize token */

   for (word = 0;  word < NUM_ID_WDS;  word++) {
      TOKEN_STR_WD(initial_token, word) = 0;
   }

   TOKEN_LEN(initial_token)		= 0;
   TOKEN_VALUE(initial_token)		= Tok_Unknown;
   TOKEN_ERR(initial_token)		= FALSE;
   TOKEN_KIND_STR(initial_token)[0]	= EOS;
   TOKEN_KIND_LEN(initial_token)	= 0;
   TOKEN_COLUMN(initial_token)		= 0;
   TOKEN_LINE(initial_token)		= 0;
   TOKEN_BUF_IDX(initial_token)		= 0;
   TOKEN_STMT_NUM(initial_token)	= 0;

   TRACE (Func_Exit, "init_lex", NULL);

   return;

}  /* init_lex */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*      Used for error recovery.  This keeps getting the LA_CH value until    *|
|*      LA_CH is EOS.   The token is UNDEFINED after this is called.          *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void flush_LA_to_EOS (void)

{
   TRACE (Func_Entry, "flush_LA_to_EOS", NULL);

   la_ch = stmt_EOS_la_ch;

   TRACE (Func_Exit, "flush_LA_to_EOS", NULL);

   return;

}  /* flush_LA_to_EOS */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	This routine skips to the next punctuator, discarding the intervening *|
|*	characters.   LA_CH is set to the punctuator.  Token is UNDEFINED     *|
|*	upon exit.   It skips over quoted strings, hollerith, boz constants,  *|
|*	and other operands.  Used for error recovery.                         *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void flush_LA_to_symbol (void)

{

   TRACE (Func_Entry, "flush_LA_to_symbol", NULL);
   
   do {

      if (LA_CH_CLASS == Ch_Class_Letter) {
         NEXT_LA_CH;
         while (VALID_LA_CH) {
            NEXT_LA_CH;
         }
      }
      else if (LA_CH_CLASS == Ch_Class_Digit || LA_CH_VALUE == DBL_QUOTE ||
          LA_CH_VALUE == QUOTE) {

         /* Skip quoted strings, hollerith constants, and other strange stuff */

         get_token(Tok_Class_Opnd);
      }
      else {
         NEXT_LA_CH;
      }
   }
   while (LA_CH_CLASS != Ch_Class_EOS  &&  LA_CH_CLASS != Ch_Class_Symbol);

   TRACE (Func_Exit, "flush_LA_to_symbol", NULL);

   return;

}  /* flush_LA_to_symbol */
#ifdef KEY /* Bug 3635 */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Check whether token exceeds our internal limit, and whether it        *|
|*	exceeds the ANSI standard limit, issuing a warning and, if need be,   *|
|*	adjusting tok_len to truncate the identifier to meet the internal     *|
|*      limit.                                                                *|
|*									      *|
|* Input parameters:							      *|
|*	tok_len			length of token             	 	      *|
|*									      *|
|* Output parameters:							      *|
|*	tok_len			new length of token            	 	      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates that we needed to truncate the token                   *|
|*	FALSE indicates that we did not need to truncate the token	      *|
|*									      *|
\******************************************************************************/
static int id_too_long(int *tok_len)
{
   if (*tok_len > ANSI90_ID_LEN) {
      if (*tok_len > MAX_ID_LEN) {
	 /* Id len exceeds our maximum, so truncate */
	 PRINTMSG (TOKEN_LINE(token), 67, Warning, TOKEN_COLUMN(token));
	 *tok_len = MAX_ID_LEN;
	 return 1;
      }
      /* Exceeds constraint imposed by F90 std, which requires
	 us to issue a message */
      PRINTMSG (TOKEN_LINE(token), 1671, Ansi, TOKEN_COLUMN(token));
   }
   return 0;
}

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Like id_too_long, but slightly different message.                     *|
|*									      *|
\******************************************************************************/
static int kind_too_long(int *tok_len) {
  if (*tok_len > ANSI90_ID_LEN) {
    if (*tok_len > MAX_ID_LEN) {
      /* Id len exceeds our maximum, so truncate */
      *tok_len = MAX_ID_LEN;
      PRINTMSG(LA_CH_LINE, 67, Warning, LA_CH_COLUMN);
      return 1;
    }
  /* Exceeds constraint imposed by F90 std, which requires
     us to issue a message */
  PRINTMSG(LA_CH_LINE, 101, Ansi, LA_CH_COLUMN);
  }
  return 0;
}

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Like id_too_long and kind_too_long, but slightly different message.   *|
|*									      *|
\******************************************************************************/
static int defined_op_too_long(int *tok_len) {
  if (*tok_len > ANSI90_ID_LEN) {
    if (*tok_len > MAX_ID_LEN) {
      /* Id len exceeds our maximum, so truncate */
      *tok_len = MAX_ID_LEN;
      PRINTMSG(LA_CH_LINE, 67, Warning, LA_CH_COLUMN);
      return 1;
    }
  /* Exceeds constraint imposed by F90 std, which requires
     us to issue a message */
  PRINTMSG(LA_CH_LINE, 65, Ansi, LA_CH_COLUMN);
  }
  return 0;
}
#endif /* KEY Bug 3635 */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Get_token is called by the parser to construct a token out of the     *|
|*	current look ahead character and additional characters from the input *|
|*	source.	 The parser supplies context information describing the class *|
|*	of token needed in the input parameter.	 Get_token uses the requested *|
|*	class to call the appropriate get_... routine to create a token.      *|
|*									      *|
|* Input parameters:							      *|
|*	class			parser requested token class		      *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*	token			token produced by scanner		      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates that a token of the requested class was produced.      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

boolean get_token (token_class_type class)

{
   boolean	result		= FALSE;
   int		tok_len		= 0;


   TRACE (Func_Entry, "get_token", NULL);

   comp_phase	= Lex_Parsing;

   switch (class) {
      case Tok_Class_Id :

         if (LA_CH_CLASS == Ch_Class_Letter         ||
             (on_off_flags.allow_leading_uscore &&
              LA_CH_VALUE == USCORE))               {

            sig_blank		= FALSE;
            result		= TRUE;
            token		= initial_token;
            TOKEN_LINE(token)	= LA_CH_LINE;
            TOKEN_COLUMN(token)	= LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
            TOKEN_VALUE(token)	= Tok_Id;

            while (VALID_LA_CH) {
               ADD_TO_TOKEN_STR (LA_CH_VALUE, tok_len);
               NEXT_LA_CH;
            }
            TOKEN_LEN(token)	= tok_len;

#ifdef KEY /* Bug 3635 */
            if (id_too_long(&tok_len)) {
               TOKEN_LEN(token) = MAX_ID_LEN;
	    }
#else
            if (tok_len > MAX_ID_LEN) { /* Id len exceeds maximum of 31 chars */
               PRINTMSG (TOKEN_LINE(token), 67, Error, TOKEN_COLUMN(token));
               TOKEN_LEN(token) = MAX_ID_LEN;
            }
#endif /* KEY Bug 3635 */
            else if (tok_len == 5  &&
                     strcmp(TOKEN_STR(token), "N$PES") == 0  &&
                     havent_issued_ndollarpes_ansi) {
               PRINTMSG (TOKEN_LINE(token), 1414, Ansi, TOKEN_COLUMN(token));
               havent_issued_ndollarpes_ansi = FALSE;
            }
         }
	 break;

      case Tok_Class_Keyword :

         if (LA_CH_CLASS == Ch_Class_Letter) {
            sig_blank		= FALSE;
            token		= initial_token;
            TOKEN_LINE(token)	= LA_CH_LINE;
            TOKEN_COLUMN(token)	= LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
	    result		= (source_form == Fixed_Form)  ?
                                   fixed_get_keyword () : free_get_keyword ();
         }
         else if (LA_CH_CLASS == Ch_Class_Dir1) {

            /* Only set to Ch_Class_Dir1 by src_input if the next letters */
            /* are known to be $ (for sgi C$ directives )                 */

            sig_blank           = FALSE;
            token               = initial_token;
            TOKEN_LINE(token)   = LA_CH_LINE;
            TOKEN_COLUMN(token) = LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
            TOKEN_VALUE(token)  = Tok_Kwd_Dir;
            TOKEN_LEN(token)    = 1;

            for (tok_len = 0; tok_len < TOKEN_LEN(token); tok_len++) {
               TOKEN_STR(token)[tok_len] = LA_CH_VALUE;
               NEXT_LA_CH;
            }
            result = TRUE;
         }
         else if (LA_CH_CLASS == Ch_Class_Dir2) {

            
            /* Only set to Ch_Class_Dir2 by src_input if the prefix is known */
            /* to be 2 chars. There are none at this time.                   */

            sig_blank           = FALSE;
            token               = initial_token;
            TOKEN_LINE(token)   = LA_CH_LINE;
            TOKEN_COLUMN(token) = LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
            TOKEN_VALUE(token)  = Tok_Kwd_Dir;
            TOKEN_LEN(token)    = 2;

            for (tok_len = 0; tok_len < TOKEN_LEN(token); tok_len++) {
               TOKEN_STR(token)[tok_len] = LA_CH_VALUE;
               NEXT_LA_CH;
            }
            result = TRUE;
         }
         else if (LA_CH_CLASS == Ch_Class_Dir3) {

            /* Only set to Ch_Class_Dir3 by src_input if the next letters */
            /* are known to be the start of a C*$* directive              */

            sig_blank           = FALSE;
            token               = initial_token;
            TOKEN_LINE(token)   = LA_CH_LINE;
            TOKEN_COLUMN(token) = LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
            TOKEN_VALUE(token)  = Tok_Kwd_Dir;
            TOKEN_LEN(token)    = 3;

            for (tok_len = 0; tok_len < TOKEN_LEN(token); tok_len++) {
               TOKEN_STR(token)[tok_len] = LA_CH_VALUE;
               NEXT_LA_CH;
            }
            result = TRUE;
         }
         else if (LA_CH_CLASS == Ch_Class_Dir4) {

            /* Only set to Ch_Class_Dir4 by src_input if the next letters */
            /* are known to be the start of a CMIC, CDIR, or C$PAR        */

            sig_blank           = FALSE;
            token               = initial_token;
            TOKEN_LINE(token)   = LA_CH_LINE;
            TOKEN_COLUMN(token) = LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
            TOKEN_VALUE(token)  = Tok_Kwd_Dir;
            TOKEN_LEN(token)    = 4;

            for (tok_len = 0; tok_len < TOKEN_LEN(token); tok_len++) {
               TOKEN_STR(token)[tok_len] = LA_CH_VALUE;
               NEXT_LA_CH;
            }
            result = TRUE;
         }
         else if (LA_CH_VALUE == USCORE &&
                  on_off_flags.allow_leading_uscore) {
         
            sig_blank           = FALSE;
            result              = TRUE;
            token               = initial_token;
            TOKEN_LINE(token)   = LA_CH_LINE;
            TOKEN_COLUMN(token) = LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
            TOKEN_VALUE(token)  = Tok_Id;

            while (VALID_LA_CH) {
               ADD_TO_TOKEN_STR (LA_CH_VALUE, tok_len);
               NEXT_LA_CH;
            }
            TOKEN_LEN(token)    = tok_len;

#ifdef KEY /* Bug 3635 */
            if (id_too_long(&tok_len)) {
               TOKEN_LEN(token) = MAX_ID_LEN;
	    }
#else
            if (tok_len > MAX_ID_LEN) { /* Id len exceeds maximum of 31 chars */
               PRINTMSG (TOKEN_LINE(token), 67, Error, TOKEN_COLUMN(token));
               TOKEN_LEN(token) = MAX_ID_LEN;
            }
#endif /* KEY Bug 3635 */
         }

	 break;

      case Tok_Class_Punct :
         if (LA_CH_CLASS == Ch_Class_Symbol || LA_CH_CLASS == Ch_Class_EOS) {
            sig_blank		= FALSE;
            token		= initial_token;
            TOKEN_LINE(token)	= LA_CH_LINE;
            TOKEN_COLUMN(token)	= LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
	    result		= get_punctuator ();
         }
	 break;

      case Tok_Class_Op :
         if (LA_CH_CLASS == Ch_Class_Symbol) {
            sig_blank		= FALSE;
            token		= initial_token;
            TOKEN_LINE(token)	= LA_CH_LINE;
            TOKEN_COLUMN(token)	= LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
	    result		= get_operator ();
         }
	 break;

      case Tok_Class_Opnd :
         switch (LA_CH_CLASS) {
            case Ch_Class_Digit:
               sig_blank		= FALSE;
               token			= initial_token;
               TOKEN_LINE(token)	= LA_CH_LINE;
               TOKEN_COLUMN(token)	= LA_CH_COLUMN;
               TOKEN_BUF_IDX(token)	= LA_CH_BUF_IDX;
               TOKEN_STMT_NUM(token)	= LA_CH_STMT_NUM;
	       result			= get_operand_digit ();
               break;

     	    case Ch_Class_Letter:
               sig_blank		= FALSE;
               token			= initial_token;
               TOKEN_LINE(token)	= LA_CH_LINE;
               TOKEN_BUF_IDX(token)	= LA_CH_BUF_IDX;
               TOKEN_STMT_NUM(token)	= LA_CH_STMT_NUM;
               TOKEN_COLUMN(token)	= LA_CH_COLUMN;
	       result			= get_operand_letter ();

               if (TOKEN_LEN(token) == 5  &&
                   strcmp(TOKEN_STR(token), "N$PES") == 0  &&
                   havent_issued_ndollarpes_ansi) {
                  PRINTMSG (TOKEN_LINE(token), 1414, Ansi, TOKEN_COLUMN(token));
                  havent_issued_ndollarpes_ansi = FALSE;

               }

               break;

            case Ch_Class_EOS:
	       result = FALSE;
               break;

            case Ch_Class_Symbol:
	       if (LA_CH_VALUE == DOT) {
                  sig_blank		= FALSE;
                  token			= initial_token;
                  TOKEN_LINE(token)	= LA_CH_LINE;
                  TOKEN_COLUMN(token)	= LA_CH_COLUMN;
                  TOKEN_BUF_IDX(token)	= LA_CH_BUF_IDX;
                  TOKEN_STMT_NUM(token)	= LA_CH_STMT_NUM;
                  result		= get_operand_dot ();
               }
               else if (LA_CH_VALUE == QUOTE  ||  LA_CH_VALUE == DBL_QUOTE) {
                  sig_blank		= FALSE;
                  token			= initial_token;
                  TOKEN_LINE(token)	= LA_CH_LINE;
                  TOKEN_COLUMN(token)	= LA_CH_COLUMN;
                  TOKEN_BUF_IDX(token)	= LA_CH_BUF_IDX;
                  TOKEN_STMT_NUM(token)	= LA_CH_STMT_NUM;
                  result		= get_operand_quote ();
              }
              break;
         } /* End switch */
     	 break;

      case Tok_Class_Int_Spec :
         if (LA_CH_CLASS == Ch_Class_Digit) {
            sig_blank		= FALSE;
            result		= TRUE;
            token		= initial_token;
            TOKEN_LINE(token)	= LA_CH_LINE;
            TOKEN_COLUMN(token)	= LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
            TOKEN_VALUE(token)	= Tok_Const_Int;

            while (LA_CH_CLASS == Ch_Class_Digit && !sig_blank) {
               ADD_TO_CONST_BUF (LA_CH_VALUE, tok_len);
               NEXT_LA_CH;
            }

            CHECK_FOR_FREE_BLANK;

            const_buf[tok_len] = '\0';

            CONVERT_INT_CONST(INTEGER_DEFAULT_TYPE, tok_len, result);
         }
	 break;

      case Tok_Class_Label :
         if (LA_CH_CLASS == Ch_Class_Digit) {
            sig_blank		= FALSE;
            token		= initial_token;
            TOKEN_LINE(token)	= LA_CH_LINE;
            TOKEN_COLUMN(token)	= LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
            result		= get_label ();
         }
	 break;

      case Tok_Class_Construct_Def :

         /* This could really be written as a buffer search.  */
         /* done at the start of every statement.   JLS/jls   */
         /* TRUE returned if construct name of < 32 chars     */
         /* found and is followed by a single colon.          */

         if (LA_CH_CLASS == Ch_Class_Letter) {
            sig_blank		= FALSE;
            token		= initial_token;
            TOKEN_LINE(token)	= LA_CH_LINE;
            TOKEN_COLUMN(token)	= LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;

            while (VALID_LA_CH) {
               ADD_TO_TOKEN_STR (LA_CH_VALUE, tok_len);
               NEXT_LA_CH;
            }

            /* Check to see if this is really a construct name */

            if (LA_CH_VALUE != COLON) {
               reset_lex(TOKEN_BUF_IDX(token), TOKEN_STMT_NUM(token));
            }
            else {
               NEXT_LA_CH;

               if (LA_CH_VALUE != COLON) { /* id followed by :: */
#ifdef KEY /* Bug 3635 */
		  id_too_long(&tok_len);
#else
                  if (tok_len > MAX_ID_LEN) { 
                     /* Id len exceeds maximum of 31 chars */
                     PRINTMSG (TOKEN_LINE(token), 67, Error, 
                               TOKEN_COLUMN(token));
                     tok_len = MAX_ID_LEN;
                  }
#endif /* KEY Bug 3635 */
                  result		= TRUE;
                  TOKEN_LEN(token)	= tok_len;
                  TOKEN_VALUE(token)	= Tok_Id;
               }
               else {
                  reset_lex(TOKEN_BUF_IDX(token), TOKEN_STMT_NUM(token));
               }
            }
         }
         break;

      case Tok_Class_DO :
         if (LA_CH_CLASS == Ch_Class_Letter) {
            sig_blank		= FALSE;
            token		= initial_token;
            TOKEN_LINE(token)	= LA_CH_LINE;
            TOKEN_COLUMN(token)	= LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;

            if (source_form == Fixed_Form) {

               /* This is a kludge to get around the fixed source form problem*/
               /* of DOUBLE possibly being a DO stmt (e.g. DO uble = ...).    */
               /* It is assumed the DOUBLE was previously parsed as type      */
               /* specification statement and failed making the check a DO    */
               /* stmt necessary.  Since DOUBLE has already been seen, this   */
               /* routine is rather trivial but must be done in order to get  */
               /* the line and column information in the loop variable token  */
               /* (UBLE) correct if this is indeed a DO stmt.	              */

               TOKEN_VALUE(token)	= Tok_Kwd_Do;
               result			= TRUE;

               if (LA_CH_VALUE != 'D') {  /* Abort compilation */

                  /* Invalid character encountered;  expected keyword         */
		  /* DO following failed parse of type spec DOUBLE            */

                  /* Following is a detailed description of when message 38   */
                  /* issues.  The parser encountered a DOUBLE keyword at the  */
                  /* beginning of a statement and attempted to parse the      */
                  /* statement as a type specifier and failed.  The parser    */
                  /* has to special case this situation by reseting the       */
                  /* scanner input and asking for the DO keyword using        */
                  /* Tok_Class_Do in get_token, because DOUBLE could possibly */
                  /* be a DO statement in fixed source form                   */
                  /* (e.g. DO uble = ...).  The scanner assumes DOUBLE had    */
                  /* been previously fetched as a token and therefore the     */
                  /* routine that gets the DO keyword (fixed_get_DO_keyword)  */
                  /* makes assumptions by expecting DO.                       */

            	  PRINTMSG (LA_CH_LINE, 38, Internal, LA_CH_COLUMN);
               }
               NEXT_LA_CH;

               if (LA_CH_VALUE != 'O') {  /* Abort compilation - see above */
            	  PRINTMSG (LA_CH_LINE, 38, Internal, LA_CH_COLUMN);
               }

               TOKEN_STR(token)[0]	= 'D';
               TOKEN_STR(token)[1]	= 'O';
               TOKEN_LEN(token)		= 2;
               NEXT_LA_CH;
            }
            else { 
               result = free_get_keyword ();
            }

         }
	 break;

      case Tok_Class_Dir_Kwd :
         if (LA_CH_CLASS == Ch_Class_Letter) {
            sig_blank		= FALSE;
            token		= initial_token;
            TOKEN_LINE(token)	= LA_CH_LINE;
            TOKEN_COLUMN(token)	= LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
            result		= get_directive ();
         }
	 break;

      case Tok_Class_Mic_Kwd :
         if (LA_CH_CLASS == Ch_Class_Letter) {
            sig_blank		= FALSE;
            token		= initial_token;
            TOKEN_LINE(token)	= LA_CH_LINE;
            TOKEN_COLUMN(token)	= LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
            result		= get_micro_directive ();
         }
	 break;

      case Tok_Class_Open_Mp_Dir_Kwd :
         if (LA_CH_CLASS == Ch_Class_Letter) {
            sig_blank           = FALSE;
            token               = initial_token;
            TOKEN_LINE(token)   = LA_CH_LINE;
            TOKEN_COLUMN(token) = LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
            result              = get_open_mp_directive ();
         }
         break;

      case Tok_Class_SGI_Dir_Kwd :
         if (LA_CH_CLASS == Ch_Class_Letter) {
            sig_blank           = FALSE;
            token               = initial_token;
            TOKEN_LINE(token)   = LA_CH_LINE;
            TOKEN_COLUMN(token) = LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
            result              = get_sgi_directive ();
         }
         break;

# ifdef _DEBUG
      case Tok_Class_Dbg_Kwd :
         if (LA_CH_CLASS == Ch_Class_Letter) {
            sig_blank		= FALSE;
            token		= initial_token;
            TOKEN_LINE(token)	= LA_CH_LINE;
            TOKEN_COLUMN(token)	= LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
            result		= get_debug_directive ();
         }
	 break;
# endif

      case Tok_Class_Format_Str :
         if (LA_CH_VALUE == LPAREN) {
            sig_blank		= FALSE;
            token		= initial_token;
            TOKEN_LINE(token)	= LA_CH_LINE;
            TOKEN_COLUMN(token)	= LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
            result		= get_format_str ();
         }
	 break;

      case Tok_Class_Program_Str :
         if (LA_CH_VALUE == LPAREN) {
            sig_blank		= FALSE;
            token		= initial_token;
            TOKEN_LINE(token)	= LA_CH_LINE;
            TOKEN_COLUMN(token)	= LA_CH_COLUMN;
            TOKEN_BUF_IDX(token) = LA_CH_BUF_IDX;
            TOKEN_STMT_NUM(token) = LA_CH_STMT_NUM;
            result		= get_program_str ();
         }
	 break;
   }  /* switch */

   comp_phase	= Pass1_Parsing;
      
   TRACE (Func_Exit, "get_token", NULL);

   return (result);

}  /* get_token */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Reset_lex is called by the parser to backup the token stream for a    *|
|*	rescan.	 The reset_src_input routine is called to reposition to the   *|
|*	requested source input character and reset the global la_ch.	      *|
|*	Be careful not to call this routine, if token is already EOS.         *|
|*	Strange and not so wonderful things can happen.                       *|
|*									      *|
|* Input parameters:							      *|
|*	buf_idx			stmt_buf_idx to reset to.           	      *|
|*	stmt_num		gets passed on to reset_src_input.            *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*									      *|
|* Returns:								      *|
|*	NONE								      *|
|*									      *|
\******************************************************************************/

void reset_lex (int buf_idx,
		int stmt_num)

{
   TRACE (Func_Entry, "reset_lex", NULL);

   reset_src_input (--buf_idx, stmt_num);

   NEXT_LA_CH;

   TRACE (Func_Exit, "reset_lex", NULL);

   return;

}  /* reset_lex */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Get_directive is called by the get_token routine to attempt	      *|
|*	recognition of a directive keyword by matching the look ahead char    *|
|*	and following characters of class Ch_Class_Letter with entries in the *|
|*	kwd_dir table.	If a keyword is not found, an id token is created.    *|
|*									      *|
|* Input parameters:							      *|
|*	la_ch			first character of directive kwd token	      *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*	token			token created by get_directive		      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates a keyword or id token was produced.		      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

static boolean get_directive (void)

{
   int		beg_idx;
   la_type	la_queue[MAX_KWD_LEN + 1];
   int		letter_idx;
   int		lim_idx;
   int		tok_len		= 0;
      

   TRACE (Func_Entry, "get_directive", NULL);

# ifdef _DEBUG
   if (LA_CH_CLASS != Ch_Class_Letter) {
      PRINTMSG(TOKEN_LINE(token), 295, Internal, TOKEN_COLUMN(token),
               "get_directive", "letter");
   }
# endif

   TOKEN_VALUE(token) = Tok_Id;

   /* check for any directive keywords starting with look ahead char */

   letter_idx	= LA_CH_VALUE - 'A';
   beg_idx	= kwd_dir_idx[letter_idx];
   lim_idx	= kwd_dir_idx[letter_idx+1];
   
   if (beg_idx != lim_idx) {

#ifdef _DEBUG
      if (kwd_dir_len[beg_idx] > MAX_ID_LEN) {
         PRINTMSG(TOKEN_LINE(token), 384, Internal, TOKEN_COLUMN(token),
                  beg_idx, kwd_dir_len[beg_idx]);
      }
# endif

      while ((LA_CH_CLASS == Ch_Class_Letter || LA_CH_VALUE == USCORE) && 
             tok_len < kwd_dir_len[beg_idx]) {

         /* Internal error if kwd_dir len ever exceeds MAX_ID_LEN        */
         /* There is no check.  Assume keywords may never be > 31 chars. */

	 la_queue[tok_len]		= la_ch;
         TOKEN_STR(token)[tok_len]	= LA_CH_VALUE;
         tok_len++;
	 NEXT_LA_CH;
      }
      
      TOKEN_LEN(token) = tok_len;

      if (tok_len >= kwd_dir_len[lim_idx-1]) {

	 /* compare token string to directive keyword entries */

	 while (beg_idx < lim_idx) {

	    if (kwd_dir_len[beg_idx] <= tok_len) {

	       if (strncmp(TOKEN_STR(token),
			   kwd_dir[beg_idx].name,
			   kwd_dir_len[beg_idx]) == IDENTICAL) {

		  /* the following chars and preceding letter can't be */
		  /* part of a keyword on full length match of string. */

		  if (tok_len == kwd_dir_len[beg_idx]  &&
		      (LA_CH_VALUE == USCORE  ||
		       LA_CH_VALUE == DOLLAR  ||
		       LA_CH_VALUE == AT_SIGN)) {
		  }
		  else {
		     TOKEN_VALUE(token) = kwd_dir[beg_idx].value;

		     /* adjust la_ch to be char following keyword */

		     if (tok_len > kwd_dir_len[beg_idx]) {
			tok_len			= kwd_dir_len[beg_idx];
			la_ch			= la_queue[tok_len];
			TOKEN_LEN(token)	= tok_len;
			reset_src_input (LA_CH_BUF_IDX, LA_CH_STMT_NUM);
		     }
		     break;
		  }
	       }
	    }

	    beg_idx++;

	 }  /* while */
      }	 /* if */
   }  /* if */

   if (TOKEN_VALUE(token) == Tok_Id) {			/* keyword not found  */

      while (VALID_LA_CH) {
	 ADD_TO_TOKEN_STR (LA_CH_VALUE, tok_len);
	 NEXT_LA_CH;
      }
    
#ifdef KEY /* Bug 3635 */
      id_too_long(&tok_len);
#else
      if (tok_len > MAX_ID_LEN) { /* Id len exceeds maximum of 31 characters. */
         PRINTMSG (TOKEN_LINE(token), 67, Error, TOKEN_COLUMN(token));
	 tok_len = MAX_ID_LEN;
      }
#endif /* KEY Bug 3635 */

      TOKEN_LEN(token) = tok_len;
   }

   TRACE (Func_Exit, "get_directive", NULL);

   return (TRUE);
   
}  /* get_directive */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Get_format_str is called by the get_token routine to attempt	      *|
|*	recognition of a format string by using the look ahead character and  *|
|*	following characters of the input source.  Blanks and embedded	      *|
|*	comments are removed from the string.				      *|
|*									      *|
|* Input parameters:							      *|
|*	la_ch			opening paren of format string		      *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*	token			token created by get_format_str		      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates a format string token was produced.		      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

static boolean get_format_str (void)

{

   TRACE (Func_Entry, "get_format_str", NULL);

# ifdef _DEBUG
   if (LA_CH_VALUE != LPAREN) {
      PRINTMSG(TOKEN_LINE(token), 295, Internal, TOKEN_COLUMN(token),
               "get_format_str", "(");
   }
# endif

   TOKEN_VALUE(token)		= Tok_Const_Char;	
   TOKEN_CONST_TBL_IDX(token)	= put_format_in_tbl();

   TRACE (Func_Exit, "get_format_str", NULL);

   return (TRUE);

}  /* get_format_str */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Fixed_get_keyword is called in fixed input source form by the	      *|
|*	get_token routine to attempt recognition of a keyword by matching the *|
|*	look ahead char and following characters of class Ch_Class_Letter     *|
|*	with entries in the kwd table.	If a keyword is not found, an id      *|
|*	token is created.						      *|
|*									      *|
|* Input parameters:							      *|
|*	la_ch			first character of kwd token		      *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*	token			token created by get_keyword		      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates a keyword or id token was produced.		      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

static boolean fixed_get_keyword (void)

{
   int		beg_idx;
   la_type	la_queue[MAX_KWD_LEN + 1];
   int		letter_idx;
   int		lim_idx;
   int		tok_len		= 0;
      

   TRACE (Func_Entry, "fixed_get_keyword", NULL);


# ifdef _DEBUG
   if (LA_CH_CLASS != Ch_Class_Letter) {
      PRINTMSG(TOKEN_LINE(token), 295, Internal, TOKEN_COLUMN(token),
               "fixed_get_keyword", "letter");
   }
# endif

   TOKEN_VALUE(token) = Tok_Id;
   
   /* check for any keywords starting with look ahead char */
   letter_idx = LA_CH_VALUE - 'A';

   beg_idx = kwd_idx[letter_idx];
   lim_idx = kwd_idx[letter_idx+1];
   
   if (beg_idx != lim_idx) {

#ifdef _DEBUG
      if (kwd_len[beg_idx] > MAX_ID_LEN) {
         PRINTMSG(TOKEN_LINE(token), 384, Internal, TOKEN_COLUMN(token),
                  beg_idx, kwd_len[beg_idx]);
      }
# endif

      while (LA_CH_CLASS == Ch_Class_Letter && tok_len < kwd_len[beg_idx]) {
         la_queue[tok_len] = la_ch;
         TOKEN_STR(token)[tok_len] = LA_CH_VALUE;
         tok_len++;
	 NEXT_LA_CH;
      }

      TOKEN_LEN(token) = tok_len;

      if (tok_len >= kwd_len[lim_idx-1]) {

         /* compare token string to keyword entries */

	 while (beg_idx < lim_idx) {
	    if (tok_len >= kwd_len[beg_idx]) {
	       if (strncmp(TOKEN_STR(token),
	       		   kwd[beg_idx].name,
			   kwd_len[beg_idx]) == IDENTICAL) {

                  /* the following chars and preceding letter can't be */
		  /* part of a keyword on full length match of string. */

		  if (tok_len == kwd_len[beg_idx]  &&
                      ! on_off_flags.allow_leading_uscore  &&
		      (LA_CH_VALUE == USCORE	 ||
		       LA_CH_VALUE == DOLLAR	 ||
		       LA_CH_VALUE == AT_SIGN)) {
                  }
	          else {
	             TOKEN_VALUE(token) = kwd[beg_idx].value;

		     /* adjust la_ch to be char following keyword */

		     if (tok_len > kwd_len[beg_idx]) {
		        tok_len		= kwd_len[beg_idx];
		        la_ch		= la_queue[tok_len];
                        TOKEN_LEN(token)	= tok_len;
		        reset_src_input (LA_CH_BUF_IDX, LA_CH_STMT_NUM);
		     }
		     break;
                  }
	       }
	    }

	    beg_idx++;

         }  /* while */
      }  /* if */
   }	 /* if */

   if (TOKEN_VALUE(token) == Tok_Id) {		/* keyword not found  */

      while (VALID_LA_CH) {
         ADD_TO_TOKEN_STR (LA_CH_VALUE, tok_len);
         NEXT_LA_CH;
      }
   
#ifdef KEY /* Bug 3635 */
      id_too_long(&tok_len);
#else
      if (tok_len > MAX_ID_LEN) { /* Id len exceeds max of 31 characters */
         PRINTMSG (TOKEN_LINE(token), 67, Error, TOKEN_COLUMN(token));
         tok_len = MAX_ID_LEN;
      }
#endif /* KEY Bug 3635 */
      TOKEN_LEN(token) = tok_len;
   }

   TRACE (Func_Exit, "fixed_get_keyword", NULL);

   return (TRUE);
   
}  /* fixed_get_keyword */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Free_get_keyword is called in free input source form by the	      *|
|*	get_token routine to attempt recognition of a keyword by matching the *|
|*	look ahead char and following characters of class Ch_Class_Letter     *|
|*	with entries in the kwd table.	If a keyword is not found, an id      *|
|*	token is created.						      *|
|*									      *|
|* Input parameters:							      *|
|*	la_ch			first character of kwd token		      *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*	token			token created by get_keyword		      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates a keyword or id token was produced.		      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

static boolean free_get_keyword (void)

{
   boolean	all_letters	= TRUE;
   int		beg_idx;
   la_type	la_queue[MAX_KWD_LEN + 1];
   int		letter_idx;
   int		lim_idx;
   int		tok_len		= 0;
      

   TRACE (Func_Entry, "free_get_keyword", NULL);

# ifdef _DEBUG
   if (LA_CH_CLASS != Ch_Class_Letter) {
      PRINTMSG(TOKEN_LINE(token), 295, Internal, TOKEN_COLUMN(token),
               "free_get_keyword", "letter");
   }
# endif

   TOKEN_VALUE(token) = Tok_Id;

   while (VALID_LA_CH) {
      if (LA_CH_CLASS != Ch_Class_Letter) {		/* non letter in kwd  */
#ifdef KEY /* Bug 5089 */
         /* F2003 allows "_" in keyword "NON_INTRINSIC" */
         all_letters = all_letters && ('_' == LA_CH_VALUE);
#else /* KEY Bug 5089 */
         all_letters = FALSE;
#endif /* KEY Bug 5089 */
      }

      if (tok_len < MAX_KWD_LEN) {
         la_queue[tok_len] = la_ch;
      }
      ADD_TO_TOKEN_STR (LA_CH_VALUE, tok_len);
      NEXT_LA_CH;
   }

   TOKEN_LEN(token) = tok_len;
   
   if (all_letters  &&  tok_len > 1  &&  tok_len <= MAX_KWD_LEN) {

      /* check for any keywords starting with first character of token */

      letter_idx	= TOKEN_STR(token)[0] - 'A';
      beg_idx		= kwd_idx[letter_idx];
      lim_idx		= kwd_idx[letter_idx+1];

      /* compare token string to keyword entries of matching length */
      while (beg_idx < lim_idx) {
         if (kwd_len[beg_idx] == tok_len) {
            if (EQUAL_STRS(TOKEN_STR(token), kwd[beg_idx].name)) {
     	       TOKEN_VALUE(token) = kwd[beg_idx].value;
               break;
            }
         }	
         beg_idx++;
      }

      if (beg_idx == lim_idx) {

         /* check for any alternate form keywords starting with first char */

         beg_idx = alt_kwd_idx[letter_idx];
         lim_idx = alt_kwd_idx[letter_idx+1];

         /* compare token string to alternate form keyword entries */

         while (beg_idx < lim_idx) {
            if (alt_kwd[beg_idx].len == tok_len) {
               if (EQUAL_STRS(TOKEN_STR(token), alt_kwd[beg_idx].name)) {
 	          TOKEN_VALUE(token)	= alt_kwd[beg_idx].value;
 	          tok_len		= alt_kwd[beg_idx].val_len;
                  TOKEN_LEN(token)	= tok_len;

                  /* adjust la_ch to be char following first keyword */

	          la_ch = la_queue[tok_len];

                  /* would'nt be here if we just passed a sig blank so .. */

                  sig_blank = FALSE;

                  /* reset src input buffer and column index to la_ch pos */

	 	  reset_src_input (LA_CH_BUF_IDX, LA_CH_STMT_NUM);
	 	  break;
               }
	    }   

	    beg_idx++;

	 } /* while */
      }  /* if */
   }	 /* if */

   if (TOKEN_VALUE(token) == Tok_Id) {

#ifdef KEY /* Bug 3635 */
      id_too_long(&tok_len);
#else
      if (tok_len > MAX_ID_LEN) { /* Id len exceeds max of 31 characters */
         PRINTMSG (TOKEN_LINE(token), 67, Error, TOKEN_COLUMN(token));
         tok_len = MAX_ID_LEN;
      }
#endif /* KEY Bug 3635 */
      TOKEN_LEN(token) = tok_len;
   }

   TRACE (Func_Exit, "free_get_keyword", NULL);

   return (TRUE);

}  /* free_get_keyword */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Get_label is called by the get_token routine to attempt recognition   *|
|*	of a label token using the look ahead character and following	      *|
|*	characters of the input source.					      *|
|*									      *|
|* Input parameters:							      *|
|*	la_ch			first character of label token		      *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*	token			token created by get_label		      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates a label token was produced.			      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

static boolean get_label (void)

{
   int		tok_cnt		= 0;
   int		tok_len		= 0;
   

   TRACE (Func_Entry, "get_label", NULL);

# ifdef _DEBUG
      if (LA_CH_CLASS != Ch_Class_Digit) {
         PRINTMSG(TOKEN_LINE(token), 295, Internal, TOKEN_COLUMN(token),
                  "get_label", "digit");
      }
# endif

   TOKEN_VALUE(token) = Tok_Label;

   while (LA_CH_VALUE == ZERO && !sig_blank) {
      NEXT_LA_CH;
      tok_cnt++;
   }

   while (LA_CH_CLASS == Ch_Class_Digit && !sig_blank) {
      ADD_TO_TOKEN_STR (LA_CH_VALUE, tok_len);
      NEXT_LA_CH;
      tok_cnt++;
   }

   CHECK_FOR_FREE_BLANK;

   TOKEN_LEN(token) = tok_len;

   if (tok_cnt == 0  ||  tok_cnt > 5) { 
      /* Label len exceeds max of 5 digits */
      PRINTMSG (TOKEN_LINE(token), 68, Error, TOKEN_COLUMN(token));

      /* truncate the long label so that error won't cascade */
      TOKEN_STR(token)[5] = '\0';
      TOKEN_LEN(token)    = 5;
      TOKEN_ERR(token)    = TRUE;
   }
   else if (tok_len == 0) { /* Label must have at least one non-zero digit */
      PRINTMSG (TOKEN_LINE(token), 69, Error, TOKEN_COLUMN(token));
      ADD_TO_TOKEN_STR ('0', TOKEN_LEN(token));
      TOKEN_ERR(token)    = TRUE;
   }

   TRACE (Func_Exit, "get_label", NULL);

   return (TRUE);

}  /* get_label */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Get_micro_directive is called by the get_token routine to attempt     *|
|*	recognition of a microtasking keyword by matching the look ahead char *|
|*	and following characters of class Ch_Class_Letter with entries in the *|
|*	kwd_mic table.	If a keyword is not found, an id token is created.    *|
|*									      *|
|* Input parameters:							      *|
|*	la_ch			first character of microtasking kwd token     *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*	token			token created by get_micro_directive	      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates a keyword or id token was produced.		      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

static boolean get_micro_directive (void)

{
   int		beg_idx;
   la_type	la_queue[MAX_KWD_LEN + 1];
   int		letter_idx;
   int		lim_idx;
   int		tok_len		= 0;
      

   TRACE (Func_Entry, "get_micro_directive", NULL);

# ifdef _DEBUG
   if (LA_CH_CLASS != Ch_Class_Letter) {
      PRINTMSG(TOKEN_LINE(token), 295, Internal, TOKEN_COLUMN(token),
               "get_micro_directive", "letter");
   }
# endif

   TOKEN_VALUE(token) = Tok_Id;

   /* check for any microtasking keywords starting with look ahead char */
   letter_idx = LA_CH_VALUE - 'A';

   beg_idx = kwd_mic_idx[letter_idx];
   lim_idx = kwd_mic_idx[letter_idx+1];
   
   if (beg_idx != lim_idx) {

#ifdef _DEBUG
      if (kwd_mic_len[beg_idx] > MAX_ID_LEN) {
         PRINTMSG(TOKEN_LINE(token), 384, Internal, TOKEN_COLUMN(token),
                  beg_idx, kwd_mic_len[beg_idx]);
      }
# endif

      while (LA_CH_CLASS == Ch_Class_Letter && tok_len < kwd_mic_len[beg_idx]) {
	 la_queue[tok_len]		= la_ch;
         TOKEN_STR(token)[tok_len]	= LA_CH_VALUE;
         tok_len++;
	 NEXT_LA_CH;
      }

      TOKEN_LEN(token) = tok_len;

      if (tok_len >= kwd_mic_len[lim_idx-1]) {

	 /* compare token string to microtasking keyword entries */

	 while (beg_idx < lim_idx) {

	    if (kwd_mic_len[beg_idx] <= tok_len) {

	       if (strncmp(TOKEN_STR(token),
			   kwd_mic[beg_idx].name,
			   kwd_mic_len[beg_idx]) == IDENTICAL) {

		  /* the following chars and preceding letter can't be */
		  /* part of a keyword on full length match of string. */

		  if (tok_len == kwd_mic_len[beg_idx]  &&
		      (LA_CH_VALUE == USCORE  ||
		       LA_CH_VALUE == DOLLAR  ||
		       LA_CH_VALUE == AT_SIGN)) {
		  }
		  else {
		     TOKEN_VALUE(token) = kwd_mic[beg_idx].value;

		     /* adjust la_ch to be char following keyword */

		     if (tok_len > kwd_mic_len[beg_idx]) {
			tok_len = kwd_mic_len[beg_idx];
			la_ch	= la_queue[tok_len];
                        TOKEN_LEN(token) = tok_len;

			/* reset src input buffer and col index to la_ch pos */
			reset_src_input (LA_CH_BUF_IDX, LA_CH_STMT_NUM);
		     }
		     break;
		  }
	       }
	    }  /* if */

	    beg_idx++;

	 }  /* while */
      }	 /* if */
   }  /* if */

   if (TOKEN_VALUE(token) == Tok_Id) {			/* keyword not found  */

      while (VALID_LA_CH) {
	 ADD_TO_TOKEN_STR (LA_CH_VALUE, tok_len);
	 NEXT_LA_CH;
      }
    
#ifdef KEY /* Bug 3635 */
      id_too_long(&tok_len);
#else
      if (tok_len > MAX_ID_LEN) { /* Id len exceeds maximum of 31 characters. */
         PRINTMSG (TOKEN_LINE(token), 67, Error, TOKEN_COLUMN(token));
	 tok_len = MAX_ID_LEN;
      }
#endif /* KEY Bug 3635 */
      TOKEN_LEN(token) = tok_len;
   }

   TRACE (Func_Exit, "get_micro_directive", NULL);

   return (TRUE);
   
}  /* get_micro_directive */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      is_par_directive is called by the classify_line routines to decide if *|
|*      a !$par prefix is followed by a directive or a comment. It must       *|
|*      remain similar in design to get_par_directive.                        *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      TRUE indicates a directive.                                           *|
|*      FALSE indicates that the line is a comment.                           *|
|*                                                                            *|
\******************************************************************************/

boolean is_par_directive (int	start_idx)

{
   int          beg_idx;
   int		blank = ' ';
   int		idx;
   boolean	is_directive = FALSE;
   int          letter_idx;
   int          lim_idx;
   int		newline = '\n';
   int		tab = '\t';
   char         upper_str[MAX_KWD_LEN + 1];
   int          str_len         = 0;


   TRACE (Func_Entry, "is_par_directive", NULL);

   idx = start_idx;

   while (nxt_line[idx] == blank || nxt_line[idx] == tab) {
      idx++;
   }

   if (ch_class[nxt_line[idx]] != Ch_Class_Letter) {
      goto EXIT;
   }
   else if (islower(nxt_line[idx])) {
      upper_str[str_len] = TOUPPER(nxt_line[idx]);
   }
   else {
      upper_str[str_len] = nxt_line[idx];
   }
   str_len++;
   idx++;

   letter_idx = upper_str[0] - 'A';

   beg_idx = kwd_sgi_dir_idx[letter_idx];
   lim_idx = kwd_sgi_dir_idx[letter_idx+1];

   if (beg_idx == lim_idx) {
      goto EXIT;
   }

   while (nxt_line[idx] != newline && str_len <= kwd_sgi_dir_len[beg_idx]) {
      if (nxt_line[idx] == blank || nxt_line[idx] == tab) {
         idx++;
      }
      else {
         if (ch_class[nxt_line[idx]] != Ch_Class_Letter &&
             nxt_line[idx] != USCORE) {
            break;
         }
         else if (islower(nxt_line[idx])) {
            upper_str[str_len] = TOUPPER(nxt_line[idx]);
         }
         else {
            upper_str[str_len] = nxt_line[idx];
         }
         str_len++;
         idx++;
      }
   }

   upper_str[str_len] = '\0';


   if (str_len >= kwd_sgi_dir_len[lim_idx-1]) {

      while (beg_idx < lim_idx) {

         if (kwd_sgi_dir_len[beg_idx] <= str_len) {

            if (strncmp(upper_str,
                        kwd_sgi_dir[beg_idx].name,
                        kwd_sgi_dir_len[beg_idx]) == IDENTICAL) {

               switch (kwd_sgi_dir[beg_idx].value) {
                  case Tok_SGI_Dir_Barrier:
                  case Tok_SGI_Dir_Criticalsection:
                  case Tok_SGI_Dir_Endcriticalsection:
                  case Tok_SGI_Dir_Endparallel:
                  case Tok_SGI_Dir_Endpdo:
                  case Tok_SGI_Dir_Endpsection:
                  case Tok_SGI_Dir_Endpsections:
                  case Tok_SGI_Dir_Endsingleprocess:
                  case Tok_SGI_Dir_Parallel:
                  case Tok_SGI_Dir_Paralleldo:
                  case Tok_SGI_Dir_Pdo:
                  case Tok_SGI_Dir_Psection:
                  case Tok_SGI_Dir_Psections:
                  case Tok_SGI_Dir_Section:
                  case Tok_SGI_Dir_Singleprocess:

                     is_directive = TRUE;
                     break;

                  default:
                     break;
               }
               break;
            }
         }  /* if */

         beg_idx++;

      }  /* while */
   }  /* if */

EXIT:

   TRACE (Func_Exit, "is_par_directive", NULL);

   return (is_directive);

}  /* is_par_directive */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      get_open_mp_directive is called by the get_token routine to attempt   *|
|*      recognition of a !$OMP        keyword by matching the look ahead char *|
|*      and following characters of class Ch_Class_Letter with entries in the *|
|*      kwd_mic table.  If a keyword is not found, an id token is created.    *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      la_ch                   first character of !$  kwd token              *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      la_ch                   next character of input source statement      *|
|*      token                   token created by get_open_mp_directive        *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      TRUE indicates a keyword or id token was produced.                    *|
|*      FALSE indicates that an error was encountered.                        *|
|*                                                                            *|
\******************************************************************************/

static boolean get_open_mp_directive (void)

{
   int          beg_idx;
   la_type      la_queue[MAX_KWD_LEN + 1];
   int          letter_idx;
   int          lim_idx;
   int          tok_len         = 0;


   TRACE (Func_Entry, "get_open_mp_directive", NULL);

# ifdef _DEBUG
   if (LA_CH_CLASS != Ch_Class_Letter) {
      PRINTMSG(TOKEN_LINE(token), 295, Internal, TOKEN_COLUMN(token),
               "get_open_mp_directive", "letter");
   }
# endif

   TOKEN_VALUE(token) = Tok_Id;

   /* check for any keywords starting with look ahead char */
   letter_idx = LA_CH_VALUE - 'A';

   beg_idx = kwd_open_mp_dir_idx[letter_idx];
   lim_idx = kwd_open_mp_dir_idx[letter_idx+1];

   if (beg_idx != lim_idx) {

#ifdef _DEBUG
      if (kwd_open_mp_dir_len[beg_idx] > MAX_ID_LEN) {
         PRINTMSG(TOKEN_LINE(token), 384, Internal, TOKEN_COLUMN(token),
                  beg_idx, kwd_open_mp_dir_len[beg_idx]);
      }
# endif

      while ((LA_CH_CLASS == Ch_Class_Letter ||
              LA_CH_CLASS == Ch_Class_Digit  ||
              LA_CH_VALUE == USCORE) &&
             tok_len < kwd_open_mp_dir_len[beg_idx]) {
         la_queue[tok_len]              = la_ch;
         TOKEN_STR(token)[tok_len]      = LA_CH_VALUE;
         tok_len++;
         NEXT_LA_CH;
      }

      TOKEN_LEN(token) = tok_len;

      if (tok_len >= kwd_open_mp_dir_len[lim_idx-1]) {

         /* compare token string to keyword entries */

         while (beg_idx < lim_idx) {

            if (kwd_open_mp_dir_len[beg_idx] <= tok_len) {

               if (strncmp(TOKEN_STR(token),
                           kwd_open_mp_dir[beg_idx].name,
                           kwd_open_mp_dir_len[beg_idx]) == IDENTICAL) {

                  /* the following chars and preceding letter can't be */
                  /* part of a keyword on full length match of string. */

                  if (tok_len == kwd_open_mp_dir_len[beg_idx]  &&
                      (LA_CH_VALUE == USCORE  ||
                       LA_CH_VALUE == DOLLAR  ||
                       LA_CH_VALUE == AT_SIGN)) {
                  }
                  else {
                     TOKEN_VALUE(token) = kwd_open_mp_dir[beg_idx].value;

                     /* adjust la_ch to be char following keyword */

                     if (tok_len > kwd_open_mp_dir_len[beg_idx]) {
                        tok_len = kwd_open_mp_dir_len[beg_idx];
                        la_ch   = la_queue[tok_len];
                        TOKEN_LEN(token) = tok_len;

                        /* reset src input buffer and col index to la_ch pos */
                        reset_src_input (LA_CH_BUF_IDX, LA_CH_STMT_NUM);
                     }
                     break;
                  }
               }
            }  /* if */

            beg_idx++;

         }  /* while */
      }  /* if */
   }  /* if */

   if (TOKEN_VALUE(token) == Tok_Id) {                  /* keyword not found  */

      while (VALID_LA_CH) {
         ADD_TO_TOKEN_STR (LA_CH_VALUE, tok_len);
         NEXT_LA_CH;
      }

#ifdef KEY /* Bug 3635 */
      id_too_long(&tok_len);
#else
      if (tok_len > MAX_ID_LEN) { /* Id len exceeds maximum of 31 characters. */
         PRINTMSG (TOKEN_LINE(token), 67, Error, TOKEN_COLUMN(token));
         tok_len = MAX_ID_LEN;
      }
#endif /* KEY Bug 3635 */
      TOKEN_LEN(token) = tok_len;
   }

   TRACE (Func_Exit, "get_open_mp_directive", NULL);

   return (TRUE);

}  /* get_open_mp_directive */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      get_sgi_directive is called by the get_token routine to attempt       *|
|*      recognition of a !$ (sgi)     keyword by matching the look ahead char *|
|*      and following characters of class Ch_Class_Letter with entries in the *|
|*      kwd_mic table.  If a keyword is not found, an id token is created.    *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      la_ch                   first character of !$  kwd token              *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      la_ch                   next character of input source statement      *|
|*      token                   token created by get_sgi_directive            *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      TRUE indicates a keyword or id token was produced.                    *|
|*      FALSE indicates that an error was encountered.                        *|
|*                                                                            *|
\******************************************************************************/

static boolean get_sgi_directive (void)

{
   int          beg_idx;
   la_type      la_queue[MAX_KWD_LEN + 1];
   int          letter_idx;
   int          lim_idx;
   int          tok_len         = 0;


   TRACE (Func_Entry, "get_sgi_directive", NULL);

# ifdef _DEBUG
   if (LA_CH_CLASS != Ch_Class_Letter) {
      PRINTMSG(TOKEN_LINE(token), 295, Internal, TOKEN_COLUMN(token),
               "get_sgi_directive", "letter");
   }
# endif

   TOKEN_VALUE(token) = Tok_Id;

   /* check for any keywords starting with look ahead char */
   letter_idx = LA_CH_VALUE - 'A';

   beg_idx = kwd_sgi_dir_idx[letter_idx];
   lim_idx = kwd_sgi_dir_idx[letter_idx+1];

   if (beg_idx != lim_idx) {

#ifdef _DEBUG
      if (kwd_sgi_dir_len[beg_idx] > MAX_ID_LEN) {
         PRINTMSG(TOKEN_LINE(token), 384, Internal, TOKEN_COLUMN(token),
                  beg_idx, kwd_sgi_dir_len[beg_idx]);
      }
# endif

      while ((LA_CH_CLASS == Ch_Class_Letter || 
              LA_CH_CLASS == Ch_Class_Digit  ||
              LA_CH_VALUE == USCORE) &&
             tok_len < kwd_sgi_dir_len[beg_idx]) {
         la_queue[tok_len]              = la_ch;
         TOKEN_STR(token)[tok_len]      = LA_CH_VALUE;
         tok_len++;
         NEXT_LA_CH;
      }

      TOKEN_LEN(token) = tok_len;

      if (tok_len >= kwd_sgi_dir_len[lim_idx-1]) {

         /* compare token string to keyword entries */

         while (beg_idx < lim_idx) {

            if (kwd_sgi_dir_len[beg_idx] <= tok_len) {

               if (strncmp(TOKEN_STR(token),
                           kwd_sgi_dir[beg_idx].name,
                           kwd_sgi_dir_len[beg_idx]) == IDENTICAL) {

                  /* the following chars and preceding letter can't be */
                  /* part of a keyword on full length match of string. */

                  if (tok_len == kwd_sgi_dir_len[beg_idx]  &&
                      (LA_CH_VALUE == USCORE  ||
                       LA_CH_VALUE == DOLLAR  ||
                       LA_CH_VALUE == AT_SIGN)) {
                  }
                  else {
                     TOKEN_VALUE(token) = kwd_sgi_dir[beg_idx].value;

                     /* adjust la_ch to be char following keyword */

                     if (tok_len > kwd_sgi_dir_len[beg_idx]) {
                        tok_len = kwd_sgi_dir_len[beg_idx];
                        la_ch   = la_queue[tok_len];
                        TOKEN_LEN(token) = tok_len;

                        /* reset src input buffer and col index to la_ch pos */
                        reset_src_input (LA_CH_BUF_IDX, LA_CH_STMT_NUM);
                     }
                     break;
                  }
               }
            }  /* if */

            beg_idx++;

         }  /* while */
      }  /* if */
   }  /* if */

   if (TOKEN_VALUE(token) == Tok_Id) {                  /* keyword not found  */

      while (VALID_LA_CH) {
         ADD_TO_TOKEN_STR (LA_CH_VALUE, tok_len);
         NEXT_LA_CH;
      }

#ifdef KEY /* Bug 3635 */
      id_too_long(&tok_len);
#else
      if (tok_len > MAX_ID_LEN) { /* Id len exceeds maximum of 31 characters. */
         PRINTMSG (TOKEN_LINE(token), 67, Error, TOKEN_COLUMN(token));
         tok_len = MAX_ID_LEN;
      }
#endif /* KEY Bug 3635 */
      TOKEN_LEN(token) = tok_len;
   }

   TRACE (Func_Exit, "get_sgi_directive", NULL);

   return (TRUE);

}  /* get_sgi_directive */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      is_dollar_directive is called by the classify_line routines to decide *|
|*      if a !$ prefix is followed by a directive or a comment. It must       *|
|*      remain similar in design to get_dollar_directive.                     *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      TRUE indicates a directive.                                           *|
|*      FALSE indicates that the line is a comment.                           *|
|*                                                                            *|
\******************************************************************************/

boolean is_dollar_directive (int	start_idx)

{
   int          beg_idx;
   int		blank = ' ';
   int		idx;
   boolean	is_directive = FALSE;
   int          letter_idx;
   int          lim_idx;
   int		newline = '\n';
   int		tab = '\t';
   char         upper_str[MAX_KWD_LEN + 1];
   int          str_len         = 0;


   TRACE (Func_Entry, "is_dollar_directive", NULL);

   idx = start_idx;

   while (nxt_line[idx] == blank || nxt_line[idx] == tab) {
      idx++;
   }

   if (ch_class[nxt_line[idx]] != Ch_Class_Letter) {
      goto EXIT;
   }
   else if (islower(nxt_line[idx])) {
      upper_str[str_len] = TOUPPER(nxt_line[idx]);
   }
   else {
      upper_str[str_len] = nxt_line[idx];
   }
   str_len++;
   idx++;

   letter_idx = upper_str[0] - 'A';

   beg_idx = kwd_sgi_dir_idx[letter_idx];
   lim_idx = kwd_sgi_dir_idx[letter_idx+1];

   if (beg_idx == lim_idx) {
      goto EXIT;
   }

   while (nxt_line[idx] != newline && str_len <= kwd_sgi_dir_len[beg_idx]) {
      if (nxt_line[idx] == blank || nxt_line[idx] == tab) {
         idx++;
      }
      else {
         if (ch_class[nxt_line[idx]] != Ch_Class_Letter &&
             nxt_line[idx] != USCORE) {
            break;
         }
         else if (islower(nxt_line[idx])) {
            upper_str[str_len] = TOUPPER(nxt_line[idx]);
         }
         else {
            upper_str[str_len] = nxt_line[idx];
         }
         str_len++;
         idx++;
      }
   }

   upper_str[str_len] = '\0';


   if (str_len >= kwd_sgi_dir_len[lim_idx-1]) {

      while (beg_idx < lim_idx) {

         if (kwd_sgi_dir_len[beg_idx] <= str_len) {

            if (strncmp(upper_str,
                        kwd_sgi_dir[beg_idx].name,
                        kwd_sgi_dir_len[beg_idx]) == IDENTICAL) {

               switch (kwd_sgi_dir[beg_idx].value) {
                  case Tok_SGI_Dir_Distribute:
                  case Tok_SGI_Dir_Distribute_Reshape:
                  case Tok_SGI_Dir_Doacross:
                  case Tok_SGI_Dir_Dynamic:
                  case Tok_SGI_Dir_Chunk:
                  case Tok_SGI_Dir_Mp_Schedtype:
                  case Tok_SGI_Dir_Page_Place:
                  case Tok_SGI_Dir_Redistribute:
                  case Tok_SGI_Dir_Copyin:

                     is_directive = TRUE;
                     break;

                  default:
                     break;
               }
               break;
            }
         }  /* if */

         beg_idx++;

      }  /* while */
   }  /* if */

EXIT:

   TRACE (Func_Exit, "is_dollar_directive", NULL);

   return (is_directive);

}  /* is_dollar_directive */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      is_star_directive is called by the classify_line routines to decide if*|
|*      a !*$* prefix is followed by a directive or a comment. It must        *|
|*      remain similar in design to get_star_directive.                       *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      TRUE indicates a directive.                                           *|
|*      FALSE indicates that the line is a comment.                           *|
|*                                                                            *|
\******************************************************************************/

boolean is_star_directive (int	start_idx)

{
   int          beg_idx;
   int		blank = ' ';
   int		idx;
   boolean	is_directive = FALSE;
   int          letter_idx;
   int          lim_idx;
   int		newline = '\n';
   int		tab = '\t';
   char         upper_str[MAX_KWD_LEN + 1];
   int          str_len         = 0;


   TRACE (Func_Entry, "is_star_directive", NULL);

   idx = start_idx;

   while (nxt_line[idx] == blank || nxt_line[idx] == tab) {
      idx++;
   }

   if (ch_class[nxt_line[idx]] != Ch_Class_Letter) {
      goto EXIT;
   }
   else if (islower(nxt_line[idx])) {
      upper_str[str_len] = TOUPPER(nxt_line[idx]);
   }
   else {
      upper_str[str_len] = nxt_line[idx];
   }
   str_len++;
   idx++;

   letter_idx = upper_str[0] - 'A';

   beg_idx = kwd_sgi_dir_idx[letter_idx];
   lim_idx = kwd_sgi_dir_idx[letter_idx+1];

   if (beg_idx == lim_idx) {
      goto EXIT;
   }

   while (nxt_line[idx] != newline && str_len <= kwd_sgi_dir_len[beg_idx]) {
      if (nxt_line[idx] == blank || nxt_line[idx] == tab) {
         idx++;
      }
      else {
         if (ch_class[nxt_line[idx]] != Ch_Class_Letter &&
             nxt_line[idx] != USCORE) {
            break;
         }
         else if (islower(nxt_line[idx])) {
            upper_str[str_len] = TOUPPER(nxt_line[idx]);
         }
         else {
            upper_str[str_len] = nxt_line[idx];
         }
         str_len++;
         idx++;
      }
   }

   upper_str[str_len] = '\0';


   if (str_len >= kwd_sgi_dir_len[lim_idx-1]) {

      while (beg_idx < lim_idx) {

         if (kwd_sgi_dir_len[beg_idx] <= str_len) {

            if (strncmp(upper_str,
                        kwd_sgi_dir[beg_idx].name,
                        kwd_sgi_dir_len[beg_idx]) == IDENTICAL) {

               switch (kwd_sgi_dir[beg_idx].value) {
                  case Tok_SGI_Dir_Align_Symbol:
                  case Tok_SGI_Dir_Aggressiveinner:
                  case Tok_SGI_Dir_Assert:
                  case Tok_SGI_Dir_Blockable:
                  case Tok_SGI_Dir_Blockingsize:
                  case Tok_SGI_Dir_Concurrentize:
                  case Tok_SGI_Dir_Fill_Symbol:
                  case Tok_SGI_Dir_Fission:
                  case Tok_SGI_Dir_Fissionable:
                  case Tok_SGI_Dir_Fusable:
                  case Tok_SGI_Dir_Flush:
                  case Tok_SGI_Dir_Fuse:
                  case Tok_SGI_Dir_Inline:
                  case Tok_SGI_Dir_Interchange:
                  case Tok_SGI_Dir_Ipa:
                  case Tok_SGI_Dir_Limit:
                  case Tok_SGI_Dir_Minconcurrent:
                  case Tok_SGI_Dir_Noblocking:
                  case Tok_SGI_Dir_Noconcurrentize:
                  case Tok_SGI_Dir_Nofission:
                  case Tok_SGI_Dir_Nofusion:
                  case Tok_SGI_Dir_Noinline:
                  case Tok_SGI_Dir_Nointerchange:
                  case Tok_SGI_Dir_Noipa:
                  case Tok_SGI_Dir_Opaque:
                  case Tok_SGI_Dir_Optional:
#ifdef KEY /* Bug 2660 */
                  case Tok_SGI_Dir_Options:
#endif /* KEY Bug 2660 */
                  case Tok_SGI_Dir_Prefetch:
                  case Tok_SGI_Dir_Prefetch_Manual:
                  case Tok_SGI_Dir_Prefetch_Ref:
                  case Tok_SGI_Dir_Prefetch_Ref_Disable:
                  case Tok_SGI_Dir_Purpleconditional:
                  case Tok_SGI_Dir_Purpleunconditional:
                  case Tok_SGI_Dir_Regionbegin:
                  case Tok_SGI_Dir_Regionend:
                  case Tok_SGI_Dir_Section_Gp:
                  case Tok_SGI_Dir_Section_Non_Gp:
                  case Tok_SGI_Dir_Unroll:

                     is_directive = TRUE;
                     break;

                  default:
                     break;
               }
               break;
            }
         }  /* if */

         beg_idx++;

      }  /* while */
   }  /* if */

EXIT:

   TRACE (Func_Exit, "is_star_directive", NULL);

   return (is_directive);

}  /* is_star_directive */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Get_operand_digit is called by the get_token routine to attempt	      *|
|*	recognition of integer constants, real constants, boolean hollerith   *|
|*	constants of the form nH..., nL..., or nR..., boolean octal constants *|
|*	of the form ...B, and character literal constants of non-default kind *|
|*	by examining the look ahead character and following characters of the *|
|*	input source.							      *|
|*									      *|
|* Input parameters:							      *|
|*	la_ch			first character of operand token	      *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*	token			token produced by get_operand_digit	      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates an operand token was produced.			      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

static boolean get_operand_digit (void)

{
   char		delim;
   char		exponent	= BLANK;
   boolean      had_letter	= FALSE;
   boolean      had_zero	= FALSE;
   int		hollerith_len	= 0;
   int          i;
   boolean	result		= TRUE;
   la_type	save_ch;
   int		tok_len		= 0;

   TRACE (Func_Entry, "get_operand_digit", NULL);

# ifdef _DEBUG
   if (LA_CH_CLASS != Ch_Class_Digit) {
      PRINTMSG(TOKEN_LINE(token), 295, Internal, TOKEN_COLUMN(token),
               "get_operand_digit", "digit");
   }
# endif

   TOKEN_VALUE(token) = Tok_Const_Int;

   /* skip leading zeros */
   while (LA_CH_CLASS == Ch_Class_Digit &&
          !sig_blank                    &&
          LA_CH_VALUE == ZERO) {

      had_zero = TRUE;
      NEXT_LA_CH;
   }

   while (LA_CH_CLASS == Ch_Class_Digit && !sig_blank) {
      ADD_TO_CONST_BUF (LA_CH_VALUE, tok_len);
      NEXT_LA_CH;
   }

   if (tok_len == 0 && had_zero) {
      ADD_TO_CONST_BUF (ZERO, tok_len);
   }

   /* check for optional decimal point or operator */

   if (LA_CH_VALUE == DOT && !sig_blank) {

      /* check for dot-op form operator */
      save_ch = la_ch;
	 
      NEXT_LA_CH;

      while (LA_CH_CLASS == Ch_Class_Letter) {
         had_letter = TRUE;
	 NEXT_LA_CH;
      }

      if (LA_CH_VALUE == DOT && had_letter) {
	
	 /* reset src input buffer and column index to la_ch pos */
         /* Have digits followed by a dot operator.              */

	 la_ch = save_ch;
	 reset_src_input (LA_CH_BUF_IDX, LA_CH_STMT_NUM);
      }
      else {		/* have decimal point in real constant */
	 TOKEN_VALUE(token) = Tok_Const_Real;	     

	 /* reset src input buffer and column index to la_ch pos */
	 la_ch = save_ch;
	 reset_src_input (LA_CH_BUF_IDX, LA_CH_STMT_NUM);
         sig_blank = FALSE;

	 /* add decimal point to constant */
	 ADD_TO_CONST_BUF (LA_CH_VALUE, tok_len);
	 NEXT_LA_CH;

	 /* check for optional fractional digits of real constant */
	 while (LA_CH_CLASS == Ch_Class_Digit && !sig_blank) {
	    ADD_TO_CONST_BUF (LA_CH_VALUE, tok_len);
	    NEXT_LA_CH;
	 }
      }
   }  /* if */

   /* check for optional exponent letter in real constant */

   if ((LA_CH_VALUE == 'D'  ||  LA_CH_VALUE == 'E' || LA_CH_VALUE == 'Q') && 
        !sig_blank) {

      switch (LA_CH_VALUE) {
      case 'D':
         TOKEN_VALUE(token) = Tok_Const_Dbl;
         break;

      case 'E':
         TOKEN_VALUE(token) = Tok_Const_Real;
         break;

      case 'Q':

# if defined(_QUAD_PRECISION)
         TOKEN_VALUE(token) = Tok_Const_Quad;
# else
         TOKEN_VALUE(token) = Tok_Const_Dbl;
         PRINTMSG(TOKEN_LINE(token), 1348, Caution,
                  TOKEN_COLUMN(token));
# endif
         break;

      }

      exponent = LA_CH_VALUE;

      ADD_TO_CONST_BUF ('E', tok_len);

      NEXT_LA_CH;

      /* check for optional sign in exponent */
      if ((LA_CH_VALUE == PLUS  ||  LA_CH_VALUE == MINUS) && !sig_blank) {
         ADD_TO_CONST_BUF (LA_CH_VALUE, tok_len);
         NEXT_LA_CH;
      }

      /* check for required digits of exponent */

      if (LA_CH_CLASS == Ch_Class_Digit && !sig_blank) {
         do {
            ADD_TO_CONST_BUF (LA_CH_VALUE, tok_len);
            NEXT_LA_CH;
         }
         while (LA_CH_CLASS == Ch_Class_Digit && !sig_blank);
      }
      else {            /* D, E or Q must be followed by an exponent */
         PRINTMSG (LA_CH_LINE, 1308, Error, LA_CH_COLUMN);
         result = FALSE;
      }

      /* check that kind-param doesn't follow real const with exponent 'D' */

      if (LA_CH_VALUE == USCORE  &&  
          (exponent == 'D' ||
           exponent == 'Q') && 
          !sig_blank) {

         /* Can't have a kind-param if it's a D or Q exponent */

         PRINTMSG (TOKEN_LINE(token), 1309, Error, TOKEN_COLUMN(token));
         result = FALSE;
      }
   }  /* if */

   TOKEN_LEN(token) = tok_len;
   const_buf[tok_len] = '\0';
 
   /* check for optional kind-param suffix on integer or real constant, or    */
   /* integer form of kind-param prefix on character literal.		      */

   if (LA_CH_VALUE == USCORE && !sig_blank) {
      NEXT_LA_CH;

      tok_len = 0;

      if (LA_CH_CLASS == Ch_Class_Digit && !sig_blank) {
	 do {
	    ADD_TO_TOKEN_KIND_STR (LA_CH_VALUE, tok_len);
	    NEXT_LA_CH;
	 }
	 while (LA_CH_CLASS == Ch_Class_Digit && !sig_blank);

#ifdef KEY /* Bug 3635 */
         if (kind_too_long(&tok_len)) {
	    result = FALSE;
	 }
#else
         if (tok_len > MAX_ID_LEN) {
            tok_len = MAX_ID_LEN;
            PRINTMSG(LA_CH_LINE, 101, Error, LA_CH_COLUMN);
            result = FALSE;
         }
#endif /* KEY Bug 3635 */
         TOKEN_KIND_LEN(token) = tok_len;
         TOKEN_KIND_STR(token)[tok_len] = EOS;
      }
      else if (LA_CH_CLASS == Ch_Class_Letter && !sig_blank) {
	 do {
	    ADD_TO_TOKEN_KIND_STR (LA_CH_VALUE, tok_len);
	    NEXT_LA_CH;
	 }
	 while (VALID_LA_CH); 

#ifdef KEY /* Bug 3635 */
         if (kind_too_long(&tok_len)) {
	    result = FALSE;
	 }
#else
         if (tok_len > MAX_ID_LEN) {
            tok_len = MAX_ID_LEN;
            PRINTMSG(LA_CH_LINE, 101, Error, LA_CH_COLUMN);
            result = FALSE;
         }
#endif /* KEY Bug 3635 */
         TOKEN_KIND_LEN(token) = tok_len;
         TOKEN_KIND_STR(token)[tok_len] = EOS;
      }
      else if ((LA_CH_VALUE == QUOTE  ||  LA_CH_VALUE == DBL_QUOTE) && 
               !sig_blank) {

	 /* check that kind-param is integer value */

	 if (TOKEN_VALUE(token) == Tok_Const_Real) {

	    /* Kind param on literal const must be integer or symbolic name */

            PRINTMSG (TOKEN_LINE(token), 89, Error, TOKEN_COLUMN(token));
            result = FALSE;
	 }
         else {
            for (i = 0; i <= TOKEN_LEN(token); i++) {
               TOKEN_KIND_STR(token)[i] = const_buf[i];
            }
            TOKEN_KIND_LEN(token) = TOKEN_LEN(token);
	 }

	 TOKEN_VALUE(token) = Tok_Const_Char;

         delim = LA_CH_VALUE;
         NEXT_LA_CH;

         result = convert_const() && result;

         TOKEN_CONST_TBL_IDX(token) = put_char_const_in_tbl ('\0', &tok_len);

         if (LA_CH_VALUE != delim){
	    PRINTMSG (TOKEN_LINE(token), 83, Error, TOKEN_COLUMN(token), delim);
            result = FALSE;
	 }   
         else {
            NEXT_LA_CH;
         }

         TOKEN_LEN(token) = tok_len;

         goto EXIT;
      }
      else { /* Kind param on literal const must be integer or symbolic name */
         PRINTMSG (LA_CH_LINE, 89, Error, LA_CH_COLUMN);
         result = FALSE;
      }	    
   }

   /* check for boolean octal suffix */
   else if (LA_CH_VALUE == 'B' && !sig_blank) {
      TOKEN_VALUE(token)       = Tok_Const_Boolean;
      TOKEN_KIND_STR(token)[0] = LA_CH_VALUE;
      TOKEN_KIND_STR(token)[1] = EOS;
      TOKEN_KIND_LEN(token)    = 1;

      /* Boolean constants are non-standard */

      PRINTMSG (TOKEN_LINE(token), 90, Ansi, TOKEN_COLUMN(token));

      if (tok_len > MAX_OCT_CONST_LEN) {
	 PRINTMSG(TOKEN_LINE(token), 91, Error, TOKEN_COLUMN(token),
                  tok_len, MAX_OCT_CONST_LEN);
      }
      else if (tok_len == MAX_OCT_CONST_LEN) {

	 if (const_buf[0] < '0'  ||  const_buf[0] > '1') {
            /* The value exceeds the range. */

	    PRINTMSG (TOKEN_LINE(token), 92, Error, TOKEN_COLUMN(token));
            result = FALSE;
	 }
      }	  

      /* validate that all digits of token are octal digits */

      tok_len = 0;

      while (IS_OCT_DIGIT(const_buf[tok_len])) {
	 tok_len++;
      }

      if (const_buf[tok_len] != EOS) { /* Invalid digit in octal const */
	 PRINTMSG(TOKEN_LINE(token), 93, Error, TOKEN_COLUMN(token),
                  const_buf[tok_len]);
         result = FALSE;
      }
      NEXT_LA_CH;

      if (result) {	/* convert const boolean */
         convert_octal_literal(FALSE);
      }
      else {
         TOKEN_CONST_TBL_IDX(token) = NULL_IDX;
      }
   }

   /* check for hollerith prefix */

   else if ((LA_CH_VALUE == 'H'  ||  
             LA_CH_VALUE == 'L'  ||  
             LA_CH_VALUE == 'R')    && !sig_blank) {

      /* digit string is length of hollerith string */

      for (i = 0; i <= TOKEN_LEN(token); i++) {
         TOKEN_STR(token)[i] = const_buf[i];
      }

      hollerith_len	= atoi (TOKEN_STR(token));
      TOKEN_VALUE(token)= Tok_Const_Hollerith;

      /* Hollerith constant form is non-standard */

      PRINTMSG (TOKEN_LINE(token), 96, Ansi, TOKEN_COLUMN(token));

      if (hollerith_len > TARGET_CHARS_PER_WORD && LA_CH_VALUE == 'R') {

         /* Hollerith constant must be 8 (4 on sparc) */
         /* characters or less in "R" form            */

	 PRINTMSG (TOKEN_LINE(token), 94, Error, TOKEN_COLUMN(token),
                   TARGET_CHARS_PER_WORD);
         result = FALSE;
      }

      TOKEN_KIND_STR(token)[0] = LA_CH_VALUE;
      TOKEN_KIND_STR(token)[1] = EOS;
      TOKEN_KIND_LEN(token)    = 1;
 
      if (hollerith_len) {
	 NEXT_LA_CH_LITERAL;

         TOKEN_CONST_TBL_IDX(token) = 
                  put_char_const_in_tbl (TOKEN_KIND_STR(token)[0], &tok_len);

         TOKEN_LEN(token) = tok_len;
	  
	 if (tok_len < hollerith_len) {

	    /* Hollerith constant contains fewer characters than specified */

	    PRINTMSG(TOKEN_LINE(token), 84, Error, TOKEN_COLUMN(token),
                     hollerith_len, tok_len);
            result = FALSE;
	 }

# ifdef _TARGET_LITTLE_ENDIAN
         if (TOKEN_KIND_STR(token)[0] != 'R') {
            CN_HOLLERITH_ENDIAN(TOKEN_CONST_TBL_IDX(token)) = TRUE;
         }
# endif

         switch(TOKEN_KIND_STR(token)[0]) {
         case 'H':
            CN_HOLLERITH_TYPE(TOKEN_CONST_TBL_IDX(token)) = H_Hollerith;
            break;

         case 'L':
            CN_HOLLERITH_TYPE(TOKEN_CONST_TBL_IDX(token)) = L_Hollerith;
            break;

         case 'R':
            CN_HOLLERITH_TYPE(TOKEN_CONST_TBL_IDX(token)) = R_Hollerith;
            break;

         }

      }
      else {
	 TOKEN_STR(token)[0] = EOS;
	 TOKEN_LEN(token)    = 0;

	 /* Number of characters in hollerith specifier must be non-zero */

	 PRINTMSG (TOKEN_LINE(token), 85, Error, TOKEN_COLUMN(token));
         result = FALSE;
      }

      goto EXIT;
   }  /* else if */

   CHECK_FOR_FREE_BLANK;

   if (result) {
      switch (TOKEN_VALUE(token)) {
         case Tok_Const_Int  :
         case Tok_Const_Real :
            result = convert_const();
            break;
         case Tok_Const_Dbl  :

# ifdef _TARGET_OS_MAX
            if (! cmd_line_flags.s_default32 &&
                on_off_flags.enable_double_precision) {
               PRINTMSG(TOKEN_LINE(token), 1110, Warning, TOKEN_COLUMN(token));
               TOKEN_VALUE(token) = Tok_Const_Real;
               result = convert_const();
            }
            else {
               CONVERT_DBL_CONST(DOUBLE_PRECISION_TYPE_IDX, 
                                 TOKEN_LEN(token), result);
            }
# else
            CONVERT_DBL_CONST(DOUBLE_PRECISION_TYPE_IDX, 
                              TOKEN_LEN(token), result);
# endif
            break;
         case Tok_Const_Quad :
            CONVERT_REAL_CONST(Real_16,
                               TOKEN_LEN(token), result);
            break;
      }
   }
   else if (TOKEN_VALUE(token) == Tok_Const_Int  ||
            TOKEN_VALUE(token) == Tok_Const_Real ||
            TOKEN_VALUE(token) == Tok_Const_Quad ||
            TOKEN_VALUE(token) == Tok_Const_Dbl) {
     TOKEN_CONST_TBL_IDX(token) = NULL_IDX;
   }

EXIT:

   TRACE (Func_Exit, "get_operand_digit", NULL);

   return (result);

}  /* get_operand_digit */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Get_operand_dot is called by the get_token routine to attempt	      *|
|*	recognition of real constants of the form .nnn, and logical constants *|
|*	that begin with "." by examining the look ahead                       *|
|*	character and following characters of the input source.		      *|
|*									      *|
|* Input parameters:							      *|
|*	la_ch			first character of operand token	      *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*	token			token produced by get_operand_dot	      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates an operand token was produced.			      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

static boolean get_operand_dot (void)

{
   int          attr_idx;
   char		exponent	= BLANK;
   int          name_idx;
   boolean	result		= TRUE;
   la_type	save_ch;
   int		tok_len		= 0;

 
   TRACE (Func_Entry, "get_operand_dot", NULL);

# ifdef _DEBUG
   if (LA_CH_VALUE != DOT) {
      PRINTMSG(TOKEN_LINE(token), 295, Internal, TOKEN_COLUMN(token),
               "get_operand_dot", ".");
   }
# endif

   /* check for logical constant or dot-op form operator */
   save_ch = la_ch;
       
   NEXT_LA_CH;

   while (LA_CH_CLASS == Ch_Class_Letter && !sig_blank) {
      ADD_TO_TOKEN_STR (LA_CH_VALUE, tok_len);
      NEXT_LA_CH;
   }

#ifdef KEY /* Bug 3635 */
   id_too_long(&tok_len);
#else
   if (tok_len > MAX_ID_LEN) {
      PRINTMSG(TOKEN_LINE(token), 67, Error, TOKEN_COLUMN(token));
      tok_len = MAX_ID_LEN;
   }
#endif /* KEY Bug 3635 */
   TOKEN_LEN(token) = tok_len;
 
   if (LA_CH_VALUE == DOT && !sig_blank) {

      if (EQUAL_STRS(TOKEN_STR(token), "TRUE")	 ||
	  EQUAL_STRS(TOKEN_STR(token), "FALSE")	 ||
	  EQUAL_STRS(TOKEN_STR(token), "T")	 ||
	  EQUAL_STRS(TOKEN_STR(token), "F")) {

	 TOKEN_VALUE(token) = (TOKEN_STR(token)[0] == 'T')  ?  Tok_Const_True  :
							       Tok_Const_False;
	 NEXT_LA_CH;

         if (tok_len == 1) {
            attr_idx = srch_sym_tbl(TOKEN_STR(token),
                                    TOKEN_LEN(token),
                                    &name_idx);

            if (attr_idx == NULL_IDX) {
               attr_idx = srch_host_sym_tbl(TOKEN_STR(token),
                                            TOKEN_LEN(token), 
                                            &name_idx,
                                            TRUE);
            }

            if (attr_idx != NULL_IDX) {

               while (AT_ATTR_LINK(attr_idx) != NULL_IDX) {
                  attr_idx = AT_ATTR_LINK(attr_idx);
               }
            }

            /* Let NOT_VISIBLE items take the standard path */

            if (attr_idx != NULL_IDX && AT_OBJ_CLASS(attr_idx) == Interface) {

               /* .T. of .F. is a defined operator so the extension */
               /* is disallowed.                                    */

               reset_lex(TOKEN_BUF_IDX(token), TOKEN_STMT_NUM(token));
               TOKEN_VALUE(token) = Tok_Unknown;
               result = FALSE;
               goto EXIT;
            }
            else {
               PRINTMSG(TOKEN_LINE(token), 510, Ansi, TOKEN_COLUMN(token),
                        TOKEN_STR(token));
            }
         }

	 /* check for optional kind-param suffix on logical constant */
	 if (LA_CH_VALUE == USCORE) {
	    NEXT_LA_CH;
 
	    tok_len = 0;

	    if (LA_CH_CLASS == Ch_Class_Digit && !sig_blank) {
	       do {				 
		  ADD_TO_TOKEN_KIND_STR (LA_CH_VALUE, tok_len);
		  NEXT_LA_CH;
	       }
	       while (LA_CH_CLASS == Ch_Class_Digit && !sig_blank);
	    }	
	    else if (LA_CH_CLASS == Ch_Class_Letter && !sig_blank) {
	       do {
		  ADD_TO_TOKEN_KIND_STR (LA_CH_VALUE, tok_len);
		  NEXT_LA_CH;
	       }
	       while (VALID_LA_CH);
	    }
	    else {
	       /* Kind param on literal const must be integer or symbolic name*/
	       PRINTMSG (LA_CH_LINE, 89, Error, LA_CH_COLUMN);
               result = FALSE;
	    }
	    TOKEN_KIND_LEN(token) = tok_len;
	 }  /* if */

         result = convert_const() && result;

      }	 /* if */
      else { /* reset src input buffer and column index to la_ch pos */
         /* this is not an opnd .. let someone else deal with it */
	 la_ch = save_ch;
	 reset_src_input (LA_CH_BUF_IDX, LA_CH_STMT_NUM);
         result = FALSE;
         sig_blank = FALSE;
         TOKEN_VALUE(token) = Tok_Unknown;
      }
   }  /* if */
   else {
      /* have decimal point in real constant */
      TOKEN_VALUE(token) = Tok_Const_Real;	  

      /* reset src input buffer and column index to la_ch pos */
      la_ch = save_ch;
      reset_src_input (LA_CH_BUF_IDX, LA_CH_STMT_NUM);
      sig_blank = FALSE;
       
      /* add decimal point to constant */
      tok_len = 0;
      ADD_TO_CONST_BUF (LA_CH_VALUE, tok_len);
      NEXT_LA_CH;

      /* check for required fractional digits of real constant */
      if (LA_CH_CLASS == Ch_Class_Digit && !sig_blank) {
	 do {
	    ADD_TO_CONST_BUF (LA_CH_VALUE, tok_len);
	    NEXT_LA_CH;
	 }
	 while (LA_CH_CLASS == Ch_Class_Digit && !sig_blank);

         /* check for optional exponent letter in real constant */
         if ((LA_CH_VALUE == 'D'  ||  
              LA_CH_VALUE == 'E' || 
              LA_CH_VALUE == 'Q') &&
             !sig_blank) {

            exponent = LA_CH_VALUE;

            switch (LA_CH_VALUE) {
            case 'D':
               TOKEN_VALUE(token) = Tok_Const_Dbl;
               break;

            case 'E':
               TOKEN_VALUE(token) = Tok_Const_Real;
               break;

            case 'Q':
# if defined(_QUAD_PRECISION)
               TOKEN_VALUE(token) = Tok_Const_Quad;
# else
               TOKEN_VALUE(token) = Tok_Const_Dbl;
               PRINTMSG(TOKEN_LINE(token), 1348, Caution,
                        TOKEN_COLUMN(token));
# endif
               break;
            }

            ADD_TO_CONST_BUF ('E', tok_len);

            NEXT_LA_CH;

            /* check for optional sign in exponent */
            if ((LA_CH_VALUE == PLUS  ||  LA_CH_VALUE == MINUS) && !sig_blank) {
               ADD_TO_CONST_BUF (LA_CH_VALUE, tok_len);
               NEXT_LA_CH;
            }

            /* check for required digits of exponent */
            if (LA_CH_CLASS == Ch_Class_Digit && !sig_blank) {
               do {
                  ADD_TO_CONST_BUF (LA_CH_VALUE, tok_len);
                  NEXT_LA_CH;
               }
               while (LA_CH_CLASS == Ch_Class_Digit && !sig_blank);
            }
            else { /* Invalid exponent in real constant */
               PRINTMSG (LA_CH_LINE, 1308, Error, LA_CH_COLUMN);
               result = FALSE;
            }

      /* check that kind-param doesn't follow real const with exponent 'D' */

            if (LA_CH_VALUE == USCORE  &&  
                (exponent == 'D' ||
                 exponent == 'Q') && 
                !sig_blank) {

               /* Kind param is invalid on double precision real const form */
               PRINTMSG (TOKEN_LINE(token), 1309, Error, TOKEN_COLUMN(token));
               result = FALSE;
            }
         }

         TOKEN_LEN(token) = tok_len;
         const_buf[tok_len] = '\0';

	 /* check for optional kind-param suffix on real constant */

	 if (LA_CH_VALUE == USCORE && !sig_blank) {
	    NEXT_LA_CH;

	    tok_len = 0;

	    if (LA_CH_CLASS == Ch_Class_Digit && !sig_blank) {
	       do {
		  ADD_TO_TOKEN_KIND_STR (LA_CH_VALUE, tok_len);
		  NEXT_LA_CH;
	       }
	       while (LA_CH_CLASS == Ch_Class_Digit && !sig_blank); 
	    }
	    else if (LA_CH_CLASS == Ch_Class_Letter && !sig_blank) {
	       do {
		  ADD_TO_TOKEN_KIND_STR (LA_CH_VALUE, tok_len);
		  NEXT_LA_CH;
	       }
	       while (VALID_LA_CH);
	    }
	    else { /* Kind param on literal const must be int or symbolic name*/
	       PRINTMSG (LA_CH_LINE, 89, Error, LA_CH_COLUMN);
               result = FALSE;
	    }

#ifdef KEY /* Bug 3635 */
            kind_too_long(&tok_len);
#else
            if (tok_len > MAX_ID_LEN) {
               tok_len = MAX_ID_LEN;
               PRINTMSG(LA_CH_LINE, 101, Error, LA_CH_COLUMN);
            }
#endif /* KEY Bug 3635 */
            TOKEN_KIND_LEN(token) = tok_len;
            TOKEN_KIND_STR(token)[tok_len] = EOS;
	 }  /* if */
      }	 /* if */
      else {
	 /* Real constant must contain digits in whole or fractional part */
	 PRINTMSG (TOKEN_LINE(token), 95, Error, TOKEN_COLUMN(token));
         result = FALSE;

#ifdef KEY /* Bug 3635 */
         id_too_long(&tok_len);
#else
         if (tok_len > MAX_ID_LEN) {
            PRINTMSG(TOKEN_LINE(token), 67, Error, TOKEN_COLUMN(token));
            tok_len = MAX_ID_LEN;
         }
#endif /* KEY Bug 3635 */
         TOKEN_LEN(token) = tok_len;
      }
   }

   if (TOKEN_VALUE(token) == Tok_Const_Real ||
       TOKEN_VALUE(token) == Tok_Const_Dbl  ||
       TOKEN_VALUE(token) == Tok_Const_Quad) {

      CHECK_FOR_FREE_BLANK;

      if (result) {
         switch (TOKEN_VALUE(token)) {
            case Tok_Const_Real :
               result = convert_const();
               break;
            case Tok_Const_Dbl  :

# ifdef _TARGET_OS_MAX
               if (! cmd_line_flags.s_default32 &&
                   on_off_flags.enable_double_precision) {
                  PRINTMSG(TOKEN_LINE(token), 1110, Warning, 
                           TOKEN_COLUMN(token));
                  TOKEN_VALUE(token) = Tok_Const_Real;
                  result = convert_const();
               }
               else {
                  CONVERT_DBL_CONST(DOUBLE_PRECISION_TYPE_IDX,
                                    TOKEN_LEN(token), result);
               }
# else 
               CONVERT_DBL_CONST(DOUBLE_PRECISION_TYPE_IDX,
                                 TOKEN_LEN(token), result);
# endif
               break;
            case Tok_Const_Quad :
               CONVERT_REAL_CONST(Real_16,
                                  TOKEN_LEN(token), result);
               break;
         }
      }
      else {
          TOKEN_CONST_TBL_IDX(token) = NULL_IDX;
      }
   }

EXIT:

   TRACE (Func_Exit, "get_operand_dot", NULL);

   return (result);

}  /* get_operand_dot */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Get_operand_letter is called by the get_token routine to attempt      *|
|*	recognition of identifiers, boolean octal, boolean hex, boolean	      *|
|*	hollerith, and non-default kind character literal constant forms by   *|
|*	examining the look ahead character and following characters of the    *|
|*	input source.							      *|
|*									      *|
|* Input parameters:							      *|
|*	la_ch			first character of operand token	      *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*	token			token produced by get_operand_letter	      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates an operand token was produced.			      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

static boolean get_operand_letter (void)

{
   char		delim;
   boolean      had_zero	= FALSE;
   char		prefix;
   boolean	result		= TRUE;
   int		tok_len		= 0;


   TRACE (Func_Entry, "get_operand_letter", NULL);

# ifdef _DEBUG
   if (LA_CH_CLASS != Ch_Class_Letter) {
      PRINTMSG(TOKEN_LINE(token), 295, Internal, TOKEN_COLUMN(token),
               "get_operand_letter", "letter");
   }
# endif

   prefix = LA_CH_VALUE;				    /* remember 1st   */

   do {
      ADD_TO_TOKEN_STR (LA_CH_VALUE, tok_len);
      NEXT_LA_CH;
   }
   while (VALID_LA_CH); 

#ifdef KEY /* Bug 3635 */
   id_too_long(&tok_len);
#else
   if (tok_len > MAX_ID_LEN) {
      PRINTMSG(TOKEN_LINE(token), 67, Error, TOKEN_COLUMN(token));
      tok_len = MAX_ID_LEN;
   }
#endif /* KEY Bug 3635 */
   TOKEN_LEN(token) = tok_len;
 
   if ((LA_CH_VALUE == QUOTE  ||  LA_CH_VALUE == DBL_QUOTE) && !sig_blank) {
      if (tok_len == 1) {

	 if (prefix == 'B' || prefix == 'O' || prefix == 'Z' || prefix == 'X') {

	    if (prefix == 'X') { /* Boolean constants are non-standard */
	       PRINTMSG (TOKEN_LINE(token), 90, Ansi, TOKEN_COLUMN(token));
	       TOKEN_VALUE(token) = Tok_Const_Boolean;
	    }
	    else {
	       TOKEN_VALUE(token) = Tok_Const_Boz;

               if (stmt_type != Data_Stmt) {
                  PRINTMSG (TOKEN_LINE(token), 771, Ansi, TOKEN_COLUMN(token));
               }
	    }

	    strcpy (TOKEN_KIND_STR(token), TOKEN_STR(token));
	    TOKEN_KIND_LEN(token) = TOKEN_LEN(token);

	    delim = LA_CH_VALUE;

	    NEXT_LA_CH;
	    tok_len = 0;

            /* skip leading zeros */
            while (LA_CH_VALUE != delim && 
                   LA_CH_VALUE != EOS  &&
                   (LA_CH_VALUE == ZERO || 
                    LA_CH_VALUE == BLANK ||
                    LA_CH_VALUE == TAB)) {

               if (LA_CH_VALUE == ZERO) {
                  had_zero = TRUE;
               }
               NEXT_LA_CH;
            }

	    while (LA_CH_VALUE != delim	 &&  LA_CH_VALUE != EOS) {
               if (LA_CH_VALUE != BLANK && LA_CH_VALUE != TAB) {
	          ADD_TO_CONST_BUF (LA_CH_VALUE, tok_len);
               }
	       NEXT_LA_CH;
	    }

            if (tok_len == 0 && had_zero) {
               ADD_TO_CONST_BUF (ZERO, tok_len);
            }

            const_buf[tok_len] = '\0';
            TOKEN_LEN(token) = tok_len;

	    if (LA_CH_VALUE == EOS) { /* Token is missing trailing delimiter */
	       PRINTMSG(TOKEN_LINE(token), 83, Error,TOKEN_COLUMN(token),delim);
               result = FALSE;
	    }
	    else {
	       if (prefix == 'B') {     /* validate length of binary constant */

		  if (tok_len > MAX_BIN_CONST_LEN || tok_len == 0) { 

		     /* Binary constant length is invalid */

		     PRINTMSG(TOKEN_LINE(token), 91, Error,
                              TOKEN_COLUMN(token), tok_len, MAX_BIN_CONST_LEN);
                     result = FALSE;
		  } 

		  /* validate that all digits of token are binary digits */
		  tok_len = 0;

		  while (IS_BIN_DIGIT(const_buf[tok_len])) {
		     tok_len++;
		  }   

	          if (const_buf[tok_len] != EOS) { 
		     PRINTMSG (TOKEN_LINE(token), 422, Error, 
                               TOKEN_COLUMN(token), const_buf[tok_len]);
                     result = FALSE;
	          }
	 
                  if (result) {
                     convert_binary_literal(TRUE);
                  }
                  else {
                     TOKEN_CONST_TBL_IDX(token) = NULL_IDX;
                  }
	       }
	       else if (prefix == 'O') {

		  /* validate length of octal constant */

		  if (tok_len > MAX_OCT_CONST_LEN || tok_len == 0) {

		     /* Octal constant length is invalid */

		     PRINTMSG(TOKEN_LINE(token), 91, Error,
                              TOKEN_COLUMN(token), tok_len, MAX_OCT_CONST_LEN);
                     result = FALSE;
		  }
		  else if (tok_len == MAX_OCT_CONST_LEN) {

		     if (const_buf[0] < '0'  || const_buf[0] > '1') {
			/* Octal constant value is out of range */

			PRINTMSG(TOKEN_LINE(token), 92, Error,
                                 TOKEN_COLUMN(token));
                        result = FALSE;
		     }
		  }	       

		  /* validate that all digits of token are octal digits */
		  tok_len = 0;

		  while (IS_OCT_DIGIT(const_buf[tok_len])) {
		     tok_len++;
		  }

	          if (const_buf[tok_len] != EOS) { 
	             PRINTMSG(TOKEN_LINE(token), 93, Error, TOKEN_COLUMN(token),
                              const_buf[tok_len]);
                     result = FALSE;
	          }

                  if (result) {
                     convert_octal_literal(TRUE);
                  }
                  else {
                     TOKEN_CONST_TBL_IDX(token) = NULL_IDX;
                  }
	       }
	       else if (prefix == 'Z') {

		  /* validate length of hex constant */ 

		  if (tok_len > MAX_HEX_CONST_LEN || tok_len == 0) {	
		     PRINTMSG(TOKEN_LINE(token), 91, Error,
                              TOKEN_COLUMN(token), tok_len, MAX_HEX_CONST_LEN);
                     result = FALSE;
		  } 

		  /* validate that all digits of token are hex digits */ 
		  tok_len = 0; 

		  while (isxdigit(const_buf[tok_len])) { 
		     tok_len++; 
		  } 

	          if (const_buf[tok_len] != EOS) { 
		     PRINTMSG (TOKEN_LINE(token), 423, Error, 
                               TOKEN_COLUMN(token), const_buf[tok_len]);
                     result = FALSE;
	          }
 
                  if (result) {
                     convert_hex_literal(TRUE);
                  }
                  else {
                     TOKEN_CONST_TBL_IDX(token) = NULL_IDX;
                  }
	       }
	       else {						/* prefix = X */

		  if (const_buf[0] == PLUS  || const_buf[0] == MINUS) {

		     /* validate length of sign plus hex constant */

		     if (--tok_len > MAX_HEX_CONST_LEN || tok_len == 0) {

			PRINTMSG(TOKEN_LINE(token), 91, Error,
                                 TOKEN_COLUMN(token), tok_len,
                                 MAX_HEX_CONST_LEN);
                        result = FALSE;
		     }
		     tok_len = 1;
		  }
		  else {

		     if (tok_len > MAX_HEX_CONST_LEN || tok_len == 0) {
			PRINTMSG(TOKEN_LINE(token), 91, Error,
                                 TOKEN_COLUMN(token), tok_len,
                                 MAX_HEX_CONST_LEN);
                        result = FALSE;
		     }
		     tok_len = 0;
		  }

		  /* validate that all digits of token are hex digits */

		  while (isxdigit(const_buf[tok_len])) {
		     tok_len++;
		  }

	          if (const_buf[tok_len] != EOS) { 
		     PRINTMSG (TOKEN_LINE(token), 423, Error, 
                               TOKEN_COLUMN(token), const_buf[tok_len]);
                     result = FALSE;
	          }

                  if (result) {
                     convert_hex_literal(FALSE);
                  }
                  else {
                     TOKEN_CONST_TBL_IDX(token) = NULL_IDX;
                  }
	       }

	       NEXT_LA_CH;
	    }
	 }
	 else {
	    TOKEN_VALUE(token) = Tok_Id;
	 }
      }	 /* if */
      else if (TOKEN_STR(token)[tok_len-1] == USCORE) {		/* kind param */

	 TOKEN_VALUE(token) = Tok_Const_Char;
	 
#ifdef KEY /* Bug 3635 */
         tok_len -= 1;
	 if (id_too_long(&tok_len)) {
            result	= FALSE;
	 }
#else
	 if (--tok_len > MAX_ID_LEN) {
	    PRINTMSG (TOKEN_LINE(token), 67, Error, TOKEN_COLUMN(token));
            result	= FALSE;
	    tok_len	= MAX_ID_LEN;
	 }
#endif /* KEY Bug 3635 */
	 TOKEN_STR(token)[tok_len] = EOS;			/* remove '_' */

	 strcpy (TOKEN_KIND_STR(token), TOKEN_STR(token));
	 TOKEN_KIND_LEN(token) = TOKEN_LEN(token) - 1;

	 delim	 = LA_CH_VALUE;
         NEXT_LA_CH;

         result = convert_const() && result;

         TOKEN_CONST_TBL_IDX(token) = put_char_const_in_tbl ('\0', &tok_len);

         TOKEN_LEN(token) = tok_len;

         if (LA_CH_VALUE != delim) {
	    PRINTMSG (TOKEN_LINE(token), 83, Error, TOKEN_COLUMN(token), delim);
            result = FALSE;
         }
         else {
            NEXT_LA_CH;
         }
      }	 /* else if */
      else {
	 TOKEN_VALUE(token) = Tok_Id;

#ifdef KEY /* Bug 3635 */
         id_too_long(&tok_len);
#else
	 if (tok_len > MAX_ID_LEN) { /* Id len exceeds max of 31 characters */
	    PRINTMSG (TOKEN_LINE(token), 67, Error, TOKEN_COLUMN(token));
	    tok_len = MAX_ID_LEN;
	 }
#endif /* KEY Bug 3635 */
      }
   }  /* if */
   else {
      TOKEN_VALUE(token) = Tok_Id;

#ifdef KEY /* Bug 3635 */
      id_too_long(&tok_len);
#else
      if (tok_len > MAX_ID_LEN) { /* Id len exceeds maximum of 31 characters */
	 PRINTMSG (TOKEN_LINE(token), 67, Error, TOKEN_COLUMN(token));
	 tok_len = MAX_ID_LEN;
      }
#endif /* KEY Bug 3635 */
   }

   TRACE (Func_Exit, "get_operand_letter", NULL);

   return (result);

}  /* get_operand_letter */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Get_operand_quote is called by the get_token routine to attempt	      *|
|*	recognition of character literal constants of the form '...' or "...",*|
|*	and boolean hollerith constants of the form '...'H, "..."H, '...'L,   *|
|*	"..."L, '...'R, or "..."R by examining the look ahead character and   *|
|*	following characters of the input source.			      *|
|*									      *|
|* Input parameters:							      *|
|*	la_ch			first character of operand token	      *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*	token			token produced by get_operand_quote	      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates an operand token was produced.			      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

static boolean get_operand_quote (void)

{
   int		char_len;
   char        *chptr;
   char		delim;
   boolean      had_zero	= FALSE;
   int		i;
   boolean	result		= TRUE;
   int          shift;
   int		tok_len		= 0;


   TRACE (Func_Entry, "get_operand_quote", NULL);

# ifdef _DEBUG
   if (LA_CH_VALUE != QUOTE && LA_CH_VALUE != DBL_QUOTE) {
      PRINTMSG(TOKEN_LINE(token), 295, Internal, TOKEN_COLUMN(token),
               "get_operand_quote", "quote or double quote");
   }
# endif

   delim			= LA_CH_VALUE;
   NEXT_LA_CH;
   TOKEN_VALUE(token)		= Tok_Const_Char;

   /* assume 'H' hollerith for now */

   TOKEN_CONST_TBL_IDX(token)	= put_char_const_in_tbl ('H', &tok_len);

   if (LA_CH_VALUE != delim) {
      PRINTMSG (TOKEN_LINE(token), 83, Error, TOKEN_COLUMN(token), delim);
      result = FALSE;
   }
   else {
      NEXT_LA_CH;
   }

   TOKEN_LEN(token) = tok_len;

   /* check for hollerith suffix letters */
   if ((LA_CH_VALUE == 'H'  ||  LA_CH_VALUE == 'L'  ||  LA_CH_VALUE == 'R') &&
       !sig_blank)                                                          {

      if (LA_CH_VALUE == 'L') { /* replace trailing blanks with nulls */
         chptr = (char *)&CN_CONST(TOKEN_CONST_TBL_IDX(token));

         while (tok_len % TARGET_CHARS_PER_WORD != 0) {
            chptr[tok_len] = '\0';
            tok_len++;
         }
      }
      else if (LA_CH_VALUE == 'R') { /* shift const to be right justified */
         chptr = (char *)&CN_CONST(TOKEN_CONST_TBL_IDX(token));
         shift = (TARGET_CHARS_PER_WORD - (tok_len % TARGET_CHARS_PER_WORD)) % 
                                           TARGET_CHARS_PER_WORD;

         if (shift) {
            while (--tok_len >= 0) {
               chptr[tok_len + shift] = chptr[tok_len];
            }

            tok_len = shift;
            while (--tok_len >= 0) {
               chptr[tok_len] = '\0';
            }
         }
      }

      TOKEN_VALUE(token) = Tok_Const_Hollerith;

      /* Hollerith constant form is non-standard */

      PRINTMSG(TOKEN_LINE(token), 96, Ansi, TOKEN_COLUMN(token));

      if (TOKEN_LEN(token) > TARGET_CHARS_PER_WORD && LA_CH_VALUE == 'R') {

         /* Hollerith constant must be 8 (4 on sparc) */
         /* characters or less in "R" form            */

	 PRINTMSG(TOKEN_LINE(token), 94, Error, TOKEN_COLUMN(token),
                  TARGET_CHARS_PER_WORD);
         result = FALSE;
      }

      TOKEN_KIND_STR(token)[0] = LA_CH_VALUE;
      TOKEN_KIND_STR(token)[1] = EOS;
      TOKEN_KIND_LEN(token)    = 1;

# ifdef _TARGET_LITTLE_ENDIAN
      if (TOKEN_KIND_STR(token)[0] != 'R') {
         CN_HOLLERITH_ENDIAN(TOKEN_CONST_TBL_IDX(token)) = TRUE;
      }
# endif

      switch(TOKEN_KIND_STR(token)[0]) {
      case 'H':
         CN_HOLLERITH_TYPE(TOKEN_CONST_TBL_IDX(token)) = H_Hollerith;
         break;

      case 'L':
         CN_HOLLERITH_TYPE(TOKEN_CONST_TBL_IDX(token)) = L_Hollerith;
         break;

      case 'R':
         CN_HOLLERITH_TYPE(TOKEN_CONST_TBL_IDX(token)) = R_Hollerith;
         break;

      }

      NEXT_LA_CH;
   }
   else if (LA_CH_VALUE == 'X' && ! sig_blank) {

      NEXT_LA_CH;

      /* this is a hex constant */

      PRINTMSG (TOKEN_LINE(token), 90, Ansi, TOKEN_COLUMN(token));
      TOKEN_VALUE(token) = Tok_Const_Boolean;

      /* put the character constant into the const_buf */

      chptr = (char *)&CN_CONST(TOKEN_CONST_TBL_IDX(token));

      char_len = tok_len;

      i = 0;
      while (i < char_len &&
             (chptr[i] == ZERO ||
              chptr[i] == BLANK ||
              chptr[i] == TAB)) {

         if (chptr[i] == ZERO) {
            had_zero = TRUE;
         }

         i++;
      }

      tok_len = 0;

      while (i < char_len) {
         if (chptr[i] != BLANK &&
             chptr[i] != TAB) {
            ADD_TO_CONST_BUF (chptr[i], tok_len);
         }
         i++;
      }

      if (tok_len == 0 && had_zero) {
         ADD_TO_CONST_BUF (ZERO, tok_len);
      }

      const_buf[tok_len] = '\0';
      TOKEN_LEN(token) = tok_len;

      if (const_buf[0] == PLUS  || const_buf[0] == MINUS) {

         /* validate length of sign plus hex constant */

         if (--tok_len > MAX_HEX_CONST_LEN || tok_len == 0) {

            PRINTMSG(TOKEN_LINE(token), 91, Error,
                     TOKEN_COLUMN(token), tok_len,
                     MAX_HEX_CONST_LEN);
            result = FALSE;
         }
         tok_len = 1;
      }
      else {

         if (tok_len > MAX_HEX_CONST_LEN || tok_len == 0) {
            PRINTMSG(TOKEN_LINE(token), 91, Error,
                     TOKEN_COLUMN(token), tok_len,
                     MAX_HEX_CONST_LEN);
            result = FALSE;
         }
         tok_len = 0;
      }

      /* validate that all digits of token are hex digits */

      while (isxdigit(const_buf[tok_len])) {
         tok_len++;
      }

      if (const_buf[tok_len] != EOS) {
         PRINTMSG (TOKEN_LINE(token), 423, Error,
                   TOKEN_COLUMN(token), const_buf[tok_len]);
         result = FALSE;
      }

      if (result) {
         convert_hex_literal(FALSE);
      }
      else {
         TOKEN_CONST_TBL_IDX(token) = NULL_IDX;
      }
   }
   else if (LA_CH_VALUE == 'O' && ! sig_blank) {

      NEXT_LA_CH;

      /* this is an octal constant */

      PRINTMSG (TOKEN_LINE(token), 90, Ansi, TOKEN_COLUMN(token));
      TOKEN_VALUE(token) = Tok_Const_Boolean;

      /* put the character constant into the const_buf */

      chptr = (char *)&CN_CONST(TOKEN_CONST_TBL_IDX(token));

      char_len = tok_len;

      i = 0;
      while (i < char_len &&
             (chptr[i] == ZERO ||
              chptr[i] == BLANK ||
              chptr[i] == TAB)) {

         if (chptr[i] == ZERO) {
            had_zero = TRUE;
         }

         i++;
      }

      tok_len = 0;

      while (i < char_len) {
         if (chptr[i] != BLANK &&
             chptr[i] != TAB) {
            ADD_TO_CONST_BUF (chptr[i], tok_len);
         }
         i++;
      }

      if (tok_len == 0 && had_zero) {
         ADD_TO_CONST_BUF (ZERO, tok_len);
      }

      const_buf[tok_len] = '\0';
      TOKEN_LEN(token) = tok_len;

      if (tok_len > MAX_OCT_CONST_LEN) {
         PRINTMSG(TOKEN_LINE(token), 91, Error, TOKEN_COLUMN(token),
                  tok_len, MAX_OCT_CONST_LEN);
      }
      else if (tok_len == MAX_OCT_CONST_LEN) {

         if (const_buf[0] < '0'  ||  const_buf[0] > '1') {
            /* The value exceeds the range. */

            PRINTMSG (TOKEN_LINE(token), 92, Error, TOKEN_COLUMN(token));
            result = FALSE;
         }
      }

      tok_len = 0;

      /* validate that all digits of token are octal digits */

      while (IS_OCT_DIGIT(const_buf[tok_len])) {
         tok_len++;
      }

      if (const_buf[tok_len] != EOS) {
         PRINTMSG (TOKEN_LINE(token), 93, Error,
                   TOKEN_COLUMN(token), const_buf[tok_len]);
         result = FALSE;
      }

      if (result) {
         convert_octal_literal(FALSE);
      }
      else {
         TOKEN_CONST_TBL_IDX(token) = NULL_IDX;
      }
   }
   else {
      CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
      TYP_TYPE(TYP_WORK_IDX)		= Character;
      TYP_LINEAR(TYP_WORK_IDX)		= CHARACTER_DEFAULT_TYPE;
      TYP_CHAR_CLASS(TYP_WORK_IDX)	= Const_Len_Char;
      TYP_FLD(TYP_WORK_IDX)	= CN_Tbl_Idx;
      TYP_IDX(TYP_WORK_IDX)	= C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, tok_len);

      CN_TYPE_IDX(TOKEN_CONST_TBL_IDX(token))	= ntr_type_tbl();
   }

   TRACE (Func_Exit, "get_operand_quote", NULL);

   return (result);

}  /* get_operand_quote */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Get_operator is called by the get_token routine to attempt recognition*|
|*	of an operator token using the look ahead character and following     *|
|*	characters of the input source.					      *|
|*									      *|
|* Input parameters:							      *|
|*	la_ch			first character of operator token	      *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*	token			token created by get_operator		      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates an operator token was produced.			      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

static boolean get_operator (void)

{
   int		buf_idx;
   char		op_ch;
   boolean	result	= TRUE;
   int		stmt_num;
   

   TRACE (Func_Entry, "get_operator", NULL);

# ifdef _DEBUG
   if (LA_CH_CLASS != Ch_Class_Symbol) {
      PRINTMSG(TOKEN_LINE(token), 295, Internal, TOKEN_COLUMN(token),
               "get_operator", "symbol");
   }
# endif

   op_ch		= LA_CH_VALUE;
   buf_idx		= LA_CH_BUF_IDX;
   stmt_num		= LA_CH_STMT_NUM;
   TOKEN_STR(token)[0]	= op_ch;

   if (op_ch != PLUS     &&
       op_ch != MINUS    &&
       op_ch != STAR     &&
       op_ch != SLASH    &&
       op_ch != EQUAL    &&
       op_ch != GT       &&
       op_ch != LT       &&
       op_ch != DOT      &&
       op_ch != PERCENT) {

      result = FALSE;
      TOKEN_VALUE(token) = Tok_Unknown;
   }
   else {

      NEXT_LA_CH;				 /* op may be multi-character */

      switch (op_ch) {
         case PLUS :
	    TOKEN_VALUE(token) = Tok_Op_Add;
            TOKEN_LEN(token)   = 1;
	    break;
    
         case MINUS :
	    TOKEN_VALUE(token) = Tok_Op_Sub;
            TOKEN_LEN(token)   = 1;
	    break;
    
         case STAR :
	    if (LA_CH_VALUE == STAR && !sig_blank) {
	       TOKEN_VALUE(token)	= Tok_Op_Power;
               TOKEN_STR(token)[1]	= STAR;
               TOKEN_LEN(token)         = 2;
	       NEXT_LA_CH;
	    }
	    else {
	       TOKEN_VALUE(token) = Tok_Op_Mult;
               TOKEN_LEN(token)   = 1;
	    }
	    break;

         case SLASH :
	    if (LA_CH_VALUE == EQUAL && !sig_blank) {
	       TOKEN_VALUE(token)	= Tok_Op_Ne;
               TOKEN_STR(token)[1]	= EQUAL;
               TOKEN_LEN(token)         = 2;
	       NEXT_LA_CH;
	    }
	    else if (LA_CH_VALUE == SLASH && !sig_blank) {
	       TOKEN_VALUE(token)  = Tok_Op_Concat;
               TOKEN_STR(token)[1] = SLASH;
               TOKEN_LEN(token)    = 2;
	       NEXT_LA_CH;
	    }
            else if (LA_CH_VALUE == RPAREN && !sig_blank) {
               result = FALSE;
               reset_lex(buf_idx,stmt_num);
               TOKEN_VALUE(token) = Tok_Unknown;
            }
	    else {
	       TOKEN_VALUE(token) = Tok_Op_Div;
               TOKEN_LEN(token)   = 1;
	    }
	    break;
       
         case EQUAL :
	    if (LA_CH_VALUE == EQUAL && !sig_blank) {
	       TOKEN_VALUE(token)	= Tok_Op_Eq;
               TOKEN_STR(token)[1]	= EQUAL;
               TOKEN_LEN(token)         = 2;
	       NEXT_LA_CH;
	    }
	    else if (LA_CH_VALUE == GT && !sig_blank) {
	       TOKEN_VALUE(token)       = Tok_Op_Ptr_Assign;
               TOKEN_STR(token)[1]	= GT;
               TOKEN_LEN(token)         = 2;
	       NEXT_LA_CH;
	    }
	    else {
	       TOKEN_VALUE(token) = Tok_Op_Assign;
               TOKEN_LEN(token)   = 1;
	    }
	    break;
	       
         case GT :
	    if (LA_CH_VALUE == EQUAL && !sig_blank) {
	       TOKEN_VALUE(token)	= Tok_Op_Ge;
               TOKEN_STR(token)[1]	= EQUAL;
               TOKEN_LEN(token)         = 2;
	       NEXT_LA_CH;
	    }
	    else {
	       TOKEN_VALUE(token) = Tok_Op_Gt;
               TOKEN_LEN(token)   = 1;
	    }
	    break;
	       
         case LT :
	    if (LA_CH_VALUE == EQUAL && !sig_blank) {
	       TOKEN_VALUE(token)	= Tok_Op_Le;
               TOKEN_STR(token)[1]	= EQUAL;
               TOKEN_LEN(token)         = 2;
	       NEXT_LA_CH;
	    }
            else if (LA_CH_VALUE == GT &&
                     !sig_blank) {

               TOKEN_VALUE(token)       = Tok_Op_Lg;
               TOKEN_STR(token)[1]      = GT;
               TOKEN_LEN(token)         = 2;
               NEXT_LA_CH;
            }
	    else {
	       TOKEN_VALUE(token) = Tok_Op_Lt;
               TOKEN_LEN(token)   = 1;
	    }
	    break;
	       
         case DOT :
            
/*
            if (LA_CH_CLASS == Ch_Class_Digit) 
*/
            if (LA_CH_CLASS != Ch_Class_Letter ||
                sig_blank)                     {
               result = FALSE;
               reset_lex(buf_idx, stmt_num);
            }
            else {
	       result = get_operator_dot ();
            }
	    break;
    
         case PERCENT :
	    TOKEN_VALUE(token) = Tok_Op_Deref;
            TOKEN_LEN(token)   = 1;
	    break;
       
         default :
	    TOKEN_VALUE(token) = Tok_Unknown;
            result             = FALSE;
            TOKEN_LEN(token)   = 1;
	    break;
      }  /* switch */
   }

   TRACE (Func_Exit, "get_operator", NULL);

   return (result);

}  /* get_operator */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Get_operator_dot is called by the get_operator routine to recognize   *|
|*	relational operators, logical operators, and defined operators by     *|
|*	matching the look ahead character and following characters of class   *|
|*	Ch_Class_Letter with entries in the dot_op table.  The operator must  *|
|*	be delimited with a trailing "."				      *|
|*									      *|
|* Input parameters:							      *|
|*	la_ch			first character of operator token	      *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*	token			token produced by get_operator_dot	      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates a dot operator token was produced.		      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

static boolean get_operator_dot (void)

{
   int          attr_idx;
   int		beg_idx;
   int		i;
   int		letter_idx;
   int		lim_idx;
   int          name_idx;
   boolean	result		= TRUE;
   int		tok_len		= 0;


   TRACE (Func_Entry, "get_operator_dot", NULL);

   /* This is only called if LA_CH_CLASS is Ch_Class_Letter */

   while (LA_CH_CLASS == Ch_Class_Letter && !sig_blank) {
      ADD_TO_TOKEN_STR (LA_CH_VALUE, tok_len);
      NEXT_LA_CH;
   }

#ifdef KEY /* Bug 3635 */
   if (defined_op_too_long(&tok_len))
#else
   if (tok_len > MAX_ID_LEN)
#endif /* KEY Bug 3635 */
   {
#ifdef KEY /* Bug 3635 */
#else
      /* Defined operator exceeds maximum length of 31 characters */
      PRINTMSG (LA_CH_LINE, 65, Error, LA_CH_COLUMN);
      tok_len	 	 = MAX_ID_LEN;
#endif /* KEY Bug 3635 */
      TOKEN_LEN(token)	 = tok_len;
      /* call this a user defined opr */
      TOKEN_VALUE(token) = Tok_Op_Defined;

      if (LA_CH_VALUE == DOT && !sig_blank) {
         NEXT_LA_CH;
      }
      else {
         PRINTMSG (LA_CH_LINE, 66, Error, LA_CH_COLUMN);
      }
   }
   else if (LA_CH_VALUE == DOT && !sig_blank) {

      /* check for any dot ops starting with first char of token */
      letter_idx = TOKEN_STR(token)[0] - 'A';

      beg_idx = dot_op_idx[letter_idx];
      lim_idx = dot_op_idx[letter_idx+1];
   
      /* compare token string to dot_op entries */
      while (beg_idx < lim_idx) {
	 if (dot_op_len[beg_idx] == tok_len) {
	    if (strncmp(TOKEN_STR(token),
			dot_op[beg_idx].name,
			tok_len) == IDENTICAL) {

	       TOKEN_VALUE(token) = dot_op[beg_idx].value;

	       break;
	    }
	 }
	 beg_idx++;
      }

      /* operator must be user defined */
      if (beg_idx == lim_idx) {
	 TOKEN_VALUE(token) = Tok_Op_Defined;
      }

      for (i = 0; i < tok_len; i++) {
         TOKEN_STR(token)[i] = tolower(TOKEN_STR(token)[i]);
      }

      switch (TOKEN_VALUE(token)) {
         case Tok_Op_Neqv     :

            if (tok_len == 3 || tok_len == 1) {
            
               attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token),
                                       &name_idx);

               if (attr_idx == NULL_IDX) {
                  attr_idx = srch_host_sym_tbl(TOKEN_STR(token),
                                               TOKEN_LEN(token), 
                                               &name_idx,
                                               TRUE);
               }

               if (attr_idx != NULL_IDX) {

                  while (AT_ATTR_LINK(attr_idx) != NULL_IDX) {
                     attr_idx = AT_ATTR_LINK(attr_idx);
                  }
               }

               if (attr_idx == NULL_IDX && 
                   SH_STMT_TYPE(curr_stmt_sh_idx) == Interface_Stmt) {
                  TOKEN_VALUE(token) = Tok_Op_Defined;
               }
 
               else if (attr_idx != NULL_IDX && 
                        AT_OBJ_CLASS(attr_idx) == Interface) {
                  TOKEN_VALUE(token) = Tok_Op_Defined;
               }
               else {
                  PRINTMSG(TOKEN_LINE(token), 317, Ansi, TOKEN_COLUMN(token),
                           TOKEN_STR(token));
               }
            }
            break;
               
         case Tok_Const_True  :
         case Tok_Const_False :

            if (tok_len == 1) {

               attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token),
                                       &name_idx);

               if (attr_idx == NULL_IDX) {
                  attr_idx = srch_host_sym_tbl(TOKEN_STR(token),
                                               TOKEN_LEN(token), 
                                               &name_idx,
                                               TRUE);
               }

               if (attr_idx != NULL_IDX) {

                  while (AT_ATTR_LINK(attr_idx) != NULL_IDX) {
                     attr_idx = AT_ATTR_LINK(attr_idx);
                  }
               }

               if (attr_idx                       == NULL_IDX && 
                   SH_STMT_TYPE(curr_stmt_sh_idx) == Interface_Stmt) {
                  TOKEN_VALUE(token) = Tok_Op_Defined;
               } 
               else if (attr_idx != NULL_IDX && 
                        AT_OBJ_CLASS(attr_idx) == Interface) {
                  TOKEN_VALUE(token) = Tok_Op_Defined;
               }
            }

            break;

         case Tok_Op_And      :
         case Tok_Op_Not      :
         case Tok_Op_Or       :

            if (tok_len == 1) {
            
               attr_idx = srch_sym_tbl(TOKEN_STR(token), TOKEN_LEN(token),
                                       &name_idx);

               if (attr_idx == NULL_IDX) {
                  attr_idx = srch_host_sym_tbl(TOKEN_STR(token),
                                               TOKEN_LEN(token), 
                                               &name_idx,
                                               TRUE);
               }

               if (attr_idx != NULL_IDX) {

                  while (AT_ATTR_LINK(attr_idx) != NULL_IDX) {
                     attr_idx = AT_ATTR_LINK(attr_idx);
                  }
               }

               if (attr_idx == NULL_IDX && 
                   SH_STMT_TYPE(curr_stmt_sh_idx) == Interface_Stmt) {
                  TOKEN_VALUE(token) = Tok_Op_Defined;
               }
               else if (attr_idx != NULL_IDX && 
                        AT_OBJ_CLASS(attr_idx) == Interface) {
                  TOKEN_VALUE(token) = Tok_Op_Defined;
               }
               else {
                  PRINTMSG(TOKEN_LINE(token), 317, Ansi, TOKEN_COLUMN(token),
                           TOKEN_STR(token));
               }
            }
            
            break;

      }
      NEXT_LA_CH;
   }
   else { /* Defined operator is missing "." delimiter */
      PRINTMSG (LA_CH_LINE, 66, Error, LA_CH_COLUMN);
      result = FALSE;
   }
   TOKEN_LEN(token) = tok_len;

   TRACE (Func_Exit, "get_operator_dot", NULL);

   return (result);

}  /* get_operator_dot */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Get_program_str is called by the get_token routine to attempt	      *|
|*	recognition of the optional string in a program statement by using    *|
|*	the look ahead character and following characters of the input source.*|
|*	This is a special case, the only thing cft90 does is to check to make *|
|*	sure there is only one (....) group.  It then gets to EOS.  Cft90     *|
|*	will do no more with this string, because it was used for CTSS.       *|
|*									      *|
|* Input parameters:							      *|
|*	la_ch			opening paren of program string		      *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates a program string token was produced.		      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

static boolean get_program_str (void)

{
   int		paren_lvl	= 0;
   boolean	result		= TRUE;


   TRACE (Func_Entry, "get_program_str", NULL);

# ifdef _DEBUG
   if (LA_CH_VALUE != LPAREN) {
      PRINTMSG(TOKEN_LINE(token), 295, Internal, TOKEN_COLUMN(token),
               "get_program_str", "(");
   }
# endif

   /* Scan thru the program string, checking if the paren groups are matched. */
   /* Do not save anything in the TOKEN.  Cray treats this as a comment.      */

   do {
      if (LA_CH_VALUE == LPAREN) {
	 paren_lvl++;
      }
      else if (LA_CH_VALUE == RPAREN) {
	 paren_lvl--;
      }
      NEXT_LA_CH;
   }
   while (paren_lvl > 0 && LA_CH_VALUE != EOS);

   if (paren_lvl > 0) {		/* Trailing ")" is missing in program string. */
      PRINTMSG (TOKEN_LINE(token), 28, Error, TOKEN_COLUMN(token));
      result = FALSE;
   }

   TRACE (Func_Exit, "get_program_str", NULL);

   return (result);

}  /* get_program_str */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Get_punctuator is called by the get_token routine to attempt	      *|
|*	recognition of a punctuator token using the look ahead character and  *|
|*	following characters of the input source.			      *|
|*									      *|
|*	EOS is considered a punctuator token.  Get_punctuator is responsible  *|
|*	for skipping redundant EOS punctuators between statements.	      *|
|*									      *|
|* Input parameters:							      *|
|*	la_ch			first character of punctuator token	      *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*	token			token created by get_punctuator		      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates a punctuator token was produced.			      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

static boolean get_punctuator (void)

{
   char		punct_ch;
   int		tok_len         = 0; 

   TRACE (Func_Entry, "get_punctuator", NULL);

   punct_ch		= LA_CH_VALUE;
   TOKEN_STR(token)[0]	= punct_ch;
   tok_len		= 1;

   NEXT_LA_CH;			      /* punct may be multi-character */

   switch (punct_ch) {
      case COLON :
	 if (LA_CH_VALUE == COLON && !sig_blank) {
	    TOKEN_VALUE(token) = Tok_Punct_Colon_Colon;
            TOKEN_STR(token)[1] = COLON;
            tok_len = 2;
	    NEXT_LA_CH;
	 }
	 else {
	    TOKEN_VALUE(token) = Tok_Punct_Colon;
	 }
	 break;

      case COMMA :
	 TOKEN_VALUE(token) = Tok_Punct_Comma;
	 break;
    
      case DASH :
	 TOKEN_VALUE(token) = Tok_Punct_Dash;
	 break;
    
      case EOS :
	 TOKEN_VALUE(token) = Tok_EOS;
	 break;
    
      case EQUAL :
	 if (LA_CH_VALUE == GT && !sig_blank) {
	    TOKEN_VALUE(token)	= Tok_Punct_Rename;
            TOKEN_STR(token)[1]	= GT;
            tok_len		= 2;
	    NEXT_LA_CH;
	 }
	 else {
	    TOKEN_VALUE(token) = Tok_Punct_Eq;
	 }
	 break;

      case LPAREN :
	 if (LA_CH_VALUE == SLASH && !sig_blank) {
	    TOKEN_VALUE(token)	= Tok_Punct_Lbrkt;
            TOKEN_STR(token)[1]	= SLASH;
            tok_len		= 2;
	    NEXT_LA_CH;
	 }
	 else {
	    TOKEN_VALUE(token) = Tok_Punct_Lparen;
	 }
	 break;

      case RPAREN :
	 TOKEN_VALUE(token) = Tok_Punct_Rparen;
	 break;
    
      case SLASH :
	 if (LA_CH_VALUE == RPAREN && !sig_blank) {
	    TOKEN_VALUE(token)	= Tok_Punct_Rbrkt;
            TOKEN_STR(token)[1]	= RPAREN;
            tok_len		= 2;
	    NEXT_LA_CH;
	 }
	 else {
	    TOKEN_VALUE(token) = Tok_Punct_Slash;
	 }
	 break;

      case STAR :
	 TOKEN_VALUE(token) = Tok_Punct_Star;
	 break;
    
      default :
	 TOKEN_VALUE(token) = Tok_Unknown;
	 break;
   }  /* switch */

   TOKEN_LEN(token) = tok_len;

   TRACE (Func_Exit, "get_punctuator", NULL);

   return (TRUE);

}  /* get_punctuator */


/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	ch_after_paren_grp						      *|
|*	 initial implementation.  Does not handle hollerith.                  *|
|*	 Needs to be rewritten before it gets to the real world.              *|
|* 	 Parse needs to be positioned with LA_CH_VALUE = to LPAREN.           *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	If the lookahead is a left paren, it searches for the character       *|
|*      following the right paren and returns it.  If there is no right paren,*|
|*      it returns EOS char.  If the lookahead is not a left paren, it returns*|
|*      the lookahead.                                                        *|
|*									      *|
\******************************************************************************/

char	ch_after_paren_grp(void)

{
   char			return_char;


   TRACE (Func_Entry, "ch_after_paren_grp", &LA_CH_VALUE);

   return_char = scan_thru_close_paren(0,0,1);

   TRACE (Func_Exit, "ch_after_paren_grp", &return_char);

   return(return_char);

}  /* ch_after_paren_grp */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      convert numeric constants that possibly have kind parameters.         *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      TRUE if no problems.                                                  *|
|*                                                                            *|
\******************************************************************************/

static boolean convert_const(void)

{
   int			attr_idx;
   long     		bytes			= 0;
   long_type		constant[MAX_WORDS_FOR_NUMERIC];
   linear_type_type	linear_type;
   id_str_type  	name;
   int			name_idx;
   boolean		result_ok		= TRUE;
   int			type_idx;
   type_desc_type	type_kind		= Default_Typed;


   TRACE (Func_Entry, "convert_const", NULL);

   TOKEN_CONST_TBL_IDX(token) = NULL_IDX;

   if (TOKEN_KIND_LEN(token) != 0) {

      if (TOKEN_KIND_STR(token)[0] >= '0' && TOKEN_KIND_STR(token)[0] <= '9') {
         errno	= 0;
         bytes	= LEX_STRTOL(TOKEN_KIND_STR(token), (char **) NULL, 10);

         if (errno != 0) {
            result_ok	= FALSE;
            PRINTMSG(TOKEN_LINE(token), 621, Error, 
                     TOKEN_COLUMN(token),
                     TOKEN_KIND_STR(token));
         }
         else {
            type_kind	= Kind_Typed;
         }
      }
      else {
         CREATE_ID(name, TOKEN_KIND_STR(token), TOKEN_KIND_LEN(token));
         attr_idx	= srch_sym_tbl(name.string,
                                       TOKEN_KIND_LEN(token),
                                       &name_idx);

         if (attr_idx == NULL_IDX) {
            attr_idx = srch_host_sym_tbl(name.string,
                                         TOKEN_KIND_LEN(token), 
                                         &name_idx,
                                         TRUE);
         }

         if (attr_idx == NULL_IDX) { /* error .. no parameter */
            PRINTMSG(TOKEN_LINE(token), 129, Error, TOKEN_COLUMN(token));
            result_ok	= FALSE;
         }
         else {

            while (AT_ATTR_LINK(attr_idx) != NULL_IDX) {
               attr_idx = AT_ATTR_LINK(attr_idx);
            }

            if (AT_NOT_VISIBLE(attr_idx)) {
               PRINTMSG(TOKEN_LINE(token), 486, Error,
                        TOKEN_COLUMN(token),
                        AT_OBJ_NAME_PTR(attr_idx),
                        AT_OBJ_NAME_PTR(AT_MODULE_IDX((attr_idx))));
               result_ok	= FALSE;
            }
            else if (AT_OBJ_CLASS(attr_idx) == Data_Obj &&
                     ATD_CLASS(attr_idx)    == Constant &&
                     TYP_TYPE(ATD_TYPE_IDX(attr_idx)) == Integer &&
                     ATD_ARRAY_IDX(attr_idx) == NULL_IDX) {
               bytes		= (long)CN_INT_TO_C(ATD_CONST_IDX(attr_idx));
               type_kind	= Kind_Typed;
            }
            else { /* error .. kind must be integer or integer parameter */
               PRINTMSG(TOKEN_LINE(token), 129, Error, TOKEN_COLUMN(token));
               result_ok	= FALSE;
            }
         }
      }
   }

   switch (TOKEN_VALUE(token)) {
   case Tok_Const_Int  :

      if (type_kind == Default_Typed) {
         type_idx	= INTEGER_DEFAULT_TYPE;
      }
      else if (!validate_kind(Integer,
                              TOKEN_LINE(token),
                              TOKEN_COLUMN(token),
                              &bytes,
	                      &linear_type)) {

         type_idx	= INTEGER_DEFAULT_TYPE;
         result_ok	= FALSE;
      }
      else {
         CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
         TYP_TYPE(TYP_WORK_IDX)		= Integer;
         TYP_LINEAR(TYP_WORK_IDX)	= linear_type;
         TYP_DCL_VALUE(TYP_WORK_IDX)	= bytes;
         TYP_DESC(TYP_WORK_IDX)		= Kind_Typed;
         type_idx			= ntr_type_tbl();
      }

#ifdef KEY /* Bug 5554 */
      int new_type_idx;
      CONVERT_INT_CONST(type_idx, TOKEN_LEN(token), result_ok);
#else /* KEY Bug 5554 */
      CONVERT_INT_CONST(type_idx, TOKEN_LEN(token), result_ok);
#endif /* KEY Bug 5554 */
      break;

   case Tok_Const_Real :

      if (type_kind == Default_Typed) {
         type_idx	= REAL_DEFAULT_TYPE;
         CONVERT_REAL_CONST(type_idx, TOKEN_LEN(token), result_ok);
      }
      else if (!validate_kind(Real,
                              TOKEN_LINE(token),
                              TOKEN_COLUMN(token),
                              &bytes,
                              &linear_type)) {
         type_idx	= REAL_DEFAULT_TYPE;
         result_ok	= FALSE;
         CONVERT_REAL_CONST(type_idx, TOKEN_LEN(token), result_ok);
      }
      else {
         CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
         TYP_TYPE(TYP_WORK_IDX)		= Real;
         TYP_LINEAR(TYP_WORK_IDX)	= linear_type;
         TYP_DCL_VALUE(TYP_WORK_IDX)	= bytes;
         TYP_DESC(TYP_WORK_IDX)		= Kind_Typed;
         type_idx			= ntr_type_tbl();

# ifdef _TARGET64
         if (linear_type > Real_8)
# else
         if (linear_type > Real_4)
# endif
         {
            CONVERT_DBL_CONST(type_idx, TOKEN_LEN(token), result_ok);
         }
         else {
            CONVERT_REAL_CONST(type_idx, TOKEN_LEN(token), result_ok);
         }
      }
      break;

   case Tok_Const_True  :
   case Tok_Const_False :

      if (type_kind == Default_Typed) {
         type_idx	= LOGICAL_DEFAULT_TYPE;
      }
      else if (!validate_kind(Logical,
                              TOKEN_LINE(token),
                              TOKEN_COLUMN(token),
                              &bytes,
                              &linear_type)) {
         type_idx	= LOGICAL_DEFAULT_TYPE;
         result_ok	= FALSE;
      }
      else {
         CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
         TYP_TYPE(TYP_WORK_IDX)		= Logical;
         TYP_LINEAR(TYP_WORK_IDX)	= linear_type;
         TYP_DCL_VALUE(TYP_WORK_IDX)	= bytes;
         TYP_DESC(TYP_WORK_IDX)		= Kind_Typed;
         type_idx			= ntr_type_tbl();
      }

      TOKEN_CONST_TBL_IDX(token) = set_up_logical_constant(constant, 
                                                           type_idx, 
                   (TOKEN_VALUE(token) == Tok_Const_True ? TRUE_VALUE :
                                                           FALSE_VALUE),
                                                           TRUE);
      break;

   case Tok_Const_Char :

      if (type_kind != Default_Typed && !validate_kind(Character,
                                                       TOKEN_LINE(token),
                                                       TOKEN_COLUMN(token),
                                                       &bytes,
                                                       &linear_type)) {
         result_ok = FALSE;
      }
      break;
   }

   TRACE (Func_Exit, "convert_const", NULL);

   return(result_ok);

} /* convert_const */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	<description>							      *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

token_values_type get_dir_token_from_str(char *str)

{
   int               beg_idx;
   int		     i;
   int               letter_idx;
   int               lim_idx;
   char              upper_str[MAX_KWD_LEN + 1];
   int               str_len         = 0;
   token_values_type value           = Tok_Unknown;


   TRACE (Func_Entry, "get_dir_token_from_str", NULL);

   str_len = 0;
   i = 0;

   while (str[i] != '\0') {
      if (str[i] == ' ' || str[i] == '\t') {
         i++;
      }
      else {
         if (ch_class[str[i]] != Ch_Class_Letter &&
             str[i] != USCORE) {
            goto EXIT;
         }
         else if (islower(str[i])) {
            upper_str[str_len] = TOUPPER(str[i]);
         }
         else {
            upper_str[str_len] = str[i];
         }
         str_len++;
         i++;
      }
   }

   if (ch_class[upper_str[0]] != Ch_Class_Letter) {
      goto EXIT;
   }

   letter_idx   = upper_str[0] - 'A';
   beg_idx      = kwd_dir_idx[letter_idx];
   lim_idx      = kwd_dir_idx[letter_idx+1];

   if (beg_idx != lim_idx) {

      if (str_len >= kwd_dir_len[lim_idx-1]) {

         while (beg_idx < lim_idx) {

            if (kwd_dir_len[beg_idx] == str_len &&
                strncmp(upper_str, 
                        kwd_dir[beg_idx].name,
                        kwd_dir_len[beg_idx]) == IDENTICAL) {

               value = kwd_dir[beg_idx].value;

               break;
            }

            beg_idx++;

         }  /* while */
      }  /* if */
   }  /* if */

   if (value                        == Tok_Unknown &&
       ((strncmp("ALL", upper_str, 3) == IDENTICAL) ||
        (strncmp("DIR", upper_str, 3) == IDENTICAL) ||
        (strncmp("MIC", upper_str, 3) == IDENTICAL) ||
        (strncmp("MIPSPRO", upper_str, 7) == IDENTICAL) ||
        (strncmp("OMP", upper_str, 3) == IDENTICAL) ||
        (strncmp("CONDITIONAL_OMP", upper_str, 15) == IDENTICAL) ||
        (strncmp("MPP", upper_str, 3) == IDENTICAL))) {

      /* Tok_Id is a signal to cmd_line that "all" or "mpp" was specified */

      value = Tok_Id;
   }
   else if (value == Tok_Unknown) {  /* See if it is a MIC keyword */
      letter_idx   = upper_str[0] - 'A';
      beg_idx      = kwd_mic_idx[letter_idx];
      lim_idx      = kwd_mic_idx[letter_idx+1];

      if (beg_idx != lim_idx) {

         if (str_len >= kwd_mic_len[lim_idx-1]) {

            while (beg_idx < lim_idx) {

               if (kwd_mic_len[beg_idx] == str_len &&
                   strncmp(upper_str, 
                           kwd_mic[beg_idx].name,
                           kwd_mic_len[beg_idx]) == IDENTICAL) {

                  value = kwd_mic[beg_idx].value;

                  break;
               }

               beg_idx++;

            }  /* while */
         }
      }
   }

   if (value == Tok_Unknown) {  /* See if it is an OpenMp keyword */
      letter_idx   = upper_str[0] - 'A';
      beg_idx      = kwd_open_mp_dir_idx[letter_idx];
      lim_idx      = kwd_open_mp_dir_idx[letter_idx+1];

      if (beg_idx != lim_idx) {

         if (str_len >= kwd_open_mp_dir_len[lim_idx-1]) {

            while (beg_idx < lim_idx) {

               if (kwd_open_mp_dir_len[beg_idx] == str_len &&
                   strncmp(upper_str, 
                           kwd_open_mp_dir[beg_idx].name,
                           kwd_open_mp_dir_len[beg_idx]) == IDENTICAL) {

                  value = kwd_open_mp_dir[beg_idx].value;

                  break;
               }

               beg_idx++;

            }  /* while */
         }
      }
   }

   if (value == Tok_Unknown) {  /* See if it is an Mips keyword */
      letter_idx   = upper_str[0] - 'A';
      beg_idx      = kwd_sgi_dir_idx[letter_idx];
      lim_idx      = kwd_sgi_dir_idx[letter_idx+1];

      if (beg_idx != lim_idx) {

         if (str_len >= kwd_sgi_dir_len[lim_idx-1]) {

            while (beg_idx < lim_idx) {

               if (kwd_sgi_dir_len[beg_idx] == str_len &&
                   strncmp(upper_str, 
                           kwd_sgi_dir[beg_idx].name,
                           kwd_sgi_dir_len[beg_idx]) == IDENTICAL) {

                  value = kwd_sgi_dir[beg_idx].value;

                  break;
               }

               beg_idx++;

            }  /* while */
         }
      }
   }

EXIT:

   TRACE (Func_Exit, "get_dir_token_from_str", NULL);

   return(value);

}  /* get_dir_token_from_str */

# ifdef _DEBUG
/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	Get_debug_directive is called by the get_token routine to attempt     *|
|*	recognition of a debug keyword by matching the look ahead char        *|
|*	and following characters of class Ch_Class_Letter with entries in the *|
|*	kwd_dbg table.	If a keyword is not found, an id token is created.    *|
|*									      *|
|* Input parameters:							      *|
|*	la_ch			first character of debug kwd token	      *|
|*									      *|
|* Output parameters:							      *|
|*	la_ch			next character of input source statement      *|
|*	token			token created by get_debug_directive	      *|
|*									      *|
|* Returns:								      *|
|*	TRUE indicates a keyword or id token was produced.		      *|
|*	FALSE indicates that an error was encountered.			      *|
|*									      *|
\******************************************************************************/

static boolean get_debug_directive (void)

{
   int		beg_idx;
   la_type	la_queue[MAX_KWD_LEN + 1];
   int		letter_idx;
   int		lim_idx;
   int		tok_len		= 0;
      

   TRACE (Func_Entry, "get_debug_directive", NULL);

# ifdef _DEBUG
   if (LA_CH_CLASS != Ch_Class_Letter) {
      PRINTMSG(TOKEN_LINE(token), 295, Internal, TOKEN_COLUMN(token),
               "get_debug_directive", "letter");
   }
# endif

   TOKEN_VALUE(token) = Tok_Id;

   /* check for any microtasking keywords starting with look ahead char */
   letter_idx = LA_CH_VALUE - 'A';

   beg_idx = kwd_dbg_idx[letter_idx];
   lim_idx = kwd_dbg_idx[letter_idx+1];
   
   if (beg_idx != lim_idx) {

#ifdef _DEBUG
      if (kwd_dbg_len[beg_idx] > MAX_ID_LEN) {
         PRINTMSG(TOKEN_LINE(token), 384, Internal, TOKEN_COLUMN(token),
                  beg_idx, kwd_dbg_len[beg_idx]);
      }
# endif

      while (LA_CH_CLASS == Ch_Class_Letter && tok_len < kwd_dbg_len[beg_idx]) {
	 la_queue[tok_len]		= la_ch;
         TOKEN_STR(token)[tok_len]	= LA_CH_VALUE;
         tok_len++;
	 NEXT_LA_CH;
      }

      TOKEN_LEN(token) = tok_len;

      if (tok_len >= kwd_dbg_len[lim_idx-1]) {

	 /* compare token string to debug keyword entries */

	 while (beg_idx < lim_idx) {

	    if (kwd_dbg_len[beg_idx] <= tok_len) {

               if (strncmp(TOKEN_STR(token),
                           kwd_dbg[beg_idx].name,
                           kwd_dbg_len[beg_idx]) == IDENTICAL) {

		  /* the following chars and preceding letter can't be */
		  /* part of a keyword on full length match of string. */

		  if (tok_len == kwd_dbg_len[beg_idx]  &&
		      (LA_CH_VALUE == USCORE  ||
		       LA_CH_VALUE == DOLLAR  ||
		       LA_CH_VALUE == AT_SIGN)) {
		  }
		  else {
		     TOKEN_VALUE(token) = kwd_dbg[beg_idx].value;

		     /* adjust la_ch to be char following keyword */

		     if (tok_len > kwd_dbg_len[beg_idx]) {
			tok_len = kwd_dbg_len[beg_idx];
			la_ch	= la_queue[tok_len];
                        TOKEN_LEN(token) = tok_len;

			/* reset src input buffer and col index to la_ch pos */
			reset_src_input (LA_CH_BUF_IDX, LA_CH_STMT_NUM);
		     }
		     break;
		  }
	       }
	    }  /* if */

	    beg_idx++;

	 }  /* while */
      }	 /* if */
   }  /* if */

   if (TOKEN_VALUE(token) == Tok_Id) {			/* keyword not found  */

      while (VALID_LA_CH) {
	 ADD_TO_TOKEN_STR (LA_CH_VALUE, tok_len);
	 NEXT_LA_CH;
      }
    
#ifdef KEY /* Bug 3635 */
      id_too_long(&tok_len);
#else
      if (tok_len > MAX_ID_LEN) { /* Id len exceeds maximum of 31 characters. */
         PRINTMSG (TOKEN_LINE(token), 67, Error, TOKEN_COLUMN(token));
	 tok_len = MAX_ID_LEN;
      }
#endif /* KEY Bug 3635 */
      TOKEN_LEN(token) = tok_len;
   }

   TRACE (Func_Exit, "get_debug_directive", NULL);

   return (TRUE);
   
}  /* get_debug_directive */
# endif

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	<description>							      *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void convert_octal_literal(boolean	is_boz)

{
   int		i;
   int		idx;
   int		num_bits;
   int		num_words;
   long_type	result[MAX_WORDS_FOR_NUMERIC];
   int		shift;
   int		temp;
   int		type_idx;
   int		word;

   TRACE (Func_Entry, "convert_octal_literal", NULL);


   num_bits = ((TOKEN_LEN(token) - 1) * 3);
   temp = const_buf[0] - '0';

   num_bits +=
    ((temp & 4) != 0 ? 3 : ((temp & 2) != 0 ? 2 : ((temp & 1) != 0 ? 1 : 0)));

   num_words = (num_bits + TARGET_BITS_PER_WORD - 1) / TARGET_BITS_PER_WORD;

   if (num_words == 0) {
      num_words = 1;
   }

   /* clear result array */
   for (i = 0; i < MAX_WORDS_FOR_NUMERIC; i++) {
      result[i] = 0;
   }

   word = num_words - 1;

   idx = TOKEN_LEN(token) - 1;
   shift = 0;

   while (idx >= 0) {

      if (shift > (TARGET_BITS_PER_WORD - 1)) {
         shift = 0;
         word--;
      }

      temp = const_buf[idx] - '0';
      idx--;

      result[word] |= ((temp & 1) << shift);
      shift++;

      if (shift > (TARGET_BITS_PER_WORD - 1)) {
         shift = 0;
         word--;
      }

      result[word] |= (((temp >> 1) & 1) << shift);
      shift++;

      if (shift > (TARGET_BITS_PER_WORD - 1)) {
         shift = 0;
         word--;
      }

      result[word] |= (((temp >> 2) & 1) << shift);  /* BRIANJ */
      shift++;
   }

   CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
   TYP_TYPE(TYP_WORK_IDX)	= Typeless;
   TYP_LINEAR(TYP_WORK_IDX)	= Short_Typeless_Const;
   TYP_BIT_LEN(TYP_WORK_IDX)	= (num_words * TARGET_BITS_PER_WORD);
   type_idx			= ntr_type_tbl();

   if (is_boz) {
      TOKEN_CONST_TBL_IDX(token) = ntr_boz_const_tbl(type_idx,
                                                     result);
   }
   else {
      TOKEN_CONST_TBL_IDX(token) = ntr_boolean_const_tbl(type_idx,
                                                         result);
   }


   TRACE (Func_Exit, "convert_octal_literal", NULL);

   return;

}  /* convert_octal_literal */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      <description>                                                         *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void convert_hex_literal(boolean       is_boz)

{
   int		i;
   int          idx;
   int		base;
   int		bits;
   char		*char_ptr;
   long_type	constant[MAX_WORDS_FOR_NUMERIC];
   int		const_idx;
   int		count;
   int		digits_per_word;
   int		num_digits;
   int          num_words;
   boolean	negate = FALSE;
   long_type    result[MAX_WORDS_FOR_NUMERIC];
   char		tmpstr[80];
   int          type_idx;
   int          word;


   TRACE (Func_Entry, "convert_hex_literal", NULL);

   if (const_buf[0] == PLUS) {
      num_digits = TOKEN_LEN(token) - 1;
      char_ptr   = &(const_buf[1]);
   }
   else if (const_buf[0] == MINUS) {
      num_digits = TOKEN_LEN(token) - 1;
      char_ptr   = &(const_buf[1]);
      negate     = TRUE;
   }
   else {
      num_digits = TOKEN_LEN(token);
      char_ptr = const_buf;
   }

   digits_per_word = TARGET_BITS_PER_WORD / 4;

   num_words = (num_digits + digits_per_word - 1) / digits_per_word;

   /* clear result array */
   for (i = 0; i < MAX_WORDS_FOR_NUMERIC; i++) {
      result[i] = 0;  /*  BRIANJ - SHould we set this to target value? */
   }

   word = num_words - 1;
   idx  = num_digits - digits_per_word;

   while (word >= 0) {

      if (idx < 0) {
         count = digits_per_word + idx;
         idx = 0;
      }
      else {
         count = digits_per_word;
      }

      strncpy(tmpstr, &(char_ptr[idx]), count);
      tmpstr[count] = '\0';

# ifdef _ARITH_INPUT_CONV
      base = 16;

      i    = AR_convert_str_to_int((AR_DATA *)constant,
                   (const AR_TYPE *)&input_arith_type[CG_INTEGER_DEFAULT_TYPE],
                                    &bits,
                      (const char *)tmpstr,
                       (const int *)&base);
      SHIFT_ARITH_RESULT(constant, CG_INTEGER_DEFAULT_TYPE);
      result[word] = constant[0];

# else
# if defined(_HOST32) && defined(_TARGET64)

      result[word] = (long_type) strtoull(tmpstr, (char **) NULL, 16);

# else 

      result[word] = strtoul(tmpstr, (char **) NULL, 16);

# endif
# endif

      idx -= digits_per_word;
      word--;
   }

   CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
   TYP_TYPE(TYP_WORK_IDX)	= Typeless;
   TYP_LINEAR(TYP_WORK_IDX)	= Short_Typeless_Const;
   TYP_BIT_LEN(TYP_WORK_IDX)	= (num_words * TARGET_BITS_PER_WORD);
   type_idx			= ntr_type_tbl();

   if (is_boz) {
      const_idx = ntr_boz_const_tbl(type_idx, result);
   }
   else {
      const_idx  = ntr_boolean_const_tbl(type_idx, result);
   }

   
   /* BHJ - need to check for '-' and do the fold. The constant is */
   /* truncated to default integer size.                           */

   if (negate) {
      const_idx = cast_typeless_constant(const_idx,
					 TYPELESS_DEFAULT_TYPE,
					 TOKEN_LINE(token),
					 TOKEN_COLUMN(token));

      type_idx = INTEGER_DEFAULT_TYPE;
      if (folder_driver((char *)&CN_CONST(const_idx),
			INTEGER_DEFAULT_TYPE,
                        NULL,
                        NULL_IDX,
                        constant,
                       &type_idx,
                        TOKEN_LINE(token),
                        TOKEN_COLUMN(token),
                        1,
                        Uminus_Opr)) {

         if (is_boz) {
            const_idx = ntr_boz_const_tbl(TYPELESS_DEFAULT_TYPE, constant);
         }
         else {
            const_idx  = ntr_boolean_const_tbl(TYPELESS_DEFAULT_TYPE, constant);
         }
      }
   }

   TOKEN_CONST_TBL_IDX(token) = const_idx;

   TRACE (Func_Exit, "convert_hex_literal", NULL);

   return;

}  /* convert_hex_literal */

/******************************************************************************\
|*                                                                            *|
|* Description:                                                               *|
|*      <description>                                                         *|
|*                                                                            *|
|* Input parameters:                                                          *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Output parameters:                                                         *|
|*      NONE                                                                  *|
|*                                                                            *|
|* Returns:                                                                   *|
|*      NOTHING                                                               *|
|*                                                                            *|
\******************************************************************************/

static void convert_binary_literal(boolean       is_boz)

{
   int		i;
   int          idx;
   int          base;
   int          bits;
   long_type    constant[MAX_WORDS_FOR_NUMERIC];
   int		count;
   int          digits_per_word;
   int          num_digits;
   int          num_words;
   long_type    result[MAX_WORDS_FOR_NUMERIC];
   char         tmpstr[80];
   int          type_idx;
   int          word;


   TRACE (Func_Entry, "convert_binary_literal", NULL);

   num_digits = TOKEN_LEN(token);

   digits_per_word = TARGET_BITS_PER_WORD;

   num_words = (num_digits + digits_per_word - 1) / digits_per_word;

   /* clear result array */
   for (i = 0; i < MAX_WORDS_FOR_NUMERIC; i++) {
      result[i] = 0; /* BRIANJ - Do we need a target value */
   }

   word = num_words - 1;
   idx  = num_digits - digits_per_word;

   while (word >= 0) {

      if (idx < 0) {
         count = digits_per_word + idx;
         idx = 0;
      }
      else {
         count = digits_per_word;
      }

      strncpy(tmpstr, &(const_buf[idx]), count);
      tmpstr[count] = '\0';

# ifdef _ARITH_INPUT_CONV
      base = 2;

      i    = AR_convert_str_to_int((AR_DATA *)constant,
                   (const AR_TYPE *)&input_arith_type[CG_INTEGER_DEFAULT_TYPE],
                                    &bits,
                      (const char *)tmpstr,
                       (const int *)&base);
      SHIFT_ARITH_RESULT(constant, CG_INTEGER_DEFAULT_TYPE);
      result[word] = constant[0];

# else
# if defined(_HOST32) && defined(_TARGET64)

      result[word] = (long_type) strtoull(tmpstr, (char **) NULL, 2);

# else

      result[word] = strtoul(tmpstr, (char **) NULL, 2);

# endif
# endif

      idx -= digits_per_word;
      word--;
   }

   CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX);
   TYP_TYPE(TYP_WORK_IDX)	= Typeless;
   TYP_LINEAR(TYP_WORK_IDX)	= Short_Typeless_Const;
   TYP_BIT_LEN(TYP_WORK_IDX)	= (num_words * TARGET_BITS_PER_WORD);
   type_idx			= ntr_type_tbl();

   if (is_boz) {
      TOKEN_CONST_TBL_IDX(token) = ntr_boz_const_tbl(type_idx,
                                                     result);
   }
   else {
      TOKEN_CONST_TBL_IDX(token) = ntr_boolean_const_tbl(type_idx,
                                                         result);
   }


   TRACE (Func_Exit, "convert_binary_literal", NULL);

   return;

}  /* convert_binary_literal */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	This routine takes a character string as input and, using the proper  *|
|*      input conversion routines, creates a fortran constant (a CN_Tbl_Idx)  *|
|*      It exists so that the frontend can create constants for values such   *|
|*      as HUGE without worrying about cross compile problems. The strings    *|
|*      must be proper 'c' numbers (like "1.7976931348623158e+308") and must  *|
|*      valid for the machine being targeted. Otherwise, an internal compiler *|
|*      error will be issued. At this time, ONLY INTEGER and REAL types are   *|
|*      supported.                                                            *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

int	cvrt_str_to_cn(char	*str,
		       int	type_idx)

{
   int		cn_idx;
   int		len;
   boolean	ok = TRUE;
   token_type	save_token;

   TRACE (Func_Entry, "cvrt_str_to_cn", NULL);

   save_token = token;

   strcpy(const_buf, str);
   len = strlen(str);

   switch (TYP_LINEAR(type_idx)) {
      case Integer_1 :
      case Integer_2 :
      case Integer_4 :
      case Integer_8 :
         CONVERT_INT_CONST(type_idx, len, ok);
         break;

      case Real_4 :
         CONVERT_REAL_CONST(type_idx, len, ok);
         break;

      case Real_8 :
# ifdef _TARGET64
         CONVERT_REAL_CONST(type_idx, len, ok);
# else
         CONVERT_DBL_CONST(type_idx, len, ok);
# endif
         break;

      case Real_16 :
         CONVERT_DBL_CONST(type_idx, len, ok);
         break;

      default :
         PRINTMSG(stmt_start_line, 1190, Internal, 0);
         break;
   }

   if (! ok) {
      PRINTMSG(stmt_start_line, 1190, Internal, 0);
   }

   cn_idx = TOKEN_CONST_TBL_IDX(token);

   token = save_token;

   TRACE (Func_Exit, "cvrt_str_to_cn", NULL);

   return(cn_idx);

}  /* cvrt_str_to_cn */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	<description>							      *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

void set_up_token_tables(void)

{
   int		i;
   int		len;

   TRACE (Func_Entry, "set_up_token_tables", NULL);

   /****************\
   |* dot_op table *|
   \****************/

   len = 0;

   while (dot_op[len].value != Tok_LAST) {
      len++;
   }

   len++;

   dot_op_len = malloc(sizeof(int) * len);

   for (i = 0; i < len; i++) {
      dot_op_len[i] = strlen(dot_op[i].name);
   }

   set_up_letter_idx_table(dot_op_idx, dot_op, len);
   
   /*************\
   |* kwd table *|
   \*************/

   len = 0;

   while (kwd[len].value != Tok_LAST) {
      len++;
   }

   len++;

   kwd_len = malloc(sizeof(int) * len);

   for (i = 0; i < len; i++) {
      kwd_len[i] = strlen(kwd[i].name);
   }

   set_up_letter_idx_table(kwd_idx, kwd, len);

   /* we do not do the alt_kwd here */

   /*****************\
   |* kwd_dir table *|
   \*****************/

   len = 0;

   while (kwd_dir[len].value != Tok_LAST) {
      len++;
   }

   len++;

   kwd_dir_len = malloc(sizeof(int) * len);

   for (i = 0; i < len; i++) {
      kwd_dir_len[i] = strlen(kwd_dir[i].name);
   }

   set_up_letter_idx_table(kwd_dir_idx, kwd_dir, len);

   /*****************\
   |* kwd_mic table *|
   \*****************/

   len = 0;

   while (kwd_mic[len].value != Tok_LAST) {
      len++;
   }

   len++;

   kwd_mic_len = malloc(sizeof(int) * len);

   for (i = 0; i < len; i++) {
      kwd_mic_len[i] = strlen(kwd_mic[i].name);
   }

   set_up_letter_idx_table(kwd_mic_idx, kwd_mic, len);

   /*********************\
   |* kwd_sgi_dir table *|
   \*********************/

   len = 0;

   while (kwd_sgi_dir[len].value != Tok_LAST) {
      len++;
   }

   len++;

   kwd_sgi_dir_len = malloc(sizeof(int) * len);

   for (i = 0; i < len; i++) {
      kwd_sgi_dir_len[i] = strlen(kwd_sgi_dir[i].name);
   }

   set_up_letter_idx_table(kwd_sgi_dir_idx, kwd_sgi_dir, len);

   /*************************\
   |* kwd_open_mp_dir table *|
   \*************************/

   len = 0;

   while (kwd_open_mp_dir[len].value != Tok_LAST) {
      len++;
   }

   len++;

   kwd_open_mp_dir_len = malloc(sizeof(int) * len);

   for (i = 0; i < len; i++) {
      kwd_open_mp_dir_len[i] = strlen(kwd_open_mp_dir[i].name);
   }

   set_up_letter_idx_table(kwd_open_mp_dir_idx, kwd_open_mp_dir, len);

# ifdef _DEBUG
   /*****************\
   |* kwd_dbg table *|
   \*****************/

   len = 0;

   while (kwd_dbg[len].value != Tok_LAST) {
      len++;
   }

   len++;

   kwd_dbg_len = malloc(sizeof(int) * len);

   for (i = 0; i < len; i++) {
      kwd_dbg_len[i] = strlen(kwd_dbg[i].name);
   }

   set_up_letter_idx_table(kwd_dbg_idx, kwd_dbg, len);


# endif

   TRACE (Func_Exit, "set_up_token_tables", NULL);

   return;

}  /* set_up_token_tables */

/******************************************************************************\
|*									      *|
|* Description:								      *|
|*	<description>							      *|
|*									      *|
|* Input parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Output parameters:							      *|
|*	NONE								      *|
|*									      *|
|* Returns:								      *|
|*	NOTHING								      *|
|*									      *|
\******************************************************************************/

static void set_up_letter_idx_table(int		*idx_tbl,
				    kwd_type	*kwd_tbl,
				    int		len)

{

   int	i;
   int	idx;
   int	k;

   TRACE (Func_Entry, "set_up_letter_idx_table", NULL);

   for (i = 0; i < 27; i++) {
      idx_tbl[i] = len - 1;
   }

   idx = -1;
   for (i = 0; i < len; i++) {
      if (kwd_tbl[i].name[0] - 'A' != idx) {
         for (k = idx+1; k <= kwd_tbl[i].name[0] - 'A'; k++) {
            idx_tbl[k] = i;
         }
         idx = kwd_tbl[i].name[0] - 'A';
      }
   }

# if 0
   printf("\t\t\t\t%3d,%4d,%4d,%4d,%4d,%4d,%4d,     /* A-G */\n",
          idx_tbl[0],idx_tbl[1],idx_tbl[2],idx_tbl[3],
          idx_tbl[4],idx_tbl[5],idx_tbl[6]);
   printf("\t\t\t\t%3d,%4d,%4d,%4d,%4d,%4d,%4d,     /* H-N */\n",
          idx_tbl[7],idx_tbl[8],idx_tbl[9],idx_tbl[10],
          idx_tbl[11],idx_tbl[12],idx_tbl[13]);
   printf("\t\t\t\t%3d,%4d,%4d,%4d,%4d,%4d,%4d,     /* O-U */\n",
          idx_tbl[14],idx_tbl[15],idx_tbl[16],idx_tbl[17],
          idx_tbl[18],idx_tbl[19],idx_tbl[20]);
   printf("\t\t\t\t%3d,%4d,%4d,%4d,%4d,               /* V-Z */\n",
          idx_tbl[21],idx_tbl[22],idx_tbl[23],idx_tbl[24],
          idx_tbl[25]);
   printf("\t\t\t\t%3d };                                 /* end */\n",
           idx_tbl[26]);
# endif


   TRACE (Func_Exit, "set_up_letter_idx_table", NULL);

   return;

}  /* set_up_letter_idx_table */
