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. */
38 #include "expression.h"
41 #include "parser-defs.h"
46 /* Ensure that if the generated parser contains any calls to malloc/realloc,
47 that they get mapped to xmalloc/xrealloc. */
49 #define malloc xmalloc
50 #define realloc xrealloc
52 /* These MUST be included in any grammar file!!!!
53 Please choose unique names! */
54 #define yymaxdepth m2_maxdepth
55 #define yyparse m2_parse
57 #define yyerror m2_error
58 #define yylval m2_lval
59 #define yychar m2_char
60 #define yydebug m2_debug
61 #define yypact m2_pact
68 #define yyexca m2_exca
69 #define yyerrflag m2_errflag
70 #define yynerrs m2_nerrs
75 #define yystate m2_state
80 #define yylloc m2_lloc
84 make_qualname PARAMS ((char *, char *));
88 parse_number PARAMS ((int));
91 yylex PARAMS ((void));
94 yyerror PARAMS ((char *));
97 yyparse PARAMS ((void));
99 /* The sign of the number being parsed. */
102 /* The block that the module specified by the qualifer on an identifer is
104 struct block *modblock=0;
106 /* #define YYDEBUG 1 */
110 /* Although the yacc "value" of an expression is not used,
111 since the result is stored in the structure being created,
112 other node types do have values. */
117 unsigned LONGEST ulval;
124 enum exp_opcode opcode;
125 struct internalvar *ivar;
131 %type <voidval> exp type_exp start set
132 %type <voidval> variable
137 %token <lval> INT HEX ERROR
138 %token <ulval> UINT TRUE FALSE CHAR
141 /* Both NAME and TYPENAME tokens represent symbols in the input,
142 and both convey their data as strings.
143 But a TYPENAME is a string that happens to be defined as a typedef
144 or builtin type name (such as int or char)
145 and a NAME is any other symbol.
147 Contexts where this distinction is not important can use the
148 nonterminal "name", which matches either NAME or TYPENAME. */
151 %token <sval> NAME BLOCKNAME IDENT VARNAME
152 %token <sval> TYPENAME
154 %token SIZE CAP ORD HIGH ABS MIN_FUNC MAX_FUNC FLOAT_FUNC VAL CHR ODD TRUNC
155 %token INC DEC INCL EXCL
157 /* The GDB scope operator */
160 %token <lval> LAST REGNAME
162 %token <ivar> INTERNAL_VAR
168 %left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
173 %left '*' '/' DIV MOD
175 %right '^' DOT '[' '('
178 /* This is not an actual token ; it is used for precedence.
188 { write_exp_elt_opcode(OP_TYPE);
189 write_exp_elt_type($1);
190 write_exp_elt_opcode(OP_TYPE);
196 exp : exp '^' %prec UNARY
197 { write_exp_elt_opcode (UNOP_IND); }
200 { number_sign = -1; }
203 write_exp_elt_opcode (UNOP_NEG); }
206 exp : '+' exp %prec UNARY
207 { write_exp_elt_opcode(UNOP_PLUS); }
210 exp : not_exp exp %prec UNARY
211 { write_exp_elt_opcode (UNOP_ZEROP); }
218 exp : CAP '(' exp ')'
219 { write_exp_elt_opcode (UNOP_CAP); }
222 exp : ORD '(' exp ')'
223 { write_exp_elt_opcode (UNOP_ORD); }
226 exp : ABS '(' exp ')'
227 { write_exp_elt_opcode (UNOP_ABS); }
230 exp : HIGH '(' exp ')'
231 { write_exp_elt_opcode (UNOP_HIGH); }
234 exp : MIN_FUNC '(' type ')'
235 { write_exp_elt_opcode (UNOP_MIN);
236 write_exp_elt_type ($3);
237 write_exp_elt_opcode (UNOP_MIN); }
240 exp : MAX_FUNC '(' type ')'
241 { write_exp_elt_opcode (UNOP_MAX);
242 write_exp_elt_type ($3);
243 write_exp_elt_opcode (UNOP_MIN); }
246 exp : FLOAT_FUNC '(' exp ')'
247 { write_exp_elt_opcode (UNOP_FLOAT); }
250 exp : VAL '(' type ',' exp ')'
251 { write_exp_elt_opcode (BINOP_VAL);
252 write_exp_elt_type ($3);
253 write_exp_elt_opcode (BINOP_VAL); }
256 exp : CHR '(' exp ')'
257 { write_exp_elt_opcode (UNOP_CHR); }
260 exp : ODD '(' exp ')'
261 { write_exp_elt_opcode (UNOP_ODD); }
264 exp : TRUNC '(' exp ')'
265 { write_exp_elt_opcode (UNOP_TRUNC); }
268 exp : SIZE exp %prec UNARY
269 { write_exp_elt_opcode (UNOP_SIZEOF); }
273 exp : INC '(' exp ')'
274 { write_exp_elt_opcode(UNOP_PREINCREMENT); }
277 exp : INC '(' exp ',' exp ')'
278 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
279 write_exp_elt_opcode(BINOP_ADD);
280 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
283 exp : DEC '(' exp ')'
284 { write_exp_elt_opcode(UNOP_PREDECREMENT);}
287 exp : DEC '(' exp ',' exp ')'
288 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
289 write_exp_elt_opcode(BINOP_SUB);
290 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
294 { write_exp_elt_opcode (STRUCTOP_STRUCT);
295 write_exp_string ($3);
296 write_exp_elt_opcode (STRUCTOP_STRUCT); }
303 { error("Sets are not implemented.");}
306 exp : INCL '(' exp ',' exp ')'
307 { error("Sets are not implemented.");}
310 exp : EXCL '(' exp ',' exp ')'
311 { error("Sets are not implemented.");}
313 set : '{' arglist '}'
314 { error("Sets are not implemented.");}
315 | type '{' arglist '}'
316 { error("Sets are not implemented.");}
320 /* Modula-2 array subscript notation [a,b,c...] */
322 /* This function just saves the number of arguments
323 that follow in the list. It is *not* specific to
326 non_empty_arglist ']' %prec DOT
327 { write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT);
328 write_exp_elt_longcst ((LONGEST) end_arglist());
329 write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT); }
333 /* This is to save the value of arglist_len
334 being accumulated by an outer function call. */
335 { start_arglist (); }
336 arglist ')' %prec DOT
337 { write_exp_elt_opcode (OP_FUNCALL);
338 write_exp_elt_longcst ((LONGEST) end_arglist ());
339 write_exp_elt_opcode (OP_FUNCALL); }
349 arglist : arglist ',' exp %prec ABOVE_COMMA
359 : non_empty_arglist ',' exp %prec ABOVE_COMMA
364 exp : '{' type '}' exp %prec UNARY
365 { write_exp_elt_opcode (UNOP_MEMVAL);
366 write_exp_elt_type ($2);
367 write_exp_elt_opcode (UNOP_MEMVAL); }
370 exp : type '(' exp ')' %prec UNARY
371 { write_exp_elt_opcode (UNOP_CAST);
372 write_exp_elt_type ($1);
373 write_exp_elt_opcode (UNOP_CAST); }
380 /* Binary operators in order of decreasing precedence. Note that some
381 of these operators are overloaded! (ie. sets) */
385 { write_exp_elt_opcode (BINOP_REPEAT); }
389 { write_exp_elt_opcode (BINOP_MUL); }
393 { write_exp_elt_opcode (BINOP_DIV); }
397 { write_exp_elt_opcode (BINOP_INTDIV); }
401 { write_exp_elt_opcode (BINOP_REM); }
405 { write_exp_elt_opcode (BINOP_ADD); }
409 { write_exp_elt_opcode (BINOP_SUB); }
413 { write_exp_elt_opcode (BINOP_EQUAL); }
416 exp : exp NOTEQUAL exp
417 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
419 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
423 { write_exp_elt_opcode (BINOP_LEQ); }
427 { write_exp_elt_opcode (BINOP_GEQ); }
431 { write_exp_elt_opcode (BINOP_LESS); }
435 { write_exp_elt_opcode (BINOP_GTR); }
439 { write_exp_elt_opcode (BINOP_AND); }
443 { write_exp_elt_opcode (BINOP_AND); }
447 { write_exp_elt_opcode (BINOP_OR); }
451 { write_exp_elt_opcode (BINOP_ASSIGN); }
458 { write_exp_elt_opcode (OP_BOOL);
459 write_exp_elt_longcst ((LONGEST) $1);
460 write_exp_elt_opcode (OP_BOOL); }
464 { write_exp_elt_opcode (OP_BOOL);
465 write_exp_elt_longcst ((LONGEST) $1);
466 write_exp_elt_opcode (OP_BOOL); }
470 { write_exp_elt_opcode (OP_LONG);
471 write_exp_elt_type (builtin_type_m2_int);
472 write_exp_elt_longcst ((LONGEST) $1);
473 write_exp_elt_opcode (OP_LONG); }
478 write_exp_elt_opcode (OP_LONG);
479 write_exp_elt_type (builtin_type_m2_card);
480 write_exp_elt_longcst ((LONGEST) $1);
481 write_exp_elt_opcode (OP_LONG);
486 { write_exp_elt_opcode (OP_LONG);
487 write_exp_elt_type (builtin_type_m2_char);
488 write_exp_elt_longcst ((LONGEST) $1);
489 write_exp_elt_opcode (OP_LONG); }
494 { write_exp_elt_opcode (OP_DOUBLE);
495 write_exp_elt_type (builtin_type_m2_real);
496 write_exp_elt_dblcst ($1);
497 write_exp_elt_opcode (OP_DOUBLE); }
503 /* The GDB internal variable $$, et al. */
505 { write_exp_elt_opcode (OP_LAST);
506 write_exp_elt_longcst ((LONGEST) $1);
507 write_exp_elt_opcode (OP_LAST); }
511 { write_exp_elt_opcode (OP_REGISTER);
512 write_exp_elt_longcst ((LONGEST) $1);
513 write_exp_elt_opcode (OP_REGISTER); }
516 exp : SIZE '(' type ')' %prec UNARY
517 { write_exp_elt_opcode (OP_LONG);
518 write_exp_elt_type (builtin_type_int);
519 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
520 write_exp_elt_opcode (OP_LONG); }
524 { write_exp_elt_opcode (OP_M2_STRING);
525 write_exp_string ($1);
526 write_exp_elt_opcode (OP_M2_STRING); }
529 /* This will be used for extensions later. Like adding modules. */
531 { $$ = SYMBOL_BLOCK_VALUE($1); }
536 = lookup_symbol (copy_name ($1), expression_context_block,
537 VAR_NAMESPACE, 0, NULL);
542 /* GDB scope operator */
543 fblock : block COLONCOLON BLOCKNAME
545 = lookup_symbol (copy_name ($3), $1,
546 VAR_NAMESPACE, 0, NULL);
547 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
548 error ("No function \"%s\" in specified context.",
554 /* Useful for assigning to PROCEDURE variables */
556 { write_exp_elt_opcode(OP_VAR_VALUE);
557 write_exp_elt_sym ($1);
558 write_exp_elt_opcode (OP_VAR_VALUE); }
561 /* GDB internal ($foo) variable */
562 variable: INTERNAL_VAR
563 { write_exp_elt_opcode (OP_INTERNALVAR);
564 write_exp_elt_intern ($1);
565 write_exp_elt_opcode (OP_INTERNALVAR); }
568 /* GDB scope operator */
569 variable: block COLONCOLON NAME
570 { struct symbol *sym;
571 sym = lookup_symbol (copy_name ($3), $1,
572 VAR_NAMESPACE, 0, NULL);
574 error ("No symbol \"%s\" in specified context.",
577 write_exp_elt_opcode (OP_VAR_VALUE);
578 write_exp_elt_sym (sym);
579 write_exp_elt_opcode (OP_VAR_VALUE); }
582 /* Base case for variables. */
584 { struct symbol *sym;
585 int is_a_field_of_this;
587 sym = lookup_symbol (copy_name ($1),
588 expression_context_block,
602 if (innermost_block == 0 ||
603 contained_in (block_found,
605 innermost_block = block_found;
612 case LOC_LABEL: /* maybe should go above? */
614 case LOC_CONST_BYTES:
615 /* These are listed so gcc -Wall will reveal
619 write_exp_elt_opcode (OP_VAR_VALUE);
620 write_exp_elt_sym (sym);
621 write_exp_elt_opcode (OP_VAR_VALUE);
625 struct minimal_symbol *msymbol;
626 register char *arg = copy_name ($1);
628 msymbol = lookup_minimal_symbol (arg,
629 (struct objfile *) NULL);
632 write_exp_elt_opcode (OP_LONG);
633 write_exp_elt_type (builtin_type_int);
634 write_exp_elt_longcst ((LONGEST) msymbol -> address);
635 write_exp_elt_opcode (OP_LONG);
636 write_exp_elt_opcode (UNOP_MEMVAL);
637 if (msymbol -> type == mst_data ||
638 msymbol -> type == mst_bss)
639 write_exp_elt_type (builtin_type_int);
640 else if (msymbol -> type == mst_text)
641 write_exp_elt_type (lookup_function_type (builtin_type_int));
643 write_exp_elt_type (builtin_type_char);
644 write_exp_elt_opcode (UNOP_MEMVAL);
646 else if (!have_full_symbols () && !have_partial_symbols ())
647 error ("No symbol table is loaded. Use the \"symbol-file\" command.");
649 error ("No symbol \"%s\" in current context.",
657 { $$ = lookup_typename (copy_name ($1),
658 expression_context_block, 0); }
669 return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
676 return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
680 /* Take care of parsing a number (anything that starts with a digit).
681 Set yylval and return the token type; update lexptr.
682 LEN is the number of characters in it. */
684 /*** Needs some error checking for the float case ***/
690 register char *p = lexptr;
691 register LONGEST n = 0;
692 register LONGEST prevn = 0;
693 register int c,i,ischar=0;
694 register int base = input_radix;
695 register int len = olen;
696 int unsigned_p = number_sign == 1 ? 1 : 0;
703 else if(p[len-1] == 'C' || p[len-1] == 'B')
706 ischar = p[len-1] == 'C';
710 /* Scan the number */
711 for (c = 0; c < len; c++)
713 if (p[c] == '.' && base == 10)
715 /* It's a float since it contains a point. */
716 yylval.dval = atof (p);
720 if (p[c] == '.' && base != 10)
721 error("Floating point numbers must be base 10.");
722 if (base == 10 && (p[c] < '0' || p[c] > '9'))
723 error("Invalid digit \'%c\' in number.",p[c]);
730 if( base == 8 && (c == '8' || c == '9'))
731 error("Invalid digit \'%c\' in octal number.",c);
732 if (c >= '0' && c <= '9')
736 if (base == 16 && c >= 'A' && c <= 'F')
744 if(!unsigned_p && number_sign == 1 && (prevn >= n))
745 unsigned_p=1; /* Try something unsigned */
746 /* Don't do the range check if n==i and i==0, since that special
747 case will give an overflow error. */
748 if(RANGE_CHECK && n!=i && i)
750 if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
751 ((!unsigned_p && number_sign==-1) && -prevn <= -n))
752 range_error("Overflow on numeric constant.");
758 if(*p == 'B' || *p == 'C' || *p == 'H')
759 lexptr++; /* Advance past B,C or H */
766 else if ( unsigned_p && number_sign == 1)
771 else if((unsigned_p && (n<0))) {
772 range_error("Overflow on numeric constant -- number too large.");
773 /* But, this can return if range_check == range_warn. */
788 { {'<', '>'}, NOTEQUAL },
789 { {':', '='}, ASSIGN },
792 { {':', ':'}, COLONCOLON },
796 /* Some specific keywords */
803 static struct keyword keytab[] =
806 {"IN", IN },/* Note space after IN */
825 {"FLOAT", FLOAT_FUNC },
830 /* Read one token, getting characters through lexptr. */
832 /* This is where we will check to make sure that the language and the operators used are
839 register int namelen;
841 register char *tokstart;
849 /* See if it is a special token of length 2 */
850 for( i = 0 ; i < sizeof tokentab2 / sizeof tokentab2[0] ; i++)
851 if(!strncmp(tokentab2[i].name, tokstart, 2))
854 return tokentab2[i].token;
857 switch (c = *tokstart)
874 if (paren_depth == 0)
881 if (comma_terminates && paren_depth == 0)
887 /* Might be a floating point number. */
888 if (lexptr[1] >= '0' && lexptr[1] <= '9')
889 break; /* Falls into number code. */
896 /* These are character tokens that appear as-is in the YACC grammar */
919 for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
922 c = tokstart[++namelen];
923 if (c >= '0' && c <= '9')
925 c = tokstart[++namelen];
926 if (c >= '0' && c <= '9')
927 c = tokstart[++namelen];
931 error("Unterminated string or character constant.");
932 yylval.sval.ptr = tokstart + 1;
933 yylval.sval.length = namelen - 1;
934 lexptr += namelen + 1;
936 if(namelen == 2) /* Single character */
938 yylval.ulval = tokstart[1];
945 /* Is it a number? */
946 /* Note: We have already dealt with the case of the token '.'.
947 See case '.' above. */
948 if ((c >= '0' && c <= '9'))
951 int got_dot = 0, got_e = 0;
952 register char *p = tokstart;
957 if (!got_e && (*p == 'e' || *p == 'E'))
959 else if (!got_dot && *p == '.')
961 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
962 && (*p == '-' || *p == '+'))
963 /* This is the sign of the exponent, not the end of the
966 else if ((*p < '0' || *p > '9') &&
967 (*p < 'A' || *p > 'F') &&
968 (*p != 'H')) /* Modula-2 hexadecimal number */
971 toktype = parse_number (p - tokstart);
972 if (toktype == ERROR)
974 char *err_copy = (char *) alloca (p - tokstart + 1);
976 bcopy (tokstart, err_copy, p - tokstart);
977 err_copy[p - tokstart] = 0;
978 error ("Invalid number \"%s\".", err_copy);
984 if (!(c == '_' || c == '$'
985 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
986 /* We must have come across a bad character (e.g. ';'). */
987 error ("Invalid character '%c' in expression.", c);
989 /* It's a name. See how long it is. */
991 for (c = tokstart[namelen];
992 (c == '_' || c == '$' || (c >= '0' && c <= '9')
993 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
994 c = tokstart[++namelen])
997 /* The token "if" terminates the expression and is NOT
998 removed from the input stream. */
999 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1006 /* Handle the tokens $digits; also $ (short for $0) and $$ (short for $$1)
1007 and $$digits (equivalent to $<-digits> if you could type that).
1008 Make token type LAST, and put the number (the digits) in yylval. */
1010 if (*tokstart == '$')
1012 register int negate = 0;
1014 /* Double dollar means negate the number and add -1 as well.
1015 Thus $$ alone means -1. */
1016 if (namelen >= 2 && tokstart[1] == '$')
1023 /* Just dollars (one or two) */
1024 yylval.lval = - negate;
1027 /* Is the rest of the token digits? */
1028 for (; c < namelen; c++)
1029 if (!(tokstart[c] >= '0' && tokstart[c] <= '9'))
1033 yylval.lval = atoi (tokstart + 1 + negate);
1035 yylval.lval = - yylval.lval;
1040 /* Handle tokens that refer to machine registers:
1041 $ followed by a register name. */
1043 if (*tokstart == '$') {
1044 for (c = 0; c < NUM_REGS; c++)
1045 if (namelen - 1 == strlen (reg_names[c])
1046 && !strncmp (tokstart + 1, reg_names[c], namelen - 1))
1051 for (c = 0; c < num_std_regs; c++)
1052 if (namelen - 1 == strlen (std_regs[c].name)
1053 && !strncmp (tokstart + 1, std_regs[c].name, namelen - 1))
1055 yylval.lval = std_regs[c].regnum;
1061 /* Lookup special keywords */
1062 for(i = 0 ; i < sizeof(keytab) / sizeof(keytab[0]) ; i++)
1063 if(namelen == strlen(keytab[i].keyw) && !strncmp(tokstart,keytab[i].keyw,namelen))
1064 return keytab[i].token;
1066 yylval.sval.ptr = tokstart;
1067 yylval.sval.length = namelen;
1069 /* Any other names starting in $ are debugger internal variables. */
1071 if (*tokstart == '$')
1073 yylval.ivar = (struct internalvar *) lookup_internalvar (copy_name (yylval.sval) + 1);
1074 return INTERNAL_VAR;
1078 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1079 functions. If this is not so, then ...
1080 Use token-type TYPENAME for symbols that happen to be defined
1081 currently as names of types; NAME for other symbols.
1082 The caller is not constrained to care about the distinction. */
1086 char *tmp = copy_name (yylval.sval);
1089 if (lookup_partial_symtab (tmp))
1091 sym = lookup_symbol (tmp, expression_context_block,
1092 VAR_NAMESPACE, 0, NULL);
1093 if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1095 if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
1110 case LOC_CONST_BYTES:
1120 error("internal: Undefined class in m2lex()");
1123 error("internal: Unforseen case in m2lex()");
1128 /* Built-in BOOLEAN type. This is sort of a hack. */
1129 if(!strncmp(tokstart,"TRUE",4))
1134 else if(!strncmp(tokstart,"FALSE",5))
1141 /* Must be another type of name... */
1148 make_qualname(mod,ident)
1151 char *new = xmalloc(strlen(mod)+strlen(ident)+2);
1162 char *msg; /* unused */
1164 printf("Parsing: %s\n",lexptr);
1166 error("Invalid syntax in expression near character '%c'.",yychar);
1168 error("Invalid syntax in expression");
1171 /* Table of operators and their precedences for printing expressions. */
1173 const static struct op_print m2_op_print_tab[] = {
1174 {"+", BINOP_ADD, PREC_ADD, 0},
1175 {"+", UNOP_PLUS, PREC_PREFIX, 0},
1176 {"-", BINOP_SUB, PREC_ADD, 0},
1177 {"-", UNOP_NEG, PREC_PREFIX, 0},
1178 {"*", BINOP_MUL, PREC_MUL, 0},
1179 {"/", BINOP_DIV, PREC_MUL, 0},
1180 {"DIV", BINOP_INTDIV, PREC_MUL, 0},
1181 {"MOD", BINOP_REM, PREC_MUL, 0},
1182 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
1183 {"OR", BINOP_OR, PREC_OR, 0},
1184 {"AND", BINOP_AND, PREC_AND, 0},
1185 {"NOT", UNOP_ZEROP, PREC_PREFIX, 0},
1186 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
1187 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
1188 {"<=", BINOP_LEQ, PREC_ORDER, 0},
1189 {">=", BINOP_GEQ, PREC_ORDER, 0},
1190 {">", BINOP_GTR, PREC_ORDER, 0},
1191 {"<", BINOP_LESS, PREC_ORDER, 0},
1192 {"^", UNOP_IND, PREC_PREFIX, 0},
1193 {"@", BINOP_REPEAT, PREC_REPEAT, 0},
1196 /* The built-in types of Modula-2. */
1198 struct type *builtin_type_m2_char;
1199 struct type *builtin_type_m2_int;
1200 struct type *builtin_type_m2_card;
1201 struct type *builtin_type_m2_real;
1202 struct type *builtin_type_m2_bool;
1204 struct type ** const (m2_builtin_types[]) =
1206 &builtin_type_m2_char,
1207 &builtin_type_m2_int,
1208 &builtin_type_m2_card,
1209 &builtin_type_m2_real,
1210 &builtin_type_m2_bool,
1214 const struct language_defn m2_language_defn = {
1220 m2_parse, /* parser */
1221 m2_error, /* parser error function */
1222 &builtin_type_m2_int, /* longest signed integral type */
1223 &builtin_type_m2_card, /* longest unsigned integral type */
1224 &builtin_type_m2_real, /* longest floating point type */
1225 "0%XH", "0%", "XH", /* Hex format string, prefix, suffix */
1226 "%oB", "%", "oB", /* Octal format string, prefix, suffix */
1227 m2_op_print_tab, /* expression operators for printing */
1231 /* Initialization for Modula-2 */
1234 _initialize_m2_exp ()
1236 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
1237 builtin_type_m2_int =
1238 init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
1240 "INTEGER", (struct objfile *) NULL);
1241 builtin_type_m2_card =
1242 init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
1244 "CARDINAL", (struct objfile *) NULL);
1245 builtin_type_m2_real =
1246 init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
1248 "REAL", (struct objfile *) NULL);
1249 builtin_type_m2_char =
1250 init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
1252 "CHAR", (struct objfile *) NULL);
1253 builtin_type_m2_bool =
1254 init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT,
1256 "BOOLEAN", (struct objfile *) NULL);
1258 TYPE_NFIELDS(builtin_type_m2_bool) = 2;
1259 TYPE_FIELDS(builtin_type_m2_bool) =
1260 (struct field *) malloc (sizeof (struct field) * 2);
1261 TYPE_FIELD_BITPOS(builtin_type_m2_bool,0) = 0;
1262 TYPE_FIELD_NAME(builtin_type_m2_bool,0) = (char *)malloc(6);
1263 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,0),"FALSE");
1264 TYPE_FIELD_BITPOS(builtin_type_m2_bool,1) = 1;
1265 TYPE_FIELD_NAME(builtin_type_m2_bool,1) = (char *)malloc(5);
1266 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,1),"TRUE");
1268 add_language (&m2_language_defn);