binutils-gdb/gdb/expprint.c
Andrew Burgess 4d00f5d8f6 gdb/fortran: Add Fortran 'kind' intrinsic and keyword
The 'kind' keyword has two uses in Fortran, it is the name of a
builtin intrinsic function, and it is also a keyword used to create a
type of a specific kind.

This commit adds support for using kind as an intrinsic function, and
also adds some initial support for using kind to create types of a
specific kind.

This commit only allows the creation of the type 'character(kind=1)',
however, it will be easy enough to extend this in future to support
more type kinds.

The kind of any expression can be queried using the kind intrinsic
function.  At the moment the kind returned corresponds to the size of
the type, this matches how gfortran handles kinds.  However, the
correspondence between kind and type size depends on the compiler
and/or the specific target, so this might not be correct for
everyone.  If we want to support different compilers/targets in future
the code to compute the kind from a type will need to be updated.

gdb/ChangeLog:

	* expprint.c (dump_subexp_body_standard): Support UNOP_KIND.
	* f-exp.y: Define 'KIND' token.
	(exp): New pattern for KIND expressions.
	(ptype): Handle types with a kind extension.
	(direct_abs_decl): Extend to spot kind extensions.
	(f77_keywords): Add 'kind' to the list.
	(push_kind_type): New function.
	(convert_to_kind_type): New function.
	* f-lang.c (evaluate_subexp_f): Support UNOP_KIND.
	* parse.c (operator_length_standard): Likewise.
	* parser-defs.h (enum type_pieces): Add tp_kind.
	* std-operator.def: Add UNOP_KIND.

gdb/testsuite/ChangeLog:

	* gdb.fortran/intrinsics.exp: New file.
	* gdb.fortran/intrinsics.f90: New file.
	* gdb.fortran/type-kinds.exp: New file.
2019-03-06 18:11:31 +00:00

1173 lines
32 KiB
C

