This is the mail archive of the
gdb-patches@sources.redhat.com
mailing list for the GDB project.
Patches to improve Fortran support in gdb
- From: "G. Helffrich" <george at gly dot bris dot ac dot uk>
- To: gdb-patches at sources dot redhat dot com
- Date: Tue, 28 May 2002 11:50:38 +0100
- Subject: Patches to improve Fortran support in gdb
Dear GDBers -
I'm submitting these patches to 5.1.1 gdb to improve support for
debugging of Fortran programs. The patches were initially developed
on 4.16 gdb, and I ported them to 5.1.1.
The patches fix bugs that are illustrated in the comments of the
following Fortran program (compiled under g77 version 2.95.2 19991024 (release) (from FSF-g77 version 0.5.25 19991024 (release))).
C Test program for gdb debugger. This illustrates gdb problems in Fortran
C support in the following areas:
C 1 - complex variable printing:
C in gdb print cc ; print c
C (garbage printed in gdb-4.16, gdb-5.1.1)
C 2 - string variable printing:
C in gdb print name ; print name(1:5)
C (not printed as string in gdb-4.16;
C "wrong number of subscripts" in gdb-4.16, gdb-5.1.1)
C 3 - improper non-square multidimensional array printing:
C in gdb print ij(1,2) ; print ij(2,1)
C (gdb-4.16, gdb-5.1.1 reports value of 31 for first; should be 21)
C 4 - substring operation on adjustable length parameters:
C in gdb print str; print str(1:5)
C (gdb-4.16, gdb-5.1.1 drops core; SIGSEGV in gdb-4.16, gdb-5.1.1)
C 5 - printing variables passed as parameters to Fortran subprograms:
C in gdb print v(1) @5 ; print v(n)
C (SIGSEGV in gdb-4.16, gdb-5.1.1)
C
C G. Helffrich <george@gly.bris.ac.uk>
complex c(5), cc
double complex dc(5), dcc
real y(5)
integer ij(5,2)
common x,y,z
character ec(4)*1
integer*2 eh(2)
integer ew
equivalence (ec,eh,ew)
character name*256
eh(1) = 1
eh(2) = 1
write(*,*) 'ew (word equivalence) is ',ew,
& ', and value should be ',2**16+1
x = 1.0
z = 3.0
do 10 i=1,5
c(i) = cmplx(float(i),5.-i)
dc(i) = dcmplx(dble(i),dble(5.-i))
y(i) = float(i)
do 12 j=1,2
ij(i,j) = i*10+j
12 continue
10 continue
cc = (0.,1.)
dcc = (0.d0,1.d0)
name = 'Funny '' and something rather long$'
C*****Set breakpoint on next line for testing conditions 1-3*****
call subr(name)
write(*,*) 'Done!'
end
subroutine subr(str)
character str*(*)
common z,x,y
common /csubr/ a,b
real x(5)
C*****Set breakpoint on next line for testing condition 4*****
write(*,*) 'string length is ',index(str,'$'),' max is ',len(str)
write(*,*) 'string value: ',str(1:index(str,'$')-1)
write(*,*) 'Common block value is ',y
a = 1.0
b = 2.0
call subcom(x,5)
end
subroutine subcom(v,n)
real v(n)
common /csubr/ a,b
C*****Set breakpoint on next line for testing condition 5*****
write(*,*) 'In subcom, a and b are:',a,b
write(*,*) 'In subcom, n and v are:',n,v
end
The patches bring gdb's support for Fortran to a standard as good as Sun's
dbx, and better in its closer approximation of Fortran syntax use in debugging
Fortran. (Another patch will follow for a language-independent feature).
Here are my ChangeLog entries for the succession of improvements.
--------
2002-04-26 George Helffrich <george@gly.bris.ac.uk>
* f-typeprint.c: Fix minor bug causing core dump if f_print_type
called with null varstring.
2002-04-25 George Helffrich <george@gly.bris.ac.uk>
* source.c, symfile.c, symtab.c, symtab.h: Define mechanism to set
default language depending on presence of external symbol, and
implement to recognize Fortran and C. Similarly set default listing
point based on language default.
2002-04-25 George Helffrich <george@gly.bris.ac.uk>
* gdb/expression.h, gdb/expprint.c, gdb/eval.c, gdb/parse.c,
gdb/f-exp.y: implement advanced Fortran functionality by eliminating
c-language syntax in Fortran expressions. Implement auto-dereferencing
of parameters passed by reference to Fortran subprocedures. This
provides a way to use Fortran-like syntax for printing of variables
passed as parameters (rather than the c-like "print *n")
2002-04-22 George Helffrich <george@gly.bris.ac.uk>
* gdb.1: update documentation to mention debugging Fortran language.
* stack.c: push and pop stack context around Fortran function backtrace
* eval.c, valops.c, f-valprint.c: implement basic Fortran functionality,
to allow array and string parameters passed to function/subroutines to
be printed.
2002-04-20 George Helffrich <george@gly.bris.ac.uk>
* stabsread.c: Handling of Fortran complex types.
* eval.c: Allow character substrings in Fortran expressions.
* f-lang.c: Use Fortran syntax for repeated items (xxxx*nnn),
and double quotes printed in strings.
* f-valprint.c: Handle printing of elements in multiply-subscripted
arrays. Handle printing of complex values.
--------
Here are the patches themselves. FYI, I am already an FSF-registered
contributor to g77.
George Helffrich
Index: gdb-5.1.1/src/gdb/ChangeLog
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/ChangeLog,v
retrieving revision 1.1.1.1
retrieving revision 1.5
diff -c -r1.1.1.1 -r1.5
*** gdb-5.1.1/src/gdb/ChangeLog 2002/02/02 11:34:11 1.1.1.1
--- gdb-5.1.1/src/gdb/ChangeLog 2002/05/25 20:27:13 1.5
***************
*** 1,3 ****
--- 1,36 ----
+ 2002-04-25 George Helffrich <george@gly.bris.ac.uk>
+
+ * source.c, symfile.c, symtab.c, symtab.h: Define mechanism to set
+ default language depending on presence of external symbol, and
+ implement to recognize Fortran and C. Similarly set default listing
+ point based on language default.
+
+ 2002-04-25 George Helffrich <george@gly.bris.ac.uk>
+
+ * gdb/expression.h, gdb/expprint.c, gdb/eval.c, gdb/parse.c,
+ gdb/f-exp.y: implement advanced Fortran functionality by eliminating
+ c-language syntax in Fortran expressions. Implement auto-dereferencing
+ of parameters passed by reference to Fortran subprocedures. This
+ provides a way to use Fortran-like syntax for printing of variables
+ passed as parameters (rather than the c-like "print *n")
+
+ 2002-04-22 George Helffrich <george@gly.bris.ac.uk>
+
+ * gdb.1: update documentation to mention debugging Fortran language.
+ * stack.c: push and pop stack context around Fortran function backtrace
+ * eval.c, valops.c, f-valprint.c: implement basic Fortran functionality,
+ to allow array and string parameters passed to function/subroutines to
+ be printed.
+
+ 2002-04-20 George Helffrich <george@gly.bris.ac.uk>
+
+ * stabsread.c: Handling of Fortran complex types.
+ * eval.c: Allow character substrings in Fortran expressions.
+ * f-lang.c: Use Fortran syntax for repeated items (xxxx*nnn),
+ and double quotes printed in strings.
+ * f-valprint.c: Handle printing of elements in multiply-subscripted
+ arrays. Handle printing of complex values.
+
2002-01-31 Andrew Cagney <ac131313@redhat.com>
* PROBLEMS: Fix tipo, 5.1->5.1.1.
Index: gdb-5.1.1/src/gdb/eval.c
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/eval.c,v
retrieving revision 1.1.1.1
retrieving revision 1.4
diff -c -r1.1.1.1 -r1.4
*** gdb-5.1.1/src/gdb/eval.c 2002/02/02 11:34:18 1.1.1.1
--- gdb-5.1.1/src/gdb/eval.c 2002/05/25 19:16:50 1.4
***************
*** 420,425 ****
--- 420,426 ----
exp->elts[pc + 2].doubleconst);
case OP_VAR_VALUE:
+ case OP_F77_VAR_VALUE:
(*pos) += 3;
if (noside == EVAL_SKIP)
goto nosideret;
***************
*** 433,440 ****
--- 434,452 ----
value_rtti_target_type () if we are dealing with a pointer
or reference to a base class and print object is on. */
+ /*
return value_of_variable (exp->elts[pc + 2].symbol,
exp->elts[pc + 1].block);
+ */
+ /* If Fortran variable is pointer, simply dereference it according
+ to Fortran semantics */
+ { struct symbol * sym = exp->elts[pc + 2].symbol;
+ value_ptr indarg = value_of_variable (sym, exp->elts[pc + 1].block);
+ if (op == OP_F77_VAR_VALUE &&
+ TYPE_CODE(SYMBOL_TYPE (sym)) == TYPE_CODE_PTR)
+ return value_ind (indarg);
+ return indarg;
+ }
case OP_LAST:
(*pos) += 2;
***************
*** 952,967 ****
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
type = check_typedef (VALUE_TYPE (arg1));
code = TYPE_CODE (type);
switch (code)
{
case TYPE_CODE_ARRAY:
goto multi_f77_subscript;
case TYPE_CODE_STRING:
goto op_f77_substr;
- case TYPE_CODE_PTR:
case TYPE_CODE_FUNC:
/* It's a function call. */
/* Allocate arg vector, including space for the function to be
--- 964,1008 ----
arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
type = check_typedef (VALUE_TYPE (arg1));
code = TYPE_CODE (type);
+ #if 0
+ if (code == TYPE_CODE_PTR) {
+ /* Pointer type is most probably a Fortran parameter. Check this
+ by seeing what it points at. */
+ struct type *elttype = check_typedef (TYPE_TARGET_TYPE (type));
+ if (TYPE_CODE(elttype) != TYPE_CODE_PTR) {
+ /* Dereference */
+ arg1 = value_ind (arg1); type = elttype; code = TYPE_CODE(elttype);
+ }
+ }
+ #endif
switch (code)
{
case TYPE_CODE_ARRAY:
+ { /* Check whether this might be a substring expression by
+ seeing whether target type is char. If so treat an array of
+ char as a string. egcs Fortran and SunOS 4.1.x Fortran don't
+ explicitly denote character string types, so we check for them
+ here.
+
+ Would be desirable to have TYPE_CODE_STRING set properly in
+ read_type (in stabsread.c) using the @S stabs syntax, but
+ this heuristic suffices for uncooperative compilers. */
+
+ struct type *tmp_type = TYPE_TARGET_TYPE(type);
+ while (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
+ tmp_type = TYPE_TARGET_TYPE (tmp_type);
+ if (nargs == 2 &&
+ (TYPE_CODE (tmp_type) == TYPE_CODE_CHAR ||
+ (TYPE_CODE (tmp_type) == TYPE_CODE_INT &&
+ TYPE_LENGTH (tmp_type) == 1))
+ ) goto op_f77_substr;
+ }
goto multi_f77_subscript;
case TYPE_CODE_STRING:
goto op_f77_substr;
case TYPE_CODE_FUNC:
/* It's a function call. */
/* Allocate arg vector, including space for the function to be
***************
*** 974,979 ****
--- 1015,1023 ----
argvec[tem] = 0; /* signal end of arglist */
goto do_call_it;
+ case TYPE_CODE_PTR:
+ error ("Fortran pointer to an unrecognized type is unknown to gdb");
+
default:
error ("Cannot perform substring on this type");
}
***************
*** 1340,1345 ****
--- 1384,1395 ----
offset_item = 0;
for (i = 1; i <= nargs; i++)
{
+ /* Note in following that array dimensioning information comes
+ from rightmost dimension towards leftmost one, whereas
+ subscript expression parsing delivers leftmost subscript
+ first, then rightmost. Thus array size gets accumulated in
+ reverse order to subscripts. */
+
/* Evaluate each subscript, It must be a legal integer in F77 */
arg2 = evaluate_subexp_with_coercion (exp, pos, noside);
***************
*** 1355,1361 ****
if (retcode == BOUND_FETCH_ERROR)
error ("Cannot obtain dynamic lower bound");
! array_size_array[i] = upper - lower + 1;
/* Zero-normalize subscripts so that offsetting will work. */
--- 1405,1411 ----
if (retcode == BOUND_FETCH_ERROR)
error ("Cannot obtain dynamic lower bound");
! array_size_array[1+nargs-i] = upper - lower + 1;
/* Zero-normalize subscripts so that offsetting will work. */
***************
*** 1796,1801 ****
--- 1846,1852 ----
evaluate_subexp (NULL_TYPE, exp, pos, noside));
case OP_VAR_VALUE:
+ case OP_F77_VAR_VALUE:
var = exp->elts[pc + 2].symbol;
/* C++: The "address" of a reference should yield the address
***************
*** 1926,1933 ****
--- 1977,1990 ----
(LONGEST) TYPE_LENGTH (type));
case OP_VAR_VALUE:
+ case OP_F77_VAR_VALUE:
(*pos) += 4;
type = check_typedef (SYMBOL_TYPE (exp->elts[pc + 2].symbol));
+ if (op == OP_F77_VAR_VALUE) {
+ /* Get referenced type if is a Fortran pointer of some sort */
+ if (TYPE_CODE (type) == TYPE_CODE_PTR)
+ type = TYPE_TARGET_TYPE (type) ;
+ }
return
value_from_longest (builtin_type_int, (LONGEST) TYPE_LENGTH (type));
Index: gdb-5.1.1/src/gdb/expprint.c
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/expprint.c,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -c -r1.1.1.1 -r1.2
*** gdb-5.1.1/src/gdb/expprint.c 2002/02/02 11:34:19 1.1.1.1
--- gdb-5.1.1/src/gdb/expprint.c 2002/05/25 19:16:51 1.2
***************
*** 601,606 ****
--- 601,608 ----
return "OP_DOUBLE";
case OP_VAR_VALUE:
return "OP_VAR_VALUE";
+ case OP_F77_VAR_VALUE:
+ return "OP_F77_VAR_VALUE";
case OP_LAST:
return "OP_LAST";
case OP_REGISTER:
Index: gdb-5.1.1/src/gdb/expression.h
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/expression.h,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -c -r1.1.1.1 -r1.2
*** gdb-5.1.1/src/gdb/expression.h 2002/02/02 11:34:19 1.1.1.1
--- gdb-5.1.1/src/gdb/expression.h 2002/05/25 19:16:51 1.2
***************
*** 154,159 ****
--- 154,164 ----
non-NULL, evaluate the symbol relative to the innermost frame
executing in that block; if the block is NULL use the selected frame. */
OP_VAR_VALUE,
+
+ /* OP_F77_VAR_VALUE is identical to OP_VAR_VALUE but with the added
+ semantic that if the symbol is a pointer type, it is automatically
+ dereferenced. This is for Fortran variables passed as parameters. */
+ OP_F77_VAR_VALUE,
/* OP_LAST is followed by an integer in the next exp_element.
The integer is zero for the last value printed,
Index: gdb-5.1.1/src/gdb/f-exp.y
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/f-exp.y,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -c -r1.1.1.1 -r1.2
*** gdb-5.1.1/src/gdb/f-exp.y 2002/02/02 11:34:19 1.1.1.1
--- gdb-5.1.1/src/gdb/f-exp.y 2002/05/25 19:16:51 1.2
***************
*** 456,468 ****
innermost_block))
innermost_block = block_found;
}
! 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);
break;
}
else
--- 456,468 ----
innermost_block))
innermost_block = block_found;
}
! write_exp_elt_opcode (OP_F77_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_F77_VAR_VALUE);
break;
}
else
Index: gdb-5.1.1/src/gdb/f-lang.c
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/f-lang.c,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -c -r1.1.1.1 -r1.2
*** gdb-5.1.1/src/gdb/f-lang.c 2002/02/02 11:34:19 1.1.1.1
--- gdb-5.1.1/src/gdb/f-lang.c 2002/05/20 03:38:36 1.2
***************
*** 105,112 ****
if (PRINT_LITERAL_FORM (c))
{
! if (c == '\\' || c == quoter)
fputs_filtered ("\\", stream);
fprintf_filtered (stream, "%c", c);
}
else
--- 105,114 ----
if (PRINT_LITERAL_FORM (c))
{
! if (c == '\\')
fputs_filtered ("\\", stream);
+ if (c == quoter)
+ fputc_filtered (quoter, stream);
fprintf_filtered (stream, "%c", c);
}
else
***************
*** 152,163 ****
fputs_filtered ("'", stream);
}
/* Print the character string STRING, printing at most LENGTH characters.
Printing stops early if the number hits print_max; repeat counts
are printed as appropriate. Print ellipses at the end if we
! had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
! FIXME: This is a copy of the same function from c-exp.y. It should
! be replaced with a true F77 version. */
static void
f_printstr (struct ui_file *stream, char *string, unsigned int length,
--- 154,176 ----
fputs_filtered ("'", stream);
}
+ /* Approximation to log base 10 of a number using log base 2 of number. */
+
+ static int
+ f_log10 (unsigned int v)
+ {
+ int i;
+ unsigned int t;
+
+ for (t = v, i = 1; (t = t>>1); i++)
+ /* NOTHING */;
+ return (i*30103)/100000;
+ }
+
/* Print the character string STRING, printing at most LENGTH characters.
Printing stops early if the number hits print_max; repeat counts
are printed as appropriate. Print ellipses at the end if we
! had to stop before printing LENGTH characters, or if FORCE_ELLIPSES. */
static void
f_printstr (struct ui_file *stream, char *string, unsigned int length,
***************
*** 199,205 ****
++reps;
}
! if (reps > repeat_count_threshold)
{
if (in_quotes)
{
--- 212,218 ----
++reps;
}
! if (reps > 4+1+f_log10(reps))
{
if (in_quotes)
{
***************
*** 210,216 ****
in_quotes = 0;
}
f_printchar (string[i], stream);
! fprintf_filtered (stream, " <repeats %u times>", reps);
i = rep1 - 1;
things_printed += repeat_count_threshold;
need_comma = 1;
--- 223,229 ----
in_quotes = 0;
}
f_printchar (string[i], stream);
! fprintf_filtered (stream, "*%u", reps);
i = rep1 - 1;
things_printed += repeat_count_threshold;
need_comma = 1;
***************
*** 225,231 ****
fputs_filtered ("'", stream);
in_quotes = 1;
}
! LA_EMIT_CHAR (string[i], stream, '"');
++things_printed;
}
}
--- 238,244 ----
fputs_filtered ("'", stream);
in_quotes = 1;
}
! LA_EMIT_CHAR (string[i], stream, '\'');
++things_printed;
}
}
Index: gdb-5.1.1/src/gdb/f-valprint.c
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/f-valprint.c,v
retrieving revision 1.1.1.1
retrieving revision 1.3
diff -c -r1.1.1.1 -r1.3
*** gdb-5.1.1/src/gdb/f-valprint.c 2002/02/02 11:34:19 1.1.1.1
--- gdb-5.1.1/src/gdb/f-valprint.c 2002/05/22 12:25:15 1.3
***************
*** 360,378 ****
struct type *elttype;
LONGEST val;
CORE_ADDR addr;
CHECK_TYPEDEF (type);
switch (TYPE_CODE (type))
{
case TYPE_CODE_STRING:
f77_get_dynamic_length_of_aggregate (type);
! LA_PRINT_STRING (stream, valaddr, TYPE_LENGTH (type), 1, 0);
break;
case TYPE_CODE_ARRAY:
fprintf_filtered (stream, "(");
! f77_print_array (type, valaddr, address, stream, format,
! deref_ref, recurse, pretty);
fprintf_filtered (stream, ")");
break;
#if 0
--- 360,399 ----
struct type *elttype;
LONGEST val;
CORE_ADDR addr;
+ value_ptr indval;
CHECK_TYPEDEF (type);
switch (TYPE_CODE (type))
{
case TYPE_CODE_STRING:
f77_get_dynamic_length_of_aggregate (type);
! indval = value_at(type, address, NULL);
! LA_PRINT_STRING (stream, VALUE_CONTENTS (indval), TYPE_LENGTH (type), 1, 0);
break;
case TYPE_CODE_ARRAY:
+ f77_get_dynamic_length_of_aggregate (type);
+ indval = value_at(type, address, NULL);
+ { /* Check whether target type is char. If so treat an array of
+ char as a string. SunOS 4.1.x Fortran doesn't explicitly
+ denote character string types, so we ape its behavior here.
+ Would be desirable to have TYPE_CODE_STRING set properly in
+ read_type (in stabsread.c) using the @S stabs syntax, but
+ this heuristic suffices for uncooperative compilers. */
+
+ struct type *tmp_type = TYPE_TARGET_TYPE(type);
+ while (TYPE_CODE (tmp_type) == TYPE_CODE_ARRAY)
+ tmp_type = TYPE_TARGET_TYPE (tmp_type);
+ if (TYPE_CODE (tmp_type) == TYPE_CODE_CHAR ||
+ (TYPE_CODE (tmp_type) == TYPE_CODE_INT &&
+ TYPE_LENGTH (tmp_type) == 1)) {
+ LA_PRINT_STRING (stream, VALUE_CONTENTS (indval), TYPE_LENGTH (type), 1, 0);
+ break;
+ }
+ }
fprintf_filtered (stream, "(");
! f77_print_array (type, VALUE_CONTENTS (indval), VALUE_ADDRESS (indval),
! stream, format, deref_ref, recurse, pretty);
fprintf_filtered (stream, ")");
break;
#if 0
***************
*** 399,404 ****
--- 420,426 ----
return 0;
}
+ #if 0
if (addressprint && format != 's')
fprintf_filtered (stream, "0x%s", paddr_nz (addr));
***************
*** 413,418 ****
--- 435,448 ----
/* Return number of characters printed, plus one for the
terminating null if we have "reached the end". */
return (i + (print_max && i != print_max));
+ #else
+ if (TYPE_CODE (elttype) != TYPE_CODE_PTR) {
+ indval = value_at(elttype, addr, NULL);
+ return f_val_print (elttype, (char *)VALUE_CONTENTS(indval), 0,
+ VALUE_ADDRESS(indval),
+ stream, format, deref_ref, recurse, pretty);
+ }
+ #endif
}
break;
***************
*** 515,520 ****
--- 545,564 ----
}
break;
+ case TYPE_CODE_STRUCT:
+ /* This happens when some compilers turn the complex type into a
+ structure.
+ The following code doesn't handle a general structure, only the
+ case of complex or double complex types.
+ */
+ /* Test for complex type of some sort */
+ if (TYPE_NFIELDS(type) != 2 ||
+ TYPE_CODE(TYPE_FIELDS(type)->type) != TYPE_CODE_FLT) {
+ error ("Invalid F77 type code %d in symbol table.", TYPE_CODE (type));
+ break;
+ }
+ /* Fall through to complex display */
+
case TYPE_CODE_COMPLEX:
switch (TYPE_LENGTH (type))
{
***************
*** 549,554 ****
--- 593,610 ----
}
gdb_flush (stream);
return 0;
+ }
+
+ /* Top-level value printing for Fortran language expressions.
+
+ Code hacked from c_value_print.
+ */
+ int
+ f_value_print (value_ptr val, struct ui_file *stream, int format,
+ enum val_prettyprint pretty)
+ {
+ return val_print (VALUE_TYPE (val), VALUE_CONTENTS (val), 0,
+ VALUE_ADDRESS (val), stream, format, 1, 0, pretty);
}
static void
Index: gdb-5.1.1/src/gdb/gdb.1
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/gdb.1,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -c -r1.1.1.1 -r1.2
*** gdb-5.1.1/src/gdb/gdb.1 2002/02/02 11:34:20 1.1.1.1
--- gdb-5.1.1/src/gdb/gdb.1 2002/05/22 12:25:15 1.2
***************
*** 1,7 ****
.\" Copyright 1991, 1999 Free Software Foundation, Inc.
.\" See section COPYING for conditions for redistribution
! .\" $Id: gdb.1,v 1.1.1.1 2002/02/02 11:34:20 george Exp $
! .TH gdb 1 "4nov1991" "GNU Tools" "GNU Tools"
.SH NAME
gdb \- The GNU Debugger
.SH SYNOPSIS
--- 1,7 ----
.\" Copyright 1991, 1999 Free Software Foundation, Inc.
.\" See section COPYING for conditions for redistribution
! .\" $Id: gdb.1,v 1.2 2002/05/22 12:25:15 george Exp $
! .TH gdb 1 "22may2002" "GNU Tools" "GNU Tools"
.SH NAME
gdb \- The GNU Debugger
.SH SYNOPSIS
***************
*** 70,77 ****
effects of one bug and go on to learn about another.
.PP
! You can use GDB to debug programs written in C, C++, and Modula-2.
! Fortran support will be added when a GNU Fortran compiler is ready.
GDB is invoked with the shell command \c
.B gdb\c
--- 70,76 ----
effects of one bug and go on to learn about another.
.PP
! You can use GDB to debug programs written in C, C++, Fortran and Modula-2.
GDB is invoked with the shell command \c
.B gdb\c
***************
*** 149,154 ****
--- 148,156 ----
.I over\c
\& any
function calls in the line.
+ .TP
+ .B list \fR[\|\fIfile\fB:\fR\|]\fIfunction
+ type the text of the program in the vicinity of where it is presently stopped.
.TP
.B step
Execute next program line (after stopping); step \c
Index: gdb-5.1.1/src/gdb/parse.c
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/parse.c,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -c -r1.1.1.1 -r1.2
*** gdb-5.1.1/src/gdb/parse.c 2002/02/02 11:34:37 1.1.1.1
--- gdb-5.1.1/src/gdb/parse.c 2002/05/25 19:16:50 1.2
***************
*** 855,860 ****
--- 855,861 ----
case OP_LONG:
case OP_DOUBLE:
case OP_VAR_VALUE:
+ case OP_F77_VAR_VALUE:
oplen = 4;
break;
***************
*** 992,997 ****
--- 993,999 ----
case OP_LONG:
case OP_DOUBLE:
case OP_VAR_VALUE:
+ case OP_F77_VAR_VALUE:
oplen = 4;
break;
Index: gdb-5.1.1/src/gdb/source.c
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/source.c,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -c -r1.1.1.1 -r1.2
*** gdb-5.1.1/src/gdb/source.c 2002/02/02 11:34:46 1.1.1.1
--- gdb-5.1.1/src/gdb/source.c 2002/05/25 20:27:13 1.2
***************
*** 133,138 ****
--- 133,150 ----
default. Also, since this can cause symbols to be read, doing it
before we need to would make things slower than necessary. */
+ /* Table of language-specific entry points. List command starts off where
+ the first-defined symbol in the list exists. Opt for ``main'' if all else
+ fails. */
+
+ struct langsym {
+ enum language language;
+ char *main;
+ } langsym_tbl[] = { /* table of language-specific entry points */
+ {language_fortran, "MAIN__"},
+ {language_unknown, NULL} /* must be last entry */
+ };
+
void
select_source_symtab (register struct symtab *s)
{
***************
*** 141,146 ****
--- 153,160 ----
struct partial_symtab *ps;
struct partial_symtab *cs_pst = 0;
struct objfile *ofp;
+ struct langsym *l;
+ char *main;
if (s)
{
***************
*** 152,162 ****
if (current_source_symtab)
return;
! /* Make the default place to list be the function `main'
! if one exists. */
! if (lookup_symbol (main_name (), 0, VAR_NAMESPACE, 0, NULL))
{
! sals = decode_line_spec (main_name (), 1);
sal = sals.sals[0];
xfree (sals.sals);
current_source_symtab = sal.symtab;
--- 166,179 ----
if (current_source_symtab)
return;
! /* Make the default place to list be the program entry point, which
! depends on the language setting. */
! for(l = langsym_tbl; l->language != language_unknown; l++)
! if (current_language->la_language == l->language) break;
! main = (l->main == NULL) ? main_name () : l->main;
! if (lookup_symbol (main, 0, VAR_NAMESPACE, 0, NULL))
{
! sals = decode_line_spec (main, 1);
sal = sals.sals[0];
xfree (sals.sals);
current_source_symtab = sal.symtab;
Index: gdb-5.1.1/src/gdb/stabsread.c
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/stabsread.c,v
retrieving revision 1.1.1.1
retrieving revision 1.3
diff -c -r1.1.1.1 -r1.3
*** gdb-5.1.1/src/gdb/stabsread.c 2002/02/02 11:34:48 1.1.1.1
--- gdb-5.1.1/src/gdb/stabsread.c 2002/05/22 12:25:15 1.3
***************
*** 4104,4109 ****
--- 4104,4110 ----
{
struct type *index_type, *element_type, *range_type;
int lower, upper;
+ int tlower = BOUND_SIMPLE, tupper = BOUND_SIMPLE;
int adjustable = 0;
int nbits;
***************
*** 4128,4133 ****
--- 4129,4145 ----
if (!(**pp >= '0' && **pp <= '9') && **pp != '-')
{
(*pp)++;
+ switch (**pp) {
+ case '?': /* stabs doc. notwithstanding, A & T both are stack values */
+ tlower = BOUND_BY_REF_ON_STACK;
+ break;
+ case 'A':
+ case 'T':
+ tlower = BOUND_BY_VALUE_ON_STACK;
+ break;
+ default:
+ tlower = BOUND_CANNOT_BE_DETERMINED;
+ }
adjustable = 1;
}
lower = read_huge_number (pp, os9k_stabs ? ',' : ';', &nbits);
***************
*** 4136,4141 ****
--- 4148,4164 ----
if (!(**pp >= '0' && **pp <= '9') && **pp != '-')
{
+ switch (**pp) {
+ case '?': /* stabs doc. notwithstanding, A & T both are stack values */
+ tupper = BOUND_BY_REF_ON_STACK;
+ break;
+ case 'A':
+ case 'T':
+ tupper = BOUND_BY_VALUE_ON_STACK;
+ break;
+ default:
+ tupper = BOUND_CANNOT_BE_DETERMINED;
+ }
(*pp)++;
adjustable = 1;
}
***************
*** 4143,4160 ****
if (nbits != 0)
return error_type (pp, objfile);
! element_type = read_type (pp, objfile);
! if (adjustable)
! {
! lower = 0;
! upper = -1;
! }
range_type =
create_range_type ((struct type *) NULL, index_type, lower, upper);
type = create_array_type (type, element_type, range_type);
return type;
}
--- 4166,4193 ----
if (nbits != 0)
return error_type (pp, objfile);
! /* This handles case of some compilers reporting unknown adjustable array
! upper bound with -1, e.g. egcs-2.91 */
! if (tlower == BOUND_SIMPLE && tupper == BOUND_SIMPLE && lower > upper) {
! tupper = BOUND_CANNOT_BE_DETERMINED;
! upper = lower;
! }
! element_type = read_type (pp, objfile);
range_type =
create_range_type ((struct type *) NULL, index_type, lower, upper);
type = create_array_type (type, element_type, range_type);
+ /* Set type of bound for use when printing adjustable arrays or characters */
+ TYPE_ARRAY_UPPER_BOUND_TYPE(type) = tupper;
+ TYPE_ARRAY_LOWER_BOUND_TYPE(type) = tlower;
+
+ /* Zero this to prevent outrageous actions when fetching values from
+ adjustable-bound arrays */
+ if (tupper != BOUND_SIMPLE || tlower != BOUND_SIMPLE)
+ TYPE_LENGTH(type) = 0;
+
return type;
}
***************
*** 4602,4619 ****
if (n3 == 0 && n2 > 0)
{
- struct type *float_type
- = init_type (TYPE_CODE_FLT, n2, 0, NULL, objfile);
-
if (self_subrange)
{
struct type *complex_type =
! init_type (TYPE_CODE_COMPLEX, 2 * n2, 0, NULL, objfile);
! TYPE_TARGET_TYPE (complex_type) = float_type;
return complex_type;
}
else
! return float_type;
}
/* If the upper bound is -1, it must really be an unsigned int. */
--- 4635,4650 ----
if (n3 == 0 && n2 > 0)
{
if (self_subrange)
{
struct type *complex_type =
! init_type (TYPE_CODE_COMPLEX, n2, 0, NULL, objfile);
! TYPE_TARGET_TYPE (complex_type) =
! init_type (TYPE_CODE_FLT, n2>>1, 0, NULL, objfile);
return complex_type;
}
else
! return init_type (TYPE_CODE_FLT, n2, 0, NULL, objfile);
}
/* If the upper bound is -1, it must really be an unsigned int. */
Index: gdb-5.1.1/src/gdb/stack.c
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/stack.c,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -c -r1.1.1.1 -r1.2
*** gdb-5.1.1/src/gdb/stack.c 2002/02/02 11:34:49 1.1.1.1
--- gdb-5.1.1/src/gdb/stack.c 2002/05/22 12:25:15 1.2
***************
*** 571,579 ****
--- 571,583 ----
if (args)
{
struct print_args_args args;
+ struct frame_info *fisave;
+ int levelsave;
#ifdef UI_OUT
struct cleanup *args_list_chain;
#endif
+ fisave = selected_frame; levelsave = selected_frame_level;
+ select_frame(fi, level);
args.fi = fi;
args.func = func;
args.stream = gdb_stdout;
***************
*** 587,592 ****
--- 591,597 ----
#else
catch_errors (print_args_stub, &args, "", RETURN_MASK_ALL);
#endif
+ select_frame(fisave, levelsave);
QUIT;
}
#ifdef UI_OUT
Index: gdb-5.1.1/src/gdb/symfile.c
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/symfile.c,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -c -r1.1.1.1 -r1.2
*** gdb-5.1.1/src/gdb/symfile.c 2002/02/02 11:34:49 1.1.1.1
--- gdb-5.1.1/src/gdb/symfile.c 2002/05/25 20:27:13 1.2
***************
*** 1021,1026 ****
--- 1021,1027 ----
such as DWARF. For stabs, we can jump through hoops looking for specially
named symbols or try to intuit the language from the specific type of stabs
we find, but we can't do that until later when we read in full symbols.
+ For the nonce, check for Fortran main, then go to default main file name.
FIXME. */
static void
***************
*** 1029,1035 ****
struct partial_symtab *pst;
enum language lang = language_unknown;
! pst = find_main_psymtab ();
if (pst != NULL)
{
if (pst->filename != NULL)
--- 1030,1037 ----
struct partial_symtab *pst;
enum language lang = language_unknown;
! if (NULL == (pst = find_main_psymtab ("MAIN__")))
! pst = find_main_psymtab (main_name ());
if (pst != NULL)
{
if (pst->filename != NULL)
Index: gdb-5.1.1/src/gdb/symtab.c
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/symtab.c,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -c -r1.1.1.1 -r1.2
*** gdb-5.1.1/src/gdb/symtab.c 2002/02/02 11:34:50 1.1.1.1
--- gdb-5.1.1/src/gdb/symtab.c 2002/05/25 20:27:13 1.2
***************
*** 1151,1164 ****
executables that have no main() ? */
struct partial_symtab *
! find_main_psymtab (void)
{
register struct partial_symtab *pst;
register struct objfile *objfile;
ALL_PSYMTABS (objfile, pst)
{
! if (lookup_partial_symbol (pst, main_name (), 1, VAR_NAMESPACE))
{
return (pst);
}
--- 1151,1164 ----
executables that have no main() ? */
struct partial_symtab *
! find_main_psymtab (char *main)
{
register struct partial_symtab *pst;
register struct objfile *objfile;
ALL_PSYMTABS (objfile, pst)
{
! if (lookup_partial_symbol (pst, main, 1, VAR_NAMESPACE))
{
return (pst);
}
Index: gdb-5.1.1/src/gdb/symtab.h
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/symtab.h,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -c -r1.1.1.1 -r1.2
*** gdb-5.1.1/src/gdb/symtab.h 2002/02/02 11:34:50 1.1.1.1
--- gdb-5.1.1/src/gdb/symtab.h 2002/05/25 20:27:13 1.2
***************
*** 1367,1373 ****
/* symtab.c */
! extern struct partial_symtab *find_main_psymtab (void);
extern struct symtab *find_line_symtab (struct symtab *, int, int *, int *);
--- 1367,1373 ----
/* symtab.c */
! extern struct partial_symtab *find_main_psymtab (char *);
extern struct symtab *find_line_symtab (struct symtab *, int, int *, int *);
Index: gdb-5.1.1/src/gdb/valops.c
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/valops.c,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -c -r1.1.1.1 -r1.2
*** gdb-5.1.1/src/gdb/valops.c 2002/02/02 11:34:52 1.1.1.1
--- gdb-5.1.1/src/gdb/valops.c 2002/05/26 12:24:56 1.2
***************
*** 3226,3231 ****
--- 3226,3232 ----
LONGEST lowerbound, upperbound, offset;
value_ptr slice;
struct type *array_type;
+ int care_about_upperbound;
array_type = check_typedef (VALUE_TYPE (array));
COERCE_VARYING_ARRAY (array, array_type);
if (TYPE_CODE (array_type) != TYPE_CODE_ARRAY
***************
*** 3235,3242 ****
range_type = TYPE_INDEX_TYPE (array_type);
if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
error ("slice from bad array or bitstring");
if (lowbound < lowerbound || length < 0
! || lowbound + length - 1 > upperbound
/* Chill allows zero-length strings but not arrays. */
|| (current_language->la_language == language_chill
&& length == 0 && TYPE_CODE (array_type) == TYPE_CODE_ARRAY))
--- 3236,3251 ----
range_type = TYPE_INDEX_TYPE (array_type);
if (get_discrete_bounds (range_type, &lowerbound, &upperbound) < 0)
error ("slice from bad array or bitstring");
+ /* Eliminate care_about_upperbound code when g77 emits stabs info for
+ adjustable string and array bounds -- this is a temporary expedience
+ to permit slices to be made when there is no debug info to locate the
+ save-expr for the adjustable upper bound */
+ care_about_upperbound =
+ current_language->la_language != language_fortran ||
+ (current_language->la_language == language_fortran &&
+ lowerbound != upperbound) ;
if (lowbound < lowerbound || length < 0
! || (care_about_upperbound && lowbound + length - 1 > upperbound)
/* Chill allows zero-length strings but not arrays. */
|| (current_language->la_language == language_chill
&& length == 0 && TYPE_CODE (array_type) == TYPE_CODE_ARRAY))
Index: f-typeprint.c
===================================================================
RCS file: /usr/src/local/cvsroot/gdb-5.1.1/src/gdb/f-typeprint.c,v
retrieving revision 1.1.1.1
retrieving revision 1.2
diff -c -r1.1.1.1 -r1.2
*** f-typeprint.c 2002/02/02 11:34:19 1.1.1.1
--- f-typeprint.c 2002/05/26 15:56:00 1.2
***************
*** 81,87 ****
/* For demangled function names, we have the arglist as part of the name,
so don't print an additional pair of ()'s */
! demangled_args = varstring[strlen (varstring) - 1] == ')';
f_type_print_varspec_suffix (type, stream, show, 0, demangled_args);
}
--- 81,87 ----
/* For demangled function names, we have the arglist as part of the name,
so don't print an additional pair of ()'s */
! demangled_args = (varstring != NULL && *varstring != '\0') ? varstring[strlen (varstring) - 1] == ')' : 0;
f_type_print_varspec_suffix (type, stream, show, 0, demangled_args);
}