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 /* These MUST be included in any grammar file!!!!
43 Please choose unique names! */
44 #define yymaxdepth m2_maxdepth
45 #define yyparse m2_parse
47 #define yyerror m2_error
48 #define yylval m2_lval
49 #define yychar m2_char
50 #define yydebug m2_debug
51 #define yypact m2_pact
58 #define yyexca m2_exca
59 #define yyerrflag m2_errflag
60 #define yynerrs m2_nerrs
65 #define yystate m2_state
70 #define yylloc m2_lloc
77 /* The sign of the number being parsed. */
80 /* The block that the module specified by the qualifer on an identifer is
82 struct block *modblock=0;
84 char *make_qualname();
86 /* #define YYDEBUG 1 */
90 /* Although the yacc "value" of an expression is not used,
91 since the result is stored in the structure being created,
92 other node types do have values. */
97 unsigned LONGEST ulval;
104 enum exp_opcode opcode;
105 struct internalvar *ivar;
111 %type <voidval> exp type_exp start set
112 %type <voidval> variable
117 %token <lval> INT HEX ERROR
118 %token <ulval> UINT TRUE FALSE CHAR
121 /* Both NAME and TYPENAME tokens represent symbols in the input,
122 and both convey their data as strings.
123 But a TYPENAME is a string that happens to be defined as a typedef
124 or builtin type name (such as int or char)
125 and a NAME is any other symbol.
127 Contexts where this distinction is not important can use the
128 nonterminal "name", which matches either NAME or TYPENAME. */
131 %token <sval> NAME BLOCKNAME IDENT CONST VARNAME
132 %token <sval> TYPENAME
134 %token SIZE CAP ORD HIGH ABS MIN_FUNC MAX_FUNC FLOAT_FUNC VAL CHR ODD TRUNC
135 %token INC DEC INCL EXCL
137 /* The GDB scope operator */
140 %token <lval> LAST REGNAME
142 %token <ivar> INTERNAL_VAR
148 %left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
153 %left '*' '/' DIV MOD
155 %right '^' DOT '[' '('
158 /* This is not an actual token ; it is used for precedence.
168 { write_exp_elt_opcode(OP_TYPE);
169 write_exp_elt_type($1);
170 write_exp_elt_opcode(OP_TYPE);
176 exp : exp '^' %prec UNARY
177 { write_exp_elt_opcode (UNOP_IND); }
180 { number_sign = -1; }
183 write_exp_elt_opcode (UNOP_NEG); }
186 exp : '+' exp %prec UNARY
187 { write_exp_elt_opcode(UNOP_PLUS); }
190 exp : not_exp exp %prec UNARY
191 { write_exp_elt_opcode (UNOP_ZEROP); }
198 exp : CAP '(' exp ')'
199 { write_exp_elt_opcode (UNOP_CAP); }
202 exp : ORD '(' exp ')'
203 { write_exp_elt_opcode (UNOP_ORD); }
206 exp : ABS '(' exp ')'
207 { write_exp_elt_opcode (UNOP_ABS); }
210 exp : HIGH '(' exp ')'
211 { write_exp_elt_opcode (UNOP_HIGH); }
214 exp : MIN_FUNC '(' type ')'
215 { write_exp_elt_opcode (UNOP_MIN);
216 write_exp_elt_type ($3);
217 write_exp_elt_opcode (UNOP_MIN); }
220 exp : MAX_FUNC '(' type ')'
221 { write_exp_elt_opcode (UNOP_MAX);
222 write_exp_elt_type ($3);
223 write_exp_elt_opcode (UNOP_MIN); }
226 exp : FLOAT_FUNC '(' exp ')'
227 { write_exp_elt_opcode (UNOP_FLOAT); }
230 exp : VAL '(' type ',' exp ')'
231 { write_exp_elt_opcode (BINOP_VAL);
232 write_exp_elt_type ($3);
233 write_exp_elt_opcode (BINOP_VAL); }
236 exp : CHR '(' exp ')'
237 { write_exp_elt_opcode (UNOP_CHR); }
240 exp : ODD '(' exp ')'
241 { write_exp_elt_opcode (UNOP_ODD); }
244 exp : TRUNC '(' exp ')'
245 { write_exp_elt_opcode (UNOP_TRUNC); }
248 exp : SIZE exp %prec UNARY
249 { write_exp_elt_opcode (UNOP_SIZEOF); }
253 exp : INC '(' exp ')'
254 { write_exp_elt_opcode(UNOP_PREINCREMENT); }
257 exp : INC '(' exp ',' exp ')'
258 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
259 write_exp_elt_opcode(BINOP_ADD);
260 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
263 exp : DEC '(' exp ')'
264 { write_exp_elt_opcode(UNOP_PREDECREMENT);}
267 exp : DEC '(' exp ',' exp ')'
268 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
269 write_exp_elt_opcode(BINOP_SUB);
270 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
274 { write_exp_elt_opcode (STRUCTOP_STRUCT);
275 write_exp_string ($3);
276 write_exp_elt_opcode (STRUCTOP_STRUCT); }
283 { error("Sets are not implemented.");}
286 exp : INCL '(' exp ',' exp ')'
287 { error("Sets are not implemented.");}
290 exp : EXCL '(' exp ',' exp ')'
291 { error("Sets are not implemented.");}
293 set : '{' arglist '}'
294 { error("Sets are not implemented.");}
295 | type '{' arglist '}'
296 { error("Sets are not implemented.");}
300 /* Modula-2 array subscript notation [a,b,c...] */
302 /* This function just saves the number of arguments
303 that follow in the list. It is *not* specific to
306 non_empty_arglist ']' %prec DOT
307 { write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT);
308 write_exp_elt_longcst ((LONGEST) end_arglist());
309 write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT); }
313 /* This is to save the value of arglist_len
314 being accumulated by an outer function call. */
315 { start_arglist (); }
316 arglist ')' %prec DOT
317 { write_exp_elt_opcode (OP_FUNCALL);
318 write_exp_elt_longcst ((LONGEST) end_arglist ());
319 write_exp_elt_opcode (OP_FUNCALL); }
329 arglist : arglist ',' exp %prec ABOVE_COMMA
339 : non_empty_arglist ',' exp %prec ABOVE_COMMA
344 exp : '{' type '}' exp %prec UNARY
345 { write_exp_elt_opcode (UNOP_MEMVAL);
346 write_exp_elt_type ($2);
347 write_exp_elt_opcode (UNOP_MEMVAL); }
350 exp : type '(' exp ')' %prec UNARY
351 { write_exp_elt_opcode (UNOP_CAST);
352 write_exp_elt_type ($1);
353 write_exp_elt_opcode (UNOP_CAST); }
360 /* Binary operators in order of decreasing precedence. Note that some
361 of these operators are overloaded! (ie. sets) */
365 { write_exp_elt_opcode (BINOP_REPEAT); }
369 { write_exp_elt_opcode (BINOP_MUL); }
373 { write_exp_elt_opcode (BINOP_DIV); }
377 { write_exp_elt_opcode (BINOP_INTDIV); }
381 { write_exp_elt_opcode (BINOP_REM); }
385 { write_exp_elt_opcode (BINOP_ADD); }
389 { write_exp_elt_opcode (BINOP_SUB); }
393 { write_exp_elt_opcode (BINOP_EQUAL); }
396 exp : exp NOTEQUAL exp
397 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
399 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
403 { write_exp_elt_opcode (BINOP_LEQ); }
407 { write_exp_elt_opcode (BINOP_GEQ); }
411 { write_exp_elt_opcode (BINOP_LESS); }
415 { write_exp_elt_opcode (BINOP_GTR); }
419 { write_exp_elt_opcode (BINOP_AND); }
423 { write_exp_elt_opcode (BINOP_AND); }
427 { write_exp_elt_opcode (BINOP_OR); }
431 { write_exp_elt_opcode (BINOP_ASSIGN); }
438 { write_exp_elt_opcode (OP_BOOL);
439 write_exp_elt_longcst ((LONGEST) $1);
440 write_exp_elt_opcode (OP_BOOL); }
444 { write_exp_elt_opcode (OP_BOOL);
445 write_exp_elt_longcst ((LONGEST) $1);
446 write_exp_elt_opcode (OP_BOOL); }
450 { write_exp_elt_opcode (OP_LONG);
451 write_exp_elt_type (builtin_type_m2_int);
452 write_exp_elt_longcst ((LONGEST) $1);
453 write_exp_elt_opcode (OP_LONG); }
458 write_exp_elt_opcode (OP_LONG);
459 write_exp_elt_type (builtin_type_m2_card);
460 write_exp_elt_longcst ((LONGEST) $1);
461 write_exp_elt_opcode (OP_LONG);
466 { write_exp_elt_opcode (OP_LONG);
467 write_exp_elt_type (builtin_type_m2_char);
468 write_exp_elt_longcst ((LONGEST) $1);
469 write_exp_elt_opcode (OP_LONG); }
474 { write_exp_elt_opcode (OP_DOUBLE);
475 write_exp_elt_type (builtin_type_m2_real);
476 write_exp_elt_dblcst ($1);
477 write_exp_elt_opcode (OP_DOUBLE); }
483 /* The GDB internal variable $$, et al. */
485 { write_exp_elt_opcode (OP_LAST);
486 write_exp_elt_longcst ((LONGEST) $1);
487 write_exp_elt_opcode (OP_LAST); }
491 { write_exp_elt_opcode (OP_REGISTER);
492 write_exp_elt_longcst ((LONGEST) $1);
493 write_exp_elt_opcode (OP_REGISTER); }
496 exp : SIZE '(' type ')' %prec UNARY
497 { write_exp_elt_opcode (OP_LONG);
498 write_exp_elt_type (builtin_type_int);
499 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
500 write_exp_elt_opcode (OP_LONG); }
504 { write_exp_elt_opcode (OP_M2_STRING);
505 write_exp_string ($1);
506 write_exp_elt_opcode (OP_M2_STRING); }
509 /* This will be used for extensions later. Like adding modules. */
511 { $$ = SYMBOL_BLOCK_VALUE($1); }
516 = lookup_symbol (copy_name ($1), expression_context_block,
517 VAR_NAMESPACE, 0, NULL);
522 /* GDB scope operator */
523 fblock : block COLONCOLON BLOCKNAME
525 = lookup_symbol (copy_name ($3), $1,
526 VAR_NAMESPACE, 0, NULL);
527 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
528 error ("No function \"%s\" in specified context.",
534 /* Useful for assigning to PROCEDURE variables */
536 { write_exp_elt_opcode(OP_VAR_VALUE);
537 write_exp_elt_sym ($1);
538 write_exp_elt_opcode (OP_VAR_VALUE); }
541 /* GDB internal ($foo) variable */
542 variable: INTERNAL_VAR
543 { write_exp_elt_opcode (OP_INTERNALVAR);
544 write_exp_elt_intern ($1);
545 write_exp_elt_opcode (OP_INTERNALVAR); }
548 /* GDB scope operator */
549 variable: block COLONCOLON NAME
550 { struct symbol *sym;
551 sym = lookup_symbol (copy_name ($3), $1,
552 VAR_NAMESPACE, 0, NULL);
554 error ("No symbol \"%s\" in specified context.",
557 write_exp_elt_opcode (OP_VAR_VALUE);
558 write_exp_elt_sym (sym);
559 write_exp_elt_opcode (OP_VAR_VALUE); }
562 /* Base case for variables. */
564 { struct symbol *sym;
565 int is_a_field_of_this;
567 sym = lookup_symbol (copy_name ($1),
568 expression_context_block,
582 if (innermost_block == 0 ||
583 contained_in (block_found,
585 innermost_block = block_found;
592 case LOC_LABEL: /* maybe should go above? */
594 case LOC_CONST_BYTES:
595 /* These are listed so gcc -Wall will reveal
599 write_exp_elt_opcode (OP_VAR_VALUE);
600 write_exp_elt_sym (sym);
601 write_exp_elt_opcode (OP_VAR_VALUE);
606 register char *arg = copy_name ($1);
608 for (i = 0; i < misc_function_count; i++)
609 if (!strcmp (misc_function_vector[i].name, arg))
612 if (i < misc_function_count)
614 enum misc_function_type mft =
615 (enum misc_function_type)
616 misc_function_vector[i].type;
618 write_exp_elt_opcode (OP_LONG);
619 write_exp_elt_type (builtin_type_int);
620 write_exp_elt_longcst ((LONGEST) misc_function_vector[i].address);
621 write_exp_elt_opcode (OP_LONG);
622 write_exp_elt_opcode (UNOP_MEMVAL);
623 if (mft == mf_data || mft == mf_bss)
624 write_exp_elt_type (builtin_type_int);
625 else if (mft == mf_text)
626 write_exp_elt_type (lookup_function_type (builtin_type_int));
628 write_exp_elt_type (builtin_type_char);
629 write_exp_elt_opcode (UNOP_MEMVAL);
631 else if (symtab_list == 0
632 && partial_symtab_list == 0)
633 error ("No symbol table is loaded. Use the \"symbol-file\" command.");
635 error ("No symbol \"%s\" in current context.",
643 { $$ = lookup_typename (copy_name ($1),
644 expression_context_block, 0); }
655 return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
662 return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
666 /* Take care of parsing a number (anything that starts with a digit).
667 Set yylval and return the token type; update lexptr.
668 LEN is the number of characters in it. */
670 /*** Needs some error checking for the float case ***/
676 register char *p = lexptr;
677 register LONGEST n = 0;
678 register LONGEST prevn = 0;
679 register int c,i,ischar=0;
680 register int base = input_radix;
681 register int len = olen;
682 int unsigned_p = number_sign == 1 ? 1 : 0;
684 extern double atof ();
691 else if(p[len-1] == 'C' || p[len-1] == 'B')
694 ischar = p[len-1] == 'C';
698 /* Scan the number */
699 for (c = 0; c < len; c++)
701 if (p[c] == '.' && base == 10)
703 /* It's a float since it contains a point. */
704 yylval.dval = atof (p);
708 if (p[c] == '.' && base != 10)
709 error("Floating point numbers must be base 10.");
710 if (base == 10 && (p[c] < '0' || p[c] > '9'))
711 error("Invalid digit \'%c\' in number.",p[c]);
718 if( base == 8 && (c == '8' || c == '9'))
719 error("Invalid digit \'%c\' in octal number.",c);
720 if (c >= '0' && c <= '9')
724 if (base == 16 && c >= 'A' && c <= 'F')
732 if(!unsigned_p && number_sign == 1 && (prevn >= n))
733 unsigned_p=1; /* Try something unsigned */
734 /* Don't do the range check if n==i and i==0, since that special
735 case will give an overflow error. */
736 if(RANGE_CHECK && n!=i && i)
738 if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
739 ((!unsigned_p && number_sign==-1) && -prevn <= -n))
740 range_error("Overflow on numeric constant.");
746 if(*p == 'B' || *p == 'C' || *p == 'H')
747 lexptr++; /* Advance past B,C or H */
754 else if ( unsigned_p && number_sign == 1)
759 else if((unsigned_p && (n<0))) {
760 range_error("Overflow on numeric constant -- number too large.");
761 /* But, this can return if range_check == range_warn. */
784 /* Some specific keywords */
791 static struct keyword keytab[] =
794 {"IN", IN },/* Note space after IN */
813 {"FLOAT", FLOAT_FUNC },
818 /* Read one token, getting characters through lexptr. */
820 /* This is where we will check to make sure that the language and the operators used are
827 register int namelen;
829 register char *tokstart;
837 /* See if it is a special token of length 2 */
838 for( i = 0 ; i < sizeof tokentab2 / sizeof tokentab2[0] ; i++)
839 if(!strncmp(tokentab2[i].name, tokstart, 2))
842 return tokentab2[i].token;
845 switch (c = *tokstart)
862 if (paren_depth == 0)
869 if (comma_terminates && paren_depth == 0)
875 /* Might be a floating point number. */
876 if (lexptr[1] >= '0' && lexptr[1] <= '9')
877 break; /* Falls into number code. */
884 /* These are character tokens that appear as-is in the YACC grammar */
907 for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
910 c = tokstart[++namelen];
911 if (c >= '0' && c <= '9')
913 c = tokstart[++namelen];
914 if (c >= '0' && c <= '9')
915 c = tokstart[++namelen];
919 error("Unterminated string or character constant.");
920 yylval.sval.ptr = tokstart + 1;
921 yylval.sval.length = namelen - 1;
922 lexptr += namelen + 1;
924 if(namelen == 2) /* Single character */
926 yylval.ulval = tokstart[1];
933 /* Is it a number? */
934 /* Note: We have already dealt with the case of the token '.'.
935 See case '.' above. */
936 if ((c >= '0' && c <= '9'))
939 int got_dot = 0, got_e = 0;
940 register char *p = tokstart;
945 if (!got_e && (*p == 'e' || *p == 'E'))
947 else if (!got_dot && *p == '.')
949 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
950 && (*p == '-' || *p == '+'))
951 /* This is the sign of the exponent, not the end of the
954 else if ((*p < '0' || *p > '9') &&
955 (*p < 'A' || *p > 'F') &&
956 (*p != 'H')) /* Modula-2 hexadecimal number */
959 toktype = parse_number (p - tokstart);
960 if (toktype == ERROR)
962 char *err_copy = (char *) alloca (p - tokstart + 1);
964 bcopy (tokstart, err_copy, p - tokstart);
965 err_copy[p - tokstart] = 0;
966 error ("Invalid number \"%s\".", err_copy);
972 if (!(c == '_' || c == '$'
973 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
974 /* We must have come across a bad character (e.g. ';'). */
975 error ("Invalid character '%c' in expression.", c);
977 /* It's a name. See how long it is. */
979 for (c = tokstart[namelen];
980 (c == '_' || c == '$' || (c >= '0' && c <= '9')
981 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
982 c = tokstart[++namelen])
985 /* The token "if" terminates the expression and is NOT
986 removed from the input stream. */
987 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
994 /* Handle the tokens $digits; also $ (short for $0) and $$ (short for $$1)
995 and $$digits (equivalent to $<-digits> if you could type that).
996 Make token type LAST, and put the number (the digits) in yylval. */
998 if (*tokstart == '$')
1000 register int negate = 0;
1002 /* Double dollar means negate the number and add -1 as well.
1003 Thus $$ alone means -1. */
1004 if (namelen >= 2 && tokstart[1] == '$')
1011 /* Just dollars (one or two) */
1012 yylval.lval = - negate;
1015 /* Is the rest of the token digits? */
1016 for (; c < namelen; c++)
1017 if (!(tokstart[c] >= '0' && tokstart[c] <= '9'))
1021 yylval.lval = atoi (tokstart + 1 + negate);
1023 yylval.lval = - yylval.lval;
1028 /* Handle tokens that refer to machine registers:
1029 $ followed by a register name. */
1031 if (*tokstart == '$') {
1032 for (c = 0; c < NUM_REGS; c++)
1033 if (namelen - 1 == strlen (reg_names[c])
1034 && !strncmp (tokstart + 1, reg_names[c], namelen - 1))
1039 for (c = 0; c < num_std_regs; c++)
1040 if (namelen - 1 == strlen (std_regs[c].name)
1041 && !strncmp (tokstart + 1, std_regs[c].name, namelen - 1))
1043 yylval.lval = std_regs[c].regnum;
1049 /* Lookup special keywords */
1050 for(i = 0 ; i < sizeof(keytab) / sizeof(keytab[0]) ; i++)
1051 if(namelen == strlen(keytab[i].keyw) && !strncmp(tokstart,keytab[i].keyw,namelen))
1052 return keytab[i].token;
1054 yylval.sval.ptr = tokstart;
1055 yylval.sval.length = namelen;
1057 /* Any other names starting in $ are debugger internal variables. */
1059 if (*tokstart == '$')
1061 yylval.ivar = (struct internalvar *) lookup_internalvar (copy_name (yylval.sval) + 1);
1062 return INTERNAL_VAR;
1066 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1067 functions. If this is not so, then ...
1068 Use token-type TYPENAME for symbols that happen to be defined
1069 currently as names of types; NAME for other symbols.
1070 The caller is not constrained to care about the distinction. */
1074 char *tmp = copy_name (yylval.sval);
1077 if (lookup_partial_symtab (tmp))
1079 sym = lookup_symbol (tmp, expression_context_block,
1080 VAR_NAMESPACE, 0, NULL);
1081 if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1083 if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
1098 case LOC_CONST_BYTES:
1108 error("internal: Undefined class in m2lex()");
1111 error("internal: Unforseen case in m2lex()");
1116 /* Built-in BOOLEAN type. This is sort of a hack. */
1117 if(!strncmp(tokstart,"TRUE",4))
1122 else if(!strncmp(tokstart,"FALSE",5))
1129 /* Must be another type of name... */
1135 make_qualname(mod,ident)
1138 char *new = xmalloc(strlen(mod)+strlen(ident)+2);
1150 printf("Parsing: %s\n",lexptr);
1152 error("Invalid syntax in expression near character '%c'.",yychar);
1154 error("Invalid syntax in expression");
1157 /* Table of operators and their precedences for printing expressions. */
1159 const static struct op_print m2_op_print_tab[] = {
1160 {"+", BINOP_ADD, PREC_ADD, 0},
1161 {"+", UNOP_PLUS, PREC_PREFIX, 0},
1162 {"-", BINOP_SUB, PREC_ADD, 0},
1163 {"-", UNOP_NEG, PREC_PREFIX, 0},
1164 {"*", BINOP_MUL, PREC_MUL, 0},
1165 {"/", BINOP_DIV, PREC_MUL, 0},
1166 {"DIV", BINOP_INTDIV, PREC_MUL, 0},
1167 {"MOD", BINOP_REM, PREC_MUL, 0},
1168 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
1169 {"OR", BINOP_OR, PREC_OR, 0},
1170 {"AND", BINOP_AND, PREC_AND, 0},
1171 {"NOT", UNOP_ZEROP, PREC_PREFIX, 0},
1172 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
1173 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
1174 {"<=", BINOP_LEQ, PREC_ORDER, 0},
1175 {">=", BINOP_GEQ, PREC_ORDER, 0},
1176 {">", BINOP_GTR, PREC_ORDER, 0},
1177 {"<", BINOP_LESS, PREC_ORDER, 0},
1178 {"^", UNOP_IND, PREC_PREFIX, 0},
1179 {"@", BINOP_REPEAT, PREC_REPEAT, 0},
1182 /* The built-in types of Modula-2. */
1184 struct type *builtin_type_m2_char;
1185 struct type *builtin_type_m2_int;
1186 struct type *builtin_type_m2_card;
1187 struct type *builtin_type_m2_real;
1188 struct type *builtin_type_m2_bool;
1190 struct type ** const (m2_builtin_types[]) =
1192 &builtin_type_m2_char,
1193 &builtin_type_m2_int,
1194 &builtin_type_m2_card,
1195 &builtin_type_m2_real,
1196 &builtin_type_m2_bool,
1200 const struct language_defn m2_language_defn = {
1206 m2_parse, /* parser */
1207 m2_error, /* parser error function */
1208 &builtin_type_m2_int, /* longest signed integral type */
1209 &builtin_type_m2_card, /* longest unsigned integral type */
1210 &builtin_type_m2_real, /* longest floating point type */
1211 "0%XH", "0%", "XH", /* Hex format string, prefix, suffix */
1212 "%oB", "%", "oB", /* Octal format string, prefix, suffix */
1213 m2_op_print_tab, /* expression operators for printing */
1217 /* Initialization for Modula-2 */
1220 _initialize_m2_exp ()
1222 /* FIXME: The code below assumes that the sizes of the basic data
1223 types are the same on the host and target machines!!! */
1225 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
1226 builtin_type_m2_int = init_type (TYPE_CODE_INT, sizeof(int), 0, "INTEGER");
1227 builtin_type_m2_card = init_type (TYPE_CODE_INT, sizeof(int), 1, "CARDINAL");
1228 builtin_type_m2_real = init_type (TYPE_CODE_FLT, sizeof(float), 0, "REAL");
1229 builtin_type_m2_char = init_type (TYPE_CODE_CHAR, sizeof(char), 1, "CHAR");
1231 builtin_type_m2_bool = init_type (TYPE_CODE_BOOL, sizeof(int), 1, "BOOLEAN");
1232 TYPE_NFIELDS(builtin_type_m2_bool) = 2;
1233 TYPE_FIELDS(builtin_type_m2_bool) =
1234 (struct field *) malloc (sizeof (struct field) * 2);
1235 TYPE_FIELD_BITPOS(builtin_type_m2_bool,0) = 0;
1236 TYPE_FIELD_NAME(builtin_type_m2_bool,0) = (char *)malloc(6);
1237 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,0),"FALSE");
1238 TYPE_FIELD_BITPOS(builtin_type_m2_bool,1) = 1;
1239 TYPE_FIELD_NAME(builtin_type_m2_bool,1) = (char *)malloc(5);
1240 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,1),"TRUE");
1242 add_language (&m2_language_defn);