+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>
* exp_ch3.adb (In_Runtime): Fix typo.
Attribute_Small |
Attribute_Storage_Unit |
Attribute_Stub_Type |
+ Attribute_System_Allocator_Alignment |
Attribute_Target_Name |
Attribute_Type_Class |
Attribute_Type_Key |
S1 := Scope (S1);
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;
----------------------------
Dcls : constant List_Id := New_List;
-- Declarations for the 'Read body
- Stms : List_Id := New_List;
+ Stms : constant List_Id := New_List;
-- Statements for the 'Read body
Disc : Entity_Id;
-- Statements within the block where we have the constrained temporary
begin
-
- Disc := First_Discriminant (Typ);
-
-- A mutable type cannot be a tagged type, so we generate a new name
-- for the stream procedure.
Make_Defining_Identifier (Loc,
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 :=
Make_Selected_Component (Loc,
Prefix => New_Occurrence_Of (Pnam, Loc),
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
-- or Has_Controlled), or components constrained using the discriminants
-- of Typ, then we need to ensure that all component assignments
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => Cstr))));
- Constrained_Stms := Statements (Handled_Statement_Sequence (Decl));
- Append_To (Stms,
- Make_Block_Statement (Loc,
- Declarations => Dcls,
- Handled_Statement_Sequence => Parent (Constrained_Stms)));
+ -- AI05-023-1: Insert discriminant check prior to initialization of the
+ -- constrained temporary.
- Append_To (Constrained_Stms,
+ Append_To (Stms,
Make_Implicit_If_Statement (Pnam,
Condition =>
Make_Attribute_Reference (Loc,
Attribute_Name => Name_Constrained),
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,
Make_Assignment_Statement (Loc,
Name => Out_Formal,
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_Handled_Statement_Sequence (Decl,
- Make_Handled_Sequence_Of_Statements (Loc,
- Statements => Stms));
end Build_Mutable_Record_Read_Procedure;
------------------------------------------
ada/g-spchge.o \
ada/g-speche.o \
ada/g-u3spch.o \
- ada/get_alfa.o \
- ada/get_scos.o \
+ ada/get_alfa.o \
ada/get_targ.o \
ada/gnat.o \
ada/gnatvsn.o \
ada/s-string.ads ada/s-unstyp.ads ada/types.ads ada/unchconv.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.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/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/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/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.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/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/alloc.ads ada/aspects.ads ada/atree.ads ada/atree.adb \
ADA_INCLUDES = -I- -I. -I$(srcdir)/ada
-INCLUDES_FOR_SUBDIR = -I. -I.. -I../.. -I$(fsrcdir)/ada \
- -I$(fsrcdir)/../include -I$(fsrcdir)
+INCLUDES_FOR_SUBDIR = -iquote . -iquote .. -iquote ../.. -iquote $(fsrcdir)/ada \
+ -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
# Avoid a lot of time thinking about remaking Makefile.in and *.def.
endif
endif
-ifeq ($(strip $(filter-out powerpc% wrs vxworks,$(targ))),)
+ifeq ($(strip $(filter-out e500% powerpc% wrs vxworks,$(targ))),)
LIBGNAT_TARGET_PAIRS = \
a-intnam.ads<a-intnam-vxworks.ads \
a-numaux.ads<a-numaux-vxworks.ads \
system.ads<system-vxworks-ppc-rtp.ads
EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
- EXTRA_GNATRTL_TASKING_OBJS=affinity.o
+ EXTRA_LIBGNAT_OBJS+=affinity.o
+ EXTRA_LIBGNAT_SRCS+=affinity.c
else
ifeq ($(strip $(filter-out kernel-smp,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \
system.ads<system-vxworks-ppc-kernel.ads
EH_MECHANISM=-gcc
- EXTRA_GNATRTL_TASKING_OBJS=affinity.o
+ EXTRA_LIBGNAT_OBJS+=affinity.o
+ EXTRA_LIBGNAT_SRCS+=affinity.c
else
LIBGNAT_TARGET_PAIRS += \
s-interr.adb<s-interr-hwint.adb \
endif
# vxworks MILS
-ifeq ($(strip $(filter-out powerpc% wrs vxworksmils,$(targ))),)
+ifeq ($(strip $(filter-out e500% powerpc% wrs vxworksmils,$(targ))),)
# target pairs for vthreads runtime
LIBGNAT_TARGET_PAIRS = \
a-elchha.adb<a-elchha-vx6-raven-cert.adb \
system.ads<system-vxworks-x86-rtp.ads
EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
- EXTRA_GNATRTL_TASKING_OBJS=affinity.o
+ EXTRA_LIBGNAT_SRCS+=affinity.o
+ EXTRA_LIBGNAT_SRCS+=affinity.c
else
ifeq ($(strip $(filter-out kernel-smp, $(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += \
s-vxwext.ads<s-vxwext-kernel.ads \
s-vxwext.adb<s-vxwext-kernel-smp.adb \
system.ads<system-vxworks-x86-kernel.ads
- EXTRA_GNATRTL_TASKING_OBJS=affinity.o
+ EXTRA_LIBGNAT_OBJS+=affinity.o
+ EXTRA_LIBGNAT_SRCS+=affinity.c
else
LIBGNAT_TARGET_PAIRS += \
s-interr.adb<s-interr-hwint.adb \
s-parame.ads<s-parame-vms-alpha.ads \
$(ATOMICS_TARGET_PAIRS)
- EXTRA_GNATRTL_NONTASKING_OBJS = s-atocou.o
TOOLS_TARGET_PAIRS= \
mlib-tgt-specific.adb<mlib-tgt-specific-vms-alpha.adb \
symbols.adb<symbols-vms.adb \
GNATLIB_SHARED=gnatlib-shared-vms
EXTRA_LIBGNAT_SRCS+=adamsg.msg
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_GNATTOOLS = \
../../gnatsym$(exeext)
s-osprim.adb<s-osprim-mingw.adb \
s-taprop.adb<s-taprop-mingw.adb
- EH_MECHANISM=-gcc
ifeq ($(strip $(filter-out x86_64%,$(arch))),)
ifeq ($(strip $(MULTISUBDIR)),/32)
LIBGNAT_TARGET_PAIRS += \
# ??? This will be replaced by gnatlib-shared-dual-win32 when GNAT
# auto-import support for array/record will be done.
GNATLIB_SHARED = gnatlib-shared-win32
+
+ EH_MECHANISM=-gcc
endif
TOOLS_TARGET_PAIRS= \
endif
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
GNATLIB_SHARED = gnatlib-shared-darwin
extern Pos get_target_long_double_size (void);
extern Pos get_target_pointer_size (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_alignment (void);
extern Nat get_float_words_be (void);
* *
* 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 *
* terms of the GNU General Public License as published by the Free Soft- *
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
run-time library at hand).
#endif
Pos
-get_target_default_allocator_alignment (void)
+get_target_system_allocator_alignment (void)
{
return MALLOC_ALIGNMENT / BITS_PER_UNIT;
}
stored just in front. */
unsigned int data_align = TYPE_ALIGN (data_type);
- unsigned int default_allocator_alignment
- = get_target_default_allocator_alignment () * BITS_PER_UNIT;
+ unsigned int system_allocator_alignment
+ = get_target_system_allocator_alignment () * BITS_PER_UNIT;
tree aligning_type
- = ((data_align > default_allocator_alignment)
+ = ((data_align > system_allocator_alignment)
? make_aligning_type (data_type, data_align, data_size,
- default_allocator_alignment,
+ system_allocator_alignment,
POINTER_SIZE / BITS_PER_UNIT)
: NULL_TREE);
return value, stored in front of the data block at allocation time. */
unsigned int data_align = TYPE_ALIGN (data_type);
- unsigned int default_allocator_alignment
- = get_target_default_allocator_alignment () * BITS_PER_UNIT;
+ unsigned int system_allocator_alignment
+ = get_target_system_allocator_alignment () * BITS_PER_UNIT;
tree free_ptr;
- if (data_align > default_allocator_alignment)
+ if (data_align > system_allocator_alignment)
{
/* DATA_FRONT_PTR (void *)
= (void *)DATA_PTR - (void *)sizeof (void *)) */
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
function Get_Strict_Alignment return Nat;
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;
pragma Import (C, Get_Double_Float_Alignment,
"get_target_double_float_alignment");
* Small::
* Storage_Unit::
* Stub_Type::
+* System_Allocator_Alignment::
* Target_Name::
* Tick::
* To_Address::
* Small::
* Storage_Unit::
* Stub_Type::
+* System_Allocator_Alignment::
* Target_Name::
* Tick::
* To_Address::
unit @code{System.Partition_Interface}. Use of this attribute will create
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
@unnumberedsec Target_Name
@findex Target_Name
RTU_Null,
-- Used as a null entry (will cause an error if referenced)
+ -- Package Ada
+
+ Ada,
+
-- Children of Ada
Ada_Calendar,
end if;
end if;
+ --------------------------------
+ -- System_Allocator_Alignment --
+ --------------------------------
+
+ when Attribute_System_Allocator_Alignment =>
+ Standard_Attribute (Ttypes.System_Allocator_Alignment);
+
---------
-- Tag --
---------
-- Note that in some cases, the values have already been folded as
-- a result of the processing in Analyze_Attribute.
- when Attribute_Abort_Signal |
- Attribute_Access |
- Attribute_Address |
- Attribute_Address_Size |
- Attribute_Asm_Input |
- Attribute_Asm_Output |
- Attribute_Base |
- Attribute_Bit_Order |
- Attribute_Bit_Position |
- Attribute_Callable |
- Attribute_Caller |
- Attribute_Class |
- Attribute_Code_Address |
- Attribute_Compiler_Version |
- Attribute_Count |
- Attribute_Default_Bit_Order |
- Attribute_Elaborated |
- Attribute_Elab_Body |
- Attribute_Elab_Spec |
- Attribute_Elab_Subp_Body |
- Attribute_Enabled |
- Attribute_External_Tag |
- Attribute_Fast_Math |
- Attribute_First_Bit |
- Attribute_Input |
- Attribute_Last_Bit |
- Attribute_Maximum_Alignment |
- Attribute_Old |
- Attribute_Output |
- Attribute_Partition_ID |
- Attribute_Pool_Address |
- Attribute_Position |
- Attribute_Priority |
- Attribute_Read |
- Attribute_Result |
- Attribute_Storage_Pool |
- Attribute_Storage_Size |
- Attribute_Storage_Unit |
- Attribute_Stub_Type |
- Attribute_Tag |
- Attribute_Target_Name |
- Attribute_Terminated |
- Attribute_To_Address |
- Attribute_Type_Key |
- Attribute_UET_Address |
- Attribute_Unchecked_Access |
- Attribute_Universal_Literal_String |
- Attribute_Unrestricted_Access |
- Attribute_Valid |
- Attribute_Value |
- Attribute_Wchar_T_Size |
- Attribute_Wide_Value |
- Attribute_Wide_Wide_Value |
- Attribute_Word_Size |
- Attribute_Write =>
+ when Attribute_Abort_Signal |
+ Attribute_Access |
+ Attribute_Address |
+ Attribute_Address_Size |
+ Attribute_Asm_Input |
+ Attribute_Asm_Output |
+ Attribute_Base |
+ Attribute_Bit_Order |
+ Attribute_Bit_Position |
+ Attribute_Callable |
+ Attribute_Caller |
+ Attribute_Class |
+ Attribute_Code_Address |
+ Attribute_Compiler_Version |
+ Attribute_Count |
+ Attribute_Default_Bit_Order |
+ Attribute_Elaborated |
+ Attribute_Elab_Body |
+ Attribute_Elab_Spec |
+ Attribute_Elab_Subp_Body |
+ Attribute_Enabled |
+ Attribute_External_Tag |
+ Attribute_Fast_Math |
+ Attribute_First_Bit |
+ Attribute_Input |
+ Attribute_Last_Bit |
+ Attribute_Maximum_Alignment |
+ Attribute_Old |
+ Attribute_Output |
+ Attribute_Partition_ID |
+ Attribute_Pool_Address |
+ Attribute_Position |
+ Attribute_Priority |
+ Attribute_Read |
+ Attribute_Result |
+ Attribute_Storage_Pool |
+ Attribute_Storage_Size |
+ Attribute_Storage_Unit |
+ Attribute_Stub_Type |
+ Attribute_System_Allocator_Alignment |
+ Attribute_Tag |
+ Attribute_Target_Name |
+ Attribute_Terminated |
+ Attribute_To_Address |
+ Attribute_Type_Key |
+ Attribute_UET_Address |
+ Attribute_Unchecked_Access |
+ Attribute_Universal_Literal_String |
+ Attribute_Unrestricted_Access |
+ Attribute_Valid |
+ Attribute_Value |
+ Attribute_Wchar_T_Size |
+ Attribute_Wide_Value |
+ Attribute_Wide_Wide_Value |
+ Attribute_Word_Size |
+ Attribute_Write =>
raise Program_Error;
end case;
Name_Storage_Size : constant Name_Id := N + $;
Name_Storage_Unit : constant Name_Id := N + $; -- GNAT
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_Target_Name : constant Name_Id := N + $; -- GNAT
Name_Terminated : constant Name_Id := N + $;
Attribute_Storage_Size,
Attribute_Storage_Unit,
Attribute_Stream_Size,
+ Attribute_System_Allocator_Alignment,
Attribute_Tag,
Attribute_Target_Name,
Attribute_Terminated,
-- --
-- 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 --
-- terms of the GNU General Public License as published by the Free Soft- --
-- The maximum alignment, in storage units, that an object or
-- 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;
-- The maximum supported size in bits for a field that is not aligned
-- on a storage unit boundary.
OSDN Git Service
