* p-exp.y (parse_number): Avoid shift overflow when ``long''.
[deliverable/binutils-gdb.git] / gdb / p-exp.y
1 /* YACC parser for Pascal expressions, for GDB.
2 Copyright 2000
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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
20
21 /* This file is derived from c-exp.y */
22
23 /* Parse a Pascal expression from text in a string,
24 and return the result as a struct expression pointer.
25 That structure contains arithmetic operations in reverse polish,
26 with constants represented by operations that are followed by special data.
27 See expression.h for the details of the format.
28 What is important here is that it can be built up sequentially
29 during the process of parsing; the lower levels of the tree always
30 come first in the result.
31
32 Note that malloc's and realloc's in this file are transformed to
33 xmalloc and xrealloc respectively by the same sed command in the
34 makefile that remaps any other malloc/realloc inserted by the parser
35 generator. Doing this with #defines and trying to control the interaction
36 with include files (<malloc.h> and <stdlib.h> for example) just became
37 too messy, particularly when such includes can be inserted at random
38 times by the parser generator. */
39
40 /* FIXME: there are still 21 shift/reduce conflicts
41 Other known bugs or limitations:
42 - pascal string operations are not supported at all.
43 - there are some problems with boolean types.
44 - Pascal type hexadecimal constants are not supported
45 because they conflict with the internal variables format.
46 Probably also lots of other problems, less well defined PM */
47 %{
48
49 #include "defs.h"
50 #include "gdb_string.h"
51 #include <ctype.h>
52 #include "expression.h"
53 #include "value.h"
54 #include "parser-defs.h"
55 #include "language.h"
56 #include "p-lang.h"
57 #include "bfd.h" /* Required by objfiles.h. */
58 #include "symfile.h" /* Required by objfiles.h. */
59 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
60
61 /* MSVC uses strnicmp instead of strncasecmp */
62 #ifdef _MSC_VER
63 #define strncasecmp strnicmp
64 #endif
65
66 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
67 as well as gratuitiously global symbol names, so we can have multiple
68 yacc generated parsers in gdb. Note that these are only the variables
69 produced by yacc. If other parser generators (bison, byacc, etc) produce
70 additional global names that conflict at link time, then those parser
71 generators need to be fixed instead of adding those names to this list. */
72
73 #define yymaxdepth pascal_maxdepth
74 #define yyparse pascal_parse
75 #define yylex pascal_lex
76 #define yyerror pascal_error
77 #define yylval pascal_lval
78 #define yychar pascal_char
79 #define yydebug pascal_debug
80 #define yypact pascal_pact
81 #define yyr1 pascal_r1
82 #define yyr2 pascal_r2
83 #define yydef pascal_def
84 #define yychk pascal_chk
85 #define yypgo pascal_pgo
86 #define yyact pascal_act
87 #define yyexca pascal_exca
88 #define yyerrflag pascal_errflag
89 #define yynerrs pascal_nerrs
90 #define yyps pascal_ps
91 #define yypv pascal_pv
92 #define yys pascal_s
93 #define yy_yys pascal_yys
94 #define yystate pascal_state
95 #define yytmp pascal_tmp
96 #define yyv pascal_v
97 #define yy_yyv pascal_yyv
98 #define yyval pascal_val
99 #define yylloc pascal_lloc
100 #define yyreds pascal_reds /* With YYDEBUG defined */
101 #define yytoks pascal_toks /* With YYDEBUG defined */
102 #define yylhs pascal_yylhs
103 #define yylen pascal_yylen
104 #define yydefred pascal_yydefred
105 #define yydgoto pascal_yydgoto
106 #define yysindex pascal_yysindex
107 #define yyrindex pascal_yyrindex
108 #define yygindex pascal_yygindex
109 #define yytable pascal_yytable
110 #define yycheck pascal_yycheck
111
112 #ifndef YYDEBUG
113 #define YYDEBUG 0 /* Default to no yydebug support */
114 #endif
115
116 int yyparse (void);
117
118 static int yylex (void);
119
120 void
121 yyerror (char *);
122
123 static char * uptok (char *, int);
124 %}
125
126 /* Although the yacc "value" of an expression is not used,
127 since the result is stored in the structure being created,
128 other node types do have values. */
129
130 %union
131 {
132 LONGEST lval;
133 struct {
134 LONGEST val;
135 struct type *type;
136 } typed_val_int;
137 struct {
138 DOUBLEST dval;
139 struct type *type;
140 } typed_val_float;
141 struct symbol *sym;
142 struct type *tval;
143 struct stoken sval;
144 struct ttype tsym;
145 struct symtoken ssym;
146 int voidval;
147 struct block *bval;
148 enum exp_opcode opcode;
149 struct internalvar *ivar;
150
151 struct type **tvec;
152 int *ivec;
153 }
154
155 %{
156 /* YYSTYPE gets defined by %union */
157 static int
158 parse_number (char *, int, int, YYSTYPE *);
159 %}
160
161 %type <voidval> exp exp1 type_exp start variable qualified_name
162 %type <tval> type typebase
163 /* %type <bval> block */
164
165 /* Fancy type parsing. */
166 %type <tval> ptype
167
168 %token <typed_val_int> INT
169 %token <typed_val_float> FLOAT
170
171 /* Both NAME and TYPENAME tokens represent symbols in the input,
172 and both convey their data as strings.
173 But a TYPENAME is a string that happens to be defined as a typedef
174 or builtin type name (such as int or char)
175 and a NAME is any other symbol.
176 Contexts where this distinction is not important can use the
177 nonterminal "name", which matches either NAME or TYPENAME. */
178
179 %token <sval> STRING
180 %token <ssym> NAME /* BLOCKNAME defined below to give it higher precedence. */
181 %token <tsym> TYPENAME
182 %type <sval> name
183 %type <ssym> name_not_typename
184
185 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
186 but which would parse as a valid number in the current input radix.
187 E.g. "c" when input_radix==16. Depending on the parse, it will be
188 turned into a name or into a number. */
189
190 %token <ssym> NAME_OR_INT
191
192 %token STRUCT CLASS SIZEOF COLONCOLON
193 %token ERROR
194
195 /* Special type cases, put in to allow the parser to distinguish different
196 legal basetypes. */
197
198 %token <voidval> VARIABLE
199
200
201 /* Object pascal */
202 %token THIS
203 %token <lval> TRUE FALSE
204
205 %left ','
206 %left ABOVE_COMMA
207 %right ASSIGN
208 %left NOT
209 %left OR
210 %left XOR
211 %left ANDAND
212 %left '=' NOTEQUAL
213 %left '<' '>' LEQ GEQ
214 %left LSH RSH DIV MOD
215 %left '@'
216 %left '+' '-'
217 %left '*' '/'
218 %right UNARY INCREMENT DECREMENT
219 %right ARROW '.' '[' '('
220 %token <ssym> BLOCKNAME
221 %type <bval> block
222 %left COLONCOLON
223
224 \f
225 %%
226
227 start : exp1
228 | type_exp
229 ;
230
231 type_exp: type
232 { write_exp_elt_opcode(OP_TYPE);
233 write_exp_elt_type($1);
234 write_exp_elt_opcode(OP_TYPE);}
235 ;
236
237 /* Expressions, including the comma operator. */
238 exp1 : exp
239 | exp1 ',' exp
240 { write_exp_elt_opcode (BINOP_COMMA); }
241 ;
242
243 /* Expressions, not including the comma operator. */
244 exp : exp '^' %prec UNARY
245 { write_exp_elt_opcode (UNOP_IND); }
246
247 exp : '@' exp %prec UNARY
248 { write_exp_elt_opcode (UNOP_ADDR); }
249
250 exp : '-' exp %prec UNARY
251 { write_exp_elt_opcode (UNOP_NEG); }
252 ;
253
254 exp : NOT exp %prec UNARY
255 { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
256 ;
257
258 exp : INCREMENT '(' exp ')' %prec UNARY
259 { write_exp_elt_opcode (UNOP_PREINCREMENT); }
260 ;
261
262 exp : DECREMENT '(' exp ')' %prec UNARY
263 { write_exp_elt_opcode (UNOP_PREDECREMENT); }
264 ;
265
266 exp : exp '.' name
267 { write_exp_elt_opcode (STRUCTOP_STRUCT);
268 write_exp_string ($3);
269 write_exp_elt_opcode (STRUCTOP_STRUCT); }
270 ;
271
272 exp : exp '[' exp1 ']'
273 { write_exp_elt_opcode (BINOP_SUBSCRIPT); }
274 ;
275
276 exp : exp '('
277 /* This is to save the value of arglist_len
278 being accumulated by an outer function call. */
279 { start_arglist (); }
280 arglist ')' %prec ARROW
281 { write_exp_elt_opcode (OP_FUNCALL);
282 write_exp_elt_longcst ((LONGEST) end_arglist ());
283 write_exp_elt_opcode (OP_FUNCALL); }
284 ;
285
286 arglist :
287 | exp
288 { arglist_len = 1; }
289 | arglist ',' exp %prec ABOVE_COMMA
290 { arglist_len++; }
291 ;
292
293 exp : type '(' exp ')' %prec UNARY
294 { write_exp_elt_opcode (UNOP_CAST);
295 write_exp_elt_type ($1);
296 write_exp_elt_opcode (UNOP_CAST); }
297 ;
298
299 exp : '(' exp1 ')'
300 { }
301 ;
302
303 /* Binary operators in order of decreasing precedence. */
304
305 exp : exp '*' exp
306 { write_exp_elt_opcode (BINOP_MUL); }
307 ;
308
309 exp : exp '/' exp
310 { write_exp_elt_opcode (BINOP_DIV); }
311 ;
312
313 exp : exp DIV exp
314 { write_exp_elt_opcode (BINOP_INTDIV); }
315 ;
316
317 exp : exp MOD exp
318 { write_exp_elt_opcode (BINOP_REM); }
319 ;
320
321 exp : exp '+' exp
322 { write_exp_elt_opcode (BINOP_ADD); }
323 ;
324
325 exp : exp '-' exp
326 { write_exp_elt_opcode (BINOP_SUB); }
327 ;
328
329 exp : exp LSH exp
330 { write_exp_elt_opcode (BINOP_LSH); }
331 ;
332
333 exp : exp RSH exp
334 { write_exp_elt_opcode (BINOP_RSH); }
335 ;
336
337 exp : exp '=' exp
338 { write_exp_elt_opcode (BINOP_EQUAL); }
339 ;
340
341 exp : exp NOTEQUAL exp
342 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
343 ;
344
345 exp : exp LEQ exp
346 { write_exp_elt_opcode (BINOP_LEQ); }
347 ;
348
349 exp : exp GEQ exp
350 { write_exp_elt_opcode (BINOP_GEQ); }
351 ;
352
353 exp : exp '<' exp
354 { write_exp_elt_opcode (BINOP_LESS); }
355 ;
356
357 exp : exp '>' exp
358 { write_exp_elt_opcode (BINOP_GTR); }
359 ;
360
361 exp : exp ANDAND exp
362 { write_exp_elt_opcode (BINOP_BITWISE_AND); }
363 ;
364
365 exp : exp XOR exp
366 { write_exp_elt_opcode (BINOP_BITWISE_XOR); }
367 ;
368
369 exp : exp OR exp
370 { write_exp_elt_opcode (BINOP_BITWISE_IOR); }
371 ;
372
373 exp : exp ASSIGN exp
374 { write_exp_elt_opcode (BINOP_ASSIGN); }
375 ;
376
377 exp : TRUE
378 { write_exp_elt_opcode (OP_BOOL);
379 write_exp_elt_longcst ((LONGEST) $1);
380 write_exp_elt_opcode (OP_BOOL); }
381 ;
382
383 exp : FALSE
384 { write_exp_elt_opcode (OP_BOOL);
385 write_exp_elt_longcst ((LONGEST) $1);
386 write_exp_elt_opcode (OP_BOOL); }
387 ;
388
389 exp : INT
390 { write_exp_elt_opcode (OP_LONG);
391 write_exp_elt_type ($1.type);
392 write_exp_elt_longcst ((LONGEST)($1.val));
393 write_exp_elt_opcode (OP_LONG); }
394 ;
395
396 exp : NAME_OR_INT
397 { YYSTYPE val;
398 parse_number ($1.stoken.ptr, $1.stoken.length, 0, &val);
399 write_exp_elt_opcode (OP_LONG);
400 write_exp_elt_type (val.typed_val_int.type);
401 write_exp_elt_longcst ((LONGEST)val.typed_val_int.val);
402 write_exp_elt_opcode (OP_LONG);
403 }
404 ;
405
406
407 exp : FLOAT
408 { write_exp_elt_opcode (OP_DOUBLE);
409 write_exp_elt_type ($1.type);
410 write_exp_elt_dblcst ($1.dval);
411 write_exp_elt_opcode (OP_DOUBLE); }
412 ;
413
414 exp : variable
415 ;
416
417 exp : VARIABLE
418 /* Already written by write_dollar_variable. */
419 ;
420
421 exp : SIZEOF '(' type ')' %prec UNARY
422 { write_exp_elt_opcode (OP_LONG);
423 write_exp_elt_type (builtin_type_int);
424 CHECK_TYPEDEF ($3);
425 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
426 write_exp_elt_opcode (OP_LONG); }
427 ;
428
429 exp : STRING
430 { /* C strings are converted into array constants with
431 an explicit null byte added at the end. Thus
432 the array upper bound is the string length.
433 There is no such thing in C as a completely empty
434 string. */
435 char *sp = $1.ptr; int count = $1.length;
436 while (count-- > 0)
437 {
438 write_exp_elt_opcode (OP_LONG);
439 write_exp_elt_type (builtin_type_char);
440 write_exp_elt_longcst ((LONGEST)(*sp++));
441 write_exp_elt_opcode (OP_LONG);
442 }
443 write_exp_elt_opcode (OP_LONG);
444 write_exp_elt_type (builtin_type_char);
445 write_exp_elt_longcst ((LONGEST)'\0');
446 write_exp_elt_opcode (OP_LONG);
447 write_exp_elt_opcode (OP_ARRAY);
448 write_exp_elt_longcst ((LONGEST) 0);
449 write_exp_elt_longcst ((LONGEST) ($1.length));
450 write_exp_elt_opcode (OP_ARRAY); }
451 ;
452
453 /* Object pascal */
454 exp : THIS
455 { write_exp_elt_opcode (OP_THIS);
456 write_exp_elt_opcode (OP_THIS); }
457 ;
458
459 /* end of object pascal. */
460
461 block : BLOCKNAME
462 {
463 if ($1.sym != 0)
464 $$ = SYMBOL_BLOCK_VALUE ($1.sym);
465 else
466 {
467 struct symtab *tem =
468 lookup_symtab (copy_name ($1.stoken));
469 if (tem)
470 $$ = BLOCKVECTOR_BLOCK (BLOCKVECTOR (tem), STATIC_BLOCK);
471 else
472 error ("No file or function \"%s\".",
473 copy_name ($1.stoken));
474 }
475 }
476 ;
477
478 block : block COLONCOLON name
479 { struct symbol *tem
480 = lookup_symbol (copy_name ($3), $1,
481 VAR_NAMESPACE, (int *) NULL,
482 (struct symtab **) NULL);
483 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
484 error ("No function \"%s\" in specified context.",
485 copy_name ($3));
486 $$ = SYMBOL_BLOCK_VALUE (tem); }
487 ;
488
489 variable: block COLONCOLON name
490 { struct symbol *sym;
491 sym = lookup_symbol (copy_name ($3), $1,
492 VAR_NAMESPACE, (int *) NULL,
493 (struct symtab **) NULL);
494 if (sym == 0)
495 error ("No symbol \"%s\" in specified context.",
496 copy_name ($3));
497
498 write_exp_elt_opcode (OP_VAR_VALUE);
499 /* block_found is set by lookup_symbol. */
500 write_exp_elt_block (block_found);
501 write_exp_elt_sym (sym);
502 write_exp_elt_opcode (OP_VAR_VALUE); }
503 ;
504
505 qualified_name: typebase COLONCOLON name
506 {
507 struct type *type = $1;
508 if (TYPE_CODE (type) != TYPE_CODE_STRUCT
509 && TYPE_CODE (type) != TYPE_CODE_UNION)
510 error ("`%s' is not defined as an aggregate type.",
511 TYPE_NAME (type));
512
513 write_exp_elt_opcode (OP_SCOPE);
514 write_exp_elt_type (type);
515 write_exp_string ($3);
516 write_exp_elt_opcode (OP_SCOPE);
517 }
518 ;
519
520 variable: qualified_name
521 | COLONCOLON name
522 {
523 char *name = copy_name ($2);
524 struct symbol *sym;
525 struct minimal_symbol *msymbol;
526
527 sym =
528 lookup_symbol (name, (const struct block *) NULL,
529 VAR_NAMESPACE, (int *) NULL,
530 (struct symtab **) NULL);
531 if (sym)
532 {
533 write_exp_elt_opcode (OP_VAR_VALUE);
534 write_exp_elt_block (NULL);
535 write_exp_elt_sym (sym);
536 write_exp_elt_opcode (OP_VAR_VALUE);
537 break;
538 }
539
540 msymbol = lookup_minimal_symbol (name, NULL, NULL);
541 if (msymbol != NULL)
542 {
543 write_exp_msymbol (msymbol,
544 lookup_function_type (builtin_type_int),
545 builtin_type_int);
546 }
547 else
548 if (!have_full_symbols () && !have_partial_symbols ())
549 error ("No symbol table is loaded. Use the \"file\" command.");
550 else
551 error ("No symbol \"%s\" in current context.", name);
552 }
553 ;
554
555 variable: name_not_typename
556 { struct symbol *sym = $1.sym;
557
558 if (sym)
559 {
560 if (symbol_read_needs_frame (sym))
561 {
562 if (innermost_block == 0 ||
563 contained_in (block_found,
564 innermost_block))
565 innermost_block = block_found;
566 }
567
568 write_exp_elt_opcode (OP_VAR_VALUE);
569 /* We want to use the selected frame, not
570 another more inner frame which happens to
571 be in the same block. */
572 write_exp_elt_block (NULL);
573 write_exp_elt_sym (sym);
574 write_exp_elt_opcode (OP_VAR_VALUE);
575 }
576 else if ($1.is_a_field_of_this)
577 {
578 /* Object pascal: it hangs off of `this'. Must
579 not inadvertently convert from a method call
580 to data ref. */
581 if (innermost_block == 0 ||
582 contained_in (block_found, innermost_block))
583 innermost_block = block_found;
584 write_exp_elt_opcode (OP_THIS);
585 write_exp_elt_opcode (OP_THIS);
586 write_exp_elt_opcode (STRUCTOP_PTR);
587 write_exp_string ($1.stoken);
588 write_exp_elt_opcode (STRUCTOP_PTR);
589 }
590 else
591 {
592 struct minimal_symbol *msymbol;
593 register char *arg = copy_name ($1.stoken);
594
595 msymbol =
596 lookup_minimal_symbol (arg, NULL, NULL);
597 if (msymbol != NULL)
598 {
599 write_exp_msymbol (msymbol,
600 lookup_function_type (builtin_type_int),
601 builtin_type_int);
602 }
603 else if (!have_full_symbols () && !have_partial_symbols ())
604 error ("No symbol table is loaded. Use the \"file\" command.");
605 else
606 error ("No symbol \"%s\" in current context.",
607 copy_name ($1.stoken));
608 }
609 }
610 ;
611
612
613 ptype : typebase
614 ;
615
616 /* We used to try to recognize more pointer to member types here, but
617 that didn't work (shift/reduce conflicts meant that these rules never
618 got executed). The problem is that
619 int (foo::bar::baz::bizzle)
620 is a function type but
621 int (foo::bar::baz::bizzle::*)
622 is a pointer to member type. Stroustrup loses again! */
623
624 type : ptype
625 | typebase COLONCOLON '*'
626 { $$ = lookup_member_type (builtin_type_int, $1); }
627 ;
628
629 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
630 : TYPENAME
631 { $$ = $1.type; }
632 | STRUCT name
633 { $$ = lookup_struct (copy_name ($2),
634 expression_context_block); }
635 | CLASS name
636 { $$ = lookup_struct (copy_name ($2),
637 expression_context_block); }
638 /* "const" and "volatile" are curently ignored. A type qualifier
639 after the type is handled in the ptype rule. I think these could
640 be too. */
641 ;
642
643 name : NAME { $$ = $1.stoken; }
644 | BLOCKNAME { $$ = $1.stoken; }
645 | TYPENAME { $$ = $1.stoken; }
646 | NAME_OR_INT { $$ = $1.stoken; }
647 ;
648
649 name_not_typename : NAME
650 | BLOCKNAME
651 /* These would be useful if name_not_typename was useful, but it is just
652 a fake for "variable", so these cause reduce/reduce conflicts because
653 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
654 =exp) or just an exp. If name_not_typename was ever used in an lvalue
655 context where only a name could occur, this might be useful.
656 | NAME_OR_INT
657 */
658 ;
659
660 %%
661
662 /* Take care of parsing a number (anything that starts with a digit).
663 Set yylval and return the token type; update lexptr.
664 LEN is the number of characters in it. */
665
666 /*** Needs some error checking for the float case ***/
667
668 static int
669 parse_number (p, len, parsed_float, putithere)
670 register char *p;
671 register int len;
672 int parsed_float;
673 YYSTYPE *putithere;
674 {
675 /* FIXME: Shouldn't these be unsigned? We don't deal with negative values
676 here, and we do kind of silly things like cast to unsigned. */
677 register LONGEST n = 0;
678 register LONGEST prevn = 0;
679 ULONGEST un;
680
681 register int i = 0;
682 register int c;
683 register int base = input_radix;
684 int unsigned_p = 0;
685
686 /* Number of "L" suffixes encountered. */
687 int long_p = 0;
688
689 /* We have found a "L" or "U" suffix. */
690 int found_suffix = 0;
691
692 ULONGEST high_bit;
693 struct type *signed_type;
694 struct type *unsigned_type;
695
696 if (parsed_float)
697 {
698 /* It's a float since it contains a point or an exponent. */
699 char c;
700 int num = 0; /* number of tokens scanned by scanf */
701 char saved_char = p[len];
702
703 p[len] = 0; /* null-terminate the token */
704 if (sizeof (putithere->typed_val_float.dval) <= sizeof (float))
705 num = sscanf (p, "%g%c", (float *) &putithere->typed_val_float.dval,&c);
706 else if (sizeof (putithere->typed_val_float.dval) <= sizeof (double))
707 num = sscanf (p, "%lg%c", (double *) &putithere->typed_val_float.dval,&c);
708 else
709 {
710 #ifdef SCANF_HAS_LONG_DOUBLE
711 num = sscanf (p, "%Lg%c", &putithere->typed_val_float.dval,&c);
712 #else
713 /* Scan it into a double, then assign it to the long double.
714 This at least wins with values representable in the range
715 of doubles. */
716 double temp;
717 num = sscanf (p, "%lg%c", &temp,&c);
718 putithere->typed_val_float.dval = temp;
719 #endif
720 }
721 p[len] = saved_char; /* restore the input stream */
722 if (num != 1) /* check scanf found ONLY a float ... */
723 return ERROR;
724 /* See if it has `f' or `l' suffix (float or long double). */
725
726 c = tolower (p[len - 1]);
727
728 if (c == 'f')
729 putithere->typed_val_float.type = builtin_type_float;
730 else if (c == 'l')
731 putithere->typed_val_float.type = builtin_type_long_double;
732 else if (isdigit (c) || c == '.')
733 putithere->typed_val_float.type = builtin_type_double;
734 else
735 return ERROR;
736
737 return FLOAT;
738 }
739
740 /* Handle base-switching prefixes 0x, 0t, 0d, 0 */
741 if (p[0] == '0')
742 switch (p[1])
743 {
744 case 'x':
745 case 'X':
746 if (len >= 3)
747 {
748 p += 2;
749 base = 16;
750 len -= 2;
751 }
752 break;
753
754 case 't':
755 case 'T':
756 case 'd':
757 case 'D':
758 if (len >= 3)
759 {
760 p += 2;
761 base = 10;
762 len -= 2;
763 }
764 break;
765
766 default:
767 base = 8;
768 break;
769 }
770
771 while (len-- > 0)
772 {
773 c = *p++;
774 if (c >= 'A' && c <= 'Z')
775 c += 'a' - 'A';
776 if (c != 'l' && c != 'u')
777 n *= base;
778 if (c >= '0' && c <= '9')
779 {
780 if (found_suffix)
781 return ERROR;
782 n += i = c - '0';
783 }
784 else
785 {
786 if (base > 10 && c >= 'a' && c <= 'f')
787 {
788 if (found_suffix)
789 return ERROR;
790 n += i = c - 'a' + 10;
791 }
792 else if (c == 'l')
793 {
794 ++long_p;
795 found_suffix = 1;
796 }
797 else if (c == 'u')
798 {
799 unsigned_p = 1;
800 found_suffix = 1;
801 }
802 else
803 return ERROR; /* Char not a digit */
804 }
805 if (i >= base)
806 return ERROR; /* Invalid digit in this base */
807
808 /* Portably test for overflow (only works for nonzero values, so make
809 a second check for zero). FIXME: Can't we just make n and prevn
810 unsigned and avoid this? */
811 if (c != 'l' && c != 'u' && (prevn >= n) && n != 0)
812 unsigned_p = 1; /* Try something unsigned */
813
814 /* Portably test for unsigned overflow.
815 FIXME: This check is wrong; for example it doesn't find overflow
816 on 0x123456789 when LONGEST is 32 bits. */
817 if (c != 'l' && c != 'u' && n != 0)
818 {
819 if ((unsigned_p && (ULONGEST) prevn >= (ULONGEST) n))
820 error ("Numeric constant too large.");
821 }
822 prevn = n;
823 }
824
825 /* An integer constant is an int, a long, or a long long. An L
826 suffix forces it to be long; an LL suffix forces it to be long
827 long. If not forced to a larger size, it gets the first type of
828 the above that it fits in. To figure out whether it fits, we
829 shift it right and see whether anything remains. Note that we
830 can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
831 operation, because many compilers will warn about such a shift
832 (which always produces a zero result). Sometimes TARGET_INT_BIT
833 or TARGET_LONG_BIT will be that big, sometimes not. To deal with
834 the case where it is we just always shift the value more than
835 once, with fewer bits each time. */
836
837 un = (ULONGEST)n >> 2;
838 if (long_p == 0
839 && (un >> (TARGET_INT_BIT - 2)) == 0)
840 {
841 high_bit = ((ULONGEST)1) << (TARGET_INT_BIT-1);
842
843 /* A large decimal (not hex or octal) constant (between INT_MAX
844 and UINT_MAX) is a long or unsigned long, according to ANSI,
845 never an unsigned int, but this code treats it as unsigned
846 int. This probably should be fixed. GCC gives a warning on
847 such constants. */
848
849 unsigned_type = builtin_type_unsigned_int;
850 signed_type = builtin_type_int;
851 }
852 else if (long_p <= 1
853 && (un >> (TARGET_LONG_BIT - 2)) == 0)
854 {
855 high_bit = ((ULONGEST)1) << (TARGET_LONG_BIT-1);
856 unsigned_type = builtin_type_unsigned_long;
857 signed_type = builtin_type_long;
858 }
859 else
860 {
861 int shift;
862 if (sizeof (ULONGEST) * HOST_CHAR_BIT < TARGET_LONG_LONG_BIT)
863 /* A long long does not fit in a LONGEST. */
864 shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
865 else
866 shift = (TARGET_LONG_LONG_BIT - 1);
867 high_bit = (ULONGEST) 1 << shift;
868 unsigned_type = builtin_type_unsigned_long_long;
869 signed_type = builtin_type_long_long;
870 }
871
872 putithere->typed_val_int.val = n;
873
874 /* If the high bit of the worked out type is set then this number
875 has to be unsigned. */
876
877 if (unsigned_p || (n & high_bit))
878 {
879 putithere->typed_val_int.type = unsigned_type;
880 }
881 else
882 {
883 putithere->typed_val_int.type = signed_type;
884 }
885
886 return INT;
887 }
888
889 struct token
890 {
891 char *operator;
892 int token;
893 enum exp_opcode opcode;
894 };
895
896 static const struct token tokentab3[] =
897 {
898 {"shr", RSH, BINOP_END},
899 {"shl", LSH, BINOP_END},
900 {"and", ANDAND, BINOP_END},
901 {"div", DIV, BINOP_END},
902 {"not", NOT, BINOP_END},
903 {"mod", MOD, BINOP_END},
904 {"inc", INCREMENT, BINOP_END},
905 {"dec", DECREMENT, BINOP_END},
906 {"xor", XOR, BINOP_END}
907 };
908
909 static const struct token tokentab2[] =
910 {
911 {"or", OR, BINOP_END},
912 {"<>", NOTEQUAL, BINOP_END},
913 {"<=", LEQ, BINOP_END},
914 {">=", GEQ, BINOP_END},
915 {":=", ASSIGN, BINOP_END}
916 };
917
918 /* Allocate uppercased var */
919 /* make an uppercased copy of tokstart */
920 static char * uptok (tokstart, namelen)
921 char *tokstart;
922 int namelen;
923 {
924 int i;
925 char *uptokstart = (char *)malloc(namelen+1);
926 for (i = 0;i <= namelen;i++)
927 {
928 if ((tokstart[i]>='a' && tokstart[i]<='z'))
929 uptokstart[i] = tokstart[i]-('a'-'A');
930 else
931 uptokstart[i] = tokstart[i];
932 }
933 uptokstart[namelen]='\0';
934 return uptokstart;
935 }
936 /* Read one token, getting characters through lexptr. */
937
938
939 static int
940 yylex ()
941 {
942 int c;
943 int namelen;
944 unsigned int i;
945 char *tokstart;
946 char *uptokstart;
947 char *tokptr;
948 char *p;
949 int explen, tempbufindex;
950 static char *tempbuf;
951 static int tempbufsize;
952
953 retry:
954
955 tokstart = lexptr;
956 explen = strlen (lexptr);
957 /* See if it is a special token of length 3. */
958 if (explen > 2)
959 for (i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
960 if (strncasecmp (tokstart, tokentab3[i].operator, 3) == 0
961 && (!isalpha (tokentab3[i].operator[0]) || explen == 3
962 || (!isalpha (tokstart[3]) && !isdigit (tokstart[3]) && tokstart[3] != '_')))
963 {
964 lexptr += 3;
965 yylval.opcode = tokentab3[i].opcode;
966 return tokentab3[i].token;
967 }
968
969 /* See if it is a special token of length 2. */
970 if (explen > 1)
971 for (i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
972 if (strncasecmp (tokstart, tokentab2[i].operator, 2) == 0
973 && (!isalpha (tokentab2[i].operator[0]) || explen == 2
974 || (!isalpha (tokstart[2]) && !isdigit (tokstart[2]) && tokstart[2] != '_')))
975 {
976 lexptr += 2;
977 yylval.opcode = tokentab2[i].opcode;
978 return tokentab2[i].token;
979 }
980
981 switch (c = *tokstart)
982 {
983 case 0:
984 return 0;
985
986 case ' ':
987 case '\t':
988 case '\n':
989 lexptr++;
990 goto retry;
991
992 case '\'':
993 /* We either have a character constant ('0' or '\177' for example)
994 or we have a quoted symbol reference ('foo(int,int)' in object pascal
995 for example). */
996 lexptr++;
997 c = *lexptr++;
998 if (c == '\\')
999 c = parse_escape (&lexptr);
1000 else if (c == '\'')
1001 error ("Empty character constant.");
1002
1003 yylval.typed_val_int.val = c;
1004 yylval.typed_val_int.type = builtin_type_char;
1005
1006 c = *lexptr++;
1007 if (c != '\'')
1008 {
1009 namelen = skip_quoted (tokstart) - tokstart;
1010 if (namelen > 2)
1011 {
1012 lexptr = tokstart + namelen;
1013 if (lexptr[-1] != '\'')
1014 error ("Unmatched single quote.");
1015 namelen -= 2;
1016 tokstart++;
1017 uptokstart = uptok(tokstart,namelen);
1018 goto tryname;
1019 }
1020 error ("Invalid character constant.");
1021 }
1022 return INT;
1023
1024 case '(':
1025 paren_depth++;
1026 lexptr++;
1027 return c;
1028
1029 case ')':
1030 if (paren_depth == 0)
1031 return 0;
1032 paren_depth--;
1033 lexptr++;
1034 return c;
1035
1036 case ',':
1037 if (comma_terminates && paren_depth == 0)
1038 return 0;
1039 lexptr++;
1040 return c;
1041
1042 case '.':
1043 /* Might be a floating point number. */
1044 if (lexptr[1] < '0' || lexptr[1] > '9')
1045 goto symbol; /* Nope, must be a symbol. */
1046 /* FALL THRU into number case. */
1047
1048 case '0':
1049 case '1':
1050 case '2':
1051 case '3':
1052 case '4':
1053 case '5':
1054 case '6':
1055 case '7':
1056 case '8':
1057 case '9':
1058 {
1059 /* It's a number. */
1060 int got_dot = 0, got_e = 0, toktype;
1061 register char *p = tokstart;
1062 int hex = input_radix > 10;
1063
1064 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1065 {
1066 p += 2;
1067 hex = 1;
1068 }
1069 else if (c == '0' && (p[1]=='t' || p[1]=='T' || p[1]=='d' || p[1]=='D'))
1070 {
1071 p += 2;
1072 hex = 0;
1073 }
1074
1075 for (;; ++p)
1076 {
1077 /* This test includes !hex because 'e' is a valid hex digit
1078 and thus does not indicate a floating point number when
1079 the radix is hex. */
1080 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1081 got_dot = got_e = 1;
1082 /* This test does not include !hex, because a '.' always indicates
1083 a decimal floating point number regardless of the radix. */
1084 else if (!got_dot && *p == '.')
1085 got_dot = 1;
1086 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1087 && (*p == '-' || *p == '+'))
1088 /* This is the sign of the exponent, not the end of the
1089 number. */
1090 continue;
1091 /* We will take any letters or digits. parse_number will
1092 complain if past the radix, or if L or U are not final. */
1093 else if ((*p < '0' || *p > '9')
1094 && ((*p < 'a' || *p > 'z')
1095 && (*p < 'A' || *p > 'Z')))
1096 break;
1097 }
1098 toktype = parse_number (tokstart, p - tokstart, got_dot|got_e, &yylval);
1099 if (toktype == ERROR)
1100 {
1101 char *err_copy = (char *) alloca (p - tokstart + 1);
1102
1103 memcpy (err_copy, tokstart, p - tokstart);
1104 err_copy[p - tokstart] = 0;
1105 error ("Invalid number \"%s\".", err_copy);
1106 }
1107 lexptr = p;
1108 return toktype;
1109 }
1110
1111 case '+':
1112 case '-':
1113 case '*':
1114 case '/':
1115 case '|':
1116 case '&':
1117 case '^':
1118 case '~':
1119 case '!':
1120 case '@':
1121 case '<':
1122 case '>':
1123 case '[':
1124 case ']':
1125 case '?':
1126 case ':':
1127 case '=':
1128 case '{':
1129 case '}':
1130 symbol:
1131 lexptr++;
1132 return c;
1133
1134 case '"':
1135
1136 /* Build the gdb internal form of the input string in tempbuf,
1137 translating any standard C escape forms seen. Note that the
1138 buffer is null byte terminated *only* for the convenience of
1139 debugging gdb itself and printing the buffer contents when
1140 the buffer contains no embedded nulls. Gdb does not depend
1141 upon the buffer being null byte terminated, it uses the length
1142 string instead. This allows gdb to handle C strings (as well
1143 as strings in other languages) with embedded null bytes */
1144
1145 tokptr = ++tokstart;
1146 tempbufindex = 0;
1147
1148 do {
1149 /* Grow the static temp buffer if necessary, including allocating
1150 the first one on demand. */
1151 if (tempbufindex + 1 >= tempbufsize)
1152 {
1153 tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1154 }
1155 switch (*tokptr)
1156 {
1157 case '\0':
1158 case '"':
1159 /* Do nothing, loop will terminate. */
1160 break;
1161 case '\\':
1162 tokptr++;
1163 c = parse_escape (&tokptr);
1164 if (c == -1)
1165 {
1166 continue;
1167 }
1168 tempbuf[tempbufindex++] = c;
1169 break;
1170 default:
1171 tempbuf[tempbufindex++] = *tokptr++;
1172 break;
1173 }
1174 } while ((*tokptr != '"') && (*tokptr != '\0'));
1175 if (*tokptr++ != '"')
1176 {
1177 error ("Unterminated string in expression.");
1178 }
1179 tempbuf[tempbufindex] = '\0'; /* See note above */
1180 yylval.sval.ptr = tempbuf;
1181 yylval.sval.length = tempbufindex;
1182 lexptr = tokptr;
1183 return (STRING);
1184 }
1185
1186 if (!(c == '_' || c == '$'
1187 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1188 /* We must have come across a bad character (e.g. ';'). */
1189 error ("Invalid character '%c' in expression.", c);
1190
1191 /* It's a name. See how long it is. */
1192 namelen = 0;
1193 for (c = tokstart[namelen];
1194 (c == '_' || c == '$' || (c >= '0' && c <= '9')
1195 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1196 {
1197 /* Template parameter lists are part of the name.
1198 FIXME: This mishandles `print $a<4&&$a>3'. */
1199 if (c == '<')
1200 {
1201 int i = namelen;
1202 int nesting_level = 1;
1203 while (tokstart[++i])
1204 {
1205 if (tokstart[i] == '<')
1206 nesting_level++;
1207 else if (tokstart[i] == '>')
1208 {
1209 if (--nesting_level == 0)
1210 break;
1211 }
1212 }
1213 if (tokstart[i] == '>')
1214 namelen = i;
1215 else
1216 break;
1217 }
1218
1219 /* do NOT uppercase internals because of registers !!! */
1220 c = tokstart[++namelen];
1221 }
1222
1223 uptokstart = uptok(tokstart,namelen);
1224
1225 /* The token "if" terminates the expression and is NOT
1226 removed from the input stream. */
1227 if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1228 {
1229 return 0;
1230 }
1231
1232 lexptr += namelen;
1233
1234 tryname:
1235
1236 /* Catch specific keywords. Should be done with a data structure. */
1237 switch (namelen)
1238 {
1239 case 6:
1240 if (STREQ (uptokstart, "OBJECT"))
1241 return CLASS;
1242 if (STREQ (uptokstart, "RECORD"))
1243 return STRUCT;
1244 if (STREQ (uptokstart, "SIZEOF"))
1245 return SIZEOF;
1246 break;
1247 case 5:
1248 if (STREQ (uptokstart, "CLASS"))
1249 return CLASS;
1250 if (STREQ (uptokstart, "FALSE"))
1251 {
1252 yylval.lval = 0;
1253 return FALSE;
1254 }
1255 break;
1256 case 4:
1257 if (STREQ (uptokstart, "TRUE"))
1258 {
1259 yylval.lval = 1;
1260 return TRUE;
1261 }
1262 if (STREQ (uptokstart, "SELF"))
1263 {
1264 /* here we search for 'this' like
1265 inserted in FPC stabs debug info */
1266 static const char this_name[] =
1267 { /* CPLUS_MARKER,*/ 't', 'h', 'i', 's', '\0' };
1268
1269 if (lookup_symbol (this_name, expression_context_block,
1270 VAR_NAMESPACE, (int *) NULL,
1271 (struct symtab **) NULL))
1272 return THIS;
1273 }
1274 break;
1275 default:
1276 break;
1277 }
1278
1279 yylval.sval.ptr = tokstart;
1280 yylval.sval.length = namelen;
1281
1282 if (*tokstart == '$')
1283 {
1284 /* $ is the normal prefix for pascal hexadecimal values
1285 but this conflicts with the GDB use for debugger variables
1286 so in expression to enter hexadecimal values
1287 we still need to use C syntax with 0xff */
1288 write_dollar_variable (yylval.sval);
1289 return VARIABLE;
1290 }
1291
1292 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1293 functions or symtabs. If this is not so, then ...
1294 Use token-type TYPENAME for symbols that happen to be defined
1295 currently as names of types; NAME for other symbols.
1296 The caller is not constrained to care about the distinction. */
1297 {
1298 char *tmp = copy_name (yylval.sval);
1299 struct symbol *sym;
1300 int is_a_field_of_this = 0;
1301 int hextype;
1302
1303 sym = lookup_symbol (tmp, expression_context_block,
1304 VAR_NAMESPACE,
1305 &is_a_field_of_this,
1306 (struct symtab **) NULL);
1307 /* second chance uppercased ! */
1308 if (!sym)
1309 {
1310 for (i = 0;i <= namelen;i++)
1311 {
1312 if ((tmp[i]>='a' && tmp[i]<='z'))
1313 tmp[i] -= ('a'-'A');
1314 /* I am not sure that copy_name gives excatly the same result ! */
1315 if ((tokstart[i]>='a' && tokstart[i]<='z'))
1316 tokstart[i] -= ('a'-'A');
1317 }
1318 sym = lookup_symbol (tmp, expression_context_block,
1319 VAR_NAMESPACE,
1320 &is_a_field_of_this,
1321 (struct symtab **) NULL);
1322 }
1323 /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1324 no psymtabs (coff, xcoff, or some future change to blow away the
1325 psymtabs once once symbols are read). */
1326 if ((sym && SYMBOL_CLASS (sym) == LOC_BLOCK) ||
1327 lookup_symtab (tmp))
1328 {
1329 yylval.ssym.sym = sym;
1330 yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1331 return BLOCKNAME;
1332 }
1333 if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1334 {
1335 #if 1
1336 /* Despite the following flaw, we need to keep this code enabled.
1337 Because we can get called from check_stub_method, if we don't
1338 handle nested types then it screws many operations in any
1339 program which uses nested types. */
1340 /* In "A::x", if x is a member function of A and there happens
1341 to be a type (nested or not, since the stabs don't make that
1342 distinction) named x, then this code incorrectly thinks we
1343 are dealing with nested types rather than a member function. */
1344
1345 char *p;
1346 char *namestart;
1347 struct symbol *best_sym;
1348
1349 /* Look ahead to detect nested types. This probably should be
1350 done in the grammar, but trying seemed to introduce a lot
1351 of shift/reduce and reduce/reduce conflicts. It's possible
1352 that it could be done, though. Or perhaps a non-grammar, but
1353 less ad hoc, approach would work well. */
1354
1355 /* Since we do not currently have any way of distinguishing
1356 a nested type from a non-nested one (the stabs don't tell
1357 us whether a type is nested), we just ignore the
1358 containing type. */
1359
1360 p = lexptr;
1361 best_sym = sym;
1362 while (1)
1363 {
1364 /* Skip whitespace. */
1365 while (*p == ' ' || *p == '\t' || *p == '\n')
1366 ++p;
1367 if (*p == ':' && p[1] == ':')
1368 {
1369 /* Skip the `::'. */
1370 p += 2;
1371 /* Skip whitespace. */
1372 while (*p == ' ' || *p == '\t' || *p == '\n')
1373 ++p;
1374 namestart = p;
1375 while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1376 || (*p >= 'a' && *p <= 'z')
1377 || (*p >= 'A' && *p <= 'Z'))
1378 ++p;
1379 if (p != namestart)
1380 {
1381 struct symbol *cur_sym;
1382 /* As big as the whole rest of the expression, which is
1383 at least big enough. */
1384 char *ncopy = alloca (strlen (tmp)+strlen (namestart)+3);
1385 char *tmp1;
1386
1387 tmp1 = ncopy;
1388 memcpy (tmp1, tmp, strlen (tmp));
1389 tmp1 += strlen (tmp);
1390 memcpy (tmp1, "::", 2);
1391 tmp1 += 2;
1392 memcpy (tmp1, namestart, p - namestart);
1393 tmp1[p - namestart] = '\0';
1394 cur_sym = lookup_symbol (ncopy, expression_context_block,
1395 VAR_NAMESPACE, (int *) NULL,
1396 (struct symtab **) NULL);
1397 if (cur_sym)
1398 {
1399 if (SYMBOL_CLASS (cur_sym) == LOC_TYPEDEF)
1400 {
1401 best_sym = cur_sym;
1402 lexptr = p;
1403 }
1404 else
1405 break;
1406 }
1407 else
1408 break;
1409 }
1410 else
1411 break;
1412 }
1413 else
1414 break;
1415 }
1416
1417 yylval.tsym.type = SYMBOL_TYPE (best_sym);
1418 #else /* not 0 */
1419 yylval.tsym.type = SYMBOL_TYPE (sym);
1420 #endif /* not 0 */
1421 return TYPENAME;
1422 }
1423 if ((yylval.tsym.type = lookup_primitive_typename (tmp)) != 0)
1424 return TYPENAME;
1425
1426 /* Input names that aren't symbols but ARE valid hex numbers,
1427 when the input radix permits them, can be names or numbers
1428 depending on the parse. Note we support radixes > 16 here. */
1429 if (!sym &&
1430 ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10) ||
1431 (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1432 {
1433 YYSTYPE newlval; /* Its value is ignored. */
1434 hextype = parse_number (tokstart, namelen, 0, &newlval);
1435 if (hextype == INT)
1436 {
1437 yylval.ssym.sym = sym;
1438 yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1439 return NAME_OR_INT;
1440 }
1441 }
1442
1443 free(uptokstart);
1444 /* Any other kind of symbol */
1445 yylval.ssym.sym = sym;
1446 yylval.ssym.is_a_field_of_this = is_a_field_of_this;
1447 return NAME;
1448 }
1449 }
1450
1451 void
1452 yyerror (msg)
1453 char *msg;
1454 {
1455 error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
1456 }
This page took 0.059118 seconds and 5 git commands to generate.