Skip to content

R
riscv-gcc-1
Commit e2cad04b by Richard Henderson Committed by Richard Henderson
Options

Make-lang.in (fortran/f95-lang.o): Update dependencies. 

        * Make-lang.in (fortran/f95-lang.o): Update dependencies.
        (fortran/trans-decl.o, fortran/trans-types.o): Likewise.
        * gfortran.h (gfc_integer_info): Add c_char, c_short, c_int,
        c_long, c_long_long.
        (gfc_logical_info): Add c_bool.
        (gfc_real_info): Add mode_precision, c_float, c_double, c_long_double.
        * trans-array.c (gfc_array_allocate): Use TYPE_PRECISION
        rather than gfc_int[48]_type_node for allocate choice.
        * trans-decl.c (gfc_build_intrinsic_function_decls): Cache
        local copies of some kind type nodes.
        (gfc_build_builtin_function_decls): Likewise.
        * trans-expr.c (gfc_conv_power_op): Likewise.
        * trans-intrinsic.c (gfc_conv_intrinsic_index,
        gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify,
        gfc_conv_intrinsic_trim, gfc_conv_intrinsic_repeat): Likewise.
        * trans-stmt.c (gfc_trans_pause, gfc_trans_stop,
        gfc_trans_character_select, gfc_trans_allocate): Likewise.
        * trans-io.c (gfc_pint4_type_node): Move into ...
        (gfc_build_io_library_fndecls): ... here.  Cache local copies of
        some kind type nodes.
        * trans-types.c (gfc_type_nodes): Remove.
        (gfc_character1_type_node, gfc_strlen_type_node): New.
        (gfc_integer_types, gfc_logical_types): New.
        (gfc_real_types, gfc_complex_types): New.
        (gfc_init_kinds): Fill in real mode_precision.
        (gfc_build_int_type, gfc_build_real_type): New.
        (gfc_build_complex_type, gfc_build_logical_type): New.
        (c_size_t_size): New.
        (gfc_init_types): Loop over kinds.
        (gfc_get_int_type, gfc_get_real_type): Use gfc_validate_kind.
        (gfc_get_complex_type, gfc_get_logical_type): Likewise.
        (gfc_get_character_type_len): Likewise.
        (gfc_type_for_size): Loop over kinds; use a reduced set of
        unsigned type nodes.
        (gfc_type_for_mode): Loop over kinds.
        (gfc_signed_or_unsigned_type): Use gfc_type_for_size.
        (gfc_unsigned_type, gfc_signed_type): Use gfc_signed_or_unsigned_type.
        * trans-types.h (F95_INT1_TYPE, F95_INT2_TYPE, F95_INT4_TYPE,
        F95_INT8_TYPE, F95_INT16_TYPE, F95_REAL4_TYPE, F95_REAL8_TYPE,
        F95_REAl16_TYPE, F95_COMPLEX4_TYPE, F95_COMPLEX8_TYPE,
        F95_COMPLEX16_TYPE, F95_LOGICAL1_TYPE, F95_LOGICAL2_TYPE,
        F95_LOGICAL4_TYPE, F95_LOGICAL8_TYPE, F95_LOGICAL16_TYPE,
        F95_CHARACTER1_TYPE, NUM_F95_TYPES, gfc_type_nodes,
        gfc_int1_type_node, gfc_int2_type_node, gfc_int4_type_node,
        gfc_int8_type_node, gfc_int16_type_node, gfc_real4_type_node,
        gfc_real8_type_node, gfc_real16_type_node, gfc_complex4_type_node,
        gfc_complex8_type_node, gfc_complex16_type_node,
        gfc_logical1_type_node, gfc_logical2_type_node,
        gfc_logical4_type_node, gfc_logical8_type_node,
        gfc_logical16_type_node, gfc_strlen_kind): Remove.
        (gfc_character1_type_node): Turn in to a variable.
        (gfc_strlen_type_node): Likewise.

