OpenE2K
/
binutils-gdb
12
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add base ada language files

This commit is contained in:
Aidan Skinner 2002-06-04 15:28:49 +00:00
parent 8d2c33be03
commit 14f9c5c955
9 changed files with 19204 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2389
gdb/ada-exp.tab.c Normal file
View File

File diff suppressed because it is too large Load Diff

962
gdb/ada-exp.y Normal file
View File

@ -0,0 +1,962 @@
/* YACC parser for Ada expressions, for GDB.
Copyright (C) 1986, 1989, 1990, 1991, 1993, 1994, 1997, 2000
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 2 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, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
/* Parse an Ada expression from text in a string,
and return the result as a struct expression pointer.
That structure contains arithmetic operations in reverse polish,
with constants represented by operations that are followed by special data.
See expression.h for the details of the format.
What is important here is that it can be built up sequentially
during the process of parsing; the lower levels of the tree always
come first in the result.
malloc's and realloc's in this file are transformed to
xmalloc and xrealloc respectively by the same sed command in the
makefile that remaps any other malloc/realloc inserted by the parser
generator. Doing this with #defines and trying to control the interaction
with include files (<malloc.h> and <stdlib.h> for example) just became
too messy, particularly when such includes can be inserted at random
times by the parser generator. */
%{
#include "defs.h"
#include <string.h>
#include <ctype.h>
#include "expression.h"
#include "value.h"
#include "parser-defs.h"
#include "language.h"
#include "ada-lang.h"
#include "bfd.h" /* Required by objfiles.h. */
#include "symfile.h" /* Required by objfiles.h. */
#include "objfiles.h" /* For have_full_symbols and have_partial_symbols */
#include "frame.h"
/* Remap normal yacc parser interface names (yyparse, yylex, yyerror, etc),
as well as gratuitiously global symbol names, so we can have multiple
yacc generated parsers in gdb. These are only the variables
produced by yacc. If other parser generators (bison, byacc, etc) produce
additional global names that conflict at link time, then those parser
generators need to be fixed instead of adding those names to this list. */
/* NOTE: This is clumsy, especially since BISON and FLEX provide --prefix
options. I presume we are maintaining it to accommodate systems
without BISON? (PNH) */
#define yymaxdepth ada_maxdepth
#define yyparse _ada_parse /* ada_parse calls this after initialization */
#define yylex ada_lex
#define yyerror ada_error
#define yylval ada_lval
#define yychar ada_char
#define yydebug ada_debug
#define yypact ada_pact
#define yyr1 ada_r1
#define yyr2 ada_r2
#define yydef ada_def
#define yychk ada_chk
#define yypgo ada_pgo
#define yyact ada_act
#define yyexca ada_exca
#define yyerrflag ada_errflag
#define yynerrs ada_nerrs
#define yyps ada_ps
#define yypv ada_pv
#define yys ada_s
#define yy_yys ada_yys
#define yystate ada_state
#define yytmp ada_tmp
#define yyv ada_v
#define yy_yyv ada_yyv
#define yyval ada_val
#define yylloc ada_lloc
#define yyreds ada_reds /* With YYDEBUG defined */
#define yytoks ada_toks /* With YYDEBUG defined */
#ifndef YYDEBUG
#define YYDEBUG 0 /* Default to no yydebug support */
#endif
struct name_info {
struct symbol* sym;
struct minimal_symbol* msym;
struct block* block;
struct stoken stoken;
};
/* If expression is in the context of TYPE'(...), then TYPE, else
* NULL. */
static struct type* type_qualifier;
int yyparse (void);
static int yylex (void);
void yyerror (char *);
static struct stoken string_to_operator (struct stoken);
static void write_attribute_call0 (enum ada_attribute);
static void write_attribute_call1 (enum ada_attribute, LONGEST);
static void write_attribute_calln (enum ada_attribute, int);
static void write_object_renaming (struct block*, struct symbol*);
static void write_var_from_name (struct block*, struct name_info);
static LONGEST
convert_char_literal (struct type*, LONGEST);
%}
%union
{
LONGEST lval;
struct {
LONGEST val;
struct type *type;
} typed_val;
struct {
DOUBLEST dval;
struct type *type;
} typed_val_float;
struct type *tval;
struct stoken sval;
struct name_info ssym;
int voidval;
struct block *bval;
struct internalvar *ivar;
}
%type <voidval> exp exp1 simple_exp start variable
%type <tval> type
%token <typed_val> INT NULL_PTR CHARLIT
%token <typed_val_float> FLOAT
%token <tval> TYPENAME
%token <bval> BLOCKNAME
/* Both NAME and TYPENAME tokens represent symbols in the input,
and both convey their data as strings.
But a TYPENAME is a string that happens to be defined as a typedef
or builtin type name (such as int or char)
and a NAME is any other symbol.
Contexts where this distinction is not important can use the
nonterminal "name", which matches either NAME or TYPENAME. */
%token <sval> STRING
%token <ssym> NAME DOT_ID OBJECT_RENAMING
%type <bval> block
%type <lval> arglist tick_arglist
%type <tval> save_qualifier
%token DOT_ALL
/* Special type cases, put in to allow the parser to distinguish different
legal basetypes. */
%token <lval> LAST REGNAME
%token <ivar> INTERNAL_VARIABLE
%nonassoc ASSIGN
%left _AND_ OR XOR THEN ELSE
%left '=' NOTEQUAL '<' '>' LEQ GEQ IN DOTDOT
%left '@'
%left '+' '-' '&'
%left UNARY
%left '*' '/' MOD REM
%right STARSTAR ABS NOT
/* The following are right-associative only so that reductions at this
precedence have lower precedence than '.' and '('. The syntax still
forces a.b.c, e.g., to be LEFT-associated. */
%right TICK_ACCESS TICK_ADDRESS TICK_FIRST TICK_LAST TICK_LENGTH
%right TICK_MAX TICK_MIN TICK_MODULUS
%right TICK_POS TICK_RANGE TICK_SIZE TICK_TAG TICK_VAL
%right '.' '(' '[' DOT_ID DOT_ALL
%token ARROW NEW
%%
start : exp1
| type { write_exp_elt_opcode (OP_TYPE);
write_exp_elt_type ($1);
write_exp_elt_opcode (OP_TYPE); }
;
/* Expressions, including the sequencing operator. */
exp1 : exp
| exp1 ';' exp
{ write_exp_elt_opcode (BINOP_COMMA); }
;
/* Expressions, not including the sequencing operator. */
simple_exp : simple_exp DOT_ALL
{ write_exp_elt_opcode (UNOP_IND); }
;
simple_exp : simple_exp DOT_ID
{ write_exp_elt_opcode (STRUCTOP_STRUCT);
write_exp_string ($2.stoken);
write_exp_elt_opcode (STRUCTOP_STRUCT);
}
;
simple_exp : simple_exp '(' arglist ')'
{
write_exp_elt_opcode (OP_FUNCALL);
write_exp_elt_longcst ($3);
write_exp_elt_opcode (OP_FUNCALL);
}
;
simple_exp : type '(' exp ')'
{
write_exp_elt_opcode (UNOP_CAST);
write_exp_elt_type ($1);
write_exp_elt_opcode (UNOP_CAST);
}
;
simple_exp : type '\'' save_qualifier { type_qualifier = $1; } '(' exp ')'
{
/* write_exp_elt_opcode (UNOP_QUAL); */
/* FIXME: UNOP_QUAL should be defined in expression.h */
write_exp_elt_type ($1);
/* write_exp_elt_opcode (UNOP_QUAL); */
/* FIXME: UNOP_QUAL should be defined in expression.h */
type_qualifier = $3;
}
;
save_qualifier : { $$ = type_qualifier; }
simple_exp :
simple_exp '(' exp DOTDOT exp ')'
{ write_exp_elt_opcode (TERNOP_SLICE); }
;
simple_exp : '(' exp1 ')' { }
;
simple_exp : variable
;
simple_exp: REGNAME /* GDB extension */
{ write_exp_elt_opcode (OP_REGISTER);
write_exp_elt_longcst ((LONGEST) $1);
write_exp_elt_opcode (OP_REGISTER);
}
;
simple_exp: INTERNAL_VARIABLE /* GDB extension */
{ write_exp_elt_opcode (OP_INTERNALVAR);
write_exp_elt_intern ($1);
write_exp_elt_opcode (OP_INTERNALVAR);
}
;
exp : simple_exp
;
simple_exp: LAST
{ write_exp_elt_opcode (OP_LAST);
write_exp_elt_longcst ((LONGEST) $1);
write_exp_elt_opcode (OP_LAST);
}
;
exp : exp ASSIGN exp /* Extension for convenience */
{ write_exp_elt_opcode (BINOP_ASSIGN); }
;
exp : '-' exp %prec UNARY
{ write_exp_elt_opcode (UNOP_NEG); }
;
exp : '+' exp %prec UNARY
{ write_exp_elt_opcode (UNOP_PLUS); }
;
exp : NOT exp %prec UNARY
{ write_exp_elt_opcode (UNOP_LOGICAL_NOT); }
;
exp : ABS exp %prec UNARY
{ write_exp_elt_opcode (UNOP_ABS); }
;
arglist : { $$ = 0; }
;
arglist : exp
{ $$ = 1; }
| any_name ARROW exp
{ $$ = 1; }
| arglist ',' exp
{ $$ = $1 + 1; }
| arglist ',' any_name ARROW exp
{ $$ = $1 + 1; }
;
exp : '{' type '}' exp %prec '.'
/* GDB extension */
{ write_exp_elt_opcode (UNOP_MEMVAL);
write_exp_elt_type ($2);
write_exp_elt_opcode (UNOP_MEMVAL);
}
;
/* Binary operators in order of decreasing precedence. */
exp : exp STARSTAR exp
{ write_exp_elt_opcode (BINOP_EXP); }
;
exp : exp '*' exp
{ write_exp_elt_opcode (BINOP_MUL); }
;
exp : exp '/' exp
{ write_exp_elt_opcode (BINOP_DIV); }
;
exp : exp REM exp /* May need to be fixed to give correct Ada REM */
{ write_exp_elt_opcode (BINOP_REM); }
;
exp : exp MOD exp
{ write_exp_elt_opcode (BINOP_MOD); }
;
exp : exp '@' exp /* GDB extension */
{ write_exp_elt_opcode (BINOP_REPEAT); }
;
exp : exp '+' exp
{ write_exp_elt_opcode (BINOP_ADD); }
;
exp : exp '&' exp
{ write_exp_elt_opcode (BINOP_CONCAT); }
;
exp : exp '-' exp
{ write_exp_elt_opcode (BINOP_SUB); }
;
exp : exp '=' exp
{ write_exp_elt_opcode (BINOP_EQUAL); }
;
exp : exp NOTEQUAL exp
{ write_exp_elt_opcode (BINOP_NOTEQUAL); }
;
exp : exp LEQ exp
{ write_exp_elt_opcode (BINOP_LEQ); }
;
exp : exp IN exp DOTDOT exp
{ /*write_exp_elt_opcode (TERNOP_MBR); */ }
/* FIXME: TERNOP_MBR should be defined in
expression.h */
| exp IN exp TICK_RANGE tick_arglist
{ /*write_exp_elt_opcode (BINOP_MBR); */
/* FIXME: BINOP_MBR should be defined in expression.h */
write_exp_elt_longcst ((LONGEST) $5);
/*write_exp_elt_opcode (BINOP_MBR); */
}
| exp IN TYPENAME %prec TICK_ACCESS
{ /*write_exp_elt_opcode (UNOP_MBR); */
/* FIXME: UNOP_QUAL should be defined in expression.h */
write_exp_elt_type ($3);
/* write_exp_elt_opcode (UNOP_MBR); */
/* FIXME: UNOP_MBR should be defined in expression.h */
}
| exp NOT IN exp DOTDOT exp
{ /*write_exp_elt_opcode (TERNOP_MBR); */
/* FIXME: TERNOP_MBR should be defined in expression.h */
write_exp_elt_opcode (UNOP_LOGICAL_NOT);
}
| exp NOT IN exp TICK_RANGE tick_arglist
{ /* write_exp_elt_opcode (BINOP_MBR); */
/* FIXME: BINOP_MBR should be defined in expression.h */
write_exp_elt_longcst ((LONGEST) $6);
/*write_exp_elt_opcode (BINOP_MBR);*/
/* FIXME: BINOP_MBR should be defined in expression.h */
write_exp_elt_opcode (UNOP_LOGICAL_NOT);
}
| exp NOT IN TYPENAME %prec TICK_ACCESS
{ /*write_exp_elt_opcode (UNOP_MBR);*/
/* FIXME: UNOP_MBR should be defined in expression.h */
write_exp_elt_type ($4);
/* write_exp_elt_opcode (UNOP_MBR);*/
/* FIXME: UNOP_MBR should be defined in expression.h */
write_exp_elt_opcode (UNOP_LOGICAL_NOT);
}
;
exp : exp GEQ exp
{ write_exp_elt_opcode (BINOP_GEQ); }
;
exp : exp '<' exp
{ write_exp_elt_opcode (BINOP_LESS); }
;
exp : exp '>' exp
{ write_exp_elt_opcode (BINOP_GTR); }
;
exp : exp _AND_ exp /* Fix for Ada elementwise AND. */
{ write_exp_elt_opcode (BINOP_BITWISE_AND); }
;
exp : exp _AND_ THEN exp %prec _AND_
{ write_exp_elt_opcode (BINOP_LOGICAL_AND); }
;
exp : exp OR exp /* Fix for Ada elementwise OR */
{ write_exp_elt_opcode (BINOP_BITWISE_IOR); }
;
exp : exp OR ELSE exp
{ write_exp_elt_opcode (BINOP_LOGICAL_OR); }
;
exp : exp XOR exp /* Fix for Ada elementwise XOR */
{ write_exp_elt_opcode (BINOP_BITWISE_XOR); }
;
simple_exp : simple_exp TICK_ACCESS
{ write_exp_elt_opcode (UNOP_ADDR); }
| simple_exp TICK_ADDRESS
{ write_exp_elt_opcode (UNOP_ADDR);
write_exp_elt_opcode (UNOP_CAST);
write_exp_elt_type (builtin_type_ada_system_address);
write_exp_elt_opcode (UNOP_CAST);
}
| simple_exp TICK_FIRST tick_arglist
{ write_attribute_call1 (ATR_FIRST, $3); }
| simple_exp TICK_LAST tick_arglist
{ write_attribute_call1 (ATR_LAST, $3); }
| simple_exp TICK_LENGTH tick_arglist
{ write_attribute_call1 (ATR_LENGTH, $3); }
| simple_exp TICK_SIZE
{ write_attribute_call0 (ATR_SIZE); }
| simple_exp TICK_TAG
{ write_attribute_call0 (ATR_TAG); }
| opt_type_prefix TICK_MIN '(' exp ',' exp ')'
{ write_attribute_calln (ATR_MIN, 2); }
| opt_type_prefix TICK_MAX '(' exp ',' exp ')'
{ write_attribute_calln (ATR_MAX, 2); }
| opt_type_prefix TICK_POS '(' exp ')'
{ write_attribute_calln (ATR_POS, 1); }
| type_prefix TICK_FIRST tick_arglist
{ write_attribute_call1 (ATR_FIRST, $3); }
| type_prefix TICK_LAST tick_arglist
{ write_attribute_call1 (ATR_LAST, $3); }
| type_prefix TICK_LENGTH tick_arglist
{ write_attribute_call1 (ATR_LENGTH, $3); }
| type_prefix TICK_VAL '(' exp ')'
{ write_attribute_calln (ATR_VAL, 1); }
| type_prefix TICK_MODULUS
{ write_attribute_call0 (ATR_MODULUS); }
;
tick_arglist : %prec '('
{ $$ = 1; }
| '(' INT ')'
{ $$ = $2.val; }
;
type_prefix :
TYPENAME
{ write_exp_elt_opcode (OP_TYPE);
write_exp_elt_type ($1);
write_exp_elt_opcode (OP_TYPE); }
;
opt_type_prefix :
type_prefix
| /* EMPTY */
{ write_exp_elt_opcode (OP_TYPE);
write_exp_elt_type (builtin_type_void);
write_exp_elt_opcode (OP_TYPE); }
;
exp : INT
{ write_exp_elt_opcode (OP_LONG);
write_exp_elt_type ($1.type);
write_exp_elt_longcst ((LONGEST)($1.val));
write_exp_elt_opcode (OP_LONG);
}
;
exp : CHARLIT
{ write_exp_elt_opcode (OP_LONG);
if (type_qualifier == NULL)
write_exp_elt_type ($1.type);
else
write_exp_elt_type (type_qualifier);
write_exp_elt_longcst
(convert_char_literal (type_qualifier, $1.val));
write_exp_elt_opcode (OP_LONG);
}
exp : FLOAT
{ write_exp_elt_opcode (OP_DOUBLE);
write_exp_elt_type ($1.type);
write_exp_elt_dblcst ($1.dval);
write_exp_elt_opcode (OP_DOUBLE);
}
;
exp : NULL_PTR
{ write_exp_elt_opcode (OP_LONG);
write_exp_elt_type (builtin_type_int);
write_exp_elt_longcst ((LONGEST)(0));
write_exp_elt_opcode (OP_LONG);
}
exp : STRING
{ /* Ada strings are converted into array constants
a lower bound of 1. Thus, the array upper bound
is the string length. */
char *sp = $1.ptr; int count;
if ($1.length == 0)
{ /* One dummy character for the type */
write_exp_elt_opcode (OP_LONG);
write_exp_elt_type (builtin_type_ada_char);
write_exp_elt_longcst ((LONGEST)(0));
write_exp_elt_opcode (OP_LONG);
}
for (count = $1.length; count > 0; count -= 1)
{
write_exp_elt_opcode (OP_LONG);
write_exp_elt_type (builtin_type_ada_char);
write_exp_elt_longcst ((LONGEST)(*sp));
sp += 1;
write_exp_elt_opcode (OP_LONG);
}
write_exp_elt_opcode (OP_ARRAY);
write_exp_elt_longcst ((LONGEST) 1);
write_exp_elt_longcst ((LONGEST) ($1.length));
write_exp_elt_opcode (OP_ARRAY);
}
;
exp : NEW TYPENAME
{ error ("NEW not implemented."); }
;
variable: NAME { write_var_from_name (NULL, $1); }
| block NAME /* GDB extension */
{ write_var_from_name ($1, $2); }
| OBJECT_RENAMING { write_object_renaming (NULL, $1.sym); }
| block OBJECT_RENAMING
{ write_object_renaming ($1, $2.sym); }
;
any_name : NAME { }
| TYPENAME { }
| OBJECT_RENAMING { }
;
block : BLOCKNAME /* GDB extension */
{ $$ = $1; }
| block BLOCKNAME /* GDB extension */
{ $$ = $2; }
;
type : TYPENAME { $$ = $1; }
| block TYPENAME { $$ = $2; }
| TYPENAME TICK_ACCESS
{ $$ = lookup_pointer_type ($1); }
| block TYPENAME TICK_ACCESS
{ $$ = lookup_pointer_type ($2); }
;
/* Some extensions borrowed from C, for the benefit of those who find they
can't get used to Ada notation in GDB. */
exp : '*' exp %prec '.'
{ write_exp_elt_opcode (UNOP_IND); }
| '&' exp %prec '.'
{ write_exp_elt_opcode (UNOP_ADDR); }
| exp '[' exp ']'
{ write_exp_elt_opcode (BINOP_SUBSCRIPT); }
;
%%
/* yylex defined in ada-lex.c: Reads one token, getting characters */
/* through lexptr. */
/* Remap normal flex interface names (yylex) as well as gratuitiously */
/* global symbol names, so we can have multiple flex-generated parsers */
/* in gdb. */
/* (See note above on previous definitions for YACC.) */
#define yy_create_buffer ada_yy_create_buffer
#define yy_delete_buffer ada_yy_delete_buffer
#define yy_init_buffer ada_yy_init_buffer
#define yy_load_buffer_state ada_yy_load_buffer_state
#define yy_switch_to_buffer ada_yy_switch_to_buffer
#define yyrestart ada_yyrestart
#define yytext ada_yytext
#define yywrap ada_yywrap
/* The following kludge was found necessary to prevent conflicts between */
/* defs.h and non-standard stdlib.h files. */
#define qsort __qsort__dummy
#include "ada-lex.c"
int
ada_parse ()
{
lexer_init (yyin); /* (Re-)initialize lexer. */
left_block_context = NULL;
type_qualifier = NULL;
return _ada_parse ();
}
void
yyerror (msg)
char *msg;
{
error ("A %s in expression, near `%s'.", (msg ? msg : "error"), lexptr);
}
/* The operator name corresponding to operator symbol STRING (adds
quotes and maps to lower-case). Destroys the previous contents of
the array pointed to by STRING.ptr. Error if STRING does not match
a valid Ada operator. Assumes that STRING.ptr points to a
null-terminated string and that, if STRING is a valid operator
symbol, the array pointed to by STRING.ptr contains at least
STRING.length+3 characters. */
static struct stoken
string_to_operator (string)
struct stoken string;
{
int i;
for (i = 0; ada_opname_table[i].mangled != NULL; i += 1)
{
if (string.length == strlen (ada_opname_table[i].demangled)-2
&& strncasecmp (string.ptr, ada_opname_table[i].demangled+1,
string.length) == 0)
{
strncpy (string.ptr, ada_opname_table[i].demangled,
string.length+2);
string.length += 2;
return string;
}
}
error ("Invalid operator symbol `%s'", string.ptr);
}
/* Emit expression to access an instance of SYM, in block BLOCK (if
* non-NULL), and with :: qualification ORIG_LEFT_CONTEXT. */
static void
write_var_from_sym (orig_left_context, block, sym)
struct block* orig_left_context;
struct block* block;
struct symbol* sym;
{
if (orig_left_context == NULL && symbol_read_needs_frame (sym))
{
if (innermost_block == 0 ||
contained_in (block, innermost_block))
innermost_block = block;
}
write_exp_elt_opcode (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);
}
/* Emit expression to access an instance of NAME. */
static void
write_var_from_name (orig_left_context, name)
struct block* orig_left_context;
struct name_info name;
{
if (name.msym != NULL)
{
write_exp_msymbol (name.msym,
lookup_function_type (builtin_type_int),
builtin_type_int);
}
else if (name.sym == NULL)
{
/* Multiple matches: record name and starting block for later
resolution by ada_resolve. */
/* write_exp_elt_opcode (OP_UNRESOLVED_VALUE); */
/* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */
write_exp_elt_block (name.block);
/* write_exp_elt_name (name.stoken.ptr); */
/* FIXME: write_exp_elt_name should be defined in defs.h, located in parse.c */
/* write_exp_elt_opcode (OP_UNRESOLVED_VALUE); */
/* FIXME: OP_UNRESOLVED_VALUE should be defined in expression.h */
}
else
write_var_from_sym (orig_left_context, name.block, name.sym);
}
/* Write a call on parameterless attribute ATR. */
static void
write_attribute_call0 (atr)
enum ada_attribute atr;
{
/* write_exp_elt_opcode (OP_ATTRIBUTE); */
/* FIXME: OP_ATTRIBUTE should be defined in expression.h */
write_exp_elt_longcst ((LONGEST) 0);
write_exp_elt_longcst ((LONGEST) atr);
/* write_exp_elt_opcode (OP_ATTRIBUTE); */
/* FIXME: OP_ATTRIBUTE should be defined in expression.h */
}
/* Write a call on an attribute ATR with one constant integer
* parameter. */
static void
write_attribute_call1 (atr, arg)
enum ada_attribute atr;
LONGEST arg;
{
write_exp_elt_opcode (OP_LONG);
write_exp_elt_type (builtin_type_int);
write_exp_elt_longcst (arg);
write_exp_elt_opcode (OP_LONG);
/*write_exp_elt_opcode (OP_ATTRIBUTE);*/
/* FIXME: OP_ATTRIBUTE should be defined in expression.h */
write_exp_elt_longcst ((LONGEST) 1);
write_exp_elt_longcst ((LONGEST) atr);
/*write_exp_elt_opcode (OP_ATTRIBUTE);*/
/* FIXME: OP_ATTRIBUTE should be defined in expression.h */
}
/* Write a call on an attribute ATR with N parameters, whose code must have
* been generated previously. */
static void
write_attribute_calln (atr, n)
enum ada_attribute atr;
int n;
{
/*write_exp_elt_opcode (OP_ATTRIBUTE);*/
/* FIXME: OP_ATTRIBUTE should be defined in expression.h */
write_exp_elt_longcst ((LONGEST) n);
write_exp_elt_longcst ((LONGEST) atr);
/* write_exp_elt_opcode (OP_ATTRIBUTE);*/
/* FIXME: OP_ATTRIBUTE should be defined in expression.h */
}
/* Emit expression corresponding to the renamed object designated by
* the type RENAMING, which must be the referent of an object renaming
* type, in the context of ORIG_LEFT_CONTEXT (?). */
static void
write_object_renaming (orig_left_context, renaming)
struct block* orig_left_context;
struct symbol* renaming;
{
const char* qualification = SYMBOL_NAME (renaming);
const char* simple_tail;
const char* expr = TYPE_FIELD_NAME (SYMBOL_TYPE (renaming), 0);
const char* suffix;
char* name;
struct symbol* sym;
enum { SIMPLE_INDEX, LOWER_BOUND, UPPER_BOUND } slice_state;
/* if orig_left_context is null, then use the currently selected
block, otherwise we might fail our symbol lookup below */
if (orig_left_context == NULL)
orig_left_context = get_selected_block (NULL);
for (simple_tail = qualification + strlen (qualification);
simple_tail != qualification; simple_tail -= 1)
{
if (*simple_tail == '.')
{
simple_tail += 1;
break;
}
else if (STREQN (simple_tail, "__", 2))
{
simple_tail += 2;
break;
}
}
suffix = strstr (expr, "___XE");
if (suffix == NULL)
goto BadEncoding;
name = (char*) malloc (suffix - expr + 1);
/* add_name_string_cleanup (name); */
/* FIXME: add_name_string_cleanup should be defined in
parser-defs.h, implemented in parse.c */
strncpy (name, expr, suffix-expr);
name[suffix-expr] = '\000';
sym = lookup_symbol (name, orig_left_context, VAR_NAMESPACE, 0, NULL);
/* if (sym == NULL)
error ("Could not find renamed variable: %s", ada_demangle (name));
*/
/* FIXME: ada_demangle should be defined in defs.h, implemented in ada-lang.c */
write_var_from_sym (orig_left_context, block_found, sym);
suffix += 5;
slice_state = SIMPLE_INDEX;
while (*suffix == 'X')
{
suffix += 1;
switch (*suffix) {
case 'L':
slice_state = LOWER_BOUND;
case 'S':
suffix += 1;
if (isdigit (*suffix))
{
char* next;
long val = strtol (suffix, &next, 10);
if (next == suffix)
goto BadEncoding;
suffix = next;
write_exp_elt_opcode (OP_LONG);
write_exp_elt_type (builtin_type_ada_int);
write_exp_elt_longcst ((LONGEST) val);
write_exp_elt_opcode (OP_LONG);
}
else
{
const char* end;
char* index_name;
int index_len;
struct symbol* index_sym;
end = strchr (suffix, 'X');
if (end == NULL)
end = suffix + strlen (suffix);
index_len = simple_tail - qualification + 2 + (suffix - end) + 1;
index_name = (char*) malloc (index_len);
memset (index_name, '\000', index_len);
/* add_name_string_cleanup (index_name);*/
/* FIXME: add_name_string_cleanup should be defined in
parser-defs.h, implemented in parse.c */
strncpy (index_name, qualification, simple_tail - qualification);
index_name[simple_tail - qualification] = '\000';
strncat (index_name, suffix, suffix-end);
suffix = end;
index_sym =
lookup_symbol (index_name, NULL, VAR_NAMESPACE, 0, NULL);
if (index_sym == NULL)
error ("Could not find %s", index_name);
write_var_from_sym (NULL, block_found, sym);
}
if (slice_state == SIMPLE_INDEX)
{
write_exp_elt_opcode (OP_FUNCALL);
write_exp_elt_longcst ((LONGEST) 1);
write_exp_elt_opcode (OP_FUNCALL);
}
else if (slice_state == LOWER_BOUND)
slice_state = UPPER_BOUND;
else if (slice_state == UPPER_BOUND)
{
write_exp_elt_opcode (TERNOP_SLICE);
slice_state = SIMPLE_INDEX;
}
break;
case 'R':
{
struct stoken field_name;
const char* end;
suffix += 1;
if (slice_state != SIMPLE_INDEX)
goto BadEncoding;
end = strchr (suffix, 'X');
if (end == NULL)
end = suffix + strlen (suffix);
field_name.length = end - suffix;
field_name.ptr = (char*) malloc (end - suffix + 1);
strncpy (field_name.ptr, suffix, end - suffix);
field_name.ptr[end - suffix] = '\000';
suffix = end;
write_exp_elt_opcode (STRUCTOP_STRUCT);
write_exp_string (field_name);
write_exp_elt_opcode (STRUCTOP_STRUCT);
break;
}
default:
goto BadEncoding;
}
}
if (slice_state == SIMPLE_INDEX)
return;
BadEncoding:
error ("Internal error in encoding of renaming declaration: %s",
SYMBOL_NAME (renaming));
}
/* Convert the character literal whose ASCII value would be VAL to the
appropriate value of type TYPE, if there is a translation.
Otherwise return VAL. Hence, in an enumeration type ('A', 'B'),
the literal 'A' (VAL == 65), returns 0. */
static LONGEST
convert_char_literal (struct type* type, LONGEST val)
{
char name[7];
int f;
if (type == NULL || TYPE_CODE (type) != TYPE_CODE_ENUM)
return val;
sprintf (name, "QU%02x", (int) val);
for (f = 0; f < TYPE_NFIELDS (type); f += 1)
{
if (STREQ (name, TYPE_FIELD_NAME (type, f)))
return TYPE_FIELD_BITPOS (type, f);
}
return val;
}

