+static void
+m2_unknown (const char *s, struct type *type, struct ui_file *stream,
+ int show, int level)
+{
+ fprintf_filtered (stream, "%s %s", s, _("is unknown"));
+}
+
+static void m2_union (struct type *type, struct ui_file *stream)
+{
+ fprintf_filtered (stream, "union");
+}
+
+static void
+m2_procedure (struct type *type, struct ui_file *stream,
+ int show, int level, const struct type_print_options *flags)
+{
+ fprintf_filtered (stream, "PROCEDURE ");
+ m2_type_name (type, stream);
+ if (TYPE_TARGET_TYPE (type) == NULL
+ || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
+ {
+ int i, len = TYPE_NFIELDS (type);
+
+ fprintf_filtered (stream, " (");
+ for (i = 0; i < len; i++)
+ {
+ if (i > 0)
+ {
+ fputs_filtered (", ", stream);
+ wrap_here (" ");
+ }
+ m2_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0, flags);
+ }
+ fprintf_filtered (stream, ") : ");
+ if (TYPE_TARGET_TYPE (type) != NULL)
+ m2_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0, flags);
+ else
+ type_print_unknown_return_type (stream);
+ }
+}
+
+static void
+m2_print_bounds (struct type *type,
+ struct ui_file *stream, int show, int level,
+ int print_high)
+{
+ struct type *target = TYPE_TARGET_TYPE (type);
+
+ if (TYPE_NFIELDS(type) == 0)
+ return;
+
+ if (print_high)
+ print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
+ else
+ print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
+}
+
+static void
+m2_short_set (struct type *type, struct ui_file *stream, int show, int level)
+{
+ fprintf_filtered(stream, "SET [");
+ m2_print_bounds (TYPE_INDEX_TYPE (type), stream,
+ show - 1, level, 0);
+
+ fprintf_filtered(stream, "..");
+ m2_print_bounds (TYPE_INDEX_TYPE (type), stream,
+ show - 1, level, 1);
+ fprintf_filtered(stream, "]");
+}
+
+int
+m2_is_long_set (struct type *type)
+{
+ LONGEST previous_high = 0; /* Unnecessary initialization
+ keeps gcc -Wall happy. */
+ int len, i;
+ struct type *range;
+
+ if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
+ {
+
+ /* check if all fields of the RECORD are consecutive sets. */
+
+ len = TYPE_NFIELDS (type);
+ for (i = TYPE_N_BASECLASSES (type); i < len; i++)
+ {
+ if (TYPE_FIELD_TYPE (type, i) == NULL)
+ return 0;
+ if (TYPE_CODE (TYPE_FIELD_TYPE (type, i)) != TYPE_CODE_SET)
+ return 0;
+ if (TYPE_FIELD_NAME (type, i) != NULL
+ && (strcmp (TYPE_FIELD_NAME (type, i), "") != 0))
+ return 0;
+ range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i));
+ if ((i > TYPE_N_BASECLASSES (type))
+ && previous_high + 1 != TYPE_LOW_BOUND (range))
+ return 0;
+ previous_high = TYPE_HIGH_BOUND (range);
+ }
+ return len>0;
+ }
+ return 0;
+}
+
+/* m2_get_discrete_bounds - a wrapper for get_discrete_bounds which
+ understands that CHARs might be signed.
+ This should be integrated into gdbtypes.c
+ inside get_discrete_bounds. */
+
+static int
+m2_get_discrete_bounds (struct type *type, LONGEST *lowp, LONGEST *highp)
+{
+ type = check_typedef (type);
+ switch (TYPE_CODE (type))
+ {
+ case TYPE_CODE_CHAR:
+ if (TYPE_LENGTH (type) < sizeof (LONGEST))
+ {
+ if (!TYPE_UNSIGNED (type))
+ {
+ *lowp = -(1 << (TYPE_LENGTH (type) * TARGET_CHAR_BIT - 1));
+ *highp = -*lowp - 1;
+ return 0;
+ }
+ }
+ /* fall through */
+ default:
+ return get_discrete_bounds (type, lowp, highp);
+ }
+}
+
+/* m2_is_long_set_of_type - returns TRUE if the long set was declared as
+ SET OF <oftype> of_type is assigned to the
+ subtype. */
+
+int
+m2_is_long_set_of_type (struct type *type, struct type **of_type)
+{
+ int len, i;
+ struct type *range;
+ struct type *target;
+ LONGEST l1, l2;
+ LONGEST h1, h2;
+
+ if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
+ {
+ len = TYPE_NFIELDS (type);
+ i = TYPE_N_BASECLASSES (type);
+ if (len == 0)
+ return 0;
+ range = TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i));
+ target = TYPE_TARGET_TYPE (range);
+
+ l1 = TYPE_LOW_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i)));
+ h1 = TYPE_HIGH_BOUND (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, len-1)));
+ *of_type = target;
+ if (m2_get_discrete_bounds (target, &l2, &h2) >= 0)
+ return (l1 == l2 && h1 == h2);
+ error (_("long_set failed to find discrete bounds for its subtype"));
+ return 0;
+ }
+ error (_("expecting long_set"));
+ return 0;
+}
+
+static int
+m2_long_set (struct type *type, struct ui_file *stream, int show, int level,
+ const struct type_print_options *flags)
+{
+ struct type *of_type;
+ int i;
+ int len = TYPE_NFIELDS (type);
+ LONGEST low;
+ LONGEST high;
+
+ if (m2_is_long_set (type))
+ {
+ if (TYPE_NAME (type) != NULL)
+ {
+ fputs_filtered (TYPE_NAME (type), stream);
+ if (show == 0)
+ return 1;
+ fputs_filtered (" = ", stream);
+ }
+
+ if (get_long_set_bounds (type, &low, &high))
+ {
+ fprintf_filtered(stream, "SET OF ");
+ i = TYPE_N_BASECLASSES (type);
+ if (m2_is_long_set_of_type (type, &of_type))
+ m2_print_type (of_type, "", stream, show - 1, level, flags);
+ else
+ {
+ fprintf_filtered(stream, "[");
+ m2_print_bounds (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, i)),
+ stream, show - 1, level, 0);
+
+ fprintf_filtered(stream, "..");
+
+ m2_print_bounds (TYPE_INDEX_TYPE (TYPE_FIELD_TYPE (type, len-1)),
+ stream, show - 1, level, 1);
+ fprintf_filtered(stream, "]");
+ }
+ }
+ else
+ /* i18n: Do not translate the "SET OF" part! */
+ fprintf_filtered(stream, _("SET OF <unknown>"));
+
+ return 1;
+ }
+ return 0;
+}
+
+/* m2_is_unbounded_array - returns TRUE if, type, should be regarded
+ as a Modula-2 unbounded ARRAY type. */
+
+int
+m2_is_unbounded_array (struct type *type)
+{
+ if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
+ {
+ /*
+ * check if we have a structure with exactly two fields named
+ * _m2_contents and _m2_high. It also checks to see if the
+ * type of _m2_contents is a pointer. The TYPE_TARGET_TYPE
+ * of the pointer determines the unbounded ARRAY OF type.
+ */
+ if (TYPE_NFIELDS (type) != 2)
+ return 0;
+ if (strcmp (TYPE_FIELD_NAME (type, 0), "_m2_contents") != 0)
+ return 0;
+ if (strcmp (TYPE_FIELD_NAME (type, 1), "_m2_high") != 0)
+ return 0;
+ if (TYPE_CODE (TYPE_FIELD_TYPE (type, 0)) != TYPE_CODE_PTR)
+ return 0;
+ return 1;
+ }
+ return 0;
+}
+
+/* m2_unbounded_array - if the struct type matches a Modula-2 unbounded
+ parameter type then display the type as an
+ ARRAY OF type. Returns TRUE if an unbounded
+ array type was detected. */
+
+static int
+m2_unbounded_array (struct type *type, struct ui_file *stream, int show,
+ int level, const struct type_print_options *flags)
+{
+ if (m2_is_unbounded_array (type))
+ {
+ if (show > 0)
+ {
+ fputs_filtered ("ARRAY OF ", stream);
+ m2_print_type (TYPE_TARGET_TYPE (TYPE_FIELD_TYPE (type, 0)),
+ "", stream, 0, level, flags);
+ }
+ return 1;
+ }
+ return 0;
+}
+
+void
+m2_record_fields (struct type *type, struct ui_file *stream, int show,
+ int level, const struct type_print_options *flags)
+{
+ /* Print the tag if it exists. */
+ if (TYPE_NAME (type) != NULL)
+ {
+ if (!startswith (TYPE_NAME (type), "$$"))
+ {
+ fputs_filtered (TYPE_NAME (type), stream);
+ if (show > 0)
+ fprintf_filtered (stream, " = ");
+ }
+ }
+ wrap_here (" ");
+ if (show < 0)
+ {
+ if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
+ fprintf_filtered (stream, "RECORD ... END ");
+ else if (TYPE_CODE (type) == TYPE_CODE_UNION)
+ fprintf_filtered (stream, "CASE ... END ");
+ }
+ else if (show > 0)
+ {
+ int i;
+ int len = TYPE_NFIELDS (type);
+
+ if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
+ fprintf_filtered (stream, "RECORD\n");
+ else if (TYPE_CODE (type) == TYPE_CODE_UNION)
+ /* i18n: Do not translate "CASE" and "OF". */
+ fprintf_filtered (stream, _("CASE <variant> OF\n"));
+
+ for (i = TYPE_N_BASECLASSES (type); i < len; i++)
+ {
+ QUIT;
+
+ print_spaces_filtered (level + 4, stream);
+ fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
+ fputs_filtered (" : ", stream);
+ m2_print_type (TYPE_FIELD_TYPE (type, i),
+ "",
+ stream, 0, level + 4, flags);
+ if (TYPE_FIELD_PACKED (type, i))
+ {
+ /* It is a bitfield. This code does not attempt
+ to look at the bitpos and reconstruct filler,
+ unnamed fields. This would lead to misleading
+ results if the compiler does not put out fields
+ for such things (I don't know what it does). */
+ fprintf_filtered (stream, " : %d",
+ TYPE_FIELD_BITSIZE (type, i));
+ }
+ fprintf_filtered (stream, ";\n");
+ }
+
+ fprintfi_filtered (level, stream, "END ");
+ }
+}