- }
- return retval;
-}
-
-/* Consider the modules separator :: as a valid symbol name character
- class. */
-
-static VEC (char_ptr) *
-f_make_symbol_completion_list (char *text, char *word)
-{
- return default_make_symbol_completion_list_break_on (text, word, ":");
-}
-
-const struct language_defn f_language_defn =
-{
- "fortran",
- language_fortran,
- range_check_on,
- case_sensitive_off,
- array_column_major,
- macro_expansion_no,
- &exp_descriptor_standard,
- f_parse, /* parser */
- f_error, /* parser error function */
- null_post_parser,
- f_printchar, /* Print character constant */
- f_printstr, /* function to print string constant */
- f_emit_char, /* Function to print a single character */
- f_print_type, /* Print a type using appropriate syntax */
- default_print_typedef, /* Print a typedef using appropriate syntax */
- f_val_print, /* Print a value using appropriate syntax */
- c_value_print, /* FIXME */
- default_read_var_value, /* la_read_var_value */
- NULL, /* Language specific skip_trampoline */
- NULL, /* name_of_this */
- cp_lookup_symbol_nonlocal, /* lookup_symbol_nonlocal */
- basic_lookup_transparent_type,/* lookup_transparent_type */
- NULL, /* Language specific symbol demangler */
- NULL, /* Language specific
- class_name_from_physname */
- f_op_print_tab, /* expression operators for printing */
- 0, /* arrays are first-class (not c-style) */
- 1, /* String lower bound */
- f_word_break_characters,
- f_make_symbol_completion_list,
- f_language_arch_info,
- default_print_array_index,
- default_pass_by_reference,
- default_get_string,
- NULL, /* la_get_symbol_name_cmp */
- iterate_over_symbols,
- LANG_MAGIC
-};
-
-static void *
-build_fortran_types (struct gdbarch *gdbarch)
-{
- struct builtin_f_type *builtin_f_type
- = GDBARCH_OBSTACK_ZALLOC (gdbarch, struct builtin_f_type);
-
- builtin_f_type->builtin_void
- = arch_type (gdbarch, TYPE_CODE_VOID, 1, "VOID");
-
- builtin_f_type->builtin_character
- = arch_integer_type (gdbarch, TARGET_CHAR_BIT, 0, "character");
-
- builtin_f_type->builtin_logical_s1
- = arch_boolean_type (gdbarch, TARGET_CHAR_BIT, 1, "logical*1");
-
- builtin_f_type->builtin_integer_s2
- = arch_integer_type (gdbarch, gdbarch_short_bit (gdbarch), 0,
- "integer*2");
-
- builtin_f_type->builtin_logical_s2
- = arch_boolean_type (gdbarch, gdbarch_short_bit (gdbarch), 1,
- "logical*2");
-
- builtin_f_type->builtin_logical_s8
- = arch_boolean_type (gdbarch, gdbarch_long_long_bit (gdbarch), 1,
- "logical*8");
+ error (_("ABS of type %s not supported"), TYPE_SAFE_NAME (type));
+
+ case BINOP_MOD:
+ arg1 = evaluate_subexp (NULL_TYPE, exp, pos, noside);
+ arg2 = evaluate_subexp (value_type (arg1), exp, pos, noside);
+ if (noside == EVAL_SKIP)
+ return eval_skip_value (exp);
+ type = value_type (arg1);
+ if (type->code () != value_type (arg2)->code ())
+ error (_("non-matching types for parameters to MOD ()"));
+ switch (type->code ())
+ {
+ case TYPE_CODE_FLT:
+ {
+ double d1
+ = target_float_to_host_double (value_contents (arg1),
+ value_type (arg1));
+ double d2
+ = target_float_to_host_double (value_contents (arg2),
+ value_type (arg2));
+ double d3 = fmod (d1, d2);
+ return value_from_host_double (type, d3);
+ }
+ case TYPE_CODE_INT:
+ {
+ LONGEST v1 = value_as_long (arg1);
+ LONGEST v2 = value_as_long (arg2);
+ if (v2 == 0)
+ error (_("calling MOD (N, 0) is undefined"));
+ LONGEST v3 = v1 - (v1 / v2) * v2;
+ return value_from_longest (value_type (arg1), v3);
+ }
+ }
+ error (_("MOD of type %s not supported"), TYPE_SAFE_NAME (type));