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