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. */
37 #include "expression.h"
40 #include "parser-defs.h"
42 /* In case the system defines these as macros, get rid of them; we use
47 /* These MUST be included in any grammar file!!!!
48 Please choose unique names! */
49 #define yymaxdepth m2_maxdepth
50 #define yyparse m2_parse
52 #define yyerror m2_error
53 #define yylval m2_lval
54 #define yychar m2_char
55 #define yydebug m2_debug
56 #define yypact m2_pact
63 #define yyexca m2_exca
64 #define yyerrflag m2_errflag
65 #define yynerrs m2_nerrs
70 #define yystate m2_state
75 #define yylloc m2_lloc
82 /* The sign of the number being parsed. */
85 /* The block that the module specified by the qualifer on an identifer is
87 struct block *modblock=0;
89 char *make_qualname();
91 /* #define YYDEBUG 1 */
95 /* Although the yacc "value" of an expression is not used,
96 since the result is stored in the structure being created,
97 other node types do have values. */
102 unsigned LONGEST ulval;
109 enum exp_opcode opcode;
110 struct internalvar *ivar;
116 %type <voidval> exp type_exp start set
117 %type <voidval> variable
122 %token <lval> INT HEX ERROR
123 %token <ulval> UINT TRUE FALSE CHAR
126 /* Both NAME and TYPENAME tokens represent symbols in the input,
127 and both convey their data as strings.
128 But a TYPENAME is a string that happens to be defined as a typedef
129 or builtin type name (such as int or char)
130 and a NAME is any other symbol.
132 Contexts where this distinction is not important can use the
133 nonterminal "name", which matches either NAME or TYPENAME. */
136 %token <sval> NAME BLOCKNAME IDENT CONST VARNAME
137 %token <sval> TYPENAME
139 %token SIZE CAP ORD HIGH ABS MIN MAX FLOAT_FUNC VAL CHR ODD TRUNC
140 %token INC DEC INCL EXCL
142 /* The GDB scope operator */
145 %token <lval> LAST REGNAME
147 %token <ivar> INTERNAL_VAR
153 %left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
158 %left '*' '/' DIV MOD
160 %right '^' DOT '[' '('
163 /* This is not an actual token ; it is used for precedence.
173 { write_exp_elt_opcode(OP_TYPE);
174 write_exp_elt_type($1);
175 write_exp_elt_opcode(OP_TYPE);
181 exp : exp '^' %prec UNARY
182 { write_exp_elt_opcode (UNOP_IND); }
185 { number_sign = -1; }
188 write_exp_elt_opcode (UNOP_NEG); }
191 exp : '+' exp %prec UNARY
192 { write_exp_elt_opcode(UNOP_PLUS); }
195 exp : not_exp exp %prec UNARY
196 { write_exp_elt_opcode (UNOP_ZEROP); }
203 exp : CAP '(' exp ')'
204 { write_exp_elt_opcode (UNOP_CAP); }
207 exp : ORD '(' exp ')'
208 { write_exp_elt_opcode (UNOP_ORD); }
211 exp : ABS '(' exp ')'
212 { write_exp_elt_opcode (UNOP_ABS); }
215 exp : HIGH '(' exp ')'
216 { write_exp_elt_opcode (UNOP_HIGH); }
219 exp : MIN '(' type ')'
220 { write_exp_elt_opcode (UNOP_MIN);
221 write_exp_elt_type ($3);
222 write_exp_elt_opcode (UNOP_MIN); }
225 exp : MAX '(' type ')'
226 { write_exp_elt_opcode (UNOP_MAX);
227 write_exp_elt_type ($3);
228 write_exp_elt_opcode (UNOP_MIN); }
231 exp : FLOAT_FUNC '(' exp ')'
232 { write_exp_elt_opcode (UNOP_FLOAT); }
235 exp : VAL '(' type ',' exp ')'
236 { write_exp_elt_opcode (BINOP_VAL);
237 write_exp_elt_type ($3);
238 write_exp_elt_opcode (BINOP_VAL); }
241 exp : CHR '(' exp ')'
242 { write_exp_elt_opcode (UNOP_CHR); }
245 exp : ODD '(' exp ')'
246 { write_exp_elt_opcode (UNOP_ODD); }
249 exp : TRUNC '(' exp ')'
250 { write_exp_elt_opcode (UNOP_TRUNC); }
253 exp : SIZE exp %prec UNARY
254 { write_exp_elt_opcode (UNOP_SIZEOF); }
258 exp : INC '(' exp ')'
259 { write_exp_elt_opcode(UNOP_PREINCREMENT); }
262 exp : INC '(' exp ',' exp ')'
263 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
264 write_exp_elt_opcode(BINOP_ADD);
265 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
268 exp : DEC '(' exp ')'
269 { write_exp_elt_opcode(UNOP_PREDECREMENT);}
272 exp : DEC '(' exp ',' exp ')'
273 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
274 write_exp_elt_opcode(BINOP_SUB);
275 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
279 { write_exp_elt_opcode (STRUCTOP_STRUCT);
280 write_exp_string ($3);
281 write_exp_elt_opcode (STRUCTOP_STRUCT); }
288 { error("Sets are not implemented.");}
291 exp : INCL '(' exp ',' exp ')'
292 { error("Sets are not implemented.");}
295 exp : EXCL '(' exp ',' exp ')'
296 { error("Sets are not implemented.");}
298 set : '{' arglist '}'
299 { error("Sets are not implemented.");}
300 | type '{' arglist '}'
301 { error("Sets are not implemented.");}
305 /* Modula-2 array subscript notation [a,b,c...] */
307 /* This function just saves the number of arguments
308 that follow in the list. It is *not* specific to
311 non_empty_arglist ']' %prec DOT
312 { write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT);
313 write_exp_elt_longcst ((LONGEST) end_arglist());
314 write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT); }
318 /* This is to save the value of arglist_len
319 being accumulated by an outer function call. */
320 { start_arglist (); }
321 arglist ')' %prec DOT
322 { write_exp_elt_opcode (OP_FUNCALL);
323 write_exp_elt_longcst ((LONGEST) end_arglist ());
324 write_exp_elt_opcode (OP_FUNCALL); }
334 arglist : arglist ',' exp %prec ABOVE_COMMA
344 : non_empty_arglist ',' exp %prec ABOVE_COMMA
349 exp : '{' type '}' exp %prec UNARY
350 { write_exp_elt_opcode (UNOP_MEMVAL);
351 write_exp_elt_type ($2);
352 write_exp_elt_opcode (UNOP_MEMVAL); }
355 exp : type '(' exp ')' %prec UNARY
356 { write_exp_elt_opcode (UNOP_CAST);
357 write_exp_elt_type ($1);
358 write_exp_elt_opcode (UNOP_CAST); }
365 /* Binary operators in order of decreasing precedence. Note that some
366 of these operators are overloaded! (ie. sets) */
370 { write_exp_elt_opcode (BINOP_REPEAT); }
374 { write_exp_elt_opcode (BINOP_MUL); }
378 { write_exp_elt_opcode (BINOP_DIV); }
382 { write_exp_elt_opcode (BINOP_INTDIV); }
386 { write_exp_elt_opcode (BINOP_REM); }
390 { write_exp_elt_opcode (BINOP_ADD); }
394 { write_exp_elt_opcode (BINOP_SUB); }
398 { write_exp_elt_opcode (BINOP_EQUAL); }
401 exp : exp NOTEQUAL exp
402 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
404 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
408 { write_exp_elt_opcode (BINOP_LEQ); }
412 { write_exp_elt_opcode (BINOP_GEQ); }
416 { write_exp_elt_opcode (BINOP_LESS); }
420 { write_exp_elt_opcode (BINOP_GTR); }
424 { write_exp_elt_opcode (BINOP_AND); }
428 { write_exp_elt_opcode (BINOP_AND); }
432 { write_exp_elt_opcode (BINOP_OR); }
436 { write_exp_elt_opcode (BINOP_ASSIGN); }
443 { write_exp_elt_opcode (OP_BOOL);
444 write_exp_elt_longcst ((LONGEST) $1);
445 write_exp_elt_opcode (OP_BOOL); }
449 { write_exp_elt_opcode (OP_BOOL);
450 write_exp_elt_longcst ((LONGEST) $1);
451 write_exp_elt_opcode (OP_BOOL); }
455 { write_exp_elt_opcode (OP_LONG);
456 write_exp_elt_type (builtin_type_m2_int);
457 write_exp_elt_longcst ((LONGEST) $1);
458 write_exp_elt_opcode (OP_LONG); }
463 write_exp_elt_opcode (OP_LONG);
464 write_exp_elt_type (builtin_type_m2_card);
465 write_exp_elt_longcst ((LONGEST) $1);
466 write_exp_elt_opcode (OP_LONG);
471 { write_exp_elt_opcode (OP_LONG);
472 write_exp_elt_type (builtin_type_m2_char);
473 write_exp_elt_longcst ((LONGEST) $1);
474 write_exp_elt_opcode (OP_LONG); }
479 { write_exp_elt_opcode (OP_DOUBLE);
480 write_exp_elt_type (builtin_type_m2_real);
481 write_exp_elt_dblcst ($1);
482 write_exp_elt_opcode (OP_DOUBLE); }
488 /* The GDB internal variable $$, et al. */
490 { write_exp_elt_opcode (OP_LAST);
491 write_exp_elt_longcst ((LONGEST) $1);
492 write_exp_elt_opcode (OP_LAST); }
496 { write_exp_elt_opcode (OP_REGISTER);
497 write_exp_elt_longcst ((LONGEST) $1);
498 write_exp_elt_opcode (OP_REGISTER); }
501 exp : SIZE '(' type ')' %prec UNARY
502 { write_exp_elt_opcode (OP_LONG);
503 write_exp_elt_type (builtin_type_int);
504 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
505 write_exp_elt_opcode (OP_LONG); }
509 { write_exp_elt_opcode (OP_M2_STRING);
510 write_exp_string ($1);
511 write_exp_elt_opcode (OP_M2_STRING); }
514 /* This will be used for extensions later. Like adding modules. */
516 { $$ = SYMBOL_BLOCK_VALUE($1); }
521 = lookup_symbol (copy_name ($1), expression_context_block,
522 VAR_NAMESPACE, 0, NULL);
527 /* GDB scope operator */
528 fblock : block COLONCOLON BLOCKNAME
530 = lookup_symbol (copy_name ($3), $1,
531 VAR_NAMESPACE, 0, NULL);
532 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
533 error ("No function \"%s\" in specified context.",
539 /* Useful for assigning to PROCEDURE variables */
541 { write_exp_elt_opcode(OP_VAR_VALUE);
542 write_exp_elt_sym ($1);
543 write_exp_elt_opcode (OP_VAR_VALUE); }
546 /* GDB internal ($foo) variable */
547 variable: INTERNAL_VAR
548 { write_exp_elt_opcode (OP_INTERNALVAR);
549 write_exp_elt_intern ($1);
550 write_exp_elt_opcode (OP_INTERNALVAR); }
553 /* GDB scope operator */
554 variable: block COLONCOLON NAME
555 { struct symbol *sym;
556 sym = lookup_symbol (copy_name ($3), $1,
557 VAR_NAMESPACE, 0, NULL);
559 error ("No symbol \"%s\" in specified context.",
562 write_exp_elt_opcode (OP_VAR_VALUE);
563 write_exp_elt_sym (sym);
564 write_exp_elt_opcode (OP_VAR_VALUE); }
567 /* Base case for variables. */
569 { struct symbol *sym;
570 int is_a_field_of_this;
572 sym = lookup_symbol (copy_name ($1),
573 expression_context_block,
587 if (innermost_block == 0 ||
588 contained_in (block_found,
590 innermost_block = block_found;
597 case LOC_LABEL: /* maybe should go above? */
599 case LOC_CONST_BYTES:
600 /* These are listed so gcc -Wall will reveal
604 write_exp_elt_opcode (OP_VAR_VALUE);
605 write_exp_elt_sym (sym);
606 write_exp_elt_opcode (OP_VAR_VALUE);
611 register char *arg = copy_name ($1);
613 for (i = 0; i < misc_function_count; i++)
614 if (!strcmp (misc_function_vector[i].name, arg))
617 if (i < misc_function_count)
619 enum misc_function_type mft =
620 (enum misc_function_type)
621 misc_function_vector[i].type;
623 write_exp_elt_opcode (OP_LONG);
624 write_exp_elt_type (builtin_type_int);
625 write_exp_elt_longcst ((LONGEST) misc_function_vector[i].address);
626 write_exp_elt_opcode (OP_LONG);
627 write_exp_elt_opcode (UNOP_MEMVAL);
628 if (mft == mf_data || mft == mf_bss)
629 write_exp_elt_type (builtin_type_int);
630 else if (mft == mf_text)
631 write_exp_elt_type (lookup_function_type (builtin_type_int));
633 write_exp_elt_type (builtin_type_char);
634 write_exp_elt_opcode (UNOP_MEMVAL);
636 else if (symtab_list == 0
637 && partial_symtab_list == 0)
638 error ("No symbol table is loaded. Use the \"symbol-file\" command.");
640 error ("No symbol \"%s\" in current context.",
648 { $$ = lookup_typename (copy_name ($1),
649 expression_context_block, 0); }
660 return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
667 return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
671 /* Take care of parsing a number (anything that starts with a digit).
672 Set yylval and return the token type; update lexptr.
673 LEN is the number of characters in it. */
675 /*** Needs some error checking for the float case ***/
681 register char *p = lexptr;
682 register LONGEST n = 0;
683 register LONGEST prevn = 0;
684 register int c,i,ischar=0;
685 register int base = input_radix;
686 register int len = olen;
687 int unsigned_p = number_sign == 1 ? 1 : 0;
689 extern double atof ();
696 else if(p[len-1] == 'C' || p[len-1] == 'B')
699 ischar = p[len-1] == 'C';
703 /* Scan the number */
704 for (c = 0; c < len; c++)
706 if (p[c] == '.' && base == 10)
708 /* It's a float since it contains a point. */
709 yylval.dval = atof (p);
713 if (p[c] == '.' && base != 10)
714 error("Floating point numbers must be base 10.");
715 if (base == 10 && (p[c] < '0' || p[c] > '9'))
716 error("Invalid digit \'%c\' in number.",p[c]);
723 if( base == 8 && (c == '8' || c == '9'))
724 error("Invalid digit \'%c\' in octal number.",c);
725 if (c >= '0' && c <= '9')
729 if (base == 16 && c >= 'A' && c <= 'F')
737 if(!unsigned_p && number_sign == 1 && (prevn >= n))
738 unsigned_p=1; /* Try something unsigned */
739 /* Don't do the range check if n==i and i==0, since that special
740 case will give an overflow error. */
741 if(RANGE_CHECK && n!=i && i)
743 if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
744 ((!unsigned_p && number_sign==-1) && -prevn <= -n))
745 range_error("Overflow on numeric constant.");
751 if(*p == 'B' || *p == 'C' || *p == 'H')
752 lexptr++; /* Advance past B,C or H */
759 else if ( unsigned_p && number_sign == 1)
764 else if((unsigned_p && (n<0))) {
765 range_error("Overflow on numeric constant -- number too large.");
766 /* But, this can return if range_check == range_warn. */
789 /* Some specific keywords */
796 static struct keyword keytab[] =
799 {"IN", IN },/* Note space after IN */
818 {"FLOAT", FLOAT_FUNC },
823 /* Read one token, getting characters through lexptr. */
825 /* This is where we will check to make sure that the language and the operators used are
832 register int namelen;
834 register char *tokstart;
842 /* See if it is a special token of length 2 */
843 for( i = 0 ; i < sizeof tokentab2 / sizeof tokentab2[0] ; i++)
844 if(!strncmp(tokentab2[i].name, tokstart, 2))
847 return tokentab2[i].token;
850 switch (c = *tokstart)
867 if (paren_depth == 0)
874 if (comma_terminates && paren_depth == 0)
880 /* Might be a floating point number. */
881 if (lexptr[1] >= '0' && lexptr[1] <= '9')
882 break; /* Falls into number code. */
889 /* These are character tokens that appear as-is in the YACC grammar */
912 for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
915 c = tokstart[++namelen];
916 if (c >= '0' && c <= '9')
918 c = tokstart[++namelen];
919 if (c >= '0' && c <= '9')
920 c = tokstart[++namelen];
924 error("Unterminated string or character constant.");
925 yylval.sval.ptr = tokstart + 1;
926 yylval.sval.length = namelen - 1;
927 lexptr += namelen + 1;
929 if(namelen == 2) /* Single character */
931 yylval.ulval = tokstart[1];
938 /* Is it a number? */
939 /* Note: We have already dealt with the case of the token '.'.
940 See case '.' above. */
941 if ((c >= '0' && c <= '9'))
944 int got_dot = 0, got_e = 0;
945 register char *p = tokstart;
950 if (!got_e && (*p == 'e' || *p == 'E'))
952 else if (!got_dot && *p == '.')
954 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
955 && (*p == '-' || *p == '+'))
956 /* This is the sign of the exponent, not the end of the
959 else if ((*p < '0' || *p > '9') &&
960 (*p < 'A' || *p > 'F') &&
961 (*p != 'H')) /* Modula-2 hexadecimal number */
964 toktype = parse_number (p - tokstart);
965 if (toktype == ERROR)
967 char *err_copy = (char *) alloca (p - tokstart + 1);
969 bcopy (tokstart, err_copy, p - tokstart);
970 err_copy[p - tokstart] = 0;
971 error ("Invalid number \"%s\".", err_copy);
977 if (!(c == '_' || c == '$'
978 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
979 /* We must have come across a bad character (e.g. ';'). */
980 error ("Invalid character '%c' in expression.", c);
982 /* It's a name. See how long it is. */
984 for (c = tokstart[namelen];
985 (c == '_' || c == '$' || (c >= '0' && c <= '9')
986 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
987 c = tokstart[++namelen])
990 /* The token "if" terminates the expression and is NOT
991 removed from the input stream. */
992 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
999 /* Handle the tokens $digits; also $ (short for $0) and $$ (short for $$1)
1000 and $$digits (equivalent to $<-digits> if you could type that).
1001 Make token type LAST, and put the number (the digits) in yylval. */
1003 if (*tokstart == '$')
1005 register int negate = 0;
1007 /* Double dollar means negate the number and add -1 as well.
1008 Thus $$ alone means -1. */
1009 if (namelen >= 2 && tokstart[1] == '$')
1016 /* Just dollars (one or two) */
1017 yylval.lval = - negate;
1020 /* Is the rest of the token digits? */
1021 for (; c < namelen; c++)
1022 if (!(tokstart[c] >= '0' && tokstart[c] <= '9'))
1026 yylval.lval = atoi (tokstart + 1 + negate);
1028 yylval.lval = - yylval.lval;
1033 /* Handle tokens that refer to machine registers:
1034 $ followed by a register name. */
1036 if (*tokstart == '$') {
1037 for (c = 0; c < NUM_REGS; c++)
1038 if (namelen - 1 == strlen (reg_names[c])
1039 && !strncmp (tokstart + 1, reg_names[c], namelen - 1))
1044 for (c = 0; c < num_std_regs; c++)
1045 if (namelen - 1 == strlen (std_regs[c].name)
1046 && !strncmp (tokstart + 1, std_regs[c].name, namelen - 1))
1048 yylval.lval = std_regs[c].regnum;
1054 /* Lookup special keywords */
1055 for(i = 0 ; i < sizeof(keytab) / sizeof(keytab[0]) ; i++)
1056 if(namelen == strlen(keytab[i].keyw) && !strncmp(tokstart,keytab[i].keyw,namelen))
1057 return keytab[i].token;
1059 yylval.sval.ptr = tokstart;
1060 yylval.sval.length = namelen;
1062 /* Any other names starting in $ are debugger internal variables. */
1064 if (*tokstart == '$')
1066 yylval.ivar = (struct internalvar *) lookup_internalvar (copy_name (yylval.sval) + 1);
1067 return INTERNAL_VAR;
1071 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1072 functions. If this is not so, then ...
1073 Use token-type TYPENAME for symbols that happen to be defined
1074 currently as names of types; NAME for other symbols.
1075 The caller is not constrained to care about the distinction. */
1079 char *tmp = copy_name (yylval.sval);
1082 if (lookup_partial_symtab (tmp))
1084 sym = lookup_symbol (tmp, expression_context_block,
1085 VAR_NAMESPACE, 0, NULL);
1086 if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1088 if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
1103 case LOC_CONST_BYTES:
1113 error("internal: Undefined class in m2lex()");
1116 error("internal: Unforseen case in m2lex()");
1121 /* Built-in BOOLEAN type. This is sort of a hack. */
1122 if(!strncmp(tokstart,"TRUE",4))
1127 else if(!strncmp(tokstart,"FALSE",5))
1134 /* Must be another type of name... */
1140 make_qualname(mod,ident)
1143 char *new = xmalloc(strlen(mod)+strlen(ident)+2);
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 = init_type (TYPE_CODE_INT, sizeof(int), 0, "INTEGER");
1232 builtin_type_m2_card = init_type (TYPE_CODE_INT, sizeof(int), 1, "CARDINAL");
1233 builtin_type_m2_real = init_type (TYPE_CODE_FLT, sizeof(float), 0, "REAL");
1234 builtin_type_m2_char = init_type (TYPE_CODE_CHAR, sizeof(char), 1, "CHAR");
1236 builtin_type_m2_bool = init_type (TYPE_CODE_BOOL, sizeof(int), 1, "BOOLEAN");
1237 TYPE_NFIELDS(builtin_type_m2_bool) = 2;
1238 TYPE_FIELDS(builtin_type_m2_bool) =
1239 (struct field *) malloc (sizeof (struct field) * 2);
1240 TYPE_FIELD_BITPOS(builtin_type_m2_bool,0) = 0;
1241 TYPE_FIELD_NAME(builtin_type_m2_bool,0) = (char *)malloc(6);
1242 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,0),"FALSE");
1243 TYPE_FIELD_BITPOS(builtin_type_m2_bool,1) = 1;
1244 TYPE_FIELD_NAME(builtin_type_m2_bool,1) = (char *)malloc(5);
1245 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,1),"TRUE");
1247 add_language (&m2_language_defn);