Skip to content

R
riscv-gcc-1
Commit 95cb33a5 by Arnaud Charlet
Options

[multiple changes] 

2010-01-27  Vincent Celier  <celier@adacore.com>

	* gnatcmd.adb: When there is only one main specified, the package
	support Switches (<main>) and attribute Switches is specified for the
	main, use these switches, instead of Default_Switches ("Ada").

2010-01-27  Robert Dewar  <dewar@adacore.com>

	* sem_prag.adb, par-prag.adb, snames.ads-tmpl: pragma Dimension initial
	implementation.
	* exp_disp.adb: Minor reformatting

From-SVN: r156283
parent 4f6fee0f
Showing with 89 additions and 23 deletions
gcc/ada/ChangeLog
2010-01-27 Vincent Celier <celier@adacore.com>
* gnatcmd.adb: When there is only one main specified, the package
support Switches (<main>) and attribute Switches is specified for the
main, use these switches, instead of Default_Switches ("Ada").
2010-01-27 Robert Dewar <dewar@adacore.com>
* sem_prag.adb, par-prag.adb, snames.ads-tmpl: pragma Dimension initial
implementation.
* exp_disp.adb: Minor reformatting
2010-01-27 Tristan Gingold <gingold@adacore.com>
* seh_init.c: Use __ImageBase instead of _ImageBase.
......
gcc/ada/exp_disp.adb
......@@ -1443,11 +1443,11 @@ package body Exp_Disp is
Thunk_Id : out Entity_Id;
Thunk_Code : out Node_Id)
is
Loc : constant Source_Ptr := Sloc (Prim);
Actuals : constant List_Id := New_List;
Decl : constant List_Id := New_List;
Formals : constant List_Id := New_List;
Target : constant Entity_Id := Ultimate_Alias (Prim);
Loc : constant Source_Ptr := Sloc (Prim);
Actuals : constant List_Id := New_List;
Decl : constant List_Id := New_List;
Formals : constant List_Id := New_List;
Target : constant Entity_Id := Ultimate_Alias (Prim);
Controlling_Typ : Entity_Id;
Decl_1 : Node_Id;
......@@ -1464,8 +1464,8 @@ package body Exp_Disp is
Thunk_Id := Empty;
Thunk_Code := Empty;
-- In case of primitives that are functions without formals and
-- a controlling result there is no need to build the thunk.
-- In case of primitives that are functions without formals and a
-- controlling result there is no need to build the thunk.
if not Present (First_Formal (Target)) then
pragma Assert (Ekind (Target) = E_Function
......@@ -1477,8 +1477,8 @@ package body Exp_Disp is
-- of the controlling formal is the covered interface type (instead of
-- the target tagged type). Done to avoid problems with discriminated
-- tagged types because, if the controlling type has discriminants with
-- default values, then the type conversions done inside the body of the
-- thunk (after the displacement of the pointer to the base of the
-- default values, then the type conversions done inside the body of
-- the thunk (after the displacement of the pointer to the base of the
-- actual object) generate code that modify its contents.
-- Note: This special management is not done for predefined primitives
......@@ -1493,7 +1493,7 @@ package body Exp_Disp is
Ftyp := Etype (Formal);
-- Use the interface type as the type of the controlling formal (see
-- comment above)
-- comment above).
if not Is_Controlling_Formal (Formal)
or else Is_Predefined_Dispatching_Operation (Prim)
......@@ -1547,7 +1547,6 @@ package body Exp_Disp is
and then Ftyp = Controlling_Typ
then
-- Generate:
-- type T is access all <<type of the target formal>>
-- S : Storage_Offset := Storage_Offset!(Formal)
-- - Offset_To_Top (address!(Formal))
......@@ -1608,8 +1607,8 @@ package body Exp_Disp is
New_Reference_To (Defining_Identifier (Decl_1), Loc)));
elsif Ftyp = Controlling_Typ then
-- Generate:
-- Generate:
-- S1 : Storage_Offset := Storage_Offset!(Formal'Address)
-- - Offset_To_Top (Formal'Address)
-- S2 : Addr_Ptr := Addr_Ptr!(S1)
......@@ -1690,6 +1689,8 @@ package body Exp_Disp is
Set_Is_Thunk (Thunk_Id);
-- Procedure case
if Ekind (Target) = E_Procedure then
Thunk_Code :=
Make_Subprogram_Body (Loc,
......@@ -1705,8 +1706,9 @@ package body Exp_Disp is
Name => New_Occurrence_Of (Target, Loc),
Parameter_Associations => Actuals))));
else pragma Assert (Ekind (Target) = E_Function);
-- Function case
else pragma Assert (Ekind (Target) = E_Function);
Thunk_Code :=
Make_Subprogram_Body (Loc,
Specification =>
......
gcc/ada/gnatcmd.adb
......@@ -1807,12 +1807,14 @@ begin
Element : Package_Element;
Default_Switches_Array : Array_Element_Id;
Switches_Array : Array_Element_Id;
The_Switches : Prj.Variable_Value;
Current : Prj.String_List_Id;
The_String : String_Element;
Main : String_Access := null;
begin
if Pkg /= No_Package then
Element := Project_Tree.Packages.Table (Pkg);
......@@ -1838,8 +1840,37 @@ begin
-- name of the programming language.
else
-- First check if there is a single main
for J in 1 .. Last_Switches.Last loop
if Last_Switches.Table (J) (1) /= '-' then
if Main = null then
Main := Last_Switches.Table (J);
else
Main := null;
exit;
end if;
end if;
end loop;
if Main /= null then
Switches_Array :=
Prj.Util.Value_Of
(Name => Name_Switches,
In_Arrays => Element.Decl.Arrays,
In_Tree => Project_Tree);
Name_Len := 0;
Add_Str_To_Name_Buffer (Main.all);
The_Switches := Prj.Util.Value_Of
(Index => Name_Find,
Src_Index => 0,
In_Array => Switches_Array,
In_Tree => Project_Tree);
end if;
if The_Switches.Kind = Prj.Undefined then
Default_Switches_Array :=
Switches_Array :=
Prj.Util.Value_Of
(Name => Name_Default_Switches,
In_Arrays => Element.Decl.Arrays,
......@@ -1847,7 +1878,7 @@ begin
The_Switches := Prj.Util.Value_Of
(Index => Name_Ada,
Src_Index => 0,
In_Array => Default_Switches_Array,
In_Array => Switches_Array,
In_Tree => Project_Tree);
end if;
end if;
......
gcc/ada/par-prag.adb
......@@ -1081,6 +1081,7 @@ begin
Pragma_Convention |
Pragma_Debug_Policy |
Pragma_Detect_Blocking |
Pragma_Dimension |
Pragma_Discard_Names |
Pragma_Eliminate |
Pragma_Elaborate |
......
gcc/ada/sem_prag.adb
......@@ -6490,6 +6490,24 @@ package body Sem_Prag is
Check_Valid_Configuration_Pragma;
Detect_Blocking := True;
---------------
-- Dimension --
---------------
when Pragma_Dimension =>
GNAT_Pragma;
Check_Arg_Count (4);
Check_No_Identifiers;
Check_Arg_Is_Local_Name (Arg1);
if not Is_Type (Arg1) then
Error_Pragma ("first argument for pragma% must be subtype");
end if;
Check_Arg_Is_Static_Expression (Arg2, Standard_Integer);
Check_Arg_Is_Static_Expression (Arg3, Standard_Integer);
Check_Arg_Is_Static_Expression (Arg4, Standard_Integer);
-------------------
-- Discard_Names --
-------------------
......@@ -12450,14 +12468,13 @@ package body Sem_Prag is
-----------------------------------------
-- This function makes use of the following static table which indicates
-- whether a given pragma is significant. A value of -1 in this table
-- indicates that the reference is significant. A value of zero indicates
-- than appearance as any argument is insignificant, a positive value
-- indicates that appearance in that parameter position is significant.
-- whether a given pragma is significant.
-- A value of 99 flags a special case requiring a special check (this is
-- used for cases not covered by this standard encoding, e.g. pragma Check
-- where the first argument is not significant, but the others are).
-- -1 indicates that references in any argument position are significant
-- 0 indicates that appearence in any argument is not significant
-- +n indicates that appearence as argument n is significant, but all
-- other arguments are not significant
-- 99 special processing required (e.g. for pragma Check)
Sig_Flags : constant array (Pragma_Id) of Int :=
(Pragma_AST_Entry => -1,
......@@ -12498,6 +12515,7 @@ package body Sem_Prag is
Pragma_Debug => -1,
Pragma_Debug_Policy => 0,
Pragma_Detect_Blocking => -1,
Pragma_Dimension => -1,
Pragma_Discard_Names => 0,
Pragma_Elaborate => -1,
Pragma_Elaborate_All => -1,
......
gcc/ada/snames.ads-tmpl
......@@ -428,6 +428,7 @@ package Snames is
Name_CPP_Virtual : constant Name_Id := N + $; -- GNAT
Name_CPP_Vtable : constant Name_Id := N + $; -- GNAT
Name_Debug : constant Name_Id := N + $; -- GNAT
Name_Dimension : constant Name_Id := N + $; -- GNAT
Name_Elaborate : constant Name_Id := N + $; -- Ada 83
Name_Elaborate_All : constant Name_Id := N + $;
Name_Elaborate_Body : constant Name_Id := N + $;
......@@ -1494,6 +1495,7 @@ package Snames is
Pragma_CPP_Virtual,
Pragma_CPP_Vtable,
Pragma_Debug,
Pragma_Dimension,
Pragma_Elaborate,
Pragma_Elaborate_All,
Pragma_Elaborate_Body,
......
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