1 /* YACC parser for Pascal expressions, for GDB.
2 Copyright (C) 2000-2022 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"
60 #define parse_type(ps) builtin_type (ps->gdbarch ())
62 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror,
64 #define GDB_YY_REMAP_PREFIX pascal_
67 /* The state of the parser, used internally when we are parsing the
70 static struct parser_state *pstate = NULL;
72 /* Depth of parentheses. */
73 static int paren_depth;
77 static int yylex (void);
79 static void yyerror (const char *);
81 static char *uptok (const char *, int);
86 /* Although the yacc "value" of an expression is not used,
87 since the result is stored in the structure being created,
88 other node types do have values. */
105 struct symtoken ssym;
107 const struct block *bval;
108 enum exp_opcode opcode;
109 struct internalvar *ivar;
116 /* YYSTYPE gets defined by %union */
117 static int parse_number (struct parser_state *,
118 const char *, int, int, YYSTYPE *);
120 static struct type *current_type;
121 static int leftdiv_is_integer;
122 static void push_current_type (void);
123 static void pop_current_type (void);
124 static int search_field;
127 %type <voidval> exp exp1 type_exp start normal_start variable qualified_name
128 %type <tval> type typebase
129 /* %type <bval> block */
131 /* Fancy type parsing. */
134 %token <typed_val_int> INT
135 %token <typed_val_float> FLOAT
137 /* Both NAME and TYPENAME tokens represent symbols in the input,
138 and both convey their data as strings.
139 But a TYPENAME is a string that happens to be defined as a typedef
140 or builtin type name (such as int or char)
141 and a NAME is any other symbol.
142 Contexts where this distinction is not important can use the
143 nonterminal "name", which matches either NAME or TYPENAME. */
146 %token <sval> FIELDNAME
147 %token <voidval> COMPLETE
148 %token <ssym> NAME /* BLOCKNAME defined below to give it higher precedence. */
149 %token <tsym> TYPENAME
151 %type <ssym> name_not_typename
153 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
154 but which would parse as a valid number in the current input radix.
155 E.g. "c" when input_radix==16. Depending on the parse, it will be
156 turned into a name or into a number. */
158 %token <ssym> NAME_OR_INT
160 %token STRUCT CLASS SIZEOF COLONCOLON
163 /* Special type cases, put in to allow the parser to distinguish different
166 %token <sval> DOLLAR_VARIABLE
171 %token <lval> TRUEKEYWORD FALSEKEYWORD
181 %left '<' '>' LEQ GEQ
182 %left LSH RSH DIV MOD
186 %right UNARY INCREMENT DECREMENT
187 %right ARROW '.' '[' '('
189 %token <ssym> BLOCKNAME
196 start : { current_type = NULL;
198 leftdiv_is_integer = 0;
210 pstate->push_new<type_operation> ($1);
211 current_type = $1; } ;
213 /* Expressions, including the comma operator. */
216 { pstate->wrap2<comma_operation> (); }
219 /* Expressions, not including the comma operator. */
220 exp : exp '^' %prec UNARY
221 { pstate->wrap<unop_ind_operation> ();
223 current_type = TYPE_TARGET_TYPE (current_type); }
226 exp : '@' exp %prec UNARY
227 { pstate->wrap<unop_addr_operation> ();
229 current_type = TYPE_POINTER_TYPE (current_type); }
232 exp : '-' exp %prec UNARY
233 { pstate->wrap<unary_neg_operation> (); }
236 exp : NOT exp %prec UNARY
237 { pstate->wrap<unary_logical_not_operation> (); }
240 exp : INCREMENT '(' exp ')' %prec UNARY
241 { pstate->wrap<preinc_operation> (); }
244 exp : DECREMENT '(' exp ')' %prec UNARY
245 { pstate->wrap<predec_operation> (); }
249 field_exp : exp '.' %prec UNARY
250 { search_field = 1; }
253 exp : field_exp FIELDNAME
255 pstate->push_new<structop_operation>
256 (pstate->pop (), copy_name ($2));
260 while (current_type->code ()
263 TYPE_TARGET_TYPE (current_type);
264 current_type = lookup_struct_elt_type (
265 current_type, $2.ptr, 0);
273 pstate->push_new<structop_operation>
274 (pstate->pop (), copy_name ($2));
278 while (current_type->code ()
281 TYPE_TARGET_TYPE (current_type);
282 current_type = lookup_struct_elt_type (
283 current_type, $2.ptr, 0);
287 exp : field_exp name COMPLETE
289 structop_base_operation *op
290 = new structop_ptr_operation (pstate->pop (),
292 pstate->mark_struct_expression (op);
293 pstate->push (operation_up (op));
296 exp : field_exp COMPLETE
298 structop_base_operation *op
299 = new structop_ptr_operation (pstate->pop (), "");
300 pstate->mark_struct_expression (op);
301 pstate->push (operation_up (op));
306 /* We need to save the current_type value. */
307 { const char *arrayname;
309 = pascal_is_string_type (current_type, NULL, NULL,
310 NULL, NULL, &arrayname);
315 ->field (arrayfieldindex - 1).type ());
316 pstate->push_new<structop_operation>
317 (pstate->pop (), arrayname);
319 push_current_type (); }
321 { pop_current_type ();
322 pstate->wrap2<subscript_operation> ();
324 current_type = TYPE_TARGET_TYPE (current_type); }
328 /* This is to save the value of arglist_len
329 being accumulated by an outer function call. */
330 { push_current_type ();
331 pstate->start_arglist (); }
332 arglist ')' %prec ARROW
334 std::vector<operation_up> args
335 = pstate->pop_vector (pstate->end_arglist ());
336 pstate->push_new<funcall_operation>
337 (pstate->pop (), std::move (args));
340 current_type = TYPE_TARGET_TYPE (current_type);
346 { pstate->arglist_len = 1; }
347 | arglist ',' exp %prec ABOVE_COMMA
348 { pstate->arglist_len++; }
351 exp : type '(' exp ')' %prec UNARY
354 /* Allow automatic dereference of classes. */
355 if ((current_type->code () == TYPE_CODE_PTR)
356 && (TYPE_TARGET_TYPE (current_type)->code () == TYPE_CODE_STRUCT)
357 && (($1)->code () == TYPE_CODE_STRUCT))
358 pstate->wrap<unop_ind_operation> ();
360 pstate->push_new<unop_cast_operation>
361 (pstate->pop (), $1);
369 /* Binary operators in order of decreasing precedence. */
372 { pstate->wrap2<mul_operation> (); }
376 if (current_type && is_integral_type (current_type))
377 leftdiv_is_integer = 1;
381 if (leftdiv_is_integer && current_type
382 && is_integral_type (current_type))
384 pstate->push_new<unop_cast_operation>
386 parse_type (pstate)->builtin_long_double);
388 = parse_type (pstate)->builtin_long_double;
389 leftdiv_is_integer = 0;
392 pstate->wrap2<div_operation> ();
397 { pstate->wrap2<intdiv_operation> (); }
401 { pstate->wrap2<rem_operation> (); }
405 { pstate->wrap2<add_operation> (); }
409 { pstate->wrap2<sub_operation> (); }
413 { pstate->wrap2<lsh_operation> (); }
417 { pstate->wrap2<rsh_operation> (); }
422 pstate->wrap2<equal_operation> ();
423 current_type = parse_type (pstate)->builtin_bool;
427 exp : exp NOTEQUAL exp
429 pstate->wrap2<notequal_operation> ();
430 current_type = parse_type (pstate)->builtin_bool;
436 pstate->wrap2<leq_operation> ();
437 current_type = parse_type (pstate)->builtin_bool;
443 pstate->wrap2<geq_operation> ();
444 current_type = parse_type (pstate)->builtin_bool;
450 pstate->wrap2<less_operation> ();
451 current_type = parse_type (pstate)->builtin_bool;
457 pstate->wrap2<gtr_operation> ();
458 current_type = parse_type (pstate)->builtin_bool;
463 { pstate->wrap2<bitwise_and_operation> (); }
467 { pstate->wrap2<bitwise_xor_operation> (); }
471 { pstate->wrap2<bitwise_ior_operation> (); }
475 { pstate->wrap2<assign_operation> (); }
480 pstate->push_new<bool_operation> ($1);
481 current_type = parse_type (pstate)->builtin_bool;
487 pstate->push_new<bool_operation> ($1);
488 current_type = parse_type (pstate)->builtin_bool;
494 pstate->push_new<long_const_operation>
496 current_type = $1.type;
502 parse_number (pstate, $1.stoken.ptr,
503 $1.stoken.length, 0, &val);
504 pstate->push_new<long_const_operation>
505 (val.typed_val_int.type,
506 val.typed_val_int.val);
507 current_type = val.typed_val_int.type;
515 std::copy (std::begin ($1.val), std::end ($1.val),
517 pstate->push_new<float_const_operation> ($1.type, data);
524 exp : DOLLAR_VARIABLE
526 pstate->push_dollar ($1);
528 /* $ is the normal prefix for pascal
529 hexadecimal values but this conflicts
530 with the GDB use for debugger variables
531 so in expression to enter hexadecimal
532 values we still need to use C syntax with
534 std::string tmp ($1.ptr, $1.length);
535 /* Handle current_type. */
536 struct internalvar *intvar
537 = lookup_only_internalvar (tmp.c_str () + 1);
538 if (intvar != nullptr)
540 scoped_value_mark mark;
543 = value_of_internalvar (pstate->gdbarch (),
545 current_type = value_type (val);
550 exp : SIZEOF '(' type ')' %prec UNARY
552 current_type = parse_type (pstate)->builtin_int;
553 $3 = check_typedef ($3);
554 pstate->push_new<long_const_operation>
555 (parse_type (pstate)->builtin_int,
559 exp : SIZEOF '(' exp ')' %prec UNARY
560 { pstate->wrap<unop_sizeof_operation> ();
561 current_type = parse_type (pstate)->builtin_int; }
564 { /* C strings are converted into array constants with
565 an explicit null byte added at the end. Thus
566 the array upper bound is the string length.
567 There is no such thing in C as a completely empty
569 const char *sp = $1.ptr; int count = $1.length;
571 std::vector<operation_up> args (count + 1);
572 for (int i = 0; i < count; ++i)
573 args[i] = (make_operation<long_const_operation>
574 (parse_type (pstate)->builtin_char,
576 args[count] = (make_operation<long_const_operation>
577 (parse_type (pstate)->builtin_char,
579 pstate->push_new<array_operation>
580 (0, $1.length, std::move (args));
587 struct value * this_val;
588 struct type * this_type;
589 pstate->push_new<op_this_operation> ();
590 /* We need type of this. */
592 = value_of_this_silent (pstate->language ());
594 this_type = value_type (this_val);
599 if (this_type->code () == TYPE_CODE_PTR)
601 this_type = TYPE_TARGET_TYPE (this_type);
602 pstate->wrap<unop_ind_operation> ();
606 current_type = this_type;
610 /* end of object pascal. */
614 if ($1.sym.symbol != 0)
615 $$ = $1.sym.symbol->value_block ();
618 std::string copy = copy_name ($1.stoken);
620 lookup_symtab (copy.c_str ());
622 $$ = (tem->compunit ()->blockvector ()
625 error (_("No file or function \"%s\"."),
631 block : block COLONCOLON name
633 std::string copy = copy_name ($3);
635 = lookup_symbol (copy.c_str (), $1,
636 VAR_DOMAIN, NULL).symbol;
638 if (!tem || tem->aclass () != LOC_BLOCK)
639 error (_("No function \"%s\" in specified context."),
641 $$ = tem->value_block (); }
644 variable: block COLONCOLON name
645 { struct block_symbol sym;
647 std::string copy = copy_name ($3);
648 sym = lookup_symbol (copy.c_str (), $1,
651 error (_("No symbol \"%s\" in specified context."),
654 pstate->push_new<var_value_operation> (sym);
658 qualified_name: typebase COLONCOLON name
660 struct type *type = $1;
662 if (type->code () != TYPE_CODE_STRUCT
663 && type->code () != TYPE_CODE_UNION)
664 error (_("`%s' is not defined as an aggregate type."),
667 pstate->push_new<scope_operation>
668 (type, copy_name ($3));
672 variable: qualified_name
675 std::string name = copy_name ($2);
677 struct block_symbol sym
678 = lookup_symbol (name.c_str (), nullptr,
679 VAR_DOMAIN, nullptr);
680 pstate->push_symbol (name.c_str (), sym);
684 variable: name_not_typename
685 { struct block_symbol sym = $1.sym;
689 if (symbol_read_needs_frame (sym.symbol))
690 pstate->block_tracker->update (sym);
692 pstate->push_new<var_value_operation> (sym);
693 current_type = sym.symbol->type (); }
694 else if ($1.is_a_field_of_this)
696 struct value * this_val;
697 struct type * this_type;
698 /* Object pascal: it hangs off of `this'. Must
699 not inadvertently convert from a method call
701 pstate->block_tracker->update (sym);
703 = make_operation<op_this_operation> ();
704 pstate->push_new<structop_operation>
705 (std::move (thisop), copy_name ($1.stoken));
706 /* We need type of this. */
708 = value_of_this_silent (pstate->language ());
710 this_type = value_type (this_val);
714 current_type = lookup_struct_elt_type (
716 copy_name ($1.stoken).c_str (), 0);
722 struct bound_minimal_symbol msymbol;
723 std::string arg = copy_name ($1.stoken);
726 lookup_bound_minimal_symbol (arg.c_str ());
727 if (msymbol.minsym != NULL)
728 pstate->push_new<var_msym_value_operation>
730 else if (!have_full_symbols ()
731 && !have_partial_symbols ())
732 error (_("No symbol table is loaded. "
733 "Use the \"file\" command."));
735 error (_("No symbol \"%s\" in current context."),
745 /* We used to try to recognize more pointer to member types here, but
746 that didn't work (shift/reduce conflicts meant that these rules never
747 got executed). The problem is that
748 int (foo::bar::baz::bizzle)
749 is a function type but
750 int (foo::bar::baz::bizzle::*)
751 is a pointer to member type. Stroustrup loses again! */
756 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
758 { $$ = lookup_pointer_type ($2); }
763 = lookup_struct (copy_name ($2).c_str (),
764 pstate->expression_context_block);
768 = lookup_struct (copy_name ($2).c_str (),
769 pstate->expression_context_block);
771 /* "const" and "volatile" are curently ignored. A type qualifier
772 after the type is handled in the ptype rule. I think these could
776 name : NAME { $$ = $1.stoken; }
777 | BLOCKNAME { $$ = $1.stoken; }
778 | TYPENAME { $$ = $1.stoken; }
779 | NAME_OR_INT { $$ = $1.stoken; }
782 name_not_typename : NAME
784 /* These would be useful if name_not_typename was useful, but it is just
785 a fake for "variable", so these cause reduce/reduce conflicts because
786 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
787 =exp) or just an exp. If name_not_typename was ever used in an lvalue
788 context where only a name could occur, this might be useful.
795 /* Take care of parsing a number (anything that starts with a digit).
796 Set yylval and return the token type; update lexptr.
797 LEN is the number of characters in it. */
799 /*** Needs some error checking for the float case ***/
802 parse_number (struct parser_state *par_state,
803 const char *p, int len, int parsed_float, YYSTYPE *putithere)
811 int base = input_radix;
814 /* Number of "L" suffixes encountered. */
817 /* We have found a "L" or "U" suffix. */
818 int found_suffix = 0;
821 struct type *signed_type;
822 struct type *unsigned_type;
826 /* Handle suffixes: 'f' for float, 'l' for long double.
827 FIXME: This appears to be an extension -- do we want this? */
828 if (len >= 1 && tolower (p[len - 1]) == 'f')
830 putithere->typed_val_float.type
831 = parse_type (par_state)->builtin_float;
834 else if (len >= 1 && tolower (p[len - 1]) == 'l')
836 putithere->typed_val_float.type
837 = parse_type (par_state)->builtin_long_double;
840 /* Default type for floating-point literals is double. */
843 putithere->typed_val_float.type
844 = parse_type (par_state)->builtin_double;
847 if (!parse_float (p, len,
848 putithere->typed_val_float.type,
849 putithere->typed_val_float.val))
854 /* Handle base-switching prefixes 0x, 0t, 0d, 0. */
855 if (p[0] == '0' && len > 1)
888 if (c >= 'A' && c <= 'Z')
890 if (c != 'l' && c != 'u')
892 if (c >= '0' && c <= '9')
900 if (base > 10 && c >= 'a' && c <= 'f')
904 n += i = c - 'a' + 10;
917 return ERROR; /* Char not a digit */
920 return ERROR; /* Invalid digit in this base. */
922 /* Portably test for overflow (only works for nonzero values, so make
923 a second check for zero). FIXME: Can't we just make n and prevn
924 unsigned and avoid this? */
925 if (c != 'l' && c != 'u' && (prevn >= n) && n != 0)
926 unsigned_p = 1; /* Try something unsigned. */
928 /* Portably test for unsigned overflow.
929 FIXME: This check is wrong; for example it doesn't find overflow
930 on 0x123456789 when LONGEST is 32 bits. */
931 if (c != 'l' && c != 'u' && n != 0)
933 if (unsigned_p && prevn >= n)
934 error (_("Numeric constant too large."));
939 /* An integer constant is an int, a long, or a long long. An L
940 suffix forces it to be long; an LL suffix forces it to be long
941 long. If not forced to a larger size, it gets the first type of
942 the above that it fits in. To figure out whether it fits, we
943 shift it right and see whether anything remains. Note that we
944 can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
945 operation, because many compilers will warn about such a shift
946 (which always produces a zero result). Sometimes gdbarch_int_bit
947 or gdbarch_long_bit will be that big, sometimes not. To deal with
948 the case where it is we just always shift the value more than
949 once, with fewer bits each time. */
953 && (un >> (gdbarch_int_bit (par_state->gdbarch ()) - 2)) == 0)
956 = ((ULONGEST)1) << (gdbarch_int_bit (par_state->gdbarch ()) - 1);
958 /* A large decimal (not hex or octal) constant (between INT_MAX
959 and UINT_MAX) is a long or unsigned long, according to ANSI,
960 never an unsigned int, but this code treats it as unsigned
961 int. This probably should be fixed. GCC gives a warning on
964 unsigned_type = parse_type (par_state)->builtin_unsigned_int;
965 signed_type = parse_type (par_state)->builtin_int;
968 && (un >> (gdbarch_long_bit (par_state->gdbarch ()) - 2)) == 0)
971 = ((ULONGEST)1) << (gdbarch_long_bit (par_state->gdbarch ()) - 1);
972 unsigned_type = parse_type (par_state)->builtin_unsigned_long;
973 signed_type = parse_type (par_state)->builtin_long;
978 if (sizeof (ULONGEST) * HOST_CHAR_BIT
979 < gdbarch_long_long_bit (par_state->gdbarch ()))
980 /* A long long does not fit in a LONGEST. */
981 shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
983 shift = (gdbarch_long_long_bit (par_state->gdbarch ()) - 1);
984 high_bit = (ULONGEST) 1 << shift;
985 unsigned_type = parse_type (par_state)->builtin_unsigned_long_long;
986 signed_type = parse_type (par_state)->builtin_long_long;
989 putithere->typed_val_int.val = n;
991 /* If the high bit of the worked out type is set then this number
992 has to be unsigned. */
994 if (unsigned_p || (n & high_bit))
996 putithere->typed_val_int.type = unsigned_type;
1000 putithere->typed_val_int.type = signed_type;
1009 struct type *stored;
1010 struct type_push *next;
1013 static struct type_push *tp_top = NULL;
1016 push_current_type (void)
1018 struct type_push *tpnew;
1019 tpnew = (struct type_push *) malloc (sizeof (struct type_push));
1020 tpnew->next = tp_top;
1021 tpnew->stored = current_type;
1022 current_type = NULL;
1027 pop_current_type (void)
1029 struct type_push *tp = tp_top;
1032 current_type = tp->stored;
1042 enum exp_opcode opcode;
1045 static const struct token tokentab3[] =
1047 {"shr", RSH, OP_NULL},
1048 {"shl", LSH, OP_NULL},
1049 {"and", ANDAND, OP_NULL},
1050 {"div", DIV, OP_NULL},
1051 {"not", NOT, OP_NULL},
1052 {"mod", MOD, OP_NULL},
1053 {"inc", INCREMENT, OP_NULL},
1054 {"dec", DECREMENT, OP_NULL},
1055 {"xor", XOR, OP_NULL}
1058 static const struct token tokentab2[] =
1060 {"or", OR, OP_NULL},
1061 {"<>", NOTEQUAL, OP_NULL},
1062 {"<=", LEQ, OP_NULL},
1063 {">=", GEQ, OP_NULL},
1064 {":=", ASSIGN, OP_NULL},
1065 {"::", COLONCOLON, OP_NULL} };
1067 /* Allocate uppercased var: */
1068 /* make an uppercased copy of tokstart. */
1070 uptok (const char *tokstart, int namelen)
1073 char *uptokstart = (char *)malloc(namelen+1);
1074 for (i = 0;i <= namelen;i++)
1076 if ((tokstart[i]>='a' && tokstart[i]<='z'))
1077 uptokstart[i] = tokstart[i]-('a'-'A');
1079 uptokstart[i] = tokstart[i];
1081 uptokstart[namelen]='\0';
1085 /* Read one token, getting characters through lexptr. */
1092 const char *tokstart;
1095 int explen, tempbufindex;
1096 static char *tempbuf;
1097 static int tempbufsize;
1101 pstate->prev_lexptr = pstate->lexptr;
1103 tokstart = pstate->lexptr;
1104 explen = strlen (pstate->lexptr);
1106 /* See if it is a special token of length 3. */
1108 for (const auto &token : tokentab3)
1109 if (strncasecmp (tokstart, token.oper, 3) == 0
1110 && (!isalpha (token.oper[0]) || explen == 3
1111 || (!isalpha (tokstart[3])
1112 && !isdigit (tokstart[3]) && tokstart[3] != '_')))
1114 pstate->lexptr += 3;
1115 yylval.opcode = token.opcode;
1119 /* See if it is a special token of length 2. */
1121 for (const auto &token : tokentab2)
1122 if (strncasecmp (tokstart, token.oper, 2) == 0
1123 && (!isalpha (token.oper[0]) || explen == 2
1124 || (!isalpha (tokstart[2])
1125 && !isdigit (tokstart[2]) && tokstart[2] != '_')))
1127 pstate->lexptr += 2;
1128 yylval.opcode = token.opcode;
1132 switch (c = *tokstart)
1135 if (search_field && pstate->parse_completion)
1147 /* We either have a character constant ('0' or '\177' for example)
1148 or we have a quoted symbol reference ('foo(int,int)' in object pascal
1151 c = *pstate->lexptr++;
1153 c = parse_escape (pstate->gdbarch (), &pstate->lexptr);
1155 error (_("Empty character constant."));
1157 yylval.typed_val_int.val = c;
1158 yylval.typed_val_int.type = parse_type (pstate)->builtin_char;
1160 c = *pstate->lexptr++;
1163 namelen = skip_quoted (tokstart) - tokstart;
1166 pstate->lexptr = tokstart + namelen;
1167 if (pstate->lexptr[-1] != '\'')
1168 error (_("Unmatched single quote."));
1171 uptokstart = uptok(tokstart,namelen);
1174 error (_("Invalid character constant."));
1184 if (paren_depth == 0)
1191 if (pstate->comma_terminates && paren_depth == 0)
1197 /* Might be a floating point number. */
1198 if (pstate->lexptr[1] < '0' || pstate->lexptr[1] > '9')
1200 goto symbol; /* Nope, must be a symbol. */
1216 /* It's a number. */
1217 int got_dot = 0, got_e = 0, toktype;
1218 const char *p = tokstart;
1219 int hex = input_radix > 10;
1221 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1226 else if (c == '0' && (p[1]=='t' || p[1]=='T'
1227 || p[1]=='d' || p[1]=='D'))
1235 /* This test includes !hex because 'e' is a valid hex digit
1236 and thus does not indicate a floating point number when
1237 the radix is hex. */
1238 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1239 got_dot = got_e = 1;
1240 /* This test does not include !hex, because a '.' always indicates
1241 a decimal floating point number regardless of the radix. */
1242 else if (!got_dot && *p == '.')
1244 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1245 && (*p == '-' || *p == '+'))
1246 /* This is the sign of the exponent, not the end of the
1249 /* We will take any letters or digits. parse_number will
1250 complain if past the radix, or if L or U are not final. */
1251 else if ((*p < '0' || *p > '9')
1252 && ((*p < 'a' || *p > 'z')
1253 && (*p < 'A' || *p > 'Z')))
1256 toktype = parse_number (pstate, tokstart,
1257 p - tokstart, got_dot | got_e, &yylval);
1258 if (toktype == ERROR)
1260 char *err_copy = (char *) alloca (p - tokstart + 1);
1262 memcpy (err_copy, tokstart, p - tokstart);
1263 err_copy[p - tokstart] = 0;
1264 error (_("Invalid number \"%s\"."), err_copy);
1295 /* Build the gdb internal form of the input string in tempbuf,
1296 translating any standard C escape forms seen. Note that the
1297 buffer is null byte terminated *only* for the convenience of
1298 debugging gdb itself and printing the buffer contents when
1299 the buffer contains no embedded nulls. Gdb does not depend
1300 upon the buffer being null byte terminated, it uses the length
1301 string instead. This allows gdb to handle C strings (as well
1302 as strings in other languages) with embedded null bytes. */
1304 tokptr = ++tokstart;
1308 /* Grow the static temp buffer if necessary, including allocating
1309 the first one on demand. */
1310 if (tempbufindex + 1 >= tempbufsize)
1312 tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1319 /* Do nothing, loop will terminate. */
1323 c = parse_escape (pstate->gdbarch (), &tokptr);
1328 tempbuf[tempbufindex++] = c;
1331 tempbuf[tempbufindex++] = *tokptr++;
1334 } while ((*tokptr != '"') && (*tokptr != '\0'));
1335 if (*tokptr++ != '"')
1337 error (_("Unterminated string in expression."));
1339 tempbuf[tempbufindex] = '\0'; /* See note above. */
1340 yylval.sval.ptr = tempbuf;
1341 yylval.sval.length = tempbufindex;
1342 pstate->lexptr = tokptr;
1346 if (!(c == '_' || c == '$'
1347 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1348 /* We must have come across a bad character (e.g. ';'). */
1349 error (_("Invalid character '%c' in expression."), c);
1351 /* It's a name. See how long it is. */
1353 for (c = tokstart[namelen];
1354 (c == '_' || c == '$' || (c >= '0' && c <= '9')
1355 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1357 /* Template parameter lists are part of the name.
1358 FIXME: This mishandles `print $a<4&&$a>3'. */
1362 int nesting_level = 1;
1363 while (tokstart[++i])
1365 if (tokstart[i] == '<')
1367 else if (tokstart[i] == '>')
1369 if (--nesting_level == 0)
1373 if (tokstart[i] == '>')
1379 /* do NOT uppercase internals because of registers !!! */
1380 c = tokstart[++namelen];
1383 uptokstart = uptok(tokstart,namelen);
1385 /* The token "if" terminates the expression and is NOT
1386 removed from the input stream. */
1387 if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1393 pstate->lexptr += namelen;
1397 /* Catch specific keywords. Should be done with a data structure. */
1401 if (strcmp (uptokstart, "OBJECT") == 0)
1406 if (strcmp (uptokstart, "RECORD") == 0)
1411 if (strcmp (uptokstart, "SIZEOF") == 0)
1418 if (strcmp (uptokstart, "CLASS") == 0)
1423 if (strcmp (uptokstart, "FALSE") == 0)
1427 return FALSEKEYWORD;
1431 if (strcmp (uptokstart, "TRUE") == 0)
1437 if (strcmp (uptokstart, "SELF") == 0)
1439 /* Here we search for 'this' like
1440 inserted in FPC stabs debug info. */
1441 static const char this_name[] = "this";
1443 if (lookup_symbol (this_name, pstate->expression_context_block,
1444 VAR_DOMAIN, NULL).symbol)
1455 yylval.sval.ptr = tokstart;
1456 yylval.sval.length = namelen;
1458 if (*tokstart == '$')
1461 return DOLLAR_VARIABLE;
1464 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1465 functions or symtabs. If this is not so, then ...
1466 Use token-type TYPENAME for symbols that happen to be defined
1467 currently as names of types; NAME for other symbols.
1468 The caller is not constrained to care about the distinction. */
1470 std::string tmp = copy_name (yylval.sval);
1472 struct field_of_this_result is_a_field_of_this;
1476 is_a_field_of_this.type = NULL;
1477 if (search_field && current_type)
1478 is_a_field = (lookup_struct_elt_type (current_type,
1479 tmp.c_str (), 1) != NULL);
1483 sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1484 VAR_DOMAIN, &is_a_field_of_this).symbol;
1485 /* second chance uppercased (as Free Pascal does). */
1486 if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1488 for (int i = 0; i <= namelen; i++)
1490 if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1491 tmp[i] -= ('a'-'A');
1493 if (search_field && current_type)
1494 is_a_field = (lookup_struct_elt_type (current_type,
1495 tmp.c_str (), 1) != NULL);
1499 sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1500 VAR_DOMAIN, &is_a_field_of_this).symbol;
1502 /* Third chance Capitalized (as GPC does). */
1503 if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1505 for (int i = 0; i <= namelen; i++)
1509 if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1510 tmp[i] -= ('a'-'A');
1513 if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
1514 tmp[i] -= ('A'-'a');
1516 if (search_field && current_type)
1517 is_a_field = (lookup_struct_elt_type (current_type,
1518 tmp.c_str (), 1) != NULL);
1522 sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1523 VAR_DOMAIN, &is_a_field_of_this).symbol;
1526 if (is_a_field || (is_a_field_of_this.type != NULL))
1528 tempbuf = (char *) realloc (tempbuf, namelen + 1);
1529 strncpy (tempbuf, tmp.c_str (), namelen);
1530 tempbuf [namelen] = 0;
1531 yylval.sval.ptr = tempbuf;
1532 yylval.sval.length = namelen;
1533 yylval.ssym.sym.symbol = NULL;
1534 yylval.ssym.sym.block = NULL;
1536 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1542 /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1543 no psymtabs (coff, xcoff, or some future change to blow away the
1544 psymtabs once once symbols are read). */
1545 if ((sym && sym->aclass () == LOC_BLOCK)
1546 || lookup_symtab (tmp.c_str ()))
1548 yylval.ssym.sym.symbol = sym;
1549 yylval.ssym.sym.block = NULL;
1550 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1554 if (sym && sym->aclass () == LOC_TYPEDEF)
1557 /* Despite the following flaw, we need to keep this code enabled.
1558 Because we can get called from check_stub_method, if we don't
1559 handle nested types then it screws many operations in any
1560 program which uses nested types. */
1561 /* In "A::x", if x is a member function of A and there happens
1562 to be a type (nested or not, since the stabs don't make that
1563 distinction) named x, then this code incorrectly thinks we
1564 are dealing with nested types rather than a member function. */
1567 const char *namestart;
1568 struct symbol *best_sym;
1570 /* Look ahead to detect nested types. This probably should be
1571 done in the grammar, but trying seemed to introduce a lot
1572 of shift/reduce and reduce/reduce conflicts. It's possible
1573 that it could be done, though. Or perhaps a non-grammar, but
1574 less ad hoc, approach would work well. */
1576 /* Since we do not currently have any way of distinguishing
1577 a nested type from a non-nested one (the stabs don't tell
1578 us whether a type is nested), we just ignore the
1585 /* Skip whitespace. */
1586 while (*p == ' ' || *p == '\t' || *p == '\n')
1588 if (*p == ':' && p[1] == ':')
1590 /* Skip the `::'. */
1592 /* Skip whitespace. */
1593 while (*p == ' ' || *p == '\t' || *p == '\n')
1596 while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1597 || (*p >= 'a' && *p <= 'z')
1598 || (*p >= 'A' && *p <= 'Z'))
1602 struct symbol *cur_sym;
1603 /* As big as the whole rest of the expression, which is
1604 at least big enough. */
1606 = (char *) alloca (tmp.size () + strlen (namestart)
1611 memcpy (tmp1, tmp.c_str (), tmp.size ());
1612 tmp1 += tmp.size ();
1613 memcpy (tmp1, "::", 2);
1615 memcpy (tmp1, namestart, p - namestart);
1616 tmp1[p - namestart] = '\0';
1618 = lookup_symbol (ncopy,
1619 pstate->expression_context_block,
1620 VAR_DOMAIN, NULL).symbol;
1623 if (cur_sym->aclass () == LOC_TYPEDEF)
1641 yylval.tsym.type = best_sym->type ();
1643 yylval.tsym.type = sym->type ();
1649 = language_lookup_primitive_type (pstate->language (),
1650 pstate->gdbarch (), tmp.c_str ());
1651 if (yylval.tsym.type != NULL)
1657 /* Input names that aren't symbols but ARE valid hex numbers,
1658 when the input radix permits them, can be names or numbers
1659 depending on the parse. Note we support radixes > 16 here. */
1661 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1662 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1664 YYSTYPE newlval; /* Its value is ignored. */
1665 hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1668 yylval.ssym.sym.symbol = sym;
1669 yylval.ssym.sym.block = NULL;
1670 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1677 /* Any other kind of symbol. */
1678 yylval.ssym.sym.symbol = sym;
1679 yylval.ssym.sym.block = NULL;
1684 /* See language.h. */
1687 pascal_language::parser (struct parser_state *par_state) const
1689 /* Setting up the parser state. */
1690 scoped_restore pstate_restore = make_scoped_restore (&pstate);
1691 gdb_assert (par_state != NULL);
1695 int result = yyparse ();
1697 pstate->set_operation (pstate->pop ());
1702 yyerror (const char *msg)
1704 if (pstate->prev_lexptr)
1705 pstate->lexptr = pstate->prev_lexptr;
1707 error (_("A %s in expression, near `%s'."), msg, pstate->lexptr);