Skip to content

R
riscv-gcc-1
Commit 26fd4eae by Arnaud Charlet
Options

[multiple changes] 

2004-01-26  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch3.adb (Build_Slice_Assignment): New TSS procedure for
	one-dimensional array an slice assignments, when component type is
	controlled.

	* exp_ch5.adb (Expand_Assign_Array): If array is one-dimensional,
	component type is controlled, and control_actions are in effect, use
	TSS procedure rather than generating inline code.

	* exp_tss.ads (TSS_Slice_Assign): New TSS procedure for one-dimensional
	arrays with controlled components.

2004-01-26  Vincent Celier  <celier@gnat.com>

	* gnatcmd.adb (GNATCmd): Add specification of argument file on the
	command line for the non VMS case.

	* gnatlink.adb (Process_Binder_File): When building object file, if
	GNU linker is used, put all object paths between quotes, to prevent ld
	error when there are unusual characters (such as '!') in the paths.

	* Makefile.generic: When there are sources in Ada and the main is in
	C/C++, invoke gnatmake with -B, instead of -z.

	* vms_conv.adb (Preprocess_Command_Data): New procedure, extracted
	from VMS_Conversion.
	(Process_Argument): New procedure, extracted from VMS_Conversion. Add
	specification of argument file on the command line.

2004-01-26  Bernard Banner  <banner@gnat.com>

	* Makefile.in: Enable GMEM_LIB and SYMLIB for x86_64

2004-01-26  Ed Schonberg  <schonberg@gnat.com>

	* snames.adb: Update copyright notice.
	Add info on slice assignment for controlled arrays.

