Make base class for parser_state
[deliverable/binutils-gdb.git] / gdb / m2-exp.y
CommitLineData
c906108c 1/* YACC grammar for Modula-2 expressions, for GDB.
42a4f53d 2 Copyright (C) 1986-2019 Free Software Foundation, Inc.
c906108c
SS
3 Generated from expread.y (now c-exp.y) and contributed by the Department
4 of Computer Science at the State University of New York at Buffalo, 1991.
5
5b1ba0e5 6 This file is part of GDB.
c906108c 7
5b1ba0e5
NS
8 This program is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 3 of the License, or
11 (at your option) any later version.
c906108c 12
5b1ba0e5
NS
13 This program is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
c906108c 17
5b1ba0e5
NS
18 You should have received a copy of the GNU General Public License
19 along with this program. If not, see <http://www.gnu.org/licenses/>. */
c906108c
SS
20
21/* Parse a Modula-2 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
025bb325 36 times by the parser generator. */
c906108c
SS
37
38%{
39
40#include "defs.h"
c906108c
SS
41#include "expression.h"
42#include "language.h"
43#include "value.h"
44#include "parser-defs.h"
45#include "m2-lang.h"
46#include "bfd.h" /* Required by objfiles.h. */
47#include "symfile.h" /* Required by objfiles.h. */
48#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
fe898f56 49#include "block.h"
c906108c 50
fa9f5be6
TT
51#define parse_type(ps) builtin_type (ps->gdbarch ())
52#define parse_m2_type(ps) builtin_m2_type (ps->gdbarch ())
3e79cecf 53
b3f11165
PA
54/* Remap normal yacc parser interface names (yyparse, yylex, yyerror,
55 etc). */
56#define GDB_YY_REMAP_PREFIX m2_
57#include "yy-remap.h"
f461f5cf 58
410a0ff2
SDJ
59/* The state of the parser, used internally when we are parsing the
60 expression. */
61
62static struct parser_state *pstate = NULL;
63
a14ed312 64int yyparse (void);
c906108c 65
a14ed312 66static int yylex (void);
c906108c 67
69d340c6 68static void yyerror (const char *);
c906108c 69
a14ed312 70static int parse_number (int);
c906108c 71
025bb325 72/* The sign of the number being parsed. */
c906108c
SS
73static int number_sign = 1;
74
c906108c
SS
75%}
76
77/* Although the yacc "value" of an expression is not used,
78 since the result is stored in the structure being created,
79 other node types do have values. */
80
81%union
82 {
83 LONGEST lval;
84 ULONGEST ulval;
edd079d9 85 gdb_byte val[16];
c906108c
SS
86 struct symbol *sym;
87 struct type *tval;
88 struct stoken sval;
89 int voidval;
3977b71f 90 const struct block *bval;
c906108c
SS
91 enum exp_opcode opcode;
92 struct internalvar *ivar;
93
94 struct type **tvec;
95 int *ivec;
96 }
97
98%type <voidval> exp type_exp start set
99%type <voidval> variable
100%type <tval> type
101%type <bval> block
102%type <sym> fblock
103
104%token <lval> INT HEX ERROR
105%token <ulval> UINT M2_TRUE M2_FALSE CHAR
edd079d9 106%token <val> FLOAT
c906108c
SS
107
108/* Both NAME and TYPENAME tokens represent symbols in the input,
109 and both convey their data as strings.
110 But a TYPENAME is a string that happens to be defined as a typedef
111 or builtin type name (such as int or char)
112 and a NAME is any other symbol.
113
114 Contexts where this distinction is not important can use the
115 nonterminal "name", which matches either NAME or TYPENAME. */
116
117%token <sval> STRING
118%token <sval> NAME BLOCKNAME IDENT VARNAME
119%token <sval> TYPENAME
120
121%token SIZE CAP ORD HIGH ABS MIN_FUNC MAX_FUNC FLOAT_FUNC VAL CHR ODD TRUNC
844781a1 122%token TSIZE
c906108c
SS
123%token INC DEC INCL EXCL
124
125/* The GDB scope operator */
126%token COLONCOLON
127
cfeadda5 128%token <voidval> DOLLAR_VARIABLE
c906108c
SS
129
130/* M2 tokens */
131%left ','
132%left ABOVE_COMMA
133%nonassoc ASSIGN
134%left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
135%left OROR
136%left LOGICAL_AND '&'
137%left '@'
138%left '+' '-'
139%left '*' '/' DIV MOD
140%right UNARY
141%right '^' DOT '[' '('
142%right NOT '~'
143%left COLONCOLON QID
144/* This is not an actual token ; it is used for precedence.
145%right QID
146*/
147
148\f
149%%
150
151start : exp
152 | type_exp
153 ;
154
155type_exp: type
410a0ff2
SDJ
156 { write_exp_elt_opcode (pstate, OP_TYPE);
157 write_exp_elt_type (pstate, $1);
158 write_exp_elt_opcode (pstate, OP_TYPE);
c906108c
SS
159 }
160 ;
161
162/* Expressions */
163
164exp : exp '^' %prec UNARY
410a0ff2 165 { write_exp_elt_opcode (pstate, UNOP_IND); }
ef944135 166 ;
c906108c
SS
167
168exp : '-'
169 { number_sign = -1; }
170 exp %prec UNARY
171 { number_sign = 1;
410a0ff2 172 write_exp_elt_opcode (pstate, UNOP_NEG); }
c906108c
SS
173 ;
174
175exp : '+' exp %prec UNARY
410a0ff2 176 { write_exp_elt_opcode (pstate, UNOP_PLUS); }
c906108c
SS
177 ;
178
179exp : not_exp exp %prec UNARY
410a0ff2 180 { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
c906108c
SS
181 ;
182
183not_exp : NOT
184 | '~'
185 ;
186
187exp : CAP '(' exp ')'
410a0ff2 188 { write_exp_elt_opcode (pstate, UNOP_CAP); }
c906108c
SS
189 ;
190
191exp : ORD '(' exp ')'
410a0ff2 192 { write_exp_elt_opcode (pstate, UNOP_ORD); }
c906108c
SS
193 ;
194
195exp : ABS '(' exp ')'
410a0ff2 196 { write_exp_elt_opcode (pstate, UNOP_ABS); }
c906108c
SS
197 ;
198
199exp : HIGH '(' exp ')'
410a0ff2 200 { write_exp_elt_opcode (pstate, UNOP_HIGH); }
c906108c
SS
201 ;
202
203exp : MIN_FUNC '(' type ')'
410a0ff2
SDJ
204 { write_exp_elt_opcode (pstate, UNOP_MIN);
205 write_exp_elt_type (pstate, $3);
206 write_exp_elt_opcode (pstate, UNOP_MIN); }
c906108c
SS
207 ;
208
209exp : MAX_FUNC '(' type ')'
410a0ff2
SDJ
210 { write_exp_elt_opcode (pstate, UNOP_MAX);
211 write_exp_elt_type (pstate, $3);
212 write_exp_elt_opcode (pstate, UNOP_MAX); }
c906108c
SS
213 ;
214
215exp : FLOAT_FUNC '(' exp ')'
410a0ff2 216 { write_exp_elt_opcode (pstate, UNOP_FLOAT); }
c906108c
SS
217 ;
218
219exp : VAL '(' type ',' exp ')'
410a0ff2
SDJ
220 { write_exp_elt_opcode (pstate, BINOP_VAL);
221 write_exp_elt_type (pstate, $3);
222 write_exp_elt_opcode (pstate, BINOP_VAL); }
c906108c
SS
223 ;
224
225exp : CHR '(' exp ')'
410a0ff2 226 { write_exp_elt_opcode (pstate, UNOP_CHR); }
c906108c
SS
227 ;
228
229exp : ODD '(' exp ')'
410a0ff2 230 { write_exp_elt_opcode (pstate, UNOP_ODD); }
c906108c
SS
231 ;
232
233exp : TRUNC '(' exp ')'
410a0ff2 234 { write_exp_elt_opcode (pstate, UNOP_TRUNC); }
c906108c
SS
235 ;
236
844781a1 237exp : TSIZE '(' exp ')'
410a0ff2 238 { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
844781a1
GM
239 ;
240
c906108c 241exp : SIZE exp %prec UNARY
410a0ff2 242 { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
c906108c
SS
243 ;
244
245
246exp : INC '(' exp ')'
410a0ff2 247 { write_exp_elt_opcode (pstate, UNOP_PREINCREMENT); }
c906108c
SS
248 ;
249
250exp : INC '(' exp ',' exp ')'
410a0ff2
SDJ
251 { write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
252 write_exp_elt_opcode (pstate, BINOP_ADD);
253 write_exp_elt_opcode (pstate,
254 BINOP_ASSIGN_MODIFY); }
c906108c
SS
255 ;
256
257exp : DEC '(' exp ')'
410a0ff2 258 { write_exp_elt_opcode (pstate, UNOP_PREDECREMENT);}
c906108c
SS
259 ;
260
261exp : DEC '(' exp ',' exp ')'
410a0ff2
SDJ
262 { write_exp_elt_opcode (pstate, BINOP_ASSIGN_MODIFY);
263 write_exp_elt_opcode (pstate, BINOP_SUB);
264 write_exp_elt_opcode (pstate,
265 BINOP_ASSIGN_MODIFY); }
c906108c
SS
266 ;
267
268exp : exp DOT NAME
410a0ff2
SDJ
269 { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
270 write_exp_string (pstate, $3);
271 write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
c906108c
SS
272 ;
273
274exp : set
275 ;
276
277exp : exp IN set
001083c6 278 { error (_("Sets are not implemented."));}
c906108c
SS
279 ;
280
281exp : INCL '(' exp ',' exp ')'
001083c6 282 { error (_("Sets are not implemented."));}
c906108c
SS
283 ;
284
285exp : EXCL '(' exp ',' exp ')'
001083c6 286 { error (_("Sets are not implemented."));}
ef944135 287 ;
c906108c
SS
288
289set : '{' arglist '}'
001083c6 290 { error (_("Sets are not implemented."));}
c906108c 291 | type '{' arglist '}'
001083c6 292 { error (_("Sets are not implemented."));}
c906108c
SS
293 ;
294
295
296/* Modula-2 array subscript notation [a,b,c...] */
297exp : exp '['
298 /* This function just saves the number of arguments
299 that follow in the list. It is *not* specific to
300 function types */
301 { start_arglist(); }
302 non_empty_arglist ']' %prec DOT
410a0ff2
SDJ
303 { write_exp_elt_opcode (pstate, MULTI_SUBSCRIPT);
304 write_exp_elt_longcst (pstate,
305 (LONGEST) end_arglist());
306 write_exp_elt_opcode (pstate, MULTI_SUBSCRIPT); }
c906108c
SS
307 ;
308
844781a1 309exp : exp '[' exp ']'
410a0ff2 310 { write_exp_elt_opcode (pstate, BINOP_SUBSCRIPT); }
844781a1
GM
311 ;
312
c906108c
SS
313exp : exp '('
314 /* This is to save the value of arglist_len
315 being accumulated by an outer function call. */
316 { start_arglist (); }
317 arglist ')' %prec DOT
410a0ff2
SDJ
318 { write_exp_elt_opcode (pstate, OP_FUNCALL);
319 write_exp_elt_longcst (pstate,
320 (LONGEST) end_arglist ());
321 write_exp_elt_opcode (pstate, OP_FUNCALL); }
c906108c
SS
322 ;
323
324arglist :
325 ;
326
327arglist : exp
328 { arglist_len = 1; }
329 ;
330
331arglist : arglist ',' exp %prec ABOVE_COMMA
332 { arglist_len++; }
333 ;
334
335non_empty_arglist
336 : exp
337 { arglist_len = 1; }
338 ;
339
340non_empty_arglist
341 : non_empty_arglist ',' exp %prec ABOVE_COMMA
342 { arglist_len++; }
343 ;
344
345/* GDB construct */
346exp : '{' type '}' exp %prec UNARY
410a0ff2
SDJ
347 { write_exp_elt_opcode (pstate, UNOP_MEMVAL);
348 write_exp_elt_type (pstate, $2);
349 write_exp_elt_opcode (pstate, UNOP_MEMVAL); }
c906108c
SS
350 ;
351
352exp : type '(' exp ')' %prec UNARY
410a0ff2
SDJ
353 { write_exp_elt_opcode (pstate, UNOP_CAST);
354 write_exp_elt_type (pstate, $1);
355 write_exp_elt_opcode (pstate, UNOP_CAST); }
c906108c
SS
356 ;
357
358exp : '(' exp ')'
359 { }
360 ;
361
362/* Binary operators in order of decreasing precedence. Note that some
363 of these operators are overloaded! (ie. sets) */
364
365/* GDB construct */
366exp : exp '@' exp
410a0ff2 367 { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
c906108c
SS
368 ;
369
370exp : exp '*' exp
410a0ff2 371 { write_exp_elt_opcode (pstate, BINOP_MUL); }
c906108c
SS
372 ;
373
374exp : exp '/' exp
410a0ff2 375 { write_exp_elt_opcode (pstate, BINOP_DIV); }
c906108c
SS
376 ;
377
378exp : exp DIV exp
410a0ff2 379 { write_exp_elt_opcode (pstate, BINOP_INTDIV); }
c906108c
SS
380 ;
381
382exp : exp MOD exp
410a0ff2 383 { write_exp_elt_opcode (pstate, BINOP_REM); }
c906108c
SS
384 ;
385
386exp : exp '+' exp
410a0ff2 387 { write_exp_elt_opcode (pstate, BINOP_ADD); }
c906108c
SS
388 ;
389
390exp : exp '-' exp
410a0ff2 391 { write_exp_elt_opcode (pstate, BINOP_SUB); }
c906108c
SS
392 ;
393
394exp : exp '=' exp
410a0ff2 395 { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
c906108c
SS
396 ;
397
398exp : exp NOTEQUAL exp
410a0ff2 399 { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
c906108c 400 | exp '#' exp
410a0ff2 401 { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
c906108c
SS
402 ;
403
404exp : exp LEQ exp
410a0ff2 405 { write_exp_elt_opcode (pstate, BINOP_LEQ); }
c906108c
SS
406 ;
407
408exp : exp GEQ exp
410a0ff2 409 { write_exp_elt_opcode (pstate, BINOP_GEQ); }
c906108c
SS
410 ;
411
412exp : exp '<' exp
410a0ff2 413 { write_exp_elt_opcode (pstate, BINOP_LESS); }
c906108c
SS
414 ;
415
416exp : exp '>' exp
410a0ff2 417 { write_exp_elt_opcode (pstate, BINOP_GTR); }
c906108c
SS
418 ;
419
420exp : exp LOGICAL_AND exp
410a0ff2 421 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
c906108c
SS
422 ;
423
424exp : exp OROR exp
410a0ff2 425 { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
c906108c
SS
426 ;
427
428exp : exp ASSIGN exp
410a0ff2 429 { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
c906108c
SS
430 ;
431
432
433/* Constants */
434
435exp : M2_TRUE
410a0ff2
SDJ
436 { write_exp_elt_opcode (pstate, OP_BOOL);
437 write_exp_elt_longcst (pstate, (LONGEST) $1);
438 write_exp_elt_opcode (pstate, OP_BOOL); }
c906108c
SS
439 ;
440
441exp : M2_FALSE
410a0ff2
SDJ
442 { write_exp_elt_opcode (pstate, OP_BOOL);
443 write_exp_elt_longcst (pstate, (LONGEST) $1);
444 write_exp_elt_opcode (pstate, OP_BOOL); }
c906108c
SS
445 ;
446
447exp : INT
410a0ff2
SDJ
448 { write_exp_elt_opcode (pstate, OP_LONG);
449 write_exp_elt_type (pstate,
450 parse_m2_type (pstate)->builtin_int);
451 write_exp_elt_longcst (pstate, (LONGEST) $1);
452 write_exp_elt_opcode (pstate, OP_LONG); }
c906108c
SS
453 ;
454
455exp : UINT
456 {
410a0ff2
SDJ
457 write_exp_elt_opcode (pstate, OP_LONG);
458 write_exp_elt_type (pstate,
459 parse_m2_type (pstate)
460 ->builtin_card);
461 write_exp_elt_longcst (pstate, (LONGEST) $1);
462 write_exp_elt_opcode (pstate, OP_LONG);
c906108c
SS
463 }
464 ;
465
466exp : CHAR
410a0ff2
SDJ
467 { write_exp_elt_opcode (pstate, OP_LONG);
468 write_exp_elt_type (pstate,
469 parse_m2_type (pstate)
470 ->builtin_char);
471 write_exp_elt_longcst (pstate, (LONGEST) $1);
472 write_exp_elt_opcode (pstate, OP_LONG); }
c906108c
SS
473 ;
474
475
476exp : FLOAT
edd079d9 477 { write_exp_elt_opcode (pstate, OP_FLOAT);
410a0ff2
SDJ
478 write_exp_elt_type (pstate,
479 parse_m2_type (pstate)
480 ->builtin_real);
edd079d9
UW
481 write_exp_elt_floatcst (pstate, $1);
482 write_exp_elt_opcode (pstate, OP_FLOAT); }
c906108c
SS
483 ;
484
485exp : variable
486 ;
487
488exp : SIZE '(' type ')' %prec UNARY
410a0ff2
SDJ
489 { write_exp_elt_opcode (pstate, OP_LONG);
490 write_exp_elt_type (pstate,
491 parse_type (pstate)->builtin_int);
492 write_exp_elt_longcst (pstate,
493 (LONGEST) TYPE_LENGTH ($3));
494 write_exp_elt_opcode (pstate, OP_LONG); }
c906108c
SS
495 ;
496
497exp : STRING
410a0ff2
SDJ
498 { write_exp_elt_opcode (pstate, OP_M2_STRING);
499 write_exp_string (pstate, $1);
500 write_exp_elt_opcode (pstate, OP_M2_STRING); }
c906108c
SS
501 ;
502
025bb325 503/* This will be used for extensions later. Like adding modules. */
c906108c
SS
504block : fblock
505 { $$ = SYMBOL_BLOCK_VALUE($1); }
506 ;
507
508fblock : BLOCKNAME
509 { struct symbol *sym
410a0ff2
SDJ
510 = lookup_symbol (copy_name ($1),
511 expression_context_block,
d12307c1 512 VAR_DOMAIN, 0).symbol;
c906108c
SS
513 $$ = sym;}
514 ;
515
516
517/* GDB scope operator */
518fblock : block COLONCOLON BLOCKNAME
519 { struct symbol *tem
520 = lookup_symbol (copy_name ($3), $1,
d12307c1 521 VAR_DOMAIN, 0).symbol;
c906108c 522 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
001083c6 523 error (_("No function \"%s\" in specified context."),
c906108c
SS
524 copy_name ($3));
525 $$ = tem;
526 }
527 ;
528
529/* Useful for assigning to PROCEDURE variables */
530variable: fblock
410a0ff2
SDJ
531 { write_exp_elt_opcode (pstate, OP_VAR_VALUE);
532 write_exp_elt_block (pstate, NULL);
533 write_exp_elt_sym (pstate, $1);
534 write_exp_elt_opcode (pstate, OP_VAR_VALUE); }
c906108c
SS
535 ;
536
537/* GDB internal ($foo) variable */
cfeadda5 538variable: DOLLAR_VARIABLE
c906108c
SS
539 ;
540
541/* GDB scope operator */
542variable: block COLONCOLON NAME
d12307c1
PMR
543 { struct block_symbol sym
544 = lookup_symbol (copy_name ($3), $1,
545 VAR_DOMAIN, 0);
546
547 if (sym.symbol == 0)
001083c6 548 error (_("No symbol \"%s\" in specified context."),
c906108c 549 copy_name ($3));
d12307c1 550 if (symbol_read_needs_frame (sym.symbol))
aee1fcdf 551 innermost_block.update (sym);
c906108c 552
410a0ff2 553 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
d12307c1
PMR
554 write_exp_elt_block (pstate, sym.block);
555 write_exp_elt_sym (pstate, sym.symbol);
410a0ff2 556 write_exp_elt_opcode (pstate, OP_VAR_VALUE); }
c906108c
SS
557 ;
558
025bb325 559/* Base case for variables. */
c906108c 560variable: NAME
d12307c1 561 { struct block_symbol sym;
1993b719 562 struct field_of_this_result is_a_field_of_this;
c906108c 563
d12307c1 564 sym = lookup_symbol (copy_name ($1),
c906108c 565 expression_context_block,
176620f1 566 VAR_DOMAIN,
2570f2b7 567 &is_a_field_of_this);
d12307c1
PMR
568
569 if (sym.symbol)
c906108c 570 {
d12307c1 571 if (symbol_read_needs_frame (sym.symbol))
aee1fcdf 572 innermost_block.update (sym);
c906108c 573
410a0ff2 574 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
63e43d3a 575 write_exp_elt_block (pstate, sym.block);
d12307c1 576 write_exp_elt_sym (pstate, sym.symbol);
410a0ff2 577 write_exp_elt_opcode (pstate, OP_VAR_VALUE);
c906108c
SS
578 }
579 else
580 {
7c7b6655 581 struct bound_minimal_symbol msymbol;
710122da 582 char *arg = copy_name ($1);
c906108c
SS
583
584 msymbol =
7c7b6655
TT
585 lookup_bound_minimal_symbol (arg);
586 if (msymbol.minsym != NULL)
410a0ff2 587 write_exp_msymbol (pstate, msymbol);
c906108c 588 else if (!have_full_symbols () && !have_partial_symbols ())
001083c6 589 error (_("No symbol table is loaded. Use the \"symbol-file\" command."));
c906108c 590 else
001083c6 591 error (_("No symbol \"%s\" in current context."),
c906108c
SS
592 copy_name ($1));
593 }
594 }
595 ;
596
597type
598 : TYPENAME
73923d7e 599 { $$ = lookup_typename (pstate->language (),
fa9f5be6 600 pstate->gdbarch (),
e6c014f2 601 copy_name ($1),
c906108c
SS
602 expression_context_block, 0); }
603
604 ;
605
606%%
607
c906108c
SS
608/* Take care of parsing a number (anything that starts with a digit).
609 Set yylval and return the token type; update lexptr.
610 LEN is the number of characters in it. */
611
612/*** Needs some error checking for the float case ***/
613
614static int
d04550a6 615parse_number (int olen)
c906108c 616{
d7561cbb 617 const char *p = lexptr;
710122da
DC
618 LONGEST n = 0;
619 LONGEST prevn = 0;
620 int c,i,ischar=0;
621 int base = input_radix;
622 int len = olen;
c906108c
SS
623 int unsigned_p = number_sign == 1 ? 1 : 0;
624
625 if(p[len-1] == 'H')
626 {
627 base = 16;
628 len--;
629 }
630 else if(p[len-1] == 'C' || p[len-1] == 'B')
631 {
632 base = 8;
633 ischar = p[len-1] == 'C';
634 len--;
635 }
636
637 /* Scan the number */
638 for (c = 0; c < len; c++)
639 {
640 if (p[c] == '.' && base == 10)
641 {
642 /* It's a float since it contains a point. */
edd079d9
UW
643 if (!parse_float (p, len,
644 parse_m2_type (pstate)->builtin_real,
645 yylval.val))
646 return ERROR;
647
c906108c
SS
648 lexptr += len;
649 return FLOAT;
650 }
651 if (p[c] == '.' && base != 10)
001083c6 652 error (_("Floating point numbers must be base 10."));
c906108c 653 if (base == 10 && (p[c] < '0' || p[c] > '9'))
001083c6 654 error (_("Invalid digit \'%c\' in number."),p[c]);
c906108c
SS
655 }
656
657 while (len-- > 0)
658 {
659 c = *p++;
660 n *= base;
661 if( base == 8 && (c == '8' || c == '9'))
001083c6 662 error (_("Invalid digit \'%c\' in octal number."),c);
c906108c
SS
663 if (c >= '0' && c <= '9')
664 i = c - '0';
665 else
666 {
667 if (base == 16 && c >= 'A' && c <= 'F')
668 i = c - 'A' + 10;
669 else
670 return ERROR;
671 }
672 n+=i;
673 if(i >= base)
674 return ERROR;
675 if(!unsigned_p && number_sign == 1 && (prevn >= n))
676 unsigned_p=1; /* Try something unsigned */
677 /* Don't do the range check if n==i and i==0, since that special
025bb325 678 case will give an overflow error. */
c906108c
SS
679 if(RANGE_CHECK && n!=i && i)
680 {
681 if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
682 ((!unsigned_p && number_sign==-1) && -prevn <= -n))
001083c6 683 range_error (_("Overflow on numeric constant."));
c906108c
SS
684 }
685 prevn=n;
686 }
687
688 lexptr = p;
689 if(*p == 'B' || *p == 'C' || *p == 'H')
690 lexptr++; /* Advance past B,C or H */
691
692 if (ischar)
693 {
694 yylval.ulval = n;
695 return CHAR;
696 }
697 else if ( unsigned_p && number_sign == 1)
698 {
699 yylval.ulval = n;
700 return UINT;
701 }
702 else if((unsigned_p && (n<0))) {
001083c6 703 range_error (_("Overflow on numeric constant -- number too large."));
c906108c
SS
704 /* But, this can return if range_check == range_warn. */
705 }
706 yylval.lval = n;
707 return INT;
708}
709
710
711/* Some tokens */
712
713static struct
714{
715 char name[2];
716 int token;
717} tokentab2[] =
718{
719 { {'<', '>'}, NOTEQUAL },
720 { {':', '='}, ASSIGN },
721 { {'<', '='}, LEQ },
722 { {'>', '='}, GEQ },
723 { {':', ':'}, COLONCOLON },
724
725};
726
727/* Some specific keywords */
728
729struct keyword {
730 char keyw[10];
731 int token;
732};
733
734static struct keyword keytab[] =
735{
736 {"OR" , OROR },
737 {"IN", IN },/* Note space after IN */
738 {"AND", LOGICAL_AND},
739 {"ABS", ABS },
740 {"CHR", CHR },
741 {"DEC", DEC },
742 {"NOT", NOT },
743 {"DIV", DIV },
744 {"INC", INC },
745 {"MAX", MAX_FUNC },
746 {"MIN", MIN_FUNC },
747 {"MOD", MOD },
748 {"ODD", ODD },
749 {"CAP", CAP },
750 {"ORD", ORD },
751 {"VAL", VAL },
752 {"EXCL", EXCL },
753 {"HIGH", HIGH },
754 {"INCL", INCL },
755 {"SIZE", SIZE },
756 {"FLOAT", FLOAT_FUNC },
757 {"TRUNC", TRUNC },
844781a1 758 {"TSIZE", SIZE },
c906108c
SS
759};
760
761
762/* Read one token, getting characters through lexptr. */
763
410a0ff2
SDJ
764/* This is where we will check to make sure that the language and the
765 operators used are compatible */
c906108c
SS
766
767static int
eeae04df 768yylex (void)
c906108c 769{
710122da
DC
770 int c;
771 int namelen;
772 int i;
d7561cbb 773 const char *tokstart;
710122da 774 char quote;
c906108c
SS
775
776 retry:
777
065432a8
PM
778 prev_lexptr = lexptr;
779
c906108c
SS
780 tokstart = lexptr;
781
782
783 /* See if it is a special token of length 2 */
784 for( i = 0 ; i < (int) (sizeof tokentab2 / sizeof tokentab2[0]) ; i++)
1e5e79d0 785 if (strncmp (tokentab2[i].name, tokstart, 2) == 0)
c906108c
SS
786 {
787 lexptr += 2;
788 return tokentab2[i].token;
789 }
790
791 switch (c = *tokstart)
792 {
793 case 0:
794 return 0;
795
796 case ' ':
797 case '\t':
798 case '\n':
799 lexptr++;
800 goto retry;
801
802 case '(':
803 paren_depth++;
804 lexptr++;
805 return c;
806
807 case ')':
808 if (paren_depth == 0)
809 return 0;
810 paren_depth--;
811 lexptr++;
812 return c;
813
814 case ',':
815 if (comma_terminates && paren_depth == 0)
816 return 0;
817 lexptr++;
818 return c;
819
820 case '.':
821 /* Might be a floating point number. */
822 if (lexptr[1] >= '0' && lexptr[1] <= '9')
823 break; /* Falls into number code. */
824 else
825 {
826 lexptr++;
827 return DOT;
828 }
829
830/* These are character tokens that appear as-is in the YACC grammar */
831 case '+':
832 case '-':
833 case '*':
834 case '/':
835 case '^':
836 case '<':
837 case '>':
838 case '[':
839 case ']':
840 case '=':
841 case '{':
842 case '}':
843 case '#':
844 case '@':
845 case '~':
846 case '&':
847 lexptr++;
848 return c;
849
850 case '\'' :
851 case '"':
852 quote = c;
853 for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
854 if (c == '\\')
855 {
856 c = tokstart[++namelen];
857 if (c >= '0' && c <= '9')
858 {
859 c = tokstart[++namelen];
860 if (c >= '0' && c <= '9')
861 c = tokstart[++namelen];
862 }
863 }
864 if(c != quote)
001083c6 865 error (_("Unterminated string or character constant."));
c906108c
SS
866 yylval.sval.ptr = tokstart + 1;
867 yylval.sval.length = namelen - 1;
868 lexptr += namelen + 1;
869
870 if(namelen == 2) /* Single character */
871 {
872 yylval.ulval = tokstart[1];
873 return CHAR;
874 }
875 else
876 return STRING;
877 }
878
879 /* Is it a number? */
880 /* Note: We have already dealt with the case of the token '.'.
881 See case '.' above. */
882 if ((c >= '0' && c <= '9'))
883 {
884 /* It's a number. */
885 int got_dot = 0, got_e = 0;
d7561cbb 886 const char *p = tokstart;
c906108c
SS
887 int toktype;
888
889 for (++p ;; ++p)
890 {
891 if (!got_e && (*p == 'e' || *p == 'E'))
892 got_dot = got_e = 1;
893 else if (!got_dot && *p == '.')
894 got_dot = 1;
895 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
896 && (*p == '-' || *p == '+'))
897 /* This is the sign of the exponent, not the end of the
898 number. */
899 continue;
900 else if ((*p < '0' || *p > '9') &&
901 (*p < 'A' || *p > 'F') &&
902 (*p != 'H')) /* Modula-2 hexadecimal number */
903 break;
904 }
905 toktype = parse_number (p - tokstart);
906 if (toktype == ERROR)
907 {
908 char *err_copy = (char *) alloca (p - tokstart + 1);
909
910 memcpy (err_copy, tokstart, p - tokstart);
911 err_copy[p - tokstart] = 0;
001083c6 912 error (_("Invalid number \"%s\"."), err_copy);
c906108c
SS
913 }
914 lexptr = p;
915 return toktype;
916 }
917
918 if (!(c == '_' || c == '$'
919 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
920 /* We must have come across a bad character (e.g. ';'). */
001083c6 921 error (_("Invalid character '%c' in expression."), c);
c906108c
SS
922
923 /* It's a name. See how long it is. */
924 namelen = 0;
925 for (c = tokstart[namelen];
926 (c == '_' || c == '$' || (c >= '0' && c <= '9')
927 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
928 c = tokstart[++namelen])
929 ;
930
931 /* The token "if" terminates the expression and is NOT
932 removed from the input stream. */
933 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
934 {
935 return 0;
936 }
937
938 lexptr += namelen;
939
940 /* Lookup special keywords */
941 for(i = 0 ; i < (int) (sizeof(keytab) / sizeof(keytab[0])) ; i++)
1e5e79d0
MD
942 if (namelen == strlen (keytab[i].keyw)
943 && strncmp (tokstart, keytab[i].keyw, namelen) == 0)
c906108c
SS
944 return keytab[i].token;
945
946 yylval.sval.ptr = tokstart;
947 yylval.sval.length = namelen;
948
949 if (*tokstart == '$')
950 {
410a0ff2 951 write_dollar_variable (pstate, yylval.sval);
cfeadda5 952 return DOLLAR_VARIABLE;
c906108c
SS
953 }
954
955 /* Use token-type BLOCKNAME for symbols that happen to be defined as
956 functions. If this is not so, then ...
957 Use token-type TYPENAME for symbols that happen to be defined
958 currently as names of types; NAME for other symbols.
959 The caller is not constrained to care about the distinction. */
960 {
961
962
963 char *tmp = copy_name (yylval.sval);
964 struct symbol *sym;
965
ccefe4c4 966 if (lookup_symtab (tmp))
c906108c 967 return BLOCKNAME;
d12307c1 968 sym = lookup_symbol (tmp, expression_context_block, VAR_DOMAIN, 0).symbol;
c906108c
SS
969 if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
970 return BLOCKNAME;
73923d7e 971 if (lookup_typename (pstate->language (), pstate->gdbarch (),
410a0ff2
SDJ
972 copy_name (yylval.sval),
973 expression_context_block, 1))
c906108c
SS
974 return TYPENAME;
975
976 if(sym)
977 {
712f90be 978 switch(SYMBOL_CLASS (sym))
c906108c
SS
979 {
980 case LOC_STATIC:
981 case LOC_REGISTER:
982 case LOC_ARG:
983 case LOC_REF_ARG:
c906108c
SS
984 case LOC_REGPARM_ADDR:
985 case LOC_LOCAL:
c906108c
SS
986 case LOC_CONST:
987 case LOC_CONST_BYTES:
988 case LOC_OPTIMIZED_OUT:
4c2df51b 989 case LOC_COMPUTED:
c906108c
SS
990 return NAME;
991
992 case LOC_TYPEDEF:
993 return TYPENAME;
994
995 case LOC_BLOCK:
996 return BLOCKNAME;
997
998 case LOC_UNDEF:
001083c6 999 error (_("internal: Undefined class in m2lex()"));
c906108c
SS
1000
1001 case LOC_LABEL:
1002 case LOC_UNRESOLVED:
001083c6 1003 error (_("internal: Unforseen case in m2lex()"));
c4093a6a
JM
1004
1005 default:
001083c6 1006 error (_("unhandled token in m2lex()"));
c4093a6a 1007 break;
c906108c
SS
1008 }
1009 }
1010 else
1011 {
025bb325 1012 /* Built-in BOOLEAN type. This is sort of a hack. */
1e5e79d0 1013 if (strncmp (tokstart, "TRUE", 4) == 0)
c906108c
SS
1014 {
1015 yylval.ulval = 1;
1016 return M2_TRUE;
1017 }
1e5e79d0 1018 else if (strncmp (tokstart, "FALSE", 5) == 0)
c906108c
SS
1019 {
1020 yylval.ulval = 0;
1021 return M2_FALSE;
1022 }
1023 }
1024
025bb325 1025 /* Must be another type of name... */
c906108c
SS
1026 return NAME;
1027 }
1028}
1029
410a0ff2
SDJ
1030int
1031m2_parse (struct parser_state *par_state)
1032{
410a0ff2 1033 /* Setting up the parser state. */
eae49211 1034 scoped_restore pstate_restore = make_scoped_restore (&pstate);
410a0ff2
SDJ
1035 gdb_assert (par_state != NULL);
1036 pstate = par_state;
1037
eae49211 1038 return yyparse ();
410a0ff2
SDJ
1039}
1040
69d340c6 1041static void
a121b7c1 1042yyerror (const char *msg)
c906108c 1043{
065432a8
PM
1044 if (prev_lexptr)
1045 lexptr = prev_lexptr;
1046
69d340c6 1047 error (_("A %s in expression, near `%s'."), msg, lexptr);
c906108c 1048}
This page took 1.634108 seconds and 4 git commands to generate.