Commit d74b97cc by Francois-Xavier Coudert Committed by François-Xavier Coudert

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
parent 4392a547
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> 2007-09-02 Steven G. Kargl <kargl@gcc.gnu.org>
* invoke.texi: Fix the -frange-checking option entry. * invoke.texi: Fix the -frange-checking option entry.
......
...@@ -289,14 +289,16 @@ fortran.stagefeedback: stageprofile-start ...@@ -289,14 +289,16 @@ fortran.stagefeedback: stageprofile-start
# which objects depend on what. FIXME # which objects depend on what. FIXME
# TODO: Add dependencies on the backend/tree header files # 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 \ fortran/parse.h fortran/arith.h fortran/target-memory.h \
$(CONFIG_H) $(SYSTEM_H) $(TM_H) $(TM_P_H) coretypes.h \ $(CONFIG_H) $(SYSTEM_H) $(TM_H) $(TM_P_H) coretypes.h \
$(RTL_H) $(TREE_H) $(TREE_DUMP_H) $(GGC_H) $(EXPR_H) \ $(RTL_H) $(TREE_H) $(TREE_DUMP_H) $(GGC_H) $(EXPR_H) \
$(FLAGS_H) output.h $(DIAGNOSTIC_H) errors.h $(FUNCTION_H) $(FLAGS_H) output.h $(DIAGNOSTIC_H) errors.h $(FUNCTION_H)
fortran/openmp.o: pointer-set.h $(TARGET_H) toplev.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-const.h fortran/trans-const.h fortran/trans.h \
fortran/trans-stmt.h fortran/trans-types.h \ fortran/trans-stmt.h fortran/trans-types.h \
$(CONFIG_H) $(SYSTEM_H) $(TREE_H) $(TM_H) coretypes.h $(GGC_H) $(CONFIG_H) $(SYSTEM_H) $(TREE_H) $(TM_H) coretypes.h $(GGC_H)
......
...@@ -28,6 +28,11 @@ along with GCC; see the file COPYING3. If not see ...@@ -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 multiple header files. Besides, Microsoft's winnt.h was 250k last
time I looked, so by comparison this is perfectly reasonable. */ 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 "system.h"
#include "intl.h" #include "intl.h"
#include "coretypes.h" #include "coretypes.h"
...@@ -57,7 +62,6 @@ char *alloca (); ...@@ -57,7 +62,6 @@ char *alloca ();
#define GFC_MAX_SYMBOL_LEN 63 /* Must be at least 63 for F2003. */ #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_BINDING_LABEL_LEN 126 /* (2 * GFC_MAX_SYMBOL_LEN) */
#define GFC_MAX_LINE 132 /* Characters beyond this are not seen. */ #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 GFC_LETTERS 26 /* Number of letters in the alphabet. */
#define MAX_SUBRECORD_LENGTH 2147483639 /* 2**31-9 */ #define MAX_SUBRECORD_LENGTH 2147483639 /* 2**31-9 */
...@@ -96,33 +100,6 @@ typedef struct ...@@ -96,33 +100,6 @@ typedef struct
mstring; 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 *****************************/ /*************************** Enums *****************************/
...@@ -532,38 +509,6 @@ enum gfc_isym_id ...@@ -532,38 +509,6 @@ enum gfc_isym_id
}; };
typedef enum gfc_isym_id 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 *****************************/ /************************* Structures *****************************/
......
...@@ -26,11 +26,11 @@ along with GCC; see the file COPYING3. If not see ...@@ -26,11 +26,11 @@ along with GCC; see the file COPYING3. If not see
NAMED_INTCST (ISOFORTRANENV_CHARACTER_STORAGE_SIZE, "character_storage_size", \ NAMED_INTCST (ISOFORTRANENV_CHARACTER_STORAGE_SIZE, "character_storage_size", \
gfc_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_FILE_STORAGE_SIZE, "file_storage_size", 8)
NAMED_INTCST (ISOFORTRANENV_INPUT_UNIT, "input_unit", 5) NAMED_INTCST (ISOFORTRANENV_INPUT_UNIT, "input_unit", GFC_STDIN_UNIT_NUMBER)
NAMED_INTCST (ISOFORTRANENV_IOSTAT_END, "iostat_end", -1) NAMED_INTCST (ISOFORTRANENV_IOSTAT_END, "iostat_end", LIBERROR_END)
NAMED_INTCST (ISOFORTRANENV_IOSTAT_EOR, "iostat_eor", -2) NAMED_INTCST (ISOFORTRANENV_IOSTAT_EOR, "iostat_eor", LIBERROR_EOR)
NAMED_INTCST (ISOFORTRANENV_NUMERIC_STORAGE_SIZE, "numeric_storage_size", \ NAMED_INTCST (ISOFORTRANENV_NUMERIC_STORAGE_SIZE, "numeric_storage_size", \
gfc_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)
/* 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
};
...@@ -62,7 +62,7 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED, ...@@ -62,7 +62,7 @@ gfc_init_options (unsigned int argc ATTRIBUTE_UNUSED,
gfc_option.max_continue_free = 39; gfc_option.max_continue_free = 39;
gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN; gfc_option.max_identifier_length = GFC_MAX_SYMBOL_LEN;
gfc_option.max_subrecord_length = 0; gfc_option.max_subrecord_length = 0;
gfc_option.convert = CONVERT_NATIVE; gfc_option.convert = GFC_CONVERT_NATIVE;
gfc_option.record_marker = 0; gfc_option.record_marker = 0;
gfc_option.verbose = 0; gfc_option.verbose = 0;
...@@ -704,19 +704,19 @@ gfc_handle_option (size_t scode, const char *arg, int value) ...@@ -704,19 +704,19 @@ gfc_handle_option (size_t scode, const char *arg, int value)
break; break;
case OPT_fconvert_little_endian: case OPT_fconvert_little_endian:
gfc_option.convert = CONVERT_LITTLE; gfc_option.convert = GFC_CONVERT_LITTLE;
break; break;
case OPT_fconvert_big_endian: case OPT_fconvert_big_endian:
gfc_option.convert = CONVERT_BIG; gfc_option.convert = GFC_CONVERT_BIG;
break; break;
case OPT_fconvert_native: case OPT_fconvert_native:
gfc_option.convert = CONVERT_NATIVE; gfc_option.convert = GFC_CONVERT_NATIVE;
break; break;
case OPT_fconvert_swap: case OPT_fconvert_swap:
gfc_option.convert = CONVERT_SWAP; gfc_option.convert = GFC_CONVERT_SWAP;
break; break;
case OPT_frecord_marker_4: case OPT_frecord_marker_4:
......
...@@ -3212,7 +3212,7 @@ gfc_generate_function_code (gfc_namespace * ns) ...@@ -3212,7 +3212,7 @@ gfc_generate_function_code (gfc_namespace * ns)
/* If this is the main program and an -fconvert option was provided, /* If this is the main program and an -fconvert option was provided,
add a call to set_convert. */ 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, tmp = build_call_expr (gfor_fndecl_set_convert, 1,
build_int_cst (integer_type_node, build_int_cst (integer_type_node,
......
...@@ -3928,11 +3928,11 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) ...@@ -3928,11 +3928,11 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
break; break;
case GFC_ISYM_IS_IOSTAT_END: case GFC_ISYM_IS_IOSTAT_END:
gfc_conv_has_intvalue (se, expr, -1); gfc_conv_has_intvalue (se, expr, LIBERROR_END);
break; break;
case GFC_ISYM_IS_IOSTAT_EOR: case GFC_ISYM_IS_IOSTAT_EOR:
gfc_conv_has_intvalue (se, expr, -2); gfc_conv_has_intvalue (se, expr, LIBERROR_EOR);
break; break;
case GFC_ISYM_ISNAN: case GFC_ISYM_ISNAN:
......
...@@ -457,18 +457,15 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type, ...@@ -457,18 +457,15 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type,
if (type == IOPARM_common_unit && e->ts.kind != 4) if (type == IOPARM_common_unit && e->ts.kind != 4)
{ {
tree cond, max; tree cond, max;
ioerror_codes bad_unit;
int i; int i;
bad_unit = IOERROR_BAD_UNIT;
/* Don't evaluate the UNIT number multiple times. */ /* Don't evaluate the UNIT number multiple times. */
se.expr = gfc_evaluate_now (se.expr, &se.pre); se.expr = gfc_evaluate_now (se.expr, &se.pre);
/* UNIT numbers should be nonnegative. */ /* UNIT numbers should be nonnegative. */
cond = fold_build2 (LT_EXPR, boolean_type_node, se.expr, cond = fold_build2 (LT_EXPR, boolean_type_node, se.expr,
build_int_cst (TREE_TYPE (se.expr),0)); 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", "Negative unit number in I/O statement",
&se.pre); &se.pre);
...@@ -477,7 +474,7 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type, ...@@ -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); max = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4);
cond = fold_build2 (GT_EXPR, boolean_type_node, se.expr, cond = fold_build2 (GT_EXPR, boolean_type_node, se.expr,
fold_convert (TREE_TYPE (se.expr), max)); 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", "Unit number in I/O statement too large",
&se.pre); &se.pre);
...@@ -519,14 +516,10 @@ set_parameter_ref (stmtblock_t *block, stmtblock_t *postblock, ...@@ -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)); addr = convert (TREE_TYPE (p->field), build_fold_addr_expr (se.expr));
/* If this is for the iostat variable initialize the /* 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) if (type == IOPARM_common_iostat)
{ gfc_add_modify_expr (block, se.expr,
ioerror_codes ok; build_int_cst (TREE_TYPE (se.expr), LIBERROR_OK));
ok = IOERROR_OK;
gfc_add_modify_expr (block, se.expr,
build_int_cst (TREE_TYPE (se.expr), ok));
}
} }
else else
{ {
...@@ -537,14 +530,10 @@ set_parameter_ref (stmtblock_t *block, stmtblock_t *postblock, ...@@ -537,14 +530,10 @@ set_parameter_ref (stmtblock_t *block, stmtblock_t *postblock,
st_parameter_field[type].name); st_parameter_field[type].name);
/* If this is for the iostat variable, initialize the /* 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) if (type == IOPARM_common_iostat)
{ gfc_add_modify_expr (block, tmpvar,
ioerror_codes ok; build_int_cst (TREE_TYPE (tmpvar), LIBERROR_OK));
ok = IOERROR_OK;
gfc_add_modify_expr (block, tmpvar,
build_int_cst (TREE_TYPE (tmpvar), ok));
}
addr = build_fold_addr_expr (tmpvar); addr = build_fold_addr_expr (tmpvar);
/* After the I/O operation, we set the variable from the temporary. */ /* After the I/O operation, we set the variable from the temporary. */
......
...@@ -24,22 +24,6 @@ along with GCC; see the file COPYING3. If not see ...@@ -24,22 +24,6 @@ along with GCC; see the file COPYING3. If not see
#ifndef GFC_BACKEND_H #ifndef GFC_BACKEND_H
#define 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_index_type;
extern GTY(()) tree gfc_array_range_type; extern GTY(()) tree gfc_array_range_type;
extern GTY(()) tree gfc_character1_type_node; extern GTY(()) tree gfc_character1_type_node;
......
...@@ -473,11 +473,6 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) ...@@ -473,11 +473,6 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
return res; 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. /* Allocate memory, using an optional status argument.
This function follows the following pseudo-code: This function follows the following pseudo-code:
...@@ -495,7 +490,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) ...@@ -495,7 +490,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
{ {
if (stat) if (stat)
{ {
*stat = ERROR_ALLOCATION; *stat = LIBERROR_ALLOCATION;
newmem = NULL; newmem = NULL;
} }
else else
...@@ -508,7 +503,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size) ...@@ -508,7 +503,7 @@ gfc_call_malloc (stmtblock_t * block, tree type, tree size)
if (newmem == NULL) if (newmem == NULL)
{ {
if (stat) if (stat)
*stat = ERROR_ALLOCATION; *stat = LIBERROR_ALLOCATION;
else else
runtime_error ("Out of memory"); runtime_error ("Out of memory");
} }
...@@ -558,7 +553,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) ...@@ -558,7 +553,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
gfc_start_block (&set_status_block); gfc_start_block (&set_status_block);
gfc_add_modify_expr (&set_status_block, gfc_add_modify_expr (&set_status_block,
build1 (INDIRECT_REF, status_type, status), 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, gfc_add_modify_expr (&set_status_block, res,
build_int_cst (pvoid_type_node, 0)); build_int_cst (pvoid_type_node, 0));
...@@ -589,7 +584,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) ...@@ -589,7 +584,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
build_int_cst (status_type, 0)); build_int_cst (status_type, 0));
tmp2 = fold_build2 (MODIFY_EXPR, status_type, tmp2 = fold_build2 (MODIFY_EXPR, status_type,
build1 (INDIRECT_REF, status_type, status), 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, tmp = fold_build3 (COND_EXPR, void_type_node, cond, tmp,
tmp2); tmp2);
} }
...@@ -627,7 +622,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status) ...@@ -627,7 +622,7 @@ gfc_allocate_with_status (stmtblock_t * block, tree size, tree status)
{ {
free (mem); free (mem);
mem = allocate (size, stat); mem = allocate (size, stat);
*stat = ERROR_ALLOCATION; *stat = LIBERROR_ALLOCATION;
return mem; return mem;
} }
else else
...@@ -675,7 +670,7 @@ gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size, ...@@ -675,7 +670,7 @@ gfc_allocate_array_with_status (stmtblock_t * block, tree mem, tree size,
gfc_add_modify_expr (&set_status_block, gfc_add_modify_expr (&set_status_block,
build1 (INDIRECT_REF, status_type, status), 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, tmp = fold_build2 (EQ_EXPR, boolean_type_node, status,
build_int_cst (status_type, 0)); build_int_cst (status_type, 0));
......
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> 2007-08-31 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
* m4/minloc1.m4: Update copyright year and ajust headers order. * m4/minloc1.m4: Update copyright year and ajust headers order.
......
...@@ -73,7 +73,7 @@ st_close (st_parameter_close *clp) ...@@ -73,7 +73,7 @@ st_close (st_parameter_close *clp)
if (u->flags.status == STATUS_SCRATCH) if (u->flags.status == STATUS_SCRATCH)
{ {
if (status == CLOSE_KEEP) 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"); "Can't KEEP a scratch file on CLOSE");
#if !HAVE_UNLINK_OPEN_FILE #if !HAVE_UNLINK_OPEN_FILE
path = (char *) gfc_alloca (u->file_len + 1); path = (char *) gfc_alloca (u->file_len + 1);
......
...@@ -90,7 +90,7 @@ formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u) ...@@ -90,7 +90,7 @@ formatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
return; return;
io_error: 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) ...@@ -122,8 +122,8 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
if (p == NULL || length_read != length) if (p == NULL || length_read != length)
goto io_error; goto io_error;
/* Only CONVERT_NATIVE and CONVERT_SWAP are valid here. */ /* Only GFC_CONVERT_NATIVE and GFC_CONVERT_SWAP are valid here. */
if (u->flags.convert == CONVERT_NATIVE) if (u->flags.convert == GFC_CONVERT_NATIVE)
{ {
switch (length) switch (length)
{ {
...@@ -178,7 +178,7 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u) ...@@ -178,7 +178,7 @@ unformatted_backspace (st_parameter_filepos *fpp, gfc_unit *u)
return; return;
io_error: 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) ...@@ -195,7 +195,7 @@ st_backspace (st_parameter_filepos *fpp)
u = find_unit (fpp->common.unit); u = find_unit (fpp->common.unit);
if (u == NULL) if (u == NULL)
{ {
generate_error (&fpp->common, ERROR_BAD_UNIT, NULL); generate_error (&fpp->common, LIBERROR_BAD_UNIT, NULL);
goto done; goto done;
} }
...@@ -296,7 +296,7 @@ st_rewind (st_parameter_filepos *fpp) ...@@ -296,7 +296,7 @@ st_rewind (st_parameter_filepos *fpp)
if (u != NULL) if (u != NULL)
{ {
if (u->flags.access == ACCESS_DIRECT) 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"); "Cannot REWIND a file opened for DIRECT access");
else else
{ {
...@@ -312,7 +312,7 @@ st_rewind (st_parameter_filepos *fpp) ...@@ -312,7 +312,7 @@ st_rewind (st_parameter_filepos *fpp)
u->last_record = 0; u->last_record = 0;
if (file_position (u->s) != 0 && sseek (u->s, 0) == FAILURE) 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. */ /* Handle special files like /dev/null differently. */
if (!is_special (u->s)) if (!is_special (u->s))
...@@ -359,7 +359,7 @@ st_flush (st_parameter_filepos *fpp) ...@@ -359,7 +359,7 @@ st_flush (st_parameter_filepos *fpp)
} }
else else
/* FLUSH on unconnected unit is illegal: F95 std., 9.3.5. */ /* 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"); "Specified UNIT in FLUSH is not connected");
library_end (); library_end ();
......
...@@ -942,7 +942,7 @@ format_error (st_parameter_dt *dtp, const fnode *f, const char *message) ...@@ -942,7 +942,7 @@ format_error (st_parameter_dt *dtp, const fnode *f, const char *message)
*p++ = '^'; *p++ = '^';
*p = '\0'; *p = '\0';
generate_error (&dtp->common, ERROR_FORMAT, buffer); generate_error (&dtp->common, LIBERROR_FORMAT, buffer);
} }
......
...@@ -302,11 +302,11 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u) ...@@ -302,11 +302,11 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
switch (u->flags.convert) switch (u->flags.convert)
{ {
/* l8_to_l4_offset is 0 for little-endian, 1 for big-endian. */ /* 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"; p = l8_to_l4_offset ? "BIG_ENDIAN" : "LITTLE_ENDIAN";
break; break;
case CONVERT_SWAP: case GFC_CONVERT_SWAP:
p = l8_to_l4_offset ? "LITTLE_ENDIAN" : "BIG_ENDIAN"; p = l8_to_l4_offset ? "LITTLE_ENDIAN" : "BIG_ENDIAN";
break; break;
......
...@@ -207,7 +207,7 @@ next_char (st_parameter_dt *dtp) ...@@ -207,7 +207,7 @@ next_char (st_parameter_dt *dtp)
check for NULL here is cautionary. */ check for NULL here is cautionary. */
if (p == NULL) if (p == NULL)
{ {
generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL); generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
return '\0'; return '\0';
} }
...@@ -228,7 +228,7 @@ next_char (st_parameter_dt *dtp) ...@@ -228,7 +228,7 @@ next_char (st_parameter_dt *dtp)
{ {
if (p == NULL) if (p == NULL)
{ {
generate_error (&dtp->common, ERROR_OS, NULL); generate_error (&dtp->common, LIBERROR_OS, NULL);
return '\0'; return '\0';
} }
if (length == 0) if (length == 0)
...@@ -465,7 +465,7 @@ convert_integer (st_parameter_dt *dtp, int length, int negative) ...@@ -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", sprintf (message, "Zero repeat count in item %d of list input",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
m = 1; m = 1;
} }
} }
...@@ -482,7 +482,7 @@ convert_integer (st_parameter_dt *dtp, int length, int negative) ...@@ -482,7 +482,7 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
dtp->u.p.item_count); dtp->u.p.item_count);
free_saved (dtp); free_saved (dtp);
generate_error (&dtp->common, ERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return 1; return 1;
} }
...@@ -529,7 +529,7 @@ parse_repeat (st_parameter_dt *dtp) ...@@ -529,7 +529,7 @@ parse_repeat (st_parameter_dt *dtp)
"Repeat count overflow in item %d of list input", "Repeat count overflow in item %d of list input",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return 1; return 1;
} }
...@@ -542,7 +542,7 @@ parse_repeat (st_parameter_dt *dtp) ...@@ -542,7 +542,7 @@ parse_repeat (st_parameter_dt *dtp)
"Zero repeat count in item %d of list input", "Zero repeat count in item %d of list input",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return 1; return 1;
} }
...@@ -563,7 +563,7 @@ parse_repeat (st_parameter_dt *dtp) ...@@ -563,7 +563,7 @@ parse_repeat (st_parameter_dt *dtp)
free_saved (dtp); free_saved (dtp);
sprintf (message, "Bad repeat count in item %d of list input", sprintf (message, "Bad repeat count in item %d of list input",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return 1; return 1;
} }
...@@ -708,7 +708,7 @@ read_logical (st_parameter_dt *dtp, int length) ...@@ -708,7 +708,7 @@ read_logical (st_parameter_dt *dtp, int length)
free_saved (dtp); free_saved (dtp);
sprintf (message, "Bad logical value while reading item %d", sprintf (message, "Bad logical value while reading item %d",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return; return;
logical_done: logical_done:
...@@ -840,7 +840,7 @@ read_integer (st_parameter_dt *dtp, int length) ...@@ -840,7 +840,7 @@ read_integer (st_parameter_dt *dtp, int length)
free_saved (dtp); free_saved (dtp);
sprintf (message, "Bad integer for item %d in list input", sprintf (message, "Bad integer for item %d in list input",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return; return;
...@@ -1004,7 +1004,7 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused))) ...@@ -1004,7 +1004,7 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
free_saved (dtp); free_saved (dtp);
sprintf (message, "Invalid string input in item %d", sprintf (message, "Invalid string input in item %d",
dtp->u.p.item_count); 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) ...@@ -1123,7 +1123,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
free_saved (dtp); free_saved (dtp);
sprintf (message, "Bad floating point number for item %d", sprintf (message, "Bad floating point number for item %d",
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return 1; return 1;
} }
...@@ -1206,7 +1206,7 @@ eol_2: ...@@ -1206,7 +1206,7 @@ eol_2:
free_saved (dtp); free_saved (dtp);
sprintf (message, "Bad complex value in item %d of list input", sprintf (message, "Bad complex value in item %d of list input",
dtp->u.p.item_count); 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) ...@@ -1421,7 +1421,7 @@ read_real (st_parameter_dt *dtp, int length)
free_saved (dtp); free_saved (dtp);
sprintf (message, "Bad real number in item %d of list input", sprintf (message, "Bad real number in item %d of list input",
dtp->u.p.item_count); 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) ...@@ -1439,7 +1439,7 @@ check_type (st_parameter_dt *dtp, bt type, int len)
type_name (dtp->u.p.saved_type), type_name (type), type_name (dtp->u.p.saved_type), type_name (type),
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return 1; return 1;
} }
...@@ -1452,7 +1452,7 @@ check_type (st_parameter_dt *dtp, bt type, int len) ...@@ -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", "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.saved_length, type_name (dtp->u.p.saved_type), len,
dtp->u.p.item_count); dtp->u.p.item_count);
generate_error (&dtp->common, ERROR_READ_VALUE, message); generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
return 1; return 1;
} }
...@@ -1478,7 +1478,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, ...@@ -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; dtp->u.p.eof_jump = &eof_jump;
if (setjmp (eof_jump)) if (setjmp (eof_jump))
{ {
generate_error (&dtp->common, ERROR_END, NULL); generate_error (&dtp->common, LIBERROR_END, NULL);
goto cleanup; goto cleanup;
} }
...@@ -2550,7 +2550,7 @@ namelist_read (st_parameter_dt *dtp) ...@@ -2550,7 +2550,7 @@ namelist_read (st_parameter_dt *dtp)
if (setjmp (eof_jump)) if (setjmp (eof_jump))
{ {
dtp->u.p.eof_jump = NULL; dtp->u.p.eof_jump = NULL;
generate_error (&dtp->common, ERROR_END, NULL); generate_error (&dtp->common, LIBERROR_END, NULL);
return; return;
} }
...@@ -2634,6 +2634,6 @@ nml_err_ret: ...@@ -2634,6 +2634,6 @@ nml_err_ret:
dtp->u.p.eof_jump = NULL; dtp->u.p.eof_jump = NULL;
free_saved (dtp); free_saved (dtp);
free_line (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; return;
} }
...@@ -99,10 +99,10 @@ static const st_option pad_opt[] = ...@@ -99,10 +99,10 @@ static const st_option pad_opt[] =
static const st_option convert_opt[] = static const st_option convert_opt[] =
{ {
{ "native", CONVERT_NATIVE}, { "native", GFC_CONVERT_NATIVE},
{ "swap", CONVERT_SWAP}, { "swap", GFC_CONVERT_SWAP},
{ "big_endian", CONVERT_BIG}, { "big_endian", GFC_CONVERT_BIG},
{ "little_endian", CONVERT_LITTLE}, { "little_endian", GFC_CONVERT_LITTLE},
{ NULL, 0} { NULL, 0}
}; };
...@@ -130,24 +130,24 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) ...@@ -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 && if (flags->status != STATUS_UNSPECIFIED && flags->status != STATUS_OLD &&
u->flags.status != flags->status) 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"); "Cannot change STATUS parameter in OPEN statement");
if (flags->access != ACCESS_UNSPECIFIED && u->flags.access != flags->access) 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"); "Cannot change ACCESS parameter in OPEN statement");
if (flags->form != FORM_UNSPECIFIED && u->flags.form != flags->form) 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"); "Cannot change FORM parameter in OPEN statement");
if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN)
&& opp->recl_in != u->recl) && 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"); "Cannot change RECL parameter in OPEN statement");
if (flags->action != ACTION_UNSPECIFIED && u->flags.action != flags->action) 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"); "Cannot change ACTION parameter in OPEN statement");
/* Status must be OLD if present. */ /* Status must be OLD if present. */
...@@ -159,24 +159,24 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) ...@@ -159,24 +159,24 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
notify_std (&opp->common, GFC_STD_GNU, notify_std (&opp->common, GFC_STD_GNU,
"OPEN statement must have a STATUS of OLD or UNKNOWN"); "OPEN statement must have a STATUS of OLD or UNKNOWN");
else 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"); "OPEN statement must have a STATUS of OLD or UNKNOWN");
} }
if (u->flags.form == FORM_UNFORMATTED) if (u->flags.form == FORM_UNFORMATTED)
{ {
if (flags->delim != DELIM_UNSPECIFIED) 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 " "DELIM parameter conflicts with UNFORMATTED form in "
"OPEN statement"); "OPEN statement");
if (flags->blank != BLANK_UNSPECIFIED) 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 " "BLANK parameter conflicts with UNFORMATTED form in "
"OPEN statement"); "OPEN statement");
if (flags->pad != PAD_UNSPECIFIED) 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 " "PAD parameter conflicts with UNFORMATTED form in "
"OPEN statement"); "OPEN statement");
} }
...@@ -221,7 +221,7 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) ...@@ -221,7 +221,7 @@ edit_modes (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
break; break;
seek_error: seek_error:
generate_error (&opp->common, ERROR_OS, NULL); generate_error (&opp->common, LIBERROR_OS, NULL);
break; break;
} }
...@@ -256,7 +256,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) ...@@ -256,7 +256,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
{ {
if (flags->form == FORM_UNFORMATTED) 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 " "DELIM parameter conflicts with UNFORMATTED form in "
"OPEN statement"); "OPEN statement");
goto fail; goto fail;
...@@ -269,7 +269,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) ...@@ -269,7 +269,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
{ {
if (flags->form == FORM_UNFORMATTED) 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 " "BLANK parameter conflicts with UNFORMATTED form in "
"OPEN statement"); "OPEN statement");
goto fail; goto fail;
...@@ -282,7 +282,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) ...@@ -282,7 +282,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
{ {
if (flags->form == FORM_UNFORMATTED) 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 " "PAD parameter conflicts with UNFORMATTED form in "
"OPEN statement"); "OPEN statement");
goto fail; goto fail;
...@@ -291,7 +291,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) ...@@ -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) 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 " "ACCESS parameter conflicts with SEQUENTIAL access in "
"OPEN statement"); "OPEN statement");
goto fail; goto fail;
...@@ -309,14 +309,14 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) ...@@ -309,14 +309,14 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
if (flags->access == ACCESS_DIRECT if (flags->access == ACCESS_DIRECT
&& (opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) == 0) && (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"); "Missing RECL parameter in OPEN statement");
goto fail; goto fail;
} }
if ((opp->common.flags & IOPARM_OPEN_HAS_RECL_IN) && opp->recl_in <= 0) 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"); "RECL parameter is non-positive in OPEN statement");
goto fail; goto fail;
} }
...@@ -330,7 +330,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) ...@@ -330,7 +330,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
break; break;
} }
generate_error (&opp->common, ERROR_BAD_OPTION, generate_error (&opp->common, LIBERROR_BAD_OPTION,
"FILE parameter must not be present in OPEN statement"); "FILE parameter must not be present in OPEN statement");
goto fail; goto fail;
...@@ -366,7 +366,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) ...@@ -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)) && (options.stderr_unit < 0 || u2->unit_number != options.stderr_unit))
{ {
unlock_unit (u2); unlock_unit (u2);
generate_error (&opp->common, ERROR_ALREADY_OPEN, NULL); generate_error (&opp->common, LIBERROR_ALREADY_OPEN, NULL);
goto cleanup; goto cleanup;
} }
...@@ -405,7 +405,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) ...@@ -405,7 +405,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
msg = NULL; msg = NULL;
} }
generate_error (&opp->common, ERROR_OS, msg); generate_error (&opp->common, LIBERROR_OS, msg);
goto cleanup; goto cleanup;
} }
...@@ -431,7 +431,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags) ...@@ -431,7 +431,7 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
if (flags->position == POSITION_APPEND) if (flags->position == POSITION_APPEND)
{ {
if (sseek (u->s, file_length (u->s)) == FAILURE) 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; u->endfile = AT_ENDFILE;
} }
...@@ -544,7 +544,7 @@ already_open (st_parameter_open *opp, gfc_unit * u, unit_flags * flags) ...@@ -544,7 +544,7 @@ already_open (st_parameter_open *opp, gfc_unit * u, unit_flags * flags)
if (sclose (u->s) == FAILURE) if (sclose (u->s) == FAILURE)
{ {
unlock_unit (u); unlock_unit (u);
generate_error (&opp->common, ERROR_OS, generate_error (&opp->common, LIBERROR_OS,
"Error closing file in OPEN statement"); "Error closing file in OPEN statement");
return; return;
} }
...@@ -624,7 +624,7 @@ st_open (st_parameter_open *opp) ...@@ -624,7 +624,7 @@ st_open (st_parameter_open *opp)
conv = get_unformatted_convert (opp->common.unit); 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. */ /* Nothing has been set by environment variable, check the convert tag. */
if (cf & IOPARM_OPEN_HAS_CONVERT) if (cf & IOPARM_OPEN_HAS_CONVERT)
...@@ -639,16 +639,16 @@ st_open (st_parameter_open *opp) ...@@ -639,16 +639,16 @@ st_open (st_parameter_open *opp)
and 1 on big-endian machines. */ and 1 on big-endian machines. */
switch (conv) switch (conv)
{ {
case CONVERT_NATIVE: case GFC_CONVERT_NATIVE:
case CONVERT_SWAP: case GFC_CONVERT_SWAP:
break; break;
case CONVERT_BIG: case GFC_CONVERT_BIG:
conv = l8_to_l4_offset ? CONVERT_NATIVE : CONVERT_SWAP; conv = l8_to_l4_offset ? GFC_CONVERT_NATIVE : GFC_CONVERT_SWAP;
break; break;
case CONVERT_LITTLE: case GFC_CONVERT_LITTLE:
conv = l8_to_l4_offset ? CONVERT_SWAP : CONVERT_NATIVE; conv = l8_to_l4_offset ? GFC_CONVERT_SWAP : GFC_CONVERT_NATIVE;
break; break;
default: default:
...@@ -659,19 +659,19 @@ st_open (st_parameter_open *opp) ...@@ -659,19 +659,19 @@ st_open (st_parameter_open *opp)
flags.convert = conv; flags.convert = conv;
if (opp->common.unit < 0) 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"); "Bad unit number in OPEN statement");
if (flags.position != POSITION_UNSPECIFIED if (flags.position != POSITION_UNSPECIFIED
&& flags.access == ACCESS_DIRECT) && 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"); "Cannot use POSITION with direct access files");
if (flags.access == ACCESS_APPEND) if (flags.access == ACCESS_APPEND)
{ {
if (flags.position != POSITION_UNSPECIFIED if (flags.position != POSITION_UNSPECIFIED
&& flags.position != POSITION_APPEND) && flags.position != POSITION_APPEND)
generate_error (&opp->common, ERROR_BAD_OPTION, generate_error (&opp->common, LIBERROR_BAD_OPTION,
"Conflicting ACCESS and POSITION flags in" "Conflicting ACCESS and POSITION flags in"
" OPEN statement"); " OPEN statement");
......
...@@ -175,7 +175,7 @@ convert_real (st_parameter_dt *dtp, void *dest, const char *buffer, int length) ...@@ -175,7 +175,7 @@ convert_real (st_parameter_dt *dtp, void *dest, const char *buffer, int length)
if (errno == EINVAL) if (errno == EINVAL)
{ {
generate_error (&dtp->common, ERROR_READ_VALUE, generate_error (&dtp->common, LIBERROR_READ_VALUE,
"Error during floating point read"); "Error during floating point read");
return 1; return 1;
} }
...@@ -223,7 +223,7 @@ read_l (st_parameter_dt *dtp, const fnode *f, char *dest, int length) ...@@ -223,7 +223,7 @@ read_l (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
break; break;
default: default:
bad: bad:
generate_error (&dtp->common, ERROR_READ_VALUE, generate_error (&dtp->common, LIBERROR_READ_VALUE,
"Bad value on logical read"); "Bad value on logical read");
break; break;
} }
...@@ -393,12 +393,12 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length) ...@@ -393,12 +393,12 @@ read_decimal (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
return; return;
bad: bad:
generate_error (&dtp->common, ERROR_READ_VALUE, generate_error (&dtp->common, LIBERROR_READ_VALUE,
"Bad value during integer read"); "Bad value during integer read");
return; return;
overflow: overflow:
generate_error (&dtp->common, ERROR_READ_OVERFLOW, generate_error (&dtp->common, LIBERROR_READ_OVERFLOW,
"Value overflowed during integer read"); "Value overflowed during integer read");
return; return;
} }
...@@ -537,12 +537,12 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length, ...@@ -537,12 +537,12 @@ read_radix (st_parameter_dt *dtp, const fnode *f, char *dest, int length,
return; return;
bad: bad:
generate_error (&dtp->common, ERROR_READ_VALUE, generate_error (&dtp->common, LIBERROR_READ_VALUE,
"Bad value during integer read"); "Bad value during integer read");
return; return;
overflow: overflow:
generate_error (&dtp->common, ERROR_READ_OVERFLOW, generate_error (&dtp->common, LIBERROR_READ_OVERFLOW,
"Value overflowed during integer read"); "Value overflowed during integer read");
return; return;
} }
...@@ -657,7 +657,7 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length) ...@@ -657,7 +657,7 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
goto done; goto done;
bad_float: bad_float:
generate_error (&dtp->common, ERROR_READ_VALUE, generate_error (&dtp->common, LIBERROR_READ_VALUE,
"Bad value during floating point read"); "Bad value during floating point read");
return; return;
......
...@@ -375,7 +375,7 @@ get_internal_unit (st_parameter_dt *dtp) ...@@ -375,7 +375,7 @@ get_internal_unit (st_parameter_dt *dtp)
iunit = get_mem (sizeof (gfc_unit)); iunit = get_mem (sizeof (gfc_unit));
if (iunit == NULL) if (iunit == NULL)
{ {
generate_error (&dtp->common, ERROR_INTERNAL_UNIT, NULL); generate_error (&dtp->common, LIBERROR_INTERNAL_UNIT, NULL);
return NULL; return NULL;
} }
......
...@@ -37,16 +37,14 @@ Boston, MA 02110-1301, USA. */ ...@@ -37,16 +37,14 @@ Boston, MA 02110-1301, USA. */
#include <float.h> #include <float.h>
#include <stdarg.h> #include <stdarg.h>
#ifndef M_PI
#define M_PI 3.14159265358979323846264338327
#endif
#if HAVE_COMPLEX_H #if HAVE_COMPLEX_H
# include <complex.h> # include <complex.h>
#else #else
#define complex __complex__ #define complex __complex__
#endif #endif
#include "../gcc/fortran/libgfortran.h"
#include "config.h" #include "config.h"
#include "c99_protos.h" #include "c99_protos.h"
...@@ -276,9 +274,6 @@ internal_proto(l8_to_l4_offset); ...@@ -276,9 +274,6 @@ internal_proto(l8_to_l4_offset);
#define GFC_REAL_16_RADIX FLT_RADIX #define GFC_REAL_16_RADIX FLT_RADIX
#endif #endif
#ifndef GFC_MAX_DIMENSIONS
#define GFC_MAX_DIMENSIONS 7
#endif
typedef struct descriptor_dimension typedef struct descriptor_dimension
{ {
...@@ -330,25 +325,6 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_8) gfc_array_l8; ...@@ -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; typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, GFC_LOGICAL_16) gfc_array_l16;
#endif #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_RANK(desc) ((desc)->dtype & GFC_DTYPE_RANK_MASK)
#define GFC_DESCRIPTOR_TYPE(desc) (((desc)->dtype & GFC_DTYPE_TYPE_MASK) \ #define GFC_DESCRIPTOR_TYPE(desc) (((desc)->dtype & GFC_DTYPE_TYPE_MASK) \
...@@ -423,60 +399,6 @@ typedef struct ...@@ -423,60 +399,6 @@ typedef struct
} }
st_option; 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 /* This is returned by notification_std to know if, given the flags
that were given (-std=, -pedantic) we should issue an error, a warning that were given (-std=, -pedantic) we should issue an error, a warning
...@@ -505,8 +427,8 @@ iexport_data_proto(filename); ...@@ -505,8 +427,8 @@ iexport_data_proto(filename);
#define gfc_alloca(x) __builtin_alloca(x) #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" #define DEFAULT_TEMPDIR "/tmp"
/* The default value of record length for preconnected units is defined /* The default value of record length for preconnected units is defined
...@@ -514,9 +436,6 @@ iexport_data_proto(filename); ...@@ -514,9 +436,6 @@ iexport_data_proto(filename);
Default value is 1 Gb. */ Default value is 1 Gb. */
#define DEFAULT_RECL 1073741824 #define DEFAULT_RECL 1073741824
typedef enum
{ CONVERT_NONE=-1, CONVERT_NATIVE, CONVERT_SWAP, CONVERT_BIG, CONVERT_LITTLE }
unit_convert;
#define CHARACTER2(name) \ #define CHARACTER2(name) \
gfc_charlen_type name ## _len; \ gfc_charlen_type name ## _len; \
......
...@@ -460,17 +460,18 @@ show_signal (variable * v) ...@@ -460,17 +460,18 @@ show_signal (variable * v)
static variable variable_table[] = { 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" "Unit number that will be preconnected to standard input\n"
"(No preconnection if negative)", 0}, "(No preconnection if negative)", 0},
{"GFORTRAN_STDOUT_UNIT", 6, &options.stdout_unit, init_integer, {"GFORTRAN_STDOUT_UNIT", GFC_STDOUT_UNIT_NUMBER, &options.stdout_unit,
show_integer, init_integer, show_integer,
"Unit number that will be preconnected to standard output\n" "Unit number that will be preconnected to standard output\n"
"(No preconnection if negative)", 0}, "(No preconnection if negative)", 0},
{"GFORTRAN_STDERR_UNIT", 0, &options.stderr_unit, init_integer, {"GFORTRAN_STDERR_UNIT", GFC_STDERR_UNIT_NUMBER, &options.stderr_unit,
show_integer, init_integer, show_integer,
"Unit number that will be preconnected to standard error\n" "Unit number that will be preconnected to standard error\n"
"(No preconnection if negative)", 0}, "(No preconnection if negative)", 0},
...@@ -622,7 +623,7 @@ show_variables (void) ...@@ -622,7 +623,7 @@ show_variables (void)
st_printf ("\nRuntime error codes:"); st_printf ("\nRuntime error codes:");
st_printf ("\n--------------------\n"); 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) if (n < 0 || n > 9)
st_printf ("%d %s\n", n, translate_error (n)); st_printf ("%d %s\n", n, translate_error (n));
else else
...@@ -881,19 +882,19 @@ do_parse (void) ...@@ -881,19 +882,19 @@ do_parse (void)
switch (tok) switch (tok)
{ {
case NATIVE: case NATIVE:
endian = CONVERT_NATIVE; endian = GFC_CONVERT_NATIVE;
break; break;
case SWAP: case SWAP:
endian = CONVERT_SWAP; endian = GFC_CONVERT_SWAP;
break; break;
case BIG: case BIG:
endian = CONVERT_BIG; endian = GFC_CONVERT_BIG;
break; break;
case LITTLE: case LITTLE:
endian = CONVERT_LITTLE; endian = GFC_CONVERT_LITTLE;
break; break;
case INTEGER: case INTEGER:
...@@ -948,25 +949,25 @@ do_parse (void) ...@@ -948,25 +949,25 @@ do_parse (void)
case NATIVE: case NATIVE:
if (next_token () != ':') if (next_token () != ':')
goto error; goto error;
endian = CONVERT_NATIVE; endian = GFC_CONVERT_NATIVE;
break; break;
case SWAP: case SWAP:
if (next_token () != ':') if (next_token () != ':')
goto error; goto error;
endian = CONVERT_SWAP; endian = GFC_CONVERT_SWAP;
break; break;
case LITTLE: case LITTLE:
if (next_token () != ':') if (next_token () != ':')
goto error; goto error;
endian = CONVERT_LITTLE; endian = GFC_CONVERT_LITTLE;
break; break;
case BIG: case BIG:
if (next_token () != ':') if (next_token () != ':')
goto error; goto error;
endian = CONVERT_BIG; endian = GFC_CONVERT_BIG;
break; break;
case INTEGER: case INTEGER:
...@@ -1034,7 +1035,7 @@ do_parse (void) ...@@ -1034,7 +1035,7 @@ do_parse (void)
end: end:
return 0; return 0;
error: error:
def = CONVERT_NONE; def = GFC_CONVERT_NONE;
return -1; return -1;
} }
...@@ -1042,7 +1043,7 @@ void init_unformatted (variable * v) ...@@ -1042,7 +1043,7 @@ void init_unformatted (variable * v)
{ {
char *val; char *val;
val = getenv (v->name); val = getenv (v->name);
def = CONVERT_NONE; def = GFC_CONVERT_NONE;
n_elist = 0; n_elist = 0;
if (val == NULL) if (val == NULL)
......
...@@ -310,83 +310,83 @@ translate_error (int code) ...@@ -310,83 +310,83 @@ translate_error (int code)
switch (code) switch (code)
{ {
case ERROR_EOR: case LIBERROR_EOR:
p = "End of record"; p = "End of record";
break; break;
case ERROR_END: case LIBERROR_END:
p = "End of file"; p = "End of file";
break; break;
case ERROR_OK: case LIBERROR_OK:
p = "Successful return"; p = "Successful return";
break; break;
case ERROR_OS: case LIBERROR_OS:
p = "Operating system error"; p = "Operating system error";
break; break;
case ERROR_BAD_OPTION: case LIBERROR_BAD_OPTION:
p = "Bad statement option"; p = "Bad statement option";
break; break;
case ERROR_MISSING_OPTION: case LIBERROR_MISSING_OPTION:
p = "Missing statement option"; p = "Missing statement option";
break; break;
case ERROR_OPTION_CONFLICT: case LIBERROR_OPTION_CONFLICT:
p = "Conflicting statement options"; p = "Conflicting statement options";
break; break;
case ERROR_ALREADY_OPEN: case LIBERROR_ALREADY_OPEN:
p = "File already opened in another unit"; p = "File already opened in another unit";
break; break;
case ERROR_BAD_UNIT: case LIBERROR_BAD_UNIT:
p = "Unattached unit"; p = "Unattached unit";
break; break;
case ERROR_FORMAT: case LIBERROR_FORMAT:
p = "FORMAT error"; p = "FORMAT error";
break; break;
case ERROR_BAD_ACTION: case LIBERROR_BAD_ACTION:
p = "Incorrect ACTION specified"; p = "Incorrect ACTION specified";
break; break;
case ERROR_ENDFILE: case LIBERROR_ENDFILE:
p = "Read past ENDFILE record"; p = "Read past ENDFILE record";
break; break;
case ERROR_BAD_US: case LIBERROR_BAD_US:
p = "Corrupt unformatted sequential file"; p = "Corrupt unformatted sequential file";
break; break;
case ERROR_READ_VALUE: case LIBERROR_READ_VALUE:
p = "Bad value during read"; p = "Bad value during read";
break; break;
case ERROR_READ_OVERFLOW: case LIBERROR_READ_OVERFLOW:
p = "Numeric overflow on read"; p = "Numeric overflow on read";
break; break;
case ERROR_INTERNAL: case LIBERROR_INTERNAL:
p = "Internal error in run-time library"; p = "Internal error in run-time library";
break; break;
case ERROR_INTERNAL_UNIT: case LIBERROR_INTERNAL_UNIT:
p = "Internal unit I/O error"; p = "Internal unit I/O error";
break; break;
case ERROR_DIRECT_EOR: case LIBERROR_DIRECT_EOR:
p = "Write exceeds length of DIRECT access record"; p = "Write exceeds length of DIRECT access record";
break; break;
case ERROR_SHORT_RECORD: case LIBERROR_SHORT_RECORD:
p = "I/O past end of record on unformatted file"; p = "I/O past end of record on unformatted file";
break; break;
case ERROR_CORRUPT_FILE: case LIBERROR_CORRUPT_FILE:
p = "Unformatted file structure has been corrupted"; p = "Unformatted file structure has been corrupted";
break; break;
...@@ -412,11 +412,11 @@ generate_error (st_parameter_common *cmp, int family, const char *message) ...@@ -412,11 +412,11 @@ generate_error (st_parameter_common *cmp, int family, const char *message)
{ {
/* Set the error status. */ /* Set the error status. */
if ((cmp->flags & IOPARM_HAS_IOSTAT)) if ((cmp->flags & IOPARM_HAS_IOSTAT))
*cmp->iostat = (family == ERROR_OS) ? errno : family; *cmp->iostat = (family == LIBERROR_OS) ? errno : family;
if (message == NULL) if (message == NULL)
message = message =
(family == ERROR_OS) ? get_oserror () : translate_error (family); (family == LIBERROR_OS) ? get_oserror () : translate_error (family);
if (cmp->flags & IOPARM_HAS_IOMSG) if (cmp->flags & IOPARM_HAS_IOMSG)
cf_strcpy (cmp->iomsg, cmp->iomsg_len, message); cf_strcpy (cmp->iomsg, cmp->iomsg_len, message);
...@@ -425,13 +425,13 @@ generate_error (st_parameter_common *cmp, int family, const char *message) ...@@ -425,13 +425,13 @@ generate_error (st_parameter_common *cmp, int family, const char *message)
cmp->flags &= ~IOPARM_LIBRETURN_MASK; cmp->flags &= ~IOPARM_LIBRETURN_MASK;
switch (family) switch (family)
{ {
case ERROR_EOR: case LIBERROR_EOR:
cmp->flags |= IOPARM_LIBRETURN_EOR; cmp->flags |= IOPARM_LIBRETURN_EOR;
if ((cmp->flags & IOPARM_EOR)) if ((cmp->flags & IOPARM_EOR))
return; return;
break; break;
case ERROR_END: case LIBERROR_END:
cmp->flags |= IOPARM_LIBRETURN_END; cmp->flags |= IOPARM_LIBRETURN_END;
if ((cmp->flags & IOPARM_END)) if ((cmp->flags & IOPARM_END))
return; return;
......
...@@ -122,7 +122,7 @@ find_option (st_parameter_common *cmp, const char *s1, gfc_charlen_type s1_len, ...@@ -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)) if (compare0 (s1, s1_len, opts->name))
return opts->value; return opts->value;
generate_error (cmp, ERROR_BAD_OPTION, error_message); generate_error (cmp, LIBERROR_BAD_OPTION, error_message);
return -1; return -1;
} }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment