Subversion Repositories openrisc

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                              B I N D G E N                               --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --

--                                                                          --

-- 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- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --

-- for  more details.  You should have  received  a copy of the GNU General --

-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --

-- http://www.gnu.org/licenses for a complete copy of the license.          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

------------------------------------------------------------------------------

with ALI;      use ALI;

with Binde;    use Binde;

with Casing;   use Casing;

with Fname;    use Fname;

with Gnatvsn;  use Gnatvsn;

with Hostparm;

with Namet;    use Namet;

with Opt;      use Opt;

with Osint;    use Osint;

with Osint.B;  use Osint.B;

with Output;   use Output;

with Rident;   use Rident;

with Table;    use Table;

with Targparm; use Targparm;

with Types;    use Types;

with System.OS_Lib;  use System.OS_Lib;

with System.WCh_Con; use System.WCh_Con;

with GNAT.Heap_Sort_A; use GNAT.Heap_Sort_A;

package body Bindgen is

   Statement_Buffer : String (1 .. 1000);

   --  Buffer used for constructing output statements

   Last : Natural := 0;

   --  Last location in Statement_Buffer currently set

   With_DECGNAT : Boolean := False;

   --  Flag which indicates whether the program uses the DECGNAT library

   --  (presence of the unit DEC).

   With_GNARL : Boolean := False;

   --  Flag which indicates whether the program uses the GNARL library

   --  (presence of the unit System.OS_Interface)

   Num_Elab_Calls : Nat := 0;

   --  Number of generated calls to elaboration routines

   System_Restrictions_Used : Boolean;

   --  Flag indicating whether the unit System.Restrictions is in the closure

   --  of the partition. This is set by Check_System_Restrictions_Used, and

   --  is used to determine whether or not to initialize the restrictions

   --  information in the body of the binder generated file (we do not want

   --  to do this unconditionally, since it drags in the System.Restrictions

   --  unit unconditionally, which is unpleasand, especially for ZFP etc.)

   Dispatching_Domains_Used : Boolean;

   --  Flag indicating whether multiprocessor dispatching domains are used in

   --  the closure of the partition. This is set by

   --  Check_Dispatching_Domains_Used, and is used to call the routine to

   --  disallow the creation of new dispatching domains just before calling

   --  the main procedure from the environment task.

   Lib_Final_Built : Boolean := False;

   --  Flag indicating whether the finalize_library rountine has been built

   CodePeer_Wrapper_Name : constant String := "call_main_subprogram";

   --  For CodePeer, introduce a wrapper subprogram which calls the

   --  user-defined main subprogram.

   ----------------------------------

   -- Interface_State Pragma Table --

   ----------------------------------

   --  This table assembles the interface state pragma information from

   --  all the units in the partition. Note that Bcheck has already checked

   --  that the information is consistent across units. The entries

   --  in this table are n/u/r/s for not set/user/runtime/system.

   package IS_Pragma_Settings is new Table.Table (

     Table_Component_Type => Character,

     Table_Index_Type     => Int,

     Table_Low_Bound      => 0,

     Table_Initial        => 100,

     Table_Increment      => 200,

     Table_Name           => "IS_Pragma_Settings");

   --  This table assembles the Priority_Specific_Dispatching pragma

   --  information from all the units in the partition. Note that Bcheck has

   --  already checked that the information is consistent across units.

   --  The entries in this table are the upper case first character of the

   --  policy name, e.g. 'F' for FIFO_Within_Priorities.

   package PSD_Pragma_Settings is new Table.Table (

     Table_Component_Type => Character,

     Table_Index_Type     => Int,

     Table_Low_Bound      => 0,

     Table_Initial        => 100,

     Table_Increment      => 200,

     Table_Name           => "PSD_Pragma_Settings");

   ----------------------

   -- Run-Time Globals --

   ----------------------

   --  This section documents the global variables that set from the

   --  generated binder file.

   --     Main_Priority                 : Integer;

   --     Time_Slice_Value              : Integer;

   --     Heap_Size                     : Natural;

   --     WC_Encoding                   : Character;

   --     Locking_Policy                : Character;

   --     Queuing_Policy                : Character;

   --     Task_Dispatching_Policy       : Character;

   --     Priority_Specific_Dispatching : System.Address;

   --     Num_Specific_Dispatching      : Integer;

   --     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;

   --     Default_Stack_Size            : Integer;

   --     Leap_Seconds_Support          : Integer;

   --     Main_CPU                      : 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.

   --  Heap_Size is the heap to use for memory allocations set by use of a

   --  -Hnn parameter for the binder or by the GNAT$NO_MALLOC_64 logical.

   --  Valid values are 32 and 64. This switch is only effective on VMS.

   --  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.

   --  Priority_Specific_Dispatching is the address of a string used to store

   --  the task dispatching policy specified for the different priorities in

   --  the partition. The length of this string is determined by the last

   --  priority for which such a pragma applies (the string will be a null

   --  string if no specific dispatching policies were used). If pragma were

   --  present, the entries apply to the priorities in sequence from the first

   --  priority. The value stored is the upper case first character of the

   --  policy name, or 'F' (for FIFO_Within_Priorities) as the default value

   --  for those priority ranges not specified.

   --  Num_Specific_Dispatching is length of the Priority_Specific_Dispatching

   --  string. It will be set to zero if no Priority_Specific_Dispatching

   --  pragmas are present.

   --  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.

   --  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.

   --  Default_Stack_Size is the default stack size used when creating an Ada

   --  task with no explicit Storage_Size clause.

   --  Leap_Seconds_Support denotes whether leap seconds have been enabled or

   --  disabled. A value of zero indicates that leap seconds are turned "off",

   --  while a value of one signifies "on" status.

   --  Main_CPU is the processor set by pragma CPU in the main program. If no

   --  such pragma is present, the value is -1.

   procedure WBI (Info : String) renames Osint.B.Write_Binder_Info;

   --  Convenient shorthand used throughout

   -----------------------

   -- Local Subprograms --

   -----------------------

   procedure Check_File_In_Partition

     (File_Name : String;

      Flag      : out Boolean);

   --  If the file indicated by File_Name is in the partition the Flag is set

   --  to True, False otherwise.

   procedure Check_System_Restrictions_Used;

   --  Sets flag System_Restrictions_Used (Set to True if and only if the unit

   --  System.Restrictions is present in the partition, otherwise False).

   procedure Check_Dispatching_Domains_Used;

   --  Sets flag Dispatching_Domains_Used to True when using the unit

   --  System.Multiprocessors.Dispatching_Domains is present in the partition,

   --  otherwise set to False.

   procedure Gen_Adainit;

   --  Generates the Adainit procedure

   procedure Gen_Adafinal;

   --  Generate the Adafinal procedure

   procedure Gen_CodePeer_Wrapper;

   --  For CodePeer, generate wrapper which calls user-defined main subprogram

   procedure Gen_Elab_Calls;

   --  Generate sequence of elaboration calls

   procedure Gen_Elab_Externals;

   --  Generate sequence of external declarations for elaboration

   procedure Gen_Elab_Order;

   --  Generate comments showing elaboration order chosen

   procedure Gen_Finalize_Library;

   --  Generate a sequence of finalization calls to elaborated packages

   procedure Gen_Main;

   --  Generate procedure main

   procedure Gen_Object_Files_Options;

   --  Output comments containing a list of the full names of the object

   --  files to be linked and the list of linker options supplied by

   --  Linker_Options pragmas in the source.

   procedure Gen_Output_File_Ada (Filename : String);

   --  Generate Ada output file

   procedure Gen_Restrictions;

   --  Generate initialization of restrictions variable

   procedure Gen_Versions;

   --  Output series of definitions for unit versions

   function Get_Ada_Main_Name return String;

   --  This function is used for the Ada main output to compute a usable name

   --  for the generated main program. The normal main program name is

   --  Ada_Main, but this won't work if the user has a unit with this name.

   --  This function tries Ada_Main first, and if there is such a clash, then

   --  it tries Ada_Name_01, Ada_Name_02 ... Ada_Name_99 in sequence.

   function Get_Main_Unit_Name (S : String) return String;

   --  Return the main unit name corresponding to S by replacing '.' with '_'

   function Get_Main_Name return String;

   --  This function is used in the main output case to compute the correct

   --  external main program. It is "main" by default, unless the flag

   --  Use_Ada_Main_Program_Name_On_Target is set, in which case it is the name

   --  of the Ada main name without the "_ada". This default can be overridden

   --  explicitly using the -Mname binder switch.

   function Get_WC_Encoding return Character;

   --  Return wide character encoding method to set as WC_Encoding in output.

   --  If -W has been used, returns the specified encoding, otherwise returns

   --  the encoding method used for the main program source. If there is no

   --  main program source (-z switch used), returns brackets ('b').

   function Has_Finalizer return Boolean;

   --  Determine whether the current unit has at least one library-level

   --  finalizer.

   function Lt_Linker_Option (Op1, Op2 : Natural) return Boolean;

   --  Compare linker options, when sorting, first according to

   --  Is_Internal_File (internal files come later) and then by

   --  elaboration order position (latest to earliest).

   procedure Move_Linker_Option (From : Natural; To : Natural);

   --  Move routine for sorting linker options

   procedure Resolve_Binder_Options;

   --  Set the value of With_GNARL and With_DECGNAT. The latter only on VMS

   --  since it tests for a package named "dec" which might cause a conflict

   --  on non-VMS systems.

   procedure Set_Char (C : Character);

   --  Set given character in Statement_Buffer at the Last + 1 position

   --  and increment Last by one to reflect the stored character.

   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.

   --  A minus sign is output for a negative value.

   procedure Set_Boolean (B : Boolean);

   --  Set given boolean value in Statement_Buffer at the Last + 1 position

   --  and update Last past the value.

   procedure Set_IS_Pragma_Table;

   --  Initializes contents of IS_Pragma_Settings table from ALI table

   procedure Set_Main_Program_Name;

   --  Given the main program name in Name_Buffer (length in Name_Len)

   --  generate the name of the routine to be used in the call. The name

   --  is generated starting at Last + 1, and Last is updated past it.

   procedure Set_Name_Buffer;

   --  Set the value stored in positions 1 .. Name_Len of the Name_Buffer

   procedure Set_PSD_Pragma_Table;

   --  Initializes contents of PSD_Pragma_Settings table from ALI table

   procedure Set_String (S : String);

   --  Sets characters of given string in Statement_Buffer, starting at the

   --  Last + 1 position, and updating last past the string value.

   procedure Set_String_Replace (S : String);

   --  Replaces the last S'Length characters in the Statement_Buffer with

   --  the characters of S. The caller must ensure that these characters do

   --  in fact exist in the Statement_Buffer.

   type Qualification_Mode is (Dollar_Sign, Dot, Double_Underscores);

   procedure Set_Unit_Name (Mode : Qualification_Mode := Double_Underscores);

   --  Given a unit name in the Name_Buffer, copy it into Statement_Buffer,

   --  starting at the Last + 1 position and update Last past the value.

   --  Depending on parameter Mode, a dot (.) can be qualified into double

   --  underscores (__), a dollar sign ($) or left as is.

   procedure Set_Unit_Number (U : Unit_Id);

   --  Sets unit number (first unit is 1, leading zeroes output to line

   --  up all output unit numbers nicely as required by the value, and

   --  by the total number of units.

   procedure Write_Statement_Buffer;

   --  Write out contents of statement buffer up to Last, and reset Last to 0

   procedure Write_Statement_Buffer (S : String);

   --  First writes its argument (using Set_String (S)), then writes out the

   --  contents of statement buffer up to Last, and reset Last to 0

   ------------------------------------

   -- Check_Dispatching_Domains_Used --

   ------------------------------------

   procedure Check_Dispatching_Domains_Used is

   begin

      Check_File_In_Partition ("s-mudido.ads", Dispatching_Domains_Used);

   end Check_Dispatching_Domains_Used;

   -----------------------------

   -- Check_File_In_Partition --

   -----------------------------

   procedure Check_File_In_Partition

     (File_Name : String;

      Flag      : out Boolean)

   is

   begin

      for J in Units.First .. Units.Last loop

         if Get_Name_String (Units.Table (J).Sfile) = File_Name then

            Flag := True;

            return;

         end if;

      end loop;

      Flag := False;

   end Check_File_In_Partition;

   ------------------------------------

   -- Check_System_Restrictions_Used --

   ------------------------------------

   procedure Check_System_Restrictions_Used is

   begin

      Check_File_In_Partition ("s-restri.ads", System_Restrictions_Used);

   end Check_System_Restrictions_Used;

   ------------------

   -- Gen_Adafinal --

   ------------------

   procedure Gen_Adafinal is

   begin

      WBI ("   procedure " & Ada_Final_Name.all & " is");

      if VM_Target = No_VM

        and Bind_Main_Program

        and not CodePeer_Mode

      then

         WBI ("      procedure s_stalib_adafinal;");

         Set_String ("      pragma Import (C, s_stalib_adafinal, ");

         Set_String ("""system__standard_library__adafinal"");");

         Write_Statement_Buffer;

      end if;

      WBI ("   begin");

      if not CodePeer_Mode then

         WBI ("      if not Is_Elaborated then");

         WBI ("         return;");

         WBI ("      end if;");

         WBI ("      Is_Elaborated := False;");

      end if;

      --  On non-virtual machine targets, finalization is done differently

      --  depending on whether this is the main program or a library.

      if VM_Target = No_VM and then not CodePeer_Mode then

         if Bind_Main_Program then

            WBI ("      s_stalib_adafinal;");

         elsif Lib_Final_Built then

            WBI ("      finalize_library;");

         else

            WBI ("      null;");

         end if;

      --  Pragma Import C cannot be used on virtual machine targets, therefore

      --  call the runtime finalization routine directly. Similarly in CodePeer

      --  mode, where imported functions are ignored.

      else

         WBI ("      System.Standard_Library.Adafinal;");

      end if;

      WBI ("   end " & Ada_Final_Name.all & ";");

      WBI ("");

   end Gen_Adafinal;

   -----------------

   -- Gen_Adainit --

   -----------------

   procedure Gen_Adainit is

      Main_Priority : Int renames ALIs.Table (ALIs.First).Main_Priority;

      Main_CPU      : Int renames ALIs.Table (ALIs.First).Main_CPU;

   begin

      --  Declare the access-to-subprogram type used for initialization of

      --  of __gnat_finalize_library_objects. This is declared at library

      --  level for compatibility with the type used in System.Soft_Links.

      --  The import of the soft link which performs library-level object

      --  finalization is not needed for VM targets; regular Ada is used in

      --  that case. For restricted run-time libraries (ZFP and Ravenscar)

      --  tasks are non-terminating, so we do not want finalization.

      if not Suppress_Standard_Library_On_Target

        and then VM_Target = No_VM

        and then not CodePeer_Mode

        and then not Configurable_Run_Time_On_Target

      then

         WBI ("   type No_Param_Proc is access procedure;");

         WBI ("");

      end if;

      WBI ("   procedure " & Ada_Init_Name.all & " is");

      --  In CodePeer mode, simplify adainit procedure by only calling

      --  elaboration procedures.

      if CodePeer_Mode then

         WBI ("   begin");

      --  If the standard library is suppressed, then the only global variables

      --  that might be needed (by the Ravenscar profile) are the priority and

      --  the processor for the environment task.

      elsif Suppress_Standard_Library_On_Target then

         if Main_Priority /= No_Main_Priority then

            WBI ("      Main_Priority : Integer;");

            WBI ("      pragma Import (C, Main_Priority," &

                 " ""__gl_main_priority"");");

            WBI ("");

         end if;

         if Main_CPU /= No_Main_CPU then

            WBI ("      Main_CPU : Integer;");

            WBI ("      pragma Import (C, Main_CPU," &

                 " ""__gl_main_cpu"");");

            WBI ("");

         end if;

         WBI ("   begin");

         if Main_Priority /= No_Main_Priority then

            Set_String ("      Main_Priority := ");

            Set_Int    (Main_Priority);

            Set_Char   (';');

            Write_Statement_Buffer;

         end if;

         if Main_CPU /= No_Main_CPU then

            Set_String ("      Main_CPU := ");

            Set_Int    (Main_CPU);

            Set_Char   (';');

            Write_Statement_Buffer;

         end if;

         if Main_Priority = No_Main_Priority

           and then Main_CPU = No_Main_CPU

         then

            WBI ("      null;");

         end if;

      --  Normal case (standard library not suppressed). Set all global values

      --  used by the run time.

      else

         WBI ("      Main_Priority : Integer;");

         WBI ("      pragma Import (C, Main_Priority, " &

              """__gl_main_priority"");");

         WBI ("      Time_Slice_Value : Integer;");

         WBI ("      pragma Import (C, Time_Slice_Value, " &

              """__gl_time_slice_val"");");

         WBI ("      WC_Encoding : Character;");

         WBI ("      pragma Import (C, WC_Encoding, ""__gl_wc_encoding"");");

         WBI ("      Locking_Policy : Character;");

         WBI ("      pragma Import (C, Locking_Policy, " &

              """__gl_locking_policy"");");

         WBI ("      Queuing_Policy : Character;");

         WBI ("      pragma Import (C, Queuing_Policy, " &

              """__gl_queuing_policy"");");

         WBI ("      Task_Dispatching_Policy : Character;");

         WBI ("      pragma Import (C, Task_Dispatching_Policy, " &

              """__gl_task_dispatching_policy"");");

         WBI ("      Priority_Specific_Dispatching : System.Address;");

         WBI ("      pragma Import (C, Priority_Specific_Dispatching, " &

              """__gl_priority_specific_dispatching"");");

         WBI ("      Num_Specific_Dispatching : Integer;");

         WBI ("      pragma Import (C, Num_Specific_Dispatching, " &

              """__gl_num_specific_dispatching"");");

         WBI ("      Main_CPU : Integer;");

         WBI ("      pragma Import (C, Main_CPU, " &

              """__gl_main_cpu"");");

         WBI ("      Interrupt_States : System.Address;");

         WBI ("      pragma Import (C, Interrupt_States, " &

              """__gl_interrupt_states"");");

         WBI ("      Num_Interrupt_States : Integer;");

         WBI ("      pragma Import (C, Num_Interrupt_States, " &

              """__gl_num_interrupt_states"");");

         WBI ("      Unreserve_All_Interrupts : Integer;");

         WBI ("      pragma Import (C, Unreserve_All_Interrupts, " &

              """__gl_unreserve_all_interrupts"");");

         if Exception_Tracebacks then

            WBI ("      Exception_Tracebacks : Integer;");

            WBI ("      pragma Import (C, Exception_Tracebacks, " &

                 """__gl_exception_tracebacks"");");

         end if;

         WBI ("      Zero_Cost_Exceptions : Integer;");

         WBI ("      pragma Import (C, Zero_Cost_Exceptions, " &

              """__gl_zero_cost_exceptions"");");

         WBI ("      Detect_Blocking : Integer;");

         WBI ("      pragma Import (C, Detect_Blocking, " &

              """__gl_detect_blocking"");");

         WBI ("      Default_Stack_Size : Integer;");

         WBI ("      pragma Import (C, Default_Stack_Size, " &

              """__gl_default_stack_size"");");

         WBI ("      Leap_Seconds_Support : Integer;");

         WBI ("      pragma Import (C, Leap_Seconds_Support, " &

              """__gl_leap_seconds_support"");");

         --  Import entry point for elaboration time signal handler

         --  installation, and indication of if it's been called previously.

         WBI ("");

         WBI ("      procedure Install_Handler;");

         WBI ("      pragma Import (C, Install_Handler, " &

              """__gnat_install_handler"");");

         WBI ("");

         WBI ("      Handler_Installed : Integer;");

         WBI ("      pragma Import (C, Handler_Installed, " &

              """__gnat_handler_installed"");");

         --  The import of the soft link which performs library-level object

         --  finalization is not needed for VM targets; regular Ada is used in

         --  that case. For restricted run-time libraries (ZFP and Ravenscar)

         --  tasks are non-terminating, so we do not want finalization.

         if VM_Target = No_VM and then not Configurable_Run_Time_On_Target then

            WBI ("");

            WBI ("      Finalize_Library_Objects : No_Param_Proc;");

            WBI ("      pragma Import (C, Finalize_Library_Objects, " &

                 """__gnat_finalize_library_objects"");");

         end if;

         --  Import entry point for environment feature enable/disable

         --  routine, and indication that it's been called previously.

         if OpenVMS_On_Target then

            WBI ("");

            WBI ("      procedure Set_Features;");

            WBI ("      pragma Import (C, Set_Features, " &

                 """__gnat_set_features"");");

            WBI ("");

            WBI ("      Features_Set : Integer;");

            WBI ("      pragma Import (C, Features_Set, " &

                 """__gnat_features_set"");");

            if Opt.Heap_Size /= 0 then

               WBI ("");

               WBI ("      Heap_Size : Integer;");

               WBI ("      pragma Import (C, Heap_Size, " &

                    """__gl_heap_size"");");

               Write_Statement_Buffer;

            end if;

         end if;

         --  Initialize stack limit variable of the environment task if the

         --  stack check method is stack limit and stack check is enabled.

         if Stack_Check_Limits_On_Target

           and then (Stack_Check_Default_On_Target or Stack_Check_Switch_Set)

         then

            WBI ("");

            WBI ("      procedure Initialize_Stack_Limit;");

            WBI ("      pragma Import (C, Initialize_Stack_Limit, " &

                 """__gnat_initialize_stack_limit"");");

         end if;

         --  Special processing when main program is CIL function/procedure

         if VM_Target = CLI_Target

           and then Bind_Main_Program

           and then not No_Main_Subprogram

         then

            WBI ("");

            --  Function case, use Set_Exit_Status to report the returned

            --  status code, since that is the only mechanism available.

            if ALIs.Table (ALIs.First).Main_Program = Func then

               WBI ("      Result : Integer;");

               WBI ("      procedure Set_Exit_Status (Code : Integer);");

               WBI ("      pragma Import (C, Set_Exit_Status, " &

                    """__gnat_set_exit_status"");");

               WBI ("");

               WBI ("      function Ada_Main_Program return Integer;");

            --  Procedure case

            else

               WBI ("      procedure Ada_Main_Program;");

            end if;

            Get_Name_String (Units.Table (First_Unit_Entry).Uname);

            Name_Len := Name_Len - 2;

            WBI ("      pragma Import (CIL, Ada_Main_Program, """

                 & Name_Buffer (1 .. Name_Len) & "."

                 & Get_Main_Unit_Name (Name_Buffer (1 .. Name_Len)) & """);");

         end if;

         --  When dispatching domains are used then we need to signal it

         --  before calling the main procedure.

         if Dispatching_Domains_Used then

            WBI ("      procedure Freeze_Dispatching_Domains;");

            WBI ("      pragma Import");

            WBI ("        (Ada, Freeze_Dispatching_Domains, " &

                 """__gnat_freeze_dispatching_domains"");");

         end if;

         WBI ("   begin");

         WBI ("      if Is_Elaborated then");

         WBI ("         return;");

         WBI ("      end if;");

         WBI ("      Is_Elaborated := True;");

         Set_String ("      Main_Priority := ");

         Set_Int    (Main_Priority);

         Set_Char   (';');

         Write_Statement_Buffer;

         Set_String ("      Time_Slice_Value := ");

         if Task_Dispatching_Policy_Specified = 'F'

           and then ALIs.Table (ALIs.First).Time_Slice_Value = -1

         then

            Set_Int (0);

         else

            Set_Int (ALIs.Table (ALIs.First).Time_Slice_Value);

         end if;

         Set_Char   (';');

         Write_Statement_Buffer;

         Set_String ("      WC_Encoding := '");

         Set_Char   (Get_WC_Encoding);

         Set_String ("';");

         Write_Statement_Buffer;

         Set_String ("      Locking_Policy := '");

         Set_Char   (Locking_Policy_Specified);

         Set_String ("';");

         Write_Statement_Buffer;

         Set_String ("      Queuing_Policy := '");

         Set_Char   (Queuing_Policy_Specified);

         Set_String ("';");

         Write_Statement_Buffer;

         Set_String ("      Task_Dispatching_Policy := '");

         Set_Char   (Task_Dispatching_Policy_Specified);

         Set_String ("';");

         Write_Statement_Buffer;

         Gen_Restrictions;

         WBI ("      Priority_Specific_Dispatching :=");

         WBI ("        Local_Priority_Specific_Dispatching'Address;");

         Set_String ("      Num_Specific_Dispatching := ");

         Set_Int (PSD_Pragma_Settings.Last + 1);

         Set_Char (';');

         Write_Statement_Buffer;

         Set_String ("      Main_CPU := ");

         Set_Int    (Main_CPU);

         Set_Char   (';');

         Write_Statement_Buffer;

         WBI ("      Interrupt_States := Local_Interrupt_States'Address;");

         Set_String ("      Num_Interrupt_States := ");