[deliverable/binutils-gdb.git] / gdb / ada-lex.l

/* FLEX lexer for Ada expressions, for GDB.
   Copyright (C) 1994, 1997, 1998, 2000, 2001, 2002, 2003, 2007
   Free Software Foundation, Inc.

This file is part of GDB.

This program 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 of the License, or
(at your option) any later version.

This program 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 this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor,
Boston, MA 02110-1301, USA.  */

/*----------------------------------------------------------------------*/

/* The converted version of this file is to be included in ada-exp.y, */
/* the Ada parser for gdb.  The function yylex obtains characters from */
/* the global pointer lexptr.  It returns a syntactic category for */
/* each successive token and places a semantic value into yylval */
/* (ada-lval), defined by the parser.   */

DIG	[0-9]
NUM10	({DIG}({DIG}|_)*)
HEXDIG	[0-9a-f]
NUM16	({HEXDIG}({HEXDIG}|_)*)
OCTDIG	[0-7]
LETTER	[a-z_]
ID	({LETTER}({LETTER}|{DIG})*|"<"{LETTER}({LETTER}|{DIG})*">")
WHITE	[ \t\n]
TICK	("'"{WHITE}*)
GRAPHIC [a-z0-9 #&'()*+,-./:;<>=_|!$%?@\[\]\\^`{}~]
OPER    ([-+*/=<>&]|"<="|">="|"**"|"/="|"and"|"or"|"xor"|"not"|"mod"|"rem"|"abs")

EXP	(e[+-]{NUM10})
POSEXP  (e"+"?{NUM10})

%{

#define NUMERAL_WIDTH 256
#define LONGEST_SIGN ((ULONGEST) 1 << (sizeof(LONGEST) * HOST_CHAR_BIT - 1))

/* Temporary staging for numeric literals.  */
static char numbuf[NUMERAL_WIDTH];
 static void canonicalizeNumeral (char *s1, const char *);
static struct stoken processString (const char*, int);
static int processInt (const char *, const char *, const char *);
static int processReal (const char *);
static struct stoken processId (const char *, int);
static int processAttribute (const char *);
static int find_dot_all (const char *);

#undef YY_DECL
#define YY_DECL static int yylex ( void )

#undef YY_INPUT
#define YY_INPUT(BUF, RESULT, MAX_SIZE) \
    if ( *lexptr == '\000' ) \
      (RESULT) = YY_NULL; \
    else \
      { \
        *(BUF) = *lexptr; \
        (RESULT) = 1; \
	lexptr += 1; \
      }

static int find_dot_all (const char *);

%}

%option case-insensitive interactive nodefault

%s BEFORE_QUAL_QUOTE

%%

{WHITE}		 { }

"--".*		 { yyterminate(); }

{NUM10}{POSEXP}  {
		   canonicalizeNumeral (numbuf, yytext);
		   return processInt (NULL, numbuf, strrchr(numbuf, 'e')+1);
		 }

{NUM10}          {
		   canonicalizeNumeral (numbuf, yytext);
		   return processInt (NULL, numbuf, NULL);
		 }

{NUM10}"#"{HEXDIG}({HEXDIG}|_)*"#"{POSEXP} {
		   canonicalizeNumeral (numbuf, yytext);
    		   return processInt (numbuf,
				      strchr (numbuf, '#') + 1,
				      strrchr(numbuf, '#') + 1);
		 }

{NUM10}"#"{HEXDIG}({HEXDIG}|_)*"#" {
		   canonicalizeNumeral (numbuf, yytext);
    		   return processInt (numbuf, strchr (numbuf, '#') + 1, NULL);
		 }

"0x"{HEXDIG}+	{
		  canonicalizeNumeral (numbuf, yytext+2);
		  return processInt ("16#", numbuf, NULL);
		}


{NUM10}"."{NUM10}{EXP} {
		   canonicalizeNumeral (numbuf, yytext);
		   return processReal (numbuf);
		}

{NUM10}"."{NUM10} {
		   canonicalizeNumeral (numbuf, yytext);
		   return processReal (numbuf);
		}

{NUM10}"#"{NUM16}"."{NUM16}"#"{EXP} {
                   error (_("Based real literals not implemented yet."));
		}

{NUM10}"#"{NUM16}"."{NUM16}"#" {
                   error (_("Based real literals not implemented yet."));
		}

<INITIAL>"'"({GRAPHIC}|\")"'" {
		   yylval.typed_val.type = type_char ();
		   yylval.typed_val.val = yytext[1];
		   return CHARLIT;
		}

<INITIAL>"'[\""{HEXDIG}{2}"\"]'"   {
                   int v;
                   yylval.typed_val.type = type_char ();
		   sscanf (yytext+3, "%2x", &v);
		   yylval.typed_val.val = v;
		   return CHARLIT;
		}

\"({GRAPHIC}|"[\""({HEXDIG}{2}|\")"\"]")*\"   {
	           yylval.sval = processString (yytext+1, yyleng-2);
		   return STRING;
		}

\"              {
                   error (_("ill-formed or non-terminated string literal"));
		}


