projects / deliverable / binutils-gdb.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Update checked-in copy for convenience. (FSF releases build their own.)
[deliverable/binutils-gdb.git] / gdb / m2-exp.y
CommitLineData
3d6b6a90
JG		 1/* YACC grammar for Modula-2 expressions, for GDB.
2 Copyright (C) 1986, 1989, 1990, 1991 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
6This file is part of GDB.
7
8This program is free software; you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
10the Free Software Foundation; either version 2 of the License, or
11(at your option) any later version.
12
13This program is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
19along with this program; if not, write to the Free Software
20Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
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%{
32#include <stdio.h>
33#include <string.h>
34#include "defs.h"
35#include "param.h"
36#include "symtab.h"
37#include "frame.h"
38#include "expression.h"
39#include "language.h"
39bf5952 40#include "value.h"
3d6b6a90
JG		 41#include "parser-defs.h"
42
43/* These MUST be included in any grammar file!!!!
44 Please choose unique names! */
d018c8a6 45#define yymaxdepth m2_maxdepth
3d6b6a90
JG		 46#define yyparse m2_parse
47#define yylex m2_lex
48#define yyerror m2_error
49#define yylval m2_lval
50#define yychar m2_char
51#define yydebug m2_debug
52#define yypact m2_pact
53#define yyr1 m2_r1
54#define yyr2 m2_r2
55#define yydef m2_def
56#define yychk m2_chk
57#define yypgo m2_pgo
58#define yyact m2_act
59#define yyexca m2_exca
9ce7cb7c
SG		 60#define yyerrflag m2_errflag
61#define yynerrs m2_nerrs
39bf5952
JG		 62#define yyps m2_ps
63#define yypv m2_pv
64#define yys m2_s
d018c8a6 65#define yy_yys m2_yys
39bf5952
JG		 66#define yystate m2_state
67#define yytmp m2_tmp
68#define yyv m2_v
d018c8a6 69#define yy_yyv m2_yyv
39bf5952
JG		 70#define yyval m2_val
71#define yylloc m2_lloc
3d6b6a90 72
f24adda3 73/* Forward decl's */
3d6b6a90 74void yyerror ();
9dffe475 75static int yylex ();
f24adda3 76int yyparse ();
3d6b6a90
JG		 77
78/* The sign of the number being parsed. */
79int number_sign = 1;
80
81/* The block that the module specified by the qualifer on an identifer is
82 contained in, */
83struct block *modblock=0;
84
85char *make_qualname();
86
87/* #define YYDEBUG 1 */
88
89%}
90
91/* Although the yacc "value" of an expression is not used,
92 since the result is stored in the structure being created,
93 other node types do have values. */
94
95%union
96 {
97 LONGEST lval;
98 unsigned LONGEST ulval;
99 double dval;
100 struct symbol *sym;
101 struct type *tval;
102 struct stoken sval;
103 int voidval;
104 struct block *bval;
105 enum exp_opcode opcode;
106 struct internalvar *ivar;
107
108 struct type **tvec;
109 int *ivec;
110 }
111
112%type <voidval> exp type_exp start set
113%type <voidval> variable
114%type <tval> type
115%type <bval> block
116%type <sym> fblock
117
118%token <lval> INT HEX ERROR
119%token <ulval> UINT TRUE FALSE CHAR
120%token <dval> FLOAT
121
122/* Both NAME and TYPENAME tokens represent symbols in the input,
123 and both convey their data as strings.
124 But a TYPENAME is a string that happens to be defined as a typedef
125 or builtin type name (such as int or char)
126 and a NAME is any other symbol.
127
128 Contexts where this distinction is not important can use the
129 nonterminal "name", which matches either NAME or TYPENAME. */
130
131%token <sval> STRING
132%token <sval> NAME BLOCKNAME IDENT CONST VARNAME
133%token <sval> TYPENAME
134
135%token SIZE CAP ORD HIGH ABS MIN MAX FLOAT_FUNC VAL CHR ODD TRUNC
136%token INC DEC INCL EXCL
137
138/* The GDB scope operator */
139%token COLONCOLON
140
141%token <lval> LAST REGNAME
142
143%token <ivar> INTERNAL_VAR
144
145/* M2 tokens */
146%left ','
147%left ABOVE_COMMA
148%nonassoc ASSIGN
149%left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
150%left OR
151%left AND '&'
152%left '@'
153%left '+' '-'
154%left '*' '/' DIV MOD
155%right UNARY
156%right '^' DOT '[' '('
157%right NOT '~'
158%left COLONCOLON QID
159/* This is not an actual token ; it is used for precedence.
160%right QID
161*/
162%%
163
164start : exp
165 | type_exp
166 ;
167
168type_exp: type
169 { write_exp_elt_opcode(OP_TYPE);
170 write_exp_elt_type($1);
171 write_exp_elt_opcode(OP_TYPE);
172 }
173 ;
174
175/* Expressions */
176
177exp : exp '^' %prec UNARY
178 { write_exp_elt_opcode (UNOP_IND); }
179
180exp : '-'
181 { number_sign = -1; }
182 exp %prec UNARY
183 { number_sign = 1;
184 write_exp_elt_opcode (UNOP_NEG); }
185 ;
186
187exp : '+' exp %prec UNARY
188 { write_exp_elt_opcode(UNOP_PLUS); }
189 ;
190
191exp : not_exp exp %prec UNARY
192 { write_exp_elt_opcode (UNOP_ZEROP); }
193 ;
194
195not_exp : NOT
196 | '~'
197 ;
198
199exp : CAP '(' exp ')'
200 { write_exp_elt_opcode (UNOP_CAP); }
201 ;
202
203exp : ORD '(' exp ')'
204 { write_exp_elt_opcode (UNOP_ORD); }
205 ;
206
207exp : ABS '(' exp ')'
208 { write_exp_elt_opcode (UNOP_ABS); }
209 ;
210
211exp : HIGH '(' exp ')'
212 { write_exp_elt_opcode (UNOP_HIGH); }
213 ;
214
215exp : MIN '(' type ')'
216 { write_exp_elt_opcode (UNOP_MIN);
217 write_exp_elt_type ($3);
218 write_exp_elt_opcode (UNOP_MIN); }
219 ;
220
221exp : MAX '(' type ')'
222 { write_exp_elt_opcode (UNOP_MAX);
223 write_exp_elt_type ($3);
224 write_exp_elt_opcode (UNOP_MIN); }
225 ;
226
227exp : FLOAT_FUNC '(' exp ')'
228 { write_exp_elt_opcode (UNOP_FLOAT); }
229 ;
230
231exp : VAL '(' type ',' exp ')'
232 { write_exp_elt_opcode (BINOP_VAL);
233 write_exp_elt_type ($3);
234 write_exp_elt_opcode (BINOP_VAL); }
235 ;
236
237exp : CHR '(' exp ')'
238 { write_exp_elt_opcode (UNOP_CHR); }
239 ;
240
241exp : ODD '(' exp ')'
242 { write_exp_elt_opcode (UNOP_ODD); }
243 ;
244
245exp : TRUNC '(' exp ')'
246 { write_exp_elt_opcode (UNOP_TRUNC); }
247 ;
248
249exp : SIZE exp %prec UNARY
250 { write_exp_elt_opcode (UNOP_SIZEOF); }
251 ;
252
253
254exp : INC '(' exp ')'
255 { write_exp_elt_opcode(UNOP_PREINCREMENT); }
256 ;
257
258exp : INC '(' exp ',' exp ')'
259 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
260 write_exp_elt_opcode(BINOP_ADD);
261 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
262 ;
263
264exp : DEC '(' exp ')'
265 { write_exp_elt_opcode(UNOP_PREDECREMENT);}
266 ;
267
268exp : DEC '(' exp ',' exp ')'
269 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
270 write_exp_elt_opcode(BINOP_SUB);
271 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
272 ;
273
274exp : exp DOT NAME
275 { write_exp_elt_opcode (STRUCTOP_STRUCT);
276 write_exp_string ($3);
277 write_exp_elt_opcode (STRUCTOP_STRUCT); }
278 ;
279
280exp : set
281 ;
282
283exp : exp IN set
284 { error("Sets are not implemented.");}
285 ;
286
287exp : INCL '(' exp ',' exp ')'
288 { error("Sets are not implemented.");}
289 ;
290
291exp : EXCL '(' exp ',' exp ')'
292 { error("Sets are not implemented.");}
293
294set : '{' arglist '}'
295 { error("Sets are not implemented.");}
296 | type '{' arglist '}'
297 { error("Sets are not implemented.");}
298 ;
299
300
301/* Modula-2 array subscript notation [a,b,c...] */
302exp : exp '['
303 /* This function just saves the number of arguments
304 that follow in the list. It is *not* specific to
305 function types */
306 { start_arglist(); }
307 non_empty_arglist ']' %prec DOT
308 { write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT);
309 write_exp_elt_longcst ((LONGEST) end_arglist());
310 write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT); }
311 ;
312
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
318 { write_exp_elt_opcode (OP_FUNCALL);
319 write_exp_elt_longcst ((LONGEST) end_arglist ());
320 write_exp_elt_opcode (OP_FUNCALL); }
321 ;
322
323arglist :
324 ;
325
326arglist : exp
327 { arglist_len = 1; }
328 ;
329
330arglist : arglist ',' exp %prec ABOVE_COMMA
331 { arglist_len++; }
332 ;
333
334non_empty_arglist
335 : exp
336 { arglist_len = 1; }
337 ;
338
339non_empty_arglist
340 : non_empty_arglist ',' exp %prec ABOVE_COMMA
341 { arglist_len++; }
342 ;
343
344/* GDB construct */
345exp : '{' type '}' exp %prec UNARY
346 { write_exp_elt_opcode (UNOP_MEMVAL);
347 write_exp_elt_type ($2);
348 write_exp_elt_opcode (UNOP_MEMVAL); }
349 ;
350
351exp : type '(' exp ')' %prec UNARY
352 { write_exp_elt_opcode (UNOP_CAST);
353 write_exp_elt_type ($1);
354 write_exp_elt_opcode (UNOP_CAST); }
355 ;
356
357exp : '(' exp ')'
358 { }
359 ;
360
361/* Binary operators in order of decreasing precedence. Note that some
362 of these operators are overloaded! (ie. sets) */
363
364/* GDB construct */
365exp : exp '@' exp
366 { write_exp_elt_opcode (BINOP_REPEAT); }
367 ;
368
369exp : exp '*' exp
370 { write_exp_elt_opcode (BINOP_MUL); }
371 ;
372
373exp : exp '/' exp
374 { write_exp_elt_opcode (BINOP_DIV); }
375 ;
376
377exp : exp DIV exp
378 { write_exp_elt_opcode (BINOP_INTDIV); }
379 ;
380
381exp : exp MOD exp
382 { write_exp_elt_opcode (BINOP_REM); }
383 ;
384
385exp : exp '+' exp
386 { write_exp_elt_opcode (BINOP_ADD); }
387 ;
388
389exp : exp '-' exp
390 { write_exp_elt_opcode (BINOP_SUB); }
391 ;
392
393exp : exp '=' exp
394 { write_exp_elt_opcode (BINOP_EQUAL); }
395 ;
396
397exp : exp NOTEQUAL exp
398 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
399 | exp '#' exp
400 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
401 ;
402
403exp : exp LEQ exp
404 { write_exp_elt_opcode (BINOP_LEQ); }
405 ;
406
407exp : exp GEQ exp
408 { write_exp_elt_opcode (BINOP_GEQ); }
409 ;
410
411exp : exp '<' exp
412 { write_exp_elt_opcode (BINOP_LESS); }
413 ;
414
415exp : exp '>' exp
416 { write_exp_elt_opcode (BINOP_GTR); }
417 ;
418
419exp : exp AND exp
420 { write_exp_elt_opcode (BINOP_AND); }
421 ;
422
423exp : exp '&' exp
424 { write_exp_elt_opcode (BINOP_AND); }
425 ;
426
427exp : exp OR exp
428 { write_exp_elt_opcode (BINOP_OR); }
429 ;
430
431exp : exp ASSIGN exp
432 { write_exp_elt_opcode (BINOP_ASSIGN); }
433 ;
434
435
436/* Constants */
437
438exp : TRUE
439 { write_exp_elt_opcode (OP_BOOL);
440 write_exp_elt_longcst ((LONGEST) $1);
441 write_exp_elt_opcode (OP_BOOL); }
442 ;
443
444exp : FALSE
445 { write_exp_elt_opcode (OP_BOOL);
446 write_exp_elt_longcst ((LONGEST) $1);
447 write_exp_elt_opcode (OP_BOOL); }
448 ;
449
450exp : INT
451 { write_exp_elt_opcode (OP_LONG);
452 write_exp_elt_type (builtin_type_m2_int);
453 write_exp_elt_longcst ((LONGEST) $1);
454 write_exp_elt_opcode (OP_LONG); }
455 ;
456
457exp : UINT
458 {
459 write_exp_elt_opcode (OP_LONG);
460 write_exp_elt_type (builtin_type_m2_card);
461 write_exp_elt_longcst ((LONGEST) $1);
462 write_exp_elt_opcode (OP_LONG);
463 }
464 ;
465
466exp : CHAR
467 { write_exp_elt_opcode (OP_LONG);
468 write_exp_elt_type (builtin_type_m2_char);
469 write_exp_elt_longcst ((LONGEST) $1);
470 write_exp_elt_opcode (OP_LONG); }
471 ;
472
473
474exp : FLOAT
475 { write_exp_elt_opcode (OP_DOUBLE);
476 write_exp_elt_type (builtin_type_m2_real);
477 write_exp_elt_dblcst ($1);
478 write_exp_elt_opcode (OP_DOUBLE); }
479 ;
480
481exp : variable
482 ;
483
484/* The GDB internal variable $$, et al. */
485exp : LAST
486 { write_exp_elt_opcode (OP_LAST);
487 write_exp_elt_longcst ((LONGEST) $1);
488 write_exp_elt_opcode (OP_LAST); }
489 ;
490
491exp : REGNAME
492 { write_exp_elt_opcode (OP_REGISTER);
493 write_exp_elt_longcst ((LONGEST) $1);
494 write_exp_elt_opcode (OP_REGISTER); }
495 ;
496
497exp : SIZE '(' type ')' %prec UNARY
498 { write_exp_elt_opcode (OP_LONG);
499 write_exp_elt_type (builtin_type_int);
500 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
501 write_exp_elt_opcode (OP_LONG); }
502 ;
503
504exp : STRING
505 { write_exp_elt_opcode (OP_M2_STRING);
506 write_exp_string ($1);
507 write_exp_elt_opcode (OP_M2_STRING); }
508 ;
509
510/* This will be used for extensions later. Like adding modules. */
511block : fblock
512 { $$ = SYMBOL_BLOCK_VALUE($1); }
513 ;
514
515fblock : BLOCKNAME
516 { struct symbol *sym
517 = lookup_symbol (copy_name ($1), expression_context_block,
518 VAR_NAMESPACE, 0, NULL);
519 $$ = sym;}
520 ;
521
522
523/* GDB scope operator */
524fblock : block COLONCOLON BLOCKNAME
525 { struct symbol *tem
526 = lookup_symbol (copy_name ($3), $1,
527 VAR_NAMESPACE, 0, NULL);
528 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
529 error ("No function \"%s\" in specified context.",
530 copy_name ($3));
531 $$ = tem;
532 }
533 ;
534
535/* Useful for assigning to PROCEDURE variables */
536variable: fblock
537 { write_exp_elt_opcode(OP_VAR_VALUE);
538 write_exp_elt_sym ($1);
539 write_exp_elt_opcode (OP_VAR_VALUE); }
540 ;
541
542/* GDB internal ($foo) variable */
543variable: INTERNAL_VAR
544 { write_exp_elt_opcode (OP_INTERNALVAR);
545 write_exp_elt_intern ($1);
546 write_exp_elt_opcode (OP_INTERNALVAR); }
547 ;
548
549/* GDB scope operator */
550variable: block COLONCOLON NAME
551 { struct symbol *sym;
552 sym = lookup_symbol (copy_name ($3), $1,
553 VAR_NAMESPACE, 0, NULL);
554 if (sym == 0)
555 error ("No symbol \"%s\" in specified context.",
556 copy_name ($3));
557
558 write_exp_elt_opcode (OP_VAR_VALUE);
559 write_exp_elt_sym (sym);
560 write_exp_elt_opcode (OP_VAR_VALUE); }
561 ;
562
563/* Base case for variables. */
564variable: NAME
565 { struct symbol *sym;
566 int is_a_field_of_this;
567
568 sym = lookup_symbol (copy_name ($1),
569 expression_context_block,
570 VAR_NAMESPACE,
571 &is_a_field_of_this,
572 NULL);
573 if (sym)
574 {
575 switch (sym->class)
576 {
577 case LOC_REGISTER:
578 case LOC_ARG:
579 case LOC_LOCAL:
580 if (innermost_block == 0 ||
581 contained_in (block_found,
582 innermost_block))
583 innermost_block = block_found;
584 }
585 write_exp_elt_opcode (OP_VAR_VALUE);
586 write_exp_elt_sym (sym);
587 write_exp_elt_opcode (OP_VAR_VALUE);
588 }
589 else
590 {
591 register int i;
592 register char *arg = copy_name ($1);
593
594 for (i = 0; i < misc_function_count; i++)
595 if (!strcmp (misc_function_vector[i].name, arg))
596 break;
597
598 if (i < misc_function_count)
599 {
600 enum misc_function_type mft =
601 (enum misc_function_type)
602 misc_function_vector[i].type;
603
604 write_exp_elt_opcode (OP_LONG);
605 write_exp_elt_type (builtin_type_int);
606 write_exp_elt_longcst ((LONGEST) misc_function_vector[i].address);
607 write_exp_elt_opcode (OP_LONG);
608 write_exp_elt_opcode (UNOP_MEMVAL);
609 if (mft == mf_data || mft == mf_bss)
610 write_exp_elt_type (builtin_type_int);
611 else if (mft == mf_text)
612 write_exp_elt_type (lookup_function_type (builtin_type_int));
613 else
614 write_exp_elt_type (builtin_type_char);
615 write_exp_elt_opcode (UNOP_MEMVAL);
616 }
617 else if (symtab_list == 0
618 && partial_symtab_list == 0)
619 error ("No symbol table is loaded. Use the \"symbol-file\" command.");
620 else
621 error ("No symbol \"%s\" in current context.",
622 copy_name ($1));
623 }
624 }
625 ;
626
627type
628 : TYPENAME
629 { $$ = lookup_typename (copy_name ($1),
630 expression_context_block, 0); }
631
632 ;
633
634%%
635
636#if 0 /* FIXME! */
637int
638overflow(a,b)
639 long a,b;
640{
641 return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
642}
643
644int
645uoverflow(a,b)
646 unsigned long a,b;
647{
648 return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
649}
650#endif /* FIXME */
651
652/* Take care of parsing a number (anything that starts with a digit).
653 Set yylval and return the token type; update lexptr.
654 LEN is the number of characters in it. */
655
656/*** Needs some error checking for the float case ***/
657
658static int
659parse_number (olen)
660 int olen;
661{
662 register char *p = lexptr;
663 register LONGEST n = 0;
664 register LONGEST prevn = 0;
665 register int c,i,ischar=0;
666 register int base = input_radix;
667 register int len = olen;
3d6b6a90
JG		 668 int unsigned_p = number_sign == 1 ? 1 : 0;
669
670 extern double atof ();
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 }
9dffe475 745 else if((unsigned_p && (n<0))) {
3d6b6a90 746 range_error("Overflow on numeric constant -- number too large.");
9dffe475 747 /* But, this can return if range_check == range_warn. */
3d6b6a90 748 }
9dffe475
JG		 749 yylval.lval = n;
750 return INT;
3d6b6a90
JG		 751}
752
753
754/* Some tokens */
755
756static 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
772struct keyword {
773 char keyw[10];
774 int token;
775};
776
777static struct keyword keytab[] =
778{
779 {"OR" , OR },
780 {"IN", IN },/* Note space after IN */
781 {"AND", AND },
782 {"ABS", ABS },
783 {"CHR", CHR },
784 {"DEC", DEC },
785 {"NOT", NOT },
786 {"DIV", DIV },
787 {"INC", INC },
788 {"MAX", MAX },
789 {"MIN", MIN },
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};
802
803
804/* Read one token, getting characters through lexptr. */
805
806/* This is where we will check to make sure that the language and the operators used are
807 compatible */
808
809static int
810yylex ()
811{
812 register int c;
813 register int namelen;
814 register int i;
815 register char *tokstart;
816 register char quote;
817
818 retry:
819
820 tokstart = lexptr;
821
822
823 /* See if it is a special token of length 2 */
824 for( i = 0 ; i < sizeof tokentab2 / sizeof tokentab2[0] ; i++)
825 if(!strncmp(tokentab2[i].name, tokstart, 2))
826 {
827 lexptr += 2;
828 return tokentab2[i].token;
829 }
830
831 switch (c = *tokstart)
832 {
833 case 0:
834 return 0;
835
836 case ' ':
837 case '\t':
838 case '\n':
839 lexptr++;
840 goto retry;
841
842 case '(':
843 paren_depth++;
844 lexptr++;
845 return c;
846
847 case ')':
848 if (paren_depth == 0)
849 return 0;
850 paren_depth--;
851 lexptr++;
852 return c;
853
854 case ',':
855 if (comma_terminates && paren_depth == 0)
856 return 0;
857 lexptr++;
858 return c;
859
860 case '.':
861 /* Might be a floating point number. */
862 if (lexptr[1] >= '0' && lexptr[1] <= '9')
863 break; /* Falls into number code. */
864 else
865 {
866 lexptr++;
867 return DOT;
868 }
869
870/* These are character tokens that appear as-is in the YACC grammar */
871 case '+':
872 case '-':
873 case '*':
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 lexptr++;
888 return c;
889
890 case '\'' :
891 case '"':
892 quote = c;
893 for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
894 if (c == '\\')
895 {
896 c = tokstart[++namelen];
897 if (c >= '0' && c <= '9')
898 {
899 c = tokstart[++namelen];
900 if (c >= '0' && c <= '9')
901 c = tokstart[++namelen];
902 }
903 }
904 if(c != quote)
905 error("Unterminated string or character constant.");
906 yylval.sval.ptr = tokstart + 1;
907 yylval.sval.length = namelen - 1;
908 lexptr += namelen + 1;
909
910 if(namelen == 2) /* Single character */
911 {
912 yylval.ulval = tokstart[1];
913 return CHAR;
914 }
915 else
916 return STRING;
917 }
918
919 /* Is it a number? */
920 /* Note: We have already dealt with the case of the token '.'.
921 See case '.' above. */
922 if ((c >= '0' && c <= '9'))
923 {
924 /* It's a number. */
925 int got_dot = 0, got_e = 0;
926 register char *p = tokstart;
927 int toktype;
928
929 for (++p ;; ++p)
930 {
931 if (!got_e && (*p == 'e' || *p == 'E'))
932 got_dot = got_e = 1;
933 else if (!got_dot && *p == '.')
934 got_dot = 1;
935 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
936 && (*p == '-' || *p == '+'))
937 /* This is the sign of the exponent, not the end of the
938 number. */
939 continue;
940 else if ((*p < '0' || *p > '9') &&
941 (*p < 'A' || *p > 'F') &&
942 (*p != 'H')) /* Modula-2 hexadecimal number */
943 break;
944 }
945 toktype = parse_number (p - tokstart);
946 if (toktype == ERROR)
947 {
948 char *err_copy = (char *) alloca (p - tokstart + 1);
949
950 bcopy (tokstart, err_copy, p - tokstart);
951 err_copy[p - tokstart] = 0;
952 error ("Invalid number \"%s\".", err_copy);
953 }
954 lexptr = p;
955 return toktype;
956 }
957
958 if (!(c == '_' || c == '$'
959 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
960 /* We must have come across a bad character (e.g. ';'). */
961 error ("Invalid character '%c' in expression.", c);
962
963 /* It's a name. See how long it is. */
964 namelen = 0;
965 for (c = tokstart[namelen];
966 (c == '_' || c == '$' || (c >= '0' && c <= '9')
967 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
968 c = tokstart[++namelen])
969 ;
970
971 /* The token "if" terminates the expression and is NOT
972 removed from the input stream. */
973 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
974 {
975 return 0;
976 }
977
978 lexptr += namelen;
979
980 /* Handle the tokens $digits; also $ (short for $0) and $$ (short for $$1)
981 and $$digits (equivalent to $<-digits> if you could type that).
982 Make token type LAST, and put the number (the digits) in yylval. */
983
984 if (*tokstart == '$')
985 {
986 register int negate = 0;
987 c = 1;
988 /* Double dollar means negate the number and add -1 as well.
989 Thus $$ alone means -1. */
990 if (namelen >= 2 && tokstart[1] == '$')
991 {
992 negate = 1;
993 c = 2;
994 }
995 if (c == namelen)
996 {
997 /* Just dollars (one or two) */
998 yylval.lval = - negate;
999 return LAST;
1000 }
1001 /* Is the rest of the token digits? */
1002 for (; c < namelen; c++)
1003 if (!(tokstart[c] >= '0' && tokstart[c] <= '9'))
1004 break;
1005 if (c == namelen)
1006 {
1007 yylval.lval = atoi (tokstart + 1 + negate);
1008 if (negate)
1009 yylval.lval = - yylval.lval;
1010 return LAST;
1011 }
1012 }
1013
1014 /* Handle tokens that refer to machine registers:
1015 $ followed by a register name. */
1016
1017 if (*tokstart == '$') {
1018 for (c = 0; c < NUM_REGS; c++)
1019 if (namelen - 1 == strlen (reg_names[c])
1020 && !strncmp (tokstart + 1, reg_names[c], namelen - 1))
1021 {
1022 yylval.lval = c;
1023 return REGNAME;
1024 }
1025 for (c = 0; c < num_std_regs; c++)
1026 if (namelen - 1 == strlen (std_regs[c].name)
1027 && !strncmp (tokstart + 1, std_regs[c].name, namelen - 1))
1028 {
1029 yylval.lval = std_regs[c].regnum;
1030 return REGNAME;
1031 }
1032 }
1033
1034
1035 /* Lookup special keywords */
1036 for(i = 0 ; i < sizeof(keytab) / sizeof(keytab[0]) ; i++)
1037 if(namelen == strlen(keytab[i].keyw) && !strncmp(tokstart,keytab[i].keyw,namelen))
1038 return keytab[i].token;
1039
1040 yylval.sval.ptr = tokstart;
1041 yylval.sval.length = namelen;
1042
1043 /* Any other names starting in $ are debugger internal variables. */
1044
1045 if (*tokstart == '$')
1046 {
1047 yylval.ivar = (struct internalvar *) lookup_internalvar (copy_name (yylval.sval) + 1);
1048 return INTERNAL_VAR;
1049 }
1050
1051
1052 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1053 functions. If this is not so, then ...
1054 Use token-type TYPENAME for symbols that happen to be defined
1055 currently as names of types; NAME for other symbols.
1056 The caller is not constrained to care about the distinction. */
1057 {
1058
1059
1060 char *tmp = copy_name (yylval.sval);
1061 struct symbol *sym;
1062
1063 if (lookup_partial_symtab (tmp))
1064 return BLOCKNAME;
1065 sym = lookup_symbol (tmp, expression_context_block,
1066 VAR_NAMESPACE, 0, NULL);
1067 if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1068 return BLOCKNAME;
1069 if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
1070 return TYPENAME;
1071
1072 if(sym)
1073 {
1074 switch(sym->class)
1075 {
1076 case LOC_STATIC:
1077 case LOC_REGISTER:
1078 case LOC_ARG:
1079 case LOC_REF_ARG:
1080 case LOC_REGPARM:
1081 case LOC_LOCAL:
1082 case LOC_LOCAL_ARG:
1083 case LOC_CONST:
1084 case LOC_CONST_BYTES:
1085 return NAME;
1086
1087 case LOC_TYPEDEF:
1088 return TYPENAME;
1089
1090 case LOC_BLOCK:
1091 return BLOCKNAME;
1092
1093 case LOC_UNDEF:
1094 error("internal: Undefined class in m2lex()");
1095
1096 case LOC_LABEL:
1097 error("internal: Unforseen case in m2lex()");
1098 }
1099 }
1100 else
1101 {
1102 /* Built-in BOOLEAN type. This is sort of a hack. */
1103 if(!strncmp(tokstart,"TRUE",4))
1104 {
1105 yylval.ulval = 1;
1106 return TRUE;
1107 }
1108 else if(!strncmp(tokstart,"FALSE",5))
1109 {
1110 yylval.ulval = 0;
1111 return FALSE;
1112 }
1113 }
1114
1115 /* Must be another type of name... */
1116 return NAME;
1117 }
1118}
1119
1120char *
1121make_qualname(mod,ident)
1122 char *mod, *ident;
1123{
1124 char *new = xmalloc(strlen(mod)+strlen(ident)+2);
1125
1126 strcpy(new,mod);
1127 strcat(new,".");
1128 strcat(new,ident);
1129 return new;
1130}
1131
1132
1133void
1134yyerror()
1135{
1136 printf("Parsing: %s\n",lexptr);
1137 if (yychar < 256)
1138 error("Invalid syntax in expression near character '%c'.",yychar);
1139 else
f24adda3 1140 error("Invalid syntax in expression");
3d6b6a90
JG		 1141}
1142\f
1143/* Table of operators and their precedences for printing expressions. */
1144
1145const static struct op_print m2_op_print_tab[] = {
1146 {"+", BINOP_ADD, PREC_ADD, 0},
1147 {"+", UNOP_PLUS, PREC_PREFIX, 0},
1148 {"-", BINOP_SUB, PREC_ADD, 0},
1149 {"-", UNOP_NEG, PREC_PREFIX, 0},
1150 {"*", BINOP_MUL, PREC_MUL, 0},
1151 {"/", BINOP_DIV, PREC_MUL, 0},
1152 {"DIV", BINOP_INTDIV, PREC_MUL, 0},
1153 {"MOD", BINOP_REM, PREC_MUL, 0},
1154 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
1155 {"OR", BINOP_OR, PREC_OR, 0},
1156 {"AND", BINOP_AND, PREC_AND, 0},
1157 {"NOT", UNOP_ZEROP, PREC_PREFIX, 0},
1158 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
1159 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
1160 {"<=", BINOP_LEQ, PREC_ORDER, 0},
1161 {">=", BINOP_GEQ, PREC_ORDER, 0},
1162 {">", BINOP_GTR, PREC_ORDER, 0},
1163 {"<", BINOP_LESS, PREC_ORDER, 0},
1164 {"^", UNOP_IND, PREC_PREFIX, 0},
1165 {"@", BINOP_REPEAT, PREC_REPEAT, 0},
1166};
1167\f
1168/* The built-in types of Modula-2. */
1169
1170struct type *builtin_type_m2_char;
1171struct type *builtin_type_m2_int;
1172struct type *builtin_type_m2_card;
1173struct type *builtin_type_m2_real;
1174struct type *builtin_type_m2_bool;
1175
9dffe475 1176struct type ** const (m2_builtin_types[]) =
3d6b6a90
JG		 1177{
1178 &builtin_type_m2_char,
1179 &builtin_type_m2_int,
1180 &builtin_type_m2_card,
1181 &builtin_type_m2_real,
1182 &builtin_type_m2_bool,
1183 0
1184};
1185
9dffe475 1186const struct language_defn m2_language_defn = {
3d6b6a90
JG		 1187 "modula-2",
1188 language_m2,
9dffe475 1189 m2_builtin_types,
3d6b6a90
JG		 1190 range_check_on,
1191 type_check_on,
1192 m2_parse, /* parser */
1193 m2_error, /* parser error function */
1194 &builtin_type_m2_int, /* longest signed integral type */
1195 &builtin_type_m2_card, /* longest unsigned integral type */
1196 &builtin_type_m2_real, /* longest floating point type */
1197 "0%XH", "0%", "XH", /* Hex format string, prefix, suffix */
1198 "%oB", "%", "oB", /* Octal format string, prefix, suffix */
1199 m2_op_print_tab, /* expression operators for printing */
1200 LANG_MAGIC
1201};
1202
1203/* Initialization for Modula-2 */
1204
1205void
1206_initialize_m2_exp ()
1207{
1208 /* FIXME: The code below assumes that the sizes of the basic data
1209 types are the same on the host and target machines!!! */
1210
1211 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
1212 builtin_type_m2_int = init_type (TYPE_CODE_INT, sizeof(int), 0, "INTEGER");
1213 builtin_type_m2_card = init_type (TYPE_CODE_INT, sizeof(int), 1, "CARDINAL");
1214 builtin_type_m2_real = init_type (TYPE_CODE_FLT, sizeof(float), 0, "REAL");
1215 builtin_type_m2_char = init_type (TYPE_CODE_CHAR, sizeof(char), 1, "CHAR");
1216
1217 builtin_type_m2_bool = init_type (TYPE_CODE_BOOL, sizeof(int), 1, "BOOLEAN");
1218 TYPE_NFIELDS(builtin_type_m2_bool) = 2;
1219 TYPE_FIELDS(builtin_type_m2_bool) =
1220 (struct field *) malloc (sizeof (struct field) * 2);
1221 TYPE_FIELD_BITPOS(builtin_type_m2_bool,0) = 0;
1222 TYPE_FIELD_NAME(builtin_type_m2_bool,0) = (char *)malloc(6);
1223 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,0),"FALSE");
1224 TYPE_FIELD_BITPOS(builtin_type_m2_bool,1) = 1;
1225 TYPE_FIELD_NAME(builtin_type_m2_bool,1) = (char *)malloc(5);
1226 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,1),"TRUE");
1227
1228 add_language (&m2_language_defn);
1229}
GDB Binutils - Deliverables
This page took 0.100231 seconds and 4 git commands to generate.