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