1 /* YACC grammar for Modula-2 expressions, for GDB.
2 Copyright (C) 1986, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1999,
3 2000, 2007, 2008, 2009, 2010, 2011 Free Software 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
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
592 write_exp_elt_opcode (OP_VAR_VALUE);
593 /* block_found is set by lookup_symbol. */
594 write_exp_elt_block (block_found);
595 write_exp_elt_sym (sym);
596 write_exp_elt_opcode (OP_VAR_VALUE); }
597 ;
598
599 /* Base case for variables. */
600 variable: NAME
601 { struct symbol *sym;
602 int is_a_field_of_this;
603
604 sym = lookup_symbol (copy_name ($1),
605 expression_context_block,
606 VAR_DOMAIN,
607 &is_a_field_of_this);
608 if (sym)
609 {
610 if (symbol_read_needs_frame (sym))
611 {
612 if (innermost_block == 0 ||
613 contained_in (block_found,
614 innermost_block))
615 innermost_block = block_found;
616 }
617
618 write_exp_elt_opcode (OP_VAR_VALUE);
619 /* We want to use the selected frame, not
620 another more inner frame which happens to
621 be in the same block. */
622 write_exp_elt_block (NULL);
623 write_exp_elt_sym (sym);
624 write_exp_elt_opcode (OP_VAR_VALUE);
625 }
626 else
627 {
628 struct minimal_symbol *msymbol;
629 char *arg = copy_name ($1);
630
631 msymbol =
632 lookup_minimal_symbol (arg, NULL, NULL);
633 if (msymbol != NULL)
634 write_exp_msymbol (msymbol);
635 else if (!have_full_symbols () && !have_partial_symbols ())
636 error (_("No symbol table is loaded. Use the \"symbol-file\" command."));
637 else
638 error (_("No symbol \"%s\" in current context."),
639 copy_name ($1));
640 }
641 }
642 ;
643
644 type
645 : TYPENAME
646 { $$ = lookup_typename (parse_language, parse_gdbarch,
647 copy_name ($1),
648 expression_context_block, 0); }
649
650 ;
651
652 %%
653
654 /* Take care of parsing a number (anything that starts with a digit).
655 Set yylval and return the token type; update lexptr.
656 LEN is the number of characters in it. */
657
658 /*** Needs some error checking for the float case ***/
659
660 static int
parse_number(olen)661 parse_number (olen)
662 int olen;
663 {
664 char *p = lexptr;
665 LONGEST n = 0;
666 LONGEST prevn = 0;
667 int c,i,ischar=0;
668 int base = input_radix;
669 int len = olen;
670 int unsigned_p = number_sign == 1 ? 1 : 0;
671
672 if(p[len-1] == 'H')
673 {
674 base = 16;
675 len--;
676 }
677 else if(p[len-1] == 'C' || p[len-1] == 'B')
678 {
679 base = 8;
680 ischar = p[len-1] == 'C';
681 len--;
682 }
683
684 /* Scan the number */
685 for (c = 0; c < len; c++)
686 {
687 if (p[c] == '.' && base == 10)
688 {
689 /* It's a float since it contains a point. */
690 yylval.dval = atof (p);
691 lexptr += len;
692 return FLOAT;
693 }
694 if (p[c] == '.' && base != 10)
695 error (_("Floating point numbers must be base 10."));
696 if (base == 10 && (p[c] < '0' || p[c] > '9'))
697 error (_("Invalid digit \'%c\' in number."),p[c]);
698 }
699
700 while (len-- > 0)
701 {
702 c = *p++;
703 n *= base;
704 if( base == 8 && (c == '8' || c == '9'))
705 error (_("Invalid digit \'%c\' in octal number."),c);
706 if (c >= '0' && c <= '9')
707 i = c - '0';
708 else
709 {
710 if (base == 16 && c >= 'A' && c <= 'F')
711 i = c - 'A' + 10;
712 else
713 return ERROR;
714 }
715 n+=i;
716 if(i >= base)
717 return ERROR;
718 if(!unsigned_p && number_sign == 1 && (prevn >= n))
719 unsigned_p=1; /* Try something unsigned */
720 /* Don't do the range check if n==i and i==0, since that special
721 case will give an overflow error. */
722 if(RANGE_CHECK && n!=i && i)
723 {
724 if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
725 ((!unsigned_p && number_sign==-1) && -prevn <= -n))
726 range_error (_("Overflow on numeric constant."));
727 }
728 prevn=n;
729 }
730
731 lexptr = p;
732 if(*p == 'B' || *p == 'C' || *p == 'H')
733 lexptr++; /* Advance past B,C or H */
734
735 if (ischar)
736 {
737 yylval.ulval = n;
738 return CHAR;
739 }
740 else if ( unsigned_p && number_sign == 1)
741 {
742 yylval.ulval = n;
743 return UINT;
744 }
745 else if((unsigned_p && (n<0))) {
746 range_error (_("Overflow on numeric constant -- number too large."));
747 /* But, this can return if range_check == range_warn. */
748 }
749 yylval.lval = n;
750 return INT;
751 }
752
753
754 /* Some tokens */
755
756 static struct
757 {
758 char name[2];
759 int token;
760 } tokentab2[] =
761 {
762 { {'<', '>'}, NOTEQUAL },
763 { {':', '='}, ASSIGN },
764 { {'<', '='}, LEQ },
765 { {'>', '='}, GEQ },
766 { {':', ':'}, COLONCOLON },
767
768 };
769
770 /* Some specific keywords */
771
772 struct keyword {
773 char keyw[10];
774 int token;
775 };
776
777 static struct keyword keytab[] =
778 {
779 {"OR" , OROR },
780 {"IN", IN },/* Note space after IN */
781 {"AND", LOGICAL_AND},
782 {"ABS", ABS },
783 {"CHR", CHR },
784 {"DEC", DEC },
785 {"NOT", NOT },
786 {"DIV", DIV },
787 {"INC", INC },
788 {"MAX", MAX_FUNC },
789 {"MIN", MIN_FUNC },
790 {"MOD", MOD },
791 {"ODD", ODD },
792 {"CAP", CAP },
793 {"ORD", ORD },
794 {"VAL", VAL },
795 {"EXCL", EXCL },
796 {"HIGH", HIGH },
797 {"INCL", INCL },
798 {"SIZE", SIZE },
799 {"FLOAT", FLOAT_FUNC },
800 {"TRUNC", TRUNC },
801 {"TSIZE", SIZE },
802 };
803
804
805 /* Read one token, getting characters through lexptr. */
806
807 /* This is where we will check to make sure that the language and the operators used are
808 compatible */
809
810 static int
yylex(void)811 yylex (void)
812 {
813 int c;
814 int namelen;
815 int i;
816 char *tokstart;
817 char quote;
818
819 retry:
820
821 prev_lexptr = lexptr;
822
823 tokstart = lexptr;
824
825
826 /* See if it is a special token of length 2 */
827 for( i = 0 ; i < (int) (sizeof tokentab2 / sizeof tokentab2[0]) ; i++)
828 if (strncmp (tokentab2[i].name, tokstart, 2) == 0)
829 {
830 lexptr += 2;
831 return tokentab2[i].token;
832 }
833
834 switch (c = *tokstart)
835 {
836 case 0:
837 return 0;
838
839 case ' ':
840 case '\t':
841 case '\n':
842 lexptr++;
843 goto retry;
844
845 case '(':
846 paren_depth++;
847 lexptr++;
848 return c;
849
850 case ')':
851 if (paren_depth == 0)
852 return 0;
853 paren_depth--;
854 lexptr++;
855 return c;
856
857 case ',':
858 if (comma_terminates && paren_depth == 0)
859 return 0;
860 lexptr++;
861 return c;
862
863 case '.':
864 /* Might be a floating point number. */
865 if (lexptr[1] >= '0' && lexptr[1] <= '9')
866 break; /* Falls into number code. */
867 else
868 {
869 lexptr++;
870 return DOT;
871 }
872
873 /* These are character tokens that appear as-is in the YACC grammar */
874 case '+':
875 case '-':
876 case '*':
877 case '/':
878 case '^':
879 case '<':
880 case '>':
881 case '[':
882 case ']':
883 case '=':
884 case '{':
885 case '}':
886 case '#':
887 case '@':
888 case '~':
889 case '&':
890 lexptr++;
891 return c;
892
893 case '\'' :
894 case '"':
895 quote = c;
896 for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
897 if (c == '\\')
898 {
899 c = tokstart[++namelen];
900 if (c >= '0' && c <= '9')
901 {
902 c = tokstart[++namelen];
903 if (c >= '0' && c <= '9')
904 c = tokstart[++namelen];
905 }
906 }
907 if(c != quote)
908 error (_("Unterminated string or character constant."));
909 yylval.sval.ptr = tokstart + 1;
910 yylval.sval.length = namelen - 1;
911 lexptr += namelen + 1;
912
913 if(namelen == 2) /* Single character */
914 {
915 yylval.ulval = tokstart[1];
916 return CHAR;
917 }
918 else
919 return STRING;
920 }
921
922 /* Is it a number? */
923 /* Note: We have already dealt with the case of the token '.'.
924 See case '.' above. */
925 if ((c >= '0' && c <= '9'))
926 {
927 /* It's a number. */
928 int got_dot = 0, got_e = 0;
929 char *p = tokstart;
930 int toktype;
931
932 for (++p ;; ++p)
933 {
934 if (!got_e && (*p == 'e' || *p == 'E'))
935 got_dot = got_e = 1;
936 else if (!got_dot && *p == '.')
937 got_dot = 1;
938 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
939 && (*p == '-' || *p == '+'))
940 /* This is the sign of the exponent, not the end of the
941 number. */
942 continue;
943 else if ((*p < '0' || *p > '9') &&
944 (*p < 'A' || *p > 'F') &&
945 (*p != 'H')) /* Modula-2 hexadecimal number */
946 break;
947 }
948 toktype = parse_number (p - tokstart);
949 if (toktype == ERROR)
950 {
951 char *err_copy = (char *) alloca (p - tokstart + 1);
952
953 memcpy (err_copy, tokstart, p - tokstart);
954 err_copy[p - tokstart] = 0;
955 error (_("Invalid number \"%s\"."), err_copy);
956 }
957 lexptr = p;
958 return toktype;
959 }
960
961 if (!(c == '_' || c == '$'
962 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
963 /* We must have come across a bad character (e.g. ';'). */
964 error (_("Invalid character '%c' in expression."), c);
965
966 /* It's a name. See how long it is. */
967 namelen = 0;
968 for (c = tokstart[namelen];
969 (c == '_' || c == '$' || (c >= '0' && c <= '9')
970 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
971 c = tokstart[++namelen])
972 ;
973
974 /* The token "if" terminates the expression and is NOT
975 removed from the input stream. */
976 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
977 {
978 return 0;
979 }
980
981 lexptr += namelen;
982
983 /* Lookup special keywords */
984 for(i = 0 ; i < (int) (sizeof(keytab) / sizeof(keytab[0])) ; i++)
985 if (namelen == strlen (keytab[i].keyw)
986 && strncmp (tokstart, keytab[i].keyw, namelen) == 0)
987 return keytab[i].token;
988
989 yylval.sval.ptr = tokstart;
990 yylval.sval.length = namelen;
991
992 if (*tokstart == '$')
993 {
994 write_dollar_variable (yylval.sval);
995 return INTERNAL_VAR;
996 }
997
998 /* Use token-type BLOCKNAME for symbols that happen to be defined as
999 functions. If this is not so, then ...
1000 Use token-type TYPENAME for symbols that happen to be defined
1001 currently as names of types; NAME for other symbols.
1002 The caller is not constrained to care about the distinction. */
1003 {
1004
1005
1006 char *tmp = copy_name (yylval.sval);
1007 struct symbol *sym;
1008
1009 if (lookup_symtab (tmp))
1010 return BLOCKNAME;
1011 sym = lookup_symbol (tmp, expression_context_block, VAR_DOMAIN, 0);
1012 if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1013 return BLOCKNAME;
1014 if (lookup_typename (parse_language, parse_gdbarch,
1015 copy_name (yylval.sval), expression_context_block, 1))
1016 return TYPENAME;
1017
1018 if(sym)
1019 {
1020 switch(SYMBOL_CLASS (sym))
1021 {
1022 case LOC_STATIC:
1023 case LOC_REGISTER:
1024 case LOC_ARG:
1025 case LOC_REF_ARG:
1026 case LOC_REGPARM_ADDR:
1027 case LOC_LOCAL:
1028 case LOC_CONST:
1029 case LOC_CONST_BYTES:
1030 case LOC_OPTIMIZED_OUT:
1031 case LOC_COMPUTED:
1032 return NAME;
1033
1034 case LOC_TYPEDEF:
1035 return TYPENAME;
1036
1037 case LOC_BLOCK:
1038 return BLOCKNAME;
1039
1040 case LOC_UNDEF:
1041 error (_("internal: Undefined class in m2lex()"));
1042
1043 case LOC_LABEL:
1044 case LOC_UNRESOLVED:
1045 error (_("internal: Unforseen case in m2lex()"));
1046
1047 default:
1048 error (_("unhandled token in m2lex()"));
1049 break;
1050 }
1051 }
1052 else
1053 {
1054 /* Built-in BOOLEAN type. This is sort of a hack. */
1055 if (strncmp (tokstart, "TRUE", 4) == 0)
1056 {
1057 yylval.ulval = 1;
1058 return M2_TRUE;
1059 }
1060 else if (strncmp (tokstart, "FALSE", 5) == 0)
1061 {
1062 yylval.ulval = 0;
1063 return M2_FALSE;
1064 }
1065 }
1066
1067 /* Must be another type of name... */
1068 return NAME;
1069 }
1070 }
1071
1072 #if 0 /* Unused */
1073 static char *
1074 make_qualname(mod,ident)
1075 char *mod, *ident;
1076 {
1077 char *new = malloc(strlen(mod)+strlen(ident)+2);
1078
1079 strcpy(new,mod);
1080 strcat(new,".");
1081 strcat(new,ident);
1082 return new;
1083 }
1084 #endif /* 0 */
1085
1086 void
yyerror(msg)1087 yyerror (msg)
1088 char *msg;
1089 {
1090 if (prev_lexptr)
1091 lexptr = prev_lexptr;
1092
1093 error (_("A %s in expression, near `%s'."), (msg ? msg : "error"), lexptr);
1094 }
1095