OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

2008-07-30 Jose Ruiz <ruiz@adacore.com>

Browse Source 
* 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
This commit is contained in:
Jose Ruiz 2008-07-30 15:03:32 +02:00 committed by Arnaud Charlet
parent 88462e8132
commit f921a1cd93
7 changed files with 275 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
gcc/ada/adaint.c
View File

@ -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__)

4
gcc/ada/argv.c
View File

@ -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 */

23
gcc/ada/cio.c
View File

@ -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 <windows.h>
#include <Rtapi.h>
#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

20
gcc/ada/gcc-interface/Makefile.in
View File

@ -1326,13 +1326,20 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
s-intman.adb<s-intman-dummy.adb \
s-osinte.ads<s-osinte-rtx.ads \
s-osprim.adb<s-osprim-rtx.adb \
s-taprop.adb<s-taprop-rtx.adb \
system.ads<system-rtx.ads
s-taprop.adb<s-taprop-rtx.adb
EXTRA_GNATRTL_NONTASKING_OBJS = s-win32.o
MISCLIB = -lwsock32 -lrtapi_w32
THREADSLIB=-lrtapi_w32
ifeq ($(strip $(filter-out rtx_w32,$(THREAD_KIND))),)
LIBGNAT_TARGET_PAIRS += system.ads<system-rtx.ads
EH_MECHANISM=-gcc
else
LIBGNAT_TARGET_PAIRS += system.ads<system-rtx-rtss.ads
EH_MECHANISM=
endif
else
LIBGNAT_TARGET_PAIRS += \
a-exetim.adb<a-exetim-mingw.adb \
@ -1354,13 +1361,14 @@ ifeq ($(strip $(filter-out cygwin32% mingw32% pe,$(osys))),)
# ??? This will be replaced by gnatlib-shared-dual-win32 when GNAT
# auto-import support for array/record will be done.
GNATLIB_SHARED = gnatlib-shared-win32
EH_MECHANISM=-gcc
endif
TOOLS_TARGET_PAIRS= \
mlib-tgt-specific.adb<mlib-tgt-specific-mingw.adb \
indepsw.adb<indepsw-mingw.adb
EH_MECHANISM=-gcc
GMEM_LIB = gmemlib
PREFIX_OBJS = $(PREFIX_REAL_OBJS)
EXTRA_GNATTOOLS = ../../gnatdll$(exeext)
@ -1706,7 +1714,7 @@ endif
# while GNATRTL_OBJS lists the object files compiled from Ada sources that
# go into the directory. The pthreads emulation is built in the threads
# subdirectory and copied.
LIBGNAT_SRCS = ada.h adaint.c adaint.h argv.c cio.c cstreams.c \
LIBGNAT_SRCS = adaint.c adaint.h argv.c cio.c cstreams.c \
errno.c exit.c cal.c ctrl_c.c env.c env.h \
raise.h raise.c sysdep.c aux-io.c init.c initialize.c seh_init.c \
final.c tracebak.c tb-alvms.c tb-alvxw.c tb-gcc.c expect.c mkdir.c \

276
gcc/ada/gnatlink.adb
View File

@ -1484,25 +1484,11 @@ begin
Exit_Program (E_Fatal);
end if;
-- Get target parameters
-- Initialize packages to be used
Namet.Initialize;
Csets.Initialize;
Snames.Initialize;
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;
-- 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;

6
gcc/ada/targparm.adb
View File

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

3
gcc/ada/targparm.ads
View File

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