Commit c5ecd6b7 by Arnaud Charlet

[multiple changes]

2011-08-29  Thomas Quinot  <quinot@adacore.com>

	* rtsfind.ads, exp_ch3.adb (In_Runtime): Minor code improvement, use
	Is_RTU instead of using Chars comparisons.

2011-08-29  Thomas Quinot  <quinot@adacore.com>

	* exp_strm.adb (Build_Mutable_Record_Read_Procedure): Do not create a
	temporary object if the actual is constrained, and the discriminants
	read from the stream don't match.

2011-08-29  Tristan Gingold  <gingold@adacore.com>

	* sem_attr.adb, exp_attr.adb: Add handling of
	Attribute_System_Allocator_Alignment
	* snames.ads-tmpl: Add Name_System_Allocator_Alignment and
	Attribute_System_Allocator_Alignment.
	* ttypes.ads, get_targ.ads: Add Get_System_Allocator_Alignment.
	* gcc-interface/targtyps.c, gcc-interface/utils2.c,
	gcc-interface/gigi.h: Renames get_target_default_allocator_alignment to
	get_target_system_allocator_alignment.

2011-08-29  Arnaud Charlet  <charlet@adacore.com>

	* gcc-interface/Makefile.in, gcc-interface/Make-lang.in: Update
	dependencies.

