[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
This commit is contained in:
Arnaud Charlet
parent
4f6fee0ff2
commit
95cb33a561
|
|
@ -1,3 +1,15 @@
|
|||
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.
|
||||
|
|
|
|||
|
|
@ -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 =>
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -1081,6 +1081,7 @@ begin
|
|||
Pragma_Convention |
|
||||
Pragma_Debug_Policy |
|
||||
Pragma_Detect_Blocking |
|
||||
Pragma_Dimension |
|
||||
Pragma_Discard_Names |
|
||||
Pragma_Eliminate |
|
||||
Pragma_Elaborate |
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
Loading…
Reference in New Issue