8626
gdb/ada-lang.c Normal file
View File

File diff suppressed because it is too large Load Diff

365
gdb/ada-lang.h Normal file
View File

@ -0,0 +1,365 @@
/* Ada language support definitions for GDB, the GNU debugger.
Copyright 1992, 1997 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 2 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, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
#if !defined (ADA_LANG_H)
#define ADA_LANG_H 1
#include "value.h"
#include "gdbtypes.h"
/* A macro to reorder the bytes of an address depending on the endiannes
of the target */
#define EXTRACT_ADDRESS(x) ((void *) extract_address (&(x), sizeof (x)))
/* A macro to reorder the bytes of an int depending on the endiannes
of the target */
#define EXTRACT_INT(x) ((int) extract_signed_integer (&(x), sizeof (x)))
/* Chain of cleanups for arguments of OP_UNRESOLVED_VALUE names. Created in
yyparse and freed in ada_resolve. */
extern struct cleanup* unresolved_names;
/* Corresponding mangled/demangled names and opcodes for Ada user-definable
operators. */
struct ada_opname_map {
const char* mangled;
const char* demangled;
enum exp_opcode op;
};
/* Table of Ada operators in mangled and demangled forms. */
/* Defined in ada-lang.c */
extern const struct ada_opname_map ada_opname_table[];
/* The maximum number of tasks known to the Ada runtime */
extern const int MAX_NUMBER_OF_KNOWN_TASKS;
/* Identifiers for Ada attributes that need special processing. Be sure
to update the table attribute_names in ada-lang.c whenever you change this.
*/
enum ada_attribute {
/* Invalid attribute for error checking. */
ATR_INVALID,
ATR_FIRST,
ATR_LAST,
ATR_LENGTH,
ATR_IMAGE,
ATR_IMG,
ATR_MAX,
ATR_MIN,
ATR_MODULUS,
ATR_POS,
ATR_SIZE,
ATR_TAG,
ATR_VAL,
/* Dummy last attribute. */
ATR_END
};
enum task_states {
Unactivated,
Runnable,
Terminated,
Activator_Sleep,
Acceptor_Sleep,
Entry_Caller_Sleep,
Async_Select_Sleep,
Delay_Sleep,
Master_Completion_Sleep,
Master_Phase_2_Sleep
};
extern char *ada_task_states[];
typedef struct {
char *P_ARRAY;
int *P_BOUNDS;
} fat_string;
typedef struct entry_call {
void *self;
} *entry_call_link;
struct task_fields
{
int entry_num;
#if (defined (VXWORKS_TARGET) || !defined (i386)) \
&& !(defined (VXWORKS_TARGET) && defined (M68K_TARGET))
int pad1;
#endif
char state;
#if (defined (VXWORKS_TARGET) && defined (M68K_TARGET))
char pad_8bits;
#endif
void *parent;
int priority;
int current_priority;
fat_string image;
entry_call_link call;
#if (defined (sun) && defined (__SVR4)) && !defined (VXWORKS_TARGET)
int pad2;
unsigned thread;
unsigned lwp;
#else
void *thread;
void *lwp;
#endif
}
#if (defined (VXWORKS_TARGET) && defined (M68K_TARGET))
__attribute__ ((packed))
#endif
;
struct task_entry
{
void *task_id;
int task_num;
int known_tasks_index;
struct task_entry *next_task;
void *thread;
void *lwp;
int stack_per;
};
extern struct type* builtin_type_ada_int;
extern struct type* builtin_type_ada_short;
extern struct type* builtin_type_ada_long;
extern struct type* builtin_type_ada_long_long;
extern struct type* builtin_type_ada_char;
extern struct type* builtin_type_ada_float;
extern struct type* builtin_type_ada_double;
extern struct type* builtin_type_ada_long_double;
extern struct type* builtin_type_ada_natural;
extern struct type* builtin_type_ada_positive;
extern struct type* builtin_type_ada_system_address;
/* Assuming V points to an array of S objects, make sure that it contains at
least M objects, updating V and S as necessary. */
#define GROW_VECT(v, s, m) \
if ((s) < (m)) grow_vect ((void**) &(v), &(s), (m), sizeof(*(v)));
extern void grow_vect (void**, size_t*, size_t, int);
extern int ada_parse (void); /* Defined in ada-exp.y */
extern void ada_error (char *); /* Defined in ada-exp.y */
/* Defined in ada-typeprint.c */
extern void ada_print_type (struct type*, char*, struct ui_file*, int, int);
extern int ada_val_print (struct type*, char*, int, CORE_ADDR,
struct ui_file*, int, int, int, enum val_prettyprint);
extern int ada_value_print (struct value*, struct ui_file*, int,
enum val_prettyprint);
/* Defined in ada-lang.c */
extern struct value* value_from_contents_and_address (struct type*, char*, CORE_ADDR);
extern void ada_emit_char (int, struct ui_file *, int, int);
extern void ada_printchar (int, struct ui_file*);
extern void ada_printstr (struct ui_file*, char *, unsigned int, int, int);
extern void ada_convert_actuals (struct value*, int, struct value**, CORE_ADDR*);
extern struct value* ada_value_subscript (struct value*, int, struct value**);
extern struct type* ada_array_element_type (struct type*, int);
extern int ada_array_arity (struct type*);
struct type* ada_type_of_array (struct value*, int);
extern struct value* ada_coerce_to_simple_array (struct value*);
extern struct value* ada_coerce_to_simple_array_ptr (struct value*);
extern int ada_is_simple_array (struct type*);
extern int ada_is_array_descriptor (struct type*);
extern int ada_is_bogus_array_descriptor (struct type*);
extern struct type* ada_index_type (struct type*, int);
extern struct value* ada_array_bound (struct value*, int, int);
extern int ada_lookup_symbol_list (const char*, struct block*, namespace_enum,
struct symbol***, struct block***);
extern char* ada_fold_name (const char*);
extern struct symbol* ada_lookup_symbol (const char*, struct block*, namespace_enum);
extern struct minimal_symbol* ada_lookup_minimal_symbol (const char*);
extern void ada_resolve (struct expression**, struct type*);
extern int ada_resolve_function (struct symbol**, struct block**, int,
struct value**, int, const char*, struct type*);
extern void ada_fill_in_ada_prototype (struct symbol*);
extern int user_select_syms (struct symbol**, struct block**, int, int);
extern int get_selections (int*, int, int, int, char*);
extern char* ada_start_decode_line_1 (char*);
extern struct symtabs_and_lines ada_finish_decode_line_1 (char**, struct symtab*, int, char***);
extern int ada_scan_number (const char*, int, LONGEST*, int*);
extern struct type* ada_parent_type (struct type*);
extern int ada_is_ignored_field (struct type*, int);
extern int ada_is_packed_array_type (struct type*);
extern struct value* ada_value_primitive_packed_val (struct value*, char*, long, int,
int, struct type*);
extern struct type* ada_coerce_to_simple_array_type (struct type*);
extern int ada_is_character_type (struct type*);
extern int ada_is_string_type (struct type*);
extern int ada_is_tagged_type (struct type*);
extern struct type* ada_tag_type (struct value*);
extern struct value* ada_value_tag (struct value*);
extern int ada_is_parent_field (struct type*, int);
extern int ada_is_wrapper_field (struct type*, int);
extern int ada_is_variant_part (struct type*, int);
extern struct type* ada_variant_discrim_type (struct type*, struct type*);
extern int ada_is_others_clause (struct type*, int);
extern int ada_in_variant (LONGEST, struct type*, int);
extern char* ada_variant_discrim_name (struct type*);
extern struct type* ada_lookup_struct_elt_type (struct type*, char*, int, int*);
extern struct value* ada_value_struct_elt (struct value*, char*, char*);
extern struct value* ada_search_struct_field (char*, struct value*, int, struct type*);
extern int ada_is_aligner_type (struct type*);
extern struct type* ada_aligned_type (struct type*);
extern char* ada_aligned_value_addr (struct type*, char*);
extern const char* ada_attribute_name (int);
extern int ada_is_fixed_point_type (struct type*);
extern DOUBLEST ada_delta (struct type*);
extern DOUBLEST ada_fixed_to_float (struct type *, LONGEST);
extern LONGEST ada_float_to_fixed (struct type*, DOUBLEST);
extern int ada_is_vax_floating_type (struct type*);
extern int ada_vax_float_type_suffix (struct type*);
extern struct value* ada_vax_float_print_function (struct type*);
extern struct type* ada_system_address_type (void);
extern int ada_which_variant_applies (struct type*, struct type*, char*);
extern struct value* ada_to_fixed_value (struct type*, char*, CORE_ADDR, struct value*);
extern struct type* ada_to_fixed_type (struct type*, char*, CORE_ADDR, struct value*);
extern int ada_name_prefix_len (const char*);
extern char* ada_type_name (struct type*);
extern struct type* ada_find_parallel_type (struct type*, const char *suffix);
extern LONGEST get_int_var_value (char*, char*, int* );
extern struct type* ada_find_any_type (const char *name);
extern int ada_prefer_type (struct type*, struct type*);
extern struct type* ada_get_base_type (struct type*);
extern struct type* ada_completed_type (struct type*);
extern char* ada_mangle (const char*);
extern const char* ada_enum_name (const char*);
extern int ada_is_modular_type (struct type*);
extern LONGEST ada_modulus (struct type*);
extern struct value* ada_value_ind (struct value*);
extern void ada_print_scalar (struct type*, LONGEST, struct ui_file*);
extern int ada_is_range_type_name (const char*);
extern const char* ada_renaming_type (struct type*);
extern int ada_is_object_renaming (struct symbol*);
extern const char* ada_simple_renamed_entity (struct symbol*);
extern char* ada_breakpoint_rewrite (char*, int*);
/* Tasking-related: ada-tasks.c */
extern int valid_task_id (int);
extern int get_current_task (void);
extern void init_task_list (void);
extern void* get_self_id (void);
extern int get_current_task (void);
extern int get_entry_number (void*);
extern void ada_report_exception_break (struct breakpoint *);
extern int ada_maybe_exception_partial_symbol (struct partial_symbol* sym);
extern int ada_is_exception_sym (struct symbol* sym);
#endif

