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 /* These MUST be included in any grammar file!!!!
44 Please choose unique names! */
45 #define yymaxdepth m2_maxdepth
46 #define yyparse m2_parse
48 #define yyerror m2_error
49 #define yylval m2_lval
50 #define yychar m2_char
51 #define yydebug m2_debug
52 #define yypact m2_pact
59 #define yyexca m2_exca
60 #define yyerrflag m2_errflag
61 #define yynerrs m2_nerrs
66 #define yystate m2_state
71 #define yylloc m2_lloc
74 make_qualname PARAMS ((char *, char *));
77 parse_number PARAMS ((int));
80 yylex PARAMS ((void));
83 yyerror PARAMS ((char *));
86 __yy_bcopy PARAMS ((char *, char *, int));
89 yyparse PARAMS ((void));
91 /* The sign of the number being parsed. */
94 /* The block that the module specified by the qualifer on an identifer is
96 struct block *modblock=0;
98 /* #define YYDEBUG 1 */
102 /* Although the yacc "value" of an expression is not used,
103 since the result is stored in the structure being created,
104 other node types do have values. */
109 unsigned LONGEST ulval;
116 enum exp_opcode opcode;
117 struct internalvar *ivar;
123 %type <voidval> exp type_exp start set
124 %type <voidval> variable
129 %token <lval> INT HEX ERROR
130 %token <ulval> UINT TRUE FALSE CHAR
133 /* Both NAME and TYPENAME tokens represent symbols in the input,
134 and both convey their data as strings.
135 But a TYPENAME is a string that happens to be defined as a typedef
136 or builtin type name (such as int or char)
137 and a NAME is any other symbol.
139 Contexts where this distinction is not important can use the
140 nonterminal "name", which matches either NAME or TYPENAME. */
143 %token <sval> NAME BLOCKNAME IDENT VARNAME
144 %token <sval> TYPENAME
146 %token SIZE CAP ORD HIGH ABS MIN_FUNC MAX_FUNC FLOAT_FUNC VAL CHR ODD TRUNC
147 %token INC DEC INCL EXCL
149 /* The GDB scope operator */
152 %token <lval> LAST REGNAME
154 %token <ivar> INTERNAL_VAR
160 %left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
165 %left '*' '/' DIV MOD
167 %right '^' DOT '[' '('
170 /* This is not an actual token ; it is used for precedence.
180 { write_exp_elt_opcode(OP_TYPE);
181 write_exp_elt_type($1);
182 write_exp_elt_opcode(OP_TYPE);
188 exp : exp '^' %prec UNARY
189 { write_exp_elt_opcode (UNOP_IND); }
192 { number_sign = -1; }
195 write_exp_elt_opcode (UNOP_NEG); }
198 exp : '+' exp %prec UNARY
199 { write_exp_elt_opcode(UNOP_PLUS); }
202 exp : not_exp exp %prec UNARY
203 { write_exp_elt_opcode (UNOP_ZEROP); }
210 exp : CAP '(' exp ')'
211 { write_exp_elt_opcode (UNOP_CAP); }
214 exp : ORD '(' exp ')'
215 { write_exp_elt_opcode (UNOP_ORD); }
218 exp : ABS '(' exp ')'
219 { write_exp_elt_opcode (UNOP_ABS); }
222 exp : HIGH '(' exp ')'
223 { write_exp_elt_opcode (UNOP_HIGH); }
226 exp : MIN_FUNC '(' type ')'
227 { write_exp_elt_opcode (UNOP_MIN);
228 write_exp_elt_type ($3);
229 write_exp_elt_opcode (UNOP_MIN); }
232 exp : MAX_FUNC '(' type ')'
233 { write_exp_elt_opcode (UNOP_MAX);
234 write_exp_elt_type ($3);
235 write_exp_elt_opcode (UNOP_MIN); }
238 exp : FLOAT_FUNC '(' exp ')'
239 { write_exp_elt_opcode (UNOP_FLOAT); }
242 exp : VAL '(' type ',' exp ')'
243 { write_exp_elt_opcode (BINOP_VAL);
244 write_exp_elt_type ($3);
245 write_exp_elt_opcode (BINOP_VAL); }
248 exp : CHR '(' exp ')'
249 { write_exp_elt_opcode (UNOP_CHR); }
252 exp : ODD '(' exp ')'
253 { write_exp_elt_opcode (UNOP_ODD); }
256 exp : TRUNC '(' exp ')'
257 { write_exp_elt_opcode (UNOP_TRUNC); }
260 exp : SIZE exp %prec UNARY
261 { write_exp_elt_opcode (UNOP_SIZEOF); }
265 exp : INC '(' exp ')'
266 { write_exp_elt_opcode(UNOP_PREINCREMENT); }
269 exp : INC '(' exp ',' exp ')'
270 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
271 write_exp_elt_opcode(BINOP_ADD);
272 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
275 exp : DEC '(' exp ')'
276 { write_exp_elt_opcode(UNOP_PREDECREMENT);}
279 exp : DEC '(' exp ',' exp ')'
280 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
281 write_exp_elt_opcode(BINOP_SUB);
282 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
286 { write_exp_elt_opcode (STRUCTOP_STRUCT);
287 write_exp_string ($3);
288 write_exp_elt_opcode (STRUCTOP_STRUCT); }
295 { error("Sets are not implemented.");}
298 exp : INCL '(' exp ',' exp ')'
299 { error("Sets are not implemented.");}
302 exp : EXCL '(' exp ',' exp ')'
303 { error("Sets are not implemented.");}
305 set : '{' arglist '}'
306 { error("Sets are not implemented.");}
307 | type '{' arglist '}'
308 { error("Sets are not implemented.");}
312 /* Modula-2 array subscript notation [a,b,c...] */
314 /* This function just saves the number of arguments
315 that follow in the list. It is *not* specific to
318 non_empty_arglist ']' %prec DOT
319 { write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT);
320 write_exp_elt_longcst ((LONGEST) end_arglist());
321 write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT); }
325 /* This is to save the value of arglist_len
326 being accumulated by an outer function call. */
327 { start_arglist (); }
328 arglist ')' %prec DOT
329 { write_exp_elt_opcode (OP_FUNCALL);
330 write_exp_elt_longcst ((LONGEST) end_arglist ());
331 write_exp_elt_opcode (OP_FUNCALL); }
341 arglist : arglist ',' exp %prec ABOVE_COMMA
351 : non_empty_arglist ',' exp %prec ABOVE_COMMA
356 exp : '{' type '}' exp %prec UNARY
357 { write_exp_elt_opcode (UNOP_MEMVAL);
358 write_exp_elt_type ($2);
359 write_exp_elt_opcode (UNOP_MEMVAL); }
362 exp : type '(' exp ')' %prec UNARY
363 { write_exp_elt_opcode (UNOP_CAST);
364 write_exp_elt_type ($1);
365 write_exp_elt_opcode (UNOP_CAST); }
372 /* Binary operators in order of decreasing precedence. Note that some
373 of these operators are overloaded! (ie. sets) */
377 { write_exp_elt_opcode (BINOP_REPEAT); }
381 { write_exp_elt_opcode (BINOP_MUL); }
385 { write_exp_elt_opcode (BINOP_DIV); }
389 { write_exp_elt_opcode (BINOP_INTDIV); }
393 { write_exp_elt_opcode (BINOP_REM); }
397 { write_exp_elt_opcode (BINOP_ADD); }
401 { write_exp_elt_opcode (BINOP_SUB); }
405 { write_exp_elt_opcode (BINOP_EQUAL); }
408 exp : exp NOTEQUAL exp
409 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
411 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
415 { write_exp_elt_opcode (BINOP_LEQ); }
419 { write_exp_elt_opcode (BINOP_GEQ); }
423 { write_exp_elt_opcode (BINOP_LESS); }
427 { write_exp_elt_opcode (BINOP_GTR); }
431 { write_exp_elt_opcode (BINOP_AND); }
435 { write_exp_elt_opcode (BINOP_AND); }
439 { write_exp_elt_opcode (BINOP_OR); }
443 { write_exp_elt_opcode (BINOP_ASSIGN); }
450 { write_exp_elt_opcode (OP_BOOL);
451 write_exp_elt_longcst ((LONGEST) $1);
452 write_exp_elt_opcode (OP_BOOL); }
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_LONG);
463 write_exp_elt_type (builtin_type_m2_int);
464 write_exp_elt_longcst ((LONGEST) $1);
465 write_exp_elt_opcode (OP_LONG); }
470 write_exp_elt_opcode (OP_LONG);
471 write_exp_elt_type (builtin_type_m2_card);
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_char);
480 write_exp_elt_longcst ((LONGEST) $1);
481 write_exp_elt_opcode (OP_LONG); }
486 { write_exp_elt_opcode (OP_DOUBLE);
487 write_exp_elt_type (builtin_type_m2_real);
488 write_exp_elt_dblcst ($1);
489 write_exp_elt_opcode (OP_DOUBLE); }
495 /* The GDB internal variable $$, et al. */
497 { write_exp_elt_opcode (OP_LAST);
498 write_exp_elt_longcst ((LONGEST) $1);
499 write_exp_elt_opcode (OP_LAST); }
503 { write_exp_elt_opcode (OP_REGISTER);
504 write_exp_elt_longcst ((LONGEST) $1);
505 write_exp_elt_opcode (OP_REGISTER); }
508 exp : SIZE '(' type ')' %prec UNARY
509 { write_exp_elt_opcode (OP_LONG);
510 write_exp_elt_type (builtin_type_int);
511 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
512 write_exp_elt_opcode (OP_LONG); }
516 { write_exp_elt_opcode (OP_M2_STRING);
517 write_exp_string ($1);
518 write_exp_elt_opcode (OP_M2_STRING); }
521 /* This will be used for extensions later. Like adding modules. */
523 { $$ = SYMBOL_BLOCK_VALUE($1); }
528 = lookup_symbol (copy_name ($1), expression_context_block,
529 VAR_NAMESPACE, 0, NULL);
534 /* GDB scope operator */
535 fblock : block COLONCOLON BLOCKNAME
537 = lookup_symbol (copy_name ($3), $1,
538 VAR_NAMESPACE, 0, NULL);
539 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
540 error ("No function \"%s\" in specified context.",
546 /* Useful for assigning to PROCEDURE variables */
548 { write_exp_elt_opcode(OP_VAR_VALUE);
549 write_exp_elt_sym ($1);
550 write_exp_elt_opcode (OP_VAR_VALUE); }
553 /* GDB internal ($foo) variable */
554 variable: INTERNAL_VAR
555 { write_exp_elt_opcode (OP_INTERNALVAR);
556 write_exp_elt_intern ($1);
557 write_exp_elt_opcode (OP_INTERNALVAR); }
560 /* GDB scope operator */
561 variable: block COLONCOLON NAME
562 { struct symbol *sym;
563 sym = lookup_symbol (copy_name ($3), $1,
564 VAR_NAMESPACE, 0, NULL);
566 error ("No symbol \"%s\" in specified context.",
569 write_exp_elt_opcode (OP_VAR_VALUE);
570 write_exp_elt_sym (sym);
571 write_exp_elt_opcode (OP_VAR_VALUE); }
574 /* Base case for variables. */
576 { struct symbol *sym;
577 int is_a_field_of_this;
579 sym = lookup_symbol (copy_name ($1),
580 expression_context_block,
594 if (innermost_block == 0 ||
595 contained_in (block_found,
597 innermost_block = block_found;
604 case LOC_LABEL: /* maybe should go above? */
606 case LOC_CONST_BYTES:
607 /* These are listed so gcc -Wall will reveal
611 write_exp_elt_opcode (OP_VAR_VALUE);
612 write_exp_elt_sym (sym);
613 write_exp_elt_opcode (OP_VAR_VALUE);
617 struct minimal_symbol *msymbol;
618 register char *arg = copy_name ($1);
620 msymbol = lookup_minimal_symbol (arg,
621 (struct objfile *) NULL);
624 write_exp_elt_opcode (OP_LONG);
625 write_exp_elt_type (builtin_type_int);
626 write_exp_elt_longcst ((LONGEST) msymbol -> address);
627 write_exp_elt_opcode (OP_LONG);
628 write_exp_elt_opcode (UNOP_MEMVAL);
629 if (msymbol -> type == mst_data ||
630 msymbol -> type == mst_bss)
631 write_exp_elt_type (builtin_type_int);
632 else if (msymbol -> type == mst_text)
633 write_exp_elt_type (lookup_function_type (builtin_type_int));
635 write_exp_elt_type (builtin_type_char);
636 write_exp_elt_opcode (UNOP_MEMVAL);
638 else if (!have_full_symbols () && !have_partial_symbols ())
639 error ("No symbol table is loaded. Use the \"symbol-file\" command.");
641 error ("No symbol \"%s\" in current context.",
649 { $$ = lookup_typename (copy_name ($1),
650 expression_context_block, 0); }
661 return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
668 return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
672 /* Take care of parsing a number (anything that starts with a digit).
673 Set yylval and return the token type; update lexptr.
674 LEN is the number of characters in it. */
676 /*** Needs some error checking for the float case ***/
682 register char *p = lexptr;
683 register LONGEST n = 0;
684 register LONGEST prevn = 0;
685 register int c,i,ischar=0;
686 register int base = input_radix;
687 register int len = olen;
688 int unsigned_p = number_sign == 1 ? 1 : 0;
695 else if(p[len-1] == 'C' || p[len-1] == 'B')
698 ischar = p[len-1] == 'C';
702 /* Scan the number */
703 for (c = 0; c < len; c++)
705 if (p[c] == '.' && base == 10)
707 /* It's a float since it contains a point. */
708 yylval.dval = atof (p);
712 if (p[c] == '.' && base != 10)
713 error("Floating point numbers must be base 10.");
714 if (base == 10 && (p[c] < '0' || p[c] > '9'))
715 error("Invalid digit \'%c\' in number.",p[c]);
722 if( base == 8 && (c == '8' || c == '9'))
723 error("Invalid digit \'%c\' in octal number.",c);
724 if (c >= '0' && c <= '9')
728 if (base == 16 && c >= 'A' && c <= 'F')
736 if(!unsigned_p && number_sign == 1 && (prevn >= n))
737 unsigned_p=1; /* Try something unsigned */
738 /* Don't do the range check if n==i and i==0, since that special
739 case will give an overflow error. */
740 if(RANGE_CHECK && n!=i && i)
742 if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
743 ((!unsigned_p && number_sign==-1) && -prevn <= -n))
744 range_error("Overflow on numeric constant.");
750 if(*p == 'B' || *p == 'C' || *p == 'H')
751 lexptr++; /* Advance past B,C or H */
758 else if ( unsigned_p && number_sign == 1)
763 else if((unsigned_p && (n<0))) {
764 range_error("Overflow on numeric constant -- number too large.");
765 /* But, this can return if range_check == range_warn. */
788 /* Some specific keywords */
795 static struct keyword keytab[] =
798 {"IN", IN },/* Note space after IN */
817 {"FLOAT", FLOAT_FUNC },
822 /* Read one token, getting characters through lexptr. */
824 /* This is where we will check to make sure that the language and the operators used are
831 register int namelen;
833 register char *tokstart;
841 /* See if it is a special token of length 2 */
842 for( i = 0 ; i < sizeof tokentab2 / sizeof tokentab2[0] ; i++)
843 if(!strncmp(tokentab2[i].name, tokstart, 2))
846 return tokentab2[i].token;
849 switch (c = *tokstart)
866 if (paren_depth == 0)
873 if (comma_terminates && paren_depth == 0)
879 /* Might be a floating point number. */
880 if (lexptr[1] >= '0' && lexptr[1] <= '9')
881 break; /* Falls into number code. */
888 /* These are character tokens that appear as-is in the YACC grammar */
911 for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
914 c = tokstart[++namelen];
915 if (c >= '0' && c <= '9')
917 c = tokstart[++namelen];
918 if (c >= '0' && c <= '9')
919 c = tokstart[++namelen];
923 error("Unterminated string or character constant.");
924 yylval.sval.ptr = tokstart + 1;
925 yylval.sval.length = namelen - 1;
926 lexptr += namelen + 1;
928 if(namelen == 2) /* Single character */
930 yylval.ulval = tokstart[1];
937 /* Is it a number? */
938 /* Note: We have already dealt with the case of the token '.'.
939 See case '.' above. */
940 if ((c >= '0' && c <= '9'))
943 int got_dot = 0, got_e = 0;
944 register char *p = tokstart;
949 if (!got_e && (*p == 'e' || *p == 'E'))
951 else if (!got_dot && *p == '.')
953 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
954 && (*p == '-' || *p == '+'))
955 /* This is the sign of the exponent, not the end of the
958 else if ((*p < '0' || *p > '9') &&
959 (*p < 'A' || *p > 'F') &&
960 (*p != 'H')) /* Modula-2 hexadecimal number */
963 toktype = parse_number (p - tokstart);
964 if (toktype == ERROR)
966 char *err_copy = (char *) alloca (p - tokstart + 1);
968 bcopy (tokstart, err_copy, p - tokstart);
969 err_copy[p - tokstart] = 0;
970 error ("Invalid number \"%s\".", err_copy);
976 if (!(c == '_' || c == '$'
977 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
978 /* We must have come across a bad character (e.g. ';'). */
979 error ("Invalid character '%c' in expression.", c);
981 /* It's a name. See how long it is. */
983 for (c = tokstart[namelen];
984 (c == '_' || c == '$' || (c >= '0' && c <= '9')
985 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
986 c = tokstart[++namelen])
989 /* The token "if" terminates the expression and is NOT
990 removed from the input stream. */
991 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
998 /* Handle the tokens $digits; also $ (short for $0) and $$ (short for $$1)
999 and $$digits (equivalent to $<-digits> if you could type that).
1000 Make token type LAST, and put the number (the digits) in yylval. */
1002 if (*tokstart == '$')
1004 register int negate = 0;
1006 /* Double dollar means negate the number and add -1 as well.
1007 Thus $$ alone means -1. */
1008 if (namelen >= 2 && tokstart[1] == '$')
1015 /* Just dollars (one or two) */
1016 yylval.lval = - negate;
1019 /* Is the rest of the token digits? */
1020 for (; c < namelen; c++)
1021 if (!(tokstart[c] >= '0' && tokstart[c] <= '9'))
1025 yylval.lval = atoi (tokstart + 1 + negate);
1027 yylval.lval = - yylval.lval;
1032 /* Handle tokens that refer to machine registers:
1033 $ followed by a register name. */
1035 if (*tokstart == '$') {
1036 for (c = 0; c < NUM_REGS; c++)
1037 if (namelen - 1 == strlen (reg_names[c])
1038 && !strncmp (tokstart + 1, reg_names[c], namelen - 1))
1043 for (c = 0; c < num_std_regs; c++)
1044 if (namelen - 1 == strlen (std_regs[c].name)
1045 && !strncmp (tokstart + 1, std_regs[c].name, namelen - 1))
1047 yylval.lval = std_regs[c].regnum;
1053 /* Lookup special keywords */
1054 for(i = 0 ; i < sizeof(keytab) / sizeof(keytab[0]) ; i++)
1055 if(namelen == strlen(keytab[i].keyw) && !strncmp(tokstart,keytab[i].keyw,namelen))
1056 return keytab[i].token;
1058 yylval.sval.ptr = tokstart;
1059 yylval.sval.length = namelen;
1061 /* Any other names starting in $ are debugger internal variables. */
1063 if (*tokstart == '$')
1065 yylval.ivar = (struct internalvar *) lookup_internalvar (copy_name (yylval.sval) + 1);
1066 return INTERNAL_VAR;
1070 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1071 functions. If this is not so, then ...
1072 Use token-type TYPENAME for symbols that happen to be defined
1073 currently as names of types; NAME for other symbols.
1074 The caller is not constrained to care about the distinction. */
1078 char *tmp = copy_name (yylval.sval);
1081 if (lookup_partial_symtab (tmp))
1083 sym = lookup_symbol (tmp, expression_context_block,
1084 VAR_NAMESPACE, 0, NULL);
1085 if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1087 if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
1102 case LOC_CONST_BYTES:
1112 error("internal: Undefined class in m2lex()");
1115 error("internal: Unforseen case in m2lex()");
1120 /* Built-in BOOLEAN type. This is sort of a hack. */
1121 if(!strncmp(tokstart,"TRUE",4))
1126 else if(!strncmp(tokstart,"FALSE",5))
1133 /* Must be another type of name... */
1139 make_qualname(mod,ident)
1142 char *new = xmalloc(strlen(mod)+strlen(ident)+2);
1153 char *msg; /* unused */
1155 printf("Parsing: %s\n",lexptr);
1157 error("Invalid syntax in expression near character '%c'.",yychar);
1159 error("Invalid syntax in expression");
1162 /* Table of operators and their precedences for printing expressions. */
1164 const static struct op_print m2_op_print_tab[] = {
1165 {"+", BINOP_ADD, PREC_ADD, 0},
1166 {"+", UNOP_PLUS, PREC_PREFIX, 0},
1167 {"-", BINOP_SUB, PREC_ADD, 0},
1168 {"-", UNOP_NEG, PREC_PREFIX, 0},
1169 {"*", BINOP_MUL, PREC_MUL, 0},
1170 {"/", BINOP_DIV, PREC_MUL, 0},
1171 {"DIV", BINOP_INTDIV, PREC_MUL, 0},
1172 {"MOD", BINOP_REM, PREC_MUL, 0},
1173 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
1174 {"OR", BINOP_OR, PREC_OR, 0},
1175 {"AND", BINOP_AND, PREC_AND, 0},
1176 {"NOT", UNOP_ZEROP, PREC_PREFIX, 0},
1177 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
1178 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
1179 {"<=", BINOP_LEQ, PREC_ORDER, 0},
1180 {">=", BINOP_GEQ, PREC_ORDER, 0},
1181 {">", BINOP_GTR, PREC_ORDER, 0},
1182 {"<", BINOP_LESS, PREC_ORDER, 0},
1183 {"^", UNOP_IND, PREC_PREFIX, 0},
1184 {"@", BINOP_REPEAT, PREC_REPEAT, 0},
1187 /* The built-in types of Modula-2. */
1189 struct type *builtin_type_m2_char;
1190 struct type *builtin_type_m2_int;
1191 struct type *builtin_type_m2_card;
1192 struct type *builtin_type_m2_real;
1193 struct type *builtin_type_m2_bool;
1195 struct type ** const (m2_builtin_types[]) =
1197 &builtin_type_m2_char,
1198 &builtin_type_m2_int,
1199 &builtin_type_m2_card,
1200 &builtin_type_m2_real,
1201 &builtin_type_m2_bool,
1205 const struct language_defn m2_language_defn = {
1211 m2_parse, /* parser */
1212 m2_error, /* parser error function */
1213 &builtin_type_m2_int, /* longest signed integral type */
1214 &builtin_type_m2_card, /* longest unsigned integral type */
1215 &builtin_type_m2_real, /* longest floating point type */
1216 "0%XH", "0%", "XH", /* Hex format string, prefix, suffix */
1217 "%oB", "%", "oB", /* Octal format string, prefix, suffix */
1218 m2_op_print_tab, /* expression operators for printing */
1222 /* Initialization for Modula-2 */
1225 _initialize_m2_exp ()
1227 /* FIXME: The code below assumes that the sizes of the basic data
1228 types are the same on the host and target machines!!! */
1230 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
1231 builtin_type_m2_int =
1232 init_type (TYPE_CODE_INT, sizeof(int), 0,
1233 "INTEGER", (struct objfile *) NULL);
1234 builtin_type_m2_card =
1235 init_type (TYPE_CODE_INT, sizeof(int), TYPE_FLAG_UNSIGNED,
1236 "CARDINAL", (struct objfile *) NULL);
1237 builtin_type_m2_real =
1238 init_type (TYPE_CODE_FLT, sizeof(float), 0,
1239 "REAL", (struct objfile *) NULL);
1240 builtin_type_m2_char =
1241 init_type (TYPE_CODE_CHAR, sizeof(char), TYPE_FLAG_UNSIGNED,
1242 "CHAR", (struct objfile *) NULL);
1243 builtin_type_m2_bool =
1244 init_type (TYPE_CODE_BOOL, sizeof(int), TYPE_FLAG_UNSIGNED,
1245 "BOOLEAN", (struct objfile *) NULL);
1247 TYPE_NFIELDS(builtin_type_m2_bool) = 2;
1248 TYPE_FIELDS(builtin_type_m2_bool) =
1249 (struct field *) malloc (sizeof (struct field) * 2);
1250 TYPE_FIELD_BITPOS(builtin_type_m2_bool,0) = 0;
1251 TYPE_FIELD_NAME(builtin_type_m2_bool,0) = (char *)malloc(6);
1252 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,0),"FALSE");
1253 TYPE_FIELD_BITPOS(builtin_type_m2_bool,1) = 1;
1254 TYPE_FIELD_NAME(builtin_type_m2_bool,1) = (char *)malloc(5);
1255 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,1),"TRUE");
1257 add_language (&m2_language_defn);