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 /* Return the encoding that should be used for the character type
48 f_get_encoding (struct type
*type
)
52 switch (TYPE_LENGTH (type
))
55 encoding
= target_charset (get_type_arch (type
));
58 if (type_byte_order (type
) == BFD_ENDIAN_BIG
)
59 encoding
= "UTF-32BE";
61 encoding
= "UTF-32LE";
65 error (_("unrecognized character type"));
73 /* Table of operators and their precedences for printing expressions. */
75 static const struct op_print f_op_print_tab
[] =
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},
97 {NULL
, OP_NULL
, PREC_REPEAT
, 0}
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
,
105 f_primitive_type_logical_s8
,
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
,
117 /* Special expression evaluation cases for Fortran. */
119 static struct value
*
120 evaluate_subexp_f (struct type
*expect_type
, struct expression
*exp
,
121 int *pos
, enum noside noside
)
123 struct value
*arg1
= NULL
, *arg2
= NULL
;
130 op
= exp
->elts
[pc
].opcode
;
136 return evaluate_subexp_standard (expect_type
, exp
, pos
, noside
);
139 arg1
= evaluate_subexp (nullptr, exp
, pos
, noside
);
140 if (noside
== EVAL_SKIP
)
141 return eval_skip_value (exp
);
142 type
= value_type (arg1
);
143 switch (type
->code ())
148 = fabs (target_float_to_host_double (value_contents (arg1
),
150 return value_from_host_double (type
, d
);
154 LONGEST l
= value_as_long (arg1
);
156 return value_from_longest (type
, l
);
159 error (_("ABS of type %s not supported"), TYPE_SAFE_NAME (type
));
162 arg1
= evaluate_subexp (nullptr, exp
, pos
, noside
);
163 arg2
= evaluate_subexp (value_type (arg1
), exp
, pos
, noside
);
164 if (noside
== EVAL_SKIP
)
165 return eval_skip_value (exp
);
166 type
= value_type (arg1
);
167 if (type
->code () != value_type (arg2
)->code ())
168 error (_("non-matching types for parameters to MOD ()"));
169 switch (type
->code ())
174 = target_float_to_host_double (value_contents (arg1
),
177 = target_float_to_host_double (value_contents (arg2
),
179 double d3
= fmod (d1
, d2
);
180 return value_from_host_double (type
, d3
);
184 LONGEST v1
= value_as_long (arg1
);
185 LONGEST v2
= value_as_long (arg2
);
187 error (_("calling MOD (N, 0) is undefined"));
188 LONGEST v3
= v1
- (v1
/ v2
) * v2
;
189 return value_from_longest (value_type (arg1
), v3
);
192 error (_("MOD of type %s not supported"), TYPE_SAFE_NAME (type
));
194 case UNOP_FORTRAN_CEILING
:
196 arg1
= evaluate_subexp (nullptr, exp
, pos
, noside
);
197 if (noside
== EVAL_SKIP
)
198 return eval_skip_value (exp
);
199 type
= value_type (arg1
);
200 if (type
->code () != TYPE_CODE_FLT
)
201 error (_("argument to CEILING must be of type float"));
203 = target_float_to_host_double (value_contents (arg1
),
206 return value_from_host_double (type
, val
);
209 case UNOP_FORTRAN_FLOOR
:
211 arg1
= evaluate_subexp (nullptr, exp
, pos
, noside
);
212 if (noside
== EVAL_SKIP
)
213 return eval_skip_value (exp
);
214 type
= value_type (arg1
);
215 if (type
->code () != TYPE_CODE_FLT
)
216 error (_("argument to FLOOR must be of type float"));
218 = target_float_to_host_double (value_contents (arg1
),
221 return value_from_host_double (type
, val
);
224 case BINOP_FORTRAN_MODULO
:
226 arg1
= evaluate_subexp (nullptr, exp
, pos
, noside
);
227 arg2
= evaluate_subexp (value_type (arg1
), exp
, pos
, noside
);
228 if (noside
== EVAL_SKIP
)
229 return eval_skip_value (exp
);
230 type
= value_type (arg1
);
231 if (type
->code () != value_type (arg2
)->code ())
232 error (_("non-matching types for parameters to MODULO ()"));
233 /* MODULO(A, P) = A - FLOOR (A / P) * P */
234 switch (type
->code ())
238 LONGEST a
= value_as_long (arg1
);
239 LONGEST p
= value_as_long (arg2
);
240 LONGEST result
= a
- (a
/ p
) * p
;
241 if (result
!= 0 && (a
< 0) != (p
< 0))
243 return value_from_longest (value_type (arg1
), result
);
248 = target_float_to_host_double (value_contents (arg1
),
251 = target_float_to_host_double (value_contents (arg2
),
253 double result
= fmod (a
, p
);
254 if (result
!= 0 && (a
< 0.0) != (p
< 0.0))
256 return value_from_host_double (type
, result
);
259 error (_("MODULO of type %s not supported"), TYPE_SAFE_NAME (type
));
262 case BINOP_FORTRAN_CMPLX
:
263 arg1
= evaluate_subexp (nullptr, exp
, pos
, noside
);
264 arg2
= evaluate_subexp (value_type (arg1
), exp
, pos
, noside
);
265 if (noside
== EVAL_SKIP
)
266 return eval_skip_value (exp
);
267 type
= builtin_f_type(exp
->gdbarch
)->builtin_complex_s16
;
268 return value_literal_complex (arg1
, arg2
, type
);
270 case UNOP_FORTRAN_KIND
:
271 arg1
= evaluate_subexp (NULL
, exp
, pos
, EVAL_AVOID_SIDE_EFFECTS
);
272 type
= value_type (arg1
);
274 switch (type
->code ())
276 case TYPE_CODE_STRUCT
:
277 case TYPE_CODE_UNION
:
278 case TYPE_CODE_MODULE
:
280 error (_("argument to kind must be an intrinsic type"));
283 if (!TYPE_TARGET_TYPE (type
))
284 return value_from_longest (builtin_type (exp
->gdbarch
)->builtin_int
,
286 return value_from_longest (builtin_type (exp
->gdbarch
)->builtin_int
,
287 TYPE_LENGTH (TYPE_TARGET_TYPE (type
)));
290 /* Should be unreachable. */
294 /* Special expression lengths for Fortran. */
297 operator_length_f (const struct expression
*exp
, int pc
, int *oplenp
,
303 switch (exp
->elts
[pc
- 1].opcode
)
306 operator_length_standard (exp
, pc
, oplenp
, argsp
);
309 case UNOP_FORTRAN_KIND
:
310 case UNOP_FORTRAN_FLOOR
:
311 case UNOP_FORTRAN_CEILING
:
316 case BINOP_FORTRAN_CMPLX
:
317 case BINOP_FORTRAN_MODULO
:
327 /* Helper for PRINT_SUBEXP_F. Arguments are as for PRINT_SUBEXP_F, except
328 the extra argument NAME which is the text that should be printed as the
329 name of this operation. */
332 print_unop_subexp_f (struct expression
*exp
, int *pos
,
333 struct ui_file
*stream
, enum precedence prec
,
337 fprintf_filtered (stream
, "%s(", name
);
338 print_subexp (exp
, pos
, stream
, PREC_SUFFIX
);
339 fputs_filtered (")", stream
);
342 /* Helper for PRINT_SUBEXP_F. Arguments are as for PRINT_SUBEXP_F, except
343 the extra argument NAME which is the text that should be printed as the
344 name of this operation. */
347 print_binop_subexp_f (struct expression
*exp
, int *pos
,
348 struct ui_file
*stream
, enum precedence prec
,
352 fprintf_filtered (stream
, "%s(", name
);
353 print_subexp (exp
, pos
, stream
, PREC_SUFFIX
);
354 fputs_filtered (",", stream
);
355 print_subexp (exp
, pos
, stream
, PREC_SUFFIX
);
356 fputs_filtered (")", stream
);
359 /* Special expression printing for Fortran. */
362 print_subexp_f (struct expression
*exp
, int *pos
,
363 struct ui_file
*stream
, enum precedence prec
)
366 enum exp_opcode op
= exp
->elts
[pc
].opcode
;
371 print_subexp_standard (exp
, pos
, stream
, prec
);
374 case UNOP_FORTRAN_KIND
:
375 print_unop_subexp_f (exp
, pos
, stream
, prec
, "KIND");
378 case UNOP_FORTRAN_FLOOR
:
379 print_unop_subexp_f (exp
, pos
, stream
, prec
, "FLOOR");
382 case UNOP_FORTRAN_CEILING
:
383 print_unop_subexp_f (exp
, pos
, stream
, prec
, "CEILING");
386 case BINOP_FORTRAN_CMPLX
:
387 print_binop_subexp_f (exp
, pos
, stream
, prec
, "CMPLX");
390 case BINOP_FORTRAN_MODULO
:
391 print_binop_subexp_f (exp
, pos
, stream
, prec
, "MODULO");
396 /* Special expression names for Fortran. */
399 op_name_f (enum exp_opcode opcode
)
404 return op_name_standard (opcode
);
409 #include "fortran-operator.def"
414 /* Special expression dumping for Fortran. */
417 dump_subexp_body_f (struct expression
*exp
,
418 struct ui_file
*stream
, int elt
)
420 int opcode
= exp
->elts
[elt
].opcode
;
426 return dump_subexp_body_standard (exp
, stream
, elt
);
428 case UNOP_FORTRAN_KIND
:
429 case UNOP_FORTRAN_FLOOR
:
430 case UNOP_FORTRAN_CEILING
:
431 case BINOP_FORTRAN_CMPLX
:
432 case BINOP_FORTRAN_MODULO
:
433 operator_length_f (exp
, (elt
+ 1), &oplen
, &nargs
);
438 for (i
= 0; i
< nargs
; i
+= 1)
439 elt
= dump_subexp (exp
, stream
, elt
);
444 /* Special expression checking for Fortran. */
447 operator_check_f (struct expression
*exp
, int pos
,
448 int (*objfile_func
) (struct objfile
*objfile
,
452 const union exp_element
*const elts
= exp
->elts
;
454 switch (elts
[pos
].opcode
)
456 case UNOP_FORTRAN_KIND
:
457 case UNOP_FORTRAN_FLOOR
:
458 case UNOP_FORTRAN_CEILING
:
459 case BINOP_FORTRAN_CMPLX
:
460 case BINOP_FORTRAN_MODULO
:
461 /* Any references to objfiles are held in the arguments to this
462 expression, not within the expression itself, so no additional
463 checking is required here, the outer expression iteration code
464 will take care of checking each argument. */
468 return operator_check_standard (exp
, pos
, objfile_func
, data
);
474 /* Expression processing for Fortran. */
475 static const struct exp_descriptor exp_descriptor_f
=
485 /* Constant data that describes the Fortran language. */
487 extern const struct language_data f_language_data
=
490 f_op_print_tab
, /* expression operators for printing */
494 /* Class representing the Fortran language. */
496 class f_language
: public language_defn
500 : language_defn (language_fortran
, f_language_data
)
503 /* See language.h. */
505 const char *name () const override
506 { return "fortran"; }
508 /* See language.h. */
510 const char *natural_name () const override
511 { return "Fortran"; }
513 /* See language.h. */
515 const std::vector
<const char *> &filename_extensions () const override
517 static const std::vector
<const char *> extensions
= {
518 ".f", ".F", ".for", ".FOR", ".ftn", ".FTN", ".fpp", ".FPP",
519 ".f90", ".F90", ".f95", ".F95", ".f03", ".F03", ".f08", ".F08"
524 /* See language.h. */
525 void language_arch_info (struct gdbarch
*gdbarch
,
526 struct language_arch_info
*lai
) const override
528 const struct builtin_f_type
*builtin
= builtin_f_type (gdbarch
);
530 lai
->string_char_type
= builtin
->builtin_character
;
531 lai
->primitive_type_vector
532 = GDBARCH_OBSTACK_CALLOC (gdbarch
, nr_f_primitive_types
+ 1,
535 lai
->primitive_type_vector
[f_primitive_type_character
]
536 = builtin
->builtin_character
;
537 lai
->primitive_type_vector
[f_primitive_type_logical
]
538 = builtin
->builtin_logical
;
539 lai
->primitive_type_vector
[f_primitive_type_logical_s1
]
540 = builtin
->builtin_logical_s1
;
541 lai
->primitive_type_vector
[f_primitive_type_logical_s2
]
542 = builtin
->builtin_logical_s2
;
543 lai
->primitive_type_vector
[f_primitive_type_logical_s8
]
544 = builtin
->builtin_logical_s8
;
545 lai
->primitive_type_vector
[f_primitive_type_real
]
546 = builtin
->builtin_real
;
547 lai
->primitive_type_vector
[f_primitive_type_real_s8
]
548 = builtin
->builtin_real_s8
;
549 lai
->primitive_type_vector
[f_primitive_type_real_s16
]
550 = builtin
->builtin_real_s16
;
551 lai
->primitive_type_vector
[f_primitive_type_complex_s8
]
552 = builtin
->builtin_complex_s8
;
553 lai
->primitive_type_vector
[f_primitive_type_complex_s16
]
554 = builtin
->builtin_complex_s16
;
555 lai
->primitive_type_vector
[f_primitive_type_void
]
556 = builtin
->builtin_void
;
558 lai
->bool_type_symbol
= "logical";
559 lai
->bool_type_default
= builtin
->builtin_logical_s2
;
562 /* See language.h. */
563 unsigned int search_name_hash (const char *name
) const override
565 return cp_search_name_hash (name
);
568 /* See language.h. */
570 char *demangle (const char *mangled
, int options
) const override
572 /* We could support demangling here to provide module namespaces
573 also for inferiors with only minimal symbol table (ELF symbols).
574 Just the mangling standard is not standardized across compilers
575 and there is no DW_AT_producer available for inferiors with only
576 the ELF symbols to check the mangling kind. */
580 /* See language.h. */
582 void print_type (struct type
*type
, const char *varstring
,
583 struct ui_file
*stream
, int show
, int level
,
584 const struct type_print_options
*flags
) const override
586 f_print_type (type
, varstring
, stream
, show
, level
, flags
);
589 /* See language.h. This just returns default set of word break
590 characters but with the modules separator `::' removed. */
592 const char *word_break_characters (void) const override
600 retval
= xstrdup (language_defn::word_break_characters ());
601 s
= strchr (retval
, ':');
604 char *last_char
= &s
[strlen (s
) - 1];
614 /* See language.h. */
616 void collect_symbol_completion_matches (completion_tracker
&tracker
,
617 complete_symbol_mode mode
,
618 symbol_name_match_type name_match_type
,
619 const char *text
, const char *word
,
620 enum type_code code
) const override
622 /* Consider the modules separator :: as a valid symbol name character
624 default_collect_symbol_completion_matches_break_on (tracker
, mode
,
630 /* See language.h. */
632 void value_print_inner
633 (struct value
*val
, struct ui_file
*stream
, int recurse
,
634 const struct value_print_options
*options
) const override
636 return f_value_print_inner (val
, stream
, recurse
, options
);
639 /* See language.h. */
641 struct block_symbol lookup_symbol_nonlocal
642 (const char *name
, const struct block
*block
,
643 const domain_enum domain
) const override
645 return cp_lookup_symbol_nonlocal (this, name
, block
, domain
);
648 /* See language.h. */
650 int parser (struct parser_state
*ps
) const override
655 /* See language.h. */
657 void emitchar (int ch
, struct type
*chtype
,
658 struct ui_file
*stream
, int quoter
) const override
660 const char *encoding
= f_get_encoding (chtype
);
661 generic_emit_char (ch
, chtype
, stream
, quoter
, encoding
);
664 /* See language.h. */
666 void printchar (int ch
, struct type
*chtype
,
667 struct ui_file
*stream
) const override
669 fputs_filtered ("'", stream
);
670 LA_EMIT_CHAR (ch
, chtype
, stream
, '\'');
671 fputs_filtered ("'", stream
);
674 /* See language.h. */
676 void printstr (struct ui_file
*stream
, struct type
*elttype
,
677 const gdb_byte
*string
, unsigned int length
,
678 const char *encoding
, int force_ellipses
,
679 const struct value_print_options
*options
) const override
681 const char *type_encoding
= f_get_encoding (elttype
);
683 if (TYPE_LENGTH (elttype
) == 4)
684 fputs_filtered ("4_", stream
);
686 if (!encoding
|| !*encoding
)
687 encoding
= type_encoding
;
689 generic_printstr (stream
, elttype
, string
, length
, encoding
,
690 force_ellipses
, '\'', 0, options
);
693 /* See language.h. */
695 void print_typedef (struct type
*type
, struct symbol
*new_symbol
,
696 struct ui_file
*stream
) const override
698 f_print_typedef (type
, new_symbol
, stream
);
701 /* See language.h. */
703 bool is_string_type_p (struct type
*type
) const override
705 type
= check_typedef (type
);
706 return (type
->code () == TYPE_CODE_STRING
707 || (type
->code () == TYPE_CODE_ARRAY
708 && TYPE_TARGET_TYPE (type
)->code () == TYPE_CODE_CHAR
));
711 /* See language.h. */
713 const char *struct_too_deep_ellipsis () const override
716 /* See language.h. */
718 bool c_style_arrays_p () const override
721 /* See language.h. */
723 bool range_checking_on_by_default () const override
726 /* See language.h. */
728 enum case_sensitivity
case_sensitivity () const override
729 { return case_sensitive_off
; }
731 /* See language.h. */
733 enum array_ordering
array_ordering () const override
734 { return array_column_major
; }
738 /* See language.h. */
740 symbol_name_matcher_ftype
*get_symbol_name_matcher_inner
741 (const lookup_name_info
&lookup_name
) const override
743 return cp_get_symbol_name_matcher (lookup_name
);
747 /* Single instance of the Fortran language class. */
749 static f_language f_language_defn
;
752 build_fortran_types (struct gdbarch
*gdbarch
)
754 struct builtin_f_type
*builtin_f_type
755 = GDBARCH_OBSTACK_ZALLOC (gdbarch
, struct builtin_f_type
);
757 builtin_f_type
->builtin_void
758 = arch_type (gdbarch
, TYPE_CODE_VOID
, TARGET_CHAR_BIT
, "void");
760 builtin_f_type
->builtin_character
761 = arch_type (gdbarch
, TYPE_CODE_CHAR
, TARGET_CHAR_BIT
, "character");
763 builtin_f_type
->builtin_logical_s1
764 = arch_boolean_type (gdbarch
, TARGET_CHAR_BIT
, 1, "logical*1");
766 builtin_f_type
->builtin_integer_s2
767 = arch_integer_type (gdbarch
, gdbarch_short_bit (gdbarch
), 0,
770 builtin_f_type
->builtin_integer_s8
771 = arch_integer_type (gdbarch
, gdbarch_long_long_bit (gdbarch
), 0,
774 builtin_f_type
->builtin_logical_s2
775 = arch_boolean_type (gdbarch
, gdbarch_short_bit (gdbarch
), 1,
778 builtin_f_type
->builtin_logical_s8
779 = arch_boolean_type (gdbarch
, gdbarch_long_long_bit (gdbarch
), 1,
782 builtin_f_type
->builtin_integer
783 = arch_integer_type (gdbarch
, gdbarch_int_bit (gdbarch
), 0,
786 builtin_f_type
->builtin_logical
787 = arch_boolean_type (gdbarch
, gdbarch_int_bit (gdbarch
), 1,
790 builtin_f_type
->builtin_real
791 = arch_float_type (gdbarch
, gdbarch_float_bit (gdbarch
),
792 "real", gdbarch_float_format (gdbarch
));
793 builtin_f_type
->builtin_real_s8
794 = arch_float_type (gdbarch
, gdbarch_double_bit (gdbarch
),
795 "real*8", gdbarch_double_format (gdbarch
));
796 auto fmt
= gdbarch_floatformat_for_type (gdbarch
, "real(kind=16)", 128);
798 builtin_f_type
->builtin_real_s16
799 = arch_float_type (gdbarch
, 128, "real*16", fmt
);
800 else if (gdbarch_long_double_bit (gdbarch
) == 128)
801 builtin_f_type
->builtin_real_s16
802 = arch_float_type (gdbarch
, gdbarch_long_double_bit (gdbarch
),
803 "real*16", gdbarch_long_double_format (gdbarch
));
805 builtin_f_type
->builtin_real_s16
806 = arch_type (gdbarch
, TYPE_CODE_ERROR
, 128, "real*16");
808 builtin_f_type
->builtin_complex_s8
809 = init_complex_type ("complex*8", builtin_f_type
->builtin_real
);
810 builtin_f_type
->builtin_complex_s16
811 = init_complex_type ("complex*16", builtin_f_type
->builtin_real_s8
);
813 if (builtin_f_type
->builtin_real_s16
->code () == TYPE_CODE_ERROR
)
814 builtin_f_type
->builtin_complex_s32
815 = arch_type (gdbarch
, TYPE_CODE_ERROR
, 256, "complex*32");
817 builtin_f_type
->builtin_complex_s32
818 = init_complex_type ("complex*32", builtin_f_type
->builtin_real_s16
);
820 return builtin_f_type
;
823 static struct gdbarch_data
*f_type_data
;
825 const struct builtin_f_type
*
826 builtin_f_type (struct gdbarch
*gdbarch
)
828 return (const struct builtin_f_type
*) gdbarch_data (gdbarch
, f_type_data
);
831 void _initialize_f_language ();
833 _initialize_f_language ()
835 f_type_data
= gdbarch_data_register_post_init (build_fortran_types
);
841 fortran_argument_convert (struct value
*value
, bool is_artificial
)
845 /* If the value is not in the inferior e.g. registers values,
846 convenience variables and user input. */
847 if (VALUE_LVAL (value
) != lval_memory
)
849 struct type
*type
= value_type (value
);
850 const int length
= TYPE_LENGTH (type
);
852 = value_as_long (value_allocate_space_in_inferior (length
));
853 write_memory (addr
, value_contents (value
), length
);
855 = value_from_contents_and_address (type
, value_contents (value
),
857 return value_addr (val
);
860 return value_addr (value
); /* Program variables, e.g. arrays. */
868 fortran_preserve_arg_pointer (struct value
*arg
, struct type
*type
)
870 if (value_type (arg
)->code () == TYPE_CODE_PTR
)
871 return value_type (arg
);