From-SVN: r86806
parent bc482be4
Showing with 367 additions and 412 deletions
gcc/fortran/ChangeLog
2004-08-30 Richard Henderson <rth@redhat.com>
* Make-lang.in (fortran/f95-lang.o): Update dependencies.
(fortran/trans-decl.o, fortran/trans-types.o): Likewise.
* gfortran.h (gfc_integer_info): Add c_char, c_short, c_int,
c_long, c_long_long.
(gfc_logical_info): Add c_bool.
(gfc_real_info): Add mode_precision, c_float, c_double, c_long_double.
* trans-array.c (gfc_array_allocate): Use TYPE_PRECISION
rather than gfc_int[48]_type_node for allocate choice.
* trans-decl.c (gfc_build_intrinsic_function_decls): Cache
local copies of some kind type nodes.
(gfc_build_builtin_function_decls): Likewise.
* trans-expr.c (gfc_conv_power_op): Likewise.
* trans-intrinsic.c (gfc_conv_intrinsic_index,
gfc_conv_intrinsic_scan, gfc_conv_intrinsic_verify,
gfc_conv_intrinsic_trim, gfc_conv_intrinsic_repeat): Likewise.
* trans-stmt.c (gfc_trans_pause, gfc_trans_stop,
gfc_trans_character_select, gfc_trans_allocate): Likewise.
* trans-io.c (gfc_pint4_type_node): Move into ...
(gfc_build_io_library_fndecls): ... here. Cache local copies of
some kind type nodes.
* trans-types.c (gfc_type_nodes): Remove.
(gfc_character1_type_node, gfc_strlen_type_node): New.
(gfc_integer_types, gfc_logical_types): New.
(gfc_real_types, gfc_complex_types): New.
(gfc_init_kinds): Fill in real mode_precision.
(gfc_build_int_type, gfc_build_real_type): New.
(gfc_build_complex_type, gfc_build_logical_type): New.
(c_size_t_size): New.
(gfc_init_types): Loop over kinds.
(gfc_get_int_type, gfc_get_real_type): Use gfc_validate_kind.
(gfc_get_complex_type, gfc_get_logical_type): Likewise.
(gfc_get_character_type_len): Likewise.
(gfc_type_for_size): Loop over kinds; use a reduced set of
unsigned type nodes.
(gfc_type_for_mode): Loop over kinds.
(gfc_signed_or_unsigned_type): Use gfc_type_for_size.
(gfc_unsigned_type, gfc_signed_type): Use gfc_signed_or_unsigned_type.
* trans-types.h (F95_INT1_TYPE, F95_INT2_TYPE, F95_INT4_TYPE,
F95_INT8_TYPE, F95_INT16_TYPE, F95_REAL4_TYPE, F95_REAL8_TYPE,
F95_REAl16_TYPE, F95_COMPLEX4_TYPE, F95_COMPLEX8_TYPE,
F95_COMPLEX16_TYPE, F95_LOGICAL1_TYPE, F95_LOGICAL2_TYPE,
F95_LOGICAL4_TYPE, F95_LOGICAL8_TYPE, F95_LOGICAL16_TYPE,
F95_CHARACTER1_TYPE, NUM_F95_TYPES, gfc_type_nodes,
gfc_int1_type_node, gfc_int2_type_node, gfc_int4_type_node,
gfc_int8_type_node, gfc_int16_type_node, gfc_real4_type_node,
gfc_real8_type_node, gfc_real16_type_node, gfc_complex4_type_node,
gfc_complex8_type_node, gfc_complex16_type_node,
gfc_logical1_type_node, gfc_logical2_type_node,
gfc_logical4_type_node, gfc_logical8_type_node,
gfc_logical16_type_node, gfc_strlen_kind): Remove.
(gfc_character1_type_node): Turn in to a variable.
(gfc_strlen_type_node): Likewise.
2004-08-30 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de> 2004-08-30 Tobias Schlueter <tobias.schlueter@physik.uni-muenchen.de>
* gfortran.h (gfc_namespace): Add new field is_block_data. * gfortran.h (gfc_namespace): Add new field is_block_data.
......
gcc/fortran/Make-lang.in
...@@ -278,14 +278,17 @@ $(F95_PARSER_OBJS): fortran/gfortran.h fortran/intrinsic.h fortran/match.h \ ...@@ -278,14 +278,17 @@ $(F95_PARSER_OBJS): fortran/gfortran.h fortran/intrinsic.h fortran/match.h \
GFORTRAN_TRANS_DEPS = fortran/gfortran.h fortran/intrinsic.h fortran/trans-array.h \ GFORTRAN_TRANS_DEPS = fortran/gfortran.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 $(CONFIG_H) $(SYSTEM_H) $(TREE_H) $(TM_H) coretypes.h $(GGC_H)
fortran/f95-lang.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \ fortran/f95-lang.o: $(GFORTRAN_TRANS_DEPS) fortran/mathbuiltins.def \
gt-fortran-f95-lang.h gtype-fortran.h cgraph.h gt-fortran-f95-lang.h gtype-fortran.h cgraph.h $(TARGET_H)
fortran/convert.o: $(GFORTRAN_TRANS_DEPS) fortran/convert.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans.o: $(GFORTRAN_TRANS_DEPS) fortran/trans.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans-decl.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-decl.h cgraph.h fortran/trans-decl.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-decl.h \
fortran/trans-types.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-types.h cgraph.h $(TARGET_H) function.h errors.h $(FLAGS_H) tree-gimple.h \
tree-dump.h
fortran/trans-types.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-types.h \
real.h toplev.h $(TARGET_H)
fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS) fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans-expr.o: $(GFORTRAN_TRANS_DEPS) fortran/trans-expr.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans-stmt.o: $(GFORTRAN_TRANS_DEPS) fortran/trans-stmt.o: $(GFORTRAN_TRANS_DEPS)
......
gcc/fortran/gfortran.h
...@@ -1090,12 +1090,18 @@ gfc_expr; ...@@ -1090,12 +1090,18 @@ gfc_expr;
typedef struct typedef struct
{ {
int kind, radix, digits, bit_size; /* Values really representable by the target. */
mpz_t huge, min_int, max_int;
int range;
mpz_t huge; int kind, radix, digits, bit_size, range;
mpz_t min_int, max_int; /* Values really representable by the target */ /* True if the C type of the given name maps to this precision.
Note that more than one bit can be set. */
unsigned int c_char : 1;
unsigned int c_short : 1;
unsigned int c_int : 1;
unsigned int c_long : 1;
unsigned int c_long_long : 1;
} }
gfc_integer_info; gfc_integer_info;
...@@ -1106,6 +1112,8 @@ typedef struct ...@@ -1106,6 +1112,8 @@ typedef struct
{ {
int kind, bit_size; int kind, bit_size;
/* True if the C++ type bool, C99 type _Bool, maps to this precision. */
unsigned int c_bool : 1;
} }
gfc_logical_info; gfc_logical_info;
...@@ -1114,10 +1122,18 @@ extern gfc_logical_info gfc_logical_kinds[]; ...@@ -1114,10 +1122,18 @@ extern gfc_logical_info gfc_logical_kinds[];
typedef struct typedef struct
{ {
mpfr_t epsilon, huge, tiny;
int kind, radix, digits, min_exponent, max_exponent; int kind, radix, digits, min_exponent, max_exponent;
int range, precision; int range, precision;
mpfr_t epsilon, huge, tiny;
/* The precision of the type as reported by GET_MODE_PRECISION. */
int mode_precision;
/* True if the C type of the given name maps to this precision.
Note that more than one bit can be set. */
unsigned int c_float : 1;
unsigned int c_double : 1;
unsigned int c_long_double : 1;
} }
gfc_real_info; gfc_real_info;
......
gcc/fortran/trans-array.c
...@@ -2784,9 +2784,9 @@ gfc_array_allocate (gfc_se * se, gfc_ref * ref, tree pstat) ...@@ -2784,9 +2784,9 @@ gfc_array_allocate (gfc_se * se, gfc_ref * ref, tree pstat)
pointer = gfc_build_addr_expr (NULL, tmp); pointer = gfc_build_addr_expr (NULL, tmp);
pointer = gfc_evaluate_now (pointer, &se->pre); pointer = gfc_evaluate_now (pointer, &se->pre);
if (gfc_array_index_type == gfc_int4_type_node) if (TYPE_PRECISION (gfc_array_index_type) == 32)
allocate = gfor_fndecl_allocate; allocate = gfor_fndecl_allocate;
else if (gfc_array_index_type == gfc_int8_type_node) else if (TYPE_PRECISION (gfc_array_index_type) == 64)
allocate = gfor_fndecl_allocate64; allocate = gfor_fndecl_allocate64;
else else
abort (); abort ();
......
gcc/fortran/trans-decl.c
...@@ -1559,6 +1559,14 @@ gfc_build_library_function_decl (tree name, tree rettype, int nargs, ...) ...@@ -1559,6 +1559,14 @@ gfc_build_library_function_decl (tree name, tree rettype, int nargs, ...)
static void static void
gfc_build_intrinsic_function_decls (void) gfc_build_intrinsic_function_decls (void)
{ {
tree gfc_int4_type_node = gfc_get_int_type (4);
tree gfc_int8_type_node = gfc_get_int_type (8);
tree gfc_logical4_type_node = gfc_get_logical_type (4);
tree gfc_real4_type_node = gfc_get_real_type (4);
tree gfc_real8_type_node = gfc_get_real_type (8);
tree gfc_complex4_type_node = gfc_get_complex_type (4);
tree gfc_complex8_type_node = gfc_get_complex_type (8);
/* String functions. */ /* String functions. */
gfor_fndecl_copy_string = gfor_fndecl_copy_string =
gfc_build_library_function_decl (get_identifier (PREFIX("copy_string")), gfc_build_library_function_decl (get_identifier (PREFIX("copy_string")),
...@@ -1738,6 +1746,10 @@ gfc_build_intrinsic_function_decls (void) ...@@ -1738,6 +1746,10 @@ gfc_build_intrinsic_function_decls (void)
void void
gfc_build_builtin_function_decls (void) gfc_build_builtin_function_decls (void)
{ {
tree gfc_int4_type_node = gfc_get_int_type (4);
tree gfc_int8_type_node = gfc_get_int_type (8);
tree gfc_logical4_type_node = gfc_get_logical_type (4);
gfor_fndecl_internal_malloc = gfor_fndecl_internal_malloc =
gfc_build_library_function_decl (get_identifier (PREFIX("internal_malloc")), gfc_build_library_function_decl (get_identifier (PREFIX("internal_malloc")),
pvoid_type_node, 1, gfc_int4_type_node); pvoid_type_node, 1, gfc_int4_type_node);
......
gcc/fortran/trans-expr.c
...@@ -553,6 +553,7 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs) ...@@ -553,6 +553,7 @@ gfc_conv_cst_int_power (gfc_se * se, tree lhs, tree rhs)
static void static void
gfc_conv_power_op (gfc_se * se, gfc_expr * expr) gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
{ {
tree gfc_int4_type_node;
int kind; int kind;
int ikind; int ikind;
gfc_se lse; gfc_se lse;
...@@ -573,6 +574,8 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr) ...@@ -573,6 +574,8 @@ gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
if (gfc_conv_cst_int_power (se, lse.expr, rse.expr)) if (gfc_conv_cst_int_power (se, lse.expr, rse.expr))
return; return;
gfc_int4_type_node = gfc_get_int_type (4);
kind = expr->op1->ts.kind; kind = expr->op1->ts.kind;
switch (expr->op2->ts.type) switch (expr->op2->ts.type)
{ {
......
gcc/fortran/trans-intrinsic.c
...@@ -1945,6 +1945,7 @@ gfc_conv_intrinsic_len_trim (gfc_se * se, gfc_expr * expr) ...@@ -1945,6 +1945,7 @@ gfc_conv_intrinsic_len_trim (gfc_se * se, gfc_expr * expr)
static void static void
gfc_conv_intrinsic_index (gfc_se * se, gfc_expr * expr) gfc_conv_intrinsic_index (gfc_se * se, gfc_expr * expr)
{ {
tree gfc_logical4_type_node = gfc_get_logical_type (4);
tree args; tree args;
tree back; tree back;
tree type; tree type;
...@@ -2245,6 +2246,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr) ...@@ -2245,6 +2246,7 @@ gfc_conv_associated (gfc_se *se, gfc_expr *expr)
static void static void
gfc_conv_intrinsic_scan (gfc_se * se, gfc_expr * expr) gfc_conv_intrinsic_scan (gfc_se * se, gfc_expr * expr)
{ {
tree gfc_logical4_type_node = gfc_get_logical_type (4);
tree args; tree args;
tree back; tree back;
tree type; tree type;
...@@ -2277,6 +2279,7 @@ gfc_conv_intrinsic_scan (gfc_se * se, gfc_expr * expr) ...@@ -2277,6 +2279,7 @@ gfc_conv_intrinsic_scan (gfc_se * se, gfc_expr * expr)
static void static void
gfc_conv_intrinsic_verify (gfc_se * se, gfc_expr * expr) gfc_conv_intrinsic_verify (gfc_se * se, gfc_expr * expr)
{ {
tree gfc_logical4_type_node = gfc_get_logical_type (4);
tree args; tree args;
tree back; tree back;
tree type; tree type;
...@@ -2529,6 +2532,7 @@ gfc_conv_intrinsic_sr_kind (gfc_se * se, gfc_expr * expr) ...@@ -2529,6 +2532,7 @@ gfc_conv_intrinsic_sr_kind (gfc_se * se, gfc_expr * expr)
static void static void
gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr) gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr)
{ {
tree gfc_int4_type_node = gfc_get_int_type (4);
tree var; tree var;
tree len; tree len;
tree addr; tree addr;
...@@ -2570,6 +2574,7 @@ gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr) ...@@ -2570,6 +2574,7 @@ gfc_conv_intrinsic_trim (gfc_se * se, gfc_expr * expr)
static void static void
gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr) gfc_conv_intrinsic_repeat (gfc_se * se, gfc_expr * expr)
{ {
tree gfc_int4_type_node = gfc_get_int_type (4);
tree tmp; tree tmp;
tree len; tree len;
tree args; tree args;
......
gcc/fortran/trans-io.c
...@@ -39,8 +39,6 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA ...@@ -39,8 +39,6 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#include "trans-const.h" #include "trans-const.h"
static GTY(()) tree gfc_pint4_type_node;
/* Members of the ioparm structure. */ /* Members of the ioparm structure. */
static GTY(()) tree ioparm_unit; static GTY(()) tree ioparm_unit;
...@@ -160,13 +158,16 @@ static enum { READ, WRITE, IOLENGTH } last_dt; ...@@ -160,13 +158,16 @@ static enum { READ, WRITE, IOLENGTH } last_dt;
void void
gfc_build_io_library_fndecls (void) gfc_build_io_library_fndecls (void)
{ {
tree gfc_int4_type_node;
tree gfc_pint4_type_node;
tree ioparm_type; tree ioparm_type;
gfc_int4_type_node = gfc_get_int_type (4);
gfc_pint4_type_node = build_pointer_type (gfc_int4_type_node); gfc_pint4_type_node = build_pointer_type (gfc_int4_type_node);
/* Build the st_parameter structure. Information associated with I/O /* Build the st_parameter structure. Information associated with I/O
calls are transferred here. This must match the one defined in the calls are transferred here. This must match the one defined in the
library exactly. */ library exactly. */
ioparm_type = make_node (RECORD_TYPE); ioparm_type = make_node (RECORD_TYPE);
TYPE_NAME (ioparm_type) = get_identifier ("_gfc_ioparm"); TYPE_NAME (ioparm_type) = get_identifier ("_gfc_ioparm");
......
gcc/fortran/trans-stmt.c
...@@ -275,6 +275,7 @@ gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED) ...@@ -275,6 +275,7 @@ gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED)
tree tree
gfc_trans_pause (gfc_code * code) gfc_trans_pause (gfc_code * code)
{ {
tree gfc_int4_type_node = gfc_get_int_type (4);
gfc_se se; gfc_se se;
tree args; tree args;
tree tmp; tree tmp;
...@@ -314,6 +315,7 @@ gfc_trans_pause (gfc_code * code) ...@@ -314,6 +315,7 @@ gfc_trans_pause (gfc_code * code)
tree tree
gfc_trans_stop (gfc_code * code) gfc_trans_stop (gfc_code * code)
{ {
tree gfc_int4_type_node = gfc_get_int_type (4);
gfc_se se; gfc_se se;
tree args; tree args;
tree tmp; tree tmp;
...@@ -991,6 +993,8 @@ gfc_trans_character_select (gfc_code *code) ...@@ -991,6 +993,8 @@ gfc_trans_character_select (gfc_code *code)
if (select_struct == NULL) if (select_struct == NULL)
{ {
tree gfc_int4_type_node = gfc_get_int_type (4);
select_struct = make_node (RECORD_TYPE); select_struct = make_node (RECORD_TYPE);
TYPE_NAME (select_struct) = get_identifier ("_jump_struct"); TYPE_NAME (select_struct) = get_identifier ("_jump_struct");
...@@ -3016,6 +3020,8 @@ gfc_trans_allocate (gfc_code * code) ...@@ -3016,6 +3020,8 @@ gfc_trans_allocate (gfc_code * code)
if (code->expr) if (code->expr)
{ {
tree gfc_int4_type_node = gfc_get_int_type (4);
stat = gfc_create_var (gfc_int4_type_node, "stat"); stat = gfc_create_var (gfc_int4_type_node, "stat");
pstat = gfc_build_addr_expr (NULL, stat); pstat = gfc_build_addr_expr (NULL, stat);
......
gcc/fortran/trans-types.c
...@@ -50,15 +50,14 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA ...@@ -50,15 +50,14 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
static tree gfc_get_derived_type (gfc_symbol * derived); static tree gfc_get_derived_type (gfc_symbol * derived);
tree gfc_type_nodes[NUM_F95_TYPES];
tree gfc_array_index_type; tree gfc_array_index_type;
tree pvoid_type_node; tree pvoid_type_node;
tree ppvoid_type_node; tree ppvoid_type_node;
tree pchar_type_node; tree pchar_type_node;
tree gfc_character1_type_node;
tree gfc_strlen_type_node;
static GTY(()) tree gfc_desc_dim_type = NULL; static GTY(()) tree gfc_desc_dim_type;
static GTY(()) tree gfc_max_array_element_size; static GTY(()) tree gfc_max_array_element_size;
/* Arrays for all integral and real kinds. We'll fill this in at runtime /* Arrays for all integral and real kinds. We'll fill this in at runtime
...@@ -67,9 +66,13 @@ static GTY(()) tree gfc_max_array_element_size; ...@@ -67,9 +66,13 @@ static GTY(()) tree gfc_max_array_element_size;
#define MAX_INT_KINDS 5 #define MAX_INT_KINDS 5
gfc_integer_info gfc_integer_kinds[MAX_INT_KINDS + 1]; gfc_integer_info gfc_integer_kinds[MAX_INT_KINDS + 1];
gfc_logical_info gfc_logical_kinds[MAX_INT_KINDS + 1]; gfc_logical_info gfc_logical_kinds[MAX_INT_KINDS + 1];
static GTY(()) tree gfc_integer_types[MAX_INT_KINDS + 1];
static GTY(()) tree gfc_logical_types[MAX_INT_KINDS + 1];
#define MAX_REAL_KINDS 4 #define MAX_REAL_KINDS 4
gfc_real_info gfc_real_kinds[MAX_REAL_KINDS + 1]; gfc_real_info gfc_real_kinds[MAX_REAL_KINDS + 1];
static GTY(()) tree gfc_real_types[MAX_REAL_KINDS + 1];
static GTY(()) tree gfc_complex_types[MAX_REAL_KINDS + 1];
/* The integer kind to use for array indices. This will be set to the /* The integer kind to use for array indices. This will be set to the
proper value based on target information from the backend. */ proper value based on target information from the backend. */
...@@ -178,6 +181,7 @@ gfc_init_kinds (void) ...@@ -178,6 +181,7 @@ gfc_init_kinds (void)
gfc_real_kinds[r_index].digits = fmt->p; gfc_real_kinds[r_index].digits = fmt->p;
gfc_real_kinds[r_index].min_exponent = fmt->emin; gfc_real_kinds[r_index].min_exponent = fmt->emin;
gfc_real_kinds[r_index].max_exponent = fmt->emax; gfc_real_kinds[r_index].max_exponent = fmt->emax;
gfc_real_kinds[r_index].mode_precision = GET_MODE_PRECISION (mode);
r_index += 1; r_index += 1;
} }
...@@ -324,6 +328,127 @@ gfc_validate_kind (bt type, int kind, bool may_fail) ...@@ -324,6 +328,127 @@ gfc_validate_kind (bt type, int kind, bool may_fail)
} }
/* Four subroutines of gfc_init_types. Create type nodes for the given kind.
Reuse common type nodes where possible. Recognize if the kind matches up
with a C type. This will be used later in determining which routines may
be scarfed from libm. */
static tree
gfc_build_int_type (gfc_integer_info *info)
{
int mode_precision = info->bit_size;
if (mode_precision == CHAR_TYPE_SIZE)
info->c_char = 1;
if (mode_precision == SHORT_TYPE_SIZE)
info->c_short = 1;
if (mode_precision == INT_TYPE_SIZE)
info->c_int = 1;
if (mode_precision == LONG_TYPE_SIZE)
info->c_long = 1;
if (mode_precision == LONG_LONG_TYPE_SIZE)
info->c_long_long = 1;
if (TYPE_PRECISION (intQI_type_node) == mode_precision)
return intQI_type_node;
if (TYPE_PRECISION (intHI_type_node) == mode_precision)
return intHI_type_node;
if (TYPE_PRECISION (intSI_type_node) == mode_precision)
return intSI_type_node;
if (TYPE_PRECISION (intDI_type_node) == mode_precision)
return intDI_type_node;
if (TYPE_PRECISION (intTI_type_node) == mode_precision)
return intTI_type_node;
return make_signed_type (mode_precision);
}
static tree
gfc_build_real_type (gfc_real_info *info)
{
int mode_precision = info->mode_precision;
tree new_type;
if (mode_precision == FLOAT_TYPE_SIZE)
info->c_float = 1;
if (mode_precision == DOUBLE_TYPE_SIZE)
info->c_double = 1;
if (mode_precision == LONG_DOUBLE_TYPE_SIZE)
info->c_long_double = 1;
if (TYPE_PRECISION (float_type_node) == mode_precision)
return float_type_node;
if (TYPE_PRECISION (double_type_node) == mode_precision)
return double_type_node;
if (TYPE_PRECISION (long_double_type_node) == mode_precision)
return long_double_type_node;
new_type = make_node (REAL_TYPE);
TYPE_PRECISION (new_type) = mode_precision;
layout_type (new_type);
return new_type;
}
static tree
gfc_build_complex_type (tree scalar_type)
{
tree new_type;
if (scalar_type == NULL)
return NULL;
if (scalar_type == float_type_node)
return complex_float_type_node;
if (scalar_type == double_type_node)
return complex_double_type_node;
if (scalar_type == long_double_type_node)
return complex_long_double_type_node;
new_type = make_node (COMPLEX_TYPE);
TREE_TYPE (new_type) = scalar_type;
layout_type (new_type);
return new_type;
}
static tree
gfc_build_logical_type (gfc_logical_info *info)
{
int bit_size = info->bit_size;
tree new_type;
if (bit_size == BOOL_TYPE_SIZE)
{
info->c_bool = 1;
return boolean_type_node;
}
new_type = make_unsigned_type (bit_size);
TREE_SET_CODE (new_type, BOOLEAN_TYPE);
TYPE_MAX_VALUE (new_type) = build_int_cst (new_type, 1);
TYPE_PRECISION (new_type) = 1;
return new_type;
}
#if 0
/* Return the bit size of the C "size_t". */
static unsigned int
c_size_t_size (void)
{
#ifdef SIZE_TYPE
if (strcmp (SIZE_TYPE, "unsigned int") == 0)
return INT_TYPE_SIZE;
if (strcmp (SIZE_TYPE, "long unsigned int") == 0)
return LONG_TYPE_SIZE;
if (strcmp (SIZE_TYPE, "short unsigned int") == 0)
return SHORT_TYPE_SIZE;
abort ();
#else
return LONG_TYPE_SIZE;
#endif
}
#endif
/* Create the backend type nodes. We map them to their /* Create the backend type nodes. We map them to their
equivalent C type, at least for now. We also give equivalent C type, at least for now. We also give
names to the types here, and we push them in the names to the types here, and we push them in the
...@@ -332,69 +457,49 @@ gfc_validate_kind (bt type, int kind, bool may_fail) ...@@ -332,69 +457,49 @@ gfc_validate_kind (bt type, int kind, bool may_fail)
void void
gfc_init_types (void) gfc_init_types (void)
{ {
char name_buf[16];
int index;
tree type;
unsigned n; unsigned n;
unsigned HOST_WIDE_INT hi; unsigned HOST_WIDE_INT hi;
unsigned HOST_WIDE_INT lo; unsigned HOST_WIDE_INT lo;
/* Name the types. */ /* Create and name the types. */
#define PUSH_TYPE(name, node) \ #define PUSH_TYPE(name, node) \
pushdecl (build_decl (TYPE_DECL, get_identifier (name), node)) pushdecl (build_decl (TYPE_DECL, get_identifier (name), node))
gfc_int1_type_node = signed_char_type_node; for (index = 0; gfc_integer_kinds[index].kind != 0; ++index)
PUSH_TYPE ("int1", gfc_int1_type_node); {
gfc_int2_type_node = short_integer_type_node; type = gfc_build_int_type (&gfc_integer_kinds[index]);
PUSH_TYPE ("int2", gfc_int2_type_node); gfc_integer_types[index] = type;
gfc_int4_type_node = gfc_type_for_size (32, 0 /*unsigned */ ); snprintf (name_buf, sizeof(name_buf), "int%d",
PUSH_TYPE ("int4", gfc_int4_type_node); gfc_integer_kinds[index].kind);
gfc_int8_type_node = gfc_type_for_size (64, 0 /*unsigned */ ); PUSH_TYPE (name_buf, type);
PUSH_TYPE ("int8", gfc_int8_type_node); }
#if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64))
gfc_int16_type_node = gfc_type_for_size (128, 0 /*unsigned */ );
PUSH_TYPE ("int16", gfc_int16_type_node);
#endif
gfc_real4_type_node = float_type_node;
PUSH_TYPE ("real4", gfc_real4_type_node);
gfc_real8_type_node = double_type_node;
PUSH_TYPE ("real8", gfc_real8_type_node);
#if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64))
/* Hmm, this will not work. Ref. g77 */
gfc_real16_type_node = long_double_type_node;
PUSH_TYPE ("real16", gfc_real16_type_node);
#endif
gfc_complex4_type_node = complex_float_type_node; for (index = 0; gfc_logical_kinds[index].kind != 0; ++index)
PUSH_TYPE ("complex4", gfc_complex4_type_node); {
gfc_complex8_type_node = complex_double_type_node; type = gfc_build_logical_type (&gfc_logical_kinds[index]);
PUSH_TYPE ("complex8", gfc_complex8_type_node); gfc_logical_types[index] = type;
#if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64)) snprintf (name_buf, sizeof(name_buf), "logical%d",
/* Hmm, this will not work. Ref. g77 */ gfc_logical_kinds[index].kind);
gfc_complex16_type_node = complex_long_double_type_node; PUSH_TYPE (name_buf, type);
PUSH_TYPE ("complex16", gfc_complex16_type_node); }
#endif
gfc_logical1_type_node = make_node (BOOLEAN_TYPE); for (index = 0; gfc_real_kinds[index].kind != 0; index++)
TYPE_PRECISION (gfc_logical1_type_node) = 8; {
fixup_unsigned_type (gfc_logical1_type_node); type = gfc_build_real_type (&gfc_real_kinds[index]);
PUSH_TYPE ("logical1", gfc_logical1_type_node); gfc_real_types[index] = type;
gfc_logical2_type_node = make_node (BOOLEAN_TYPE); snprintf (name_buf, sizeof(name_buf), "real%d",
TYPE_PRECISION (gfc_logical2_type_node) = 16; gfc_real_kinds[index].kind);
fixup_unsigned_type (gfc_logical2_type_node); PUSH_TYPE (name_buf, type);
PUSH_TYPE ("logical2", gfc_logical2_type_node);
gfc_logical4_type_node = make_node (BOOLEAN_TYPE); type = gfc_build_complex_type (type);
TYPE_PRECISION (gfc_logical4_type_node) = 32; gfc_complex_types[index] = type;
fixup_unsigned_type (gfc_logical4_type_node); snprintf (name_buf, sizeof(name_buf), "complex%d",
PUSH_TYPE ("logical4", gfc_logical4_type_node); gfc_real_kinds[index].kind);
gfc_logical8_type_node = make_node (BOOLEAN_TYPE); PUSH_TYPE (name_buf, type);
TYPE_PRECISION (gfc_logical8_type_node) = 64; }
fixup_unsigned_type (gfc_logical8_type_node);
PUSH_TYPE ("logical8", gfc_logical8_type_node);
#if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64))
gfc_logical16_type_node = make_node (BOOLEAN_TYPE);
TYPE_PRECISION (gfc_logical16_type_node) = 128;
fixup_unsigned_type (gfc_logical16_type_node);
PUSH_TYPE ("logical16", gfc_logical16_type_node);
#endif
gfc_character1_type_node = build_type_variant (signed_char_type_node, 0, 0); gfc_character1_type_node = build_type_variant (signed_char_type_node, 0, 0);
PUSH_TYPE ("char", gfc_character1_type_node); PUSH_TYPE ("char", gfc_character1_type_node);
...@@ -407,6 +512,7 @@ gfc_init_types (void) ...@@ -407,6 +512,7 @@ gfc_init_types (void)
PUSH_TYPE ("c_integer", integer_type_node); PUSH_TYPE ("c_integer", integer_type_node);
if (!TYPE_NAME (char_type_node)) if (!TYPE_NAME (char_type_node))
PUSH_TYPE ("c_char", char_type_node); PUSH_TYPE ("c_char", char_type_node);
#undef PUSH_TYPE #undef PUSH_TYPE
pvoid_type_node = build_pointer_type (void_type_node); pvoid_type_node = build_pointer_type (void_type_node);
...@@ -419,116 +525,53 @@ gfc_init_types (void) ...@@ -419,116 +525,53 @@ gfc_init_types (void)
by the number of bits available to store this field in the array by the number of bits available to store this field in the array
descriptor. */ descriptor. */
n = TREE_INT_CST_LOW (TYPE_SIZE (gfc_array_index_type)) n = TYPE_PRECISION (gfc_array_index_type) - GFC_DTYPE_SIZE_SHIFT;
- GFC_DTYPE_SIZE_SHIFT; lo = ~ (unsigned HOST_WIDE_INT) 0;
if (n > HOST_BITS_PER_WIDE_INT)
if (n > sizeof (HOST_WIDE_INT) * 8) hi = lo >> (2*HOST_BITS_PER_WIDE_INT - n);
{
lo = ~(unsigned HOST_WIDE_INT) 0;
hi = lo >> (sizeof (HOST_WIDE_INT) * 16 - n);
}
else else
{ hi = 0, lo >>= HOST_BITS_PER_WIDE_INT - n;
hi = 0;
lo = (~(unsigned HOST_WIDE_INT) 0) >> (sizeof (HOST_WIDE_INT) * 8 - n);
}
gfc_max_array_element_size gfc_max_array_element_size
= build_int_cst_wide (long_unsigned_type_node, lo, hi); = build_int_cst_wide (long_unsigned_type_node, lo, hi);
size_type_node = gfc_array_index_type; size_type_node = gfc_array_index_type;
boolean_type_node = gfc_get_logical_type (gfc_default_logical_kind);
boolean_type_node = gfc_get_logical_type (gfc_default_logical_kind);
boolean_true_node = build_int_cst (boolean_type_node, 1); boolean_true_node = build_int_cst (boolean_type_node, 1);
boolean_false_node = build_int_cst (boolean_type_node, 0); boolean_false_node = build_int_cst (boolean_type_node, 0);
/* ??? Shouldn't this be based on gfc_index_integer_kind or so? */
gfc_strlen_type_node = gfc_get_int_type (4);
} }
/* Get a type node for an integer kind. */ /* Get the type node for the given type and kind. */
tree tree
gfc_get_int_type (int kind) gfc_get_int_type (int kind)
{ {
switch (kind) int index = gfc_validate_kind (BT_INTEGER, kind, false);
{ return gfc_integer_types[index];
case 1:
return (gfc_int1_type_node);
case 2:
return (gfc_int2_type_node);
case 4:
return (gfc_int4_type_node);
case 8:
return (gfc_int8_type_node);
#if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64))
case 16:
return (95 _int16_type_node);
#endif
default:
fatal_error ("integer kind=%d not available", kind);
}
} }
/* Get a type node for a real kind. */
tree tree
gfc_get_real_type (int kind) gfc_get_real_type (int kind)
{ {
switch (kind) int index = gfc_validate_kind (BT_REAL, kind, false);
{ return gfc_real_types[index];
case 4:
return (gfc_real4_type_node);
case 8:
return (gfc_real8_type_node);
#if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64))
case 16:
return (gfc_real16_type_node);
#endif
default:
fatal_error ("real kind=%d not available", kind);
}
} }
/* Get a type node for a complex kind. */
tree tree
gfc_get_complex_type (int kind) gfc_get_complex_type (int kind)
{ {
int index = gfc_validate_kind (BT_COMPLEX, kind, false);
switch (kind) return gfc_complex_types[index];
{
case 4:
return (gfc_complex4_type_node);
case 8:
return (gfc_complex8_type_node);
#if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64))
case 16:
return (gfc_complex16_type_node);
#endif
default:
fatal_error ("complex kind=%d not available", kind);
}
} }
/* Get a type node for a logical kind. */
tree tree
gfc_get_logical_type (int kind) gfc_get_logical_type (int kind)
{ {
switch (kind) int index = gfc_validate_kind (BT_LOGICAL, kind, false);
{ return gfc_logical_types[index];
case 1:
return (gfc_logical1_type_node);
case 2:
return (gfc_logical2_type_node);
case 4:
return (gfc_logical4_type_node);
case 8:
return (gfc_logical8_type_node);
#if (GFC_USE_TYPES16 && (HOST_BITS_PER_WIDE_INT >= 64))
case 16:
return (gfc_logical16_type_node);
#endif
default:
fatal_error ("logical kind=%d not available", kind);
}
} }
/* Create a character type with the given kind and length. */ /* Create a character type with the given kind and length. */
...@@ -536,22 +579,12 @@ gfc_get_logical_type (int kind) ...@@ -536,22 +579,12 @@ gfc_get_logical_type (int kind)
tree tree
gfc_get_character_type_len (int kind, tree len) gfc_get_character_type_len (int kind, tree len)
{ {
tree base; tree bounds, type;
tree bounds;
tree type;
switch (kind)
{
case 1:
base = gfc_character1_type_node;
break;
default: gfc_validate_kind (BT_CHARACTER, kind, false);
fatal_error ("character kind=%d not available", kind);
}
bounds = build_range_type (gfc_array_index_type, gfc_index_one_node, len); bounds = build_range_type (gfc_array_index_type, gfc_index_one_node, len);
type = build_array_type (base, bounds); type = build_array_type (gfc_character1_type_node, bounds);
TYPE_STRING_FLAG (type) = 1; TYPE_STRING_FLAG (type) = 1;
return type; return type;
...@@ -1534,8 +1567,7 @@ gfc_get_function_type (gfc_symbol * sym) ...@@ -1534,8 +1567,7 @@ gfc_get_function_type (gfc_symbol * sym)
return type; return type;
} }
/* Routines for getting integer type nodes. */ /* Language hooks for middle-end access to type nodes. */
/* Return an integer type with BITS bits of precision, /* Return an integer type with BITS bits of precision,
that is unsigned if UNSIGNEDP is nonzero, otherwise signed. */ that is unsigned if UNSIGNEDP is nonzero, otherwise signed. */
...@@ -1543,111 +1575,79 @@ gfc_get_function_type (gfc_symbol * sym) ...@@ -1543,111 +1575,79 @@ gfc_get_function_type (gfc_symbol * sym)
tree tree
gfc_type_for_size (unsigned bits, int unsignedp) gfc_type_for_size (unsigned bits, int unsignedp)
{ {
if (bits == TYPE_PRECISION (integer_type_node)) if (!unsignedp)
return unsignedp ? unsigned_type_node : integer_type_node; {
int i;
if (bits == TYPE_PRECISION (signed_char_type_node)) for (i = 0; i <= MAX_INT_KINDS; ++i)
return unsignedp ? unsigned_char_type_node : signed_char_type_node; {
tree type = gfc_integer_types[i];
if (bits == TYPE_PRECISION (short_integer_type_node)) if (type && bits == TYPE_PRECISION (type))
return unsignedp ? short_unsigned_type_node : short_integer_type_node; return type;
}
if (bits == TYPE_PRECISION (long_integer_type_node)) }
return unsignedp ? long_unsigned_type_node : long_integer_type_node; else
{
if (bits == TYPE_PRECISION (long_long_integer_type_node)) if (bits == TYPE_PRECISION (unsigned_intQI_type_node))
return (unsignedp ? long_long_unsigned_type_node return unsigned_intQI_type_node;
: long_long_integer_type_node); if (bits == TYPE_PRECISION (unsigned_intHI_type_node))
/*TODO: We currently don't initialise this... return unsigned_intHI_type_node;
if (bits == TYPE_PRECISION (widest_integer_literal_type_node)) if (bits == TYPE_PRECISION (unsigned_intSI_type_node))
return (unsignedp ? widest_unsigned_literal_type_node return unsigned_intSI_type_node;
: widest_integer_literal_type_node);*/ if (bits == TYPE_PRECISION (unsigned_intDI_type_node))
return unsigned_intDI_type_node;
if (bits <= TYPE_PRECISION (intQI_type_node)) if (bits == TYPE_PRECISION (unsigned_intTI_type_node))
return unsignedp ? unsigned_intQI_type_node : intQI_type_node; return unsigned_intTI_type_node;
}
if (bits <= TYPE_PRECISION (intHI_type_node))
return unsignedp ? unsigned_intHI_type_node : intHI_type_node;
if (bits <= TYPE_PRECISION (intSI_type_node))
return unsignedp ? unsigned_intSI_type_node : intSI_type_node;
if (bits <= TYPE_PRECISION (intDI_type_node))
return unsignedp ? unsigned_intDI_type_node : intDI_type_node;
return 0; return NULL_TREE;
} }
/* Return a data type that has machine mode MODE. /* Return a data type that has machine mode MODE. If the mode is an
If the mode is an integer, integer, then UNSIGNEDP selects between signed and unsigned types. */
then UNSIGNEDP selects between signed and unsigned types. */
tree tree
gfc_type_for_mode (enum machine_mode mode, int unsignedp) gfc_type_for_mode (enum machine_mode mode, int unsignedp)
{ {
if (mode == TYPE_MODE (integer_type_node)) int i;
return unsignedp ? unsigned_type_node : integer_type_node; tree *base;
if (mode == TYPE_MODE (signed_char_type_node)) if (GET_MODE_CLASS (mode) == MODE_FLOAT)
return unsignedp ? unsigned_char_type_node : signed_char_type_node; base = gfc_real_types;
else if (GET_MODE_CLASS (mode) == MODE_COMPLEX_FLOAT)
if (mode == TYPE_MODE (short_integer_type_node)) base = gfc_complex_types;
return unsignedp ? short_unsigned_type_node : short_integer_type_node; else if (SCALAR_INT_MODE_P (mode))
return gfc_type_for_size (GET_MODE_PRECISION (mode), unsignedp);
if (mode == TYPE_MODE (long_integer_type_node)) else if (VECTOR_MODE_P (mode))
return unsignedp ? long_unsigned_type_node : long_integer_type_node;
if (mode == TYPE_MODE (long_long_integer_type_node))
return unsignedp ? long_long_unsigned_type_node :
long_long_integer_type_node;
/*TODO: see above
if (mode == TYPE_MODE (widest_integer_literal_type_node))
return unsignedp ? widest_unsigned_literal_type_node
: widest_integer_literal_type_node;
*/
if (mode == QImode)
return unsignedp ? unsigned_intQI_type_node : intQI_type_node;
if (mode == HImode)
return unsignedp ? unsigned_intHI_type_node : intHI_type_node;
if (mode == SImode)
return unsignedp ? unsigned_intSI_type_node : intSI_type_node;
if (mode == DImode)
return unsignedp ? unsigned_intDI_type_node : intDI_type_node;
#if HOST_BITS_PER_WIDE_INT >= 64
if (mode == TYPE_MODE (intTI_type_node))
return unsignedp ? unsigned_intTI_type_node : intTI_type_node;
#endif
if (mode == TYPE_MODE (float_type_node))
return float_type_node;
if (mode == TYPE_MODE (double_type_node))
return double_type_node;
if (mode == TYPE_MODE (long_double_type_node))
return long_double_type_node;
if (mode == TYPE_MODE (build_pointer_type (char_type_node)))
return build_pointer_type (char_type_node);
if (mode == TYPE_MODE (build_pointer_type (integer_type_node)))
return build_pointer_type (integer_type_node);
if (VECTOR_MODE_P (mode))
{ {
enum machine_mode inner_mode = GET_MODE_INNER (mode); enum machine_mode inner_mode = GET_MODE_INNER (mode);
tree inner_type = gfc_type_for_mode (inner_mode, unsignedp); tree inner_type = gfc_type_for_mode (inner_mode, unsignedp);
if (inner_type != NULL_TREE) if (inner_type != NULL_TREE)
return build_vector_type_for_mode (inner_type, mode); return build_vector_type_for_mode (inner_type, mode);
return NULL_TREE;
} }
else
abort ();
return 0; for (i = 0; i <= MAX_REAL_KINDS; ++i)
{
tree type = base[i];
if (type && mode == TYPE_MODE (type))
return type;
}
return NULL_TREE;
}
/* Return a type the same as TYPE except unsigned or
signed according to UNSIGNEDP. */
tree
gfc_signed_or_unsigned_type (int unsignedp, tree type)
{
if (TREE_CODE (type) != INTEGER_TYPE || TYPE_UNSIGNED (type) == unsignedp)
return type;
else
return gfc_type_for_size (TYPE_PRECISION (type), unsignedp);
} }
/* Return an unsigned type the same as TYPE in other respects. */ /* Return an unsigned type the same as TYPE in other respects. */
...@@ -1655,35 +1655,6 @@ gfc_type_for_mode (enum machine_mode mode, int unsignedp) ...@@ -1655,35 +1655,6 @@ gfc_type_for_mode (enum machine_mode mode, int unsignedp)
tree tree
gfc_unsigned_type (tree type) gfc_unsigned_type (tree type)
{ {
tree type1 = TYPE_MAIN_VARIANT (type);
if (type1 == signed_char_type_node || type1 == char_type_node)
return unsigned_char_type_node;
if (type1 == integer_type_node)
return unsigned_type_node;
if (type1 == short_integer_type_node)
return short_unsigned_type_node;
if (type1 == long_integer_type_node)
return long_unsigned_type_node;
if (type1 == long_long_integer_type_node)
return long_long_unsigned_type_node;
/*TODO :see others
if (type1 == widest_integer_literal_type_node)
return widest_unsigned_literal_type_node;
*/
#if HOST_BITS_PER_WIDE_INT >= 64
if (type1 == intTI_type_node)
return unsigned_intTI_type_node;
#endif
if (type1 == intDI_type_node)
return unsigned_intDI_type_node;
if (type1 == intSI_type_node)
return unsigned_intSI_type_node;
if (type1 == intHI_type_node)
return unsigned_intHI_type_node;
if (type1 == intQI_type_node)
return unsigned_intQI_type_node;
return gfc_signed_or_unsigned_type (1, type); return gfc_signed_or_unsigned_type (1, type);
} }
...@@ -1692,77 +1663,7 @@ gfc_unsigned_type (tree type) ...@@ -1692,77 +1663,7 @@ gfc_unsigned_type (tree type)
tree tree
gfc_signed_type (tree type) gfc_signed_type (tree type)
{ {
tree type1 = TYPE_MAIN_VARIANT (type);
if (type1 == unsigned_char_type_node || type1 == char_type_node)
return signed_char_type_node;
if (type1 == unsigned_type_node)
return integer_type_node;
if (type1 == short_unsigned_type_node)
return short_integer_type_node;
if (type1 == long_unsigned_type_node)
return long_integer_type_node;
if (type1 == long_long_unsigned_type_node)
return long_long_integer_type_node;
/*TODO: see others
if (type1 == widest_unsigned_literal_type_node)
return widest_integer_literal_type_node;
*/
#if HOST_BITS_PER_WIDE_INT >= 64
if (type1 == unsigned_intTI_type_node)
return intTI_type_node;
#endif
if (type1 == unsigned_intDI_type_node)
return intDI_type_node;
if (type1 == unsigned_intSI_type_node)
return intSI_type_node;
if (type1 == unsigned_intHI_type_node)
return intHI_type_node;
if (type1 == unsigned_intQI_type_node)
return intQI_type_node;
return gfc_signed_or_unsigned_type (0, type); return gfc_signed_or_unsigned_type (0, type);
} }
/* Return a type the same as TYPE except unsigned or
signed according to UNSIGNEDP. */
tree
gfc_signed_or_unsigned_type (int unsignedp, tree type)
{
if (!INTEGRAL_TYPE_P (type) || TYPE_UNSIGNED (type) == unsignedp)
return type;
if (TYPE_PRECISION (type) == TYPE_PRECISION (signed_char_type_node))
return unsignedp ? unsigned_char_type_node : signed_char_type_node;
if (TYPE_PRECISION (type) == TYPE_PRECISION (integer_type_node))
return unsignedp ? unsigned_type_node : integer_type_node;
if (TYPE_PRECISION (type) == TYPE_PRECISION (short_integer_type_node))
return unsignedp ? short_unsigned_type_node : short_integer_type_node;
if (TYPE_PRECISION (type) == TYPE_PRECISION (long_integer_type_node))
return unsignedp ? long_unsigned_type_node : long_integer_type_node;
if (TYPE_PRECISION (type) == TYPE_PRECISION (long_long_integer_type_node))
return (unsignedp ? long_long_unsigned_type_node
: long_long_integer_type_node);
/*TODO: see others
if (TYPE_PRECISION (type) == TYPE_PRECISION (widest_integer_literal_type_node))
return (unsignedp ? widest_unsigned_literal_type_node
: widest_integer_literal_type_node);
*/
#if HOST_BITS_PER_WIDE_INT >= 64
if (TYPE_PRECISION (type) == TYPE_PRECISION (intTI_type_node))
return unsignedp ? unsigned_intTI_type_node : intTI_type_node;
#endif
if (TYPE_PRECISION (type) == TYPE_PRECISION (intDI_type_node))
return unsignedp ? unsigned_intDI_type_node : intDI_type_node;
if (TYPE_PRECISION (type) == TYPE_PRECISION (intSI_type_node))
return unsignedp ? unsigned_intSI_type_node : intSI_type_node;
if (TYPE_PRECISION (type) == TYPE_PRECISION (intHI_type_node))
return unsignedp ? unsigned_intHI_type_node : intHI_type_node;
if (TYPE_PRECISION (type) == TYPE_PRECISION (intQI_type_node))
return unsignedp ? unsigned_intQI_type_node : intQI_type_node;
return type;
}
#include "gt-fortran-trans-types.h" #include "gt-fortran-trans-types.h"
gcc/fortran/trans-types.h
...@@ -24,28 +24,6 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA ...@@ -24,28 +24,6 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#ifndef GFC_BACKEND_H #ifndef GFC_BACKEND_H
#define GFC_BACKEND_H #define GFC_BACKEND_H
enum
{
F95_INT1_TYPE,
F95_INT2_TYPE,
F95_INT4_TYPE,
F95_INT8_TYPE,
F95_INT16_TYPE,
F95_REAL4_TYPE,
F95_REAL8_TYPE,
F95_REAl16_TYPE,
F95_COMPLEX4_TYPE,
F95_COMPLEX8_TYPE,
F95_COMPLEX16_TYPE,
F95_LOGICAL1_TYPE,
F95_LOGICAL2_TYPE,
F95_LOGICAL4_TYPE,
F95_LOGICAL8_TYPE,
F95_LOGICAL16_TYPE,
F95_CHARACTER1_TYPE,
NUM_F95_TYPES
};
#define GFC_DTYPE_RANK_MASK 0x07 #define GFC_DTYPE_RANK_MASK 0x07
#define GFC_DTYPE_TYPE_SHIFT 3 #define GFC_DTYPE_TYPE_SHIFT 3
#define GFC_DTYPE_TYPE_MASK 0x38 #define GFC_DTYPE_TYPE_MASK 0x38
...@@ -62,37 +40,12 @@ enum ...@@ -62,37 +40,12 @@ enum
GFC_DTYPE_CHARACTER GFC_DTYPE_CHARACTER
}; };
extern GTY(()) tree gfc_type_nodes[NUM_F95_TYPES];
extern GTY(()) tree gfc_array_index_type; extern GTY(()) tree gfc_array_index_type;
extern GTY(()) tree gfc_character1_type_node;
extern GTY(()) tree ppvoid_type_node; extern GTY(()) tree ppvoid_type_node;
extern GTY(()) tree pvoid_type_node; extern GTY(()) tree pvoid_type_node;
extern GTY(()) tree pchar_type_node; extern GTY(()) tree pchar_type_node;
extern GTY(()) tree gfc_strlen_type_node;
#define gfc_int1_type_node gfc_type_nodes[F95_INT1_TYPE]
#define gfc_int2_type_node gfc_type_nodes[F95_INT2_TYPE]
#define gfc_int4_type_node gfc_type_nodes[F95_INT4_TYPE]
#define gfc_int8_type_node gfc_type_nodes[F95_INT8_TYPE]
#define gfc_int16_type_node gfc_type_nodes[F95_INT16_TYPE]
#define gfc_real4_type_node gfc_type_nodes[F95_REAL4_TYPE]
#define gfc_real8_type_node gfc_type_nodes[F95_REAL8_TYPE]
#define gfc_real16_type_node gfc_type_nodes[F95_REAL16_TYPE]
#define gfc_complex4_type_node gfc_type_nodes[F95_COMPLEX4_TYPE]
#define gfc_complex8_type_node gfc_type_nodes[F95_COMPLEX8_TYPE]
#define gfc_complex16_type_node gfc_type_nodes[F95_COMPLEX16_TYPE]
#define gfc_logical1_type_node gfc_type_nodes[F95_LOGICAL1_TYPE]
#define gfc_logical2_type_node gfc_type_nodes[F95_LOGICAL2_TYPE]
#define gfc_logical4_type_node gfc_type_nodes[F95_LOGICAL4_TYPE]
#define gfc_logical8_type_node gfc_type_nodes[F95_LOGICAL8_TYPE]
#define gfc_logical16_type_node gfc_type_nodes[F95_LOGICAL16_TYPE]
#define gfc_character1_type_node gfc_type_nodes[F95_CHARACTER1_TYPE]
#define gfc_strlen_kind 4
#define gfc_strlen_type_node gfc_int4_type_node
/* These C-specific types are used while building builtin function decls. /* These C-specific types are used while building builtin function decls.
For now it doesn't really matter what these are defined to as we don't For now it doesn't really matter what these are defined to as we don't
......
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