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 /* Special expression evaluation cases for Fortran. */
170 static struct value
*
171 evaluate_subexp_f (struct type
*expect_type
, struct expression
*exp
,
172 int *pos
, enum noside noside
)
174 struct value
*arg1
= NULL
, *arg2
= NULL
;
181 op
= exp
->elts
[pc
].opcode
;
187 return evaluate_subexp_standard (expect_type
, exp
, pos
, noside
);
190 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
191 if (noside
== EVAL_SKIP
)
192 return eval_skip_value (exp
);
193 type
= value_type (arg1
);
194 switch (type
->code ())
199 = fabs (target_float_to_host_double (value_contents (arg1
),
201 return value_from_host_double (type
, d
);
205 LONGEST l
= value_as_long (arg1
);
207 return value_from_longest (type
, l
);
210 error (_("ABS of type %s not supported"), TYPE_SAFE_NAME (type
));
213 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
214 arg2
= evaluate_subexp (value_type (arg1
), exp
, pos
, noside
);
215 if (noside
== EVAL_SKIP
)
216 return eval_skip_value (exp
);
217 type
= value_type (arg1
);
218 if (type
->code () != value_type (arg2
)->code ())
219 error (_("non-matching types for parameters to MOD ()"));
220 switch (type
->code ())
225 = target_float_to_host_double (value_contents (arg1
),
228 = target_float_to_host_double (value_contents (arg2
),
230 double d3
= fmod (d1
, d2
);
231 return value_from_host_double (type
, d3
);
235 LONGEST v1
= value_as_long (arg1
);
236 LONGEST v2
= value_as_long (arg2
);
238 error (_("calling MOD (N, 0) is undefined"));
239 LONGEST v3
= v1
- (v1
/ v2
) * v2
;
240 return value_from_longest (value_type (arg1
), v3
);
243 error (_("MOD of type %s not supported"), TYPE_SAFE_NAME (type
));
245 case UNOP_FORTRAN_CEILING
:
247 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
248 if (noside
== EVAL_SKIP
)
249 return eval_skip_value (exp
);
250 type
= value_type (arg1
);
251 if (type
->code () != TYPE_CODE_FLT
)
252 error (_("argument to CEILING must be of type float"));
254 = target_float_to_host_double (value_contents (arg1
),
257 return value_from_host_double (type
, val
);
260 case UNOP_FORTRAN_FLOOR
:
262 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
263 if (noside
== EVAL_SKIP
)
264 return eval_skip_value (exp
);
265 type
= value_type (arg1
);
266 if (type
->code () != TYPE_CODE_FLT
)
267 error (_("argument to FLOOR must be of type float"));
269 = target_float_to_host_double (value_contents (arg1
),
272 return value_from_host_double (type
, val
);
275 case BINOP_FORTRAN_MODULO
:
277 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
278 arg2
= evaluate_subexp (value_type (arg1
), exp
, pos
, noside
);
279 if (noside
== EVAL_SKIP
)
280 return eval_skip_value (exp
);
281 type
= value_type (arg1
);
282 if (type
->code () != value_type (arg2
)->code ())
283 error (_("non-matching types for parameters to MODULO ()"));
284 /* MODULO(A, P) = A - FLOOR (A / P) * P */
285 switch (type
->code ())
289 LONGEST a
= value_as_long (arg1
);
290 LONGEST p
= value_as_long (arg2
);
291 LONGEST result
= a
- (a
/ p
) * p
;
292 if (result
!= 0 && (a
< 0) != (p
< 0))
294 return value_from_longest (value_type (arg1
), result
);
299 = target_float_to_host_double (value_contents (arg1
),
302 = target_float_to_host_double (value_contents (arg2
),
304 double result
= fmod (a
, p
);
305 if (result
!= 0 && (a
< 0.0) != (p
< 0.0))
307 return value_from_host_double (type
, result
);
310 error (_("MODULO of type %s not supported"), TYPE_SAFE_NAME (type
));
313 case BINOP_FORTRAN_CMPLX
:
314 arg1
= evaluate_subexp (NULL_TYPE
, exp
, pos
, noside
);
315 arg2
= evaluate_subexp (value_type (arg1
), exp
, pos
, noside
);
316 if (noside
== EVAL_SKIP
)
317 return eval_skip_value (exp
);
318 type
= builtin_f_type(exp
->gdbarch
)->builtin_complex_s16
;
319 return value_literal_complex (arg1
, arg2
, type
);
321 case UNOP_FORTRAN_KIND
:
322 arg1
= evaluate_subexp (NULL
, exp
, pos
, EVAL_AVOID_SIDE_EFFECTS
);
323 type
= value_type (arg1
);
325 switch (type
->code ())
327 case TYPE_CODE_STRUCT
:
328 case TYPE_CODE_UNION
:
329 case TYPE_CODE_MODULE
:
331 error (_("argument to kind must be an intrinsic type"));
334 if (!TYPE_TARGET_TYPE (type
))
335 return value_from_longest (builtin_type (exp
->gdbarch
)->builtin_int
,
337 return value_from_longest (builtin_type (exp
->gdbarch
)->builtin_int
,
338 TYPE_LENGTH (TYPE_TARGET_TYPE (type
)));
341 /* Should be unreachable. */
345 /* Return true if TYPE is a string. */
348 f_is_string_type_p (struct type
*type
)
350 type
= check_typedef (type
);
351 return (type
->code () == TYPE_CODE_STRING
352 || (type
->code () == TYPE_CODE_ARRAY
353 && TYPE_TARGET_TYPE (type
)->code () == TYPE_CODE_CHAR
));
356 /* Special expression lengths for Fortran. */
359 operator_length_f (const struct expression
*exp
, int pc
, int *oplenp
,
365 switch (exp
->elts
[pc
- 1].opcode
)
368 operator_length_standard (exp
, pc
, oplenp
, argsp
);
371 case UNOP_FORTRAN_KIND
:
372 case UNOP_FORTRAN_FLOOR
:
373 case UNOP_FORTRAN_CEILING
:
378 case BINOP_FORTRAN_CMPLX
:
379 case BINOP_FORTRAN_MODULO
:
389 /* Helper for PRINT_SUBEXP_F. Arguments are as for PRINT_SUBEXP_F, except
390 the extra argument NAME which is the text that should be printed as the
391 name of this operation. */
394 print_unop_subexp_f (struct expression
*exp
, int *pos
,
395 struct ui_file
*stream
, enum precedence prec
,
399 fprintf_filtered (stream
, "%s(", name
);
400 print_subexp (exp
, pos
, stream
, PREC_SUFFIX
);
401 fputs_filtered (")", stream
);
404 /* Helper for PRINT_SUBEXP_F. Arguments are as for PRINT_SUBEXP_F, except
405 the extra argument NAME which is the text that should be printed as the
406 name of this operation. */
409 print_binop_subexp_f (struct expression
*exp
, int *pos
,
410 struct ui_file
*stream
, enum precedence prec
,
414 fprintf_filtered (stream
, "%s(", name
);
415 print_subexp (exp
, pos
, stream
, PREC_SUFFIX
);
416 fputs_filtered (",", stream
);
417 print_subexp (exp
, pos
, stream
, PREC_SUFFIX
);
418 fputs_filtered (")", stream
);
421 /* Special expression printing for Fortran. */
424 print_subexp_f (struct expression
*exp
, int *pos
,
425 struct ui_file
*stream
, enum precedence prec
)
428 enum exp_opcode op
= exp
->elts
[pc
].opcode
;
433 print_subexp_standard (exp
, pos
, stream
, prec
);
436 case UNOP_FORTRAN_KIND
:
437 print_unop_subexp_f (exp
, pos
, stream
, prec
, "KIND");
440 case UNOP_FORTRAN_FLOOR
:
441 print_unop_subexp_f (exp
, pos
, stream
, prec
, "FLOOR");
444 case UNOP_FORTRAN_CEILING
:
445 print_unop_subexp_f (exp
, pos
, stream
, prec
, "CEILING");
448 case BINOP_FORTRAN_CMPLX
:
449 print_binop_subexp_f (exp
, pos
, stream
, prec
, "CMPLX");
452 case BINOP_FORTRAN_MODULO
:
453 print_binop_subexp_f (exp
, pos
, stream
, prec
, "MODULO");
458 /* Special expression names for Fortran. */
461 op_name_f (enum exp_opcode opcode
)
466 return op_name_standard (opcode
);
471 #include "fortran-operator.def"
476 /* Special expression dumping for Fortran. */
479 dump_subexp_body_f (struct expression
*exp
,
480 struct ui_file
*stream
, int elt
)
482 int opcode
= exp
->elts
[elt
].opcode
;
488 return dump_subexp_body_standard (exp
, stream
, elt
);
490 case UNOP_FORTRAN_KIND
:
491 case UNOP_FORTRAN_FLOOR
:
492 case UNOP_FORTRAN_CEILING
:
493 case BINOP_FORTRAN_CMPLX
:
494 case BINOP_FORTRAN_MODULO
:
495 operator_length_f (exp
, (elt
+ 1), &oplen
, &nargs
);
500 for (i
= 0; i
< nargs
; i
+= 1)
501 elt
= dump_subexp (exp
, stream
, elt
);
506 /* Special expression checking for Fortran. */
509 operator_check_f (struct expression
*exp
, int pos
,
510 int (*objfile_func
) (struct objfile
*objfile
,
514 const union exp_element
*const elts
= exp
->elts
;
516 switch (elts
[pos
].opcode
)
518 case UNOP_FORTRAN_KIND
:
519 case UNOP_FORTRAN_FLOOR
:
520 case UNOP_FORTRAN_CEILING
:
521 case BINOP_FORTRAN_CMPLX
:
522 case BINOP_FORTRAN_MODULO
:
523 /* Any references to objfiles are held in the arguments to this
524 expression, not within the expression itself, so no additional
525 checking is required here, the outer expression iteration code
526 will take care of checking each argument. */
530 return operator_check_standard (exp
, pos
, objfile_func
, data
);
536 static const char *f_extensions
[] =
538 ".f", ".F", ".for", ".FOR", ".ftn", ".FTN", ".fpp", ".FPP",
539 ".f90", ".F90", ".f95", ".F95", ".f03", ".F03", ".f08", ".F08",
543 /* Expression processing for Fortran. */
544 static const struct exp_descriptor exp_descriptor_f
=
554 /* Constant data that describes the Fortran language. */
556 extern const struct language_data f_language_data
=
567 f_parse
, /* parser */
569 f_printchar
, /* Print character constant */
570 f_printstr
, /* function to print string constant */
571 f_emit_char
, /* Function to print a single character */
572 f_print_typedef
, /* Print a typedef using appropriate syntax */
573 NULL
, /* name_of_this */
574 false, /* la_store_sym_names_in_linkage_form_p */
575 cp_lookup_symbol_nonlocal
, /* lookup_symbol_nonlocal */
576 f_op_print_tab
, /* expression operators for printing */
577 0, /* arrays are first-class (not c-style) */
578 1, /* String lower bound */
581 "(...)" /* la_struct_too_deep_ellipsis */
584 /* Class representing the Fortran language. */
586 class f_language
: public language_defn
590 : language_defn (language_fortran
, f_language_data
)
593 /* See language.h. */
594 void language_arch_info (struct gdbarch
*gdbarch
,
595 struct language_arch_info
*lai
) const override
597 const struct builtin_f_type
*builtin
= builtin_f_type (gdbarch
);
599 lai
->string_char_type
= builtin
->builtin_character
;
600 lai
->primitive_type_vector
601 = GDBARCH_OBSTACK_CALLOC (gdbarch
, nr_f_primitive_types
+ 1,
604 lai
->primitive_type_vector
[f_primitive_type_character
]
605 = builtin
->builtin_character
;
606 lai
->primitive_type_vector
[f_primitive_type_logical
]
607 = builtin
->builtin_logical
;
608 lai
->primitive_type_vector
[f_primitive_type_logical_s1
]
609 = builtin
->builtin_logical_s1
;
610 lai
->primitive_type_vector
[f_primitive_type_logical_s2
]
611 = builtin
->builtin_logical_s2
;
612 lai
->primitive_type_vector
[f_primitive_type_logical_s8
]
613 = builtin
->builtin_logical_s8
;
614 lai
->primitive_type_vector
[f_primitive_type_real
]
615 = builtin
->builtin_real
;
616 lai
->primitive_type_vector
[f_primitive_type_real_s8
]
617 = builtin
->builtin_real_s8
;
618 lai
->primitive_type_vector
[f_primitive_type_real_s16
]
619 = builtin
->builtin_real_s16
;
620 lai
->primitive_type_vector
[f_primitive_type_complex_s8
]
621 = builtin
->builtin_complex_s8
;
622 lai
->primitive_type_vector
[f_primitive_type_complex_s16
]
623 = builtin
->builtin_complex_s16
;
624 lai
->primitive_type_vector
[f_primitive_type_void
]
625 = builtin
->builtin_void
;
627 lai
->bool_type_symbol
= "logical";
628 lai
->bool_type_default
= builtin
->builtin_logical_s2
;
631 /* See language.h. */
632 unsigned int search_name_hash (const char *name
) const override
634 return cp_search_name_hash (name
);
637 /* See language.h. */
639 char *demangle (const char *mangled
, int options
) const override
641 /* We could support demangling here to provide module namespaces
642 also for inferiors with only minimal symbol table (ELF symbols).
643 Just the mangling standard is not standardized across compilers
644 and there is no DW_AT_producer available for inferiors with only
645 the ELF symbols to check the mangling kind. */
649 /* See language.h. */
651 void print_type (struct type
*type
, const char *varstring
,
652 struct ui_file
*stream
, int show
, int level
,
653 const struct type_print_options
*flags
) const override
655 f_print_type (type
, varstring
, stream
, show
, level
, flags
);
658 /* See language.h. This just returns default set of word break
659 characters but with the modules separator `::' removed. */
661 const char *word_break_characters (void) const override
669 retval
= xstrdup (language_defn::word_break_characters ());
670 s
= strchr (retval
, ':');
673 char *last_char
= &s
[strlen (s
) - 1];
683 /* See language.h. */
685 void collect_symbol_completion_matches (completion_tracker
&tracker
,
686 complete_symbol_mode mode
,
687 symbol_name_match_type name_match_type
,
688 const char *text
, const char *word
,
689 enum type_code code
) const override
691 /* Consider the modules separator :: as a valid symbol name character
693 default_collect_symbol_completion_matches_break_on (tracker
, mode
,
699 /* See language.h. */
701 void value_print_inner
702 (struct value
*val
, struct ui_file
*stream
, int recurse
,
703 const struct value_print_options
*options
) const override
705 return f_value_print_inner (val
, stream
, recurse
, options
);
711 /* See language.h. */
713 symbol_name_matcher_ftype
*get_symbol_name_matcher_inner
714 (const lookup_name_info
&lookup_name
) const override
716 return cp_get_symbol_name_matcher (lookup_name
);
720 /* Single instance of the Fortran language class. */
722 static f_language f_language_defn
;
725 build_fortran_types (struct gdbarch
*gdbarch
)
727 struct builtin_f_type
*builtin_f_type
728 = GDBARCH_OBSTACK_ZALLOC (gdbarch
, struct builtin_f_type
);
730 builtin_f_type
->builtin_void
731 = arch_type (gdbarch
, TYPE_CODE_VOID
, TARGET_CHAR_BIT
, "void");
733 builtin_f_type
->builtin_character
734 = arch_type (gdbarch
, TYPE_CODE_CHAR
, TARGET_CHAR_BIT
, "character");
736 builtin_f_type
->builtin_logical_s1
737 = arch_boolean_type (gdbarch
, TARGET_CHAR_BIT
, 1, "logical*1");
739 builtin_f_type
->builtin_integer_s2
740 = arch_integer_type (gdbarch
, gdbarch_short_bit (gdbarch
), 0,
743 builtin_f_type
->builtin_integer_s8
744 = arch_integer_type (gdbarch
, gdbarch_long_long_bit (gdbarch
), 0,
747 builtin_f_type
->builtin_logical_s2
748 = arch_boolean_type (gdbarch
, gdbarch_short_bit (gdbarch
), 1,
751 builtin_f_type
->builtin_logical_s8
752 = arch_boolean_type (gdbarch
, gdbarch_long_long_bit (gdbarch
), 1,
755 builtin_f_type
->builtin_integer
756 = arch_integer_type (gdbarch
, gdbarch_int_bit (gdbarch
), 0,
759 builtin_f_type
->builtin_logical
760 = arch_boolean_type (gdbarch
, gdbarch_int_bit (gdbarch
), 1,
763 builtin_f_type
->builtin_real
764 = arch_float_type (gdbarch
, gdbarch_float_bit (gdbarch
),
765 "real", gdbarch_float_format (gdbarch
));
766 builtin_f_type
->builtin_real_s8
767 = arch_float_type (gdbarch
, gdbarch_double_bit (gdbarch
),
768 "real*8", gdbarch_double_format (gdbarch
));
769 auto fmt
= gdbarch_floatformat_for_type (gdbarch
, "real(kind=16)", 128);
771 builtin_f_type
->builtin_real_s16
772 = arch_float_type (gdbarch
, 128, "real*16", fmt
);
773 else if (gdbarch_long_double_bit (gdbarch
) == 128)
774 builtin_f_type
->builtin_real_s16
775 = arch_float_type (gdbarch
, gdbarch_long_double_bit (gdbarch
),
776 "real*16", gdbarch_long_double_format (gdbarch
));
778 builtin_f_type
->builtin_real_s16
779 = arch_type (gdbarch
, TYPE_CODE_ERROR
, 128, "real*16");
781 builtin_f_type
->builtin_complex_s8
782 = init_complex_type ("complex*8", builtin_f_type
->builtin_real
);
783 builtin_f_type
->builtin_complex_s16
784 = init_complex_type ("complex*16", builtin_f_type
->builtin_real_s8
);
786 if (builtin_f_type
->builtin_real_s16
->code () == TYPE_CODE_ERROR
)
787 builtin_f_type
->builtin_complex_s32
788 = arch_type (gdbarch
, TYPE_CODE_ERROR
, 256, "complex*32");
790 builtin_f_type
->builtin_complex_s32
791 = init_complex_type ("complex*32", builtin_f_type
->builtin_real_s16
);
793 return builtin_f_type
;
796 static struct gdbarch_data
*f_type_data
;
798 const struct builtin_f_type
*
799 builtin_f_type (struct gdbarch
*gdbarch
)
801 return (const struct builtin_f_type
*) gdbarch_data (gdbarch
, f_type_data
);
804 void _initialize_f_language ();
806 _initialize_f_language ()
808 f_type_data
= gdbarch_data_register_post_init (build_fortran_types
);
814 fortran_argument_convert (struct value
*value
, bool is_artificial
)
818 /* If the value is not in the inferior e.g. registers values,
819 convenience variables and user input. */
820 if (VALUE_LVAL (value
) != lval_memory
)
822 struct type
*type
= value_type (value
);
823 const int length
= TYPE_LENGTH (type
);
825 = value_as_long (value_allocate_space_in_inferior (length
));
826 write_memory (addr
, value_contents (value
), length
);
828 = value_from_contents_and_address (type
, value_contents (value
),
830 return value_addr (val
);
833 return value_addr (value
); /* Program variables, e.g. arrays. */
841 fortran_preserve_arg_pointer (struct value
*arg
, struct type
*type
)
843 if (value_type (arg
)->code () == TYPE_CODE_PTR
)
844 return value_type (arg
);