1 /* Fortran language support routines for GDB, the GNU debugger.
3 Copyright (C) 1993-2020 Free Software Foundation, Inc.
5 Contributed by Motorola. Adapted from the C parser by Farooq Butt
6 (fmbutt@engage.sps.mot.com).
8 This file is part of GDB.
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.
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.
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/>. */
26 #include "expression.h"
27 #include "parser-defs.h"
34 #include "cp-support.h"
37 #include "target-float.h"
44 static void f_printchar (int c
, struct type
*type
, struct ui_file
* stream
);
45 static void f_emit_char (int c
, struct type
*type
,
46 struct ui_file
* stream
, int quoter
);
48 /* Return the encoding that should be used for the character type
52 f_get_encoding (struct type
*type
)
56 switch (TYPE_LENGTH (type
))
59 encoding
= target_charset (get_type_arch (type
));
62 if (type_byte_order (type
) == BFD_ENDIAN_BIG
)
63 encoding
= "UTF-32BE";
65 encoding
= "UTF-32LE";
69 error (_("unrecognized character type"));
75 /* Print the character C on STREAM as part of the contents of a literal
76 string whose delimiter is QUOTER. Note that that format for printing
77 characters and strings is language specific.
78 FIXME: This is a copy of the same function from c-exp.y. It should
79 be replaced with a true F77 version. */
82 f_emit_char (int c
, struct type
*type
, struct ui_file
*stream
, int quoter
)
84 const char *encoding
= f_get_encoding (type
);
86 generic_emit_char (c
, type
, stream
, quoter
, encoding
);
89 /* Implementation of la_printchar. */
92 f_printchar (int c
, struct type
*type
, struct ui_file
*stream
)
94 fputs_filtered ("'", stream
);
95 LA_EMIT_CHAR (c
, type
, stream
, '\'');
96 fputs_filtered ("'", stream
);
99 /* Print the character string STRING, printing at most LENGTH characters.
100 Printing stops early if the number hits print_max; repeat counts
101 are printed as appropriate. Print ellipses at the end if we
102 had to stop before printing LENGTH characters, or if FORCE_ELLIPSES.
103 FIXME: This is a copy of the same function from c-exp.y. It should
104 be replaced with a true F77 version. */
107 f_printstr (struct ui_file
*stream
, struct type
*type
, const gdb_byte
*string
,
108 unsigned int length
, const char *encoding
, int force_ellipses
,
109 const struct value_print_options
*options
)
111 const char *type_encoding
= f_get_encoding (type
);
113 if (TYPE_LENGTH (type
) == 4)
114 fputs_filtered ("4_", stream
);
116 if (!encoding
|| !*encoding
)
117 encoding
= type_encoding
;
119 generic_printstr (stream
, type
, string
, length
, encoding
,
120 force_ellipses
, '\'', 0, options
);
124 /* Table of operators and their precedences for printing expressions. */
126 static const struct op_print f_op_print_tab
[] =
128 {"+", BINOP_ADD
, PREC_ADD
, 0},
129 {"+", UNOP_PLUS
, PREC_PREFIX
, 0},
130 {"-", BINOP_SUB
, PREC_ADD
, 0},
131 {"-", UNOP_NEG
, PREC_PREFIX
, 0},
132 {"*", BINOP_MUL
, PREC_MUL
, 0},
133 {"/", BINOP_DIV
, PREC_MUL
, 0},
134 {"DIV", BINOP_INTDIV
, PREC_MUL
, 0},
135 {"MOD", BINOP_REM
, PREC_MUL
, 0},
136 {"=", BINOP_ASSIGN
, PREC_ASSIGN
, 1},
137 {".OR.", BINOP_LOGICAL_OR
, PREC_LOGICAL_OR
, 0},
138 {".AND.", BINOP_LOGICAL_AND
, PREC_LOGICAL_AND
, 0},
139 {".NOT.", UNOP_LOGICAL_NOT
, PREC_PREFIX
, 0},
140 {".EQ.", BINOP_EQUAL
, PREC_EQUAL
, 0},
141 {".NE.", BINOP_NOTEQUAL
, PREC_EQUAL
, 0},
142 {".LE.", BINOP_LEQ
, PREC_ORDER
, 0},
143 {".GE.", BINOP_GEQ
, PREC_ORDER
, 0},
144 {".GT.", BINOP_GTR
, PREC_ORDER
, 0},
145 {".LT.", BINOP_LESS
, PREC_ORDER
, 0},
146 {"**", UNOP_IND
, PREC_PREFIX
, 0},
147 {"@", BINOP_REPEAT
, PREC_REPEAT
, 0},
148 {NULL
, OP_NULL
, PREC_REPEAT
, 0}
151 enum f_primitive_types
{
152 f_primitive_type_character
,
153 f_primitive_type_logical
,
154 f_primitive_type_logical_s1
,
155 f_primitive_type_logical_s2
,
156 f_primitive_type_logical_s8
,
157 f_primitive_type_integer
,
158 f_primitive_type_integer_s2
,
159 f_primitive_type_real
,
160 f_primitive_type_real_s8
,
161 f_primitive_type_real_s16
,
162 f_primitive_type_complex_s8
,
163 f_primitive_type_complex_s16
,
164 f_primitive_type_void
,
169 f_language_arch_info (struct gdbarch
*gdbarch
,
170 struct language_arch_info
*lai
)
172 const struct builtin_f_type
*builtin
= builtin_f_type (gdbarch
);
174 lai
->string_char_type
= builtin
->builtin_character
;
175 lai
->primitive_type_vector
176 = GDBARCH_OBSTACK_CALLOC (gdbarch
, nr_f_primitive_types
+ 1,
179 lai
->primitive_type_vector
[f_primitive_type_character
]
180 = builtin
->builtin_character
;
181 lai
->primitive_type_vector
[f_primitive_type_logical
]
182 = builtin
->builtin_logical
;
183 lai
->primitive_type_vector
[f_primitive_type_logical_s1
]
184 = builtin
->builtin_logical_s1
;
185 lai
->primitive_type_vector
[f_primitive_type_logical_s2
]
186 = builtin
->builtin_logical_s2
;
187 lai
->primitive_type_vector
[f_primitive_type_logical_s8
]
188 = builtin
->builtin_logical_s8
;
189 lai
->primitive_type_vector
[f_primitive_type_real
]
190 = builtin
->builtin_real
;
191 lai
->primitive_type_vector
[f_primitive_type_real_s8
]
192 = builtin
->builtin_real_s8
;
193 lai
->primitive_type_vector
[f_primitive_type_real_s16
]
194 = builtin
->builtin_real_s16
;
195 lai
->primitive_type_vector
[f_primitive_type_complex_s8
]
196 = builtin
->builtin_complex_s8
;
197 lai
->primitive_type_vector
[f_primitive_type_complex_s16
]
198 = builtin
->builtin_complex_s16
;
199 lai
->primitive_type_vector
[f_primitive_type_void
]
200 = builtin
->builtin_void
;
202 lai
->bool_type_symbol
= "logical";
203 lai
->bool_type_default
= builtin
->builtin_logical_s2
;
206 /* Remove the modules separator :: from the default break list. */
209 f_word_break_characters (void)
217 retval
= xstrdup (default_word_break_characters ());
218 s
= strchr (retval
, ':');
221 char *last_char
= &s
[strlen (s
) - 1];
230 /* Consider the modules separator :: as a valid symbol name character
234 f_collect_symbol_completion_matches (completion_tracker
&tracker
,
235 complete_symbol_mode mode
,
236 symbol_name_match_type compare_name
,
237 const char *text
, const char *word
,
240 default_collect_symbol_completion_matches_break_on (tracker
, mode
,
242 text
, word
, ":", code
);
245 /* Special expression evaluation cases for Fortran. */
247 static struct value
*
248 evaluate_subexp_f (struct type
*expect_type
, struct expression
*exp
,
249 int *pos
, enum noside noside
)
251 struct value
*arg1
= NULL
, *arg2
= NULL
;
258 op
= exp
->elts
[pc
].opcode
;
264 return evaluate_subexp_standard (expect_type
, exp
, pos
, noside
);
267 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
268 if (noside
== EVAL_SKIP
)
269 return eval_skip_value (exp
);
270 type
= value_type (arg1
);
271 switch (type
->code ())
276 = fabs (target_float_to_host_double (value_contents (arg1
),
278 return value_from_host_double (type
, d
);
282 LONGEST l
= value_as_long (arg1
);
284 return value_from_longest (type
, l
);
287 error (_("ABS of type %s not supported"), TYPE_SAFE_NAME (type
));
290 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
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
);
295 if (type
->code () != value_type (arg2
)->code ())
296 error (_("non-matching types for parameters to MOD ()"));
297 switch (type
->code ())
302 = target_float_to_host_double (value_contents (arg1
),
305 = target_float_to_host_double (value_contents (arg2
),
307 double d3
= fmod (d1
, d2
);
308 return value_from_host_double (type
, d3
);
312 LONGEST v1
= value_as_long (arg1
);
313 LONGEST v2
= value_as_long (arg2
);
315 error (_("calling MOD (N, 0) is undefined"));
316 LONGEST v3
= v1
- (v1
/ v2
) * v2
;
317 return value_from_longest (value_type (arg1
), v3
);
320 error (_("MOD of type %s not supported"), TYPE_SAFE_NAME (type
));
322 case UNOP_FORTRAN_CEILING
:
324 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
325 if (noside
== EVAL_SKIP
)
326 return eval_skip_value (exp
);
327 type
= value_type (arg1
);
328 if (type
->code () != TYPE_CODE_FLT
)
329 error (_("argument to CEILING must be of type float"));
331 = target_float_to_host_double (value_contents (arg1
),
334 return value_from_host_double (type
, val
);
337 case UNOP_FORTRAN_FLOOR
:
339 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
340 if (noside
== EVAL_SKIP
)
341 return eval_skip_value (exp
);
342 type
= value_type (arg1
);
343 if (type
->code () != TYPE_CODE_FLT
)
344 error (_("argument to FLOOR must be of type float"));
346 = target_float_to_host_double (value_contents (arg1
),
349 return value_from_host_double (type
, val
);
352 case BINOP_FORTRAN_MODULO
:
354 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
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
);
359 if (type
->code () != value_type (arg2
)->code ())
360 error (_("non-matching types for parameters to MODULO ()"));
361 /* MODULO(A, P) = A - FLOOR (A / P) * P */
362 switch (type
->code ())
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))
371 return value_from_longest (value_type (arg1
), result
);
376 = target_float_to_host_double (value_contents (arg1
),
379 = target_float_to_host_double (value_contents (arg2
),
381 double result
= fmod (a
, p
);
382 if (result
!= 0 && (a
< 0.0) != (p
< 0.0))
384 return value_from_host_double (type
, result
);
387 error (_("MODULO of type %s not supported"), TYPE_SAFE_NAME (type
));
390 case BINOP_FORTRAN_CMPLX
:
391 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
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
);
398 case UNOP_FORTRAN_KIND
:
399 arg1
= evaluate_subexp (NULL
, exp
, pos
, EVAL_AVOID_SIDE_EFFECTS
);
400 type
= value_type (arg1
);
402 switch (type
->code ())
404 case TYPE_CODE_STRUCT
:
405 case TYPE_CODE_UNION
:
406 case TYPE_CODE_MODULE
:
408 error (_("argument to kind must be an intrinsic type"));
411 if (!TYPE_TARGET_TYPE (type
))
412 return value_from_longest (builtin_type (exp
->gdbarch
)->builtin_int
,
414 return value_from_longest (builtin_type (exp
->gdbarch
)->builtin_int
,
415 TYPE_LENGTH (TYPE_TARGET_TYPE (type
)));
418 /* Should be unreachable. */
422 /* Return true if TYPE is a string. */
425 f_is_string_type_p (struct type
*type
)
427 type
= check_typedef (type
);
428 return (type
->code () == TYPE_CODE_STRING
429 || (type
->code () == TYPE_CODE_ARRAY
430 && TYPE_TARGET_TYPE (type
)->code () == TYPE_CODE_CHAR
));
433 /* Special expression lengths for Fortran. */
436 operator_length_f (const struct expression
*exp
, int pc
, int *oplenp
,
442 switch (exp
->elts
[pc
- 1].opcode
)
445 operator_length_standard (exp
, pc
, oplenp
, argsp
);
448 case UNOP_FORTRAN_KIND
:
449 case UNOP_FORTRAN_FLOOR
:
450 case UNOP_FORTRAN_CEILING
:
455 case BINOP_FORTRAN_CMPLX
:
456 case BINOP_FORTRAN_MODULO
:
466 /* Helper for PRINT_SUBEXP_F. Arguments are as for PRINT_SUBEXP_F, except
467 the extra argument NAME which is the text that should be printed as the
468 name of this operation. */
471 print_unop_subexp_f (struct expression
*exp
, int *pos
,
472 struct ui_file
*stream
, enum precedence prec
,
476 fprintf_filtered (stream
, "%s(", name
);
477 print_subexp (exp
, pos
, stream
, PREC_SUFFIX
);
478 fputs_filtered (")", stream
);
481 /* Helper for PRINT_SUBEXP_F. Arguments are as for PRINT_SUBEXP_F, except
482 the extra argument NAME which is the text that should be printed as the
483 name of this operation. */
486 print_binop_subexp_f (struct expression
*exp
, int *pos
,
487 struct ui_file
*stream
, enum precedence prec
,
491 fprintf_filtered (stream
, "%s(", name
);
492 print_subexp (exp
, pos
, stream
, PREC_SUFFIX
);
493 fputs_filtered (",", stream
);
494 print_subexp (exp
, pos
, stream
, PREC_SUFFIX
);
495 fputs_filtered (")", stream
);
498 /* Special expression printing for Fortran. */
501 print_subexp_f (struct expression
*exp
, int *pos
,
502 struct ui_file
*stream
, enum precedence prec
)
505 enum exp_opcode op
= exp
->elts
[pc
].opcode
;
510 print_subexp_standard (exp
, pos
, stream
, prec
);
513 case UNOP_FORTRAN_KIND
:
514 print_unop_subexp_f (exp
, pos
, stream
, prec
, "KIND");
517 case UNOP_FORTRAN_FLOOR
:
518 print_unop_subexp_f (exp
, pos
, stream
, prec
, "FLOOR");
521 case UNOP_FORTRAN_CEILING
:
522 print_unop_subexp_f (exp
, pos
, stream
, prec
, "CEILING");
525 case BINOP_FORTRAN_CMPLX
:
526 print_binop_subexp_f (exp
, pos
, stream
, prec
, "CMPLX");
529 case BINOP_FORTRAN_MODULO
:
530 print_binop_subexp_f (exp
, pos
, stream
, prec
, "MODULO");
535 /* Special expression names for Fortran. */
538 op_name_f (enum exp_opcode opcode
)
543 return op_name_standard (opcode
);
548 #include "fortran-operator.def"
553 /* Special expression dumping for Fortran. */
556 dump_subexp_body_f (struct expression
*exp
,
557 struct ui_file
*stream
, int elt
)
559 int opcode
= exp
->elts
[elt
].opcode
;
565 return dump_subexp_body_standard (exp
, stream
, elt
);
567 case UNOP_FORTRAN_KIND
:
568 case UNOP_FORTRAN_FLOOR
:
569 case UNOP_FORTRAN_CEILING
:
570 case BINOP_FORTRAN_CMPLX
:
571 case BINOP_FORTRAN_MODULO
:
572 operator_length_f (exp
, (elt
+ 1), &oplen
, &nargs
);
577 for (i
= 0; i
< nargs
; i
+= 1)
578 elt
= dump_subexp (exp
, stream
, elt
);
583 /* Special expression checking for Fortran. */
586 operator_check_f (struct expression
*exp
, int pos
,
587 int (*objfile_func
) (struct objfile
*objfile
,
591 const union exp_element
*const elts
= exp
->elts
;
593 switch (elts
[pos
].opcode
)
595 case UNOP_FORTRAN_KIND
:
596 case UNOP_FORTRAN_FLOOR
:
597 case UNOP_FORTRAN_CEILING
:
598 case BINOP_FORTRAN_CMPLX
:
599 case BINOP_FORTRAN_MODULO
:
600 /* Any references to objfiles are held in the arguments to this
601 expression, not within the expression itself, so no additional
602 checking is required here, the outer expression iteration code
603 will take care of checking each argument. */
607 return operator_check_standard (exp
, pos
, objfile_func
, data
);
613 static const char *f_extensions
[] =
615 ".f", ".F", ".for", ".FOR", ".ftn", ".FTN", ".fpp", ".FPP",
616 ".f90", ".F90", ".f95", ".F95", ".f03", ".F03", ".f08", ".F08",
620 /* Expression processing for Fortran. */
621 static const struct exp_descriptor exp_descriptor_f
=
631 /* Constant data that describes the Fortran language. */
633 extern const struct language_data f_language_data
=
644 f_parse
, /* parser */
646 f_printchar
, /* Print character constant */
647 f_printstr
, /* function to print string constant */
648 f_emit_char
, /* Function to print a single character */
649 f_print_type
, /* Print a type using appropriate syntax */
650 f_print_typedef
, /* Print a typedef using appropriate syntax */
651 f_value_print_innner
, /* la_value_print_inner */
652 c_value_print
, /* FIXME */
653 default_read_var_value
, /* la_read_var_value */
654 NULL
, /* Language specific skip_trampoline */
655 NULL
, /* name_of_this */
656 false, /* la_store_sym_names_in_linkage_form_p */
657 cp_lookup_symbol_nonlocal
, /* lookup_symbol_nonlocal */
658 basic_lookup_transparent_type
,/* lookup_transparent_type */
660 /* We could support demangling here to provide module namespaces
661 also for inferiors with only minimal symbol table (ELF symbols).
662 Just the mangling standard is not standardized across compilers
663 and there is no DW_AT_producer available for inferiors with only
664 the ELF symbols to check the mangling kind. */
665 NULL
, /* Language specific symbol demangler */
667 NULL
, /* Language specific
668 class_name_from_physname */
669 f_op_print_tab
, /* expression operators for printing */
670 0, /* arrays are first-class (not c-style) */
671 1, /* String lower bound */
672 f_word_break_characters
,
673 f_collect_symbol_completion_matches
,
674 f_language_arch_info
,
675 default_pass_by_reference
,
676 c_watch_location_expression
,
677 cp_get_symbol_name_matcher
, /* la_get_symbol_name_matcher */
678 iterate_over_symbols
,
684 "(...)" /* la_struct_too_deep_ellipsis */
687 /* Class representing the Fortran language. */
689 class f_language
: public language_defn
693 : language_defn (language_fortran
, f_language_data
)
697 /* Single instance of the Fortran language class. */
699 static f_language f_language_defn
;
702 build_fortran_types (struct gdbarch
*gdbarch
)
704 struct builtin_f_type
*builtin_f_type
705 = GDBARCH_OBSTACK_ZALLOC (gdbarch
, struct builtin_f_type
);
707 builtin_f_type
->builtin_void
708 = arch_type (gdbarch
, TYPE_CODE_VOID
, TARGET_CHAR_BIT
, "void");
710 builtin_f_type
->builtin_character
711 = arch_type (gdbarch
, TYPE_CODE_CHAR
, TARGET_CHAR_BIT
, "character");
713 builtin_f_type
->builtin_logical_s1
714 = arch_boolean_type (gdbarch
, TARGET_CHAR_BIT
, 1, "logical*1");
716 builtin_f_type
->builtin_integer_s2
717 = arch_integer_type (gdbarch
, gdbarch_short_bit (gdbarch
), 0,
720 builtin_f_type
->builtin_integer_s8
721 = arch_integer_type (gdbarch
, gdbarch_long_long_bit (gdbarch
), 0,
724 builtin_f_type
->builtin_logical_s2
725 = arch_boolean_type (gdbarch
, gdbarch_short_bit (gdbarch
), 1,
728 builtin_f_type
->builtin_logical_s8
729 = arch_boolean_type (gdbarch
, gdbarch_long_long_bit (gdbarch
), 1,
732 builtin_f_type
->builtin_integer
733 = arch_integer_type (gdbarch
, gdbarch_int_bit (gdbarch
), 0,
736 builtin_f_type
->builtin_logical
737 = arch_boolean_type (gdbarch
, gdbarch_int_bit (gdbarch
), 1,
740 builtin_f_type
->builtin_real
741 = arch_float_type (gdbarch
, gdbarch_float_bit (gdbarch
),
742 "real", gdbarch_float_format (gdbarch
));
743 builtin_f_type
->builtin_real_s8
744 = arch_float_type (gdbarch
, gdbarch_double_bit (gdbarch
),
745 "real*8", gdbarch_double_format (gdbarch
));
746 auto fmt
= gdbarch_floatformat_for_type (gdbarch
, "real(kind=16)", 128);
748 builtin_f_type
->builtin_real_s16
749 = arch_float_type (gdbarch
, 128, "real*16", fmt
);
750 else if (gdbarch_long_double_bit (gdbarch
) == 128)
751 builtin_f_type
->builtin_real_s16
752 = arch_float_type (gdbarch
, gdbarch_long_double_bit (gdbarch
),
753 "real*16", gdbarch_long_double_format (gdbarch
));
755 builtin_f_type
->builtin_real_s16
756 = arch_type (gdbarch
, TYPE_CODE_ERROR
, 128, "real*16");
758 builtin_f_type
->builtin_complex_s8
759 = init_complex_type ("complex*8", builtin_f_type
->builtin_real
);
760 builtin_f_type
->builtin_complex_s16
761 = init_complex_type ("complex*16", builtin_f_type
->builtin_real_s8
);
763 if (builtin_f_type
->builtin_real_s16
->code () == TYPE_CODE_ERROR
)
764 builtin_f_type
->builtin_complex_s32
765 = arch_type (gdbarch
, TYPE_CODE_ERROR
, 256, "complex*32");
767 builtin_f_type
->builtin_complex_s32
768 = init_complex_type ("complex*32", builtin_f_type
->builtin_real_s16
);
770 return builtin_f_type
;
773 static struct gdbarch_data
*f_type_data
;
775 const struct builtin_f_type
*
776 builtin_f_type (struct gdbarch
*gdbarch
)
778 return (const struct builtin_f_type
*) gdbarch_data (gdbarch
, f_type_data
);
781 void _initialize_f_language ();
783 _initialize_f_language ()
785 f_type_data
= gdbarch_data_register_post_init (build_fortran_types
);
791 fortran_argument_convert (struct value
*value
, bool is_artificial
)
795 /* If the value is not in the inferior e.g. registers values,
796 convenience variables and user input. */
797 if (VALUE_LVAL (value
) != lval_memory
)
799 struct type
*type
= value_type (value
);
800 const int length
= TYPE_LENGTH (type
);
802 = value_as_long (value_allocate_space_in_inferior (length
));
803 write_memory (addr
, value_contents (value
), length
);
805 = value_from_contents_and_address (type
, value_contents (value
),
807 return value_addr (val
);
810 return value_addr (value
); /* Program variables, e.g. arrays. */
818 fortran_preserve_arg_pointer (struct value
*arg
, struct type
*type
)
820 if (value_type (arg
)->code () == TYPE_CODE_PTR
)
821 return value_type (arg
);