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:
parent
77e5104283
commit
c96597bfe5
|
@ -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;
|
||||
|
|
|
@ -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.
|
||||
|
|
|
@ -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;
|
||||
|
@ -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);
|
||||
|
|
Loading…
Reference in New Issue