int f77_get_dynamic_lowerbound (struct type *type, int *lower_bound) { CORE_ADDR current_frame_addr; CORE_ADDR ptr_to_lower_bound; switch (TYPE_ARRAY_LOWER_BOUND_TYPE (type)) { case BOUND_BY_VALUE_ON_STACK: current_frame_addr = get_frame_base (deprecated_selected_frame); if (current_frame_addr > 0) { *lower_bound = read_memory_integer (current_frame_addr + TYPE_ARRAY_LOWER_BOUND_VALUE (type), 4); } else { *lower_bound = DEFAULT_LOWER_BOUND; return BOUND_FETCH_ERROR; } break; case BOUND_SIMPLE: *lower_bound = TYPE_ARRAY_LOWER_BOUND_VALUE (type); break; case BOUND_CANNOT_BE_DETERMINED: error ("Lower bound may not be '*' in F77"); break; case BOUND_BY_REF_ON_STACK: current_frame_addr = get_frame_base (deprecated_selected_frame); if (current_frame_addr > 0) { ptr_to_lower_bound = read_memory_typed_address (current_frame_addr + TYPE_ARRAY_LOWER_BOUND_VALUE (type), builtin_type_void_data_ptr); *lower_bound = read_memory_integer (ptr_to_lower_bound, 4); } else { *lower_bound = DEFAULT_LOWER_BOUND; return BOUND_FETCH_ERROR; } break; case BOUND_BY_REF_IN_REG: case BOUND_BY_VALUE_IN_REG: default: error ("??? unhandled dynamic array bound type ???"); break; } return BOUND_FETCH_OK; }
int f77_get_lowerbound (struct type *type) { if (TYPE_ARRAY_LOWER_BOUND_IS_UNDEFINED (type)) error (_("Lower bound may not be '*' in F77")); return TYPE_ARRAY_LOWER_BOUND_VALUE (type); }
void pascal_type_print_varspec_prefix (struct type *type, struct ui_file *stream, int show, int passed_a_ptr) { char *name; if (type == 0) return; if (TYPE_NAME (type) && show <= 0) return; QUIT; switch (TYPE_CODE (type)) { case TYPE_CODE_PTR: fprintf_filtered (stream, "^"); pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1); break; /* pointer should be handled normally in pascal */ case TYPE_CODE_MEMBER: if (passed_a_ptr) fprintf_filtered (stream, "("); pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0); fprintf_filtered (stream, " "); name = type_name_no_tag (TYPE_DOMAIN_TYPE (type)); if (name) fputs_filtered (name, stream); else pascal_type_print_base (TYPE_DOMAIN_TYPE (type), stream, 0, passed_a_ptr); fprintf_filtered (stream, "::"); break; case TYPE_CODE_METHOD: if (passed_a_ptr) fprintf_filtered (stream, "("); if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID) { fprintf_filtered (stream, "function "); } else { fprintf_filtered (stream, "procedure "); } if (passed_a_ptr) { fprintf_filtered (stream, " "); pascal_type_print_base (TYPE_DOMAIN_TYPE (type), stream, 0, passed_a_ptr); fprintf_filtered (stream, "::"); } break; case TYPE_CODE_REF: pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1); fprintf_filtered (stream, "&"); break; case TYPE_CODE_FUNC: if (passed_a_ptr) fprintf_filtered (stream, "("); if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID) { fprintf_filtered (stream, "function "); } else { fprintf_filtered (stream, "procedure "); } break; case TYPE_CODE_ARRAY: if (passed_a_ptr) fprintf_filtered (stream, "("); fprintf_filtered (stream, "array "); if (TYPE_LENGTH (type) >= 0 && TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0 && TYPE_ARRAY_UPPER_BOUND_TYPE (type) != BOUND_CANNOT_BE_DETERMINED) fprintf_filtered (stream, "[%d..%d] ", TYPE_ARRAY_LOWER_BOUND_VALUE (type), TYPE_ARRAY_UPPER_BOUND_VALUE (type) ); fprintf_filtered (stream, "of "); break; case TYPE_CODE_UNDEF: case TYPE_CODE_STRUCT: case TYPE_CODE_UNION: case TYPE_CODE_ENUM: case TYPE_CODE_INT: case TYPE_CODE_FLT: case TYPE_CODE_VOID: case TYPE_CODE_ERROR: case TYPE_CODE_CHAR: case TYPE_CODE_BOOL: case TYPE_CODE_SET: case TYPE_CODE_RANGE: case TYPE_CODE_STRING: case TYPE_CODE_BITSTRING: case TYPE_CODE_COMPLEX: case TYPE_CODE_TYPEDEF: case TYPE_CODE_TEMPLATE: /* These types need no prefix. They are listed here so that gcc -Wall will reveal any types that haven't been handled. */ break; default: error (_("type not handled in pascal_type_print_varspec_prefix()")); break; } }
void pascal_type_print_varspec_prefix (struct type *type, struct ui_file *stream, int show, int passed_a_ptr, const struct type_print_options *flags) { if (type == 0) return; if (TYPE_NAME (type) && show <= 0) return; QUIT; switch (TYPE_CODE (type)) { case TYPE_CODE_PTR: fprintf_filtered (stream, "^"); pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1, flags); break; /* Pointer should be handled normally in pascal. */ case TYPE_CODE_METHOD: if (passed_a_ptr) fprintf_filtered (stream, "("); if (TYPE_TARGET_TYPE (type) != NULL && TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID) { fprintf_filtered (stream, "function "); } else { fprintf_filtered (stream, "procedure "); } if (passed_a_ptr) { fprintf_filtered (stream, " "); pascal_type_print_base (TYPE_SELF_TYPE (type), stream, 0, passed_a_ptr, flags); fprintf_filtered (stream, "::"); } break; case TYPE_CODE_REF: pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1, flags); fprintf_filtered (stream, "&"); break; case TYPE_CODE_FUNC: if (passed_a_ptr) fprintf_filtered (stream, "("); if (TYPE_TARGET_TYPE (type) != NULL && TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID) { fprintf_filtered (stream, "function "); } else { fprintf_filtered (stream, "procedure "); } break; case TYPE_CODE_ARRAY: if (passed_a_ptr) fprintf_filtered (stream, "("); fprintf_filtered (stream, "array "); if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0 && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type)) fprintf_filtered (stream, "[%s..%s] ", plongest (TYPE_ARRAY_LOWER_BOUND_VALUE (type)), plongest (TYPE_ARRAY_UPPER_BOUND_VALUE (type))); fprintf_filtered (stream, "of "); break; case TYPE_CODE_UNDEF: case TYPE_CODE_STRUCT: case TYPE_CODE_UNION: case TYPE_CODE_ENUM: case TYPE_CODE_INT: case TYPE_CODE_FLT: case TYPE_CODE_VOID: case TYPE_CODE_ERROR: case TYPE_CODE_CHAR: case TYPE_CODE_BOOL: case TYPE_CODE_SET: case TYPE_CODE_RANGE: case TYPE_CODE_STRING: case TYPE_CODE_COMPLEX: case TYPE_CODE_TYPEDEF: /* These types need no prefix. They are listed here so that gcc -Wall will reveal any types that haven't been handled. */ break; default: error (_("type not handled in pascal_type_print_varspec_prefix()")); break; } }