Automatic date update in version.in
[external/binutils.git] / gdb / m2-exp.y
1 /* YACC grammar for Modula-2 expressions, for GDB.
2    Copyright (C) 1986-2018 Free Software Foundation, Inc.
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
6    This file is part of GDB.
7
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.
12
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.
17
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/>.  */
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
36    times by the parser generator.  */
37    
38 %{
39
40 #include "defs.h"
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 */
49 #include "block.h"
50
51 #define parse_type(ps) builtin_type (parse_gdbarch (ps))
52 #define parse_m2_type(ps) builtin_m2_type (parse_gdbarch (ps))
53
54 /* Remap normal yacc parser interface names (yyparse, yylex, yyerror,
55    etc).  */
56 #define GDB_YY_REMAP_PREFIX m2_
57 #include "yy-remap.h"
58
59 /* The state of the parser, used internally when we are parsing the
60    expression.  */
61
62 static struct parser_state *pstate = NULL;
63
64 int yyparse (void);
65
66 static int yylex (void);
67
68 static void yyerror (const char *);
69
70 static int parse_number (int);
71
72 /* The sign of the number being parsed.  */
73 static int number_sign = 1;
74
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;
85     gdb_byte val[16];
86     struct symbol *sym;
87     struct type *tval;
88     struct stoken sval;
89     int voidval;
90     const struct block *bval;
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
106 %token <val> FLOAT
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
122 %token TSIZE
123 %token INC DEC INCL EXCL
124
125 /* The GDB scope operator */
126 %token COLONCOLON
127
128 %token <voidval> INTERNAL_VAR
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
151 start   :       exp
152         |       type_exp
153         ;
154
155 type_exp:       type
156                 { write_exp_elt_opcode (pstate, OP_TYPE);
157                   write_exp_elt_type (pstate, $1);
158                   write_exp_elt_opcode (pstate, OP_TYPE);
159                 }
160         ;
161
162 /* Expressions */
163
164 exp     :       exp '^'   %prec UNARY
165                         { write_exp_elt_opcode (pstate, UNOP_IND); }
166         ;
167
168 exp     :       '-'
169                         { number_sign = -1; }
170                 exp    %prec UNARY
171                         { number_sign = 1;
172                           write_exp_elt_opcode (pstate, UNOP_NEG); }
173         ;
174
175 exp     :       '+' exp    %prec UNARY
176                 { write_exp_elt_opcode (pstate, UNOP_PLUS); }
177         ;
178
179 exp     :       not_exp exp %prec UNARY
180                         { write_exp_elt_opcode (pstate, UNOP_LOGICAL_NOT); }
181         ;
182
183 not_exp :       NOT
184         |       '~'
185         ;
186
187 exp     :       CAP '(' exp ')'
188                         { write_exp_elt_opcode (pstate, UNOP_CAP); }
189         ;
190
191 exp     :       ORD '(' exp ')'
192                         { write_exp_elt_opcode (pstate, UNOP_ORD); }
193         ;
194
195 exp     :       ABS '(' exp ')'
196                         { write_exp_elt_opcode (pstate, UNOP_ABS); }
197         ;
198
199 exp     :       HIGH '(' exp ')'
200                         { write_exp_elt_opcode (pstate, UNOP_HIGH); }
201         ;
202
203 exp     :       MIN_FUNC '(' type ')'
204                         { write_exp_elt_opcode (pstate, UNOP_MIN);
205                           write_exp_elt_type (pstate, $3);
206                           write_exp_elt_opcode (pstate, UNOP_MIN); }
207         ;
208
209 exp     :       MAX_FUNC '(' type ')'
210                         { write_exp_elt_opcode (pstate, UNOP_MAX);
211                           write_exp_elt_type (pstate, $3);
212                           write_exp_elt_opcode (pstate, UNOP_MAX); }
213         ;
214
215 exp     :       FLOAT_FUNC '(' exp ')'
216                         { write_exp_elt_opcode (pstate, UNOP_FLOAT); }
217         ;
218
219 exp     :       VAL '(' type ',' exp ')'
220                         { write_exp_elt_opcode (pstate, BINOP_VAL);
221                           write_exp_elt_type (pstate, $3);
222                           write_exp_elt_opcode (pstate, BINOP_VAL); }
223         ;
224
225 exp     :       CHR '(' exp ')'
226                         { write_exp_elt_opcode (pstate, UNOP_CHR); }
227         ;
228
229 exp     :       ODD '(' exp ')'
230                         { write_exp_elt_opcode (pstate, UNOP_ODD); }
231         ;
232
233 exp     :       TRUNC '(' exp ')'
234                         { write_exp_elt_opcode (pstate, UNOP_TRUNC); }
235         ;
236
237 exp     :       TSIZE '(' exp ')'
238                         { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
239         ;
240
241 exp     :       SIZE exp       %prec UNARY
242                         { write_exp_elt_opcode (pstate, UNOP_SIZEOF); }
243         ;
244
245
246 exp     :       INC '(' exp ')'
247                         { write_exp_elt_opcode (pstate, UNOP_PREINCREMENT); }
248         ;
249
250 exp     :       INC '(' exp ',' exp ')'
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); }
255         ;
256
257 exp     :       DEC '(' exp ')'
258                         { write_exp_elt_opcode (pstate, UNOP_PREDECREMENT);}
259         ;
260
261 exp     :       DEC '(' exp ',' exp ')'
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); }
266         ;
267
268 exp     :       exp DOT NAME
269                         { write_exp_elt_opcode (pstate, STRUCTOP_STRUCT);
270                           write_exp_string (pstate, $3);
271                           write_exp_elt_opcode (pstate, STRUCTOP_STRUCT); }
272         ;
273
274 exp     :       set
275         ;
276
277 exp     :       exp IN set
278                         { error (_("Sets are not implemented."));}
279         ;
280
281 exp     :       INCL '(' exp ',' exp ')'
282                         { error (_("Sets are not implemented."));}
283         ;
284
285 exp     :       EXCL '(' exp ',' exp ')'
286                         { error (_("Sets are not implemented."));}
287         ;
288
289 set     :       '{' arglist '}'
290                         { error (_("Sets are not implemented."));}
291         |       type '{' arglist '}'
292                         { error (_("Sets are not implemented."));}
293         ;
294
295
296 /* Modula-2 array subscript notation [a,b,c...] */
297 exp     :       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
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); }
307         ;
308
309 exp     :       exp '[' exp ']'
310                         { write_exp_elt_opcode (pstate, BINOP_SUBSCRIPT); }
311         ;
312
313 exp     :       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
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); }
322         ;
323
324 arglist :
325         ;
326
327 arglist :       exp
328                         { arglist_len = 1; }
329         ;
330
331 arglist :       arglist ',' exp   %prec ABOVE_COMMA
332                         { arglist_len++; }
333         ;
334
335 non_empty_arglist
336         :       exp
337                         { arglist_len = 1; }
338         ;
339
340 non_empty_arglist
341         :       non_empty_arglist ',' exp %prec ABOVE_COMMA
342                         { arglist_len++; }
343         ;
344
345 /* GDB construct */
346 exp     :       '{' type '}' exp  %prec UNARY
347                         { write_exp_elt_opcode (pstate, UNOP_MEMVAL);
348                           write_exp_elt_type (pstate, $2);
349                           write_exp_elt_opcode (pstate, UNOP_MEMVAL); }
350         ;
351
352 exp     :       type '(' exp ')' %prec UNARY
353                         { write_exp_elt_opcode (pstate, UNOP_CAST);
354                           write_exp_elt_type (pstate, $1);
355                           write_exp_elt_opcode (pstate, UNOP_CAST); }
356         ;
357
358 exp     :       '(' 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 */
366 exp     :       exp '@' exp
367                         { write_exp_elt_opcode (pstate, BINOP_REPEAT); }
368         ;
369
370 exp     :       exp '*' exp
371                         { write_exp_elt_opcode (pstate, BINOP_MUL); }
372         ;
373
374 exp     :       exp '/' exp
375                         { write_exp_elt_opcode (pstate, BINOP_DIV); }
376         ;
377
378 exp     :       exp DIV exp
379                         { write_exp_elt_opcode (pstate, BINOP_INTDIV); }
380         ;
381
382 exp     :       exp MOD exp
383                         { write_exp_elt_opcode (pstate, BINOP_REM); }
384         ;
385
386 exp     :       exp '+' exp
387                         { write_exp_elt_opcode (pstate, BINOP_ADD); }
388         ;
389
390 exp     :       exp '-' exp
391                         { write_exp_elt_opcode (pstate, BINOP_SUB); }
392         ;
393
394 exp     :       exp '=' exp
395                         { write_exp_elt_opcode (pstate, BINOP_EQUAL); }
396         ;
397
398 exp     :       exp NOTEQUAL exp
399                         { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
400         |       exp '#' exp
401                         { write_exp_elt_opcode (pstate, BINOP_NOTEQUAL); }
402         ;
403
404 exp     :       exp LEQ exp
405                         { write_exp_elt_opcode (pstate, BINOP_LEQ); }
406         ;
407
408 exp     :       exp GEQ exp
409                         { write_exp_elt_opcode (pstate, BINOP_GEQ); }
410         ;
411
412 exp     :       exp '<' exp
413                         { write_exp_elt_opcode (pstate, BINOP_LESS); }
414         ;
415
416 exp     :       exp '>' exp
417                         { write_exp_elt_opcode (pstate, BINOP_GTR); }
418         ;
419
420 exp     :       exp LOGICAL_AND exp
421                         { write_exp_elt_opcode (pstate, BINOP_LOGICAL_AND); }
422         ;
423
424 exp     :       exp OROR exp
425                         { write_exp_elt_opcode (pstate, BINOP_LOGICAL_OR); }
426         ;
427
428 exp     :       exp ASSIGN exp
429                         { write_exp_elt_opcode (pstate, BINOP_ASSIGN); }
430         ;
431
432
433 /* Constants */
434
435 exp     :       M2_TRUE
436                         { write_exp_elt_opcode (pstate, OP_BOOL);
437                           write_exp_elt_longcst (pstate, (LONGEST) $1);
438                           write_exp_elt_opcode (pstate, OP_BOOL); }
439         ;
440
441 exp     :       M2_FALSE
442                         { write_exp_elt_opcode (pstate, OP_BOOL);
443                           write_exp_elt_longcst (pstate, (LONGEST) $1);
444                           write_exp_elt_opcode (pstate, OP_BOOL); }
445         ;
446
447 exp     :       INT
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); }
453         ;
454
455 exp     :       UINT
456                         {
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);
463                         }
464         ;
465
466 exp     :       CHAR
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); }
473         ;
474
475
476 exp     :       FLOAT
477                         { write_exp_elt_opcode (pstate, OP_FLOAT);
478                           write_exp_elt_type (pstate,
479                                               parse_m2_type (pstate)
480                                               ->builtin_real);
481                           write_exp_elt_floatcst (pstate, $1);
482                           write_exp_elt_opcode (pstate, OP_FLOAT); }
483         ;
484
485 exp     :       variable
486         ;
487
488 exp     :       SIZE '(' type ')'       %prec UNARY
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); }
495         ;
496
497 exp     :       STRING
498                         { write_exp_elt_opcode (pstate, OP_M2_STRING);
499                           write_exp_string (pstate, $1);
500                           write_exp_elt_opcode (pstate, OP_M2_STRING); }
501         ;
502
503 /* This will be used for extensions later.  Like adding modules.  */
504 block   :       fblock  
505                         { $$ = SYMBOL_BLOCK_VALUE($1); }
506         ;
507
508 fblock  :       BLOCKNAME
509                         { struct symbol *sym
510                             = lookup_symbol (copy_name ($1),
511                                              expression_context_block,
512                                              VAR_DOMAIN, 0).symbol;
513                           $$ = sym;}
514         ;
515                              
516
517 /* GDB scope operator */
518 fblock  :       block COLONCOLON BLOCKNAME
519                         { struct symbol *tem
520                             = lookup_symbol (copy_name ($3), $1,
521                                              VAR_DOMAIN, 0).symbol;
522                           if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
523                             error (_("No function \"%s\" in specified context."),
524                                    copy_name ($3));
525                           $$ = tem;
526                         }
527         ;
528
529 /* Useful for assigning to PROCEDURE variables */
530 variable:       fblock
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); }
535         ;
536
537 /* GDB internal ($foo) variable */
538 variable:       INTERNAL_VAR
539         ;
540
541 /* GDB scope operator */
542 variable:       block COLONCOLON NAME
543                         { struct block_symbol sym
544                             = lookup_symbol (copy_name ($3), $1,
545                                              VAR_DOMAIN, 0);
546
547                           if (sym.symbol == 0)
548                             error (_("No symbol \"%s\" in specified context."),
549                                    copy_name ($3));
550                           if (symbol_read_needs_frame (sym.symbol))
551                             innermost_block.update (sym);
552
553                           write_exp_elt_opcode (pstate, OP_VAR_VALUE);
554                           write_exp_elt_block (pstate, sym.block);
555                           write_exp_elt_sym (pstate, sym.symbol);
556                           write_exp_elt_opcode (pstate, OP_VAR_VALUE); }
557         ;
558
559 /* Base case for variables.  */
560 variable:       NAME
561                         { struct block_symbol sym;
562                           struct field_of_this_result is_a_field_of_this;
563
564                           sym = lookup_symbol (copy_name ($1),
565                                                expression_context_block,
566                                                VAR_DOMAIN,
567                                                &is_a_field_of_this);
568
569                           if (sym.symbol)
570                             {
571                               if (symbol_read_needs_frame (sym.symbol))
572                                 innermost_block.update (sym);
573
574                               write_exp_elt_opcode (pstate, OP_VAR_VALUE);
575                               write_exp_elt_block (pstate, sym.block);
576                               write_exp_elt_sym (pstate, sym.symbol);
577                               write_exp_elt_opcode (pstate, OP_VAR_VALUE);
578                             }
579                           else
580                             {
581                               struct bound_minimal_symbol msymbol;
582                               char *arg = copy_name ($1);
583
584                               msymbol =
585                                 lookup_bound_minimal_symbol (arg);
586                               if (msymbol.minsym != NULL)
587                                 write_exp_msymbol (pstate, msymbol);
588                               else if (!have_full_symbols () && !have_partial_symbols ())
589                                 error (_("No symbol table is loaded.  Use the \"symbol-file\" command."));
590                               else
591                                 error (_("No symbol \"%s\" in current context."),
592                                        copy_name ($1));
593                             }
594                         }
595         ;
596
597 type
598         :       TYPENAME
599                         { $$ = lookup_typename (parse_language (pstate),
600                                                 parse_gdbarch (pstate),
601                                                 copy_name ($1),
602                                                 expression_context_block, 0); }
603
604         ;
605
606 %%
607
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
614 static int
615 parse_number (int olen)
616 {
617   const char *p = lexptr;
618   LONGEST n = 0;
619   LONGEST prevn = 0;
620   int c,i,ischar=0;
621   int base = input_radix;
622   int len = olen;
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.  */
643         if (!parse_float (p, len,
644                           parse_m2_type (pstate)->builtin_real,
645                           yylval.val))
646           return ERROR;
647
648         lexptr += len;
649         return FLOAT;
650       }
651     if (p[c] == '.' && base != 10)
652        error (_("Floating point numbers must be base 10."));
653     if (base == 10 && (p[c] < '0' || p[c] > '9'))
654        error (_("Invalid digit \'%c\' in number."),p[c]);
655  }
656
657   while (len-- > 0)
658     {
659       c = *p++;
660       n *= base;
661       if( base == 8 && (c == '8' || c == '9'))
662          error (_("Invalid digit \'%c\' in octal number."),c);
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
678          case will give an overflow error.  */
679       if(RANGE_CHECK && n!=i && i)
680       {
681          if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
682             ((!unsigned_p && number_sign==-1) && -prevn <= -n))
683             range_error (_("Overflow on numeric constant."));
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))) {
703      range_error (_("Overflow on numeric constant -- number too large."));
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
713 static 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
729 struct keyword {
730    char keyw[10];
731    int token;
732 };
733
734 static 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      },
758     {"TSIZE", SIZE       },
759 };
760
761
762 /* Read one token, getting characters through lexptr.  */
763
764 /* This is where we will check to make sure that the language and the
765    operators used are compatible  */
766
767 static int
768 yylex (void)
769 {
770   int c;
771   int namelen;
772   int i;
773   const char *tokstart;
774   char quote;
775
776  retry:
777
778   prev_lexptr = lexptr;
779
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++)
785      if (strncmp (tokentab2[i].name, tokstart, 2) == 0)
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)
865          error (_("Unterminated string or character constant."));
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;
886       const char *p = tokstart;
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;
912             error (_("Invalid number \"%s\"."), err_copy);
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. ';').  */
921     error (_("Invalid character '%c' in expression."), c);
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++)
942      if (namelen == strlen (keytab[i].keyw)
943          && strncmp (tokstart, keytab[i].keyw, namelen) == 0)
944            return keytab[i].token;
945
946   yylval.sval.ptr = tokstart;
947   yylval.sval.length = namelen;
948
949   if (*tokstart == '$')
950     {
951       write_dollar_variable (pstate, yylval.sval);
952       return INTERNAL_VAR;
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
966     if (lookup_symtab (tmp))
967       return BLOCKNAME;
968     sym = lookup_symbol (tmp, expression_context_block, VAR_DOMAIN, 0).symbol;
969     if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
970       return BLOCKNAME;
971     if (lookup_typename (parse_language (pstate), parse_gdbarch (pstate),
972                          copy_name (yylval.sval),
973                          expression_context_block, 1))
974       return TYPENAME;
975
976     if(sym)
977     {
978       switch(SYMBOL_CLASS (sym))
979        {
980        case LOC_STATIC:
981        case LOC_REGISTER:
982        case LOC_ARG:
983        case LOC_REF_ARG:
984        case LOC_REGPARM_ADDR:
985        case LOC_LOCAL:
986        case LOC_CONST:
987        case LOC_CONST_BYTES:
988        case LOC_OPTIMIZED_OUT:
989        case LOC_COMPUTED:
990           return NAME;
991
992        case LOC_TYPEDEF:
993           return TYPENAME;
994
995        case LOC_BLOCK:
996           return BLOCKNAME;
997
998        case LOC_UNDEF:
999           error (_("internal:  Undefined class in m2lex()"));
1000
1001        case LOC_LABEL:
1002        case LOC_UNRESOLVED:
1003           error (_("internal:  Unforseen case in m2lex()"));
1004
1005        default:
1006           error (_("unhandled token in m2lex()"));
1007           break;
1008        }
1009     }
1010     else
1011     {
1012        /* Built-in BOOLEAN type.  This is sort of a hack.  */
1013        if (strncmp (tokstart, "TRUE", 4) == 0)
1014        {
1015           yylval.ulval = 1;
1016           return M2_TRUE;
1017        }
1018        else if (strncmp (tokstart, "FALSE", 5) == 0)
1019        {
1020           yylval.ulval = 0;
1021           return M2_FALSE;
1022        }
1023     }
1024
1025     /* Must be another type of name...  */
1026     return NAME;
1027  }
1028 }
1029
1030 int
1031 m2_parse (struct parser_state *par_state)
1032 {
1033   /* Setting up the parser state.  */
1034   scoped_restore pstate_restore = make_scoped_restore (&pstate);
1035   gdb_assert (par_state != NULL);
1036   pstate = par_state;
1037
1038   return yyparse ();
1039 }
1040
1041 static void
1042 yyerror (const char *msg)
1043 {
1044   if (prev_lexptr)
1045     lexptr = prev_lexptr;
1046
1047   error (_("A %s in expression, near `%s'."), msg, lexptr);
1048 }