Commit 5c52bf3b by Arnaud Charlet

[multiple changes]

2010-06-22  Thomas Quinot  <quinot@adacore.com>

	* exp_attr.adb, lib-writ.ads, bindgen.adb: Minor reformatting.
	* einfo.adb (Related_Expression, Set_Related_Expression): Add
	assertions.

2010-06-22  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Add_Internal_Interface_Entities): Minor code
	reorganization to properly check if the operation has been inherited as
	an abstract operation.

2010-06-22  Ed Falis  <falis@adacore.com>

	* s-osinte-vxworks.ads: Complete previous change.

From-SVN: r161159
parent be5a1b93
2010-06-22 Thomas Quinot <quinot@adacore.com> 2010-06-22 Thomas Quinot <quinot@adacore.com>
* exp_attr.adb, lib-writ.ads, bindgen.adb: Minor reformatting.
* einfo.adb (Related_Expression, Set_Related_Expression): Add
assertions.
2010-06-22 Javier Miranda <miranda@adacore.com>
* sem_ch3.adb (Add_Internal_Interface_Entities): Minor code
reorganization to properly check if the operation has been inherited as
an abstract operation.
2010-06-22 Ed Falis <falis@adacore.com>
* s-osinte-vxworks.ads: Complete previous change.
2010-06-22 Thomas Quinot <quinot@adacore.com>
* sem_res.adb: Add comment. * sem_res.adb: Add comment.
* projects.texi, gnat_ugn.texi: Remove macro. * projects.texi, gnat_ugn.texi: Remove macro.
......
...@@ -1942,8 +1942,8 @@ package body Bindgen is ...@@ -1942,8 +1942,8 @@ package body Bindgen is
for E in Elab_Order.First .. Elab_Order.Last loop for E in Elab_Order.First .. Elab_Order.Last loop
-- If not spec that has an associated body, then generate a -- If not spec that has an associated body, then generate a comment
-- comment giving the name of the corresponding object file. -- giving the name of the corresponding object file.
if (not Units.Table (Elab_Order.Table (E)).SAL_Interface) if (not Units.Table (Elab_Order.Table (E)).SAL_Interface)
and then Units.Table (Elab_Order.Table (E)).Utype /= Is_Spec and then Units.Table (Elab_Order.Table (E)).Utype /= Is_Spec
...@@ -1952,8 +1952,8 @@ package body Bindgen is ...@@ -1952,8 +1952,8 @@ package body Bindgen is
(ALIs.Table (ALIs.Table
(Units.Table (Elab_Order.Table (E)).My_ALI).Ofile_Full_Name); (Units.Table (Elab_Order.Table (E)).My_ALI).Ofile_Full_Name);
-- If the presence of an object file is necessary or if it -- If the presence of an object file is necessary or if it exists,
-- exists, then use it. -- then use it.
if not Hostparm.Exclude_Missing_Objects if not Hostparm.Exclude_Missing_Objects
or else or else
...@@ -1975,8 +1975,7 @@ package body Bindgen is ...@@ -1975,8 +1975,7 @@ package body Bindgen is
(ALIs.Table (ALIs.Table
(Units.Table (Elab_Order.Table (E)).My_ALI).Sfile) (Units.Table (Elab_Order.Table (E)).My_ALI).Sfile)
then then
-- Special case for g-trasym.obj, which is not included -- Special case for g-trasym.obj (not included in libgnat)
-- in libgnat.
Get_Name_String (ALIs.Table Get_Name_String (ALIs.Table
(Units.Table (Elab_Order.Table (E)).My_ALI).Sfile); (Units.Table (Elab_Order.Table (E)).My_ALI).Sfile);
...@@ -2010,38 +2009,36 @@ package body Bindgen is ...@@ -2010,38 +2009,36 @@ package body Bindgen is
-- This sort accomplishes two important purposes: -- This sort accomplishes two important purposes:
-- a) All application files are sorted to the front, and all -- a) All application files are sorted to the front, and all GNAT
-- GNAT internal files are sorted to the end. This results -- internal files are sorted to the end. This results in a well
-- in a well defined dividing line between the two sets of -- defined dividing line between the two sets of files, for the
-- files, for the purpose of inserting certain standard -- purpose of inserting certain standard library references into
-- library references into the linker arguments list. -- the linker arguments list.
-- b) Given two different units, we sort the linker options so -- b) Given two different units, we sort the linker options so that
-- that those from a unit earlier in the elaboration order -- those from a unit earlier in the elaboration order comes later
-- comes later in the list. This is a heuristic designed -- in the list. This is a heuristic designed to create a more
-- to create a more friendly order of linker options when -- friendly order of linker options when the operations appear in
-- the operations appear in separate units. The idea is that -- separate units. The idea is that if unit A must be elaborated
-- if unit A must be elaborated before unit B, then it is -- before unit B, then it is more likely that B references
-- more likely that B references libraries included by A, -- libraries included by A, than vice versa, so we want libraries
-- than vice versa, so we want the libraries included by -- included by A to come after libraries included by B.
-- A to come after the libraries included by B.
-- These two criteria are implemented by function Lt_Linker_Option. Note
-- These two criteria are implemented by function Lt_Linker_Option. -- that a special case of b) is that specs are elaborated before bodies,
-- Note that a special case of b) is that specs are elaborated before -- so linker options from specs come after linker options for bodies,
-- bodies, so linker options from specs come after linker options -- and again, the assumption is that libraries used by the body are more
-- for bodies, and again, the assumption is that libraries used by -- likely to reference libraries used by the spec, than vice versa.
-- the body are more likely to reference libraries used by the spec,
-- than vice versa.
Sort Sort
(Linker_Options.Last, (Linker_Options.Last,
Move_Linker_Option'Access, Move_Linker_Option'Access,
Lt_Linker_Option'Access); Lt_Linker_Option'Access);
-- Write user linker options, i.e. the set of linker options that -- Write user linker options, i.e. the set of linker options that come
-- come from all files other than GNAT internal files, Lgnat is -- from all files other than GNAT internal files, Lgnat is left set to
-- left set to point to the first entry from a GNAT internal file, -- point to the first entry from a GNAT internal file, or past the end
-- or past the end of the entriers if there are no internal files. -- of the entriers if there are no internal files.
Lgnat := Linker_Options.Last + 1; Lgnat := Linker_Options.Last + 1;
...@@ -2145,9 +2142,9 @@ package body Bindgen is ...@@ -2145,9 +2142,9 @@ package body Bindgen is
Set_PSD_Pragma_Table; Set_PSD_Pragma_Table;
-- Override Ada_Bind_File and Bind_Main_Program for VMs since -- Override Ada_Bind_File and Bind_Main_Program for VMs since JGNAT only
-- JGNAT only supports Ada code, and the main program is already -- supports Ada code, and the main program is already generated by the
-- generated by the compiler. -- compiler.
if VM_Target /= No_VM then if VM_Target /= No_VM then
Ada_Bind_File := True; Ada_Bind_File := True;
...@@ -2279,8 +2276,7 @@ package body Bindgen is ...@@ -2279,8 +2276,7 @@ package body Bindgen is
WBI (" gnat_envp : System.Address;"); WBI (" gnat_envp : System.Address;");
-- If the standard library is not suppressed, these variables -- If the standard library is not suppressed, these variables
-- are in the runtime data area for easy access from the -- are in the run-time data area for easy run time access.
-- runtime.
if not Suppress_Standard_Library_On_Target then if not Suppress_Standard_Library_On_Target then
WBI (""); WBI ("");
...@@ -2475,8 +2471,8 @@ package body Bindgen is ...@@ -2475,8 +2471,8 @@ package body Bindgen is
if not Cumulative_Restrictions.Set (No_Finalization) then if not Cumulative_Restrictions.Set (No_Finalization) then
-- In the Java case, pragma Import C cannot be used, so the -- In the Java case, pragma Import C cannot be used, so the standard
-- standard Ada constructs will be used instead. -- Ada constructs will be used instead.
if VM_Target = No_VM then if VM_Target = No_VM then
WBI (""); WBI ("");
...@@ -2631,8 +2627,8 @@ package body Bindgen is ...@@ -2631,8 +2627,8 @@ package body Bindgen is
WBI ("extern void __gnat_stack_usage_initialize (int size);"); WBI ("extern void __gnat_stack_usage_initialize (int size);");
end if; end if;
-- Initialize stack limit for the environment task if the stack -- Initialize stack limit for the environment task if the stack check
-- check method is stack limit and stack check is enabled. -- method is stack limit and stack check is enabled.
if Stack_Check_Limits_On_Target if Stack_Check_Limits_On_Target
and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set) and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set)
...@@ -2666,8 +2662,8 @@ package body Bindgen is ...@@ -2666,8 +2662,8 @@ package body Bindgen is
if Bind_Main_Program then if Bind_Main_Program then
-- First deal with argc/argv/envp. In the normal case they -- First deal with argc/argv/envp. In the normal case they are in the
-- are in the run-time library. -- run-time library.
if not Configurable_Run_Time_On_Target then if not Configurable_Run_Time_On_Target then
WBI ("extern int gnat_argc;"); WBI ("extern int gnat_argc;");
...@@ -2680,8 +2676,8 @@ package body Bindgen is ...@@ -2680,8 +2676,8 @@ package body Bindgen is
elsif not Command_Line_Args_On_Target then elsif not Command_Line_Args_On_Target then
null; null;
-- Otherwise, in the configurable run-time case they are right in -- Otherwise, in the configurable run-time case they are right in the
-- the binder file. -- binder file.
else else
WBI ("int gnat_argc;"); WBI ("int gnat_argc;");
...@@ -2694,8 +2690,8 @@ package body Bindgen is ...@@ -2694,8 +2690,8 @@ package body Bindgen is
if not Configurable_Run_Time_On_Target then if not Configurable_Run_Time_On_Target then
WBI ("extern int gnat_exit_status;"); WBI ("extern int gnat_exit_status;");
-- If configurable run time and no exit status on target, then -- If configurable run time and no exit status on target, then the
-- the generation of this variables is entirely suppressed. -- generation of this variables is entirely suppressed.
elsif not Exit_Status_Supported_On_Target then elsif not Exit_Status_Supported_On_Target then
null; null;
...@@ -2710,9 +2706,8 @@ package body Bindgen is ...@@ -2710,9 +2706,8 @@ package body Bindgen is
WBI (""); WBI ("");
end if; end if;
-- When suppressing the standard library, the __gnat_break_start -- When suppressing the standard library, the __gnat_break_start routine
-- routine (for the debugger to get initial control) is defined in -- (for the debugger to get initial control) is defined in this file.
-- this file.
if Suppress_Standard_Library_On_Target then if Suppress_Standard_Library_On_Target then
WBI (""); WBI ("");
...@@ -2736,8 +2731,8 @@ package body Bindgen is ...@@ -2736,8 +2731,8 @@ package body Bindgen is
Write_Statement_Buffer; Write_Statement_Buffer;
end if; end if;
-- Generate the adafinal routine. In no runtime mode, this is -- Generate the adafinal routine. In no runtime mode, this is not
-- not needed, since there is no finalization to do. -- needed, since there is no finalization to do.
if not Cumulative_Restrictions.Set (No_Finalization) then if not Cumulative_Restrictions.Set (No_Finalization) then
Gen_Adafinal_C; Gen_Adafinal_C;
...@@ -2982,9 +2977,9 @@ package body Bindgen is ...@@ -2982,9 +2977,9 @@ package body Bindgen is
-- unnnnn : constant Integer := 16#hhhhhhhh#; -- unnnnn : constant Integer := 16#hhhhhhhh#;
-- pragma Export (C, unnnnn, unam); -- pragma Export (C, unnnnn, unam);
-- for each unit, where unam is the unit name suffixed by either B or -- for each unit, where unam is the unit name suffixed by either B or S for
-- S for body or spec, with dots replaced by double underscores, and -- body or spec, with dots replaced by double underscores, and hhhhhhhh is
-- hhhhhhhh is the version number, and nnnnn is a 5-digits serial number. -- the version number, and nnnnn is a 5-digits serial number.
procedure Gen_Versions_Ada is procedure Gen_Versions_Ada is
Ubuf : String (1 .. 6) := "u00000"; Ubuf : String (1 .. 6) := "u00000";
...@@ -3054,8 +3049,8 @@ package body Bindgen is ...@@ -3054,8 +3049,8 @@ package body Bindgen is
-- unsigned unam = 0xhhhhhhhh; -- unsigned unam = 0xhhhhhhhh;
-- for each unit, where unam is the unit name suffixed by either B or -- for each unit, where unam is the unit name suffixed by either B or S for
-- S for body or spec, with dots replaced by double underscores. -- body or spec, with dots replaced by double underscores.
procedure Gen_Versions_C is procedure Gen_Versions_C is
begin begin
...@@ -3193,9 +3188,9 @@ package body Bindgen is ...@@ -3193,9 +3188,9 @@ package body Bindgen is
Get_Name_String (Units.Table (First_Unit_Entry).Uname); Get_Name_String (Units.Table (First_Unit_Entry).Uname);
-- If this is a child name, return only the name of the child, -- If this is a child name, return only the name of the child, since
-- since we can't have dots in a nested program name. Note that -- we can't have dots in a nested program name. Note that we do not
-- we do not include the %b at the end of the unit name. -- include the %b at the end of the unit name.
for J in reverse 1 .. Name_Len - 2 loop for J in reverse 1 .. Name_Len - 2 loop
if J = 1 or else Name_Buffer (J - 1) = '.' then if J = 1 or else Name_Buffer (J - 1) = '.' then
...@@ -3227,12 +3222,12 @@ package body Bindgen is ...@@ -3227,12 +3222,12 @@ package body Bindgen is
-- no better choice. If some other encoding is required when there is -- no better choice. If some other encoding is required when there is
-- no main, it must be set explicitly using -Wx. -- no main, it must be set explicitly using -Wx.
-- Note: if the ALI file always passed the wide character encoding -- Note: if the ALI file always passed the wide character encoding of
-- of every file, then we could use the encoding of the initial -- every file, then we could use the encoding of the initial specified
-- specified file, but this information is passed only for potential -- file, but this information is passed only for potential main
-- main programs. We could fix this sometime, but it is a very minor -- programs. We could fix this sometime, but it is a very minor point
-- point (wide character default encoding for [Wide_[Wide_]Text_IO -- (wide character default encoding for [Wide_[Wide_]Text_IO when there
-- when there is no main program). -- is no main program).
elsif No_Main_Subprogram then elsif No_Main_Subprogram then
return 'b'; return 'b';
...@@ -3263,8 +3258,8 @@ package body Bindgen is ...@@ -3263,8 +3258,8 @@ package body Bindgen is
Linker_Options.Table (Op2).Internal_File; Linker_Options.Table (Op2).Internal_File;
-- If both internal or both non-internal, sort according to the -- If both internal or both non-internal, sort according to the
-- elaboration position. A unit that is elaborated later should -- elaboration position. A unit that is elaborated later should come
-- come earlier in the linker options list. -- earlier in the linker options list.
else else
return Units.Table (Linker_Options.Table (Op1).Unit).Elab_Position return Units.Table (Linker_Options.Table (Op1).Unit).Elab_Position
...@@ -3293,9 +3288,9 @@ package body Bindgen is ...@@ -3293,9 +3288,9 @@ package body Bindgen is
Get_Name_String (Units.Table (Elab_Order.Table (E)).Uname); Get_Name_String (Units.Table (Elab_Order.Table (E)).Uname);
-- This is not a perfect approach, but is the current protocol -- This is not a perfect approach, but is the current protocol
-- between the run-time and the binder to indicate that tasking -- between the run-time and the binder to indicate that tasking is
-- is used: system.os_interface should always be used by any -- used: system.os_interface should always be used by any tasking
-- tasking application. -- application.
if Name_Buffer (1 .. 19) = "system.os_interface" then if Name_Buffer (1 .. 19) = "system.os_interface" then
With_GNARL := True; With_GNARL := True;
......
...@@ -2434,7 +2434,7 @@ package body Einfo is ...@@ -2434,7 +2434,7 @@ package body Einfo is
function Related_Expression (Id : E) return N is function Related_Expression (Id : E) return N is
begin begin
pragma Assert (Is_Type (Id) pragma Assert (Ekind (Id) in Type_Kind
or else Ekind_In (Id, E_Constant, E_Variable)); or else Ekind_In (Id, E_Constant, E_Variable));
return Node24 (Id); return Node24 (Id);
end Related_Expression; end Related_Expression;
...@@ -4893,6 +4893,8 @@ package body Einfo is ...@@ -4893,6 +4893,8 @@ package body Einfo is
procedure Set_Related_Expression (Id : E; V : N) is procedure Set_Related_Expression (Id : E; V : N) is
begin begin
pragma Assert (Ekind (Id) in Type_Kind
or else Ekind_In (Id, E_Constant, E_Variable, E_Void));
Set_Node24 (Id, V); Set_Node24 (Id, V);
end Set_Related_Expression; end Set_Related_Expression;
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, 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- --
...@@ -1257,8 +1257,8 @@ package body Exp_Attr is ...@@ -1257,8 +1257,8 @@ package body Exp_Attr is
-- subprogram spec or package. This sequence of code references the -- subprogram spec or package. This sequence of code references the
-- the unsigned constant created in the main program by the binder. -- the unsigned constant created in the main program by the binder.
-- A special exception occurs for Standard, where the string -- A special exception occurs for Standard, where the string returned
-- returned is a copy of the library string in gnatvsn.ads. -- is a copy of the library string in gnatvsn.ads.
when Attribute_Body_Version | Attribute_Version => Version : declare when Attribute_Body_Version | Attribute_Version => Version : declare
E : constant Entity_Id := Make_Temporary (Loc, 'V'); E : constant Entity_Id := Make_Temporary (Loc, 'V');
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- -- Copyright (C) 1992-2010, 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- --
...@@ -610,8 +610,8 @@ package Lib.Writ is ...@@ -610,8 +610,8 @@ package Lib.Writ is
--------------------- ---------------------
-- The reference lines contain information about references from any of the -- The reference lines contain information about references from any of the
-- units in the compilation (including, body version and version -- units in the compilation (including body version and version attributes,
-- attributes, linker options pragmas and source dependencies. -- linker options pragmas and source dependencies).
-- ------------------------------------ -- ------------------------------------
-- -- E External Version References -- -- -- E External Version References --
...@@ -696,7 +696,7 @@ package Lib.Writ is ...@@ -696,7 +696,7 @@ package Lib.Writ is
-- reference data. See the spec of Par_SCO for full details of the format. -- reference data. See the spec of Par_SCO for full details of the format.
---------------------- ----------------------
-- Global_Variables -- -- Global variables --
---------------------- ----------------------
-- The table structure defined here stores one entry for each -- The table structure defined here stores one entry for each
......
...@@ -155,7 +155,7 @@ package System.OS_Interface is ...@@ -155,7 +155,7 @@ package System.OS_Interface is
SIG_DFL : constant := 0; SIG_DFL : constant := 0;
SIG_IGN : constant := 1; SIG_IGN : constant := 1;
subtype sigset_t is System.VxWorks.Ext.sigset_t; type sigset_t is private;
type struct_sigaction is record type struct_sigaction is record
sa_handler : System.Address; sa_handler : System.Address;
...@@ -497,4 +497,5 @@ private ...@@ -497,4 +497,5 @@ private
type clockid_t is new int; type clockid_t is new int;
CLOCK_REALTIME : constant clockid_t := 0; CLOCK_REALTIME : constant clockid_t := 0;
type sigset_t is new System.VxWorks.Ext.sigset_t;
end System.OS_Interface; end System.OS_Interface;
...@@ -1567,16 +1567,16 @@ package body Sem_Ch3 is ...@@ -1567,16 +1567,16 @@ package body Sem_Ch3 is
and then Alias (Prim) = Iface_Prim; and then Alias (Prim) = Iface_Prim;
Next_Elmt (El); Next_Elmt (El);
end loop; end loop;
end;
end if;
-- If the operation was not explicitly overridden, it should -- If the operation was not explicitly overridden, it
-- have been inherited as an abstract operation so Prim can -- should have been inherited as an abstract operation
-- not be Empty at this stage. -- so Prim can not be Empty at this stage.
if No (Prim) then if No (El) then
raise Program_Error; raise Program_Error;
end if; end if;
end;
end if;
Derive_Subprogram Derive_Subprogram
(New_Subp => New_Subp, (New_Subp => New_Subp,
......
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