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.
6 This file is part of GDB.
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 2 of the License, or
11 (at your option) any later version.
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.
18 You should have received a copy of the GNU General Public License
19 along with this program; if not, write to the Free Software
20 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
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.
31 Note that malloc's and realloc's in this file are transformed to
32 xmalloc and xrealloc respectively by the same sed command in the
33 makefile that remaps any other malloc/realloc inserted by the parser
34 generator. Doing this with #defines and trying to control the interaction
35 with include files (<malloc.h> and <stdlib.h> for example) just became
36 too messy, particularly when such includes can be inserted at random
37 times by the parser generator. */
47 #include "expression.h"
50 #include "parser-defs.h"
55 /* These MUST be included in any grammar file!!!! Please choose unique names!
56 Note that this are a combined list of variables that can be produced
57 by any one of bison, byacc, or yacc. */
58 #define yymaxdepth m2_maxdepth
59 #define yyparse m2_parse
61 #define yyerror m2_error
62 #define yylval m2_lval
63 #define yychar m2_char
64 #define yydebug m2_debug
65 #define yypact m2_pact
72 #define yyexca m2_exca
73 #define yyerrflag m2_errflag
74 #define yynerrs m2_nerrs
79 #define yystate m2_state
84 #define yylloc m2_lloc
85 #define yyss m2_yyss /* byacc */
86 #define yyssp m2_yysp /* byacc */
87 #define yyvs m2_yyvs /* byacc */
88 #define yyvsp m2_yyvsp /* byacc */
92 make_qualname PARAMS ((char *, char *));
96 parse_number PARAMS ((int));
99 yylex PARAMS ((void));
102 yyerror PARAMS ((char *));
105 yyparse PARAMS ((void));
107 /* The sign of the number being parsed. */
110 /* The block that the module specified by the qualifer on an identifer is
112 struct block *modblock=0;
114 /* #define YYDEBUG 1 */
117 /* Although the yacc "value" of an expression is not used,
118 since the result is stored in the structure being created,
119 other node types do have values. */
124 unsigned LONGEST ulval;
131 enum exp_opcode opcode;
132 struct internalvar *ivar;
138 %type <voidval> exp type_exp start set
139 %type <voidval> variable
144 %token <lval> INT HEX ERROR
145 %token <ulval> UINT M2_TRUE M2_FALSE CHAR
148 /* Both NAME and TYPENAME tokens represent symbols in the input,
149 and both convey their data as strings.
150 But a TYPENAME is a string that happens to be defined as a typedef
151 or builtin type name (such as int or char)
152 and a NAME is any other symbol.
154 Contexts where this distinction is not important can use the
155 nonterminal "name", which matches either NAME or TYPENAME. */
158 %token <sval> NAME BLOCKNAME IDENT VARNAME
159 %token <sval> TYPENAME
161 %token SIZE CAP ORD HIGH ABS MIN_FUNC MAX_FUNC FLOAT_FUNC VAL CHR ODD TRUNC
162 %token INC DEC INCL EXCL
164 /* The GDB scope operator */
167 %token <lval> LAST REGNAME
169 %token <ivar> INTERNAL_VAR
175 %left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
180 %left '*' '/' DIV MOD
182 %right '^' DOT '[' '('
185 /* This is not an actual token ; it is used for precedence.
197 { write_exp_elt_opcode(OP_TYPE);
198 write_exp_elt_type($1);
199 write_exp_elt_opcode(OP_TYPE);
205 exp : exp '^' %prec UNARY
206 { write_exp_elt_opcode (UNOP_IND); }
209 { number_sign = -1; }
212 write_exp_elt_opcode (UNOP_NEG); }
215 exp : '+' exp %prec UNARY
216 { write_exp_elt_opcode(UNOP_PLUS); }
219 exp : not_exp exp %prec UNARY
220 { write_exp_elt_opcode (UNOP_ZEROP); }
227 exp : CAP '(' exp ')'
228 { write_exp_elt_opcode (UNOP_CAP); }
231 exp : ORD '(' exp ')'
232 { write_exp_elt_opcode (UNOP_ORD); }
235 exp : ABS '(' exp ')'
236 { write_exp_elt_opcode (UNOP_ABS); }
239 exp : HIGH '(' exp ')'
240 { write_exp_elt_opcode (UNOP_HIGH); }
243 exp : MIN_FUNC '(' type ')'
244 { write_exp_elt_opcode (UNOP_MIN);
245 write_exp_elt_type ($3);
246 write_exp_elt_opcode (UNOP_MIN); }
249 exp : MAX_FUNC '(' type ')'
250 { write_exp_elt_opcode (UNOP_MAX);
251 write_exp_elt_type ($3);
252 write_exp_elt_opcode (UNOP_MIN); }
255 exp : FLOAT_FUNC '(' exp ')'
256 { write_exp_elt_opcode (UNOP_FLOAT); }
259 exp : VAL '(' type ',' exp ')'
260 { write_exp_elt_opcode (BINOP_VAL);
261 write_exp_elt_type ($3);
262 write_exp_elt_opcode (BINOP_VAL); }
265 exp : CHR '(' exp ')'
266 { write_exp_elt_opcode (UNOP_CHR); }
269 exp : ODD '(' exp ')'
270 { write_exp_elt_opcode (UNOP_ODD); }
273 exp : TRUNC '(' exp ')'
274 { write_exp_elt_opcode (UNOP_TRUNC); }
277 exp : SIZE exp %prec UNARY
278 { write_exp_elt_opcode (UNOP_SIZEOF); }
282 exp : INC '(' exp ')'
283 { write_exp_elt_opcode(UNOP_PREINCREMENT); }
286 exp : INC '(' exp ',' exp ')'
287 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
288 write_exp_elt_opcode(BINOP_ADD);
289 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
292 exp : DEC '(' exp ')'
293 { write_exp_elt_opcode(UNOP_PREDECREMENT);}
296 exp : DEC '(' exp ',' exp ')'
297 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
298 write_exp_elt_opcode(BINOP_SUB);
299 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
303 { write_exp_elt_opcode (STRUCTOP_STRUCT);
304 write_exp_string ($3);
305 write_exp_elt_opcode (STRUCTOP_STRUCT); }
312 { error("Sets are not implemented.");}
315 exp : INCL '(' exp ',' exp ')'
316 { error("Sets are not implemented.");}
319 exp : EXCL '(' exp ',' exp ')'
320 { error("Sets are not implemented.");}
322 set : '{' arglist '}'
323 { error("Sets are not implemented.");}
324 | type '{' arglist '}'
325 { error("Sets are not implemented.");}
329 /* Modula-2 array subscript notation [a,b,c...] */
331 /* This function just saves the number of arguments
332 that follow in the list. It is *not* specific to
335 non_empty_arglist ']' %prec DOT
336 { write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT);
337 write_exp_elt_longcst ((LONGEST) end_arglist());
338 write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT); }
342 /* This is to save the value of arglist_len
343 being accumulated by an outer function call. */
344 { start_arglist (); }
345 arglist ')' %prec DOT
346 { write_exp_elt_opcode (OP_FUNCALL);
347 write_exp_elt_longcst ((LONGEST) end_arglist ());
348 write_exp_elt_opcode (OP_FUNCALL); }
358 arglist : arglist ',' exp %prec ABOVE_COMMA
368 : non_empty_arglist ',' exp %prec ABOVE_COMMA
373 exp : '{' type '}' exp %prec UNARY
374 { write_exp_elt_opcode (UNOP_MEMVAL);
375 write_exp_elt_type ($2);
376 write_exp_elt_opcode (UNOP_MEMVAL); }
379 exp : type '(' exp ')' %prec UNARY
380 { write_exp_elt_opcode (UNOP_CAST);
381 write_exp_elt_type ($1);
382 write_exp_elt_opcode (UNOP_CAST); }
389 /* Binary operators in order of decreasing precedence. Note that some
390 of these operators are overloaded! (ie. sets) */
394 { write_exp_elt_opcode (BINOP_REPEAT); }
398 { write_exp_elt_opcode (BINOP_MUL); }
402 { write_exp_elt_opcode (BINOP_DIV); }
406 { write_exp_elt_opcode (BINOP_INTDIV); }
410 { write_exp_elt_opcode (BINOP_REM); }
414 { write_exp_elt_opcode (BINOP_ADD); }
418 { write_exp_elt_opcode (BINOP_SUB); }
422 { write_exp_elt_opcode (BINOP_EQUAL); }
425 exp : exp NOTEQUAL exp
426 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
428 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
432 { write_exp_elt_opcode (BINOP_LEQ); }
436 { write_exp_elt_opcode (BINOP_GEQ); }
440 { write_exp_elt_opcode (BINOP_LESS); }
444 { write_exp_elt_opcode (BINOP_GTR); }
448 { write_exp_elt_opcode (BINOP_AND); }
452 { write_exp_elt_opcode (BINOP_AND); }
456 { write_exp_elt_opcode (BINOP_OR); }
460 { write_exp_elt_opcode (BINOP_ASSIGN); }
467 { write_exp_elt_opcode (OP_BOOL);
468 write_exp_elt_longcst ((LONGEST) $1);
469 write_exp_elt_opcode (OP_BOOL); }
473 { write_exp_elt_opcode (OP_BOOL);
474 write_exp_elt_longcst ((LONGEST) $1);
475 write_exp_elt_opcode (OP_BOOL); }
479 { write_exp_elt_opcode (OP_LONG);
480 write_exp_elt_type (builtin_type_m2_int);
481 write_exp_elt_longcst ((LONGEST) $1);
482 write_exp_elt_opcode (OP_LONG); }
487 write_exp_elt_opcode (OP_LONG);
488 write_exp_elt_type (builtin_type_m2_card);
489 write_exp_elt_longcst ((LONGEST) $1);
490 write_exp_elt_opcode (OP_LONG);
495 { write_exp_elt_opcode (OP_LONG);
496 write_exp_elt_type (builtin_type_m2_char);
497 write_exp_elt_longcst ((LONGEST) $1);
498 write_exp_elt_opcode (OP_LONG); }
503 { write_exp_elt_opcode (OP_DOUBLE);
504 write_exp_elt_type (builtin_type_m2_real);
505 write_exp_elt_dblcst ($1);
506 write_exp_elt_opcode (OP_DOUBLE); }
512 /* The GDB internal variable $$, et al. */
514 { write_exp_elt_opcode (OP_LAST);
515 write_exp_elt_longcst ((LONGEST) $1);
516 write_exp_elt_opcode (OP_LAST); }
520 { write_exp_elt_opcode (OP_REGISTER);
521 write_exp_elt_longcst ((LONGEST) $1);
522 write_exp_elt_opcode (OP_REGISTER); }
525 exp : SIZE '(' type ')' %prec UNARY
526 { write_exp_elt_opcode (OP_LONG);
527 write_exp_elt_type (builtin_type_int);
528 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
529 write_exp_elt_opcode (OP_LONG); }
533 { write_exp_elt_opcode (OP_M2_STRING);
534 write_exp_string ($1);
535 write_exp_elt_opcode (OP_M2_STRING); }
538 /* This will be used for extensions later. Like adding modules. */
540 { $$ = SYMBOL_BLOCK_VALUE($1); }
545 = lookup_symbol (copy_name ($1), expression_context_block,
546 VAR_NAMESPACE, 0, NULL);
551 /* GDB scope operator */
552 fblock : block COLONCOLON BLOCKNAME
554 = lookup_symbol (copy_name ($3), $1,
555 VAR_NAMESPACE, 0, NULL);
556 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
557 error ("No function \"%s\" in specified context.",
563 /* Useful for assigning to PROCEDURE variables */
565 { write_exp_elt_opcode(OP_VAR_VALUE);
566 write_exp_elt_sym ($1);
567 write_exp_elt_opcode (OP_VAR_VALUE); }
570 /* GDB internal ($foo) variable */
571 variable: INTERNAL_VAR
572 { write_exp_elt_opcode (OP_INTERNALVAR);
573 write_exp_elt_intern ($1);
574 write_exp_elt_opcode (OP_INTERNALVAR); }
577 /* GDB scope operator */
578 variable: block COLONCOLON NAME
579 { struct symbol *sym;
580 sym = lookup_symbol (copy_name ($3), $1,
581 VAR_NAMESPACE, 0, NULL);
583 error ("No symbol \"%s\" in specified context.",
586 write_exp_elt_opcode (OP_VAR_VALUE);
587 write_exp_elt_sym (sym);
588 write_exp_elt_opcode (OP_VAR_VALUE); }
591 /* Base case for variables. */
593 { struct symbol *sym;
594 int is_a_field_of_this;
596 sym = lookup_symbol (copy_name ($1),
597 expression_context_block,
611 if (innermost_block == 0 ||
612 contained_in (block_found,
614 innermost_block = block_found;
621 case LOC_LABEL: /* maybe should go above? */
623 case LOC_CONST_BYTES:
624 /* These are listed so gcc -Wall will reveal
628 write_exp_elt_opcode (OP_VAR_VALUE);
629 write_exp_elt_sym (sym);
630 write_exp_elt_opcode (OP_VAR_VALUE);
634 struct minimal_symbol *msymbol;
635 register char *arg = copy_name ($1);
637 msymbol = lookup_minimal_symbol (arg,
638 (struct objfile *) NULL);
641 write_exp_elt_opcode (OP_LONG);
642 write_exp_elt_type (builtin_type_int);
643 write_exp_elt_longcst ((LONGEST) msymbol -> address);
644 write_exp_elt_opcode (OP_LONG);
645 write_exp_elt_opcode (UNOP_MEMVAL);
646 if (msymbol -> type == mst_data ||
647 msymbol -> type == mst_bss)
648 write_exp_elt_type (builtin_type_int);
649 else if (msymbol -> type == mst_text)
650 write_exp_elt_type (lookup_function_type (builtin_type_int));
652 write_exp_elt_type (builtin_type_char);
653 write_exp_elt_opcode (UNOP_MEMVAL);
655 else if (!have_full_symbols () && !have_partial_symbols ())
656 error ("No symbol table is loaded. Use the \"symbol-file\" command.");
658 error ("No symbol \"%s\" in current context.",
666 { $$ = lookup_typename (copy_name ($1),
667 expression_context_block, 0); }
678 return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
685 return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
689 /* Take care of parsing a number (anything that starts with a digit).
690 Set yylval and return the token type; update lexptr.
691 LEN is the number of characters in it. */
693 /*** Needs some error checking for the float case ***/
699 register char *p = lexptr;
700 register LONGEST n = 0;
701 register LONGEST prevn = 0;
702 register int c,i,ischar=0;
703 register int base = input_radix;
704 register int len = olen;
705 int unsigned_p = number_sign == 1 ? 1 : 0;
712 else if(p[len-1] == 'C' || p[len-1] == 'B')
715 ischar = p[len-1] == 'C';
719 /* Scan the number */
720 for (c = 0; c < len; c++)
722 if (p[c] == '.' && base == 10)
724 /* It's a float since it contains a point. */
725 yylval.dval = atof (p);
729 if (p[c] == '.' && base != 10)
730 error("Floating point numbers must be base 10.");
731 if (base == 10 && (p[c] < '0' || p[c] > '9'))
732 error("Invalid digit \'%c\' in number.",p[c]);
739 if( base == 8 && (c == '8' || c == '9'))
740 error("Invalid digit \'%c\' in octal number.",c);
741 if (c >= '0' && c <= '9')
745 if (base == 16 && c >= 'A' && c <= 'F')
753 if(!unsigned_p && number_sign == 1 && (prevn >= n))
754 unsigned_p=1; /* Try something unsigned */
755 /* Don't do the range check if n==i and i==0, since that special
756 case will give an overflow error. */
757 if(RANGE_CHECK && n!=i && i)
759 if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
760 ((!unsigned_p && number_sign==-1) && -prevn <= -n))
761 range_error("Overflow on numeric constant.");
767 if(*p == 'B' || *p == 'C' || *p == 'H')
768 lexptr++; /* Advance past B,C or H */
775 else if ( unsigned_p && number_sign == 1)
780 else if((unsigned_p && (n<0))) {
781 range_error("Overflow on numeric constant -- number too large.");
782 /* But, this can return if range_check == range_warn. */
797 { {'<', '>'}, NOTEQUAL },
798 { {':', '='}, ASSIGN },
801 { {':', ':'}, COLONCOLON },
805 /* Some specific keywords */
812 static struct keyword keytab[] =
815 {"IN", IN },/* Note space after IN */
834 {"FLOAT", FLOAT_FUNC },
839 /* Read one token, getting characters through lexptr. */
841 /* This is where we will check to make sure that the language and the operators used are
848 register int namelen;
850 register char *tokstart;
858 /* See if it is a special token of length 2 */
859 for( i = 0 ; i < sizeof tokentab2 / sizeof tokentab2[0] ; i++)
860 if(!strncmp(tokentab2[i].name, tokstart, 2))
863 return tokentab2[i].token;
866 switch (c = *tokstart)
883 if (paren_depth == 0)
890 if (comma_terminates && paren_depth == 0)
896 /* Might be a floating point number. */
897 if (lexptr[1] >= '0' && lexptr[1] <= '9')
898 break; /* Falls into number code. */
905 /* These are character tokens that appear as-is in the YACC grammar */
928 for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
931 c = tokstart[++namelen];
932 if (c >= '0' && c <= '9')
934 c = tokstart[++namelen];
935 if (c >= '0' && c <= '9')
936 c = tokstart[++namelen];
940 error("Unterminated string or character constant.");
941 yylval.sval.ptr = tokstart + 1;
942 yylval.sval.length = namelen - 1;
943 lexptr += namelen + 1;
945 if(namelen == 2) /* Single character */
947 yylval.ulval = tokstart[1];
954 /* Is it a number? */
955 /* Note: We have already dealt with the case of the token '.'.
956 See case '.' above. */
957 if ((c >= '0' && c <= '9'))
960 int got_dot = 0, got_e = 0;
961 register char *p = tokstart;
966 if (!got_e && (*p == 'e' || *p == 'E'))
968 else if (!got_dot && *p == '.')
970 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
971 && (*p == '-' || *p == '+'))
972 /* This is the sign of the exponent, not the end of the
975 else if ((*p < '0' || *p > '9') &&
976 (*p < 'A' || *p > 'F') &&
977 (*p != 'H')) /* Modula-2 hexadecimal number */
980 toktype = parse_number (p - tokstart);
981 if (toktype == ERROR)
983 char *err_copy = (char *) alloca (p - tokstart + 1);
985 memcpy (err_copy, tokstart, p - tokstart);
986 err_copy[p - tokstart] = 0;
987 error ("Invalid number \"%s\".", err_copy);
993 if (!(c == '_' || c == '$'
994 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
995 /* We must have come across a bad character (e.g. ';'). */
996 error ("Invalid character '%c' in expression.", c);
998 /* It's a name. See how long it is. */
1000 for (c = tokstart[namelen];
1001 (c == '_' || c == '$' || (c >= '0' && c <= '9')
1002 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1003 c = tokstart[++namelen])
1006 /* The token "if" terminates the expression and is NOT
1007 removed from the input stream. */
1008 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1015 /* Handle the tokens $digits; also $ (short for $0) and $$ (short for $$1)
1016 and $$digits (equivalent to $<-digits> if you could type that).
1017 Make token type LAST, and put the number (the digits) in yylval. */
1019 if (*tokstart == '$')
1021 register int negate = 0;
1023 /* Double dollar means negate the number and add -1 as well.
1024 Thus $$ alone means -1. */
1025 if (namelen >= 2 && tokstart[1] == '$')
1032 /* Just dollars (one or two) */
1033 yylval.lval = - negate;
1036 /* Is the rest of the token digits? */
1037 for (; c < namelen; c++)
1038 if (!(tokstart[c] >= '0' && tokstart[c] <= '9'))
1042 yylval.lval = atoi (tokstart + 1 + negate);
1044 yylval.lval = - yylval.lval;
1049 /* Handle tokens that refer to machine registers:
1050 $ followed by a register name. */
1052 if (*tokstart == '$') {
1053 for (c = 0; c < NUM_REGS; c++)
1054 if (namelen - 1 == strlen (reg_names[c])
1055 && !strncmp (tokstart + 1, reg_names[c], namelen - 1))
1060 for (c = 0; c < num_std_regs; c++)
1061 if (namelen - 1 == strlen (std_regs[c].name)
1062 && !strncmp (tokstart + 1, std_regs[c].name, namelen - 1))
1064 yylval.lval = std_regs[c].regnum;
1070 /* Lookup special keywords */
1071 for(i = 0 ; i < sizeof(keytab) / sizeof(keytab[0]) ; i++)
1072 if(namelen == strlen(keytab[i].keyw) && !strncmp(tokstart,keytab[i].keyw,namelen))
1073 return keytab[i].token;
1075 yylval.sval.ptr = tokstart;
1076 yylval.sval.length = namelen;
1078 /* Any other names starting in $ are debugger internal variables. */
1080 if (*tokstart == '$')
1082 yylval.ivar = (struct internalvar *) lookup_internalvar (copy_name (yylval.sval) + 1);
1083 return INTERNAL_VAR;
1087 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1088 functions. If this is not so, then ...
1089 Use token-type TYPENAME for symbols that happen to be defined
1090 currently as names of types; NAME for other symbols.
1091 The caller is not constrained to care about the distinction. */
1095 char *tmp = copy_name (yylval.sval);
1098 if (lookup_partial_symtab (tmp))
1100 sym = lookup_symbol (tmp, expression_context_block,
1101 VAR_NAMESPACE, 0, NULL);
1102 if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1104 if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
1119 case LOC_CONST_BYTES:
1129 error("internal: Undefined class in m2lex()");
1132 error("internal: Unforseen case in m2lex()");
1137 /* Built-in BOOLEAN type. This is sort of a hack. */
1138 if(!strncmp(tokstart,"TRUE",4))
1143 else if(!strncmp(tokstart,"FALSE",5))
1150 /* Must be another type of name... */
1157 make_qualname(mod,ident)
1160 char *new = malloc(strlen(mod)+strlen(ident)+2);
1171 char *msg; /* unused */
1173 printf("Parsing: %s\n",lexptr);
1175 error("Invalid syntax in expression near character '%c'.",yychar);
1177 error("Invalid syntax in expression");
1180 /* Table of operators and their precedences for printing expressions. */
1182 const static struct op_print m2_op_print_tab[] = {
1183 {"+", BINOP_ADD, PREC_ADD, 0},
1184 {"+", UNOP_PLUS, PREC_PREFIX, 0},
1185 {"-", BINOP_SUB, PREC_ADD, 0},
1186 {"-", UNOP_NEG, PREC_PREFIX, 0},
1187 {"*", BINOP_MUL, PREC_MUL, 0},
1188 {"/", BINOP_DIV, PREC_MUL, 0},
1189 {"DIV", BINOP_INTDIV, PREC_MUL, 0},
1190 {"MOD", BINOP_REM, PREC_MUL, 0},
1191 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
1192 {"OR", BINOP_OR, PREC_OR, 0},
1193 {"AND", BINOP_AND, PREC_AND, 0},
1194 {"NOT", UNOP_ZEROP, PREC_PREFIX, 0},
1195 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
1196 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
1197 {"<=", BINOP_LEQ, PREC_ORDER, 0},
1198 {">=", BINOP_GEQ, PREC_ORDER, 0},
1199 {">", BINOP_GTR, PREC_ORDER, 0},
1200 {"<", BINOP_LESS, PREC_ORDER, 0},
1201 {"^", UNOP_IND, PREC_PREFIX, 0},
1202 {"@", BINOP_REPEAT, PREC_REPEAT, 0},
1205 /* The built-in types of Modula-2. */
1207 struct type *builtin_type_m2_char;
1208 struct type *builtin_type_m2_int;
1209 struct type *builtin_type_m2_card;
1210 struct type *builtin_type_m2_real;
1211 struct type *builtin_type_m2_bool;
1213 struct type ** const (m2_builtin_types[]) =
1215 &builtin_type_m2_char,
1216 &builtin_type_m2_int,
1217 &builtin_type_m2_card,
1218 &builtin_type_m2_real,
1219 &builtin_type_m2_bool,
1223 const struct language_defn m2_language_defn = {
1229 m2_parse, /* parser */
1230 m2_error, /* parser error function */
1231 &builtin_type_m2_int, /* longest signed integral type */
1232 &builtin_type_m2_card, /* longest unsigned integral type */
1233 &builtin_type_m2_real, /* longest floating point type */
1234 "0%XH", "0%", "XH", /* Hex format string, prefix, suffix */
1235 "%oB", "%", "oB", /* Octal format string, prefix, suffix */
1236 m2_op_print_tab, /* expression operators for printing */
1240 /* Initialization for Modula-2 */
1243 _initialize_m2_exp ()
1245 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
1246 builtin_type_m2_int =
1247 init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
1249 "INTEGER", (struct objfile *) NULL);
1250 builtin_type_m2_card =
1251 init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
1253 "CARDINAL", (struct objfile *) NULL);
1254 builtin_type_m2_real =
1255 init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
1257 "REAL", (struct objfile *) NULL);
1258 builtin_type_m2_char =
1259 init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
1261 "CHAR", (struct objfile *) NULL);
1262 builtin_type_m2_bool =
1263 init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT,
1265 "BOOLEAN", (struct objfile *) NULL);
1267 TYPE_NFIELDS(builtin_type_m2_bool) = 2;
1268 TYPE_FIELDS(builtin_type_m2_bool) =
1269 (struct field *) malloc (sizeof (struct field) * 2);
1270 TYPE_FIELD_BITPOS(builtin_type_m2_bool,0) = 0;
1271 TYPE_FIELD_NAME(builtin_type_m2_bool,0) = (char *)malloc(6);
1272 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,0),"FALSE");
1273 TYPE_FIELD_BITPOS(builtin_type_m2_bool,1) = 1;
1274 TYPE_FIELD_NAME(builtin_type_m2_bool,1) = (char *)malloc(5);
1275 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,1),"TRUE");
1277 add_language (&m2_language_defn);