[RFC 6/8] Modula-2 language

Sergio Durigan Junior
2012-01-15T19:06:11Z

Hello,

This is the patch for the Modula-2 language.

Thanks,

Sergio.

diff --git a/gdb/m2-exp.y b/gdb/m2-exp.y
index ef9ec8e..afa96ef 100644
--- a/gdb/m2-exp.y
+++ b/gdb/m2-exp.y
@@ -50,8 +50,8 @@
#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
#include "block.h"

-#define parse_type builtin_type (parse_gdbarch)
-#define parse_m2_type builtin_m2_type (parse_gdbarch)
+#define parse_type(ps) builtin_type (parse_gdbarch (ps))
+#define parse_m2_type(ps) builtin_m2_type (parse_gdbarch (ps))

/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
as well as gratuitiously global symbol names, so we can have multiple
@@ -107,29 +107,22 @@

#define YYFPRINTF parser_fprintf

-int yyparse (void);
+int yyparse (struct parser_state *);

-static int yylex (void);
+static int yylex (struct parser_state *);

-void yyerror (char *);
-
-#if 0
-static char *make_qualname (char *, char *);
-#endif
+void yyerror (struct parser_state *, char *);

static int parse_number (int);

/* The sign of the number being parsed. */
static int number_sign = 1;

-/* The block that the module specified by the qualifer on an identifer is
- contained in, */
-#if 0
-static struct block *modblock=0;
-#endif
-
%}

+%parse-param {struct parser_state *ps}
+%lex-param {struct parser_state *ps}
+
/* Although the yacc "value" of an expression is not used,
since the result is stored in the structure being created,
other node types do have values. */
@@ -209,31 +202,31 @@ start : exp
;

type_exp: type
- { write_exp_elt_opcode(OP_TYPE);
- write_exp_elt_type($1);
- write_exp_elt_opcode(OP_TYPE);
+ { write_exp_elt_opcode (ps, OP_TYPE);
+ write_exp_elt_type (ps, $1);
+ write_exp_elt_opcode (ps, OP_TYPE);
}
;

/* Expressions */

exp : exp '^' %prec UNARY
- { write_exp_elt_opcode (UNOP_IND); }
+ { write_exp_elt_opcode (ps, UNOP_IND); }
;

exp : '-'
{ number_sign = -1; }
exp %prec UNARY
{ number_sign = 1;
- write_exp_elt_opcode (UNOP_NEG); }
+ write_exp_elt_opcode (ps, UNOP_NEG); }
;

exp : '+' exp %prec UNARY
- { write_exp_elt_opcode(UNOP_PLUS); }
+ { write_exp_elt_opcode (ps, UNOP_PLUS); }
;

