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
,
168 /* Remove the modules separator :: from the default break list. */
171 f_word_break_characters (void)
179 retval
= xstrdup (default_word_break_characters ());
180 s
= strchr (retval
, ':');
183 char *last_char
= &s
[strlen (s
) - 1];
192 /* Consider the modules separator :: as a valid symbol name character
196 f_collect_symbol_completion_matches (completion_tracker
&tracker
,
197 complete_symbol_mode mode
,
198 symbol_name_match_type compare_name
,
199 const char *text
, const char *word
,
202 default_collect_symbol_completion_matches_break_on (tracker
, mode
,
204 text
, word
, ":", code
);
207 /* Special expression evaluation cases for Fortran. */
209 static struct value
*
210 evaluate_subexp_f (struct type
*expect_type
, struct expression
*exp
,
211 int *pos
, enum noside noside
)
213 struct value
*arg1
= NULL
, *arg2
= NULL
;
220 op
= exp
->elts
[pc
].opcode
;
226 return evaluate_subexp_standard (expect_type
, exp
, pos
, noside
);
229 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
230 if (noside
== EVAL_SKIP
)
231 return eval_skip_value (exp
);
232 type
= value_type (arg1
);
233 switch (type
->code ())
238 = fabs (target_float_to_host_double (value_contents (arg1
),
240 return value_from_host_double (type
, d
);
244 LONGEST l
= value_as_long (arg1
);
246 return value_from_longest (type
, l
);
249 error (_("ABS of type %s not supported"), TYPE_SAFE_NAME (type
));
252 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
253 arg2
= evaluate_subexp (value_type (arg1
), exp
, pos
, noside
);
254 if (noside
== EVAL_SKIP
)
255 return eval_skip_value (exp
);
256 type
= value_type (arg1
);
257 if (type
->code () != value_type (arg2
)->code ())
258 error (_("non-matching types for parameters to MOD ()"));
259 switch (type
->code ())
264 = target_float_to_host_double (value_contents (arg1
),
267 = target_float_to_host_double (value_contents (arg2
),
269 double d3
= fmod (d1
, d2
);
270 return value_from_host_double (type
, d3
);
274 LONGEST v1
= value_as_long (arg1
);
275 LONGEST v2
= value_as_long (arg2
);
277 error (_("calling MOD (N, 0) is undefined"));
278 LONGEST v3
= v1
- (v1
/ v2
) * v2
;
279 return value_from_longest (value_type (arg1
), v3
);
282 error (_("MOD of type %s not supported"), TYPE_SAFE_NAME (type
));
284 case UNOP_FORTRAN_CEILING
:
286 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
287 if (noside
== EVAL_SKIP
)
288 return eval_skip_value (exp
);
289 type
= value_type (arg1
);
290 if (type
->code () != TYPE_CODE_FLT
)
291 error (_("argument to CEILING must be of type float"));
293 = target_float_to_host_double (value_contents (arg1
),
296 return value_from_host_double (type
, val
);
299 case UNOP_FORTRAN_FLOOR
:
301 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
302 if (noside
== EVAL_SKIP
)
303 return eval_skip_value (exp
);
304 type
= value_type (arg1
);
305 if (type
->code () != TYPE_CODE_FLT
)
306 error (_("argument to FLOOR must be of type float"));
308 = target_float_to_host_double (value_contents (arg1
),
311 return value_from_host_double (type
, val
);
314 case BINOP_FORTRAN_MODULO
:
316 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
317 arg2
= evaluate_subexp (value_type (arg1
), exp
, pos
, noside
);
318 if (noside
== EVAL_SKIP
)
319 return eval_skip_value (exp
);
320 type
= value_type (arg1
);
321 if (type
->code () != value_type (arg2
)->code ())
322 error (_("non-matching types for parameters to MODULO ()"));
323 /* MODULO(A, P) = A - FLOOR (A / P) * P */
324 switch (type
->code ())
328 LONGEST a
= value_as_long (arg1
);
329 LONGEST p
= value_as_long (arg2
);
330 LONGEST result
= a
- (a
/ p
) * p
;
331 if (result
!= 0 && (a
< 0) != (p
< 0))
333 return value_from_longest (value_type (arg1
), result
);
338 = target_float_to_host_double (value_contents (arg1
),
341 = target_float_to_host_double (value_contents (arg2
),
343 double result
= fmod (a
, p
);
344 if (result
!= 0 && (a
< 0.0) != (p
< 0.0))
346 return value_from_host_double (type
, result
);
349 error (_("MODULO of type %s not supported"), TYPE_SAFE_NAME (type
));
352 case BINOP_FORTRAN_CMPLX
:
353 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
354 arg2
= evaluate_subexp (value_type (arg1
), exp
, pos
, noside
);
355 if (noside
== EVAL_SKIP
)
356 return eval_skip_value (exp
);
357 type
= builtin_f_type(exp
->gdbarch
)->builtin_complex_s16
;
358 return value_literal_complex (arg1
, arg2
, type
);
360 case UNOP_FORTRAN_KIND
:
361 arg1
= evaluate_subexp (NULL
, exp
, pos
, EVAL_AVOID_SIDE_EFFECTS
);
362 type
= value_type (arg1
);
364 switch (type
->code ())
366 case TYPE_CODE_STRUCT
:
367 case TYPE_CODE_UNION
:
368 case TYPE_CODE_MODULE
:
370 error (_("argument to kind must be an intrinsic type"));
373 if (!TYPE_TARGET_TYPE (type
))
374 return value_from_longest (builtin_type (exp
->gdbarch
)->builtin_int
,
376 return value_from_longest (builtin_type (exp
->gdbarch
)->builtin_int
,
377 TYPE_LENGTH (TYPE_TARGET_TYPE (type
)));
380 /* Should be unreachable. */
384 /* Return true if TYPE is a string. */
387 f_is_string_type_p (struct type
*type
)
389 type
= check_typedef (type
);
390 return (type
->code () == TYPE_CODE_STRING
391 || (type
->code () == TYPE_CODE_ARRAY
392 && TYPE_TARGET_TYPE (type
)->code () == TYPE_CODE_CHAR
));
395 /* Special expression lengths for Fortran. */
398 operator_length_f (const struct expression
*exp
, int pc
, int *oplenp
,
404 switch (exp
->elts
[pc
- 1].opcode
)
407 operator_length_standard (exp
, pc
, oplenp
, argsp
);
410 case UNOP_FORTRAN_KIND
:
411 case UNOP_FORTRAN_FLOOR
:
412 case UNOP_FORTRAN_CEILING
:
417 case BINOP_FORTRAN_CMPLX
:
418 case BINOP_FORTRAN_MODULO
:
428 /* Helper for PRINT_SUBEXP_F. Arguments are as for PRINT_SUBEXP_F, except
429 the extra argument NAME which is the text that should be printed as the
430 name of this operation. */
433 print_unop_subexp_f (struct expression
*exp
, int *pos
,
434 struct ui_file
*stream
, enum precedence prec
,
438 fprintf_filtered (stream
, "%s(", name
);
439 print_subexp (exp
, pos
, stream
, PREC_SUFFIX
);
440 fputs_filtered (")", stream
);
443 /* Helper for PRINT_SUBEXP_F. Arguments are as for PRINT_SUBEXP_F, except
444 the extra argument NAME which is the text that should be printed as the
445 name of this operation. */
448 print_binop_subexp_f (struct expression
*exp
, int *pos
,
449 struct ui_file
*stream
, enum precedence prec
,
453 fprintf_filtered (stream
, "%s(", name
);
454 print_subexp (exp
, pos
, stream
, PREC_SUFFIX
);
455 fputs_filtered (",", stream
);
456 print_subexp (exp
, pos
, stream
, PREC_SUFFIX
);
457 fputs_filtered (")", stream
);
460 /* Special expression printing for Fortran. */
463 print_subexp_f (struct expression
*exp
, int *pos
,
464 struct ui_file
*stream
, enum precedence prec
)
467 enum exp_opcode op
= exp
->elts
[pc
].opcode
;
472 print_subexp_standard (exp
, pos
, stream
, prec
);
475 case UNOP_FORTRAN_KIND
:
476 print_unop_subexp_f (exp
, pos
, stream
, prec
, "KIND");
479 case UNOP_FORTRAN_FLOOR
:
480 print_unop_subexp_f (exp
, pos
, stream
, prec
, "FLOOR");
483 case UNOP_FORTRAN_CEILING
:
484 print_unop_subexp_f (exp
, pos
, stream
, prec
, "CEILING");
487 case BINOP_FORTRAN_CMPLX
:
488 print_binop_subexp_f (exp
, pos
, stream
, prec
, "CMPLX");
491 case BINOP_FORTRAN_MODULO
:
492 print_binop_subexp_f (exp
, pos
, stream
, prec
, "MODULO");
497 /* Special expression names for Fortran. */
500 op_name_f (enum exp_opcode opcode
)
505 return op_name_standard (opcode
);
510 #include "fortran-operator.def"
515 /* Special expression dumping for Fortran. */
518 dump_subexp_body_f (struct expression
*exp
,
519 struct ui_file
*stream
, int elt
)
521 int opcode
= exp
->elts
[elt
].opcode
;
527 return dump_subexp_body_standard (exp
, stream
, elt
);
529 case UNOP_FORTRAN_KIND
:
530 case UNOP_FORTRAN_FLOOR
:
531 case UNOP_FORTRAN_CEILING
:
532 case BINOP_FORTRAN_CMPLX
:
533 case BINOP_FORTRAN_MODULO
:
534 operator_length_f (exp
, (elt
+ 1), &oplen
, &nargs
);
539 for (i
= 0; i
< nargs
; i
+= 1)
540 elt
= dump_subexp (exp
, stream
, elt
);
545 /* Special expression checking for Fortran. */
548 operator_check_f (struct expression
*exp
, int pos
,
549 int (*objfile_func
) (struct objfile
*objfile
,
553 const union exp_element
*const elts
= exp
->elts
;
555 switch (elts
[pos
].opcode
)
557 case UNOP_FORTRAN_KIND
:
558 case UNOP_FORTRAN_FLOOR
:
559 case UNOP_FORTRAN_CEILING
:
560 case BINOP_FORTRAN_CMPLX
:
561 case BINOP_FORTRAN_MODULO
:
562 /* Any references to objfiles are held in the arguments to this
563 expression, not within the expression itself, so no additional
564 checking is required here, the outer expression iteration code
565 will take care of checking each argument. */
569 return operator_check_standard (exp
, pos
, objfile_func
, data
);
575 static const char *f_extensions
[] =
577 ".f", ".F", ".for", ".FOR", ".ftn", ".FTN", ".fpp", ".FPP",
578 ".f90", ".F90", ".f95", ".F95", ".f03", ".F03", ".f08", ".F08",
582 /* Expression processing for Fortran. */
583 static const struct exp_descriptor exp_descriptor_f
=
593 /* Constant data that describes the Fortran language. */
595 extern const struct language_data f_language_data
=
606 f_parse
, /* parser */
608 f_printchar
, /* Print character constant */
609 f_printstr
, /* function to print string constant */
610 f_emit_char
, /* Function to print a single character */
611 f_print_typedef
, /* Print a typedef using appropriate syntax */
612 f_value_print_innner
, /* la_value_print_inner */
613 c_value_print
, /* FIXME */
614 NULL
, /* name_of_this */
615 false, /* la_store_sym_names_in_linkage_form_p */
616 cp_lookup_symbol_nonlocal
, /* lookup_symbol_nonlocal */
617 NULL
, /* Language specific
618 class_name_from_physname */
619 f_op_print_tab
, /* expression operators for printing */
620 0, /* arrays are first-class (not c-style) */
621 1, /* String lower bound */
622 f_word_break_characters
,
623 f_collect_symbol_completion_matches
,
624 c_watch_location_expression
,
625 cp_get_symbol_name_matcher
, /* la_get_symbol_name_matcher */
629 "(...)" /* la_struct_too_deep_ellipsis */
632 /* Class representing the Fortran language. */
634 class f_language
: public language_defn
638 : language_defn (language_fortran
, f_language_data
)
641 /* See language.h. */
642 void language_arch_info (struct gdbarch
*gdbarch
,
643 struct language_arch_info
*lai
) const override
645 const struct builtin_f_type
*builtin
= builtin_f_type (gdbarch
);
647 lai
->string_char_type
= builtin
->builtin_character
;
648 lai
->primitive_type_vector
649 = GDBARCH_OBSTACK_CALLOC (gdbarch
, nr_f_primitive_types
+ 1,
652 lai
->primitive_type_vector
[f_primitive_type_character
]
653 = builtin
->builtin_character
;
654 lai
->primitive_type_vector
[f_primitive_type_logical
]
655 = builtin
->builtin_logical
;
656 lai
->primitive_type_vector
[f_primitive_type_logical_s1
]
657 = builtin
->builtin_logical_s1
;
658 lai
->primitive_type_vector
[f_primitive_type_logical_s2
]
659 = builtin
->builtin_logical_s2
;
660 lai
->primitive_type_vector
[f_primitive_type_logical_s8
]
661 = builtin
->builtin_logical_s8
;
662 lai
->primitive_type_vector
[f_primitive_type_real
]
663 = builtin
->builtin_real
;
664 lai
->primitive_type_vector
[f_primitive_type_real_s8
]
665 = builtin
->builtin_real_s8
;
666 lai
->primitive_type_vector
[f_primitive_type_real_s16
]
667 = builtin
->builtin_real_s16
;
668 lai
->primitive_type_vector
[f_primitive_type_complex_s8
]
669 = builtin
->builtin_complex_s8
;
670 lai
->primitive_type_vector
[f_primitive_type_complex_s16
]
671 = builtin
->builtin_complex_s16
;
672 lai
->primitive_type_vector
[f_primitive_type_void
]
673 = builtin
->builtin_void
;
675 lai
->bool_type_symbol
= "logical";
676 lai
->bool_type_default
= builtin
->builtin_logical_s2
;
679 /* See language.h. */
680 unsigned int search_name_hash (const char *name
) const override
682 return cp_search_name_hash (name
);
685 /* See language.h. */
687 char *demangle (const char *mangled
, int options
) const override
689 /* We could support demangling here to provide module namespaces
690 also for inferiors with only minimal symbol table (ELF symbols).
691 Just the mangling standard is not standardized across compilers
692 and there is no DW_AT_producer available for inferiors with only
693 the ELF symbols to check the mangling kind. */
697 /* See language.h. */
699 void print_type (struct type
*type
, const char *varstring
,
700 struct ui_file
*stream
, int show
, int level
,
701 const struct type_print_options
*flags
) const override
703 f_print_type (type
, varstring
, stream
, show
, level
, flags
);
707 /* Single instance of the Fortran language class. */
709 static f_language f_language_defn
;
712 build_fortran_types (struct gdbarch
*gdbarch
)
714 struct builtin_f_type
*builtin_f_type
715 = GDBARCH_OBSTACK_ZALLOC (gdbarch
, struct builtin_f_type
);
717 builtin_f_type
->builtin_void
718 = arch_type (gdbarch
, TYPE_CODE_VOID
, TARGET_CHAR_BIT
, "void");
720 builtin_f_type
->builtin_character
721 = arch_type (gdbarch
, TYPE_CODE_CHAR
, TARGET_CHAR_BIT
, "character");
723 builtin_f_type
->builtin_logical_s1
724 = arch_boolean_type (gdbarch
, TARGET_CHAR_BIT
, 1, "logical*1");
726 builtin_f_type
->builtin_integer_s2
727 = arch_integer_type (gdbarch
, gdbarch_short_bit (gdbarch
), 0,
730 builtin_f_type
->builtin_integer_s8
731 = arch_integer_type (gdbarch
, gdbarch_long_long_bit (gdbarch
), 0,
734 builtin_f_type
->builtin_logical_s2
735 = arch_boolean_type (gdbarch
, gdbarch_short_bit (gdbarch
), 1,
738 builtin_f_type
->builtin_logical_s8
739 = arch_boolean_type (gdbarch
, gdbarch_long_long_bit (gdbarch
), 1,
742 builtin_f_type
->builtin_integer
743 = arch_integer_type (gdbarch
, gdbarch_int_bit (gdbarch
), 0,
746 builtin_f_type
->builtin_logical
747 = arch_boolean_type (gdbarch
, gdbarch_int_bit (gdbarch
), 1,
750 builtin_f_type
->builtin_real
751 = arch_float_type (gdbarch
, gdbarch_float_bit (gdbarch
),
752 "real", gdbarch_float_format (gdbarch
));
753 builtin_f_type
->builtin_real_s8
754 = arch_float_type (gdbarch
, gdbarch_double_bit (gdbarch
),
755 "real*8", gdbarch_double_format (gdbarch
));
756 auto fmt
= gdbarch_floatformat_for_type (gdbarch
, "real(kind=16)", 128);
758 builtin_f_type
->builtin_real_s16
759 = arch_float_type (gdbarch
, 128, "real*16", fmt
);
760 else if (gdbarch_long_double_bit (gdbarch
) == 128)
761 builtin_f_type
->builtin_real_s16
762 = arch_float_type (gdbarch
, gdbarch_long_double_bit (gdbarch
),
763 "real*16", gdbarch_long_double_format (gdbarch
));
765 builtin_f_type
->builtin_real_s16
766 = arch_type (gdbarch
, TYPE_CODE_ERROR
, 128, "real*16");
768 builtin_f_type
->builtin_complex_s8
769 = init_complex_type ("complex*8", builtin_f_type
->builtin_real
);
770 builtin_f_type
->builtin_complex_s16
771 = init_complex_type ("complex*16", builtin_f_type
->builtin_real_s8
);
773 if (builtin_f_type
->builtin_real_s16
->code () == TYPE_CODE_ERROR
)
774 builtin_f_type
->builtin_complex_s32
775 = arch_type (gdbarch
, TYPE_CODE_ERROR
, 256, "complex*32");
777 builtin_f_type
->builtin_complex_s32
778 = init_complex_type ("complex*32", builtin_f_type
->builtin_real_s16
);
780 return builtin_f_type
;
783 static struct gdbarch_data
*f_type_data
;
785 const struct builtin_f_type
*
786 builtin_f_type (struct gdbarch
*gdbarch
)
788 return (const struct builtin_f_type
*) gdbarch_data (gdbarch
, f_type_data
);
791 void _initialize_f_language ();
793 _initialize_f_language ()
795 f_type_data
= gdbarch_data_register_post_init (build_fortran_types
);
801 fortran_argument_convert (struct value
*value
, bool is_artificial
)
805 /* If the value is not in the inferior e.g. registers values,
806 convenience variables and user input. */
807 if (VALUE_LVAL (value
) != lval_memory
)
809 struct type
*type
= value_type (value
);
810 const int length
= TYPE_LENGTH (type
);
812 = value_as_long (value_allocate_space_in_inferior (length
));
813 write_memory (addr
, value_contents (value
), length
);
815 = value_from_contents_and_address (type
, value_contents (value
),
817 return value_addr (val
);
820 return value_addr (value
); /* Program variables, e.g. arrays. */
828 fortran_preserve_arg_pointer (struct value
*arg
, struct type
*type
)
830 if (value_type (arg
)->code () == TYPE_CODE_PTR
)
831 return value_type (arg
);