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