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
78 /* The sign of the number being parsed. */
81 /* The block that the module specified by the qualifer on an identifer is
83 struct block *modblock=0;
85 char *make_qualname();
87 /* #define YYDEBUG 1 */
91 /* Although the yacc "value" of an expression is not used,
92 since the result is stored in the structure being created,
93 other node types do have values. */
98 unsigned LONGEST ulval;
105 enum exp_opcode opcode;
106 struct internalvar *ivar;
112 %type <voidval> exp type_exp start set
113 %type <voidval> variable
118 %token <lval> INT HEX ERROR
119 %token <ulval> UINT TRUE FALSE CHAR
122 /* Both NAME and TYPENAME tokens represent symbols in the input,
123 and both convey their data as strings.
124 But a TYPENAME is a string that happens to be defined as a typedef
125 or builtin type name (such as int or char)
126 and a NAME is any other symbol.
128 Contexts where this distinction is not important can use the
129 nonterminal "name", which matches either NAME or TYPENAME. */
132 %token <sval> NAME BLOCKNAME IDENT CONST VARNAME
133 %token <sval> TYPENAME
135 %token SIZE CAP ORD HIGH ABS MIN MAX FLOAT_FUNC VAL CHR ODD TRUNC
136 %token INC DEC INCL EXCL
138 /* The GDB scope operator */
141 %token <lval> LAST REGNAME
143 %token <ivar> INTERNAL_VAR
149 %left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
154 %left '*' '/' DIV MOD
156 %right '^' DOT '[' '('
159 /* This is not an actual token ; it is used for precedence.
169 { write_exp_elt_opcode(OP_TYPE);
170 write_exp_elt_type($1);
171 write_exp_elt_opcode(OP_TYPE);
177 exp : exp '^' %prec UNARY
178 { write_exp_elt_opcode (UNOP_IND); }
181 { number_sign = -1; }
184 write_exp_elt_opcode (UNOP_NEG); }
187 exp : '+' exp %prec UNARY
188 { write_exp_elt_opcode(UNOP_PLUS); }
191 exp : not_exp exp %prec UNARY
192 { write_exp_elt_opcode (UNOP_ZEROP); }
199 exp : CAP '(' exp ')'
200 { write_exp_elt_opcode (UNOP_CAP); }
203 exp : ORD '(' exp ')'
204 { write_exp_elt_opcode (UNOP_ORD); }
207 exp : ABS '(' exp ')'
208 { write_exp_elt_opcode (UNOP_ABS); }
211 exp : HIGH '(' exp ')'
212 { write_exp_elt_opcode (UNOP_HIGH); }
215 exp : MIN '(' type ')'
216 { write_exp_elt_opcode (UNOP_MIN);
217 write_exp_elt_type ($3);
218 write_exp_elt_opcode (UNOP_MIN); }
221 exp : MAX '(' type ')'
222 { write_exp_elt_opcode (UNOP_MAX);
223 write_exp_elt_type ($3);
224 write_exp_elt_opcode (UNOP_MIN); }
227 exp : FLOAT_FUNC '(' exp ')'
228 { write_exp_elt_opcode (UNOP_FLOAT); }
231 exp : VAL '(' type ',' exp ')'
232 { write_exp_elt_opcode (BINOP_VAL);
233 write_exp_elt_type ($3);
234 write_exp_elt_opcode (BINOP_VAL); }
237 exp : CHR '(' exp ')'
238 { write_exp_elt_opcode (UNOP_CHR); }
241 exp : ODD '(' exp ')'
242 { write_exp_elt_opcode (UNOP_ODD); }
245 exp : TRUNC '(' exp ')'
246 { write_exp_elt_opcode (UNOP_TRUNC); }
249 exp : SIZE exp %prec UNARY
250 { write_exp_elt_opcode (UNOP_SIZEOF); }
254 exp : INC '(' exp ')'
255 { write_exp_elt_opcode(UNOP_PREINCREMENT); }
258 exp : INC '(' exp ',' exp ')'
259 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
260 write_exp_elt_opcode(BINOP_ADD);
261 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
264 exp : DEC '(' exp ')'
265 { write_exp_elt_opcode(UNOP_PREDECREMENT);}
268 exp : DEC '(' exp ',' exp ')'
269 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
270 write_exp_elt_opcode(BINOP_SUB);
271 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
275 { write_exp_elt_opcode (STRUCTOP_STRUCT);
276 write_exp_string ($3);
277 write_exp_elt_opcode (STRUCTOP_STRUCT); }
284 { error("Sets are not implemented.");}
287 exp : INCL '(' exp ',' exp ')'
288 { error("Sets are not implemented.");}
291 exp : EXCL '(' exp ',' exp ')'
292 { error("Sets are not implemented.");}
294 set : '{' arglist '}'
295 { error("Sets are not implemented.");}
296 | type '{' arglist '}'
297 { error("Sets are not implemented.");}
301 /* Modula-2 array subscript notation [a,b,c...] */
303 /* This function just saves the number of arguments
304 that follow in the list. It is *not* specific to
307 non_empty_arglist ']' %prec DOT
308 { write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT);
309 write_exp_elt_longcst ((LONGEST) end_arglist());
310 write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT); }
314 /* This is to save the value of arglist_len
315 being accumulated by an outer function call. */
316 { start_arglist (); }
317 arglist ')' %prec DOT
318 { write_exp_elt_opcode (OP_FUNCALL);
319 write_exp_elt_longcst ((LONGEST) end_arglist ());
320 write_exp_elt_opcode (OP_FUNCALL); }
330 arglist : arglist ',' exp %prec ABOVE_COMMA
340 : non_empty_arglist ',' exp %prec ABOVE_COMMA
345 exp : '{' type '}' exp %prec UNARY
346 { write_exp_elt_opcode (UNOP_MEMVAL);
347 write_exp_elt_type ($2);
348 write_exp_elt_opcode (UNOP_MEMVAL); }
351 exp : type '(' exp ')' %prec UNARY
352 { write_exp_elt_opcode (UNOP_CAST);
353 write_exp_elt_type ($1);
354 write_exp_elt_opcode (UNOP_CAST); }
361 /* Binary operators in order of decreasing precedence. Note that some
362 of these operators are overloaded! (ie. sets) */
366 { write_exp_elt_opcode (BINOP_REPEAT); }
370 { write_exp_elt_opcode (BINOP_MUL); }
374 { write_exp_elt_opcode (BINOP_DIV); }
378 { write_exp_elt_opcode (BINOP_INTDIV); }
382 { write_exp_elt_opcode (BINOP_REM); }
386 { write_exp_elt_opcode (BINOP_ADD); }
390 { write_exp_elt_opcode (BINOP_SUB); }
394 { write_exp_elt_opcode (BINOP_EQUAL); }
397 exp : exp NOTEQUAL exp
398 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
400 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
404 { write_exp_elt_opcode (BINOP_LEQ); }
408 { write_exp_elt_opcode (BINOP_GEQ); }
412 { write_exp_elt_opcode (BINOP_LESS); }
416 { write_exp_elt_opcode (BINOP_GTR); }
420 { write_exp_elt_opcode (BINOP_AND); }
424 { write_exp_elt_opcode (BINOP_AND); }
428 { write_exp_elt_opcode (BINOP_OR); }
432 { write_exp_elt_opcode (BINOP_ASSIGN); }
439 { write_exp_elt_opcode (OP_BOOL);
440 write_exp_elt_longcst ((LONGEST) $1);
441 write_exp_elt_opcode (OP_BOOL); }
445 { write_exp_elt_opcode (OP_BOOL);
446 write_exp_elt_longcst ((LONGEST) $1);
447 write_exp_elt_opcode (OP_BOOL); }
451 { write_exp_elt_opcode (OP_LONG);
452 write_exp_elt_type (builtin_type_m2_int);
453 write_exp_elt_longcst ((LONGEST) $1);
454 write_exp_elt_opcode (OP_LONG); }
459 write_exp_elt_opcode (OP_LONG);
460 write_exp_elt_type (builtin_type_m2_card);
461 write_exp_elt_longcst ((LONGEST) $1);
462 write_exp_elt_opcode (OP_LONG);
467 { write_exp_elt_opcode (OP_LONG);
468 write_exp_elt_type (builtin_type_m2_char);
469 write_exp_elt_longcst ((LONGEST) $1);
470 write_exp_elt_opcode (OP_LONG); }
475 { write_exp_elt_opcode (OP_DOUBLE);
476 write_exp_elt_type (builtin_type_m2_real);
477 write_exp_elt_dblcst ($1);
478 write_exp_elt_opcode (OP_DOUBLE); }
484 /* The GDB internal variable $$, et al. */
486 { write_exp_elt_opcode (OP_LAST);
487 write_exp_elt_longcst ((LONGEST) $1);
488 write_exp_elt_opcode (OP_LAST); }
492 { write_exp_elt_opcode (OP_REGISTER);
493 write_exp_elt_longcst ((LONGEST) $1);
494 write_exp_elt_opcode (OP_REGISTER); }
497 exp : SIZE '(' type ')' %prec UNARY
498 { write_exp_elt_opcode (OP_LONG);
499 write_exp_elt_type (builtin_type_int);
500 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
501 write_exp_elt_opcode (OP_LONG); }
505 { write_exp_elt_opcode (OP_M2_STRING);
506 write_exp_string ($1);
507 write_exp_elt_opcode (OP_M2_STRING); }
510 /* This will be used for extensions later. Like adding modules. */
512 { $$ = SYMBOL_BLOCK_VALUE($1); }
517 = lookup_symbol (copy_name ($1), expression_context_block,
518 VAR_NAMESPACE, 0, NULL);
523 /* GDB scope operator */
524 fblock : block COLONCOLON BLOCKNAME
526 = lookup_symbol (copy_name ($3), $1,
527 VAR_NAMESPACE, 0, NULL);
528 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
529 error ("No function \"%s\" in specified context.",
535 /* Useful for assigning to PROCEDURE variables */
537 { write_exp_elt_opcode(OP_VAR_VALUE);
538 write_exp_elt_sym ($1);
539 write_exp_elt_opcode (OP_VAR_VALUE); }
542 /* GDB internal ($foo) variable */
543 variable: INTERNAL_VAR
544 { write_exp_elt_opcode (OP_INTERNALVAR);
545 write_exp_elt_intern ($1);
546 write_exp_elt_opcode (OP_INTERNALVAR); }
549 /* GDB scope operator */
550 variable: block COLONCOLON NAME
551 { struct symbol *sym;
552 sym = lookup_symbol (copy_name ($3), $1,
553 VAR_NAMESPACE, 0, NULL);
555 error ("No symbol \"%s\" in specified context.",
558 write_exp_elt_opcode (OP_VAR_VALUE);
559 write_exp_elt_sym (sym);
560 write_exp_elt_opcode (OP_VAR_VALUE); }
563 /* Base case for variables. */
565 { struct symbol *sym;
566 int is_a_field_of_this;
568 sym = lookup_symbol (copy_name ($1),
569 expression_context_block,
580 if (innermost_block == 0 ||
581 contained_in (block_found,
583 innermost_block = block_found;
585 write_exp_elt_opcode (OP_VAR_VALUE);
586 write_exp_elt_sym (sym);
587 write_exp_elt_opcode (OP_VAR_VALUE);
592 register char *arg = copy_name ($1);
594 for (i = 0; i < misc_function_count; i++)
595 if (!strcmp (misc_function_vector[i].name, arg))
598 if (i < misc_function_count)
600 enum misc_function_type mft =
601 (enum misc_function_type)
602 misc_function_vector[i].type;
604 write_exp_elt_opcode (OP_LONG);
605 write_exp_elt_type (builtin_type_int);
606 write_exp_elt_longcst ((LONGEST) misc_function_vector[i].address);
607 write_exp_elt_opcode (OP_LONG);
608 write_exp_elt_opcode (UNOP_MEMVAL);
609 if (mft == mf_data || mft == mf_bss)
610 write_exp_elt_type (builtin_type_int);
611 else if (mft == mf_text)
612 write_exp_elt_type (lookup_function_type (builtin_type_int));
614 write_exp_elt_type (builtin_type_char);
615 write_exp_elt_opcode (UNOP_MEMVAL);
617 else if (symtab_list == 0
618 && partial_symtab_list == 0)
619 error ("No symbol table is loaded. Use the \"symbol-file\" command.");
621 error ("No symbol \"%s\" in current context.",
629 { $$ = lookup_typename (copy_name ($1),
630 expression_context_block, 0); }
641 return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
648 return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
652 /* Take care of parsing a number (anything that starts with a digit).
653 Set yylval and return the token type; update lexptr.
654 LEN is the number of characters in it. */
656 /*** Needs some error checking for the float case ***/
662 register char *p = lexptr;
663 register LONGEST n = 0;
664 register LONGEST prevn = 0;
665 register int c,i,ischar=0;
666 register int base = input_radix;
667 register int len = olen;
668 int unsigned_p = number_sign == 1 ? 1 : 0;
670 extern double atof ();
677 else if(p[len-1] == 'C' || p[len-1] == 'B')
680 ischar = p[len-1] == 'C';
684 /* Scan the number */
685 for (c = 0; c < len; c++)
687 if (p[c] == '.' && base == 10)
689 /* It's a float since it contains a point. */
690 yylval.dval = atof (p);
694 if (p[c] == '.' && base != 10)
695 error("Floating point numbers must be base 10.");
696 if (base == 10 && (p[c] < '0' || p[c] > '9'))
697 error("Invalid digit \'%c\' in number.",p[c]);
704 if( base == 8 && (c == '8' || c == '9'))
705 error("Invalid digit \'%c\' in octal number.",c);
706 if (c >= '0' && c <= '9')
710 if (base == 16 && c >= 'A' && c <= 'F')
718 if(!unsigned_p && number_sign == 1 && (prevn >= n))
719 unsigned_p=1; /* Try something unsigned */
720 /* Don't do the range check if n==i and i==0, since that special
721 case will give an overflow error. */
722 if(RANGE_CHECK && n!=i && i)
724 if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
725 ((!unsigned_p && number_sign==-1) && -prevn <= -n))
726 range_error("Overflow on numeric constant.");
732 if(*p == 'B' || *p == 'C' || *p == 'H')
733 lexptr++; /* Advance past B,C or H */
740 else if ( unsigned_p && number_sign == 1)
745 else if((unsigned_p && (n<0))) {
746 range_error("Overflow on numeric constant -- number too large.");
747 /* But, this can return if range_check == range_warn. */
770 /* Some specific keywords */
777 static struct keyword keytab[] =
780 {"IN", IN },/* Note space after IN */
799 {"FLOAT", FLOAT_FUNC },
804 /* Read one token, getting characters through lexptr. */
806 /* This is where we will check to make sure that the language and the operators used are
813 register int namelen;
815 register char *tokstart;
823 /* See if it is a special token of length 2 */
824 for( i = 0 ; i < sizeof tokentab2 / sizeof tokentab2[0] ; i++)
825 if(!strncmp(tokentab2[i].name, tokstart, 2))
828 return tokentab2[i].token;
831 switch (c = *tokstart)
848 if (paren_depth == 0)
855 if (comma_terminates && paren_depth == 0)
861 /* Might be a floating point number. */
862 if (lexptr[1] >= '0' && lexptr[1] <= '9')
863 break; /* Falls into number code. */
870 /* These are character tokens that appear as-is in the YACC grammar */
893 for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
896 c = tokstart[++namelen];
897 if (c >= '0' && c <= '9')
899 c = tokstart[++namelen];
900 if (c >= '0' && c <= '9')
901 c = tokstart[++namelen];
905 error("Unterminated string or character constant.");
906 yylval.sval.ptr = tokstart + 1;
907 yylval.sval.length = namelen - 1;
908 lexptr += namelen + 1;
910 if(namelen == 2) /* Single character */
912 yylval.ulval = tokstart[1];
919 /* Is it a number? */
920 /* Note: We have already dealt with the case of the token '.'.
921 See case '.' above. */
922 if ((c >= '0' && c <= '9'))
925 int got_dot = 0, got_e = 0;
926 register char *p = tokstart;
931 if (!got_e && (*p == 'e' || *p == 'E'))
933 else if (!got_dot && *p == '.')
935 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
936 && (*p == '-' || *p == '+'))
937 /* This is the sign of the exponent, not the end of the
940 else if ((*p < '0' || *p > '9') &&
941 (*p < 'A' || *p > 'F') &&
942 (*p != 'H')) /* Modula-2 hexadecimal number */
945 toktype = parse_number (p - tokstart);
946 if (toktype == ERROR)
948 char *err_copy = (char *) alloca (p - tokstart + 1);
950 bcopy (tokstart, err_copy, p - tokstart);
951 err_copy[p - tokstart] = 0;
952 error ("Invalid number \"%s\".", err_copy);
958 if (!(c == '_' || c == '$'
959 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
960 /* We must have come across a bad character (e.g. ';'). */
961 error ("Invalid character '%c' in expression.", c);
963 /* It's a name. See how long it is. */
965 for (c = tokstart[namelen];
966 (c == '_' || c == '$' || (c >= '0' && c <= '9')
967 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
968 c = tokstart[++namelen])
971 /* The token "if" terminates the expression and is NOT
972 removed from the input stream. */
973 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
980 /* Handle the tokens $digits; also $ (short for $0) and $$ (short for $$1)
981 and $$digits (equivalent to $<-digits> if you could type that).
982 Make token type LAST, and put the number (the digits) in yylval. */
984 if (*tokstart == '$')
986 register int negate = 0;
988 /* Double dollar means negate the number and add -1 as well.
989 Thus $$ alone means -1. */
990 if (namelen >= 2 && tokstart[1] == '$')
997 /* Just dollars (one or two) */
998 yylval.lval = - negate;
1001 /* Is the rest of the token digits? */
1002 for (; c < namelen; c++)
1003 if (!(tokstart[c] >= '0' && tokstart[c] <= '9'))
1007 yylval.lval = atoi (tokstart + 1 + negate);
1009 yylval.lval = - yylval.lval;
1014 /* Handle tokens that refer to machine registers:
1015 $ followed by a register name. */
1017 if (*tokstart == '$') {
1018 for (c = 0; c < NUM_REGS; c++)
1019 if (namelen - 1 == strlen (reg_names[c])
1020 && !strncmp (tokstart + 1, reg_names[c], namelen - 1))
1025 for (c = 0; c < num_std_regs; c++)
1026 if (namelen - 1 == strlen (std_regs[c].name)
1027 && !strncmp (tokstart + 1, std_regs[c].name, namelen - 1))
1029 yylval.lval = std_regs[c].regnum;
1035 /* Lookup special keywords */
1036 for(i = 0 ; i < sizeof(keytab) / sizeof(keytab[0]) ; i++)
1037 if(namelen == strlen(keytab[i].keyw) && !strncmp(tokstart,keytab[i].keyw,namelen))
1038 return keytab[i].token;
1040 yylval.sval.ptr = tokstart;
1041 yylval.sval.length = namelen;
1043 /* Any other names starting in $ are debugger internal variables. */
1045 if (*tokstart == '$')
1047 yylval.ivar = (struct internalvar *) lookup_internalvar (copy_name (yylval.sval) + 1);
1048 return INTERNAL_VAR;
1052 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1053 functions. If this is not so, then ...
1054 Use token-type TYPENAME for symbols that happen to be defined
1055 currently as names of types; NAME for other symbols.
1056 The caller is not constrained to care about the distinction. */
1060 char *tmp = copy_name (yylval.sval);
1063 if (lookup_partial_symtab (tmp))
1065 sym = lookup_symbol (tmp, expression_context_block,
1066 VAR_NAMESPACE, 0, NULL);
1067 if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1069 if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
1084 case LOC_CONST_BYTES:
1094 error("internal: Undefined class in m2lex()");
1097 error("internal: Unforseen case in m2lex()");
1102 /* Built-in BOOLEAN type. This is sort of a hack. */
1103 if(!strncmp(tokstart,"TRUE",4))
1108 else if(!strncmp(tokstart,"FALSE",5))
1115 /* Must be another type of name... */
1121 make_qualname(mod,ident)
1124 char *new = xmalloc(strlen(mod)+strlen(ident)+2);
1136 printf("Parsing: %s\n",lexptr);
1138 error("Invalid syntax in expression near character '%c'.",yychar);
1140 error("Invalid syntax in expression");
1143 /* Table of operators and their precedences for printing expressions. */
1145 const static struct op_print m2_op_print_tab[] = {
1146 {"+", BINOP_ADD, PREC_ADD, 0},
1147 {"+", UNOP_PLUS, PREC_PREFIX, 0},
1148 {"-", BINOP_SUB, PREC_ADD, 0},
1149 {"-", UNOP_NEG, PREC_PREFIX, 0},
1150 {"*", BINOP_MUL, PREC_MUL, 0},
1151 {"/", BINOP_DIV, PREC_MUL, 0},
1152 {"DIV", BINOP_INTDIV, PREC_MUL, 0},
1153 {"MOD", BINOP_REM, PREC_MUL, 0},
1154 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
1155 {"OR", BINOP_OR, PREC_OR, 0},
1156 {"AND", BINOP_AND, PREC_AND, 0},
1157 {"NOT", UNOP_ZEROP, PREC_PREFIX, 0},
1158 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
1159 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
1160 {"<=", BINOP_LEQ, PREC_ORDER, 0},
1161 {">=", BINOP_GEQ, PREC_ORDER, 0},
1162 {">", BINOP_GTR, PREC_ORDER, 0},
1163 {"<", BINOP_LESS, PREC_ORDER, 0},
1164 {"^", UNOP_IND, PREC_PREFIX, 0},
1165 {"@", BINOP_REPEAT, PREC_REPEAT, 0},
1168 /* The built-in types of Modula-2. */
1170 struct type *builtin_type_m2_char;
1171 struct type *builtin_type_m2_int;
1172 struct type *builtin_type_m2_card;
1173 struct type *builtin_type_m2_real;
1174 struct type *builtin_type_m2_bool;
1176 struct type ** const (m2_builtin_types[]) =
1178 &builtin_type_m2_char,
1179 &builtin_type_m2_int,
1180 &builtin_type_m2_card,
1181 &builtin_type_m2_real,
1182 &builtin_type_m2_bool,
1186 const struct language_defn m2_language_defn = {
1192 m2_parse, /* parser */
1193 m2_error, /* parser error function */
1194 &builtin_type_m2_int, /* longest signed integral type */
1195 &builtin_type_m2_card, /* longest unsigned integral type */
1196 &builtin_type_m2_real, /* longest floating point type */
1197 "0%XH", "0%", "XH", /* Hex format string, prefix, suffix */
1198 "%oB", "%", "oB", /* Octal format string, prefix, suffix */
1199 m2_op_print_tab, /* expression operators for printing */
1203 /* Initialization for Modula-2 */
1206 _initialize_m2_exp ()
1208 /* FIXME: The code below assumes that the sizes of the basic data
1209 types are the same on the host and target machines!!! */
1211 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
1212 builtin_type_m2_int = init_type (TYPE_CODE_INT, sizeof(int), 0, "INTEGER");
1213 builtin_type_m2_card = init_type (TYPE_CODE_INT, sizeof(int), 1, "CARDINAL");
1214 builtin_type_m2_real = init_type (TYPE_CODE_FLT, sizeof(float), 0, "REAL");
1215 builtin_type_m2_char = init_type (TYPE_CODE_CHAR, sizeof(char), 1, "CHAR");
1217 builtin_type_m2_bool = init_type (TYPE_CODE_BOOL, sizeof(int), 1, "BOOLEAN");
1218 TYPE_NFIELDS(builtin_type_m2_bool) = 2;
1219 TYPE_FIELDS(builtin_type_m2_bool) =
1220 (struct field *) malloc (sizeof (struct field) * 2);
1221 TYPE_FIELD_BITPOS(builtin_type_m2_bool,0) = 0;
1222 TYPE_FIELD_NAME(builtin_type_m2_bool,0) = (char *)malloc(6);
1223 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,0),"FALSE");
1224 TYPE_FIELD_BITPOS(builtin_type_m2_bool,1) = 1;
1225 TYPE_FIELD_NAME(builtin_type_m2_bool,1) = (char *)malloc(5);
1226 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,1),"TRUE");
1228 add_language (&m2_language_defn);