/* Print in infix form a struct expression.
Copyright (C) 1986-2019 Free Software Foundation, Inc.
This file is part of GDB.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>. */
#include "defs.h"
#include "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "value.h"
#include "language.h"
#include "parser-defs.h"
#include "user-regs.h" /* For user_reg_map_regnum_to_name. */
#include "target.h"
#include "block.h"
#include "objfiles.h"
#include "valprint.h"
#include <ctype.h>
void
print_expression (struct expression *exp, struct ui_file *stream)
{
int pc = 0;
print_subexp (exp, &pc, stream, PREC_NULL);
}
/* Print the subexpression of EXP that starts in position POS, on STREAM.
PREC is the precedence of the surrounding operator;
if the precedence of the main operator of this subexpression is less,
parentheses are needed here. */
void
print_subexp (struct expression *exp, int *pos,
struct ui_file *stream, enum precedence prec)
{
exp->language_defn->la_exp_desc->print_subexp (exp, pos, stream, prec);
}
/* Standard implementation of print_subexp for use in language_defn
vectors. */
void
print_subexp_standard (struct expression *exp, int *pos,
struct ui_file *stream, enum precedence prec)
{
unsigned tem;
const struct op_print *op_print_tab;
int pc;
unsigned nargs;
const char *op_str;
int assign_modify = 0;
enum exp_opcode opcode;
enum precedence myprec = PREC_NULL;
/* Set to 1 for a right-associative operator. */
int assoc = 0;
struct value *val;
char *tempstr = NULL;
op_print_tab = exp->language_defn->la_op_print_tab;
pc = (*pos)++;
opcode = exp->elts[pc].opcode;
switch (opcode)
{
/* Common ops */
case OP_TYPE:
(*pos) += 2;
type_print (exp->elts[pc + 1].type, "", stream, 0);
return;
case OP_SCOPE:
myprec = PREC_PREFIX;
assoc = 0;
fputs_filtered (TYPE_NAME (exp->elts[pc + 1].type), stream);
fputs_filtered ("::", stream);
nargs = longest_to_int (exp->elts[pc + 2].longconst);
(*pos) += 4 + BYTES_TO_EXP_ELEM (nargs + 1);
fputs_filtered (&exp->elts[pc + 3].string, stream);
return;
case OP_LONG:
{
struct value_print_options opts;
get_no_prettyformat_print_options (&opts);
(*pos) += 3;
value_print (value_from_longest (exp->elts[pc + 1].type,
exp->elts[pc + 2].longconst),
stream, &opts);
}
return;
case OP_FLOAT:
{
struct value_print_options opts;
get_no_prettyformat_print_options (&opts);
(*pos) += 3;
value_print (value_from_contents (exp->elts[pc + 1].type,
exp->elts[pc + 2].floatconst),
stream, &opts);
}
return;
case OP_VAR_VALUE:
{
const struct block *b;
(*pos) += 3;
b = exp->elts[pc + 1].block;
if (b != NULL
&& BLOCK_FUNCTION (b) != NULL
&& SYMBOL_PRINT_NAME (BLOCK_FUNCTION (b)) != NULL)
{
fputs_filtered (SYMBOL_PRINT_NAME (BLOCK_FUNCTION (b)), stream);
fputs_filtered ("::", stream);
}
fputs_filtered (SYMBOL_PRINT_NAME (exp->elts[pc + 2].symbol), stream);
}
return;
case OP_VAR_MSYM_VALUE:
{
(*pos) += 3;
fputs_filtered (MSYMBOL_PRINT_NAME (exp->elts[pc + 2].msymbol), stream);
}
return;
case OP_FUNC_STATIC_VAR:
{
tem = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
fputs_filtered (&exp->elts[pc + 1].string, stream);
}
return;
case OP_VAR_ENTRY_VALUE:
{
(*pos) += 2;
fprintf_filtered (stream, "%s@entry",
SYMBOL_PRINT_NAME (exp->elts[pc + 1].symbol));
}
return;
case OP_LAST:
(*pos) += 2;
fprintf_filtered (stream, "$%d",
longest_to_int (exp->elts[pc + 1].longconst));
return;
case OP_REGISTER:
{
const char *name = &exp->elts[pc + 2].string;
(*pos) += 3 + BYTES_TO_EXP_ELEM (exp->elts[pc + 1].longconst + 1);
fprintf_filtered (stream, "$%s", name);
return;
}
case OP_BOOL:
(*pos) += 2;
fprintf_filtered (stream, "%s",
longest_to_int (exp->elts[pc + 1].longconst)
? "TRUE" : "FALSE");
return;
case OP_INTERNALVAR:
(*pos) += 2;
fprintf_filtered (stream, "$%s",
internalvar_name (exp->elts[pc + 1].internalvar));
return;
case OP_FUNCALL:
case OP_F77_UNDETERMINED_ARGLIST:
(*pos) += 2;
nargs = longest_to_int (exp->elts[pc + 1].longconst);
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered (" (", stream);
for (tem = 0; tem < nargs; tem++)
{
if (tem != 0)
fputs_filtered (", ", stream);
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
}
fputs_filtered (")", stream);
return;
case OP_NAME:
nargs = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (nargs + 1);
fputs_filtered (&exp->elts[pc + 2].string, stream);
return;
case OP_STRING:
{
struct value_print_options opts;
nargs = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (nargs + 1);
/* LA_PRINT_STRING will print using the current repeat count threshold.
If necessary, we can temporarily set it to zero, or pass it as an
additional parameter to LA_PRINT_STRING. -fnf */
get_user_print_options (&opts);
LA_PRINT_STRING (stream, builtin_type (exp->gdbarch)->builtin_char,
(gdb_byte *) &exp->elts[pc + 2].string, nargs,
NULL, 0, &opts);
}
return;
case OP_OBJC_NSSTRING: /* Objective-C Foundation Class
NSString constant. */
{
struct value_print_options opts;
nargs = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (nargs + 1);
fputs_filtered ("@\"", stream);
get_user_print_options (&opts);
LA_PRINT_STRING (stream, builtin_type (exp->gdbarch)->builtin_char,
(gdb_byte *) &exp->elts[pc + 2].string, nargs,
NULL, 0, &opts);
fputs_filtered ("\"", stream);
}
return;
case OP_OBJC_MSGCALL:
{ /* Objective C message (method) call. */
gdb::unique_xmalloc_ptr<char> selector;
(*pos) += 3;
nargs = longest_to_int (exp->elts[pc + 2].longconst);
fprintf_unfiltered (stream, "[");
print_subexp (exp, pos, stream, PREC_SUFFIX);
if (0 == target_read_string (exp->elts[pc + 1].longconst,
&selector, 1024, NULL))
{
error (_("bad selector"));
return;
}
if (nargs)
{
char *s, *nextS;
s = selector.get ();
for (tem = 0; tem < nargs; tem++)
{
nextS = strchr (s, ':');
gdb_assert (nextS); /* Make sure we found ':'. */
*nextS = '\0';
fprintf_unfiltered (stream, " %s: ", s);
s = nextS + 1;
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
}
}
else
{
fprintf_unfiltered (stream, " %s", selector.get ());
}
fprintf_unfiltered (stream, "]");
return;
}
case OP_ARRAY:
(*pos) += 3;
nargs = longest_to_int (exp->elts[pc + 2].longconst);
nargs -= longest_to_int (exp->elts[pc + 1].longconst);
nargs++;
tem = 0;
if (exp->elts[pc + 4].opcode == OP_LONG
&& exp->elts[pc + 5].type
== builtin_type (exp->gdbarch)->builtin_char
&& exp->language_defn->la_language == language_c)
{
/* Attempt to print C character arrays using string syntax.
Walk through the args, picking up one character from each
of the OP_LONG expression elements. If any array element
does not match our expection of what we should find for
a simple string, revert back to array printing. Note that
the last expression element is an explicit null terminator
byte, which doesn't get printed. */
tempstr = (char *) alloca (nargs);
pc += 4;
while (tem < nargs)
{
if (exp->elts[pc].opcode != OP_LONG
|| exp->elts[pc + 1].type
!= builtin_type (exp->gdbarch)->builtin_char)
{
/* Not a simple array of char, use regular array
printing. */
tem = 0;
break;
}
else
{
tempstr[tem++] =
longest_to_int (exp->elts[pc + 2].longconst);
pc += 4;
}
}
}
if (tem > 0)
{
struct value_print_options opts;
get_user_print_options (&opts);
LA_PRINT_STRING (stream, builtin_type (exp->gdbarch)->builtin_char,
(gdb_byte *) tempstr, nargs - 1, NULL, 0, &opts);
(*pos) = pc;
}
else
{
fputs_filtered (" {", stream);
for (tem = 0; tem < nargs; tem++)
{
if (tem != 0)
{
fputs_filtered (", ", stream);
}
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
}
fputs_filtered ("}", stream);
}
return;
case TERNOP_COND:
if ((int) prec > (int) PREC_COMMA)
fputs_filtered ("(", stream);
/* Print the subexpressions, forcing parentheses
around any binary operations within them.
This is more parentheses than are strictly necessary,
but it looks clearer. */
print_subexp (exp, pos, stream, PREC_HYPER);
fputs_filtered (" ? ", stream);
print_subexp (exp, pos, stream, PREC_HYPER);
fputs_filtered (" : ", stream);
print_subexp (exp, pos, stream, PREC_HYPER);
if ((int) prec > (int) PREC_COMMA)
fputs_filtered (")", stream);
return;
case TERNOP_SLICE:
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered ("(", stream);
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (opcode == TERNOP_SLICE ? " : " : " UP ", stream);
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (")", stream);
return;
case STRUCTOP_STRUCT:
tem = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered (".", stream);
fputs_filtered (&exp->elts[pc + 2].string, stream);
return;
/* Will not occur for Modula-2. */
case STRUCTOP_PTR:
tem = longest_to_int (exp->elts[pc + 1].longconst);
(*pos) += 3 + BYTES_TO_EXP_ELEM (tem + 1);
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered ("->", stream);
fputs_filtered (&exp->elts[pc + 2].string, stream);
return;
case STRUCTOP_MEMBER:
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered (".*", stream);
print_subexp (exp, pos, stream, PREC_SUFFIX);
return;
case STRUCTOP_MPTR:
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered ("->*", stream);
print_subexp (exp, pos, stream, PREC_SUFFIX);
return;
case BINOP_SUBSCRIPT:
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered ("[", stream);
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered ("]", stream);
return;
case UNOP_POSTINCREMENT:
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered ("++", stream);
return;
case UNOP_POSTDECREMENT:
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered ("--", stream);
return;
case UNOP_CAST:
(*pos) += 2;
if ((int) prec > (int) PREC_PREFIX)
fputs_filtered ("(", stream);
fputs_filtered ("(", stream);
type_print (exp->elts[pc + 1].type, "", stream, 0);
fputs_filtered (") ", stream);
print_subexp (exp, pos, stream, PREC_PREFIX);
if ((int) prec > (int) PREC_PREFIX)
fputs_filtered (")", stream);
return;
case UNOP_CAST_TYPE:
if ((int) prec > (int) PREC_PREFIX)
fputs_filtered ("(", stream);
fputs_filtered ("(", stream);
print_subexp (exp, pos, stream, PREC_PREFIX);
fputs_filtered (") ", stream);
print_subexp (exp, pos, stream, PREC_PREFIX);
if ((int) prec > (int) PREC_PREFIX)
fputs_filtered (")", stream);
return;
case UNOP_DYNAMIC_CAST:
case UNOP_REINTERPRET_CAST:
fputs_filtered (opcode == UNOP_DYNAMIC_CAST ? "dynamic_cast"
: "reinterpret_cast", stream);
fputs_filtered ("<", stream);
print_subexp (exp, pos, stream, PREC_PREFIX);
fputs_filtered ("> (", stream);
print_subexp (exp, pos, stream, PREC_PREFIX);
fputs_filtered (")", stream);
return;
case UNOP_MEMVAL:
(*pos) += 2;
if ((int) prec > (int) PREC_PREFIX)
fputs_filtered ("(", stream);
if (TYPE_CODE (exp->elts[pc + 1].type) == TYPE_CODE_FUNC
&& exp->elts[pc + 3].opcode == OP_LONG)
{
struct value_print_options opts;
/* We have a minimal symbol fn, probably. It's encoded
as a UNOP_MEMVAL (function-type) of an OP_LONG (int, address).
Swallow the OP_LONG (including both its opcodes); ignore
its type; print the value in the type of the MEMVAL. */
(*pos) += 4;
val = value_at_lazy (exp->elts[pc + 1].type,
(CORE_ADDR) exp->elts[pc + 5].longconst);
get_no_prettyformat_print_options (&opts);
value_print (val, stream, &opts);
}
else
{
fputs_filtered ("{", stream);
type_print (exp->elts[pc + 1].type, "", stream, 0);
fputs_filtered ("} ", stream);
print_subexp (exp, pos, stream, PREC_PREFIX);
}
if ((int) prec > (int) PREC_PREFIX)
fputs_filtered (")", stream);
return;
case UNOP_MEMVAL_TYPE:
if ((int) prec > (int) PREC_PREFIX)
fputs_filtered ("(", stream);
fputs_filtered ("{", stream);
print_subexp (exp, pos, stream, PREC_PREFIX);
fputs_filtered ("} ", stream);
print_subexp (exp, pos, stream, PREC_PREFIX);
if ((int) prec > (int) PREC_PREFIX)
fputs_filtered (")", stream);
return;
case BINOP_ASSIGN_MODIFY:
opcode = exp->elts[pc + 1].opcode;
(*pos) += 2;
myprec = PREC_ASSIGN;
assoc = 1;
assign_modify = 1;
op_str = "???";
for (tem = 0; op_print_tab[tem].opcode != OP_NULL; tem++)
if (op_print_tab[tem].opcode == opcode)
{
op_str = op_print_tab[tem].string;
break;
}
if (op_print_tab[tem].opcode != opcode)
/* Not found; don't try to keep going because we don't know how
to interpret further elements. */
error (_("Invalid expression"));
break;
/* C++ ops */
case OP_THIS:
++(*pos);
if (exp->language_defn->la_name_of_this)
fputs_filtered (exp->language_defn->la_name_of_this, stream);
else
fprintf_filtered (stream, _("<language %s has no 'this'>"),
exp->language_defn->la_name);
return;
/* Modula-2 ops */
case MULTI_SUBSCRIPT:
(*pos) += 2;
nargs = longest_to_int (exp->elts[pc + 1].longconst);
print_subexp (exp, pos, stream, PREC_SUFFIX);
fprintf_unfiltered (stream, " [");
for (tem = 0; tem < nargs; tem++)
{
if (tem != 0)
fprintf_unfiltered (stream, ", ");
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
}
fprintf_unfiltered (stream, "]");
return;
case BINOP_VAL:
(*pos) += 2;
fprintf_unfiltered (stream, "VAL(");
type_print (exp->elts[pc + 1].type, "", stream, 0);
fprintf_unfiltered (stream, ",");
print_subexp (exp, pos, stream, PREC_PREFIX);
fprintf_unfiltered (stream, ")");
return;
case TYPE_INSTANCE:
{
type_instance_flags flags
= (type_instance_flag_value) longest_to_int (exp->elts[pc + 1].longconst);
LONGEST count = exp->elts[pc + 2].longconst;
/* The FLAGS. */
(*pos)++;
/* The COUNT. */
(*pos)++;
fputs_unfiltered ("TypeInstance(", stream);
while (count-- > 0)
{
type_print (exp->elts[(*pos)++].type, "", stream, 0);
if (count > 0)
fputs_unfiltered (",", stream);
}
fputs_unfiltered (",", stream);
/* Ending COUNT and ending TYPE_INSTANCE. */
(*pos) += 2;
print_subexp (exp, pos, stream, PREC_PREFIX);
if (flags & TYPE_INSTANCE_FLAG_CONST)
fputs_unfiltered (",const", stream);
if (flags & TYPE_INSTANCE_FLAG_VOLATILE)
fputs_unfiltered (",volatile", stream);
fputs_unfiltered (")", stream);
return;
}
case OP_RANGE:
{
enum range_type range_type;
range_type = (enum range_type)
longest_to_int (exp->elts[pc + 1].longconst);
*pos += 2;
if (range_type == NONE_BOUND_DEFAULT_EXCLUSIVE
|| range_type == LOW_BOUND_DEFAULT_EXCLUSIVE)
fputs_filtered ("EXCLUSIVE_", stream);
fputs_filtered ("RANGE(", stream);
if (range_type == HIGH_BOUND_DEFAULT
|| range_type == NONE_BOUND_DEFAULT
|| range_type == NONE_BOUND_DEFAULT_EXCLUSIVE)
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered ("..", stream);
if (range_type == LOW_BOUND_DEFAULT
|| range_type == NONE_BOUND_DEFAULT)
print_subexp (exp, pos, stream, PREC_ABOVE_COMMA);
fputs_filtered (")", stream);
return;
}
/* Default ops */
default:
op_str = "???";
for (tem = 0; op_print_tab[tem].opcode != OP_NULL; tem++)
if (op_print_tab[tem].opcode == opcode)
{
op_str = op_print_tab[tem].string;
myprec = op_print_tab[tem].precedence;
assoc = op_print_tab[tem].right_assoc;
break;
}
if (op_print_tab[tem].opcode != opcode)
/* Not found; don't try to keep going because we don't know how
to interpret further elements. For example, this happens
if opcode is OP_TYPE. */
error (_("Invalid expression"));
}
/* Note that PREC_BUILTIN will always emit parentheses. */
if ((int) myprec < (int) prec)
fputs_filtered ("(", stream);
if ((int) opcode > (int) BINOP_END)
{
if (assoc)
{
/* Unary postfix operator. */
print_subexp (exp, pos, stream, PREC_SUFFIX);
fputs_filtered (op_str, stream);
}
else
{
/* Unary prefix operator. */
fputs_filtered (op_str, stream);
if (myprec == PREC_BUILTIN_FUNCTION)
fputs_filtered ("(", stream);
print_subexp (exp, pos, stream, PREC_PREFIX);
if (myprec == PREC_BUILTIN_FUNCTION)
fputs_filtered (")", stream);
}
}
else
{
/* Binary operator. */
/* Print left operand.
If operator is right-associative,
increment precedence for this operand. */
print_subexp (exp, pos, stream,
(enum precedence) ((int) myprec + assoc));
/* Print the operator itself. */
if (assign_modify)
fprintf_filtered (stream, " %s= ", op_str);
else if (op_str[0] == ',')
fprintf_filtered (stream, "%s ", op_str);
else
fprintf_filtered (stream, " %s ", op_str);
/* Print right operand.
If operator is left-associative,
increment precedence for this operand. */
print_subexp (exp, pos, stream,
(enum precedence) ((int) myprec + !assoc));
}
if ((int) myprec < (int) prec)
fputs_filtered (")", stream);
}
/* Return the operator corresponding to opcode OP as
a string. NULL indicates that the opcode was not found in the
current language table. */
const char *
op_string (enum exp_opcode op)
{
int tem;
const struct op_print *op_print_tab;
op_print_tab = current_language->la_op_print_tab;
for (tem = 0; op_print_tab[tem].opcode != OP_NULL; tem++)
if (op_print_tab[tem].opcode == op)
return op_print_tab[tem].string;
return NULL;
}
/* Support for dumping the raw data from expressions in a human readable
form. */
static int dump_subexp_body (struct expression *exp, struct ui_file *, int);
/* Name for OPCODE, when it appears in expression EXP. */
const char *
op_name (struct expression *exp, enum exp_opcode opcode)
{
if (opcode >= OP_UNUSED_LAST)
{
char *cell = get_print_cell ();
xsnprintf (cell, PRINT_CELL_SIZE, "unknown opcode: %u",
unsigned (opcode));
return cell;
}
return exp->language_defn->la_exp_desc->op_name (opcode);
}
/* Default name for the standard operator OPCODE (i.e., one defined in
the definition of enum exp_opcode). */
const char *
op_name_standard (enum exp_opcode opcode)
{
switch (opcode)
{
default:
{
static char buf[30];
xsnprintf (buf, sizeof (buf), "<unknown %d>", opcode);
return buf;
}
#define OP(name) \
case name: \
return #name ;
#include "std-operator.def"
#undef OP
}
}
/* Print a raw dump of expression EXP to STREAM.
NOTE, if non-NULL, is printed as extra explanatory text. */
void
dump_raw_expression (struct expression *exp, struct ui_file *stream,
const char *note)
{
int elt;
char *eltscan;
int eltsize;
fprintf_filtered (stream, "Dump of expression @ ");
gdb_print_host_address (exp, stream);
if (note)
fprintf_filtered (stream, ", %s:", note);
fprintf_filtered (stream, "\n\tLanguage %s, %d elements, %ld bytes each.\n",
exp->language_defn->la_name, exp->nelts,
(long) sizeof (union exp_element));
fprintf_filtered (stream, "\t%5s %20s %16s %s\n", "Index", "Opcode",
"Hex Value", "String Value");
for (elt = 0; elt < exp->nelts; elt++)
{
fprintf_filtered (stream, "\t%5d ", elt);
const char *opcode_name = op_name (exp, exp->elts[elt].opcode);
fprintf_filtered (stream, "%20s ", opcode_name);
print_longest (stream, 'd', 0, exp->elts[elt].longconst);
fprintf_filtered (stream, " ");
for (eltscan = (char *) &exp->elts[elt],
eltsize = sizeof (union exp_element);
eltsize-- > 0;
eltscan++)
{
fprintf_filtered (stream, "%c",
isprint (*eltscan) ? (*eltscan & 0xFF) : '.');
}
fprintf_filtered (stream, "\n");
}
}
/* Dump the subexpression of prefix expression EXP whose operator is at
position ELT onto STREAM. Returns the position of the next
subexpression in EXP. */
int
dump_subexp (struct expression *exp, struct ui_file *stream, int elt)
{
static int indent = 0;
int i;
fprintf_filtered (stream, "\n");
fprintf_filtered (stream, "\t%5d ", elt);
for (i = 1; i <= indent; i++)
fprintf_filtered (stream, " ");
indent += 2;
fprintf_filtered (stream, "%-20s ", op_name (exp, exp->elts[elt].opcode));
elt = dump_subexp_body (exp, stream, elt);
indent -= 2;
return elt;
}
/* Dump the operands of prefix expression EXP whose opcode is at
position ELT onto STREAM. Returns the position of the next
subexpression in EXP. */
static int
dump_subexp_body (struct expression *exp, struct ui_file *stream, int elt)
{
return exp->language_defn->la_exp_desc->dump_subexp_body (exp, stream, elt);
}
/* Default value for subexp_body in exp_descriptor vector. */
int
dump_subexp_body_standard (struct expression *exp,
struct ui_file *stream, int elt)
{
int opcode = exp->elts[elt++].opcode;
switch (opcode)
{
case TERNOP_COND:
case TERNOP_SLICE:
elt = dump_subexp (exp, stream, elt);
/* FALL THROUGH */
case BINOP_ADD:
case BINOP_SUB:
case BINOP_MUL:
case BINOP_DIV:
case BINOP_REM:
case BINOP_MOD:
case BINOP_LSH:
case BINOP_RSH:
case BINOP_LOGICAL_AND:
case BINOP_LOGICAL_OR:
case BINOP_BITWISE_AND:
case BINOP_BITWISE_IOR:
case BINOP_BITWISE_XOR:
case BINOP_EQUAL:
case BINOP_NOTEQUAL:
case BINOP_LESS:
case BINOP_GTR:
case BINOP_LEQ:
case BINOP_GEQ:
case BINOP_REPEAT:
case BINOP_ASSIGN:
case BINOP_COMMA:
case BINOP_SUBSCRIPT:
case BINOP_EXP:
case BINOP_MIN:
case BINOP_MAX:
case BINOP_INTDIV:
case BINOP_ASSIGN_MODIFY:
case BINOP_VAL:
case BINOP_CONCAT:
case BINOP_END:
case STRUCTOP_MEMBER:
case STRUCTOP_MPTR:
elt = dump_subexp (exp, stream, elt);
/* FALL THROUGH */
case UNOP_NEG:
case UNOP_LOGICAL_NOT:
case UNOP_COMPLEMENT:
case UNOP_IND:
case UNOP_ADDR:
case UNOP_PREINCREMENT:
case UNOP_POSTINCREMENT:
case UNOP_PREDECREMENT:
case UNOP_POSTDECREMENT:
case UNOP_SIZEOF:
case UNOP_ALIGNOF:
case UNOP_PLUS:
case UNOP_CAP:
case UNOP_CHR:
case UNOP_ORD:
case UNOP_ABS:
case UNOP_FLOAT:
case UNOP_HIGH:
case UNOP_MAX:
case UNOP_MIN:
case UNOP_ODD:
case UNOP_TRUNC:
case UNOP_KIND:
elt = dump_subexp (exp, stream, elt);
break;
case OP_LONG:
fprintf_filtered (stream, "Type @");
gdb_print_host_address (exp->elts[elt].type, stream);
fprintf_filtered (stream, " (");
type_print (exp->elts[elt].type, NULL, stream, 0);
fprintf_filtered (stream, "), value %ld (0x%lx)",
(long) exp->elts[elt + 1].longconst,
(long) exp->elts[elt + 1].longconst);
elt += 3;
break;
case OP_FLOAT:
fprintf_filtered (stream, "Type @");
gdb_print_host_address (exp->elts[elt].type, stream);
fprintf_filtered (stream, " (");
type_print (exp->elts[elt].type, NULL, stream, 0);
fprintf_filtered (stream, "), value ");
print_floating (exp->elts[elt + 1].floatconst,
exp->elts[elt].type, stream);
elt += 3;
break;
case OP_VAR_VALUE:
fprintf_filtered (stream, "Block @");
gdb_print_host_address (exp->elts[elt].block, stream);
fprintf_filtered (stream, ", symbol @");
gdb_print_host_address (exp->elts[elt + 1].symbol, stream);
fprintf_filtered (stream, " (%s)",
SYMBOL_PRINT_NAME (exp->elts[elt + 1].symbol));
elt += 3;
break;
case OP_VAR_MSYM_VALUE:
fprintf_filtered (stream, "Objfile @");
gdb_print_host_address (exp->elts[elt].objfile, stream);
fprintf_filtered (stream, ", msymbol @");
gdb_print_host_address (exp->elts[elt + 1].msymbol, stream);
fprintf_filtered (stream, " (%s)",
MSYMBOL_PRINT_NAME (exp->elts[elt + 1].msymbol));
elt += 3;
break;
case OP_VAR_ENTRY_VALUE:
fprintf_filtered (stream, "Entry value of symbol @");
gdb_print_host_address (exp->elts[elt].symbol, stream);
fprintf_filtered (stream, " (%s)",
SYMBOL_PRINT_NAME (exp->elts[elt].symbol));
elt += 2;
break;
case OP_LAST:
fprintf_filtered (stream, "History element %ld",
(long) exp->elts[elt].longconst);
elt += 2;
break;
case OP_REGISTER:
fprintf_filtered (stream, "Register $%s", &exp->elts[elt + 1].string);
elt += 3 + BYTES_TO_EXP_ELEM (exp->elts[elt].longconst + 1);
break;
case OP_INTERNALVAR:
fprintf_filtered (stream, "Internal var @");
gdb_print_host_address (exp->elts[elt].internalvar, stream);
fprintf_filtered (stream, " (%s)",
internalvar_name (exp->elts[elt].internalvar));
elt += 2;
break;
case OP_FUNCALL:
case OP_F77_UNDETERMINED_ARGLIST:
{
int i, nargs;
nargs = longest_to_int (exp->elts[elt].longconst);
fprintf_filtered (stream, "Number of args: %d", nargs);
elt += 2;
for (i = 1; i <= nargs + 1; i++)
elt = dump_subexp (exp, stream, elt);
}
break;
case OP_ARRAY:
{
int lower, upper;
int i;
lower = longest_to_int (exp->elts[elt].longconst);
upper = longest_to_int (exp->elts[elt + 1].longconst);
fprintf_filtered (stream, "Bounds [%d:%d]", lower, upper);
elt += 3;
for (i = 1; i <= upper - lower + 1; i++)
elt = dump_subexp (exp, stream, elt);
}
break;
case UNOP_DYNAMIC_CAST:
case UNOP_REINTERPRET_CAST:
case UNOP_CAST_TYPE:
case UNOP_MEMVAL_TYPE:
fprintf_filtered (stream, " (");
elt = dump_subexp (exp, stream, elt);
fprintf_filtered (stream, ")");
elt = dump_subexp (exp, stream, elt);
break;
case UNOP_MEMVAL:
case UNOP_CAST:
fprintf_filtered (stream, "Type @");
gdb_print_host_address (exp->elts[elt].type, stream);
fprintf_filtered (stream, " (");
type_print (exp->elts[elt].type, NULL, stream, 0);
fprintf_filtered (stream, ")");
elt = dump_subexp (exp, stream, elt + 2);
break;
case OP_TYPE:
fprintf_filtered (stream, "Type @");
gdb_print_host_address (exp->elts[elt].type, stream);
fprintf_filtered (stream, " (");
type_print (exp->elts[elt].type, NULL, stream, 0);
fprintf_filtered (stream, ")");
elt += 2;
break;
case OP_TYPEOF:
case OP_DECLTYPE:
fprintf_filtered (stream, "Typeof (");
elt = dump_subexp (exp, stream, elt);
fprintf_filtered (stream, ")");
break;
case OP_TYPEID:
fprintf_filtered (stream, "typeid (");
elt = dump_subexp (exp, stream, elt);
fprintf_filtered (stream, ")");
break;
case STRUCTOP_STRUCT:
case STRUCTOP_PTR:
{
char *elem_name;
int len;
len = longest_to_int (exp->elts[elt].longconst);
elem_name = &exp->elts[elt + 1].string;
fprintf_filtered (stream, "Element name: `%.*s'", len, elem_name);
elt = dump_subexp (exp, stream, elt + 3 + BYTES_TO_EXP_ELEM (len + 1));
}
break;
case OP_SCOPE:
{
char *elem_name;
int len;
fprintf_filtered (stream, "Type @");
gdb_print_host_address (exp->elts[elt].type, stream);
fprintf_filtered (stream, " (");
type_print (exp->elts[elt].type, NULL, stream, 0);
fprintf_filtered (stream, ") ");
len = longest_to_int (exp->elts[elt + 1].longconst);
elem_name = &exp->elts[elt + 2].string;
fprintf_filtered (stream, "Field name: `%.*s'", len, elem_name);
elt += 4 + BYTES_TO_EXP_ELEM (len + 1);
}
break;
case OP_FUNC_STATIC_VAR:
{
int len = longest_to_int (exp->elts[elt].longconst);
const char *var_name = &exp->elts[elt + 1].string;
fprintf_filtered (stream, "Field name: `%.*s'", len, var_name);
elt += 3 + BYTES_TO_EXP_ELEM (len + 1);
}
break;
case TYPE_INSTANCE:
{
type_instance_flags flags
= (type_instance_flag_value) longest_to_int (exp->elts[elt++].longconst);
LONGEST len = exp->elts[elt++].longconst;
fprintf_filtered (stream, "%s TypeInstance: ", plongest (len));
while (len-- > 0)
{
fprintf_filtered (stream, "Type @");
gdb_print_host_address (exp->elts[elt].type, stream);
fprintf_filtered (stream, " (");
type_print (exp->elts[elt].type, NULL, stream, 0);
fprintf_filtered (stream, ")");
elt++;
if (len > 0)
fputs_filtered (", ", stream);
}
fprintf_filtered (stream, " Flags: %s (", hex_string (flags));
bool space = false;
auto print_one = [&] (const char *mod)
{
if (space)
fputs_filtered (" ", stream);
space = true;
fprintf_filtered (stream, "%s", mod);
};
if (flags & TYPE_INSTANCE_FLAG_CONST)
print_one ("const");
if (flags & TYPE_INSTANCE_FLAG_VOLATILE)
print_one ("volatile");
fprintf_filtered (stream, ")");
/* Ending LEN and ending TYPE_INSTANCE. */
elt += 2;
elt = dump_subexp (exp, stream, elt);
}
break;
case OP_STRING:
{
LONGEST len = exp->elts[elt].longconst;
LONGEST type = exp->elts[elt + 1].longconst;
fprintf_filtered (stream, "Language-specific string type: %s",
plongest (type));
/* Skip length. */
elt += 1;
/* Skip string content. */
elt += BYTES_TO_EXP_ELEM (len);
/* Skip length and ending OP_STRING. */
elt += 2;
}
break;
case OP_RANGE:
{
enum range_type range_type;
range_type = (enum range_type)
longest_to_int (exp->elts[elt].longconst);
elt += 2;
switch (range_type)
{
case BOTH_BOUND_DEFAULT:
fputs_filtered ("Range '..'", stream);
break;
case LOW_BOUND_DEFAULT:
fputs_filtered ("Range '..EXP'", stream);
break;
case LOW_BOUND_DEFAULT_EXCLUSIVE:
fputs_filtered ("ExclusiveRange '..EXP'", stream);
break;
case HIGH_BOUND_DEFAULT:
fputs_filtered ("Range 'EXP..'", stream);
break;
case NONE_BOUND_DEFAULT:
fputs_filtered ("Range 'EXP..EXP'", stream);
break;
case NONE_BOUND_DEFAULT_EXCLUSIVE:
fputs_filtered ("ExclusiveRange 'EXP..EXP'", stream);
break;
default:
fputs_filtered ("Invalid Range!", stream);
break;
}
if (range_type == HIGH_BOUND_DEFAULT
|| range_type == NONE_BOUND_DEFAULT)
elt = dump_subexp (exp, stream, elt);
if (range_type == LOW_BOUND_DEFAULT
|| range_type == NONE_BOUND_DEFAULT)
elt = dump_subexp (exp, stream, elt);
}
break;
default:
case OP_NULL:
case MULTI_SUBSCRIPT:
case OP_COMPLEX:
case OP_BOOL:
case OP_M2_STRING:
case OP_THIS:
case OP_NAME:
fprintf_filtered (stream, "Unknown format");
}
return elt;
}
void
dump_prefix_expression (struct expression *exp, struct ui_file *stream)
{
int elt;
fprintf_filtered (stream, "Dump of expression @ ");
gdb_print_host_address (exp, stream);
fputs_filtered (", after conversion to prefix form:\nExpression: `", stream);
print_expression (exp, stream);
fprintf_filtered (stream, "'\n\tLanguage %s, %d elements, %ld bytes each.\n",
exp->language_defn->la_name, exp->nelts,
(long) sizeof (union exp_element));
fputs_filtered ("\n", stream);
for (elt = 0; elt < exp->nelts;)
elt = dump_subexp (exp, stream, elt);
fputs_filtered ("\n", stream);
}