From-SVN: r76634
parent ecf67f46
Showing with 241 additions and 36 deletions
gcc/ada/ChangeLog
2004-01-26 Ed Schonberg <schonberg@gnat.com>
* exp_ch3.adb (Build_Slice_Assignment): New TSS procedure for
one-dimensional array an slice assignments, when component type is
controlled.
* exp_ch5.adb (Expand_Assign_Array): If array is one-dimensional,
component type is controlled, and control_actions are in effect, use
TSS procedure rather than generating inline code.
* exp_tss.ads (TSS_Slice_Assign): New TSS procedure for one-dimensional
arrays with controlled components.
2004-01-26 Vincent Celier <celier@gnat.com>
* gnatcmd.adb (GNATCmd): Add specification of argument file on the
command line for the non VMS case.
* gnatlink.adb (Process_Binder_File): When building object file, if
GNU linker is used, put all object paths between quotes, to prevent ld
error when there are unusual characters (such as '!') in the paths.
* Makefile.generic: When there are sources in Ada and the main is in
C/C++, invoke gnatmake with -B, instead of -z.
* vms_conv.adb (Preprocess_Command_Data): New procedure, extracted
from VMS_Conversion.
(Process_Argument): New procedure, extracted from VMS_Conversion. Add
specification of argument file on the command line.
2004-01-26 Bernard Banner <banner@gnat.com>
* Makefile.in: Enable GMEM_LIB and SYMLIB for x86_64
2004-01-26 Ed Schonberg <schonberg@gnat.com>
* snames.adb: Update copyright notice.
Add info on slice assignment for controlled arrays.
2004-01-23 Robert Dewar <dewar@gnat.com>
* exp_aggr.adb: Minor reformatting
......
gcc/ada/Makefile.generic
......@@ -337,21 +337,16 @@ internal-build: $(LINKER) archive-objects force
else
# C/C++ main
# The trick here is to force gnatmake to bind/link, even if there is no
# Ada main program. To achieve this effect, we use the -z switch, which is
# close enough to our needs, and the usual -n gnatbind switch and --LINK=
# gnatlink switch.
link: $(LINKER) archive-objects force
$(GNATMAKE) $(EXEC_RULE) -z -P$(PROJECT_FILE) $(ADA_SOURCES) \
-bargs -n -largs $(LARGS) $(LDFLAGS)
$(GNATMAKE) $(EXEC_RULE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) \
-largs $(MAIN_OBJECT) $(LARGS) $(LDFLAGS)
internal-build: $(LINKER) archive-objects force
@echo $(GNATMAKE) -z -P$(PROJECT_FILE) $(ADA_SOURCES) $(EXEC_RULE) $(ADAFLAGS)
@$(GNATMAKE) $(EXEC_RULE) -z \
-P$(PROJECT_FILE) $(ADA_SOURCES) $(ADAFLAGS) \
-bargs -n \
-largs $(LARGS) $(LDFLAGS)
@echo $(GNATMAKE) -B -P$(PROJECT_FILE) $(ADA_SOURCES) $(EXEC_RULE) $(ADAFLAGS)
@$(GNATMAKE) $(EXEC_RULE) \
-B -P$(PROJECT_FILE) $(ADA_SOURCES) $(ADAFLAGS) \
-largs $(MAIN_OBJECT) $(LARGS) $(LDFLAGS)
endif
else
......
gcc/ada/Makefile.in
......@@ -1287,11 +1287,13 @@ ifeq ($(strip $(filter-out %x86_64 linux%,$(arch) $(osys))),)
system.ads<5nsystem.ads
TOOLS_TARGET_PAIRS=mlib-tgt.adb<5lml-tgt.adb
MISCLIB=
SYMLIB = -laddr2line -lbfd -liberty $(LIBINTL)
THREADSLIB=-lpthread
GNATLIB_SHARED=gnatlib-shared-dual
GMEM_LIB = gmemlib
PREFIX_OBJS=$(PREFIX_REAL_OBJS)
LIBRARY_VERSION := $(LIB_VERSION)
endif
# The runtime library for gnat comprises two directories. One contains the
......
gcc/ada/exp_ch5.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004, 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- --
......@@ -32,6 +32,7 @@ with Exp_Ch7; use Exp_Ch7;
with Exp_Ch11; use Exp_Ch11;
with Exp_Dbug; use Exp_Dbug;
with Exp_Pakd; use Exp_Pakd;
with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util;
with Hostparm; use Hostparm;
with Nlists; use Nlists;
......@@ -160,6 +161,10 @@ package body Exp_Ch5 is
-- This switch is set to True if the array move must be done using
-- an explicit front end generated loop.
procedure Apply_Dereference (Arg : in out Node_Id);
-- If the argument is an access to an array, and the assignment is
-- converted into a procedure call, apply explicit dereference.
function Has_Address_Clause (Exp : Node_Id) return Boolean;
-- Test if Exp is a reference to an array whose declaration has
-- an address clause, or it is a slice of such an array.
......@@ -185,6 +190,20 @@ package body Exp_Ch5 is
-- generate a front end loop, which is not so terrible.
-- It would really be better if backend handled this ???
-----------------------
-- Apply_Dereference --
-----------------------
procedure Apply_Dereference (Arg : in out Node_Id) is
Typ : constant Entity_Id := Etype (Arg);
begin
if Is_Access_Type (Typ) then
Rewrite (Arg, Make_Explicit_Dereference (Loc,
Prefix => Relocate_Node (Arg)));
Analyze_And_Resolve (Arg, Designated_Type (Typ));
end if;
end Apply_Dereference;
------------------------
-- Has_Address_Clause --
------------------------
......@@ -704,10 +723,47 @@ package body Exp_Ch5 is
-- Cases where either Forwards_OK or Backwards_OK is true
if Forwards_OK (N) or else Backwards_OK (N) then
Rewrite (N,
Expand_Assign_Array_Loop
(N, Larray, Rarray, L_Type, R_Type, Ndim,
Rev => not Forwards_OK (N)));
if Controlled_Type (Component_Type (L_Type))
and then Base_Type (L_Type) = Base_Type (R_Type)
and then Ndim = 1
and then not No_Ctrl_Actions (N)
then
declare
Proc : constant Entity_Id :=
TSS (Base_Type (L_Type), TSS_Slice_Assign);
Actuals : List_Id;
begin
Apply_Dereference (Larray);
Apply_Dereference (Rarray);
Actuals := New_List (
Duplicate_Subexpr (Larray, Name_Req => True),
Duplicate_Subexpr (Rarray, Name_Req => True),
Duplicate_Subexpr (Left_Lo, Name_Req => True),
Duplicate_Subexpr (Left_Hi, Name_Req => True),
Duplicate_Subexpr (Right_Lo, Name_Req => True),
Duplicate_Subexpr (Right_Hi, Name_Req => True));
if Forwards_OK (N) then
Append_To (Actuals,
New_Occurrence_Of (Standard_False, Loc));
else
Append_To (Actuals,
New_Occurrence_Of (Standard_True, Loc));
end if;
Rewrite (N,
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (Proc, Loc),
Parameter_Associations => Actuals));
end;
else
Rewrite (N,
Expand_Assign_Array_Loop
(N, Larray, Rarray, L_Type, R_Type, Ndim,
Rev => not Forwards_OK (N)));
end if;
-- Case of both are false with No_Implicit_Conditionals
......@@ -806,19 +862,53 @@ package body Exp_Ch5 is
Right_Opnd => Cright_Lo);
end if;
Rewrite (N,
Make_Implicit_If_Statement (N,
Condition => Condition,
if Controlled_Type (Component_Type (L_Type))
and then Base_Type (L_Type) = Base_Type (R_Type)
and then Ndim = 1
and then not No_Ctrl_Actions (N)
then
Then_Statements => New_List (
Expand_Assign_Array_Loop
(N, Larray, Rarray, L_Type, R_Type, Ndim,
Rev => False)),
-- Call TSS procedure for array assignment, passing the
-- the explicit bounds of right- and left-hand side.
Else_Statements => New_List (
Expand_Assign_Array_Loop
(N, Larray, Rarray, L_Type, R_Type, Ndim,
Rev => True))));
declare
Proc : constant Node_Id :=
TSS (Base_Type (L_Type), TSS_Slice_Assign);
Actuals : List_Id;
begin
Apply_Dereference (Larray);
Apply_Dereference (Rarray);
Actuals := New_List (
Duplicate_Subexpr (Larray, Name_Req => True),
Duplicate_Subexpr (Rarray, Name_Req => True),
Duplicate_Subexpr (Left_Lo, Name_Req => True),
Duplicate_Subexpr (Left_Hi, Name_Req => True),
Duplicate_Subexpr (Right_Lo, Name_Req => True),
Duplicate_Subexpr (Right_Hi, Name_Req => True));
Append_To (Actuals, Condition);
Rewrite (N,
Make_Procedure_Call_Statement (Loc,
Name => New_Reference_To (Proc, Loc),
Parameter_Associations => Actuals));
end;
else
Rewrite (N,
Make_Implicit_If_Statement (N,
Condition => Condition,
Then_Statements => New_List (
Expand_Assign_Array_Loop
(N, Larray, Rarray, L_Type, R_Type, Ndim,
Rev => False)),
Else_Statements => New_List (
Expand_Assign_Array_Loop
(N, Larray, Rarray, L_Type, R_Type, Ndim,
Rev => True))));
end if;
end if;
Analyze (N, Suppress => All_Checks);
......
gcc/ada/exp_tss.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 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- --
......@@ -81,6 +81,7 @@ package Exp_Tss is
TSS_RAS_Access : constant TNT := "RA"; -- RAs type access
TSS_RAS_Dereference : constant TNT := "RD"; -- RAs type deference
TSS_Rep_To_Pos : constant TNT := "RP"; -- Rep to Pos conversion
TSS_Slice_Assign : constant TNT := "SA"; -- Slice assignment
TSS_Stream_Input : constant TNT := "SI"; -- Stream Input attribute
TSS_Stream_Output : constant TNT := "SO"; -- Stream Output attribute
TSS_Stream_Read : constant TNT := "SR"; -- Stream Read attribute
......@@ -95,6 +96,7 @@ package Exp_Tss is
TSS_RAS_Access,
TSS_RAS_Dereference,
TSS_Rep_To_Pos,
TSS_Slice_Assign,
TSS_Stream_Input,
TSS_Stream_Output,
TSS_Stream_Read,
......
gcc/ada/gnatcmd.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1996-2004 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- --
......@@ -493,10 +493,66 @@ begin
end;
end;
-- Get the arguments from the command line and from the eventual
-- argument file(s) specified on the command line.
for Arg in Command_Arg + 1 .. Argument_Count loop
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'(Argument (Arg));
declare
The_Arg : constant String := Argument (Arg);
begin
-- Check if an argument file is specified
if The_Arg (The_Arg'First) = '@' then
declare
Arg_File : Ada.Text_IO.File_Type;
Line : String (1 .. 256);
Last : Natural;
begin
-- Open the file. Fail if the file cannot be found.
begin
Open
(Arg_File, In_File,
The_Arg (The_Arg'First + 1 .. The_Arg'Last));
exception
when others =>
Put
(Standard_Error, "Cannot open argument file """);
Put
(Standard_Error,
The_Arg (The_Arg'First + 1 .. The_Arg'Last));
Put_Line (Standard_Error, """");
raise Error_Exit;
end;
-- Read line by line and put the content of each
-- non empty line in the Last_Switches table.
while not End_Of_File (Arg_File) loop
Get_Line (Arg_File, Line, Last);
if Last /= 0 then
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'(Line (1 .. Last));
end if;
end loop;
Close (Arg_File);
end;
else
-- It is not an argument file; just put the argument in
-- the Last_Switches table.
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
new String'(The_Arg);
end if;
end;
end loop;
end if;
end if;
......
gcc/ada/gnatlink.adb
......@@ -673,6 +673,11 @@ procedure Gnatlink is
-- Predicate indicating whether this target uses the GNU linker. In
-- this case we must output a GNU linker compatible response file.
Opening : aliased constant String := """";
Closing : aliased constant String := '"' & ASCII.LF;
-- Needed to quote object paths in object list files when GNU linker
-- is used.
procedure Get_Next_Line;
-- Read the next line from the binder file without the line
-- terminator.
......@@ -883,6 +888,8 @@ procedure Gnatlink is
-- If target is using the GNU linker we must add a special header
-- and footer in the response file.
-- The syntax is : INPUT (object1.o object2.o ... )
-- Because the GNU linker does not like name with characters such
-- as '!', we must put the object paths between double quotes.
if Using_GNU_Linker then
declare
......@@ -895,9 +902,22 @@ procedure Gnatlink is
end if;
for J in Objs_Begin .. Objs_End loop
-- Opening quote for GNU linker
if Using_GNU_Linker then
Status := Write (Tname_FD, Opening'Address, 1);
end if;
Status := Write (Tname_FD, Linker_Objects.Table (J).all'Address,
Linker_Objects.Table (J).all'Length);
Status := Write (Tname_FD, ASCII.LF'Address, 1);
Linker_Objects.Table (J).all'Length);
-- Closing quote for GNU linker
if Using_GNU_Linker then
Status := Write (Tname_FD, Closing'Address, 2);
else
Status := Write (Tname_FD, ASCII.LF'Address, 1);
end if;
Response_File_Objects.Increment_Last;
Response_File_Objects.Table (Response_File_Objects.Last) :=
......
gcc/ada/snames.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004, 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- --
......@@ -690,6 +690,7 @@ package body Snames is
-- xxxRA RAs type access routine for type xxx (Exp_TSS)
-- xxxRD RAs type dereference routine for type xxx (Exp_TSS)
-- xxxRP Rep to Pos conversion for enumeration type xxx (Exp_TSS)
-- xxxSA array/slice assignment for controlled comp. arrays (Exp_TSS)
-- xxxSI stream input attribute subprogram for type xxx (Exp_TSS)
-- xxxSO stream output attribute subprogram for type xxx (Exp_TSS)
-- xxxSR stream read attribute subprogram for type xxx (Exp_TSS)
......
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