exp : not_exp exp %prec UNARY
- { write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
+ { write_exp_elt_opcode (ps, UNOP_LOGICAL_NOT); }
;

not_exp : NOT
@@ -241,88 +234,88 @@ not_exp : NOT
;

exp : CAP '(' exp ')'
- { write_exp_elt_opcode (UNOP_CAP); }
+ { write_exp_elt_opcode (ps, UNOP_CAP); }
;

exp : ORD '(' exp ')'
- { write_exp_elt_opcode (UNOP_ORD); }
+ { write_exp_elt_opcode (ps, UNOP_ORD); }
;

exp : ABS '(' exp ')'
- { write_exp_elt_opcode (UNOP_ABS); }
+ { write_exp_elt_opcode (ps, UNOP_ABS); }
;

exp : HIGH '(' exp ')'
- { write_exp_elt_opcode (UNOP_HIGH); }
+ { write_exp_elt_opcode (ps, UNOP_HIGH); }
;

exp : MIN_FUNC '(' type ')'
- { write_exp_elt_opcode (UNOP_MIN);
- write_exp_elt_type ($3);
- write_exp_elt_opcode (UNOP_MIN); }
+ { write_exp_elt_opcode (ps, UNOP_MIN);
+ write_exp_elt_type (ps, $3);
+ write_exp_elt_opcode (ps, UNOP_MIN); }
;

exp : MAX_FUNC '(' type ')'
- { write_exp_elt_opcode (UNOP_MAX);
- write_exp_elt_type ($3);
- write_exp_elt_opcode (UNOP_MAX); }
+ { write_exp_elt_opcode (ps, UNOP_MAX);
+ write_exp_elt_type (ps, $3);
+ write_exp_elt_opcode (ps, UNOP_MAX); }
;

exp : FLOAT_FUNC '(' exp ')'
- { write_exp_elt_opcode (UNOP_FLOAT); }
+ { write_exp_elt_opcode (ps, UNOP_FLOAT); }
;

exp : VAL '(' type ',' exp ')'
- { write_exp_elt_opcode (BINOP_VAL);
- write_exp_elt_type ($3);
- write_exp_elt_opcode (BINOP_VAL); }
+ { write_exp_elt_opcode (ps, BINOP_VAL);
+ write_exp_elt_type (ps, $3);
+ write_exp_elt_opcode (ps, BINOP_VAL); }
;

exp : CHR '(' exp ')'
- { write_exp_elt_opcode (UNOP_CHR); }
+ { write_exp_elt_opcode (ps, UNOP_CHR); }
;

exp : ODD '(' exp ')'
- { write_exp_elt_opcode (UNOP_ODD); }
+ { write_exp_elt_opcode (ps, UNOP_ODD); }
;

exp : TRUNC '(' exp ')'
- { write_exp_elt_opcode (UNOP_TRUNC); }
+ { write_exp_elt_opcode (ps, UNOP_TRUNC); }
;

exp : TSIZE '(' exp ')'
- { write_exp_elt_opcode (UNOP_SIZEOF); }
+ { write_exp_elt_opcode (ps, UNOP_SIZEOF); }
;

exp : SIZE exp %prec UNARY
- { write_exp_elt_opcode (UNOP_SIZEOF); }
+ { write_exp_elt_opcode (ps, UNOP_SIZEOF); }
;

exp : INC '(' exp ')'
- { write_exp_elt_opcode(UNOP_PREINCREMENT); }
+ { write_exp_elt_opcode (ps, UNOP_PREINCREMENT); }
;

exp : INC '(' exp ',' exp ')'
- { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
- write_exp_elt_opcode(BINOP_ADD);
- write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
+ { write_exp_elt_opcode (ps, BINOP_ASSIGN_MODIFY);
+ write_exp_elt_opcode (ps, BINOP_ADD);
+ write_exp_elt_opcode (ps, BINOP_ASSIGN_MODIFY); }
;

exp : DEC '(' exp ')'
- { write_exp_elt_opcode(UNOP_PREDECREMENT);}
+ { write_exp_elt_opcode (ps, UNOP_PREDECREMENT);}
;

exp : DEC '(' exp ',' exp ')'
- { write_exp_elt_opcode(BINOP_ASSIGN_MODIFY);
- write_exp_elt_opcode(BINOP_SUB);
- write_exp_elt_opcode(BINOP_ASSIGN_MODIFY); }
+ { write_exp_elt_opcode (ps, BINOP_ASSIGN_MODIFY);
+ write_exp_elt_opcode (ps, BINOP_SUB);
+ write_exp_elt_opcode (ps, BINOP_ASSIGN_MODIFY); }
;

exp : exp DOT NAME
- { write_exp_elt_opcode (STRUCTOP_STRUCT);
- write_exp_string ($3);
- write_exp_elt_opcode (STRUCTOP_STRUCT); }
+ { write_exp_elt_opcode (ps, STRUCTOP_STRUCT);
+ write_exp_string (ps, $3);
+ write_exp_elt_opcode (ps, STRUCTOP_STRUCT); }
;

exp : set
@@ -354,13 +347,13 @@ exp : exp '['
function types */
{ start_arglist(); }
non_empty_arglist ']' %prec DOT
- { write_exp_elt_opcode (MULTI_SUBSCRIPT);
- write_exp_elt_longcst ((LONGEST) end_arglist());
- write_exp_elt_opcode (MULTI_SUBSCRIPT); }
+ { write_exp_elt_opcode (ps, MULTI_SUBSCRIPT);
+ write_exp_elt_longcst (ps, (LONGEST) end_arglist());
+ write_exp_elt_opcode (ps, MULTI_SUBSCRIPT); }
;

exp : exp '[' exp ']'
- { write_exp_elt_opcode (BINOP_SUBSCRIPT); }
+ { write_exp_elt_opcode (ps, BINOP_SUBSCRIPT); }
;

exp : exp '('
@@ -368,9 +361,9 @@ exp : exp '('
being accumulated by an outer function call. */
{ start_arglist (); }
arglist ')' %prec DOT
- { write_exp_elt_opcode (OP_FUNCALL);
- write_exp_elt_longcst ((LONGEST) end_arglist ());
- write_exp_elt_opcode (OP_FUNCALL); }
+ { write_exp_elt_opcode (ps, OP_FUNCALL);
+ write_exp_elt_longcst (ps, (LONGEST) end_arglist ());
+ write_exp_elt_opcode (ps, OP_FUNCALL); }
;

arglist :
@@ -396,15 +389,15 @@ non_empty_arglist

/* GDB construct */
exp : '{' type '}' exp %prec UNARY
- { write_exp_elt_opcode (UNOP_MEMVAL);
- write_exp_elt_type ($2);
- write_exp_elt_opcode (UNOP_MEMVAL); }
+ { write_exp_elt_opcode (ps, UNOP_MEMVAL);
+ write_exp_elt_type (ps, $2);
+ write_exp_elt_opcode (ps, UNOP_MEMVAL); }
;

exp : type '(' exp ')' %prec UNARY
- { write_exp_elt_opcode (UNOP_CAST);
- write_exp_elt_type ($1);
- write_exp_elt_opcode (UNOP_CAST); }
+ { write_exp_elt_opcode (ps, UNOP_CAST);
+ write_exp_elt_type (ps, $1);
+ write_exp_elt_opcode (ps, UNOP_CAST); }
;

exp : '(' exp ')'
@@ -416,131 +409,139 @@ exp : '(' exp ')'

/* GDB construct */
exp : exp '@' exp
- { write_exp_elt_opcode (BINOP_REPEAT); }
+ { write_exp_elt_opcode (ps, BINOP_REPEAT); }
;

exp : exp '*' exp
- { write_exp_elt_opcode (BINOP_MUL); }
+ { write_exp_elt_opcode (ps, BINOP_MUL); }
;

exp : exp '/' exp
- { write_exp_elt_opcode (BINOP_DIV); }
+ { write_exp_elt_opcode (ps, BINOP_DIV); }
;

exp : exp DIV exp
- { write_exp_elt_opcode (BINOP_INTDIV); }
+ { write_exp_elt_opcode (ps, BINOP_INTDIV); }
;

exp : exp MOD exp
- { write_exp_elt_opcode (BINOP_REM); }
+ { write_exp_elt_opcode (ps, BINOP_REM); }
;

exp : exp '+' exp
- { write_exp_elt_opcode (BINOP_ADD); }
+ { write_exp_elt_opcode (ps, BINOP_ADD); }
;

exp : exp '-' exp
- { write_exp_elt_opcode (BINOP_SUB); }
+ { write_exp_elt_opcode (ps, BINOP_SUB); }
;

exp : exp '=' exp
- { write_exp_elt_opcode (BINOP_EQUAL); }
+ { write_exp_elt_opcode (ps, BINOP_EQUAL); }
;

exp : exp NOTEQUAL exp
- { write_exp_elt_opcode (BINOP_NOTEQUAL); }
+ { write_exp_elt_opcode (ps, BINOP_NOTEQUAL); }
| exp '#' exp
- { write_exp_elt_opcode (BINOP_NOTEQUAL); }
+ { write_exp_elt_opcode (ps, BINOP_NOTEQUAL); }
;

exp : exp LEQ exp
- { write_exp_elt_opcode (BINOP_LEQ); }
+ { write_exp_elt_opcode (ps, BINOP_LEQ); }
;

exp : exp GEQ exp
- { write_exp_elt_opcode (BINOP_GEQ); }
+ { write_exp_elt_opcode (ps, BINOP_GEQ); }
;

exp : exp '<' exp
- { write_exp_elt_opcode (BINOP_LESS); }
+ { write_exp_elt_opcode (ps, BINOP_LESS); }
;

exp : exp '>' exp
- { write_exp_elt_opcode (BINOP_GTR); }
+ { write_exp_elt_opcode (ps, BINOP_GTR); }
;

exp : exp LOGICAL_AND exp
- { write_exp_elt_opcode (BINOP_LOGICAL_AND); }
+ { write_exp_elt_opcode (ps, BINOP_LOGICAL_AND); }
;

exp : exp OROR exp
- { write_exp_elt_opcode (BINOP_LOGICAL_OR); }
+ { write_exp_elt_opcode (ps, BINOP_LOGICAL_OR); }
;

exp : exp ASSIGN exp
- { write_exp_elt_opcode (BINOP_ASSIGN); }
+ { write_exp_elt_opcode (ps, BINOP_ASSIGN); }
;

/* Constants */

exp : M2_TRUE
- { write_exp_elt_opcode (OP_BOOL);
- write_exp_elt_longcst ((LONGEST) $1);
- write_exp_elt_opcode (OP_BOOL); }
+ { write_exp_elt_opcode (ps, OP_BOOL);
+ write_exp_elt_longcst (ps, (LONGEST) $1);
+ write_exp_elt_opcode (ps, OP_BOOL); }
;

exp : M2_FALSE
- { write_exp_elt_opcode (OP_BOOL);
- write_exp_elt_longcst ((LONGEST) $1);
- write_exp_elt_opcode (OP_BOOL); }
+ { write_exp_elt_opcode (ps, OP_BOOL);
+ write_exp_elt_longcst (ps, (LONGEST) $1);
+ write_exp_elt_opcode (ps, OP_BOOL); }
;

exp : INT
- { write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (parse_m2_type->builtin_int);
- write_exp_elt_longcst ((LONGEST) $1);
- write_exp_elt_opcode (OP_LONG); }
+ { write_exp_elt_opcode (ps, OP_LONG);
+ write_exp_elt_type (ps,
+ parse_m2_type (ps)->builtin_int);
+ write_exp_elt_longcst (ps, (LONGEST) $1);
+ write_exp_elt_opcode (ps, OP_LONG); }
;

exp : UINT
{
- write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (parse_m2_type->builtin_card);
- write_exp_elt_longcst ((LONGEST) $1);
- write_exp_elt_opcode (OP_LONG);
+ write_exp_elt_opcode (ps, OP_LONG);
+ write_exp_elt_type (ps,
+ parse_m2_type (ps)
+ ->builtin_card);
+ write_exp_elt_longcst (ps, (LONGEST) $1);
+ write_exp_elt_opcode (ps, OP_LONG);
}
;

exp : CHAR
- { write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (parse_m2_type->builtin_char);
- write_exp_elt_longcst ((LONGEST) $1);
- write_exp_elt_opcode (OP_LONG); }
+ { write_exp_elt_opcode (ps, OP_LONG);
+ write_exp_elt_type (ps,
+ parse_m2_type (ps)
+ ->builtin_char);
+ write_exp_elt_longcst (ps, (LONGEST) $1);
+ write_exp_elt_opcode (ps, OP_LONG); }
;

exp : FLOAT
- { write_exp_elt_opcode (OP_DOUBLE);
- write_exp_elt_type (parse_m2_type->builtin_real);
- write_exp_elt_dblcst ($1);
- write_exp_elt_opcode (OP_DOUBLE); }
+ { write_exp_elt_opcode (ps, OP_DOUBLE);
+ write_exp_elt_type (ps,
+ parse_m2_type (ps)
+ ->builtin_real);
+ write_exp_elt_dblcst (ps, $1);
+ write_exp_elt_opcode (ps, OP_DOUBLE); }
;

exp : variable
;

exp : SIZE '(' type ')' %prec UNARY
- { write_exp_elt_opcode (OP_LONG);
- write_exp_elt_type (parse_type->builtin_int);
- write_exp_elt_longcst ((LONGEST) TYPE_LENGTH ($3));
- write_exp_elt_opcode (OP_LONG); }
+ { write_exp_elt_opcode (ps, OP_LONG);
+ write_exp_elt_type (ps, parse_type (ps)->builtin_int);
+ write_exp_elt_longcst (ps,
+ (LONGEST) TYPE_LENGTH ($3));
+ write_exp_elt_opcode (ps, OP_LONG); }
;

exp : STRING
- { write_exp_elt_opcode (OP_M2_STRING);
- write_exp_string ($1);
- write_exp_elt_opcode (OP_M2_STRING); }
+ { write_exp_elt_opcode (ps, OP_M2_STRING);
+ write_exp_string (ps, $1);
+ write_exp_elt_opcode (ps, OP_M2_STRING); }
;

/* This will be used for extensions later. Like adding modules. */
@@ -550,7 +551,8 @@ block : fblock

fblock : BLOCKNAME
{ struct symbol *sym
- = lookup_symbol (copy_name ($1), expression_context_block,
+ = lookup_symbol (copy_name ($1),
+ expression_context_block,
VAR_DOMAIN, 0);
$$ = sym;}
;
@@ -570,10 +572,10 @@ fblock : block COLONCOLON BLOCKNAME

/* Useful for assigning to PROCEDURE variables */
variable: fblock
- { write_exp_elt_opcode(OP_VAR_VALUE);
- write_exp_elt_block (NULL);
- write_exp_elt_sym ($1);
- write_exp_elt_opcode (OP_VAR_VALUE); }
+ { write_exp_elt_opcode (ps, OP_VAR_VALUE);
+ write_exp_elt_block (ps, NULL);
+ write_exp_elt_sym (ps, $1);
+ write_exp_elt_opcode (ps, OP_VAR_VALUE); }
;

/* GDB internal ($foo) variable */
@@ -596,11 +598,11 @@ variable: block COLONCOLON NAME
innermost_block = block_found;
}

- write_exp_elt_opcode (OP_VAR_VALUE);
+ write_exp_elt_opcode (ps, OP_VAR_VALUE);
/* block_found is set by lookup_symbol. */
- write_exp_elt_block (block_found);
- write_exp_elt_sym (sym);
- write_exp_elt_opcode (OP_VAR_VALUE); }
+ write_exp_elt_block (ps, block_found);
+ write_exp_elt_sym (ps, sym);
+ write_exp_elt_opcode (ps, OP_VAR_VALUE); }
;

