1 /* YACC parser for Pascal expressions, for GDB.
2 Copyright (C) 2000-2021 Free Software Foundation, Inc.
4 This file is part of GDB.
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 3 of the License, or
9 (at your option) any later version.
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with this program. If not, see <http://www.gnu.org/licenses/>. */
19 /* This file is derived from c-exp.y */
21 /* Parse a Pascal expression from text in a string,
22 and return the result as a struct expression pointer.
23 That structure contains arithmetic operations in reverse polish,
24 with constants represented by operations that are followed by special data.
25 See expression.h for the details of the format.
26 What is important here is that it can be built up sequentially
27 during the process of parsing; the lower levels of the tree always
28 come first in the result.
30 Note that malloc's and realloc's in this file are transformed to
31 xmalloc and xrealloc respectively by the same sed command in the
32 makefile that remaps any other malloc/realloc inserted by the parser
33 generator. Doing this with #defines and trying to control the interaction
34 with include files (<malloc.h> and <stdlib.h> for example) just became
35 too messy, particularly when such includes can be inserted at random
36 times by the parser generator. */
38 /* Known bugs or limitations:
39 - pascal string operations are not supported at all.
40 - there are some problems with boolean types.
41 - Pascal type hexadecimal constants are not supported
42 because they conflict with the internal variables format.
43 Probably also lots of other problems, less well defined PM. */
48 #include "expression.h"
50 #include "parser-defs.h"
53 #include "bfd.h" /* Required by objfiles.h. */
54 #include "symfile.h" /* Required by objfiles.h. */
55 #include "objfiles.h" /* For have_full_symbols and have_partial_symbols. */
57 #include "completer.h"
59 #define parse_type(ps) builtin_type (ps->gdbarch ())
61 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror,
63 #define GDB_YY_REMAP_PREFIX pascal_
66 /* The state of the parser, used internally when we are parsing the
69 static struct parser_state *pstate = NULL;
71 /* Depth of parentheses. */
72 static int paren_depth;
76 static int yylex (void);
78 static void yyerror (const char *);
80 static char *uptok (const char *, int);
83 /* Although the yacc "value" of an expression is not used,
84 since the result is stored in the structure being created,
85 other node types do have values. */
102 struct symtoken ssym;
104 const struct block *bval;
105 enum exp_opcode opcode;
106 struct internalvar *ivar;
113 /* YYSTYPE gets defined by %union */
114 static int parse_number (struct parser_state *,
115 const char *, int, int, YYSTYPE *);
117 static struct type *current_type;
118 static int leftdiv_is_integer;
119 static void push_current_type (void);
120 static void pop_current_type (void);
121 static int search_field;
124 %type <voidval> exp exp1 type_exp start normal_start variable qualified_name
125 %type <tval> type typebase
126 /* %type <bval> block */
128 /* Fancy type parsing. */
131 %token <typed_val_int> INT
132 %token <typed_val_float> FLOAT
134 /* Both NAME and TYPENAME tokens represent symbols in the input,
135 and both convey their data as strings.
136 But a TYPENAME is a string that happens to be defined as a typedef
137 or builtin type name (such as int or char)
138 and a NAME is any other symbol.
139 Contexts where this distinction is not important can use the
140 nonterminal "name", which matches either NAME or TYPENAME. */
143 %token <sval> FIELDNAME
144 %token <voidval> COMPLETE
145 %token <ssym> NAME /* BLOCKNAME defined below to give it higher precedence. */
146 %token <tsym> TYPENAME
148 %type <ssym> name_not_typename
150 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
151 but which would parse as a valid number in the current input radix.
152 E.g. "c" when input_radix==16. Depending on the parse, it will be
153 turned into a name or into a number. */
155 %token <ssym> NAME_OR_INT
157 %token STRUCT CLASS SIZEOF COLONCOLON
160 /* Special type cases, put in to allow the parser to distinguish different
163 %token <sval> DOLLAR_VARIABLE
168 %token <lval> TRUEKEYWORD FALSEKEYWORD
178 %left '<' '>' LEQ GEQ
179 %left LSH RSH DIV MOD
183 %right UNARY INCREMENT DECREMENT
184 %right ARROW '.' '[' '('
186 %token <ssym> BLOCKNAME
193 start : { current_type = NULL;
195 leftdiv_is_integer = 0;
206 { write_exp_elt_opcode (pstate, OP_TYPE);
207 write_exp_elt_type (pstate, $1);
208 write_exp_elt_opcode (pstate, OP_TYPE);
209 current_type = $1; } ;
211 /* Expressions, including the comma operator. */
214 { write_exp_elt_opcode (pstate, BINOP_COMMA); }
217 /* Expressions, not including the comma operator. */
218 exp : exp '^' %prec UNARY
219 { write_exp_elt_opcode (pstate, UNOP_IND);
221 current_type = TYPE_TARGET_TYPE (current_type); }
224 exp : '@' exp %prec UNARY
225 { write_exp_elt_opcode (pstate, UNOP_ADDR);
227 current_type = TYPE_POINTER_TYPE (current_type); }
230 exp : '-' exp %prec UNARY
231 { write_exp_elt_opcode (pstate, UNOP_NEG); }
234 exp : NOT exp %prec UNARY
235 { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
238 exp : INCREMENT '(' exp ')' %prec UNARY
239 { write_exp_elt_opcode (pstate, UNOP_PREINCREMENT); }
242 exp : DECREMENT '(' exp ')' %prec UNARY
243 { write_exp_elt_opcode (pstate, UNOP_PREDECREMENT); }
247 field_exp : exp '.' %prec UNARY
248 { search_field = 1; }
251 exp : field_exp FIELDNAME
252 { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
253 write_exp_string (pstate, $2);
254 write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
258 while (current_type->code ()
261 TYPE_TARGET_TYPE (current_type);
262 current_type = lookup_struct_elt_type (
263 current_type, $2.ptr, 0);
270 { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
271 write_exp_string (pstate, $2);
272 write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
276 while (current_type->code ()
279 TYPE_TARGET_TYPE (current_type);
280 current_type = lookup_struct_elt_type (
281 current_type, $2.ptr, 0);
285 exp : field_exp name COMPLETE
286 { pstate->mark_struct_expression ();
287 write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
288 write_exp_string (pstate, $2);
289 write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
291 exp : field_exp COMPLETE
293 pstate->mark_struct_expression ();
294 write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
297 write_exp_string (pstate, s);
298 write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
302 /* We need to save the current_type value. */
303 { const char *arrayname;
305 = pascal_is_string_type (current_type, NULL, NULL,
306 NULL, NULL, &arrayname);
309 struct stoken stringsval;
312 buf = (char *) alloca (strlen (arrayname) + 1);
313 stringsval.ptr = buf;
314 stringsval.length = strlen (arrayname);
315 strcpy (buf, arrayname);
318 ->field (arrayfieldindex - 1).type ());
319 write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
320 write_exp_string (pstate, stringsval);
321 write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
323 push_current_type (); }
325 { pop_current_type ();
326 write_exp_elt_opcode (pstate, BINOP_SUBSCRIPT);
328 current_type = TYPE_TARGET_TYPE (current_type); }
332 /* This is to save the value of arglist_len
333 being accumulated by an outer function call. */
334 { push_current_type ();
335 pstate->start_arglist (); }
336 arglist ')' %prec ARROW
337 { write_exp_elt_opcode (pstate, OP_FUNCALL);
338 write_exp_elt_longcst (pstate,
339 pstate->end_arglist ());
340 write_exp_elt_opcode (pstate, OP_FUNCALL);
343 current_type = TYPE_TARGET_TYPE (current_type);
349 { pstate->arglist_len = 1; }
350 | arglist ',' exp %prec ABOVE_COMMA
351 { pstate->arglist_len++; }
354 exp : type '(' exp ')' %prec UNARY
357 /* Allow automatic dereference of classes. */
358 if ((current_type->code () == TYPE_CODE_PTR)
359 && (TYPE_TARGET_TYPE (current_type)->code () == TYPE_CODE_STRUCT)
360 && (($1)->code () == TYPE_CODE_STRUCT))
361 write_exp_elt_opcode (pstate, UNOP_IND);
363 write_exp_elt_opcode (pstate, UNOP_CAST);
364 write_exp_elt_type (pstate, $1);
365 write_exp_elt_opcode (pstate, UNOP_CAST);
373 /* Binary operators in order of decreasing precedence. */
376 { write_exp_elt_opcode (pstate, BINOP_MUL); }
380 if (current_type && is_integral_type (current_type))
381 leftdiv_is_integer = 1;
385 if (leftdiv_is_integer && current_type
386 && is_integral_type (current_type))
388 write_exp_elt_opcode (pstate, UNOP_CAST);
389 write_exp_elt_type (pstate,
391 ->builtin_long_double);
393 = parse_type (pstate)->builtin_long_double;
394 write_exp_elt_opcode (pstate, UNOP_CAST);
395 leftdiv_is_integer = 0;
398 write_exp_elt_opcode (pstate, BINOP_DIV);
403 { write_exp_elt_opcode (pstate, BINOP_INTDIV); }
407 { write_exp_elt_opcode (pstate, BINOP_REM); }
411 { write_exp_elt_opcode (pstate, BINOP_ADD); }
415 { write_exp_elt_opcode (pstate, BINOP_SUB); }
419 { write_exp_elt_opcode (pstate, BINOP_LSH); }
423 { write_exp_elt_opcode (pstate, BINOP_RSH); }
427 { write_exp_elt_opcode (pstate, BINOP_EQUAL);
428 current_type = parse_type (pstate)->builtin_bool;
432 exp : exp NOTEQUAL exp
433 { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL);
434 current_type = parse_type (pstate)->builtin_bool;
439 { write_exp_elt_opcode (pstate, BINOP_LEQ);
440 current_type = parse_type (pstate)->builtin_bool;
445 { write_exp_elt_opcode (pstate, BINOP_GEQ);
446 current_type = parse_type (pstate)->builtin_bool;
451 { write_exp_elt_opcode (pstate, BINOP_LESS);
452 current_type = parse_type (pstate)->builtin_bool;
457 { write_exp_elt_opcode (pstate, BINOP_GTR);
458 current_type = parse_type (pstate)->builtin_bool;
463 { write_exp_elt_opcode (pstate, BINOP_BITWISE_AND); }
467 { write_exp_elt_opcode (pstate, BINOP_BITWISE_XOR); }
471 { write_exp_elt_opcode (pstate, BINOP_BITWISE_IOR); }
475 { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
479 { write_exp_elt_opcode (pstate, OP_BOOL);
480 write_exp_elt_longcst (pstate, (LONGEST) $1);
481 current_type = parse_type (pstate)->builtin_bool;
482 write_exp_elt_opcode (pstate, OP_BOOL); }
486 { write_exp_elt_opcode (pstate, OP_BOOL);
487 write_exp_elt_longcst (pstate, (LONGEST) $1);
488 current_type = parse_type (pstate)->builtin_bool;
489 write_exp_elt_opcode (pstate, OP_BOOL); }
493 { write_exp_elt_opcode (pstate, OP_LONG);
494 write_exp_elt_type (pstate, $1.type);
495 current_type = $1.type;
496 write_exp_elt_longcst (pstate, (LONGEST)($1.val));
497 write_exp_elt_opcode (pstate, OP_LONG); }
502 parse_number (pstate, $1.stoken.ptr,
503 $1.stoken.length, 0, &val);
504 write_exp_elt_opcode (pstate, OP_LONG);
505 write_exp_elt_type (pstate, val.typed_val_int.type);
506 current_type = val.typed_val_int.type;
507 write_exp_elt_longcst (pstate, (LONGEST)
508 val.typed_val_int.val);
509 write_exp_elt_opcode (pstate, OP_LONG);
515 { write_exp_elt_opcode (pstate, OP_FLOAT);
516 write_exp_elt_type (pstate, $1.type);
517 current_type = $1.type;
518 write_exp_elt_floatcst (pstate, $1.val);
519 write_exp_elt_opcode (pstate, OP_FLOAT); }
525 exp : DOLLAR_VARIABLE
527 write_dollar_variable (pstate, $1);
529 /* $ is the normal prefix for pascal
530 hexadecimal values but this conflicts
531 with the GDB use for debugger variables
532 so in expression to enter hexadecimal
533 values we still need to use C syntax with
535 std::string tmp ($1.ptr, $1.length);
536 /* Handle current_type. */
537 struct internalvar *intvar
538 = lookup_only_internalvar (tmp.c_str () + 1);
539 if (intvar != nullptr)
541 scoped_value_mark mark;
544 = value_of_internalvar (pstate->gdbarch (),
546 current_type = value_type (val);
551 exp : SIZEOF '(' type ')' %prec UNARY
552 { write_exp_elt_opcode (pstate, OP_LONG);
553 write_exp_elt_type (pstate,
554 parse_type (pstate)->builtin_int);
555 current_type = parse_type (pstate)->builtin_int;
556 $3 = check_typedef ($3);
557 write_exp_elt_longcst (pstate,
558 (LONGEST) TYPE_LENGTH ($3));
559 write_exp_elt_opcode (pstate, OP_LONG); }
562 exp : SIZEOF '(' exp ')' %prec UNARY
563 { write_exp_elt_opcode (pstate, UNOP_SIZEOF);
564 current_type = parse_type (pstate)->builtin_int; }
567 { /* C strings are converted into array constants with
568 an explicit null byte added at the end. Thus
569 the array upper bound is the string length.
570 There is no such thing in C as a completely empty
572 const char *sp = $1.ptr; int count = $1.length;
576 write_exp_elt_opcode (pstate, OP_LONG);
577 write_exp_elt_type (pstate,
580 write_exp_elt_longcst (pstate,
582 write_exp_elt_opcode (pstate, OP_LONG);
584 write_exp_elt_opcode (pstate, OP_LONG);
585 write_exp_elt_type (pstate,
588 write_exp_elt_longcst (pstate, (LONGEST)'\0');
589 write_exp_elt_opcode (pstate, OP_LONG);
590 write_exp_elt_opcode (pstate, OP_ARRAY);
591 write_exp_elt_longcst (pstate, (LONGEST) 0);
592 write_exp_elt_longcst (pstate,
593 (LONGEST) ($1.length));
594 write_exp_elt_opcode (pstate, OP_ARRAY); }
600 struct value * this_val;
601 struct type * this_type;
602 write_exp_elt_opcode (pstate, OP_THIS);
603 write_exp_elt_opcode (pstate, OP_THIS);
604 /* We need type of this. */
606 = value_of_this_silent (pstate->language ());
608 this_type = value_type (this_val);
613 if (this_type->code () == TYPE_CODE_PTR)
615 this_type = TYPE_TARGET_TYPE (this_type);
616 write_exp_elt_opcode (pstate, UNOP_IND);
620 current_type = this_type;
624 /* end of object pascal. */
628 if ($1.sym.symbol != 0)
629 $$ = SYMBOL_BLOCK_VALUE ($1.sym.symbol);
632 std::string copy = copy_name ($1.stoken);
634 lookup_symtab (copy.c_str ());
636 $$ = BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (tem),
639 error (_("No file or function \"%s\"."),
645 block : block COLONCOLON name
647 std::string copy = copy_name ($3);
649 = lookup_symbol (copy.c_str (), $1,
650 VAR_DOMAIN, NULL).symbol;
652 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
653 error (_("No function \"%s\" in specified context."),
655 $$ = SYMBOL_BLOCK_VALUE (tem); }
658 variable: block COLONCOLON name
659 { struct block_symbol sym;
661 std::string copy = copy_name ($3);
662 sym = lookup_symbol (copy.c_str (), $1,
665 error (_("No symbol \"%s\" in specified context."),
668 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
669 write_exp_elt_block (pstate, sym.block);
670 write_exp_elt_sym (pstate, sym.symbol);
671 write_exp_elt_opcode (pstate, OP_VAR_VALUE); }
674 qualified_name: typebase COLONCOLON name
676 struct type *type = $1;
678 if (type->code () != TYPE_CODE_STRUCT
679 && type->code () != TYPE_CODE_UNION)
680 error (_("`%s' is not defined as an aggregate type."),
683 write_exp_elt_opcode (pstate, OP_SCOPE);
684 write_exp_elt_type (pstate, type);
685 write_exp_string (pstate, $3);
686 write_exp_elt_opcode (pstate, OP_SCOPE);
690 variable: qualified_name
693 std::string name = copy_name ($2);
695 struct block_symbol sym
696 = lookup_symbol (name.c_str (), nullptr,
697 VAR_DOMAIN, nullptr);
698 write_exp_symbol_reference (pstate, name.c_str (),
703 variable: name_not_typename
704 { struct block_symbol sym = $1.sym;
708 if (symbol_read_needs_frame (sym.symbol))
709 pstate->block_tracker->update (sym);
711 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
712 write_exp_elt_block (pstate, sym.block);
713 write_exp_elt_sym (pstate, sym.symbol);
714 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
715 current_type = sym.symbol->type; }
716 else if ($1.is_a_field_of_this)
718 struct value * this_val;
719 struct type * this_type;
720 /* Object pascal: it hangs off of `this'. Must
721 not inadvertently convert from a method call
723 pstate->block_tracker->update (sym);
724 write_exp_elt_opcode (pstate, OP_THIS);
725 write_exp_elt_opcode (pstate, OP_THIS);
726 write_exp_elt_opcode (pstate, STRUCTOP_PTR);
727 write_exp_string (pstate, $1.stoken);
728 write_exp_elt_opcode (pstate, STRUCTOP_PTR);
729 /* We need type of this. */
731 = value_of_this_silent (pstate->language ());
733 this_type = value_type (this_val);
737 current_type = lookup_struct_elt_type (
739 copy_name ($1.stoken).c_str (), 0);
745 struct bound_minimal_symbol msymbol;
746 std::string arg = copy_name ($1.stoken);
749 lookup_bound_minimal_symbol (arg.c_str ());
750 if (msymbol.minsym != NULL)
751 write_exp_msymbol (pstate, msymbol);
752 else if (!have_full_symbols ()
753 && !have_partial_symbols ())
754 error (_("No symbol table is loaded. "
755 "Use the \"file\" command."));
757 error (_("No symbol \"%s\" in current context."),
767 /* We used to try to recognize more pointer to member types here, but
768 that didn't work (shift/reduce conflicts meant that these rules never
769 got executed). The problem is that
770 int (foo::bar::baz::bizzle)
771 is a function type but
772 int (foo::bar::baz::bizzle::*)
773 is a pointer to member type. Stroustrup loses again! */
778 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
780 { $$ = lookup_pointer_type ($2); }
785 = lookup_struct (copy_name ($2).c_str (),
786 pstate->expression_context_block);
790 = lookup_struct (copy_name ($2).c_str (),
791 pstate->expression_context_block);
793 /* "const" and "volatile" are curently ignored. A type qualifier
794 after the type is handled in the ptype rule. I think these could
798 name : NAME { $$ = $1.stoken; }
799 | BLOCKNAME { $$ = $1.stoken; }
800 | TYPENAME { $$ = $1.stoken; }
801 | NAME_OR_INT { $$ = $1.stoken; }
804 name_not_typename : NAME
806 /* These would be useful if name_not_typename was useful, but it is just
807 a fake for "variable", so these cause reduce/reduce conflicts because
808 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
809 =exp) or just an exp. If name_not_typename was ever used in an lvalue
810 context where only a name could occur, this might be useful.
817 /* Take care of parsing a number (anything that starts with a digit).
818 Set yylval and return the token type; update lexptr.
819 LEN is the number of characters in it. */
821 /*** Needs some error checking for the float case ***/
824 parse_number (struct parser_state *par_state,
825 const char *p, int len, int parsed_float, YYSTYPE *putithere)
827 /* FIXME: Shouldn't these be unsigned? We don't deal with negative values
828 here, and we do kind of silly things like cast to unsigned. */
835 int base = input_radix;
838 /* Number of "L" suffixes encountered. */
841 /* We have found a "L" or "U" suffix. */
842 int found_suffix = 0;
845 struct type *signed_type;
846 struct type *unsigned_type;
850 /* Handle suffixes: 'f' for float, 'l' for long double.
851 FIXME: This appears to be an extension -- do we want this? */
852 if (len >= 1 && tolower (p[len - 1]) == 'f')
854 putithere->typed_val_float.type
855 = parse_type (par_state)->builtin_float;
858 else if (len >= 1 && tolower (p[len - 1]) == 'l')
860 putithere->typed_val_float.type
861 = parse_type (par_state)->builtin_long_double;
864 /* Default type for floating-point literals is double. */
867 putithere->typed_val_float.type
868 = parse_type (par_state)->builtin_double;
871 if (!parse_float (p, len,
872 putithere->typed_val_float.type,
873 putithere->typed_val_float.val))
878 /* Handle base-switching prefixes 0x, 0t, 0d, 0. */
912 if (c >= 'A' && c <= 'Z')
914 if (c != 'l' && c != 'u')
916 if (c >= '0' && c <= '9')
924 if (base > 10 && c >= 'a' && c <= 'f')
928 n += i = c - 'a' + 10;
941 return ERROR; /* Char not a digit */
944 return ERROR; /* Invalid digit in this base. */
946 /* Portably test for overflow (only works for nonzero values, so make
947 a second check for zero). FIXME: Can't we just make n and prevn
948 unsigned and avoid this? */
949 if (c != 'l' && c != 'u' && (prevn >= n) && n != 0)
950 unsigned_p = 1; /* Try something unsigned. */
952 /* Portably test for unsigned overflow.
953 FIXME: This check is wrong; for example it doesn't find overflow
954 on 0x123456789 when LONGEST is 32 bits. */
955 if (c != 'l' && c != 'u' && n != 0)
957 if ((unsigned_p && (ULONGEST) prevn >= (ULONGEST) n))
958 error (_("Numeric constant too large."));
963 /* An integer constant is an int, a long, or a long long. An L
964 suffix forces it to be long; an LL suffix forces it to be long
965 long. If not forced to a larger size, it gets the first type of
966 the above that it fits in. To figure out whether it fits, we
967 shift it right and see whether anything remains. Note that we
968 can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
969 operation, because many compilers will warn about such a shift
970 (which always produces a zero result). Sometimes gdbarch_int_bit
971 or gdbarch_long_bit will be that big, sometimes not. To deal with
972 the case where it is we just always shift the value more than
973 once, with fewer bits each time. */
975 un = (ULONGEST)n >> 2;
977 && (un >> (gdbarch_int_bit (par_state->gdbarch ()) - 2)) == 0)
980 = ((ULONGEST)1) << (gdbarch_int_bit (par_state->gdbarch ()) - 1);
982 /* A large decimal (not hex or octal) constant (between INT_MAX
983 and UINT_MAX) is a long or unsigned long, according to ANSI,
984 never an unsigned int, but this code treats it as unsigned
985 int. This probably should be fixed. GCC gives a warning on
988 unsigned_type = parse_type (par_state)->builtin_unsigned_int;
989 signed_type = parse_type (par_state)->builtin_int;
992 && (un >> (gdbarch_long_bit (par_state->gdbarch ()) - 2)) == 0)
995 = ((ULONGEST)1) << (gdbarch_long_bit (par_state->gdbarch ()) - 1);
996 unsigned_type = parse_type (par_state)->builtin_unsigned_long;
997 signed_type = parse_type (par_state)->builtin_long;
1002 if (sizeof (ULONGEST) * HOST_CHAR_BIT
1003 < gdbarch_long_long_bit (par_state->gdbarch ()))
1004 /* A long long does not fit in a LONGEST. */
1005 shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
1007 shift = (gdbarch_long_long_bit (par_state->gdbarch ()) - 1);
1008 high_bit = (ULONGEST) 1 << shift;
1009 unsigned_type = parse_type (par_state)->builtin_unsigned_long_long;
1010 signed_type = parse_type (par_state)->builtin_long_long;
1013 putithere->typed_val_int.val = n;
1015 /* If the high bit of the worked out type is set then this number
1016 has to be unsigned. */
1018 if (unsigned_p || (n & high_bit))
1020 putithere->typed_val_int.type = unsigned_type;
1024 putithere->typed_val_int.type = signed_type;
1033 struct type *stored;
1034 struct type_push *next;
1037 static struct type_push *tp_top = NULL;
1040 push_current_type (void)
1042 struct type_push *tpnew;
1043 tpnew = (struct type_push *) malloc (sizeof (struct type_push));
1044 tpnew->next = tp_top;
1045 tpnew->stored = current_type;
1046 current_type = NULL;
1051 pop_current_type (void)
1053 struct type_push *tp = tp_top;
1056 current_type = tp->stored;
1066 enum exp_opcode opcode;
1069 static const struct token tokentab3[] =
1071 {"shr", RSH, BINOP_END},
1072 {"shl", LSH, BINOP_END},
1073 {"and", ANDAND, BINOP_END},
1074 {"div", DIV, BINOP_END},
1075 {"not", NOT, BINOP_END},
1076 {"mod", MOD, BINOP_END},
1077 {"inc", INCREMENT, BINOP_END},
1078 {"dec", DECREMENT, BINOP_END},
1079 {"xor", XOR, BINOP_END}
1082 static const struct token tokentab2[] =
1084 {"or", OR, BINOP_END},
1085 {"<>", NOTEQUAL, BINOP_END},
1086 {"<=", LEQ, BINOP_END},
1087 {">=", GEQ, BINOP_END},
1088 {":=", ASSIGN, BINOP_END},
1089 {"::", COLONCOLON, BINOP_END} };
1091 /* Allocate uppercased var: */
1092 /* make an uppercased copy of tokstart. */
1094 uptok (const char *tokstart, int namelen)
1097 char *uptokstart = (char *)malloc(namelen+1);
1098 for (i = 0;i <= namelen;i++)
1100 if ((tokstart[i]>='a' && tokstart[i]<='z'))
1101 uptokstart[i] = tokstart[i]-('a'-'A');
1103 uptokstart[i] = tokstart[i];
1105 uptokstart[namelen]='\0';
1109 /* Read one token, getting characters through lexptr. */
1116 const char *tokstart;
1119 int explen, tempbufindex;
1120 static char *tempbuf;
1121 static int tempbufsize;
1125 pstate->prev_lexptr = pstate->lexptr;
1127 tokstart = pstate->lexptr;
1128 explen = strlen (pstate->lexptr);
1130 /* See if it is a special token of length 3. */
1132 for (int i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
1133 if (strncasecmp (tokstart, tokentab3[i].oper, 3) == 0
1134 && (!isalpha (tokentab3[i].oper[0]) || explen == 3
1135 || (!isalpha (tokstart[3])
1136 && !isdigit (tokstart[3]) && tokstart[3] != '_')))
1138 pstate->lexptr += 3;
1139 yylval.opcode = tokentab3[i].opcode;
1140 return tokentab3[i].token;
1143 /* See if it is a special token of length 2. */
1145 for (int i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1146 if (strncasecmp (tokstart, tokentab2[i].oper, 2) == 0
1147 && (!isalpha (tokentab2[i].oper[0]) || explen == 2
1148 || (!isalpha (tokstart[2])
1149 && !isdigit (tokstart[2]) && tokstart[2] != '_')))
1151 pstate->lexptr += 2;
1152 yylval.opcode = tokentab2[i].opcode;
1153 return tokentab2[i].token;
1156 switch (c = *tokstart)
1159 if (search_field && pstate->parse_completion)
1171 /* We either have a character constant ('0' or '\177' for example)
1172 or we have a quoted symbol reference ('foo(int,int)' in object pascal
1175 c = *pstate->lexptr++;
1177 c = parse_escape (pstate->gdbarch (), &pstate->lexptr);
1179 error (_("Empty character constant."));
1181 yylval.typed_val_int.val = c;
1182 yylval.typed_val_int.type = parse_type (pstate)->builtin_char;
1184 c = *pstate->lexptr++;
1187 namelen = skip_quoted (tokstart) - tokstart;
1190 pstate->lexptr = tokstart + namelen;
1191 if (pstate->lexptr[-1] != '\'')
1192 error (_("Unmatched single quote."));
1195 uptokstart = uptok(tokstart,namelen);
1198 error (_("Invalid character constant."));
1208 if (paren_depth == 0)
1215 if (pstate->comma_terminates && paren_depth == 0)
1221 /* Might be a floating point number. */
1222 if (pstate->lexptr[1] < '0' || pstate->lexptr[1] > '9')
1224 goto symbol; /* Nope, must be a symbol. */
1240 /* It's a number. */
1241 int got_dot = 0, got_e = 0, toktype;
1242 const char *p = tokstart;
1243 int hex = input_radix > 10;
1245 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1250 else if (c == '0' && (p[1]=='t' || p[1]=='T'
1251 || p[1]=='d' || p[1]=='D'))
1259 /* This test includes !hex because 'e' is a valid hex digit
1260 and thus does not indicate a floating point number when
1261 the radix is hex. */
1262 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1263 got_dot = got_e = 1;
1264 /* This test does not include !hex, because a '.' always indicates
1265 a decimal floating point number regardless of the radix. */
1266 else if (!got_dot && *p == '.')
1268 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1269 && (*p == '-' || *p == '+'))
1270 /* This is the sign of the exponent, not the end of the
1273 /* We will take any letters or digits. parse_number will
1274 complain if past the radix, or if L or U are not final. */
1275 else if ((*p < '0' || *p > '9')
1276 && ((*p < 'a' || *p > 'z')
1277 && (*p < 'A' || *p > 'Z')))
1280 toktype = parse_number (pstate, tokstart,
1281 p - tokstart, got_dot | got_e, &yylval);
1282 if (toktype == ERROR)
1284 char *err_copy = (char *) alloca (p - tokstart + 1);
1286 memcpy (err_copy, tokstart, p - tokstart);
1287 err_copy[p - tokstart] = 0;
1288 error (_("Invalid number \"%s\"."), err_copy);
1319 /* Build the gdb internal form of the input string in tempbuf,
1320 translating any standard C escape forms seen. Note that the
1321 buffer is null byte terminated *only* for the convenience of
1322 debugging gdb itself and printing the buffer contents when
1323 the buffer contains no embedded nulls. Gdb does not depend
1324 upon the buffer being null byte terminated, it uses the length
1325 string instead. This allows gdb to handle C strings (as well
1326 as strings in other languages) with embedded null bytes. */
1328 tokptr = ++tokstart;
1332 /* Grow the static temp buffer if necessary, including allocating
1333 the first one on demand. */
1334 if (tempbufindex + 1 >= tempbufsize)
1336 tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1343 /* Do nothing, loop will terminate. */
1347 c = parse_escape (pstate->gdbarch (), &tokptr);
1352 tempbuf[tempbufindex++] = c;
1355 tempbuf[tempbufindex++] = *tokptr++;
1358 } while ((*tokptr != '"') && (*tokptr != '\0'));
1359 if (*tokptr++ != '"')
1361 error (_("Unterminated string in expression."));
1363 tempbuf[tempbufindex] = '\0'; /* See note above. */
1364 yylval.sval.ptr = tempbuf;
1365 yylval.sval.length = tempbufindex;
1366 pstate->lexptr = tokptr;
1370 if (!(c == '_' || c == '$'
1371 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1372 /* We must have come across a bad character (e.g. ';'). */
1373 error (_("Invalid character '%c' in expression."), c);
1375 /* It's a name. See how long it is. */
1377 for (c = tokstart[namelen];
1378 (c == '_' || c == '$' || (c >= '0' && c <= '9')
1379 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1381 /* Template parameter lists are part of the name.
1382 FIXME: This mishandles `print $a<4&&$a>3'. */
1386 int nesting_level = 1;
1387 while (tokstart[++i])
1389 if (tokstart[i] == '<')
1391 else if (tokstart[i] == '>')
1393 if (--nesting_level == 0)
1397 if (tokstart[i] == '>')
1403 /* do NOT uppercase internals because of registers !!! */
1404 c = tokstart[++namelen];
1407 uptokstart = uptok(tokstart,namelen);
1409 /* The token "if" terminates the expression and is NOT
1410 removed from the input stream. */
1411 if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1417 pstate->lexptr += namelen;
1421 /* Catch specific keywords. Should be done with a data structure. */
1425 if (strcmp (uptokstart, "OBJECT") == 0)
1430 if (strcmp (uptokstart, "RECORD") == 0)
1435 if (strcmp (uptokstart, "SIZEOF") == 0)
1442 if (strcmp (uptokstart, "CLASS") == 0)
1447 if (strcmp (uptokstart, "FALSE") == 0)
1451 return FALSEKEYWORD;
1455 if (strcmp (uptokstart, "TRUE") == 0)
1461 if (strcmp (uptokstart, "SELF") == 0)
1463 /* Here we search for 'this' like
1464 inserted in FPC stabs debug info. */
1465 static const char this_name[] = "this";
1467 if (lookup_symbol (this_name, pstate->expression_context_block,
1468 VAR_DOMAIN, NULL).symbol)
1479 yylval.sval.ptr = tokstart;
1480 yylval.sval.length = namelen;
1482 if (*tokstart == '$')
1485 return DOLLAR_VARIABLE;
1488 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1489 functions or symtabs. If this is not so, then ...
1490 Use token-type TYPENAME for symbols that happen to be defined
1491 currently as names of types; NAME for other symbols.
1492 The caller is not constrained to care about the distinction. */
1494 std::string tmp = copy_name (yylval.sval);
1496 struct field_of_this_result is_a_field_of_this;
1500 is_a_field_of_this.type = NULL;
1501 if (search_field && current_type)
1502 is_a_field = (lookup_struct_elt_type (current_type,
1503 tmp.c_str (), 1) != NULL);
1507 sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1508 VAR_DOMAIN, &is_a_field_of_this).symbol;
1509 /* second chance uppercased (as Free Pascal does). */
1510 if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1512 for (int i = 0; i <= namelen; i++)
1514 if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1515 tmp[i] -= ('a'-'A');
1517 if (search_field && current_type)
1518 is_a_field = (lookup_struct_elt_type (current_type,
1519 tmp.c_str (), 1) != NULL);
1523 sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1524 VAR_DOMAIN, &is_a_field_of_this).symbol;
1526 /* Third chance Capitalized (as GPC does). */
1527 if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1529 for (int i = 0; i <= namelen; i++)
1533 if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1534 tmp[i] -= ('a'-'A');
1537 if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
1538 tmp[i] -= ('A'-'a');
1540 if (search_field && current_type)
1541 is_a_field = (lookup_struct_elt_type (current_type,
1542 tmp.c_str (), 1) != NULL);
1546 sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1547 VAR_DOMAIN, &is_a_field_of_this).symbol;
1550 if (is_a_field || (is_a_field_of_this.type != NULL))
1552 tempbuf = (char *) realloc (tempbuf, namelen + 1);
1553 strncpy (tempbuf, tmp.c_str (), namelen);
1554 tempbuf [namelen] = 0;
1555 yylval.sval.ptr = tempbuf;
1556 yylval.sval.length = namelen;
1557 yylval.ssym.sym.symbol = NULL;
1558 yylval.ssym.sym.block = NULL;
1560 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1566 /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1567 no psymtabs (coff, xcoff, or some future change to blow away the
1568 psymtabs once once symbols are read). */
1569 if ((sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1570 || lookup_symtab (tmp.c_str ()))
1572 yylval.ssym.sym.symbol = sym;
1573 yylval.ssym.sym.block = NULL;
1574 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1578 if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1581 /* Despite the following flaw, we need to keep this code enabled.
1582 Because we can get called from check_stub_method, if we don't
1583 handle nested types then it screws many operations in any
1584 program which uses nested types. */
1585 /* In "A::x", if x is a member function of A and there happens
1586 to be a type (nested or not, since the stabs don't make that
1587 distinction) named x, then this code incorrectly thinks we
1588 are dealing with nested types rather than a member function. */
1591 const char *namestart;
1592 struct symbol *best_sym;
1594 /* Look ahead to detect nested types. This probably should be
1595 done in the grammar, but trying seemed to introduce a lot
1596 of shift/reduce and reduce/reduce conflicts. It's possible
1597 that it could be done, though. Or perhaps a non-grammar, but
1598 less ad hoc, approach would work well. */
1600 /* Since we do not currently have any way of distinguishing
1601 a nested type from a non-nested one (the stabs don't tell
1602 us whether a type is nested), we just ignore the
1609 /* Skip whitespace. */
1610 while (*p == ' ' || *p == '\t' || *p == '\n')
1612 if (*p == ':' && p[1] == ':')
1614 /* Skip the `::'. */
1616 /* Skip whitespace. */
1617 while (*p == ' ' || *p == '\t' || *p == '\n')
1620 while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1621 || (*p >= 'a' && *p <= 'z')
1622 || (*p >= 'A' && *p <= 'Z'))
1626 struct symbol *cur_sym;
1627 /* As big as the whole rest of the expression, which is
1628 at least big enough. */
1630 = (char *) alloca (tmp.size () + strlen (namestart)
1635 memcpy (tmp1, tmp.c_str (), tmp.size ());
1636 tmp1 += tmp.size ();
1637 memcpy (tmp1, "::", 2);
1639 memcpy (tmp1, namestart, p - namestart);
1640 tmp1[p - namestart] = '\0';
1642 = lookup_symbol (ncopy,
1643 pstate->expression_context_block,
1644 VAR_DOMAIN, NULL).symbol;
1647 if (SYMBOL_CLASS (cur_sym) == LOC_TYPEDEF)
1665 yylval.tsym.type = SYMBOL_TYPE (best_sym);
1667 yylval.tsym.type = SYMBOL_TYPE (sym);
1673 = language_lookup_primitive_type (pstate->language (),
1674 pstate->gdbarch (), tmp.c_str ());
1675 if (yylval.tsym.type != NULL)
1681 /* Input names that aren't symbols but ARE valid hex numbers,
1682 when the input radix permits them, can be names or numbers
1683 depending on the parse. Note we support radixes > 16 here. */
1685 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1686 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1688 YYSTYPE newlval; /* Its value is ignored. */
1689 hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1692 yylval.ssym.sym.symbol = sym;
1693 yylval.ssym.sym.block = NULL;
1694 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1701 /* Any other kind of symbol. */
1702 yylval.ssym.sym.symbol = sym;
1703 yylval.ssym.sym.block = NULL;
1708 /* See language.h. */
1711 pascal_language::parser (struct parser_state *par_state) const
1713 /* Setting up the parser state. */
1714 scoped_restore pstate_restore = make_scoped_restore (&pstate);
1715 gdb_assert (par_state != NULL);
1723 yyerror (const char *msg)
1725 if (pstate->prev_lexptr)
1726 pstate->lexptr = pstate->prev_lexptr;
1728 error (_("A %s in expression, near `%s'."), msg, pstate->lexptr);