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"
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 $$ = SYMBOL_BLOCK_VALUE ($1.sym.symbol);
618 std::string copy = copy_name ($1.stoken);
620 lookup_symtab (copy.c_str ());
622 $$ = BLOCKVECTOR_BLOCK (SYMTAB_BLOCKVECTOR (tem),
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 || SYMBOL_CLASS (tem) != LOC_BLOCK)
639 error (_("No function \"%s\" in specified context."),
641 $$ = SYMBOL_BLOCK_VALUE (tem); }
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>
655 (sym.symbol, sym.block);
659 qualified_name: typebase COLONCOLON name
661 struct type *type = $1;
663 if (type->code () != TYPE_CODE_STRUCT
664 && type->code () != TYPE_CODE_UNION)
665 error (_("`%s' is not defined as an aggregate type."),
668 pstate->push_new<scope_operation>
669 (type, copy_name ($3));
673 variable: qualified_name
676 std::string name = copy_name ($2);
678 struct block_symbol sym
679 = lookup_symbol (name.c_str (), nullptr,
680 VAR_DOMAIN, nullptr);
681 pstate->push_symbol (name.c_str (), sym);
685 variable: name_not_typename
686 { struct block_symbol sym = $1.sym;
690 if (symbol_read_needs_frame (sym.symbol))
691 pstate->block_tracker->update (sym);
693 pstate->push_new<var_value_operation>
694 (sym.symbol, sym.block);
695 current_type = sym.symbol->type; }
696 else if ($1.is_a_field_of_this)
698 struct value * this_val;
699 struct type * this_type;
700 /* Object pascal: it hangs off of `this'. Must
701 not inadvertently convert from a method call
703 pstate->block_tracker->update (sym);
705 = make_operation<op_this_operation> ();
706 pstate->push_new<structop_operation>
707 (std::move (thisop), copy_name ($1.stoken));
708 /* We need type of this. */
710 = value_of_this_silent (pstate->language ());
712 this_type = value_type (this_val);
716 current_type = lookup_struct_elt_type (
718 copy_name ($1.stoken).c_str (), 0);
724 struct bound_minimal_symbol msymbol;
725 std::string arg = copy_name ($1.stoken);
728 lookup_bound_minimal_symbol (arg.c_str ());
729 if (msymbol.minsym != NULL)
730 pstate->push_new<var_msym_value_operation>
732 else if (!have_full_symbols ()
733 && !have_partial_symbols ())
734 error (_("No symbol table is loaded. "
735 "Use the \"file\" command."));
737 error (_("No symbol \"%s\" in current context."),
747 /* We used to try to recognize more pointer to member types here, but
748 that didn't work (shift/reduce conflicts meant that these rules never
749 got executed). The problem is that
750 int (foo::bar::baz::bizzle)
751 is a function type but
752 int (foo::bar::baz::bizzle::*)
753 is a pointer to member type. Stroustrup loses again! */
758 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
760 { $$ = lookup_pointer_type ($2); }
765 = lookup_struct (copy_name ($2).c_str (),
766 pstate->expression_context_block);
770 = lookup_struct (copy_name ($2).c_str (),
771 pstate->expression_context_block);
773 /* "const" and "volatile" are curently ignored. A type qualifier
774 after the type is handled in the ptype rule. I think these could
778 name : NAME { $$ = $1.stoken; }
779 | BLOCKNAME { $$ = $1.stoken; }
780 | TYPENAME { $$ = $1.stoken; }
781 | NAME_OR_INT { $$ = $1.stoken; }
784 name_not_typename : NAME
786 /* These would be useful if name_not_typename was useful, but it is just
787 a fake for "variable", so these cause reduce/reduce conflicts because
788 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
789 =exp) or just an exp. If name_not_typename was ever used in an lvalue
790 context where only a name could occur, this might be useful.
797 /* Take care of parsing a number (anything that starts with a digit).
798 Set yylval and return the token type; update lexptr.
799 LEN is the number of characters in it. */
801 /*** Needs some error checking for the float case ***/
804 parse_number (struct parser_state *par_state,
805 const char *p, int len, int parsed_float, YYSTYPE *putithere)
807 /* FIXME: Shouldn't these be unsigned? We don't deal with negative values
808 here, and we do kind of silly things like cast to unsigned. */
815 int base = input_radix;
818 /* Number of "L" suffixes encountered. */
821 /* We have found a "L" or "U" suffix. */
822 int found_suffix = 0;
825 struct type *signed_type;
826 struct type *unsigned_type;
830 /* Handle suffixes: 'f' for float, 'l' for long double.
831 FIXME: This appears to be an extension -- do we want this? */
832 if (len >= 1 && tolower (p[len - 1]) == 'f')
834 putithere->typed_val_float.type
835 = parse_type (par_state)->builtin_float;
838 else if (len >= 1 && tolower (p[len - 1]) == 'l')
840 putithere->typed_val_float.type
841 = parse_type (par_state)->builtin_long_double;
844 /* Default type for floating-point literals is double. */
847 putithere->typed_val_float.type
848 = parse_type (par_state)->builtin_double;
851 if (!parse_float (p, len,
852 putithere->typed_val_float.type,
853 putithere->typed_val_float.val))
858 /* Handle base-switching prefixes 0x, 0t, 0d, 0. */
892 if (c >= 'A' && c <= 'Z')
894 if (c != 'l' && c != 'u')
896 if (c >= '0' && c <= '9')
904 if (base > 10 && c >= 'a' && c <= 'f')
908 n += i = c - 'a' + 10;
921 return ERROR; /* Char not a digit */
924 return ERROR; /* Invalid digit in this base. */
926 /* Portably test for overflow (only works for nonzero values, so make
927 a second check for zero). FIXME: Can't we just make n and prevn
928 unsigned and avoid this? */
929 if (c != 'l' && c != 'u' && (prevn >= n) && n != 0)
930 unsigned_p = 1; /* Try something unsigned. */
932 /* Portably test for unsigned overflow.
933 FIXME: This check is wrong; for example it doesn't find overflow
934 on 0x123456789 when LONGEST is 32 bits. */
935 if (c != 'l' && c != 'u' && n != 0)
937 if ((unsigned_p && (ULONGEST) prevn >= (ULONGEST) n))
938 error (_("Numeric constant too large."));
943 /* An integer constant is an int, a long, or a long long. An L
944 suffix forces it to be long; an LL suffix forces it to be long
945 long. If not forced to a larger size, it gets the first type of
946 the above that it fits in. To figure out whether it fits, we
947 shift it right and see whether anything remains. Note that we
948 can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
949 operation, because many compilers will warn about such a shift
950 (which always produces a zero result). Sometimes gdbarch_int_bit
951 or gdbarch_long_bit will be that big, sometimes not. To deal with
952 the case where it is we just always shift the value more than
953 once, with fewer bits each time. */
955 un = (ULONGEST)n >> 2;
957 && (un >> (gdbarch_int_bit (par_state->gdbarch ()) - 2)) == 0)
960 = ((ULONGEST)1) << (gdbarch_int_bit (par_state->gdbarch ()) - 1);
962 /* A large decimal (not hex or octal) constant (between INT_MAX
963 and UINT_MAX) is a long or unsigned long, according to ANSI,
964 never an unsigned int, but this code treats it as unsigned
965 int. This probably should be fixed. GCC gives a warning on
968 unsigned_type = parse_type (par_state)->builtin_unsigned_int;
969 signed_type = parse_type (par_state)->builtin_int;
972 && (un >> (gdbarch_long_bit (par_state->gdbarch ()) - 2)) == 0)
975 = ((ULONGEST)1) << (gdbarch_long_bit (par_state->gdbarch ()) - 1);
976 unsigned_type = parse_type (par_state)->builtin_unsigned_long;
977 signed_type = parse_type (par_state)->builtin_long;
982 if (sizeof (ULONGEST) * HOST_CHAR_BIT
983 < gdbarch_long_long_bit (par_state->gdbarch ()))
984 /* A long long does not fit in a LONGEST. */
985 shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
987 shift = (gdbarch_long_long_bit (par_state->gdbarch ()) - 1);
988 high_bit = (ULONGEST) 1 << shift;
989 unsigned_type = parse_type (par_state)->builtin_unsigned_long_long;
990 signed_type = parse_type (par_state)->builtin_long_long;
993 putithere->typed_val_int.val = n;
995 /* If the high bit of the worked out type is set then this number
996 has to be unsigned. */
998 if (unsigned_p || (n & high_bit))
1000 putithere->typed_val_int.type = unsigned_type;
1004 putithere->typed_val_int.type = signed_type;
1013 struct type *stored;
1014 struct type_push *next;
1017 static struct type_push *tp_top = NULL;
1020 push_current_type (void)
1022 struct type_push *tpnew;
1023 tpnew = (struct type_push *) malloc (sizeof (struct type_push));
1024 tpnew->next = tp_top;
1025 tpnew->stored = current_type;
1026 current_type = NULL;
1031 pop_current_type (void)
1033 struct type_push *tp = tp_top;
1036 current_type = tp->stored;
1046 enum exp_opcode opcode;
1049 static const struct token tokentab3[] =
1051 {"shr", RSH, OP_NULL},
1052 {"shl", LSH, OP_NULL},
1053 {"and", ANDAND, OP_NULL},
1054 {"div", DIV, OP_NULL},
1055 {"not", NOT, OP_NULL},
1056 {"mod", MOD, OP_NULL},
1057 {"inc", INCREMENT, OP_NULL},
1058 {"dec", DECREMENT, OP_NULL},
1059 {"xor", XOR, OP_NULL}
1062 static const struct token tokentab2[] =
1064 {"or", OR, OP_NULL},
1065 {"<>", NOTEQUAL, OP_NULL},
1066 {"<=", LEQ, OP_NULL},
1067 {">=", GEQ, OP_NULL},
1068 {":=", ASSIGN, OP_NULL},
1069 {"::", COLONCOLON, OP_NULL} };
1071 /* Allocate uppercased var: */
1072 /* make an uppercased copy of tokstart. */
1074 uptok (const char *tokstart, int namelen)
1077 char *uptokstart = (char *)malloc(namelen+1);
1078 for (i = 0;i <= namelen;i++)
1080 if ((tokstart[i]>='a' && tokstart[i]<='z'))
1081 uptokstart[i] = tokstart[i]-('a'-'A');
1083 uptokstart[i] = tokstart[i];
1085 uptokstart[namelen]='\0';
1089 /* Read one token, getting characters through lexptr. */
1096 const char *tokstart;
1099 int explen, tempbufindex;
1100 static char *tempbuf;
1101 static int tempbufsize;
1105 pstate->prev_lexptr = pstate->lexptr;
1107 tokstart = pstate->lexptr;
1108 explen = strlen (pstate->lexptr);
1110 /* See if it is a special token of length 3. */
1112 for (int i = 0; i < sizeof (tokentab3) / sizeof (tokentab3[0]); i++)
1113 if (strncasecmp (tokstart, tokentab3[i].oper, 3) == 0
1114 && (!isalpha (tokentab3[i].oper[0]) || explen == 3
1115 || (!isalpha (tokstart[3])
1116 && !isdigit (tokstart[3]) && tokstart[3] != '_')))
1118 pstate->lexptr += 3;
1119 yylval.opcode = tokentab3[i].opcode;
1120 return tokentab3[i].token;
1123 /* See if it is a special token of length 2. */
1125 for (int i = 0; i < sizeof (tokentab2) / sizeof (tokentab2[0]); i++)
1126 if (strncasecmp (tokstart, tokentab2[i].oper, 2) == 0
1127 && (!isalpha (tokentab2[i].oper[0]) || explen == 2
1128 || (!isalpha (tokstart[2])
1129 && !isdigit (tokstart[2]) && tokstart[2] != '_')))
1131 pstate->lexptr += 2;
1132 yylval.opcode = tokentab2[i].opcode;
1133 return tokentab2[i].token;
1136 switch (c = *tokstart)
1139 if (search_field && pstate->parse_completion)
1151 /* We either have a character constant ('0' or '\177' for example)
1152 or we have a quoted symbol reference ('foo(int,int)' in object pascal
1155 c = *pstate->lexptr++;
1157 c = parse_escape (pstate->gdbarch (), &pstate->lexptr);
1159 error (_("Empty character constant."));
1161 yylval.typed_val_int.val = c;
1162 yylval.typed_val_int.type = parse_type (pstate)->builtin_char;
1164 c = *pstate->lexptr++;
1167 namelen = skip_quoted (tokstart) - tokstart;
1170 pstate->lexptr = tokstart + namelen;
1171 if (pstate->lexptr[-1] != '\'')
1172 error (_("Unmatched single quote."));
1175 uptokstart = uptok(tokstart,namelen);
1178 error (_("Invalid character constant."));
1188 if (paren_depth == 0)
1195 if (pstate->comma_terminates && paren_depth == 0)
1201 /* Might be a floating point number. */
1202 if (pstate->lexptr[1] < '0' || pstate->lexptr[1] > '9')
1204 goto symbol; /* Nope, must be a symbol. */
1220 /* It's a number. */
1221 int got_dot = 0, got_e = 0, toktype;
1222 const char *p = tokstart;
1223 int hex = input_radix > 10;
1225 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1230 else if (c == '0' && (p[1]=='t' || p[1]=='T'
1231 || p[1]=='d' || p[1]=='D'))
1239 /* This test includes !hex because 'e' is a valid hex digit
1240 and thus does not indicate a floating point number when
1241 the radix is hex. */
1242 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1243 got_dot = got_e = 1;
1244 /* This test does not include !hex, because a '.' always indicates
1245 a decimal floating point number regardless of the radix. */
1246 else if (!got_dot && *p == '.')
1248 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1249 && (*p == '-' || *p == '+'))
1250 /* This is the sign of the exponent, not the end of the
1253 /* We will take any letters or digits. parse_number will
1254 complain if past the radix, or if L or U are not final. */
1255 else if ((*p < '0' || *p > '9')
1256 && ((*p < 'a' || *p > 'z')
1257 && (*p < 'A' || *p > 'Z')))
1260 toktype = parse_number (pstate, tokstart,
1261 p - tokstart, got_dot | got_e, &yylval);
1262 if (toktype == ERROR)
1264 char *err_copy = (char *) alloca (p - tokstart + 1);
1266 memcpy (err_copy, tokstart, p - tokstart);
1267 err_copy[p - tokstart] = 0;
1268 error (_("Invalid number \"%s\"."), err_copy);
1299 /* Build the gdb internal form of the input string in tempbuf,
1300 translating any standard C escape forms seen. Note that the
1301 buffer is null byte terminated *only* for the convenience of
1302 debugging gdb itself and printing the buffer contents when
1303 the buffer contains no embedded nulls. Gdb does not depend
1304 upon the buffer being null byte terminated, it uses the length
1305 string instead. This allows gdb to handle C strings (as well
1306 as strings in other languages) with embedded null bytes. */
1308 tokptr = ++tokstart;
1312 /* Grow the static temp buffer if necessary, including allocating
1313 the first one on demand. */
1314 if (tempbufindex + 1 >= tempbufsize)
1316 tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1323 /* Do nothing, loop will terminate. */
1327 c = parse_escape (pstate->gdbarch (), &tokptr);
1332 tempbuf[tempbufindex++] = c;
1335 tempbuf[tempbufindex++] = *tokptr++;
1338 } while ((*tokptr != '"') && (*tokptr != '\0'));
1339 if (*tokptr++ != '"')
1341 error (_("Unterminated string in expression."));
1343 tempbuf[tempbufindex] = '\0'; /* See note above. */
1344 yylval.sval.ptr = tempbuf;
1345 yylval.sval.length = tempbufindex;
1346 pstate->lexptr = tokptr;
1350 if (!(c == '_' || c == '$'
1351 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1352 /* We must have come across a bad character (e.g. ';'). */
1353 error (_("Invalid character '%c' in expression."), c);
1355 /* It's a name. See how long it is. */
1357 for (c = tokstart[namelen];
1358 (c == '_' || c == '$' || (c >= '0' && c <= '9')
1359 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1361 /* Template parameter lists are part of the name.
1362 FIXME: This mishandles `print $a<4&&$a>3'. */
1366 int nesting_level = 1;
1367 while (tokstart[++i])
1369 if (tokstart[i] == '<')
1371 else if (tokstart[i] == '>')
1373 if (--nesting_level == 0)
1377 if (tokstart[i] == '>')
1383 /* do NOT uppercase internals because of registers !!! */
1384 c = tokstart[++namelen];
1387 uptokstart = uptok(tokstart,namelen);
1389 /* The token "if" terminates the expression and is NOT
1390 removed from the input stream. */
1391 if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1397 pstate->lexptr += namelen;
1401 /* Catch specific keywords. Should be done with a data structure. */
1405 if (strcmp (uptokstart, "OBJECT") == 0)
1410 if (strcmp (uptokstart, "RECORD") == 0)
1415 if (strcmp (uptokstart, "SIZEOF") == 0)
1422 if (strcmp (uptokstart, "CLASS") == 0)
1427 if (strcmp (uptokstart, "FALSE") == 0)
1431 return FALSEKEYWORD;
1435 if (strcmp (uptokstart, "TRUE") == 0)
1441 if (strcmp (uptokstart, "SELF") == 0)
1443 /* Here we search for 'this' like
1444 inserted in FPC stabs debug info. */
1445 static const char this_name[] = "this";
1447 if (lookup_symbol (this_name, pstate->expression_context_block,
1448 VAR_DOMAIN, NULL).symbol)
1459 yylval.sval.ptr = tokstart;
1460 yylval.sval.length = namelen;
1462 if (*tokstart == '$')
1465 return DOLLAR_VARIABLE;
1468 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1469 functions or symtabs. If this is not so, then ...
1470 Use token-type TYPENAME for symbols that happen to be defined
1471 currently as names of types; NAME for other symbols.
1472 The caller is not constrained to care about the distinction. */
1474 std::string tmp = copy_name (yylval.sval);
1476 struct field_of_this_result is_a_field_of_this;
1480 is_a_field_of_this.type = NULL;
1481 if (search_field && current_type)
1482 is_a_field = (lookup_struct_elt_type (current_type,
1483 tmp.c_str (), 1) != NULL);
1487 sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1488 VAR_DOMAIN, &is_a_field_of_this).symbol;
1489 /* second chance uppercased (as Free Pascal does). */
1490 if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1492 for (int i = 0; i <= namelen; i++)
1494 if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1495 tmp[i] -= ('a'-'A');
1497 if (search_field && current_type)
1498 is_a_field = (lookup_struct_elt_type (current_type,
1499 tmp.c_str (), 1) != NULL);
1503 sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1504 VAR_DOMAIN, &is_a_field_of_this).symbol;
1506 /* Third chance Capitalized (as GPC does). */
1507 if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1509 for (int i = 0; i <= namelen; i++)
1513 if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1514 tmp[i] -= ('a'-'A');
1517 if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
1518 tmp[i] -= ('A'-'a');
1520 if (search_field && current_type)
1521 is_a_field = (lookup_struct_elt_type (current_type,
1522 tmp.c_str (), 1) != NULL);
1526 sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1527 VAR_DOMAIN, &is_a_field_of_this).symbol;
1530 if (is_a_field || (is_a_field_of_this.type != NULL))
1532 tempbuf = (char *) realloc (tempbuf, namelen + 1);
1533 strncpy (tempbuf, tmp.c_str (), namelen);
1534 tempbuf [namelen] = 0;
1535 yylval.sval.ptr = tempbuf;
1536 yylval.sval.length = namelen;
1537 yylval.ssym.sym.symbol = NULL;
1538 yylval.ssym.sym.block = NULL;
1540 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1546 /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1547 no psymtabs (coff, xcoff, or some future change to blow away the
1548 psymtabs once once symbols are read). */
1549 if ((sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1550 || lookup_symtab (tmp.c_str ()))
1552 yylval.ssym.sym.symbol = sym;
1553 yylval.ssym.sym.block = NULL;
1554 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1558 if (sym && SYMBOL_CLASS (sym) == LOC_TYPEDEF)
1561 /* Despite the following flaw, we need to keep this code enabled.
1562 Because we can get called from check_stub_method, if we don't
1563 handle nested types then it screws many operations in any
1564 program which uses nested types. */
1565 /* In "A::x", if x is a member function of A and there happens
1566 to be a type (nested or not, since the stabs don't make that
1567 distinction) named x, then this code incorrectly thinks we
1568 are dealing with nested types rather than a member function. */
1571 const char *namestart;
1572 struct symbol *best_sym;
1574 /* Look ahead to detect nested types. This probably should be
1575 done in the grammar, but trying seemed to introduce a lot
1576 of shift/reduce and reduce/reduce conflicts. It's possible
1577 that it could be done, though. Or perhaps a non-grammar, but
1578 less ad hoc, approach would work well. */
1580 /* Since we do not currently have any way of distinguishing
1581 a nested type from a non-nested one (the stabs don't tell
1582 us whether a type is nested), we just ignore the
1589 /* Skip whitespace. */
1590 while (*p == ' ' || *p == '\t' || *p == '\n')
1592 if (*p == ':' && p[1] == ':')
1594 /* Skip the `::'. */
1596 /* Skip whitespace. */
1597 while (*p == ' ' || *p == '\t' || *p == '\n')
1600 while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1601 || (*p >= 'a' && *p <= 'z')
1602 || (*p >= 'A' && *p <= 'Z'))
1606 struct symbol *cur_sym;
1607 /* As big as the whole rest of the expression, which is
1608 at least big enough. */
1610 = (char *) alloca (tmp.size () + strlen (namestart)
1615 memcpy (tmp1, tmp.c_str (), tmp.size ());
1616 tmp1 += tmp.size ();
1617 memcpy (tmp1, "::", 2);
1619 memcpy (tmp1, namestart, p - namestart);
1620 tmp1[p - namestart] = '\0';
1622 = lookup_symbol (ncopy,
1623 pstate->expression_context_block,
1624 VAR_DOMAIN, NULL).symbol;
1627 if (SYMBOL_CLASS (cur_sym) == LOC_TYPEDEF)
1645 yylval.tsym.type = SYMBOL_TYPE (best_sym);
1647 yylval.tsym.type = SYMBOL_TYPE (sym);
1653 = language_lookup_primitive_type (pstate->language (),
1654 pstate->gdbarch (), tmp.c_str ());
1655 if (yylval.tsym.type != NULL)
1661 /* Input names that aren't symbols but ARE valid hex numbers,
1662 when the input radix permits them, can be names or numbers
1663 depending on the parse. Note we support radixes > 16 here. */
1665 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1666 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1668 YYSTYPE newlval; /* Its value is ignored. */
1669 hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1672 yylval.ssym.sym.symbol = sym;
1673 yylval.ssym.sym.block = NULL;
1674 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1681 /* Any other kind of symbol. */
1682 yylval.ssym.sym.symbol = sym;
1683 yylval.ssym.sym.block = NULL;
1688 /* See language.h. */
1691 pascal_language::parser (struct parser_state *par_state) const
1693 /* Setting up the parser state. */
1694 scoped_restore pstate_restore = make_scoped_restore (&pstate);
1695 gdb_assert (par_state != NULL);
1699 int result = yyparse ();
1701 pstate->set_operation (pstate->pop ());
1706 yyerror (const char *msg)
1708 if (pstate->prev_lexptr)
1709 pstate->lexptr = pstate->prev_lexptr;
1711 error (_("A %s in expression, near `%s'."), msg, pstate->lexptr);