1 /* YACC parser for Pascal expressions, for GDB.
2 Copyright (C) 2000-2024 Free Software Foundation, Inc.
3
4 This file is part of GDB.
5
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.
10
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.
15
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/>. */
18
19 /* This file is derived from c-exp.y */
20
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.
29
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. */
37
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. */
44 %{
45
46 #include <ctype.h>
47 #include "expression.h"
48 #include "value.h"
49 #include "parser-defs.h"
50 #include "language.h"
51 #include "p-lang.h"
52 #include "block.h"
53 #include "expop.h"
54
55 #define parse_type(ps) builtin_type (ps->gdbarch ())
56
57 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror,
58 etc). */
59 #define GDB_YY_REMAP_PREFIX pascal_
60 #include "yy-remap.h"
61
62 /* The state of the parser, used internally when we are parsing the
63 expression. */
64
65 static struct parser_state *pstate = NULL;
66
67 /* Depth of parentheses. */
68 static int paren_depth;
69
70 int yyparse (void);
71
72 static int yylex (void);
73
74 static void yyerror (const char *);
75
76 static char *uptok (const char *, int);
77
78 static const char *pascal_skip_string (const char *str);
79
80 using namespace expr;
81 %}
82
83 /* Although the yacc "value" of an expression is not used,
84 since the result is stored in the structure being created,
85 other node types do have values. */
86
87 %union
88 {
89 LONGEST lval;
90 struct {
91 LONGEST val;
92 struct type *type;
93 } typed_val_int;
94 struct {
95 gdb_byte val[16];
96 struct type *type;
97 } typed_val_float;
98 struct symbol *sym;
99 struct type *tval;
100 struct stoken sval;
101 struct ttype tsym;
102 struct symtoken ssym;
103 int voidval;
104 const struct block *bval;
105 enum exp_opcode opcode;
106 struct internalvar *ivar;
107
108 struct type **tvec;
109 int *ivec;
110 }
111
112 %{
113 /* YYSTYPE gets defined by %union */
114 static int parse_number (struct parser_state *,
115 const char *, int, int, YYSTYPE *);
116
117 static struct type *current_type;
118 static int leftdiv_is_integer;
119 static void push_current_type (void);
120 static void pop_current_type (void);
121 static int search_field;
122 %}
123
124 %type <voidval> exp exp1 type_exp start normal_start variable qualified_name
125 %type <tval> type typebase
126 /* %type <bval> block */
127
128 /* Fancy type parsing. */
129 %type <tval> ptype
130
131 %token <typed_val_int> INT
132 %token <typed_val_float> FLOAT
133
134 /* Both NAME and TYPENAME tokens represent symbols in the input,
135 and both convey their data as strings.
136 But a TYPENAME is a string that happens to be defined as a typedef
137 or builtin type name (such as int or char)
138 and a NAME is any other symbol.
139 Contexts where this distinction is not important can use the
140 nonterminal "name", which matches either NAME or TYPENAME. */
141
142 %token <sval> STRING
143 %token <sval> FIELDNAME
144 %token <voidval> COMPLETE
145 %token <ssym> NAME /* BLOCKNAME defined below to give it higher precedence. */
146 %token <tsym> TYPENAME
147 %type <sval> name
148 %type <ssym> name_not_typename
149
150 /* A NAME_OR_INT is a symbol which is not known in the symbol table,
151 but which would parse as a valid number in the current input radix.
152 E.g. "c" when input_radix==16. Depending on the parse, it will be
153 turned into a name or into a number. */
154
155 %token <ssym> NAME_OR_INT
156
157 %token STRUCT CLASS SIZEOF COLONCOLON
158 %token ERROR
159
160 /* Special type cases, put in to allow the parser to distinguish different
161 legal basetypes. */
162
163 %token <sval> DOLLAR_VARIABLE
164
165
166 /* Object pascal */
167 %token THIS
168 %token <lval> TRUEKEYWORD FALSEKEYWORD
169
170 %left ','
171 %left ABOVE_COMMA
172 %right ASSIGN
173 %left NOT
174 %left OR
175 %left XOR
176 %left ANDAND
177 %left '=' NOTEQUAL
178 %left '<' '>' LEQ GEQ
179 %left LSH RSH DIV MOD
180 %left '@'
181 %left '+' '-'
182 %left '*' '/'
183 %right UNARY INCREMENT DECREMENT
184 %right ARROW '.' '[' '('
185 %left '^'
186 %token <ssym> BLOCKNAME
187 %type <bval> block
188 %left COLONCOLON
189
190
191 %%
192
193 start : { current_type = NULL;
194 search_field = 0;
195 leftdiv_is_integer = 0;
196 }
197 normal_start {}
198 ;
199
200 normal_start :
201 exp1
202 | type_exp
203 ;
204
205 type_exp: type
206 {
207 pstate->push_new<type_operation> ($1);
208 current_type = $1; } ;
209
210 /* Expressions, including the comma operator. */
211 exp1 : exp
212 | exp1 ',' exp
213 { pstate->wrap2<comma_operation> (); }
214 ;
215
216 /* Expressions, not including the comma operator. */
217 exp : exp '^' %prec UNARY
218 { pstate->wrap<unop_ind_operation> ();
219 if (current_type)
220 current_type = current_type->target_type (); }
221 ;
222
223 exp : '@' exp %prec UNARY
224 { pstate->wrap<unop_addr_operation> ();
225 if (current_type)
226 current_type = TYPE_POINTER_TYPE (current_type); }
227 ;
228
229 exp : '-' exp %prec UNARY
230 { pstate->wrap<unary_neg_operation> (); }
231 ;
232
233 exp : NOT exp %prec UNARY
234 { pstate->wrap<unary_logical_not_operation> (); }
235 ;
236
237 exp : INCREMENT '(' exp ')' %prec UNARY
238 { pstate->wrap<preinc_operation> (); }
239 ;
240
241 exp : DECREMENT '(' exp ')' %prec UNARY
242 { pstate->wrap<predec_operation> (); }
243 ;
244
245
246 field_exp : exp '.' %prec UNARY
247 { search_field = 1; }
248 ;
249
250 exp : field_exp FIELDNAME
251 {
252 pstate->push_new<structop_operation>
253 (pstate->pop (), copy_name ($2));
254 search_field = 0;
255 if (current_type)
256 {
257 while (current_type->code ()
258 == TYPE_CODE_PTR)
259 current_type =
260 current_type->target_type ();
261 current_type = lookup_struct_elt_type (
262 current_type, $2.ptr, 0);
263 }
264 }
265 ;
266
267
268 exp : field_exp name
269 {
270 pstate->push_new<structop_operation>
271 (pstate->pop (), copy_name ($2));
272 search_field = 0;
273 if (current_type)
274 {
275 while (current_type->code ()
276 == TYPE_CODE_PTR)
277 current_type =
278 current_type->target_type ();
279 current_type = lookup_struct_elt_type (
280 current_type, $2.ptr, 0);
281 }
282 }
283 ;
284 exp : field_exp name COMPLETE
285 {
286 structop_base_operation *op
287 = new structop_ptr_operation (pstate->pop (),
288 copy_name ($2));
289 pstate->mark_struct_expression (op);
290 pstate->push (operation_up (op));
291 }
292 ;
293 exp : field_exp COMPLETE
294 {
295 structop_base_operation *op
296 = new structop_ptr_operation (pstate->pop (), "");
297 pstate->mark_struct_expression (op);
298 pstate->push (operation_up (op));
299 }
300 ;
301
302 exp : exp '['
303 /* We need to save the current_type value. */
304 { const char *arrayname;
305 int arrayfieldindex
306 = pascal_is_string_type (current_type, NULL, NULL,
307 NULL, NULL, &arrayname);
308 if (arrayfieldindex)
309 {
310 current_type
311 = (current_type
312 ->field (arrayfieldindex - 1).type ());
313 pstate->push_new<structop_operation>
314 (pstate->pop (), arrayname);
315 }
316 push_current_type (); }
317 exp1 ']'
318 { pop_current_type ();
319 pstate->wrap2<subscript_operation> ();
320 if (current_type)
321 current_type = current_type->target_type (); }
322 ;
323
324 exp : exp '('
325 /* This is to save the value of arglist_len
326 being accumulated by an outer function call. */
327 { push_current_type ();
328 pstate->start_arglist (); }
329 arglist ')' %prec ARROW
330 {
331 std::vector<operation_up> args
332 = pstate->pop_vector (pstate->end_arglist ());
333 pstate->push_new<funcall_operation>
334 (pstate->pop (), std::move (args));
335 pop_current_type ();
336 if (current_type)
337 current_type = current_type->target_type ();
338 }
339 ;
340
341 arglist :
342 | exp
343 { pstate->arglist_len = 1; }
344 | arglist ',' exp %prec ABOVE_COMMA
345 { pstate->arglist_len++; }
346 ;
347
348 exp : type '(' exp ')' %prec UNARY
349 { if (current_type)
350 {
351 /* Allow automatic dereference of classes. */
352 if ((current_type->code () == TYPE_CODE_PTR)
353 && (current_type->target_type ()->code () == TYPE_CODE_STRUCT)
354 && (($1)->code () == TYPE_CODE_STRUCT))
355 pstate->wrap<unop_ind_operation> ();
356 }
357 pstate->push_new<unop_cast_operation>
358 (pstate->pop (), $1);
359 current_type = $1; }
360 ;
361
362 exp : '(' exp1 ')'
363 { }
364 ;
365
366 /* Binary operators in order of decreasing precedence. */
367
368 exp : exp '*' exp
369 { pstate->wrap2<mul_operation> (); }
370 ;
371
372 exp : exp '/' {
373 if (current_type && is_integral_type (current_type))
374 leftdiv_is_integer = 1;
375 }
376 exp
377 {
378 if (leftdiv_is_integer && current_type
379 && is_integral_type (current_type))
380 {
381 pstate->push_new<unop_cast_operation>
382 (pstate->pop (),
383 parse_type (pstate)->builtin_long_double);
384 current_type
385 = parse_type (pstate)->builtin_long_double;
386 leftdiv_is_integer = 0;
387 }
388
389 pstate->wrap2<div_operation> ();
390 }
391 ;
392
393 exp : exp DIV exp
394 { pstate->wrap2<intdiv_operation> (); }
395 ;
396
397 exp : exp MOD exp
398 { pstate->wrap2<rem_operation> (); }
399 ;
400
401 exp : exp '+' exp
402 { pstate->wrap2<add_operation> (); }
403 ;
404
405 exp : exp '-' exp
406 { pstate->wrap2<sub_operation> (); }
407 ;
408
409 exp : exp LSH exp
410 { pstate->wrap2<lsh_operation> (); }
411 ;
412
413 exp : exp RSH exp
414 { pstate->wrap2<rsh_operation> (); }
415 ;
416
417 exp : exp '=' exp
418 {
419 pstate->wrap2<equal_operation> ();
420 current_type = parse_type (pstate)->builtin_bool;
421 }
422 ;
423
424 exp : exp NOTEQUAL exp
425 {
426 pstate->wrap2<notequal_operation> ();
427 current_type = parse_type (pstate)->builtin_bool;
428 }
429 ;
430
431 exp : exp LEQ exp
432 {
433 pstate->wrap2<leq_operation> ();
434 current_type = parse_type (pstate)->builtin_bool;
435 }
436 ;
437
438 exp : exp GEQ exp
439 {
440 pstate->wrap2<geq_operation> ();
441 current_type = parse_type (pstate)->builtin_bool;
442 }
443 ;
444
445 exp : exp '<' exp
446 {
447 pstate->wrap2<less_operation> ();
448 current_type = parse_type (pstate)->builtin_bool;
449 }
450 ;
451
452 exp : exp '>' exp
453 {
454 pstate->wrap2<gtr_operation> ();
455 current_type = parse_type (pstate)->builtin_bool;
456 }
457 ;
458
459 exp : exp ANDAND exp
460 { pstate->wrap2<bitwise_and_operation> (); }
461 ;
462
463 exp : exp XOR exp
464 { pstate->wrap2<bitwise_xor_operation> (); }
465 ;
466
467 exp : exp OR exp
468 { pstate->wrap2<bitwise_ior_operation> (); }
469 ;
470
471 exp : exp ASSIGN exp
472 { pstate->wrap2<assign_operation> (); }
473 ;
474
475 exp : TRUEKEYWORD
476 {
477 pstate->push_new<bool_operation> ($1);
478 current_type = parse_type (pstate)->builtin_bool;
479 }
480 ;
481
482 exp : FALSEKEYWORD
483 {
484 pstate->push_new<bool_operation> ($1);
485 current_type = parse_type (pstate)->builtin_bool;
486 }
487 ;
488
489 exp : INT
490 {
491 pstate->push_new<long_const_operation>
492 ($1.type, $1.val);
493 current_type = $1.type;
494 }
495 ;
496
497 exp : NAME_OR_INT
498 { YYSTYPE val;
499 parse_number (pstate, $1.stoken.ptr,
500 $1.stoken.length, 0, &val);
501 pstate->push_new<long_const_operation>
502 (val.typed_val_int.type,
503 val.typed_val_int.val);
504 current_type = val.typed_val_int.type;
505 }
506 ;
507
508
509 exp : FLOAT
510 {
511 float_data data;
512 std::copy (std::begin ($1.val), std::end ($1.val),
513 std::begin (data));
514 pstate->push_new<float_const_operation> ($1.type, data);
515 }
516 ;
517
518 exp : variable
519 ;
520
521 exp : DOLLAR_VARIABLE
522 {
523 pstate->push_dollar ($1);
524
525 /* $ is the normal prefix for pascal
526 hexadecimal values but this conflicts
527 with the GDB use for debugger variables
528 so in expression to enter hexadecimal
529 values we still need to use C syntax with
530 0xff */
531 std::string tmp ($1.ptr, $1.length);
532 /* Handle current_type. */
533 struct internalvar *intvar
534 = lookup_only_internalvar (tmp.c_str () + 1);
535 if (intvar != nullptr)
536 {
537 scoped_value_mark mark;
538
539 value *val
540 = value_of_internalvar (pstate->gdbarch (),
541 intvar);
542 current_type = val->type ();
543 }
544 }
545 ;
546
547 exp : SIZEOF '(' type ')' %prec UNARY
548 {
549 current_type = parse_type (pstate)->builtin_int;
550 $3 = check_typedef ($3);
551 pstate->push_new<long_const_operation>
552 (parse_type (pstate)->builtin_int,
553 $3->length ()); }
554 ;
555
556 exp : SIZEOF '(' exp ')' %prec UNARY
557 { pstate->wrap<unop_sizeof_operation> ();
558 current_type = parse_type (pstate)->builtin_int; }
559
560 exp : STRING
561 { /* C strings are converted into array constants with
562 an explicit null byte added at the end. Thus
563 the array upper bound is the string length.
564 There is no such thing in C as a completely empty
565 string. */
566 const char *sp = $1.ptr; int count = $1.length;
567
568 std::vector<operation_up> args (count + 1);
569 for (int i = 0; i < count; ++i)
570 args[i] = (make_operation<long_const_operation>
571 (parse_type (pstate)->builtin_char,
572 *sp++));
573 args[count] = (make_operation<long_const_operation>
574 (parse_type (pstate)->builtin_char,
575 '\0'));
576 pstate->push_new<array_operation>
577 (0, $1.length, std::move (args));
578 }
579 ;
580
581 /* Object pascal */
582 exp : THIS
583 {
584 struct value * this_val;
585 struct type * this_type;
586 pstate->push_new<op_this_operation> ();
587 /* We need type of this. */
588 this_val
589 = value_of_this_silent (pstate->language ());
590 if (this_val)
591 this_type = this_val->type ();
592 else
593 this_type = NULL;
594 if (this_type)
595 {
596 if (this_type->code () == TYPE_CODE_PTR)
597 {
598 this_type = this_type->target_type ();
599 pstate->wrap<unop_ind_operation> ();
600 }
601 }
602
603 current_type = this_type;
604 }
605 ;
606
607 /* end of object pascal. */
608
609 block : BLOCKNAME
610 {
611 if ($1.sym.symbol != 0)
612 $$ = $1.sym.symbol->value_block ();
613 else
614 {
615 std::string copy = copy_name ($1.stoken);
616 struct symtab *tem =
617 lookup_symtab (copy.c_str ());
618 if (tem)
619 $$ = (tem->compunit ()->blockvector ()
620 ->static_block ());
621 else
622 error (_("No file or function \"%s\"."),
623 copy.c_str ());
624 }
625 }
626 ;
627
628 block : block COLONCOLON name
629 {
630 std::string copy = copy_name ($3);
631 struct symbol *tem
632 = lookup_symbol (copy.c_str (), $1,
633 SEARCH_FUNCTION_DOMAIN,
634 nullptr).symbol;
635
636 if (tem == nullptr)
637 error (_("No function \"%s\" in specified context."),
638 copy.c_str ());
639 $$ = tem->value_block (); }
640 ;
641
642 variable: block COLONCOLON name
643 { struct block_symbol sym;
644
645 std::string copy = copy_name ($3);
646 sym = lookup_symbol (copy.c_str (), $1,
647 SEARCH_VFT, NULL);
648 if (sym.symbol == 0)
649 error (_("No symbol \"%s\" in specified context."),
650 copy.c_str ());
651
652 pstate->push_new<var_value_operation> (sym);
653 }
654 ;
655
656 qualified_name: typebase COLONCOLON name
657 {
658 struct type *type = $1;
659
660 if (type->code () != TYPE_CODE_STRUCT
661 && type->code () != TYPE_CODE_UNION)
662 error (_("`%s' is not defined as an aggregate type."),
663 type->name ());
664
665 pstate->push_new<scope_operation>
666 (type, copy_name ($3));
667 }
668 ;
669
670 variable: qualified_name
671 | COLONCOLON name
672 {
673 std::string name = copy_name ($2);
674
675 struct block_symbol sym
676 = lookup_symbol (name.c_str (), nullptr,
677 SEARCH_VFT, nullptr);
678 pstate->push_symbol (name.c_str (), sym);
679 }
680 ;
681
682 variable: name_not_typename
683 { struct block_symbol sym = $1.sym;
684
685 if (sym.symbol)
686 {
687 if (symbol_read_needs_frame (sym.symbol))
688 pstate->block_tracker->update (sym);
689
690 pstate->push_new<var_value_operation> (sym);
691 current_type = sym.symbol->type (); }
692 else if ($1.is_a_field_of_this)
693 {
694 struct value * this_val;
695 struct type * this_type;
696 /* Object pascal: it hangs off of `this'. Must
697 not inadvertently convert from a method call
698 to data ref. */
699 pstate->block_tracker->update (sym);
700 operation_up thisop
701 = make_operation<op_this_operation> ();
702 pstate->push_new<structop_operation>
703 (std::move (thisop), copy_name ($1.stoken));
704 /* We need type of this. */
705 this_val
706 = value_of_this_silent (pstate->language ());
707 if (this_val)
708 this_type = this_val->type ();
709 else
710 this_type = NULL;
711 if (this_type)
712 current_type = lookup_struct_elt_type (
713 this_type,
714 copy_name ($1.stoken).c_str (), 0);
715 else
716 current_type = NULL;
717 }
718 else
719 {
720 struct bound_minimal_symbol msymbol;
721 std::string arg = copy_name ($1.stoken);
722
723 msymbol =
724 lookup_bound_minimal_symbol (arg.c_str ());
725 if (msymbol.minsym != NULL)
726 pstate->push_new<var_msym_value_operation>
727 (msymbol);
728 else if (!have_full_symbols ()
729 && !have_partial_symbols ())
730 error (_("No symbol table is loaded. "
731 "Use the \"file\" command."));
732 else
733 error (_("No symbol \"%s\" in current context."),
734 arg.c_str ());
735 }
736 }
737 ;
738
739
740 ptype : typebase
741 ;
742
743 /* We used to try to recognize more pointer to member types here, but
744 that didn't work (shift/reduce conflicts meant that these rules never
745 got executed). The problem is that
746 int (foo::bar::baz::bizzle)
747 is a function type but
748 int (foo::bar::baz::bizzle::*)
749 is a pointer to member type. Stroustrup loses again! */
750
751 type : ptype
752 ;
753
754 typebase /* Implements (approximately): (type-qualifier)* type-specifier */
755 : '^' typebase
756 { $$ = lookup_pointer_type ($2); }
757 | TYPENAME
758 { $$ = $1.type; }
759 | STRUCT name
760 { $$
761 = lookup_struct (copy_name ($2).c_str (),
762 pstate->expression_context_block);
763 }
764 | CLASS name
765 { $$
766 = lookup_struct (copy_name ($2).c_str (),
767 pstate->expression_context_block);
768 }
769 /* "const" and "volatile" are curently ignored. A type qualifier
770 after the type is handled in the ptype rule. I think these could
771 be too. */
772 ;
773
774 name : NAME { $$ = $1.stoken; }
775 | BLOCKNAME { $$ = $1.stoken; }
776 | TYPENAME { $$ = $1.stoken; }
777 | NAME_OR_INT { $$ = $1.stoken; }
778 ;
779
780 name_not_typename : NAME
781 | BLOCKNAME
782 /* These would be useful if name_not_typename was useful, but it is just
783 a fake for "variable", so these cause reduce/reduce conflicts because
784 the parser can't tell whether NAME_OR_INT is a name_not_typename (=variable,
785 =exp) or just an exp. If name_not_typename was ever used in an lvalue
786 context where only a name could occur, this might be useful.
787 | NAME_OR_INT
788 */
789 ;
790
791 %%
792
793 /* Take care of parsing a number (anything that starts with a digit).
794 Set yylval and return the token type; update lexptr.
795 LEN is the number of characters in it. */
796
797 /*** Needs some error checking for the float case ***/
798
799 static int
800 parse_number (struct parser_state *par_state,
801 const char *p, int len, int parsed_float, YYSTYPE *putithere)
802 {
803 ULONGEST n = 0;
804 ULONGEST prevn = 0;
805
806 int i = 0;
807 int c;
808 int base = input_radix;
809 int unsigned_p = 0;
810
811 /* Number of "L" suffixes encountered. */
812 int long_p = 0;
813
814 /* We have found a "L" or "U" suffix. */
815 int found_suffix = 0;
816
817 if (parsed_float)
818 {
819 /* Handle suffixes: 'f' for float, 'l' for long double.
820 FIXME: This appears to be an extension -- do we want this? */
821 if (len >= 1 && tolower (p[len - 1]) == 'f')
822 {
823 putithere->typed_val_float.type
824 = parse_type (par_state)->builtin_float;
825 len--;
826 }
827 else if (len >= 1 && tolower (p[len - 1]) == 'l')
828 {
829 putithere->typed_val_float.type
830 = parse_type (par_state)->builtin_long_double;
831 len--;
832 }
833 /* Default type for floating-point literals is double. */
834 else
835 {
836 putithere->typed_val_float.type
837 = parse_type (par_state)->builtin_double;
838 }
839
840 if (!parse_float (p, len,
841 putithere->typed_val_float.type,
842 putithere->typed_val_float.val))
843 return ERROR;
844 return FLOAT;
845 }
846
847 /* Handle base-switching prefixes 0x, 0t, 0d, 0. */
848 if (p[0] == '0' && len > 1)
849 switch (p[1])
850 {
851 case 'x':
852 case 'X':
853 if (len >= 3)
854 {
855 p += 2;
856 base = 16;
857 len -= 2;
858 }
859 break;
860
861 case 't':
862 case 'T':
863 case 'd':
864 case 'D':
865 if (len >= 3)
866 {
867 p += 2;
868 base = 10;
869 len -= 2;
870 }
871 break;
872
873 default:
874 base = 8;
875 break;
876 }
877
878 while (len-- > 0)
879 {
880 c = *p++;
881 if (c >= 'A' && c <= 'Z')
882 c += 'a' - 'A';
883 if (c != 'l' && c != 'u')
884 n *= base;
885 if (c >= '0' && c <= '9')
886 {
887 if (found_suffix)
888 return ERROR;
889 n += i = c - '0';
890 }
891 else
892 {
893 if (base > 10 && c >= 'a' && c <= 'f')
894 {
895 if (found_suffix)
896 return ERROR;
897 n += i = c - 'a' + 10;
898 }
899 else if (c == 'l')
900 {
901 ++long_p;
902 found_suffix = 1;
903 }
904 else if (c == 'u')
905 {
906 unsigned_p = 1;
907 found_suffix = 1;
908 }
909 else
910 return ERROR; /* Char not a digit */
911 }
912 if (i >= base)
913 return ERROR; /* Invalid digit in this base. */
914
915 if (c != 'l' && c != 'u')
916 {
917 /* Test for overflow. */
918 if (prevn == 0 && n == 0)
919 ;
920 else if (prevn >= n)
921 error (_("Numeric constant too large."));
922 }
923 prevn = n;
924 }
925
926 /* An integer constant is an int, a long, or a long long. An L
927 suffix forces it to be long; an LL suffix forces it to be long
928 long. If not forced to a larger size, it gets the first type of
929 the above that it fits in. To figure out whether it fits, we
930 shift it right and see whether anything remains. Note that we
931 can't shift sizeof (LONGEST) * HOST_CHAR_BIT bits or more in one
932 operation, because many compilers will warn about such a shift
933 (which always produces a zero result). Sometimes gdbarch_int_bit
934 or gdbarch_long_bit will be that big, sometimes not. To deal with
935 the case where it is we just always shift the value more than
936 once, with fewer bits each time. */
937
938 int int_bits = gdbarch_int_bit (par_state->gdbarch ());
939 int long_bits = gdbarch_long_bit (par_state->gdbarch ());
940 int long_long_bits = gdbarch_long_long_bit (par_state->gdbarch ());
941 bool have_signed = !unsigned_p;
942 bool have_int = long_p == 0;
943 bool have_long = long_p <= 1;
944 if (have_int && have_signed && fits_in_type (1, n, int_bits, true))
945 putithere->typed_val_int.type = parse_type (par_state)->builtin_int;
946 else if (have_int && fits_in_type (1, n, int_bits, false))
947 putithere->typed_val_int.type
948 = parse_type (par_state)->builtin_unsigned_int;
949 else if (have_long && have_signed && fits_in_type (1, n, long_bits, true))
950 putithere->typed_val_int.type = parse_type (par_state)->builtin_long;
951 else if (have_long && fits_in_type (1, n, long_bits, false))
952 putithere->typed_val_int.type
953 = parse_type (par_state)->builtin_unsigned_long;
954 else if (have_signed && fits_in_type (1, n, long_long_bits, true))
955 putithere->typed_val_int.type
956 = parse_type (par_state)->builtin_long_long;
957 else if (fits_in_type (1, n, long_long_bits, false))
958 putithere->typed_val_int.type
959 = parse_type (par_state)->builtin_unsigned_long_long;
960 else
961 error (_("Numeric constant too large."));
962 putithere->typed_val_int.val = n;
963
964 return INT;
965 }
966
967
968 struct type_push
969 {
970 struct type *stored;
971 struct type_push *next;
972 };
973
974 static struct type_push *tp_top = NULL;
975
976 static void
push_current_type(void)977 push_current_type (void)
978 {
979 struct type_push *tpnew;
980 tpnew = (struct type_push *) malloc (sizeof (struct type_push));
981 tpnew->next = tp_top;
982 tpnew->stored = current_type;
983 current_type = NULL;
984 tp_top = tpnew;
985 }
986
987 static void
pop_current_type(void)988 pop_current_type (void)
989 {
990 struct type_push *tp = tp_top;
991 if (tp)
992 {
993 current_type = tp->stored;
994 tp_top = tp->next;
995 free (tp);
996 }
997 }
998
999 struct p_token
1000 {
1001 const char *oper;
1002 int token;
1003 enum exp_opcode opcode;
1004 };
1005
1006 static const struct p_token tokentab3[] =
1007 {
1008 {"shr", RSH, OP_NULL},
1009 {"shl", LSH, OP_NULL},
1010 {"and", ANDAND, OP_NULL},
1011 {"div", DIV, OP_NULL},
1012 {"not", NOT, OP_NULL},
1013 {"mod", MOD, OP_NULL},
1014 {"inc", INCREMENT, OP_NULL},
1015 {"dec", DECREMENT, OP_NULL},
1016 {"xor", XOR, OP_NULL}
1017 };
1018
1019 static const struct p_token tokentab2[] =
1020 {
1021 {"or", OR, OP_NULL},
1022 {"<>", NOTEQUAL, OP_NULL},
1023 {"<=", LEQ, OP_NULL},
1024 {">=", GEQ, OP_NULL},
1025 {":=", ASSIGN, OP_NULL},
1026 {"::", COLONCOLON, OP_NULL} };
1027
1028 /* Allocate uppercased var: */
1029 /* make an uppercased copy of tokstart. */
1030 static char *
uptok(const char * tokstart,int namelen)1031 uptok (const char *tokstart, int namelen)
1032 {
1033 int i;
1034 char *uptokstart = (char *)malloc(namelen+1);
1035 for (i = 0;i <= namelen;i++)
1036 {
1037 if ((tokstart[i]>='a' && tokstart[i]<='z'))
1038 uptokstart[i] = tokstart[i]-('a'-'A');
1039 else
1040 uptokstart[i] = tokstart[i];
1041 }
1042 uptokstart[namelen]='\0';
1043 return uptokstart;
1044 }
1045
1046 /* Skip over a Pascal string. STR must point to the opening single quote
1047 character. This function returns a pointer to the character after the
1048 closing single quote character.
1049
1050 This function does not support embedded, escaped single quotes, which
1051 is done by placing two consecutive single quotes into a string.
1052 Support for this would be easy to add, but this function is only used
1053 from the Python expression parser, and if we did skip over escaped
1054 quotes then the rest of the expression parser wouldn't handle them
1055 correctly. */
1056 static const char *
pascal_skip_string(const char * str)1057 pascal_skip_string (const char *str)
1058 {
1059 gdb_assert (*str == '\'');
1060
1061 do
1062 ++str;
1063 while (*str != '\0' && *str != '\'');
1064
1065 return str;
1066 }
1067
1068 /* Read one token, getting characters through lexptr. */
1069
1070 static int
yylex(void)1071 yylex (void)
1072 {
1073 int c;
1074 int namelen;
1075 const char *tokstart;
1076 char *uptokstart;
1077 const char *tokptr;
1078 int explen, tempbufindex;
1079 static char *tempbuf;
1080 static int tempbufsize;
1081
1082 retry:
1083
1084 pstate->prev_lexptr = pstate->lexptr;
1085
1086 tokstart = pstate->lexptr;
1087 explen = strlen (pstate->lexptr);
1088
1089 /* See if it is a special token of length 3. */
1090 if (explen > 2)
1091 for (const auto &token : tokentab3)
1092 if (strncasecmp (tokstart, token.oper, 3) == 0
1093 && (!isalpha (token.oper[0]) || explen == 3
1094 || (!isalpha (tokstart[3])
1095 && !isdigit (tokstart[3]) && tokstart[3] != '_')))
1096 {
1097 pstate->lexptr += 3;
1098 yylval.opcode = token.opcode;
1099 return token.token;
1100 }
1101
1102 /* See if it is a special token of length 2. */
1103 if (explen > 1)
1104 for (const auto &token : tokentab2)
1105 if (strncasecmp (tokstart, token.oper, 2) == 0
1106 && (!isalpha (token.oper[0]) || explen == 2
1107 || (!isalpha (tokstart[2])
1108 && !isdigit (tokstart[2]) && tokstart[2] != '_')))
1109 {
1110 pstate->lexptr += 2;
1111 yylval.opcode = token.opcode;
1112 return token.token;
1113 }
1114
1115 switch (c = *tokstart)
1116 {
1117 case 0:
1118 if (search_field && pstate->parse_completion)
1119 return COMPLETE;
1120 else
1121 return 0;
1122
1123 case ' ':
1124 case '\t':
1125 case '\n':
1126 pstate->lexptr++;
1127 goto retry;
1128
1129 case '\'':
1130 /* We either have a character constant ('0' or '\177' for example)
1131 or we have a quoted symbol reference ('foo(int,int)' in object pascal
1132 for example). */
1133 pstate->lexptr++;
1134 c = *pstate->lexptr++;
1135 if (c == '\\')
1136 c = parse_escape (pstate->gdbarch (), &pstate->lexptr);
1137 else if (c == '\'')
1138 error (_("Empty character constant."));
1139
1140 yylval.typed_val_int.val = c;
1141 yylval.typed_val_int.type = parse_type (pstate)->builtin_char;
1142
1143 c = *pstate->lexptr++;
1144 if (c != '\'')
1145 {
1146 namelen = pascal_skip_string (tokstart) - tokstart;
1147 if (namelen > 2)
1148 {
1149 pstate->lexptr = tokstart + namelen;
1150 if (pstate->lexptr[-1] != '\'')
1151 error (_("Unmatched single quote."));
1152 namelen -= 2;
1153 tokstart++;
1154 uptokstart = uptok(tokstart,namelen);
1155 goto tryname;
1156 }
1157 error (_("Invalid character constant."));
1158 }
1159 return INT;
1160
1161 case '(':
1162 paren_depth++;
1163 pstate->lexptr++;
1164 return c;
1165
1166 case ')':
1167 if (paren_depth == 0)
1168 return 0;
1169 paren_depth--;
1170 pstate->lexptr++;
1171 return c;
1172
1173 case ',':
1174 if (pstate->comma_terminates && paren_depth == 0)
1175 return 0;
1176 pstate->lexptr++;
1177 return c;
1178
1179 case '.':
1180 /* Might be a floating point number. */
1181 if (pstate->lexptr[1] < '0' || pstate->lexptr[1] > '9')
1182 {
1183 goto symbol; /* Nope, must be a symbol. */
1184 }
1185
1186 [[fallthrough]];
1187
1188 case '0':
1189 case '1':
1190 case '2':
1191 case '3':
1192 case '4':
1193 case '5':
1194 case '6':
1195 case '7':
1196 case '8':
1197 case '9':
1198 {
1199 /* It's a number. */
1200 int got_dot = 0, got_e = 0, toktype;
1201 const char *p = tokstart;
1202 int hex = input_radix > 10;
1203
1204 if (c == '0' && (p[1] == 'x' || p[1] == 'X'))
1205 {
1206 p += 2;
1207 hex = 1;
1208 }
1209 else if (c == '0' && (p[1]=='t' || p[1]=='T'
1210 || p[1]=='d' || p[1]=='D'))
1211 {
1212 p += 2;
1213 hex = 0;
1214 }
1215
1216 for (;; ++p)
1217 {
1218 /* This test includes !hex because 'e' is a valid hex digit
1219 and thus does not indicate a floating point number when
1220 the radix is hex. */
1221 if (!hex && !got_e && (*p == 'e' || *p == 'E'))
1222 got_dot = got_e = 1;
1223 /* This test does not include !hex, because a '.' always indicates
1224 a decimal floating point number regardless of the radix. */
1225 else if (!got_dot && *p == '.')
1226 got_dot = 1;
1227 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
1228 && (*p == '-' || *p == '+'))
1229 /* This is the sign of the exponent, not the end of the
1230 number. */
1231 continue;
1232 /* We will take any letters or digits. parse_number will
1233 complain if past the radix, or if L or U are not final. */
1234 else if ((*p < '0' || *p > '9')
1235 && ((*p < 'a' || *p > 'z')
1236 && (*p < 'A' || *p > 'Z')))
1237 break;
1238 }
1239 toktype = parse_number (pstate, tokstart,
1240 p - tokstart, got_dot | got_e, &yylval);
1241 if (toktype == ERROR)
1242 error (_("Invalid number \"%.*s\"."), (int) (p - tokstart),
1243 tokstart);
1244 pstate->lexptr = p;
1245 return toktype;
1246 }
1247
1248 case '+':
1249 case '-':
1250 case '*':
1251 case '/':
1252 case '|':
1253 case '&':
1254 case '^':
1255 case '~':
1256 case '!':
1257 case '@':
1258 case '<':
1259 case '>':
1260 case '[':
1261 case ']':
1262 case '?':
1263 case ':':
1264 case '=':
1265 case '{':
1266 case '}':
1267 symbol:
1268 pstate->lexptr++;
1269 return c;
1270
1271 case '"':
1272
1273 /* Build the gdb internal form of the input string in tempbuf,
1274 translating any standard C escape forms seen. Note that the
1275 buffer is null byte terminated *only* for the convenience of
1276 debugging gdb itself and printing the buffer contents when
1277 the buffer contains no embedded nulls. Gdb does not depend
1278 upon the buffer being null byte terminated, it uses the length
1279 string instead. This allows gdb to handle C strings (as well
1280 as strings in other languages) with embedded null bytes. */
1281
1282 tokptr = ++tokstart;
1283 tempbufindex = 0;
1284
1285 do {
1286 /* Grow the static temp buffer if necessary, including allocating
1287 the first one on demand. */
1288 if (tempbufindex + 1 >= tempbufsize)
1289 {
1290 tempbuf = (char *) realloc (tempbuf, tempbufsize += 64);
1291 }
1292
1293 switch (*tokptr)
1294 {
1295 case '\0':
1296 case '"':
1297 /* Do nothing, loop will terminate. */
1298 break;
1299 case '\\':
1300 ++tokptr;
1301 c = parse_escape (pstate->gdbarch (), &tokptr);
1302 if (c == -1)
1303 {
1304 continue;
1305 }
1306 tempbuf[tempbufindex++] = c;
1307 break;
1308 default:
1309 tempbuf[tempbufindex++] = *tokptr++;
1310 break;
1311 }
1312 } while ((*tokptr != '"') && (*tokptr != '\0'));
1313 if (*tokptr++ != '"')
1314 {
1315 error (_("Unterminated string in expression."));
1316 }
1317 tempbuf[tempbufindex] = '\0'; /* See note above. */
1318 yylval.sval.ptr = tempbuf;
1319 yylval.sval.length = tempbufindex;
1320 pstate->lexptr = tokptr;
1321 return (STRING);
1322 }
1323
1324 if (!(c == '_' || c == '$'
1325 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
1326 /* We must have come across a bad character (e.g. ';'). */
1327 error (_("Invalid character '%c' in expression."), c);
1328
1329 /* It's a name. See how long it is. */
1330 namelen = 0;
1331 for (c = tokstart[namelen];
1332 (c == '_' || c == '$' || (c >= '0' && c <= '9')
1333 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || c == '<');)
1334 {
1335 /* Template parameter lists are part of the name.
1336 FIXME: This mishandles `print $a<4&&$a>3'. */
1337 if (c == '<')
1338 {
1339 int i = namelen;
1340 int nesting_level = 1;
1341 while (tokstart[++i])
1342 {
1343 if (tokstart[i] == '<')
1344 nesting_level++;
1345 else if (tokstart[i] == '>')
1346 {
1347 if (--nesting_level == 0)
1348 break;
1349 }
1350 }
1351 if (tokstart[i] == '>')
1352 namelen = i;
1353 else
1354 break;
1355 }
1356
1357 /* do NOT uppercase internals because of registers !!! */
1358 c = tokstart[++namelen];
1359 }
1360
1361 uptokstart = uptok(tokstart,namelen);
1362
1363 /* The token "if" terminates the expression and is NOT
1364 removed from the input stream. */
1365 if (namelen == 2 && uptokstart[0] == 'I' && uptokstart[1] == 'F')
1366 {
1367 free (uptokstart);
1368 return 0;
1369 }
1370
1371 pstate->lexptr += namelen;
1372
1373 tryname:
1374
1375 /* Catch specific keywords. Should be done with a data structure. */
1376 switch (namelen)
1377 {
1378 case 6:
1379 if (strcmp (uptokstart, "OBJECT") == 0)
1380 {
1381 free (uptokstart);
1382 return CLASS;
1383 }
1384 if (strcmp (uptokstart, "RECORD") == 0)
1385 {
1386 free (uptokstart);
1387 return STRUCT;
1388 }
1389 if (strcmp (uptokstart, "SIZEOF") == 0)
1390 {
1391 free (uptokstart);
1392 return SIZEOF;
1393 }
1394 break;
1395 case 5:
1396 if (strcmp (uptokstart, "CLASS") == 0)
1397 {
1398 free (uptokstart);
1399 return CLASS;
1400 }
1401 if (strcmp (uptokstart, "FALSE") == 0)
1402 {
1403 yylval.lval = 0;
1404 free (uptokstart);
1405 return FALSEKEYWORD;
1406 }
1407 break;
1408 case 4:
1409 if (strcmp (uptokstart, "TRUE") == 0)
1410 {
1411 yylval.lval = 1;
1412 free (uptokstart);
1413 return TRUEKEYWORD;
1414 }
1415 if (strcmp (uptokstart, "SELF") == 0)
1416 {
1417 /* Here we search for 'this' like
1418 inserted in FPC stabs debug info. */
1419 static const char this_name[] = "this";
1420
1421 if (lookup_symbol (this_name, pstate->expression_context_block,
1422 SEARCH_VFT, NULL).symbol)
1423 {
1424 free (uptokstart);
1425 return THIS;
1426 }
1427 }
1428 break;
1429 default:
1430 break;
1431 }
1432
1433 yylval.sval.ptr = tokstart;
1434 yylval.sval.length = namelen;
1435
1436 if (*tokstart == '$')
1437 {
1438 free (uptokstart);
1439 return DOLLAR_VARIABLE;
1440 }
1441
1442 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1443 functions or symtabs. If this is not so, then ...
1444 Use token-type TYPENAME for symbols that happen to be defined
1445 currently as names of types; NAME for other symbols.
1446 The caller is not constrained to care about the distinction. */
1447 {
1448 std::string tmp = copy_name (yylval.sval);
1449 struct symbol *sym;
1450 struct field_of_this_result is_a_field_of_this = { .type = NULL };
1451 int is_a_field = 0;
1452 int hextype;
1453
1454 is_a_field_of_this.type = NULL;
1455 if (search_field && current_type)
1456 is_a_field = (lookup_struct_elt_type (current_type,
1457 tmp.c_str (), 1) != NULL);
1458 if (is_a_field)
1459 sym = NULL;
1460 else
1461 sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1462 SEARCH_VFT, &is_a_field_of_this).symbol;
1463 /* second chance uppercased (as Free Pascal does). */
1464 if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1465 {
1466 for (int i = 0; i <= namelen; i++)
1467 {
1468 if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1469 tmp[i] -= ('a'-'A');
1470 }
1471 if (search_field && current_type)
1472 is_a_field = (lookup_struct_elt_type (current_type,
1473 tmp.c_str (), 1) != NULL);
1474 if (is_a_field)
1475 sym = NULL;
1476 else
1477 sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1478 SEARCH_VFT, &is_a_field_of_this).symbol;
1479 }
1480 /* Third chance Capitalized (as GPC does). */
1481 if (!sym && is_a_field_of_this.type == NULL && !is_a_field)
1482 {
1483 for (int i = 0; i <= namelen; i++)
1484 {
1485 if (i == 0)
1486 {
1487 if ((tmp[i] >= 'a' && tmp[i] <= 'z'))
1488 tmp[i] -= ('a'-'A');
1489 }
1490 else
1491 if ((tmp[i] >= 'A' && tmp[i] <= 'Z'))
1492 tmp[i] -= ('A'-'a');
1493 }
1494 if (search_field && current_type)
1495 is_a_field = (lookup_struct_elt_type (current_type,
1496 tmp.c_str (), 1) != NULL);
1497 if (is_a_field)
1498 sym = NULL;
1499 else
1500 sym = lookup_symbol (tmp.c_str (), pstate->expression_context_block,
1501 SEARCH_VFT, &is_a_field_of_this).symbol;
1502 }
1503
1504 if (is_a_field || (is_a_field_of_this.type != NULL))
1505 {
1506 tempbuf = (char *) realloc (tempbuf, namelen + 1);
1507 strncpy (tempbuf, tmp.c_str (), namelen);
1508 tempbuf [namelen] = 0;
1509 yylval.sval.ptr = tempbuf;
1510 yylval.sval.length = namelen;
1511 yylval.ssym.sym.symbol = NULL;
1512 yylval.ssym.sym.block = NULL;
1513 free (uptokstart);
1514 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1515 if (is_a_field)
1516 return FIELDNAME;
1517 else
1518 return NAME;
1519 }
1520 /* Call lookup_symtab, not lookup_partial_symtab, in case there are
1521 no psymtabs (coff, xcoff, or some future change to blow away the
1522 psymtabs once once symbols are read). */
1523 if ((sym && sym->aclass () == LOC_BLOCK)
1524 || lookup_symtab (tmp.c_str ()))
1525 {
1526 yylval.ssym.sym.symbol = sym;
1527 yylval.ssym.sym.block = NULL;
1528 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1529 free (uptokstart);
1530 return BLOCKNAME;
1531 }
1532 if (sym && sym->aclass () == LOC_TYPEDEF)
1533 {
1534 #if 1
1535 /* Despite the following flaw, we need to keep this code enabled.
1536 Because we can get called from check_stub_method, if we don't
1537 handle nested types then it screws many operations in any
1538 program which uses nested types. */
1539 /* In "A::x", if x is a member function of A and there happens
1540 to be a type (nested or not, since the stabs don't make that
1541 distinction) named x, then this code incorrectly thinks we
1542 are dealing with nested types rather than a member function. */
1543
1544 const char *p;
1545 const char *namestart;
1546 struct symbol *best_sym;
1547
1548 /* Look ahead to detect nested types. This probably should be
1549 done in the grammar, but trying seemed to introduce a lot
1550 of shift/reduce and reduce/reduce conflicts. It's possible
1551 that it could be done, though. Or perhaps a non-grammar, but
1552 less ad hoc, approach would work well. */
1553
1554 /* Since we do not currently have any way of distinguishing
1555 a nested type from a non-nested one (the stabs don't tell
1556 us whether a type is nested), we just ignore the
1557 containing type. */
1558
1559 p = pstate->lexptr;
1560 best_sym = sym;
1561 while (1)
1562 {
1563 /* Skip whitespace. */
1564 while (*p == ' ' || *p == '\t' || *p == '\n')
1565 ++p;
1566 if (*p == ':' && p[1] == ':')
1567 {
1568 /* Skip the `::'. */
1569 p += 2;
1570 /* Skip whitespace. */
1571 while (*p == ' ' || *p == '\t' || *p == '\n')
1572 ++p;
1573 namestart = p;
1574 while (*p == '_' || *p == '$' || (*p >= '0' && *p <= '9')
1575 || (*p >= 'a' && *p <= 'z')
1576 || (*p >= 'A' && *p <= 'Z'))
1577 ++p;
1578 if (p != namestart)
1579 {
1580 struct symbol *cur_sym;
1581 /* As big as the whole rest of the expression, which is
1582 at least big enough. */
1583 char *ncopy
1584 = (char *) alloca (tmp.size () + strlen (namestart)
1585 + 3);
1586 char *tmp1;
1587
1588 tmp1 = ncopy;
1589 memcpy (tmp1, tmp.c_str (), tmp.size ());
1590 tmp1 += tmp.size ();
1591 memcpy (tmp1, "::", 2);
1592 tmp1 += 2;
1593 memcpy (tmp1, namestart, p - namestart);
1594 tmp1[p - namestart] = '\0';
1595 cur_sym
1596 = lookup_symbol (ncopy,
1597 pstate->expression_context_block,
1598 SEARCH_VFT, NULL).symbol;
1599 if (cur_sym)
1600 {
1601 if (cur_sym->aclass () == LOC_TYPEDEF)
1602 {
1603 best_sym = cur_sym;
1604 pstate->lexptr = p;
1605 }
1606 else
1607 break;
1608 }
1609 else
1610 break;
1611 }
1612 else
1613 break;
1614 }
1615 else
1616 break;
1617 }
1618
1619 yylval.tsym.type = best_sym->type ();
1620 #else /* not 0 */
1621 yylval.tsym.type = sym->type ();
1622 #endif /* not 0 */
1623 free (uptokstart);
1624 return TYPENAME;
1625 }
1626 yylval.tsym.type
1627 = language_lookup_primitive_type (pstate->language (),
1628 pstate->gdbarch (), tmp.c_str ());
1629 if (yylval.tsym.type != NULL)
1630 {
1631 free (uptokstart);
1632 return TYPENAME;
1633 }
1634
1635 /* Input names that aren't symbols but ARE valid hex numbers,
1636 when the input radix permits them, can be names or numbers
1637 depending on the parse. Note we support radixes > 16 here. */
1638 if (!sym
1639 && ((tokstart[0] >= 'a' && tokstart[0] < 'a' + input_radix - 10)
1640 || (tokstart[0] >= 'A' && tokstart[0] < 'A' + input_radix - 10)))
1641 {
1642 YYSTYPE newlval; /* Its value is ignored. */
1643 hextype = parse_number (pstate, tokstart, namelen, 0, &newlval);
1644 if (hextype == INT)
1645 {
1646 yylval.ssym.sym.symbol = sym;
1647 yylval.ssym.sym.block = NULL;
1648 yylval.ssym.is_a_field_of_this = is_a_field_of_this.type != NULL;
1649 free (uptokstart);
1650 return NAME_OR_INT;
1651 }
1652 }
1653
1654 free(uptokstart);
1655 /* Any other kind of symbol. */
1656 yylval.ssym.sym.symbol = sym;
1657 yylval.ssym.sym.block = NULL;
1658 return NAME;
1659 }
1660 }
1661
1662 /* See language.h. */
1663
1664 int
parser(struct parser_state * par_state)1665 pascal_language::parser (struct parser_state *par_state) const
1666 {
1667 /* Setting up the parser state. */
1668 scoped_restore pstate_restore = make_scoped_restore (&pstate);
1669 gdb_assert (par_state != NULL);
1670 pstate = par_state;
1671 paren_depth = 0;
1672
1673 int result = yyparse ();
1674 if (!result)
1675 pstate->set_operation (pstate->pop ());
1676 return result;
1677 }
1678
1679 static void
yyerror(const char * msg)1680 yyerror (const char *msg)
1681 {
1682 pstate->parse_error (msg);
1683 }
1684