Skip to content

R
riscv-gcc-1
Commit 6367dd30 by Arnaud Charlet
Options

[multiple changes] 

2011-08-04  Emmanuel Briot  <briot@adacore.com>

	* make.adb, makeutl.adb, makeutl.ads (Make): major refactoring.
	Create several new subprograms to move code out of Make. This makes the
	code more readable, removes code duplication, and is a preparation work
	for adding support for aggregate projects.

2011-08-04  Tristan Gingold  <gingold@adacore.com>

	* s-po32gl.ads, s-po32gl.adb: New files.
	* exp_ch7.ads (Get_Global_Pool_For_Access_Type): New function.
	* exp_ch7.adb (Get_Global_Pool_For_Access_Type): New function.
	(Build_Finalization_Collection): Use it.
	* exp_ch4.adb (Complete_Controlled_Allocation): Ditto.
	* rtsfind.ads: System_Pool_32_Global, Re_Global_Pool_32_Object: New
	literals.
	* gcc-interface/Makefile.in: Use s-po32gl.o on VMS.
	* gcc-interface/Make-lang.in: Update dependencies.

From-SVN: r177364
parent cd8bfe35
Showing with 302 additions and 46 deletions
gcc/ada/ChangeLog
2011-08-04 Emmanuel Briot <briot@adacore.com>
* make.adb, makeutl.adb, makeutl.ads (Make): major refactoring.
Create several new subprograms to move code out of Make. This makes the
code more readable, removes code duplication, and is a preparation work
for adding support for aggregate projects.
2011-08-04 Tristan Gingold <gingold@adacore.com>
* s-po32gl.ads, s-po32gl.adb: New files.
* exp_ch7.ads (Get_Global_Pool_For_Access_Type): New function.
* exp_ch7.adb (Get_Global_Pool_For_Access_Type): New function.
(Build_Finalization_Collection): Use it.
* exp_ch4.adb (Complete_Controlled_Allocation): Ditto.
* rtsfind.ads: System_Pool_32_Global, Re_Global_Pool_32_Object: New
literals.
* gcc-interface/Makefile.in: Use s-po32gl.o on VMS.
* gcc-interface/Make-lang.in: Update dependencies.
2011-08-04 Emmanuel Briot <briot@adacore.com>
* makeutl.adb (Complete_Mains): add support for specs with no suffix on
the command line.
......
gcc/ada/exp_ch4.adb
......@@ -455,7 +455,8 @@ package body Exp_Ch4 is
or else Is_Library_Level_Entity (Ptr_Typ))
then
declare
Pool_Id : constant Entity_Id := RTE (RE_Global_Pool_Object);
Pool_Id : constant Entity_Id :=
Get_Global_Pool_For_Access_Type (Ptr_Typ);
Scop : Node_Id := Cunit_Entity (Current_Sem_Unit);
begin
......
gcc/ada/exp_ch7.adb
......@@ -949,7 +949,7 @@ package body Exp_Ch7 is
begin
if No (Associated_Storage_Pool (Base_Typ)) then
Pool_Id := RTE (RE_Global_Pool_Object);
Pool_Id := Get_Global_Pool_For_Access_Type (Base_Typ);
Set_Associated_Storage_Pool (Base_Typ, Pool_Id);
else
Pool_Id := Associated_Storage_Pool (Base_Typ);
......@@ -959,7 +959,7 @@ package body Exp_Ch7 is
-- The default choice is the global pool
else
Pool_Id := RTE (RE_Global_Pool_Object);
Pool_Id := Get_Global_Pool_For_Access_Type (Typ);
Set_Associated_Storage_Pool (Typ, Pool_Id);
end if;
......@@ -4072,6 +4072,21 @@ package body Exp_Ch7 is
end loop;
end Find_Node_To_Be_Wrapped;
-------------------------------------
-- Get_Global_Pool_For_Access_Type --
-------------------------------------
function Get_Global_Pool_For_Access_Type (T : Entity_Id) return Entity_Id is
begin
if Opt.True_VMS_Target
and then Esize (T) = 32
then
return RTE (RE_Global_Pool_32_Object);
else
return RTE (RE_Global_Pool_Object);
end if;
end Get_Global_Pool_For_Access_Type;
----------------------------------
-- Has_New_Controlled_Component --
----------------------------------
......
gcc/ada/exp_ch7.ads
......@@ -98,6 +98,11 @@ package Exp_Ch7 is
-- applies, in which case we know that class-wide objects do not contain
-- controlled parts.
function Get_Global_Pool_For_Access_Type (T : Entity_Id) return Entity_Id;
-- Return the pool id for access type T. This is generally the node
-- corresponding to System.Global_Pool.Global_Pool_Object except on
-- VMS if the access size is 32.
function Has_New_Controlled_Component (E : Entity_Id) return Boolean;
-- E is a type entity. Give the same result as Has_Controlled_Component
-- except for tagged extensions where the result is True only if the
......
gcc/ada/gcc-interface/Make-lang.in
......@@ -1301,17 +1301,16 @@ ada/alfa.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/aspects.ads ada/atree.ads ada/atree.adb ada/casing.ads \
ada/debug.ads ada/einfo.ads ada/gnat.ads ada/g-htable.ads \
ada/g-table.ads ada/g-table.adb ada/hostparm.ads ada/interfac.ads \
ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb \
ada/nmake.ads ada/opt.ads ada/output.ads ada/output.adb \
ada/put_alfa.ads ada/put_alfa.adb ada/sem_util.ads \
ada/sinfo.ads ada/sinfo.adb ada/sinput.ads ada/snames.ads \
ada/system.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-secsta.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
ada/types.ads ada/uintp.ads ada/uintp.adb ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb ada/nmake.ads \
ada/opt.ads ada/output.ads ada/output.adb ada/put_alfa.ads \
ada/put_alfa.adb ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb \
ada/sinput.ads ada/snames.ads ada/system.ads ada/s-exctab.ads \
ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads \
ada/s-parame.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads ada/uintp.adb \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/ali-util.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/ali.ads ada/ali.adb ada/ali-util.ads \
......@@ -2753,13 +2752,14 @@ ada/get_alfa.o : ada/ada.ads ada/a-except.ads ada/a-ioexce.ads \
ada/a-unccon.ads ada/a-uncdea.ads ada/alfa.ads ada/alfa.adb \
ada/alloc.ads ada/atree.ads ada/debug.ads ada/einfo.ads \
ada/get_alfa.ads ada/get_alfa.adb ada/gnat.ads ada/g-table.ads \
ada/g-table.adb ada/hostparm.ads ada/namet.ads ada/opt.ads \
ada/output.ads ada/put_alfa.ads ada/sinfo.ads ada/snames.ads \
ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-os_lib.ads \
ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \
ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads
ada/g-table.adb ada/hostparm.ads ada/namet.ads ada/nlists.ads \
ada/nmake.ads ada/opt.ads ada/output.ads ada/put_alfa.ads \
ada/sem_util.ads ada/sinfo.ads ada/snames.ads ada/system.ads \
ada/s-exctab.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
ada/types.ads ada/uintp.ads ada/unchconv.ads ada/unchdeal.ads \
ada/urealp.ads
ada/get_scos.o : ada/ada.ads ada/a-ioexce.ads ada/a-unccon.ads \
ada/get_scos.ads ada/get_scos.adb ada/gnat.ads ada/g-table.ads \
......@@ -3314,13 +3314,14 @@ ada/prepcomp.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/put_alfa.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alfa.ads ada/alfa.adb ada/alloc.ads ada/atree.ads \
ada/debug.ads ada/einfo.ads ada/gnat.ads ada/g-table.ads \
ada/g-table.adb ada/hostparm.ads ada/namet.ads ada/opt.ads \
ada/output.ads ada/put_alfa.ads ada/put_alfa.adb ada/sinfo.ads \
ada/snames.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads \
ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads
ada/g-table.adb ada/hostparm.ads ada/namet.ads ada/nlists.ads \
ada/nmake.ads ada/opt.ads ada/output.ads ada/put_alfa.ads \
ada/put_alfa.adb ada/sem_util.ads ada/sinfo.ads ada/snames.ads \
ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-os_lib.ads \
ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads ada/s-traent.ads \
ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
ada/tree_io.ads ada/types.ads ada/uintp.ads ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads
ada/put_scos.o : ada/ada.ads ada/a-unccon.ads ada/gnat.ads ada/g-table.ads \
ada/g-table.adb ada/par_sco.ads ada/put_scos.ads ada/put_scos.adb \
......@@ -3951,23 +3952,22 @@ ada/sem_ch13.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/sem_ch2.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
ada/atree.adb ada/casing.ads ada/csets.ads ada/debug.ads ada/einfo.ads \
ada/einfo.adb ada/err_vars.ads ada/errout.ads ada/errout.adb \
ada/erroutc.ads ada/erroutc.adb ada/fname.ads ada/fname-uf.ads \
ada/gnat.ads ada/g-htable.ads ada/gnatvsn.ads ada/hostparm.ads \
ada/interfac.ads ada/lib.ads ada/namet.ads ada/namet.adb ada/nlists.ads \
ada/nlists.adb ada/nmake.ads ada/opt.ads ada/output.ads \
ada/restrict.ads ada/restrict.adb ada/rident.ads ada/scans.ads \
ada/sem_aux.ads ada/sem_ch2.ads ada/sem_ch2.adb ada/sem_ch8.ads \
ada/sem_util.ads ada/sinfo.ads ada/sinfo.adb ada/sinput.ads \
ada/snames.ads ada/stand.ads ada/stylesw.ads ada/system.ads \
ada/s-carun8.ads ada/s-exctab.ads ada/s-htable.ads ada/s-imenne.ads \
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
ada/targparm.ads ada/tree_io.ads ada/types.ads ada/types.adb \
ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/err_vars.ads ada/errout.ads ada/errout.adb ada/erroutc.ads \
ada/erroutc.adb ada/fname.ads ada/fname-uf.ads ada/gnat.ads \
ada/g-htable.ads ada/gnatvsn.ads ada/hostparm.ads ada/interfac.ads \
ada/lib.ads ada/namet.ads ada/namet.adb ada/nlists.ads ada/nlists.adb \
ada/opt.ads ada/output.ads ada/restrict.ads ada/restrict.adb \
ada/rident.ads ada/scans.ads ada/sem_aux.ads ada/sem_ch2.ads \
ada/sem_ch2.adb ada/sem_ch8.ads ada/sinfo.ads ada/sinfo.adb \
ada/sinput.ads ada/snames.ads ada/stand.ads ada/stylesw.ads \
ada/system.ads ada/s-carun8.ads ada/s-exctab.ads ada/s-htable.ads \
ada/s-imenne.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
ada/s-rident.ads ada/s-secsta.ads ada/s-soflin.ads ada/s-stache.ads \
ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads \
ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
ada/table.adb ada/targparm.ads ada/tree_io.ads ada/types.ads \
ada/types.adb ada/uintp.ads ada/uintp.adb ada/uname.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/sem_ch3.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/aspects.ads ada/atree.ads \
......
gcc/ada/gcc-interface/Makefile.in
......@@ -1574,6 +1574,7 @@ adamsg.o: adamsg.msg
GNATLIB_SHARED=gnatlib-shared-vms
EXTRA_LIBGNAT_SRCS+=adamsg.msg
EXTRA_LIBGNAT_OBJS+=adamsg.o
EXTRA_GNATRTL_NONTASKING_OBJS+-s-po32gl.o
EXTRA_GNATRTL_TASKING_OBJS=s-tpopde.o
EXTRA_GNATTOOLS = \
../../gnatsym$(exeext)
......
gcc/ada/make.adb
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/makeutl.adb
......@@ -1696,6 +1696,38 @@ package body Makeutl is
return No_Main_Info;
else
Current := Current + 1;
-- If not using projects, and in the gnatmake case, the main file
-- may have not have the extension. Try ".adb" first then ".ads"
if Names.Table (Current).Project = No_Project then
declare
Orig_Main : constant File_Name_Type :=
Names.Table (Current).File;
Current_Main : File_Name_Type;
begin
if Strip_Suffix (Orig_Main) = Orig_Main then
Get_Name_String (Orig_Main);
Add_Str_To_Name_Buffer (".adb");
Current_Main := Name_Find;
if Full_Source_Name (Current_Main) = No_File then
Get_Name_String (Orig_Main);
Add_Str_To_Name_Buffer (".ads");
Current_Main := Name_Find;
if Full_Source_Name (Current_Main) /= No_File then
Names.Table (Current).File := Current_Main;
end if;
else
Names.Table (Current).File := Current_Main;
end if;
end if;
end;
end if;
return Names.Table (Current);
end if;
end Next_Main;
......
gcc/ada/makeutl.ads
......@@ -352,7 +352,7 @@ package Makeutl is
function Next_Main return String;
function Next_Main return Main_Info;
-- Moves the cursor forward and returns the new current entry. Returns
-- No_File_And_Loc if there are no more mains in the table.
-- No_Main_Info there are no more mains in the table.
function Number_Of_Mains (Tree : Project_Tree_Ref) return Natural;
-- Returns the number of mains in this project tree (if Tree is null, it
......
gcc/ada/rtsfind.ads
......@@ -324,6 +324,7 @@ package Rtsfind is
System_Pack_63,
System_Parameters,
System_Partition_Interface,
System_Pool_32_Global,
System_Pool_Global,
System_Pool_Empty,
System_Pool_Local,
......@@ -1154,6 +1155,8 @@ package Rtsfind is
RE_Global_Pool_Object, -- System.Pool_Global
RE_Global_Pool_32_Object, -- System.Pool_32_Global
RE_Stack_Bounded_Pool, -- System.Pool_Size
RE_Do_Apc, -- System.RPC
......@@ -2452,6 +2455,8 @@ package Rtsfind is
RE_Global_Pool_Object => System_Pool_Global,
RE_Global_Pool_32_Object => System_Pool_32_Global,
RE_Stack_Bounded_Pool => System_Pool_Size,
RE_Do_Apc => System_RPC,
......
gcc/ada/s-po32gl.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . P O O L _ 3 2 _ G L O B A L --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2011, 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. --
-- --
------------------------------------------------------------------------------
with System.Storage_Pools; use System.Storage_Pools;
with System.Memory;
package body System.Pool_32_Global is
package SSE renames System.Storage_Elements;
--------------
-- Allocate --
--------------
overriding procedure Allocate
(Pool : in out Unbounded_No_Reclaim_Pool_32;
Address : out System.Address;
Storage_Size : SSE.Storage_Count;
Alignment : SSE.Storage_Count)
is
pragma Warnings (Off, Pool);
pragma Warnings (Off, Alignment);
begin
Address := Memory.Alloc32 (Memory.size_t (Storage_Size));
-- The call to Alloc returns an address whose alignment is compatible
-- with the worst case alignment requirement for the machine; thus the
-- Alignment argument can be safely ignored.
if Address = Null_Address then
raise Storage_Error;
end if;
end Allocate;
----------------
-- Deallocate --
----------------
overriding procedure Deallocate
(Pool : in out Unbounded_No_Reclaim_Pool_32;
Address : System.Address;
Storage_Size : SSE.Storage_Count;
Alignment : SSE.Storage_Count)
is
pragma Warnings (Off, Pool);
pragma Warnings (Off, Storage_Size);
pragma Warnings (Off, Alignment);
begin
Memory.Free (Address);
end Deallocate;
------------------
-- Storage_Size --
------------------
overriding function Storage_Size
(Pool : Unbounded_No_Reclaim_Pool_32)
return SSE.Storage_Count
is
pragma Warnings (Off, Pool);
begin
-- The 32 bit heap is limited to 2 GB of memory
return SSE.Storage_Count (2 ** 31);
end Storage_Size;
end System.Pool_32_Global;
gcc/ada/s-po32gl.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S Y S T E M . P O O L _ 3 2 _ G L O B A L --
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2011, 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. --
-- --
------------------------------------------------------------------------------
-- Storage pool corresponding to default global storage pool used for types
-- designated by a 32 bits access type for which no storage pool is specified.
-- This is specific to VMS.
with System;
with System.Storage_Pools;
with System.Storage_Elements;
package System.Pool_32_Global is
pragma Elaborate_Body;
-- Needed to ensure that library routines can execute allocators
-- Allocation strategy:
-- Call to malloc/free for each Allocate/Deallocate
-- No user specifiable size
-- No automatic reclaim
-- Minimal overhead
-- Pool simulating the allocation/deallocation strategy used by the
-- compiler for access types globally declared.
type Unbounded_No_Reclaim_Pool_32 is new
System.Storage_Pools.Root_Storage_Pool with null record;
overriding function Storage_Size
(Pool : Unbounded_No_Reclaim_Pool_32)
return System.Storage_Elements.Storage_Count;
overriding procedure Allocate
(Pool : in out Unbounded_No_Reclaim_Pool_32;
Address : out System.Address;
Storage_Size : System.Storage_Elements.Storage_Count;
Alignment : System.Storage_Elements.Storage_Count);
overriding procedure Deallocate
(Pool : in out Unbounded_No_Reclaim_Pool_32;
Address : System.Address;
Storage_Size : System.Storage_Elements.Storage_Count;
Alignment : System.Storage_Elements.Storage_Count);
-- Pool object used by the compiler when implicit Storage Pool objects are
-- explicitly referred to. For instance when writing something like:
-- for T'Storage_Pool use Q'Storage_Pool;
-- and Q'Storage_Pool hasn't been defined explicitly.
Global_Pool_32_Object : Unbounded_No_Reclaim_Pool_32;
end System.Pool_32_Global;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment