Table_Increment => 200,
Table_Name => "IS_Pragma_Settings");
+ ----------------------
+ -- Run-Time Globals --
+ ----------------------
+
+ -- This section documents the global variables that are passed to the
+ -- run time from the generated binder file. The call that is made is
+ -- to the routine Set_Globals, which has the following spec:
+
+ -- procedure Set_Globals
+ -- (Main_Priority : Integer;
+ -- Time_Slice_Value : Integer;
+ -- WC_Encoding : Character;
+ -- Locking_Policy : Character;
+ -- Queuing_Policy : Character;
+ -- Task_Dispatching_Policy : Character;
+ -- Restrictions : System.Address;
+ -- Interrupt_States : System.Address;
+ -- Num_Interrupt_States : Integer;
+ -- Unreserve_All_Interrupts : Integer;
+ -- Exception_Tracebacks : Integer;
+ -- Zero_Cost_Exceptions : Integer);
+
+ -- Main_Priority is the priority value set by pragma Priority in the
+ -- main program. If no such pragma is present, the value is -1.
+
+ -- Time_Slice_Value is the time slice value set by pragma Time_Slice
+ -- in the main program, or by the use of a -Tnnn parameter for the
+ -- binder (if both are present, the binder value overrides). The
+ -- value is in milliseconds. A value of zero indicates that time
+ -- slicing should be suppressed. If no pragma is present, and no
+ -- -T switch was used, the value is -1.
+
+ -- WC_Encoding shows the wide character encoding method used for
+ -- the main program. This is one of the encoding letters defined
+ -- in System.WCh_Con.WC_Encoding_Letters.
+
+ -- Locking_Policy is a space if no locking policy was specified
+ -- for the partition. If a locking policy was specified, the value
+ -- is the upper case first character of the locking policy name,
+ -- for example, 'C' for Ceiling_Locking.
+
+ -- Queuing_Policy is a space if no queuing policy was specified
+ -- for the partition. If a queuing policy was specified, the value
+ -- is the upper case first character of the queuing policy name
+ -- for example, 'F' for FIFO_Queuing.
+
+ -- Task_Dispatching_Policy is a space if no task dispatching policy
+ -- was specified for the partition. If a task dispatching policy
+ -- was specified, the value is the upper case first character of
+ -- the policy name, e.g. 'F' for FIFO_Within_Priorities.
+
+ -- Restrictions is the address of a null-terminated string specifying the
+ -- restrictions information for the partition. The format is identical to
+ -- that of the parameter string found on R lines in ali files (see Lib.Writ
+ -- spec in lib-writ.ads for full details). The difference is that in this
+ -- context the values are the cumulative ones for the entire partition.
+
+ -- Interrupt_States is the address of a string used to specify the
+ -- cumulative results of Interrupt_State pragmas used in the partition.
+ -- The length of this string is determined by the last interrupt for which
+ -- such a pragma is given (the string will be a null string if no pragmas
+ -- were used). If pragma were present the entries apply to the interrupts
+ -- in sequence from the first interrupt, and are set to one of four
+ -- possible settings: 'n' for not specified, 'u' for user, 'r' for
+ -- run time, 's' for system, see description of Interrupt_State pragma
+ -- for further details.
+
+ -- Num_Interrupt_States is the length of the Interrupt_States string.
+ -- It will be set to zero if no Interrupt_State pragmas are present.
+
+ -- Unreserve_All_Interrupts is set to one if at least one unit in the
+ -- partition had a pragma Unreserve_All_Interrupts, and zero otherwise.
+
+ -- Exception_Tracebacks is set to one if the -E parameter was present
+ -- in the bind and to zero otherwise. Note that on some targets exception
+ -- tracebacks are provided by default, so a value of zero for this
+ -- parameter does not necessarily mean no trace backs are available.
+
+ -- Zero_Cost_Exceptions is set to one if zero cost exceptions are used for
+ -- this partition, and to zero if longjmp/setjmp exceptions are used.
+ -- the use of zero
+
-----------------------
-- Local Subprograms --
-----------------------
procedure Gen_Output_File_C (Filename : String);
-- Generate output file (C code case)
+ procedure Gen_Restrictions_String_1;
+ -- Generate first restrictions string, which consists of the parameters
+ -- the first R line, as described in lib-writ.ads, with the restrictions
+ -- being those for the entire partition (from Cumulative_Restrictions).
+
+ procedure Gen_Restrictions_String_2;
+ -- Generate first restrictions string, which consists of the parameters
+ -- the second R line, as described in lib-writ.ads, with the restrictions
+ -- being those for the entire partition (from Cumulative_Restrictions).
+
procedure Gen_Versions_Ada;
-- Output series of definitions for unit versions (Ada code case)
U : Unit_Record renames Units.Table (Unum);
begin
- if U.Set_Elab_Entity and then not U.Interface then
+ -- Check for Elab_Entity to be set for this unit
+
+ if U.Set_Elab_Entity
+
+ -- Don't generate reference for stand alone library
+
+ and then not U.Interface
+
+ -- Don't generate reference for predefined file in No_Run_Time
+ -- mode, since we don't include the object files in this case
+
+ and then not
+ (No_Run_Time_Mode
+ and then Is_Predefined_File_Name (U.Sfile))
+ then
Set_String (" ");
Set_String ("E");
Set_Unit_Number (Unum);
Set_String (" Restrictions : constant String :=");
Write_Statement_Buffer;
- Set_String (" """);
- for J in All_Restrictions loop
- null;
- end loop;
+ Set_String (" """);
+ Gen_Restrictions_String_1;
+ Set_String (""" &");
+ Write_Statement_Buffer;
- Set_String (""";");
+ Set_String (" """);
+ Gen_Restrictions_String_2;
+ Set_String (""" & ASCII.Nul;");
Write_Statement_Buffer;
WBI ("");
declare
Unum : constant Unit_Id := Elab_Order.Table (E);
U : Unit_Record renames Units.Table (Unum);
+
begin
- if U.Set_Elab_Entity and then not U.Interface then
+ -- Check for Elab entity to be set for this unit
+
+ if U.Set_Elab_Entity
+
+ -- Don't generate reference for stand alone library
+
+ and then not U.Interface
+
+ -- Don't generate reference for predefined file in No_Run_Time
+ -- mode, since we don't include the object files in this case
+
+ and then not
+ (No_Run_Time_Mode
+ and then Is_Predefined_File_Name (U.Sfile))
+ then
Set_String (" extern char ");
Get_Name_String (U.Uname);
Set_Unit_Name;
-- Generate definition for restrictions string
Set_String (" const char *restrictions = """);
-
- for J in All_Restrictions loop
- null;
- end loop;
-
+ Gen_Restrictions_String_1;
+ Gen_Restrictions_String_2;
Set_String (""";");
Write_Statement_Buffer;
Unum_Spec := Unum;
end if;
+ -- Nothing to do if predefined unit in no run time mode
+
+ if No_Run_Time_Mode and then Is_Predefined_File_Name (U.Sfile) then
+ null;
+
-- Case of no elaboration code
- if U.No_Elab then
+ elsif U.No_Elab then
-- The only case in which we have to do something is if
-- this is a body, with a separate spec, where the separate
procedure Gen_Elab_Calls_C is
begin
-
for E in Elab_Order.First .. Elab_Order.Last loop
declare
Unum : constant Unit_Id := Elab_Order.Table (E);
Unum_Spec := Unum;
end if;
+ -- Nothing to do if predefined unit in no run time mode
+
+ if No_Run_Time_Mode and then Is_Predefined_File_Name (U.Sfile) then
+ null;
+
-- Case of no elaboration code
- if U.No_Elab then
+ elsif U.No_Elab then
-- The only case in which we have to do something is if
-- this is a body, with a separate spec, where the separate
or else GNAT.OS_Lib.Is_Regular_File (Name_Buffer (1 .. Name_Len))
then
Write_Info_Ada_C (" -- ", "", Name_Buffer (1 .. Name_Len));
+
if Output_Object_List then
Write_Str (Name_Buffer (1 .. Name_Len));
Write_Eol;
procedure Gen_Output_File (Filename : String) is
Is_Public_Version : constant Boolean := Get_Gnat_Build_Type = Public;
+ Is_GAP_Version : constant Boolean := Get_Gnat_Build_Type = GAP;
begin
-- Acquire settings for Interrupt_State pragmas
-- Get the time stamp of the former bind for public version warning
- if Is_Public_Version then
+ if Is_Public_Version or Is_GAP_Version then
Record_Time_From_Last_Bind;
end if;
Close_Binder_Output;
end Gen_Output_File_C;
+ -------------------------------
+ -- Gen_Restrictions_String_1 --
+ -------------------------------
+
+ procedure Gen_Restrictions_String_1 is
+ begin
+ for R in All_Boolean_Restrictions loop
+ if Cumulative_Restrictions.Set (R) then
+ Set_Char ('r');
+ elsif Cumulative_Restrictions.Violated (R) then
+ Set_Char ('v');
+ else
+ Set_Char ('n');
+ end if;
+ end loop;
+ end Gen_Restrictions_String_1;
+
+ -------------------------------
+ -- Gen_Restrictions_String_2 --
+ -------------------------------
+
+ procedure Gen_Restrictions_String_2 is
+ begin
+ for RP in All_Parameter_Restrictions loop
+ if Cumulative_Restrictions.Set (RP) then
+ Set_Char ('r');
+ Set_Int (Int (Cumulative_Restrictions.Value (RP)));
+ else
+ Set_Char ('n');
+ end if;
+
+ if not Cumulative_Restrictions.Violated (RP)
+ or else RP not in Checked_Parameter_Restrictions
+ then
+ Set_Char ('n');
+ else
+ Set_Char ('v');
+ Set_Int (Int (Cumulative_Restrictions.Count (RP)));
+
+ if Cumulative_Restrictions.Unknown (RP) then
+ Set_Char ('+');
+ end if;
+ end if;
+ end loop;
+ end Gen_Restrictions_String_2;
+
----------------------
-- Gen_Versions_Ada --
----------------------
---------------------
procedure Set_Unit_Number (U : Unit_Id) is
- Num_Units : constant Nat := Nat (Units.Table'Last) - Nat (Unit_Id'First);
+ Num_Units : constant Nat := Nat (Units.Last) - Nat (Unit_Id'First);
Unum : constant Nat := Nat (U) - Nat (Unit_Id'First);
begin
OSDN Git Service