/* Base case for variables. */
@@ -622,13 +624,13 @@ variable: NAME
innermost_block = block_found;
}

- write_exp_elt_opcode (OP_VAR_VALUE);
+ write_exp_elt_opcode (ps, OP_VAR_VALUE);
/* We want to use the selected frame, not
another more inner frame which happens to
be in the same block. */
- write_exp_elt_block (NULL);
- write_exp_elt_sym (sym);
- write_exp_elt_opcode (OP_VAR_VALUE);
+ write_exp_elt_block (ps, NULL);
+ write_exp_elt_sym (ps, sym);
+ write_exp_elt_opcode (ps, OP_VAR_VALUE);
}
else
{
@@ -638,7 +640,7 @@ variable: NAME
msymbol =
lookup_minimal_symbol (arg, NULL, NULL);
if (msymbol != NULL)
- write_exp_msymbol (msymbol);
+ write_exp_msymbol (ps, msymbol);
else if (!have_full_symbols () && !have_partial_symbols ())
error (_("No symbol table is loaded. Use the \"symbol-file\" command."));
else
@@ -650,7 +652,8 @@ variable: NAME

type
: TYPENAME
- { $$ = lookup_typename (parse_language, parse_gdbarch,
+ { $$ = lookup_typename (parse_language (ps),
+ parse_gdbarch (ps),
copy_name ($1),
expression_context_block, 0); }

@@ -665,8 +668,7 @@ type
/*** Needs some error checking for the float case ***/

static int
-parse_number (olen)
- int olen;
+parse_number (int olen)
{
char *p = lexptr;
LONGEST n = 0;
@@ -811,11 +813,11 @@ static struct keyword keytab[] =

/* Read one token, getting characters through lexptr. */

-/* This is where we will check to make sure that the language and the operators used are
- compatible */
+/* This is where we will check to make sure that the language and the
+ operators used are compatible */

static int
-yylex (void)
+yylex (struct parser_state *ps)
{
int c;
int namelen;
@@ -998,7 +1000,7 @@ yylex (void)

if (*tokstart == '$')
{
- write_dollar_variable (yylval.sval);
+ write_dollar_variable (ps, yylval.sval);
return INTERNAL_VAR;
}

@@ -1018,7 +1020,7 @@ yylex (void)
sym = lookup_symbol (tmp, expression_context_block, VAR_DOMAIN, 0);
if (sym && SYMBOL_CLASS (sym) == LOC_BLOCK)
return BLOCKNAME;
- if (lookup_typename (parse_language, parse_gdbarch,
+ if (lookup_typename (parse_language (ps), parse_gdbarch (ps),
copy_name (yylval.sval), expression_context_block, 1))
return TYPENAME;

@@ -1076,23 +1078,8 @@ yylex (void)
}
}

-#if 0 /* Unused */
-static char *
-make_qualname(mod,ident)
- char *mod, *ident;
-{
- char *new = malloc(strlen(mod)+strlen(ident)+2);
-
- strcpy(new,mod);
- strcat(new,".");
- strcat(new,ident);
- return new;
-}
-#endif /* 0 */
-
void
-yyerror (msg)
- char *msg;
+yyerror (struct parser_state *ps, char *msg)
{
if (prev_lexptr)
lexptr = prev_lexptr;
diff --git a/gdb/m2-lang.h b/gdb/m2-lang.h
index 2803e63..ce50701 100644
--- a/gdb/m2-lang.h
+++ b/gdb/m2-lang.h
@@ -18,9 +18,11 @@
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */

-extern int m2_parse (void); /* Defined in m2-exp.y */
+struct parser_state;

-extern void m2_error (char *); /* Defined in m2-exp.y */
+extern int m2_parse (struct parser_state *); /* Defined in m2-exp.y */
+
+extern void m2_error (struct parser_state *, char *); /* Defined in m2-exp.y */

/* Defined in m2-typeprint.c */
extern void m2_print_type (struct type *, const char *, struct ui_file *, int,