X-Git-Url: https://git.libre-soc.org/?a=blobdiff_plain;f=gcc%2Fada%2Fbindgen.adb;h=9efc873c3e44a1765a9bbfd6ca3fb7c836246db8;hb=97edd4267e6fef2da066feafc39c107f2687ee37;hp=8d5262b48c77fc426e2107cab11f348affcf2e9c;hpb=c1c8247201bd938d49716db8edc2767ff2a4d7d5;p=gcc.git diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 8d5262b48c7..9efc873c3e4 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2019, 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- -- @@ -24,7 +24,6 @@ ------------------------------------------------------------------------------ with ALI; use ALI; -with Binde; use Binde; with Casing; use Casing; with Fname; use Fname; with Gnatvsn; use Gnatvsn; @@ -35,26 +34,23 @@ with Osint; use Osint; with Osint.B; use Osint.B; with Output; use Output; with Rident; use Rident; -with Table; use Table; +with Stringt; use Stringt; +with Table; with Targparm; use Targparm; with Types; use Types; -with System.OS_Lib; use System.OS_Lib; +with System.OS_Lib; with System.WCh_Con; use System.WCh_Con; with GNAT.Heap_Sort_A; use GNAT.Heap_Sort_A; +with GNAT.HTable; 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). + Stm_Last : Natural := 0; + -- Stm_Last location in Statement_Buffer currently set With_GNARL : Boolean := False; -- Flag which indicates whether the program uses the GNARL library @@ -63,6 +59,14 @@ package body Bindgen is Num_Elab_Calls : Nat := 0; -- Number of generated calls to elaboration routines + Num_Primary_Stacks : Int := 0; + -- Number of default-sized primary stacks the binder needs to allocate for + -- task objects declared in the program. + + Num_Sec_Stacks : Int := 0; + -- Number of default-sized primary stacks the binder needs to allocate for + -- task objects declared in the program. + System_Restrictions_Used : Boolean := False; -- Flag indicating whether the unit System.Restrictions is in the closure -- of the partition. This is set by Resolve_Binder_Options, and is used @@ -78,6 +82,12 @@ package body Bindgen is -- domains just before calling the main procedure from the environment -- task. + System_Secondary_Stack_Used : Boolean := False; + -- Flag indicating whether the unit System.Secondary_Stack is in the + -- closure of the partition. This is set by Resolve_Binder_Options, and + -- is used to initialize the package in cases where the run-time brings + -- in package but the secondary stack is not used. + System_Tasking_Restricted_Stages_Used : Boolean := False; -- Flag indicating whether the unit System.Tasking.Restricted.Stages is in -- the closure of the partition. This is set by Resolve_Binder_Options, @@ -90,9 +100,24 @@ package body Bindgen is -- attach interrupt handlers at the end of the elaboration when partition -- elaboration policy is sequential. + System_BB_CPU_Primitives_Multiprocessors_Used : Boolean := False; + -- Flag indicating whether unit System.BB.CPU_Primitives.Multiprocessors + -- is in the closure of the partition. This is set by procedure + -- Resolve_Binder_Options, and it is used to call a procedure that starts + -- slave processors. + + System_Version_Control_Used : Boolean := False; + -- Flag indicating whether unit System.Version_Control is in the closure. + -- This unit is implicitly withed by the compiler when Version or + -- Body_Version attributes are used. If the package is not in the closure, + -- the version definitions can be removed. + Lib_Final_Built : Boolean := False; -- Flag indicating whether the finalize_library rountine has been built + Bind_Env_String_Built : Boolean := False; + -- Flag indicating whether a bind environment string has been built + CodePeer_Wrapper_Name : constant String := "call_main_subprogram"; -- For CodePeer, introduce a wrapper subprogram which calls the -- user-defined main subprogram. @@ -106,13 +131,13 @@ package body Bindgen is -- 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"); + 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 @@ -120,13 +145,29 @@ package body Bindgen is -- 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"); + 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"); + + ---------------------------- + -- Bind_Environment Table -- + ---------------------------- + + subtype Header_Num is Int range 0 .. 36; + + function Hash (Nam : Name_Id) return Header_Num; + + package Bind_Environment is new GNAT.HTable.Simple_HTable + (Header_Num => Header_Num, + Element => Name_Id, + No_Element => No_Name, + Key => Name_Id, + Hash => Hash, + Equal => "="); ---------------------- -- Run-Time Globals -- @@ -149,10 +190,14 @@ package body Bindgen is -- Num_Interrupt_States : Integer; -- Unreserve_All_Interrupts : Integer; -- Exception_Tracebacks : Integer; + -- Exception_Tracebacks_Symbolic : Integer; -- Detect_Blocking : Integer; -- Default_Stack_Size : Integer; + -- Default_Secondary_Stack_Size : System.Parameters.Size_Type; -- Leap_Seconds_Support : Integer; -- Main_CPU : Integer; + -- Default_Sized_SS_Pool : System.Address; + -- Binder_Sec_Stacks_Count : Natural; -- Main_Priority is the priority value set by pragma Priority in the main -- program. If no such pragma is present, the value is -1. @@ -163,13 +208,6 @@ package body Bindgen is -- 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. - - -- Float_Format is the float representation in use. Valid values are - -- 'I' for IEEE and 'V' for VAX Float. This is only for 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. @@ -225,10 +263,13 @@ package body Bindgen is -- 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. + -- Exception_Tracebacks is set to one if the -Ea or -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. + + -- Exception_Tracebacks_Symbolic is set to one if the -Es parameter was + -- present in the bind and to zero otherwise. -- Detect_Blocking indicates whether pragma Detect_Blocking is active or -- not. A value of zero indicates that the pragma is not present, while a @@ -237,6 +278,9 @@ package body Bindgen is -- Default_Stack_Size is the default stack size used when creating an Ada -- task with no explicit Storage_Size clause. + -- Default_Secondary_Stack_Size is the default secondary stack size used + -- when creating an Ada task with no explicit Secondary_Stack_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. @@ -244,6 +288,14 @@ package body Bindgen is -- Main_CPU is the processor set by pragma CPU in the main program. If no -- such pragma is present, the value is -1. + -- Default_Sized_SS_Pool is set to the address of the default-sized + -- secondary stacks array generated by the binder. This pool of stacks is + -- generated when either the restriction No_Implicit_Heap_Allocations + -- or No_Implicit_Task_Allocations is active. + + -- Binder_Sec_Stacks_Count is the number of generated secondary stacks in + -- the Default_Sized_SS_Pool. + procedure WBI (Info : String) renames Osint.B.Write_Binder_Info; -- Convenient shorthand used throughout @@ -251,36 +303,41 @@ package body Bindgen is -- Local Subprograms -- ----------------------- - procedure Gen_Adainit; + procedure Gen_Adainit (Elab_Order : Unit_Id_Array); -- Generates the Adainit procedure procedure Gen_Adafinal; -- Generate the Adafinal procedure + procedure Gen_Bind_Env_String; + -- Generate the bind environment buffer + procedure Gen_CodePeer_Wrapper; -- For CodePeer, generate wrapper which calls user-defined main subprogram - procedure Gen_Elab_Calls; + procedure Gen_Elab_Calls (Elab_Order : Unit_Id_Array); -- Generate sequence of elaboration calls - procedure Gen_Elab_Externals; + procedure Gen_Elab_Externals (Elab_Order : Unit_Id_Array); -- Generate sequence of external declarations for elaboration - procedure Gen_Elab_Order; + procedure Gen_Elab_Order (Elab_Order : Unit_Id_Array); -- Generate comments showing elaboration order chosen - procedure Gen_Finalize_Library; + procedure Gen_Finalize_Library (Elab_Order : Unit_Id_Array); -- Generate a sequence of finalization calls to elaborated packages procedure Gen_Main; -- Generate procedure main - procedure Gen_Object_Files_Options; + procedure Gen_Object_Files_Options (Elab_Order : Unit_Id_Array); -- 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); + procedure Gen_Output_File_Ada + (Filename : String; + Elab_Order : Unit_Id_Array); -- Generate Ada output file procedure Gen_Restrictions; @@ -312,11 +369,11 @@ package body Bindgen is -- 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; + function Has_Finalizer (Elab_Order : Unit_Id_Array) return Boolean; -- Determine whether the current unit has at least one library-level -- finalizer. - function Lt_Linker_Option (Op1, Op2 : Natural) return Boolean; + function Lt_Linker_Option (Op1 : Natural; 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). @@ -324,31 +381,29 @@ package body Bindgen is 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 Resolve_Binder_Options (Elab_Order : Unit_Id_Array); + -- Set the value of With_GNARL 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. + -- Set given character in Statement_Buffer at the Stm_Last + 1 position + -- and increment Stm_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. + -- Set given value in decimal in Statement_Buffer with no spaces starting + -- at the Stm_Last + 1 position, and updating Stm_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. + -- Set given boolean value in Statement_Buffer at the Stm_Last + 1 position + -- and update Stm_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. + -- 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 Stm_Last + 1, and Stm_Last is updated past it. procedure Set_Name_Buffer; -- Set the value stored in positions 1 .. Name_Len of the Name_Buffer @@ -358,32 +413,34 @@ package body Bindgen is 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. + -- Stm_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); + -- 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. - procedure Set_Unit_Name (Mode : Qualification_Mode := Double_Underscores); + procedure Set_Unit_Name; -- 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. + -- starting at the Stm_Last + 1 position and update Stm_Last past the + -- value. Each dot (.) will be qualified into double underscores (__). 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. + -- 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 + -- Write out contents of statement buffer up to Stm_Last, and reset + -- Stm_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 + -- contents of statement buffer up to Stm_Last, and resets Stm_Last to 0. + + procedure Write_Bind_Line (S : String); + -- Write S (an LF-terminated string) to the binder file (for use with + -- Set_Special_Output). ------------------ -- Gen_Adafinal -- @@ -393,16 +450,24 @@ package body Bindgen is begin WBI (" procedure " & Ada_Final_Name.all & " is"); - if VM_Target = No_VM - and Bind_Main_Program - and not CodePeer_Mode - then + -- Call s_stalib_adafinal to await termination of tasks and so on. We + -- want to do this if there is a main program, either in Ada or in some + -- other language. (Note that Bind_Main_Program is True for Ada mains, + -- but False for mains in other languages.) We do not want to do this if + -- we're binding a library. + + if not Bind_For_Library 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 (""); + WBI (" procedure Runtime_Finalize;"); + WBI (" pragma Import (C, Runtime_Finalize, " & + """__gnat_runtime_finalize"");"); + WBI (""); WBI (" begin"); if not CodePeer_Mode then @@ -412,11 +477,13 @@ package body Bindgen is 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. + WBI (" Runtime_Finalize;"); + + -- By default (real 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 + if not CodePeer_Mode then + if not Bind_For_Library then WBI (" s_stalib_adafinal;"); elsif Lib_Final_Built then WBI (" finalize_library;"); @@ -424,9 +491,9 @@ package body Bindgen is 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. + -- Pragma Import C cannot be used on virtual targets, therefore call the + -- runtime finalization routine directly in CodePeer mode, where + -- imported functions are ignored. else WBI (" System.Standard_Library.Adafinal;"); @@ -440,7 +507,7 @@ package body Bindgen is -- Gen_Adainit -- ----------------- - procedure Gen_Adainit is + procedure Gen_Adainit (Elab_Order : Unit_Id_Array) is Main_Priority : Int renames ALIs.Table (ALIs.First).Main_Priority; Main_CPU : Int renames ALIs.Table (ALIs.First).Main_CPU; @@ -449,12 +516,11 @@ package body Bindgen is -- 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 + -- finalization does not work for CodePeer, so 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 @@ -470,14 +536,6 @@ package body Bindgen is if CodePeer_Mode then WBI (" begin"); - -- When compiling for the AAMP small library, where the standard library - -- is no longer suppressed, we still want to exclude the setting of the - -- various imported globals, which aren't present for that library. - - elsif AAMP_On_Target and then Configurable_Run_Time_On_Target then - WBI (" begin"); - WBI (" null;"); - -- 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. @@ -517,6 +575,39 @@ package body Bindgen is WBI (" procedure Activate_All_Tasks_Sequential;"); WBI (" pragma Import (C, Activate_All_Tasks_Sequential," & " ""__gnat_activate_all_tasks"");"); + WBI (""); + end if; + + if System_BB_CPU_Primitives_Multiprocessors_Used then + WBI (" procedure Start_Slave_CPUs;"); + WBI (" pragma Import (C, Start_Slave_CPUs," & + " ""__gnat_start_slave_cpus"");"); + WBI (""); + end if; + + -- A restricted run-time may attempt to initialize the main task's + -- secondary stack even if the stack is not used. Consequently, + -- the binder needs to initialize Binder_Sec_Stacks_Count anytime + -- System.Secondary_Stack is in the enclosure of the partition. + + if System_Secondary_Stack_Used then + WBI (" Binder_Sec_Stacks_Count : Natural;"); + WBI (" pragma Import (Ada, Binder_Sec_Stacks_Count, " & + """__gnat_binder_ss_count"");"); + WBI (""); + end if; + + if Sec_Stack_Used then + WBI (" Default_Secondary_Stack_Size : " & + "System.Parameters.Size_Type;"); + WBI (" pragma Import (C, Default_Secondary_Stack_Size, " & + """__gnat_default_ss_size"");"); + + WBI (" Default_Sized_SS_Pool : System.Address;"); + WBI (" pragma Import (Ada, Default_Sized_SS_Pool, " & + """__gnat_default_ss_pool"");"); + + WBI (""); end if; WBI (" begin"); @@ -551,6 +642,50 @@ package body Bindgen is WBI (" null;"); end if; + -- Generate default-sized secondary stack pool and set secondary + -- stack globals. + + if Sec_Stack_Used then + + -- Elaborate the body of the binder to initialize the default- + -- sized secondary stack pool. + + WBI (""); + WBI (" " & Get_Ada_Main_Name & "'Elab_Body;"); + + -- Generate the default-sized secondary stack pool and set the + -- related secondary stack globals. + + Set_String (" Default_Secondary_Stack_Size := "); + + if Opt.Default_Sec_Stack_Size /= Opt.No_Stack_Size then + Set_Int (Opt.Default_Sec_Stack_Size); + else + Set_String ("System.Parameters.Runtime_Default_Sec_Stack_Size"); + end if; + + Set_Char (';'); + Write_Statement_Buffer; + + Set_String (" Binder_Sec_Stacks_Count := "); + Set_Int (Num_Sec_Stacks); + Set_Char (';'); + Write_Statement_Buffer; + + WBI (" Default_Sized_SS_Pool := " & + "Sec_Default_Sized_Stacks'Address;"); + WBI (""); + + -- When a restricted run-time initializes the main task's secondary + -- stack but the program does not use it, no secondary stack is + -- generated. Binder_Sec_Stacks_Count is set to zero so the run-time + -- is aware that the lack of pre-allocated secondary stack is + -- expected. + + elsif System_Secondary_Stack_Used then + WBI (" Binder_Sec_Stacks_Count := 0;"); + end if; + -- Normal case (standard library not suppressed). Set all global values -- used by the run time. @@ -592,10 +727,16 @@ package body Bindgen is WBI (" pragma Import (C, Unreserve_All_Interrupts, " & """__gl_unreserve_all_interrupts"");"); - if Exception_Tracebacks then + if Exception_Tracebacks or Exception_Tracebacks_Symbolic then WBI (" Exception_Tracebacks : Integer;"); WBI (" pragma Import (C, Exception_Tracebacks, " & """__gl_exception_tracebacks"");"); + + if Exception_Tracebacks_Symbolic then + WBI (" Exception_Tracebacks_Symbolic : Integer;"); + WBI (" pragma Import (C, Exception_Tracebacks_Symbolic, " & + """__gl_exception_tracebacks_symbolic"");"); + end if; end if; WBI (" Detect_Blocking : Integer;"); @@ -604,21 +745,29 @@ package body Bindgen is WBI (" Default_Stack_Size : Integer;"); WBI (" pragma Import (C, Default_Stack_Size, " & """__gl_default_stack_size"");"); + + if Sec_Stack_Used then + WBI (" Default_Secondary_Stack_Size : " & + "System.Parameters.Size_Type;"); + WBI (" pragma Import (C, Default_Secondary_Stack_Size, " & + """__gnat_default_ss_size"");"); + end if; + WBI (" Leap_Seconds_Support : Integer;"); WBI (" pragma Import (C, Leap_Seconds_Support, " & """__gl_leap_seconds_support"");"); + WBI (" Bind_Env_Addr : System.Address;"); + WBI (" pragma Import (C, Bind_Env_Addr, " & + """__gl_bind_env_addr"");"); -- 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"");"); + WBI (" procedure Runtime_Initialize " & + "(Install_Handler : Integer);"); + WBI (" pragma Import (C, Runtime_Initialize, " & + """__gnat_runtime_initialize"");"); -- Import handlers attach procedure for sequential elaboration policy @@ -647,48 +796,24 @@ package body Bindgen is " ""__gnat_activate_all_tasks"");"); end if; - -- 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) + -- Import procedure to start slave cpus for bareboard runtime + + if System_BB_CPU_Primitives_Multiprocessors_Used then + WBI (" procedure Start_Slave_CPUs;"); + WBI (" pragma Import (C, Start_Slave_CPUs," & + " ""__gnat_start_slave_cpus"");"); + end if; + + -- 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 + if 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; - - WBI (""); - WBI (" Float_Format : Character;"); - WBI (" pragma Import (C, Float_Format, " & - """__gl_float_format"");"); - - Write_Statement_Buffer; - end if; - -- Initialize stack limit variable of the environment task if the -- stack check method is stack limit and stack check is enabled. @@ -701,38 +826,6 @@ package body Bindgen is """__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. @@ -743,6 +836,20 @@ package body Bindgen is & """__gnat_freeze_dispatching_domains"");"); end if; + -- Secondary stack global variables + + WBI (" Binder_Sec_Stacks_Count : Natural;"); + WBI (" pragma Import (Ada, Binder_Sec_Stacks_Count, " & + """__gnat_binder_ss_count"");"); + + WBI (" Default_Sized_SS_Pool : System.Address;"); + WBI (" pragma Import (Ada, Default_Sized_SS_Pool, " & + """__gnat_default_ss_pool"");"); + + WBI (""); + + -- Start of processing for Adainit + WBI (" begin"); WBI (" if Is_Elaborated then"); WBI (" return;"); @@ -842,8 +949,12 @@ package body Bindgen is Set_Char (';'); Write_Statement_Buffer; - if Exception_Tracebacks then + if Exception_Tracebacks or Exception_Tracebacks_Symbolic then WBI (" Exception_Tracebacks := 1;"); + + if Exception_Tracebacks_Symbolic then + WBI (" Exception_Tracebacks_Symbolic := 1;"); + end if; end if; Set_String (" Detect_Blocking := "); @@ -873,57 +984,56 @@ package body Bindgen is Set_String (";"); Write_Statement_Buffer; - -- Generate call to Install_Handler + if Bind_Env_String_Built then + WBI (" Bind_Env_Addr := Bind_Env'Address;"); + end if; - -- In .NET, when binding with -z, we don't install the signal handler - -- to let the caller handle the last exception handler. + WBI (""); - if VM_Target /= CLI_Target - or else Bind_Main_Program - then - WBI (""); - WBI (" if Handler_Installed = 0 then"); - WBI (" Install_Handler;"); - WBI (" end if;"); - end if; + -- Generate default-sized secondary stack pool and set secondary + -- stack globals. - -- Generate call to Set_Features + if Sec_Stack_Used then - if OpenVMS_On_Target then + -- Elaborate the body of the binder to initialize the default- + -- sized secondary stack pool. - -- Set_Features will call IEEE$SET_FP_CONTROL appropriately - -- depending on the setting of Float_Format. + WBI (" " & Get_Ada_Main_Name & "'Elab_Body;"); - WBI (""); - Set_String (" Float_Format := '"); + -- Generate the default-sized secondary stack pool and set the + -- related secondary stack globals. - if Float_Format_Specified = 'G' - or else - Float_Format_Specified = 'D' - then - Set_Char ('V'); + Set_String (" Default_Secondary_Stack_Size := "); + + if Opt.Default_Sec_Stack_Size /= Opt.No_Stack_Size then + Set_Int (Opt.Default_Sec_Stack_Size); else - Set_Char ('I'); + Set_String ("System.Parameters.Runtime_Default_Sec_Stack_Size"); end if; - Set_String ("';"); + Set_Char (';'); Write_Statement_Buffer; - WBI (""); - WBI (" if Features_Set = 0 then"); - WBI (" Set_Features;"); - WBI (" end if;"); + Set_String (" Binder_Sec_Stacks_Count := "); + Set_Int (Num_Sec_Stacks); + Set_Char (';'); + Write_Statement_Buffer; - -- Features_Set may twiddle the heap size according to a logical - -- name, but the binder switch must override. + Set_String (" Default_Sized_SS_Pool := "); - if Opt.Heap_Size /= 0 then - Set_String (" Heap_Size := "); - Set_Int (Opt.Heap_Size); - Set_Char (';'); - Write_Statement_Buffer; + if Num_Sec_Stacks > 0 then + Set_String ("Sec_Default_Sized_Stacks'Address;"); + else + Set_String ("System.Null_Address;"); end if; + + Write_Statement_Buffer; + WBI (""); end if; + + -- Generate call to Runtime_Initialize + + WBI (" Runtime_Initialize (1);"); end if; -- Generate call to set Initialize_Scalar values if active @@ -938,19 +1048,8 @@ package body Bindgen is Write_Statement_Buffer; end if; - -- Generate assignment of default secondary stack size if set - - if Sec_Stack_Used and then Default_Sec_Stack_Size /= -1 then - WBI (""); - Set_String (" System.Secondary_Stack."); - Set_String ("Default_Secondary_Stack_Size := "); - Set_Int (Opt.Default_Sec_Stack_Size); - Set_Char (';'); - Write_Statement_Buffer; - end if; - - -- Initialize stack limit variable of the environment task if the - -- stack check method is stack limit and stack check is enabled. + -- 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) @@ -964,37 +1063,22 @@ package body Bindgen is if CodePeer_Mode then null; - -- On virtual machine targets, or on non-virtual machine ones if this - -- is the main program case, attach finalize_library to the soft link. - -- Do it only when not using a restricted run time, in which case tasks - -- are non-terminating, so we do not want library-level finalization. + -- If this is the main program case, attach finalize_library to the soft + -- link. Do it only when not using a restricted run time, in which case + -- tasks are non-terminating, so we do not want library-level + -- finalization. - elsif (VM_Target /= No_VM or else Bind_Main_Program) + elsif not Bind_For_Library and then not Configurable_Run_Time_On_Target and then not Suppress_Standard_Library_On_Target then WBI (""); - if VM_Target = No_VM then - if Lib_Final_Built then - Set_String (" Finalize_Library_Objects := "); - Set_String ("finalize_library'access;"); - else - Set_String (" Finalize_Library_Objects := null;"); - end if; - - -- On VM targets use regular Ada to set the soft link - + if Lib_Final_Built then + Set_String (" Finalize_Library_Objects := "); + Set_String ("finalize_library'access;"); else - if Lib_Final_Built then - Set_String - (" System.Soft_Links.Finalize_Library_Objects"); - Set_String (" := finalize_library'access;"); - else - Set_String - (" System.Soft_Links.Finalize_Library_Objects"); - Set_String (" := null;"); - end if; + Set_String (" Finalize_Library_Objects := null;"); end if; Write_Statement_Buffer; @@ -1006,57 +1090,106 @@ package body Bindgen is WBI (""); end if; - Gen_Elab_Calls; + Gen_Elab_Calls (Elab_Order); - -- Call System.Elaboration_Allocators.Mark_Start_Of_Elaboration if - -- restriction No_Standard_Allocators_After_Elaboration is active. + if not CodePeer_Mode then - if Cumulative_Restrictions.Set - (No_Standard_Allocators_After_Elaboration) - then - WBI (" System.Elaboration_Allocators.Mark_End_Of_Elaboration;"); - end if; + -- Call System.Elaboration_Allocators.Mark_Start_Of_Elaboration if + -- restriction No_Standard_Allocators_After_Elaboration is active. - -- From this point, no new dispatching domain can be created. + if Cumulative_Restrictions.Set + (No_Standard_Allocators_After_Elaboration) + then + WBI + (" System.Elaboration_Allocators.Mark_End_Of_Elaboration;"); + end if; - if Dispatching_Domains_Used then - WBI (" Freeze_Dispatching_Domains;"); - end if; + -- From this point, no new dispatching domain can be created - -- Sequential partition elaboration policy + if Dispatching_Domains_Used then + WBI (" Freeze_Dispatching_Domains;"); + end if; - if Partition_Elaboration_Policy_Specified = 'S' then - if System_Interrupts_Used then - WBI (" Install_Restricted_Handlers_Sequential;"); + -- Sequential partition elaboration policy + + if Partition_Elaboration_Policy_Specified = 'S' then + if System_Interrupts_Used then + WBI (" Install_Restricted_Handlers_Sequential;"); + end if; + + if System_Tasking_Restricted_Stages_Used then + WBI (" Activate_All_Tasks_Sequential;"); + end if; end if; - if System_Tasking_Restricted_Stages_Used then - WBI (" Activate_All_Tasks_Sequential;"); + if System_BB_CPU_Primitives_Multiprocessors_Used then + WBI (" Start_Slave_CPUs;"); end if; end if; - -- Case of main program is CIL function or procedure + WBI (" end " & Ada_Init_Name.all & ";"); + WBI (""); + end Gen_Adainit; - if VM_Target = CLI_Target - and then Bind_Main_Program - and then not No_Main_Subprogram - then - -- For function case, use Set_Exit_Status to set result + ------------------------- + -- Gen_Bind_Env_String -- + ------------------------- - if ALIs.Table (ALIs.First).Main_Program = Func then - WBI (" Result := Ada_Main_Program;"); - WBI (" Set_Exit_Status (Result);"); + procedure Gen_Bind_Env_String is + procedure Write_Name_With_Len (Nam : Name_Id); + -- Write Nam as a string literal, prefixed with one + -- character encoding Nam's length. - -- Procedure case + ------------------------- + -- Write_Name_With_Len -- + ------------------------- - else - WBI (" Ada_Main_Program;"); - end if; + procedure Write_Name_With_Len (Nam : Name_Id) is + begin + Get_Name_String (Nam); + + Start_String; + Store_String_Char (Character'Val (Name_Len)); + Store_String_Chars (Name_Buffer (1 .. Name_Len)); + + Write_String_Table_Entry (End_String); + end Write_Name_With_Len; + + -- Local variables + + Amp : Character; + KN : Name_Id := No_Name; + VN : Name_Id := No_Name; + + -- Start of processing for Gen_Bind_Env_String + + begin + Bind_Environment.Get_First (KN, VN); + + if VN = No_Name then + return; end if; - WBI (" end " & Ada_Init_Name.all & ";"); - WBI (""); - end Gen_Adainit; + Set_Special_Output (Write_Bind_Line'Access); + + WBI (" Bind_Env : aliased constant String :="); + Amp := ' '; + while VN /= No_Name loop + Write_Str (" " & Amp & ' '); + Write_Name_With_Len (KN); + Write_Str (" & "); + Write_Name_With_Len (VN); + Write_Eol; + + Bind_Environment.Get_Next (KN, VN); + Amp := '&'; + end loop; + WBI (" & ASCII.NUL;"); + + Cancel_Special_Output; + + Bind_Env_String_Built := True; + end Gen_Bind_Env_String; -------------------------- -- Gen_CodePeer_Wrapper -- @@ -1085,15 +1218,15 @@ package body Bindgen is -- Gen_Elab_Calls -- -------------------- - procedure Gen_Elab_Calls is + procedure Gen_Elab_Calls (Elab_Order : Unit_Id_Array) is Check_Elab_Flag : Boolean; begin -- Loop through elaboration order entries - for E in Elab_Order.First .. Elab_Order.Last loop + for E in Elab_Order'Range loop declare - Unum : constant Unit_Id := Elab_Order.Table (E); + Unum : constant Unit_Id := Elab_Order (E); U : Unit_Record renames Units.Table (Unum); Unum_Spec : Unit_Id; @@ -1137,46 +1270,21 @@ package body Bindgen is then -- In the case of a body with a separate spec, where the -- separate spec has an elaboration entity defined, this is - -- where we increment the elaboration entity if one exists + -- where we increment the elaboration entity if one exists. + + -- Likewise for lone specs with an elaboration entity defined + -- despite No_Elaboration_Code, e.g. when requested to preserve + -- control flow. - if U.Utype = Is_Body + if (U.Utype = Is_Body or else U.Utype = Is_Spec_Only) and then Units.Table (Unum_Spec).Set_Elab_Entity and then not CodePeer_Mode then Set_String (" E"); Set_Unit_Number (Unum_Spec); - - -- The AAMP target has no notion of shared libraries, and - -- there's no possibility of reelaboration, so we treat the - -- the elaboration var as a flag instead of a counter and - -- simply set it. - - if AAMP_On_Target then - Set_String (" := 1;"); - - -- Otherwise (normal case), increment elaboration counter - - else - Set_String (" := E"); - Set_Unit_Number (Unum_Spec); - Set_String (" + 1;"); - end if; - - Write_Statement_Buffer; - - -- In the special case where the target is AAMP and the unit is - -- a spec with a body, the elaboration entity is initialized - -- here. This is done because it's the only way to accomplish - -- initialization of such entities, as there is no mechanism - -- for load time global variable initialization on AAMP. - - elsif AAMP_On_Target - and then U.Utype = Is_Spec - and then Units.Table (Unum_Spec).Set_Elab_Entity - then - Set_String (" E"); + Set_String (" := E"); Set_Unit_Number (Unum_Spec); - Set_String (" := 0;"); + Set_String (" + 1;"); Write_Statement_Buffer; end if; @@ -1200,22 +1308,6 @@ package body Bindgen is -- variables, only calls to 'Elab* subprograms. else - -- In the special case where the target is AAMP and the unit is - -- a spec with a body, the elaboration entity is initialized - -- here. This is done because it's the only way to accomplish - -- initialization of such entities, as there is no mechanism - -- for load time global variable initialization on AAMP. - - if AAMP_On_Target - and then U.Utype = Is_Spec - and then Units.Table (Unum_Spec).Set_Elab_Entity - then - Set_String (" E"); - Set_Unit_Number (Unum_Spec); - Set_String (" := 0;"); - Write_Statement_Buffer; - end if; - -- Check incompatibilities with No_Multiple_Elaboration if not CodePeer_Mode @@ -1264,37 +1356,24 @@ package body Bindgen is Set_String (" "); Get_Decoded_Name_String_With_Brackets (U.Uname); - if VM_Target = CLI_Target and then U.Unit_Kind /= 's' then - if Name_Buffer (Name_Len) = 's' then - Name_Buffer (Name_Len - 1 .. Name_Len + 12) := - "_pkg'elab_spec"; - else - Name_Buffer (Name_Len - 1 .. Name_Len + 12) := - "_pkg'elab_body"; - end if; + if Name_Buffer (Name_Len) = 's' then + Name_Buffer (Name_Len - 1 .. Name_Len + 8) := + "'elab_spec"; + Name_Len := Name_Len + 8; + + -- Special case in CodePeer mode for subprogram bodies + -- which correspond to CodePeer 'Elab_Subp_Body special + -- init procedure. - Name_Len := Name_Len + 12; + elsif U.Unit_Kind = 's' and CodePeer_Mode then + Name_Buffer (Name_Len - 1 .. Name_Len + 13) := + "'elab_subp_body"; + Name_Len := Name_Len + 13; else - if Name_Buffer (Name_Len) = 's' then - Name_Buffer (Name_Len - 1 .. Name_Len + 8) := - "'elab_spec"; - Name_Len := Name_Len + 8; - - -- Special case in CodePeer mode for subprogram bodies - -- which correspond to CodePeer 'Elab_Subp_Body special - -- init procedure. - - elsif U.Unit_Kind = 's' and CodePeer_Mode then - Name_Buffer (Name_Len - 1 .. Name_Len + 13) := - "'elab_subp_body"; - Name_Len := Name_Len + 13; - - else - Name_Buffer (Name_Len - 1 .. Name_Len + 8) := - "'elab_body"; - Name_Len := Name_Len + 8; - end if; + Name_Buffer (Name_Len - 1 .. Name_Len + 8) := + "'elab_body"; + Name_Len := Name_Len + 8; end if; Set_Casing (U.Icasing); @@ -1312,23 +1391,9 @@ package body Bindgen is then Set_String (" E"); Set_Unit_Number (Unum_Spec); - - -- The AAMP target has no notion of shared libraries, and - -- there's no possibility of reelaboration, so we treat the - -- the elaboration var as a flag instead of a counter and - -- simply set it. - - if AAMP_On_Target then - Set_String (" := 1;"); - - -- Otherwise (normal case), increment elaboration counter - - else - Set_String (" := E"); - Set_Unit_Number (Unum_Spec); - Set_String (" + 1;"); - end if; - + Set_String (" := E"); + Set_Unit_Number (Unum_Spec); + Set_String (" + 1;"); Write_Statement_Buffer; end if; end if; @@ -1340,15 +1405,15 @@ package body Bindgen is -- Gen_Elab_Externals -- ------------------------ - procedure Gen_Elab_Externals is + procedure Gen_Elab_Externals (Elab_Order : Unit_Id_Array) is begin if CodePeer_Mode then return; end if; - for E in Elab_Order.First .. Elab_Order.Last loop + for E in Elab_Order'Range loop declare - Unum : constant Unit_Id := Elab_Order.Table (E); + Unum : constant Unit_Id := Elab_Order (E); U : Unit_Record renames Units.Table (Unum); begin @@ -1367,54 +1432,14 @@ package body Bindgen is (No_Run_Time_Mode and then Is_Predefined_File_Name (U.Sfile)) then + Get_Name_String (U.Sfile); Set_String (" "); Set_String ("E"); Set_Unit_Number (Unum); - - case VM_Target is - when No_VM | JVM_Target => - Set_String (" : Short_Integer; pragma Import (Ada, "); - when CLI_Target => - Set_String (" : Short_Integer; pragma Import (CIL, "); - end case; - - Set_String ("E"); + Set_String (" : Short_Integer; pragma Import (Ada, E"); Set_Unit_Number (Unum); Set_String (", """); Get_Name_String (U.Uname); - - -- In the case of JGNAT we need to emit an Import name that - -- includes the class name (using '$' separators in the case - -- of a child unit name). - - if VM_Target /= No_VM then - for J in 1 .. Name_Len - 2 loop - if VM_Target = CLI_Target - or else Name_Buffer (J) /= '.' - then - Set_Char (Name_Buffer (J)); - else - Set_String ("$"); - end if; - end loop; - - if VM_Target /= CLI_Target or else U.Unit_Kind = 's' then - Set_String ("."); - else - Set_String ("_pkg."); - end if; - - -- If the unit name is very long, then split the - -- Import link name across lines using "&" (occurs - -- in some C2 tests). - - if 2 * Name_Len + 60 > Hostparm.Max_Line_Length then - Set_String (""" &"); - Write_Statement_Buffer; - Set_String (" """); - end if; - end if; - Set_Unit_Name; Set_String ("_E"");"); Write_Statement_Buffer; @@ -1429,31 +1454,26 @@ package body Bindgen is -- Gen_Elab_Order -- -------------------- - procedure Gen_Elab_Order is + procedure Gen_Elab_Order (Elab_Order : Unit_Id_Array) is begin + WBI (""); WBI (" -- BEGIN ELABORATION ORDER"); - for J in Elab_Order.First .. Elab_Order.Last loop + for J in Elab_Order'Range loop Set_String (" -- "); - Get_Name_String (Units.Table (Elab_Order.Table (J)).Uname); + Get_Name_String (Units.Table (Elab_Order (J)).Uname); Set_Name_Buffer; Write_Statement_Buffer; end loop; WBI (" -- END ELABORATION ORDER"); - WBI (""); end Gen_Elab_Order; -------------------------- -- Gen_Finalize_Library -- -------------------------- - procedure Gen_Finalize_Library is - Count : Int := 1; - U : Unit_Record; - Uspec : Unit_Record; - Unum : Unit_Id; - + procedure Gen_Finalize_Library (Elab_Order : Unit_Id_Array) is procedure Gen_Header; -- Generate the header of the finalization routine @@ -1467,6 +1487,13 @@ package body Bindgen is WBI (" begin"); end Gen_Header; + -- Local variables + + Count : Int := 1; + U : Unit_Record; + Uspec : Unit_Record; + Unum : Unit_Id; + -- Start of processing for Gen_Finalize_Library begin @@ -1474,8 +1501,8 @@ package body Bindgen is return; end if; - for E in reverse Elab_Order.First .. Elab_Order.Last loop - Unum := Elab_Order.Table (E); + for E in reverse Elab_Order'Range loop + Unum := Elab_Order (E); U := Units.Table (Unum); -- Dealing with package bodies is a little complicated. In such @@ -1543,46 +1570,15 @@ package body Bindgen is Write_Statement_Buffer; -- Generate: - -- pragma Import (CIL, F, - -- "xx.yy_pkg.xx__yy__finalize_[body|spec]"); - -- -- for .NET targets - - -- pragma Import (Java, F, - -- "xx$yy.xx__yy__finalize_[body|spec]"); - -- -- for JVM targets - -- pragma Import (Ada, F, -- "xx__yy__finalize_[body|spec]"); - -- -- for default targets - - if VM_Target = CLI_Target then - Set_String (" pragma Import (CIL, F"); - elsif VM_Target = JVM_Target then - Set_String (" pragma Import (Java, F"); - else - Set_String (" pragma Import (Ada, F"); - end if; + Set_String (" pragma Import (Ada, F"); Set_Int (Count); Set_String (", """); -- Perform name construction - -- .NET xx.yy_pkg.xx__yy__finalize - - if VM_Target = CLI_Target then - Set_Unit_Name (Mode => Dot); - Set_String ("_pkg."); - - -- JVM xx$yy.xx__yy__finalize - - elsif VM_Target = JVM_Target then - Set_Unit_Name (Mode => Dollar_Sign); - Set_Char ('.'); - end if; - - -- Default xx__yy__finalize - Set_Unit_Name; Set_String ("__finalize_"); @@ -1662,31 +1658,17 @@ package body Bindgen is -- raised an exception. In that case import the actual exception -- and the routine necessary to raise it. - if VM_Target = No_VM then - WBI (" declare"); - WBI (" procedure Reraise_Library_Exception_If_Any;"); - - Set_String (" pragma Import (Ada, "); - Set_String ("Reraise_Library_Exception_If_Any, "); - Set_String ("""__gnat_reraise_library_exception_if_any"");"); - Write_Statement_Buffer; - - WBI (" begin"); - WBI (" Reraise_Library_Exception_If_Any;"); - WBI (" end;"); + WBI (" declare"); + WBI (" procedure Reraise_Library_Exception_If_Any;"); - -- VM-specific code, use regular Ada to produce the desired behavior - - else - WBI (" if System.Soft_Links.Library_Exception_Set then"); - - Set_String (" Ada.Exceptions.Reraise_Occurrence ("); - Set_String ("System.Soft_Links.Library_Exception);"); - Write_Statement_Buffer; - - WBI (" end if;"); - end if; + Set_String (" pragma Import (Ada, "); + Set_String ("Reraise_Library_Exception_If_Any, "); + Set_String ("""__gnat_reraise_library_exception_if_any"");"); + Write_Statement_Buffer; + WBI (" begin"); + WBI (" Reraise_Library_Exception_If_Any;"); + WBI (" end;"); WBI (" end finalize_library;"); WBI (""); end if; @@ -1819,17 +1801,22 @@ package body Bindgen is end if; end if; - -- Generate a reference to Ada_Main_Program_Name. This symbol is - -- not referenced elsewhere in the generated program, but is needed - -- by the debugger (that's why it is generated in the first place). - -- The reference stops Ada_Main_Program_Name from being optimized - -- away by smart linkers, such as the AiX linker. + -- Generate a reference to Ada_Main_Program_Name. This symbol is not + -- referenced elsewhere in the generated program, but is needed by + -- the debugger (that's why it is generated in the first place). The + -- reference stops Ada_Main_Program_Name from being optimized away by + -- smart linkers. -- Because this variable is unused, we make this variable "aliased" -- with a pragma Volatile in order to tell the compiler to preserve -- this variable at any level of optimization. - if Bind_Main_Program and not CodePeer_Mode then + -- CodePeer and CCG do not need this extra code on the other hand. + + if Bind_Main_Program + and then not CodePeer_Mode + and then not Generate_C_Code + then WBI (" Ensure_Reference : aliased System.Address := " & "Ada_Main_Program_Name'Address;"); WBI (" pragma Volatile (Ensure_Reference);"); @@ -1849,9 +1836,9 @@ package body Bindgen is WBI (" gnat_envp := envp;"); WBI (""); - -- If configurable run time and no command line args, then nothing - -- needs to be done since the gnat_argc/argv/envp variables are - -- suppressed in this case. + -- If configurable run time and no command line args, then nothing needs + -- to be done since the gnat_argc/argv/envp variables are suppressed in + -- this case. elsif Configurable_Run_Time_On_Target then null; @@ -1952,11 +1939,11 @@ package body Bindgen is -- Gen_Object_Files_Options -- ------------------------------ - procedure Gen_Object_Files_Options is + procedure Gen_Object_Files_Options (Elab_Order : Unit_Id_Array) is Lgnat : Natural; - -- This keeps track of the position in the sorted set of entries - -- in the Linker_Options table of where the first entry from an - -- internal file appears. + -- This keeps track of the position in the sorted set of entries in the + -- Linker_Options table of where the first entry from an internal file + -- appears. Linker_Option_List_Started : Boolean := False; -- Set to True when "LINKER OPTION LIST" is displayed @@ -2021,17 +2008,17 @@ package body Bindgen is Set_List_File (Object_List_Filename.all); end if; - for E in Elab_Order.First .. Elab_Order.Last loop + for E in Elab_Order'Range loop -- If not spec that has an associated body, then generate a comment -- giving the name of the corresponding object file. - if not Units.Table (Elab_Order.Table (E)).SAL_Interface - and then Units.Table (Elab_Order.Table (E)).Utype /= Is_Spec + if not Units.Table (Elab_Order (E)).SAL_Interface + and then Units.Table (Elab_Order (E)).Utype /= Is_Spec then Get_Name_String (ALIs.Table - (Units.Table (Elab_Order.Table (E)).My_ALI).Ofile_Full_Name); + (Units.Table (Elab_Order (E)).My_ALI).Ofile_Full_Name); -- If the presence of an object file is necessary or if it exists, -- then use it. @@ -2055,17 +2042,32 @@ package body Bindgen is end if; -- Add a "-Ldir" for each directory in the object path - if VM_Target /= CLI_Target then - for J in 1 .. Nb_Dir_In_Obj_Search_Path loop - declare - Dir : constant String_Ptr := Dir_In_Obj_Search_Path (J); - begin - Name_Len := 0; - Add_Str_To_Name_Buffer ("-L"); - Add_Str_To_Name_Buffer (Dir.all); - Write_Linker_Option; - end; - end loop; + + for J in 1 .. Nb_Dir_In_Obj_Search_Path loop + declare + Dir : constant String_Ptr := Dir_In_Obj_Search_Path (J); + + begin + Name_Len := 0; + Add_Str_To_Name_Buffer ("-L"); + Add_Str_To_Name_Buffer (Dir.all); + Write_Linker_Option; + end; + end loop; + + if not (Opt.No_Run_Time_Mode or Opt.No_Stdlib) then + Name_Len := 0; + + if Opt.Shared_Libgnat then + Add_Str_To_Name_Buffer ("-shared"); + else + Add_Str_To_Name_Buffer ("-static"); + end if; + + -- Write directly to avoid inclusion in -K output as -static and + -- -shared are not usually specified linker options. + + WBI (" -- " & Name_Buffer (1 .. Name_Len)); end if; -- Sort linker options @@ -2120,36 +2122,12 @@ package body Bindgen is -- files. The reason for this decision is that libraries referenced -- by internal routines may reference these standard library entries. - -- Note that we do not insert anything when pragma No_Run_Time has been - -- specified or when the standard libraries are not to be used, - -- otherwise on some platforms, such as VMS, we may get duplicate - -- symbols when linking. + -- Note that we do not insert anything when pragma No_Run_Time has + -- been specified or when the standard libraries are not to be used, + -- otherwise on some platforms, we may get duplicate symbols when + -- linking (not clear if this is still the case, but it is harmless). if not (Opt.No_Run_Time_Mode or else Opt.No_Stdlib) then - Name_Len := 0; - - if Opt.Shared_Libgnat then - Add_Str_To_Name_Buffer ("-shared"); - else - Add_Str_To_Name_Buffer ("-static"); - end if; - - -- Write directly to avoid -K output (why???) - - WBI (" -- " & Name_Buffer (1 .. Name_Len)); - - if With_DECGNAT then - Name_Len := 0; - - if Opt.Shared_Libgnat then - Add_Str_To_Name_Buffer (Shared_Lib ("decgnat")); - else - Add_Str_To_Name_Buffer ("-ldecgnat"); - end if; - - Write_Linker_Option; - end if; - if With_GNARL then Name_Len := 0; @@ -2191,7 +2169,10 @@ package body Bindgen is -- Gen_Output_File -- --------------------- - procedure Gen_Output_File (Filename : String) is + procedure Gen_Output_File + (Filename : String; + Elab_Order : Unit_Id_Array) + is begin -- Acquire settings for Interrupt_State pragmas @@ -2201,12 +2182,6 @@ package body Bindgen is Set_PSD_Pragma_Table; - -- For JGNAT the main program is already generated by the compiler - - if VM_Target = JVM_Target then - Bind_Main_Program := False; - end if; - -- Override time slice value if -T switch is set if Time_Slice_Set then @@ -2215,31 +2190,53 @@ package body Bindgen is -- Count number of elaboration calls - for E in Elab_Order.First .. Elab_Order.Last loop - if Units.Table (Elab_Order.Table (E)).No_Elab then + for E in Elab_Order'Range loop + if Units.Table (Elab_Order (E)).No_Elab then null; else Num_Elab_Calls := Num_Elab_Calls + 1; end if; end loop; + -- Count the number of statically allocated stacks to be generated by + -- the binder. If the user has specified the number of default-sized + -- secondary stacks, use that number. Otherwise start the count at one + -- as the binder is responsible for creating a secondary stack for the + -- main task. + + if Opt.Quantity_Of_Default_Size_Sec_Stacks /= -1 then + Num_Sec_Stacks := Quantity_Of_Default_Size_Sec_Stacks; + elsif Sec_Stack_Used then + Num_Sec_Stacks := 1; + end if; + + for J in Units.First .. Units.Last loop + Num_Primary_Stacks := + Num_Primary_Stacks + Units.Table (J).Primary_Stack_Count; + + Num_Sec_Stacks := + Num_Sec_Stacks + Units.Table (J).Sec_Stack_Count; + end loop; + -- Generate output file in appropriate language - Gen_Output_File_Ada (Filename); + Gen_Output_File_Ada (Filename, Elab_Order); end Gen_Output_File; ------------------------- -- Gen_Output_File_Ada -- ------------------------- - procedure Gen_Output_File_Ada (Filename : String) is - + procedure Gen_Output_File_Ada + (Filename : String; Elab_Order : Unit_Id_Array) + is Ada_Main : constant String := Get_Ada_Main_Name; -- Name to be used for generated Ada main program. See the body of -- function Get_Ada_Main_Name for details on the form of the name. Needs_Library_Finalization : constant Boolean := - not Configurable_Run_Time_On_Target and then Has_Finalizer; + not Configurable_Run_Time_On_Target + and then Has_Finalizer (Elab_Order); -- For restricted run-time libraries (ZFP and Ravenscar) tasks are -- non-terminating, so we do not want finalization. @@ -2258,6 +2255,7 @@ package body Bindgen is -- handle use of Ada 2005 keywords as identifiers in Ada 95 mode. None -- of the Ada 2005 or Ada 2012 constructs are needed by the binder file. + WBI ("pragma Warnings (Off);"); WBI ("pragma Ada_95;"); -- If we are operating in Restrictions (No_Exception_Handlers) mode, @@ -2290,71 +2288,65 @@ package body Bindgen is WBI ("with System.Scalar_Values;"); end if; - -- Generate with of System.Secondary_Stack if active + -- Generate withs of System.Secondary_Stack and System.Parameters to + -- allow the generation of the default-sized secondary stack pool. - if Sec_Stack_Used and then Default_Sec_Stack_Size /= -1 then + if Sec_Stack_Used then + WBI ("with System.Parameters;"); WBI ("with System.Secondary_Stack;"); end if; - Resolve_Binder_Options; + Resolve_Binder_Options (Elab_Order); - -- Usually, adafinal is called using a pragma Import C. Since Import C - -- doesn't have the same semantics for VMs or CodePeer use standard Ada. + -- Generate standard with's if not Suppress_Standard_Library_On_Target then if CodePeer_Mode then WBI ("with System.Standard_Library;"); - elsif VM_Target /= No_VM then - WBI ("with System.Soft_Links;"); - WBI ("with System.Standard_Library;"); end if; end if; WBI ("package " & Ada_Main & " is"); - WBI (" pragma Warnings (Off);"); -- Main program case if Bind_Main_Program then - if VM_Target = No_VM then + -- Generate argc/argv stuff unless suppressed + + if Command_Line_Args_On_Target + or not Configurable_Run_Time_On_Target + then + WBI (""); + WBI (" gnat_argc : Integer;"); + WBI (" gnat_argv : System.Address;"); + WBI (" gnat_envp : System.Address;"); - -- Generate argc/argv stuff unless suppressed + -- If the standard library is not suppressed, these variables + -- are in the run-time data area for easy run time access. - if Command_Line_Args_On_Target - or not Configurable_Run_Time_On_Target - then + if not Suppress_Standard_Library_On_Target then WBI (""); - WBI (" gnat_argc : Integer;"); - WBI (" gnat_argv : System.Address;"); - WBI (" gnat_envp : System.Address;"); - - -- If the standard library is not suppressed, these variables - -- are in the run-time data area for easy run time access. - - if not Suppress_Standard_Library_On_Target then - WBI (""); - WBI (" pragma Import (C, gnat_argc);"); - WBI (" pragma Import (C, gnat_argv);"); - WBI (" pragma Import (C, gnat_envp);"); - end if; + WBI (" pragma Import (C, gnat_argc);"); + WBI (" pragma Import (C, gnat_argv);"); + WBI (" pragma Import (C, gnat_envp);"); end if; + end if; - -- Define exit status. Again in normal mode, this is in the - -- run-time library, and is initialized there, but in the - -- configurable runtime case, the variable is declared and - -- initialized in this file. - - WBI (""); + -- Define exit status. Again in normal mode, this is in the run-time + -- library, and is initialized there, but in the configurable + -- run-time case, the variable is declared and initialized in this + -- file. - if Configurable_Run_Time_Mode then - if Exit_Status_Supported_On_Target then - WBI (" gnat_exit_status : Integer := 0;"); - end if; + WBI (""); - else - WBI (" gnat_exit_status : Integer;"); - WBI (" pragma Import (C, gnat_exit_status);"); + if Configurable_Run_Time_Mode then + if Exit_Status_Supported_On_Target then + WBI (" gnat_exit_status : Integer := 0;"); end if; + + else + WBI (" gnat_exit_status : Integer;"); + WBI (" pragma Import (C, gnat_exit_status);"); end if; -- Generate the GNAT_Version and Ada_Main_Program_Name info only for @@ -2374,12 +2366,8 @@ package body Bindgen is Set_String (" Ada_Main_Program_Name : constant String := """); Get_Name_String (Units.Table (First_Unit_Entry).Uname); - if VM_Target = No_VM then - Set_Main_Program_Name; - Set_String (""" & ASCII.NUL;"); - else - Set_String (Name_Buffer (1 .. Name_Len - 2) & """;"); - end if; + Set_Main_Program_Name; + Set_String (""" & ASCII.NUL;"); Write_Statement_Buffer; @@ -2411,7 +2399,7 @@ package body Bindgen is end if; end if; - if Bind_Main_Program and then VM_Target = No_VM then + if Bind_Main_Program then WBI (""); @@ -2451,8 +2439,17 @@ package body Bindgen is Get_Main_Name & """);"); end if; - Gen_Versions; - Gen_Elab_Order; + -- Generate version numbers for units, only if needed. Be very safe on + -- the condition. + + if not Configurable_Run_Time_On_Target + or else System_Version_Control_Used + or else not Bind_Main_Program + then + Gen_Versions; + end if; + + Gen_Elab_Order (Elab_Order); -- Spec is complete @@ -2468,6 +2465,7 @@ package body Bindgen is -- handle use of Ada 2005 keywords as identifiers in Ada 95 mode. None -- of the Ada 2005/2012 constructs are needed by the binder file. + WBI ("pragma Warnings (Off);"); WBI ("pragma Ada_95;"); -- Output Source_File_Name pragmas which look like @@ -2530,12 +2528,34 @@ package body Bindgen is WBI (""); WBI ("package body " & Ada_Main & " is"); - WBI (" pragma Warnings (Off);"); WBI (""); -- Generate externals for elaboration entities - Gen_Elab_Externals; + Gen_Elab_Externals (Elab_Order); + + -- Generate default-sized secondary stacks pool. At least one stack is + -- created and assigned to the environment task if secondary stacks are + -- used by the program. + + if Sec_Stack_Used then + Set_String (" Sec_Default_Sized_Stacks"); + Set_String (" : array (1 .. "); + Set_Int (Num_Sec_Stacks); + Set_String (") of aliased System.Secondary_Stack.SS_Stack ("); + + if Opt.Default_Sec_Stack_Size /= No_Stack_Size then + Set_Int (Opt.Default_Sec_Stack_Size); + else + Set_String ("System.Parameters.Runtime_Default_Sec_Stack_Size"); + end if; + + Set_String (");"); + Write_Statement_Buffer; + WBI (""); + end if; + + -- Generate reference if not CodePeer_Mode then if not Suppress_Standard_Library_On_Target then @@ -2566,13 +2586,18 @@ package body Bindgen is WBI (""); end if; - -- The B.1 (39) implementation advice says that the adainit/adafinal - -- routines should be idempotent. Generate a flag to ensure that. - -- This is not needed if we are suppressing the standard library - -- since it would never be referenced. - if not Suppress_Standard_Library_On_Target then + + -- The B.1(39) implementation advice says that the adainit and + -- adafinal routines should be idempotent. Generate a flag to + -- ensure that. This is not needed if we are suppressing the + -- standard library since it would never be referenced. + WBI (" Is_Elaborated : Boolean := False;"); + + -- Generate bind environment string + + Gen_Bind_Env_String; end if; WBI (""); @@ -2582,21 +2607,21 @@ package body Bindgen is if not Cumulative_Restrictions.Set (No_Finalization) then if Needs_Library_Finalization then - Gen_Finalize_Library; + Gen_Finalize_Library (Elab_Order); end if; Gen_Adafinal; end if; - Gen_Adainit; + Gen_Adainit (Elab_Order); - if Bind_Main_Program and then VM_Target = No_VM then + if Bind_Main_Program then Gen_Main; end if; -- Output object file list and the Ada body is complete - Gen_Object_Files_Options; + Gen_Object_Files_Options (Elab_Order); WBI (""); WBI ("end " & Ada_Main & ";"); @@ -2726,8 +2751,8 @@ package body Bindgen is WBI (" type Version_32 is mod 2 ** 32;"); for U in Units.First .. Units.Last loop if not Units.Table (U).SAL_Interface - and then - (not Bind_For_Library or else Units.Table (U).Directly_Scanned) + and then (not Bind_For_Library + or else Units.Table (U).Directly_Scanned) then Increment_Ubuf; WBI (" " & Ubuf & " : constant Version_32 := 16#" & @@ -2787,25 +2812,20 @@ package body Bindgen is function Get_Ada_Main_Name return String is Suffix : constant String := "_00"; Name : String (1 .. Opt.Ada_Main_Name.all'Length + Suffix'Length) := - Opt.Ada_Main_Name.all & Suffix; + Opt.Ada_Main_Name.all & Suffix; Nlen : Natural; begin - -- The main program generated by JGNAT expects a package called - -- ada_
. - if VM_Target /= No_VM then - Get_Name_String (Units.Table (First_Unit_Entry).Uname); - return "ada_" & Get_Main_Unit_Name (Name_Buffer (1 .. Name_Len - 2)); - end if; + -- For CodePeer, we want reproducible names (independent of other mains + -- that may or may not be present) that don't collide when analyzing + -- multiple mains and which are easily recognizable as "ada_main" names. - -- For CodePeer, we want reproducible names (independent of other - -- mains that may or may not be present) that don't collide - -- when analyzing multiple mains and which are easily recognizable - -- as "ada_main" names. if CodePeer_Mode then Get_Name_String (Units.Table (First_Unit_Entry).Uname); - return "ada_main_for_" & - Get_Main_Unit_Name (Name_Buffer (1 .. Name_Len - 2)); + + return + "ada_main_for_" & + Get_Main_Unit_Name (Name_Buffer (1 .. Name_Len - 2)); end if; -- This loop tries the following possibilities in order @@ -2909,7 +2929,7 @@ package body Bindgen is -- every file, then we could use the encoding of the initial specified -- file, but this information is passed only for potential main -- programs. We could fix this sometime, but it is a very minor point - -- (wide character default encoding for [Wide_[Wide_]Text_IO when there + -- (wide character default encoding for [Wide_[Wide_]]Text_IO when there -- is no main program). elsif No_Main_Subprogram then @@ -2926,13 +2946,13 @@ package body Bindgen is -- Has_Finalizer -- ------------------- - function Has_Finalizer return Boolean is + function Has_Finalizer (Elab_Order : Unit_Id_Array) return Boolean is U : Unit_Record; Unum : Unit_Id; begin - for E in reverse Elab_Order.First .. Elab_Order.Last loop - Unum := Elab_Order.Table (E); + for E in reverse Elab_Order'Range loop + Unum := Elab_Order (E); U := Units.Table (Unum); -- We are only interested in non-generic packages @@ -2949,11 +2969,20 @@ package body Bindgen is return False; end Has_Finalizer; + ---------- + -- Hash -- + ---------- + + function Hash (Nam : Name_Id) return Header_Num is + begin + return Int (Nam - Names_Low_Bound) rem Header_Num'Last; + end Hash; + ---------------------- -- Lt_Linker_Option -- ---------------------- - function Lt_Linker_Option (Op1, Op2 : Natural) return Boolean is + function Lt_Linker_Option (Op1 : Natural; Op2 : Natural) return Boolean is begin -- Sort internal files last @@ -2975,7 +3004,6 @@ package body Bindgen is return Units.Table (Linker_Options.Table (Op1).Unit).Elab_Position > Units.Table (Linker_Options.Table (Op2).Unit).Elab_Position; - end if; end Lt_Linker_Option; @@ -2992,12 +3020,11 @@ package body Bindgen is -- Resolve_Binder_Options -- ---------------------------- - procedure Resolve_Binder_Options is - + procedure Resolve_Binder_Options (Elab_Order : Unit_Id_Array) is procedure Check_Package (Var : in out Boolean; Name : String); -- Set Var to true iff the current identifier in Namet is Name. Do - -- nothing if it doesn't match. This procedure is just an helper to - -- avoid to explicitely deal with length. + -- nothing if it doesn't match. This procedure is just a helper to + -- avoid explicitly dealing with length. ------------------- -- Check_Package -- @@ -3012,11 +3039,11 @@ package body Bindgen is end if; end Check_Package; - -- Start of processing for Check_Package + -- Start of processing for Resolve_Binder_Options begin - for E in Elab_Order.First .. Elab_Order.Last loop - Get_Name_String (Units.Table (Elab_Order.Table (E)).Uname); + for E in Elab_Order'Range loop + Get_Name_String (Units.Table (Elab_Order (E)).Uname); -- This is not a perfect approach, but is the current protocol -- between the run-time and the binder to indicate that tasking is @@ -3025,12 +3052,6 @@ package body Bindgen is Check_Package (With_GNARL, "system.os_interface%s"); - -- Ditto for declib and the "dec" package - - if OpenVMS_On_Target then - Check_Package (With_DECGNAT, "dec%s"); - end if; - -- Ditto for the use of restricted tasking Check_Package @@ -3050,23 +3071,61 @@ package body Bindgen is -- Ditto for the use of restrictions Check_Package (System_Restrictions_Used, "system.restrictions%s"); + + -- Ditto for the use of System.Secondary_Stack + + Check_Package + (System_Secondary_Stack_Used, "system.secondary_stack%s"); + + -- Ditto for use of an SMP bareboard runtime + + Check_Package (System_BB_CPU_Primitives_Multiprocessors_Used, + "system.bb.cpu_primitives.multiprocessors%s"); + + -- Ditto for System.Version_Control, which is used for Version and + -- Body_Version attributes. + + Check_Package (System_Version_Control_Used, + "system.version_control%s"); end loop; end Resolve_Binder_Options; + ------------------ + -- Set_Bind_Env -- + ------------------ + + procedure Set_Bind_Env (Key, Value : String) is + begin + -- The lengths of Key and Value are stored as single bytes + + if Key'Length > 255 then + Osint.Fail ("bind environment key """ & Key & """ too long"); + end if; + + if Value'Length > 255 then + Osint.Fail ("bind environment value """ & Value & """ too long"); + end if; + + Bind_Environment.Set (Name_Find (Key), Name_Find (Value)); + end Set_Bind_Env; + ----------------- -- Set_Boolean -- ----------------- procedure Set_Boolean (B : Boolean) is - True_Str : constant String := "True"; False_Str : constant String := "False"; + True_Str : constant String := "True"; + begin if B then - Statement_Buffer (Last + 1 .. Last + True_Str'Length) := True_Str; - Last := Last + True_Str'Length; + Statement_Buffer (Stm_Last + 1 .. Stm_Last + True_Str'Length) := + True_Str; + Stm_Last := Stm_Last + True_Str'Length; else - Statement_Buffer (Last + 1 .. Last + False_Str'Length) := False_Str; - Last := Last + False_Str'Length; + Statement_Buffer (Stm_Last + 1 .. Stm_Last + False_Str'Length) := + False_Str; + Stm_Last := Stm_Last + False_Str'Length; end if; end Set_Boolean; @@ -3076,8 +3135,8 @@ package body Bindgen is procedure Set_Char (C : Character) is begin - Last := Last + 1; - Statement_Buffer (Last) := C; + Stm_Last := Stm_Last + 1; + Statement_Buffer (Stm_Last) := C; end Set_Char; ------------- @@ -3095,8 +3154,8 @@ package body Bindgen is Set_Int (N / 10); end if; - Last := Last + 1; - Statement_Buffer (Last) := + Stm_Last := Stm_Last + 1; + Statement_Buffer (Stm_Last) := Character'Val (N mod 10 + Character'Pos ('0')); end if; end Set_Int; @@ -3113,9 +3172,9 @@ package body Bindgen is loop declare Inum : constant Int := - Interrupt_States.Table (K).Interrupt_Id; + Interrupt_States.Table (K).Interrupt_Id; Stat : constant Character := - Interrupt_States.Table (K).Interrupt_State; + Interrupt_States.Table (K).Interrupt_State; begin while IS_Pragma_Settings.Last < Inum loop @@ -3136,8 +3195,8 @@ package body Bindgen is begin -- Note that name has %b on the end which we ignore - -- First we output the initial _ada_ since we know that the main - -- program is a library level subprogram. + -- First we output the initial _ada_ since we know that the main program + -- is a library level subprogram. Set_String ("_ada_"); @@ -3196,8 +3255,8 @@ package body Bindgen is procedure Set_String (S : String) is begin - Statement_Buffer (Last + 1 .. Last + S'Length) := S; - Last := Last + S'Length; + Statement_Buffer (Stm_Last + 1 .. Stm_Last + S'Length) := S; + Stm_Last := Stm_Last + S'Length; end Set_String; ------------------------ @@ -3206,24 +3265,18 @@ package body Bindgen is procedure Set_String_Replace (S : String) is begin - Statement_Buffer (Last - S'Length + 1 .. Last) := S; + Statement_Buffer (Stm_Last - S'Length + 1 .. Stm_Last) := S; end Set_String_Replace; ------------------- -- Set_Unit_Name -- ------------------- - procedure Set_Unit_Name (Mode : Qualification_Mode := Double_Underscores) is + procedure Set_Unit_Name is begin for J in 1 .. Name_Len - 2 loop if Name_Buffer (J) = '.' then - if Mode = Double_Underscores then - Set_String ("__"); - elsif Mode = Dot then - Set_Char ('.'); - else - Set_Char ('$'); - end if; + Set_String ("__"); else Set_Char (Name_Buffer (J)); end if; @@ -3250,14 +3303,25 @@ package body Bindgen is Set_Int (Unum); end Set_Unit_Number; + --------------------- + -- Write_Bind_Line -- + --------------------- + + procedure Write_Bind_Line (S : String) is + begin + -- Need to strip trailing LF from S + + WBI (S (S'First .. S'Last - 1)); + end Write_Bind_Line; + ---------------------------- -- Write_Statement_Buffer -- ---------------------------- procedure Write_Statement_Buffer is begin - WBI (Statement_Buffer (1 .. Last)); - Last := 0; + WBI (Statement_Buffer (1 .. Stm_Last)); + Stm_Last := 0; end Write_Statement_Buffer; procedure Write_Statement_Buffer (S : String) is