+2012-07-12 Vasiliy Fofanov <fofanov@adacore.com>
+
+ * vms_data.ads: Add VMS qualifiers for -gnatn1/2 switches.
+
+2012-07-12 Thomas Quinot <quinot@adacore.com>
+
+ * exp_ch5.adb, exp_pakd.adb, rtsfind.ads, freeze.adb, sem_util.adb,
+ sem_util.ads, exp_aggr.adb
+ (Exp_Aggr.Packed_Array_Aggregate_Handled): Simplify processing
+ for reverse storage order aggregate.
+ (Exp_Pakd.Byte_Swap): New utility routine used by...
+ (Exp_Pakd.Expand_Bit_Packed_Element_Set,
+ Expand_Packed_Element_Reference): For the case of a free-standing
+ packed array with reverse storage order, perform byte swapping.
+ (Rtsfind): Make new entities RE_Bswap_{16,32,64} available.
+ (Freeze.Check_Component_Storage_Order): New utility routine
+ to enforce legality rules for nested composite types whose
+ enclosing composite has an explicitly defined Scalar_Storage_Order
+ attribute.
+ (Sem_Util.In_Reverse_Storage_Order_Object): Renamed from
+ Sem_Util.In_Reverse_Storage_Order_Record, as SSO now applies to
+ array types as well.
+ (Exp_Ch5.Expand_Assign_Array): Remove now unnecessary kludge
+ for change of scalar storage order in assignments. The Lhs and
+ Rhs now always have the same scalar storage order.
+
+2012-07-12 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * g-debpoo.adb (Allocate): Add local constant
+ No_Element. Initialize the allocated memory chunk to No_Element.
+
+2012-07-12 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch12.adb (Validate_Derived_Type_Instance): Handle properly
+ the case of an instance of a child unit where a formal derived
+ type DT is an extension of a type T declared in a parent unit,
+ and the actual in the instance of the child is the type T declared
+ in the parent instance, and that actual is not a derived type.
+
+2012-07-12 Eric Botcazou <ebotcazou@adacore.com>
+ Tristan Gingold <gingold@adacore.com>
+
+ * system-hpux-ia64.ads: Enable ZCX by default.
+ * gcc-interface/Makefile.in: Use alternate stack on ia64-hpux.
+ Change soext to .so.
+
2012-07-12 Robert Dewar <dewar@adacore.com>
* s-atopri.adb, s-atopri.ads: Minor reformatting.
Expr : Node_Id;
-- Next expression from positional parameters of aggregate
- Enclosing_Aggregate : Node_Id;
-
- In_Reverse_Storage_Order_Record : Boolean;
- -- True if we are within an aggregate of a record type with
- -- reversed storage order.
-
begin
- -- Determine whether we are in a reversed storage order record
- -- aggregate.
-
- In_Reverse_Storage_Order_Record := False;
- Enclosing_Aggregate := Parent (N);
- while Present (Enclosing_Aggregate) loop
- if Nkind (Enclosing_Aggregate) = N_Component_Association then
- null;
-
- elsif Nkind (Enclosing_Aggregate) /= N_Aggregate then
- exit;
-
- elsif Is_Record_Type (Etype (Enclosing_Aggregate))
- and then Reverse_Storage_Order (Etype (Enclosing_Aggregate))
- then
- In_Reverse_Storage_Order_Record := True;
- exit;
- end if;
-
- Enclosing_Aggregate := Parent (Enclosing_Aggregate);
- end loop;
-
-- For little endian, we fill up the low order bits of the target
-- value. For big endian we fill up the high order bits of the
-- target value (which is a left justified modular value).
if Bytes_Big_Endian
xor Debug_Flag_8
- xor In_Reverse_Storage_Order_Record
+ xor Reverse_Storage_Order (Base_Type (Typ))
then
Shift := Csiz * (Len - 1);
Incr := -Csiz;
elsif Has_Controlled_Component (L_Type) then
Loop_Required := True;
- -- If changing scalar storage order and assigning a bit packed array,
- -- force loop expansion.
-
- elsif Is_Bit_Packed_Array (L_Type)
- and then (In_Reverse_Storage_Order_Record (Rhs) /=
- In_Reverse_Storage_Order_Record (Lhs))
- then
- Loop_Required := True;
-
-- If object is atomic, we cannot tolerate a loop
elsif Is_Atomic_Object (Act_Lhs)
-- array type on the fly). Such actions are inserted into the tree
-- directly using Insert_Action.
+ function Byte_Swap (N : Node_Id) return Node_Id;
+ -- Wrap N in a call to a byte swapping function, with appropriate type
+ -- conversions.
+
+ ---------------
+ -- Byte_Swap --
+ ---------------
+
+ function Byte_Swap (N : Node_Id) return Node_Id is
+ Loc : constant Source_Ptr := Sloc (N);
+ T : constant Entity_Id := Etype (N);
+ Swap_RE : RE_Id;
+ Swap_F : Entity_Id;
+
+ begin
+ pragma Assert (Esize (T) > 8);
+
+ if Esize (T) <= 16 then
+ Swap_RE := RE_Bswap_16;
+ elsif Esize (T) <= 32 then
+ Swap_RE := RE_Bswap_32;
+ else pragma Assert (Esize (T) <= 64);
+ Swap_RE := RE_Bswap_64;
+ end if;
+
+ Swap_F := RTE (Swap_RE);
+
+ return Unchecked_Convert_To
+ (T,
+ Make_Function_Call (Loc,
+ Name =>
+ New_Occurrence_Of (Swap_F, Loc),
+ Parameter_Associations =>
+ New_List (Unchecked_Convert_To (Etype (Swap_F), N))));
+ end Byte_Swap;
+
------------------------------
-- Compute_Linear_Subscript --
------------------------------
-- contains the value. Otherwise Rhs_Val_Known is set False, and
-- the Rhs_Val is undefined.
+ Require_Byte_Swapping : Boolean := False;
+ -- True if byte swapping required, for the Reverse_Storage_Order case
+ -- when the packed array is a free-standing object. (If it is part
+ -- of a composite type, and therefore potentially not aligned on a byte
+ -- boundary, the swapping is done by the back-end).
+
function Get_Shift return Node_Id;
-- Function used to get the value of Shift, making sure that it
-- gets duplicated if the function is called more than once.
-- Obj := atyp!((Obj and Mask1) or (shift_left (rhs, Shift)))
+ -- or in the case of a freestanding Reverse_Storage_Order object,
+
+ -- Obj := Swap (atyp!((Swap (Obj) and Mask1)
+ -- or (shift_left (rhs, Shift))))
+
-- where Mask1 is obtained by shifting Cmask left Shift bits
-- and then complementing the result.
Set_Etype (Obj, T);
Set_Etype (New_Lhs, T);
Set_Etype (New_Rhs, T);
+
+ if Reverse_Storage_Order (Base_Type (Atyp))
+ and then Esize (T) > 8
+ and then not In_Reverse_Storage_Order_Object (Obj)
+ then
+ Require_Byte_Swapping := True;
+ New_Rhs := Byte_Swap (New_Rhs);
+ end if;
end;
-- First we deal with the "and"
end;
end if;
+ if Require_Byte_Swapping then
+ Set_Etype (New_Rhs, Etype (Obj));
+ New_Rhs := Byte_Swap (New_Rhs);
+ end if;
+
-- Now do the rewrite
Rewrite (N,
Lit := Make_Integer_Literal (Loc, Cmask);
Set_Print_In_Hex (Lit);
+ -- Byte swapping required for the Reverse_Storage_Order case, but
+ -- only for a free-standing object (see note on Require_Byte_Swapping
+ -- in Expand_Bit_Packed_Element_Set).
+
+ if Reverse_Storage_Order (Atyp)
+ and then Esize (Atyp) > 8
+ and then not In_Reverse_Storage_Order_Object (Obj)
+ then
+ Obj := Byte_Swap (Obj);
+ end if;
+
-- We generate a shift right to position the field, followed by a
-- masking operation to extract the bit field, and we finally do an
-- unchecked conversion to convert the result to the required target.
-- We also have to adjust if the storage order is reversed
- if Bytes_Big_Endian xor In_Reverse_Storage_Order_Record (Obj) then
+ if Bytes_Big_Endian xor Reverse_Storage_Order (Base_Type (Atyp)) then
Shift :=
Make_Op_Subtract (Loc,
Left_Opnd => Make_Integer_Literal (Loc, Osiz - Csiz),
-- Apply legality checks to address clauses for object declarations,
-- at the point the object is frozen.
+ procedure Check_Component_Storage_Order
+ (Encl_Type : Entity_Id;
+ Comp : Entity_Id);
+ -- For an Encl_Type that has a Scalar_Storage_Order attribute definition
+ -- clause, verify that the component type is compatible. For arrays,
+ -- Comp is Empty; for records, it is the entity of the component under
+ -- consideration.
+
procedure Check_Strict_Alignment (E : Entity_Id);
-- E is a base type. If E is tagged or has a component that is aliased
-- or tagged or contains something this is aliased or tagged, set
Set_Size_Known_At_Compile_Time (T, Size_Known (T));
end Check_Compile_Time_Size;
+ -----------------------------------
+ -- Check_Component_Storage_Order --
+ -----------------------------------
+
+ procedure Check_Component_Storage_Order
+ (Encl_Type : Entity_Id;
+ Comp : Entity_Id)
+ is
+ Comp_Type : Entity_Id;
+ Comp_Def : Node_Id;
+ Err_Node : Node_Id;
+ ADC : Node_Id;
+
+ begin
+ -- Record case
+
+ if Present (Comp) then
+ Err_Node := Comp;
+ Comp_Type := Etype (Comp);
+ Comp_Def := Component_Definition (Parent (Comp));
+
+ -- Array case
+
+ else
+ Err_Node := Encl_Type;
+ Comp_Type := Component_Type (Encl_Type);
+ Comp_Def := Component_Definition
+ (Type_Definition (Declaration_Node (Encl_Type)));
+ end if;
+
+ -- Note: the Reverse_Storage_Order flag is set on the base type,
+ -- but the attribute definition clause is attached to the first
+ -- subtype.
+
+ Comp_Type := Base_Type (Comp_Type);
+ ADC := Get_Attribute_Definition_Clause
+ (First_Subtype (Comp_Type),
+ Attribute_Scalar_Storage_Order);
+
+ if (Is_Record_Type (Comp_Type) or else Is_Array_Type (Comp_Type))
+ and then
+ (No (ADC) or else Reverse_Storage_Order (Encl_Type)
+ /= Reverse_Storage_Order (Etype (Comp_Type)))
+ then
+ Error_Msg_N
+ ("component type must have same scalar storage order as "
+ & "enclosing composite", Err_Node);
+
+ elsif Aliased_Present (Comp_Def) then
+ Error_Msg_N ("aliased component not permitted for type with "
+ & "explicit Scalar_Storage_Order", Err_Node);
+ end if;
+ end Check_Component_Storage_Order;
+
-----------------------------
-- Check_Debug_Info_Needed --
-----------------------------
end if;
-- Warn if there is a Scalar_Storage_Order but no component clause
+ -- (or pragma Pack).
- if not Placed_Component then
+ if not (Placed_Component or else Is_Packed (Rec)) then
Error_Msg_N
("?scalar storage order specified but no component clause",
ADC);
end if;
+
+ -- Check attribute on component types
+
+ Comp := First_Component (Rec);
+ while Present (Comp) loop
+ Check_Component_Storage_Order (Rec, Comp);
+ Next_Component (Comp);
+ end loop;
end if;
-- Deal with Bit_Order aspect specifying a non-default bit order
ADC := Get_Attribute_Definition_Clause (Rec, Attribute_Bit_Order);
if Present (ADC) and then Base_Type (Rec) = Rec then
- if not Placed_Component then
+ if not (Placed_Component or else Is_Packed (Rec)) then
Error_Msg_N ("?bit order specification has no effect", ADC);
Error_Msg_N
("\?since no component clauses were specified", ADC);
end if;
end if;
+ -- Check for scalar storage order
+
+ if Present (Get_Attribute_Definition_Clause
+ (E, Attribute_Scalar_Storage_Order))
+ then
+ Check_Component_Storage_Order (E, Empty);
+ end if;
+
-- Processing that is done only for subtypes
else
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
-- terms of wasted memory). To do that, all we should have to do it to
-- set the size of this array to the page size. See mprotect().
- P : Ptr;
+ No_Element : constant Storage_Element := 0;
Current : Byte_Count;
+ P : Ptr;
Trace : Traceback_Htable_Elem_Ptr;
begin
-- Use standard (i.e. through malloc) allocations. This automatically
-- raises Storage_Error if needed. We also try once more to physically
-- release memory, so that even marked blocks, in the advanced scanning,
- -- are freed.
+ -- are freed. Initialize the storage array to avoid bogus warnings by
+ -- valgrind.
begin
- P := new Local_Storage_Array;
+ P := new Local_Storage_Array'(others => No_Element);
exception
when Storage_Error =>
Free_Physically (Pool);
- P := new Local_Storage_Array;
+ P := new Local_Storage_Array'(others => No_Element);
end;
Storage_Address :=
s-osinte.ads<s-osinte-hpux.ads \
s-osprim.adb<s-osprim-posix.adb \
s-taprop.adb<s-taprop-posix.adb \
- s-taspri.ads<s-taspri-posix-noaltstack.ads \
+ s-taspri.ads<s-taspri-posix.ads \
s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
system.ads<system-hpux-ia64.ads \
$(ATOMICS_TARGET_PAIRS) \
mlib-tgt-specific.adb<mlib-tgt-specific-ia64-hpux.adb
MISCLIB=
+ EH_MECHANISM=-gcc
THREADSLIB=-lpthread
GNATLIB_SHARED=gnatlib-shared-dual
GMEM_LIB = gmemlib
- soext = .sl
+ soext = .so
SO_OPTS = -Wl,+h,
LIBRARY_VERSION := $(LIB_VERSION)
endif
System_Aux_DEC,
System_Bit_Ops,
System_Boolean_Array_Operations,
+ System_Byte_Swapping,
System_Checked_Pools,
System_Compare_Array_Signed_16,
System_Compare_Array_Signed_32,
RE_Vector_Nxor, -- System_Boolean_Array_Operations,
RE_Vector_Xor, -- System_Boolean_Array_Operations,
+ RE_Bswap_16, -- System.Byte_Swapping
+ RE_Bswap_32, -- System.Byte_Swapping
+ RE_Bswap_64, -- System.Byte_Swapping
+
RE_Checked_Pool, -- System.Checked_Pools
RE_Compare_Array_S8, -- System.Compare_Array_Signed_8
RE_Vector_Nxor => System_Boolean_Array_Operations,
RE_Vector_Xor => System_Boolean_Array_Operations,
+ RE_Bswap_16 => System_Byte_Swapping,
+ RE_Bswap_32 => System_Byte_Swapping,
+ RE_Bswap_64 => System_Byte_Swapping,
+
RE_Compare_Array_S8 => System_Compare_Array_Signed_8,
RE_Compare_Array_S8_Unaligned => System_Compare_Array_Signed_8,
Get_Instance_Of (Base_Type (Get_Instance_Of (A_Gen_T)));
end if;
+ -- An unusual case: the actual is a type declared in a parent unit,
+ -- but is not a formal type so there is no instance_of for it.
+ -- Retrieve it by analyzing the record extension.
+
+ elsif Is_Child_Unit (Scope (A_Gen_T))
+ and then In_Open_Scopes (Scope (Act_T))
+ and then Is_Generic_Instance (Scope (Act_T))
+ then
+ Analyze (Subtype_Mark (Def));
+ Ancestor := Entity (Subtype_Mark (Def));
+
else
Ancestor := Get_Instance_Of (Etype (Base_Type (A_Gen_T)));
end if;
end In_Parameter_Specification;
-------------------------------------
- -- In_Reverse_Storage_Order_Record --
+ -- In_Reverse_Storage_Order_Object --
-------------------------------------
- function In_Reverse_Storage_Order_Record (N : Node_Id) return Boolean is
+ function In_Reverse_Storage_Order_Object (N : Node_Id) return Boolean is
Pref : Node_Id;
+ Btyp : Entity_Id := Empty;
begin
Pref := N;
end case;
end loop;
- return Present (Pref)
- and then Is_Record_Type (Etype (Pref))
- and then Reverse_Storage_Order (Etype (Pref));
- end In_Reverse_Storage_Order_Record;
+ if Present (Pref) then
+ Btyp := Base_Type (Etype (Pref));
+ end if;
+
+ return Present (Btyp)
+ and then (Is_Record_Type (Btyp) or else Is_Array_Type (Btyp))
+ and then Reverse_Storage_Order (Btyp);
+ end In_Reverse_Storage_Order_Object;
--------------------------------------
-- In_Subprogram_Or_Concurrent_Unit --
function In_Parameter_Specification (N : Node_Id) return Boolean;
-- Returns True if node N belongs to a parameter specification
- function In_Reverse_Storage_Order_Record (N : Node_Id) return Boolean;
- -- Returns True if N denotes a component or subcomponent in a record object
- -- that has Reverse_Storage_Order.
+ function In_Reverse_Storage_Order_Object (N : Node_Id) return Boolean;
+ -- Returns True if N denotes a component or subcomponent in a record or
+ -- array that has Reverse_Storage_Order.
function In_Subprogram_Or_Concurrent_Unit return Boolean;
-- Determines if the current scope is within a subprogram compilation unit
-- S p e c --
-- (HP-UX/ia64 Version) --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
Always_Compatible_Rep : constant Boolean := True;
Suppress_Standard_Library : constant Boolean := False;
Use_Ada_Main_Program_Name : constant Boolean := False;
- ZCX_By_Default : constant Boolean := False;
+ ZCX_By_Default : constant Boolean := True;
end System;
S_GCC_Inline : aliased constant S := "/INLINE=" &
"PRAGMA " &
"-gnatn " &
+ "PRAGMA_LEVEL_1 " &
+ "-gnatn1 " &
+ "PRAGMA_LEVEL_2 " &
+ "-gnatn2 " &
"FULL " &
"-gnatN " &
"SUPPRESS " &
projects / gcc.git / commitdiff