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"
40 #include "parser-defs.h"
42 /* These MUST be included in any grammar file!!!!
43 Please choose unique names! */
44 #define yyparse m2_parse
46 #define yyerror m2_error
47 #define yylval m2_lval
48 #define yychar m2_char
49 #define yydebug m2_debug
50 #define yypact m2_pact
57 #define yyexca m2_exca
61 /* The sign of the number being parsed. */
64 /* The block that the module specified by the qualifer on an identifer is
66 struct block *modblock=0;
68 char *make_qualname();
70 /* #define YYDEBUG 1 */
74 /* Although the yacc "value" of an expression is not used,
75 since the result is stored in the structure being created,
76 other node types do have values. */
81 unsigned LONGEST ulval;
88 enum exp_opcode opcode;
89 struct internalvar *ivar;
95 %type <voidval> exp type_exp start set
96 %type <voidval> variable
101 %token <lval> INT HEX ERROR
102 %token <ulval> UINT TRUE FALSE CHAR
105 /* Both NAME and TYPENAME tokens represent symbols in the input,
106 and both convey their data as strings.
107 But a TYPENAME is a string that happens to be defined as a typedef
108 or builtin type name (such as int or char)
109 and a NAME is any other symbol.
111 Contexts where this distinction is not important can use the
112 nonterminal "name", which matches either NAME or TYPENAME. */
115 %token <sval> NAME BLOCKNAME IDENT CONST VARNAME
116 %token <sval> TYPENAME
118 %token SIZE CAP ORD HIGH ABS MIN MAX FLOAT_FUNC VAL CHR ODD TRUNC
119 %token INC DEC INCL EXCL
121 /* The GDB scope operator */
124 %token <lval> LAST REGNAME
126 %token <ivar> INTERNAL_VAR
132 %left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
137 %left '*' '/' DIV MOD
139 %right '^' DOT '[' '('
142 /* This is not an actual token ; it is used for precedence.
152 { write_exp_elt_opcode(OP_TYPE);
153 write_exp_elt_type($1);
154 write_exp_elt_opcode(OP_TYPE);
160 exp : exp '^' %prec UNARY
161 { write_exp_elt_opcode (UNOP_IND); }
164 { number_sign = -1; }
167 write_exp_elt_opcode (UNOP_NEG); }
170 exp : '+' exp %prec UNARY
171 { write_exp_elt_opcode(UNOP_PLUS); }
174 exp : not_exp exp %prec UNARY
175 { write_exp_elt_opcode (UNOP_ZEROP); }
182 exp : CAP '(' exp ')'
183 { write_exp_elt_opcode (UNOP_CAP); }
186 exp : ORD '(' exp ')'
187 { write_exp_elt_opcode (UNOP_ORD); }
190 exp : ABS '(' exp ')'
191 { write_exp_elt_opcode (UNOP_ABS); }
194 exp : HIGH '(' exp ')'
195 { write_exp_elt_opcode (UNOP_HIGH); }
198 exp : MIN '(' type ')'
199 { write_exp_elt_opcode (UNOP_MIN);
200 write_exp_elt_type ($3);
201 write_exp_elt_opcode (UNOP_MIN); }
204 exp : MAX '(' type ')'
205 { write_exp_elt_opcode (UNOP_MAX);
206 write_exp_elt_type ($3);
207 write_exp_elt_opcode (UNOP_MIN); }
210 exp : FLOAT_FUNC '(' exp ')'
211 { write_exp_elt_opcode (UNOP_FLOAT); }
214 exp : VAL '(' type ',' exp ')'
215 { write_exp_elt_opcode (BINOP_VAL);
216 write_exp_elt_type ($3);
217 write_exp_elt_opcode (BINOP_VAL); }
220 exp : CHR '(' exp ')'
221 { write_exp_elt_opcode (UNOP_CHR); }
224 exp : ODD '(' exp ')'
225 { write_exp_elt_opcode (UNOP_ODD); }
228 exp : TRUNC '(' exp ')'
229 { write_exp_elt_opcode (UNOP_TRUNC); }
232 exp : SIZE exp %prec UNARY
233 { write_exp_elt_opcode (UNOP_SIZEOF); }
237 exp : INC '(' exp ')'
238 { write_exp_elt_opcode(UNOP_PREINCREMENT); }
241 exp : INC '(' exp ',' exp ')'
242 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
243 write_exp_elt_opcode(BINOP_ADD);
244 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
247 exp : DEC '(' exp ')'
248 { write_exp_elt_opcode(UNOP_PREDECREMENT);}
251 exp : DEC '(' exp ',' exp ')'
252 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
253 write_exp_elt_opcode(BINOP_SUB);
254 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
258 { write_exp_elt_opcode (STRUCTOP_STRUCT);
259 write_exp_string ($3);
260 write_exp_elt_opcode (STRUCTOP_STRUCT); }
267 { error("Sets are not implemented.");}
270 exp : INCL '(' exp ',' exp ')'
271 { error("Sets are not implemented.");}
274 exp : EXCL '(' exp ',' exp ')'
275 { error("Sets are not implemented.");}
277 set : '{' arglist '}'
278 { error("Sets are not implemented.");}
279 | type '{' arglist '}'
280 { error("Sets are not implemented.");}
284 /* Modula-2 array subscript notation [a,b,c...] */
286 /* This function just saves the number of arguments
287 that follow in the list. It is *not* specific to
290 non_empty_arglist ']' %prec DOT
291 { write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT);
292 write_exp_elt_longcst ((LONGEST) end_arglist());
293 write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT); }
297 /* This is to save the value of arglist_len
298 being accumulated by an outer function call. */
299 { start_arglist (); }
300 arglist ')' %prec DOT
301 { write_exp_elt_opcode (OP_FUNCALL);
302 write_exp_elt_longcst ((LONGEST) end_arglist ());
303 write_exp_elt_opcode (OP_FUNCALL); }
313 arglist : arglist ',' exp %prec ABOVE_COMMA
323 : non_empty_arglist ',' exp %prec ABOVE_COMMA
328 exp : '{' type '}' exp %prec UNARY
329 { write_exp_elt_opcode (UNOP_MEMVAL);
330 write_exp_elt_type ($2);
331 write_exp_elt_opcode (UNOP_MEMVAL); }
334 exp : type '(' exp ')' %prec UNARY
335 { write_exp_elt_opcode (UNOP_CAST);
336 write_exp_elt_type ($1);
337 write_exp_elt_opcode (UNOP_CAST); }
344 /* Binary operators in order of decreasing precedence. Note that some
345 of these operators are overloaded! (ie. sets) */
349 { write_exp_elt_opcode (BINOP_REPEAT); }
353 { write_exp_elt_opcode (BINOP_MUL); }
357 { write_exp_elt_opcode (BINOP_DIV); }
361 { write_exp_elt_opcode (BINOP_INTDIV); }
365 { write_exp_elt_opcode (BINOP_REM); }
369 { write_exp_elt_opcode (BINOP_ADD); }
373 { write_exp_elt_opcode (BINOP_SUB); }
377 { write_exp_elt_opcode (BINOP_EQUAL); }
380 exp : exp NOTEQUAL exp
381 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
383 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
387 { write_exp_elt_opcode (BINOP_LEQ); }
391 { write_exp_elt_opcode (BINOP_GEQ); }
395 { write_exp_elt_opcode (BINOP_LESS); }
399 { write_exp_elt_opcode (BINOP_GTR); }
403 { write_exp_elt_opcode (BINOP_AND); }
407 { write_exp_elt_opcode (BINOP_AND); }
411 { write_exp_elt_opcode (BINOP_OR); }
415 { write_exp_elt_opcode (BINOP_ASSIGN); }
422 { write_exp_elt_opcode (OP_BOOL);
423 write_exp_elt_longcst ((LONGEST) $1);
424 write_exp_elt_opcode (OP_BOOL); }
428 { write_exp_elt_opcode (OP_BOOL);
429 write_exp_elt_longcst ((LONGEST) $1);
430 write_exp_elt_opcode (OP_BOOL); }
434 { write_exp_elt_opcode (OP_LONG);
435 write_exp_elt_type (builtin_type_m2_int);
436 write_exp_elt_longcst ((LONGEST) $1);
437 write_exp_elt_opcode (OP_LONG); }
442 write_exp_elt_opcode (OP_LONG);
443 write_exp_elt_type (builtin_type_m2_card);
444 write_exp_elt_longcst ((LONGEST) $1);
445 write_exp_elt_opcode (OP_LONG);
450 { write_exp_elt_opcode (OP_LONG);
451 write_exp_elt_type (builtin_type_m2_char);
452 write_exp_elt_longcst ((LONGEST) $1);
453 write_exp_elt_opcode (OP_LONG); }
458 { write_exp_elt_opcode (OP_DOUBLE);
459 write_exp_elt_type (builtin_type_m2_real);
460 write_exp_elt_dblcst ($1);
461 write_exp_elt_opcode (OP_DOUBLE); }
467 /* The GDB internal variable $$, et al. */
469 { write_exp_elt_opcode (OP_LAST);
470 write_exp_elt_longcst ((LONGEST) $1);
471 write_exp_elt_opcode (OP_LAST); }
475 { write_exp_elt_opcode (OP_REGISTER);
476 write_exp_elt_longcst ((LONGEST) $1);
477 write_exp_elt_opcode (OP_REGISTER); }
480 exp : SIZE '(' type ')' %prec UNARY
481 { write_exp_elt_opcode (OP_LONG);
482 write_exp_elt_type (builtin_type_int);
483 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
484 write_exp_elt_opcode (OP_LONG); }
488 { write_exp_elt_opcode (OP_M2_STRING);
489 write_exp_string ($1);
490 write_exp_elt_opcode (OP_M2_STRING); }
493 /* This will be used for extensions later. Like adding modules. */
495 { $$ = SYMBOL_BLOCK_VALUE($1); }
500 = lookup_symbol (copy_name ($1), expression_context_block,
501 VAR_NAMESPACE, 0, NULL);
506 /* GDB scope operator */
507 fblock : block COLONCOLON BLOCKNAME
509 = lookup_symbol (copy_name ($3), $1,
510 VAR_NAMESPACE, 0, NULL);
511 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
512 error ("No function \"%s\" in specified context.",
518 /* Useful for assigning to PROCEDURE variables */
520 { write_exp_elt_opcode(OP_VAR_VALUE);
521 write_exp_elt_sym ($1);
522 write_exp_elt_opcode (OP_VAR_VALUE); }
525 /* GDB internal ($foo) variable */
526 variable: INTERNAL_VAR
527 { write_exp_elt_opcode (OP_INTERNALVAR);
528 write_exp_elt_intern ($1);
529 write_exp_elt_opcode (OP_INTERNALVAR); }
532 /* GDB scope operator */
533 variable: block COLONCOLON NAME
534 { struct symbol *sym;
535 sym = lookup_symbol (copy_name ($3), $1,
536 VAR_NAMESPACE, 0, NULL);
538 error ("No symbol \"%s\" in specified context.",
541 write_exp_elt_opcode (OP_VAR_VALUE);
542 write_exp_elt_sym (sym);
543 write_exp_elt_opcode (OP_VAR_VALUE); }
546 /* Base case for variables. */
548 { struct symbol *sym;
549 int is_a_field_of_this;
551 sym = lookup_symbol (copy_name ($1),
552 expression_context_block,
563 if (innermost_block == 0 ||
564 contained_in (block_found,
566 innermost_block = block_found;
568 write_exp_elt_opcode (OP_VAR_VALUE);
569 write_exp_elt_sym (sym);
570 write_exp_elt_opcode (OP_VAR_VALUE);
575 register char *arg = copy_name ($1);
577 for (i = 0; i < misc_function_count; i++)
578 if (!strcmp (misc_function_vector[i].name, arg))
581 if (i < misc_function_count)
583 enum misc_function_type mft =
584 (enum misc_function_type)
585 misc_function_vector[i].type;
587 write_exp_elt_opcode (OP_LONG);
588 write_exp_elt_type (builtin_type_int);
589 write_exp_elt_longcst ((LONGEST) misc_function_vector[i].address);
590 write_exp_elt_opcode (OP_LONG);
591 write_exp_elt_opcode (UNOP_MEMVAL);
592 if (mft == mf_data || mft == mf_bss)
593 write_exp_elt_type (builtin_type_int);
594 else if (mft == mf_text)
595 write_exp_elt_type (lookup_function_type (builtin_type_int));
597 write_exp_elt_type (builtin_type_char);
598 write_exp_elt_opcode (UNOP_MEMVAL);
600 else if (symtab_list == 0
601 && partial_symtab_list == 0)
602 error ("No symbol table is loaded. Use the \"symbol-file\" command.");
604 error ("No symbol \"%s\" in current context.",
612 { $$ = lookup_typename (copy_name ($1),
613 expression_context_block, 0); }
624 return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
631 return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
635 /* Take care of parsing a number (anything that starts with a digit).
636 Set yylval and return the token type; update lexptr.
637 LEN is the number of characters in it. */
639 /*** Needs some error checking for the float case ***/
645 register char *p = lexptr;
646 register LONGEST n = 0;
647 register LONGEST prevn = 0;
648 register int c,i,ischar=0;
649 register int base = input_radix;
650 register int len = olen;
652 int unsigned_p = number_sign == 1 ? 1 : 0;
654 extern double atof ();
661 else if(p[len-1] == 'C' || p[len-1] == 'B')
664 ischar = p[len-1] == 'C';
668 /* Scan the number */
669 for (c = 0; c < len; c++)
671 if (p[c] == '.' && base == 10)
673 /* It's a float since it contains a point. */
674 yylval.dval = atof (p);
678 if (p[c] == '.' && base != 10)
679 error("Floating point numbers must be base 10.");
680 if (base == 10 && (p[c] < '0' || p[c] > '9'))
681 error("Invalid digit \'%c\' in number.",p[c]);
688 if( base == 8 && (c == '8' || c == '9'))
689 error("Invalid digit \'%c\' in octal number.",c);
690 if (c >= '0' && c <= '9')
694 if (base == 16 && c >= 'A' && c <= 'F')
702 if(!unsigned_p && number_sign == 1 && (prevn >= n))
703 unsigned_p=1; /* Try something unsigned */
704 /* Don't do the range check if n==i and i==0, since that special
705 case will give an overflow error. */
706 if(RANGE_CHECK && n!=i && i)
708 if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
709 ((!unsigned_p && number_sign==-1) && -prevn <= -n))
710 range_error("Overflow on numeric constant.");
716 if(*p == 'B' || *p == 'C' || *p == 'H')
717 lexptr++; /* Advance past B,C or H */
724 else if ( unsigned_p && number_sign == 1)
729 else if((unsigned_p && (n<0)))
730 range_error("Overflow on numeric constant -- number too large.");
755 /* Some specific keywords */
762 static struct keyword keytab[] =
765 {"IN", IN },/* Note space after IN */
784 {"FLOAT", FLOAT_FUNC },
789 /* Read one token, getting characters through lexptr. */
791 /* This is where we will check to make sure that the language and the operators used are
798 register int namelen;
800 register char *tokstart;
808 /* See if it is a special token of length 2 */
809 for( i = 0 ; i < sizeof tokentab2 / sizeof tokentab2[0] ; i++)
810 if(!strncmp(tokentab2[i].name, tokstart, 2))
813 return tokentab2[i].token;
816 switch (c = *tokstart)
833 if (paren_depth == 0)
840 if (comma_terminates && paren_depth == 0)
846 /* Might be a floating point number. */
847 if (lexptr[1] >= '0' && lexptr[1] <= '9')
848 break; /* Falls into number code. */
855 /* These are character tokens that appear as-is in the YACC grammar */
878 for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
881 c = tokstart[++namelen];
882 if (c >= '0' && c <= '9')
884 c = tokstart[++namelen];
885 if (c >= '0' && c <= '9')
886 c = tokstart[++namelen];
890 error("Unterminated string or character constant.");
891 yylval.sval.ptr = tokstart + 1;
892 yylval.sval.length = namelen - 1;
893 lexptr += namelen + 1;
895 if(namelen == 2) /* Single character */
897 yylval.ulval = tokstart[1];
904 /* Is it a number? */
905 /* Note: We have already dealt with the case of the token '.'.
906 See case '.' above. */
907 if ((c >= '0' && c <= '9'))
910 int got_dot = 0, got_e = 0;
911 register char *p = tokstart;
916 if (!got_e && (*p == 'e' || *p == 'E'))
918 else if (!got_dot && *p == '.')
920 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
921 && (*p == '-' || *p == '+'))
922 /* This is the sign of the exponent, not the end of the
925 else if ((*p < '0' || *p > '9') &&
926 (*p < 'A' || *p > 'F') &&
927 (*p != 'H')) /* Modula-2 hexadecimal number */
930 toktype = parse_number (p - tokstart);
931 if (toktype == ERROR)
933 char *err_copy = (char *) alloca (p - tokstart + 1);
935 bcopy (tokstart, err_copy, p - tokstart);
936 err_copy[p - tokstart] = 0;
937 error ("Invalid number \"%s\".", err_copy);
943 if (!(c == '_' || c == '$'
944 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
945 /* We must have come across a bad character (e.g. ';'). */
946 error ("Invalid character '%c' in expression.", c);
948 /* It's a name. See how long it is. */
950 for (c = tokstart[namelen];
951 (c == '_' || c == '$' || (c >= '0' && c <= '9')
952 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
953 c = tokstart[++namelen])
956 /* The token "if" terminates the expression and is NOT
957 removed from the input stream. */
958 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
965 /* Handle the tokens $digits; also $ (short for $0) and $$ (short for $$1)
966 and $$digits (equivalent to $<-digits> if you could type that).
967 Make token type LAST, and put the number (the digits) in yylval. */
969 if (*tokstart == '$')
971 register int negate = 0;
973 /* Double dollar means negate the number and add -1 as well.
974 Thus $$ alone means -1. */
975 if (namelen >= 2 && tokstart[1] == '$')
982 /* Just dollars (one or two) */
983 yylval.lval = - negate;
986 /* Is the rest of the token digits? */
987 for (; c < namelen; c++)
988 if (!(tokstart[c] >= '0' && tokstart[c] <= '9'))
992 yylval.lval = atoi (tokstart + 1 + negate);
994 yylval.lval = - yylval.lval;
999 /* Handle tokens that refer to machine registers:
1000 $ followed by a register name. */
1002 if (*tokstart == '$') {
1003 for (c = 0; c < NUM_REGS; c++)
1004 if (namelen - 1 == strlen (reg_names[c])
1005 && !strncmp (tokstart + 1, reg_names[c], namelen - 1))
1010 for (c = 0; c < num_std_regs; c++)
1011 if (namelen - 1 == strlen (std_regs[c].name)
1012 && !strncmp (tokstart + 1, std_regs[c].name, namelen - 1))
1014 yylval.lval = std_regs[c].regnum;
1020 /* Lookup special keywords */
1021 for(i = 0 ; i < sizeof(keytab) / sizeof(keytab[0]) ; i++)
1022 if(namelen == strlen(keytab[i].keyw) && !strncmp(tokstart,keytab[i].keyw,namelen))
1023 return keytab[i].token;
1025 yylval.sval.ptr = tokstart;
1026 yylval.sval.length = namelen;
1028 /* Any other names starting in $ are debugger internal variables. */
1030 if (*tokstart == '$')
1032 yylval.ivar = (struct internalvar *) lookup_internalvar (copy_name (yylval.sval) + 1);
1033 return INTERNAL_VAR;
1037 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1038 functions. If this is not so, then ...
1039 Use token-type TYPENAME for symbols that happen to be defined
1040 currently as names of types; NAME for other symbols.
1041 The caller is not constrained to care about the distinction. */
1045 char *tmp = copy_name (yylval.sval);
1048 if (lookup_partial_symtab (tmp))
1050 sym = lookup_symbol (tmp, expression_context_block,
1051 VAR_NAMESPACE, 0, NULL);
1052 if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1054 if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
1069 case LOC_CONST_BYTES:
1079 error("internal: Undefined class in m2lex()");
1082 error("internal: Unforseen case in m2lex()");
1087 /* Built-in BOOLEAN type. This is sort of a hack. */
1088 if(!strncmp(tokstart,"TRUE",4))
1093 else if(!strncmp(tokstart,"FALSE",5))
1100 /* Must be another type of name... */
1106 make_qualname(mod,ident)
1109 char *new = xmalloc(strlen(mod)+strlen(ident)+2);
1121 printf("Parsing: %s\n",lexptr);
1123 error("Invalid syntax in expression near character '%c'.",yychar);
1125 error("Invalid syntax in expression near a '%s'.",
1126 yytname[yychar-255]);
1129 /* Table of operators and their precedences for printing expressions. */
1131 const static struct op_print m2_op_print_tab[] = {
1132 {"+", BINOP_ADD, PREC_ADD, 0},
1133 {"+", UNOP_PLUS, PREC_PREFIX, 0},
1134 {"-", BINOP_SUB, PREC_ADD, 0},
1135 {"-", UNOP_NEG, PREC_PREFIX, 0},
1136 {"*", BINOP_MUL, PREC_MUL, 0},
1137 {"/", BINOP_DIV, PREC_MUL, 0},
1138 {"DIV", BINOP_INTDIV, PREC_MUL, 0},
1139 {"MOD", BINOP_REM, PREC_MUL, 0},
1140 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
1141 {"OR", BINOP_OR, PREC_OR, 0},
1142 {"AND", BINOP_AND, PREC_AND, 0},
1143 {"NOT", UNOP_ZEROP, PREC_PREFIX, 0},
1144 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
1145 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
1146 {"<=", BINOP_LEQ, PREC_ORDER, 0},
1147 {">=", BINOP_GEQ, PREC_ORDER, 0},
1148 {">", BINOP_GTR, PREC_ORDER, 0},
1149 {"<", BINOP_LESS, PREC_ORDER, 0},
1150 {"^", UNOP_IND, PREC_PREFIX, 0},
1151 {"@", BINOP_REPEAT, PREC_REPEAT, 0},
1154 /* The built-in types of Modula-2. */
1156 struct type *builtin_type_m2_char;
1157 struct type *builtin_type_m2_int;
1158 struct type *builtin_type_m2_card;
1159 struct type *builtin_type_m2_real;
1160 struct type *builtin_type_m2_bool;
1162 struct type **(m2_builtin_types[]) =
1164 &builtin_type_m2_char,
1165 &builtin_type_m2_int,
1166 &builtin_type_m2_card,
1167 &builtin_type_m2_real,
1168 &builtin_type_m2_bool,
1172 struct language_defn m2_language_defn = {
1175 &m2_builtin_types[0],
1178 m2_parse, /* parser */
1179 m2_error, /* parser error function */
1180 &builtin_type_m2_int, /* longest signed integral type */
1181 &builtin_type_m2_card, /* longest unsigned integral type */
1182 &builtin_type_m2_real, /* longest floating point type */
1183 "0%XH", "0%", "XH", /* Hex format string, prefix, suffix */
1184 "%oB", "%", "oB", /* Octal format string, prefix, suffix */
1185 m2_op_print_tab, /* expression operators for printing */
1189 /* Initialization for Modula-2 */
1192 _initialize_m2_exp ()
1194 /* FIXME: The code below assumes that the sizes of the basic data
1195 types are the same on the host and target machines!!! */
1197 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
1198 builtin_type_m2_int = init_type (TYPE_CODE_INT, sizeof(int), 0, "INTEGER");
1199 builtin_type_m2_card = init_type (TYPE_CODE_INT, sizeof(int), 1, "CARDINAL");
1200 builtin_type_m2_real = init_type (TYPE_CODE_FLT, sizeof(float), 0, "REAL");
1201 builtin_type_m2_char = init_type (TYPE_CODE_CHAR, sizeof(char), 1, "CHAR");
1203 builtin_type_m2_bool = init_type (TYPE_CODE_BOOL, sizeof(int), 1, "BOOLEAN");
1204 TYPE_NFIELDS(builtin_type_m2_bool) = 2;
1205 TYPE_FIELDS(builtin_type_m2_bool) =
1206 (struct field *) malloc (sizeof (struct field) * 2);
1207 TYPE_FIELD_BITPOS(builtin_type_m2_bool,0) = 0;
1208 TYPE_FIELD_NAME(builtin_type_m2_bool,0) = (char *)malloc(6);
1209 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,0),"FALSE");
1210 TYPE_FIELD_BITPOS(builtin_type_m2_bool,1) = 1;
1211 TYPE_FIELD_NAME(builtin_type_m2_bool,1) = (char *)malloc(5);
1212 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,1),"TRUE");
1214 add_language (&m2_language_defn);