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"
43 /* Ensure that if the generated parser contains any calls to malloc/realloc,
44 that they get mapped to xmalloc/xrealloc. */
46 #define malloc xmalloc
47 #define realloc xrealloc
49 /* These MUST be included in any grammar file!!!!
50 Please choose unique names! */
51 #define yymaxdepth m2_maxdepth
52 #define yyparse m2_parse
54 #define yyerror m2_error
55 #define yylval m2_lval
56 #define yychar m2_char
57 #define yydebug m2_debug
58 #define yypact m2_pact
65 #define yyexca m2_exca
66 #define yyerrflag m2_errflag
67 #define yynerrs m2_nerrs
72 #define yystate m2_state
77 #define yylloc m2_lloc
80 make_qualname PARAMS ((char *, char *));
83 parse_number PARAMS ((int));
86 yylex PARAMS ((void));
89 yyerror PARAMS ((char *));
92 __yy_bcopy PARAMS ((char *, char *, int));
95 yyparse PARAMS ((void));
97 /* The sign of the number being parsed. */
100 /* The block that the module specified by the qualifer on an identifer is
102 struct block *modblock=0;
104 /* #define YYDEBUG 1 */
108 /* Although the yacc "value" of an expression is not used,
109 since the result is stored in the structure being created,
110 other node types do have values. */
115 unsigned LONGEST ulval;
122 enum exp_opcode opcode;
123 struct internalvar *ivar;
129 %type <voidval> exp type_exp start set
130 %type <voidval> variable
135 %token <lval> INT HEX ERROR
136 %token <ulval> UINT TRUE FALSE CHAR
139 /* Both NAME and TYPENAME tokens represent symbols in the input,
140 and both convey their data as strings.
141 But a TYPENAME is a string that happens to be defined as a typedef
142 or builtin type name (such as int or char)
143 and a NAME is any other symbol.
145 Contexts where this distinction is not important can use the
146 nonterminal "name", which matches either NAME or TYPENAME. */
149 %token <sval> NAME BLOCKNAME IDENT VARNAME
150 %token <sval> TYPENAME
152 %token SIZE CAP ORD HIGH ABS MIN_FUNC MAX_FUNC FLOAT_FUNC VAL CHR ODD TRUNC
153 %token INC DEC INCL EXCL
155 /* The GDB scope operator */
158 %token <lval> LAST REGNAME
160 %token <ivar> INTERNAL_VAR
166 %left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
171 %left '*' '/' DIV MOD
173 %right '^' DOT '[' '('
176 /* This is not an actual token ; it is used for precedence.
186 { write_exp_elt_opcode(OP_TYPE);
187 write_exp_elt_type($1);
188 write_exp_elt_opcode(OP_TYPE);
194 exp : exp '^' %prec UNARY
195 { write_exp_elt_opcode (UNOP_IND); }
198 { number_sign = -1; }
201 write_exp_elt_opcode (UNOP_NEG); }
204 exp : '+' exp %prec UNARY
205 { write_exp_elt_opcode(UNOP_PLUS); }
208 exp : not_exp exp %prec UNARY
209 { write_exp_elt_opcode (UNOP_ZEROP); }
216 exp : CAP '(' exp ')'
217 { write_exp_elt_opcode (UNOP_CAP); }
220 exp : ORD '(' exp ')'
221 { write_exp_elt_opcode (UNOP_ORD); }
224 exp : ABS '(' exp ')'
225 { write_exp_elt_opcode (UNOP_ABS); }
228 exp : HIGH '(' exp ')'
229 { write_exp_elt_opcode (UNOP_HIGH); }
232 exp : MIN_FUNC '(' type ')'
233 { write_exp_elt_opcode (UNOP_MIN);
234 write_exp_elt_type ($3);
235 write_exp_elt_opcode (UNOP_MIN); }
238 exp : MAX_FUNC '(' type ')'
239 { write_exp_elt_opcode (UNOP_MAX);
240 write_exp_elt_type ($3);
241 write_exp_elt_opcode (UNOP_MIN); }
244 exp : FLOAT_FUNC '(' exp ')'
245 { write_exp_elt_opcode (UNOP_FLOAT); }
248 exp : VAL '(' type ',' exp ')'
249 { write_exp_elt_opcode (BINOP_VAL);
250 write_exp_elt_type ($3);
251 write_exp_elt_opcode (BINOP_VAL); }
254 exp : CHR '(' exp ')'
255 { write_exp_elt_opcode (UNOP_CHR); }
258 exp : ODD '(' exp ')'
259 { write_exp_elt_opcode (UNOP_ODD); }
262 exp : TRUNC '(' exp ')'
263 { write_exp_elt_opcode (UNOP_TRUNC); }
266 exp : SIZE exp %prec UNARY
267 { write_exp_elt_opcode (UNOP_SIZEOF); }
271 exp : INC '(' exp ')'
272 { write_exp_elt_opcode(UNOP_PREINCREMENT); }
275 exp : INC '(' exp ',' exp ')'
276 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
277 write_exp_elt_opcode(BINOP_ADD);
278 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
281 exp : DEC '(' exp ')'
282 { write_exp_elt_opcode(UNOP_PREDECREMENT);}
285 exp : DEC '(' exp ',' exp ')'
286 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
287 write_exp_elt_opcode(BINOP_SUB);
288 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
292 { write_exp_elt_opcode (STRUCTOP_STRUCT);
293 write_exp_string ($3);
294 write_exp_elt_opcode (STRUCTOP_STRUCT); }
301 { error("Sets are not implemented.");}
304 exp : INCL '(' exp ',' exp ')'
305 { error("Sets are not implemented.");}
308 exp : EXCL '(' exp ',' exp ')'
309 { error("Sets are not implemented.");}
311 set : '{' arglist '}'
312 { error("Sets are not implemented.");}
313 | type '{' arglist '}'
314 { error("Sets are not implemented.");}
318 /* Modula-2 array subscript notation [a,b,c...] */
320 /* This function just saves the number of arguments
321 that follow in the list. It is *not* specific to
324 non_empty_arglist ']' %prec DOT
325 { write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT);
326 write_exp_elt_longcst ((LONGEST) end_arglist());
327 write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT); }
331 /* This is to save the value of arglist_len
332 being accumulated by an outer function call. */
333 { start_arglist (); }
334 arglist ')' %prec DOT
335 { write_exp_elt_opcode (OP_FUNCALL);
336 write_exp_elt_longcst ((LONGEST) end_arglist ());
337 write_exp_elt_opcode (OP_FUNCALL); }
347 arglist : arglist ',' exp %prec ABOVE_COMMA
357 : non_empty_arglist ',' exp %prec ABOVE_COMMA
362 exp : '{' type '}' exp %prec UNARY
363 { write_exp_elt_opcode (UNOP_MEMVAL);
364 write_exp_elt_type ($2);
365 write_exp_elt_opcode (UNOP_MEMVAL); }
368 exp : type '(' exp ')' %prec UNARY
369 { write_exp_elt_opcode (UNOP_CAST);
370 write_exp_elt_type ($1);
371 write_exp_elt_opcode (UNOP_CAST); }
378 /* Binary operators in order of decreasing precedence. Note that some
379 of these operators are overloaded! (ie. sets) */
383 { write_exp_elt_opcode (BINOP_REPEAT); }
387 { write_exp_elt_opcode (BINOP_MUL); }
391 { write_exp_elt_opcode (BINOP_DIV); }
395 { write_exp_elt_opcode (BINOP_INTDIV); }
399 { write_exp_elt_opcode (BINOP_REM); }
403 { write_exp_elt_opcode (BINOP_ADD); }
407 { write_exp_elt_opcode (BINOP_SUB); }
411 { write_exp_elt_opcode (BINOP_EQUAL); }
414 exp : exp NOTEQUAL exp
415 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
417 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
421 { write_exp_elt_opcode (BINOP_LEQ); }
425 { write_exp_elt_opcode (BINOP_GEQ); }
429 { write_exp_elt_opcode (BINOP_LESS); }
433 { write_exp_elt_opcode (BINOP_GTR); }
437 { write_exp_elt_opcode (BINOP_AND); }
441 { write_exp_elt_opcode (BINOP_AND); }
445 { write_exp_elt_opcode (BINOP_OR); }
449 { write_exp_elt_opcode (BINOP_ASSIGN); }
456 { write_exp_elt_opcode (OP_BOOL);
457 write_exp_elt_longcst ((LONGEST) $1);
458 write_exp_elt_opcode (OP_BOOL); }
462 { write_exp_elt_opcode (OP_BOOL);
463 write_exp_elt_longcst ((LONGEST) $1);
464 write_exp_elt_opcode (OP_BOOL); }
468 { write_exp_elt_opcode (OP_LONG);
469 write_exp_elt_type (builtin_type_m2_int);
470 write_exp_elt_longcst ((LONGEST) $1);
471 write_exp_elt_opcode (OP_LONG); }
476 write_exp_elt_opcode (OP_LONG);
477 write_exp_elt_type (builtin_type_m2_card);
478 write_exp_elt_longcst ((LONGEST) $1);
479 write_exp_elt_opcode (OP_LONG);
484 { write_exp_elt_opcode (OP_LONG);
485 write_exp_elt_type (builtin_type_m2_char);
486 write_exp_elt_longcst ((LONGEST) $1);
487 write_exp_elt_opcode (OP_LONG); }
492 { write_exp_elt_opcode (OP_DOUBLE);
493 write_exp_elt_type (builtin_type_m2_real);
494 write_exp_elt_dblcst ($1);
495 write_exp_elt_opcode (OP_DOUBLE); }
501 /* The GDB internal variable $$, et al. */
503 { write_exp_elt_opcode (OP_LAST);
504 write_exp_elt_longcst ((LONGEST) $1);
505 write_exp_elt_opcode (OP_LAST); }
509 { write_exp_elt_opcode (OP_REGISTER);
510 write_exp_elt_longcst ((LONGEST) $1);
511 write_exp_elt_opcode (OP_REGISTER); }
514 exp : SIZE '(' type ')' %prec UNARY
515 { write_exp_elt_opcode (OP_LONG);
516 write_exp_elt_type (builtin_type_int);
517 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
518 write_exp_elt_opcode (OP_LONG); }
522 { write_exp_elt_opcode (OP_M2_STRING);
523 write_exp_string ($1);
524 write_exp_elt_opcode (OP_M2_STRING); }
527 /* This will be used for extensions later. Like adding modules. */
529 { $$ = SYMBOL_BLOCK_VALUE($1); }
534 = lookup_symbol (copy_name ($1), expression_context_block,
535 VAR_NAMESPACE, 0, NULL);
540 /* GDB scope operator */
541 fblock : block COLONCOLON BLOCKNAME
543 = lookup_symbol (copy_name ($3), $1,
544 VAR_NAMESPACE, 0, NULL);
545 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
546 error ("No function \"%s\" in specified context.",
552 /* Useful for assigning to PROCEDURE variables */
554 { write_exp_elt_opcode(OP_VAR_VALUE);
555 write_exp_elt_sym ($1);
556 write_exp_elt_opcode (OP_VAR_VALUE); }
559 /* GDB internal ($foo) variable */
560 variable: INTERNAL_VAR
561 { write_exp_elt_opcode (OP_INTERNALVAR);
562 write_exp_elt_intern ($1);
563 write_exp_elt_opcode (OP_INTERNALVAR); }
566 /* GDB scope operator */
567 variable: block COLONCOLON NAME
568 { struct symbol *sym;
569 sym = lookup_symbol (copy_name ($3), $1,
570 VAR_NAMESPACE, 0, NULL);
572 error ("No symbol \"%s\" in specified context.",
575 write_exp_elt_opcode (OP_VAR_VALUE);
576 write_exp_elt_sym (sym);
577 write_exp_elt_opcode (OP_VAR_VALUE); }
580 /* Base case for variables. */
582 { struct symbol *sym;
583 int is_a_field_of_this;
585 sym = lookup_symbol (copy_name ($1),
586 expression_context_block,
600 if (innermost_block == 0 ||
601 contained_in (block_found,
603 innermost_block = block_found;
610 case LOC_LABEL: /* maybe should go above? */
612 case LOC_CONST_BYTES:
613 /* These are listed so gcc -Wall will reveal
617 write_exp_elt_opcode (OP_VAR_VALUE);
618 write_exp_elt_sym (sym);
619 write_exp_elt_opcode (OP_VAR_VALUE);
623 struct minimal_symbol *msymbol;
624 register char *arg = copy_name ($1);
626 msymbol = lookup_minimal_symbol (arg,
627 (struct objfile *) NULL);
630 write_exp_elt_opcode (OP_LONG);
631 write_exp_elt_type (builtin_type_int);
632 write_exp_elt_longcst ((LONGEST) msymbol -> address);
633 write_exp_elt_opcode (OP_LONG);
634 write_exp_elt_opcode (UNOP_MEMVAL);
635 if (msymbol -> type == mst_data ||
636 msymbol -> type == mst_bss)
637 write_exp_elt_type (builtin_type_int);
638 else if (msymbol -> type == mst_text)
639 write_exp_elt_type (lookup_function_type (builtin_type_int));
641 write_exp_elt_type (builtin_type_char);
642 write_exp_elt_opcode (UNOP_MEMVAL);
644 else if (!have_full_symbols () && !have_partial_symbols ())
645 error ("No symbol table is loaded. Use the \"symbol-file\" command.");
647 error ("No symbol \"%s\" in current context.",
655 { $$ = lookup_typename (copy_name ($1),
656 expression_context_block, 0); }
667 return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
674 return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
678 /* Take care of parsing a number (anything that starts with a digit).
679 Set yylval and return the token type; update lexptr.
680 LEN is the number of characters in it. */
682 /*** Needs some error checking for the float case ***/
688 register char *p = lexptr;
689 register LONGEST n = 0;
690 register LONGEST prevn = 0;
691 register int c,i,ischar=0;
692 register int base = input_radix;
693 register int len = olen;
694 int unsigned_p = number_sign == 1 ? 1 : 0;
701 else if(p[len-1] == 'C' || p[len-1] == 'B')
704 ischar = p[len-1] == 'C';
708 /* Scan the number */
709 for (c = 0; c < len; c++)
711 if (p[c] == '.' && base == 10)
713 /* It's a float since it contains a point. */
714 yylval.dval = atof (p);
718 if (p[c] == '.' && base != 10)
719 error("Floating point numbers must be base 10.");
720 if (base == 10 && (p[c] < '0' || p[c] > '9'))
721 error("Invalid digit \'%c\' in number.",p[c]);
728 if( base == 8 && (c == '8' || c == '9'))
729 error("Invalid digit \'%c\' in octal number.",c);
730 if (c >= '0' && c <= '9')
734 if (base == 16 && c >= 'A' && c <= 'F')
742 if(!unsigned_p && number_sign == 1 && (prevn >= n))
743 unsigned_p=1; /* Try something unsigned */
744 /* Don't do the range check if n==i and i==0, since that special
745 case will give an overflow error. */
746 if(RANGE_CHECK && n!=i && i)
748 if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
749 ((!unsigned_p && number_sign==-1) && -prevn <= -n))
750 range_error("Overflow on numeric constant.");
756 if(*p == 'B' || *p == 'C' || *p == 'H')
757 lexptr++; /* Advance past B,C or H */
764 else if ( unsigned_p && number_sign == 1)
769 else if((unsigned_p && (n<0))) {
770 range_error("Overflow on numeric constant -- number too large.");
771 /* But, this can return if range_check == range_warn. */
794 /* Some specific keywords */
801 static struct keyword keytab[] =
804 {"IN", IN },/* Note space after IN */
823 {"FLOAT", FLOAT_FUNC },
828 /* Read one token, getting characters through lexptr. */
830 /* This is where we will check to make sure that the language and the operators used are
837 register int namelen;
839 register char *tokstart;
847 /* See if it is a special token of length 2 */
848 for( i = 0 ; i < sizeof tokentab2 / sizeof tokentab2[0] ; i++)
849 if(!strncmp(tokentab2[i].name, tokstart, 2))
852 return tokentab2[i].token;
855 switch (c = *tokstart)
872 if (paren_depth == 0)
879 if (comma_terminates && paren_depth == 0)
885 /* Might be a floating point number. */
886 if (lexptr[1] >= '0' && lexptr[1] <= '9')
887 break; /* Falls into number code. */
894 /* These are character tokens that appear as-is in the YACC grammar */
917 for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
920 c = tokstart[++namelen];
921 if (c >= '0' && c <= '9')
923 c = tokstart[++namelen];
924 if (c >= '0' && c <= '9')
925 c = tokstart[++namelen];
929 error("Unterminated string or character constant.");
930 yylval.sval.ptr = tokstart + 1;
931 yylval.sval.length = namelen - 1;
932 lexptr += namelen + 1;
934 if(namelen == 2) /* Single character */
936 yylval.ulval = tokstart[1];
943 /* Is it a number? */
944 /* Note: We have already dealt with the case of the token '.'.
945 See case '.' above. */
946 if ((c >= '0' && c <= '9'))
949 int got_dot = 0, got_e = 0;
950 register char *p = tokstart;
955 if (!got_e && (*p == 'e' || *p == 'E'))
957 else if (!got_dot && *p == '.')
959 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
960 && (*p == '-' || *p == '+'))
961 /* This is the sign of the exponent, not the end of the
964 else if ((*p < '0' || *p > '9') &&
965 (*p < 'A' || *p > 'F') &&
966 (*p != 'H')) /* Modula-2 hexadecimal number */
969 toktype = parse_number (p - tokstart);
970 if (toktype == ERROR)
972 char *err_copy = (char *) alloca (p - tokstart + 1);
974 bcopy (tokstart, err_copy, p - tokstart);
975 err_copy[p - tokstart] = 0;
976 error ("Invalid number \"%s\".", err_copy);
982 if (!(c == '_' || c == '$'
983 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
984 /* We must have come across a bad character (e.g. ';'). */
985 error ("Invalid character '%c' in expression.", c);
987 /* It's a name. See how long it is. */
989 for (c = tokstart[namelen];
990 (c == '_' || c == '$' || (c >= '0' && c <= '9')
991 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
992 c = tokstart[++namelen])
995 /* The token "if" terminates the expression and is NOT
996 removed from the input stream. */
997 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1004 /* Handle the tokens $digits; also $ (short for $0) and $$ (short for $$1)
1005 and $$digits (equivalent to $<-digits> if you could type that).
1006 Make token type LAST, and put the number (the digits) in yylval. */
1008 if (*tokstart == '$')
1010 register int negate = 0;
1012 /* Double dollar means negate the number and add -1 as well.
1013 Thus $$ alone means -1. */
1014 if (namelen >= 2 && tokstart[1] == '$')
1021 /* Just dollars (one or two) */
1022 yylval.lval = - negate;
1025 /* Is the rest of the token digits? */
1026 for (; c < namelen; c++)
1027 if (!(tokstart[c] >= '0' && tokstart[c] <= '9'))
1031 yylval.lval = atoi (tokstart + 1 + negate);
1033 yylval.lval = - yylval.lval;
1038 /* Handle tokens that refer to machine registers:
1039 $ followed by a register name. */
1041 if (*tokstart == '$') {
1042 for (c = 0; c < NUM_REGS; c++)
1043 if (namelen - 1 == strlen (reg_names[c])
1044 && !strncmp (tokstart + 1, reg_names[c], namelen - 1))
1049 for (c = 0; c < num_std_regs; c++)
1050 if (namelen - 1 == strlen (std_regs[c].name)
1051 && !strncmp (tokstart + 1, std_regs[c].name, namelen - 1))
1053 yylval.lval = std_regs[c].regnum;
1059 /* Lookup special keywords */
1060 for(i = 0 ; i < sizeof(keytab) / sizeof(keytab[0]) ; i++)
1061 if(namelen == strlen(keytab[i].keyw) && !strncmp(tokstart,keytab[i].keyw,namelen))
1062 return keytab[i].token;
1064 yylval.sval.ptr = tokstart;
1065 yylval.sval.length = namelen;
1067 /* Any other names starting in $ are debugger internal variables. */
1069 if (*tokstart == '$')
1071 yylval.ivar = (struct internalvar *) lookup_internalvar (copy_name (yylval.sval) + 1);
1072 return INTERNAL_VAR;
1076 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1077 functions. If this is not so, then ...
1078 Use token-type TYPENAME for symbols that happen to be defined
1079 currently as names of types; NAME for other symbols.
1080 The caller is not constrained to care about the distinction. */
1084 char *tmp = copy_name (yylval.sval);
1087 if (lookup_partial_symtab (tmp))
1089 sym = lookup_symbol (tmp, expression_context_block,
1090 VAR_NAMESPACE, 0, NULL);
1091 if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1093 if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
1108 case LOC_CONST_BYTES:
1118 error("internal: Undefined class in m2lex()");
1121 error("internal: Unforseen case in m2lex()");
1126 /* Built-in BOOLEAN type. This is sort of a hack. */
1127 if(!strncmp(tokstart,"TRUE",4))
1132 else if(!strncmp(tokstart,"FALSE",5))
1139 /* Must be another type of name... */
1145 make_qualname(mod,ident)
1148 char *new = xmalloc(strlen(mod)+strlen(ident)+2);
1159 char *msg; /* unused */
1161 printf("Parsing: %s\n",lexptr);
1163 error("Invalid syntax in expression near character '%c'.",yychar);
1165 error("Invalid syntax in expression");
1168 /* Table of operators and their precedences for printing expressions. */
1170 const static struct op_print m2_op_print_tab[] = {
1171 {"+", BINOP_ADD, PREC_ADD, 0},
1172 {"+", UNOP_PLUS, PREC_PREFIX, 0},
1173 {"-", BINOP_SUB, PREC_ADD, 0},
1174 {"-", UNOP_NEG, PREC_PREFIX, 0},
1175 {"*", BINOP_MUL, PREC_MUL, 0},
1176 {"/", BINOP_DIV, PREC_MUL, 0},
1177 {"DIV", BINOP_INTDIV, PREC_MUL, 0},
1178 {"MOD", BINOP_REM, PREC_MUL, 0},
1179 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
1180 {"OR", BINOP_OR, PREC_OR, 0},
1181 {"AND", BINOP_AND, PREC_AND, 0},
1182 {"NOT", UNOP_ZEROP, PREC_PREFIX, 0},
1183 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
1184 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
1185 {"<=", BINOP_LEQ, PREC_ORDER, 0},
1186 {">=", BINOP_GEQ, PREC_ORDER, 0},
1187 {">", BINOP_GTR, PREC_ORDER, 0},
1188 {"<", BINOP_LESS, PREC_ORDER, 0},
1189 {"^", UNOP_IND, PREC_PREFIX, 0},
1190 {"@", BINOP_REPEAT, PREC_REPEAT, 0},
1193 /* The built-in types of Modula-2. */
1195 struct type *builtin_type_m2_char;
1196 struct type *builtin_type_m2_int;
1197 struct type *builtin_type_m2_card;
1198 struct type *builtin_type_m2_real;
1199 struct type *builtin_type_m2_bool;
1201 struct type ** const (m2_builtin_types[]) =
1203 &builtin_type_m2_char,
1204 &builtin_type_m2_int,
1205 &builtin_type_m2_card,
1206 &builtin_type_m2_real,
1207 &builtin_type_m2_bool,
1211 const struct language_defn m2_language_defn = {
1217 m2_parse, /* parser */
1218 m2_error, /* parser error function */
1219 &builtin_type_m2_int, /* longest signed integral type */
1220 &builtin_type_m2_card, /* longest unsigned integral type */
1221 &builtin_type_m2_real, /* longest floating point type */
1222 "0%XH", "0%", "XH", /* Hex format string, prefix, suffix */
1223 "%oB", "%", "oB", /* Octal format string, prefix, suffix */
1224 m2_op_print_tab, /* expression operators for printing */
1228 /* Initialization for Modula-2 */
1231 _initialize_m2_exp ()
1233 /* FIXME: The code below assumes that the sizes of the basic data
1234 types are the same on the host and target machines!!! */
1236 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
1237 builtin_type_m2_int =
1238 init_type (TYPE_CODE_INT, sizeof(int), 0,
1239 "INTEGER", (struct objfile *) NULL);
1240 builtin_type_m2_card =
1241 init_type (TYPE_CODE_INT, sizeof(int), TYPE_FLAG_UNSIGNED,
1242 "CARDINAL", (struct objfile *) NULL);
1243 builtin_type_m2_real =
1244 init_type (TYPE_CODE_FLT, sizeof(float), 0,
1245 "REAL", (struct objfile *) NULL);
1246 builtin_type_m2_char =
1247 init_type (TYPE_CODE_CHAR, sizeof(char), TYPE_FLAG_UNSIGNED,
1248 "CHAR", (struct objfile *) NULL);
1249 builtin_type_m2_bool =
1250 init_type (TYPE_CODE_BOOL, sizeof(int), TYPE_FLAG_UNSIGNED,
1251 "BOOLEAN", (struct objfile *) NULL);
1253 TYPE_NFIELDS(builtin_type_m2_bool) = 2;
1254 TYPE_FIELDS(builtin_type_m2_bool) =
1255 (struct field *) malloc (sizeof (struct field) * 2);
1256 TYPE_FIELD_BITPOS(builtin_type_m2_bool,0) = 0;
1257 TYPE_FIELD_NAME(builtin_type_m2_bool,0) = (char *)malloc(6);
1258 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,0),"FALSE");
1259 TYPE_FIELD_BITPOS(builtin_type_m2_bool,1) = 1;
1260 TYPE_FIELD_NAME(builtin_type_m2_bool,1) = (char *)malloc(5);
1261 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,1),"TRUE");
1263 add_language (&m2_language_defn);