This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Better support for access constant
- To: gcc-patches at gcc dot gnu dot org
- Subject: [Ada] Better support for access constant
- From: bosch at gnat dot com
- Date: Fri, 26 Oct 2001 11:59:22 -0400 (EDT)
2001-10-26 Richard Kenner <kenner@gnat.com>
* decl.c (gnat_to_gnu_entity, case E_General_Access_Type):
Make constant variant of designated type for Is_Access_Constant.
Call update_pointer_to with main variant.
* trans.c (process_freeze_entity, process_type):
Call update_pointer_to on main variant.
* utils.c (update_pointer_to): Make corresponding variant for NEW_TYPE.
If main variant, update all other variants.
* utils2.c (build_unary_op, case INDIRECT_REF): No longer set
TREE_STATIC.
*** decl.c 2001/10/16 11:35:39 1.7
--- decl.c 2001/10/20 18:05:29 1.8
***************
*** 2730,2735 ****
--- 2730,2736 ----
: In_Extended_Main_Code_Unit (gnat_desig_type));
int got_fat_p = 0;
int made_dummy = 0;
+ tree gnu_desig_type = 0;
if (No (gnat_desig_full)
&& (Ekind (gnat_desig_type) == E_Class_Wide_Type
***************
*** 2838,2845 ****
/* If we already know what the full type is, use it. */
else if (Present (gnat_desig_full)
&& present_gnu_tree (gnat_desig_full))
! gnu_type
! = build_pointer_type (TREE_TYPE (get_gnu_tree (gnat_desig_full)));
/* Get the type of the thing we are to point to and build a pointer
to it. If it is a reference to an incomplete or private type with a
--- 2839,2845 ----
/* If we already know what the full type is, use it. */
else if (Present (gnat_desig_full)
&& present_gnu_tree (gnat_desig_full))
! gnu_desig_type = TREE_TYPE (get_gnu_tree (gnat_desig_full));
/* Get the type of the thing we are to point to and build a pointer
to it. If it is a reference to an incomplete or private type with a
***************
*** 2851,2857 ****
&& ! present_gnu_tree (gnat_desig_full)
&& Is_Record_Type (gnat_desig_full))
{
! gnu_type = build_pointer_type (make_dummy_type (gnat_desig_type));
made_dummy = 1;
}
--- 2851,2857 ----
&& ! present_gnu_tree (gnat_desig_full)
&& Is_Record_Type (gnat_desig_full))
{
! gnu_desig_type = make_dummy_type (gnat_desig_type);
made_dummy = 1;
}
***************
*** 2867,2873 ****
&& (Is_Record_Type (gnat_desig_full)
|| Is_Array_Type (gnat_desig_full)))))
{
! gnu_type = build_pointer_type (make_dummy_type (gnat_desig_type));
made_dummy = 1;
}
else if (gnat_desig_type == gnat_entity)
--- 2867,2873 ----
&& (Is_Record_Type (gnat_desig_full)
|| Is_Array_Type (gnat_desig_full)))))
{
! gnu_desig_type = make_dummy_type (gnat_desig_type);
made_dummy = 1;
}
else if (gnat_desig_type == gnat_entity)
***************
*** 2876,2882 ****
TREE_TYPE (gnu_type) = TYPE_POINTER_TO (gnu_type) = gnu_type;
}
else
! gnu_type = build_pointer_type (gnat_to_gnu_type (gnat_desig_type));
/* It is possible that the above call to gnat_to_gnu_type resolved our
type. If so, just return it. */
--- 2876,2882 ----
TREE_TYPE (gnu_type) = TYPE_POINTER_TO (gnu_type) = gnu_type;
}
else
! gnu_desig_type = gnat_to_gnu_type (gnat_desig_type);
/* It is possible that the above call to gnat_to_gnu_type resolved our
type. If so, just return it. */
***************
*** 2886,2891 ****
--- 2886,2906 ----
break;
}
+ /* If we have a GCC type for the designated type, possibly
+ modify it if we are pointing only to constant objects and then
+ make a pointer to it. Don't do this for unconstrained arrays. */
+ if (gnu_type == 0 && gnu_desig_type != 0)
+ {
+ if (Is_Access_Constant (gnat_entity)
+ && TREE_CODE (gnu_desig_type) != UNCONSTRAINED_ARRAY_TYPE)
+ gnu_desig_type
+ = build_qualified_type (gnu_desig_type,
+ (TYPE_QUALS (gnu_desig_type)
+ | TYPE_QUAL_CONST));
+
+ gnu_type = build_pointer_type (gnu_desig_type);
+ }
+
/* If we are not defining this object and we made a dummy pointer,
save our current definition, evaluate the actual type, and replace
the tentative type we made with the actual one. If we are to defer
***************
*** 2912,2919 ****
this_made_decl = saved = 1;
if (defer_incomplete_level == 0)
! update_pointer_to
! (gnu_old_type, gnat_to_gnu_type (gnat_desig_type));
else
{
struct incomplete *p
--- 2927,2934 ----
this_made_decl = saved = 1;
if (defer_incomplete_level == 0)
! update_pointer_to (TYPE_MAIN_VARIANT (gnu_old_type),
! gnat_to_gnu_type (gnat_desig_type));
else
{
struct incomplete *p
***************
*** 3808,3814 ****
next = incp->next;
if (incp->old_type != 0)
! update_pointer_to (incp->old_type,
gnat_to_gnu_type (incp->full_type));
free (incp);
}
--- 3823,3829 ----
next = incp->next;
if (incp->old_type != 0)
! update_pointer_to (TYPE_MAIN_VARIANT (incp->old_type),
gnat_to_gnu_type (incp->full_type));
free (incp);
}
***************
*** 3823,3829 ****
for (incp = defer_incomplete_list; incp; incp = incp->next)
if (incp->old_type != 0 && incp->full_type == gnat_entity)
{
! update_pointer_to (incp->old_type, TREE_TYPE (gnu_decl));
incp->old_type = 0;
}
}
--- 3838,3845 ----
for (incp = defer_incomplete_list; incp; incp = incp->next)
if (incp->old_type != 0 && incp->full_type == gnat_entity)
{
! update_pointer_to (TYPE_MAIN_VARIANT (incp->old_type),
! TREE_TYPE (gnu_decl));
incp->old_type = 0;
}
}
*** trans.c 2001/10/16 01:03:01 1.3
--- trans.c 2001/10/20 18:05:32 1.4
***************
*** 4048,4054 ****
if (gnu_old != 0)
{
DECL_NAME (gnu_new) = DECL_NAME (gnu_old);
! update_pointer_to (TREE_TYPE (gnu_old), TREE_TYPE (gnu_new));
}
}
--- 4048,4055 ----
if (gnu_old != 0)
{
DECL_NAME (gnu_new) = DECL_NAME (gnu_old);
! update_pointer_to (TYPE_MAIN_VARIANT (TREE_TYPE (gnu_old)),
! TREE_TYPE (gnu_new));
}
}
***************
*** 4725,4731 ****
/* If we have an old type and we've made pointers to this type,
update those pointers. */
if (gnu_old != 0)
! update_pointer_to (TREE_TYPE (gnu_old), TREE_TYPE (gnu_new));
/* If this is a record type corresponding to a task or protected type
that is a completion of an incomplete type, perform a similar update
--- 4726,4733 ----
/* If we have an old type and we've made pointers to this type,
update those pointers. */
if (gnu_old != 0)
! update_pointer_to (TYPE_MAIN_VARIANT (TREE_TYPE (gnu_old)),
! TREE_TYPE (gnu_new));
/* If this is a record type corresponding to a task or protected type
that is a completion of an incomplete type, perform a similar update
***************
*** 4744,4750 ****
save_gnu_tree (Corresponding_Concurrent_Type (gnat_entity),
gnu_new, 0);
! update_pointer_to (TREE_TYPE (gnu_task_old), TREE_TYPE (gnu_new));
}
}
--- 4746,4753 ----
save_gnu_tree (Corresponding_Concurrent_Type (gnat_entity),
gnu_new, 0);
! update_pointer_to (TYPE_MAIN_VARIANT (TREE_TYPE (gnu_task_old)),
! TREE_TYPE (gnu_new));
}
}
*** utils.c 2001/09/29 22:41:53 1.4
--- utils.c 2001/10/20 18:05:34 1.5
***************
*** 2581,2588 ****
{
tree ptr = TYPE_POINTER_TO (old_type);
tree ref = TYPE_REFERENCE_TO (old_type);
! if ((ptr == 0 && ref == 0) || old_type == new_type)
return;
/* First handle the simple case. */
--- 2581,2602 ----
{
tree ptr = TYPE_POINTER_TO (old_type);
tree ref = TYPE_REFERENCE_TO (old_type);
+ tree type;
! /* If this is the main variant, process all the other variants first. */
! if (TYPE_MAIN_VARIANT (old_type) == old_type)
! for (type = TYPE_NEXT_VARIANT (old_type); type != 0;
! type = TYPE_NEXT_VARIANT (type))
! update_pointer_to (type, new_type);
!
! /* If no pointer or reference, we are done. Otherwise, get the new type with
! the same qualifiers as the old type and see if it is the same as the old
! type. */
! if (ptr == 0 && ref == 0)
! return;
!
! new_type = build_qualified_type (new_type, TYPE_QUALS (old_type));
! if (old_type == new_type)
return;
/* First handle the simple case. */
*** utils2.c 2001/09/08 13:44:39 1.1
--- utils2.c 2001/10/20 18:05:36 1.2
***************
*** 1279,1286 ****
else
{
result = fold (build1 (op_code, TREE_TYPE (type), operand));
! TREE_READONLY (result) = TREE_STATIC (result)
! = TREE_READONLY (TREE_TYPE (type));
}
side_effects = flag_volatile
--- 1279,1285 ----
else
{
result = fold (build1 (op_code, TREE_TYPE (type), operand));
! TREE_READONLY (result) = TREE_READONLY (TREE_TYPE (type));
}
side_effects = flag_volatile