From f921a1cd93f089a81c2ae2cee22bc9b0ee3beee5 Mon Sep 17 00:00:00 2001 From: Jose Ruiz Date: Wed, 30 Jul 2008 15:03:32 +0200 Subject: [PATCH] 2008-07-30 Jose Ruiz * adaint.c (__gnat_file_exists): Do not use __gnat_stat for RTX. (__main for RTX in RTSS mode): Create this dummy procedure symbol to avoid the use of this symbol from libgcc.a in RTX kernel mode. * cio.c (put_int, put_int_stderr, put_char, put_char_stderr): For RTX we call the function RtPrintf for console output. * argv.c Do not use the environ variable for RTX. * gnatlink.adb (gnatlink): The part that handles the --RTS option has been moved before the call to Osint.Add_Default_Search_Dirs in order to take into account the flags in system.ads (RTX_RTSS_Kernel_Module) from the appropriate run time. * targparm.ads (RTX_RTSS_Kernel_Module_On_Target): Add this flag that is set to True if target is a RTSS module for RTX. * targparm.adb (Targparm_Tags, RTX_Str, Targparm_Str): Add tag RTX for RTX_RTSS_Kernel_Module (Get_Target_Parameters): Add processing of RTX_RTSS_Kernel_Module flag. * gcc-interface/Makefile.in (LIBGNAT_TARGET_PAIRS for RTX): Use gcc exception handling mechanism for Windows and RTX in Win32 mode, but not for RTX in kernel mode (RTSS). (LIBGNAT_SRCS): Remove ada.h From-SVN: r138305 --- gcc/ada/adaint.c | 18 +- gcc/ada/argv.c | 4 +- gcc/ada/cio.c | 23 ++- gcc/ada/gcc-interface/Makefile.in | 20 ++- gcc/ada/gnatlink.adb | 276 +++++++++++++++++++++++------- gcc/ada/targparm.adb | 6 +- gcc/ada/targparm.ads | 3 + 7 files changed, 275 insertions(+), 75 deletions(-) diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c index 8f7bcab516f..29f649aa096 100644 --- a/gcc/ada/adaint.c +++ b/gcc/ada/adaint.c @@ -1061,6 +1061,7 @@ __gnat_readdir (DIR *dirp, char *buffer, int *len) /* Not supported in RTX */ return NULL; + #elif defined (__MINGW32__) struct _tdirent *dirent = _treaddir ((_TDIR*)dirp); @@ -1606,7 +1607,7 @@ __gnat_stat (char *name, struct stat *statbuf) int __gnat_file_exists (char *name) { -#if defined (__MINGW32__) && !defined (RTX) +#ifdef __MINGW32__ /* On Windows do not use __gnat_stat() because a bug in Microsoft _stat() routine. When the system time-zone is set with a negative offset the _stat() routine fails on specific files like CON: */ @@ -3048,11 +3049,14 @@ __gnat_sals_init_using_constructors () #endif } +#ifdef RTX + /* In RTX mode, the procedure to get the time (as file time) is different in RTSS mode and Win32 mode. In order to avoid duplicating an Ada file, we introduce an intermediate procedure to link against the corresponding one in each situation. */ -#ifdef RTX + +extern void GetTimeAsFileTime(LPFILETIME pTime); void GetTimeAsFileTime(LPFILETIME pTime) { @@ -3062,6 +3066,16 @@ void GetTimeAsFileTime(LPFILETIME pTime) GetSystemTimeAsFileTime (pTime); /* w32 interface */ #endif } + +#ifdef RTSS +/* Add symbol that is required to link. It would otherwise be taken from + libgcc.a and it would try to use the gcc constructors that are not + supported by Microsoft linker. */ + +extern void __main (void); + +void __main (void) {} +#endif #endif #if defined (linux) || defined(__GLIBC__) diff --git a/gcc/ada/argv.c b/gcc/ada/argv.c index 276edf7e0f2..0adfa4ea948 100644 --- a/gcc/ada/argv.c +++ b/gcc/ada/argv.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2007, Free Software Foundation, Inc. * + * Copyright (C) 1992-2008, 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- * @@ -61,7 +61,7 @@ int gnat_argc = 0; const char **gnat_argv = (const char **) 0; const char **gnat_envp = (const char **) 0; -#ifdef _WIN32 +#if defined (_WIN32) && !defined (RTX) /* Note that on Windows environment the environ point to a buffer that could be reallocated if needed. It means that gnat_envp needs to be updated before using gnat_envp to point to the right environment space */ diff --git a/gcc/ada/cio.c b/gcc/ada/cio.c index 6fba5a0b0cb..67dcfc3dd36 100644 --- a/gcc/ada/cio.c +++ b/gcc/ada/cio.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 1992-2005, Free Software Foundation, Inc. * + * Copyright (C) 1992-2008, 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- * @@ -56,6 +56,11 @@ #undef getchar #endif +#ifdef RTX +#include +#include +#endif + int get_char (void) { @@ -78,27 +83,43 @@ get_int (void) void put_int (int x) { +#ifdef RTX + RtPrintf ("%d", x); +#else /* Use fprintf rather than printf, since the latter is unbuffered on vxworks */ fprintf (stdout, "%d", x); +#endif } void put_int_stderr (int x) { +#ifdef RTX + RtPrintf ("%d", x); +#else fprintf (stderr, "%d", x); +#endif } void put_char (int c) { +#ifdef RTX + RtPrintf ("%c", c); +#else putchar (c); +#endif } void put_char_stderr (int c) { +#ifdef RTX + RtPrintf ("%c", c); +#else fputc (c, stderr); +#endif } #ifdef __vxworks diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 020ee2080be..a8c0c1bbb25 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -1326,13 +1326,20 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),) s-intman.adb Gcc := new String'("jgnat"); - when CLI_Target => Gcc := new String'("dotnet-gnatcompile"); - when No_VM => raise Program_Error; - end case; - - Ada_Bind_File := True; - Begin_Info := "-- BEGIN Object file/option list"; - End_Info := "-- END Object file/option list "; - end if; -- We always compile with -c @@ -1510,50 +1496,6 @@ begin Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := new String'("-c"); - -- If the main program is in Ada it is compiled with the following - -- switches: - - -- -gnatA stops reading gnat.adc, since we don't know what - -- pragmas would work, and we do not need it anyway. - - -- -gnatWb allows brackets coding for wide characters - - -- -gnatiw allows wide characters in identifiers. This is needed - -- because bindgen uses brackets encoding for all upper - -- half and wide characters in identifier names. - - if Ada_Bind_File then - Binder_Options_From_ALI.Increment_Last; - Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := - new String'("-gnatA"); - Binder_Options_From_ALI.Increment_Last; - Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := - new String'("-gnatWb"); - Binder_Options_From_ALI.Increment_Last; - Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := - new String'("-gnatiw"); - end if; - - -- Locate all the necessary programs and verify required files are present - - Gcc_Path := System.OS_Lib.Locate_Exec_On_Path (Gcc.all); - - if Gcc_Path = null then - Exit_With_Error ("Couldn't locate " & Gcc.all); - end if; - - if Linker_Path = null then - if VM_Target = CLI_Target then - Linker_Path := System.OS_Lib.Locate_Exec_On_Path ("ilasm"); - - if Linker_Path = null then - Exit_With_Error ("Couldn't locate ilasm"); - end if; - else - Linker_Path := Gcc_Path; - end if; - end if; - if Ali_File_Name = null then Exit_With_Error ("no ali file given for link"); end if; @@ -1624,6 +1566,18 @@ begin := String_Access (Arg); end if; + -- Set the RTS_*_Path_Name variables, so that the + -- correct directories will be set when + -- Osint.Add_Default_Search_Dirs will be called later. + + Opt.RTS_Src_Path_Name := + Get_RTS_Search_Dir + (Arg (Arg'First + 6 .. Arg'Last), Include); + + Opt.RTS_Lib_Path_Name := + Get_RTS_Search_Dir + (Arg (Arg'First + 6 .. Arg'Last), Objects); + -- GNAT doesn't support the GCC multilib mechanism. -- This means that, when a multilib switch is used -- to request a particular compilation mode, the @@ -1635,8 +1589,7 @@ begin -- Pass -mrtp to the linker if --RTS=rtp was passed - if Linker_Path = Gcc_Path - and then Arg'Length > 8 + if Arg'Length > 8 and then Arg (Arg'First + 6 .. Arg'First + 8) = "rtp" then Linker_Options.Increment_Last; @@ -1645,8 +1598,7 @@ begin -- Pass -fsjlj to the linker if --RTS=sjlj was passed - elsif Linker_Path = Gcc_Path - and then Arg'Length > 9 + elsif Arg'Length > 9 and then Arg (Arg'First + 6 .. Arg'First + 9) = "sjlj" then Linker_Options.Increment_Last; @@ -1660,6 +1612,77 @@ begin end; end if; + -- Get target parameters + + Osint.Add_Default_Search_Dirs; + Targparm.Get_Target_Parameters; + + if VM_Target /= No_VM then + case VM_Target is + when JVM_Target => Gcc := new String'("jgnat"); + when CLI_Target => Gcc := new String'("dotnet-gnatcompile"); + when No_VM => raise Program_Error; + end case; + + Ada_Bind_File := True; + Begin_Info := "-- BEGIN Object file/option list"; + End_Info := "-- END Object file/option list "; + end if; + + -- If the main program is in Ada it is compiled with the following + -- switches: + + -- -gnatA stops reading gnat.adc, since we don't know what + -- pragmas would work, and we do not need it anyway. + + -- -gnatWb allows brackets coding for wide characters + + -- -gnatiw allows wide characters in identifiers. This is needed + -- because bindgen uses brackets encoding for all upper + -- half and wide characters in identifier names. + + if Ada_Bind_File then + Binder_Options_From_ALI.Increment_Last; + Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := + new String'("-gnatA"); + Binder_Options_From_ALI.Increment_Last; + Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := + new String'("-gnatWb"); + Binder_Options_From_ALI.Increment_Last; + Binder_Options_From_ALI.Table (Binder_Options_From_ALI.Last) := + new String'("-gnatiw"); + end if; + + -- Locate all the necessary programs and verify required files are present + + Gcc_Path := System.OS_Lib.Locate_Exec_On_Path (Gcc.all); + + if Gcc_Path = null then + Exit_With_Error ("Couldn't locate " & Gcc.all); + end if; + + if Linker_Path = null then + if VM_Target = CLI_Target then + Linker_Path := System.OS_Lib.Locate_Exec_On_Path ("ilasm"); + + if Linker_Path = null then + Exit_With_Error ("Couldn't locate ilasm"); + end if; + + elsif RTX_RTSS_Kernel_Module_On_Target then + -- Use Microsoft linker for RTSS modules + + Linker_Path := System.OS_Lib.Locate_Exec_On_Path ("link"); + + if Linker_Path = null then + Exit_With_Error ("Couldn't locate link"); + end if; + + else + Linker_Path := Gcc_Path; + end if; + end if; + Write_Header; -- If no output name specified, then use the base name of .ali file name @@ -1680,6 +1703,11 @@ begin Linker_Options.Table (Linker_Options.Last) := new String'("/OUTPUT=" & Output_File_Name.all); + elsif RTX_RTSS_Kernel_Module_On_Target then + Linker_Options.Increment_Last; + Linker_Options.Table (Linker_Options.Last) := + new String'("/OUT:" & Output_File_Name.all); + else Linker_Options.Increment_Last; Linker_Options.Table (Linker_Options.Last) := new String'("-o"); @@ -1869,6 +1897,119 @@ begin Num_Args := Num_Args - 1; end if; end loop; + + elsif RTX_RTSS_Kernel_Module_On_Target then + -- Remove flags not relevant for Microsoft linker and adapt some + -- others. + + for J in reverse Linker_Options.First .. Linker_Options.Last loop + + -- Remove flags that are not accepted + if Linker_Options.Table (J)'Length = 0 + or else Linker_Options.Table (J) (1 .. 2) = "-l" + or else Linker_Options.Table (J) (1 .. 3) = "-Wl" + or else Linker_Options.Table (J) (1 .. 3) = "-sh" + or else Linker_Options.Table (J) (1 .. 8) = "-Xlinker" + or else Linker_Options.Table (J) (1 .. 9) = "-mthreads" + then + Linker_Options.Table (J .. Linker_Options.Last - 1) := + Linker_Options.Table (J + 1 .. Linker_Options.Last); + Linker_Options.Decrement_Last; + Num_Args := Num_Args - 1; + + -- Replace "-L" by its counterpart "/LIBPATH:" and UNIX "/" by + -- Windows "\". + elsif Linker_Options.Table (J) (1 .. 2) = "-L" then + declare + Libpath_Option : constant String_Access := new String' + ("/LIBPATH:" & + Linker_Options.Table (J) + (3 .. Linker_Options.Table (J).all'Last)); + begin + for Index in 10 .. Libpath_Option'Last loop + if Libpath_Option (Index) = '/' then + Libpath_Option (Index) := '\'; + end if; + end loop; + + Linker_Options.Table (J) := Libpath_Option; + end; + + -- Replace "-g" by "/DEBUG" + elsif Linker_Options.Table (J) (1 .. 2) = "-g" then + Linker_Options.Table (J) := new String'("/DEBUG"); + + -- Replace "-o" by "/OUT:" + elsif Linker_Options.Table (J) (1 .. 2) = "-o" then + Linker_Options.Table (J + 1) := new String' + ("/OUT:" & Linker_Options.Table (J + 1).all); + + Linker_Options.Table (J .. Linker_Options.Last - 1) := + Linker_Options.Table (J + 1 .. Linker_Options.Last); + Linker_Options.Decrement_Last; + Num_Args := Num_Args - 1; + + -- Replace "--stack=" by "/STACK:" + elsif Linker_Options.Table (J) (1 .. 8) = "--stack=" then + Linker_Options.Table (J) := new String' + ("/STACK:" & + Linker_Options.Table (J) + (9 .. Linker_Options.Table (J).all'Last)); + + -- Replace "-v" by its counterpart "/VERBOSE" + elsif Linker_Options.Table (J) (1 .. 2) = "-v" then + Linker_Options.Table (J) := new String'("/VERBOSE"); + end if; + end loop; + + -- Add some required flags to create RTSS modules + + declare + Flags_For_Linker : constant array (1 .. 17) of String_Access := + (new String'("/NODEFAULTLIB"), + new String'("/INCREMENTAL:NO"), + new String'("/NOLOGO"), + new String'("/DRIVER"), + new String'("/ALIGN:0x20"), + new String'("/SUBSYSTEM:NATIVE"), + new String'("/ENTRY:_RtapiProcessEntryCRT@8"), + new String'("/RELEASE"), + new String'("startupCRT.obj"), + new String'("rtxlibcmt.lib"), + new String'("oldnames.lib"), + new String'("rtapi_rtss.lib"), + new String'("Rtx_Rtss.lib"), + new String'("libkernel32.a"), + new String'("libws2_32.a"), + new String'("libmswsock.a"), + new String'("libadvapi32.a")); + -- These flags need to be passed to Microsoft linker. They + -- come from the RTX documentation. + + Gcc_Lib_Path : constant String_Access := new String' + ("/LIBPATH:" & Include_Dir_Default_Prefix & "\..\"); + -- Place to look for gcc related libraries, such as libgcc + + begin + -- Replace UNIX "/" by Windows "\" in the path + + for Index in 10 .. Gcc_Lib_Path.all'Last loop + if Gcc_Lib_Path (Index) = '/' then + Gcc_Lib_Path (Index) := '\'; + end if; + end loop; + + Linker_Options.Increment_Last; + Linker_Options.Table (Linker_Options.Last) := Gcc_Lib_Path; + Num_Args := Num_Args + 1; + + for Index in Flags_For_Linker'Range loop + Linker_Options.Increment_Last; + Linker_Options.Table (Linker_Options.Last) := + Flags_For_Linker (Index); + Num_Args := Num_Args + 1; + end loop; + end; end if; -- Remove duplicate stack size setting from the Linker_Options @@ -1978,6 +2119,15 @@ begin Linker_Options.Table (Linker_Options.Last) := Static_Libgcc; Num_Args := Num_Args + 1; end if; + + elsif RTX_RTSS_Kernel_Module_On_Target then + + -- Force the use of the static libgcc for RTSS modules + + Linker_Options.Increment_Last; + Linker_Options.Table (Linker_Options.Last) := + new String'("libgcc.a"); + Num_Args := Num_Args + 1; end if; end Clean_Link_Option_Set; diff --git a/gcc/ada/targparm.adb b/gcc/ada/targparm.adb index 6039cf7406b..52bbbcb953c 100644 --- a/gcc/ada/targparm.adb +++ b/gcc/ada/targparm.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2008, 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- -- @@ -54,6 +54,7 @@ package body Targparm is MOV, -- Machine_Overflows MRN, -- Machine_Rounds PAS, -- Preallocated_Stacks + RTX, -- RTX_RTSS_Kernel_Module S64, -- Support_64_Bit_Divides SAG, -- Support_Aggregates SCA, -- Support_Composite_Assign @@ -90,6 +91,7 @@ package body Targparm is MOV_Str : aliased constant Source_Buffer := "Machine_Overflows"; MRN_Str : aliased constant Source_Buffer := "Machine_Rounds"; PAS_Str : aliased constant Source_Buffer := "Preallocated_Stacks"; + RTX_Str : aliased constant Source_Buffer := "RTX_RTSS_Kernel_Module"; S64_Str : aliased constant Source_Buffer := "Support_64_Bit_Divides"; SAG_Str : aliased constant Source_Buffer := "Support_Aggregates"; SCA_Str : aliased constant Source_Buffer := "Support_Composite_Assign"; @@ -126,6 +128,7 @@ package body Targparm is MOV_Str'Access, MRN_Str'Access, PAS_Str'Access, + RTX_Str'Access, S64_Str'Access, SAG_Str'Access, SCA_Str'Access, @@ -573,6 +576,7 @@ package body Targparm is when MOV => Machine_Overflows_On_Target := Result; when MRN => Machine_Rounds_On_Target := Result; when PAS => Preallocated_Stacks_On_Target := Result; + when RTX => RTX_RTSS_Kernel_Module_On_Target := Result; when S64 => Support_64_Bit_Divides_On_Target := Result; when SAG => Support_Aggregates_On_Target := Result; when SCA => Support_Composite_Assign_On_Target := Result; diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads index c40d6d81adc..97192a56143 100644 --- a/gcc/ada/targparm.ads +++ b/gcc/ada/targparm.ads @@ -216,6 +216,9 @@ package Targparm is OpenVMS_On_Target : Boolean := False; -- Set to True if target is OpenVMS + RTX_RTSS_Kernel_Module_On_Target : Boolean := False; + -- Set to True if target is RTSS module for RTX + type Virtual_Machine_Kind is (No_VM, JVM_Target, CLI_Target); VM_Target : Virtual_Machine_Kind := No_VM; -- Kind of virtual machine targetted