if		{
		  while (*lexptr != 'i' && *lexptr != 'I')
		    lexptr -= 1;
		  yyrestart(NULL);
		  return 0;
		}

	/* ADA KEYWORDS */

abs		{ return ABS; }
and		{ return _AND_; }
else		{ return ELSE; }
in		{ return IN; }
mod		{ return MOD; }
new		{ return NEW; }
not		{ return NOT; }
null		{ return NULL_PTR; }
or		{ return OR; }
others          { return OTHERS; }
rem		{ return REM; }
then		{ return THEN; }
xor		{ return XOR; }

        /* ATTRIBUTES */

{TICK}[a-zA-Z][a-zA-Z]+ { return processAttribute (yytext+1); }

	/* PUNCTUATION */

"=>"		{ return ARROW; }
".."		{ return DOTDOT; }
"**"		{ return STARSTAR; }
":="		{ return ASSIGN; }
"/="		{ return NOTEQUAL; }
"<="		{ return LEQ; }
">="		{ return GEQ; }

<BEFORE_QUAL_QUOTE>"'" { BEGIN INITIAL; return '\''; }

[-&*+./:<>=|;\[\]] { return yytext[0]; }

","		{ if (paren_depth == 0 && comma_terminates)
		    {
		      lexptr -= 1;
		      yyrestart(NULL);
		      return 0;
		    }
		  else
		    return ',';
		}

"("		{ paren_depth += 1; return '('; }
")"		{ if (paren_depth == 0)
		    {
		      lexptr -= 1;
		      yyrestart(NULL);
		      return 0;
		    }
		  else
 		    {
		      paren_depth -= 1;
		      return ')';
		    }
		}

"."{WHITE}*all  { return DOT_ALL; }

"."{WHITE}*{ID} {
	 	  yylval.sval = processId (yytext+1, yyleng-1);
	          return DOT_ID;
		}

