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

bindgen.adb (Gen_Adainit_Ada): If the main program is a CIL function... 

2008-04-08  Jerome Lambourg  <lambourg@adacore.com>
	    Arnaud Charlet  <charlet@adacore.com>

	* bindgen.adb (Gen_Adainit_Ada): If the main program is a CIL function,
	then use __gnat_set_exit_status to report the returned status code.

	* comperr.adb (Compiler_Abort): Convert most bug boxes into clean error
	messages on .NET, since some constructs of the language are not
	properly supported.

	* gnatlink.adb (Gnatlink): In case the command line is too long for the
	.NET linker, gnatlink now concatenate all .il files and pass this to
	ilasm.

From-SVN: r134066
This commit is contained in:
Jerome Lambourg 2008-04-08 08:58:12 +02:00 committed by Arnaud Charlet
parent 77e5104283
commit c96597bfe5
3 changed files with 94 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gcc/ada/bindgen.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- 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- --
@ -618,17 +618,27 @@ package body Bindgen is
"""__gnat_initialize_stack_limit"");");
end if;
-- Special processing when main program is CIL function/procedure
if VM_Target = CLI_Target
and then Bind_Main_Program
and then not No_Main_Subprogram
then
WBI ("");
-- Function case, use Set_Exit_Status to report the returned
-- status code, since that is the only mechanism available.
if ALIs.Table (ALIs.First).Main_Program = Func then
WBI (" Result : Integer;");
WBI (" procedure Set_Exit_Status (Code : Integer);");
WBI (" pragma Import (C, Set_Exit_Status, " &
"""__gnat_set_exit_status"");");
WBI ("");
WBI (" function Ada_Main_Program return Integer;");
-- Procedure case
else
WBI (" procedure Ada_Main_Program;");
end if;
@ -797,12 +807,20 @@ package body Bindgen is
WBI ("");
Gen_Elab_Calls_Ada;
-- Case of main program is CIL function or procedure
if VM_Target = CLI_Target
and then Bind_Main_Program
and then not No_Main_Subprogram
then
-- For function case, use Set_Exit_Status to set result
if ALIs.Table (ALIs.First).Main_Program = Func then
WBI (" Result := Ada_Main_Program;");
WBI (" Set_Exit_Status (Result);");
-- Procedure case
else
WBI (" Ada_Main_Program;");
end if;
@ -2270,7 +2288,7 @@ package body Bindgen is
if VM_Target = No_VM then
Set_Main_Program_Name;
Set_String (""" & Ascii.NUL;");
Set_String (""" & ASCII.NUL;");
else
Set_String (Name_Buffer (1 .. Name_Len - 2) & """;");
end if;

28
gcc/ada/comperr.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- 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- --
@ -39,6 +39,7 @@ with Output; use Output;
with Sinput; use Sinput;
with Sprint; use Sprint;
with Sdefault; use Sdefault;
with Targparm; use Targparm;
with Treepr; use Treepr;
with Types; use Types;
@ -112,6 +113,31 @@ package body Comperr is
Abort_In_Progress := True;
-- Generate a "standard" error message instead of a bug box in case of
-- .NET compiler, since we do not support all constructs of the
-- language. Of course ideally, we should detect this before bombing
-- on e.g. an assertion error, but in practice most of these bombs
-- are due to a legitimate case of a construct not being supported (in
-- a sense they all are, since for sure we are not supporting something
-- if we bomb!) By giving this message, we provide a more reasonable
-- practical interface, since giving scary bug boxes on unsupported
-- features is definitely not helpful.
-- Note that the call to Error_Msg_N below sets Serious_Errors_Detected
-- to 1, so we use the regular mechanism below in order to display a
-- "compilation abandoned" message and exit, so we still know we have
-- this case (and -gnatdk can still be used to get the bug box).
if VM_Target = CLI_Target
and then Serious_Errors_Detected = 0
and then not Debug_Flag_K
and then Sloc (Current_Error_Node) > No_Location
then
Error_Msg_N
("unsupported construct in this context",
Current_Error_Node);
end if;
-- If any errors have already occurred, then we guess that the abort
-- may well be caused by previous errors, and we don't make too much
-- fuss about it, since we want to let programmer fix the errors first.

52
gcc/ada/gnatlink.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2007, Free Software Foundation, Inc. --
-- Copyright (C) 1996-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- --
@ -139,7 +139,7 @@ procedure Gnatlink is
Gcc : String_Access := Program_Name ("gcc");
Read_Mode : constant String := "r" & ASCII.Nul;
Read_Mode : constant String := "r" & ASCII.NUL;
Begin_Info : String := "-- BEGIN Object file/option list";
End_Info : String := "-- END Object file/option list ";
@ -147,7 +147,6 @@ procedure Gnatlink is
Gcc_Path : String_Access;
Linker_Path : String_Access;
Output_File_Name : String_Access;
Ali_File_Name : String_Access;
Binder_Spec_Src_File : String_Access;
@ -160,6 +159,10 @@ procedure Gnatlink is
-- Temporary file used by linker to pass list of object files on
-- certain systems with limitations on size of arguments.
Lname : String_Access := null;
-- File used by linker for CLI target, used to concatenate all .il files
-- when the command line passed to ilasm is too long
Debug_Flag_Present : Boolean := False;
Verbose_Mode : Boolean := False;
Very_Verbose_Mode : Boolean := False;
@ -167,7 +170,7 @@ procedure Gnatlink is
Ada_Bind_File : Boolean := True;
-- Set to True if bind file is generated in Ada
Standard_Gcc : Boolean := True;
Standard_Gcc : Boolean := True;
Compile_Bind_File : Boolean := True;
-- Set to False if bind file is not to be compiled
@ -953,7 +956,42 @@ procedure Gnatlink is
-- to read from a file instead of the command line is only triggered if
-- a conservative threshold is passed.
if Object_List_File_Required
if VM_Target = CLI_Target
and then Link_Bytes > Link_Max
then
Lname := new String'("l~" & Base_Name (Ali_File_Name.all) & ".il");
for J in Objs_Begin .. Objs_End loop
Copy_File (Linker_Objects.Table (J).all, Lname.all,
Success => Closing_Status,
Mode => Append);
end loop;
-- Add the special objects list file option together with the name
-- of the temporary file to the objects file table.
Linker_Objects.Table (Objs_Begin) :=
new String'(Value (Object_File_Option_Ptr) & Lname.all);
-- The slots containing these object file names are then removed
-- from the objects table so they do not appear in the link. They
-- are removed by moving up the linker options and non-Ada object
-- files appearing after the Ada object list in the table.
declare
N : Integer;
begin
N := Objs_End - Objs_Begin + 1;
for J in Objs_End + 1 .. Linker_Objects.Last loop
Linker_Objects.Table (J - N + 1) := Linker_Objects.Table (J);
end loop;
Linker_Objects.Set_Last (Linker_Objects.Last - N + 1);
end;
elsif Object_List_File_Required
or else (Object_List_File_Supported
and then Link_Bytes > Link_Max)
then
@ -2015,6 +2053,10 @@ begin
Delete (Tname);
end if;
if Lname /= null then
Delete (Lname.all & ASCII.NUL);
end if;
if not Success then
Error_Msg ("error when calling " & Linker_Path.all);
Exit_Program (E_Fatal);