From-SVN: r178176
parent e7898e54
2011-08-29 Thomas Quinot <quinot@adacore.com>
* rtsfind.ads, exp_ch3.adb (In_Runtime): Minor code improvement, use
Is_RTU instead of using Chars comparisons.
2011-08-29 Thomas Quinot <quinot@adacore.com>
* exp_strm.adb (Build_Mutable_Record_Read_Procedure): Do not create a
temporary object if the actual is constrained, and the discriminants
read from the stream don't match.
2011-08-29 Tristan Gingold <gingold@adacore.com>
* sem_attr.adb, exp_attr.adb: Add handling of
Attribute_System_Allocator_Alignment
* snames.ads-tmpl: Add Name_System_Allocator_Alignment and
Attribute_System_Allocator_Alignment.
* ttypes.ads, get_targ.ads: Add Get_System_Allocator_Alignment.
* gcc-interface/targtyps.c, gcc-interface/utils2.c,
gcc-interface/gigi.h: Renames get_target_default_allocator_alignment to
get_target_system_allocator_alignment.
2011-08-29 Arnaud Charlet <charlet@adacore.com>
* gcc-interface/Makefile.in, gcc-interface/Make-lang.in: Update
dependencies.
2011-08-29 Arnaud Charlet <charlet@adacore.com> 2011-08-29 Arnaud Charlet <charlet@adacore.com>
* exp_ch3.adb (In_Runtime): Fix typo. * exp_ch3.adb (In_Runtime): Fix typo.
......
...@@ -5379,6 +5379,7 @@ package body Exp_Attr is ...@@ -5379,6 +5379,7 @@ package body Exp_Attr is
Attribute_Small | Attribute_Small |
Attribute_Storage_Unit | Attribute_Storage_Unit |
Attribute_Stub_Type | Attribute_Stub_Type |
Attribute_System_Allocator_Alignment |
Attribute_Target_Name | Attribute_Target_Name |
Attribute_Type_Class | Attribute_Type_Class |
Attribute_Type_Key | Attribute_Type_Key |
......
...@@ -7079,7 +7079,7 @@ package body Exp_Ch3 is ...@@ -7079,7 +7079,7 @@ package body Exp_Ch3 is
S1 := Scope (S1); S1 := Scope (S1);
end loop; end loop;
return Chars (S1) = Name_System or else Chars (S1) = Name_Ada; return Is_RTU (S1, System) or else Is_RTU (S1, Ada);
end In_Runtime; end In_Runtime;
---------------------------- ----------------------------
......
...@@ -867,7 +867,7 @@ package body Exp_Strm is ...@@ -867,7 +867,7 @@ package body Exp_Strm is
Dcls : constant List_Id := New_List; Dcls : constant List_Id := New_List;
-- Declarations for the 'Read body -- Declarations for the 'Read body
Stms : List_Id := New_List; Stms : constant List_Id := New_List;
-- Statements for the 'Read body -- Statements for the 'Read body
Disc : Entity_Id; Disc : Entity_Id;
...@@ -895,9 +895,6 @@ package body Exp_Strm is ...@@ -895,9 +895,6 @@ package body Exp_Strm is
-- Statements within the block where we have the constrained temporary -- Statements within the block where we have the constrained temporary
begin begin
Disc := First_Discriminant (Typ);
-- A mutable type cannot be a tagged type, so we generate a new name -- A mutable type cannot be a tagged type, so we generate a new name
-- for the stream procedure. -- for the stream procedure.
...@@ -905,6 +902,23 @@ package body Exp_Strm is ...@@ -905,6 +902,23 @@ package body Exp_Strm is
Make_Defining_Identifier (Loc, Make_Defining_Identifier (Loc,
Chars => Make_TSS_Name_Local (Typ, TSS_Stream_Read)); Chars => Make_TSS_Name_Local (Typ, TSS_Stream_Read));
if Is_Unchecked_Union (Typ) then
-- If this is an unchecked union, the stream procedure is erroneous,
-- because there are no discriminants to read.
-- This should generate a warning ???
Append_To (Stms,
Make_Raise_Program_Error (Loc,
Reason => PE_Unchecked_Union_Restriction));
Build_Stream_Procedure (Loc, Typ, Decl, Pnam, Stms, Outp => True);
return;
end if;
Disc := First_Discriminant (Typ);
Out_Formal := Out_Formal :=
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
Prefix => New_Occurrence_Of (Pnam, Loc), Prefix => New_Occurrence_Of (Pnam, Loc),
...@@ -957,6 +971,14 @@ package body Exp_Strm is ...@@ -957,6 +971,14 @@ package body Exp_Strm is
Build_Record_Read_Write_Procedure (Loc, Typ, Decl, Pnam, Name_Read); Build_Record_Read_Write_Procedure (Loc, Typ, Decl, Pnam, Name_Read);
-- Save original statement sequence for component assignments, and
-- replace it with Stms.
Constrained_Stms := Statements (Handled_Statement_Sequence (Decl));
Set_Handled_Statement_Sequence (Decl,
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Stms));
-- If Typ has controlled components (i.e. if it is classwide -- If Typ has controlled components (i.e. if it is classwide
-- or Has_Controlled), or components constrained using the discriminants -- or Has_Controlled), or components constrained using the discriminants
-- of Typ, then we need to ensure that all component assignments -- of Typ, then we need to ensure that all component assignments
...@@ -974,13 +996,10 @@ package body Exp_Strm is ...@@ -974,13 +996,10 @@ package body Exp_Strm is
Make_Index_Or_Discriminant_Constraint (Loc, Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => Cstr)))); Constraints => Cstr))));
Constrained_Stms := Statements (Handled_Statement_Sequence (Decl)); -- AI05-023-1: Insert discriminant check prior to initialization of the
Append_To (Stms, -- constrained temporary.
Make_Block_Statement (Loc,
Declarations => Dcls,
Handled_Statement_Sequence => Parent (Constrained_Stms)));
Append_To (Constrained_Stms, Append_To (Stms,
Make_Implicit_If_Statement (Pnam, Make_Implicit_If_Statement (Pnam,
Condition => Condition =>
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
...@@ -988,28 +1007,20 @@ package body Exp_Strm is ...@@ -988,28 +1007,20 @@ package body Exp_Strm is
Attribute_Name => Name_Constrained), Attribute_Name => Name_Constrained),
Then_Statements => Discriminant_Checks)); Then_Statements => Discriminant_Checks));
-- Now insert back original component assignments, wrapped in a block
-- in which V is the constrained temporary.
Append_To (Stms,
Make_Block_Statement (Loc,
Declarations => Dcls,
Handled_Statement_Sequence => Parent (Constrained_Stms)));
Append_To (Constrained_Stms, Append_To (Constrained_Stms,
Make_Assignment_Statement (Loc, Make_Assignment_Statement (Loc,
Name => Out_Formal, Name => Out_Formal,
Expression => Make_Identifier (Loc, Name_V))); Expression => Make_Identifier (Loc, Name_V)));
if Is_Unchecked_Union (Typ) then
-- If this is an unchecked union, the stream procedure is erroneous,
-- because there are no discriminants to read.
-- This should generate a warning ???
Stms :=
New_List (
Make_Raise_Program_Error (Loc,
Reason => PE_Unchecked_Union_Restriction));
end if;
Set_Declarations (Decl, Tmps_For_Discs); Set_Declarations (Decl, Tmps_For_Discs);
Set_Handled_Statement_Sequence (Decl,
Make_Handled_Sequence_Of_Statements (Loc,
Statements => Stms));
end Build_Mutable_Record_Read_Procedure; end Build_Mutable_Record_Read_Procedure;
------------------------------------------ ------------------------------------------
......
...@@ -241,8 +241,7 @@ GNAT_ADA_OBJS = \ ...@@ -241,8 +241,7 @@ GNAT_ADA_OBJS = \
ada/g-spchge.o \ ada/g-spchge.o \
ada/g-speche.o \ ada/g-speche.o \
ada/g-u3spch.o \ ada/g-u3spch.o \
ada/get_alfa.o \ ada/get_alfa.o \
ada/get_scos.o \
ada/get_targ.o \ ada/get_targ.o \
ada/gnat.o \ ada/gnat.o \
ada/gnatvsn.o \ ada/gnatvsn.o \
...@@ -2801,12 +2800,6 @@ ada/get_alfa.o : ada/ada.ads ada/a-ioexce.ads ada/a-unccon.ads \ ...@@ -2801,12 +2800,6 @@ ada/get_alfa.o : ada/ada.ads ada/a-ioexce.ads ada/a-unccon.ads \
ada/s-string.ads ada/s-unstyp.ads ada/types.ads ada/unchconv.ads \ ada/s-string.ads ada/s-unstyp.ads ada/types.ads ada/unchconv.ads \
ada/unchdeal.ads ada/unchdeal.ads
ada/get_scos.o : ada/ada.ads ada/a-ioexce.ads ada/a-unccon.ads \
ada/get_scos.ads ada/get_scos.adb ada/gnat.ads ada/g-table.ads \
ada/g-table.adb ada/scos.ads ada/scos.adb ada/system.ads \
ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads ada/s-unstyp.ads \
ada/types.ads ada/unchconv.ads ada/unchdeal.ads
ada/get_targ.o : ada/ada.ads ada/a-unccon.ads ada/get_targ.ads \ ada/get_targ.o : ada/ada.ads ada/a-unccon.ads ada/get_targ.ads \
ada/get_targ.adb ada/system.ads ada/s-exctab.ads ada/s-stalib.ads \ ada/get_targ.adb ada/system.ads ada/s-exctab.ads ada/s-stalib.ads \
ada/s-unstyp.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads ada/s-unstyp.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads
...@@ -3362,7 +3355,7 @@ ada/put_scos.o : ada/ada.ads ada/a-unccon.ads ada/gnat.ads ada/g-table.ads \ ...@@ -3362,7 +3355,7 @@ ada/put_scos.o : ada/ada.ads ada/a-unccon.ads ada/gnat.ads ada/g-table.ads \
ada/g-table.adb ada/par_sco.ads ada/put_scos.ads ada/put_scos.adb \ ada/g-table.adb ada/par_sco.ads ada/put_scos.ads ada/put_scos.adb \
ada/scos.ads ada/scos.adb ada/system.ads ada/s-exctab.ads \ ada/scos.ads ada/scos.adb ada/system.ads ada/s-exctab.ads \
ada/s-memory.ads ada/s-stalib.ads ada/s-unstyp.ads ada/types.ads \ ada/s-memory.ads ada/s-stalib.ads ada/s-unstyp.ads ada/types.ads \
ada/unchconv.ads ada/unchdeal.ads ada/unchconv.ads ada/unchdeal.ads ada/snames.ads
ada/repinfo.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ada/repinfo.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \ ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
...@@ -3651,7 +3644,7 @@ ada/scng.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \ ...@@ -3651,7 +3644,7 @@ ada/scng.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/scos.o : ada/ada.ads ada/a-unccon.ads ada/gnat.ads ada/g-table.ads \ ada/scos.o : ada/ada.ads ada/a-unccon.ads ada/gnat.ads ada/g-table.ads \
ada/g-table.adb ada/scos.ads ada/scos.adb ada/system.ads \ ada/g-table.adb ada/scos.ads ada/scos.adb ada/system.ads \
ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads ada/s-unstyp.ads \ ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads ada/s-unstyp.ads \
ada/types.ads ada/unchconv.ads ada/unchdeal.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads ada/snames.ads
ada/sem.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \ ada/sem.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads ada/a-uncdea.ads \
ada/alloc.ads ada/aspects.ads ada/atree.ads ada/atree.adb \ ada/alloc.ads ada/aspects.ads ada/atree.ads ada/atree.adb \
......
...@@ -274,8 +274,16 @@ INCLUDES = -I- -I. -I.. -I$(srcdir)/ada -I$(srcdir) -I$(srcdir)/config \ ...@@ -274,8 +274,16 @@ INCLUDES = -I- -I. -I.. -I$(srcdir)/ada -I$(srcdir) -I$(srcdir)/config \
ADA_INCLUDES = -I- -I. -I$(srcdir)/ada ADA_INCLUDES = -I- -I. -I$(srcdir)/ada
INCLUDES_FOR_SUBDIR = -I. -I.. -I../.. -I$(fsrcdir)/ada \ INCLUDES_FOR_SUBDIR = -iquote . -iquote .. -iquote ../.. -iquote $(fsrcdir)/ada \
-I$(fsrcdir)/../include -I$(fsrcdir) -I$(fsrcdir)/../include
ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
# On Windows native the tconfig.h files used by C runtime files needs to have
# the gcc source dir in its include dir list
INCLUDES_FOR_SUBDIR = -iquote . -iquote .. -iquote ../.. -iquote $(fsrcdir)/ada \
-I$(fsrcdir)/../include -I$(fsrcdir)
endif
ADA_INCLUDES_FOR_SUBDIR = -I. -I$(fsrcdir)/ada ADA_INCLUDES_FOR_SUBDIR = -I. -I$(fsrcdir)/ada
# Avoid a lot of time thinking about remaking Makefile.in and *.def. # Avoid a lot of time thinking about remaking Makefile.in and *.def.
...@@ -466,7 +474,7 @@ ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),) ...@@ -466,7 +474,7 @@ ifeq ($(strip $(filter-out m68k% wrs vx%,$(targ))),)
endif endif
endif endif
ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),) ifeq ($(strip $(filter-out e500% powerpc% wrs vxworks,$(targ))),)
LIBGNAT_TARGET_PAIRS = \ LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-vxworks.ads \ a-intnam.ads<a-intnam-vxworks.ads \
a-numaux.ads<a-numaux-vxworks.ads \ a-numaux.ads<a-numaux-vxworks.ads \
...@@ -521,7 +529,8 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),) ...@@ -521,7 +529,8 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
system.ads<system-vxworks-ppc-rtp.ads system.ads<system-vxworks-ppc-rtp.ads
EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
EXTRA_GNATRTL_TASKING_OBJS=affinity.o EXTRA_LIBGNAT_OBJS+=affinity.o
EXTRA_LIBGNAT_SRCS+=affinity.c
else else
ifeq ($(strip $(filter-out kernel-smp,$(THREAD_KIND))),) ifeq ($(strip $(filter-out kernel-smp,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \ LIBGNAT_TARGET_PAIRS += \
...@@ -532,7 +541,8 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),) ...@@ -532,7 +541,8 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
system.ads<system-vxworks-ppc-kernel.ads system.ads<system-vxworks-ppc-kernel.ads
EH_MECHANISM=-gcc EH_MECHANISM=-gcc
EXTRA_GNATRTL_TASKING_OBJS=affinity.o EXTRA_LIBGNAT_OBJS+=affinity.o
EXTRA_LIBGNAT_SRCS+=affinity.c
else else
LIBGNAT_TARGET_PAIRS += \ LIBGNAT_TARGET_PAIRS += \
s-interr.adb<s-interr-hwint.adb \ s-interr.adb<s-interr-hwint.adb \
...@@ -622,7 +632,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),) ...@@ -622,7 +632,7 @@ ifeq ($(strip $(filter-out powerpc% wrs vxworksae,$(targ))),)
endif endif
# vxworks MILS # vxworks MILS
ifeq ($(strip $(filter-out powerpc% wrs vxworksmils,$(targ))),) ifeq ($(strip $(filter-out e500% powerpc% wrs vxworksmils,$(targ))),)
# target pairs for vthreads runtime # target pairs for vthreads runtime
LIBGNAT_TARGET_PAIRS = \ LIBGNAT_TARGET_PAIRS = \
a-elchha.adb<a-elchha-vx6-raven-cert.adb \ a-elchha.adb<a-elchha-vx6-raven-cert.adb \
...@@ -837,7 +847,8 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),) ...@@ -837,7 +847,8 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
system.ads<system-vxworks-x86-rtp.ads system.ads<system-vxworks-x86-rtp.ads
EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
EXTRA_GNATRTL_TASKING_OBJS=affinity.o EXTRA_LIBGNAT_SRCS+=affinity.o
EXTRA_LIBGNAT_SRCS+=affinity.c
else else
ifeq ($(strip $(filter-out kernel-smp, $(THREAD_KIND))),) ifeq ($(strip $(filter-out kernel-smp, $(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \ LIBGNAT_TARGET_PAIRS += \
...@@ -846,7 +857,8 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),) ...@@ -846,7 +857,8 @@ ifeq ($(strip $(filter-out %86 wrs vxworks,$(targ))),)
s-vxwext.ads<s-vxwext-kernel.ads \ s-vxwext.ads<s-vxwext-kernel.ads \
s-vxwext.adb<s-vxwext-kernel-smp.adb \ s-vxwext.adb<s-vxwext-kernel-smp.adb \
system.ads<system-vxworks-x86-kernel.ads system.ads<system-vxworks-x86-kernel.ads
EXTRA_GNATRTL_TASKING_OBJS=affinity.o EXTRA_LIBGNAT_OBJS+=affinity.o
EXTRA_LIBGNAT_SRCS+=affinity.c
else else
LIBGNAT_TARGET_PAIRS += \ LIBGNAT_TARGET_PAIRS += \
s-interr.adb<s-interr-hwint.adb \ s-interr.adb<s-interr-hwint.adb \
...@@ -1530,7 +1542,6 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ))) ...@@ -1530,7 +1542,6 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ)))
s-parame.ads<s-parame-vms-alpha.ads \ s-parame.ads<s-parame-vms-alpha.ads \
$(ATOMICS_TARGET_PAIRS) $(ATOMICS_TARGET_PAIRS)
EXTRA_GNATRTL_NONTASKING_OBJS = s-atocou.o
TOOLS_TARGET_PAIRS= \ TOOLS_TARGET_PAIRS= \
mlib-tgt-specific.adb<mlib-tgt-specific-vms-alpha.adb \ mlib-tgt-specific.adb<mlib-tgt-specific-vms-alpha.adb \
symbols.adb<symbols-vms.adb \ symbols.adb<symbols-vms.adb \
...@@ -1548,7 +1559,7 @@ adamsg.o: adamsg.msg ...@@ -1548,7 +1559,7 @@ adamsg.o: adamsg.msg
GNATLIB_SHARED=gnatlib-shared-vms GNATLIB_SHARED=gnatlib-shared-vms
EXTRA_LIBGNAT_SRCS+=adamsg.msg EXTRA_LIBGNAT_SRCS+=adamsg.msg
EXTRA_LIBGNAT_OBJS+=adamsg.o EXTRA_LIBGNAT_OBJS+=adamsg.o
EXTRA_GNATRTL_NONTASKING_OBJS+-s-po32gl.o EXTRA_GNATRTL_NONTASKING_OBJS+=s-po32gl.o
EXTRA_GNATRTL_TASKING_OBJS=s-tpopde.o EXTRA_GNATRTL_TASKING_OBJS=s-tpopde.o
EXTRA_GNATTOOLS = \ EXTRA_GNATTOOLS = \
../../gnatsym$(exeext) ../../gnatsym$(exeext)
...@@ -1617,7 +1628,6 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),) ...@@ -1617,7 +1628,6 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
s-osprim.adb<s-osprim-mingw.adb \ s-osprim.adb<s-osprim-mingw.adb \
s-taprop.adb<s-taprop-mingw.adb s-taprop.adb<s-taprop-mingw.adb
EH_MECHANISM=-gcc
ifeq ($(strip $(filter-out x86_64%,$(arch))),) ifeq ($(strip $(filter-out x86_64%,$(arch))),)
ifeq ($(strip $(MULTISUBDIR)),/32) ifeq ($(strip $(MULTISUBDIR)),/32)
LIBGNAT_TARGET_PAIRS += \ LIBGNAT_TARGET_PAIRS += \
...@@ -1649,6 +1659,8 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),) ...@@ -1649,6 +1659,8 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
# ??? This will be replaced by gnatlib-shared-dual-win32 when GNAT # ??? This will be replaced by gnatlib-shared-dual-win32 when GNAT
# auto-import support for array/record will be done. # auto-import support for array/record will be done.
GNATLIB_SHARED = gnatlib-shared-win32 GNATLIB_SHARED = gnatlib-shared-win32
EH_MECHANISM=-gcc
endif endif
TOOLS_TARGET_PAIRS= \ TOOLS_TARGET_PAIRS= \
...@@ -2163,7 +2175,8 @@ ifeq ($(strip $(filter-out darwin%,$(osys))),) ...@@ -2163,7 +2175,8 @@ ifeq ($(strip $(filter-out darwin%,$(osys))),)
endif endif
TOOLS_TARGET_PAIRS = \ TOOLS_TARGET_PAIRS = \
mlib-tgt-specific.adb<mlib-tgt-specific-darwin.adb mlib-tgt-specific.adb<mlib-tgt-specific-darwin.adb \
indepsw.adb<indepsw-darwin.adb
EH_MECHANISM=-gcc EH_MECHANISM=-gcc
GNATLIB_SHARED = gnatlib-shared-darwin GNATLIB_SHARED = gnatlib-shared-darwin
......
...@@ -954,7 +954,7 @@ extern Pos get_target_double_size (void); ...@@ -954,7 +954,7 @@ extern Pos get_target_double_size (void);
extern Pos get_target_long_double_size (void); extern Pos get_target_long_double_size (void);
extern Pos get_target_pointer_size (void); extern Pos get_target_pointer_size (void);
extern Pos get_target_maximum_default_alignment (void); extern Pos get_target_maximum_default_alignment (void);
extern Pos get_target_default_allocator_alignment (void); extern Pos get_target_system_allocator_alignment (void);
extern Pos get_target_maximum_allowed_alignment (void); extern Pos get_target_maximum_allowed_alignment (void);
extern Pos get_target_maximum_alignment (void); extern Pos get_target_maximum_alignment (void);
extern Nat get_float_words_be (void); extern Nat get_float_words_be (void);
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
* * * *
* Body * * Body *
* * * *
* 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 * * 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- * * terms of the GNU General Public License as published by the Free Soft- *
...@@ -149,7 +149,7 @@ get_target_maximum_default_alignment (void) ...@@ -149,7 +149,7 @@ get_target_maximum_default_alignment (void)
return BIGGEST_ALIGNMENT / BITS_PER_UNIT; return BIGGEST_ALIGNMENT / BITS_PER_UNIT;
} }
/* Standard'Default_Allocator_Alignment. Alignment guaranteed to be honored /* Standard'System_Allocator_Alignment. Alignment guaranteed to be honored
by the default allocator (System.Memory.Alloc or malloc if we have no by the default allocator (System.Memory.Alloc or malloc if we have no
run-time library at hand). run-time library at hand).
...@@ -172,7 +172,7 @@ get_target_maximum_default_alignment (void) ...@@ -172,7 +172,7 @@ get_target_maximum_default_alignment (void)
#endif #endif
Pos Pos
get_target_default_allocator_alignment (void) get_target_system_allocator_alignment (void)
{ {
return MALLOC_ALIGNMENT / BITS_PER_UNIT; return MALLOC_ALIGNMENT / BITS_PER_UNIT;
} }
......
...@@ -1907,13 +1907,13 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node) ...@@ -1907,13 +1907,13 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node)
stored just in front. */ stored just in front. */
unsigned int data_align = TYPE_ALIGN (data_type); unsigned int data_align = TYPE_ALIGN (data_type);
unsigned int default_allocator_alignment unsigned int system_allocator_alignment
= get_target_default_allocator_alignment () * BITS_PER_UNIT; = get_target_system_allocator_alignment () * BITS_PER_UNIT;
tree aligning_type tree aligning_type
= ((data_align > default_allocator_alignment) = ((data_align > system_allocator_alignment)
? make_aligning_type (data_type, data_align, data_size, ? make_aligning_type (data_type, data_align, data_size,
default_allocator_alignment, system_allocator_alignment,
POINTER_SIZE / BITS_PER_UNIT) POINTER_SIZE / BITS_PER_UNIT)
: NULL_TREE); : NULL_TREE);
...@@ -1986,12 +1986,12 @@ maybe_wrap_free (tree data_ptr, tree data_type) ...@@ -1986,12 +1986,12 @@ maybe_wrap_free (tree data_ptr, tree data_type)
return value, stored in front of the data block at allocation time. */ return value, stored in front of the data block at allocation time. */
unsigned int data_align = TYPE_ALIGN (data_type); unsigned int data_align = TYPE_ALIGN (data_type);
unsigned int default_allocator_alignment unsigned int system_allocator_alignment
= get_target_default_allocator_alignment () * BITS_PER_UNIT; = get_target_system_allocator_alignment () * BITS_PER_UNIT;
tree free_ptr; tree free_ptr;
if (data_align > default_allocator_alignment) if (data_align > system_allocator_alignment)
{ {
/* DATA_FRONT_PTR (void *) /* DATA_FRONT_PTR (void *)
= (void *)DATA_PTR - (void *)sizeof (void *)) */ = (void *)DATA_PTR - (void *)sizeof (void *)) */
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2009, 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -95,6 +95,10 @@ package Get_Targ is ...@@ -95,6 +95,10 @@ package Get_Targ is
function Get_Strict_Alignment return Nat; function Get_Strict_Alignment return Nat;
pragma Import (C, Get_Strict_Alignment, "get_target_strict_alignment"); pragma Import (C, Get_Strict_Alignment, "get_target_strict_alignment");
function Get_System_Allocator_Alignment return Nat;
pragma Import (C, Get_System_Allocator_Alignment,
"get_target_system_allocator_alignment");
function Get_Double_Float_Alignment return Nat; function Get_Double_Float_Alignment return Nat;
pragma Import (C, Get_Double_Float_Alignment, pragma Import (C, Get_Double_Float_Alignment,
"get_target_double_float_alignment"); "get_target_double_float_alignment");
......
...@@ -270,6 +270,7 @@ Implementation Defined Attributes ...@@ -270,6 +270,7 @@ Implementation Defined Attributes
* Small:: * Small::
* Storage_Unit:: * Storage_Unit::
* Stub_Type:: * Stub_Type::
* System_Allocator_Alignment::
* Target_Name:: * Target_Name::
* Tick:: * Tick::
* To_Address:: * To_Address::
...@@ -5752,6 +5753,7 @@ consideration, you should minimize the use of these attributes. ...@@ -5752,6 +5753,7 @@ consideration, you should minimize the use of these attributes.
* Small:: * Small::
* Storage_Unit:: * Storage_Unit::
* Stub_Type:: * Stub_Type::
* System_Allocator_Alignment::
* Target_Name:: * Target_Name::
* Tick:: * Tick::
* To_Address:: * To_Address::
...@@ -6490,6 +6492,18 @@ type @code{RACW_Stub_Type} declared in the internal implementation-defined ...@@ -6490,6 +6492,18 @@ type @code{RACW_Stub_Type} declared in the internal implementation-defined
unit @code{System.Partition_Interface}. Use of this attribute will create unit @code{System.Partition_Interface}. Use of this attribute will create
an implicit dependency on this unit. an implicit dependency on this unit.
@node System_Allocator_Alignment
@unnumberedsec System_Allocator_Alignment
@cindex Alignment, allocator
@findex System_Allocator_Alignment
@noindent
@code{Standard'System_Allocator_Alignment} (@code{Standard} is the only
permissible prefix) provides the observable guaranted to be honored by
the system allocator (malloc). This is a static value that can be used
in user storage pools based on malloc either to reject allocation
with alignment too large or to enable a realignment circuitry if the
alignment request is larger than this value.
@node Target_Name @node Target_Name
@unnumberedsec Target_Name @unnumberedsec Target_Name
@findex Target_Name @findex Target_Name
......
...@@ -114,6 +114,10 @@ package Rtsfind is ...@@ -114,6 +114,10 @@ package Rtsfind is
RTU_Null, RTU_Null,
-- Used as a null entry (will cause an error if referenced) -- Used as a null entry (will cause an error if referenced)
-- Package Ada
Ada,
-- Children of Ada -- Children of Ada
Ada_Calendar, Ada_Calendar,
......
...@@ -4563,6 +4563,13 @@ package body Sem_Attr is ...@@ -4563,6 +4563,13 @@ package body Sem_Attr is
end if; end if;
end if; end if;
--------------------------------
-- System_Allocator_Alignment --
--------------------------------
when Attribute_System_Allocator_Alignment =>
Standard_Attribute (Ttypes.System_Allocator_Alignment);
--------- ---------
-- Tag -- -- Tag --
--------- ---------
...@@ -7698,61 +7705,62 @@ package body Sem_Attr is ...@@ -7698,61 +7705,62 @@ package body Sem_Attr is
-- Note that in some cases, the values have already been folded as -- Note that in some cases, the values have already been folded as
-- a result of the processing in Analyze_Attribute. -- a result of the processing in Analyze_Attribute.
when Attribute_Abort_Signal | when Attribute_Abort_Signal |
Attribute_Access | Attribute_Access |
Attribute_Address | Attribute_Address |
Attribute_Address_Size | Attribute_Address_Size |
Attribute_Asm_Input | Attribute_Asm_Input |
Attribute_Asm_Output | Attribute_Asm_Output |
Attribute_Base | Attribute_Base |
Attribute_Bit_Order | Attribute_Bit_Order |
Attribute_Bit_Position | Attribute_Bit_Position |
Attribute_Callable | Attribute_Callable |
Attribute_Caller | Attribute_Caller |
Attribute_Class | Attribute_Class |
Attribute_Code_Address | Attribute_Code_Address |
Attribute_Compiler_Version | Attribute_Compiler_Version |
Attribute_Count | Attribute_Count |
Attribute_Default_Bit_Order | Attribute_Default_Bit_Order |
Attribute_Elaborated | Attribute_Elaborated |
Attribute_Elab_Body | Attribute_Elab_Body |
Attribute_Elab_Spec | Attribute_Elab_Spec |
Attribute_Elab_Subp_Body | Attribute_Elab_Subp_Body |
Attribute_Enabled | Attribute_Enabled |
Attribute_External_Tag | Attribute_External_Tag |
Attribute_Fast_Math | Attribute_Fast_Math |
Attribute_First_Bit | Attribute_First_Bit |
Attribute_Input | Attribute_Input |
Attribute_Last_Bit | Attribute_Last_Bit |
Attribute_Maximum_Alignment | Attribute_Maximum_Alignment |
Attribute_Old | Attribute_Old |
Attribute_Output | Attribute_Output |
Attribute_Partition_ID | Attribute_Partition_ID |
Attribute_Pool_Address | Attribute_Pool_Address |
Attribute_Position | Attribute_Position |
Attribute_Priority | Attribute_Priority |
Attribute_Read | Attribute_Read |
Attribute_Result | Attribute_Result |
Attribute_Storage_Pool | Attribute_Storage_Pool |
Attribute_Storage_Size | Attribute_Storage_Size |
Attribute_Storage_Unit | Attribute_Storage_Unit |
Attribute_Stub_Type | Attribute_Stub_Type |
Attribute_Tag | Attribute_System_Allocator_Alignment |
Attribute_Target_Name | Attribute_Tag |
Attribute_Terminated | Attribute_Target_Name |
Attribute_To_Address | Attribute_Terminated |
Attribute_Type_Key | Attribute_To_Address |
Attribute_UET_Address | Attribute_Type_Key |
Attribute_Unchecked_Access | Attribute_UET_Address |
Attribute_Universal_Literal_String | Attribute_Unchecked_Access |
Attribute_Unrestricted_Access | Attribute_Universal_Literal_String |
Attribute_Valid | Attribute_Unrestricted_Access |
Attribute_Value | Attribute_Valid |
Attribute_Wchar_T_Size | Attribute_Value |
Attribute_Wide_Value | Attribute_Wchar_T_Size |
Attribute_Wide_Wide_Value | Attribute_Wide_Value |
Attribute_Word_Size | Attribute_Wide_Wide_Value |
Attribute_Write => Attribute_Word_Size |
Attribute_Write =>
raise Program_Error; raise Program_Error;
end case; end case;
......
...@@ -814,6 +814,7 @@ package Snames is ...@@ -814,6 +814,7 @@ package Snames is
Name_Storage_Size : constant Name_Id := N + $; Name_Storage_Size : constant Name_Id := N + $;
Name_Storage_Unit : constant Name_Id := N + $; -- GNAT Name_Storage_Unit : constant Name_Id := N + $; -- GNAT
Name_Stream_Size : constant Name_Id := N + $; -- Ada 05 Name_Stream_Size : constant Name_Id := N + $; -- Ada 05
Name_System_Allocator_Alignment : constant Name_Id := N + $; -- GNAT
Name_Tag : constant Name_Id := N + $; Name_Tag : constant Name_Id := N + $;
Name_Target_Name : constant Name_Id := N + $; -- GNAT Name_Target_Name : constant Name_Id := N + $; -- GNAT
Name_Terminated : constant Name_Id := N + $; Name_Terminated : constant Name_Id := N + $;
...@@ -1354,6 +1355,7 @@ package Snames is ...@@ -1354,6 +1355,7 @@ package Snames is
Attribute_Storage_Size, Attribute_Storage_Size,
Attribute_Storage_Unit, Attribute_Storage_Unit,
Attribute_Stream_Size, Attribute_Stream_Size,
Attribute_System_Allocator_Alignment,
Attribute_Tag, Attribute_Tag,
Attribute_Target_Name, Attribute_Target_Name,
Attribute_Terminated, Attribute_Terminated,
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2009, 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -188,6 +188,10 @@ package Ttypes is ...@@ -188,6 +188,10 @@ package Ttypes is
-- The maximum alignment, in storage units, that an object or -- The maximum alignment, in storage units, that an object or
-- type may require on the target machine. -- type may require on the target machine.
System_Allocator_Alignment : constant Pos :=
Get_System_Allocator_Alignment;
-- The alignment, in storage units, of addresses returned by malloc.
Max_Unaligned_Field : constant Pos := Get_Max_Unaligned_Field; Max_Unaligned_Field : constant Pos := Get_Max_Unaligned_Field;
-- The maximum supported size in bits for a field that is not aligned -- The maximum supported size in bits for a field that is not aligned
-- on a storage unit boundary. -- on a storage unit boundary.
......
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