{ID}({WHITE}*"."{WHITE}*({ID}|\"{OPER}\"))*(" "*"'")?  {
                  int all_posn = find_dot_all (yytext);

                  if (all_posn == -1 && yytext[yyleng-1] == '\'')
		    {
		      BEGIN BEFORE_QUAL_QUOTE;
		      yyless (yyleng-1);
		    }
                  else if (all_posn >= 0)
		    yyless (all_posn);
                  yylval.sval = processId (yytext, yyleng);
                  return NAME;
               }


	/* GDB EXPRESSION CONSTRUCTS  */

"'"[^']+"'"{WHITE}*:: {
                  yyless (yyleng - 2);
		  yylval.sval = processId (yytext, yyleng);
		  return NAME;
		}

"::"            { return COLONCOLON; }

[{}@]		{ return yytext[0]; }

	/* REGISTERS AND GDB CONVENIENCE VARIABLES */

"$"({LETTER}|{DIG}|"$")*  {
		  yylval.sval.ptr = yytext;
		  yylval.sval.length = yyleng;
		  return SPECIAL_VARIABLE;
		}

	/* CATCH-ALL ERROR CASE */

.		{ error (_("Invalid character '%s' in expression."), yytext); }
%%

#include <ctype.h>
#include "gdb_string.h"

/* Initialize the lexer for processing new expression. */

void
lexer_init (FILE *inp)
{
  BEGIN INITIAL;
  yyrestart (inp);
}


/* Copy S2 to S1, removing all underscores, and downcasing all letters.  */

static void
canonicalizeNumeral (char *s1, const char *s2)
{
  for (; *s2 != '\000'; s2 += 1)
    {
      if (*s2 != '_')
	{
	  *s1 = tolower(*s2);
	  s1 += 1;
	}
    }
  s1[0] = '\000';
}

/* Interprets the prefix of NUM that consists of digits of the given BASE
   as an integer of that BASE, with the string EXP as an exponent.
   Puts value in yylval, and returns INT, if the string is valid.  Causes
   an error if the number is improperly formated.   BASE, if NULL, defaults
   to "10", and EXP to "1".  The EXP does not contain a leading 'e' or 'E'.
 */

static int
processInt (const char *base0, const char *num0, const char *exp0)
{
  ULONGEST result;
  long exp;
  int base;

  char *trailer;

  if (base0 == NULL)
    base = 10;
  else
    {
      base = strtol (base0, (char **) NULL, 10);
      if (base < 2 || base > 16)
	error (_("Invalid base: %d."), base);
    }

  if (exp0 == NULL)
    exp = 0;
  else
    exp = strtol(exp0, (char **) NULL, 10);

  errno = 0;
  result = strtoulst (num0, (const char **) &trailer, base);
  if (errno == ERANGE)
    error (_("Integer literal out of range"));
  if (isxdigit(*trailer))
    error (_("Invalid digit `%c' in based literal"), *trailer);

  while (exp > 0)
    {
      if (result > (ULONG_MAX / base))
	error (_("Integer literal out of range"));
      result *= base;
      exp -= 1;
    }

  if ((result >> (TARGET_INT_BIT-1)) == 0)
    yylval.typed_val.type = type_int ();
  else if ((result >> (TARGET_LONG_BIT-1)) == 0)
    yylval.typed_val.type = type_long ();
  else if (((result >> (TARGET_LONG_BIT-1)) >> 1) == 0)
    {
      /* We have a number representable as an unsigned integer quantity.
         For consistency with the C treatment, we will treat it as an
	 anonymous modular (unsigned) quantity.  Alas, the types are such
	 that we need to store .val as a signed quantity.  Sorry
         for the mess, but C doesn't officially guarantee that a simple
         assignment does the trick (no, it doesn't; read the reference manual).
       */
      yylval.typed_val.type = builtin_type_unsigned_long;
      if (result & LONGEST_SIGN)
	yylval.typed_val.val =
	  (LONGEST) (result & ~LONGEST_SIGN)
	  - (LONGEST_SIGN>>1) - (LONGEST_SIGN>>1);
      else
	yylval.typed_val.val = (LONGEST) result;
      return INT;
    }
  else
    yylval.typed_val.type = type_long_long ();

  yylval.typed_val.val = (LONGEST) result;
  return INT;
}

static int
processReal (const char *num0)
{
  sscanf (num0, DOUBLEST_SCAN_FORMAT, &yylval.typed_val_float.dval);

  yylval.typed_val_float.type = type_float ();
  if (sizeof(DOUBLEST) >= TARGET_DOUBLE_BIT / TARGET_CHAR_BIT)
    yylval.typed_val_float.type = type_double ();
  if (sizeof(DOUBLEST) >= TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT)
    yylval.typed_val_float.type = type_long_double ();

  return FLOAT;
}


/* Store a canonicalized version of NAME0[0..LEN-1] in yylval.ssym.  The
   resulting string is valid until the next call to ada_parse.  It differs
   from NAME0 in that:
    + Characters between '...' or <...> are transfered verbatim to 
      yylval.ssym.
    + <, >, and trailing "'" characters in quoted sequences are removed
      (a leading quote is preserved to indicate that the name is not to be
      GNAT-encoded).
    + Unquoted whitespace is removed.
    + Unquoted alphabetic characters are mapped to lower case.
   Result is returned as a struct stoken, but for convenience, the string
   is also null-terminated.  Result string valid until the next call of
   ada_parse.
 */
static struct stoken
processId (const char *name0, int len)
{
  char *name = obstack_alloc (&temp_parse_space, len + 11);
  int i0, i;
  struct stoken result;

  while (len > 0 && isspace (name0[len-1]))
    len -= 1;
  i = i0 = 0;
  while (i0 < len)
    {
      if (isalnum (name0[i0]))
	{
	  name[i] = tolower (name0[i0]);
	  i += 1; i0 += 1;
	}
      else switch (name0[i0])
	{
	default:
	  name[i] = name0[i0];
	  i += 1; i0 += 1;
	  break;
	case ' ': case '\t':
	  i0 += 1;
	  break;
	case '\'':
	  do
	    {
	      name[i] = name0[i0];
	      i += 1; i0 += 1;
	    }
	  while (i0 < len && name0[i0] != '\'');
	  i0 += 1;
	  break;
	case '<':
	  i0 += 1;
	  while (i0 < len && name0[i0] != '>')
	    {
	      name[i] = name0[i0];
	      i += 1; i0 += 1;
	    }
	  i0 += 1;
	  break;
	}
    }
  name[i] = '\000';

  result.ptr = name;
  result.length = i;
  return result;
}

/* Return TEXT[0..LEN-1], a string literal without surrounding quotes,
   with special hex character notations replaced with characters. 
   Result valid until the next call to ada_parse.  */

static struct stoken
processString (const char *text, int len)
{
  const char *p;
  char *q;
  const char *lim = text + len;
  struct stoken result;

  q = result.ptr = obstack_alloc (&temp_parse_space, len);
  p = text;
  while (p < lim)
    {
      if (p[0] == '[' && p[1] == '"' && p+2 < lim)
         {
           if (p[2] == '"')  /* "...["""]... */
             {
               *q = '"';
	       p += 4;
	     }
           else
	     {
               int chr;
	       sscanf (p+2, "%2x", &chr);
	       *q = (char) chr;
	       p += 5;
	     }
         }
       else
         *q = *p;
       q += 1;
       p += 1;
     }
  result.length = q - result.ptr;
  return result;
}

/* Returns the position within STR of the '.' in a
   '.{WHITE}*all' component of a dotted name, or -1 if there is none.
   Note: we actually don't need this routine, since 'all' can never be an
   Ada identifier.  Thus, looking up foo.all or foo.all.x as a name
   must fail, and will eventually be interpreted as (foo).all or
   (foo).all.x.  However, this does avoid an extraneous lookup. */

static int
find_dot_all (const char *str)
{
  int i;
  for (i = 0; str[i] != '\000'; i += 1)
    {
      if (str[i] == '.')
	{
	  int i0 = i;
	  do
	    i += 1;
	  while (isspace (str[i]));
	  if (strncmp (str+i, "all", 3) == 0
	      && ! isalnum (str[i+3]) && str[i+3] != '_')
	    return i0;
	}
    }
  return -1;
}

/* Returns non-zero iff string SUBSEQ matches a subsequence of STR, ignoring
   case.  */

static int
subseqMatch (const char *subseq, const char *str)
{
  if (subseq[0] == '\0')
    return 1;
  else if (str[0] == '\0')
    return 0;
  else if (tolower (subseq[0]) == tolower (str[0]))
    return subseqMatch (subseq+1, str+1) || subseqMatch (subseq, str+1);
  else
    return subseqMatch (subseq, str+1);
}


static struct { const char *name; int code; }
attributes[] = {
  { "address", TICK_ADDRESS },
  { "unchecked_access", TICK_ACCESS },
  { "unrestricted_access", TICK_ACCESS },
  { "access", TICK_ACCESS },
  { "first", TICK_FIRST },
  { "last", TICK_LAST },
  { "length", TICK_LENGTH },
  { "max", TICK_MAX },
  { "min", TICK_MIN },
  { "modulus", TICK_MODULUS },
  { "pos", TICK_POS },
  { "range", TICK_RANGE },
  { "size", TICK_SIZE },
  { "tag", TICK_TAG },
  { "val", TICK_VAL },
  { NULL, -1 }
};

/* Return the syntactic code corresponding to the attribute name or
   abbreviation STR.  */

static int
processAttribute (const char *str)
{
  int i, k;

  for (i = 0; attributes[i].code != -1; i += 1)
    if (strcasecmp (str, attributes[i].name) == 0)
      return attributes[i].code;

  for (i = 0, k = -1; attributes[i].code != -1; i += 1)
    if (subseqMatch (str, attributes[i].name))
      {
	if (k == -1)
	  k = i;
	else
	  error (_("ambiguous attribute name: `%s'"), str);
      }
  if (k == -1)
    error (_("unrecognized attribute: `%s'"), str);

  return attributes[k].code;
}

int
yywrap(void)
{
  return 1;
}

/* Dummy definition to suppress warnings about unused static definitions. */
typedef void (*dummy_function) ();
dummy_function ada_flex_use[] = 
{ 
  (dummy_function) yyunput
};
Commit	Line	Data
	1	/* FLEX lexer for Ada expressions, for GDB.
	2	Copyright (C) 1994, 1997, 1998, 2000, 2001, 2002, 2003, 2007
	3	Free Software Foundation, Inc.
	4
	5	This file is part of GDB.
	6
	7	This program is free software; you can redistribute it and/or modify
	8	it under the terms of the GNU General Public License as published by
	9	the Free Software Foundation; either version 2 of the License, or
	10	(at your option) any later version.
	11
	12	This program is distributed in the hope that it will be useful,
	13	but WITHOUT ANY WARRANTY; without even the implied warranty of
	14	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	15	GNU General Public License for more details.
	16
	17	You should have received a copy of the GNU General Public License
	18	along with this program; if not, write to the Free Software
	19	Foundation, Inc., 51 Franklin Street, Fifth Floor,
	20	Boston, MA 02110-1301, USA. */
	21
	22	/----------------------------------------------------------------------/
	23
	24	/* The converted version of this file is to be included in ada-exp.y, */
	25	/* the Ada parser for gdb. The function yylex obtains characters from */
	26	/* the global pointer lexptr. It returns a syntactic category for */
	27	/* each successive token and places a semantic value into yylval */
	28	/* (ada-lval), defined by the parser. */
	29
	30	DIG [0-9]
	31	NUM10 ({DIG}({DIG}\|_)*)
	32	HEXDIG [0-9a-f]
	33	NUM16 ({HEXDIG}({HEXDIG}\|_)*)
	34	OCTDIG [0-7]
	35	LETTER [a-z_]
	36	ID ({LETTER}({LETTER}\|{DIG})\|"<"{LETTER}({LETTER}\|{DIG})">")
	37	WHITE [ \t\n]
	38	TICK ("'"{WHITE}*)
	39	GRAPHIC [a-z0-9 #&'()*+,-./:;<>=_\|!$%?@\[\]\\^`{}~]
	40	OPER ([-+/=<>&]\|"<="\|">="\|"*"\|"/="\|"and"\|"or"\|"xor"\|"not"\|"mod"\|"rem"\|"abs")
	41
	42	EXP (e[+-]{NUM10})
	43	POSEXP (e"+"?{NUM10})
	44
	45	%{
	46
	47	#define NUMERAL_WIDTH 256
	48	#define LONGEST_SIGN ((ULONGEST) 1 << (sizeof(LONGEST) * HOST_CHAR_BIT - 1))
	49
	50	/* Temporary staging for numeric literals. */
	51	static char numbuf[NUMERAL_WIDTH];
	52	static void canonicalizeNumeral (char s1, const char );
	53	static struct stoken processString (const char*, int);
	54	static int processInt (const char , const char , const char *);
	55	static int processReal (const char *);
	56	static struct stoken processId (const char *, int);
	57	static int processAttribute (const char *);
	58	static int find_dot_all (const char *);
	59
	60	#undef YY_DECL
	61	#define YY_DECL static int yylex ( void )
	62
	63	#undef YY_INPUT
	64	#define YY_INPUT(BUF, RESULT, MAX_SIZE) \
	65	if ( *lexptr == '\000' ) \
	66	(RESULT) = YY_NULL; \
	67	else \
	68	{ \
	69	(BUF) = lexptr; \
	70	(RESULT) = 1; \
	71	lexptr += 1; \
	72	}
	73
	74	static int find_dot_all (const char *);
	75
	76	%}
	77
	78	%option case-insensitive interactive nodefault
	79
	80	%s BEFORE_QUAL_QUOTE
	81
	82	%%
	83
	84	{WHITE} { }
	85
	86	"--".* { yyterminate(); }
	87
	88	{NUM10}{POSEXP} {
	89	canonicalizeNumeral (numbuf, yytext);
	90	return processInt (NULL, numbuf, strrchr(numbuf, 'e')+1);
	91	}
	92
	93	{NUM10} {
	94	canonicalizeNumeral (numbuf, yytext);
	95	return processInt (NULL, numbuf, NULL);
	96	}
	97
	98	{NUM10}"#"{HEXDIG}({HEXDIG}\|_)*"#"{POSEXP} {
	99	canonicalizeNumeral (numbuf, yytext);
	100	return processInt (numbuf,
	101	strchr (numbuf, '#') + 1,
	102	strrchr(numbuf, '#') + 1);
	103	}
	104
	105	{NUM10}"#"{HEXDIG}({HEXDIG}\|_)*"#" {
	106	canonicalizeNumeral (numbuf, yytext);
	107	return processInt (numbuf, strchr (numbuf, '#') + 1, NULL);
	108	}
	109
	110	"0x"{HEXDIG}+ {
	111	canonicalizeNumeral (numbuf, yytext+2);
	112	return processInt ("16#", numbuf, NULL);
	113	}
	114
	115
	116	{NUM10}"."{NUM10}{EXP} {
	117	canonicalizeNumeral (numbuf, yytext);
	118	return processReal (numbuf);
	119	}
	120
	121	{NUM10}"."{NUM10} {
	122	canonicalizeNumeral (numbuf, yytext);
	123	return processReal (numbuf);
	124	}
	125
	126	{NUM10}"#"{NUM16}"."{NUM16}"#"{EXP} {
	127	error (_("Based real literals not implemented yet."));
	128	}
	129
	130	{NUM10}"#"{NUM16}"."{NUM16}"#" {
	131	error (_("Based real literals not implemented yet."));
	132	}
	133
	134	<INITIAL>"'"({GRAPHIC}\|\")"'" {
	135	yylval.typed_val.type = type_char ();
	136	yylval.typed_val.val = yytext[1];
	137	return CHARLIT;
	138	}
	139
	140	<INITIAL>"'[\""{HEXDIG}{2}"\"]'" {
	141	int v;
	142	yylval.typed_val.type = type_char ();
	143	sscanf (yytext+3, "%2x", &v);
	144	yylval.typed_val.val = v;
	145	return CHARLIT;
	146	}
	147
	148	\"({GRAPHIC}\|"[\""({HEXDIG}{2}\|\")"\"]")*\" {
	149	yylval.sval = processString (yytext+1, yyleng-2);
	150	return STRING;
	151	}
	152
	153	\" {
	154	error (_("ill-formed or non-terminated string literal"));
	155	}
	156
	157
	158	if {
	159	while (lexptr != 'i' && lexptr != 'I')
	160	lexptr -= 1;
	161	yyrestart(NULL);
	162	return 0;
	163	}
	164
	165	/* ADA KEYWORDS */
	166
	167	abs { return ABS; }
	168	and { return _AND_; }
	169	else { return ELSE; }
	170	in { return IN; }
	171	mod { return MOD; }
	172	new { return NEW; }
	173	not { return NOT; }
	174	null { return NULL_PTR; }
	175	or { return OR; }
	176	others { return OTHERS; }
	177	rem { return REM; }
	178	then { return THEN; }
	179	xor { return XOR; }
	180
	181	/* ATTRIBUTES */
	182
	183	{TICK}[a-zA-Z][a-zA-Z]+ { return processAttribute (yytext+1); }
	184
	185	/* PUNCTUATION */
	186
	187	"=>" { return ARROW; }
	188	".." { return DOTDOT; }
	189	"**" { return STARSTAR; }
	190	":=" { return ASSIGN; }
	191	"/=" { return NOTEQUAL; }
	192	"<=" { return LEQ; }
	193	">=" { return GEQ; }
	194
	195	<BEFORE_QUAL_QUOTE>"'" { BEGIN INITIAL; return '\''; }
	196
	197	[-&*+./:<>=\|;\[\]] { return yytext[0]; }
	198
	199	"," { if (paren_depth == 0 && comma_terminates)
	200	{
	201	lexptr -= 1;
	202	yyrestart(NULL);
	203	return 0;
	204	}
	205	else
	206	return ',';
	207	}
	208
	209	"(" { paren_depth += 1; return '('; }
	210	")" { if (paren_depth == 0)
	211	{
	212	lexptr -= 1;
	213	yyrestart(NULL);
	214	return 0;
	215	}
	216	else
	217	{
	218	paren_depth -= 1;
	219	return ')';
	220	}
	221	}
	222
	223	"."{WHITE}*all { return DOT_ALL; }
	224
	225	"."{WHITE}*{ID} {
	226	yylval.sval = processId (yytext+1, yyleng-1);
	227	return DOT_ID;
	228	}
	229
	230	{ID}({WHITE}"."{WHITE}({ID}\|\"{OPER}\"))(" ""'")? {
	231	int all_posn = find_dot_all (yytext);
	232
	233	if (all_posn == -1 && yytext[yyleng-1] == '\'')
	234	{
	235	BEGIN BEFORE_QUAL_QUOTE;
	236	yyless (yyleng-1);
	237	}
	238	else if (all_posn >= 0)
	239	yyless (all_posn);
	240	yylval.sval = processId (yytext, yyleng);
	241	return NAME;
	242	}
	243
	244
	245	/* GDB EXPRESSION CONSTRUCTS */
	246
	247	"'"[^']+"'"{WHITE}*:: {
	248	yyless (yyleng - 2);
	249	yylval.sval = processId (yytext, yyleng);
	250	return NAME;
	251	}
	252
	253	"::" { return COLONCOLON; }
	254
	255	[{}@] { return yytext[0]; }
	256
	257	/* REGISTERS AND GDB CONVENIENCE VARIABLES */
	258
	259	"$"({LETTER}\|{DIG}\|"$")* {
	260	yylval.sval.ptr = yytext;
	261	yylval.sval.length = yyleng;
	262	return SPECIAL_VARIABLE;
	263	}
	264
	265	/* CATCH-ALL ERROR CASE */
	266
	267	. { error (_("Invalid character '%s' in expression."), yytext); }
	268	%%
	269
	270	#include <ctype.h>
	271	#include "gdb_string.h"
	272
	273	/* Initialize the lexer for processing new expression. */
	274
	275	void
	276	lexer_init (FILE *inp)
	277	{
	278	BEGIN INITIAL;
	279	yyrestart (inp);
	280	}
	281
	282
	283	/* Copy S2 to S1, removing all underscores, and downcasing all letters. */
	284
	285	static void
	286	canonicalizeNumeral (char s1, const char s2)
	287	{
	288	for (; *s2 != '\000'; s2 += 1)
	289	{
	290	if (*s2 != '_')
	291	{
	292	s1 = tolower(s2);
	293	s1 += 1;
	294	}
	295	}
	296	s1[0] = '\000';
	297	}
	298
	299	/* Interprets the prefix of NUM that consists of digits of the given BASE
	300	as an integer of that BASE, with the string EXP as an exponent.
	301	Puts value in yylval, and returns INT, if the string is valid. Causes
	302	an error if the number is improperly formated. BASE, if NULL, defaults
	303	to "10", and EXP to "1". The EXP does not contain a leading 'e' or 'E'.
	304	*/
	305
	306	static int
	307	processInt (const char base0, const char num0, const char *exp0)
	308	{
	309	ULONGEST result;
	310	long exp;
	311	int base;
	312
	313	char *trailer;
	314
	315	if (base0 == NULL)
	316	base = 10;
	317	else
	318	{
	319	base = strtol (base0, (char **) NULL, 10);
	320	if (base < 2 \|\| base > 16)
	321	error (_("Invalid base: %d."), base);
	322	}
	323
	324	if (exp0 == NULL)
	325	exp = 0;
	326	else
	327	exp = strtol(exp0, (char **) NULL, 10);
	328
	329	errno = 0;
	330	result = strtoulst (num0, (const char **) &trailer, base);
	331	if (errno == ERANGE)
	332	error (_("Integer literal out of range"));
	333	if (isxdigit(*trailer))
	334	error (_("Invalid digit `%c' in based literal"), *trailer);
	335
	336	while (exp > 0)
	337	{
	338	if (result > (ULONG_MAX / base))
	339	error (_("Integer literal out of range"));
	340	result *= base;
	341	exp -= 1;
	342	}
	343
	344	if ((result >> (TARGET_INT_BIT-1)) == 0)
	345	yylval.typed_val.type = type_int ();
	346	else if ((result >> (TARGET_LONG_BIT-1)) == 0)
	347	yylval.typed_val.type = type_long ();
	348	else if (((result >> (TARGET_LONG_BIT-1)) >> 1) == 0)
	349	{
	350	/* We have a number representable as an unsigned integer quantity.
	351	For consistency with the C treatment, we will treat it as an
	352	anonymous modular (unsigned) quantity. Alas, the types are such
	353	that we need to store .val as a signed quantity. Sorry
	354	for the mess, but C doesn't officially guarantee that a simple
	355	assignment does the trick (no, it doesn't; read the reference manual).
	356	*/
	357	yylval.typed_val.type = builtin_type_unsigned_long;
	358	if (result & LONGEST_SIGN)
	359	yylval.typed_val.val =
	360	(LONGEST) (result & ~LONGEST_SIGN)
	361	- (LONGEST_SIGN>>1) - (LONGEST_SIGN>>1);
	362	else
	363	yylval.typed_val.val = (LONGEST) result;
	364	return INT;
	365	}
	366	else
	367	yylval.typed_val.type = type_long_long ();
	368
	369	yylval.typed_val.val = (LONGEST) result;
	370	return INT;
	371	}
	372
	373	static int
	374	processReal (const char *num0)
	375	{
	376	sscanf (num0, DOUBLEST_SCAN_FORMAT, &yylval.typed_val_float.dval);
	377
	378	yylval.typed_val_float.type = type_float ();
	379	if (sizeof(DOUBLEST) >= TARGET_DOUBLE_BIT / TARGET_CHAR_BIT)
	380	yylval.typed_val_float.type = type_double ();
	381	if (sizeof(DOUBLEST) >= TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT)
	382	yylval.typed_val_float.type = type_long_double ();
	383
	384	return FLOAT;
	385	}
	386
	387
	388	/* Store a canonicalized version of NAME0[0..LEN-1] in yylval.ssym. The
	389	resulting string is valid until the next call to ada_parse. It differs
	390	from NAME0 in that:
	391	+ Characters between '...' or <...> are transfered verbatim to
	392	yylval.ssym.
	393	+ <, >, and trailing "'" characters in quoted sequences are removed
	394	(a leading quote is preserved to indicate that the name is not to be
	395	GNAT-encoded).
	396	+ Unquoted whitespace is removed.
	397	+ Unquoted alphabetic characters are mapped to lower case.
	398	Result is returned as a struct stoken, but for convenience, the string
	399	is also null-terminated. Result string valid until the next call of
	400	ada_parse.
	401	*/
	402	static struct stoken
	403	processId (const char *name0, int len)
	404	{
	405	char *name = obstack_alloc (&temp_parse_space, len + 11);
	406	int i0, i;
	407	struct stoken result;
	408
	409	while (len > 0 && isspace (name0[len-1]))
	410	len -= 1;
	411	i = i0 = 0;
	412	while (i0 < len)
	413	{
	414	if (isalnum (name0[i0]))
	415	{
	416	name[i] = tolower (name0[i0]);
	417	i += 1; i0 += 1;
	418	}
	419	else switch (name0[i0])
	420	{
	421	default:
	422	name[i] = name0[i0];
	423	i += 1; i0 += 1;
	424	break;
	425	case ' ': case '\t':
	426	i0 += 1;
	427	break;
	428	case '\'':
	429	do
	430	{
	431	name[i] = name0[i0];
	432	i += 1; i0 += 1;
	433	}
	434	while (i0 < len && name0[i0] != '\'');
	435	i0 += 1;
	436	break;
	437	case '<':
	438	i0 += 1;
	439	while (i0 < len && name0[i0] != '>')
	440	{
	441	name[i] = name0[i0];
	442	i += 1; i0 += 1;
	443	}
	444	i0 += 1;
	445	break;
	446	}
	447	}
	448	name[i] = '\000';
	449
	450	result.ptr = name;
	451	result.length = i;
	452	return result;
	453	}
	454
	455	/* Return TEXT[0..LEN-1], a string literal without surrounding quotes,
	456	with special hex character notations replaced with characters.
	457	Result valid until the next call to ada_parse. */
	458
	459	static struct stoken
	460	processString (const char *text, int len)
	461	{
	462	const char *p;
	463	char *q;
	464	const char *lim = text + len;
	465	struct stoken result;
	466
	467	q = result.ptr = obstack_alloc (&temp_parse_space, len);
	468	p = text;
	469	while (p < lim)
	470	{
	471	if (p[0] == '[' && p[1] == '"' && p+2 < lim)
	472	{
	473	if (p[2] == '"') /* "...["""]... */
	474	{
	475	*q = '"';
	476	p += 4;
	477	}
	478	else
	479	{
	480	int chr;
	481	sscanf (p+2, "%2x", &chr);
	482	*q = (char) chr;
	483	p += 5;
	484	}
	485	}
	486	else
	487	q = p;
	488	q += 1;
	489	p += 1;
	490	}
	491	result.length = q - result.ptr;
	492	return result;
	493	}
	494
	495	/* Returns the position within STR of the '.' in a
	496	'.{WHITE}*all' component of a dotted name, or -1 if there is none.
	497	Note: we actually don't need this routine, since 'all' can never be an
	498	Ada identifier. Thus, looking up foo.all or foo.all.x as a name
	499	must fail, and will eventually be interpreted as (foo).all or
	500	(foo).all.x. However, this does avoid an extraneous lookup. */
	501
	502	static int
	503	find_dot_all (const char *str)
	504	{
	505	int i;
	506	for (i = 0; str[i] != '\000'; i += 1)
	507	{
	508	if (str[i] == '.')
	509	{
	510	int i0 = i;
	511	do
	512	i += 1;
	513	while (isspace (str[i]));
	514	if (strncmp (str+i, "all", 3) == 0
	515	&& ! isalnum (str[i+3]) && str[i+3] != '_')
	516	return i0;
	517	}
	518	}
	519	return -1;
	520	}
	521
	522	/* Returns non-zero iff string SUBSEQ matches a subsequence of STR, ignoring
	523	case. */
	524
	525	static int
	526	subseqMatch (const char subseq, const char str)
	527	{
	528	if (subseq[0] == '\0')
	529	return 1;
	530	else if (str[0] == '\0')
	531	return 0;
	532	else if (tolower (subseq[0]) == tolower (str[0]))
	533	return subseqMatch (subseq+1, str+1) \|\| subseqMatch (subseq, str+1);
	534	else
	535	return subseqMatch (subseq, str+1);
	536	}
	537
	538
	539	static struct { const char *name; int code; }
	540	attributes[] = {
	541	{ "address", TICK_ADDRESS },
	542	{ "unchecked_access", TICK_ACCESS },
	543	{ "unrestricted_access", TICK_ACCESS },
	544	{ "access", TICK_ACCESS },
	545	{ "first", TICK_FIRST },
	546	{ "last", TICK_LAST },
	547	{ "length", TICK_LENGTH },
	548	{ "max", TICK_MAX },
	549	{ "min", TICK_MIN },
	550	{ "modulus", TICK_MODULUS },
	551	{ "pos", TICK_POS },
	552	{ "range", TICK_RANGE },
	553	{ "size", TICK_SIZE },
	554	{ "tag", TICK_TAG },
	555	{ "val", TICK_VAL },
	556	{ NULL, -1 }
	557	};
	558
	559	/* Return the syntactic code corresponding to the attribute name or
	560	abbreviation STR. */
	561
	562	static int
	563	processAttribute (const char *str)
	564	{
	565	int i, k;
	566
	567	for (i = 0; attributes[i].code != -1; i += 1)
	568	if (strcasecmp (str, attributes[i].name) == 0)
	569	return attributes[i].code;
	570
	571	for (i = 0, k = -1; attributes[i].code != -1; i += 1)
	572	if (subseqMatch (str, attributes[i].name))
	573	{
	574	if (k == -1)
	575	k = i;
	576	else
	577	error (_("ambiguous attribute name: `%s'"), str);
	578	}
	579	if (k == -1)
	580	error (_("unrecognized attribute: `%s'"), str);
	581
	582	return attributes[k].code;
	583	}
	584
	585	int
	586	yywrap(void)
	587	{
	588	return 1;
	589	}
	590
	591	/* Dummy definition to suppress warnings about unused static definitions. */
	592	typedef void (*dummy_function) ();
	593	dummy_function ada_flex_use[] =
	594	{
	595	(dummy_function) yyunput
	596	};