Commit | Line | Data |
---|---|---|
c906108c | 1 | /* Fortran language support routines for GDB, the GNU debugger. |
ce27fb25 | 2 | |
b811d2c2 | 3 | Copyright (C) 1993-2020 Free Software Foundation, Inc. |
ce27fb25 | 4 | |
c906108c SS |
5 | Contributed by Motorola. Adapted from the C parser by Farooq Butt |
6 | (fmbutt@engage.sps.mot.com). | |
7 | ||
c5aa993b | 8 | This file is part of GDB. |
c906108c | 9 | |
c5aa993b JM |
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 | |
a9762ec7 | 12 | the Free Software Foundation; either version 3 of the License, or |
c5aa993b | 13 | (at your option) any later version. |
c906108c | 14 | |
c5aa993b JM |
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. | |
c906108c | 19 | |
c5aa993b | 20 | You should have received a copy of the GNU General Public License |
a9762ec7 | 21 | along with this program. If not, see <http://www.gnu.org/licenses/>. */ |
c906108c SS |
22 | |
23 | #include "defs.h" | |
4de283e4 | 24 | #include "symtab.h" |
d55e5aa6 | 25 | #include "gdbtypes.h" |
4de283e4 | 26 | #include "expression.h" |
d55e5aa6 | 27 | #include "parser-defs.h" |
4de283e4 TT |
28 | #include "language.h" |
29 | #include "varobj.h" | |
30 | #include "gdbcore.h" | |
31 | #include "f-lang.h" | |
745b8ca0 | 32 | #include "valprint.h" |
5f9a71c3 | 33 | #include "value.h" |
4de283e4 TT |
34 | #include "cp-support.h" |
35 | #include "charset.h" | |
36 | #include "c-lang.h" | |
37 | #include "target-float.h" | |
0d12e84c | 38 | #include "gdbarch.h" |
4de283e4 TT |
39 | |
40 | #include <math.h> | |
c906108c | 41 | |
c906108c SS |
42 | /* Local functions */ |
43 | ||
3b2b8fea TT |
44 | /* Return the encoding that should be used for the character type |
45 | TYPE. */ | |
46 | ||
47 | static const char * | |
48 | f_get_encoding (struct type *type) | |
49 | { | |
50 | const char *encoding; | |
51 | ||
52 | switch (TYPE_LENGTH (type)) | |
53 | { | |
54 | case 1: | |
55 | encoding = target_charset (get_type_arch (type)); | |
56 | break; | |
57 | case 4: | |
34877895 | 58 | if (type_byte_order (type) == BFD_ENDIAN_BIG) |
3b2b8fea TT |
59 | encoding = "UTF-32BE"; |
60 | else | |
61 | encoding = "UTF-32LE"; | |
62 | break; | |
63 | ||
64 | default: | |
65 | error (_("unrecognized character type")); | |
66 | } | |
67 | ||
68 | return encoding; | |
69 | } | |
70 | ||
c906108c | 71 | \f |
c5aa993b | 72 | |
c906108c SS |
73 | /* Table of operators and their precedences for printing expressions. */ |
74 | ||
c5aa993b JM |
75 | static const struct op_print f_op_print_tab[] = |
76 | { | |
77 | {"+", BINOP_ADD, PREC_ADD, 0}, | |
78 | {"+", UNOP_PLUS, PREC_PREFIX, 0}, | |
79 | {"-", BINOP_SUB, PREC_ADD, 0}, | |
80 | {"-", UNOP_NEG, PREC_PREFIX, 0}, | |
81 | {"*", BINOP_MUL, PREC_MUL, 0}, | |
82 | {"/", BINOP_DIV, PREC_MUL, 0}, | |
83 | {"DIV", BINOP_INTDIV, PREC_MUL, 0}, | |
84 | {"MOD", BINOP_REM, PREC_MUL, 0}, | |
85 | {"=", BINOP_ASSIGN, PREC_ASSIGN, 1}, | |
86 | {".OR.", BINOP_LOGICAL_OR, PREC_LOGICAL_OR, 0}, | |
87 | {".AND.", BINOP_LOGICAL_AND, PREC_LOGICAL_AND, 0}, | |
88 | {".NOT.", UNOP_LOGICAL_NOT, PREC_PREFIX, 0}, | |
89 | {".EQ.", BINOP_EQUAL, PREC_EQUAL, 0}, | |
90 | {".NE.", BINOP_NOTEQUAL, PREC_EQUAL, 0}, | |
91 | {".LE.", BINOP_LEQ, PREC_ORDER, 0}, | |
92 | {".GE.", BINOP_GEQ, PREC_ORDER, 0}, | |
93 | {".GT.", BINOP_GTR, PREC_ORDER, 0}, | |
94 | {".LT.", BINOP_LESS, PREC_ORDER, 0}, | |
95 | {"**", UNOP_IND, PREC_PREFIX, 0}, | |
96 | {"@", BINOP_REPEAT, PREC_REPEAT, 0}, | |
f486487f | 97 | {NULL, OP_NULL, PREC_REPEAT, 0} |
c906108c SS |
98 | }; |
99 | \f | |
cad351d1 UW |
100 | enum f_primitive_types { |
101 | f_primitive_type_character, | |
102 | f_primitive_type_logical, | |
103 | f_primitive_type_logical_s1, | |
104 | f_primitive_type_logical_s2, | |
ce4b0682 | 105 | f_primitive_type_logical_s8, |
cad351d1 UW |
106 | f_primitive_type_integer, |
107 | f_primitive_type_integer_s2, | |
108 | f_primitive_type_real, | |
109 | f_primitive_type_real_s8, | |
110 | f_primitive_type_real_s16, | |
111 | f_primitive_type_complex_s8, | |
112 | f_primitive_type_complex_s16, | |
113 | f_primitive_type_void, | |
114 | nr_f_primitive_types | |
c906108c SS |
115 | }; |
116 | ||
6d816919 AB |
117 | /* Called from fortran_value_subarray to take a slice of an array or a |
118 | string. ARRAY is the array or string to be accessed. EXP, POS, and | |
119 | NOSIDE are as for evaluate_subexp_standard. Return a value that is a | |
120 | slice of the array. */ | |
121 | ||
122 | static struct value * | |
123 | value_f90_subarray (struct value *array, | |
124 | struct expression *exp, int *pos, enum noside noside) | |
125 | { | |
126 | int pc = (*pos) + 1; | |
127 | LONGEST low_bound, high_bound; | |
128 | struct type *range = check_typedef (value_type (array)->index_type ()); | |
129 | enum range_type range_type | |
130 | = (enum range_type) longest_to_int (exp->elts[pc].longconst); | |
131 | ||
132 | *pos += 3; | |
133 | ||
134 | if (range_type == LOW_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) | |
135 | low_bound = range->bounds ()->low.const_val (); | |
136 | else | |
137 | low_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); | |
138 | ||
139 | if (range_type == HIGH_BOUND_DEFAULT || range_type == BOTH_BOUND_DEFAULT) | |
140 | high_bound = range->bounds ()->high.const_val (); | |
141 | else | |
142 | high_bound = value_as_long (evaluate_subexp (nullptr, exp, pos, noside)); | |
143 | ||
144 | return value_slice (array, low_bound, high_bound - low_bound + 1); | |
145 | } | |
146 | ||
147 | /* Helper for skipping all the arguments in an undetermined argument list. | |
148 | This function was designed for use in the OP_F77_UNDETERMINED_ARGLIST | |
149 | case of evaluate_subexp_standard as multiple, but not all, code paths | |
150 | require a generic skip. */ | |
151 | ||
152 | static void | |
153 | skip_undetermined_arglist (int nargs, struct expression *exp, int *pos, | |
154 | enum noside noside) | |
155 | { | |
156 | for (int i = 0; i < nargs; ++i) | |
157 | evaluate_subexp (nullptr, exp, pos, noside); | |
158 | } | |
159 | ||
160 | /* Return the number of dimensions for a Fortran array or string. */ | |
161 | ||
162 | int | |
163 | calc_f77_array_dims (struct type *array_type) | |
164 | { | |
165 | int ndimen = 1; | |
166 | struct type *tmp_type; | |
167 | ||
168 | if ((array_type->code () == TYPE_CODE_STRING)) | |
169 | return 1; | |
170 | ||
171 | if ((array_type->code () != TYPE_CODE_ARRAY)) | |
172 | error (_("Can't get dimensions for a non-array type")); | |
173 | ||
174 | tmp_type = array_type; | |
175 | ||
176 | while ((tmp_type = TYPE_TARGET_TYPE (tmp_type))) | |
177 | { | |
178 | if (tmp_type->code () == TYPE_CODE_ARRAY) | |
179 | ++ndimen; | |
180 | } | |
181 | return ndimen; | |
182 | } | |
183 | ||
184 | /* Called from evaluate_subexp_standard to perform array indexing, and | |
185 | sub-range extraction, for Fortran. As well as arrays this function | |
186 | also handles strings as they can be treated like arrays of characters. | |
187 | ARRAY is the array or string being accessed. EXP, POS, and NOSIDE are | |
188 | as for evaluate_subexp_standard, and NARGS is the number of arguments | |
189 | in this access (e.g. 'array (1,2,3)' would be NARGS 3). */ | |
190 | ||
191 | static struct value * | |
192 | fortran_value_subarray (struct value *array, struct expression *exp, | |
193 | int *pos, int nargs, enum noside noside) | |
194 | { | |
195 | if (exp->elts[*pos].opcode == OP_RANGE) | |
196 | return value_f90_subarray (array, exp, pos, noside); | |
197 | ||
198 | if (noside == EVAL_SKIP) | |
199 | { | |
200 | skip_undetermined_arglist (nargs, exp, pos, noside); | |
201 | /* Return the dummy value with the correct type. */ | |
202 | return array; | |
203 | } | |
204 | ||
205 | LONGEST subscript_array[MAX_FORTRAN_DIMS]; | |
206 | int ndimensions = 1; | |
207 | struct type *type = check_typedef (value_type (array)); | |
208 | ||
209 | if (nargs > MAX_FORTRAN_DIMS) | |
210 | error (_("Too many subscripts for F77 (%d Max)"), MAX_FORTRAN_DIMS); | |
211 | ||
212 | ndimensions = calc_f77_array_dims (type); | |
213 | ||
214 | if (nargs != ndimensions) | |
215 | error (_("Wrong number of subscripts")); | |
216 | ||
217 | gdb_assert (nargs > 0); | |
218 | ||
219 | /* Now that we know we have a legal array subscript expression let us | |
220 | actually find out where this element exists in the array. */ | |
221 | ||
222 | /* Take array indices left to right. */ | |
223 | for (int i = 0; i < nargs; i++) | |
224 | { | |
225 | /* Evaluate each subscript; it must be a legal integer in F77. */ | |
226 | value *arg2 = evaluate_subexp_with_coercion (exp, pos, noside); | |
227 | ||
228 | /* Fill in the subscript array. */ | |
229 | subscript_array[i] = value_as_long (arg2); | |
230 | } | |
231 | ||
232 | /* Internal type of array is arranged right to left. */ | |
233 | for (int i = nargs; i > 0; i--) | |
234 | { | |
235 | struct type *array_type = check_typedef (value_type (array)); | |
236 | LONGEST index = subscript_array[i - 1]; | |
237 | ||
238 | array = value_subscripted_rvalue (array, index, | |
239 | f77_get_lowerbound (array_type)); | |
240 | } | |
241 | ||
242 | return array; | |
243 | } | |
244 | ||
9dad4a58 | 245 | /* Special expression evaluation cases for Fortran. */ |
cb8c24b6 SM |
246 | |
247 | static struct value * | |
9dad4a58 AB |
248 | evaluate_subexp_f (struct type *expect_type, struct expression *exp, |
249 | int *pos, enum noside noside) | |
250 | { | |
b6d03bb2 | 251 | struct value *arg1 = NULL, *arg2 = NULL; |
4d00f5d8 AB |
252 | enum exp_opcode op; |
253 | int pc; | |
254 | struct type *type; | |
255 | ||
256 | pc = *pos; | |
257 | *pos += 1; | |
258 | op = exp->elts[pc].opcode; | |
259 | ||
260 | switch (op) | |
261 | { | |
262 | default: | |
263 | *pos -= 1; | |
264 | return evaluate_subexp_standard (expect_type, exp, pos, noside); | |
265 | ||
0841c79a | 266 | case UNOP_ABS: |
fe1fe7ea | 267 | arg1 = evaluate_subexp (nullptr, exp, pos, noside); |
0841c79a AB |
268 | if (noside == EVAL_SKIP) |
269 | return eval_skip_value (exp); | |
270 | type = value_type (arg1); | |
78134374 | 271 | switch (type->code ()) |
0841c79a AB |
272 | { |
273 | case TYPE_CODE_FLT: | |
274 | { | |
275 | double d | |
276 | = fabs (target_float_to_host_double (value_contents (arg1), | |
277 | value_type (arg1))); | |
278 | return value_from_host_double (type, d); | |
279 | } | |
280 | case TYPE_CODE_INT: | |
281 | { | |
282 | LONGEST l = value_as_long (arg1); | |
283 | l = llabs (l); | |
284 | return value_from_longest (type, l); | |
285 | } | |
286 | } | |
287 | error (_("ABS of type %s not supported"), TYPE_SAFE_NAME (type)); | |
288 | ||
b6d03bb2 | 289 | case BINOP_MOD: |
fe1fe7ea | 290 | arg1 = evaluate_subexp (nullptr, exp, pos, noside); |
b6d03bb2 AB |
291 | arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside); |
292 | if (noside == EVAL_SKIP) | |
293 | return eval_skip_value (exp); | |
294 | type = value_type (arg1); | |
78134374 | 295 | if (type->code () != value_type (arg2)->code ()) |
b6d03bb2 | 296 | error (_("non-matching types for parameters to MOD ()")); |
78134374 | 297 | switch (type->code ()) |
b6d03bb2 AB |
298 | { |
299 | case TYPE_CODE_FLT: | |
300 | { | |
301 | double d1 | |
302 | = target_float_to_host_double (value_contents (arg1), | |
303 | value_type (arg1)); | |
304 | double d2 | |
305 | = target_float_to_host_double (value_contents (arg2), | |
306 | value_type (arg2)); | |
307 | double d3 = fmod (d1, d2); | |
308 | return value_from_host_double (type, d3); | |
309 | } | |
310 | case TYPE_CODE_INT: | |
311 | { | |
312 | LONGEST v1 = value_as_long (arg1); | |
313 | LONGEST v2 = value_as_long (arg2); | |
314 | if (v2 == 0) | |
315 | error (_("calling MOD (N, 0) is undefined")); | |
316 | LONGEST v3 = v1 - (v1 / v2) * v2; | |
317 | return value_from_longest (value_type (arg1), v3); | |
318 | } | |
319 | } | |
320 | error (_("MOD of type %s not supported"), TYPE_SAFE_NAME (type)); | |
321 | ||
322 | case UNOP_FORTRAN_CEILING: | |
323 | { | |
fe1fe7ea | 324 | arg1 = evaluate_subexp (nullptr, exp, pos, noside); |
b6d03bb2 AB |
325 | if (noside == EVAL_SKIP) |
326 | return eval_skip_value (exp); | |
327 | type = value_type (arg1); | |
78134374 | 328 | if (type->code () != TYPE_CODE_FLT) |
b6d03bb2 AB |
329 | error (_("argument to CEILING must be of type float")); |
330 | double val | |
331 | = target_float_to_host_double (value_contents (arg1), | |
332 | value_type (arg1)); | |
333 | val = ceil (val); | |
334 | return value_from_host_double (type, val); | |
335 | } | |
336 | ||
337 | case UNOP_FORTRAN_FLOOR: | |
338 | { | |
fe1fe7ea | 339 | arg1 = evaluate_subexp (nullptr, exp, pos, noside); |
b6d03bb2 AB |
340 | if (noside == EVAL_SKIP) |
341 | return eval_skip_value (exp); | |
342 | type = value_type (arg1); | |
78134374 | 343 | if (type->code () != TYPE_CODE_FLT) |
b6d03bb2 AB |
344 | error (_("argument to FLOOR must be of type float")); |
345 | double val | |
346 | = target_float_to_host_double (value_contents (arg1), | |
347 | value_type (arg1)); | |
348 | val = floor (val); | |
349 | return value_from_host_double (type, val); | |
350 | } | |
351 | ||
352 | case BINOP_FORTRAN_MODULO: | |
353 | { | |
fe1fe7ea | 354 | arg1 = evaluate_subexp (nullptr, exp, pos, noside); |
b6d03bb2 AB |
355 | arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside); |
356 | if (noside == EVAL_SKIP) | |
357 | return eval_skip_value (exp); | |
358 | type = value_type (arg1); | |
78134374 | 359 | if (type->code () != value_type (arg2)->code ()) |
b6d03bb2 AB |
360 | error (_("non-matching types for parameters to MODULO ()")); |
361 | /* MODULO(A, P) = A - FLOOR (A / P) * P */ | |
78134374 | 362 | switch (type->code ()) |
b6d03bb2 AB |
363 | { |
364 | case TYPE_CODE_INT: | |
365 | { | |
366 | LONGEST a = value_as_long (arg1); | |
367 | LONGEST p = value_as_long (arg2); | |
368 | LONGEST result = a - (a / p) * p; | |
369 | if (result != 0 && (a < 0) != (p < 0)) | |
370 | result += p; | |
371 | return value_from_longest (value_type (arg1), result); | |
372 | } | |
373 | case TYPE_CODE_FLT: | |
374 | { | |
375 | double a | |
376 | = target_float_to_host_double (value_contents (arg1), | |
377 | value_type (arg1)); | |
378 | double p | |
379 | = target_float_to_host_double (value_contents (arg2), | |
380 | value_type (arg2)); | |
381 | double result = fmod (a, p); | |
382 | if (result != 0 && (a < 0.0) != (p < 0.0)) | |
383 | result += p; | |
384 | return value_from_host_double (type, result); | |
385 | } | |
386 | } | |
387 | error (_("MODULO of type %s not supported"), TYPE_SAFE_NAME (type)); | |
388 | } | |
389 | ||
390 | case BINOP_FORTRAN_CMPLX: | |
fe1fe7ea | 391 | arg1 = evaluate_subexp (nullptr, exp, pos, noside); |
b6d03bb2 AB |
392 | arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside); |
393 | if (noside == EVAL_SKIP) | |
394 | return eval_skip_value (exp); | |
395 | type = builtin_f_type(exp->gdbarch)->builtin_complex_s16; | |
396 | return value_literal_complex (arg1, arg2, type); | |
397 | ||
83228e93 | 398 | case UNOP_FORTRAN_KIND: |
4d00f5d8 AB |
399 | arg1 = evaluate_subexp (NULL, exp, pos, EVAL_AVOID_SIDE_EFFECTS); |
400 | type = value_type (arg1); | |
401 | ||
78134374 | 402 | switch (type->code ()) |
4d00f5d8 AB |
403 | { |
404 | case TYPE_CODE_STRUCT: | |
405 | case TYPE_CODE_UNION: | |
406 | case TYPE_CODE_MODULE: | |
407 | case TYPE_CODE_FUNC: | |
408 | error (_("argument to kind must be an intrinsic type")); | |
409 | } | |
410 | ||
411 | if (!TYPE_TARGET_TYPE (type)) | |
412 | return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, | |
413 | TYPE_LENGTH (type)); | |
414 | return value_from_longest (builtin_type (exp->gdbarch)->builtin_int, | |
78134374 | 415 | TYPE_LENGTH (TYPE_TARGET_TYPE (type))); |
6d816919 AB |
416 | |
417 | ||
418 | case OP_F77_UNDETERMINED_ARGLIST: | |
419 | /* Remember that in F77, functions, substring ops and array subscript | |
420 | operations cannot be disambiguated at parse time. We have made | |
421 | all array subscript operations, substring operations as well as | |
422 | function calls come here and we now have to discover what the heck | |
423 | this thing actually was. If it is a function, we process just as | |
424 | if we got an OP_FUNCALL. */ | |
425 | int nargs = longest_to_int (exp->elts[pc + 1].longconst); | |
426 | (*pos) += 2; | |
427 | ||
428 | /* First determine the type code we are dealing with. */ | |
429 | arg1 = evaluate_subexp (nullptr, exp, pos, noside); | |
430 | type = check_typedef (value_type (arg1)); | |
431 | enum type_code code = type->code (); | |
432 | ||
433 | if (code == TYPE_CODE_PTR) | |
434 | { | |
435 | /* Fortran always passes variable to subroutines as pointer. | |
436 | So we need to look into its target type to see if it is | |
437 | array, string or function. If it is, we need to switch | |
438 | to the target value the original one points to. */ | |
439 | struct type *target_type = check_typedef (TYPE_TARGET_TYPE (type)); | |
440 | ||
441 | if (target_type->code () == TYPE_CODE_ARRAY | |
442 | || target_type->code () == TYPE_CODE_STRING | |
443 | || target_type->code () == TYPE_CODE_FUNC) | |
444 | { | |
445 | arg1 = value_ind (arg1); | |
446 | type = check_typedef (value_type (arg1)); | |
447 | code = type->code (); | |
448 | } | |
449 | } | |
450 | ||
451 | switch (code) | |
452 | { | |
453 | case TYPE_CODE_ARRAY: | |
454 | case TYPE_CODE_STRING: | |
455 | return fortran_value_subarray (arg1, exp, pos, nargs, noside); | |
456 | ||
457 | case TYPE_CODE_PTR: | |
458 | case TYPE_CODE_FUNC: | |
459 | case TYPE_CODE_INTERNAL_FUNCTION: | |
460 | { | |
461 | /* It's a function call. Allocate arg vector, including | |
462 | space for the function to be called in argvec[0] and a | |
463 | termination NULL. */ | |
464 | struct value **argvec = (struct value **) | |
465 | alloca (sizeof (struct value *) * (nargs + 2)); | |
466 | argvec[0] = arg1; | |
467 | int tem = 1; | |
468 | for (; tem <= nargs; tem++) | |
469 | { | |
470 | argvec[tem] = evaluate_subexp_with_coercion (exp, pos, noside); | |
471 | /* Arguments in Fortran are passed by address. Coerce the | |
472 | arguments here rather than in value_arg_coerce as | |
473 | otherwise the call to malloc to place the non-lvalue | |
474 | parameters in target memory is hit by this Fortran | |
475 | specific logic. This results in malloc being called | |
476 | with a pointer to an integer followed by an attempt to | |
477 | malloc the arguments to malloc in target memory. | |
478 | Infinite recursion ensues. */ | |
479 | if (code == TYPE_CODE_PTR || code == TYPE_CODE_FUNC) | |
480 | { | |
481 | bool is_artificial | |
482 | = TYPE_FIELD_ARTIFICIAL (value_type (arg1), tem - 1); | |
483 | argvec[tem] = fortran_argument_convert (argvec[tem], | |
484 | is_artificial); | |
485 | } | |
486 | } | |
487 | argvec[tem] = 0; /* signal end of arglist */ | |
488 | if (noside == EVAL_SKIP) | |
489 | return eval_skip_value (exp); | |
490 | return evaluate_subexp_do_call (exp, noside, nargs, argvec, NULL, | |
491 | expect_type); | |
492 | } | |
493 | ||
494 | default: | |
495 | error (_("Cannot perform substring on this type")); | |
496 | } | |
4d00f5d8 AB |
497 | } |
498 | ||
499 | /* Should be unreachable. */ | |
500 | return nullptr; | |
9dad4a58 AB |
501 | } |
502 | ||
83228e93 AB |
503 | /* Special expression lengths for Fortran. */ |
504 | ||
505 | static void | |
506 | operator_length_f (const struct expression *exp, int pc, int *oplenp, | |
507 | int *argsp) | |
508 | { | |
509 | int oplen = 1; | |
510 | int args = 0; | |
511 | ||
512 | switch (exp->elts[pc - 1].opcode) | |
513 | { | |
514 | default: | |
515 | operator_length_standard (exp, pc, oplenp, argsp); | |
516 | return; | |
517 | ||
518 | case UNOP_FORTRAN_KIND: | |
b6d03bb2 AB |
519 | case UNOP_FORTRAN_FLOOR: |
520 | case UNOP_FORTRAN_CEILING: | |
83228e93 AB |
521 | oplen = 1; |
522 | args = 1; | |
523 | break; | |
b6d03bb2 AB |
524 | |
525 | case BINOP_FORTRAN_CMPLX: | |
526 | case BINOP_FORTRAN_MODULO: | |
527 | oplen = 1; | |
528 | args = 2; | |
529 | break; | |
6d816919 AB |
530 | |
531 | case OP_F77_UNDETERMINED_ARGLIST: | |
532 | oplen = 3; | |
533 | args = 1 + longest_to_int (exp->elts[pc - 2].longconst); | |
534 | break; | |
83228e93 AB |
535 | } |
536 | ||
537 | *oplenp = oplen; | |
538 | *argsp = args; | |
539 | } | |
540 | ||
b6d03bb2 AB |
541 | /* Helper for PRINT_SUBEXP_F. Arguments are as for PRINT_SUBEXP_F, except |
542 | the extra argument NAME which is the text that should be printed as the | |
543 | name of this operation. */ | |
544 | ||
545 | static void | |
546 | print_unop_subexp_f (struct expression *exp, int *pos, | |
547 | struct ui_file *stream, enum precedence prec, | |
548 | const char *name) | |
549 | { | |
550 | (*pos)++; | |
551 | fprintf_filtered (stream, "%s(", name); | |
552 | print_subexp (exp, pos, stream, PREC_SUFFIX); | |
553 | fputs_filtered (")", stream); | |
554 | } | |
555 | ||
556 | /* Helper for PRINT_SUBEXP_F. Arguments are as for PRINT_SUBEXP_F, except | |
557 | the extra argument NAME which is the text that should be printed as the | |
558 | name of this operation. */ | |
559 | ||
560 | static void | |
561 | print_binop_subexp_f (struct expression *exp, int *pos, | |
562 | struct ui_file *stream, enum precedence prec, | |
563 | const char *name) | |
564 | { | |
565 | (*pos)++; | |
566 | fprintf_filtered (stream, "%s(", name); | |
567 | print_subexp (exp, pos, stream, PREC_SUFFIX); | |
568 | fputs_filtered (",", stream); | |
569 | print_subexp (exp, pos, stream, PREC_SUFFIX); | |
570 | fputs_filtered (")", stream); | |
571 | } | |
572 | ||
83228e93 AB |
573 | /* Special expression printing for Fortran. */ |
574 | ||
575 | static void | |
576 | print_subexp_f (struct expression *exp, int *pos, | |
577 | struct ui_file *stream, enum precedence prec) | |
578 | { | |
579 | int pc = *pos; | |
580 | enum exp_opcode op = exp->elts[pc].opcode; | |
581 | ||
582 | switch (op) | |
583 | { | |
584 | default: | |
585 | print_subexp_standard (exp, pos, stream, prec); | |
586 | return; | |
587 | ||
588 | case UNOP_FORTRAN_KIND: | |
b6d03bb2 AB |
589 | print_unop_subexp_f (exp, pos, stream, prec, "KIND"); |
590 | return; | |
591 | ||
592 | case UNOP_FORTRAN_FLOOR: | |
593 | print_unop_subexp_f (exp, pos, stream, prec, "FLOOR"); | |
594 | return; | |
595 | ||
596 | case UNOP_FORTRAN_CEILING: | |
597 | print_unop_subexp_f (exp, pos, stream, prec, "CEILING"); | |
598 | return; | |
599 | ||
600 | case BINOP_FORTRAN_CMPLX: | |
601 | print_binop_subexp_f (exp, pos, stream, prec, "CMPLX"); | |
602 | return; | |
603 | ||
604 | case BINOP_FORTRAN_MODULO: | |
605 | print_binop_subexp_f (exp, pos, stream, prec, "MODULO"); | |
83228e93 | 606 | return; |
6d816919 AB |
607 | |
608 | case OP_F77_UNDETERMINED_ARGLIST: | |
609 | print_subexp_funcall (exp, pos, stream); | |
610 | return; | |
83228e93 AB |
611 | } |
612 | } | |
613 | ||
614 | /* Special expression names for Fortran. */ | |
615 | ||
616 | static const char * | |
617 | op_name_f (enum exp_opcode opcode) | |
618 | { | |
619 | switch (opcode) | |
620 | { | |
621 | default: | |
622 | return op_name_standard (opcode); | |
623 | ||
624 | #define OP(name) \ | |
625 | case name: \ | |
626 | return #name ; | |
627 | #include "fortran-operator.def" | |
628 | #undef OP | |
629 | } | |
630 | } | |
631 | ||
632 | /* Special expression dumping for Fortran. */ | |
633 | ||
634 | static int | |
635 | dump_subexp_body_f (struct expression *exp, | |
636 | struct ui_file *stream, int elt) | |
637 | { | |
638 | int opcode = exp->elts[elt].opcode; | |
639 | int oplen, nargs, i; | |
640 | ||
641 | switch (opcode) | |
642 | { | |
643 | default: | |
644 | return dump_subexp_body_standard (exp, stream, elt); | |
645 | ||
646 | case UNOP_FORTRAN_KIND: | |
b6d03bb2 AB |
647 | case UNOP_FORTRAN_FLOOR: |
648 | case UNOP_FORTRAN_CEILING: | |
649 | case BINOP_FORTRAN_CMPLX: | |
650 | case BINOP_FORTRAN_MODULO: | |
83228e93 AB |
651 | operator_length_f (exp, (elt + 1), &oplen, &nargs); |
652 | break; | |
6d816919 AB |
653 | |
654 | case OP_F77_UNDETERMINED_ARGLIST: | |
655 | return dump_subexp_body_funcall (exp, stream, elt); | |
83228e93 AB |
656 | } |
657 | ||
658 | elt += oplen; | |
659 | for (i = 0; i < nargs; i += 1) | |
660 | elt = dump_subexp (exp, stream, elt); | |
661 | ||
662 | return elt; | |
663 | } | |
664 | ||
665 | /* Special expression checking for Fortran. */ | |
666 | ||
667 | static int | |
668 | operator_check_f (struct expression *exp, int pos, | |
669 | int (*objfile_func) (struct objfile *objfile, | |
670 | void *data), | |
671 | void *data) | |
672 | { | |
673 | const union exp_element *const elts = exp->elts; | |
674 | ||
675 | switch (elts[pos].opcode) | |
676 | { | |
677 | case UNOP_FORTRAN_KIND: | |
b6d03bb2 AB |
678 | case UNOP_FORTRAN_FLOOR: |
679 | case UNOP_FORTRAN_CEILING: | |
680 | case BINOP_FORTRAN_CMPLX: | |
681 | case BINOP_FORTRAN_MODULO: | |
83228e93 AB |
682 | /* Any references to objfiles are held in the arguments to this |
683 | expression, not within the expression itself, so no additional | |
684 | checking is required here, the outer expression iteration code | |
685 | will take care of checking each argument. */ | |
686 | break; | |
687 | ||
688 | default: | |
689 | return operator_check_standard (exp, pos, objfile_func, data); | |
690 | } | |
691 | ||
692 | return 0; | |
693 | } | |
694 | ||
9dad4a58 AB |
695 | /* Expression processing for Fortran. */ |
696 | static const struct exp_descriptor exp_descriptor_f = | |
697 | { | |
83228e93 AB |
698 | print_subexp_f, |
699 | operator_length_f, | |
700 | operator_check_f, | |
701 | op_name_f, | |
702 | dump_subexp_body_f, | |
9dad4a58 AB |
703 | evaluate_subexp_f |
704 | }; | |
705 | ||
0874fd07 AB |
706 | /* Class representing the Fortran language. */ |
707 | ||
708 | class f_language : public language_defn | |
709 | { | |
710 | public: | |
711 | f_language () | |
0e25e767 | 712 | : language_defn (language_fortran) |
0874fd07 | 713 | { /* Nothing. */ } |
1fb314aa | 714 | |
6f7664a9 AB |
715 | /* See language.h. */ |
716 | ||
717 | const char *name () const override | |
718 | { return "fortran"; } | |
719 | ||
720 | /* See language.h. */ | |
721 | ||
722 | const char *natural_name () const override | |
723 | { return "Fortran"; } | |
724 | ||
e171d6f1 AB |
725 | /* See language.h. */ |
726 | ||
727 | const std::vector<const char *> &filename_extensions () const override | |
728 | { | |
729 | static const std::vector<const char *> extensions = { | |
730 | ".f", ".F", ".for", ".FOR", ".ftn", ".FTN", ".fpp", ".FPP", | |
731 | ".f90", ".F90", ".f95", ".F95", ".f03", ".F03", ".f08", ".F08" | |
732 | }; | |
733 | return extensions; | |
734 | } | |
735 | ||
1fb314aa AB |
736 | /* See language.h. */ |
737 | void language_arch_info (struct gdbarch *gdbarch, | |
738 | struct language_arch_info *lai) const override | |
739 | { | |
740 | const struct builtin_f_type *builtin = builtin_f_type (gdbarch); | |
741 | ||
742 | lai->string_char_type = builtin->builtin_character; | |
743 | lai->primitive_type_vector | |
744 | = GDBARCH_OBSTACK_CALLOC (gdbarch, nr_f_primitive_types + 1, | |
745 | struct type *); | |
746 | ||
747 | lai->primitive_type_vector [f_primitive_type_character] | |
748 | = builtin->builtin_character; | |
749 | lai->primitive_type_vector [f_primitive_type_logical] | |
750 | = builtin->builtin_logical; | |
751 | lai->primitive_type_vector [f_primitive_type_logical_s1] | |
752 | = builtin->builtin_logical_s1; | |
753 | lai->primitive_type_vector [f_primitive_type_logical_s2] | |
754 | = builtin->builtin_logical_s2; | |
755 | lai->primitive_type_vector [f_primitive_type_logical_s8] | |
756 | = builtin->builtin_logical_s8; | |
757 | lai->primitive_type_vector [f_primitive_type_real] | |
758 | = builtin->builtin_real; | |
759 | lai->primitive_type_vector [f_primitive_type_real_s8] | |
760 | = builtin->builtin_real_s8; | |
761 | lai->primitive_type_vector [f_primitive_type_real_s16] | |
762 | = builtin->builtin_real_s16; | |
763 | lai->primitive_type_vector [f_primitive_type_complex_s8] | |
764 | = builtin->builtin_complex_s8; | |
765 | lai->primitive_type_vector [f_primitive_type_complex_s16] | |
766 | = builtin->builtin_complex_s16; | |
767 | lai->primitive_type_vector [f_primitive_type_void] | |
768 | = builtin->builtin_void; | |
769 | ||
770 | lai->bool_type_symbol = "logical"; | |
771 | lai->bool_type_default = builtin->builtin_logical_s2; | |
772 | } | |
fb8006fd AB |
773 | |
774 | /* See language.h. */ | |
775 | unsigned int search_name_hash (const char *name) const override | |
776 | { | |
777 | return cp_search_name_hash (name); | |
778 | } | |
fbfb0a46 AB |
779 | |
780 | /* See language.h. */ | |
781 | ||
0a50df5d AB |
782 | char *demangle (const char *mangled, int options) const override |
783 | { | |
784 | /* We could support demangling here to provide module namespaces | |
785 | also for inferiors with only minimal symbol table (ELF symbols). | |
786 | Just the mangling standard is not standardized across compilers | |
787 | and there is no DW_AT_producer available for inferiors with only | |
788 | the ELF symbols to check the mangling kind. */ | |
789 | return nullptr; | |
790 | } | |
791 | ||
792 | /* See language.h. */ | |
793 | ||
fbfb0a46 AB |
794 | void print_type (struct type *type, const char *varstring, |
795 | struct ui_file *stream, int show, int level, | |
796 | const struct type_print_options *flags) const override | |
797 | { | |
798 | f_print_type (type, varstring, stream, show, level, flags); | |
799 | } | |
c9debfb9 | 800 | |
53fc67f8 AB |
801 | /* See language.h. This just returns default set of word break |
802 | characters but with the modules separator `::' removed. */ | |
803 | ||
804 | const char *word_break_characters (void) const override | |
805 | { | |
806 | static char *retval; | |
807 | ||
808 | if (!retval) | |
809 | { | |
810 | char *s; | |
811 | ||
812 | retval = xstrdup (language_defn::word_break_characters ()); | |
813 | s = strchr (retval, ':'); | |
814 | if (s) | |
815 | { | |
816 | char *last_char = &s[strlen (s) - 1]; | |
817 | ||
818 | *s = *last_char; | |
819 | *last_char = 0; | |
820 | } | |
821 | } | |
822 | return retval; | |
823 | } | |
824 | ||
7e56227d AB |
825 | |
826 | /* See language.h. */ | |
827 | ||
828 | void collect_symbol_completion_matches (completion_tracker &tracker, | |
829 | complete_symbol_mode mode, | |
830 | symbol_name_match_type name_match_type, | |
831 | const char *text, const char *word, | |
832 | enum type_code code) const override | |
833 | { | |
834 | /* Consider the modules separator :: as a valid symbol name character | |
835 | class. */ | |
836 | default_collect_symbol_completion_matches_break_on (tracker, mode, | |
837 | name_match_type, | |
838 | text, word, ":", | |
839 | code); | |
840 | } | |
841 | ||
ebe2334e AB |
842 | /* See language.h. */ |
843 | ||
844 | void value_print_inner | |
845 | (struct value *val, struct ui_file *stream, int recurse, | |
846 | const struct value_print_options *options) const override | |
847 | { | |
848 | return f_value_print_inner (val, stream, recurse, options); | |
849 | } | |
850 | ||
a78a19b1 AB |
851 | /* See language.h. */ |
852 | ||
853 | struct block_symbol lookup_symbol_nonlocal | |
854 | (const char *name, const struct block *block, | |
855 | const domain_enum domain) const override | |
856 | { | |
857 | return cp_lookup_symbol_nonlocal (this, name, block, domain); | |
858 | } | |
ebe2334e | 859 | |
87afa652 AB |
860 | /* See language.h. */ |
861 | ||
862 | int parser (struct parser_state *ps) const override | |
863 | { | |
864 | return f_parse (ps); | |
865 | } | |
866 | ||
ec8cec5b AB |
867 | /* See language.h. */ |
868 | ||
869 | void emitchar (int ch, struct type *chtype, | |
870 | struct ui_file *stream, int quoter) const override | |
871 | { | |
872 | const char *encoding = f_get_encoding (chtype); | |
873 | generic_emit_char (ch, chtype, stream, quoter, encoding); | |
874 | } | |
875 | ||
52b50f2c AB |
876 | /* See language.h. */ |
877 | ||
878 | void printchar (int ch, struct type *chtype, | |
879 | struct ui_file *stream) const override | |
880 | { | |
881 | fputs_filtered ("'", stream); | |
882 | LA_EMIT_CHAR (ch, chtype, stream, '\''); | |
883 | fputs_filtered ("'", stream); | |
884 | } | |
885 | ||
d711ee67 AB |
886 | /* See language.h. */ |
887 | ||
888 | void printstr (struct ui_file *stream, struct type *elttype, | |
889 | const gdb_byte *string, unsigned int length, | |
890 | const char *encoding, int force_ellipses, | |
891 | const struct value_print_options *options) const override | |
892 | { | |
893 | const char *type_encoding = f_get_encoding (elttype); | |
894 | ||
895 | if (TYPE_LENGTH (elttype) == 4) | |
896 | fputs_filtered ("4_", stream); | |
897 | ||
898 | if (!encoding || !*encoding) | |
899 | encoding = type_encoding; | |
900 | ||
901 | generic_printstr (stream, elttype, string, length, encoding, | |
902 | force_ellipses, '\'', 0, options); | |
903 | } | |
904 | ||
4ffc13fb AB |
905 | /* See language.h. */ |
906 | ||
907 | void print_typedef (struct type *type, struct symbol *new_symbol, | |
908 | struct ui_file *stream) const override | |
909 | { | |
910 | f_print_typedef (type, new_symbol, stream); | |
911 | } | |
912 | ||
39e7ecca AB |
913 | /* See language.h. */ |
914 | ||
915 | bool is_string_type_p (struct type *type) const override | |
916 | { | |
917 | type = check_typedef (type); | |
918 | return (type->code () == TYPE_CODE_STRING | |
919 | || (type->code () == TYPE_CODE_ARRAY | |
920 | && TYPE_TARGET_TYPE (type)->code () == TYPE_CODE_CHAR)); | |
921 | } | |
922 | ||
22e3f3ed AB |
923 | /* See language.h. */ |
924 | ||
925 | const char *struct_too_deep_ellipsis () const override | |
926 | { return "(...)"; } | |
927 | ||
67bd3fd5 AB |
928 | /* See language.h. */ |
929 | ||
930 | bool c_style_arrays_p () const override | |
931 | { return false; } | |
932 | ||
efdf6a73 AB |
933 | /* See language.h. */ |
934 | ||
935 | bool range_checking_on_by_default () const override | |
936 | { return true; } | |
937 | ||
0d201fa4 AB |
938 | /* See language.h. */ |
939 | ||
940 | enum case_sensitivity case_sensitivity () const override | |
941 | { return case_sensitive_off; } | |
942 | ||
3a3440fb AB |
943 | /* See language.h. */ |
944 | ||
945 | enum array_ordering array_ordering () const override | |
946 | { return array_column_major; } | |
947 | ||
5aba6ebe AB |
948 | /* See language.h. */ |
949 | ||
950 | const struct exp_descriptor *expression_ops () const override | |
951 | { return &exp_descriptor_f; } | |
952 | ||
b7c6e27d AB |
953 | /* See language.h. */ |
954 | ||
955 | const struct op_print *opcode_print_table () const override | |
956 | { return f_op_print_tab; } | |
957 | ||
c9debfb9 AB |
958 | protected: |
959 | ||
960 | /* See language.h. */ | |
961 | ||
962 | symbol_name_matcher_ftype *get_symbol_name_matcher_inner | |
963 | (const lookup_name_info &lookup_name) const override | |
964 | { | |
965 | return cp_get_symbol_name_matcher (lookup_name); | |
966 | } | |
0874fd07 AB |
967 | }; |
968 | ||
969 | /* Single instance of the Fortran language class. */ | |
970 | ||
971 | static f_language f_language_defn; | |
972 | ||
54ef06c7 UW |
973 | static void * |
974 | build_fortran_types (struct gdbarch *gdbarch) | |
c906108c | 975 | { |
54ef06c7 UW |
976 | struct builtin_f_type *builtin_f_type |
977 | = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_f_type); | |
978 | ||
e9bb382b | 979 | builtin_f_type->builtin_void |
bbe75b9d | 980 | = arch_type (gdbarch, TYPE_CODE_VOID, TARGET_CHAR_BIT, "void"); |
e9bb382b UW |
981 | |
982 | builtin_f_type->builtin_character | |
4a270568 | 983 | = arch_type (gdbarch, TYPE_CODE_CHAR, TARGET_CHAR_BIT, "character"); |
e9bb382b UW |
984 | |
985 | builtin_f_type->builtin_logical_s1 | |
986 | = arch_boolean_type (gdbarch, TARGET_CHAR_BIT, 1, "logical*1"); | |
987 | ||
988 | builtin_f_type->builtin_integer_s2 | |
989 | = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch), 0, | |
990 | "integer*2"); | |
991 | ||
067630bd AB |
992 | builtin_f_type->builtin_integer_s8 |
993 | = arch_integer_type (gdbarch, gdbarch_long_long_bit (gdbarch), 0, | |
994 | "integer*8"); | |
995 | ||
e9bb382b UW |
996 | builtin_f_type->builtin_logical_s2 |
997 | = arch_boolean_type (gdbarch, gdbarch_short_bit (gdbarch), 1, | |
998 | "logical*2"); | |
999 | ||
ce4b0682 SDJ |
1000 | builtin_f_type->builtin_logical_s8 |
1001 | = arch_boolean_type (gdbarch, gdbarch_long_long_bit (gdbarch), 1, | |
1002 | "logical*8"); | |
1003 | ||
e9bb382b UW |
1004 | builtin_f_type->builtin_integer |
1005 | = arch_integer_type (gdbarch, gdbarch_int_bit (gdbarch), 0, | |
1006 | "integer"); | |
1007 | ||
1008 | builtin_f_type->builtin_logical | |
1009 | = arch_boolean_type (gdbarch, gdbarch_int_bit (gdbarch), 1, | |
1010 | "logical*4"); | |
1011 | ||
1012 | builtin_f_type->builtin_real | |
1013 | = arch_float_type (gdbarch, gdbarch_float_bit (gdbarch), | |
49f190bc | 1014 | "real", gdbarch_float_format (gdbarch)); |
e9bb382b UW |
1015 | builtin_f_type->builtin_real_s8 |
1016 | = arch_float_type (gdbarch, gdbarch_double_bit (gdbarch), | |
49f190bc | 1017 | "real*8", gdbarch_double_format (gdbarch)); |
34d11c68 | 1018 | auto fmt = gdbarch_floatformat_for_type (gdbarch, "real(kind=16)", 128); |
dc42e902 AB |
1019 | if (fmt != nullptr) |
1020 | builtin_f_type->builtin_real_s16 | |
1021 | = arch_float_type (gdbarch, 128, "real*16", fmt); | |
1022 | else if (gdbarch_long_double_bit (gdbarch) == 128) | |
1023 | builtin_f_type->builtin_real_s16 | |
1024 | = arch_float_type (gdbarch, gdbarch_long_double_bit (gdbarch), | |
1025 | "real*16", gdbarch_long_double_format (gdbarch)); | |
1026 | else | |
1027 | builtin_f_type->builtin_real_s16 | |
1028 | = arch_type (gdbarch, TYPE_CODE_ERROR, 128, "real*16"); | |
e9bb382b UW |
1029 | |
1030 | builtin_f_type->builtin_complex_s8 | |
5b930b45 | 1031 | = init_complex_type ("complex*8", builtin_f_type->builtin_real); |
e9bb382b | 1032 | builtin_f_type->builtin_complex_s16 |
5b930b45 | 1033 | = init_complex_type ("complex*16", builtin_f_type->builtin_real_s8); |
0830d301 | 1034 | |
78134374 | 1035 | if (builtin_f_type->builtin_real_s16->code () == TYPE_CODE_ERROR) |
0830d301 TT |
1036 | builtin_f_type->builtin_complex_s32 |
1037 | = arch_type (gdbarch, TYPE_CODE_ERROR, 256, "complex*32"); | |
1038 | else | |
1039 | builtin_f_type->builtin_complex_s32 | |
1040 | = init_complex_type ("complex*32", builtin_f_type->builtin_real_s16); | |
54ef06c7 UW |
1041 | |
1042 | return builtin_f_type; | |
1043 | } | |
1044 | ||
1045 | static struct gdbarch_data *f_type_data; | |
1046 | ||
1047 | const struct builtin_f_type * | |
1048 | builtin_f_type (struct gdbarch *gdbarch) | |
1049 | { | |
9a3c8263 | 1050 | return (const struct builtin_f_type *) gdbarch_data (gdbarch, f_type_data); |
4e845cd3 MS |
1051 | } |
1052 | ||
6c265988 | 1053 | void _initialize_f_language (); |
4e845cd3 | 1054 | void |
6c265988 | 1055 | _initialize_f_language () |
4e845cd3 | 1056 | { |
54ef06c7 | 1057 | f_type_data = gdbarch_data_register_post_init (build_fortran_types); |
c906108c | 1058 | } |
aa3cfbda RB |
1059 | |
1060 | /* See f-lang.h. */ | |
1061 | ||
1062 | struct value * | |
1063 | fortran_argument_convert (struct value *value, bool is_artificial) | |
1064 | { | |
1065 | if (!is_artificial) | |
1066 | { | |
1067 | /* If the value is not in the inferior e.g. registers values, | |
1068 | convenience variables and user input. */ | |
1069 | if (VALUE_LVAL (value) != lval_memory) | |
1070 | { | |
1071 | struct type *type = value_type (value); | |
1072 | const int length = TYPE_LENGTH (type); | |
1073 | const CORE_ADDR addr | |
1074 | = value_as_long (value_allocate_space_in_inferior (length)); | |
1075 | write_memory (addr, value_contents (value), length); | |
1076 | struct value *val | |
1077 | = value_from_contents_and_address (type, value_contents (value), | |
1078 | addr); | |
1079 | return value_addr (val); | |
1080 | } | |
1081 | else | |
1082 | return value_addr (value); /* Program variables, e.g. arrays. */ | |
1083 | } | |
1084 | return value; | |
1085 | } | |
1086 | ||
1087 | /* See f-lang.h. */ | |
1088 | ||
1089 | struct type * | |
1090 | fortran_preserve_arg_pointer (struct value *arg, struct type *type) | |
1091 | { | |
78134374 | 1092 | if (value_type (arg)->code () == TYPE_CODE_PTR) |
aa3cfbda RB |
1093 | return value_type (arg); |
1094 | return type; | |
1095 | } |