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.
31 Note that malloc's and realloc's in this file are transformed to
32 xmalloc and xrealloc respectively by the same sed command in the
33 makefile that remaps any other malloc/realloc inserted by the parser
34 generator. Doing this with #defines and trying to control the interaction
35 with include files (<malloc.h> and <stdlib.h> for example) just became
36 too messy, particularly when such includes can be inserted at random
37 times by the parser generator. */
47 #include "expression.h"
50 #include "parser-defs.h"
55 /* These MUST be included in any grammar file!!!! Please choose unique names!
56 Note that this are a combined list of variables that can be produced
57 by any one of bison, byacc, or yacc. */
58 #define yymaxdepth m2_maxdepth
59 #define yyparse m2_parse
61 #define yyerror m2_error
62 #define yylval m2_lval
63 #define yychar m2_char
64 #define yydebug m2_debug
65 #define yypact m2_pact
72 #define yyexca m2_exca
73 #define yyerrflag m2_errflag
74 #define yynerrs m2_nerrs
79 #define yystate m2_state
84 #define yylloc m2_lloc
85 #define yyss m2_yyss /* byacc */
86 #define yyssp m2_yysp /* byacc */
87 #define yyvs m2_yyvs /* byacc */
88 #define yyvsp m2_yyvsp /* byacc */
92 make_qualname PARAMS ((char *, char *));
96 parse_number PARAMS ((int));
99 yylex PARAMS ((void));
102 yyerror PARAMS ((char *));
105 yyparse PARAMS ((void));
107 /* The sign of the number being parsed. */
108 static int number_sign = 1;
110 /* The block that the module specified by the qualifer on an identifer is
113 static struct block *modblock=0;
116 /* #define YYDEBUG 1 */
119 /* Although the yacc "value" of an expression is not used,
120 since the result is stored in the structure being created,
121 other node types do have values. */
126 unsigned LONGEST ulval;
133 enum exp_opcode opcode;
134 struct internalvar *ivar;
140 %type <voidval> exp type_exp start set
141 %type <voidval> variable
146 %token <lval> INT HEX ERROR
147 %token <ulval> UINT M2_TRUE M2_FALSE CHAR
150 /* Both NAME and TYPENAME tokens represent symbols in the input,
151 and both convey their data as strings.
152 But a TYPENAME is a string that happens to be defined as a typedef
153 or builtin type name (such as int or char)
154 and a NAME is any other symbol.
156 Contexts where this distinction is not important can use the
157 nonterminal "name", which matches either NAME or TYPENAME. */
160 %token <sval> NAME BLOCKNAME IDENT VARNAME
161 %token <sval> TYPENAME
163 %token SIZE CAP ORD HIGH ABS MIN_FUNC MAX_FUNC FLOAT_FUNC VAL CHR ODD TRUNC
164 %token INC DEC INCL EXCL
166 /* The GDB scope operator */
169 %token <lval> LAST REGNAME
171 %token <ivar> INTERNAL_VAR
177 %left '<' '>' LEQ GEQ '=' NOTEQUAL '#' IN
179 %left LOGICAL_AND '&'
182 %left '*' '/' DIV MOD
184 %right '^' DOT '[' '('
187 /* This is not an actual token ; it is used for precedence.
199 { write_exp_elt_opcode(OP_TYPE);
200 write_exp_elt_type($1);
201 write_exp_elt_opcode(OP_TYPE);
207 exp : exp '^' %prec UNARY
208 { write_exp_elt_opcode (UNOP_IND); }
211 { number_sign = -1; }
214 write_exp_elt_opcode (UNOP_NEG); }
217 exp : '+' exp %prec UNARY
218 { write_exp_elt_opcode(UNOP_PLUS); }
221 exp : not_exp exp %prec UNARY
222 { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
229 exp : CAP '(' exp ')'
230 { write_exp_elt_opcode (UNOP_CAP); }
233 exp : ORD '(' exp ')'
234 { write_exp_elt_opcode (UNOP_ORD); }
237 exp : ABS '(' exp ')'
238 { write_exp_elt_opcode (UNOP_ABS); }
241 exp : HIGH '(' exp ')'
242 { write_exp_elt_opcode (UNOP_HIGH); }
245 exp : MIN_FUNC '(' type ')'
246 { write_exp_elt_opcode (UNOP_MIN);
247 write_exp_elt_type ($3);
248 write_exp_elt_opcode (UNOP_MIN); }
251 exp : MAX_FUNC '(' type ')'
252 { write_exp_elt_opcode (UNOP_MAX);
253 write_exp_elt_type ($3);
254 write_exp_elt_opcode (UNOP_MIN); }
257 exp : FLOAT_FUNC '(' exp ')'
258 { write_exp_elt_opcode (UNOP_FLOAT); }
261 exp : VAL '(' type ',' exp ')'
262 { write_exp_elt_opcode (BINOP_VAL);
263 write_exp_elt_type ($3);
264 write_exp_elt_opcode (BINOP_VAL); }
267 exp : CHR '(' exp ')'
268 { write_exp_elt_opcode (UNOP_CHR); }
271 exp : ODD '(' exp ')'
272 { write_exp_elt_opcode (UNOP_ODD); }
275 exp : TRUNC '(' exp ')'
276 { write_exp_elt_opcode (UNOP_TRUNC); }
279 exp : SIZE exp %prec UNARY
280 { write_exp_elt_opcode (UNOP_SIZEOF); }
284 exp : INC '(' exp ')'
285 { write_exp_elt_opcode(UNOP_PREINCREMENT); }
288 exp : INC '(' exp ',' exp ')'
289 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
290 write_exp_elt_opcode(BINOP_ADD);
291 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
294 exp : DEC '(' exp ')'
295 { write_exp_elt_opcode(UNOP_PREDECREMENT);}
298 exp : DEC '(' exp ',' exp ')'
299 { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
300 write_exp_elt_opcode(BINOP_SUB);
301 write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
305 { write_exp_elt_opcode (STRUCTOP_STRUCT);
306 write_exp_string ($3);
307 write_exp_elt_opcode (STRUCTOP_STRUCT); }
314 { error("Sets are not implemented.");}
317 exp : INCL '(' exp ',' exp ')'
318 { error("Sets are not implemented.");}
321 exp : EXCL '(' exp ',' exp ')'
322 { error("Sets are not implemented.");}
324 set : '{' arglist '}'
325 { error("Sets are not implemented.");}
326 | type '{' arglist '}'
327 { error("Sets are not implemented.");}
331 /* Modula-2 array subscript notation [a,b,c...] */
333 /* This function just saves the number of arguments
334 that follow in the list. It is *not* specific to
337 non_empty_arglist ']' %prec DOT
338 { write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT);
339 write_exp_elt_longcst ((LONGEST) end_arglist());
340 write_exp_elt_opcode (BINOP_MULTI_SUBSCRIPT); }
344 /* This is to save the value of arglist_len
345 being accumulated by an outer function call. */
346 { start_arglist (); }
347 arglist ')' %prec DOT
348 { write_exp_elt_opcode (OP_FUNCALL);
349 write_exp_elt_longcst ((LONGEST) end_arglist ());
350 write_exp_elt_opcode (OP_FUNCALL); }
360 arglist : arglist ',' exp %prec ABOVE_COMMA
370 : non_empty_arglist ',' exp %prec ABOVE_COMMA
375 exp : '{' type '}' exp %prec UNARY
376 { write_exp_elt_opcode (UNOP_MEMVAL);
377 write_exp_elt_type ($2);
378 write_exp_elt_opcode (UNOP_MEMVAL); }
381 exp : type '(' exp ')' %prec UNARY
382 { write_exp_elt_opcode (UNOP_CAST);
383 write_exp_elt_type ($1);
384 write_exp_elt_opcode (UNOP_CAST); }
391 /* Binary operators in order of decreasing precedence. Note that some
392 of these operators are overloaded! (ie. sets) */
396 { write_exp_elt_opcode (BINOP_REPEAT); }
400 { write_exp_elt_opcode (BINOP_MUL); }
404 { write_exp_elt_opcode (BINOP_DIV); }
408 { write_exp_elt_opcode (BINOP_INTDIV); }
412 { write_exp_elt_opcode (BINOP_REM); }
416 { write_exp_elt_opcode (BINOP_ADD); }
420 { write_exp_elt_opcode (BINOP_SUB); }
424 { write_exp_elt_opcode (BINOP_EQUAL); }
427 exp : exp NOTEQUAL exp
428 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
430 { write_exp_elt_opcode (BINOP_NOTEQUAL); }
434 { write_exp_elt_opcode (BINOP_LEQ); }
438 { write_exp_elt_opcode (BINOP_GEQ); }
442 { write_exp_elt_opcode (BINOP_LESS); }
446 { write_exp_elt_opcode (BINOP_GTR); }
449 exp : exp LOGICAL_AND exp
450 { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
454 { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
458 { write_exp_elt_opcode (BINOP_ASSIGN); }
465 { write_exp_elt_opcode (OP_BOOL);
466 write_exp_elt_longcst ((LONGEST) $1);
467 write_exp_elt_opcode (OP_BOOL); }
471 { write_exp_elt_opcode (OP_BOOL);
472 write_exp_elt_longcst ((LONGEST) $1);
473 write_exp_elt_opcode (OP_BOOL); }
477 { write_exp_elt_opcode (OP_LONG);
478 write_exp_elt_type (builtin_type_m2_int);
479 write_exp_elt_longcst ((LONGEST) $1);
480 write_exp_elt_opcode (OP_LONG); }
485 write_exp_elt_opcode (OP_LONG);
486 write_exp_elt_type (builtin_type_m2_card);
487 write_exp_elt_longcst ((LONGEST) $1);
488 write_exp_elt_opcode (OP_LONG);
493 { write_exp_elt_opcode (OP_LONG);
494 write_exp_elt_type (builtin_type_m2_char);
495 write_exp_elt_longcst ((LONGEST) $1);
496 write_exp_elt_opcode (OP_LONG); }
501 { write_exp_elt_opcode (OP_DOUBLE);
502 write_exp_elt_type (builtin_type_m2_real);
503 write_exp_elt_dblcst ($1);
504 write_exp_elt_opcode (OP_DOUBLE); }
510 /* The GDB internal variable $$, et al. */
512 { write_exp_elt_opcode (OP_LAST);
513 write_exp_elt_longcst ((LONGEST) $1);
514 write_exp_elt_opcode (OP_LAST); }
518 { write_exp_elt_opcode (OP_REGISTER);
519 write_exp_elt_longcst ((LONGEST) $1);
520 write_exp_elt_opcode (OP_REGISTER); }
523 exp : SIZE '(' type ')' %prec UNARY
524 { write_exp_elt_opcode (OP_LONG);
525 write_exp_elt_type (builtin_type_int);
526 write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
527 write_exp_elt_opcode (OP_LONG); }
531 { write_exp_elt_opcode (OP_M2_STRING);
532 write_exp_string ($1);
533 write_exp_elt_opcode (OP_M2_STRING); }
536 /* This will be used for extensions later. Like adding modules. */
538 { $$ = SYMBOL_BLOCK_VALUE($1); }
543 = lookup_symbol (copy_name ($1), expression_context_block,
544 VAR_NAMESPACE, 0, NULL);
549 /* GDB scope operator */
550 fblock : block COLONCOLON BLOCKNAME
552 = lookup_symbol (copy_name ($3), $1,
553 VAR_NAMESPACE, 0, NULL);
554 if (!tem || SYMBOL_CLASS (tem) != LOC_BLOCK)
555 error ("No function \"%s\" in specified context.",
561 /* Useful for assigning to PROCEDURE variables */
563 { write_exp_elt_opcode(OP_VAR_VALUE);
564 write_exp_elt_sym ($1);
565 write_exp_elt_opcode (OP_VAR_VALUE); }
568 /* GDB internal ($foo) variable */
569 variable: INTERNAL_VAR
570 { write_exp_elt_opcode (OP_INTERNALVAR);
571 write_exp_elt_intern ($1);
572 write_exp_elt_opcode (OP_INTERNALVAR); }
575 /* GDB scope operator */
576 variable: block COLONCOLON NAME
577 { struct symbol *sym;
578 sym = lookup_symbol (copy_name ($3), $1,
579 VAR_NAMESPACE, 0, NULL);
581 error ("No symbol \"%s\" in specified context.",
584 write_exp_elt_opcode (OP_VAR_VALUE);
585 write_exp_elt_sym (sym);
586 write_exp_elt_opcode (OP_VAR_VALUE); }
589 /* Base case for variables. */
591 { struct symbol *sym;
592 int is_a_field_of_this;
594 sym = lookup_symbol (copy_name ($1),
595 expression_context_block,
609 if (innermost_block == 0 ||
610 contained_in (block_found,
612 innermost_block = block_found;
619 case LOC_LABEL: /* maybe should go above? */
621 case LOC_CONST_BYTES:
622 /* These are listed so gcc -Wall will reveal
626 write_exp_elt_opcode (OP_VAR_VALUE);
627 write_exp_elt_sym (sym);
628 write_exp_elt_opcode (OP_VAR_VALUE);
632 struct minimal_symbol *msymbol;
633 register char *arg = copy_name ($1);
635 msymbol = lookup_minimal_symbol (arg,
636 (struct objfile *) NULL);
639 write_exp_elt_opcode (OP_LONG);
640 write_exp_elt_type (builtin_type_int);
641 write_exp_elt_longcst ((LONGEST) msymbol -> address);
642 write_exp_elt_opcode (OP_LONG);
643 write_exp_elt_opcode (UNOP_MEMVAL);
644 if (msymbol -> type == mst_data ||
645 msymbol -> type == mst_bss)
646 write_exp_elt_type (builtin_type_int);
647 else if (msymbol -> type == mst_text)
648 write_exp_elt_type (lookup_function_type (builtin_type_int));
650 write_exp_elt_type (builtin_type_char);
651 write_exp_elt_opcode (UNOP_MEMVAL);
653 else if (!have_full_symbols () && !have_partial_symbols ())
654 error ("No symbol table is loaded. Use the \"symbol-file\" command.");
656 error ("No symbol \"%s\" in current context.",
664 { $$ = lookup_typename (copy_name ($1),
665 expression_context_block, 0); }
676 return (MAX_OF_TYPE(builtin_type_m2_int) - b) < a;
683 return (MAX_OF_TYPE(builtin_type_m2_card) - b) < a;
687 /* Take care of parsing a number (anything that starts with a digit).
688 Set yylval and return the token type; update lexptr.
689 LEN is the number of characters in it. */
691 /*** Needs some error checking for the float case ***/
697 register char *p = lexptr;
698 register LONGEST n = 0;
699 register LONGEST prevn = 0;
700 register int c,i,ischar=0;
701 register int base = input_radix;
702 register int len = olen;
703 int unsigned_p = number_sign == 1 ? 1 : 0;
710 else if(p[len-1] == 'C' || p[len-1] == 'B')
713 ischar = p[len-1] == 'C';
717 /* Scan the number */
718 for (c = 0; c < len; c++)
720 if (p[c] == '.' && base == 10)
722 /* It's a float since it contains a point. */
723 yylval.dval = atof (p);
727 if (p[c] == '.' && base != 10)
728 error("Floating point numbers must be base 10.");
729 if (base == 10 && (p[c] < '0' || p[c] > '9'))
730 error("Invalid digit \'%c\' in number.",p[c]);
737 if( base == 8 && (c == '8' || c == '9'))
738 error("Invalid digit \'%c\' in octal number.",c);
739 if (c >= '0' && c <= '9')
743 if (base == 16 && c >= 'A' && c <= 'F')
751 if(!unsigned_p && number_sign == 1 && (prevn >= n))
752 unsigned_p=1; /* Try something unsigned */
753 /* Don't do the range check if n==i and i==0, since that special
754 case will give an overflow error. */
755 if(RANGE_CHECK && n!=i && i)
757 if((unsigned_p && (unsigned)prevn >= (unsigned)n) ||
758 ((!unsigned_p && number_sign==-1) && -prevn <= -n))
759 range_error("Overflow on numeric constant.");
765 if(*p == 'B' || *p == 'C' || *p == 'H')
766 lexptr++; /* Advance past B,C or H */
773 else if ( unsigned_p && number_sign == 1)
778 else if((unsigned_p && (n<0))) {
779 range_error("Overflow on numeric constant -- number too large.");
780 /* But, this can return if range_check == range_warn. */
795 { {'<', '>'}, NOTEQUAL },
796 { {':', '='}, ASSIGN },
799 { {':', ':'}, COLONCOLON },
803 /* Some specific keywords */
810 static struct keyword keytab[] =
813 {"IN", IN },/* Note space after IN */
814 {"AND", LOGICAL_AND},
832 {"FLOAT", FLOAT_FUNC },
837 /* Read one token, getting characters through lexptr. */
839 /* This is where we will check to make sure that the language and the operators used are
846 register int namelen;
848 register char *tokstart;
856 /* See if it is a special token of length 2 */
857 for( i = 0 ; i < sizeof tokentab2 / sizeof tokentab2[0] ; i++)
858 if(!strncmp(tokentab2[i].name, tokstart, 2))
861 return tokentab2[i].token;
864 switch (c = *tokstart)
881 if (paren_depth == 0)
888 if (comma_terminates && paren_depth == 0)
894 /* Might be a floating point number. */
895 if (lexptr[1] >= '0' && lexptr[1] <= '9')
896 break; /* Falls into number code. */
903 /* These are character tokens that appear as-is in the YACC grammar */
926 for (namelen = 1; (c = tokstart[namelen]) != quote && c != '\0'; namelen++)
929 c = tokstart[++namelen];
930 if (c >= '0' && c <= '9')
932 c = tokstart[++namelen];
933 if (c >= '0' && c <= '9')
934 c = tokstart[++namelen];
938 error("Unterminated string or character constant.");
939 yylval.sval.ptr = tokstart + 1;
940 yylval.sval.length = namelen - 1;
941 lexptr += namelen + 1;
943 if(namelen == 2) /* Single character */
945 yylval.ulval = tokstart[1];
952 /* Is it a number? */
953 /* Note: We have already dealt with the case of the token '.'.
954 See case '.' above. */
955 if ((c >= '0' && c <= '9'))
958 int got_dot = 0, got_e = 0;
959 register char *p = tokstart;
964 if (!got_e && (*p == 'e' || *p == 'E'))
966 else if (!got_dot && *p == '.')
968 else if (got_e && (p[-1] == 'e' || p[-1] == 'E')
969 && (*p == '-' || *p == '+'))
970 /* This is the sign of the exponent, not the end of the
973 else if ((*p < '0' || *p > '9') &&
974 (*p < 'A' || *p > 'F') &&
975 (*p != 'H')) /* Modula-2 hexadecimal number */
978 toktype = parse_number (p - tokstart);
979 if (toktype == ERROR)
981 char *err_copy = (char *) alloca (p - tokstart + 1);
983 memcpy (err_copy, tokstart, p - tokstart);
984 err_copy[p - tokstart] = 0;
985 error ("Invalid number \"%s\".", err_copy);
991 if (!(c == '_' || c == '$'
992 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')))
993 /* We must have come across a bad character (e.g. ';'). */
994 error ("Invalid character '%c' in expression.", c);
996 /* It's a name. See how long it is. */
998 for (c = tokstart[namelen];
999 (c == '_' || c == '$' || (c >= '0' && c <= '9')
1000 || (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));
1001 c = tokstart[++namelen])
1004 /* The token "if" terminates the expression and is NOT
1005 removed from the input stream. */
1006 if (namelen == 2 && tokstart[0] == 'i' && tokstart[1] == 'f')
1013 /* Handle the tokens $digits; also $ (short for $0) and $$ (short for $$1)
1014 and $$digits (equivalent to $<-digits> if you could type that).
1015 Make token type LAST, and put the number (the digits) in yylval. */
1017 if (*tokstart == '$')
1019 register int negate = 0;
1021 /* Double dollar means negate the number and add -1 as well.
1022 Thus $$ alone means -1. */
1023 if (namelen >= 2 && tokstart[1] == '$')
1030 /* Just dollars (one or two) */
1031 yylval.lval = - negate;
1034 /* Is the rest of the token digits? */
1035 for (; c < namelen; c++)
1036 if (!(tokstart[c] >= '0' && tokstart[c] <= '9'))
1040 yylval.lval = atoi (tokstart + 1 + negate);
1042 yylval.lval = - yylval.lval;
1047 /* Handle tokens that refer to machine registers:
1048 $ followed by a register name. */
1050 if (*tokstart == '$') {
1051 for (c = 0; c < NUM_REGS; c++)
1052 if (namelen - 1 == strlen (reg_names[c])
1053 && !strncmp (tokstart + 1, reg_names[c], namelen - 1))
1058 for (c = 0; c < num_std_regs; c++)
1059 if (namelen - 1 == strlen (std_regs[c].name)
1060 && !strncmp (tokstart + 1, std_regs[c].name, namelen - 1))
1062 yylval.lval = std_regs[c].regnum;
1068 /* Lookup special keywords */
1069 for(i = 0 ; i < sizeof(keytab) / sizeof(keytab[0]) ; i++)
1070 if(namelen == strlen(keytab[i].keyw) && !strncmp(tokstart,keytab[i].keyw,namelen))
1071 return keytab[i].token;
1073 yylval.sval.ptr = tokstart;
1074 yylval.sval.length = namelen;
1076 /* Any other names starting in $ are debugger internal variables. */
1078 if (*tokstart == '$')
1080 yylval.ivar = (struct internalvar *) lookup_internalvar (copy_name (yylval.sval) + 1);
1081 return INTERNAL_VAR;
1085 /* Use token-type BLOCKNAME for symbols that happen to be defined as
1086 functions. If this is not so, then ...
1087 Use token-type TYPENAME for symbols that happen to be defined
1088 currently as names of types; NAME for other symbols.
1089 The caller is not constrained to care about the distinction. */
1093 char *tmp = copy_name (yylval.sval);
1096 if (lookup_partial_symtab (tmp))
1098 sym = lookup_symbol (tmp, expression_context_block,
1099 VAR_NAMESPACE, 0, NULL);
1100 if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
1102 if (lookup_typename (copy_name (yylval.sval), expression_context_block, 1))
1117 case LOC_CONST_BYTES:
1127 error("internal: Undefined class in m2lex()");
1130 error("internal: Unforseen case in m2lex()");
1135 /* Built-in BOOLEAN type. This is sort of a hack. */
1136 if(!strncmp(tokstart,"TRUE",4))
1141 else if(!strncmp(tokstart,"FALSE",5))
1148 /* Must be another type of name... */
1155 make_qualname(mod,ident)
1158 char *new = malloc(strlen(mod)+strlen(ident)+2);
1169 char *msg; /* unused */
1171 printf("Parsing: %s\n",lexptr);
1173 error("Invalid syntax in expression near character '%c'.",yychar);
1175 error("Invalid syntax in expression");
1179 /* Print the character C on STREAM as part of the contents of a literal
1180 string whose delimiter is QUOTER. Note that that format for printing
1181 characters and strings is language specific.
1182 FIXME: This is a copy of the same function from c-exp.y. It should
1183 be replaced with a true Modula version.
1187 emit_char (c, stream, quoter)
1193 c &= 0xFF; /* Avoid sign bit follies */
1195 if (PRINT_LITERAL_FORM (c))
1197 if (c == '\\' || c == quoter)
1199 fputs_filtered ("\\", stream);
1201 fprintf_filtered (stream, "%c", c);
1208 fputs_filtered ("\\n", stream);
1211 fputs_filtered ("\\b", stream);
1214 fputs_filtered ("\\t", stream);
1217 fputs_filtered ("\\f", stream);
1220 fputs_filtered ("\\r", stream);
1223 fputs_filtered ("\\e", stream);
1226 fputs_filtered ("\\a", stream);
1229 fprintf_filtered (stream, "\\%.3o", (unsigned int) c);
1235 /* FIXME: This is a copy of the same function from c-exp.y. It should
1236 be replaced with a true Modula version. */
1239 m2_printchar (c, stream)
1243 fputs_filtered ("'", stream);
1244 emit_char (c, stream, '\'');
1245 fputs_filtered ("'", stream);
1248 /* Print the character string STRING, printing at most LENGTH characters.
1249 Printing stops early if the number hits print_max; repeat counts
1250 are printed as appropriate. Print ellipses at the end if we
1251 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
1252 FIXME: This is a copy of the same function from c-exp.y. It should
1253 be replaced with a true Modula version. */
1256 m2_printstr (stream, string, length, force_ellipses)
1259 unsigned int length;
1262 register unsigned int i;
1263 unsigned int things_printed = 0;
1266 extern int inspect_it;
1267 extern int repeat_count_threshold;
1268 extern int print_max;
1272 fputs_filtered ("\"\"", stdout);
1276 for (i = 0; i < length && things_printed < print_max; ++i)
1278 /* Position of the character we are examining
1279 to see whether it is repeated. */
1281 /* Number of repetitions we have detected so far. */
1288 fputs_filtered (", ", stream);
1294 while (rep1 < length && string[rep1] == string[i])
1300 if (reps > repeat_count_threshold)
1305 fputs_filtered ("\\\", ", stream);
1307 fputs_filtered ("\", ", stream);
1310 m2_printchar (string[i], stream);
1311 fprintf_filtered (stream, " <repeats %u times>", reps);
1313 things_printed += repeat_count_threshold;
1321 fputs_filtered ("\\\"", stream);
1323 fputs_filtered ("\"", stream);
1326 emit_char (string[i], stream, '"');
1331 /* Terminate the quotes if necessary. */
1335 fputs_filtered ("\\\"", stream);
1337 fputs_filtered ("\"", stream);
1340 if (force_ellipses || i < length)
1341 fputs_filtered ("...", stream);
1344 /* FIXME: This is a copy of c_create_fundamental_type(), before
1345 all the non-C types were stripped from it. Needs to be fixed
1346 by an experienced Modula programmer. */
1348 static struct type *
1349 m2_create_fundamental_type (objfile, typeid)
1350 struct objfile *objfile;
1353 register struct type *type = NULL;
1354 register int nbytes;
1359 /* FIXME: For now, if we are asked to produce a type not in this
1360 language, create the equivalent of a C integer type with the
1361 name "<?type?>". When all the dust settles from the type
1362 reconstruction work, this should probably become an error. */
1363 type = init_type (TYPE_CODE_INT,
1364 TARGET_INT_BIT / TARGET_CHAR_BIT,
1365 0, "<?type?>", objfile);
1366 warning ("internal error: no Modula fundamental type %d", typeid);
1369 type = init_type (TYPE_CODE_VOID,
1370 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
1371 0, "void", objfile);
1374 type = init_type (TYPE_CODE_BOOL,
1375 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
1376 TYPE_FLAG_UNSIGNED, "boolean", objfile);
1379 type = init_type (TYPE_CODE_PASCAL_ARRAY,
1380 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
1381 0, "string", objfile);
1384 type = init_type (TYPE_CODE_INT,
1385 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
1386 0, "char", objfile);
1388 case FT_SIGNED_CHAR:
1389 type = init_type (TYPE_CODE_INT,
1390 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
1391 TYPE_FLAG_SIGNED, "signed char", objfile);
1393 case FT_UNSIGNED_CHAR:
1394 type = init_type (TYPE_CODE_INT,
1395 TARGET_CHAR_BIT / TARGET_CHAR_BIT,
1396 TYPE_FLAG_UNSIGNED, "unsigned char", objfile);
1399 type = init_type (TYPE_CODE_INT,
1400 TARGET_SHORT_BIT / TARGET_CHAR_BIT,
1401 0, "short", objfile);
1403 case FT_SIGNED_SHORT:
1404 type = init_type (TYPE_CODE_INT,
1405 TARGET_SHORT_BIT / TARGET_CHAR_BIT,
1406 TYPE_FLAG_SIGNED, "short", objfile); /* FIXME-fnf */
1408 case FT_UNSIGNED_SHORT:
1409 type = init_type (TYPE_CODE_INT,
1410 TARGET_SHORT_BIT / TARGET_CHAR_BIT,
1411 TYPE_FLAG_UNSIGNED, "unsigned short", objfile);
1414 type = init_type (TYPE_CODE_INT,
1415 TARGET_INT_BIT / TARGET_CHAR_BIT,
1418 case FT_SIGNED_INTEGER:
1419 type = init_type (TYPE_CODE_INT,
1420 TARGET_INT_BIT / TARGET_CHAR_BIT,
1421 TYPE_FLAG_SIGNED, "int", objfile); /* FIXME -fnf */
1423 case FT_UNSIGNED_INTEGER:
1424 type = init_type (TYPE_CODE_INT,
1425 TARGET_INT_BIT / TARGET_CHAR_BIT,
1426 TYPE_FLAG_UNSIGNED, "unsigned int", objfile);
1428 case FT_FIXED_DECIMAL:
1429 type = init_type (TYPE_CODE_INT,
1430 TARGET_INT_BIT / TARGET_CHAR_BIT,
1431 0, "fixed decimal", objfile);
1434 type = init_type (TYPE_CODE_INT,
1435 TARGET_LONG_BIT / TARGET_CHAR_BIT,
1436 0, "long", objfile);
1438 case FT_SIGNED_LONG:
1439 type = init_type (TYPE_CODE_INT,
1440 TARGET_LONG_BIT / TARGET_CHAR_BIT,
1441 TYPE_FLAG_SIGNED, "long", objfile); /* FIXME -fnf */
1443 case FT_UNSIGNED_LONG:
1444 type = init_type (TYPE_CODE_INT,
1445 TARGET_LONG_BIT / TARGET_CHAR_BIT,
1446 TYPE_FLAG_UNSIGNED, "unsigned long", objfile);
1449 type = init_type (TYPE_CODE_INT,
1450 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
1451 0, "long long", objfile);
1453 case FT_SIGNED_LONG_LONG:
1454 type = init_type (TYPE_CODE_INT,
1455 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
1456 TYPE_FLAG_SIGNED, "signed long long", objfile);
1458 case FT_UNSIGNED_LONG_LONG:
1459 type = init_type (TYPE_CODE_INT,
1460 TARGET_LONG_LONG_BIT / TARGET_CHAR_BIT,
1461 TYPE_FLAG_UNSIGNED, "unsigned long long", objfile);
1464 type = init_type (TYPE_CODE_FLT,
1465 TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
1466 0, "float", objfile);
1468 case FT_DBL_PREC_FLOAT:
1469 type = init_type (TYPE_CODE_FLT,
1470 TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
1471 0, "double", objfile);
1473 case FT_FLOAT_DECIMAL:
1474 type = init_type (TYPE_CODE_FLT,
1475 TARGET_DOUBLE_BIT / TARGET_CHAR_BIT,
1476 0, "floating decimal", objfile);
1478 case FT_EXT_PREC_FLOAT:
1479 type = init_type (TYPE_CODE_FLT,
1480 TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT,
1481 0, "long double", objfile);
1484 type = init_type (TYPE_CODE_FLT,
1485 TARGET_COMPLEX_BIT / TARGET_CHAR_BIT,
1486 0, "complex", objfile);
1488 case FT_DBL_PREC_COMPLEX:
1489 type = init_type (TYPE_CODE_FLT,
1490 TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT,
1491 0, "double complex", objfile);
1493 case FT_EXT_PREC_COMPLEX:
1494 type = init_type (TYPE_CODE_FLT,
1495 TARGET_DOUBLE_COMPLEX_BIT / TARGET_CHAR_BIT,
1496 0, "long double complex", objfile);
1503 /* Table of operators and their precedences for printing expressions. */
1505 const static struct op_print m2_op_print_tab[] = {
1506 {"+", BINOP_ADD, PREC_ADD, 0},
1507 {"+", UNOP_PLUS, PREC_PREFIX, 0},
1508 {"-", BINOP_SUB, PREC_ADD, 0},
1509 {"-", UNOP_NEG, PREC_PREFIX, 0},
1510 {"*", BINOP_MUL, PREC_MUL, 0},
1511 {"/", BINOP_DIV, PREC_MUL, 0},
1512 {"DIV", BINOP_INTDIV, PREC_MUL, 0},
1513 {"MOD", BINOP_REM, PREC_MUL, 0},
1514 {":=", BINOP_ASSIGN, PREC_ASSIGN, 1},
1515 {"OR", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0},
1516 {"AND", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0},
1517 {"NOT", UNOP_LOGICAL_NOT, PREC_PREFIX, 0},
1518 {"=", BINOP_EQUAL, PREC_EQUAL, 0},
1519 {"<>", BINOP_NOTEQUAL, PREC_EQUAL, 0},
1520 {"<=", BINOP_LEQ, PREC_ORDER, 0},
1521 {">=", BINOP_GEQ, PREC_ORDER, 0},
1522 {">", BINOP_GTR, PREC_ORDER, 0},
1523 {"<", BINOP_LESS, PREC_ORDER, 0},
1524 {"^", UNOP_IND, PREC_PREFIX, 0},
1525 {"@", BINOP_REPEAT, PREC_REPEAT, 0},
1529 /* The built-in types of Modula-2. */
1531 struct type *builtin_type_m2_char;
1532 struct type *builtin_type_m2_int;
1533 struct type *builtin_type_m2_card;
1534 struct type *builtin_type_m2_real;
1535 struct type *builtin_type_m2_bool;
1537 struct type ** const (m2_builtin_types[]) =
1539 &builtin_type_m2_char,
1540 &builtin_type_m2_int,
1541 &builtin_type_m2_card,
1542 &builtin_type_m2_real,
1543 &builtin_type_m2_bool,
1547 const struct language_defn m2_language_defn = {
1553 m2_parse, /* parser */
1554 m2_error, /* parser error function */
1555 m2_printchar, /* Print character constant */
1556 m2_printstr, /* function to print string constant */
1557 m2_create_fundamental_type, /* Create fundamental type in this language */
1558 &builtin_type_m2_int, /* longest signed integral type */
1559 &builtin_type_m2_card, /* longest unsigned integral type */
1560 &builtin_type_m2_real, /* longest floating point type */
1561 {"", "", "", ""}, /* Binary format info */
1562 {"%oB", "", "o", "B"}, /* Octal format info */
1563 {"%d", "", "d", ""}, /* Decimal format info */
1564 {"0%XH", "0", "X", "H"}, /* Hex format info */
1565 m2_op_print_tab, /* expression operators for printing */
1569 /* Initialization for Modula-2 */
1572 _initialize_m2_exp ()
1574 /* Modula-2 "pervasive" types. NOTE: these can be redefined!!! */
1575 builtin_type_m2_int =
1576 init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
1578 "INTEGER", (struct objfile *) NULL);
1579 builtin_type_m2_card =
1580 init_type (TYPE_CODE_INT, TARGET_INT_BIT / TARGET_CHAR_BIT,
1582 "CARDINAL", (struct objfile *) NULL);
1583 builtin_type_m2_real =
1584 init_type (TYPE_CODE_FLT, TARGET_FLOAT_BIT / TARGET_CHAR_BIT,
1586 "REAL", (struct objfile *) NULL);
1587 builtin_type_m2_char =
1588 init_type (TYPE_CODE_CHAR, TARGET_CHAR_BIT / TARGET_CHAR_BIT,
1590 "CHAR", (struct objfile *) NULL);
1591 builtin_type_m2_bool =
1592 init_type (TYPE_CODE_BOOL, TARGET_INT_BIT / TARGET_CHAR_BIT,
1594 "BOOLEAN", (struct objfile *) NULL);
1596 TYPE_NFIELDS(builtin_type_m2_bool) = 2;
1597 TYPE_FIELDS(builtin_type_m2_bool) =
1598 (struct field *) malloc (sizeof (struct field) * 2);
1599 TYPE_FIELD_BITPOS(builtin_type_m2_bool,0) = 0;
1600 TYPE_FIELD_NAME(builtin_type_m2_bool,0) = (char *)malloc(6);
1601 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,0),"FALSE");
1602 TYPE_FIELD_BITPOS(builtin_type_m2_bool,1) = 1;
1603 TYPE_FIELD_NAME(builtin_type_m2_bool,1) = (char *)malloc(5);
1604 strcpy(TYPE_FIELD_NAME(builtin_type_m2_bool,1),"TRUE");
1606 add_language (&m2_language_defn);