3174
gdb/ada-lex.c Normal file
View File

File diff suppressed because it is too large Load Diff

928
gdb/ada-lex.l Normal file
View File

@ -0,0 +1,928 @@
/* FLEX lexer for Ada expressions, for GDB.
Copyright (C) 1994, 1997, 2000
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 2 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, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
/*----------------------------------------------------------------------*/
/* The converted version of this file is to be included in ada-exp.y, */
/* the Ada parser for gdb. The function yylex obtains characters from */
/* the global pointer lexptr. It returns a syntactic category for */
/* each successive token and places a semantic value into yylval */
/* (ada-lval), defined by the parser. */
/* Run flex with (at least) the -i option (case-insensitive), and the -I */
/* option (interactive---no unnecessary lookahead). */
DIG [0-9]
NUM10 ({DIG}({DIG}|_)*)
HEXDIG [0-9a-f]
NUM16 ({HEXDIG}({HEXDIG}|_)*)
OCTDIG [0-7]
LETTER [a-z_]
ID ({LETTER}({LETTER}|{DIG})*|"<"{LETTER}({LETTER}|{DIG})*">")
WHITE [ \t\n]
TICK ("'"{WHITE}*)
GRAPHIC [a-z0-9 #&'()*+,-./:;<>=_|!$%?@\[\]\\^`{}~]
OPER ([-+*/=<>&]|"<="|">="|"**"|"/="|"and"|"or"|"xor"|"not"|"mod"|"rem"|"abs")
EXP (e[+-]{NUM10})
POSEXP (e"+"?{NUM10})
%{
#define NUMERAL_WIDTH 256
#define LONGEST_SIGN ((ULONGEST) 1 << (sizeof(LONGEST) * HOST_CHAR_BIT - 1))
/* Temporary staging for numeric literals. */
static char numbuf[NUMERAL_WIDTH];
static void canonicalizeNumeral (char* s1, const char*);
static int processInt (const char*, const char*, const char*);
static int processReal (const char*);
static int processId (const char*, int);
static int processAttribute (const char*);
static int find_dot_all (const char*);
#undef YY_DECL
#define YY_DECL static int yylex ( void )
#undef YY_INPUT
#define YY_INPUT(BUF, RESULT, MAX_SIZE) \
if ( *lexptr == '\000' ) \
(RESULT) = YY_NULL; \
else \
{ \
*(BUF) = *lexptr; \
(RESULT) = 1; \
lexptr += 1; \
}
static char *tempbuf = NULL;
static int tempbufsize = 0;
static int tempbuf_len;
static struct block* left_block_context;
static void resize_tempbuf (unsigned int);
static void block_lookup (char*, char*);
static int name_lookup (char*, char*, int*);
static int find_dot_all (const char*);
%}
%s IN_STRING BEFORE_QUAL_QUOTE
%%
{WHITE} { }
"--".* { yyterminate(); }
{NUM10}{POSEXP} {
canonicalizeNumeral (numbuf, yytext);
return processInt (NULL, numbuf, strrchr(numbuf, 'e')+1);
}
{NUM10} {
canonicalizeNumeral (numbuf, yytext);
return processInt (NULL, numbuf, NULL);
}
{NUM10}"#"{HEXDIG}({HEXDIG}|_)*"#"{POSEXP} {
canonicalizeNumeral (numbuf, yytext);
return processInt (numbuf,
strchr (numbuf, '#') + 1,
strrchr(numbuf, '#') + 1);
}
{NUM10}"#"{HEXDIG}({HEXDIG}|_)*"#" {
canonicalizeNumeral (numbuf, yytext);
return processInt (numbuf, strchr (numbuf, '#') + 1, NULL);
}
"0x"{HEXDIG}+ {
canonicalizeNumeral (numbuf, yytext+2);
return processInt ("16#", numbuf, NULL);
}
{NUM10}"."{NUM10}{EXP} {
canonicalizeNumeral (numbuf, yytext);
return processReal (numbuf);
}
{NUM10}"."{NUM10} {
canonicalizeNumeral (numbuf, yytext);
return processReal (numbuf);
}
{NUM10}"#"{NUM16}"."{NUM16}"#"{EXP} {
error ("Based real literals not implemented yet.");
}
{NUM10}"#"{NUM16}"."{NUM16}"#" {
error ("Based real literals not implemented yet.");
}
<INITIAL>"'"({GRAPHIC}|\")"'" {
yylval.typed_val.type = builtin_type_ada_char;
yylval.typed_val.val = yytext[1];
return CHARLIT;
}
<INITIAL>"'[\""{HEXDIG}{2}"\"]'" {
int v;
yylval.typed_val.type = builtin_type_ada_char;
sscanf (yytext+3, "%2x", &v);
yylval.typed_val.val = v;
return CHARLIT;
}
\"{OPER}\"/{WHITE}*"(" { return processId (yytext, yyleng); }
<INITIAL>\" {
tempbuf_len = 0;
BEGIN IN_STRING;
}
<IN_STRING>{GRAPHIC}*\" {
resize_tempbuf (yyleng+tempbuf_len);
strncpy (tempbuf+tempbuf_len, yytext, yyleng-1);
tempbuf_len += yyleng-1;
yylval.sval.ptr = tempbuf;
yylval.sval.length = tempbuf_len;
BEGIN INITIAL;
return STRING;
}
<IN_STRING>{GRAPHIC}*"[\""{HEXDIG}{2}"\"]" {
int n;
resize_tempbuf (yyleng-5+tempbuf_len+1);
strncpy (tempbuf+tempbuf_len, yytext, yyleng-6);
sscanf(yytext+yyleng-4, "%2x", &n);
tempbuf[yyleng-6+tempbuf_len] = (char) n;
tempbuf_len += yyleng-5;
}
<IN_STRING>{GRAPHIC}*"[\"\"\"]" {
int n;
resize_tempbuf (yyleng-4+tempbuf_len+1);
strncpy (tempbuf+tempbuf_len, yytext, yyleng-6);
tempbuf[yyleng-5+tempbuf_len] = '"';
tempbuf_len += yyleng-4;
}
if {
while (*lexptr != 'i' && *lexptr != 'I')
lexptr -= 1;
yyrestart(NULL);
return 0;
}
/* ADA KEYWORDS */
abs { return ABS; }
and { return _AND_; }
else { return ELSE; }
in { return IN; }
mod { return MOD; }
new { return NEW; }
not { return NOT; }
null { return NULL_PTR; }
or { return OR; }
rem { return REM; }
then { return THEN; }
xor { return XOR; }
/* ATTRIBUTES */
{TICK}[a-zA-Z][a-zA-Z]+ { return processAttribute (yytext+1); }
/* PUNCTUATION */
"=>" { return ARROW; }
".." { return DOTDOT; }
"**" { return STARSTAR; }
":=" { return ASSIGN; }
"/=" { return NOTEQUAL; }
"<=" { return LEQ; }
">=" { return GEQ; }
<BEFORE_QUAL_QUOTE>"'" { BEGIN INITIAL; return '\''; }
[-&*+./:<>=|;\[\]] { return yytext[0]; }
"," { if (paren_depth == 0 && comma_terminates)
{
lexptr -= 1;
yyrestart(NULL);
return 0;
}
else
return ',';
}
"(" { paren_depth += 1; return '('; }
")" { if (paren_depth == 0)
{
lexptr -= 1;
yyrestart(NULL);
return 0;
}
else
{
paren_depth -= 1;
return ')';
}
}
"."{WHITE}*all { return DOT_ALL; }
"."{WHITE}*{ID} {
processId (yytext+1, yyleng-1);
return DOT_ID;
}
{ID}({WHITE}*"."{WHITE}*({ID}|\"{OPER}\"))*(" "*"'")? {
int all_posn = find_dot_all (yytext);
int token_type, segments, k;
int quote_follows;
if (all_posn == -1 && yytext[yyleng-1] == '\'')
{
quote_follows = 1;
do {
yyless (yyleng-1);
} while (yytext[yyleng-1] == ' ');
}
else
quote_follows = 0;
if (all_posn >= 0)
yyless (all_posn);
processId(yytext, yyleng);
segments = name_lookup (ada_mangle (yylval.ssym.stoken.ptr),
yylval.ssym.stoken.ptr, &token_type);
left_block_context = NULL;
for (k = yyleng; segments > 0 && k > 0; k -= 1)
{
if (yytext[k-1] == '.')
segments -= 1;
quote_follows = 0;
}
if (k <= 0)
error ("confused by name %s", yytext);
yyless (k);
if (quote_follows)
BEGIN BEFORE_QUAL_QUOTE;
return token_type;
}
/* GDB EXPRESSION CONSTRUCTS */
"'"[^']+"'"{WHITE}*:: {
processId(yytext, yyleng-2);
block_lookup (yylval.ssym.stoken.ptr, yylval.ssym.stoken.ptr);
return BLOCKNAME;
}
{ID}({WHITE}*"."{WHITE}*({ID}|\"{OPER}\"))*{WHITE}*:: {
processId(yytext, yyleng-2);
block_lookup (ada_mangle (yylval.ssym.stoken.ptr),
yylval.ssym.stoken.ptr);
return BLOCKNAME;
}
[{}@] { return yytext[0]; }
"$$" { yylval.lval = -1; return LAST; }
"$$"{DIG}+ { yylval.lval = -atoi(yytext+2); return LAST; }
"$" { yylval.lval = 0; return LAST; }
"$"{DIG}+ { yylval.lval = atoi(yytext+1); return LAST; }
/* REGISTERS AND GDB CONVENIENCE VARIABLES */
"$"({LETTER}|{DIG}|"$")+ {
int c;
for (c = 0; c < NUM_REGS; c++)
if (REGISTER_NAME (c) &&
strcmp (yytext + 1, REGISTER_NAME (c)) == 0)
{
yylval.lval = c;
return REGNAME;
}
yylval.sval.ptr = yytext;
yylval.sval.length = yyleng;
yylval.ivar =
lookup_internalvar (copy_name (yylval.sval) + 1);
return INTERNAL_VARIABLE;
}
/* CATCH-ALL ERROR CASE */
. { error ("Invalid character '%s' in expression.", yytext); }
%%
#include <ctype.h>
#include <string.h>
/* Initialize the lexer for processing new expression */
void
lexer_init (FILE* inp)
{
BEGIN INITIAL;
yyrestart (inp);
}
/* Make sure that tempbuf points at an array at least N characters long. */
static void
resize_tempbuf (n)
unsigned int n;
{
if (tempbufsize < n)
{
tempbufsize = (n+63) & ~63;
tempbuf = (char*) xrealloc (tempbuf, tempbufsize);
}
}
/* Copy S2 to S1, removing all underscores, and downcasing all letters. */
static void
canonicalizeNumeral (s1,s2)
char* s1;
const char* s2;
{
for (; *s2 != '\000'; s2 += 1)
{
if (*s2 != '_')
{
*s1 = tolower(*s2);
s1 += 1;
}
}
s1[0] = '\000';
}
#define HIGH_BYTE_POSN ((sizeof (ULONGEST) - 1) * HOST_CHAR_BIT)
/* True (non-zero) iff DIGIT is a valid digit in radix BASE,
where 2 <= BASE <= 16. */
static int
is_digit_in_base (digit, base)
unsigned char digit;
int base;
{
if (!isxdigit (digit))
return 0;
if (base <= 10)
return (isdigit (digit) && digit < base + '0');
else
return (isdigit (digit) || tolower (digit) < base - 10 + 'a');
}
static int
digit_to_int (c)
unsigned char c;
{
if (isdigit (c))
return c - '0';
else
return tolower (c) - 'a' + 10;
}
/* As for strtoul, but for ULONGEST results. */
ULONGEST
strtoulst (num, trailer, base)
const char *num;
const char **trailer;
int base;
{
unsigned int high_part;
ULONGEST result;
int i;
unsigned char lim;
if (base < 2 || base > 16)
{
errno = EINVAL;
return 0;
}
lim = base - 1 + '0';
result = high_part = 0;
for (i = 0; is_digit_in_base (num[i], base); i += 1)
{
result = result*base + digit_to_int (num[i]);
high_part = high_part*base + (unsigned int) (result >> HIGH_BYTE_POSN);
result &= ((ULONGEST) 1 << HIGH_BYTE_POSN) - 1;
if (high_part > 0xff)
{
errno = ERANGE;
result = high_part = 0;
break;
}
}
if (trailer != NULL)
*trailer = &num[i];
return result + ((ULONGEST) high_part << HIGH_BYTE_POSN);
}
/* Interprets the prefix of NUM that consists of digits of the given BASE
as an integer of that BASE, with the string EXP as an exponent.
Puts value in yylval, and returns INT, if the string is valid. Causes
an error if the number is improperly formated. BASE, if NULL, defaults
to "10", and EXP to "1". The EXP does not contain a leading 'e' or 'E'. */
static int
processInt (base0, num0, exp0)
const char* num0;
const char* base0;
const char* exp0;
{
ULONGEST result;
long exp;
int base;
char* trailer;
if (base0 == NULL)
base = 10;
else
{
base = strtol (base0, (char**) NULL, 10);
if (base < 2 || base > 16)
error ("Invalid base: %d.", base);
}
if (exp0 == NULL)
exp = 0;
else
exp = strtol(exp0, (char**) NULL, 10);
errno = 0;
result = strtoulst (num0, &trailer, base);
if (errno == ERANGE)
error ("Integer literal out of range");
if (isxdigit(*trailer))
error ("Invalid digit `%c' in based literal", *trailer);
while (exp > 0)
{
if (result > (ULONG_MAX / base))
error ("Integer literal out of range");
result *= base;
exp -= 1;
}
if ((result >> (TARGET_INT_BIT-1)) == 0)
yylval.typed_val.type = builtin_type_ada_int;
else if ((result >> (TARGET_LONG_BIT-1)) == 0)
yylval.typed_val.type = builtin_type_ada_long;
else if (((result >> (TARGET_LONG_BIT-1)) >> 1) == 0)
{
/* We have a number representable as an unsigned integer quantity.
For consistency with the C treatment, we will treat it as an
anonymous modular (unsigned) quantity. Alas, the types are such
that we need to store .val as a signed quantity. Sorry
for the mess, but C doesn't officially guarantee that a simple
assignment does the trick (no, it doesn't; read the reference manual).
*/
yylval.typed_val.type = builtin_type_unsigned_long;
if (result & LONGEST_SIGN)
yylval.typed_val.val =
(LONGEST) (result & ~LONGEST_SIGN)
- (LONGEST_SIGN>>1) - (LONGEST_SIGN>>1);
else
yylval.typed_val.val = (LONGEST) result;
return INT;
}
else
yylval.typed_val.type = builtin_type_ada_long_long;
yylval.typed_val.val = (LONGEST) result;
return INT;
}
static int
processReal (num0)
const char* num0;
{
if (sizeof (DOUBLEST) <= sizeof (float))
sscanf (num0, "%g", &yylval.typed_val_float.dval);
else if (sizeof (DOUBLEST) <= sizeof (double))
sscanf (num0, "%lg", &yylval.typed_val_float.dval);
else
{
#ifdef PRINTF_HAS_LONG_DOUBLE
sscanf (num0, "%Lg", &yylval.typed_val_float.dval);
#else
/* Scan it into a double, then convert and assign it to the
long double. This at least wins with values representable
in the range of doubles. */
double temp;
sscanf (num0, "%lg", &temp);
yylval.typed_val_float.dval = temp;
#endif
}
yylval.typed_val_float.type = builtin_type_ada_float;
if (sizeof(DOUBLEST) >= TARGET_DOUBLE_BIT / TARGET_CHAR_BIT)
yylval.typed_val_float.type = builtin_type_ada_double;
if (sizeof(DOUBLEST) >= TARGET_LONG_DOUBLE_BIT / TARGET_CHAR_BIT)
yylval.typed_val_float.type = builtin_type_ada_long_double;
return FLOAT;
}
static int
processId (name0, len)
const char *name0;
int len;
{
char* name = xmalloc (len + 11);
int i0, i;
/* add_name_string_cleanup (name); */
/* FIXME: add_name_string_cleanup should be defined in parse.c */
while (len > 0 && isspace (name0[len-1]))
len -= 1;
i = i0 = 0;
while (i0 < len)
{
if (isalnum (name0[i0]))
{
name[i] = tolower (name0[i0]);
i += 1; i0 += 1;
}
else switch (name0[i0])
{
default:
name[i] = name0[i0];
i += 1; i0 += 1;
break;
case ' ': case '\t':
i0 += 1;
break;
case '\'':
i0 += 1;
while (i0 < len && name0[i0] != '\'')
{
name[i] = name0[i0];
i += 1; i0 += 1;
}
i0 += 1;
break;
case '<':
i0 += 1;
while (i0 < len && name0[i0] != '>')
{
name[i] = name0[i0];
i += 1; i0 += 1;
}
i0 += 1;
break;
}
}
name[i] = '\000';
yylval.ssym.sym = NULL;
yylval.ssym.stoken.ptr = name;
yylval.ssym.stoken.length = i;
return NAME;
}
static void
block_lookup (name, err_name)
char* name;
char* err_name;
{
struct symbol** syms;
struct block** blocks;
int nsyms;
struct symtab *symtab;
nsyms = ada_lookup_symbol_list (name, left_block_context,
VAR_NAMESPACE, &syms, &blocks);
if (left_block_context == NULL &&
(nsyms == 0 || SYMBOL_CLASS (syms[0]) != LOC_BLOCK))
symtab = lookup_symtab (name);
else
symtab = NULL;
if (symtab != NULL)
left_block_context = yylval.bval =
BLOCKVECTOR_BLOCK (BLOCKVECTOR (symtab), STATIC_BLOCK);
else if (nsyms == 0 || SYMBOL_CLASS (syms[0]) != LOC_BLOCK)
{
if (left_block_context == NULL)
error ("No file or function \"%s\".", err_name);
else
error ("No function \"%s\" in specified context.", err_name);
}
else
{
left_block_context = yylval.bval = SYMBOL_BLOCK_VALUE (syms[0]);
if (nsyms > 1)
warning ("Function name \"%s\" ambiguous here", err_name);
}
}
/* Look up NAME0 (assumed to be mangled) as a name in VAR_NAMESPACE,
setting *TOKEN_TYPE to NAME or TYPENAME, depending on what is
found. Try first the entire name, then the name without the last
segment (i.e., after the last .id), etc., and return the number of
segments that had to be removed to get a match. Calls error if no
matches are found, using ERR_NAME in any error message. When
exactly one symbol match is found, it is placed in yylval. */
static int
name_lookup (name0, err_name, token_type)
char* name0;
char* err_name;
int* token_type;
{
struct symbol** syms;
struct block** blocks;
struct type* type;
int len0 = strlen (name0);
char* name = savestring (name0, len0);
int nsyms;
int segments;
/* add_name_string_cleanup (name);*/
/* FIXME: add_name_string_cleanup should be defined in parse.c */
yylval.ssym.stoken.ptr = name;
yylval.ssym.stoken.length = strlen (name);
for (segments = 0; ; segments += 1)
{
struct type* preferred_type;
int i, preferred_index;
if (left_block_context == NULL)
nsyms = ada_lookup_symbol_list (name, expression_context_block,
VAR_NAMESPACE, &syms, &blocks);
else
nsyms = ada_lookup_symbol_list (name, left_block_context,
VAR_NAMESPACE, &syms, &blocks);
/* Check for a type definition. */
/* Look for a symbol that doesn't denote void. This is (I think) a */
/* temporary kludge to get around problems in GNAT output. */
preferred_index = -1; preferred_type = NULL;
for (i = 0; i < nsyms; i += 1)
switch (SYMBOL_CLASS (syms[i]))
{
case LOC_TYPEDEF:
if (ada_prefer_type (SYMBOL_TYPE (syms[i]), preferred_type))
{
preferred_index = i;
preferred_type = SYMBOL_TYPE (syms[i]);
}
break;
case LOC_REGISTER:
case LOC_ARG:
case LOC_REF_ARG:
case LOC_REGPARM:
case LOC_REGPARM_ADDR:
case LOC_LOCAL:
case LOC_LOCAL_ARG:
case LOC_BASEREG:
case LOC_BASEREG_ARG:
goto NotType;
default:
break;
}
if (preferred_type != NULL)
{
/* if (TYPE_CODE (preferred_type) == TYPE_CODE_VOID)
error ("`%s' matches only void type name(s)",
ada_demangle (name));
*/
/* FIXME: ada_demangle should be defined in defs.h, and is located in ada-lang.c */
/* else*/ if (ada_is_object_renaming (syms[preferred_index]))
{
yylval.ssym.sym = syms[preferred_index];
*token_type = OBJECT_RENAMING;
return segments;
}
else if (ada_renaming_type (SYMBOL_TYPE (syms[preferred_index]))
!= NULL)
{
int result;
const char* renaming =
ada_simple_renamed_entity (syms[preferred_index]);
char* new_name = xmalloc (strlen (renaming) + len0
- yylval.ssym.stoken.length + 1);
/* add_name_string_cleanup (new_name);*/
/* FIXME: add_name_string_cleanup should be defined in parse.c */
strcpy (new_name, renaming);
strcat (new_name, name0 + yylval.ssym.stoken.length);
result = name_lookup (new_name, err_name, token_type);
if (result > segments)
error ("Confused by renamed symbol.");
return result;
}
else if (segments == 0)
{
yylval.tval = preferred_type;
*token_type = TYPENAME;
return 0;
}
}
if (segments == 0)
{
type = lookup_primitive_typename (name);
if (type == NULL && STREQ ("system__address", name))
type = builtin_type_ada_system_address;
if (type != NULL)
{
yylval.tval = type;
*token_type = TYPENAME;
return 0;
}
}
NotType:
if (nsyms == 1)
{
*token_type = NAME;
yylval.ssym.sym = syms[0];
yylval.ssym.msym = NULL;
yylval.ssym.block = blocks[0];
return segments;
}
else if (nsyms == 0) {
int i;
yylval.ssym.msym = ada_lookup_minimal_symbol (name);
if (yylval.ssym.msym != NULL)
{
yylval.ssym.sym = NULL;
yylval.ssym.block = NULL;
*token_type = NAME;
return segments;
}
for (i = yylval.ssym.stoken.length - 1; i > 0; i -= 1)
{
if (name[i] == '.')
{
name[i] = '\0';
yylval.ssym.stoken.length = i;
break;
}
else if (name[i] == '_' && name[i-1] == '_')
{
i -= 1;
name[i] = '\0';
yylval.ssym.stoken.length = i;
break;
}
}
if (i <= 0)
{
if (!have_full_symbols () && !have_partial_symbols ()
&& left_block_context == NULL)
error ("No symbol table is loaded. Use the \"file\" command.");
if (left_block_context == NULL)
error ("No definition of \"%s\" in current context.",
err_name);
else
error ("No definition of \"%s\" in specified context.",
err_name);
}
}
else
{
*token_type = NAME;
yylval.ssym.sym = NULL;
yylval.ssym.msym = NULL;
if (left_block_context == NULL)
yylval.ssym.block = expression_context_block;
else
yylval.ssym.block = left_block_context;
return segments;
}
}
}
/* Returns the position within STR of the '.' in a
'.{WHITE}*all' component of a dotted name, or -1 if there is none. */
static int
find_dot_all (str)
const char* str;
{
int i;
for (i = 0; str[i] != '\000'; i += 1)
{
if (str[i] == '.')
{
int i0 = i;
do
i += 1;
while (isspace (str[i]));
if (strcmp (str+i, "all") == 0
&& ! isalnum (str[i+3]) && str[i+3] != '_')
return i0;
}
}
return -1;
}
/* Returns non-zero iff string SUBSEQ matches a subsequence of STR, ignoring
case. */
static int
subseqMatch (subseq, str)
const char* subseq;
const char* str;
{
if (subseq[0] == '\0')
return 1;
else if (str[0] == '\0')
return 0;
else if (tolower (subseq[0]) == tolower (str[0]))
return subseqMatch (subseq+1, str+1) || subseqMatch (subseq, str+1);
else
return subseqMatch (subseq, str+1);
}
static struct { const char* name; int code; }
attributes[] = {
{ "address", TICK_ADDRESS },
{ "unchecked_access", TICK_ACCESS },
{ "unrestricted_access", TICK_ACCESS },
{ "access", TICK_ACCESS },
{ "first", TICK_FIRST },
{ "last", TICK_LAST },
{ "length", TICK_LENGTH },
{ "max", TICK_MAX },
{ "min", TICK_MIN },
{ "modulus", TICK_MODULUS },
{ "pos", TICK_POS },
{ "range", TICK_RANGE },
{ "size", TICK_SIZE },
{ "tag", TICK_TAG },
{ "val", TICK_VAL },
{ NULL, -1 }
};
/* Return the syntactic code corresponding to the attribute name or
abbreviation STR. */
static int
processAttribute (str)
const char* str;
{
int i, k;
for (i = 0; attributes[i].code != -1; i += 1)
if (strcasecmp (str, attributes[i].name) == 0)
return attributes[i].code;
for (i = 0, k = -1; attributes[i].code != -1; i += 1)
if (subseqMatch (str, attributes[i].name))
{
if (k == -1)
k = i;
else
error ("ambiguous attribute name: `%s'", str);
}
if (k == -1)
error ("unrecognized attribute: `%s'", str);
return attributes[k].code;
}
int
yywrap()
{
return 1;
}

806
gdb/ada-tasks.c Normal file
View File

@ -0,0 +1,806 @@
/* file ada-tasks.c: Ada tasking control for GDB
Copyright 1997 Free Software Foundation, Inc.
Contributed by Ada Core Technologies, Inc
.
This file is part of GDB.
[$Id$]
Authors: Roch-Alexandre Nomine Beguin, Arnaud Charlet <charlet@gnat.com>
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 2 of the License, or
(at your option) any later version.
*/
#include <ctype.h>
#include "defs.h"
#include "command.h"
#include "value.h"
#include "language.h"
#include "inferior.h"
#include "symtab.h"
#include "target.h"
#include "gdbcore.h"
#if (defined(__alpha__) && defined(__osf__) && !defined(__alpha_vxworks))
#include <sys/procfs.h>
#endif
#if (defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET))
#include "gregset.h"
#endif
#include "ada-lang.h"
/* FIXME: move all this conditional compilation in description
files or in configure.in */
#if defined (VXWORKS_TARGET)
#define THREAD_TO_PID(tid,lwpid) (tid)
#elif defined (linux)
#define THREAD_TO_PID(tid,lwpid) (0)
#elif (defined (sun) && defined (__SVR4))
#define THREAD_TO_PID thread_to_pid
#elif defined (sgi) || defined (__WIN32__) || defined (hpux)
#define THREAD_TO_PID(tid,lwpid) ((int)lwpid)
#else
#define THREAD_TO_PID(tid,lwpid) (0)
#endif
#if defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET)
#define THREAD_FETCH_REGISTERS dec_thread_fetch_registers
#define GET_CURRENT_THREAD dec_thread_get_current_thread
extern int dec_thread_get_registers (gdb_gregset_t *, gdb_fpregset_t *);
#endif
#if defined (_AIX)
#define THREAD_FETCH_REGISTERS aix_thread_fetch_registers
#define GET_CURRENT_THREAD aix_thread_get_current_thread
#endif
#if defined(VXWORKS_TARGET)
#define GET_CURRENT_THREAD() ((void*)inferior_pid)
#define THREAD_FETCH_REGISTERS() (-1)
#elif defined (sun) && defined (__SVR4)
#define GET_CURRENT_THREAD solaris_thread_get_current_thread
#define THREAD_FETCH_REGISTERS() (-1)
extern void *GET_CURRENT_THREAD();
#elif defined (_AIX) || (defined(__alpha__) && defined(__osf__))
extern void *GET_CURRENT_THREAD();
#elif defined (__WIN32__) || defined (hpux)
#define GET_CURRENT_THREAD() (inferior_pid)
#define THREAD_FETCH_REGISTERS() (-1)
#else
#define GET_CURRENT_THREAD() (NULL)
#define THREAD_FETCH_REGISTERS() (-1)
#endif
#define KNOWN_TASKS_NAME "system__tasking__debug__known_tasks"
#define READ_MEMORY(addr, var) read_memory (addr, (char*) &var, sizeof (var))
/* external declarations */
extern struct value* find_function_in_inferior (char *);
/* Global visible variables */
struct task_entry *task_list = NULL;
int ada__tasks_check_symbol_table = 1;
void *pthread_kern_addr = NULL;
#if (defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET))
gdb_gregset_t gregset_saved;
gdb_fpregset_t fpregset_saved;
#endif
/* The maximum number of tasks known to the Ada runtime */
const int MAX_NUMBER_OF_KNOWN_TASKS = 1000;
/* the current task */
int current_task = -1, current_task_id = -1, current_task_index;
void *current_thread, *current_lwp;
char *ada_task_states[] =
{
"Unactivated",
"Runnable",
"Terminated",
"Child Activation Wait",
"Accept Statement",
"Waiting on entry call",
"Async Select Wait",
"Delay Sleep",
"Child Termination Wait",
"Wait Child in Term Alt",
"",
"",
"",
"",
"Asynchronous Hold"
};
/* Global internal types */
static char *ada_long_task_states[] =
{
"Unactivated",
"Runnable",
"Terminated",
"Waiting for child activation",
"Blocked in accept statement",
"Waiting on entry call",
"Asynchronous Selective Wait",
"Delay Sleep",
"Waiting for children termination",
"Waiting for children in terminate alternative",
"",
"",
"",
"",
"Asynchronous Hold"
};
/* Global internal variables */
static int highest_task_num = 0;
int thread_support = 0; /* 1 if the thread library in use is supported */
static int gdbtk_task_initialization = 0;
static int add_task_entry (p_task_id, index)
void *p_task_id;
int index;
{
struct task_entry *new_task_entry = NULL;
struct task_entry *pt;
highest_task_num++;
new_task_entry = malloc (sizeof (struct task_entry));
new_task_entry->task_num = highest_task_num;
new_task_entry->task_id = p_task_id;
new_task_entry->known_tasks_index = index;
new_task_entry->next_task = NULL;
pt = task_list;
if (pt)
{
while (pt->next_task)
pt = pt->next_task;
pt->next_task = new_task_entry;
pt->stack_per = 0;
}
else task_list = new_task_entry;
return new_task_entry->task_num;
}
int
get_entry_number (p_task_id)
void *p_task_id;
{
struct task_entry *pt;
pt = task_list;
while (pt != NULL)
{
if (pt->task_id == p_task_id)
return pt->task_num;
pt = pt->next_task;
}
return 0;
}
static struct task_entry *get_thread_entry_vptr (thread)
void *thread;
{
struct task_entry *pt;
pt = task_list;
while (pt != NULL)
{
if (pt->thread == thread)
return pt;
pt = pt->next_task;
}
return 0;
}
static struct task_entry *get_entry_vptr (p_task_num)
int p_task_num;
{
struct task_entry *pt;
pt = task_list;
while (pt)
{
if (pt->task_num == p_task_num)
return pt;
pt = pt->next_task;
}
return NULL;
}
void init_task_list ()
{
struct task_entry *pt, *old_pt;
pt = task_list;
while (pt)
{
old_pt = pt;
pt = pt->next_task;
free (old_pt);
};
task_list = NULL;
highest_task_num = 0;
}
int valid_task_id (task)
int task;
{
return get_entry_vptr (task) != NULL;
}
void *get_self_id ()
{
struct value* val;
void *self_id;
int result;
struct task_entry *ent;
extern int do_not_insert_breakpoints;
#if !((defined(sun) && defined(__SVR4)) || defined(VXWORKS_TARGET) || defined(__WIN32__))
if (thread_support)
#endif
{
ent = get_thread_entry_vptr (GET_CURRENT_THREAD ());
return ent ? ent->task_id : 0;
}
/* FIXME: calling a function in the inferior with a multithreaded application
is not reliable, so return NULL if there is no safe way to get the current
task */
return NULL;
}
int get_current_task ()
{
int result;
/* FIXME: language_ada should be defined in defs.h */
/* if (current_language->la_language != language_ada) return -1; */
result = get_entry_number (get_self_id ());
/* return -1 if not found */
return result == 0 ? -1 : result;
}
/* Print detailed information about specified task */
static void
info_task (arg, from_tty)
char *arg;
int from_tty;
{
void *temp_task;
struct task_entry *pt, *pt2;
void *self_id, *caller;
struct task_fields atcb, atcb2;
struct entry_call call;
int bounds [2];
char image [256];
int num;
/* FIXME: language_ada should be defined in defs.h */
/* if (current_language->la_language != language_ada)
{
printf_filtered ("The current language does not support tasks.\n");
return;
}
*/
pt = get_entry_vptr (atoi (arg));
if (pt == NULL)
{
printf_filtered ("Task %s not found.\n", arg);
return;
}
temp_task = pt->task_id;
/* read the atcb in the inferior */
READ_MEMORY ((CORE_ADDR) temp_task, atcb);
/* print the Ada task id */
printf_filtered ("Ada Task: %p\n", temp_task);
/* print the name of the task */
if (atcb.image.P_ARRAY != NULL) {
READ_MEMORY ((CORE_ADDR) EXTRACT_ADDRESS (atcb.image.P_BOUNDS), bounds);
bounds [1] = EXTRACT_INT (bounds [1]);
read_memory ((CORE_ADDR) EXTRACT_ADDRESS (atcb.image.P_ARRAY),
(char*) &image, bounds [1]);
printf_filtered ("Name: %.*s\n", bounds [1], image);
}
else printf_filtered ("<no name>\n");
/* print the thread id */
if ((long) pt->thread < 65536)
printf_filtered ("Thread: %ld\n", (long int) pt->thread);
else
printf_filtered ("Thread: %p\n", pt->thread);
if ((long) pt->lwp != 0)
{
if ((long) pt->lwp < 65536)
printf_filtered ("LWP: %ld\n", (long int) pt->lwp);
else
printf_filtered ("LWP: %p\n", pt->lwp);
}
/* print the parent gdb task id */
num = get_entry_number (EXTRACT_ADDRESS (atcb.parent));
if (num != 0)
{
printf_filtered ("Parent: %d", num);
pt2 = get_entry_vptr (num);
READ_MEMORY ((CORE_ADDR) pt2->task_id, atcb2);
/* print the name of the task */
if (atcb2.image.P_ARRAY != NULL) {
READ_MEMORY ((CORE_ADDR) EXTRACT_ADDRESS (atcb2.image.P_BOUNDS),
bounds);
bounds [1] = EXTRACT_INT (bounds [1]);
read_memory ((CORE_ADDR) EXTRACT_ADDRESS (atcb2.image.P_ARRAY),
(char*) &image, bounds [1]);
printf_filtered (" (%.*s)\n", bounds [1], image);
}
else
printf_filtered ("\n");
}
else
printf_filtered ("No parent\n");
/* print the base priority of the task */
printf_filtered ("Base Priority: %d\n", EXTRACT_INT (atcb.priority));
/* print the current state of the task */
/* check if this task is accepting a rendezvous */
if (atcb.call == NULL)
caller = NULL;
else {
READ_MEMORY ((CORE_ADDR) EXTRACT_ADDRESS (atcb.call), call);
caller = EXTRACT_ADDRESS (call.self);
}
if (caller != NULL)
{
num = get_entry_number (caller);
printf_filtered ("Accepting rendezvous with %d", num);
if (num != 0)
{
pt2 = get_entry_vptr (num);
READ_MEMORY ((CORE_ADDR) pt2->task_id, atcb2);
/* print the name of the task */
if (atcb2.image.P_ARRAY != NULL) {
READ_MEMORY ((CORE_ADDR) EXTRACT_ADDRESS (atcb2.image.P_BOUNDS),
bounds);
bounds [1] = EXTRACT_INT (bounds [1]);
read_memory ((CORE_ADDR) EXTRACT_ADDRESS (atcb2.image.P_ARRAY),
(char*) &image, bounds [1]);
printf_filtered (" (%.*s)\n", bounds [1], image);
}
else
printf_filtered ("\n");
}
else
printf_filtered ("\n");
}
else
printf_filtered ("State: %s\n", ada_long_task_states [atcb.state]);
}
#if 0
/* A useful function that shows the alignment of all the fields in the
tasks_fields structure
*/
print_align ()
{
struct task_fields tf;
void *tf_base = &(tf);
void *tf_state = &(tf.state);
void *tf_entry_num = &(tf.entry_num);
void *tf_parent = &(tf.parent);
void *tf_priority = &(tf.priority);
void *tf_current_priority = &(tf.current_priority);
void *tf_image = &(tf.image);
void *tf_call = &(tf.call);
void *tf_thread = &(tf.thread);
void *tf_lwp = &(tf.lwp);
printf_filtered ("\n");
printf_filtered ("(tf_base = 0x%x)\n", tf_base);
printf_filtered ("task_fields.entry_num at %3d (0x%x)\n", tf_entry_num - tf_base, tf_entry_num);
printf_filtered ("task_fields.state at %3d (0x%x)\n", tf_state - tf_base, tf_state);
printf_filtered ("task_fields.parent at %3d (0x%x)\n", tf_parent - tf_base, tf_parent);
printf_filtered ("task_fields.priority at %3d (0x%x)\n", tf_priority - tf_base, tf_priority);
printf_filtered ("task_fields.current_priority at %3d (0x%x)\n", tf_current_priority - tf_base, tf_current_priority);
printf_filtered ("task_fields.image at %3d (0x%x)\n", tf_image - tf_base, tf_image);
printf_filtered ("task_fields.call at %3d (0x%x)\n", tf_call - tf_base, tf_call);
printf_filtered ("task_fields.thread at %3d (0x%x)\n", tf_thread - tf_base, tf_thread);
printf_filtered ("task_fields.lwp at %3d (0x%x)\n", tf_lwp - tf_base, tf_lwp);
printf_filtered ("\n");
}
#endif
/* Print information about currently known tasks */
static void
info_tasks (arg, from_tty)
char *arg;
int from_tty;
{
struct value* val;
int i, task_number, state;
void *temp_task, *temp_tasks [MAX_NUMBER_OF_KNOWN_TASKS];
struct task_entry *pt;
void *self_id, *caller, *thread_id=NULL;
struct task_fields atcb;
struct entry_call call;
int bounds [2];
char image [256];
int size;
char car;
#if defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET)
pthreadTeb_t thr;
gdb_gregset_t regs;
#endif
static struct symbol *sym;
static struct minimal_symbol *msym;
static void *known_tasks_addr = NULL;
int init_only = gdbtk_task_initialization;
gdbtk_task_initialization = 0;
task_number = 0;
if (PIDGET(inferior_ptid) == 0)
{
printf_filtered ("The program is not being run under gdb. ");
printf_filtered ("Use 'run' or 'attach' first.\n");
return;
}
if (ada__tasks_check_symbol_table)
{
thread_support = 0;
#if (defined(__alpha__) && defined(__osf__) & !defined(VXWORKS_TARGET)) || \
defined (_AIX)
thread_support = 1;
#endif
msym = lookup_minimal_symbol (KNOWN_TASKS_NAME, NULL, NULL);
if (msym != NULL)
known_tasks_addr = (void *) SYMBOL_VALUE_ADDRESS (msym);
else
#ifndef VXWORKS_TARGET
return;
#else
{
if (target_lookup_symbol (KNOWN_TASKS_NAME, &known_tasks_addr) != 0)
return;
}
#endif
ada__tasks_check_symbol_table = 0;
}
if (known_tasks_addr == NULL)
return;
#if !((defined(sun) && defined(__SVR4)) || defined(VXWORKS_TARGET) || defined(__WIN32__) || defined (hpux))
if (thread_support)
#endif
thread_id = GET_CURRENT_THREAD ();
/* then we get a list of tasks created */
init_task_list ();
READ_MEMORY ((CORE_ADDR) known_tasks_addr, temp_tasks);
for (i=0; i<MAX_NUMBER_OF_KNOWN_TASKS; i++)
{
temp_task = EXTRACT_ADDRESS (temp_tasks[i]);
if (temp_task != NULL)
{
task_number = get_entry_number (temp_task);
if (task_number == 0)
task_number = add_task_entry (temp_task, i);
}
}
/* Return without printing anything if this function was called in
order to init GDBTK tasking. */
if (init_only) return;
/* print the header */
#if defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET)
printf_filtered
(" ID TID P-ID Pri Stack %% State Name\n");
#else
printf_filtered (" ID TID P-ID Pri State Name\n");
#endif
/* Now that we have a list of task id's, we can print them */
pt = task_list;
while (pt)
{
temp_task = pt->task_id;
/* read the atcb in the inferior */
READ_MEMORY ((CORE_ADDR) temp_task, atcb);
/* store the thread id for future use */
pt->thread = EXTRACT_ADDRESS (atcb.thread);
#if defined (linux)
pt->lwp = (void *) THREAD_TO_PID (atcb.thread, 0);
#else
pt->lwp = EXTRACT_ADDRESS (atcb.lwp);
#endif
/* print a star if this task is the current one */
if (thread_id)
#if defined (__WIN32__) || defined (SGI) || defined (hpux)
printf_filtered (pt->lwp == thread_id ? "*" : " ");
#else
printf_filtered (pt->thread == thread_id ? "*" : " ");
#endif
/* print the gdb task id */
printf_filtered ("%3d", pt->task_num);
/* print the Ada task id */
#ifndef VXWORKS_TARGET
printf_filtered (" %9lx", (long) temp_task);
#else
#ifdef TARGET_64
printf_filtered (" %#9lx", (unsigned long)pt->thread & 0x3ffffffffff);
#else
printf_filtered (" %#9lx", (long)pt->thread);
#endif
#endif
/* print the parent gdb task id */
printf_filtered
(" %4d", get_entry_number (EXTRACT_ADDRESS (atcb.parent)));
/* print the base priority of the task */
printf_filtered (" %3d", EXTRACT_INT (atcb.priority));
#if defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET)
if (pt->task_num == 1 || atcb.state == Terminated)
{
printf_filtered (" Unknown");
goto next;
}
read_memory ((CORE_ADDR)atcb.thread, &thr, sizeof (thr));
current_thread = atcb.thread;
regs.regs [SP_REGNUM] = 0;
if (dec_thread_get_registers (&regs, NULL) == 0) {
pt->stack_per = (100 * ((long)thr.__stack_base -
regs.regs [SP_REGNUM])) / thr.__stack_size;
/* if the thread is terminated but still there, the
stack_base/size values are erroneous. Try to patch it */
if (pt->stack_per < 0 || pt->stack_per > 100) pt->stack_per = 0;
}
/* print information about stack space used in the thread */
if (thr.__stack_size < 1024*1024)
{
size = thr.__stack_size / 1024;
car = 'K';
}
else if (thr.__stack_size < 1024*1024*1024)
{
size = thr.__stack_size / 1024 / 1024;
car = 'M';
}
else /* Who knows... */
{
size = thr.__stack_size / 1024 / 1024 / 1024;
car = 'G';
}
printf_filtered (" %4d%c %2d", size, car, pt->stack_per);
next:
#endif
/* print the current state of the task */
/* check if this task is accepting a rendezvous */
if (atcb.call == NULL)
caller = NULL;
else {
READ_MEMORY ((CORE_ADDR) EXTRACT_ADDRESS (atcb.call), call);
caller = EXTRACT_ADDRESS (call.self);
}
if (caller != NULL)
printf_filtered (" Accepting RV with %-4d", get_entry_number (caller));
else
{
state = atcb.state;
#if defined (__WIN32__) || defined (SGI) || defined (hpux)
if (state == Runnable && (thread_id && pt->lwp == thread_id))
#else
if (state == Runnable && (thread_id && pt->thread == thread_id))
#endif
/* Replace "Runnable" by "Running" if this is the current task */
printf_filtered (" %-22s", "Running");
else
printf_filtered (" %-22s", ada_task_states [state]);
}
/* finally, print the name of the task */
if (atcb.image.P_ARRAY != NULL) {
READ_MEMORY ((CORE_ADDR) EXTRACT_ADDRESS (atcb.image.P_BOUNDS), bounds);
bounds [1] = EXTRACT_INT (bounds [1]);
read_memory ((CORE_ADDR) EXTRACT_ADDRESS (atcb.image.P_ARRAY),
(char*)&image, bounds [1]);
printf_filtered (" %.*s\n", bounds [1], image);
}
else printf_filtered (" <no name>\n");
pt = pt->next_task;
}
}
/* Task list initialization for GDB-Tk. We basically use info_tasks()
to initialize our variables, but abort that function before we
actually print anything. */
int
gdbtk_tcl_tasks_initialize ()
{
gdbtk_task_initialization = 1;
info_tasks ("", gdb_stdout);
return (task_list != NULL);
}
static void
info_tasks_command (arg, from_tty)
char *arg;
int from_tty;
{
if (arg == NULL || *arg == '\000')
info_tasks (arg, from_tty);
else
info_task (arg, from_tty);
}
/* Switch from one thread to another. */
static void
switch_to_thread (ptid_t ptid)
{
if (ptid_equal (ptid, inferior_ptid))
return;
inferior_ptid = ptid;
flush_cached_frames ();
registers_changed ();
stop_pc = read_pc ();
select_frame (get_current_frame ());
}
/* Switch to a specified task. */
static int task_switch (tid, lwpid)
void *tid, *lwpid;
{
int res = 0, pid;
if (thread_support)
{
flush_cached_frames ();
if (current_task != current_task_id)
{
res = THREAD_FETCH_REGISTERS ();
}
else
{
#if (defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET))
supply_gregset (&gregset_saved);
supply_fpregset (&fpregset_saved);
#endif
}
if (res == 0) stop_pc = read_pc();
select_frame (get_current_frame ());
return res;
}
return -1;
}
static void task_command (tidstr, from_tty)
char *tidstr;
int from_tty;
{
int num;
struct task_entry *e;
if (!tidstr)
error ("Please specify a task ID. Use the \"info tasks\" command to\n"
"see the IDs of currently known tasks.");
num = atoi (tidstr);
e = get_entry_vptr (num);
if (e == NULL)
error ("Task ID %d not known. Use the \"info tasks\" command to\n"
"see the IDs of currently known tasks.", num);
if (current_task_id == -1)
{
#if (defined(__alpha__) && defined(__osf__) && !defined(VXWORKS_TARGET))
fill_gregset (&gregset_saved, -1);
fill_fpregset (&fpregset_saved, -1);
#endif
current_task_id = get_current_task ();
}
current_task = num;
current_task_index = e->known_tasks_index;
current_thread = e->thread;
current_lwp = e->lwp;
if (task_switch (e->thread, e->lwp) == 0)
{
/* FIXME: find_printable_frame should be defined in frame.h, and
implemented in ada-lang.c */
/* find_printable_frame (selected_frame, frame_relative_level (selected_frame));*/
printf_filtered ("[Switching to task %d]\n", num);
print_stack_frame (selected_frame, frame_relative_level (selected_frame), 1);
}
else
printf_filtered ("Unable to switch to task %d\n", num);
}
void
_initialize_tasks ()
{
static struct cmd_list_element *task_cmd_list = NULL;
extern struct cmd_list_element *cmdlist;
add_info (
"tasks", info_tasks_command,
"Without argument: list all known Ada tasks, with status information.\n"
"info tasks n: print detailed information of task n.\n");
add_prefix_cmd ("task", class_run, task_command,
"Use this command to switch between tasks.\n\
The new task ID must be currently known.", &task_cmd_list, "task ", 1,
&cmdlist);
}

896
gdb/ada-typeprint.c Normal file
View File

@ -0,0 +1,896 @@
/* Support for printing Ada types for GDB, the GNU debugger.
Copyright 1986, 1988, 1989, 1991, 1997 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 2 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, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
#include "defs.h"
#include "obstack.h"
#include "bfd.h" /* Binary File Description */
#include "symtab.h"
#include "gdbtypes.h"
#include "expression.h"
#include "value.h"
#include "gdbcore.h"
#include "target.h"
#include "command.h"
#include "gdbcmd.h"
#include "language.h"
#include "demangle.h"
#include "c-lang.h"
#include "typeprint.h"
#include "ada-lang.h"
#include <ctype.h>
#include <string.h>
#include <errno.h>
static int print_record_field_types (struct type *, struct type *,
struct ui_file *, int, int);
static void print_array_type (struct type*, struct ui_file*, int, int);
static void print_choices (struct type*, int, struct ui_file*, struct type*);
static void print_range (struct type*, struct ui_file*);
static void print_range_bound (struct type*, char*, int*, struct ui_file*);
static void
print_dynamic_range_bound (struct type*, const char*, int,
const char*, struct ui_file*);
static void print_range_type_named (char*, struct ui_file*);
static char* name_buffer;
static int name_buffer_len;
/* The (demangled) Ada name of TYPE. This value persists until the
next call. */
static char*
demangled_type_name (type)
struct type *type;
{
if (ada_type_name (type) == NULL)
return NULL;
else
{
char* raw_name = ada_type_name (type);
char *s, *q;
if (name_buffer == NULL || name_buffer_len <= strlen (raw_name))
{
name_buffer_len = 16 + 2 * strlen (raw_name);
name_buffer = xrealloc (name_buffer, name_buffer_len);
}
strcpy (name_buffer, raw_name);
s = (char*) strstr (name_buffer, "___");
if (s != NULL)
*s = '\0';
s = name_buffer + strlen (name_buffer) - 1;
while (s > name_buffer && (s[0] != '_' || s[-1] != '_'))
s -= 1;
if (s == name_buffer)
return name_buffer;
if (! islower (s[1]))
return NULL;
for (s = q = name_buffer; *s != '\0'; q += 1)
{
if (s[0] == '_' && s[1] == '_')
{
*q = '.'; s += 2;
}
else
{
*q = *s; s += 1;
}
}
*q = '\0';
return name_buffer;
}
}
/* Print a description of a type in the format of a
typedef for the current language.
NEW is the new name for a type TYPE. */
void
ada_typedef_print (type, new, stream)
struct type *type;
struct symbol *new;
struct ui_file *stream;
{
fprintf_filtered (stream, "type %.*s is ",
ada_name_prefix_len (SYMBOL_SOURCE_NAME(new)),
SYMBOL_SOURCE_NAME(new));
type_print (type, "", stream, 1);
}
/* Print range type TYPE on STREAM. */
static void
print_range (type, stream)
struct type* type;
struct ui_file* stream;
{
struct type* target_type;
target_type = TYPE_TARGET_TYPE (type);
if (target_type == NULL)
target_type = type;
switch (TYPE_CODE (target_type))
{
case TYPE_CODE_RANGE:
case TYPE_CODE_INT:
case TYPE_CODE_BOOL:
case TYPE_CODE_CHAR:
case TYPE_CODE_ENUM:
break;
default:
target_type = builtin_type_ada_int;
break;
}
if (TYPE_NFIELDS (type) < 2)
{
/* A range needs at least 2 bounds to be printed. If there are less
than 2, just print the type name instead of the range itself.
This check handles cases such as characters, for example.
Note that if the name is not defined, then we don't print anything.
*/
fprintf_filtered (stream, "%.*s",
ada_name_prefix_len (TYPE_NAME (type)),
TYPE_NAME (type));
}
else
{
/* We extract the range type bounds respectively from the first element
and the last element of the type->fields array */
const LONGEST lower_bound = (LONGEST) TYPE_LOW_BOUND (type);
const LONGEST upper_bound =
(LONGEST) TYPE_FIELD_BITPOS (type, TYPE_NFIELDS (type) -1);
ada_print_scalar (target_type, lower_bound, stream);
fprintf_filtered (stream, " .. ");
ada_print_scalar (target_type, upper_bound, stream);
}
}
/* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
set *N past the bound and its delimiter, if any. */
static void
print_range_bound (type, bounds, n, stream)
struct type* type;
char* bounds;
int* n;
struct ui_file* stream;
{
LONGEST B;
if (ada_scan_number (bounds, *n, &B, n))
{
ada_print_scalar (type, B, stream);
if (bounds[*n] == '_')
*n += 2;
}
else
{
int bound_len;
char* bound = bounds + *n;
char* pend;
pend = strstr (bound, "__");
if (pend == NULL)
*n += bound_len = strlen (bound);
else
{
bound_len = pend - bound;
*n += bound_len + 2;
}
fprintf_filtered (stream, "%.*s", bound_len, bound);
}
}
/* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
the value (if found) of the bound indicated by SUFFIX ("___L" or
"___U") according to the ___XD conventions. */
static void
print_dynamic_range_bound (type, name, name_len, suffix, stream)
struct type* type;
const char* name;
int name_len;
const char* suffix;
struct ui_file* stream;
{
static char *name_buf = NULL;
static size_t name_buf_len = 0;
LONGEST B;
int OK;
GROW_VECT (name_buf, name_buf_len, name_len + strlen (suffix) + 1);
strncpy (name_buf, name, name_len);
strcpy (name_buf + name_len, suffix);
B = get_int_var_value (name_buf, 0, &OK);
if (OK)
ada_print_scalar (type, B, stream);
else
fprintf_filtered (stream, "?");
}
/* Print the range type named NAME. */
static void
print_range_type_named (name, stream)
char* name;
struct ui_file* stream;
{
struct type *raw_type = ada_find_any_type (name);
struct type *base_type;
LONGEST low, high;
char* subtype_info;
if (raw_type == NULL)
base_type = builtin_type_int;
else if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
base_type = TYPE_TARGET_TYPE (raw_type);
else
base_type = raw_type;
subtype_info = strstr (name, "___XD");
if (subtype_info == NULL && raw_type == NULL)
fprintf_filtered (stream, "? .. ?");
else if (subtype_info == NULL)
print_range (raw_type, stream);
else
{
int prefix_len = subtype_info - name;
char *bounds_str;
int n;
subtype_info += 5;
bounds_str = strchr (subtype_info, '_');
n = 1;
if (*subtype_info == 'L')
{
print_range_bound (raw_type, bounds_str, &n, stream);
subtype_info += 1;
}
else
print_dynamic_range_bound (raw_type, name, prefix_len, "___L", stream);
fprintf_filtered (stream, " .. ");
if (*subtype_info == 'U')
print_range_bound (raw_type, bounds_str, &n, stream);
else
print_dynamic_range_bound (raw_type, name, prefix_len, "___U", stream);
}
}
/* Print enumerated type TYPE on STREAM. */
static void
print_enum_type (type, stream)
struct type *type;
struct ui_file *stream;
{
int len = TYPE_NFIELDS (type);
int i, lastval;
fprintf_filtered (stream, "(");
wrap_here (" ");
lastval = 0;
for (i = 0; i < len; i++)
{
QUIT;
if (i) fprintf_filtered (stream, ", ");
wrap_here (" ");
fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
if (lastval != TYPE_FIELD_BITPOS (type, i))
{
fprintf_filtered (stream, " => %d", TYPE_FIELD_BITPOS (type, i));
lastval = TYPE_FIELD_BITPOS (type, i);
}
lastval += 1;
}
fprintf_filtered (stream, ")");
}
/* Print representation of Ada fixed-point type TYPE on STREAM. */
static void
print_fixed_point_type (type, stream)
struct type *type;
struct ui_file *stream;
{
DOUBLEST delta = ada_delta (type);
DOUBLEST small = ada_fixed_to_float (type, 1.0);
if (delta < 0.0)
fprintf_filtered (stream, "delta ??");
else
{
fprintf_filtered (stream, "delta %g", (double) delta);
if (delta != small)
fprintf_filtered (stream, " <'small = %g>", (double) small);
}
}
/* Print representation of special VAX floating-point type TYPE on STREAM. */
static void
print_vax_floating_point_type (type, stream)
struct type *type;
struct ui_file *stream;
{
fprintf_filtered (stream, "<float format %c>",
ada_vax_float_type_suffix (type));
}
/* Print simple (constrained) array type TYPE on STREAM. LEVEL is the
recursion (indentation) level, in case the element type itself has
nested structure, and SHOW is the number of levels of internal
structure to show (see ada_print_type). */
static void
print_array_type (type, stream, show, level)
struct type *type;
struct ui_file *stream;
int show;
int level;
{
int bitsize;
int n_indices;
bitsize = 0;
fprintf_filtered (stream, "array (");
n_indices = -1;
if (show < 0)
fprintf_filtered (stream, "...");
else
{
if (ada_is_packed_array_type (type))
type = ada_coerce_to_simple_array_type (type);
if (ada_is_simple_array (type))
{
struct type* range_desc_type =
ada_find_parallel_type (type, "___XA");
struct type* arr_type;
bitsize = 0;
if (range_desc_type == NULL)
{
for (arr_type = type; TYPE_CODE (arr_type) == TYPE_CODE_ARRAY;
arr_type = TYPE_TARGET_TYPE (arr_type))
{
if (arr_type != type)
fprintf_filtered (stream, ", ");
print_range (TYPE_INDEX_TYPE (arr_type), stream);
if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
}
}
else
{
int k;
n_indices = TYPE_NFIELDS (range_desc_type);
for (k = 0, arr_type = type;
k < n_indices;
k += 1, arr_type = TYPE_TARGET_TYPE (arr_type))
{
if (k > 0)
fprintf_filtered (stream, ", ");
print_range_type_named (TYPE_FIELD_NAME (range_desc_type, k),
stream);
if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
}
}
}
else
{
int i, i0;
for (i = i0 = ada_array_arity (type); i > 0; i -= 1)
fprintf_filtered (stream, "%s<>", i == i0 ? "" : ", ");
}
}
fprintf_filtered (stream, ") of ");
wrap_here ("");
ada_print_type (ada_array_element_type (type, n_indices), "", stream,
show == 0 ? 0 : show-1, level+1);
if (bitsize > 0)
fprintf_filtered (stream, " <packed: %d-bit elements>", bitsize);
}
/* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
STREAM, assuming the VAL_TYPE is the type of the values. */
static void
print_choices (type, field_num, stream, val_type)
struct type *type;
int field_num;
struct ui_file *stream;
struct type *val_type;
{
int have_output;
int p;
const char* name = TYPE_FIELD_NAME (type, field_num);
have_output = 0;
/* Skip over leading 'V': NOTE soon to be obsolete. */
if (name[0] == 'V')
{
if (! ada_scan_number (name, 1, NULL, &p))
goto Huh;
}
else
p = 0;
while (1)
{
switch (name[p])
{
default:
return;
case 'S':
case 'R':
case 'O':
if (have_output)
fprintf_filtered (stream, " | ");
have_output = 1;
break;
}
switch (name[p])
{
case 'S':
{
LONGEST W;
if (! ada_scan_number (name, p + 1, &W, &p))
goto Huh;
ada_print_scalar (val_type, W, stream);
break;
}
case 'R':
{
LONGEST L, U;
if (! ada_scan_number (name, p + 1, &L, &p)
|| name[p] != 'T'
|| ! ada_scan_number (name, p + 1, &U, &p))
goto Huh;
ada_print_scalar (val_type, L, stream);
fprintf_filtered (stream, " .. ");
ada_print_scalar (val_type, U, stream);
break;
}
case 'O':
fprintf_filtered (stream, "others");
p += 1;
break;
}
}
Huh:
fprintf_filtered (stream, "??");
}
/* Assuming that field FIELD_NUM of TYPE is a VARIANTS field whose
discriminant is contained in OUTER_TYPE, print its variants on STREAM.
LEVEL is the recursion
(indentation) level, in case any of the fields themselves have
nested structure, and SHOW is the number of levels of internal structure
to show (see ada_print_type). For this purpose, fields nested in a
variant part are taken to be at the same level as the fields
immediately outside the variant part. */
static void
print_variant_clauses (type, field_num, outer_type, stream, show, level)
struct type *type;
int field_num;
struct type *outer_type;
struct ui_file *stream;
int show;
int level;
{
int i;
struct type *var_type;
struct type *discr_type;
var_type = TYPE_FIELD_TYPE (type, field_num);
discr_type = ada_variant_discrim_type (var_type, outer_type);
if (TYPE_CODE (var_type) == TYPE_CODE_PTR)
{
var_type = TYPE_TARGET_TYPE (var_type);
if (TYPE_FLAGS (var_type) & TYPE_FLAG_STUB)
{
var_type = ada_find_parallel_type (var_type, "___XVU");
if (var_type == NULL)
return;
}
}
for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
{
fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
print_choices (var_type, i, stream, discr_type);
fprintf_filtered (stream, " =>");
if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
outer_type, stream, show, level+4) <= 0)
fprintf_filtered (stream, " null;");
}
}
/* Assuming that field FIELD_NUM of TYPE is a variant part whose
discriminants are contained in OUTER_TYPE, print a description of it
on STREAM. LEVEL is the recursion (indentation) level, in case any of
the fields themselves have nested structure, and SHOW is the number of
levels of internal structure to show (see ada_print_type). For this
purpose, fields nested in a variant part are taken to be at the same
level as the fields immediately outside the variant part. */
static void
print_variant_part (type, field_num, outer_type, stream, show, level)
struct type *type;
int field_num;
struct type *outer_type;
struct ui_file *stream;
int show;
int level;
{
fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
ada_variant_discrim_name
(TYPE_FIELD_TYPE (type, field_num)));
print_variant_clauses (type, field_num, outer_type, stream, show, level + 4);
fprintf_filtered (stream, "\n%*send case;", level + 4, "");
}
/* Print a description on STREAM of the fields in record type TYPE, whose
discriminants are in OUTER_TYPE. LEVEL is the recursion (indentation)
level, in case any of the fields themselves have nested structure,
and SHOW is the number of levels of internal structure to show
(see ada_print_type). Does not print parent type information of TYPE.
Returns 0 if no fields printed, -1 for an incomplete type, else > 0.
Prints each field beginning on a new line, but does not put a new line at
end. */
static int
print_record_field_types (type, outer_type, stream, show, level)
struct type *type;
struct type *outer_type;
struct ui_file *stream;
int show;
int level;
{
int len, i, flds;
flds = 0;
len = TYPE_NFIELDS (type);
if (len == 0 && (TYPE_FLAGS (type) & TYPE_FLAG_STUB) != 0)
return -1;
for (i = 0; i < len; i += 1)
{
QUIT;
if (ada_is_parent_field (type, i)
|| ada_is_ignored_field (type, i))
;
else if (ada_is_wrapper_field (type, i))
flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
stream, show, level);
else if (ada_is_variant_part (type, i))
{
print_variant_part (type, i, outer_type, stream, show, level);
flds = 1;
}
else
{
flds += 1;
fprintf_filtered (stream, "\n%*s", level + 4, "");
ada_print_type (TYPE_FIELD_TYPE (type, i),
TYPE_FIELD_NAME (type, i),
stream, show - 1, level + 4);
fprintf_filtered (stream, ";");
}
}
return flds;
}
/* Print record type TYPE on STREAM. LEVEL is the recursion (indentation)
level, in case the element type itself has nested structure, and SHOW is
the number of levels of internal structure to show (see ada_print_type). */
static void
print_record_type (type0, stream, show, level)
struct type* type0;
struct ui_file* stream;
int show;
int level;
{
struct type* parent_type;
struct type* type;
type = type0;
if (TYPE_FLAGS (type) & TYPE_FLAG_STUB)
{
struct type* type1 = ada_find_parallel_type (type, "___XVE");
if (type1 != NULL)
type = type1;
}
parent_type = ada_parent_type (type);
if (ada_type_name (parent_type) != NULL)
fprintf_filtered (stream, "new %s with ",
demangled_type_name (parent_type));
else if (parent_type == NULL && ada_is_tagged_type (type))
fprintf_filtered (stream, "tagged ");
fprintf_filtered (stream, "record");
if (show < 0)
fprintf_filtered (stream, " ... end record");
else
{
int flds;
flds = 0;
if (parent_type != NULL && ada_type_name (parent_type) == NULL)
flds += print_record_field_types (parent_type, parent_type,
stream, show, level);
flds += print_record_field_types (type, type, stream, show, level);
if (flds > 0)
fprintf_filtered (stream, "\n%*send record", level, "");
else if (flds < 0)
fprintf_filtered (stream, " <incomplete type> end record");
else
fprintf_filtered (stream, " null; end record");
}
}
/* Print the unchecked union type TYPE in something resembling Ada
format on STREAM. LEVEL is the recursion (indentation) level
in case the element type itself has nested structure, and SHOW is the
number of levels of internal structure to show (see ada_print_type). */
static void
print_unchecked_union_type (struct type* type, struct ui_file* stream,
int show, int level)
{
fprintf_filtered (stream, "record (?) is");
if (show < 0)
fprintf_filtered (stream, " ... end record");
else if (TYPE_NFIELDS (type) == 0)
fprintf_filtered (stream, " null; end record");
else
{
int i;
fprintf_filtered (stream, "\n%*scase ? is",
level+4, "");
for (i = 0; i < TYPE_NFIELDS (type); i += 1)
{
fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level+8, "",
level+12, "");
ada_print_type (TYPE_FIELD_TYPE (type, i),
TYPE_FIELD_NAME (type, i),
stream, show - 1, level + 12);
fprintf_filtered (stream, ";");
}
fprintf_filtered (stream, "\n%*send case;\n%*send record",
level+4, "", level, "");
}
}
/* Print function or procedure type TYPE on STREAM. Make it a header
for function or procedure NAME if NAME is not null. */
static void
print_func_type (type, stream, name)
struct type *type;
struct ui_file *stream;
char* name;
{
int i, len = TYPE_NFIELDS (type);
if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
fprintf_filtered (stream, "procedure");
else
fprintf_filtered (stream, "function");
if (name != NULL && name[0] != '\0')
fprintf_filtered (stream, " %s", name);
if (len > 0)
{
fprintf_filtered (stream, " (");
for (i = 0; i < len; i += 1)
{
if (i > 0)
{
fputs_filtered ("; ", stream);
wrap_here (" ");
}
fprintf_filtered (stream, "a%d: ", i+1);
ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0);
}
fprintf_filtered (stream, ")");
}
if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
{
fprintf_filtered (stream, " return ");
ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0);
}
}
/* Print a description of a type TYPE0.
Output goes to STREAM (via stdio).
If VARSTRING is a non-empty string, print as an Ada variable/field
declaration.
SHOW+1 is the maximum number of levels of internal type structure
to show (this applies to record types, enumerated types, and
array types).
SHOW is the number of levels of internal type structure to show
when there is a type name for the SHOWth deepest level (0th is
outer level).
When SHOW<0, no inner structure is shown.
LEVEL indicates level of recursion (for nested definitions). */
void
ada_print_type (type0, varstring, stream, show, level)
struct type* type0;
char* varstring;
struct ui_file* stream;
int show;
int level;
{
enum type_code code;
int demangled_args;
struct type* type = ada_completed_type (ada_get_base_type (type0));
char* type_name = demangled_type_name (type);
int is_var_decl = (varstring != NULL && varstring[0] != '\0');
if (type == NULL)
{
if (is_var_decl)
fprintf_filtered (stream, "%.*s: ",
ada_name_prefix_len(varstring),
varstring);
fprintf_filtered (stream, "<null type?>");
return;
}
if (show > 0)
CHECK_TYPEDEF (type);
if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
fprintf_filtered (stream, "%.*s: ",
ada_name_prefix_len (varstring), varstring);
if (type_name != NULL && show <= 0)
{
fprintf_filtered (stream, "%.*s",
ada_name_prefix_len (type_name), type_name);
return;
}
if (ada_is_aligner_type (type))
ada_print_type (ada_aligned_type (type), "", stream, show, level);
else if (ada_is_packed_array_type (type))
print_array_type (type, stream, show, level);
else
switch (TYPE_CODE (type))
{
default:
fprintf_filtered (stream, "<");
c_print_type (type, "", stream, show, level);
fprintf_filtered (stream, ">");
break;
case TYPE_CODE_PTR:
fprintf_filtered (stream, "access ");
ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show,
level);
break;
case TYPE_CODE_REF:
fprintf_filtered (stream, "<ref> ");
ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show,
level);
break;
case TYPE_CODE_ARRAY:
print_array_type (type, stream, show, level);
break;
case TYPE_CODE_INT:
if (ada_is_fixed_point_type (type))
print_fixed_point_type (type, stream);
else if (ada_is_vax_floating_type (type))
print_vax_floating_point_type (type, stream);
else
{
char* name = ada_type_name (type);
if (! ada_is_range_type_name (name))
fprintf_filtered (stream, "<%d-byte integer>", TYPE_LENGTH (type));
else
{
fprintf_filtered (stream, "range ");
print_range_type_named (name, stream);
}
}
break;
case TYPE_CODE_RANGE:
if (ada_is_fixed_point_type (type))
print_fixed_point_type (type, stream);
else if (ada_is_vax_floating_type (type))
print_vax_floating_point_type (type, stream);
else if (ada_is_modular_type (type))
fprintf_filtered (stream, "mod %ld", (long) ada_modulus (type));
else
{
fprintf_filtered (stream, "range ");
print_range (type, stream);
}
break;
case TYPE_CODE_FLT:
fprintf_filtered (stream, "<%d-byte float>", TYPE_LENGTH (type));
break;
case TYPE_CODE_ENUM:
if (show < 0)
fprintf_filtered (stream, "(...)");
else
print_enum_type (type, stream);
break;
case TYPE_CODE_STRUCT:
if (ada_is_array_descriptor (type))
print_array_type (type, stream, show, level);
else if (ada_is_bogus_array_descriptor (type))
fprintf_filtered (stream, "array (?) of ? (<mal-formed descriptor>)");
else
print_record_type (type, stream, show, level);
break;
case TYPE_CODE_UNION:
print_unchecked_union_type (type, stream, show, level);
break;
case TYPE_CODE_FUNC:
print_func_type (type, stream, varstring);
break;
}
}

1058
gdb/ada-valprint.c Normal file
View File

File diff suppressed because it is too large Load Diff