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