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
81 make_qualname PARAMS ((char *, char *));
85 parse_number PARAMS ((int));
88 yylex PARAMS ((void));
91 yyerror PARAMS ((char *));
94 yyparse PARAMS ((void));
96 /* The sign of the number being parsed. */
99 /* The block that the module specified by the qualifer on an identifer is
101 struct block *modblock=0;
103 /* #define YYDEBUG 1 */
107 /* Although the yacc "value" of an expression is not used,
108 since the result is stored in the structure being created,
109 other node types do have values. */
114 unsigned LONGEST ulval;
121 enum exp_opcode opcode;
122 struct internalvar *ivar;
128 %type <voidval> exp type_exp start set
129 %type <voidval> variable
134 %token <lval> INT HEX ERROR
135 %token <ulval> UINT TRUE FALSE CHAR
138 /* Both NAME and TYPENAME tokens represent symbols in the input,
139 and both convey their data as strings.
140 But a TYPENAME is a string that happens to be defined as a typedef
141 or builtin type name (such as int or char)
142 and a NAME is any other symbol.
144 Contexts where this distinction is not important can use the
145 nonterminal "name", which matches either NAME or TYPENAME. */
148 %token <sval> NAME BLOCKNAME IDENT VARNAME
149 %token <sval> TYPENAME
151 %token SIZE CAP ORD HIGH ABS MIN_FUNC MAX_FUNC FLOAT_FUNC VAL CHR ODD TRUNC
152 %token INC DEC INCL EXCL
154 /* The GDB scope operator */
157 %token <lval> LAST REGNAME
159 %token <ivar> INTERNAL_VAR
165 %left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
170 %left '*' '/' DIV MOD
172 %right '^' DOT '[' '('
175 /* This is not an actual token ; it is used for precedence.
185 { write_exp_elt_opcode(OP_TYPE);
186 write_exp_elt_type($1);
187 write_exp_elt_opcode(OP_TYPE);
193 exp : exp '^' %prec UNARY
194 { write_exp_elt_opcode (UNOP_IND); }
197 { number_sign = -1; }
200 write_exp_elt_opcode (UNOP_NEG); }
203 exp : '+' exp %prec UNARY
204 { write_exp_elt_opcode(UNOP_PLUS); }
207 exp : not_exp exp %prec UNARY
208 { write_exp_elt_opcode (UNOP_ZEROP); }
215 exp : CAP '(' exp ')'
216 { write_exp_elt_opcode (UNOP_CAP); }
219 exp : ORD '(' exp ')'
220 { write_exp_elt_opcode (UNOP_ORD); }
223 exp : ABS '(' exp ')'
224 { write_exp_elt_opcode (UNOP_ABS); }
227 exp : HIGH '(' exp ')'
228 { write_exp_elt_opcode (UNOP_HIGH); }
231 exp : MIN_FUNC '(' type ')'
232 { write_exp_elt_opcode (UNOP_MIN);
233 write_exp_elt_type ($3);
234 write_exp_elt_opcode (UNOP_MIN); }
237 exp : MAX_FUNC '(' type ')'
238 { write_exp_elt_opcode (UNOP_MAX);
239 write_exp_elt_type ($3);
240 write_exp_elt_opcode (UNOP_MIN); }
243 exp : FLOAT_FUNC '(' exp ')'
244 { write_exp_elt_opcode (UNOP_FLOAT); }
247 exp : VAL '(' type ',' exp ')'
248 { write_exp_elt_opcode (BINOP_VAL);
249 write_exp_elt_type ($3);
250 write_exp_elt_opcode (BINOP_VAL); }
253 exp : CHR '(' exp ')'
254 { write_exp_elt_opcode (UNOP_CHR); }
257 exp : ODD '(' exp ')'
258 { write_exp_elt_opcode (UNOP_ODD); }
261 exp : TRUNC '(' exp ')'
262 { write_exp_elt_opcode (UNOP_TRUNC); }
265 exp : SIZE exp %prec UNARY
266 { write_exp_elt_opcode (UNOP_SIZEOF); }
270 exp : INC '(' exp ')'
271 { write_exp_elt_opcode(UNOP_PREINCREMENT); }
274 exp : INC '(' exp ',' exp ')'
275 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
276 write_exp_elt_opcode(BINOP_ADD);
277 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
280 exp : DEC '(' exp ')'
281 { write_exp_elt_opcode(UNOP_PREDECREMENT);}
284 exp : DEC '(' exp ',' exp ')'
285 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
286 write_exp_elt_opcode(BINOP_SUB);
287 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
291 { write_exp_elt_opcode (STRUCTOP_STRUCT);
292 write_exp_string ($3);
293 write_exp_elt_opcode (STRUCTOP_STRUCT); }
300 { error("Sets are not implemented.");}
303 exp : INCL '(' exp ',' exp ')'
304 { error("Sets are not implemented.");}
307 exp : EXCL '(' exp ',' exp ')'
308 { error("Sets are not implemented.");}
310 set : '{' arglist '}'
311 { error("Sets are not implemented.");}
312 | type '{' arglist '}'
313 { error("Sets are not implemented.");}
317 /* Modula-2 array subscript notation [a,b,c...] */
319 /* This function just saves the number of arguments
320 that follow in the list. It is *not* specific to
323 non_empty_arglist ']' %prec DOT
324 { write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT);
325 write_exp_elt_longcst ((LONGEST) end_arglist());
326 write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT); }
330 /* This is to save the value of arglist_len
331 being accumulated by an outer function call. */
332 { start_arglist (); }
333 arglist ')' %prec DOT
334 { write_exp_elt_opcode (OP_FUNCALL);
335 write_exp_elt_longcst ((LONGEST) end_arglist ());
336 write_exp_elt_opcode (OP_FUNCALL); }
346 arglist : arglist ',' exp %prec ABOVE_COMMA
356 : non_empty_arglist ',' exp %prec ABOVE_COMMA
361 exp : '{' type '}' exp %prec UNARY
362 { write_exp_elt_opcode (UNOP_MEMVAL);
363 write_exp_elt_type ($2);
364 write_exp_elt_opcode (UNOP_MEMVAL); }
367 exp : type '(' exp ')' %prec UNARY
368 { write_exp_elt_opcode (UNOP_CAST);
369 write_exp_elt_type ($1);
370 write_exp_elt_opcode (UNOP_CAST); }
377 /* Binary operators in order of decreasing precedence. Note that some
378 of these operators are overloaded! (ie. sets) */
382 { write_exp_elt_opcode (BINOP_REPEAT); }
386 { write_exp_elt_opcode (BINOP_MUL); }
390 { write_exp_elt_opcode (BINOP_DIV); }
394 { write_exp_elt_opcode (BINOP_INTDIV); }
398 { write_exp_elt_opcode (BINOP_REM); }
402 { write_exp_elt_opcode (BINOP_ADD); }
406 { write_exp_elt_opcode (BINOP_SUB); }
410 { write_exp_elt_opcode (BINOP_EQUAL); }
413 exp : exp NOTEQUAL exp
414 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
416 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
420 { write_exp_elt_opcode (BINOP_LEQ); }
424 { write_exp_elt_opcode (BINOP_GEQ); }
428 { write_exp_elt_opcode (BINOP_LESS); }
432 { write_exp_elt_opcode (BINOP_GTR); }
436 { write_exp_elt_opcode (BINOP_AND); }
440 { write_exp_elt_opcode (BINOP_AND); }
444 { write_exp_elt_opcode (BINOP_OR); }
448 { write_exp_elt_opcode (BINOP_ASSIGN); }
455 { write_exp_elt_opcode (OP_BOOL);
456 write_exp_elt_longcst ((LONGEST) $1);
457 write_exp_elt_opcode (OP_BOOL); }
461 { write_exp_elt_opcode (OP_BOOL);
462 write_exp_elt_longcst ((LONGEST) $1);
463 write_exp_elt_opcode (OP_BOOL); }
467 { write_exp_elt_opcode (OP_LONG);
468 write_exp_elt_type (builtin_type_m2_int);
469 write_exp_elt_longcst ((LONGEST) $1);
470 write_exp_elt_opcode (OP_LONG); }
475 write_exp_elt_opcode (OP_LONG);
476 write_exp_elt_type (builtin_type_m2_card);
477 write_exp_elt_longcst ((LONGEST) $1);
478 write_exp_elt_opcode (OP_LONG);
483 { write_exp_elt_opcode (OP_LONG);
484 write_exp_elt_type (builtin_type_m2_char);
485 write_exp_elt_longcst ((LONGEST) $1);
486 write_exp_elt_opcode (OP_LONG); }
491 { write_exp_elt_opcode (OP_DOUBLE);
492 write_exp_elt_type (builtin_type_m2_real);
493 write_exp_elt_dblcst ($1);
494 write_exp_elt_opcode (OP_DOUBLE); }
500 /* The GDB internal variable $$, et al. */
502 { write_exp_elt_opcode (OP_LAST);
503 write_exp_elt_longcst ((LONGEST) $1);
504 write_exp_elt_opcode (OP_LAST); }
508 { write_exp_elt_opcode (OP_REGISTER);
509 write_exp_elt_longcst ((LONGEST) $1);
510 write_exp_elt_opcode (OP_REGISTER); }
513 exp : SIZE '(' type ')' %prec UNARY
514 { write_exp_elt_opcode (OP_LONG);
515 write_exp_elt_type (builtin_type_int);
516 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
517 write_exp_elt_opcode (OP_LONG); }
521 { write_exp_elt_opcode (OP_M2_STRING);
522 write_exp_string ($1);
523 write_exp_elt_opcode (OP_M2_STRING); }
526 /* This will be used for extensions later. Like adding modules. */
528 { $$ = SYMBOL_BLOCK_VALUE($1); }
533 = lookup_symbol (copy_name ($1), expression_context_block,
534 VAR_NAMESPACE, 0, NULL);
539 /* GDB scope operator */
540 fblock : block COLONCOLON BLOCKNAME
542 = lookup_symbol (copy_name ($3), $1,
543 VAR_NAMESPACE, 0, NULL);
544 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
545 error ("No function \"%s\" in specified context.",
551 /* Useful for assigning to PROCEDURE variables */
553 { write_exp_elt_opcode(OP_VAR_VALUE);
554 write_exp_elt_sym ($1);
555 write_exp_elt_opcode (OP_VAR_VALUE); }
558 /* GDB internal ($foo) variable */
559 variable: INTERNAL_VAR
560 { write_exp_elt_opcode (OP_INTERNALVAR);
561 write_exp_elt_intern ($1);
562 write_exp_elt_opcode (OP_INTERNALVAR); }
565 /* GDB scope operator */
566 variable: block COLONCOLON NAME
567 { struct symbol *sym;
568 sym = lookup_symbol (copy_name ($3), $1,
569 VAR_NAMESPACE, 0, NULL);
571 error ("No symbol \"%s\" in specified context.",
574 write_exp_elt_opcode (OP_VAR_VALUE);
575 write_exp_elt_sym (sym);
576 write_exp_elt_opcode (OP_VAR_VALUE); }
579 /* Base case for variables. */
581 { struct symbol *sym;
582 int is_a_field_of_this;
584 sym = lookup_symbol (copy_name ($1),
585 expression_context_block,
599 if (innermost_block == 0 ||
600 contained_in (block_found,
602 innermost_block = block_found;
609 case LOC_LABEL: /* maybe should go above? */
611 case LOC_CONST_BYTES:
612 /* These are listed so gcc -Wall will reveal
616 write_exp_elt_opcode (OP_VAR_VALUE);
617 write_exp_elt_sym (sym);
618 write_exp_elt_opcode (OP_VAR_VALUE);
622 struct minimal_symbol *msymbol;
623 register char *arg = copy_name ($1);
625 msymbol = lookup_minimal_symbol (arg,
626 (struct objfile *) NULL);
629 write_exp_elt_opcode (OP_LONG);
630 write_exp_elt_type (builtin_type_int);
631 write_exp_elt_longcst ((LONGEST) msymbol -> address);
632 write_exp_elt_opcode (OP_LONG);
633 write_exp_elt_opcode (UNOP_MEMVAL);
634 if (msymbol -> type == mst_data ||
635 msymbol -> type == mst_bss)
636 write_exp_elt_type (builtin_type_int);
637 else if (msymbol -> type == mst_text)
638 write_exp_elt_type (lookup_function_type (builtin_type_int));
640 write_exp_elt_type (builtin_type_char);
641 write_exp_elt_opcode (UNOP_MEMVAL);
643 else if (!have_full_symbols () && !have_partial_symbols ())
644 error ("No symbol table is loaded. Use the \"symbol-file\" command.");
646 error ("No symbol \"%s\" in current context.",
654 { $$ = lookup_typename (copy_name ($1),
655 expression_context_block, 0); }
666 return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
673 return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
677 /* Take care of parsing a number (anything that starts with a digit).
678 Set yylval and return the token type; update lexptr.
679 LEN is the number of characters in it. */
681 /*** Needs some error checking for the float case ***/
687 register char *p = lexptr;
688 register LONGEST n = 0;
689 register LONGEST prevn = 0;
690 register int c,i,ischar=0;
691 register int base = input_radix;
692 register int len = olen;
693 int unsigned_p = number_sign == 1 ? 1 : 0;
700 else if(p[len-1] == 'C' || p[len-1] == 'B')
703 ischar = p[len-1] == 'C';
707 /* Scan the number */
708 for (c = 0; c < len; c++)
710 if (p[c] == '.' && base == 10)
712 /* It's a float since it contains a point. */
713 yylval.dval = atof (p);
717 if (p[c] == '.' && base != 10)
718 error("Floating point numbers must be base 10.");
719 if (base == 10 && (p[c] < '0' || p[c] > '9'))
720 error("Invalid digit \'%c\' in number.",p[c]);
727 if( base == 8 && (c == '8' || c == '9'))
728 error("Invalid digit \'%c\' in octal number.",c);
729 if (c >= '0' && c <= '9')
733 if (base == 16 && c >= 'A' && c <= 'F')
741 if(!unsigned_p && number_sign == 1 && (prevn >= n))
742 unsigned_p=1; /* Try something unsigned */
743 /* Don't do the range check if n==i and i==0, since that special
744 case will give an overflow error. */
745 if(RANGE_CHECK && n!=i && i)
747 if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
748 ((!unsigned_p && number_sign==-1) && -prevn <= -n))
749 range_error("Overflow on numeric constant.");
755 if(*p == 'B' || *p == 'C' || *p == 'H')
756 lexptr++; /* Advance past B,C or H */
763 else if ( unsigned_p && number_sign == 1)
768 else if((unsigned_p && (n<0))) {
769 range_error("Overflow on numeric constant -- number too large.");
770 /* But, this can return if range_check == range_warn. */
793 /* Some specific keywords */
800 static struct keyword keytab[] =
803 {"IN", IN },/* Note space after IN */
822 {"FLOAT", FLOAT_FUNC },
827 /* Read one token, getting characters through lexptr. */
829 /* This is where we will check to make sure that the language and the operators used are
836 register int namelen;
838 register char *tokstart;
846 /* See if it is a special token of length 2 */
847 for( i = 0 ; i < sizeof tokentab2 / sizeof tokentab2[0] ; i++)
848 if(!strncmp(tokentab2[i].name, tokstart, 2))
851 return tokentab2[i].token;
854 switch (c = *tokstart)
871 if (paren_depth == 0)
878 if (comma_terminates && paren_depth == 0)
884 /* Might be a floating point number. */
885 if (lexptr[1] >= '0' && lexptr[1] <= '9')
886 break; /* Falls into number code. */
893 /* These are character tokens that appear as-is in the YACC grammar */
916 for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
919 c = tokstart[++namelen];
920 if (c >= '0' && c <= '9')
922 c = tokstart[++namelen];
923 if (c >= '0' && c <= '9')
924 c = tokstart[++namelen];
928 error("Unterminated string or character constant.");
929 yylval.sval.ptr = tokstart + 1;
930 yylval.sval.length = namelen - 1;
931 lexptr += namelen + 1;
933 if(namelen == 2) /* Single character */
935 yylval.ulval = tokstart[1];
942 /* Is it a number? */
943 /* Note: We have already dealt with the case of the token '.'.
944 See case '.' above. */
945 if ((c >= '0' && c <= '9'))
948 int got_dot = 0, got_e = 0;
949 register char *p = tokstart;
954 if (!got_e && (*p == 'e' || *p == 'E'))
956 else if (!got_dot && *p == '.')
958 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
959 && (*p == '-' || *p == '+'))
960 /* This is the sign of the exponent, not the end of the
963 else if ((*p < '0' || *p > '9') &&
964 (*p < 'A' || *p > 'F') &&
965 (*p != 'H')) /* Modula-2 hexadecimal number */
968 toktype = parse_number (p - tokstart);
969 if (toktype == ERROR)
971 char *err_copy = (char *) alloca (p - tokstart + 1);
973 bcopy (tokstart, err_copy, p - tokstart);
974 err_copy[p - tokstart] = 0;
975 error ("Invalid number \"%s\".", err_copy);
981 if (!(c == '_' || c == '$'
982 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
983 /* We must have come across a bad character (e.g. ';'). */
984 error ("Invalid character '%c' in expression.", c);
986 /* It's a name. See how long it is. */
988 for (c = tokstart[namelen];
989 (c == '_' || c == '$' || (c >= '0' && c <= '9')
990 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
991 c = tokstart[++namelen])
994 /* The token "if" terminates the expression and is NOT
995 removed from the input stream. */
996 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1003 /* Handle the tokens $digits; also $ (short for $0) and $$ (short for $$1)
1004 and $$digits (equivalent to $<-digits> if you could type that).
1005 Make token type LAST, and put the number (the digits) in yylval. */
1007 if (*tokstart == '$')
1009 register int negate = 0;
1011 /* Double dollar means negate the number and add -1 as well.
1012 Thus $$ alone means -1. */
1013 if (namelen >= 2 && tokstart[1] == '$')
1020 /* Just dollars (one or two) */
1021 yylval.lval = - negate;
1024 /* Is the rest of the token digits? */
1025 for (; c < namelen; c++)
1026 if (!(tokstart[c] >= '0' && tokstart[c] <= '9'))
1030 yylval.lval = atoi (tokstart + 1 + negate);
1032 yylval.lval = - yylval.lval;
1037 /* Handle tokens that refer to machine registers:
1038 $ followed by a register name. */
1040 if (*tokstart == '$') {
1041 for (c = 0; c < NUM_REGS; c++)
1042 if (namelen - 1 == strlen (reg_names[c])
1043 && !strncmp (tokstart + 1, reg_names[c], namelen - 1))
1048 for (c = 0; c < num_std_regs; c++)
1049 if (namelen - 1 == strlen (std_regs[c].name)
1050 && !strncmp (tokstart + 1, std_regs[c].name, namelen - 1))
1052 yylval.lval = std_regs[c].regnum;
1058 /* Lookup special keywords */
1059 for(i = 0 ; i < sizeof(keytab) / sizeof(keytab[0]) ; i++)
1060 if(namelen == strlen(keytab[i].keyw) && !strncmp(tokstart,keytab[i].keyw,namelen))
1061 return keytab[i].token;
1063 yylval.sval.ptr = tokstart;
1064 yylval.sval.length = namelen;
1066 /* Any other names starting in $ are debugger internal variables. */
1068 if (*tokstart == '$')
1070 yylval.ivar = (struct internalvar *) lookup_internalvar (copy_name (yylval.sval) + 1);
1071 return INTERNAL_VAR;
1075 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1076 functions. If this is not so, then ...
1077 Use token-type TYPENAME for symbols that happen to be defined
1078 currently as names of types; NAME for other symbols.
1079 The caller is not constrained to care about the distinction. */
1083 char *tmp = copy_name (yylval.sval);
1086 if (lookup_partial_symtab (tmp))
1088 sym = lookup_symbol (tmp, expression_context_block,
1089 VAR_NAMESPACE, 0, NULL);
1090 if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1092 if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
1107 case LOC_CONST_BYTES:
1117 error("internal: Undefined class in m2lex()");
1120 error("internal: Unforseen case in m2lex()");
1125 /* Built-in BOOLEAN type. This is sort of a hack. */
1126 if(!strncmp(tokstart,"TRUE",4))
1131 else if(!strncmp(tokstart,"FALSE",5))
1138 /* 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);