mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-04 02:50:29 +08:00
[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
This commit is contained in:
Arnaud Charlet
parent
ecf67f46ef
commit
26fd4eae69
@ -1,3 +1,42 @@
|
||||
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -114,6 +114,12 @@ package body Exp_Ch3 is
|
||||
-- Build record initialization procedure. N is the type declaration
|
||||
-- node, and Pe is the corresponding entity for the record type.
|
||||
|
||||
procedure Build_Slice_Assignment (Typ : Entity_Id);
|
||||
-- Build assignment procedure for one-dimensional arrays of controlled
|
||||
-- types. Other array and slice assignments are expanded in-line, but
|
||||
-- the code expansion for controlled components (when control actions
|
||||
-- are active) can lead to very large blocks that GCC3 handles poorly.
|
||||
|
||||
procedure Build_Variant_Record_Equality (Typ : Entity_Id);
|
||||
-- Create An Equality function for the non-tagged variant record 'Typ'
|
||||
-- and attach it to the TSS list
|
||||
@ -2474,6 +2480,287 @@ package body Exp_Ch3 is
|
||||
end if;
|
||||
end Build_Record_Init_Proc;
|
||||
|
||||
----------------------------
|
||||
-- Build_Slice_Assignment --
|
||||
----------------------------
|
||||
|
||||
-- Generates the following subprogram:
|
||||
-- procedure Assign
|
||||
-- (Source, Target : Array_Type,
|
||||
-- Left_Lo, Left_Hi, Right_Lo, Right_Hi : Index;
|
||||
-- Rev : Boolean)
|
||||
-- is
|
||||
-- Li1 : Index;
|
||||
-- Ri1 : Index;
|
||||
-- begin
|
||||
-- if Rev then
|
||||
-- Li1 := Left_Hi;
|
||||
-- Ri1 := Right_Hi;
|
||||
-- else
|
||||
-- Li1 := Left_Lo;
|
||||
-- Ri1 := Right_Lo;
|
||||
-- end if;
|
||||
--
|
||||
-- loop
|
||||
-- Target (Li1) := Source (Ri1);
|
||||
-- if Rev then
|
||||
-- exit when Li2 = Left_Lo;
|
||||
-- Li2 := Index'pred (Li2);
|
||||
-- Ri2 := Index'pred (Ri2);
|
||||
-- else
|
||||
-- exit when Li2 = Left_Hi;
|
||||
-- Li2 := Index'succ (Li2);
|
||||
-- Ri2 := Index'succ (Ri2);
|
||||
-- end if;
|
||||
-- end loop;
|
||||
-- end Assign;
|
||||
|
||||
procedure Build_Slice_Assignment (Typ : Entity_Id) is
|
||||
Loc : constant Source_Ptr := Sloc (Typ);
|
||||
Index : constant Entity_Id := Base_Type (Etype (First_Index (Typ)));
|
||||
|
||||
-- Build formal parameters of procedure
|
||||
|
||||
Larray : constant Entity_Id :=
|
||||
Make_Defining_Identifier
|
||||
(Loc, Chars => New_Internal_Name ('A'));
|
||||
Rarray : constant Entity_Id :=
|
||||
Make_Defining_Identifier
|
||||
(Loc, Chars => New_Internal_Name ('R'));
|
||||
Left_Lo : constant Entity_Id :=
|
||||
Make_Defining_Identifier
|
||||
(Loc, Chars => New_Internal_Name ('L'));
|
||||
Left_Hi : constant Entity_Id :=
|
||||
Make_Defining_Identifier
|
||||
(Loc, Chars => New_Internal_Name ('L'));
|
||||
Right_Lo : constant Entity_Id :=
|
||||
Make_Defining_Identifier
|
||||
(Loc, Chars => New_Internal_Name ('R'));
|
||||
Right_Hi : constant Entity_Id :=
|
||||
Make_Defining_Identifier
|
||||
(Loc, Chars => New_Internal_Name ('R'));
|
||||
Rev : constant Entity_Id :=
|
||||
Make_Defining_Identifier
|
||||
(Loc, Chars => New_Internal_Name ('D'));
|
||||
Proc_Name : constant Entity_Id :=
|
||||
Make_Defining_Identifier (Loc,
|
||||
Chars => Make_TSS_Name (Typ, TSS_Slice_Assign));
|
||||
|
||||
Lnn : constant Entity_Id :=
|
||||
Make_Defining_Identifier (Loc, New_Internal_Name ('L'));
|
||||
Rnn : constant Entity_Id :=
|
||||
Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
|
||||
-- subscripts for left and right sides
|
||||
|
||||
Decls : List_Id;
|
||||
Loops : Node_Id;
|
||||
Stats : List_Id;
|
||||
|
||||
begin
|
||||
|
||||
-- Build declarations for indices.
|
||||
|
||||
Decls := New_List;
|
||||
|
||||
Append_To (Decls,
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Lnn,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Index, Loc)));
|
||||
|
||||
Append_To (Decls,
|
||||
Make_Object_Declaration (Loc,
|
||||
Defining_Identifier => Rnn,
|
||||
Object_Definition =>
|
||||
New_Occurrence_Of (Index, Loc)));
|
||||
|
||||
Stats := New_List;
|
||||
|
||||
-- Build initializations for indices.
|
||||
|
||||
declare
|
||||
F_Init : constant List_Id := New_List;
|
||||
B_Init : constant List_Id := New_List;
|
||||
|
||||
begin
|
||||
Append_To (F_Init,
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Occurrence_Of (Lnn, Loc),
|
||||
Expression => New_Occurrence_Of (Left_Lo, Loc)));
|
||||
|
||||
Append_To (F_Init,
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Occurrence_Of (Rnn, Loc),
|
||||
Expression => New_Occurrence_Of (Right_Lo, Loc)));
|
||||
|
||||
Append_To (B_Init,
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Occurrence_Of (Lnn, Loc),
|
||||
Expression => New_Occurrence_Of (Left_Hi, Loc)));
|
||||
|
||||
Append_To (B_Init,
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Occurrence_Of (Rnn, Loc),
|
||||
Expression => New_Occurrence_Of (Right_Hi, Loc)));
|
||||
|
||||
Append_To (Stats,
|
||||
Make_If_Statement (Loc,
|
||||
Condition => New_Occurrence_Of (Rev, Loc),
|
||||
Then_Statements => B_Init,
|
||||
Else_Statements => F_Init));
|
||||
end;
|
||||
|
||||
-- Now construct the assignment statement
|
||||
|
||||
Loops :=
|
||||
Make_Loop_Statement (Loc,
|
||||
Statements => New_List (
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name =>
|
||||
Make_Indexed_Component (Loc,
|
||||
Prefix => New_Occurrence_Of (Larray, Loc),
|
||||
Expressions => New_List (New_Occurrence_Of (Lnn, Loc))),
|
||||
Expression =>
|
||||
Make_Indexed_Component (Loc,
|
||||
Prefix => New_Occurrence_Of (Rarray, Loc),
|
||||
Expressions => New_List (New_Occurrence_Of (Rnn, Loc))))),
|
||||
End_Label => Empty);
|
||||
|
||||
-- Build the increment/decrement statements.
|
||||
|
||||
declare
|
||||
F_Ass : constant List_Id := New_List;
|
||||
B_Ass : constant List_Id := New_List;
|
||||
|
||||
begin
|
||||
Append_To (F_Ass,
|
||||
Make_Exit_Statement (Loc,
|
||||
Condition =>
|
||||
Make_Op_Eq (Loc,
|
||||
Left_Opnd => New_Occurrence_Of (Lnn, Loc),
|
||||
Right_Opnd => New_Occurrence_Of (Left_Hi, Loc))));
|
||||
|
||||
Append_To (B_Ass,
|
||||
Make_Exit_Statement (Loc,
|
||||
Condition =>
|
||||
Make_Op_Eq (Loc,
|
||||
Left_Opnd => New_Occurrence_Of (Lnn, Loc),
|
||||
Right_Opnd => New_Occurrence_Of (Left_Lo, Loc))));
|
||||
|
||||
Append_To (F_Ass,
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Occurrence_Of (Lnn, Loc),
|
||||
Expression =>
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix =>
|
||||
New_Occurrence_Of (Index, Loc),
|
||||
Attribute_Name => Name_Succ,
|
||||
Expressions => New_List (
|
||||
New_Occurrence_Of (Lnn, Loc)))));
|
||||
|
||||
Append_To (F_Ass,
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Occurrence_Of (Rnn, Loc),
|
||||
Expression =>
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix =>
|
||||
New_Occurrence_Of (Index, Loc),
|
||||
Attribute_Name => Name_Succ,
|
||||
Expressions => New_List (
|
||||
New_Occurrence_Of (Rnn, Loc)))));
|
||||
|
||||
Append_To (B_Ass,
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Occurrence_Of (Lnn, Loc),
|
||||
Expression =>
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix =>
|
||||
New_Occurrence_Of (Index, Loc),
|
||||
Attribute_Name => Name_Pred,
|
||||
Expressions => New_List (
|
||||
New_Occurrence_Of (Lnn, Loc)))));
|
||||
|
||||
Append_To (B_Ass,
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Occurrence_Of (Rnn, Loc),
|
||||
Expression =>
|
||||
Make_Attribute_Reference (Loc,
|
||||
Prefix =>
|
||||
New_Occurrence_Of (Index, Loc),
|
||||
Attribute_Name => Name_Pred,
|
||||
Expressions => New_List (
|
||||
New_Occurrence_Of (Rnn, Loc)))));
|
||||
|
||||
Append_To (Statements (Loops),
|
||||
Make_If_Statement (Loc,
|
||||
Condition => New_Occurrence_Of (Rev, Loc),
|
||||
Then_Statements => B_Ass,
|
||||
Else_Statements => F_Ass));
|
||||
end;
|
||||
|
||||
Append_To (Stats, Loops);
|
||||
|
||||
declare
|
||||
Spec : Node_Id;
|
||||
Formals : List_Id := New_List;
|
||||
|
||||
begin
|
||||
Formals := New_List (
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier => Larray,
|
||||
Out_Present => True,
|
||||
Parameter_Type =>
|
||||
New_Reference_To (Base_Type (Typ), Loc)),
|
||||
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier => Rarray,
|
||||
Parameter_Type =>
|
||||
New_Reference_To (Base_Type (Typ), Loc)),
|
||||
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier => Left_Lo,
|
||||
Parameter_Type =>
|
||||
New_Reference_To (Index, Loc)),
|
||||
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier => Left_Hi,
|
||||
Parameter_Type =>
|
||||
New_Reference_To (Index, Loc)),
|
||||
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier => Right_Lo,
|
||||
Parameter_Type =>
|
||||
New_Reference_To (Index, Loc)),
|
||||
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier => Right_Hi,
|
||||
Parameter_Type =>
|
||||
New_Reference_To (Index, Loc)));
|
||||
|
||||
Append_To (Formals,
|
||||
Make_Parameter_Specification (Loc,
|
||||
Defining_Identifier => Rev,
|
||||
Parameter_Type =>
|
||||
New_Reference_To (Standard_Boolean, Loc)));
|
||||
|
||||
Spec :=
|
||||
Make_Procedure_Specification (Loc,
|
||||
Defining_Unit_Name => Proc_Name,
|
||||
Parameter_Specifications => Formals);
|
||||
|
||||
Discard_Node (
|
||||
Make_Subprogram_Body (Loc,
|
||||
Specification => Spec,
|
||||
Declarations => Decls,
|
||||
Handled_Statement_Sequence =>
|
||||
Make_Handled_Sequence_Of_Statements (Loc,
|
||||
Statements => Stats)));
|
||||
end;
|
||||
|
||||
Set_TSS (Typ, Proc_Name);
|
||||
Set_Is_Pure (Proc_Name);
|
||||
end Build_Slice_Assignment;
|
||||
|
||||
------------------------------------
|
||||
-- Build_Variant_Record_Equality --
|
||||
------------------------------------
|
||||
@ -3483,6 +3770,12 @@ package body Exp_Ch3 is
|
||||
|
||||
if Typ = Base and then Has_Controlled_Component (Base) then
|
||||
Build_Controlling_Procs (Base);
|
||||
|
||||
if not Is_Limited_Type (Component_Type (Typ))
|
||||
and then Number_Dimensions (Typ) = 1
|
||||
then
|
||||
Build_Slice_Assignment (Typ);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- For packed case, there is a default initialization, except
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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) :=
|
||||
|
||||
@ -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)
|
||||
|
||||
1899
gcc/ada/vms_conv.adb
1899
gcc/ada/vms_conv.adb
File diff suppressed because it is too large
Load Diff
Loading…
x
Reference in New Issue
Block a user