From ef5c67f98a32d8d0a7737d530c735c3a60df2219 Mon Sep 17 00:00:00 2001 From: ebotcazou Date: Thu, 3 Feb 2011 13:19:38 +0000 Subject: [PATCH] * gcc-interface/gigi.h (fill_vms_descriptor): Take GNU_TYPE instead of GNAT_FORMAL. * gcc-interface/utils2.c (fill_vms_descriptor): Move from here to... * gcc-interface/utils.c (fill_vms_descriptor): ...here. Take GNU_TYPE instead of GNAT_FORMAL. Protect the expression against multiple uses. Do not generate the check directly, instead instantiate the template check present in the descriptor. (make_descriptor_field): Move around. (build_vms_descriptor32): Build a template check in the POINTER field. (build_vms_descriptor): Remove useless suffixes. * gcc-interface/trans.c (call_to_gnu): Adjust fill_vms_descriptor call. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@169788 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 14 +++ gcc/ada/gcc-interface/gigi.h | 9 +- gcc/ada/gcc-interface/trans.c | 6 +- gcc/ada/gcc-interface/utils.c | 196 +++++++++++++++++++++++------------------ gcc/ada/gcc-interface/utils2.c | 54 +----------- 5 files changed, 134 insertions(+), 145 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 56d0030cf76..c520f728562 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2011-02-03 Eric Botcazou + + * gcc-interface/gigi.h (fill_vms_descriptor): Take GNU_TYPE instead of + GNAT_FORMAL. + * gcc-interface/utils2.c (fill_vms_descriptor): Move from here to... + * gcc-interface/utils.c (fill_vms_descriptor): ...here. Take GNU_TYPE + instead of GNAT_FORMAL. Protect the expression against multiple uses. + Do not generate the check directly, instead instantiate the template + check present in the descriptor. + (make_descriptor_field): Move around. + (build_vms_descriptor32): Build a template check in the POINTER field. + (build_vms_descriptor): Remove useless suffixes. + * gcc-interface/trans.c (call_to_gnu): Adjust fill_vms_descriptor call. + 2011-01-26 Eric Botcazou PR bootstrap/47467 diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index 67a7a472abd..e45cf138337 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -6,7 +6,7 @@ * * * C Header File * * * - * Copyright (C) 1992-2010, Free Software Foundation, Inc. * + * Copyright (C) 1992-2011, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -861,10 +861,9 @@ extern tree build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, Entity_Id gnat_pool, Node_Id gnat_node, bool); -/* Fill in a VMS descriptor for EXPR and return a constructor for it. - GNAT_FORMAL is how we find the descriptor record. GNAT_ACTUAL is how - we derive the source location on a C_E */ -extern tree fill_vms_descriptor (tree expr, Entity_Id gnat_formal, +/* Fill in a VMS descriptor of GNU_TYPE for GNU_EXPR and return the result. + GNAT_ACTUAL is the actual parameter for which the descriptor is built. */ +extern tree fill_vms_descriptor (tree gnu_type, tree gnu_expr, Node_Id gnat_actual); /* Indicate that we need to take the address of T and that it therefore diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 30dbf7a969a..e438960ee3b 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -3071,9 +3071,9 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) = convert (DECL_ARG_TYPE (gnu_formal), integer_zero_node); else gnu_actual = build_unary_op (ADDR_EXPR, NULL_TREE, - fill_vms_descriptor (gnu_actual, - gnat_formal, - gnat_actual)); + fill_vms_descriptor + (TREE_TYPE (TREE_TYPE (gnu_formal)), + gnu_actual, gnat_actual)); } else { diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 19a17f9394a..eac87e0bbc9 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2010, Free Software Foundation, Inc. * + * Copyright (C) 1992-2011, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -203,7 +203,6 @@ static tree split_plus (tree, tree *); static tree float_type_for_precision (int, enum machine_mode); static tree convert_to_fat_pointer (tree, tree); static tree convert_to_thin_pointer (tree, tree); -static tree make_descriptor_field (const char *,tree, tree, tree, tree); static bool potential_alignment_gap (tree, tree, tree); static void process_attributes (tree, struct attrib *); @@ -2280,6 +2279,22 @@ build_template (tree template_type, tree array_type, tree expr) return gnat_build_constructor (template_type, template_elts); } +/* Helper routine to make a descriptor field. FIELD_LIST is the list of decls + being built; the new decl is chained on to the front of the list. */ + +static tree +make_descriptor_field (const char *name, tree type, tree rec_type, + tree initial, tree field_list) +{ + tree field + = create_field_decl (get_identifier (name), type, rec_type, NULL_TREE, + NULL_TREE, 0, 0); + + DECL_INITIAL (field) = initial; + DECL_CHAIN (field) = field_list; + return field; +} + /* Build a 32-bit VMS descriptor from a Mechanism_Type, which must specify a descriptor type, and the GCC type of an object. Each FIELD_DECL in the type contains in its DECL_INITIAL the expression to use when a constructor @@ -2291,15 +2306,11 @@ tree build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity) { tree record_type = make_node (RECORD_TYPE); - tree pointer32_type; + tree pointer32_type, pointer64_type; tree field_list = NULL_TREE; - int klass; - int dtype = 0; - tree inner_type; - int ndim; - int i; + int klass, ndim, i, dtype = 0; + tree inner_type, tem; tree *idx_arr; - tree tem; /* If TYPE is an unconstrained array, use the underlying array type. */ if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) @@ -2439,15 +2450,22 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity) = make_descriptor_field ("CLASS", gnat_type_for_size (8, 1), record_type, size_int (klass), field_list); - /* Of course this will crash at run time if the address space is not - within the low 32 bits, but there is nothing else we can do. */ pointer32_type = build_pointer_type_for_mode (type, SImode, false); + pointer64_type = build_pointer_type_for_mode (type, DImode, false); + + /* Ensure that only 32-bit pointers are passed in 32-bit descriptors. Note + that we cannot build a template call to the CE routine as it would get a + wrong source location; instead we use a second placeholder for it. */ + tem = build_unary_op (ADDR_EXPR, pointer64_type, + build0 (PLACEHOLDER_EXPR, type)); + tem = build3 (COND_EXPR, pointer32_type, + build_binary_op (GE_EXPR, boolean_type_node, tem, + build_int_cstu (pointer64_type, 0x80000000)), + build0 (PLACEHOLDER_EXPR, void_type_node), + convert (pointer32_type, tem)); field_list - = make_descriptor_field ("POINTER", pointer32_type, record_type, - build_unary_op (ADDR_EXPR, - pointer32_type, - build0 (PLACEHOLDER_EXPR, type)), + = make_descriptor_field ("POINTER", pointer32_type, record_type, tem, field_list); switch (mech) @@ -2488,7 +2506,6 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity) = make_descriptor_field ("DIGITS", gnat_type_for_size (8, 1), record_type, size_zero_node, field_list); - field_list = make_descriptor_field ("AFLAGS", gnat_type_for_size (8, 1), record_type, @@ -2587,16 +2604,12 @@ build_vms_descriptor32 (tree type, Mechanism_Type mech, Entity_Id gnat_entity) tree build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) { - tree record64_type = make_node (RECORD_TYPE); + tree record_type = make_node (RECORD_TYPE); tree pointer64_type; - tree field_list64 = NULL_TREE; - int klass; - int dtype = 0; - tree inner_type; - int ndim; - int i; + tree field_list = NULL_TREE; + int klass, ndim, i, dtype = 0; + tree inner_type, tem; tree *idx_arr; - tree tem; /* If TYPE is an unconstrained array, use the underlying array type. */ if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE) @@ -2718,32 +2731,32 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) /* Make the type for a 64-bit descriptor for VMS. The first six fields are the same for all types. */ - field_list64 + field_list = make_descriptor_field ("MBO", gnat_type_for_size (16, 1), - record64_type, size_int (1), field_list64); - field_list64 + record_type, size_int (1), field_list); + field_list = make_descriptor_field ("DTYPE", gnat_type_for_size (8, 1), - record64_type, size_int (dtype), field_list64); - field_list64 + record_type, size_int (dtype), field_list); + field_list = make_descriptor_field ("CLASS", gnat_type_for_size (8, 1), - record64_type, size_int (klass), field_list64); - field_list64 + record_type, size_int (klass), field_list); + field_list = make_descriptor_field ("MBMO", gnat_type_for_size (32, 1), - record64_type, ssize_int (-1), field_list64); - field_list64 + record_type, ssize_int (-1), field_list); + field_list = make_descriptor_field ("LENGTH", gnat_type_for_size (64, 1), - record64_type, + record_type, size_in_bytes (mech == By_Descriptor_A ? inner_type : type), - field_list64); + field_list); pointer64_type = build_pointer_type_for_mode (type, DImode, false); - field_list64 - = make_descriptor_field ("POINTER", pointer64_type, record64_type, + field_list + = make_descriptor_field ("POINTER", pointer64_type, record_type, build_unary_op (ADDR_EXPR, pointer64_type, build0 (PLACEHOLDER_EXPR, type)), - field_list64); + field_list); switch (mech) { @@ -2752,31 +2765,31 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) break; case By_Descriptor_SB: - field_list64 + field_list = make_descriptor_field ("SB_L1", gnat_type_for_size (64, 1), - record64_type, + record_type, (TREE_CODE (type) == ARRAY_TYPE ? TYPE_MIN_VALUE (TYPE_DOMAIN (type)) : size_zero_node), - field_list64); - field_list64 + field_list); + field_list = make_descriptor_field ("SB_U1", gnat_type_for_size (64, 1), - record64_type, + record_type, (TREE_CODE (type) == ARRAY_TYPE ? TYPE_MAX_VALUE (TYPE_DOMAIN (type)) : size_zero_node), - field_list64); + field_list); break; case By_Descriptor_A: case By_Descriptor_NCA: - field_list64 + field_list = make_descriptor_field ("SCALE", gnat_type_for_size (8, 1), - record64_type, size_zero_node, field_list64); + record_type, size_zero_node, field_list); - field_list64 + field_list = make_descriptor_field ("DIGITS", gnat_type_for_size (8, 1), - record64_type, size_zero_node, field_list64); + record_type, size_zero_node, field_list); dtype = (mech == By_Descriptor_NCA ? 0 @@ -2785,22 +2798,22 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) : (TREE_CODE (type) == ARRAY_TYPE && TYPE_CONVENTION_FORTRAN_P (type) ? 224 : 192)); - field_list64 + field_list = make_descriptor_field ("AFLAGS", gnat_type_for_size (8, 1), - record64_type, size_int (dtype), - field_list64); + record_type, size_int (dtype), + field_list); - field_list64 + field_list = make_descriptor_field ("DIMCT", gnat_type_for_size (8, 1), - record64_type, size_int (ndim), field_list64); + record_type, size_int (ndim), field_list); - field_list64 + field_list = make_descriptor_field ("MBZ", gnat_type_for_size (32, 1), - record64_type, size_int (0), field_list64); - field_list64 + record_type, size_int (0), field_list); + field_list = make_descriptor_field ("ARSIZE", gnat_type_for_size (64, 1), - record64_type, size_in_bytes (type), - field_list64); + record_type, size_in_bytes (type), + field_list); /* Now build a pointer to the 0,0,0... element. */ tem = build0 (PLACEHOLDER_EXPR, type); @@ -2810,10 +2823,10 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) convert (TYPE_DOMAIN (inner_type), size_zero_node), NULL_TREE, NULL_TREE); - field_list64 - = make_descriptor_field ("A0", pointer64_type, record64_type, + field_list + = make_descriptor_field ("A0", pointer64_type, record_type, build1 (ADDR_EXPR, pointer64_type, tem), - field_list64); + field_list); /* Next come the addressing coefficients. */ tem = size_one_node; @@ -2830,9 +2843,9 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) fname[0] = (mech == By_Descriptor_NCA ? 'S' : 'M'); fname[1] = '0' + i, fname[2] = 0; - field_list64 + field_list = make_descriptor_field (fname, gnat_type_for_size (64, 1), - record64_type, idx_length, field_list64); + record_type, idx_length, field_list); if (mech == By_Descriptor_NCA) tem = idx_length; @@ -2844,16 +2857,16 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) char fname[3]; fname[0] = 'L', fname[1] = '0' + i, fname[2] = 0; - field_list64 + field_list = make_descriptor_field (fname, gnat_type_for_size (64, 1), - record64_type, - TYPE_MIN_VALUE (idx_arr[i]), field_list64); + record_type, + TYPE_MIN_VALUE (idx_arr[i]), field_list); fname[0] = 'U'; - field_list64 + field_list = make_descriptor_field (fname, gnat_type_for_size (64, 1), - record64_type, - TYPE_MAX_VALUE (idx_arr[i]), field_list64); + record_type, + TYPE_MAX_VALUE (idx_arr[i]), field_list); } break; @@ -2861,26 +2874,41 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity) post_error ("unsupported descriptor type for &", gnat_entity); } - TYPE_NAME (record64_type) = create_concat_name (gnat_entity, "DESC64"); - finish_record_type (record64_type, nreverse (field_list64), 0, false); - return record64_type; + TYPE_NAME (record_type) = create_concat_name (gnat_entity, "DESC64"); + finish_record_type (record_type, nreverse (field_list), 0, false); + return record_type; } -/* Utility routine for above code to make a field. FIELD_LIST is the - list of decls being built; the new decl is chained on to the front of - the list. */ +/* Fill in a VMS descriptor of GNU_TYPE for GNU_EXPR and return the result. + GNAT_ACTUAL is the actual parameter for which the descriptor is built. */ -static tree -make_descriptor_field (const char *name, tree type, - tree rec_type, tree initial, tree field_list) +tree +fill_vms_descriptor (tree gnu_type, tree gnu_expr, Node_Id gnat_actual) { - tree field - = create_field_decl (get_identifier (name), type, rec_type, NULL_TREE, - NULL_TREE, 0, 0); + VEC(constructor_elt,gc) *v = NULL; + tree field; - DECL_INITIAL (field) = initial; - DECL_CHAIN (field) = field_list; - return field; + gnu_expr = maybe_unconstrained_array (gnu_expr); + gnu_expr = gnat_protect_expr (gnu_expr); + gnat_mark_addressable (gnu_expr); + + /* We may need to substitute both GNU_EXPR and a CALL_EXPR to the raise CE + routine in case we have a 32-bit descriptor. */ + gnu_expr = build2 (COMPOUND_EXPR, void_type_node, + build_call_raise (CE_Range_Check_Failed, gnat_actual, + N_Raise_Constraint_Error), + gnu_expr); + + for (field = TYPE_FIELDS (gnu_type); field; field = DECL_CHAIN (field)) + { + tree value + = convert (TREE_TYPE (field), + SUBSTITUTE_PLACEHOLDER_IN_EXPR (DECL_INITIAL (field), + gnu_expr)); + CONSTRUCTOR_APPEND_ELT (v, field, value); + } + + return gnat_build_constructor (gnu_type, v); } /* Convert GNU_EXPR, a pointer to a 64bit VMS descriptor, to GNU_TYPE, a diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index 905b9aa481e..07d6b5bd0bf 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2010, Free Software Foundation, Inc. * + * Copyright (C) 1992-2011, Free Software Foundation, Inc. * * * * GNAT is free software; you can redistribute it and/or modify it under * * terms of the GNU General Public License as published by the Free Soft- * @@ -2216,58 +2216,6 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc, return convert (result_type, result); } -/* Fill in a VMS descriptor for EXPR and return a constructor for it. - GNAT_FORMAL is how we find the descriptor record. GNAT_ACTUAL is - how we derive the source location to raise C_E on an out of range - pointer. */ - -tree -fill_vms_descriptor (tree expr, Entity_Id gnat_formal, Node_Id gnat_actual) -{ - tree parm_decl = get_gnu_tree (gnat_formal); - tree record_type = TREE_TYPE (TREE_TYPE (parm_decl)); - tree field; - const bool do_range_check - = strcmp ("MBO", - IDENTIFIER_POINTER (DECL_NAME (TYPE_FIELDS (record_type)))); - VEC(constructor_elt,gc) *v = NULL; - - expr = maybe_unconstrained_array (expr); - gnat_mark_addressable (expr); - - for (field = TYPE_FIELDS (record_type); field; field = DECL_CHAIN (field)) - { - tree conexpr = convert (TREE_TYPE (field), - SUBSTITUTE_PLACEHOLDER_IN_EXPR - (DECL_INITIAL (field), expr)); - - /* Check to ensure that only 32-bit pointers are passed in - 32-bit descriptors */ - if (do_range_check - && strcmp (IDENTIFIER_POINTER (DECL_NAME (field)), "POINTER") == 0) - { - tree pointer64type - = build_pointer_type_for_mode (void_type_node, DImode, false); - tree addr64expr = build_unary_op (ADDR_EXPR, pointer64type, expr); - tree malloc64low - = build_int_cstu (long_integer_type_node, 0x80000000); - - add_stmt (build3 (COND_EXPR, void_type_node, - build_binary_op (GE_EXPR, boolean_type_node, - convert (long_integer_type_node, - addr64expr), - malloc64low), - build_call_raise (CE_Range_Check_Failed, - gnat_actual, - N_Raise_Constraint_Error), - NULL_TREE)); - } - CONSTRUCTOR_APPEND_ELT (v, field, conexpr); - } - - return gnat_build_constructor (record_type, v); -} - /* Indicate that we need to take the address of T and that it therefore should not be allocated in a register. Returns true if successful. */ -- 2.11.4.GIT