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 $$ = SYMBOL_BLOCK_VALUE ($1.sym.symbol);
618 std::string copy = copy_name ($1.stoken);
620 lookup_symtab (copy.c_str ());
622 $$ = BLOCKVECTOR_BLOCK
623 (tem->compunit ()->blockvector (),
626 error (_("No file or function \"%s\"."),
632 block : block COLONCOLON name
634 std::string copy = copy_name ($3);
636 = lookup_symbol (copy.c_str (), $1,
637 VAR_DOMAIN, NULL).symbol;
639 if (!tem || tem->aclass () != LOC_BLOCK)
640 error (_("No function \"%s\" in specified context."),
642 $$ = SYMBOL_BLOCK_VALUE (tem); }
645 variable: block COLONCOLON name
646 { struct block_symbol sym;
648 std::string copy = copy_name ($3);
649 sym = lookup_symbol (copy.c_str (), $1,
652 error (_("No symbol \"%s\" in specified context."),
655 pstate->push_new<var_value_operation> (sym);
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> (sym);
694 current_type = sym.symbol->type (); }
695 else if ($1.is_a_field_of_this)
697 struct value * this_val;
698 struct type * this_type;
699 /* Object pascal: it hangs off of `this'. Must
700 not inadvertently convert from a method call
702 pstate->block_tracker->update (sym);
704 = make_operation<op_this_operation> ();
705 pstate->push_new<structop_operation>
706 (std::move (thisop), copy_name ($1.stoken));
707 /* We need type of this. */
709 = value_of_this_silent (pstate->language ());
711 this_type = value_type (this_val);
715 current_type = lookup_struct_elt_type (
717 copy_name ($1.stoken).c_str (), 0);
723 struct bound_minimal_symbol msymbol;
724 std::string arg = copy_name ($1.stoken);
727 lookup_bound_minimal_symbol (arg.c_str ());
728 if (msymbol.minsym != NULL)
729 pstate->push_new<var_msym_value_operation>
731 else if (!have_full_symbols ()
732 && !have_partial_symbols ())
733 error (_("No symbol table is loaded. "
734 "Use the \"file\" command."));
736 error (_("No symbol \"%s\" in current context."),
746 /* We used to try to recognize more pointer to member types here, but
747 that didn't work (shift/reduce conflicts meant that these rules never
748 got executed). The problem is that
749 int (foo::bar::baz::bizzle)
750 is a function type but
751 int (foo::bar::baz::bizzle::*)
752 is a pointer to member type. Stroustrup loses again! */
757 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
759 { $$ = lookup_pointer_type ($2); }
764 = lookup_struct (copy_name ($2).c_str (),
765 pstate->expression_context_block);
769 = lookup_struct (copy_name ($2).c_str (),
770 pstate->expression_context_block);
772 /* "const" and "volatile" are curently ignored. A type qualifier
773 after the type is handled in the ptype rule. I think these could
777 name : NAME { $$ = $1.stoken; }
778 | BLOCKNAME { $$ = $1.stoken; }
779 | TYPENAME { $$ = $1.stoken; }
780 | NAME_OR_INT { $$ = $1.stoken; }
783 name_not_typename : NAME
785 /* These would be useful if name_not_typename was useful, but it is just
786 a fake for "variable", so these cause reduce/reduce conflicts because
787 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
788 =exp) or just an exp. If name_not_typename was ever used in an lvalue
789 context where only a name could occur, this might be useful.
796 /* Take care of parsing a number (anything that starts with a digit).
797 Set yylval and return the token type; update lexptr.
798 LEN is the number of characters in it. */
800 /*** Needs some error checking for the float case ***/
803 parse_number (struct parser_state *par_state,
804 const char *p, int len, int parsed_float, YYSTYPE *putithere)
806 /* FIXME: Shouldn't these be unsigned? We don't deal with negative values
807 here, and we do kind of silly things like cast to unsigned. */
814 int base = input_radix;
817 /* Number of "L" suffixes encountered. */
820 /* We have found a "L" or "U" suffix. */
821 int found_suffix = 0;
824 struct type *signed_type;
825 struct type *unsigned_type;
829 /* Handle suffixes: 'f' for float, 'l' for long double.
830 FIXME: This appears to be an extension -- do we want this? */
831 if (len >= 1 && tolower (p[len - 1]) == 'f')
833 putithere->typed_val_float.type
834 = parse_type (par_state)->builtin_float;
837 else if (len >= 1 && tolower (p[len - 1]) == 'l')
839 putithere->typed_val_float.type
840 = parse_type (par_state)->builtin_long_double;
843 /* Default type for floating-point literals is double. */
846 putithere->typed_val_float.type
847 = parse_type (par_state)->builtin_double;
850 if (!parse_float (p, len,
851 putithere->typed_val_float.type,
852 putithere->typed_val_float.val))
857 /* Handle base-switching prefixes 0x, 0t, 0d, 0. */
891 if (c >= 'A' && c <= 'Z')
893 if (c != 'l' && c != 'u')
895 if (c >= '0' && c <= '9')
903 if (base > 10 && c >= 'a' && c <= 'f')
907 n += i = c - 'a' + 10;
920 return ERROR; /* Char not a digit */
923 return ERROR; /* Invalid digit in this base. */
925 /* Portably test for overflow (only works for nonzero values, so make
926 a second check for zero). FIXME: Can't we just make n and prevn
927 unsigned and avoid this? */
928 if (c != 'l' && c != 'u' && (prevn >= n) && n != 0)
929 unsigned_p = 1; /* Try something unsigned. */
931 /* Portably test for unsigned overflow.
932 FIXME: This check is wrong; for example it doesn't find overflow
933 on 0x123456789 when LONGEST is 32 bits. */
934 if (c != 'l' && c != 'u' && n != 0)
936 if ((unsigned_p && (ULONGEST) prevn >= (ULONGEST) n))
937 error (_("Numeric constant too large."));
942 /* An integer constant is an int, a long, or a long long. An L
943 suffix forces it to be long; an LL suffix forces it to be long
944 long. If not forced to a larger size, it gets the first type of
945 the above that it fits in. To figure out whether it fits, we
946 shift it right and see whether anything remains. Note that we
947 can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
948 operation, because many compilers will warn about such a shift
949 (which always produces a zero result). Sometimes gdbarch_int_bit
950 or gdbarch_long_bit will be that big, sometimes not. To deal with
951 the case where it is we just always shift the value more than
952 once, with fewer bits each time. */
954 un = (ULONGEST)n >> 2;
956 && (un >> (gdbarch_int_bit (par_state->gdbarch ()) - 2)) == 0)
959 = ((ULONGEST)1) << (gdbarch_int_bit (par_state->gdbarch ()) - 1);
961 /* A large decimal (not hex or octal) constant (between INT_MAX
962 and UINT_MAX) is a long or unsigned long, according to ANSI,
963 never an unsigned int, but this code treats it as unsigned
964 int. This probably should be fixed. GCC gives a warning on
967 unsigned_type = parse_type (par_state)->builtin_unsigned_int;
968 signed_type = parse_type (par_state)->builtin_int;
971 && (un >> (gdbarch_long_bit (par_state->gdbarch ()) - 2)) == 0)
974 = ((ULONGEST)1) << (gdbarch_long_bit (par_state->gdbarch ()) - 1);
975 unsigned_type = parse_type (par_state)->builtin_unsigned_long;
976 signed_type = parse_type (par_state)->builtin_long;
981 if (sizeof (ULONGEST) * HOST_CHAR_BIT
982 < gdbarch_long_long_bit (par_state->gdbarch ()))
983 /* A long long does not fit in a LONGEST. */
984 shift = (sizeof (ULONGEST) * HOST_CHAR_BIT - 1);
986 shift = (gdbarch_long_long_bit (par_state->gdbarch ()) - 1);
987 high_bit = (ULONGEST) 1 << shift;
988 unsigned_type = parse_type (par_state)->builtin_unsigned_long_long;
989 signed_type = parse_type (par_state)->builtin_long_long;
992 putithere->typed_val_int.val = n;
994 /* If the high bit of the worked out type is set then this number
995 has to be unsigned. */
997 if (unsigned_p || (n & high_bit))
999 putithere->typed_val_int.type = unsigned_type;
1003 putithere->typed_val_int.type = signed_type;
1012 struct type *stored;
1013 struct type_push *next;
1016 static struct type_push *tp_top = NULL;
1019 push_current_type (void)
1021 struct type_push *tpnew;
1022 tpnew = (struct type_push *) malloc (sizeof (struct type_push));
1023 tpnew->next = tp_top;
1024 tpnew->stored = current_type;
1025 current_type = NULL;
1030 pop_current_type (void)
1032 struct type_push *tp = tp_top;
1035 current_type = tp->stored;
1045 enum exp_opcode opcode;
1048 static const struct token tokentab3[] =
1050 {"shr", RSH, OP_NULL},
1051 {"shl", LSH, OP_NULL},
1052 {"and", ANDAND, OP_NULL},
1053 {"div", DIV, OP_NULL},
1054 {"not", NOT, OP_NULL},
1055 {"mod", MOD, OP_NULL},
1056 {"inc", INCREMENT, OP_NULL},
1057 {"dec", DECREMENT, OP_NULL},
1058 {"xor", XOR, OP_NULL}
1061 static const struct token tokentab2[] =
1063 {"or", OR, OP_NULL},
1064 {"<>", NOTEQUAL, OP_NULL},
1065 {"<=", LEQ, OP_NULL},
1066 {">=", GEQ, OP_NULL},
1067 {":=", ASSIGN, OP_NULL},
1068 {"::", COLONCOLON, OP_NULL} };
1070 /* Allocate uppercased var: */
1071 /* make an uppercased copy of tokstart. */
1073 uptok (const char *tokstart, int namelen)
1076 char *uptokstart = (char *)malloc(namelen+1);
1077 for (i = 0;i <= namelen;i++)
1079 if ((tokstart[i]>='a' && tokstart[i]<='z'))
1080 uptokstart[i] = tokstart[i]-('a'-'A');
1082 uptokstart[i] = tokstart[i];
1084 uptokstart[namelen]='\0';
1088 /* Read one token, getting characters through lexptr. */
1095 const char *tokstart;
1098 int explen, tempbufindex;
1099 static char *tempbuf;
1100 static int tempbufsize;
1104 pstate->prev_lexptr = pstate->lexptr;
1106 tokstart = pstate->lexptr;
1107 explen = strlen (pstate->lexptr);
1109 /* See if it is a special token of length 3. */
1111 for (const auto &token : tokentab3)
1112 if (strncasecmp (tokstart, token.oper, 3) == 0
1113 && (!isalpha (token.oper[0]) || explen == 3
1114 || (!isalpha (tokstart[3])
1115 && !isdigit (tokstart[3]) && tokstart[3] != '_')))
1117 pstate->lexptr += 3;
1118 yylval.opcode = token.opcode;
1122 /* See if it is a special token of length 2. */
1124 for (const auto &token : tokentab2)
1125 if (strncasecmp (tokstart, token.oper, 2) == 0
1126 && (!isalpha (token.oper[0]) || explen == 2
1127 || (!isalpha (tokstart[2])
1128 && !isdigit (tokstart[2]) && tokstart[2] != '_')))
1130 pstate->lexptr += 2;
1131 yylval.opcode = token.opcode;
1135 switch (c = *tokstart)
1138 if (search_field && pstate->parse_completion)
1150 /* We either have a character constant ('0' or '\177' for example)
1151 or we have a quoted symbol reference ('foo(int,int)' in object pascal
1154 c = *pstate->lexptr++;
1156 c = parse_escape (pstate->gdbarch (), &pstate->lexptr);
1158 error (_("Empty character constant."));
1160 yylval.typed_val_int.val = c;
1161 yylval.typed_val_int.type = parse_type (pstate)->builtin_char;
1163 c = *pstate->lexptr++;
1166 namelen = skip_quoted (tokstart) - tokstart;
1169 pstate->lexptr = tokstart + namelen;
1170 if (pstate->lexptr[-1] != '\'')
1171 error (_("Unmatched single quote."));
1174 uptokstart = uptok(tokstart,namelen);
1177 error (_("Invalid character constant."));
1187 if (paren_depth == 0)
1194 if (pstate->comma_terminates && paren_depth == 0)
1200 /* Might be a floating point number. */
1201 if (pstate->lexptr[1] < '0' || pstate->lexptr[1] > '9')
1203 goto symbol; /* Nope, must be a symbol. */
1219 /* It's a number. */
1220 int got_dot = 0, got_e = 0, toktype;
1221 const char *p = tokstart;
1222 int hex = input_radix > 10;
1224 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1229 else if (c == '0' && (p[1]=='t' || p[1]=='T'
1230 || p[1]=='d' || p[1]=='D'))
1238 /* This test includes !hex because 'e' is a valid hex digit
1239 and thus does not indicate a floating point number when
1240 the radix is hex. */
1241 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1242 got_dot = got_e = 1;
1243 /* This test does not include !hex, because a '.' always indicates
1244 a decimal floating point number regardless of the radix. */
1245 else if (!got_dot && *p == '.')
1247 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1248 && (*p == '-' || *p == '+'))
1249 /* This is the sign of the exponent, not the end of the
1252 /* We will take any letters or digits. parse_number will
1253 complain if past the radix, or if L or U are not final. */
1254 else if ((*p < '0' || *p > '9')
1255 && ((*p < 'a' || *p > 'z')
1256 && (*p < 'A' || *p > 'Z')))
1259 toktype = parse_number (pstate, tokstart,
1260 p - tokstart, got_dot | got_e, &yylval);
1261 if (toktype == ERROR)
1263 char *err_copy = (char *) alloca (p - tokstart + 1);
1265 memcpy (err_copy, tokstart, p - tokstart);
1266 err_copy[p - tokstart] = 0;
1267 error (_("Invalid number \"%s\"."), err_copy);
1298 /* Build the gdb internal form of the input string in tempbuf,
1299 translating any standard C escape forms seen. Note that the
1300 buffer is null byte terminated *only* for the convenience of
1301 debugging gdb itself and printing the buffer contents when
1302 the buffer contains no embedded nulls. Gdb does not depend
1303 upon the buffer being null byte terminated, it uses the length
1304 string instead. This allows gdb to handle C strings (as well
1305 as strings in other languages) with embedded null bytes. */
1307 tokptr = ++tokstart;
1311 /* Grow the static temp buffer if necessary, including allocating
1312 the first one on demand. */
1313 if (tempbufindex + 1 >= tempbufsize)
1315 tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1322 /* Do nothing, loop will terminate. */
1326 c = parse_escape (pstate->gdbarch (), &tokptr);
1331 tempbuf[tempbufindex++] = c;
1334 tempbuf[tempbufindex++] = *tokptr++;
1337 } while ((*tokptr != '"') && (*tokptr != '\0'));
1338 if (*tokptr++ != '"')
1340 error (_("Unterminated string in expression."));
1342 tempbuf[tempbufindex] = '\0'; /* See note above. */
1343 yylval.sval.ptr = tempbuf;
1344 yylval.sval.length = tempbufindex;
1345 pstate->lexptr = tokptr;
1349 if (!(c == '_' || c == '$'
1350 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1351 /* We must have come across a bad character (e.g. ';'). */
1352 error (_("Invalid character '%c' in expression."), c);
1354 /* It's a name. See how long it is. */
1356 for (c = tokstart[namelen];
1357 (c == '_' || c == '$' || (c >= '0' && c <= '9')
1358 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1360 /* Template parameter lists are part of the name.
1361 FIXME: This mishandles `print $a<4&&$a>3'. */
1365 int nesting_level = 1;
1366 while (tokstart[++i])
1368 if (tokstart[i] == '<')
1370 else if (tokstart[i] == '>')
1372 if (--nesting_level == 0)
1376 if (tokstart[i] == '>')
1382 /* do NOT uppercase internals because of registers !!! */
1383 c = tokstart[++namelen];
1386 uptokstart = uptok(tokstart,namelen);
1388 /* The token "if" terminates the expression and is NOT
1389 removed from the input stream. */
1390 if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1396 pstate->lexptr += namelen;
1400 /* Catch specific keywords. Should be done with a data structure. */
1404 if (strcmp (uptokstart, "OBJECT") == 0)
1409 if (strcmp (uptokstart, "RECORD") == 0)
1414 if (strcmp (uptokstart, "SIZEOF") == 0)
1421 if (strcmp (uptokstart, "CLASS") == 0)
1426 if (strcmp (uptokstart, "FALSE") == 0)
1430 return FALSEKEYWORD;
1434 if (strcmp (uptokstart, "TRUE") == 0)
1440 if (strcmp (uptokstart, "SELF") == 0)
1442 /* Here we search for 'this' like
1443 inserted in FPC stabs debug info. */
1444 static const char this_name[] = "this";
1446 if (lookup_symbol (this_name, pstate->expression_context_block,
1447 VAR_DOMAIN, NULL).symbol)
1458 yylval.sval.ptr = tokstart;
1459 yylval.sval.length = namelen;
1461 if (*tokstart == '$')
1464 return DOLLAR_VARIABLE;
1467 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1468 functions or symtabs. If this is not so, then ...
1469 Use token-type TYPENAME for symbols that happen to be defined
1470 currently as names of types; NAME for other symbols.
1471 The caller is not constrained to care about the distinction. */
1473 std::string tmp = copy_name (yylval.sval);
1475 struct field_of_this_result is_a_field_of_this;
1479 is_a_field_of_this.type = NULL;
1480 if (search_field && current_type)
1481 is_a_field = (lookup_struct_elt_type (current_type,
1482 tmp.c_str (), 1) != NULL);
1486 sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1487 VAR_DOMAIN, &is_a_field_of_this).symbol;
1488 /* second chance uppercased (as Free Pascal does). */
1489 if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1491 for (int i = 0; i <= namelen; i++)
1493 if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1494 tmp[i] -= ('a'-'A');
1496 if (search_field && current_type)
1497 is_a_field = (lookup_struct_elt_type (current_type,
1498 tmp.c_str (), 1) != NULL);
1502 sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1503 VAR_DOMAIN, &is_a_field_of_this).symbol;
1505 /* Third chance Capitalized (as GPC does). */
1506 if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1508 for (int i = 0; i <= namelen; i++)
1512 if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1513 tmp[i] -= ('a'-'A');
1516 if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
1517 tmp[i] -= ('A'-'a');
1519 if (search_field && current_type)
1520 is_a_field = (lookup_struct_elt_type (current_type,
1521 tmp.c_str (), 1) != NULL);
1525 sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1526 VAR_DOMAIN, &is_a_field_of_this).symbol;
1529 if (is_a_field || (is_a_field_of_this.type != NULL))
1531 tempbuf = (char *) realloc (tempbuf, namelen + 1);
1532 strncpy (tempbuf, tmp.c_str (), namelen);
1533 tempbuf [namelen] = 0;
1534 yylval.sval.ptr = tempbuf;
1535 yylval.sval.length = namelen;
1536 yylval.ssym.sym.symbol = NULL;
1537 yylval.ssym.sym.block = NULL;
1539 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1545 /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1546 no psymtabs (coff, xcoff, or some future change to blow away the
1547 psymtabs once once symbols are read). */
1548 if ((sym && sym->aclass () == LOC_BLOCK)
1549 || lookup_symtab (tmp.c_str ()))
1551 yylval.ssym.sym.symbol = sym;
1552 yylval.ssym.sym.block = NULL;
1553 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1557 if (sym && sym->aclass () == LOC_TYPEDEF)
1560 /* Despite the following flaw, we need to keep this code enabled.
1561 Because we can get called from check_stub_method, if we don't
1562 handle nested types then it screws many operations in any
1563 program which uses nested types. */
1564 /* In "A::x", if x is a member function of A and there happens
1565 to be a type (nested or not, since the stabs don't make that
1566 distinction) named x, then this code incorrectly thinks we
1567 are dealing with nested types rather than a member function. */
1570 const char *namestart;
1571 struct symbol *best_sym;
1573 /* Look ahead to detect nested types. This probably should be
1574 done in the grammar, but trying seemed to introduce a lot
1575 of shift/reduce and reduce/reduce conflicts. It's possible
1576 that it could be done, though. Or perhaps a non-grammar, but
1577 less ad hoc, approach would work well. */
1579 /* Since we do not currently have any way of distinguishing
1580 a nested type from a non-nested one (the stabs don't tell
1581 us whether a type is nested), we just ignore the
1588 /* Skip whitespace. */
1589 while (*p == ' ' || *p == '\t' || *p == '\n')
1591 if (*p == ':' && p[1] == ':')
1593 /* Skip the `::'. */
1595 /* Skip whitespace. */
1596 while (*p == ' ' || *p == '\t' || *p == '\n')
1599 while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1600 || (*p >= 'a' && *p <= 'z')
1601 || (*p >= 'A' && *p <= 'Z'))
1605 struct symbol *cur_sym;
1606 /* As big as the whole rest of the expression, which is
1607 at least big enough. */
1609 = (char *) alloca (tmp.size () + strlen (namestart)
1614 memcpy (tmp1, tmp.c_str (), tmp.size ());
1615 tmp1 += tmp.size ();
1616 memcpy (tmp1, "::", 2);
1618 memcpy (tmp1, namestart, p - namestart);
1619 tmp1[p - namestart] = '\0';
1621 = lookup_symbol (ncopy,
1622 pstate->expression_context_block,
1623 VAR_DOMAIN, NULL).symbol;
1626 if (cur_sym->aclass () == LOC_TYPEDEF)
1644 yylval.tsym.type = best_sym->type ();
1646 yylval.tsym.type = sym->type ();
1652 = language_lookup_primitive_type (pstate->language (),
1653 pstate->gdbarch (), tmp.c_str ());
1654 if (yylval.tsym.type != NULL)
1660 /* Input names that aren't symbols but ARE valid hex numbers,
1661 when the input radix permits them, can be names or numbers
1662 depending on the parse. Note we support radixes > 16 here. */
1664 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1665 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1667 YYSTYPE newlval; /* Its value is ignored. */
1668 hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1671 yylval.ssym.sym.symbol = sym;
1672 yylval.ssym.sym.block = NULL;
1673 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1680 /* Any other kind of symbol. */
1681 yylval.ssym.sym.symbol = sym;
1682 yylval.ssym.sym.block = NULL;
1687 /* See language.h. */
1690 pascal_language::parser (struct parser_state *par_state) const
1692 /* Setting up the parser state. */
1693 scoped_restore pstate_restore = make_scoped_restore (&pstate);
1694 gdb_assert (par_state != NULL);
1698 int result = yyparse ();
1700 pstate->set_operation (pstate->pop ());
1705 yyerror (const char *msg)
1707 if (pstate->prev_lexptr)
1708 pstate->lexptr = pstate->prev_lexptr;
1710 error (_("A %s in expression, near `%s'."), msg, pstate->lexptr);