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;
+ -- Detect_Blocking : 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
+
+ -- Detect_Blocking indicates whether pragma Detect_Blocking is
+ -- active or not. A value of zero indicates that the pragma is not
+ -- present, while a value of 1 signals its presence in the
+ -- partition.
+
-----------------------
-- Local Subprograms --
-----------------------
-- Set given character in Statement_Buffer at the Last + 1 position
-- and increment Last by one to reflect the stored character.
+ procedure Set_EA_Last;
+ -- Output the number of elements in array EA
+
procedure Set_Int (N : Int);
-- Set given value in decimal in Statement_Buffer with no spaces
-- starting at the Last + 1 position, and updating Last past the value.
if Hostparm.Java_VM then
WBI (" System.Standard_Library.Adafinal;");
+
+ -- If there is no finalization, there is nothing to do
+
+ elsif Cumulative_Restrictions.Set (No_Finalization) then
+ WBI (" null;");
else
WBI (" Do_Finalize;");
end if;
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);
WBI (" Locking_Policy : Character;");
WBI (" Queuing_Policy : Character;");
WBI (" Task_Dispatching_Policy : Character;");
+
WBI (" Restrictions : System.Address;");
WBI (" Interrupt_States : System.Address;");
WBI (" Num_Interrupt_States : Integer;");
WBI (" Unreserve_All_Interrupts : Integer;");
WBI (" Exception_Tracebacks : Integer;");
- WBI (" Zero_Cost_Exceptions : Integer);");
+ WBI (" Zero_Cost_Exceptions : Integer;");
+ WBI (" Detect_Blocking : Integer);");
WBI (" pragma Import (C, Set_Globals, ""__gnat_set_globals"");");
-- Import entry point for elaboration time signal handler
Set_String ("0");
end if;
+ Set_String (",");
+ Write_Statement_Buffer;
+
+ Set_String (" Detect_Blocking => ");
+
+ if Detect_Blocking then
+ Set_Int (1);
+ else
+ Set_Int (0);
+ end if;
+
Set_String (");");
Write_Statement_Buffer;
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;
Set_String (" ");
Set_Int (Boolean'Pos (Zero_Cost_Exceptions_Specified));
- Set_String (");");
+ Set_String (",");
Tab_To (24);
Set_String ("/* Zero_Cost_Exceptions */");
Write_Statement_Buffer;
+
+ Set_String (" ");
+
+ if Detect_Blocking then
+ Set_Int (1);
+ else
+ Set_Int (0);
+ end if;
+
+ Set_String (");");
+ Tab_To (24);
+ Set_String ("/* Detect_Blocking */");
+ Write_Statement_Buffer;
WBI ("");
-- Install elaboration time signal handler
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
Set_String (") of System.Address := (");
if Num = 1 then
- Set_String ("1 => A1);");
- Write_Statement_Buffer;
+ Set_String ("1 => ");
else
Write_Statement_Buffer;
+ end if;
- for A in ALIs.First .. ALIs.Last loop
- if not ALIs.Table (A).Interface
- and then ALIs.Table (A).Unit_Exception_Table
- then
- Get_Decoded_Name_String_With_Brackets
- (Units.Table (ALIs.Table (A).First_Unit).Uname);
- Set_Casing (Mixed_Case);
+ for A in ALIs.First .. ALIs.Last loop
+ if not ALIs.Table (A).Interface
+ and then ALIs.Table (A).Unit_Exception_Table
+ then
+ Get_Decoded_Name_String_With_Brackets
+ (Units.Table (ALIs.Table (A).First_Unit).Uname);
+ Set_Casing (Mixed_Case);
+
+ if Num /= 1 then
Set_String (" ");
- Set_String (Name_Buffer (1 .. Name_Len - 2));
- Set_String ("'UET_Address");
+ end if;
- if A = Last then
- Set_String (");");
- else
- Set_Char (',');
- end if;
+ Set_String (Name_Buffer (1 .. Name_Len - 2));
+ Set_String ("'UET_Address");
- Write_Statement_Buffer;
+ if A = Last then
+ Set_String (");");
+ else
+ Set_Char (',');
end if;
- end loop;
- end if;
+
+ Write_Statement_Buffer;
+ end if;
+ end loop;
WBI (" ");
Set_String (" EA : aliased constant array (1 .. ");
- Set_Int (Num_Elab_Calls + 2);
+ Set_EA_Last;
Set_String (") of System.Address := (");
Write_Statement_Buffer;
- WBI (" " & Ada_Init_Name.all & "'Code_Address,");
+ Set_String (" " & Ada_Init_Name.all & "'Code_Address");
-- If compiling for the JVM, we directly reference Adafinal because
-- we don't import it via Do_Finalize (see Gen_Output_File_Ada).
if not Cumulative_Restrictions.Set (No_Finalization) then
+ Set_Char (',');
+ Write_Statement_Buffer;
+
if Hostparm.Java_VM then
Set_String
(" System.Standard_Library.Adafinal'Code_Address");
Set_String (" SDP_Table_Build (ST'Address, ");
Set_Int (Num);
Set_String (", EA'Address, ");
- Set_Int (Num_Elab_Calls + 2);
+ Set_EA_Last;
Set_String (");");
Write_Statement_Buffer;
end Gen_Exception_Table_Ada;
WBI ("");
Set_String (" void (*ea[");
- Set_Int (Num_Elab_Calls + 2);
+ Set_EA_Last;
Set_String ("]) () = {");
Write_Statement_Buffer;
- WBI (" " & Ada_Init_Name.all & ",");
+ Set_String (" " & Ada_Init_Name.all);
if not Cumulative_Restrictions.Set (No_Finalization) then
+ Set_Char (',');
+ Write_Statement_Buffer;
Set_String (" system__standard_library__adafinal");
end if;
Set_String (" __gnat_SDP_Table_Build (&st, ");
Set_Int (Num);
Set_String (", ea, ");
- Set_Int (Num_Elab_Calls + 2);
+ Set_EA_Last;
Set_String (");");
Write_Statement_Buffer;
end Gen_Exception_Table_C;
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;
"""__gnat_ada_main_program_name"");");
end if;
- -- No need to generate a finalization routine if finalization
- -- is restricted, since there is nothing to do in this case.
-
- if not Cumulative_Restrictions.Set (No_Finalization) then
- WBI ("");
- WBI (" procedure " & Ada_Final_Name.all & ";");
- WBI (" pragma Export (C, " & Ada_Final_Name.all & ", """ &
- Ada_Final_Name.all & """);");
- end if;
+ WBI ("");
+ WBI (" procedure " & Ada_Final_Name.all & ";");
+ WBI (" pragma Export (C, " & Ada_Final_Name.all & ", """ &
+ Ada_Final_Name.all & """);");
WBI ("");
WBI (" procedure " & Ada_Init_Name.all & ";");
Gen_Adainit_Ada;
- -- No need to generate a finalization routine if no finalization
-
- if not Cumulative_Restrictions.Set (No_Finalization) then
- Gen_Adafinal_Ada;
- end if;
+ Gen_Adafinal_Ada;
if Bind_Main_Program then
WBI ("extern void __gnat_set_globals");
WBI (" (int, int, char, char, char, char,");
WBI (" const char *, const char *,");
- WBI (" int, int, int, int);");
+ WBI (" int, int, int, int, int);");
WBI ("extern void " & Ada_Final_Name.all & " (void);");
WBI ("extern void " & Ada_Init_Name.all & " (void);");
WBI ("extern void system__standard_library__adafinal (void);");
Statement_Buffer (Last) := C;
end Set_Char;
+ -----------------
+ -- Set_EA_Last --
+ -----------------
+
+ procedure Set_EA_Last is
+ begin
+ -- When there is no finalization, only adainit is added
+
+ if Cumulative_Restrictions.Set (No_Finalization) then
+ Set_Int (Num_Elab_Calls + 1);
+
+ -- When there is finalization, both adainit and adafinal are added
+
+ else
+ Set_Int (Num_Elab_Calls + 2);
+ end if;
+ end Set_EA_Last;
+
-------------
-- Set_Int --
-------------
---------------------
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
