Upgrade GDB from 7.4.1 to 7.6.1 on the vendor branch
[dragonfly.git] / contrib / gdb-7 / gdb / f-typeprint.c
1 /* Support for printing Fortran types for GDB, the GNU debugger.
2
3    Copyright (C) 1986-2013 Free Software Foundation, Inc.
4
5    Contributed by Motorola.  Adapted from the C version by Farooq Butt
6    (fmbutt@engage.sps.mot.com).
7
8    This file is part of GDB.
9
10    This program is free software; you can redistribute it and/or modify
11    it under the terms of the GNU General Public License as published by
12    the Free Software Foundation; either version 3 of the License, or
13    (at your option) any later version.
14
15    This program is distributed in the hope that it will be useful,
16    but WITHOUT ANY WARRANTY; without even the implied warranty of
17    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18    GNU General Public License for more details.
19
20    You should have received a copy of the GNU General Public License
21    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
22
23 #include "defs.h"
24 #include "gdb_obstack.h"
25 #include "bfd.h"
26 #include "symtab.h"
27 #include "gdbtypes.h"
28 #include "expression.h"
29 #include "value.h"
30 #include "gdbcore.h"
31 #include "target.h"
32 #include "f-lang.h"
33
34 #include "gdb_string.h"
35 #include <errno.h>
36
37 #if 0                           /* Currently unused.  */
38 static void f_type_print_args (struct type *, struct ui_file *);
39 #endif
40
41 static void f_type_print_varspec_suffix (struct type *, struct ui_file *, int,
42                                          int, int, int);
43
44 void f_type_print_varspec_prefix (struct type *, struct ui_file *,
45                                   int, int);
46
47 void f_type_print_base (struct type *, struct ui_file *, int, int);
48 \f
49
50 /* LEVEL is the depth to indent lines by.  */
51
52 void
53 f_print_type (struct type *type, const char *varstring, struct ui_file *stream,
54               int show, int level, const struct type_print_options *flags)
55 {
56   enum type_code code;
57   int demangled_args;
58
59   f_type_print_base (type, stream, show, level);
60   code = TYPE_CODE (type);
61   if ((varstring != NULL && *varstring != '\0')
62   /* Need a space if going to print stars or brackets;
63      but not if we will print just a type name.  */
64       || ((show > 0 || TYPE_NAME (type) == 0)
65           && (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC
66               || code == TYPE_CODE_METHOD
67               || code == TYPE_CODE_ARRAY
68               || code == TYPE_CODE_REF)))
69     fputs_filtered (" ", stream);
70   f_type_print_varspec_prefix (type, stream, show, 0);
71
72   if (varstring != NULL)
73     {
74       fputs_filtered (varstring, stream);
75
76       /* For demangled function names, we have the arglist as part of the name,
77          so don't print an additional pair of ()'s.  */
78
79       demangled_args = varstring[strlen (varstring) - 1] == ')'; 
80       f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0);
81    }
82 }
83
84 /* Print any asterisks or open-parentheses needed before the
85    variable name (to describe its type).
86
87    On outermost call, pass 0 for PASSED_A_PTR.
88    On outermost call, SHOW > 0 means should ignore
89    any typename for TYPE and show its details.
90    SHOW is always zero on recursive calls.  */
91
92 void
93 f_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
94                              int show, int passed_a_ptr)
95 {
96   if (type == 0)
97     return;
98
99   if (TYPE_NAME (type) && show <= 0)
100     return;
101
102   QUIT;
103
104   switch (TYPE_CODE (type))
105     {
106     case TYPE_CODE_PTR:
107       f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
108       break;
109
110     case TYPE_CODE_FUNC:
111       f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
112       if (passed_a_ptr)
113         fprintf_filtered (stream, "(");
114       break;
115
116     case TYPE_CODE_ARRAY:
117       f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
118       break;
119
120     case TYPE_CODE_UNDEF:
121     case TYPE_CODE_STRUCT:
122     case TYPE_CODE_UNION:
123     case TYPE_CODE_ENUM:
124     case TYPE_CODE_INT:
125     case TYPE_CODE_FLT:
126     case TYPE_CODE_VOID:
127     case TYPE_CODE_ERROR:
128     case TYPE_CODE_CHAR:
129     case TYPE_CODE_BOOL:
130     case TYPE_CODE_SET:
131     case TYPE_CODE_RANGE:
132     case TYPE_CODE_STRING:
133     case TYPE_CODE_METHOD:
134     case TYPE_CODE_REF:
135     case TYPE_CODE_COMPLEX:
136     case TYPE_CODE_TYPEDEF:
137       /* These types need no prefix.  They are listed here so that
138          gcc -Wall will reveal any types that haven't been handled.  */
139       break;
140     }
141 }
142
143 /* Print any array sizes, function arguments or close parentheses
144    needed after the variable name (to describe its type).
145    Args work like c_type_print_varspec_prefix.  */
146
147 static void
148 f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
149                              int show, int passed_a_ptr, int demangled_args,
150                              int arrayprint_recurse_level)
151 {
152   int upper_bound, lower_bound;
153
154   /* No static variables are permitted as an error call may occur during
155      execution of this function.  */
156
157   if (type == 0)
158     return;
159
160   if (TYPE_NAME (type) && show <= 0)
161     return;
162
163   QUIT;
164
165   switch (TYPE_CODE (type))
166     {
167     case TYPE_CODE_ARRAY:
168       arrayprint_recurse_level++;
169
170       if (arrayprint_recurse_level == 1)
171         fprintf_filtered (stream, "(");
172
173       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
174         f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
175                                      arrayprint_recurse_level);
176
177       lower_bound = f77_get_lowerbound (type);
178       if (lower_bound != 1)     /* Not the default.  */
179         fprintf_filtered (stream, "%d:", lower_bound);
180
181       /* Make sure that, if we have an assumed size array, we
182          print out a warning and print the upperbound as '*'.  */
183
184       if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
185         fprintf_filtered (stream, "*");
186       else
187         {
188           upper_bound = f77_get_upperbound (type);
189           fprintf_filtered (stream, "%d", upper_bound);
190         }
191
192       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
193         f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 0, 0,
194                                      arrayprint_recurse_level);
195       if (arrayprint_recurse_level == 1)
196         fprintf_filtered (stream, ")");
197       else
198         fprintf_filtered (stream, ",");
199       arrayprint_recurse_level--;
200       break;
201
202     case TYPE_CODE_PTR:
203     case TYPE_CODE_REF:
204       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0,
205                                    arrayprint_recurse_level);
206       fprintf_filtered (stream, ")");
207       break;
208
209     case TYPE_CODE_FUNC:
210       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
211                                    passed_a_ptr, 0, arrayprint_recurse_level);
212       if (passed_a_ptr)
213         fprintf_filtered (stream, ")");
214
215       fprintf_filtered (stream, "()");
216       break;
217
218     case TYPE_CODE_UNDEF:
219     case TYPE_CODE_STRUCT:
220     case TYPE_CODE_UNION:
221     case TYPE_CODE_ENUM:
222     case TYPE_CODE_INT:
223     case TYPE_CODE_FLT:
224     case TYPE_CODE_VOID:
225     case TYPE_CODE_ERROR:
226     case TYPE_CODE_CHAR:
227     case TYPE_CODE_BOOL:
228     case TYPE_CODE_SET:
229     case TYPE_CODE_RANGE:
230     case TYPE_CODE_STRING:
231     case TYPE_CODE_METHOD:
232     case TYPE_CODE_COMPLEX:
233     case TYPE_CODE_TYPEDEF:
234       /* These types do not need a suffix.  They are listed so that
235          gcc -Wall will report types that may not have been considered.  */
236       break;
237     }
238 }
239
240 /* Print the name of the type (or the ultimate pointer target,
241    function value or array element), or the description of a
242    structure or union.
243
244    SHOW nonzero means don't print this type as just its name;
245    show its real definition even if it has a name.
246    SHOW zero means print just typename or struct tag if there is one
247    SHOW negative means abbreviate structure elements.
248    SHOW is decremented for printing of structure elements.
249
250    LEVEL is the depth to indent by.
251    We increase it for some recursive calls.  */
252
253 void
254 f_type_print_base (struct type *type, struct ui_file *stream, int show,
255                    int level)
256 {
257   int upper_bound;
258   int index;
259
260   QUIT;
261
262   wrap_here ("    ");
263   if (type == NULL)
264     {
265       fputs_filtered ("<type unknown>", stream);
266       return;
267     }
268
269   /* When SHOW is zero or less, and there is a valid type name, then always
270      just print the type name directly from the type.  */
271
272   if ((show <= 0) && (TYPE_NAME (type) != NULL))
273     {
274       fputs_filtered (TYPE_NAME (type), stream);
275       return;
276     }
277
278   if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF)
279     CHECK_TYPEDEF (type);
280
281   switch (TYPE_CODE (type))
282     {
283     case TYPE_CODE_TYPEDEF:
284       f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
285       break;
286
287     case TYPE_CODE_ARRAY:
288     case TYPE_CODE_FUNC:
289       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
290       break;
291
292     case TYPE_CODE_PTR:
293       fprintf_filtered (stream, "PTR TO -> ( ");
294       f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
295       break;
296
297     case TYPE_CODE_REF:
298       fprintf_filtered (stream, "REF TO -> ( ");
299       f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
300       break;
301
302     case TYPE_CODE_VOID:
303       fprintfi_filtered (level, stream, "VOID");
304       break;
305
306     case TYPE_CODE_UNDEF:
307       fprintfi_filtered (level, stream, "struct <unknown>");
308       break;
309
310     case TYPE_CODE_ERROR:
311       fprintfi_filtered (level, stream, "%s", TYPE_ERROR_NAME (type));
312       break;
313
314     case TYPE_CODE_RANGE:
315       /* This should not occur.  */
316       fprintfi_filtered (level, stream, "<range type>");
317       break;
318
319     case TYPE_CODE_CHAR:
320     case TYPE_CODE_INT:
321       /* There may be some character types that attempt to come
322          through as TYPE_CODE_INT since dbxstclass.h is so
323          C-oriented, we must change these to "character" from "char".  */
324
325       if (strcmp (TYPE_NAME (type), "char") == 0)
326         fprintfi_filtered (level, stream, "character");
327       else
328         goto default_case;
329       break;
330
331     case TYPE_CODE_STRING:
332       /* Strings may have dynamic upperbounds (lengths) like arrays.  */
333
334       if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
335         fprintfi_filtered (level, stream, "character*(*)");
336       else
337         {
338           upper_bound = f77_get_upperbound (type);
339           fprintf_filtered (stream, "character*%d", upper_bound);
340         }
341       break;
342
343     case TYPE_CODE_STRUCT:
344     case TYPE_CODE_UNION:
345       if (TYPE_CODE (type) == TYPE_CODE_UNION)
346         fprintfi_filtered (level, stream, "Type, C_Union :: ");
347       else
348         fprintfi_filtered (level, stream, "Type ");
349       fputs_filtered (TYPE_TAG_NAME (type), stream);
350       fputs_filtered ("\n", stream);
351       for (index = 0; index < TYPE_NFIELDS (type); index++)
352         {
353           f_type_print_base (TYPE_FIELD_TYPE (type, index), stream, show,
354                              level + 4);
355           fputs_filtered (" :: ", stream);
356           fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
357           f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index),
358                                        stream, 0, 0, 0, 0);
359           fputs_filtered ("\n", stream);
360         } 
361       fprintfi_filtered (level, stream, "End Type ");
362       fputs_filtered (TYPE_TAG_NAME (type), stream);
363       break;
364
365     case TYPE_CODE_MODULE:
366       fprintfi_filtered (level, stream, "module %s", TYPE_TAG_NAME (type));
367       break;
368
369     default_case:
370     default:
371       /* Handle types not explicitly handled by the other cases,
372          such as fundamental types.  For these, just print whatever
373          the type name is, as recorded in the type itself.  If there
374          is no type name, then complain.  */
375       if (TYPE_NAME (type) != NULL)
376         fprintfi_filtered (level, stream, "%s", TYPE_NAME (type));
377       else
378         error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));
379       break;
380     }
381 }