summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog24
-rw-r--r--gcc/fortran/Make-lang.in6
-rw-r--r--gcc/fortran/gfortran.h65
-rw-r--r--gcc/fortran/iso-fortran-env.def10
-rw-r--r--gcc/fortran/libgfortran.h108
-rw-r--r--gcc/fortran/options.c10
-rw-r--r--gcc/fortran/trans-decl.c2
-rw-r--r--gcc/fortran/trans-intrinsic.c4
-rw-r--r--gcc/fortran/trans-io.c27
-rw-r--r--gcc/fortran/trans-types.h16
-rw-r--r--gcc/fortran/trans.c17
-rw-r--r--libgfortran/ChangeLog35
-rw-r--r--libgfortran/io/close.c2
-rw-r--r--libgfortran/io/file_pos.c16
-rw-r--r--libgfortran/io/format.c2
-rw-r--r--libgfortran/io/inquire.c4
-rw-r--r--libgfortran/io/list_read.c36
-rw-r--r--libgfortran/io/open.c70
-rw-r--r--libgfortran/io/read.c14
-rw-r--r--libgfortran/io/transfer.c156
-rw-r--r--libgfortran/io/unit.c2
-rw-r--r--libgfortran/libgfortran.h89
-rw-r--r--libgfortran/runtime/environ.c33
-rw-r--r--libgfortran/runtime/error.c48
-rw-r--r--libgfortran/runtime/string.c2
25 files changed, 400 insertions, 398 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3b3d469bcaa..ce57c1358ca 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,27 @@
+2007-09-03 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ 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 <kargl@gcc.gnu.org>
* invoke.texi: Fix the -frange-checking option entry.
diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
index 30320a84810..c217b026c5f 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 5c8c56dd6ad..b9c6c31e97f 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 c45f7a5b38d..8ef5597d3b2 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 00000000000..d9bfa05e80a
--- /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
+<http://www.gnu.org/licenses/>. */
+
+
+/* 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 3ab736236be..a68c3bed781 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 109a18707b4..0b709030d47 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 3c43a8432b0..ebe855542bd 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 80646cd0819..289c2d2e2fc 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 0650d7e0ef6..7a0e9bf32ac 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 1113e80fdc3..b9fd2dff698 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 405be974044..5c02df9b679 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,38 @@
+2007-09-03 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ 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 <fxcoudert@gcc.gnu.org>
* m4/minloc1.m4: Update copyright year and ajust headers order.
diff --git a/libgfortran/io/close.c b/libgfortran/io/close.c
index 7bd8a3e05fd..eb66f66507e 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 0a7dd042896..c0412e83879 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 038c80d95b1..0f7a2e5bb84 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 84f4683f882..2c16a3b922d 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 68fac2c10e9..b97130b7708 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 e4a54edc8fd..0a409ed4ad3 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 2049cca7b01..8baa3576af8 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 8118707e7fb..793f1941d04 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 644205fc19f..a293baba077 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 d068a753fa4..7ce198a1f0e 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -37,16 +37,14 @@ Boston, MA 02110-1301, USA. */
#include <float.h>
#include <stdarg.h>
-#ifndef M_PI
-#define M_PI 3.14159265358979323846264338327
-#endif
-
#if HAVE_COMPLEX_H
# include <complex.h>
#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 28cf58981fd..62e4cfaf247 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 9aa7cd83bc7..279e26518ea 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 9dfda2b8611..ee7bcfb4be8 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;
}
View Lorry Controller Status