diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 23 | ||||
| -rw-r--r-- | gcc/ada/adaint.c | 2 | ||||
| -rw-r--r-- | gcc/ada/bindgen.adb | 25 | ||||
| -rw-r--r-- | gcc/ada/final.c | 18 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/Make-lang.in | 6 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/Makefile.in | 4 | ||||
| -rw-r--r-- | gcc/ada/gnat_ugn.texi | 989 | ||||
| -rw-r--r-- | gcc/ada/initialize.c | 224 | ||||
| -rw-r--r-- | gcc/ada/rtfinal.c | 89 | ||||
| -rw-r--r-- | gcc/ada/rtinit.c | 381 |
10 files changed, 1028 insertions, 733 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 16bb768e..6afb823f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2015-01-06 Pascal Obry <obry@adacore.com> + + * adaint.c (ProcListEvt): Set to NULL. + * rtinit.c: New file. + (__gnat_rt_init_count): New reference counter set to 0. + (__gnat_runtime_initialize): Move code here from __gnat_initialize when + this code is actually needed for the runtime initialization. This + routine returns immediately if the initialization has already been done. + * final.c: Revert previous change. + * rtfinal.c: New file. + (__gnat_runtime_finalize)[Win32]: Add finalization of the critical + section and event. The default version of this routine is empty (except + for the reference counting code). This routine returns immediately if + some others libraries are referencing the runtime. + * bindgen.adb (Gen_Adainit): Generate call to Runtime_Initialize + remove circuitry to initialize the signal handler as this is + now done by the runtime initialization routine. + (Gen_Adafinal): Generate call to Runtime_Finalize. + * gnat_ugn.texi: Update documentation about concurrency and + initialization/finalization of the run-time. + * gcc-interface/Makefile.in, gcc-interface/Make-lang.in: Add + references to rtfinal.o and rtinit.o + 2015-01-06 Robert Dewar <dewar@adacore.com> * exp_attr.adb (Expand_N_Attribute_Reference): Add dummy entry diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 5df6f3d..1bf7d66 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -2318,7 +2318,7 @@ static void SignalListChanged (void) {} #else CRITICAL_SECTION ProcListCS; -HANDLE ProcListEvt; +HANDLE ProcListEvt = NULL; static void EnterCS (void) { diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 8979b77..0a9ece0 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -390,6 +390,11 @@ package body Bindgen is 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 @@ -399,6 +404,8 @@ package body Bindgen is WBI (" Is_Elaborated := False;"); end if; + WBI (" Runtime_Finalize;"); + -- On non-virtual machine targets, finalization is done differently -- depending on whether this is the main program or a library. @@ -599,13 +606,9 @@ package body Bindgen is -- 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;"); + WBI (" pragma Import (C, Runtime_Initialize, " & + """__gnat_runtime_initialize"");"); -- Import handlers attach procedure for sequential elaboration policy @@ -835,13 +838,9 @@ package body Bindgen is -- In .NET, when binding with -z, we don't install the signal handler -- to let the caller handle the last exception handler. - if VM_Target /= CLI_Target - or else Bind_Main_Program - then + if Bind_Main_Program then WBI (""); - WBI (" if Handler_Installed = 0 then"); - WBI (" Install_Handler;"); - WBI (" end if;"); + WBI (" Runtime_Initialize;"); end if; end if; diff --git a/gcc/ada/final.c b/gcc/ada/final.c index dffc2b2..2afcfa5 100644 --- a/gcc/ada/final.c +++ b/gcc/ada/final.c @@ -40,28 +40,10 @@ extern void __gnat_finalize (void); at all, the intention is that this be replaced by system specific code where finalization is required. */ -#if defined (__MINGW32__) -#include "mingw32.h" -#include <windows.h> - -extern CRITICAL_SECTION ProcListCS; -extern HANDLE ProcListEvt; - -void -__gnat_finalize (void) -{ - /* delete critical section and event handle used for the - processes chain list */ - DeleteCriticalSection(&ProcListCS); - CloseHandle (ProcListEvt); -} - -#else void __gnat_finalize (void) { } -#endif #ifdef __cplusplus } diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index efae513..6fa4f4c 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -223,8 +223,8 @@ GCC_LLINK=$(LLINKER) $(GCC_LINKERFLAGS) $(LDFLAGS) # Object files for gnat1 from C sources. GNAT1_C_OBJS = ada/adadecode.o ada/adaint.o ada/argv.o ada/cio.o \ ada/cstreams.o ada/env.o ada/init.o ada/initialize.o ada/raise.o \ - ada/seh_init.o ada/targext.o ada/cuintp.o ada/decl.o \ - ada/misc.o ada/utils.o ada/utils2.o ada/trans.o ada/targtyps.o + ada/seh_init.o ada/targext.o ada/cuintp.o ada/decl.o ada/rtfinal.o \ + ada/rtinit.o ada/misc.o ada/utils.o ada/utils2.o ada/trans.o ada/targtyps.o # Object files from Ada sources that are used by gnat1 GNAT_ADA_OBJS = \ @@ -513,6 +513,8 @@ GNATBIND_OBJS = \ ada/raise.o \ ada/restrict.o \ ada/rident.o \ + ada/rtfinal.o \ + ada/rtinit.o \ ada/s-addope.o \ ada/s-assert.o \ ada/s-carun8.o \ diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index eb24f11..870cfab 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -2400,7 +2400,7 @@ endif # thread.c is special as put into GNATRTL_TASKING_OBJS by Makefile.rtl LIBGNAT_OBJS = adadecode.o adaint.o argv.o aux-io.o \ cal.o cio.o cstreams.o ctrl_c.o \ - env.o errno.o exit.o expect.o final.o \ + env.o errno.o exit.o expect.o final.o rtfinal.o rtinit.o \ init.o initialize.o locales.o mkdir.o \ raise.o seh_init.o socket.o sysdep.o \ targext.o terminals.o tracebak.o \ @@ -3046,6 +3046,8 @@ errno.o : errno.c exit.o : adaint.h exit.c expect.o : expect.c final.o : final.c +rtfinal.o : rtfinal.c +rtinit.o : rtinit.c locales.o : locales.c mkdir.o : mkdir.c socket.o : socket.c gsocket.h diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index d77aba5..9e487db 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -17544,6 +17544,13 @@ finalization of all Ada libraries must be performed at the end of the program. No call to these libraries or to the Ada run-time library should be made after the finalization phase. +@noindent +Note also that special care must be taken with multi-tasks +applications. The initialization and finalization routines are not +protected against concurrent access. If such requirement is needed it +must be ensured at the application level using a specific operating +system services like a mutex or a critical-section. + @node Restrictions in Stand-alone Libraries @subsection Restrictions in Stand-alone Libraries @@ -22308,11 +22315,10 @@ Comments have been added for clarification purposes. -- as a unit name in the partition, in which case some other unique -- name is used. +@b{pragma} Ada_95; @b{with} System; @b{package} ada_main @b{is} - - Elab_Final_Code : Integer; - @b{pragma} Import (C, Elab_Final_Code, "__gnat_inside_elab_final_code"); + @b{pragma} Warnings (Off); -- The main program saves the parameters (argument count, -- argument values, environment pointer) in global variables @@ -22337,16 +22343,11 @@ Comments have been added for clarification purposes. @b{pragma} Import (C, gnat_exit_status); GNAT_Version : @b{constant} String := - "GNAT Version: 6.0.0w (20061115)"; + "GNAT Version: Pro 7.4.0w (20141119-49)" & ASCII.NUL; @b{pragma} Export (C, GNAT_Version, "__gnat_version"); - -- This is the generated adafinal routine that performs - -- finalization at the end of execution. In the case where - -- Ada is the main program, this main program makes a call - -- to adafinal at program termination. - - @b{procedure} adafinal; - @b{pragma} Export (C, adafinal, "adafinal"); + Ada_Main_Program_Name : constant String := "_ada_hello" & ASCII.NUL; + @b{pragma} Export (C, Ada_Main_Program_Name, "__gnat_ada_main_program_name"); -- This is the generated adainit routine that performs -- initialization at the start of execution. In the case @@ -22356,13 +22357,18 @@ Comments have been added for clarification purposes. @b{procedure} adainit; @b{pragma} Export (C, adainit, "adainit"); + -- This is the generated adafinal routine that performs + -- finalization at the end of execution. In the case where + -- Ada is the main program, this main program makes a call + -- to adafinal at program termination. + + @b{procedure} adafinal; + @b{pragma} Export (C, adafinal, "adafinal"); + -- This routine is called at the start of execution. It is -- a dummy routine that is used by the debugger to breakpoint -- at the start of execution. - @b{procedure} Break_Start; - @b{pragma} Import (C, Break_Start, "__gnat_break_start"); - -- This is the actual generated main program (it would be -- suppressed if the no main program switch were used). As -- required by standard system conventions, this program has @@ -22382,191 +22388,300 @@ Comments have been added for clarification purposes. -- string that would be returned by use of the -- Body_Version or Version attributes. - @b{type} Version_32 @b{is} @b{mod} 2 ** 32; - u00001 : @b{constant} Version_32 := 16#7880BEB3#; - u00002 : @b{constant} Version_32 := 16#0D24CBD0#; - u00003 : @b{constant} Version_32 := 16#3283DBEB#; - u00004 : @b{constant} Version_32 := 16#2359F9ED#; - u00005 : @b{constant} Version_32 := 16#664FB847#; - u00006 : @b{constant} Version_32 := 16#68E803DF#; - u00007 : @b{constant} Version_32 := 16#5572E604#; - u00008 : @b{constant} Version_32 := 16#46B173D8#; - u00009 : @b{constant} Version_32 := 16#156A40CF#; - u00010 : @b{constant} Version_32 := 16#033DABE0#; - u00011 : @b{constant} Version_32 := 16#6AB38FEA#; - u00012 : @b{constant} Version_32 := 16#22B6217D#; - u00013 : @b{constant} Version_32 := 16#68A22947#; - u00014 : @b{constant} Version_32 := 16#18CC4A56#; - u00015 : @b{constant} Version_32 := 16#08258E1B#; - u00016 : @b{constant} Version_32 := 16#367D5222#; - u00017 : @b{constant} Version_32 := 16#20C9ECA4#; - u00018 : @b{constant} Version_32 := 16#50D32CB6#; - u00019 : @b{constant} Version_32 := 16#39A8BB77#; - u00020 : @b{constant} Version_32 := 16#5CF8FA2B#; - u00021 : @b{constant} Version_32 := 16#2F1EB794#; - u00022 : @b{constant} Version_32 := 16#31AB6444#; - u00023 : @b{constant} Version_32 := 16#1574B6E9#; - u00024 : @b{constant} Version_32 := 16#5109C189#; - u00025 : @b{constant} Version_32 := 16#56D770CD#; - u00026 : @b{constant} Version_32 := 16#02F9DE3D#; - u00027 : @b{constant} Version_32 := 16#08AB6B2C#; - u00028 : @b{constant} Version_32 := 16#3FA37670#; - u00029 : @b{constant} Version_32 := 16#476457A0#; - u00030 : @b{constant} Version_32 := 16#731E1B6E#; - u00031 : @b{constant} Version_32 := 16#23C2E789#; - u00032 : @b{constant} Version_32 := 16#0F1BD6A1#; - u00033 : @b{constant} Version_32 := 16#7C25DE96#; - u00034 : @b{constant} Version_32 := 16#39ADFFA2#; - u00035 : @b{constant} Version_32 := 16#571DE3E7#; - u00036 : @b{constant} Version_32 := 16#5EB646AB#; - u00037 : @b{constant} Version_32 := 16#4249379B#; - u00038 : @b{constant} Version_32 := 16#0357E00A#; - u00039 : @b{constant} Version_32 := 16#3784FB72#; - u00040 : @b{constant} Version_32 := 16#2E723019#; - u00041 : @b{constant} Version_32 := 16#623358EA#; - u00042 : @b{constant} Version_32 := 16#107F9465#; - u00043 : @b{constant} Version_32 := 16#6843F68A#; - u00044 : @b{constant} Version_32 := 16#63305874#; - u00045 : @b{constant} Version_32 := 16#31E56CE1#; - u00046 : @b{constant} Version_32 := 16#02917970#; - u00047 : @b{constant} Version_32 := 16#6CCBA70E#; - u00048 : @b{constant} Version_32 := 16#41CD4204#; - u00049 : @b{constant} Version_32 := 16#572E3F58#; - u00050 : @b{constant} Version_32 := 16#20729FF5#; - u00051 : @b{constant} Version_32 := 16#1D4F93E8#; - u00052 : @b{constant} Version_32 := 16#30B2EC3D#; - u00053 : @b{constant} Version_32 := 16#34054F96#; - u00054 : @b{constant} Version_32 := 16#5A199860#; - u00055 : @b{constant} Version_32 := 16#0E7F912B#; - u00056 : @b{constant} Version_32 := 16#5760634A#; - u00057 : @b{constant} Version_32 := 16#5D851835#; - -- The following Export pragmas export the version numbers -- with symbolic names ending in B (for body) or S -- (for spec) so that they can be located in a link. The -- information provided here is sufficient to track down -- the exact versions of units used in a given build. + + @b{type} Version_32 @b{is} @b{mod} 2 ** 32; + u00001 : @b{constant} Version_32 := 16#8ad6e54a#; @b{pragma} Export (C, u00001, "helloB"); + u00002 : @b{constant} Version_32 := 16#fbff4c67#; @b{pragma} Export (C, u00002, "system__standard_libraryB"); + u00003 : @b{constant} Version_32 := 16#1ec6fd90#; @b{pragma} Export (C, u00003, "system__standard_libraryS"); + u00004 : @b{constant} Version_32 := 16#3ffc8e18#; @b{pragma} Export (C, u00004, "adaS"); + u00005 : @b{constant} Version_32 := 16#28f088c2#; @b{pragma} Export (C, u00005, "ada__text_ioB"); + u00006 : @b{constant} Version_32 := 16#f372c8ac#; @b{pragma} Export (C, u00006, "ada__text_ioS"); + u00007 : @b{constant} Version_32 := 16#2c143749#; @b{pragma} Export (C, u00007, "ada__exceptionsB"); + u00008 : @b{constant} Version_32 := 16#f4f0cce8#; @b{pragma} Export (C, u00008, "ada__exceptionsS"); - @b{pragma} Export (C, u00009, "gnatS"); - @b{pragma} Export (C, u00010, "gnat__heap_sort_aB"); - @b{pragma} Export (C, u00011, "gnat__heap_sort_aS"); - @b{pragma} Export (C, u00012, "systemS"); - @b{pragma} Export (C, u00013, "system__exception_tableB"); - @b{pragma} Export (C, u00014, "system__exception_tableS"); - @b{pragma} Export (C, u00015, "gnat__htableB"); - @b{pragma} Export (C, u00016, "gnat__htableS"); - @b{pragma} Export (C, u00017, "system__exceptionsS"); - @b{pragma} Export (C, u00018, "system__machine_state_operationsB"); - @b{pragma} Export (C, u00019, "system__machine_state_operationsS"); - @b{pragma} Export (C, u00020, "system__machine_codeS"); - @b{pragma} Export (C, u00021, "system__storage_elementsB"); - @b{pragma} Export (C, u00022, "system__storage_elementsS"); - @b{pragma} Export (C, u00023, "system__secondary_stackB"); - @b{pragma} Export (C, u00024, "system__secondary_stackS"); - @b{pragma} Export (C, u00025, "system__parametersB"); - @b{pragma} Export (C, u00026, "system__parametersS"); - @b{pragma} Export (C, u00027, "system__soft_linksB"); - @b{pragma} Export (C, u00028, "system__soft_linksS"); - @b{pragma} Export (C, u00029, "system__stack_checkingB"); - @b{pragma} Export (C, u00030, "system__stack_checkingS"); + u00009 : @b{constant} Version_32 := 16#a46739c0#; + @b{pragma} Export (C, u00009, "ada__exceptions__last_chance_handlerB"); + u00010 : @b{constant} Version_32 := 16#3aac8c92#; + @b{pragma} Export (C, u00010, "ada__exceptions__last_chance_handlerS"); + u00011 : @b{constant} Version_32 := 16#1d274481#; + @b{pragma} Export (C, u00011, "systemS"); + u00012 : @b{constant} Version_32 := 16#a207fefe#; + @b{pragma} Export (C, u00012, "system__soft_linksB"); + u00013 : @b{constant} Version_32 := 16#467d9556#; + @b{pragma} Export (C, u00013, "system__soft_linksS"); + u00014 : @b{constant} Version_32 := 16#b01dad17#; + @b{pragma} Export (C, u00014, "system__parametersB"); + u00015 : @b{constant} Version_32 := 16#630d49fe#; + @b{pragma} Export (C, u00015, "system__parametersS"); + u00016 : @b{constant} Version_32 := 16#b19b6653#; + @b{pragma} Export (C, u00016, "system__secondary_stackB"); + u00017 : @b{constant} Version_32 := 16#b6468be8#; + @b{pragma} Export (C, u00017, "system__secondary_stackS"); + u00018 : @b{constant} Version_32 := 16#39a03df9#; + @b{pragma} Export (C, u00018, "system__storage_elementsB"); + u00019 : @b{constant} Version_32 := 16#30e40e85#; + @b{pragma} Export (C, u00019, "system__storage_elementsS"); + u00020 : @b{constant} Version_32 := 16#41837d1e#; + @b{pragma} Export (C, u00020, "system__stack_checkingB"); + u00021 : @b{constant} Version_32 := 16#93982f69#; + @b{pragma} Export (C, u00021, "system__stack_checkingS"); + u00022 : @b{constant} Version_32 := 16#393398c1#; + @b{pragma} Export (C, u00022, "system__exception_tableB"); + u00023 : @b{constant} Version_32 := 16#b33e2294#; + @b{pragma} Export (C, u00023, "system__exception_tableS"); + u00024 : @b{constant} Version_32 := 16#ce4af020#; + @b{pragma} Export (C, u00024, "system__exceptionsB"); + u00025 : @b{constant} Version_32 := 16#75442977#; + @b{pragma} Export (C, u00025, "system__exceptionsS"); + u00026 : @b{constant} Version_32 := 16#37d758f1#; + @b{pragma} Export (C, u00026, "system__exceptions__machineS"); + u00027 : @b{constant} Version_32 := 16#b895431d#; + @b{pragma} Export (C, u00027, "system__exceptions_debugB"); + u00028 : @b{constant} Version_32 := 16#aec55d3f#; + @b{pragma} Export (C, u00028, "system__exceptions_debugS"); + u00029 : @b{constant} Version_32 := 16#570325c8#; + @b{pragma} Export (C, u00029, "system__img_intB"); + u00030 : @b{constant} Version_32 := 16#1ffca443#; + @b{pragma} Export (C, u00030, "system__img_intS"); + u00031 : @b{constant} Version_32 := 16#b98c3e16#; @b{pragma} Export (C, u00031, "system__tracebackB"); + u00032 : @b{constant} Version_32 := 16#831a9d5a#; @b{pragma} Export (C, u00032, "system__tracebackS"); - @b{pragma} Export (C, u00033, "ada__streamsS"); - @b{pragma} Export (C, u00034, "ada__tagsB"); - @b{pragma} Export (C, u00035, "ada__tagsS"); - @b{pragma} Export (C, u00036, "system__string_opsB"); - @b{pragma} Export (C, u00037, "system__string_opsS"); - @b{pragma} Export (C, u00038, "interfacesS"); - @b{pragma} Export (C, u00039, "interfaces__c_streamsB"); - @b{pragma} Export (C, u00040, "interfaces__c_streamsS"); - @b{pragma} Export (C, u00041, "system__file_ioB"); - @b{pragma} Export (C, u00042, "system__file_ioS"); - @b{pragma} Export (C, u00043, "ada__finalizationB"); - @b{pragma} Export (C, u00044, "ada__finalizationS"); - @b{pragma} Export (C, u00045, "system__finalization_rootB"); - @b{pragma} Export (C, u00046, "system__finalization_rootS"); - @b{pragma} Export (C, u00047, "system__finalization_implementationB"); - @b{pragma} Export (C, u00048, "system__finalization_implementationS"); - @b{pragma} Export (C, u00049, "system__string_ops_concat_3B"); - @b{pragma} Export (C, u00050, "system__string_ops_concat_3S"); - @b{pragma} Export (C, u00051, "system__stream_attributesB"); - @b{pragma} Export (C, u00052, "system__stream_attributesS"); - @b{pragma} Export (C, u00053, "ada__io_exceptionsS"); - @b{pragma} Export (C, u00054, "system__unsigned_typesS"); - @b{pragma} Export (C, u00055, "system__file_control_blockS"); - @b{pragma} Export (C, u00056, "ada__finalization__list_controllerB"); - @b{pragma} Export (C, u00057, "ada__finalization__list_controllerS"); - - -- BEGIN ELABORATION ORDER - -- ada (spec) - -- gnat (spec) - -- gnat.heap_sort_a (spec) - -- gnat.heap_sort_a (body) - -- gnat.htable (spec) - -- gnat.htable (body) - -- interfaces (spec) - -- system (spec) - -- system.machine_code (spec) - -- system.parameters (spec) - -- system.parameters (body) - -- interfaces.c_streams (spec) - -- interfaces.c_streams (body) - -- system.standard_library (spec) - -- ada.exceptions (spec) - -- system.exception_table (spec) - -- system.exception_table (body) - -- ada.io_exceptions (spec) - -- system.exceptions (spec) - -- system.storage_elements (spec) - -- system.storage_elements (body) - -- system.machine_state_operations (spec) - -- system.machine_state_operations (body) - -- system.secondary_stack (spec) - -- system.stack_checking (spec) - -- system.soft_links (spec) - -- system.soft_links (body) - -- system.stack_checking (body) - -- system.secondary_stack (body) - -- system.standard_library (body) - -- system.string_ops (spec) - -- system.string_ops (body) - -- ada.tags (spec) - -- ada.tags (body) - -- ada.streams (spec) - -- system.finalization_root (spec) - -- system.finalization_root (body) - -- system.string_ops_concat_3 (spec) - -- system.string_ops_concat_3 (body) - -- system.traceback (spec) - -- system.traceback (body) - -- ada.exceptions (body) - -- system.unsigned_types (spec) - -- system.stream_attributes (spec) - -- system.stream_attributes (body) - -- system.finalization_implementation (spec) - -- system.finalization_implementation (body) - -- ada.finalization (spec) - -- ada.finalization (body) - -- ada.finalization.list_controller (spec) - -- ada.finalization.list_controller (body) - -- system.file_control_block (spec) - -- system.file_io (spec) - -- system.file_io (body) - -- ada.text_io (spec) - -- ada.text_io (body) - -- hello (body) - -- END ELABORATION ORDER + u00033 : @b{constant} Version_32 := 16#9ed49525#; + @b{pragma} Export (C, u00033, "system__traceback_entriesB"); + u00034 : @b{constant} Version_32 := 16#1d7cb2f1#; + @b{pragma} Export (C, u00034, "system__traceback_entriesS"); + u00035 : @b{constant} Version_32 := 16#8c33a517#; + @b{pragma} Export (C, u00035, "system__wch_conB"); + u00036 : @b{constant} Version_32 := 16#065a6653#; + @b{pragma} Export (C, u00036, "system__wch_conS"); + u00037 : @b{constant} Version_32 := 16#9721e840#; + @b{pragma} Export (C, u00037, "system__wch_stwB"); + u00038 : @b{constant} Version_32 := 16#2b4b4a52#; + @b{pragma} Export (C, u00038, "system__wch_stwS"); + u00039 : @b{constant} Version_32 := 16#92b797cb#; + @b{pragma} Export (C, u00039, "system__wch_cnvB"); + u00040 : @b{constant} Version_32 := 16#09eddca0#; + @b{pragma} Export (C, u00040, "system__wch_cnvS"); + u00041 : @b{constant} Version_32 := 16#6033a23f#; + @b{pragma} Export (C, u00041, "interfacesS"); + u00042 : @b{constant} Version_32 := 16#ece6fdb6#; + @b{pragma} Export (C, u00042, "system__wch_jisB"); + u00043 : @b{constant} Version_32 := 16#899dc581#; + @b{pragma} Export (C, u00043, "system__wch_jisS"); + u00044 : @b{constant} Version_32 := 16#10558b11#; + @b{pragma} Export (C, u00044, "ada__streamsB"); + u00045 : @b{constant} Version_32 := 16#2e6701ab#; + @b{pragma} Export (C, u00045, "ada__streamsS"); + u00046 : @b{constant} Version_32 := 16#db5c917c#; + @b{pragma} Export (C, u00046, "ada__io_exceptionsS"); + u00047 : @b{constant} Version_32 := 16#12c8cd7d#; + @b{pragma} Export (C, u00047, "ada__tagsB"); + u00048 : @b{constant} Version_32 := 16#ce72c228#; + @b{pragma} Export (C, u00048, "ada__tagsS"); + u00049 : @b{constant} Version_32 := 16#c3335bfd#; + @b{pragma} Export (C, u00049, "system__htableB"); + u00050 : @b{constant} Version_32 := 16#99e5f76b#; + @b{pragma} Export (C, u00050, "system__htableS"); + u00051 : @b{constant} Version_32 := 16#089f5cd0#; + @b{pragma} Export (C, u00051, "system__string_hashB"); + u00052 : @b{constant} Version_32 := 16#3bbb9c15#; + @b{pragma} Export (C, u00052, "system__string_hashS"); + u00053 : @b{constant} Version_32 := 16#807fe041#; + @b{pragma} Export (C, u00053, "system__unsigned_typesS"); + u00054 : @b{constant} Version_32 := 16#d27be59e#; + @b{pragma} Export (C, u00054, "system__val_lluB"); + u00055 : @b{constant} Version_32 := 16#fa8db733#; + @b{pragma} Export (C, u00055, "system__val_lluS"); + u00056 : @b{constant} Version_32 := 16#27b600b2#; + @b{pragma} Export (C, u00056, "system__val_utilB"); + u00057 : @b{constant} Version_32 := 16#b187f27f#; + @b{pragma} Export (C, u00057, "system__val_utilS"); + u00058 : @b{constant} Version_32 := 16#d1060688#; + @b{pragma} Export (C, u00058, "system__case_utilB"); + u00059 : @b{constant} Version_32 := 16#392e2d56#; + @b{pragma} Export (C, u00059, "system__case_utilS"); + u00060 : @b{constant} Version_32 := 16#84a27f0d#; + @b{pragma} Export (C, u00060, "interfaces__c_streamsB"); + u00061 : @b{constant} Version_32 := 16#8bb5f2c0#; + @b{pragma} Export (C, u00061, "interfaces__c_streamsS"); + u00062 : @b{constant} Version_32 := 16#6db6928f#; + @b{pragma} Export (C, u00062, "system__crtlS"); + u00063 : @b{constant} Version_32 := 16#4e6a342b#; + @b{pragma} Export (C, u00063, "system__file_ioB"); + u00064 : @b{constant} Version_32 := 16#ba56a5e4#; + @b{pragma} Export (C, u00064, "system__file_ioS"); + u00065 : @b{constant} Version_32 := 16#b7ab275c#; + @b{pragma} Export (C, u00065, "ada__finalizationB"); + u00066 : @b{constant} Version_32 := 16#19f764ca#; + @b{pragma} Export (C, u00066, "ada__finalizationS"); + u00067 : @b{constant} Version_32 := 16#95817ed8#; + @b{pragma} Export (C, u00067, "system__finalization_rootB"); + u00068 : @b{constant} Version_32 := 16#52d53711#; + @b{pragma} Export (C, u00068, "system__finalization_rootS"); + u00069 : @b{constant} Version_32 := 16#769e25e6#; + @b{pragma} Export (C, u00069, "interfaces__cB"); + u00070 : @b{constant} Version_32 := 16#4a38bedb#; + @b{pragma} Export (C, u00070, "interfaces__cS"); + u00071 : @b{constant} Version_32 := 16#07e6ee66#; + @b{pragma} Export (C, u00071, "system__os_libB"); + u00072 : @b{constant} Version_32 := 16#d7b69782#; + @b{pragma} Export (C, u00072, "system__os_libS"); + u00073 : @b{constant} Version_32 := 16#1a817b8e#; + @b{pragma} Export (C, u00073, "system__stringsB"); + u00074 : @b{constant} Version_32 := 16#639855e7#; + @b{pragma} Export (C, u00074, "system__stringsS"); + u00075 : @b{constant} Version_32 := 16#e0b8de29#; + @b{pragma} Export (C, u00075, "system__file_control_blockS"); + u00076 : @b{constant} Version_32 := 16#b5b2aca1#; + @b{pragma} Export (C, u00076, "system__finalization_mastersB"); + u00077 : @b{constant} Version_32 := 16#69316dc1#; + @b{pragma} Export (C, u00077, "system__finalization_mastersS"); + u00078 : @b{constant} Version_32 := 16#57a37a42#; + @b{pragma} Export (C, u00078, "system__address_imageB"); + u00079 : @b{constant} Version_32 := 16#bccbd9bb#; + @b{pragma} Export (C, u00079, "system__address_imageS"); + u00080 : @b{constant} Version_32 := 16#7268f812#; + @b{pragma} Export (C, u00080, "system__img_boolB"); + u00081 : @b{constant} Version_32 := 16#e8fe356a#; + @b{pragma} Export (C, u00081, "system__img_boolS"); + u00082 : @b{constant} Version_32 := 16#d7aac20c#; + @b{pragma} Export (C, u00082, "system__ioB"); + u00083 : @b{constant} Version_32 := 16#8365b3ce#; + @b{pragma} Export (C, u00083, "system__ioS"); + u00084 : @b{constant} Version_32 := 16#6d4d969a#; + @b{pragma} Export (C, u00084, "system__storage_poolsB"); + u00085 : @b{constant} Version_32 := 16#e87cc305#; + @b{pragma} Export (C, u00085, "system__storage_poolsS"); + u00086 : @b{constant} Version_32 := 16#e34550ca#; + @b{pragma} Export (C, u00086, "system__pool_globalB"); + u00087 : @b{constant} Version_32 := 16#c88d2d16#; + @b{pragma} Export (C, u00087, "system__pool_globalS"); + u00088 : @b{constant} Version_32 := 16#9d39c675#; + @b{pragma} Export (C, u00088, "system__memoryB"); + u00089 : @b{constant} Version_32 := 16#445a22b5#; + @b{pragma} Export (C, u00089, "system__memoryS"); + u00090 : @b{constant} Version_32 := 16#6a859064#; + @b{pragma} Export (C, u00090, "system__storage_pools__subpoolsB"); + u00091 : @b{constant} Version_32 := 16#e3b008dc#; + @b{pragma} Export (C, u00091, "system__storage_pools__subpoolsS"); + u00092 : @b{constant} Version_32 := 16#63f11652#; + @b{pragma} Export (C, u00092, "system__storage_pools__subpools__finalizationB"); + u00093 : @b{constant} Version_32 := 16#fe2f4b3a#; + @b{pragma} Export (C, u00093, "system__storage_pools__subpools__finalizationS"); + + -- BEGIN ELABORATION ORDER + -- ada%s + -- interfaces%s + -- system%s + -- system.case_util%s + -- system.case_util%b + -- system.htable%s + -- system.img_bool%s + -- system.img_bool%b + -- system.img_int%s + -- system.img_int%b + -- system.io%s + -- system.io%b + -- system.parameters%s + -- system.parameters%b + -- system.crtl%s + -- interfaces.c_streams%s + -- interfaces.c_streams%b + -- system.standard_library%s + -- system.exceptions_debug%s + -- system.exceptions_debug%b + -- system.storage_elements%s + -- system.storage_elements%b + -- system.stack_checking%s + -- system.stack_checking%b + -- system.string_hash%s + -- system.string_hash%b + -- system.htable%b + -- system.strings%s + -- system.strings%b + -- system.os_lib%s + -- system.traceback_entries%s + -- system.traceback_entries%b + -- ada.exceptions%s + -- system.soft_links%s + -- system.unsigned_types%s + -- system.val_llu%s + -- system.val_util%s + -- system.val_util%b + -- system.val_llu%b + -- system.wch_con%s + -- system.wch_con%b + -- system.wch_cnv%s + -- system.wch_jis%s + -- system.wch_jis%b + -- system.wch_cnv%b + -- system.wch_stw%s + -- system.wch_stw%b + -- ada.exceptions.last_chance_handler%s + -- ada.exceptions.last_chance_handler%b + -- system.address_image%s + -- system.exception_table%s + -- system.exception_table%b + -- ada.io_exceptions%s + -- ada.tags%s + -- ada.streams%s + -- ada.streams%b + -- interfaces.c%s + -- system.exceptions%s + -- system.exceptions%b + -- system.exceptions.machine%s + -- system.finalization_root%s + -- system.finalization_root%b + -- ada.finalization%s + -- ada.finalization%b + -- system.storage_pools%s + -- system.storage_pools%b + -- system.finalization_masters%s + -- system.storage_pools.subpools%s + -- system.storage_pools.subpools.finalization%s + -- system.storage_pools.subpools.finalization%b + -- system.memory%s + -- system.memory%b + -- system.standard_library%b + -- system.pool_global%s + -- system.pool_global%b + -- system.file_control_block%s + -- system.file_io%s + -- system.secondary_stack%s + -- system.file_io%b + -- system.storage_pools.subpools%b + -- system.finalization_masters%b + -- interfaces.c%b + -- ada.tags%b + -- system.soft_links%b + -- system.os_lib%b + -- system.secondary_stack%b + -- system.address_image%b + -- system.traceback%s + -- ada.exceptions%b + -- system.traceback%b + -- ada.text_io%s + -- ada.text_io%b + -- hello%b + -- END ELABORATION ORDER @b{end} ada_main; +@b{pragma} Ada_95; -- The following source file name pragmas allow the generated file -- names to be unique for different main programs. They are needed -- since the package name will always be Ada_Main. @@ -22574,15 +22689,94 @@ Comments have been added for clarification purposes. @b{pragma} Source_File_Name (ada_main, Spec_File_Name => "b~hello.ads"); @b{pragma} Source_File_Name (ada_main, Body_File_Name => "b~hello.adb"); +@b{pragma} Suppress (Overflow_Check); +@b{with} Ada.Exceptions; + -- Generated package body for Ada_Main starts here @b{package} @b{body} ada_main @b{is} + @b{pragma} Warnings (Off); - -- The actual finalization is performed by calling the - -- library routine in System.Standard_Library.Adafinal - - @b{procedure} Do_Finalize; - @b{pragma} Import (C, Do_Finalize, "system__standard_library__adafinal"); + -- These values are reference counter associated to units which have + -- been elaborated. It is also used to avoid elaborating the + -- same unit twice. + + E72 : Short_Integer; @b{pragma} Import (Ada, E72, "system__os_lib_E"); + E13 : Short_Integer; @b{pragma} Import (Ada, E13, "system__soft_links_E"); + E23 : Short_Integer; @b{pragma} Import (Ada, E23, "system__exception_table_E"); + E46 : Short_Integer; @b{pragma} Import (Ada, E46, "ada__io_exceptions_E"); + E48 : Short_Integer; @b{pragma} Import (Ada, E48, "ada__tags_E"); + E45 : Short_Integer; @b{pragma} Import (Ada, E45, "ada__streams_E"); + E70 : Short_Integer; @b{pragma} Import (Ada, E70, "interfaces__c_E"); + E25 : Short_Integer; @b{pragma} Import (Ada, E25, "system__exceptions_E"); + E68 : Short_Integer; @b{pragma} Import (Ada, E68, "system__finalization_root_E"); + E66 : Short_Integer; @b{pragma} Import (Ada, E66, "ada__finalization_E"); + E85 : Short_Integer; @b{pragma} Import (Ada, E85, "system__storage_pools_E"); + E77 : Short_Integer; @b{pragma} Import (Ada, E77, "system__finalization_masters_E"); + E91 : Short_Integer; @b{pragma} Import (Ada, E91, "system__storage_pools__subpools_E"); + E87 : Short_Integer; @b{pragma} Import (Ada, E87, "system__pool_global_E"); + E75 : Short_Integer; @b{pragma} Import (Ada, E75, "system__file_control_block_E"); + E64 : Short_Integer; @b{pragma} Import (Ada, E64, "system__file_io_E"); + E17 : Short_Integer; @b{pragma} Import (Ada, E17, "system__secondary_stack_E"); + E06 : Short_Integer; @b{pragma} Import (Ada, E06, "ada__text_io_E"); + + Local_Priority_Specific_Dispatching : @b{constant} String := ""; + Local_Interrupt_States : @b{constant} String := ""; + + Is_Elaborated : Boolean := False; + +@findex finalize_library + @b{procedure} finalize_library @b{is} + @b{begin} + E06 := E06 - 1; + @b{declare} + @b{procedure} F1; + @b{pragma} Import (Ada, F1, "ada__text_io__finalize_spec"); + @b{begin} + F1; + @b{end}; + E77 := E77 - 1; + E91 := E91 - 1; + @b{declare} + @b{procedure} F2; + @b{pragma} Import (Ada, F2, "system__file_io__finalize_body"); + @b{begin} + E64 := E64 - 1; + F2; + @b{end}; + @b{declare} + @b{procedure} F3; + @b{pragma} Import (Ada, F3, "system__file_control_block__finalize_spec"); + @b{begin} + E75 := E75 - 1; + F3; + @b{end}; + E87 := E87 - 1; + @b{declare} + @b{procedure} F4; + @b{pragma} Import (Ada, F4, "system__pool_global__finalize_spec"); + @b{begin} + F4; + @b{end}; + @b{declare} + @b{procedure} F5; + @b{pragma} Import (Ada, F5, "system__storage_pools__subpools__finalize_spec"); + @b{begin} + F5; + @b{end}; + @b{declare} + @b{procedure} F6; + @b{pragma} Import (Ada, F6, "system__finalization_masters__finalize_spec"); + @b{begin} + F6; + @b{end}; + @b{declare} + @b{procedure} Reraise_Library_Exception_If_Any; + @b{pragma} Import (Ada, Reraise_Library_Exception_If_Any, "__gnat_reraise_library_exception_if_any"); + @b{begin} + Reraise_Library_Exception_If_Any; + @b{end}; + @b{end} finalize_library; ------------- -- adainit -- @@ -22591,290 +22785,122 @@ Comments have been added for clarification purposes. @findex adainit @b{procedure} adainit @b{is} - -- These booleans are set to True once the associated unit has - -- been elaborated. It is also used to avoid elaborating the - -- same unit twice. - - E040 : Boolean; - @b{pragma} Import (Ada, E040, "interfaces__c_streams_E"); - - E008 : Boolean; - @b{pragma} Import (Ada, E008, "ada__exceptions_E"); - - E014 : Boolean; - @b{pragma} Import (Ada, E014, "system__exception_table_E"); - - E053 : Boolean; - @b{pragma} Import (Ada, E053, "ada__io_exceptions_E"); - - E017 : Boolean; - @b{pragma} Import (Ada, E017, "system__exceptions_E"); - - E024 : Boolean; - @b{pragma} Import (Ada, E024, "system__secondary_stack_E"); - - E030 : Boolean; - @b{pragma} Import (Ada, E030, "system__stack_checking_E"); - - E028 : Boolean; - @b{pragma} Import (Ada, E028, "system__soft_links_E"); - - E035 : Boolean; - @b{pragma} Import (Ada, E035, "ada__tags_E"); - - E033 : Boolean; - @b{pragma} Import (Ada, E033, "ada__streams_E"); - - E046 : Boolean; - @b{pragma} Import (Ada, E046, "system__finalization_root_E"); - - E048 : Boolean; - @b{pragma} Import (Ada, E048, "system__finalization_implementation_E"); - - E044 : Boolean; - @b{pragma} Import (Ada, E044, "ada__finalization_E"); - - E057 : Boolean; - @b{pragma} Import (Ada, E057, "ada__finalization__list_controller_E"); - - E055 : Boolean; - @b{pragma} Import (Ada, E055, "system__file_control_block_E"); - - E042 : Boolean; - @b{pragma} Import (Ada, E042, "system__file_io_E"); - - E006 : Boolean; - @b{pragma} Import (Ada, E006, "ada__text_io_E"); - - -- Set_Globals is a library routine that stores away the - -- value of the indicated set of global values in global - -- variables within the library. - - @b{procedure} Set_Globals - (Main_Priority : Integer; - Time_Slice_Value : Integer; - WC_Encoding : Character; - Locking_Policy : Character; - Queuing_Policy : Character; - Task_Dispatching_Policy : Character; - Adafinal : System.Address; - Unreserve_All_Interrupts : Integer; - Exception_Tracebacks : Integer); -@findex __gnat_set_globals - @b{pragma} Import (C, Set_Globals, "__gnat_set_globals"); - - -- SDP_Table_Build is a library routine used to build the - -- exception tables. See unit Ada.Exceptions in files - -- a-except.ads/adb for full details of how zero cost - -- exception handling works. This procedure, the call to - -- it, and the two following tables are all omitted if the - -- build is in longjmp/setjmp exception mode. - -@findex SDP_Table_Build -@findex Zero Cost Exceptions - @b{procedure} SDP_Table_Build - (SDP_Addresses : System.Address; - SDP_Count : Natural; - Elab_Addresses : System.Address; - Elab_Addr_Count : Natural); - @b{pragma} Import (C, SDP_Table_Build, "__gnat_SDP_Table_Build"); - - -- Table of Unit_Exception_Table addresses. Used for zero - -- cost exception handling to build the top level table. - - ST : @b{aliased} @b{constant} @b{array} (1 .. 23) @b{of} System.Address := ( - Hello'UET_Address, - Ada.Text_Io'UET_Address, - Ada.Exceptions'UET_Address, - Gnat.Heap_Sort_A'UET_Address, - System.Exception_Table'UET_Address, - System.Machine_State_Operations'UET_Address, - System.Secondary_Stack'UET_Address, - System.Parameters'UET_Address, - System.Soft_Links'UET_Address, - System.Stack_Checking'UET_Address, - System.Traceback'UET_Address, - Ada.Streams'UET_Address, - Ada.Tags'UET_Address, - System.String_Ops'UET_Address, - Interfaces.C_Streams'UET_Address, - System.File_Io'UET_Address, - Ada.Finalization'UET_Address, - System.Finalization_Root'UET_Address, - System.Finalization_Implementation'UET_Address, - System.String_Ops_Concat_3'UET_Address, - System.Stream_Attributes'UET_Address, - System.File_Control_Block'UET_Address, - Ada.Finalization.List_Controller'UET_Address); - - -- Table of addresses of elaboration routines. Used for - -- zero cost exception handling to make sure these - -- addresses are included in the top level procedure - -- address table. - - EA : @b{aliased} @b{constant} @b{array} (1 .. 23) @b{of} System.Address := ( - adainit'Code_Address, - Do_Finalize'Code_Address, - Ada.Exceptions'Elab_Spec'Address, - System.Exceptions'Elab_Spec'Address, - Interfaces.C_Streams'Elab_Spec'Address, - System.Exception_Table'Elab_Body'Address, - Ada.Io_Exceptions'Elab_Spec'Address, - System.Stack_Checking'Elab_Spec'Address, - System.Soft_Links'Elab_Body'Address, - System.Secondary_Stack'Elab_Body'Address, - Ada.Tags'Elab_Spec'Address, - Ada.Tags'Elab_Body'Address, - Ada.Streams'Elab_Spec'Address, - System.Finalization_Root'Elab_Spec'Address, - Ada.Exceptions'Elab_Body'Address, - System.Finalization_Implementation'Elab_Spec'Address, - System.Finalization_Implementation'Elab_Body'Address, - Ada.Finalization'Elab_Spec'Address, - Ada.Finalization.List_Controller'Elab_Spec'Address, - System.File_Control_Block'Elab_Spec'Address, - System.File_Io'Elab_Body'Address, - Ada.Text_Io'Elab_Spec'Address, - Ada.Text_Io'Elab_Body'Address); + Main_Priority : Integer; + @b{pragma} Import (C, Main_Priority, "__gl_main_priority"); + Time_Slice_Value : Integer; + @b{pragma} Import (C, Time_Slice_Value, "__gl_time_slice_val"); + WC_Encoding : Character; + @b{pragma} Import (C, WC_Encoding, "__gl_wc_encoding"); + Locking_Policy : Character; + pragma Import (C, Locking_Policy, "__gl_locking_policy"); + Queuing_Policy : Character; + @b{pragma} Import (C, Queuing_Policy, "__gl_queuing_policy"); + Task_Dispatching_Policy : Character; + @b{pragma} Import (C, Task_Dispatching_Policy, "__gl_task_dispatching_policy"); + Priority_Specific_Dispatching : System.Address; + @b{pragma} Import (C, Priority_Specific_Dispatching, "__gl_priority_specific_dispatching"); + Num_Specific_Dispatching : Integer; + @b{pragma} Import (C, Num_Specific_Dispatching, "__gl_num_specific_dispatching"); + Main_CPU : Integer; + @b{pragma} Import (C, Main_CPU, "__gl_main_cpu"); + Interrupt_States : System.Address; + @b{pragma} Import (C, Interrupt_States, "__gl_interrupt_states"); + Num_Interrupt_States : Integer; + @b{pragma} Import (C, Num_Interrupt_States, "__gl_num_interrupt_states"); + Unreserve_All_Interrupts : Integer; + @b{pragma} Import (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts"); + Detect_Blocking : Integer; + @b{pragma} Import (C, Detect_Blocking, "__gl_detect_blocking"); + Default_Stack_Size : Integer; + @b{pragma} Import (C, Default_Stack_Size, "__gl_default_stack_size"); + Leap_Seconds_Support : Integer; + @b{pragma} Import (C, Leap_Seconds_Support, "__gl_leap_seconds_support"); + + procedure Runtime_Initialize; + @b{pragma} Import (C, Runtime_Initialize, "__gnat_runtime_initialize"); + + Finalize_Library_Objects : No_Param_Proc; + @b{pragma} Import (C, Finalize_Library_Objects, "__gnat_finalize_library_objects"); -- Start of processing for adainit @b{begin} - -- Call SDP_Table_Build to build the top level procedure - -- table for zero cost exception handling (omitted in - -- longjmp/setjmp mode). - - SDP_Table_Build (ST'Address, 23, EA'Address, 23); - - -- Call Set_Globals to record various information for - -- this partition. The values are derived by the binder - -- from information stored in the ali files by the compiler. - -@findex __gnat_set_globals - Set_Globals - (Main_Priority => -1, - -- Priority of main program, -1 if no pragma Priority used - - Time_Slice_Value => -1, - -- Time slice from Time_Slice pragma, -1 if none used - - WC_Encoding => 'b', - -- Wide_Character encoding used, default is brackets - - Locking_Policy => ' ', - -- Locking_Policy used, default of space means not - -- specified, otherwise it is the first character of - -- the policy name. - - Queuing_Policy => ' ', - -- Queuing_Policy used, default of space means not - -- specified, otherwise it is the first character of - -- the policy name. - - Task_Dispatching_Policy => ' ', - -- Task_Dispatching_Policy used, default of space means - -- not specified, otherwise first character of the - -- policy name. - - Adafinal => System.Null_Address, - -- Address of Adafinal routine, not used anymore - - Unreserve_All_Interrupts => 0, - -- Set true if pragma Unreserve_All_Interrupts was used - - Exception_Tracebacks => 0); - -- Indicates if exception tracebacks are enabled - - Elab_Final_Code := 1; + -- Record various information for this partition. The values + -- are derived by the binder from information stored in the ali + -- files by the compiler. + + @b{if} Is_Elaborated @b{then} + @b{return}; + @b{end if}; + Is_Elaborated := True; + Main_Priority := -1; + Time_Slice_Value := -1; + WC_Encoding := 'b'; + Locking_Policy := ' '; + Queuing_Policy := ' '; + Task_Dispatching_Policy := ' '; + Priority_Specific_Dispatching := + Local_Priority_Specific_Dispatching'Address; + Num_Specific_Dispatching := 0; + Main_CPU := -1; + Interrupt_States := Local_Interrupt_States'Address; + Num_Interrupt_States := 0; + Unreserve_All_Interrupts := 0; + Detect_Blocking := 0; + Default_Stack_Size := -1; + Leap_Seconds_Support := 0; + + Runtime_Initialize; + + Finalize_Library_Objects := finalize_library'access; -- Now we have the elaboration calls for all units in the partition. -- The Elab_Spec and Elab_Body attributes generate references to the -- implicit elaboration procedures generated by the compiler for - -- each unit that requires elaboration. - - @b{if} @b{not} E040 @b{then} - Interfaces.C_Streams'Elab_Spec; - @b{end} @b{if}; - E040 := True; - @b{if} @b{not} E008 @b{then} - Ada.Exceptions'Elab_Spec; - @b{end} @b{if}; - @b{if} @b{not} E014 @b{then} - System.Exception_Table'Elab_Body; - E014 := True; - @b{end} @b{if}; - @b{if} @b{not} E053 @b{then} - Ada.Io_Exceptions'Elab_Spec; - E053 := True; - @b{end} @b{if}; - @b{if} @b{not} E017 @b{then} - System.Exceptions'Elab_Spec; - E017 := True; - @b{end} @b{if}; - @b{if} @b{not} E030 @b{then} - System.Stack_Checking'Elab_Spec; - @b{end} @b{if}; - @b{if} @b{not} E028 @b{then} - System.Soft_Links'Elab_Body; - E028 := True; - @b{end} @b{if}; - E030 := True; - @b{if} @b{not} E024 @b{then} - System.Secondary_Stack'Elab_Body; - E024 := True; - @b{end} @b{if}; - @b{if} @b{not} E035 @b{then} - Ada.Tags'Elab_Spec; - @b{end} @b{if}; - @b{if} @b{not} E035 @b{then} - Ada.Tags'Elab_Body; - E035 := True; - @b{end} @b{if}; - @b{if} @b{not} E033 @b{then} - Ada.Streams'Elab_Spec; - E033 := True; - @b{end} @b{if}; - @b{if} @b{not} E046 @b{then} - System.Finalization_Root'Elab_Spec; - @b{end} @b{if}; - E046 := True; - @b{if} @b{not} E008 @b{then} - Ada.Exceptions'Elab_Body; - E008 := True; - @b{end} @b{if}; - @b{if} @b{not} E048 @b{then} - System.Finalization_Implementation'Elab_Spec; - @b{end} @b{if}; - @b{if} @b{not} E048 @b{then} - System.Finalization_Implementation'Elab_Body; - E048 := True; - @b{end} @b{if}; - @b{if} @b{not} E044 @b{then} - Ada.Finalization'Elab_Spec; - @b{end} @b{if}; - E044 := True; - @b{if} @b{not} E057 @b{then} - Ada.Finalization.List_Controller'Elab_Spec; - @b{end} @b{if}; - E057 := True; - @b{if} @b{not} E055 @b{then} - System.File_Control_Block'Elab_Spec; - E055 := True; - @b{end} @b{if}; - @b{if} @b{not} E042 @b{then} - System.File_Io'Elab_Body; - E042 := True; - @b{end} @b{if}; - @b{if} @b{not} E006 @b{then} - Ada.Text_Io'Elab_Spec; - @b{end} @b{if}; - @b{if} @b{not} E006 @b{then} - Ada.Text_Io'Elab_Body; - E006 := True; - @b{end} @b{if}; - - Elab_Final_Code := 0; + -- each unit that requires elaboration. Increment a counter of + -- reference for each unit. + + System.Soft_Links'Elab_Spec; + System.Exception_Table'Elab_Body; + E23 := E23 + 1; + Ada.Io_Exceptions'Elab_Spec; + E46 := E46 + 1; + Ada.Tags'Elab_Spec; + Ada.Streams'Elab_Spec; + E45 := E45 + 1; + Interfaces.C'Elab_Spec; + System.Exceptions'Elab_Spec; + E25 := E25 + 1; + System.Finalization_Root'Elab_Spec; + E68 := E68 + 1; + Ada.Finalization'Elab_Spec; + E66 := E66 + 1; + System.Storage_Pools'Elab_Spec; + E85 := E85 + 1; + System.Finalization_Masters'Elab_Spec; + System.Storage_Pools.Subpools'Elab_Spec; + System.Pool_Global'Elab_Spec; + E87 := E87 + 1; + System.File_Control_Block'Elab_Spec; + E75 := E75 + 1; + System.File_Io'Elab_Body; + E64 := E64 + 1; + E91 := E91 + 1; + System.Finalization_Masters'Elab_Body; + E77 := E77 + 1; + E70 := E70 + 1; + Ada.Tags'Elab_Body; + E48 := E48 + 1; + System.Soft_Links'Elab_Body; + E13 := E13 + 1; + System.Os_Lib'Elab_Body; + E72 := E72 + 1; + System.Secondary_Stack'Elab_Body; + E17 := E17 + 1; + Ada.Text_Io'Elab_Spec; + Ada.Text_Io'Elab_Body; + E06 := E06 + 1; @b{end} adainit; -------------- @@ -22883,10 +22909,31 @@ Comments have been added for clarification purposes. @findex adafinal @b{procedure} adafinal @b{is} + @b{procedure} s_stalib_adafinal; + @b{pragma} Import (C, s_stalib_adafinal, "system__standard_library__adafinal"); + + @b{procedure} Runtime_Finalize; + @b{pragma} Import (C, Runtime_Finalize, "__gnat_runtime_finalize"); + @b{begin} - Do_Finalize; + @b{if not} Is_Elaborated @b{then} + @b{return}; + @b{end if}; + Is_Elaborated := False; + Runtime_Finalize; + s_stalib_adafinal; @b{end} adafinal; + -- We get to the main program of the partition by using + -- pragma Import because if we try to with the unit and + -- call it Ada style, then not only do we waste time + -- recompiling it, but also, we don't really know the right + -- switches (e.g.@: identifier character set) to be used + -- to compile it. + + @b{procedure} Ada_Main_Program; + @b{pragma} Import (Ada, Ada_Main_Program, "_ada_hello"); + ---------- -- main -- ---------- @@ -22923,15 +22970,12 @@ Comments have been added for clarification purposes. @b{procedure} finalize; @b{pragma} Import (C, finalize, "__gnat_finalize"); - -- We get to the main program of the partition by using - -- pragma Import because if we try to with the unit and - -- call it Ada style, then not only do we waste time - -- recompiling it, but also, we don't really know the right - -- switches (e.g.@: identifier character set) to be used - -- to compile it. + -- The following is to initialize the SEH exceptions + + SEH : @b{aliased array} (1 .. 2) of Integer; - @b{procedure} Ada_Main_Program; - @b{pragma} Import (Ada, Ada_Main_Program, "_ada_hello"); + Ensure_Reference : aliased System.Address := Ada_Main_Program_Name'Address; + @b{pragma} Volatile (Ensure_Reference); -- Start of processing for main @@ -22944,17 +22988,12 @@ Comments have been added for clarification purposes. -- Call low level system initialization - Initialize; + Initialize (SEH'Address); -- Call our generated Ada initialization routine adainit; - -- This is the point at which we want the debugger to get - -- control - - Break_Start; - -- Now we call the main program of the partition Ada_Main_Program; diff --git a/gcc/ada/initialize.c b/gcc/ada/initialize.c index 9426c9e..8282ba5 100644 --- a/gcc/ada/initialize.c +++ b/gcc/ada/initialize.c @@ -62,230 +62,15 @@ extern "C" { /* __gnat_initialize (NT-mingw32 Version) */ /******************************************/ -int __gnat_wide_text_translation_required = 0; -/* wide text translation, 0=none, 1=activated */ +extern void __gnat_install_handler(void); #if defined (__MINGW32__) -#include "mingw32.h" -#include <windows.h> -extern void __gnat_init_float (void); extern void __gnat_install_SEH_handler (void *); -extern int gnat_argc; -extern char **gnat_argv; -extern CRITICAL_SECTION ProcListCS; -extern HANDLE ProcListEvt; - -#ifdef GNAT_UNICODE_SUPPORT - -#define EXPAND_ARGV_RATE 128 - -static void -append_arg (int *index, LPWSTR dir, LPWSTR value, - char ***argv, int *last, int quoted) -{ - int size; - LPWSTR fullvalue; - int vallen = _tcslen (value); - int dirlen; - - if (dir == NULL) - { - /* no dir prefix */ - dirlen = 0; - fullvalue = (LPWSTR) xmalloc ((vallen + 1) * sizeof(TCHAR)); - } - else - { - /* Add dir first */ - dirlen = _tcslen (dir); - - fullvalue = (LPWSTR) xmalloc ((dirlen + vallen + 1) * sizeof(TCHAR)); - _tcscpy (fullvalue, dir); - } - - /* Append value */ - - if (quoted) - { - _tcsncpy (fullvalue + dirlen, value + 1, vallen - 1); - fullvalue [dirlen + vallen - sizeof(TCHAR)] = _T('\0'); - } - else - _tcscpy (fullvalue + dirlen, value); - - if (*last <= *index) - { - *last += EXPAND_ARGV_RATE; - *argv = (char **) xrealloc (*argv, (*last) * sizeof (char *)); - } - - size = WS2SC (NULL, fullvalue, 0); - (*argv)[*index] = (char *) xmalloc (size + sizeof(TCHAR)); - WS2SC ((*argv)[*index], fullvalue, size); - - free (fullvalue); - - (*index)++; -} -#endif - void __gnat_initialize (void *eh ATTRIBUTE_UNUSED) { - /* Initialize floating-point coprocessor. This call is needed because - the MS libraries default to 64-bit precision instead of 80-bit - precision, and we require the full precision for proper operation, - given that we have set Max_Digits etc with this in mind */ - __gnat_init_float (); - - /* Initialize the critical section and event handle for the win32_wait() - implementation, see adaint.c */ - InitializeCriticalSection (&ProcListCS); - ProcListEvt = CreateEvent (NULL, FALSE, FALSE, NULL); - -#ifdef GNAT_UNICODE_SUPPORT - /* Set current code page for filenames handling. */ - { - char *codepage = getenv ("GNAT_CODE_PAGE"); - - /* Default code page is UTF-8. */ - CurrentCodePage = CP_UTF8; - - if (codepage != NULL) - { - if (strcmp (codepage, "CP_ACP") == 0) - CurrentCodePage = CP_ACP; - else if (strcmp (codepage, "CP_UTF8") == 0) - CurrentCodePage = CP_UTF8; - } - } - - /* Set current encoding for the IO. */ - { - char *ccsencoding = getenv ("GNAT_CCS_ENCODING"); - - /* Default CCS Encoding. */ - CurrentCCSEncoding = _O_TEXT; - __gnat_wide_text_translation_required = 0; - - if (ccsencoding != NULL) - { - if (strcmp (ccsencoding, "U16TEXT") == 0) - { - CurrentCCSEncoding = _O_U16TEXT; - __gnat_wide_text_translation_required = 1; - } - else if (strcmp (ccsencoding, "TEXT") == 0) - { - CurrentCCSEncoding = _O_TEXT; - __gnat_wide_text_translation_required = 0; - } - else if (strcmp (ccsencoding, "WTEXT") == 0) - { - CurrentCCSEncoding = _O_WTEXT; - __gnat_wide_text_translation_required = 1; - } - else if (strcmp (ccsencoding, "U8TEXT") == 0) - { - CurrentCCSEncoding = _O_U8TEXT; - __gnat_wide_text_translation_required = 1; - } - } - } - - /* Adjust gnat_argv to support Unicode characters. */ - { - LPWSTR *wargv; - int wargc; - int k; - int last; - int argc_expanded = 0; - TCHAR result [MAX_PATH]; - int quoted; - - wargv = CommandLineToArgvW (GetCommandLineW(), &wargc); - - if (wargv != NULL) - { - /* Set gnat_argv with arguments encoded in UTF-8. */ - last = wargc + 1; - gnat_argv = (char **) xmalloc ((last) * sizeof (char *)); - - /* argv[0] is the executable full path-name. */ - - SearchPath (NULL, wargv[0], _T(".exe"), MAX_PATH, result, NULL); - append_arg (&argc_expanded, NULL, result, &gnat_argv, &last, 0); - - for (k=1; k<wargc; k++) - { - quoted = (wargv[k][0] == _T('\'')); - - /* Check for wildcard expansion if the argument is not quoted. */ - if (!quoted - && (_tcsstr (wargv[k], _T("?")) != 0 || - _tcsstr (wargv[k], _T("*")) != 0)) - { - /* Wilcards are present, append all corresponding matches. */ - WIN32_FIND_DATA FileData; - HANDLE hDir = FindFirstFile (wargv[k], &FileData); - LPWSTR dir = NULL; - LPWSTR ldir = _tcsrchr (wargv[k], _T('\\')); - - if (ldir == NULL) - ldir = _tcsrchr (wargv[k], _T('/')); - - if (hDir == INVALID_HANDLE_VALUE) - { - /* No match, append arg as-is. */ - append_arg (&argc_expanded, NULL, wargv[k], - &gnat_argv, &last, quoted); - } - else - { - if (ldir != NULL) - { - int n = ldir - wargv[k] + 1; - dir = (LPWSTR) xmalloc ((n + 1) * sizeof (TCHAR)); - _tcsncpy (dir, wargv[k], n); - dir[n] = _T('\0'); - } - - /* Append first match and all remaining ones. */ - - do { - /* Do not add . and .. special entries */ - - if (_tcscmp (FileData.cFileName, _T(".")) != 0 - && _tcscmp (FileData.cFileName, _T("..")) != 0) - append_arg (&argc_expanded, dir, FileData.cFileName, - &gnat_argv, &last, 0); - } while (FindNextFile (hDir, &FileData)); - - FindClose (hDir); - - if (dir != NULL) - free (dir); - } - } - else - { - /* No wildcard. Store parameter as-is. Remove quote if - needed. */ - append_arg (&argc_expanded, NULL, wargv[k], - &gnat_argv, &last, quoted); - } - } - - LocalFree (wargv); - gnat_argc = argc_expanded; - gnat_argv = (char **) xrealloc - (gnat_argv, argc_expanded * sizeof (char *)); - } - } -#endif - /* Note that we do not activate this for the compiler itself to avoid a bootstrap path problem. Older version of gnatbind will generate a call to __gnat_initialize() without argument. Therefore we cannot use eh in @@ -305,12 +90,9 @@ __gnat_initialize (void *eh ATTRIBUTE_UNUSED) #elif defined (__Lynx__) || defined (__FreeBSD__) || defined(__NetBSD__) \ || defined (__OpenBSD__) -extern void __gnat_init_float (void); - void __gnat_initialize (void *eh ATTRIBUTE_UNUSED) { - __gnat_init_float (); } /***************************************/ @@ -319,12 +101,9 @@ __gnat_initialize (void *eh ATTRIBUTE_UNUSED) #elif defined(__vxworks) -extern void __gnat_init_float (void); - void __gnat_initialize (void *eh) { - __gnat_init_float (); } #elif defined(_T_HPUX10) || (!defined(IN_RTS) && defined(_X_HPUX10)) @@ -354,7 +133,6 @@ void __gnat_initialize (void *eh ATTRIBUTE_UNUSED) { } - #endif #ifdef __cplusplus diff --git a/gcc/ada/rtfinal.c b/gcc/ada/rtfinal.c new file mode 100644 index 0000000..0500964 --- /dev/null +++ b/gcc/ada/rtfinal.c @@ -0,0 +1,89 @@ +/**************************************************************************** + * * + * GNAT COMPILER COMPONENTS * + * * + * R T F I N A L * + * * + * C Implementation File * + * * + * Copyright (C) 2014-2015, 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. * + * * + * As a special exception under Section 7 of GPL version 3, you are granted * + * additional permissions described in the GCC Runtime Library Exception, * + * version 3.1, as published by the Free Software Foundation. * + * * + * You should have received a copy of the GNU General Public License and * + * a copy of the GCC Runtime Library Exception along with this program; * + * see the files COPYING3 and COPYING.RUNTIME respectively. If not, see * + * <http://www.gnu.org/licenses/>. * + * * + * GNAT was originally developed by the GNAT team at New York University. * + * Extensive contributions were provided by Ada Core Technologies Inc. * + * * + ****************************************************************************/ + +#ifdef __cplusplus +extern "C" { +#endif + +extern void __gnat_runtime_finalize (void); + +/* This routine is called at the extreme end of execution of an Ada program + (the call is generated by the binder). The standard routine does nothing + at all, the intention is that this be replaced by system specific code + where finalization is required. + + Note that __gnat_runtime_initialize() is called in adafinal() */ + +extern int __gnat_rt_init_count; +/* see initialize.c */ + +#if defined (__MINGW32__) +#include "mingw32.h" +#include <windows.h> + +extern CRITICAL_SECTION ProcListCS; +extern HANDLE ProcListEvt; + +void +__gnat_runtime_finalize (void) +{ + /* decrement the reference counter */ + + __gnat_rt_init_count--; + + /* if still some referenced return now */ + if (__gnat_rt_init_count > 0) + return; + + /* delete critical section and event handle used for the + processes chain list */ + DeleteCriticalSection(&ProcListCS); + CloseHandle (ProcListEvt); +} + +#else + +void +__gnat_runtime_finalize (void) +{ + /* decrement the reference counter */ + + __gnat_rt_init_count--; + + /* if still some referenced return now */ + if (__gnat_rt_init_count > 0) + return; +} +#endif + +#ifdef __cplusplus +} +#endif diff --git a/gcc/ada/rtinit.c b/gcc/ada/rtinit.c new file mode 100644 index 0000000..59bac0f --- /dev/null +++ b/gcc/ada/rtinit.c @@ -0,0 +1,381 @@ +/**************************************************************************** + * * + * GNAT COMPILER COMPONENTS * + * * + * I N I T I A L I Z E * + * * + * C Implementation File * + * * + * Copyright (C) 2014-2015, 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. * + * * + * As a special exception under Section 7 of GPL version 3, you are granted * + * additional permissions described in the GCC Runtime Library Exception, * + * version 3.1, as published by the Free Software Foundation. * + * * + * You should have received a copy of the GNU General Public License and * + * a copy of the GCC Runtime Library Exception along with this program; * + * see the files COPYING3 and COPYING.RUNTIME respectively. If not, see * + * <http://www.gnu.org/licenses/>. * + * * + * GNAT was originally developed by the GNAT team at New York University. * + * Extensive contributions were provided by Ada Core Technologies Inc. * + * * + ****************************************************************************/ + +/* This unit provides implementation for __gnat_runtime_initialize () + which is called in adainit() to do special initialization needed by + the GNAT runtime. */ + + +/* The following include is here to meet the published VxWorks requirement + that the __vxworks header appear before any other include. */ +#ifdef __vxworks +#include "vxWorks.h" +#endif + +#ifdef IN_RTS +#include "tconfig.h" +#include "tsystem.h" +/* We don't have libiberty, so use malloc. */ +#define xmalloc(S) malloc (S) +#define xrealloc(V,S) realloc (V,S) +#else +#include "config.h" +#include "system.h" +#endif + +#include "raise.h" +#include <fcntl.h> + +#ifdef __cplusplus +extern "C" { +#endif + +/**************************************************/ +/* __gnat_runtime_initialize (NT-mingw32 Version) */ +/**************************************************/ + +extern void __gnat_install_handler(void); + +int __gnat_wide_text_translation_required = 0; +/* wide text translation, 0=none, 1=activated */ + +int __gnat_rt_init_count = 0; +/* number of references to the GNAT runtime, this is used to initialize + and finalize properly the run-time. */ + +#if defined (__MINGW32__) +#include "mingw32.h" +#include <windows.h> + +extern void __gnat_init_float (void); +extern void __gnat_install_SEH_handler (void *); + +extern int gnat_argc; +extern char **gnat_argv; +extern CRITICAL_SECTION ProcListCS; +extern HANDLE ProcListEvt; + +#ifdef GNAT_UNICODE_SUPPORT + +#define EXPAND_ARGV_RATE 128 + +static void +append_arg (int *index, LPWSTR dir, LPWSTR value, + char ***argv, int *last, int quoted) +{ + int size; + LPWSTR fullvalue; + int vallen = _tcslen (value); + int dirlen; + + if (dir == NULL) + { + /* no dir prefix */ + dirlen = 0; + fullvalue = (LPWSTR) xmalloc ((vallen + 1) * sizeof(TCHAR)); + } + else + { + /* Add dir first */ + dirlen = _tcslen (dir); + + fullvalue = (LPWSTR) xmalloc ((dirlen + vallen + 1) * sizeof(TCHAR)); + _tcscpy (fullvalue, dir); + } + + /* Append value */ + + if (quoted) + { + _tcsncpy (fullvalue + dirlen, value + 1, vallen - 1); + fullvalue [dirlen + vallen - sizeof(TCHAR)] = _T('\0'); + } + else + _tcscpy (fullvalue + dirlen, value); + + if (*last <= *index) + { + *last += EXPAND_ARGV_RATE; + *argv = (char **) xrealloc (*argv, (*last) * sizeof (char *)); + } + + size = WS2SC (NULL, fullvalue, 0); + (*argv)[*index] = (char *) xmalloc (size + sizeof(TCHAR)); + WS2SC ((*argv)[*index], fullvalue, size); + + free (fullvalue); + + (*index)++; +} +#endif + +void +__gnat_runtime_initialize(void) +{ + /* increment the reference counter */ + + __gnat_rt_init_count++; + + /* if already initialized return now */ + if (__gnat_rt_init_count > 1) + return; + + /* Initialize floating-point coprocessor. This call is needed because + the MS libraries default to 64-bit precision instead of 80-bit + precision, and we require the full precision for proper operation, + given that we have set Max_Digits etc with this in mind */ + + __gnat_init_float (); + + /* Initialize the critical section and event handle for the win32_wait() + implementation, see adaint.c */ + + InitializeCriticalSection (&ProcListCS); + ProcListEvt = CreateEvent (NULL, FALSE, FALSE, NULL); + +#ifdef GNAT_UNICODE_SUPPORT + /* Set current code page for filenames handling. */ + { + char *codepage = getenv ("GNAT_CODE_PAGE"); + + /* Default code page is UTF-8. */ + CurrentCodePage = CP_UTF8; + + if (codepage != NULL) + { + if (strcmp (codepage, "CP_ACP") == 0) + CurrentCodePage = CP_ACP; + else if (strcmp (codepage, "CP_UTF8") == 0) + CurrentCodePage = CP_UTF8; + } + } + + /* Set current encoding for the IO. */ + { + char *ccsencoding = getenv ("GNAT_CCS_ENCODING"); + + /* Default CCS Encoding. */ + CurrentCCSEncoding = _O_TEXT; + __gnat_wide_text_translation_required = 0; + + if (ccsencoding != NULL) + { + if (strcmp (ccsencoding, "U16TEXT") == 0) + { + CurrentCCSEncoding = _O_U16TEXT; + __gnat_wide_text_translation_required = 1; + } + else if (strcmp (ccsencoding, "TEXT") == 0) + { + CurrentCCSEncoding = _O_TEXT; + __gnat_wide_text_translation_required = 0; + } + else if (strcmp (ccsencoding, "WTEXT") == 0) + { + CurrentCCSEncoding = _O_WTEXT; + __gnat_wide_text_translation_required = 1; + } + else if (strcmp (ccsencoding, "U8TEXT") == 0) + { + CurrentCCSEncoding = _O_U8TEXT; + __gnat_wide_text_translation_required = 1; + } + } + } + + /* Adjust gnat_argv to support Unicode characters. */ + { + LPWSTR *wargv; + int wargc; + int k; + int last; + int argc_expanded = 0; + TCHAR result [MAX_PATH]; + int quoted; + + wargv = CommandLineToArgvW (GetCommandLineW(), &wargc); + + if (wargv != NULL) + { + /* Set gnat_argv with arguments encoded in UTF-8. */ + last = wargc + 1; + gnat_argv = (char **) xmalloc ((last) * sizeof (char *)); + + /* argv[0] is the executable full path-name. */ + + SearchPath (NULL, wargv[0], _T(".exe"), MAX_PATH, result, NULL); + append_arg (&argc_expanded, NULL, result, &gnat_argv, &last, 0); + + for (k=1; k<wargc; k++) + { + quoted = (wargv[k][0] == _T('\'')); + + /* Check for wildcard expansion if the argument is not quoted. */ + if (!quoted + && (_tcsstr (wargv[k], _T("?")) != 0 || + _tcsstr (wargv[k], _T("*")) != 0)) + { + /* Wilcards are present, append all corresponding matches. */ + WIN32_FIND_DATA FileData; + HANDLE hDir = FindFirstFile (wargv[k], &FileData); + LPWSTR dir = NULL; + LPWSTR ldir = _tcsrchr (wargv[k], _T('\\')); + + if (ldir == NULL) + ldir = _tcsrchr (wargv[k], _T('/')); + + if (hDir == INVALID_HANDLE_VALUE) + { + /* No match, append arg as-is. */ + append_arg (&argc_expanded, NULL, wargv[k], + &gnat_argv, &last, quoted); + } + else + { + if (ldir != NULL) + { + int n = ldir - wargv[k] + 1; + dir = (LPWSTR) xmalloc ((n + 1) * sizeof (TCHAR)); + _tcsncpy (dir, wargv[k], n); + dir[n] = _T('\0'); + } + + /* Append first match and all remaining ones. */ + + do { + /* Do not add . and .. special entries */ + + if (_tcscmp (FileData.cFileName, _T(".")) != 0 + && _tcscmp (FileData.cFileName, _T("..")) != 0) + append_arg (&argc_expanded, dir, FileData.cFileName, + &gnat_argv, &last, 0); + } while (FindNextFile (hDir, &FileData)); + + FindClose (hDir); + + if (dir != NULL) + free (dir); + } + } + else + { + /* No wildcard. Store parameter as-is. Remove quote if + needed. */ + append_arg (&argc_expanded, NULL, wargv[k], + &gnat_argv, &last, quoted); + } + } + + LocalFree (wargv); + gnat_argc = argc_expanded; + gnat_argv = (char **) xrealloc + (gnat_argv, argc_expanded * sizeof (char *)); + } + } +#endif + + __gnat_install_handler(); +} + +/**************************************************/ +/* __gnat_runtime_initialize (init_float version) */ +/**************************************************/ + +#elif defined (__Lynx__) || defined (__FreeBSD__) || defined(__NetBSD__) \ + || defined (__OpenBSD__) + +extern void __gnat_init_float (void); + +void +__gnat_runtime_initialize(void) +{ + /* increment the reference counter */ + + __gnat_rt_init_count++; + + /* if already initialized return now */ + if (__gnat_rt_init_count > 1) + return; + + __gnat_init_float (); + + __gnat_install_handler(); +} + +/***********************************************/ +/* __gnat_runtime_initialize (VxWorks Version) */ +/***********************************************/ + +#elif defined(__vxworks) + +extern void __gnat_init_float (void); + +void +__gnat_runtime_initialize(void) +{ + /* increment the reference counter */ + + __gnat_rt_init_count++; + + /* if already initialized return now */ + if (__gnat_rt_init_count > 1) + return; + + __gnat_init_float (); + + __gnat_install_handler(); +} + +#else + +/***********************************************/ +/* __gnat_runtime_initialize (default version) */ +/***********************************************/ + +void +__gnat_runtime_initialize(void) +{ + /* increment the reference counter */ + + __gnat_rt_init_count++; + + /* if already initialized return now */ + if (__gnat_rt_init_count > 1) + return; + + __gnat_install_handler(); +} + +#endif + +#ifdef __cplusplus +} +#endif |