* doublest.h: Conditionalize DOUBLEST on PRINTF_HAS_LONG_DOUBLE
[external/binutils.git] / gdb / ada-lex.l
1 /* FLEX lexer for Ada expressions, for GDB.
2    Copyright (C) 1994, 1997, 1998, 2000, 2001, 2002, 2003
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 #define HIGH_BYTE_POSN ((sizeof (ULONGEST) - 1) * HOST_CHAR_BIT)
300
301 /* True (non-zero) iff DIGIT is a valid digit in radix BASE,
302    where 2 <= BASE <= 16.  */
303
304 static int
305 is_digit_in_base (unsigned char digit, int base)
306 {
307   if (!isxdigit (digit))
308     return 0;
309   if (base <= 10)
310     return (isdigit (digit) && digit < base + '0');
311   else
312     return (isdigit (digit) || tolower (digit) < base - 10 + 'a');
313 }
314
315 static int
316 digit_to_int (unsigned char c)
317 {
318   if (isdigit (c))
319     return c - '0';
320   else
321     return tolower (c) - 'a' + 10;
322 }
323
324 /* As for strtoul, but for ULONGEST results.  */
325
326 ULONGEST
327 strtoulst (const char *num, const char **trailer, int base)
328 {
329   unsigned int high_part;
330   ULONGEST result;
331   int i;
332   unsigned char lim;
333
334   if (base < 2 || base > 16)
335     {
336       errno = EINVAL;
337       return 0;
338     }
339   lim = base - 1 + '0';
340
341   result = high_part = 0;
342   for (i = 0; is_digit_in_base (num[i], base); i += 1)
343     {
344       result = result*base + digit_to_int (num[i]);
345       high_part = high_part*base + (unsigned int) (result >> HIGH_BYTE_POSN);
346       result &= ((ULONGEST) 1 << HIGH_BYTE_POSN) - 1;
347       if (high_part > 0xff)
348         {
349           errno = ERANGE;
350           result = high_part = 0;
351           break;
352         }
353     }
354
355   if (trailer != NULL)
356     *trailer = &num[i];
357
358   return result + ((ULONGEST) high_part << HIGH_BYTE_POSN);
359 }
360
361 /* Interprets the prefix of NUM that consists of digits of the given BASE
362    as an integer of that BASE, with the string EXP as an exponent.
363    Puts value in yylval, and returns INT, if the string is valid.  Causes
364    an error if the number is improperly formated.   BASE, if NULL, defaults
365    to "10", and EXP to "1".  The EXP does not contain a leading 'e' or 'E'.
366  */
367
368 static int
369 processInt (const char *base0, const char *num0, const char *exp0)
370 {
371   ULONGEST result;
372   long exp;
373   int base;
374
375   char *trailer;
376
377   if (base0 == NULL)
378     base = 10;
379   else
380     {
381       base = strtol (base0, (char **) NULL, 10);
382       if (base < 2 || base > 16)
383         error (_("Invalid base: %d."), base);
384     }
385
386   if (exp0 == NULL)
387     exp = 0;
388   else
389     exp = strtol(exp0, (char **) NULL, 10);
390
391   errno = 0;
392   result = strtoulst (num0, (const char **) &trailer, base);
393   if (errno == ERANGE)
394     error (_("Integer literal out of range"));
395   if (isxdigit(*trailer))
396     error (_("Invalid digit `%c' in based literal"), *trailer);
397
398   while (exp > 0)
399     {
400       if (result > (ULONG_MAX / base))
401         error (_("Integer literal out of range"));
402       result *= base;
403       exp -= 1;
404     }
405
406   if ((result >> (TARGET_INT_BIT-1)) == 0)
407     yylval.typed_val.type = type_int ();
408   else if ((result >> (TARGET_LONG_BIT-1)) == 0)
409     yylval.typed_val.type = type_long ();
410   else if (((result >> (TARGET_LONG_BIT-1)) >> 1) == 0)
411     {
412       /* We have a number representable as an unsigned integer quantity.
413          For consistency with the C treatment, we will treat it as an
414          anonymous modular (unsigned) quantity.  Alas, the types are such
415          that we need to store .val as a signed quantity.  Sorry
416          for the mess, but C doesn't officially guarantee that a simple
417          assignment does the trick (no, it doesn't; read the reference manual).
418        */
419       yylval.typed_val.type = builtin_type_unsigned_long;
420       if (result & LONGEST_SIGN)
421         yylval.typed_val.val =
422           (LONGEST) (result & ~LONGEST_SIGN)
423           - (LONGEST_SIGN>>1) - (LONGEST_SIGN>>1);
424       else
425         yylval.typed_val.val = (LONGEST) result;
426       return INT;
427     }
428   else
429     yylval.typed_val.type = type_long_long ();
430
431   yylval.typed_val.val = (LONGEST) result;
432   return INT;
433 }
434
435 static int
436 processReal (const char *num0)
437 {
438   sscanf (num0, DOUBLEST_SCAN_FORMAT, &yylval.typed_val_float.dval);
439
440   yylval.typed_val_float.type = type_float ();
441   if (sizeof(DOUBLEST) >= TARGET_DOUBLE_BIT / TARGET_CHAR_BIT)
442     yylval.typed_val_float.type = type_double ();
443   if (sizeof(DOUBLEST) >= TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT)
444     yylval.typed_val_float.type = type_long_double ();
445
446   return FLOAT;
447 }
448
449
450 /* Store a canonicalized version of NAME0[0..LEN-1] in yylval.ssym.  The
451    resulting string is valid until the next call to ada_parse.  It differs
452    from NAME0 in that:
453     + Characters between '...' or <...> are transfered verbatim to 
454       yylval.ssym.
455     + <, >, and trailing "'" characters in quoted sequences are removed
456       (a leading quote is preserved to indicate that the name is not to be
457       GNAT-encoded).
458     + Unquoted whitespace is removed.
459     + Unquoted alphabetic characters are mapped to lower case.
460    Result is returned as a struct stoken, but for convenience, the string
461    is also null-terminated.  Result string valid until the next call of
462    ada_parse.
463  */
464 static struct stoken
465 processId (const char *name0, int len)
466 {
467   char *name = obstack_alloc (&temp_parse_space, len + 11);
468   int i0, i;
469   struct stoken result;
470
471   while (len > 0 && isspace (name0[len-1]))
472     len -= 1;
473   i = i0 = 0;
474   while (i0 < len)
475     {
476       if (isalnum (name0[i0]))
477         {
478           name[i] = tolower (name0[i0]);
479           i += 1; i0 += 1;
480         }
481       else switch (name0[i0])
482         {
483         default:
484           name[i] = name0[i0];
485           i += 1; i0 += 1;
486           break;
487         case ' ': case '\t':
488           i0 += 1;
489           break;
490         case '\'':
491           do
492             {
493               name[i] = name0[i0];
494               i += 1; i0 += 1;
495             }
496           while (i0 < len && name0[i0] != '\'');
497           i0 += 1;
498           break;
499         case '<':
500           i0 += 1;
501           while (i0 < len && name0[i0] != '>')
502             {
503               name[i] = name0[i0];
504               i += 1; i0 += 1;
505             }
506           i0 += 1;
507           break;
508         }
509     }
510   name[i] = '\000';
511
512   result.ptr = name;
513   result.length = i;
514   return result;
515 }
516
517 /* Return TEXT[0..LEN-1], a string literal without surrounding quotes,
518    with special hex character notations replaced with characters. 
519    Result valid until the next call to ada_parse.  */
520
521 static struct stoken
522 processString (const char *text, int len)
523 {
524   const char *p;
525   char *q;
526   const char *lim = text + len;
527   struct stoken result;
528
529   q = result.ptr = obstack_alloc (&temp_parse_space, len);
530   p = text;
531   while (p < lim)
532     {
533       if (p[0] == '[' && p[1] == '"' && p+2 < lim)
534          {
535            if (p[2] == '"')  /* "...["""]... */
536              {
537                *q = '"';
538                p += 4;
539              }
540            else
541              {
542                int chr;
543                sscanf (p+2, "%2x", &chr);
544                *q = (char) chr;
545                p += 5;
546              }
547          }
548        else
549          *q = *p;
550        q += 1;
551        p += 1;
552      }
553   result.length = q - result.ptr;
554   return result;
555 }
556
557 /* Returns the position within STR of the '.' in a
558    '.{WHITE}*all' component of a dotted name, or -1 if there is none.
559    Note: we actually don't need this routine, since 'all' can never be an
560    Ada identifier.  Thus, looking up foo.all or foo.all.x as a name
561    must fail, and will eventually be interpreted as (foo).all or
562    (foo).all.x.  However, this does avoid an extraneous lookup. */
563
564 static int
565 find_dot_all (const char *str)
566 {
567   int i;
568   for (i = 0; str[i] != '\000'; i += 1)
569     {
570       if (str[i] == '.')
571         {
572           int i0 = i;
573           do
574             i += 1;
575           while (isspace (str[i]));
576           if (strncmp (str+i, "all", 3) == 0
577               && ! isalnum (str[i+3]) && str[i+3] != '_')
578             return i0;
579         }
580     }
581   return -1;
582 }
583
584 /* Returns non-zero iff string SUBSEQ matches a subsequence of STR, ignoring
585    case.  */
586
587 static int
588 subseqMatch (const char *subseq, const char *str)
589 {
590   if (subseq[0] == '\0')
591     return 1;
592   else if (str[0] == '\0')
593     return 0;
594   else if (tolower (subseq[0]) == tolower (str[0]))
595     return subseqMatch (subseq+1, str+1) || subseqMatch (subseq, str+1);
596   else
597     return subseqMatch (subseq, str+1);
598 }
599
600
601 static struct { const char *name; int code; }
602 attributes[] = {
603   { "address", TICK_ADDRESS },
604   { "unchecked_access", TICK_ACCESS },
605   { "unrestricted_access", TICK_ACCESS },
606   { "access", TICK_ACCESS },
607   { "first", TICK_FIRST },
608   { "last", TICK_LAST },
609   { "length", TICK_LENGTH },
610   { "max", TICK_MAX },
611   { "min", TICK_MIN },
612   { "modulus", TICK_MODULUS },
613   { "pos", TICK_POS },
614   { "range", TICK_RANGE },
615   { "size", TICK_SIZE },
616   { "tag", TICK_TAG },
617   { "val", TICK_VAL },
618   { NULL, -1 }
619 };
620
621 /* Return the syntactic code corresponding to the attribute name or
622    abbreviation STR.  */
623
624 static int
625 processAttribute (const char *str)
626 {
627   int i, k;
628
629   for (i = 0; attributes[i].code != -1; i += 1)
630     if (strcasecmp (str, attributes[i].name) == 0)
631       return attributes[i].code;
632
633   for (i = 0, k = -1; attributes[i].code != -1; i += 1)
634     if (subseqMatch (str, attributes[i].name))
635       {
636         if (k == -1)
637           k = i;
638         else
639           error (_("ambiguous attribute name: `%s'"), str);
640       }
641   if (k == -1)
642     error (_("unrecognized attribute: `%s'"), str);
643
644   return attributes[k].code;
645 }
646
647 int
648 yywrap(void)
649 {
650   return 1;
651 }
652
653 /* Dummy definition to suppress warnings about unused static definitions. */
654 typedef void (*dummy_function) ();
655 dummy_function ada_flex_use[] = 
656
657   (dummy_function) yyunput
658 };