Skip to content

R
riscv-gcc-1
Commit f91510fc by Arnaud Charlet
Options

[multiple changes] 

2012-03-09  Vasiliy Fofanov  <fofanov@adacore.com>

	* a-direct.adb: Do not strip the trailing directory separator
	from path, as this is already done inside Normalize_Pathname;
	doing it again produces the wrong result on Windows for the
	drive's root dir (i.e. "X:\" becomes "X:").

2012-03-09  Thomas Quinot  <quinot@adacore.com>

	* exp_attr.adb, freeze.adb, sem_attr.adb, aspects.adb, aspects.ads,
	sem_ch13.adb, snames.ads-tmpl (Exp_Attr.Expand_N_Attribute_Reference):
	Add Attribute_Scalar_Storage_Order.
	(Sem_Attr.Analyze_Attribute, Eval_Attribute): Ditto.
	(Aspects): Add Aspect_Scalar_Storage_Order (Snames): Add
	Name_Scalar_Storage_Order and Attribute_Scalar_Storage_Order.
	(Sem_Ch13.Analyze_Attribute_Definition_Clause): Add processing
	for Scalar_Storage_Order.
	(Freeze): If Scalar_Storage_Order is specified, check that it
	is compatible with Bit_Order.

From-SVN: r185142
parent a1fc903a
Showing with 140 additions and 33 deletions
gcc/ada/ChangeLog
2012-03-09 Vasiliy Fofanov <fofanov@adacore.com>
* a-direct.adb: Do not strip the trailing directory separator
from path, as this is already done inside Normalize_Pathname;
doing it again produces the wrong result on Windows for the
drive's root dir (i.e. "X:\" becomes "X:").
2012-03-09 Thomas Quinot <quinot@adacore.com>
* exp_attr.adb, freeze.adb, sem_attr.adb, aspects.adb, aspects.ads,
sem_ch13.adb, snames.ads-tmpl (Exp_Attr.Expand_N_Attribute_Reference):
Add Attribute_Scalar_Storage_Order.
(Sem_Attr.Analyze_Attribute, Eval_Attribute): Ditto.
(Aspects): Add Aspect_Scalar_Storage_Order (Snames): Add
Name_Scalar_Storage_Order and Attribute_Scalar_Storage_Order.
(Sem_Ch13.Analyze_Attribute_Definition_Clause): Add processing
for Scalar_Storage_Order.
(Freeze): If Scalar_Storage_Order is specified, check that it
is compatible with Bit_Order.
2012-03-09 Robert Dewar <dewar@adacore.com> 2012-03-09 Robert Dewar <dewar@adacore.com>
* s-osinte-linux.ads, sem_util.adb, s-taprop-linux.adb, exp_ch4.adb, * s-osinte-linux.ads, sem_util.adb, s-taprop-linux.adb, exp_ch4.adb,
......
gcc/ada/a-direct.adb
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- -- Copyright (C) 2004-2012, 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- --
...@@ -514,18 +514,10 @@ package body Ada.Directories is ...@@ -514,18 +514,10 @@ package body Ada.Directories is
begin begin
Local_Get_Current_Dir (Buffer'Address, Path_Len'Address); Local_Get_Current_Dir (Buffer'Address, Path_Len'Address);
declare -- We need to resolve links because of A.16(47), since we must not
-- We need to resolve links because of A.16(47), since we must not -- return alternative names for files
-- return alternative names for files return Normalize_Pathname (Buffer (1 .. Path_Len));
Cur : constant String := Normalize_Pathname (Buffer (1 .. Path_Len));
begin
if Cur'Length > 1 and then Cur (Cur'Last) = Dir_Separator then
return Cur (1 .. Cur'Last - 1);
else
return Cur;
end if;
end;
end Current_Directory; end Current_Directory;
---------------------- ----------------------
......
gcc/ada/aspects.adb
...@@ -278,6 +278,7 @@ package body Aspects is ...@@ -278,6 +278,7 @@ package body Aspects is
Aspect_Pure_12 => Aspect_Pure_12, Aspect_Pure_12 => Aspect_Pure_12,
Aspect_Remote_Call_Interface => Aspect_Remote_Call_Interface, Aspect_Remote_Call_Interface => Aspect_Remote_Call_Interface,
Aspect_Remote_Types => Aspect_Remote_Types, Aspect_Remote_Types => Aspect_Remote_Types,
Aspect_Scalar_Storage_Order => Aspect_Scalar_Storage_Order,
Aspect_Shared_Passive => Aspect_Shared_Passive, Aspect_Shared_Passive => Aspect_Shared_Passive,
Aspect_Universal_Data => Aspect_Universal_Data, Aspect_Universal_Data => Aspect_Universal_Data,
Aspect_Input => Aspect_Input, Aspect_Input => Aspect_Input,
......
gcc/ada/aspects.ads
...@@ -74,6 +74,7 @@ package Aspects is ...@@ -74,6 +74,7 @@ package Aspects is
Aspect_Predicate, -- GNAT Aspect_Predicate, -- GNAT
Aspect_Priority, Aspect_Priority,
Aspect_Read, Aspect_Read,
Aspect_Scalar_Storage_Order, -- GNAT
Aspect_Simple_Storage_Pool, -- GNAT Aspect_Simple_Storage_Pool, -- GNAT
Aspect_Size, Aspect_Size,
Aspect_Small, Aspect_Small,
...@@ -188,6 +189,7 @@ package Aspects is ...@@ -188,6 +189,7 @@ package Aspects is
Aspect_Pure_Function => True, Aspect_Pure_Function => True,
Aspect_Remote_Access_Type => True, Aspect_Remote_Access_Type => True,
Aspect_Shared => True, Aspect_Shared => True,
Aspect_Scalar_Storage_Order => True,
Aspect_Simple_Storage_Pool => True, Aspect_Simple_Storage_Pool => True,
Aspect_Simple_Storage_Pool_Type => True, Aspect_Simple_Storage_Pool_Type => True,
Aspect_Suppress_Debug_Info => True, Aspect_Suppress_Debug_Info => True,
...@@ -281,6 +283,7 @@ package Aspects is ...@@ -281,6 +283,7 @@ package Aspects is
Aspect_Predicate => Expression, Aspect_Predicate => Expression,
Aspect_Priority => Expression, Aspect_Priority => Expression,
Aspect_Read => Name, Aspect_Read => Name,
Aspect_Scalar_Storage_Order => Expression,
Aspect_Simple_Storage_Pool => Name, Aspect_Simple_Storage_Pool => Name,
Aspect_Size => Expression, Aspect_Size => Expression,
Aspect_Small => Expression, Aspect_Small => Expression,
...@@ -367,6 +370,7 @@ package Aspects is ...@@ -367,6 +370,7 @@ package Aspects is
Aspect_Remote_Access_Type => Name_Remote_Access_Type, Aspect_Remote_Access_Type => Name_Remote_Access_Type,
Aspect_Remote_Call_Interface => Name_Remote_Call_Interface, Aspect_Remote_Call_Interface => Name_Remote_Call_Interface,
Aspect_Remote_Types => Name_Remote_Types, Aspect_Remote_Types => Name_Remote_Types,
Aspect_Scalar_Storage_Order => Name_Scalar_Storage_Order,
Aspect_Shared => Name_Shared, Aspect_Shared => Name_Shared,
Aspect_Shared_Passive => Name_Shared_Passive, Aspect_Shared_Passive => Name_Shared_Passive,
Aspect_Simple_Storage_Pool => Name_Simple_Storage_Pool, Aspect_Simple_Storage_Pool => Name_Simple_Storage_Pool,
......
gcc/ada/exp_attr.adb
...@@ -5672,7 +5672,8 @@ package body Exp_Attr is ...@@ -5672,7 +5672,8 @@ package body Exp_Attr is
Attribute_Definite | Attribute_Definite |
Attribute_Null_Parameter | Attribute_Null_Parameter |
Attribute_Passed_By_Reference | Attribute_Passed_By_Reference |
Attribute_Pool_Address => Attribute_Pool_Address |
Attribute_Scalar_Storage_Order =>
null; null;
-- The following attributes are also handled by the back end, but return -- The following attributes are also handled by the back end, but return
......
gcc/ada/freeze.adb
...@@ -2129,6 +2129,28 @@ package body Freeze is ...@@ -2129,6 +2129,28 @@ package body Freeze is
Next_Entity (Comp); Next_Entity (Comp);
end loop; end loop;
-- Check compatibility of Scalar_Storage_Order with Bit_Order, if the
-- former is specified.
ADC := Get_Attribute_Definition_Clause
(Rec, Attribute_Scalar_Storage_Order);
if Present (ADC)
and then
Reverse_Bit_Order (Rec) /= Reverse_Storage_Order (Rec)
then
if Bytes_Big_Endian = not Reverse_Storage_Order (Rec) then
Error_Msg_N
("Scalar_Storage_Order High_Order_First is inconsistent with"
& " Bit_Order", ADC);
else
Error_Msg_N
("Scalar_Storage_Order Low_Order_First is inconsistent with"
& " Bit_Order", ADC);
end if;
end if;
-- Deal with Bit_Order aspect specifying a non-default bit order -- Deal with Bit_Order aspect specifying a non-default bit order
if Reverse_Bit_Order (Rec) and then Base_Type (Rec) = Rec then if Reverse_Bit_Order (Rec) and then Base_Type (Rec) = Rec then
......
gcc/ada/sem_attr.adb
...@@ -4442,6 +4442,35 @@ package body Sem_Attr is ...@@ -4442,6 +4442,35 @@ package body Sem_Attr is
Check_Object_Reference (E1); Check_Object_Reference (E1);
Set_Etype (N, Standard_Boolean); Set_Etype (N, Standard_Boolean);
--------------------------
-- Scalar_Storage_Order --
--------------------------
when Attribute_Scalar_Storage_Order => Scalar_Storage_Order :
begin
Check_E0;
Check_Type;
if not Is_Record_Type (P_Type) then
Error_Attr_P ("prefix of % attribute must be record type");
end if;
if Bytes_Big_Endian xor Reverse_Storage_Order (P_Type) then
Rewrite (N,
New_Occurrence_Of (RTE (RE_High_Order_First), Loc));
else
Rewrite (N,
New_Occurrence_Of (RTE (RE_Low_Order_First), Loc));
end if;
Set_Etype (N, RTE (RE_Bit_Order));
Resolve (N);
-- Reset incorrect indication of staticness
Set_Is_Static_Expression (N, False);
end Scalar_Storage_Order;
----------- -----------
-- Scale -- -- Scale --
----------- -----------
...@@ -7963,6 +7992,7 @@ package body Sem_Attr is ...@@ -7963,6 +7992,7 @@ package body Sem_Attr is
Attribute_Priority | Attribute_Priority |
Attribute_Read | Attribute_Read |
Attribute_Result | Attribute_Result |
Attribute_Scalar_Storage_Order |
Attribute_Simple_Storage_Pool | Attribute_Simple_Storage_Pool |
Attribute_Storage_Pool | Attribute_Storage_Pool |
Attribute_Storage_Size | Attribute_Storage_Size |
......
gcc/ada/sem_ch13.adb
...@@ -1064,24 +1064,25 @@ package body Sem_Ch13 is ...@@ -1064,24 +1064,25 @@ package body Sem_Ch13 is
-- Aspects corresponding to attribute definition clauses -- Aspects corresponding to attribute definition clauses
when Aspect_Address | when Aspect_Address |
Aspect_Alignment | Aspect_Alignment |
Aspect_Bit_Order | Aspect_Bit_Order |
Aspect_Component_Size | Aspect_Component_Size |
Aspect_External_Tag | Aspect_External_Tag |
Aspect_Input | Aspect_Input |
Aspect_Machine_Radix | Aspect_Machine_Radix |
Aspect_Object_Size | Aspect_Object_Size |
Aspect_Output | Aspect_Output |
Aspect_Read | Aspect_Read |
Aspect_Size | Aspect_Scalar_Storage_Order |
Aspect_Small | Aspect_Size |
Aspect_Simple_Storage_Pool | Aspect_Small |
Aspect_Storage_Pool | Aspect_Simple_Storage_Pool |
Aspect_Storage_Size | Aspect_Storage_Pool |
Aspect_Stream_Size | Aspect_Storage_Size |
Aspect_Value_Size | Aspect_Stream_Size |
Aspect_Write => Aspect_Value_Size |
Aspect_Write =>
-- Construct the attribute definition clause -- Construct the attribute definition clause
...@@ -2989,6 +2990,40 @@ package body Sem_Ch13 is ...@@ -2989,6 +2990,40 @@ package body Sem_Ch13 is
Analyze_Stream_TSS_Definition (TSS_Stream_Read); Analyze_Stream_TSS_Definition (TSS_Stream_Read);
Set_Has_Specified_Stream_Read (Ent); Set_Has_Specified_Stream_Read (Ent);
--------------------------
-- Scalar_Storage_Order --
--------------------------
-- Scalar_Storage_Order attribute definition clause
when Attribute_Scalar_Storage_Order => Scalar_Storage_Order : declare
begin
if not Is_Record_Type (U_Ent) then
Error_Msg_N
("Scalar_Storage_Order can only be defined for record type",
Nam);
elsif Duplicate_Clause then
null;
else
Analyze_And_Resolve (Expr, RTE (RE_Bit_Order));
if Etype (Expr) = Any_Type then
return;
elsif not Is_Static_Expression (Expr) then
Flag_Non_Static_Expr
("Scalar_Storage_Order requires static expression!", Expr);
else
if (Expr_Value (Expr) = 0) /= Bytes_Big_Endian then
Set_Reverse_Storage_Order (U_Ent, True);
end if;
end if;
end if;
end Scalar_Storage_Order;
---------- ----------
-- Size -- -- Size --
---------- ----------
...@@ -6147,7 +6182,7 @@ package body Sem_Ch13 is ...@@ -6147,7 +6182,7 @@ package body Sem_Ch13 is
when Aspect_Address => when Aspect_Address =>
T := RTE (RE_Address); T := RTE (RE_Address);
when Aspect_Bit_Order => when Aspect_Bit_Order | Aspect_Scalar_Storage_Order =>
T := RTE (RE_Bit_Order); T := RTE (RE_Bit_Order);
when Aspect_CPU => when Aspect_CPU =>
......
gcc/ada/snames.ads-tmpl
...@@ -120,7 +120,7 @@ package Snames is ...@@ -120,7 +120,7 @@ package Snames is
Name_uY : constant Name_Id := First_Name_Id + Character'Pos ('Y'); Name_uY : constant Name_Id := First_Name_Id + Character'Pos ('Y');
Name_uZ : constant Name_Id := First_Name_Id + Character'Pos ('Z'); Name_uZ : constant Name_Id := First_Name_Id + Character'Pos ('Z');
-- Note: the following table is read by the utility program XSNAMES and -- Note: the following table is read by the utility program XSNAMES, and
-- its format should not be changed without coordinating with this program. -- its format should not be changed without coordinating with this program.
N : constant Name_Id := First_Name_Id + 256; N : constant Name_Id := First_Name_Id + 256;
...@@ -826,6 +826,7 @@ package Snames is ...@@ -826,6 +826,7 @@ package Snames is
Name_Safe_Last : constant Name_Id := N + $; Name_Safe_Last : constant Name_Id := N + $;
Name_Safe_Small : constant Name_Id := N + $; -- Ada 83 Name_Safe_Small : constant Name_Id := N + $; -- Ada 83
Name_Same_Storage : constant Name_Id := N + $; -- Ada 12 Name_Same_Storage : constant Name_Id := N + $; -- Ada 12
Name_Scalar_Storage_Order : constant Name_Id := N + $; -- GNAT
Name_Scale : constant Name_Id := N + $; Name_Scale : constant Name_Id := N + $;
Name_Scaling : constant Name_Id := N + $; Name_Scaling : constant Name_Id := N + $;
Name_Signed_Zeros : constant Name_Id := N + $; Name_Signed_Zeros : constant Name_Id := N + $;
...@@ -1387,6 +1388,7 @@ package Snames is ...@@ -1387,6 +1388,7 @@ package Snames is
Attribute_Safe_Last, Attribute_Safe_Last,
Attribute_Safe_Small, Attribute_Safe_Small,
Attribute_Same_Storage, Attribute_Same_Storage,
Attribute_Scalar_Storage_Order,
Attribute_Scale, Attribute_Scale,
Attribute_Scaling, Attribute_Scaling,
Attribute_Signed_Zeros, Attribute_Signed_Zeros,
......
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