From d74b97cc7e574d56c7542f40a76b151e7088829b Mon Sep 17 00:00:00 2001 From: Francois-Xavier Coudert Date: Mon, 3 Sep 2007 16:44:15 +0000 Subject: [PATCH] re PR fortran/31675 (Fortran front-end and libgfortran should have a common header file) PR fortran/31675 * libgfortran.h: New file. * iso-fortran-env.def: Use macros in the new header instead of hardcoded integer constants. * Make-lang.in (F95_PARSER_OBJS, GFORTRAN_TRANS_DEPS): Add fortran/libgfortran.h. * gfortran.h (GFC_STD_*, GFC_FPE_*, options_convert, ioerror_codes): Remove. * trans.c (ERROR_ALLOCATION): Remove. (gfc_call_malloc, gfc_allocate_with_status, gfc_allocate_array_with_status): Use LIBERROR_ALLOCATION. * trans-types.h (GFC_DTYPE_*): Remove. * trans-decl.c (gfc_generate_function_code): Use GFC_CONVERT_NATIVE instead of CONVERT_NATIVE. * trans-io.c (set_parameter_value, set_parameter_ref): Use LIBERROR_* macros instead of IOERROR_ macros. * trans-intrinsic.c (gfc_conv_intrinsic_function): Use LIBERROR_END and LIBERROR_EOR instead of hardcoded constants. * options.c (gfc_init_options): Use GFC_CONVERT_NATIVE instead of CONVERT_NATIVE. (gfc_handle_option): Use GFC_CONVERT_* macros instead of CONVERT_*. * libgfortran.h: Include gcc/fortran/libgfortran.h. Remove M_PI, GFC_MAX_DIMENSIONS, GFC_DTYPE_*, GFC_NUM_RANK_BITS, error_codes, GFC_STD_*, GFC_FPE_* and unit_convert. * runtime/environ.c (variable_table): Use GFC_*_UNIT_NUMBER instead of hardcoded constants. (do_parse, init_unformatted): Use GFC_CONVERT_* macros instead of CONVERT_*. * runtime/string.c (find_option): Use LIBERROR_BAD_OPTION instead of ERROR_BAD_OPTION. * runtime/error.c (translate_error, generate_error): Use LIBERROR_* macros instead of ERROR_*. * io/file_pos.c (formatted_backspace, unformatted_backspace, st_backspace, st_rewind, st_flush): Rename macros. * io/open.c (convert_opt, edit_modes, new_unit, already_open, st_open): Likewise. * io/close.c (st_close): Likewise. * io/list_read.c (next_char, convert_integer, parse_repeat, read_logical, read_integer, read_character, parse_real, check_type, list_formatted_read_scalar, namelist_read, nml_err_ret): Likewise. * io/read.c (convert_real, read_l, read_decimal, read_radix, read_f): Likewise. * io/inquire.c (inquire_via_unit): Likewise. * io/unit.c (get_internal_unit): Likewise. * io/transfer.c (read_sf, read_block, read_block_direct, write_block, write_buf, unformatted_read, unformatted_write, formatted_transfer_scalar, us_read, us_write, data_transfer_init, skip_record, next_record_r, write_us_marker, next_record_w_unf, next_record_w, finalize_transfer, st_read, st_write_done): Likewise. * io/format.c (format_error): Likewise. From-SVN: r128050 --- gcc/fortran/ChangeLog | 24 +++++++ gcc/fortran/Make-lang.in | 6 +- gcc/fortran/gfortran.h | 65 ++--------------- gcc/fortran/iso-fortran-env.def | 10 +-- gcc/fortran/libgfortran.h | 108 ++++++++++++++++++++++++++++ gcc/fortran/options.c | 10 +-- gcc/fortran/trans-decl.c | 2 +- gcc/fortran/trans-intrinsic.c | 4 +- gcc/fortran/trans-io.c | 27 +++---- gcc/fortran/trans-types.h | 16 ----- gcc/fortran/trans.c | 17 ++--- libgfortran/ChangeLog | 35 +++++++++ libgfortran/io/close.c | 2 +- libgfortran/io/file_pos.c | 16 ++--- libgfortran/io/format.c | 2 +- libgfortran/io/inquire.c | 4 +- libgfortran/io/list_read.c | 36 +++++----- libgfortran/io/open.c | 70 +++++++++--------- libgfortran/io/read.c | 14 ++-- libgfortran/io/transfer.c | 156 ++++++++++++++++++++-------------------- libgfortran/io/unit.c | 2 +- libgfortran/libgfortran.h | 89 ++--------------------- libgfortran/runtime/environ.c | 33 ++++----- libgfortran/runtime/error.c | 48 ++++++------- libgfortran/runtime/string.c | 2 +- 25 files changed, 400 insertions(+), 398 deletions(-) create mode 100644 gcc/fortran/libgfortran.h diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 3b3d469..ce57c13 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,27 @@ +2007-09-03 Francois-Xavier Coudert + + PR fortran/31675 + * libgfortran.h: New file. + * iso-fortran-env.def: Use macros in the new header instead of + hardcoded integer constants. + * Make-lang.in (F95_PARSER_OBJS, GFORTRAN_TRANS_DEPS): Add + fortran/libgfortran.h. + * gfortran.h (GFC_STD_*, GFC_FPE_*, options_convert, + ioerror_codes): Remove. + * trans.c (ERROR_ALLOCATION): Remove. + (gfc_call_malloc, gfc_allocate_with_status, + gfc_allocate_array_with_status): Use LIBERROR_ALLOCATION. + * trans-types.h (GFC_DTYPE_*): Remove. + * trans-decl.c (gfc_generate_function_code): Use + GFC_CONVERT_NATIVE instead of CONVERT_NATIVE. + * trans-io.c (set_parameter_value, set_parameter_ref): Use + LIBERROR_* macros instead of IOERROR_ macros. + * trans-intrinsic.c (gfc_conv_intrinsic_function): Use + LIBERROR_END and LIBERROR_EOR instead of hardcoded constants. + * options.c (gfc_init_options): Use GFC_CONVERT_NATIVE instead of + CONVERT_NATIVE. + (gfc_handle_option): Use GFC_CONVERT_* macros instead of CONVERT_*. + 2007-09-02 Steven G. Kargl * invoke.texi: Fix the -frange-checking option entry. diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in index 30320a8..c217b02 100644 --- a/gcc/fortran/Make-lang.in +++ b/gcc/fortran/Make-lang.in @@ -289,14 +289,16 @@ fortran.stagefeedback: stageprofile-start # which objects depend on what. FIXME # TODO: Add dependencies on the backend/tree header files -$(F95_PARSER_OBJS): fortran/gfortran.h fortran/intrinsic.h fortran/match.h \ +$(F95_PARSER_OBJS): fortran/gfortran.h fortran/libgfortran.h \ + fortran/intrinsic.h fortran/match.h \ fortran/parse.h fortran/arith.h fortran/target-memory.h \ $(CONFIG_H) $(SYSTEM_H) $(TM_H) $(TM_P_H) coretypes.h \ $(RTL_H) $(TREE_H) $(TREE_DUMP_H) $(GGC_H) $(EXPR_H) \ $(FLAGS_H) output.h $(DIAGNOSTIC_H) errors.h $(FUNCTION_H) fortran/openmp.o: pointer-set.h $(TARGET_H) toplev.h -GFORTRAN_TRANS_DEPS = fortran/gfortran.h fortran/intrinsic.h fortran/trans-array.h \ +GFORTRAN_TRANS_DEPS = fortran/gfortran.h fortran/libgfortran.h \ + fortran/intrinsic.h fortran/trans-array.h \ fortran/trans-const.h fortran/trans-const.h fortran/trans.h \ fortran/trans-stmt.h fortran/trans-types.h \ $(CONFIG_H) $(SYSTEM_H) $(TREE_H) $(TM_H) coretypes.h $(GGC_H) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 5c8c56d..b9c6c31 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -28,6 +28,11 @@ along with GCC; see the file COPYING3. If not see multiple header files. Besides, Microsoft's winnt.h was 250k last time I looked, so by comparison this is perfectly reasonable. */ +/* Declarations common to the front-end and library are put in + libgfortran/libgfortran_frontend.h */ +#include "libgfortran.h" + + #include "system.h" #include "intl.h" #include "coretypes.h" @@ -57,7 +62,6 @@ char *alloca (); #define GFC_MAX_SYMBOL_LEN 63 /* Must be at least 63 for F2003. */ #define GFC_MAX_BINDING_LABEL_LEN 126 /* (2 * GFC_MAX_SYMBOL_LEN) */ #define GFC_MAX_LINE 132 /* Characters beyond this are not seen. */ -#define GFC_MAX_DIMENSIONS 7 /* Maximum dimensions in an array. */ #define GFC_LETTERS 26 /* Number of letters in the alphabet. */ #define MAX_SUBRECORD_LENGTH 2147483639 /* 2**31-9 */ @@ -96,33 +100,6 @@ typedef struct mstring; -/* Flags to specify which standard/extension contains a feature. */ -#define GFC_STD_LEGACY (1<<6) /* Backward compatibility. */ -#define GFC_STD_GNU (1<<5) /* GNU Fortran extension. */ -#define GFC_STD_F2003 (1<<4) /* New in F2003. */ -/* Note that no additional features were deleted or made obsolescent - in F2003. */ -#define GFC_STD_F95 (1<<3) /* New in F95. */ -#define GFC_STD_F95_DEL (1<<2) /* Deleted in F95. */ -#define GFC_STD_F95_OBS (1<<1) /* Obsolescent in F95. */ -#define GFC_STD_F77 (1<<0) /* Included in F77, but not - deleted or obsolescent in - later standards. */ - -/* Bitmasks for the various FPE that can be enabled. */ -#define GFC_FPE_INVALID (1<<0) -#define GFC_FPE_DENORMAL (1<<1) -#define GFC_FPE_ZERO (1<<2) -#define GFC_FPE_OVERFLOW (1<<3) -#define GFC_FPE_UNDERFLOW (1<<4) -#define GFC_FPE_PRECISION (1<<5) - -/* Keep this in sync with libgfortran/io/io.h ! */ - -typedef enum - { CONVERT_NATIVE=0, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE } -options_convert; - /*************************** Enums *****************************/ @@ -532,38 +509,6 @@ enum gfc_isym_id }; typedef enum gfc_isym_id gfc_isym_id; -/* Runtime errors. The EOR and EOF errors are required to be negative. - These codes must be kept synchronized with their equivalents in - libgfortran/libgfortran.h . */ - -typedef enum -{ - IOERROR_FIRST = -3, /* Marker for the first error. */ - IOERROR_EOR = -2, - IOERROR_END = -1, - IOERROR_OK = 0, /* Indicates success, must be zero. */ - IOERROR_OS = 5000, /* Operating system error, more info in errno. */ - IOERROR_OPTION_CONFLICT, - IOERROR_BAD_OPTION, - IOERROR_MISSING_OPTION, - IOERROR_ALREADY_OPEN, - IOERROR_BAD_UNIT, - IOERROR_FORMAT, - IOERROR_BAD_ACTION, - IOERROR_ENDFILE, - IOERROR_BAD_US, - IOERROR_READ_VALUE, - IOERROR_READ_OVERFLOW, - IOERROR_INTERNAL, - IOERROR_INTERNAL_UNIT, - IOERROR_ALLOCATION, - IOERROR_DIRECT_EOR, - IOERROR_SHORT_RECORD, - IOERROR_CORRUPT_FILE, - IOERROR_LAST /* Not a real error, the last error # + 1. */ -} -ioerror_codes; - /************************* Structures *****************************/ diff --git a/gcc/fortran/iso-fortran-env.def b/gcc/fortran/iso-fortran-env.def index c45f7a5..8ef5597 100644 --- a/gcc/fortran/iso-fortran-env.def +++ b/gcc/fortran/iso-fortran-env.def @@ -26,11 +26,11 @@ along with GCC; see the file COPYING3. If not see NAMED_INTCST (ISOFORTRANENV_CHARACTER_STORAGE_SIZE, "character_storage_size", \ gfc_character_storage_size) -NAMED_INTCST (ISOFORTRANENV_ERROR_UNIT, "error_unit", 0) +NAMED_INTCST (ISOFORTRANENV_ERROR_UNIT, "error_unit", GFC_STDERR_UNIT_NUMBER) NAMED_INTCST (ISOFORTRANENV_FILE_STORAGE_SIZE, "file_storage_size", 8) -NAMED_INTCST (ISOFORTRANENV_INPUT_UNIT, "input_unit", 5) -NAMED_INTCST (ISOFORTRANENV_IOSTAT_END, "iostat_end", -1) -NAMED_INTCST (ISOFORTRANENV_IOSTAT_EOR, "iostat_eor", -2) +NAMED_INTCST (ISOFORTRANENV_INPUT_UNIT, "input_unit", GFC_STDIN_UNIT_NUMBER) +NAMED_INTCST (ISOFORTRANENV_IOSTAT_END, "iostat_end", LIBERROR_END) +NAMED_INTCST (ISOFORTRANENV_IOSTAT_EOR, "iostat_eor", LIBERROR_EOR) NAMED_INTCST (ISOFORTRANENV_NUMERIC_STORAGE_SIZE, "numeric_storage_size", \ gfc_numeric_storage_size) -NAMED_INTCST (ISOFORTRANENV_OUTPUT_UNIT, "output_unit", 6) +NAMED_INTCST (ISOFORTRANENV_OUTPUT_UNIT, "output_unit", GFC_STDOUT_UNIT_NUMBER) diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h new file mode 100644 index 0000000..d9bfa05 --- /dev/null +++ b/gcc/fortran/libgfortran.h @@ -0,0 +1,108 @@ +/* Header file to the Fortran front-end and runtime library + Copyright (C) 2007 Free Software Foundation, Inc. + +This file is part of GCC. + +GCC is free software; you can redistribute it and/or modify it under +the terms of the GNU General Public License as published by the Free +Software Foundation; either version 3, or (at your option) any later +version. + +GCC is distributed in the hope that it will be useful, but WITHOUT ANY +WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with GCC; see the file COPYING3. If not see +. */ + + +/* Flags to specify which standard/extension contains a feature. + Note that no features were obsoleted nor deleted in F2003. */ +#define GFC_STD_LEGACY (1<<6) /* Backward compatibility. */ +#define GFC_STD_GNU (1<<5) /* GNU Fortran extension. */ +#define GFC_STD_F2003 (1<<4) /* New in F2003. */ +#define GFC_STD_F95 (1<<3) /* New in F95. */ +#define GFC_STD_F95_DEL (1<<2) /* Deleted in F95. */ +#define GFC_STD_F95_OBS (1<<1) /* Obsolescent in F95. */ +#define GFC_STD_F77 (1<<0) /* Included in F77, but not deleted or + obsolescent in later standards. */ + + +/* Bitmasks for the various FPE that can be enabled. */ +#define GFC_FPE_INVALID (1<<0) +#define GFC_FPE_DENORMAL (1<<1) +#define GFC_FPE_ZERO (1<<2) +#define GFC_FPE_OVERFLOW (1<<3) +#define GFC_FPE_UNDERFLOW (1<<4) +#define GFC_FPE_PRECISION (1<<5) + + +/* Possible values for the CONVERT I/O specifier. */ +typedef enum +{ + GFC_CONVERT_NONE = -1, + GFC_CONVERT_NATIVE = 0, + GFC_CONVERT_SWAP, + GFC_CONVERT_BIG, + GFC_CONVERT_LITTLE +} +unit_convert; + + +/* Runtime errors. */ +typedef enum +{ + LIBERROR_FIRST = -3, /* Marker for the first error. */ + LIBERROR_EOR = -2, /* End of record, must be negative. */ + LIBERROR_END = -1, /* End of file, must be negative. */ + LIBERROR_OK = 0, /* Indicates success, must be zero. */ + LIBERROR_OS = 5000, /* OS error, more info in errno. */ + LIBERROR_OPTION_CONFLICT, + LIBERROR_BAD_OPTION, + LIBERROR_MISSING_OPTION, + LIBERROR_ALREADY_OPEN, + LIBERROR_BAD_UNIT, + LIBERROR_FORMAT, + LIBERROR_BAD_ACTION, + LIBERROR_ENDFILE, + LIBERROR_BAD_US, + LIBERROR_READ_VALUE, + LIBERROR_READ_OVERFLOW, + LIBERROR_INTERNAL, + LIBERROR_INTERNAL_UNIT, + LIBERROR_ALLOCATION, + LIBERROR_DIRECT_EOR, + LIBERROR_SHORT_RECORD, + LIBERROR_CORRUPT_FILE, + LIBERROR_LAST /* Not a real error, the last error # + 1. */ +} +libgfortran_error_codes; + + +/* Default unit number for preconnected standard input and output. */ +#define GFC_STDIN_UNIT_NUMBER 5 +#define GFC_STDOUT_UNIT_NUMBER 6 +#define GFC_STDERR_UNIT_NUMBER 0 + + +#define GFC_MAX_DIMENSIONS 7 + +#define GFC_DTYPE_RANK_MASK 0x07 +#define GFC_DTYPE_TYPE_SHIFT 3 +#define GFC_DTYPE_TYPE_MASK 0x38 +#define GFC_DTYPE_SIZE_SHIFT 6 + +enum +{ + GFC_DTYPE_UNKNOWN = 0, + GFC_DTYPE_INTEGER, + /* TODO: recognize logical types. */ + GFC_DTYPE_LOGICAL, + GFC_DTYPE_REAL, + GFC_DTYPE_COMPLEX, + GFC_DTYPE_DERIVED, + GFC_DTYPE_CHARACTER +}; + diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c index 3ab7362..a68c3be 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.c @@ -62,7 +62,7 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, gfc_option.max_continue_free = 39; gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN; gfc_option.max_subrecord_length = 0; - gfc_option.convert = CONVERT_NATIVE; + gfc_option.convert = GFC_CONVERT_NATIVE; gfc_option.record_marker = 0; gfc_option.verbose = 0; @@ -704,19 +704,19 @@ gfc_handle_option (size_t scode, const char *arg, int value) break; case OPT_fconvert_little_endian: - gfc_option.convert = CONVERT_LITTLE; + gfc_option.convert = GFC_CONVERT_LITTLE; break; case OPT_fconvert_big_endian: - gfc_option.convert = CONVERT_BIG; + gfc_option.convert = GFC_CONVERT_BIG; break; case OPT_fconvert_native: - gfc_option.convert = CONVERT_NATIVE; + gfc_option.convert = GFC_CONVERT_NATIVE; break; case OPT_fconvert_swap: - gfc_option.convert = CONVERT_SWAP; + gfc_option.convert = GFC_CONVERT_SWAP; break; case OPT_frecord_marker_4: diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 109a187..0b70903 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -3212,7 +3212,7 @@ gfc_generate_function_code (gfc_namespace * ns) /* If this is the main program and an -fconvert option was provided, add a call to set_convert. */ - if (sym->attr.is_main_program && gfc_option.convert != CONVERT_NATIVE) + if (sym->attr.is_main_program && gfc_option.convert != GFC_CONVERT_NATIVE) { tmp = build_call_expr (gfor_fndecl_set_convert, 1, build_int_cst (integer_type_node, diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 3c43a84..ebe8555 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -3928,11 +3928,11 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) break; case GFC_ISYM_IS_IOSTAT_END: - gfc_conv_has_intvalue (se, expr, -1); + gfc_conv_has_intvalue (se, expr, LIBERROR_END); break; case GFC_ISYM_IS_IOSTAT_EOR: - gfc_conv_has_intvalue (se, expr, -2); + gfc_conv_has_intvalue (se, expr, LIBERROR_EOR); break; case GFC_ISYM_ISNAN: diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 80646cd..289c2d2 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -457,18 +457,15 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type, if (type == IOPARM_common_unit && e->ts.kind != 4) { tree cond, max; - ioerror_codes bad_unit; int i; - bad_unit = IOERROR_BAD_UNIT; - /* Don't evaluate the UNIT number multiple times. */ se.expr = gfc_evaluate_now (se.expr, &se.pre); /* UNIT numbers should be nonnegative. */ cond = fold_build2 (LT_EXPR, boolean_type_node, se.expr, build_int_cst (TREE_TYPE (se.expr),0)); - gfc_trans_io_runtime_check (cond, var, bad_unit, + gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT, "Negative unit number in I/O statement", &se.pre); @@ -477,7 +474,7 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type, max = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4); cond = fold_build2 (GT_EXPR, boolean_type_node, se.expr, fold_convert (TREE_TYPE (se.expr), max)); - gfc_trans_io_runtime_check (cond, var, bad_unit, + gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT, "Unit number in I/O statement too large", &se.pre); @@ -519,14 +516,10 @@ set_parameter_ref (stmtblock_t *block, stmtblock_t *postblock, addr = convert (TREE_TYPE (p->field), build_fold_addr_expr (se.expr)); /* If this is for the iostat variable initialize the - user variable to IOERROR_OK which is zero. */ + user variable to LIBERROR_OK which is zero. */ if (type == IOPARM_common_iostat) - { - ioerror_codes ok; - ok = IOERROR_OK; - gfc_add_modify_expr (block, se.expr, - build_int_cst (TREE_TYPE (se.expr), ok)); - } + gfc_add_modify_expr (block, se.expr, + build_int_cst (TREE_TYPE (se.expr), LIBERROR_OK)); } else { @@ -537,14 +530,10 @@ set_parameter_ref (stmtblock_t *block, stmtblock_t *postblock, st_parameter_field[type].name); /* If this is for the iostat variable, initialize the - user variable to IOERROR_OK which is zero. */ + user variable to LIBERROR_OK which is zero. */ if (type == IOPARM_common_iostat) - { - ioerror_codes ok; - ok = IOERROR_OK; - gfc_add_modify_expr (block, tmpvar, - build_int_cst (TREE_TYPE (tmpvar), ok)); - } + gfc_add_modify_expr (block, tmpvar, + build_int_cst (TREE_TYPE (tmpvar), LIBERROR_OK)); addr = build_fold_addr_expr (tmpvar); /* After the I/O operation, we set the variable from the temporary. */ diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index 0650d7e..7a0e9bf 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -24,22 +24,6 @@ along with GCC; see the file COPYING3. If not see #ifndef GFC_BACKEND_H #define GFC_BACKEND_H -#define GFC_DTYPE_RANK_MASK 0x07 -#define GFC_DTYPE_TYPE_SHIFT 3 -#define GFC_DTYPE_TYPE_MASK 0x38 -#define GFC_DTYPE_SIZE_SHIFT 6 - -enum -{ - GFC_DTYPE_UNKNOWN = 0, - GFC_DTYPE_INTEGER, - GFC_DTYPE_LOGICAL, - GFC_DTYPE_REAL, - GFC_DTYPE_COMPLEX, - GFC_DTYPE_DERIVED, - GFC_DTYPE_CHARACTER -}; - extern GTY(()) tree gfc_array_index_type; extern GTY(()) tree gfc_array_range_type; extern GTY(()) tree gfc_character1_type_node; diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 1113e80..b9fd2df 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -473,11 +473,6 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) return res; } -/* The status variable of allocate statement is set to ERROR_ALLOCATION - when the allocation wasn't successful. This value needs to be kept in - sync with libgfortran/libgfortran.h. */ -#define ERROR_ALLOCATION 5014 - /* Allocate memory, using an optional status argument. This function follows the following pseudo-code: @@ -495,7 +490,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) { if (stat) { - *stat = ERROR_ALLOCATION; + *stat = LIBERROR_ALLOCATION; newmem = NULL; } else @@ -508,7 +503,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) if (newmem == NULL) { if (stat) - *stat = ERROR_ALLOCATION; + *stat = LIBERROR_ALLOCATION; else runtime_error ("Out of memory"); } @@ -558,7 +553,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) gfc_start_block (&set_status_block); gfc_add_modify_expr (&set_status_block, build1 (INDIRECT_REF, status_type, status), - build_int_cst (status_type, ERROR_ALLOCATION)); + build_int_cst (status_type, LIBERROR_ALLOCATION)); gfc_add_modify_expr (&set_status_block, res, build_int_cst (pvoid_type_node, 0)); @@ -589,7 +584,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) build_int_cst (status_type, 0)); tmp2 = fold_build2 (MODIFY_EXPR, status_type, build1 (INDIRECT_REF, status_type, status), - build_int_cst (status_type, ERROR_ALLOCATION)); + build_int_cst (status_type, LIBERROR_ALLOCATION)); tmp = fold_build3 (COND_EXPR, void_type_node, cond, tmp, tmp2); } @@ -627,7 +622,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) { free (mem); mem = allocate (size, stat); - *stat = ERROR_ALLOCATION; + *stat = LIBERROR_ALLOCATION; return mem; } else @@ -675,7 +670,7 @@ gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size, gfc_add_modify_expr (&set_status_block, build1 (INDIRECT_REF, status_type, status), - build_int_cst (status_type, ERROR_ALLOCATION)); + build_int_cst (status_type, LIBERROR_ALLOCATION)); tmp = fold_build2 (EQ_EXPR, boolean_type_node, status, build_int_cst (status_type, 0)); diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 405be97..5c02df9 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,38 @@ +2007-09-03 Francois-Xavier Coudert + + PR fortran/31675 + * libgfortran.h: Include gcc/fortran/libgfortran.h. + Remove M_PI, GFC_MAX_DIMENSIONS, GFC_DTYPE_*, GFC_NUM_RANK_BITS, + error_codes, GFC_STD_*, GFC_FPE_* and unit_convert. + * runtime/environ.c (variable_table): Use GFC_*_UNIT_NUMBER instead + of hardcoded constants. + (do_parse, init_unformatted): Use GFC_CONVERT_* macros instead of + CONVERT_*. + * runtime/string.c (find_option): Use LIBERROR_BAD_OPTION instead + of ERROR_BAD_OPTION. + * runtime/error.c (translate_error, generate_error): Use + LIBERROR_* macros instead of ERROR_*. + * io/file_pos.c (formatted_backspace, unformatted_backspace, + st_backspace, st_rewind, st_flush): Rename macros. + * io/open.c (convert_opt, edit_modes, new_unit, already_open, + st_open): Likewise. + * io/close.c (st_close): Likewise. + * io/list_read.c (next_char, convert_integer, parse_repeat, + read_logical, read_integer, read_character, parse_real, + check_type, list_formatted_read_scalar, namelist_read, + nml_err_ret): Likewise. + * io/read.c (convert_real, read_l, read_decimal, read_radix, + read_f): Likewise. + * io/inquire.c (inquire_via_unit): Likewise. + * io/unit.c (get_internal_unit): Likewise. + * io/transfer.c (read_sf, read_block, read_block_direct, + write_block, write_buf, unformatted_read, unformatted_write, + formatted_transfer_scalar, us_read, us_write, data_transfer_init, + skip_record, next_record_r, write_us_marker, next_record_w_unf, + next_record_w, finalize_transfer, st_read, st_write_done): + Likewise. + * io/format.c (format_error): Likewise. + 2007-08-31 Francois-Xavier Coudert * m4/minloc1.m4: Update copyright year and ajust headers order. diff --git a/libgfortran/io/close.c b/libgfortran/io/close.c index 7bd8a3e..eb66f66 100644 --- a/libgfortran/io/close.c +++ b/libgfortran/io/close.c @@ -73,7 +73,7 @@ st_close (st_parameter_close *clp) if (u->flags.status == STATUS_SCRATCH) { if (status == CLOSE_KEEP) - generate_error (&clp->common, ERROR_BAD_OPTION, + generate_error (&clp->common, LIBERROR_BAD_OPTION, "Can't KEEP a scratch file on CLOSE"); #if !HAVE_UNLINK_OPEN_FILE path = (char *) gfc_alloca (u->file_len + 1); diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c index 0a7dd04..c0412e8 100644 --- a/libgfortran/io/file_pos.c +++ b/libgfortran/io/file_pos.c @@ -90,7 +90,7 @@ formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u) return; io_error: - generate_error (&fpp->common, ERROR_OS, NULL); + generate_error (&fpp->common, LIBERROR_OS, NULL); } @@ -122,8 +122,8 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u) if (p == NULL || length_read != length) goto io_error; - /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */ - if (u->flags.convert == CONVERT_NATIVE) + /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */ + if (u->flags.convert == GFC_CONVERT_NATIVE) { switch (length) { @@ -178,7 +178,7 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u) return; io_error: - generate_error (&fpp->common, ERROR_OS, NULL); + generate_error (&fpp->common, LIBERROR_OS, NULL); } @@ -195,7 +195,7 @@ st_backspace (st_parameter_filepos *fpp) u = find_unit (fpp->common.unit); if (u == NULL) { - generate_error (&fpp->common, ERROR_BAD_UNIT, NULL); + generate_error (&fpp->common, LIBERROR_BAD_UNIT, NULL); goto done; } @@ -296,7 +296,7 @@ st_rewind (st_parameter_filepos *fpp) if (u != NULL) { if (u->flags.access == ACCESS_DIRECT) - generate_error (&fpp->common, ERROR_BAD_OPTION, + generate_error (&fpp->common, LIBERROR_BAD_OPTION, "Cannot REWIND a file opened for DIRECT access"); else { @@ -312,7 +312,7 @@ st_rewind (st_parameter_filepos *fpp) u->last_record = 0; if (file_position (u->s) != 0 && sseek (u->s, 0) == FAILURE) - generate_error (&fpp->common, ERROR_OS, NULL); + generate_error (&fpp->common, LIBERROR_OS, NULL); /* Handle special files like /dev/null differently. */ if (!is_special (u->s)) @@ -359,7 +359,7 @@ st_flush (st_parameter_filepos *fpp) } else /* FLUSH on unconnected unit is illegal: F95 std., 9.3.5. */ - generate_error (&fpp->common, ERROR_BAD_OPTION, + generate_error (&fpp->common, LIBERROR_BAD_OPTION, "Specified UNIT in FLUSH is not connected"); library_end (); diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c index 038c80d..0f7a2e5 100644 --- a/libgfortran/io/format.c +++ b/libgfortran/io/format.c @@ -942,7 +942,7 @@ format_error (st_parameter_dt *dtp, const fnode *f, const char *message) *p++ = '^'; *p = '\0'; - generate_error (&dtp->common, ERROR_FORMAT, buffer); + generate_error (&dtp->common, LIBERROR_FORMAT, buffer); } diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c index 84f4683..2c16a3b 100644 --- a/libgfortran/io/inquire.c +++ b/libgfortran/io/inquire.c @@ -302,11 +302,11 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u) switch (u->flags.convert) { /* l8_to_l4_offset is 0 for little-endian, 1 for big-endian. */ - case CONVERT_NATIVE: + case GFC_CONVERT_NATIVE: p = l8_to_l4_offset ? "BIG_ENDIAN" : "LITTLE_ENDIAN"; break; - case CONVERT_SWAP: + case GFC_CONVERT_SWAP: p = l8_to_l4_offset ? "LITTLE_ENDIAN" : "BIG_ENDIAN"; break; diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 68fac2c..b97130b 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -207,7 +207,7 @@ next_char (st_parameter_dt *dtp) check for NULL here is cautionary. */ if (p == NULL) { - generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL); + generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); return '\0'; } @@ -228,7 +228,7 @@ next_char (st_parameter_dt *dtp) { if (p == NULL) { - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); return '\0'; } if (length == 0) @@ -465,7 +465,7 @@ convert_integer (st_parameter_dt *dtp, int length, int negative) sprintf (message, "Zero repeat count in item %d of list input", dtp->u.p.item_count); - generate_error (&dtp->common, ERROR_READ_VALUE, message); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); m = 1; } } @@ -482,7 +482,7 @@ convert_integer (st_parameter_dt *dtp, int length, int negative) dtp->u.p.item_count); free_saved (dtp); - generate_error (&dtp->common, ERROR_READ_VALUE, message); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); return 1; } @@ -529,7 +529,7 @@ parse_repeat (st_parameter_dt *dtp) "Repeat count overflow in item %d of list input", dtp->u.p.item_count); - generate_error (&dtp->common, ERROR_READ_VALUE, message); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); return 1; } @@ -542,7 +542,7 @@ parse_repeat (st_parameter_dt *dtp) "Zero repeat count in item %d of list input", dtp->u.p.item_count); - generate_error (&dtp->common, ERROR_READ_VALUE, message); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); return 1; } @@ -563,7 +563,7 @@ parse_repeat (st_parameter_dt *dtp) free_saved (dtp); sprintf (message, "Bad repeat count in item %d of list input", dtp->u.p.item_count); - generate_error (&dtp->common, ERROR_READ_VALUE, message); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); return 1; } @@ -708,7 +708,7 @@ read_logical (st_parameter_dt *dtp, int length) free_saved (dtp); sprintf (message, "Bad logical value while reading item %d", dtp->u.p.item_count); - generate_error (&dtp->common, ERROR_READ_VALUE, message); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); return; logical_done: @@ -840,7 +840,7 @@ read_integer (st_parameter_dt *dtp, int length) free_saved (dtp); sprintf (message, "Bad integer for item %d in list input", dtp->u.p.item_count); - generate_error (&dtp->common, ERROR_READ_VALUE, message); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); return; @@ -1004,7 +1004,7 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused))) free_saved (dtp); sprintf (message, "Invalid string input in item %d", dtp->u.p.item_count); - generate_error (&dtp->common, ERROR_READ_VALUE, message); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); } } @@ -1123,7 +1123,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length) free_saved (dtp); sprintf (message, "Bad floating point number for item %d", dtp->u.p.item_count); - generate_error (&dtp->common, ERROR_READ_VALUE, message); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); return 1; } @@ -1206,7 +1206,7 @@ eol_2: free_saved (dtp); sprintf (message, "Bad complex value in item %d of list input", dtp->u.p.item_count); - generate_error (&dtp->common, ERROR_READ_VALUE, message); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); } @@ -1421,7 +1421,7 @@ read_real (st_parameter_dt *dtp, int length) free_saved (dtp); sprintf (message, "Bad real number in item %d of list input", dtp->u.p.item_count); - generate_error (&dtp->common, ERROR_READ_VALUE, message); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); } @@ -1439,7 +1439,7 @@ check_type (st_parameter_dt *dtp, bt type, int len) type_name (dtp->u.p.saved_type), type_name (type), dtp->u.p.item_count); - generate_error (&dtp->common, ERROR_READ_VALUE, message); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); return 1; } @@ -1452,7 +1452,7 @@ check_type (st_parameter_dt *dtp, bt type, int len) "Read kind %d %s where kind %d is required for item %d", dtp->u.p.saved_length, type_name (dtp->u.p.saved_type), len, dtp->u.p.item_count); - generate_error (&dtp->common, ERROR_READ_VALUE, message); + generate_error (&dtp->common, LIBERROR_READ_VALUE, message); return 1; } @@ -1478,7 +1478,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, dtp->u.p.eof_jump = &eof_jump; if (setjmp (eof_jump)) { - generate_error (&dtp->common, ERROR_END, NULL); + generate_error (&dtp->common, LIBERROR_END, NULL); goto cleanup; } @@ -2550,7 +2550,7 @@ namelist_read (st_parameter_dt *dtp) if (setjmp (eof_jump)) { dtp->u.p.eof_jump = NULL; - generate_error (&dtp->common, ERROR_END, NULL); + generate_error (&dtp->common, LIBERROR_END, NULL); return; } @@ -2634,6 +2634,6 @@ nml_err_ret: dtp->u.p.eof_jump = NULL; free_saved (dtp); free_line (dtp); - generate_error (&dtp->common, ERROR_READ_VALUE, nml_err_msg); + generate_error (&dtp->common, LIBERROR_READ_VALUE, nml_err_msg); return; } diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c index e4a54ed..0a409ed 100644 --- a/libgfortran/io/open.c +++ b/libgfortran/io/open.c @@ -99,10 +99,10 @@ static const st_option pad_opt[] = static const st_option convert_opt[] = { - { "native", CONVERT_NATIVE}, - { "swap", CONVERT_SWAP}, - { "big_endian", CONVERT_BIG}, - { "little_endian", CONVERT_LITTLE}, + { "native", GFC_CONVERT_NATIVE}, + { "swap", GFC_CONVERT_SWAP}, + { "big_endian", GFC_CONVERT_BIG}, + { "little_endian", GFC_CONVERT_LITTLE}, { NULL, 0} }; @@ -130,24 +130,24 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD && u->flags.status != flags->status) - generate_error (&opp->common, ERROR_BAD_OPTION, + generate_error (&opp->common, LIBERROR_BAD_OPTION, "Cannot change STATUS parameter in OPEN statement"); if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access) - generate_error (&opp->common, ERROR_BAD_OPTION, + generate_error (&opp->common, LIBERROR_BAD_OPTION, "Cannot change ACCESS parameter in OPEN statement"); if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form) - generate_error (&opp->common, ERROR_BAD_OPTION, + generate_error (&opp->common, LIBERROR_BAD_OPTION, "Cannot change FORM parameter in OPEN statement"); if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) && opp->recl_in != u->recl) - generate_error (&opp->common, ERROR_BAD_OPTION, + generate_error (&opp->common, LIBERROR_BAD_OPTION, "Cannot change RECL parameter in OPEN statement"); if (flags->action != ACTION_UNSPECIFIED && u->flags.action != flags->action) - generate_error (&opp->common, ERROR_BAD_OPTION, + generate_error (&opp->common, LIBERROR_BAD_OPTION, "Cannot change ACTION parameter in OPEN statement"); /* Status must be OLD if present. */ @@ -159,24 +159,24 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) notify_std (&opp->common, GFC_STD_GNU, "OPEN statement must have a STATUS of OLD or UNKNOWN"); else - generate_error (&opp->common, ERROR_BAD_OPTION, + generate_error (&opp->common, LIBERROR_BAD_OPTION, "OPEN statement must have a STATUS of OLD or UNKNOWN"); } if (u->flags.form == FORM_UNFORMATTED) { if (flags->delim != DELIM_UNSPECIFIED) - generate_error (&opp->common, ERROR_OPTION_CONFLICT, + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "DELIM parameter conflicts with UNFORMATTED form in " "OPEN statement"); if (flags->blank != BLANK_UNSPECIFIED) - generate_error (&opp->common, ERROR_OPTION_CONFLICT, + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "BLANK parameter conflicts with UNFORMATTED form in " "OPEN statement"); if (flags->pad != PAD_UNSPECIFIED) - generate_error (&opp->common, ERROR_OPTION_CONFLICT, + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "PAD parameter conflicts with UNFORMATTED form in " "OPEN statement"); } @@ -221,7 +221,7 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) break; seek_error: - generate_error (&opp->common, ERROR_OS, NULL); + generate_error (&opp->common, LIBERROR_OS, NULL); break; } @@ -256,7 +256,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) { if (flags->form == FORM_UNFORMATTED) { - generate_error (&opp->common, ERROR_OPTION_CONFLICT, + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "DELIM parameter conflicts with UNFORMATTED form in " "OPEN statement"); goto fail; @@ -269,7 +269,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) { if (flags->form == FORM_UNFORMATTED) { - generate_error (&opp->common, ERROR_OPTION_CONFLICT, + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "BLANK parameter conflicts with UNFORMATTED form in " "OPEN statement"); goto fail; @@ -282,7 +282,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) { if (flags->form == FORM_UNFORMATTED) { - generate_error (&opp->common, ERROR_OPTION_CONFLICT, + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "PAD parameter conflicts with UNFORMATTED form in " "OPEN statement"); goto fail; @@ -291,7 +291,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT) { - generate_error (&opp->common, ERROR_OPTION_CONFLICT, + generate_error (&opp->common, LIBERROR_OPTION_CONFLICT, "ACCESS parameter conflicts with SEQUENTIAL access in " "OPEN statement"); goto fail; @@ -309,14 +309,14 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) if (flags->access == ACCESS_DIRECT && (opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) == 0) { - generate_error (&opp->common, ERROR_MISSING_OPTION, + generate_error (&opp->common, LIBERROR_MISSING_OPTION, "Missing RECL parameter in OPEN statement"); goto fail; } if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) && opp->recl_in <= 0) { - generate_error (&opp->common, ERROR_BAD_OPTION, + generate_error (&opp->common, LIBERROR_BAD_OPTION, "RECL parameter is non-positive in OPEN statement"); goto fail; } @@ -330,7 +330,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) break; } - generate_error (&opp->common, ERROR_BAD_OPTION, + generate_error (&opp->common, LIBERROR_BAD_OPTION, "FILE parameter must not be present in OPEN statement"); goto fail; @@ -366,7 +366,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) && (options.stderr_unit < 0 || u2->unit_number != options.stderr_unit)) { unlock_unit (u2); - generate_error (&opp->common, ERROR_ALREADY_OPEN, NULL); + generate_error (&opp->common, LIBERROR_ALREADY_OPEN, NULL); goto cleanup; } @@ -405,7 +405,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) msg = NULL; } - generate_error (&opp->common, ERROR_OS, msg); + generate_error (&opp->common, LIBERROR_OS, msg); goto cleanup; } @@ -431,7 +431,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) if (flags->position == POSITION_APPEND) { if (sseek (u->s, file_length (u->s)) == FAILURE) - generate_error (&opp->common, ERROR_OS, NULL); + generate_error (&opp->common, LIBERROR_OS, NULL); u->endfile = AT_ENDFILE; } @@ -544,7 +544,7 @@ already_open (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) if (sclose (u->s) == FAILURE) { unlock_unit (u); - generate_error (&opp->common, ERROR_OS, + generate_error (&opp->common, LIBERROR_OS, "Error closing file in OPEN statement"); return; } @@ -624,7 +624,7 @@ st_open (st_parameter_open *opp) conv = get_unformatted_convert (opp->common.unit); - if (conv == CONVERT_NONE) + if (conv == GFC_CONVERT_NONE) { /* Nothing has been set by environment variable, check the convert tag. */ if (cf & IOPARM_OPEN_HAS_CONVERT) @@ -639,16 +639,16 @@ st_open (st_parameter_open *opp) and 1 on big-endian machines. */ switch (conv) { - case CONVERT_NATIVE: - case CONVERT_SWAP: + case GFC_CONVERT_NATIVE: + case GFC_CONVERT_SWAP: break; - case CONVERT_BIG: - conv = l8_to_l4_offset ? CONVERT_NATIVE : CONVERT_SWAP; + case GFC_CONVERT_BIG: + conv = l8_to_l4_offset ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP; break; - case CONVERT_LITTLE: - conv = l8_to_l4_offset ? CONVERT_SWAP : CONVERT_NATIVE; + case GFC_CONVERT_LITTLE: + conv = l8_to_l4_offset ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE; break; default: @@ -659,19 +659,19 @@ st_open (st_parameter_open *opp) flags.convert = conv; if (opp->common.unit < 0) - generate_error (&opp->common, ERROR_BAD_OPTION, + generate_error (&opp->common, LIBERROR_BAD_OPTION, "Bad unit number in OPEN statement"); if (flags.position != POSITION_UNSPECIFIED && flags.access == ACCESS_DIRECT) - generate_error (&opp->common, ERROR_BAD_OPTION, + generate_error (&opp->common, LIBERROR_BAD_OPTION, "Cannot use POSITION with direct access files"); if (flags.access == ACCESS_APPEND) { if (flags.position != POSITION_UNSPECIFIED && flags.position != POSITION_APPEND) - generate_error (&opp->common, ERROR_BAD_OPTION, + generate_error (&opp->common, LIBERROR_BAD_OPTION, "Conflicting ACCESS and POSITION flags in" " OPEN statement"); diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c index 2049cca..8baa357 100644 --- a/libgfortran/io/read.c +++ b/libgfortran/io/read.c @@ -175,7 +175,7 @@ convert_real (st_parameter_dt *dtp, void *dest, const char *buffer, int length) if (errno == EINVAL) { - generate_error (&dtp->common, ERROR_READ_VALUE, + generate_error (&dtp->common, LIBERROR_READ_VALUE, "Error during floating point read"); return 1; } @@ -223,7 +223,7 @@ read_l (st_parameter_dt *dtp, const fnode *f, char *dest, int length) break; default: bad: - generate_error (&dtp->common, ERROR_READ_VALUE, + generate_error (&dtp->common, LIBERROR_READ_VALUE, "Bad value on logical read"); break; } @@ -393,12 +393,12 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length) return; bad: - generate_error (&dtp->common, ERROR_READ_VALUE, + generate_error (&dtp->common, LIBERROR_READ_VALUE, "Bad value during integer read"); return; overflow: - generate_error (&dtp->common, ERROR_READ_OVERFLOW, + generate_error (&dtp->common, LIBERROR_READ_OVERFLOW, "Value overflowed during integer read"); return; } @@ -537,12 +537,12 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length, return; bad: - generate_error (&dtp->common, ERROR_READ_VALUE, + generate_error (&dtp->common, LIBERROR_READ_VALUE, "Bad value during integer read"); return; overflow: - generate_error (&dtp->common, ERROR_READ_OVERFLOW, + generate_error (&dtp->common, LIBERROR_READ_OVERFLOW, "Value overflowed during integer read"); return; } @@ -657,7 +657,7 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length) goto done; bad_float: - generate_error (&dtp->common, ERROR_READ_VALUE, + generate_error (&dtp->common, LIBERROR_READ_VALUE, "Bad value during floating point read"); return; diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 8118707..793f194 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -185,7 +185,7 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error) { if (no_error) break; - generate_error (&dtp->common, ERROR_END, NULL); + generate_error (&dtp->common, LIBERROR_END, NULL); return NULL; } @@ -218,7 +218,7 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error) { if (no_error) break; - generate_error (&dtp->common, ERROR_EOR, NULL); + generate_error (&dtp->common, LIBERROR_EOR, NULL); return NULL; } @@ -275,7 +275,7 @@ read_block (st_parameter_dt *dtp, int *length) if (sseek (dtp->u.p.current_unit->s, dtp->u.p.current_unit->strm_pos - 1) == FAILURE) { - generate_error (&dtp->common, ERROR_END, NULL); + generate_error (&dtp->common, LIBERROR_END, NULL); return NULL; } } @@ -293,7 +293,7 @@ read_block (st_parameter_dt *dtp, int *length) if (dtp->u.p.current_unit->flags.pad == PAD_NO) { /* Not enough data left. */ - generate_error (&dtp->common, ERROR_EOR, NULL); + generate_error (&dtp->common, LIBERROR_EOR, NULL); return NULL; } } @@ -301,7 +301,7 @@ read_block (st_parameter_dt *dtp, int *length) if (dtp->u.p.current_unit->bytes_left == 0) { dtp->u.p.current_unit->endfile = AT_ENDFILE; - generate_error (&dtp->common, ERROR_END, NULL); + generate_error (&dtp->common, LIBERROR_END, NULL); return NULL; } @@ -332,7 +332,7 @@ read_block (st_parameter_dt *dtp, int *length) *length = nread; else { - generate_error (&dtp->common, ERROR_EOR, NULL); + generate_error (&dtp->common, LIBERROR_EOR, NULL); source = NULL; } } @@ -360,7 +360,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) if (sseek (dtp->u.p.current_unit->s, dtp->u.p.current_unit->strm_pos - 1) == FAILURE) { - generate_error (&dtp->common, ERROR_END, NULL); + generate_error (&dtp->common, LIBERROR_END, NULL); return; } @@ -368,7 +368,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) have_read_record = to_read_record; if (sread (dtp->u.p.current_unit->s, buf, &have_read_record) != 0) { - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); return; } @@ -378,7 +378,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) { /* Short read, e.g. if we hit EOF. For stream files, we have to set the end-of-file condition. */ - generate_error (&dtp->common, ERROR_END, NULL); + generate_error (&dtp->common, LIBERROR_END, NULL); return; } return; @@ -403,7 +403,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) if (sread (dtp->u.p.current_unit->s, buf, &to_read_record) != 0) { - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); return; } @@ -417,7 +417,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) if (short_record) { - generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL); + generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); return; } return; @@ -429,7 +429,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) if (dtp->u.p.current_unit->endfile == AT_ENDFILE) { - generate_error (&dtp->common, ERROR_END, NULL); + generate_error (&dtp->common, LIBERROR_END, NULL); return; } @@ -468,7 +468,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) if (sread (dtp->u.p.current_unit->s, buf + have_read_record, &have_read_subrecord) != 0) { - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); return; } @@ -482,7 +482,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) marker would still be present. */ *nbytes = have_read_record; - generate_error (&dtp->common, ERROR_CORRUPT_FILE, NULL); + generate_error (&dtp->common, LIBERROR_CORRUPT_FILE, NULL); return; } @@ -500,7 +500,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) dtp->u.p.current_unit->current_record = 0; next_record_r_unf (dtp, 0); - generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL); + generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); return; } } @@ -514,7 +514,7 @@ read_block_direct (st_parameter_dt *dtp, void *buf, size_t *nbytes) dtp->u.p.current_unit->bytes_left -= have_read_record; if (short_record) { - generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL); + generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); return; } return; @@ -536,7 +536,7 @@ write_block (st_parameter_dt *dtp, int length) if (sseek (dtp->u.p.current_unit->s, dtp->u.p.current_unit->strm_pos - 1) == FAILURE) { - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); return NULL; } } @@ -552,7 +552,7 @@ write_block (st_parameter_dt *dtp, int length) dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; else { - generate_error (&dtp->common, ERROR_EOR, NULL); + generate_error (&dtp->common, LIBERROR_EOR, NULL); return NULL; } } @@ -564,12 +564,12 @@ write_block (st_parameter_dt *dtp, int length) if (dest == NULL) { - generate_error (&dtp->common, ERROR_END, NULL); + generate_error (&dtp->common, LIBERROR_END, NULL); return NULL; } if (is_internal_unit (dtp) && dtp->u.p.current_unit->endfile == AT_ENDFILE) - generate_error (&dtp->common, ERROR_END, NULL); + generate_error (&dtp->common, LIBERROR_END, NULL); if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) dtp->u.p.size_used += (gfc_offset) length; @@ -599,13 +599,13 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) if (sseek (dtp->u.p.current_unit->s, dtp->u.p.current_unit->strm_pos - 1) == FAILURE) { - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); return FAILURE; } if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0) { - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); return FAILURE; } @@ -620,13 +620,13 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) { if (dtp->u.p.current_unit->bytes_left < (gfc_offset) nbytes) { - generate_error (&dtp->common, ERROR_DIRECT_EOR, NULL); + generate_error (&dtp->common, LIBERROR_DIRECT_EOR, NULL); return FAILURE; } if (swrite (dtp->u.p.current_unit->s, buf, &nbytes) != 0) { - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); return FAILURE; } @@ -665,7 +665,7 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) if (swrite (dtp->u.p.current_unit->s, buf + have_written, &to_write_subrecord) != 0) { - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); return FAILURE; } @@ -682,7 +682,7 @@ write_buf (st_parameter_dt *dtp, void *buf, size_t nbytes) dtp->u.p.current_unit->bytes_left -= have_written; if (short_record) { - generate_error (&dtp->common, ERROR_SHORT_RECORD, NULL); + generate_error (&dtp->common, LIBERROR_SHORT_RECORD, NULL); return FAILURE; } return SUCCESS; @@ -699,7 +699,7 @@ unformatted_read (st_parameter_dt *dtp, bt type, size_t i, sz; /* Currently, character implies size=1. */ - if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE + if (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE || size == 1 || type == BT_CHARACTER) { sz = size * nelems; @@ -741,7 +741,7 @@ unformatted_write (st_parameter_dt *dtp, bt type, void *source, int kind __attribute__((unused)), size_t size, size_t nelems) { - if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE || + if (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE || size == 1 || type == BT_CHARACTER) { size *= nelems; @@ -916,7 +916,7 @@ formatted_transfer_scalar (st_parameter_dt *dtp, bt type, void *p, int len, { /* No data descriptors left. */ if (n > 0) - generate_error (&dtp->common, ERROR_FORMAT, + generate_error (&dtp->common, LIBERROR_FORMAT, "Insufficient data descriptors in format after reversion"); return; } @@ -1564,12 +1564,12 @@ us_read (st_parameter_dt *dtp, int continued) if (p == NULL || n != nr) { - generate_error (&dtp->common, ERROR_BAD_US, NULL); + generate_error (&dtp->common, LIBERROR_BAD_US, NULL); return; } - /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */ - if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE) + /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */ + if (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE) { switch (nr) { @@ -1639,7 +1639,7 @@ us_write (st_parameter_dt *dtp, int continued) nbytes = compile_options.record_marker ; if (swrite (dtp->u.p.current_unit->s, &dummy, &nbytes) != 0) - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); /* For sequential unformatted, if RECL= was not specified in the OPEN we write until we have more bytes than can fit in the subrecord @@ -1721,7 +1721,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) { close_unit (dtp->u.p.current_unit); dtp->u.p.current_unit = NULL; - generate_error (&dtp->common, ERROR_BAD_OPTION, + generate_error (&dtp->common, LIBERROR_BAD_OPTION, "Bad unit number in OPEN statement"); return; } @@ -1743,23 +1743,23 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) conv = get_unformatted_convert (dtp->common.unit); - if (conv == CONVERT_NONE) + if (conv == GFC_CONVERT_NONE) conv = compile_options.convert; /* We use l8_to_l4_offset, which is 0 on little-endian machines and 1 on big-endian machines. */ switch (conv) { - case CONVERT_NATIVE: - case CONVERT_SWAP: + case GFC_CONVERT_NATIVE: + case GFC_CONVERT_SWAP: break; - case CONVERT_BIG: - conv = l8_to_l4_offset ? CONVERT_NATIVE : CONVERT_SWAP; + case GFC_CONVERT_BIG: + conv = l8_to_l4_offset ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP; break; - case CONVERT_LITTLE: - conv = l8_to_l4_offset ? CONVERT_SWAP : CONVERT_NATIVE; + case GFC_CONVERT_LITTLE: + conv = l8_to_l4_offset ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE; break; default: @@ -1782,14 +1782,14 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) if (read_flag && dtp->u.p.current_unit->flags.action == ACTION_WRITE) { - generate_error (&dtp->common, ERROR_BAD_ACTION, + generate_error (&dtp->common, LIBERROR_BAD_ACTION, "Cannot read from file opened for WRITE"); return; } if (!read_flag && dtp->u.p.current_unit->flags.action == ACTION_READ) { - generate_error (&dtp->common, ERROR_BAD_ACTION, + generate_error (&dtp->common, LIBERROR_BAD_ACTION, "Cannot write to file opened for READ"); return; } @@ -1805,7 +1805,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) && (cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT)) != 0) { - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, "Format present for UNFORMATTED data transfer"); return; } @@ -1813,20 +1813,20 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) if ((cf & IOPARM_DT_HAS_NAMELIST_NAME) != 0 && dtp->u.p.ionml != NULL) { if ((cf & IOPARM_DT_HAS_FORMAT) != 0) - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, "A format cannot be specified with a namelist"); } else if (dtp->u.p.current_unit->flags.form == FORM_FORMATTED && !(cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT))) { - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, "Missing format for FORMATTED data transfer"); } if (is_internal_unit (dtp) && dtp->u.p.current_unit->flags.form == FORM_UNFORMATTED) { - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, "Internal file cannot be accessed by UNFORMATTED " "data transfer"); return; @@ -1837,7 +1837,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT && (cf & IOPARM_DT_HAS_REC) == 0) { - generate_error (&dtp->common, ERROR_MISSING_OPTION, + generate_error (&dtp->common, LIBERROR_MISSING_OPTION, "Direct access data transfer requires record number"); return; } @@ -1845,7 +1845,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) if (dtp->u.p.current_unit->flags.access == ACCESS_SEQUENTIAL && (cf & IOPARM_DT_HAS_REC) != 0) { - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, "Record number not allowed for sequential access data transfer"); return; } @@ -1861,14 +1861,14 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) { if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT) { - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, "ADVANCE specification conflicts with sequential access"); return; } if (is_internal_unit (dtp)) { - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, "ADVANCE specification conflicts with internal file"); return; } @@ -1876,7 +1876,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) if ((cf & (IOPARM_DT_HAS_FORMAT | IOPARM_DT_LIST_FORMAT)) != IOPARM_DT_HAS_FORMAT) { - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, "ADVANCE specification requires an explicit format"); return; } @@ -1886,7 +1886,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) { if ((cf & IOPARM_EOR) != 0 && dtp->u.p.advance_status != ADVANCE_NO) { - generate_error (&dtp->common, ERROR_MISSING_OPTION, + generate_error (&dtp->common, LIBERROR_MISSING_OPTION, "EOR specification requires an ADVANCE specification " "of NO"); return; @@ -1894,7 +1894,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) if ((cf & IOPARM_DT_HAS_SIZE) != 0 && dtp->u.p.advance_status != ADVANCE_NO) { - generate_error (&dtp->common, ERROR_MISSING_OPTION, + generate_error (&dtp->common, LIBERROR_MISSING_OPTION, "SIZE specification requires an ADVANCE specification of NO"); return; } @@ -1903,21 +1903,21 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) { /* Write constraints. */ if ((cf & IOPARM_END) != 0) { - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, "END specification cannot appear in a write statement"); return; } if ((cf & IOPARM_EOR) != 0) { - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, "EOR specification cannot appear in a write statement"); return; } if ((cf & IOPARM_DT_HAS_SIZE) != 0) { - generate_error (&dtp->common, ERROR_OPTION_CONFLICT, + generate_error (&dtp->common, LIBERROR_OPTION_CONFLICT, "SIZE specification cannot appear in a write statement"); return; } @@ -1931,14 +1931,14 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) { if (dtp->rec <= 0) { - generate_error (&dtp->common, ERROR_BAD_OPTION, + generate_error (&dtp->common, LIBERROR_BAD_OPTION, "Record number must be positive"); return; } if (dtp->rec >= dtp->u.p.current_unit->maxrec) { - generate_error (&dtp->common, ERROR_BAD_OPTION, + generate_error (&dtp->common, LIBERROR_BAD_OPTION, "Record number too large"); return; } @@ -1956,7 +1956,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) if (dtp->u.p.mode == READING && (dtp->rec -1) * dtp->u.p.current_unit->recl >= file_length (dtp->u.p.current_unit->s)) { - generate_error (&dtp->common, ERROR_BAD_OPTION, + generate_error (&dtp->common, LIBERROR_BAD_OPTION, "Non-existing record number"); return; } @@ -1967,7 +1967,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1) * dtp->u.p.current_unit->recl) == FAILURE) { - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); return; } } @@ -2033,7 +2033,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) { if (dtp->u.p.current_unit->read_bad && !is_stream_io (dtp)) { - generate_error (&dtp->common, ERROR_BAD_OPTION, + generate_error (&dtp->common, LIBERROR_BAD_OPTION, "Cannot READ after a nonadvancing WRITE"); return; } @@ -2135,7 +2135,7 @@ skip_record (st_parameter_dt *dtp, size_t bytes) /* Direct access files do not generate END conditions, only I/O errors. */ if (sseek (dtp->u.p.current_unit->s, new) == FAILURE) - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); } else { /* Seek by reading data. */ @@ -2148,7 +2148,7 @@ skip_record (st_parameter_dt *dtp, size_t bytes) p = salloc_r (dtp->u.p.current_unit->s, &rlength); if (p == NULL) { - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); return; } @@ -2231,7 +2231,7 @@ next_record_r (st_parameter_dt *dtp) record = record * dtp->u.p.current_unit->recl; if (sseek (dtp->u.p.current_unit->s, record) == FAILURE) { - generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL); + generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); break; } dtp->u.p.current_unit->bytes_left = dtp->u.p.current_unit->recl; @@ -2252,7 +2252,7 @@ next_record_r (st_parameter_dt *dtp) if (p == NULL) { - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); break; } @@ -2296,8 +2296,8 @@ write_us_marker (st_parameter_dt *dtp, const gfc_offset buf) else len = compile_options.record_marker; - /* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */ - if (dtp->u.p.current_unit->flags.convert == CONVERT_NATIVE) + /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */ + if (dtp->u.p.current_unit->flags.convert == GFC_CONVERT_NATIVE) { switch (len) { @@ -2393,7 +2393,7 @@ next_record_w_unf (st_parameter_dt *dtp, int next_subrecord) return; io_error: - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); return; } @@ -2461,7 +2461,7 @@ next_record_w (st_parameter_dt *dtp, int done) if (sset (dtp->u.p.current_unit->s, ' ', length) == FAILURE) { - generate_error (&dtp->common, ERROR_END, NULL); + generate_error (&dtp->common, LIBERROR_END, NULL); return; } @@ -2476,7 +2476,7 @@ next_record_w (st_parameter_dt *dtp, int done) if (sseek (dtp->u.p.current_unit->s, record) == FAILURE) { - generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL); + generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); return; } @@ -2505,7 +2505,7 @@ next_record_w (st_parameter_dt *dtp, int done) if (sset (dtp->u.p.current_unit->s, ' ', length) == FAILURE) { - generate_error (&dtp->common, ERROR_END, NULL); + generate_error (&dtp->common, LIBERROR_END, NULL); return; } } @@ -2542,7 +2542,7 @@ next_record_w (st_parameter_dt *dtp, int done) break; io_error: - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); break; } } @@ -2603,7 +2603,7 @@ finalize_transfer (st_parameter_dt *dtp) if (dtp->u.p.eor_condition) { - generate_error (&dtp->common, ERROR_EOR, NULL); + generate_error (&dtp->common, LIBERROR_EOR, NULL); return; } @@ -2626,7 +2626,7 @@ finalize_transfer (st_parameter_dt *dtp) dtp->u.p.eof_jump = &eof_jump; if (setjmp (eof_jump)) { - generate_error (&dtp->common, ERROR_END, NULL); + generate_error (&dtp->common, LIBERROR_END, NULL); return; } @@ -2756,14 +2756,14 @@ st_read (st_parameter_dt *dtp) case AT_ENDFILE: if (!is_internal_unit (dtp)) { - generate_error (&dtp->common, ERROR_END, NULL); + generate_error (&dtp->common, LIBERROR_END, NULL); dtp->u.p.current_unit->endfile = AFTER_ENDFILE; dtp->u.p.current_unit->current_record = 0; } break; case AFTER_ENDFILE: - generate_error (&dtp->common, ERROR_ENDFILE, NULL); + generate_error (&dtp->common, LIBERROR_ENDFILE, NULL); dtp->u.p.current_unit->current_record = 0; break; } @@ -2825,7 +2825,7 @@ st_write_done (st_parameter_dt *dtp) { flush (dtp->u.p.current_unit->s); if (struncate (dtp->u.p.current_unit->s) == FAILURE) - generate_error (&dtp->common, ERROR_OS, NULL); + generate_error (&dtp->common, LIBERROR_OS, NULL); } dtp->u.p.current_unit->endfile = AT_ENDFILE; break; diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index 644205f..a293bab 100644 --- a/libgfortran/io/unit.c +++ b/libgfortran/io/unit.c @@ -375,7 +375,7 @@ get_internal_unit (st_parameter_dt *dtp) iunit = get_mem (sizeof (gfc_unit)); if (iunit == NULL) { - generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL); + generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL); return NULL; } diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index d068a75..7ce198a 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -37,16 +37,14 @@ Boston, MA 02110-1301, USA. */ #include #include -#ifndef M_PI -#define M_PI 3.14159265358979323846264338327 -#endif - #if HAVE_COMPLEX_H # include #else #define complex __complex__ #endif +#include "../gcc/fortran/libgfortran.h" + #include "config.h" #include "c99_protos.h" @@ -276,9 +274,6 @@ internal_proto(l8_to_l4_offset); #define GFC_REAL_16_RADIX FLT_RADIX #endif -#ifndef GFC_MAX_DIMENSIONS -#define GFC_MAX_DIMENSIONS 7 -#endif typedef struct descriptor_dimension { @@ -330,25 +325,6 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_8) gfc_array_l8; typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16; #endif -#define GFC_DTYPE_RANK_MASK 0x07 -#define GFC_DTYPE_TYPE_SHIFT 3 -#define GFC_DTYPE_TYPE_MASK 0x38 -#define GFC_DTYPE_SIZE_SHIFT 6 - -/* added for f03. --Rickett, 02.28.06 */ -#define GFC_NUM_RANK_BITS 3 - -enum -{ - GFC_DTYPE_UNKNOWN = 0, - GFC_DTYPE_INTEGER, - /* TODO: recognize logical types. */ - GFC_DTYPE_LOGICAL, - GFC_DTYPE_REAL, - GFC_DTYPE_COMPLEX, - GFC_DTYPE_DERIVED, - GFC_DTYPE_CHARACTER -}; #define GFC_DESCRIPTOR_RANK(desc) ((desc)->dtype & GFC_DTYPE_RANK_MASK) #define GFC_DESCRIPTOR_TYPE(desc) (((desc)->dtype & GFC_DTYPE_TYPE_MASK) \ @@ -423,60 +399,6 @@ typedef struct } st_option; -/* Runtime errors. The EOR and EOF errors are required to be negative. - These codes must be kept sychronized with their equivalents in - gcc/fortran/gfortran.h . */ - -typedef enum -{ - ERROR_FIRST = -3, /* Marker for the first error. */ - ERROR_EOR = -2, - ERROR_END = -1, - ERROR_OK = 0, /* Indicates success, must be zero. */ - ERROR_OS = 5000, /* Operating system error, more info in errno. */ - ERROR_OPTION_CONFLICT, - ERROR_BAD_OPTION, - ERROR_MISSING_OPTION, - ERROR_ALREADY_OPEN, - ERROR_BAD_UNIT, - ERROR_FORMAT, - ERROR_BAD_ACTION, - ERROR_ENDFILE, - ERROR_BAD_US, - ERROR_READ_VALUE, - ERROR_READ_OVERFLOW, - ERROR_INTERNAL, - ERROR_INTERNAL_UNIT, - ERROR_ALLOCATION, /* Keep in sync with value used in - gcc/fortran/trans.c - (gfc_allocate_array_with_status). */ - ERROR_DIRECT_EOR, - ERROR_SHORT_RECORD, - ERROR_CORRUPT_FILE, - ERROR_LAST /* Not a real error, the last error # + 1. */ -} -error_codes; - - -/* Flags to specify which standard/extension contains a feature. - Keep them in sync with their counterparts in gcc/fortran/gfortran.h. */ -#define GFC_STD_LEGACY (1<<6) /* Backward compatibility. */ -#define GFC_STD_GNU (1<<5) /* GNU Fortran extension. */ -#define GFC_STD_F2003 (1<<4) /* New in F2003. */ -/* Note that no features were obsoleted nor deleted in F2003. */ -#define GFC_STD_F95 (1<<3) /* New in F95. */ -#define GFC_STD_F95_DEL (1<<2) /* Deleted in F95. */ -#define GFC_STD_F95_OBS (1<<1) /* Obsoleted in F95. */ -#define GFC_STD_F77 (1<<0) /* Up to and including F77. */ - -/* Bitmasks for the various FPE that can be enabled. - Keep them in sync with their counterparts in gcc/fortran/gfortran.h. */ -#define GFC_FPE_INVALID (1<<0) -#define GFC_FPE_DENORMAL (1<<1) -#define GFC_FPE_ZERO (1<<2) -#define GFC_FPE_OVERFLOW (1<<3) -#define GFC_FPE_UNDERFLOW (1<<4) -#define GFC_FPE_PRECISION (1<<5) /* This is returned by notification_std to know if, given the flags that were given (-std=, -pedantic) we should issue an error, a warning @@ -505,8 +427,8 @@ iexport_data_proto(filename); #define gfc_alloca(x) __builtin_alloca(x) -/* Various I/O stuff also used in other parts of the library. */ - +/* Directory for creating temporary files. Only used when none of the + following environment variables exist: GFORTRAN_TMPDIR, TMP and TEMP. */ #define DEFAULT_TEMPDIR "/tmp" /* The default value of record length for preconnected units is defined @@ -514,9 +436,6 @@ iexport_data_proto(filename); Default value is 1 Gb. */ #define DEFAULT_RECL 1073741824 -typedef enum -{ CONVERT_NONE=-1, CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE } -unit_convert; #define CHARACTER2(name) \ gfc_charlen_type name ## _len; \ diff --git a/libgfortran/runtime/environ.c b/libgfortran/runtime/environ.c index 28cf589..62e4cfa 100644 --- a/libgfortran/runtime/environ.c +++ b/libgfortran/runtime/environ.c @@ -460,17 +460,18 @@ show_signal (variable * v) static variable variable_table[] = { - {"GFORTRAN_STDIN_UNIT", 5, &options.stdin_unit, init_integer, show_integer, + {"GFORTRAN_STDIN_UNIT", GFC_STDIN_UNIT_NUMBER, &options.stdin_unit, + init_integer, show_integer, "Unit number that will be preconnected to standard input\n" "(No preconnection if negative)", 0}, - {"GFORTRAN_STDOUT_UNIT", 6, &options.stdout_unit, init_integer, - show_integer, + {"GFORTRAN_STDOUT_UNIT", GFC_STDOUT_UNIT_NUMBER, &options.stdout_unit, + init_integer, show_integer, "Unit number that will be preconnected to standard output\n" "(No preconnection if negative)", 0}, - {"GFORTRAN_STDERR_UNIT", 0, &options.stderr_unit, init_integer, - show_integer, + {"GFORTRAN_STDERR_UNIT", GFC_STDERR_UNIT_NUMBER, &options.stderr_unit, + init_integer, show_integer, "Unit number that will be preconnected to standard error\n" "(No preconnection if negative)", 0}, @@ -622,7 +623,7 @@ show_variables (void) st_printf ("\nRuntime error codes:"); st_printf ("\n--------------------\n"); - for (n = ERROR_FIRST + 1; n < ERROR_LAST; n++) + for (n = LIBERROR_FIRST + 1; n < LIBERROR_LAST; n++) if (n < 0 || n > 9) st_printf ("%d %s\n", n, translate_error (n)); else @@ -881,19 +882,19 @@ do_parse (void) switch (tok) { case NATIVE: - endian = CONVERT_NATIVE; + endian = GFC_CONVERT_NATIVE; break; case SWAP: - endian = CONVERT_SWAP; + endian = GFC_CONVERT_SWAP; break; case BIG: - endian = CONVERT_BIG; + endian = GFC_CONVERT_BIG; break; case LITTLE: - endian = CONVERT_LITTLE; + endian = GFC_CONVERT_LITTLE; break; case INTEGER: @@ -948,25 +949,25 @@ do_parse (void) case NATIVE: if (next_token () != ':') goto error; - endian = CONVERT_NATIVE; + endian = GFC_CONVERT_NATIVE; break; case SWAP: if (next_token () != ':') goto error; - endian = CONVERT_SWAP; + endian = GFC_CONVERT_SWAP; break; case LITTLE: if (next_token () != ':') goto error; - endian = CONVERT_LITTLE; + endian = GFC_CONVERT_LITTLE; break; case BIG: if (next_token () != ':') goto error; - endian = CONVERT_BIG; + endian = GFC_CONVERT_BIG; break; case INTEGER: @@ -1034,7 +1035,7 @@ do_parse (void) end: return 0; error: - def = CONVERT_NONE; + def = GFC_CONVERT_NONE; return -1; } @@ -1042,7 +1043,7 @@ void init_unformatted (variable * v) { char *val; val = getenv (v->name); - def = CONVERT_NONE; + def = GFC_CONVERT_NONE; n_elist = 0; if (val == NULL) diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c index 9aa7cd8..279e265 100644 --- a/libgfortran/runtime/error.c +++ b/libgfortran/runtime/error.c @@ -310,83 +310,83 @@ translate_error (int code) switch (code) { - case ERROR_EOR: + case LIBERROR_EOR: p = "End of record"; break; - case ERROR_END: + case LIBERROR_END: p = "End of file"; break; - case ERROR_OK: + case LIBERROR_OK: p = "Successful return"; break; - case ERROR_OS: + case LIBERROR_OS: p = "Operating system error"; break; - case ERROR_BAD_OPTION: + case LIBERROR_BAD_OPTION: p = "Bad statement option"; break; - case ERROR_MISSING_OPTION: + case LIBERROR_MISSING_OPTION: p = "Missing statement option"; break; - case ERROR_OPTION_CONFLICT: + case LIBERROR_OPTION_CONFLICT: p = "Conflicting statement options"; break; - case ERROR_ALREADY_OPEN: + case LIBERROR_ALREADY_OPEN: p = "File already opened in another unit"; break; - case ERROR_BAD_UNIT: + case LIBERROR_BAD_UNIT: p = "Unattached unit"; break; - case ERROR_FORMAT: + case LIBERROR_FORMAT: p = "FORMAT error"; break; - case ERROR_BAD_ACTION: + case LIBERROR_BAD_ACTION: p = "Incorrect ACTION specified"; break; - case ERROR_ENDFILE: + case LIBERROR_ENDFILE: p = "Read past ENDFILE record"; break; - case ERROR_BAD_US: + case LIBERROR_BAD_US: p = "Corrupt unformatted sequential file"; break; - case ERROR_READ_VALUE: + case LIBERROR_READ_VALUE: p = "Bad value during read"; break; - case ERROR_READ_OVERFLOW: + case LIBERROR_READ_OVERFLOW: p = "Numeric overflow on read"; break; - case ERROR_INTERNAL: + case LIBERROR_INTERNAL: p = "Internal error in run-time library"; break; - case ERROR_INTERNAL_UNIT: + case LIBERROR_INTERNAL_UNIT: p = "Internal unit I/O error"; break; - case ERROR_DIRECT_EOR: + case LIBERROR_DIRECT_EOR: p = "Write exceeds length of DIRECT access record"; break; - case ERROR_SHORT_RECORD: + case LIBERROR_SHORT_RECORD: p = "I/O past end of record on unformatted file"; break; - case ERROR_CORRUPT_FILE: + case LIBERROR_CORRUPT_FILE: p = "Unformatted file structure has been corrupted"; break; @@ -412,11 +412,11 @@ generate_error (st_parameter_common *cmp, int family, const char *message) { /* Set the error status. */ if ((cmp->flags & IOPARM_HAS_IOSTAT)) - *cmp->iostat = (family == ERROR_OS) ? errno : family; + *cmp->iostat = (family == LIBERROR_OS) ? errno : family; if (message == NULL) message = - (family == ERROR_OS) ? get_oserror () : translate_error (family); + (family == LIBERROR_OS) ? get_oserror () : translate_error (family); if (cmp->flags & IOPARM_HAS_IOMSG) cf_strcpy (cmp->iomsg, cmp->iomsg_len, message); @@ -425,13 +425,13 @@ generate_error (st_parameter_common *cmp, int family, const char *message) cmp->flags &= ~IOPARM_LIBRETURN_MASK; switch (family) { - case ERROR_EOR: + case LIBERROR_EOR: cmp->flags |= IOPARM_LIBRETURN_EOR; if ((cmp->flags & IOPARM_EOR)) return; break; - case ERROR_END: + case LIBERROR_END: cmp->flags |= IOPARM_LIBRETURN_END; if ((cmp->flags & IOPARM_END)) return; diff --git a/libgfortran/runtime/string.c b/libgfortran/runtime/string.c index 9dfda2b..ee7bcfb 100644 --- a/libgfortran/runtime/string.c +++ b/libgfortran/runtime/string.c @@ -122,7 +122,7 @@ find_option (st_parameter_common *cmp, const char *s1, gfc_charlen_type s1_len, if (compare0 (s1, s1_len, opts->name)) return opts->value; - generate_error (cmp, ERROR_BAD_OPTION, error_message); + generate_error (cmp, LIBERROR_BAD_OPTION, error_message); return -1; } -- 2.7.4