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
58 #define yyerrflag m2_errflag
59 #define yynerrs m2_nerrs
66 /* The sign of the number being parsed. */
69 /* The block that the module specified by the qualifer on an identifer is
71 struct block *modblock=0;
73 char *make_qualname();
75 /* #define YYDEBUG 1 */
79 /* Although the yacc "value" of an expression is not used,
80 since the result is stored in the structure being created,
81 other node types do have values. */
86 unsigned LONGEST ulval;
93 enum exp_opcode opcode;
94 struct internalvar *ivar;
100 %type <voidval> exp type_exp start set
101 %type <voidval> variable
106 %token <lval> INT HEX ERROR
107 %token <ulval> UINT TRUE FALSE CHAR
110 /* Both NAME and TYPENAME tokens represent symbols in the input,
111 and both convey their data as strings.
112 But a TYPENAME is a string that happens to be defined as a typedef
113 or builtin type name (such as int or char)
114 and a NAME is any other symbol.
116 Contexts where this distinction is not important can use the
117 nonterminal "name", which matches either NAME or TYPENAME. */
120 %token <sval> NAME BLOCKNAME IDENT CONST VARNAME
121 %token <sval> TYPENAME
123 %token SIZE CAP ORD HIGH ABS MIN MAX FLOAT_FUNC VAL CHR ODD TRUNC
124 %token INC DEC INCL EXCL
126 /* The GDB scope operator */
129 %token <lval> LAST REGNAME
131 %token <ivar> INTERNAL_VAR
137 %left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
142 %left '*' '/' DIV MOD
144 %right '^' DOT '[' '('
147 /* This is not an actual token ; it is used for precedence.
157 { write_exp_elt_opcode(OP_TYPE);
158 write_exp_elt_type($1);
159 write_exp_elt_opcode(OP_TYPE);
165 exp : exp '^' %prec UNARY
166 { write_exp_elt_opcode (UNOP_IND); }
169 { number_sign = -1; }
172 write_exp_elt_opcode (UNOP_NEG); }
175 exp : '+' exp %prec UNARY
176 { write_exp_elt_opcode(UNOP_PLUS); }
179 exp : not_exp exp %prec UNARY
180 { write_exp_elt_opcode (UNOP_ZEROP); }
187 exp : CAP '(' exp ')'
188 { write_exp_elt_opcode (UNOP_CAP); }
191 exp : ORD '(' exp ')'
192 { write_exp_elt_opcode (UNOP_ORD); }
195 exp : ABS '(' exp ')'
196 { write_exp_elt_opcode (UNOP_ABS); }
199 exp : HIGH '(' exp ')'
200 { write_exp_elt_opcode (UNOP_HIGH); }
203 exp : MIN '(' type ')'
204 { write_exp_elt_opcode (UNOP_MIN);
205 write_exp_elt_type ($3);
206 write_exp_elt_opcode (UNOP_MIN); }
209 exp : MAX '(' type ')'
210 { write_exp_elt_opcode (UNOP_MAX);
211 write_exp_elt_type ($3);
212 write_exp_elt_opcode (UNOP_MIN); }
215 exp : FLOAT_FUNC '(' exp ')'
216 { write_exp_elt_opcode (UNOP_FLOAT); }
219 exp : VAL '(' type ',' exp ')'
220 { write_exp_elt_opcode (BINOP_VAL);
221 write_exp_elt_type ($3);
222 write_exp_elt_opcode (BINOP_VAL); }
225 exp : CHR '(' exp ')'
226 { write_exp_elt_opcode (UNOP_CHR); }
229 exp : ODD '(' exp ')'
230 { write_exp_elt_opcode (UNOP_ODD); }
233 exp : TRUNC '(' exp ')'
234 { write_exp_elt_opcode (UNOP_TRUNC); }
237 exp : SIZE exp %prec UNARY
238 { write_exp_elt_opcode (UNOP_SIZEOF); }
242 exp : INC '(' exp ')'
243 { write_exp_elt_opcode(UNOP_PREINCREMENT); }
246 exp : INC '(' exp ',' exp ')'
247 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
248 write_exp_elt_opcode(BINOP_ADD);
249 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
252 exp : DEC '(' exp ')'
253 { write_exp_elt_opcode(UNOP_PREDECREMENT);}
256 exp : DEC '(' exp ',' exp ')'
257 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
258 write_exp_elt_opcode(BINOP_SUB);
259 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
263 { write_exp_elt_opcode (STRUCTOP_STRUCT);
264 write_exp_string ($3);
265 write_exp_elt_opcode (STRUCTOP_STRUCT); }
272 { error("Sets are not implemented.");}
275 exp : INCL '(' exp ',' exp ')'
276 { error("Sets are not implemented.");}
279 exp : EXCL '(' exp ',' exp ')'
280 { error("Sets are not implemented.");}
282 set : '{' arglist '}'
283 { error("Sets are not implemented.");}
284 | type '{' arglist '}'
285 { error("Sets are not implemented.");}
289 /* Modula-2 array subscript notation [a,b,c...] */
291 /* This function just saves the number of arguments
292 that follow in the list. It is *not* specific to
295 non_empty_arglist ']' %prec DOT
296 { write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT);
297 write_exp_elt_longcst ((LONGEST) end_arglist());
298 write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT); }
302 /* This is to save the value of arglist_len
303 being accumulated by an outer function call. */
304 { start_arglist (); }
305 arglist ')' %prec DOT
306 { write_exp_elt_opcode (OP_FUNCALL);
307 write_exp_elt_longcst ((LONGEST) end_arglist ());
308 write_exp_elt_opcode (OP_FUNCALL); }
318 arglist : arglist ',' exp %prec ABOVE_COMMA
328 : non_empty_arglist ',' exp %prec ABOVE_COMMA
333 exp : '{' type '}' exp %prec UNARY
334 { write_exp_elt_opcode (UNOP_MEMVAL);
335 write_exp_elt_type ($2);
336 write_exp_elt_opcode (UNOP_MEMVAL); }
339 exp : type '(' exp ')' %prec UNARY
340 { write_exp_elt_opcode (UNOP_CAST);
341 write_exp_elt_type ($1);
342 write_exp_elt_opcode (UNOP_CAST); }
349 /* Binary operators in order of decreasing precedence. Note that some
350 of these operators are overloaded! (ie. sets) */
354 { write_exp_elt_opcode (BINOP_REPEAT); }
358 { write_exp_elt_opcode (BINOP_MUL); }
362 { write_exp_elt_opcode (BINOP_DIV); }
366 { write_exp_elt_opcode (BINOP_INTDIV); }
370 { write_exp_elt_opcode (BINOP_REM); }
374 { write_exp_elt_opcode (BINOP_ADD); }
378 { write_exp_elt_opcode (BINOP_SUB); }
382 { write_exp_elt_opcode (BINOP_EQUAL); }
385 exp : exp NOTEQUAL exp
386 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
388 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
392 { write_exp_elt_opcode (BINOP_LEQ); }
396 { write_exp_elt_opcode (BINOP_GEQ); }
400 { write_exp_elt_opcode (BINOP_LESS); }
404 { write_exp_elt_opcode (BINOP_GTR); }
408 { write_exp_elt_opcode (BINOP_AND); }
412 { write_exp_elt_opcode (BINOP_AND); }
416 { write_exp_elt_opcode (BINOP_OR); }
420 { write_exp_elt_opcode (BINOP_ASSIGN); }
427 { write_exp_elt_opcode (OP_BOOL);
428 write_exp_elt_longcst ((LONGEST) $1);
429 write_exp_elt_opcode (OP_BOOL); }
433 { write_exp_elt_opcode (OP_BOOL);
434 write_exp_elt_longcst ((LONGEST) $1);
435 write_exp_elt_opcode (OP_BOOL); }
439 { write_exp_elt_opcode (OP_LONG);
440 write_exp_elt_type (builtin_type_m2_int);
441 write_exp_elt_longcst ((LONGEST) $1);
442 write_exp_elt_opcode (OP_LONG); }
447 write_exp_elt_opcode (OP_LONG);
448 write_exp_elt_type (builtin_type_m2_card);
449 write_exp_elt_longcst ((LONGEST) $1);
450 write_exp_elt_opcode (OP_LONG);
455 { write_exp_elt_opcode (OP_LONG);
456 write_exp_elt_type (builtin_type_m2_char);
457 write_exp_elt_longcst ((LONGEST) $1);
458 write_exp_elt_opcode (OP_LONG); }
463 { write_exp_elt_opcode (OP_DOUBLE);
464 write_exp_elt_type (builtin_type_m2_real);
465 write_exp_elt_dblcst ($1);
466 write_exp_elt_opcode (OP_DOUBLE); }
472 /* The GDB internal variable $$, et al. */
474 { write_exp_elt_opcode (OP_LAST);
475 write_exp_elt_longcst ((LONGEST) $1);
476 write_exp_elt_opcode (OP_LAST); }
480 { write_exp_elt_opcode (OP_REGISTER);
481 write_exp_elt_longcst ((LONGEST) $1);
482 write_exp_elt_opcode (OP_REGISTER); }
485 exp : SIZE '(' type ')' %prec UNARY
486 { write_exp_elt_opcode (OP_LONG);
487 write_exp_elt_type (builtin_type_int);
488 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
489 write_exp_elt_opcode (OP_LONG); }
493 { write_exp_elt_opcode (OP_M2_STRING);
494 write_exp_string ($1);
495 write_exp_elt_opcode (OP_M2_STRING); }
498 /* This will be used for extensions later. Like adding modules. */
500 { $$ = SYMBOL_BLOCK_VALUE($1); }
505 = lookup_symbol (copy_name ($1), expression_context_block,
506 VAR_NAMESPACE, 0, NULL);
511 /* GDB scope operator */
512 fblock : block COLONCOLON BLOCKNAME
514 = lookup_symbol (copy_name ($3), $1,
515 VAR_NAMESPACE, 0, NULL);
516 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
517 error ("No function \"%s\" in specified context.",
523 /* Useful for assigning to PROCEDURE variables */
525 { write_exp_elt_opcode(OP_VAR_VALUE);
526 write_exp_elt_sym ($1);
527 write_exp_elt_opcode (OP_VAR_VALUE); }
530 /* GDB internal ($foo) variable */
531 variable: INTERNAL_VAR
532 { write_exp_elt_opcode (OP_INTERNALVAR);
533 write_exp_elt_intern ($1);
534 write_exp_elt_opcode (OP_INTERNALVAR); }
537 /* GDB scope operator */
538 variable: block COLONCOLON NAME
539 { struct symbol *sym;
540 sym = lookup_symbol (copy_name ($3), $1,
541 VAR_NAMESPACE, 0, NULL);
543 error ("No symbol \"%s\" in specified context.",
546 write_exp_elt_opcode (OP_VAR_VALUE);
547 write_exp_elt_sym (sym);
548 write_exp_elt_opcode (OP_VAR_VALUE); }
551 /* Base case for variables. */
553 { struct symbol *sym;
554 int is_a_field_of_this;
556 sym = lookup_symbol (copy_name ($1),
557 expression_context_block,
568 if (innermost_block == 0 ||
569 contained_in (block_found,
571 innermost_block = block_found;
573 write_exp_elt_opcode (OP_VAR_VALUE);
574 write_exp_elt_sym (sym);
575 write_exp_elt_opcode (OP_VAR_VALUE);
580 register char *arg = copy_name ($1);
582 for (i = 0; i < misc_function_count; i++)
583 if (!strcmp (misc_function_vector[i].name, arg))
586 if (i < misc_function_count)
588 enum misc_function_type mft =
589 (enum misc_function_type)
590 misc_function_vector[i].type;
592 write_exp_elt_opcode (OP_LONG);
593 write_exp_elt_type (builtin_type_int);
594 write_exp_elt_longcst ((LONGEST) misc_function_vector[i].address);
595 write_exp_elt_opcode (OP_LONG);
596 write_exp_elt_opcode (UNOP_MEMVAL);
597 if (mft == mf_data || mft == mf_bss)
598 write_exp_elt_type (builtin_type_int);
599 else if (mft == mf_text)
600 write_exp_elt_type (lookup_function_type (builtin_type_int));
602 write_exp_elt_type (builtin_type_char);
603 write_exp_elt_opcode (UNOP_MEMVAL);
605 else if (symtab_list == 0
606 && partial_symtab_list == 0)
607 error ("No symbol table is loaded. Use the \"symbol-file\" command.");
609 error ("No symbol \"%s\" in current context.",
617 { $$ = lookup_typename (copy_name ($1),
618 expression_context_block, 0); }
629 return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
636 return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
640 /* Take care of parsing a number (anything that starts with a digit).
641 Set yylval and return the token type; update lexptr.
642 LEN is the number of characters in it. */
644 /*** Needs some error checking for the float case ***/
650 register char *p = lexptr;
651 register LONGEST n = 0;
652 register LONGEST prevn = 0;
653 register int c,i,ischar=0;
654 register int base = input_radix;
655 register int len = olen;
657 int unsigned_p = number_sign == 1 ? 1 : 0;
659 extern double atof ();
666 else if(p[len-1] == 'C' || p[len-1] == 'B')
669 ischar = p[len-1] == 'C';
673 /* Scan the number */
674 for (c = 0; c < len; c++)
676 if (p[c] == '.' && base == 10)
678 /* It's a float since it contains a point. */
679 yylval.dval = atof (p);
683 if (p[c] == '.' && base != 10)
684 error("Floating point numbers must be base 10.");
685 if (base == 10 && (p[c] < '0' || p[c] > '9'))
686 error("Invalid digit \'%c\' in number.",p[c]);
693 if( base == 8 && (c == '8' || c == '9'))
694 error("Invalid digit \'%c\' in octal number.",c);
695 if (c >= '0' && c <= '9')
699 if (base == 16 && c >= 'A' && c <= 'F')
707 if(!unsigned_p && number_sign == 1 && (prevn >= n))
708 unsigned_p=1; /* Try something unsigned */
709 /* Don't do the range check if n==i and i==0, since that special
710 case will give an overflow error. */
711 if(RANGE_CHECK && n!=i && i)
713 if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
714 ((!unsigned_p && number_sign==-1) && -prevn <= -n))
715 range_error("Overflow on numeric constant.");
721 if(*p == 'B' || *p == 'C' || *p == 'H')
722 lexptr++; /* Advance past B,C or H */
729 else if ( unsigned_p && number_sign == 1)
734 else if((unsigned_p && (n<0))) {
735 range_error("Overflow on numeric constant -- number too large.");
736 /* But, this can return if range_check == range_warn. */
759 /* Some specific keywords */
766 static struct keyword keytab[] =
769 {"IN", IN },/* Note space after IN */
788 {"FLOAT", FLOAT_FUNC },
793 /* Read one token, getting characters through lexptr. */
795 /* This is where we will check to make sure that the language and the operators used are
802 register int namelen;
804 register char *tokstart;
812 /* See if it is a special token of length 2 */
813 for( i = 0 ; i < sizeof tokentab2 / sizeof tokentab2[0] ; i++)
814 if(!strncmp(tokentab2[i].name, tokstart, 2))
817 return tokentab2[i].token;
820 switch (c = *tokstart)
837 if (paren_depth == 0)
844 if (comma_terminates && paren_depth == 0)
850 /* Might be a floating point number. */
851 if (lexptr[1] >= '0' && lexptr[1] <= '9')
852 break; /* Falls into number code. */
859 /* These are character tokens that appear as-is in the YACC grammar */
882 for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
885 c = tokstart[++namelen];
886 if (c >= '0' && c <= '9')
888 c = tokstart[++namelen];
889 if (c >= '0' && c <= '9')
890 c = tokstart[++namelen];
894 error("Unterminated string or character constant.");
895 yylval.sval.ptr = tokstart + 1;
896 yylval.sval.length = namelen - 1;
897 lexptr += namelen + 1;
899 if(namelen == 2) /* Single character */
901 yylval.ulval = tokstart[1];
908 /* Is it a number? */
909 /* Note: We have already dealt with the case of the token '.'.
910 See case '.' above. */
911 if ((c >= '0' && c <= '9'))
914 int got_dot = 0, got_e = 0;
915 register char *p = tokstart;
920 if (!got_e && (*p == 'e' || *p == 'E'))
922 else if (!got_dot && *p == '.')
924 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
925 && (*p == '-' || *p == '+'))
926 /* This is the sign of the exponent, not the end of the
929 else if ((*p < '0' || *p > '9') &&
930 (*p < 'A' || *p > 'F') &&
931 (*p != 'H')) /* Modula-2 hexadecimal number */
934 toktype = parse_number (p - tokstart);
935 if (toktype == ERROR)
937 char *err_copy = (char *) alloca (p - tokstart + 1);
939 bcopy (tokstart, err_copy, p - tokstart);
940 err_copy[p - tokstart] = 0;
941 error ("Invalid number \"%s\".", err_copy);
947 if (!(c == '_' || c == '$'
948 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
949 /* We must have come across a bad character (e.g. ';'). */
950 error ("Invalid character '%c' in expression.", c);
952 /* It's a name. See how long it is. */
954 for (c = tokstart[namelen];
955 (c == '_' || c == '$' || (c >= '0' && c <= '9')
956 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
957 c = tokstart[++namelen])
960 /* The token "if" terminates the expression and is NOT
961 removed from the input stream. */
962 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
969 /* Handle the tokens $digits; also $ (short for $0) and $$ (short for $$1)
970 and $$digits (equivalent to $<-digits> if you could type that).
971 Make token type LAST, and put the number (the digits) in yylval. */
973 if (*tokstart == '$')
975 register int negate = 0;
977 /* Double dollar means negate the number and add -1 as well.
978 Thus $$ alone means -1. */
979 if (namelen >= 2 && tokstart[1] == '$')
986 /* Just dollars (one or two) */
987 yylval.lval = - negate;
990 /* Is the rest of the token digits? */
991 for (; c < namelen; c++)
992 if (!(tokstart[c] >= '0' && tokstart[c] <= '9'))
996 yylval.lval = atoi (tokstart + 1 + negate);
998 yylval.lval = - yylval.lval;
1003 /* Handle tokens that refer to machine registers:
1004 $ followed by a register name. */
1006 if (*tokstart == '$') {
1007 for (c = 0; c < NUM_REGS; c++)
1008 if (namelen - 1 == strlen (reg_names[c])
1009 && !strncmp (tokstart + 1, reg_names[c], namelen - 1))
1014 for (c = 0; c < num_std_regs; c++)
1015 if (namelen - 1 == strlen (std_regs[c].name)
1016 && !strncmp (tokstart + 1, std_regs[c].name, namelen - 1))
1018 yylval.lval = std_regs[c].regnum;
1024 /* Lookup special keywords */
1025 for(i = 0 ; i < sizeof(keytab) / sizeof(keytab[0]) ; i++)
1026 if(namelen == strlen(keytab[i].keyw) && !strncmp(tokstart,keytab[i].keyw,namelen))
1027 return keytab[i].token;
1029 yylval.sval.ptr = tokstart;
1030 yylval.sval.length = namelen;
1032 /* Any other names starting in $ are debugger internal variables. */
1034 if (*tokstart == '$')
1036 yylval.ivar = (struct internalvar *) lookup_internalvar (copy_name (yylval.sval) + 1);
1037 return INTERNAL_VAR;
1041 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1042 functions. If this is not so, then ...
1043 Use token-type TYPENAME for symbols that happen to be defined
1044 currently as names of types; NAME for other symbols.
1045 The caller is not constrained to care about the distinction. */
1049 char *tmp = copy_name (yylval.sval);
1052 if (lookup_partial_symtab (tmp))
1054 sym = lookup_symbol (tmp, expression_context_block,
1055 VAR_NAMESPACE, 0, NULL);
1056 if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1058 if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
1073 case LOC_CONST_BYTES:
1083 error("internal: Undefined class in m2lex()");
1086 error("internal: Unforseen case in m2lex()");
1091 /* Built-in BOOLEAN type. This is sort of a hack. */
1092 if(!strncmp(tokstart,"TRUE",4))
1097 else if(!strncmp(tokstart,"FALSE",5))
1104 /* Must be another type of name... */
1110 make_qualname(mod,ident)
1113 char *new = xmalloc(strlen(mod)+strlen(ident)+2);
1125 printf("Parsing: %s\n",lexptr);
1127 error("Invalid syntax in expression near character '%c'.",yychar);
1129 error("Invalid syntax in expression");
1132 /* Table of operators and their precedences for printing expressions. */
1134 const static struct op_print m2_op_print_tab[] = {
1135 {"+", BINOP_ADD, PREC_ADD, 0},
1136 {"+", UNOP_PLUS, PREC_PREFIX, 0},
1137 {"-", BINOP_SUB, PREC_ADD, 0},
1138 {"-", UNOP_NEG, PREC_PREFIX, 0},
1139 {"*", BINOP_MUL, PREC_MUL, 0},
1140 {"/", BINOP_DIV, PREC_MUL, 0},
1141 {"DIV", BINOP_INTDIV, PREC_MUL, 0},
1142 {"MOD", BINOP_REM, PREC_MUL, 0},
1143 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
1144 {"OR", BINOP_OR, PREC_OR, 0},
1145 {"AND", BINOP_AND, PREC_AND, 0},
1146 {"NOT", UNOP_ZEROP, PREC_PREFIX, 0},
1147 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
1148 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
1149 {"<=", BINOP_LEQ, PREC_ORDER, 0},
1150 {">=", BINOP_GEQ, PREC_ORDER, 0},
1151 {">", BINOP_GTR, PREC_ORDER, 0},
1152 {"<", BINOP_LESS, PREC_ORDER, 0},
1153 {"^", UNOP_IND, PREC_PREFIX, 0},
1154 {"@", BINOP_REPEAT, PREC_REPEAT, 0},
1157 /* The built-in types of Modula-2. */
1159 struct type *builtin_type_m2_char;
1160 struct type *builtin_type_m2_int;
1161 struct type *builtin_type_m2_card;
1162 struct type *builtin_type_m2_real;
1163 struct type *builtin_type_m2_bool;
1165 struct type ** const (m2_builtin_types[]) =
1167 &builtin_type_m2_char,
1168 &builtin_type_m2_int,
1169 &builtin_type_m2_card,
1170 &builtin_type_m2_real,
1171 &builtin_type_m2_bool,
1175 const struct language_defn m2_language_defn = {
1181 m2_parse, /* parser */
1182 m2_error, /* parser error function */
1183 &builtin_type_m2_int, /* longest signed integral type */
1184 &builtin_type_m2_card, /* longest unsigned integral type */
1185 &builtin_type_m2_real, /* longest floating point type */
1186 "0%XH", "0%", "XH", /* Hex format string, prefix, suffix */
1187 "%oB", "%", "oB", /* Octal format string, prefix, suffix */
1188 m2_op_print_tab, /* expression operators for printing */
1192 /* Initialization for Modula-2 */
1195 _initialize_m2_exp ()
1197 /* FIXME: The code below assumes that the sizes of the basic data
1198 types are the same on the host and target machines!!! */
1200 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
1201 builtin_type_m2_int = init_type (TYPE_CODE_INT, sizeof(int), 0, "INTEGER");
1202 builtin_type_m2_card = init_type (TYPE_CODE_INT, sizeof(int), 1, "CARDINAL");
1203 builtin_type_m2_real = init_type (TYPE_CODE_FLT, sizeof(float), 0, "REAL");
1204 builtin_type_m2_char = init_type (TYPE_CODE_CHAR, sizeof(char), 1, "CHAR");
1206 builtin_type_m2_bool = init_type (TYPE_CODE_BOOL, sizeof(int), 1, "BOOLEAN");
1207 TYPE_NFIELDS(builtin_type_m2_bool) = 2;
1208 TYPE_FIELDS(builtin_type_m2_bool) =
1209 (struct field *) malloc (sizeof (struct field) * 2);
1210 TYPE_FIELD_BITPOS(builtin_type_m2_bool,0) = 0;
1211 TYPE_FIELD_NAME(builtin_type_m2_bool,0) = (char *)malloc(6);
1212 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,0),"FALSE");
1213 TYPE_FIELD_BITPOS(builtin_type_m2_bool,1) = 1;
1214 TYPE_FIELD_NAME(builtin_type_m2_bool,1) = (char *)malloc(5);
1215 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,1),"TRUE");
1217 add_language (&m2_language_defn);