Skip to content

R
riscv-gcc-1
Commit e761d11c by Arnaud Charlet
Options

[multiple changes] 

2012-03-07  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch4.adb (Apply_Accessibility_Check): Call
	Remove_Side_Effects in the build-in-place case, to ensure that
	we capture the call and don't end up with two calls.

2012-03-07  Javier Miranda  <miranda@adacore.com>

	* exp_ch6.adb (Expand_Inlined_Call): Skip inlining of functions
	that return unconstrained types using an extended return statement
	since the support for inlining these functions has not been yet
	added to the frontend.
	* s-vaflop.adb, s-vaflop-vms-alpha.adb: Code reorganization.
	* a-ngrear.ads: Replace all the Inline_Always pragmas by pragma
	Inline.
	* a-ngrear.adb (Eigenvalues, Transpose): Restructured to use
	extended return statement.
	* a-strsup.adb, a-stzsup.adb, a-stwisu.adb (Concat, Super_Slice,
	Super_To_String): Restructured to use extended return statement.
	* a-chahan.adb (To_Basic, To_Lower, To_Upper): Restructured to
	use extended return statement.
	* s-gearop.adb (Diagonal, Matrix_Elementwise_Operation,
	Vector_Elementwise_Operation, Matrix_Elementwise_Operation,
	Matrix_Matrix_Scalar_Elementwise_Operation,
	Vector_Vector_Elementwise_Operation,
	Vector_Vector_Scalar_Elementwise_Operation,
	Matrix_Scalar_Elementwise_Operation,
	Vector_Scalar_Elementwise_Operation,
	Scalar_Matrix_Elementwise_Operation,
	Scalar_Vector_Elementwise_Operation, Matrix_Matrix_Product,
	Matrix_Vector_Product, Outer_Product, Unit_Matrix, Unit_Vector,
	Vector_Matrix_Product): Restructured to use extended return
	statement.

2012-03-07  Vincent Pucci  <pucci@adacore.com>

	* sem_ch5.adb (One_Bound): Minor reformatting.

2012-03-07  Tristan Gingold  <gingold@adacore.com>

	* s-osinte-vms-ia64.adb, s-osinte-vms-ia64.ads, s-osinte-vms.adb,
	s-osinte-vms.ads, gcc-interface/Makefile.in: Merge s-osinte-vms and
	s-osinte-vms-ia64.

From-SVN: r185051
parent 62db841a
Showing with 416 additions and 411 deletions
gcc/ada/ChangeLog
2012-03-07 Gary Dismukes <dismukes@adacore.com>
* exp_ch4.adb (Apply_Accessibility_Check): Call
Remove_Side_Effects in the build-in-place case, to ensure that
we capture the call and don't end up with two calls.
2012-03-07 Javier Miranda <miranda@adacore.com>
* exp_ch6.adb (Expand_Inlined_Call): Skip inlining of functions
that return unconstrained types using an extended return statement
since the support for inlining these functions has not been yet
added to the frontend.
* s-vaflop.adb, s-vaflop-vms-alpha.adb: Code reorganization.
* a-ngrear.ads: Replace all the Inline_Always pragmas by pragma
Inline.
* a-ngrear.adb (Eigenvalues, Transpose): Restructured to use
extended return statement.
* a-strsup.adb, a-stzsup.adb, a-stwisu.adb (Concat, Super_Slice,
Super_To_String): Restructured to use extended return statement.
* a-chahan.adb (To_Basic, To_Lower, To_Upper): Restructured to
use extended return statement.
* s-gearop.adb (Diagonal, Matrix_Elementwise_Operation,
Vector_Elementwise_Operation, Matrix_Elementwise_Operation,
Matrix_Matrix_Scalar_Elementwise_Operation,
Vector_Vector_Elementwise_Operation,
Vector_Vector_Scalar_Elementwise_Operation,
Matrix_Scalar_Elementwise_Operation,
Vector_Scalar_Elementwise_Operation,
Scalar_Matrix_Elementwise_Operation,
Scalar_Vector_Elementwise_Operation, Matrix_Matrix_Product,
Matrix_Vector_Product, Outer_Product, Unit_Matrix, Unit_Vector,
Vector_Matrix_Product): Restructured to use extended return
statement.
2012-03-07 Vincent Pucci <pucci@adacore.com>
* sem_ch5.adb (One_Bound): Minor reformatting.
2012-03-07 Tristan Gingold <gingold@adacore.com>
* s-osinte-vms-ia64.adb, s-osinte-vms-ia64.ads, s-osinte-vms.adb,
s-osinte-vms.ads, gcc-interface/Makefile.in: Merge s-osinte-vms and
s-osinte-vms-ia64.
2012-03-07 Ed Schonberg <schonberg@adacore.com>
* checks.adb (Apply_Predicate_Check): Do not generate a predicate
......
gcc/ada/a-chahan.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2012, 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- --
......@@ -422,14 +422,12 @@ package body Ada.Characters.Handling is
end To_Basic;
function To_Basic (Item : String) return String is
Result : String (1 .. Item'Length);
begin
for J in Item'Range loop
Result (J - (Item'First - 1)) := Value (Basic_Map, Item (J));
end loop;
return Result;
return Result : String (1 .. Item'Length) do
for J in Item'Range loop
Result (J - (Item'First - 1)) := Value (Basic_Map, Item (J));
end loop;
end return;
end To_Basic;
------------------
......@@ -485,14 +483,12 @@ package body Ada.Characters.Handling is
end To_Lower;
function To_Lower (Item : String) return String is
Result : String (1 .. Item'Length);
begin
for J in Item'Range loop
Result (J - (Item'First - 1)) := Value (Lower_Case_Map, Item (J));
end loop;
return Result;
return Result : String (1 .. Item'Length) do
for J in Item'Range loop
Result (J - (Item'First - 1)) := Value (Lower_Case_Map, Item (J));
end loop;
end return;
end To_Lower;
---------------
......@@ -527,14 +523,12 @@ package body Ada.Characters.Handling is
function To_Upper
(Item : String) return String
is
Result : String (1 .. Item'Length);
begin
for J in Item'Range loop
Result (J - (Item'First - 1)) := Value (Upper_Case_Map, Item (J));
end loop;
return Result;
return Result : String (1 .. Item'Length) do
for J in Item'Range loop
Result (J - (Item'First - 1)) := Value (Upper_Case_Map, Item (J));
end loop;
end return;
end To_Upper;
-----------------------
......
gcc/ada/a-ngrear.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2006-2011, Free Software Foundation, Inc. --
-- Copyright (C) 2006-2012, 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- --
......@@ -482,12 +482,15 @@ package body Ada.Numerics.Generic_Real_Arrays is
-----------------
function Eigenvalues (A : Real_Matrix) return Real_Vector is
Values : Real_Vector (A'Range (1));
Vectors : Real_Matrix (1 .. 0, 1 .. 0);
begin
Jacobi (A, Values, Vectors, Compute_Vectors => False);
Sort_Eigensystem (Values, Vectors);
return Values;
return Values : Real_Vector (A'Range (1)) do
declare
Vectors : Real_Matrix (1 .. 0, 1 .. 0);
begin
Jacobi (A, Values, Vectors, Compute_Vectors => False);
Sort_Eigensystem (Values, Vectors);
end;
end return;
end Eigenvalues;
-------------
......@@ -742,10 +745,10 @@ package body Ada.Numerics.Generic_Real_Arrays is
---------------
function Transpose (X : Real_Matrix) return Real_Matrix is
R : Real_Matrix (X'Range (2), X'Range (1));
begin
Transpose (X, R);
return R;
return R : Real_Matrix (X'Range (2), X'Range (1)) do
Transpose (X, R);
end return;
end Transpose;
-----------------
......
gcc/ada/a-ngrear.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2009, Free Software Foundation, Inc. --
-- Copyright (C) 2009-2012, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
......@@ -125,15 +125,15 @@ private
-- front end always inline these, the expense of the unconstrained returns
-- can be avoided.
pragma Inline_Always ("+");
pragma Inline_Always ("-");
pragma Inline_Always ("*");
pragma Inline_Always ("/");
pragma Inline_Always ("abs");
pragma Inline_Always (Eigenvalues);
pragma Inline_Always (Inverse);
pragma Inline_Always (Solve);
pragma Inline_Always (Transpose);
pragma Inline_Always (Unit_Matrix);
pragma Inline_Always (Unit_Vector);
pragma Inline ("+");
pragma Inline ("-");
pragma Inline ("*");
pragma Inline ("/");
pragma Inline ("abs");
pragma Inline (Eigenvalues);
pragma Inline (Inverse);
pragma Inline (Solve);
pragma Inline (Transpose);
pragma Inline (Unit_Matrix);
pragma Inline (Unit_Vector);
end Ada.Numerics.Generic_Real_Arrays;
gcc/ada/a-strsup.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2003-2012, 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- --
......@@ -42,100 +42,107 @@ package body Ada.Strings.Superbounded is
(Left : Super_String;
Right : Super_String) return Super_String
is
Result : Super_String (Left.Max_Length);
Llen : constant Natural := Left.Current_Length;
Rlen : constant Natural := Right.Current_Length;
Nlen : constant Natural := Llen + Rlen;
begin
if Nlen > Left.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
end if;
return Result : Super_String (Left.Max_Length) do
declare
Llen : constant Natural := Left.Current_Length;
Rlen : constant Natural := Right.Current_Length;
Nlen : constant Natural := Llen + Rlen;
begin
if Nlen > Left.Max_Length then
raise Ada.Strings.Length_Error;
end if;
return Result;
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
end;
end return;
end Concat;
function Concat
(Left : Super_String;
Right : String) return Super_String
is
Result : Super_String (Left.Max_Length);
Llen : constant Natural := Left.Current_Length;
Nlen : constant Natural := Llen + Right'Length;
begin
if Nlen > Left.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Llen + 1 .. Nlen) := Right;
end if;
return Result;
return Result : Super_String (Left.Max_Length) do
declare
Llen : constant Natural := Left.Current_Length;
Nlen : constant Natural := Llen + Right'Length;
begin
if Nlen > Left.Max_Length then
raise Ada.Strings.Length_Error;
end if;
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Llen + 1 .. Nlen) := Right;
end;
end return;
end Concat;
function Concat
(Left : String;
Right : Super_String) return Super_String
is
Result : Super_String (Right.Max_Length);
Llen : constant Natural := Left'Length;
Rlen : constant Natural := Right.Current_Length;
Nlen : constant Natural := Llen + Rlen;
begin
if Nlen > Right.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left;
Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
end if;
return Result : Super_String (Right.Max_Length) do
declare
Llen : constant Natural := Left'Length;
Rlen : constant Natural := Right.Current_Length;
Nlen : constant Natural := Llen + Rlen;
begin
if Nlen > Right.Max_Length then
raise Ada.Strings.Length_Error;
end if;
return Result;
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left;
Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
end;
end return;
end Concat;
function Concat
(Left : Super_String;
Right : Character) return Super_String
is
Result : Super_String (Left.Max_Length);
Llen : constant Natural := Left.Current_Length;
begin
if Llen = Left.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Llen + 1;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Result.Current_Length) := Right;
end if;
return Result : Super_String (Left.Max_Length) do
declare
Llen : constant Natural := Left.Current_Length;
begin
if Llen = Left.Max_Length then
raise Ada.Strings.Length_Error;
end if;
return Result;
Result.Current_Length := Llen + 1;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Result.Current_Length) := Right;
end;
end return;
end Concat;
function Concat
(Left : Character;
Right : Super_String) return Super_String
is
Result : Super_String (Right.Max_Length);
Rlen : constant Natural := Right.Current_Length;
begin
if Rlen = Right.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Rlen + 1;
Result.Data (1) := Left;
Result.Data (2 .. Result.Current_Length) := Right.Data (1 .. Rlen);
end if;
return Result : Super_String (Right.Max_Length) do
declare
Rlen : constant Natural := Right.Current_Length;
begin
if Rlen = Right.Max_Length then
raise Ada.Strings.Length_Error;
end if;
return Result;
Result.Current_Length := Rlen + 1;
Result.Data (1) := Left;
Result.Data (2 .. Result.Current_Length) :=
Right.Data (1 .. Rlen);
end;
end return;
end Concat;
-----------
......@@ -1459,13 +1466,15 @@ package body Ada.Strings.Superbounded is
begin
-- Note: test of High > Length is in accordance with AI95-00128
if Low > Source.Current_Length + 1
or else High > Source.Current_Length
then
raise Index_Error;
else
return Source.Data (Low .. High);
end if;
return R : String (Low .. High) do
if Low > Source.Current_Length + 1
or else High > Source.Current_Length
then
raise Index_Error;
end if;
R := Source.Data (Low .. High);
end return;
end Super_Slice;
function Super_Slice
......@@ -1473,19 +1482,17 @@ package body Ada.Strings.Superbounded is
Low : Positive;
High : Natural) return Super_String
is
Result : Super_String (Source.Max_Length);
begin
if Low > Source.Current_Length + 1
or else High > Source.Current_Length
then
raise Index_Error;
else
return Result : Super_String (Source.Max_Length) do
if Low > Source.Current_Length + 1
or else High > Source.Current_Length
then
raise Index_Error;
end if;
Result.Current_Length := High - Low + 1;
Result.Data (1 .. Result.Current_Length) := Source.Data (Low .. High);
end if;
return Result;
end return;
end Super_Slice;
procedure Super_Slice
......@@ -1615,7 +1622,9 @@ package body Ada.Strings.Superbounded is
function Super_To_String (Source : Super_String) return String is
begin
return Source.Data (1 .. Source.Current_Length);
return R : String (1 .. Source.Current_Length) do
R := Source.Data (1 .. Source.Current_Length);
end return;
end Super_To_String;
---------------------
......
gcc/ada/a-stwisu.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2003-2012, 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- --
......@@ -42,100 +42,111 @@ package body Ada.Strings.Wide_Superbounded is
(Left : Super_String;
Right : Super_String) return Super_String
is
Result : Super_String (Left.Max_Length);
Llen : constant Natural := Left.Current_Length;
Rlen : constant Natural := Right.Current_Length;
Nlen : constant Natural := Llen + Rlen;
begin
if Nlen > Left.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
end if;
return Result : Super_String (Left.Max_Length) do
declare
Llen : constant Natural := Left.Current_Length;
Rlen : constant Natural := Right.Current_Length;
Nlen : constant Natural := Llen + Rlen;
return Result;
begin
if Nlen > Left.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
end if;
end;
end return;
end Concat;
function Concat
(Left : Super_String;
Right : Wide_String) return Super_String
is
Result : Super_String (Left.Max_Length);
Llen : constant Natural := Left.Current_Length;
Nlen : constant Natural := Llen + Right'Length;
begin
if Nlen > Left.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Llen + 1 .. Nlen) := Right;
end if;
return Result;
return Result : Super_String (Left.Max_Length) do
declare
Llen : constant Natural := Left.Current_Length;
Nlen : constant Natural := Llen + Right'Length;
begin
if Nlen > Left.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Llen + 1 .. Nlen) := Right;
end if;
end;
end return;
end Concat;
function Concat
(Left : Wide_String;
Right : Super_String) return Super_String
is
Result : Super_String (Right.Max_Length);
Llen : constant Natural := Left'Length;
Rlen : constant Natural := Right.Current_Length;
Nlen : constant Natural := Llen + Rlen;
begin
if Nlen > Right.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left;
Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
end if;
return Result : Super_String (Right.Max_Length) do
declare
Llen : constant Natural := Left'Length;
Rlen : constant Natural := Right.Current_Length;
Nlen : constant Natural := Llen + Rlen;
return Result;
begin
if Nlen > Right.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left;
Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
end if;
end;
end return;
end Concat;
function Concat
(Left : Super_String;
Right : Wide_Character) return Super_String
is
Result : Super_String (Left.Max_Length);
Llen : constant Natural := Left.Current_Length;
begin
if Llen = Left.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Llen + 1;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Result.Current_Length) := Right;
end if;
return Result : Super_String (Left.Max_Length) do
declare
Llen : constant Natural := Left.Current_Length;
return Result;
begin
if Llen = Left.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Llen + 1;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Result.Current_Length) := Right;
end if;
end;
end return;
end Concat;
function Concat
(Left : Wide_Character;
Right : Super_String) return Super_String
is
Result : Super_String (Right.Max_Length);
Rlen : constant Natural := Right.Current_Length;
begin
if Rlen = Right.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Rlen + 1;
Result.Data (1) := Left;
Result.Data (2 .. Result.Current_Length) := Right.Data (1 .. Rlen);
end if;
return Result : Super_String (Right.Max_Length) do
declare
Rlen : constant Natural := Right.Current_Length;
return Result;
begin
if Rlen = Right.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Rlen + 1;
Result.Data (1) := Left;
Result.Data (2 .. Result.Current_Length) :=
Right.Data (1 .. Rlen);
end if;
end;
end return;
end Concat;
-----------
......@@ -1462,13 +1473,15 @@ package body Ada.Strings.Wide_Superbounded is
begin
-- Note: test of High > Length is in accordance with AI95-00128
if Low > Source.Current_Length + 1
or else High > Source.Current_Length
then
raise Index_Error;
else
return Source.Data (Low .. High);
end if;
return R : Wide_String (Low .. High) do
if Low > Source.Current_Length + 1
or else High > Source.Current_Length
then
raise Index_Error;
end if;
R := Source.Data (Low .. High);
end return;
end Super_Slice;
function Super_Slice
......@@ -1476,19 +1489,17 @@ package body Ada.Strings.Wide_Superbounded is
Low : Positive;
High : Natural) return Super_String
is
Result : Super_String (Source.Max_Length);
begin
if Low > Source.Current_Length + 1
or else High > Source.Current_Length
then
raise Index_Error;
else
return Result : Super_String (Source.Max_Length) do
if Low > Source.Current_Length + 1
or else High > Source.Current_Length
then
raise Index_Error;
end if;
Result.Current_Length := High - Low + 1;
Result.Data (1 .. Result.Current_Length) := Source.Data (Low .. High);
end if;
return Result;
end return;
end Super_Slice;
procedure Super_Slice
......@@ -1618,7 +1629,9 @@ package body Ada.Strings.Wide_Superbounded is
function Super_To_String (Source : Super_String) return Wide_String is
begin
return Source.Data (1 .. Source.Current_Length);
return R : Wide_String (1 .. Source.Current_Length) do
R := Source.Data (1 .. Source.Current_Length);
end return;
end Super_To_String;
---------------------
......
gcc/ada/a-stzsup.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2003-2012, 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- --
......@@ -42,100 +42,111 @@ package body Ada.Strings.Wide_Wide_Superbounded is
(Left : Super_String;
Right : Super_String) return Super_String
is
Result : Super_String (Left.Max_Length);
Llen : constant Natural := Left.Current_Length;
Rlen : constant Natural := Right.Current_Length;
Nlen : constant Natural := Llen + Rlen;
begin
if Nlen > Left.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
end if;
return Result : Super_String (Left.Max_Length) do
declare
Llen : constant Natural := Left.Current_Length;
Rlen : constant Natural := Right.Current_Length;
Nlen : constant Natural := Llen + Rlen;
return Result;
begin
if Nlen > Left.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
end if;
end;
end return;
end Concat;
function Concat
(Left : Super_String;
Right : Wide_Wide_String) return Super_String
is
Result : Super_String (Left.Max_Length);
Llen : constant Natural := Left.Current_Length;
Nlen : constant Natural := Llen + Right'Length;
begin
if Nlen > Left.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Llen + 1 .. Nlen) := Right;
end if;
return Result;
return Result : Super_String (Left.Max_Length) do
declare
Llen : constant Natural := Left.Current_Length;
Nlen : constant Natural := Llen + Right'Length;
begin
if Nlen > Left.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Llen + 1 .. Nlen) := Right;
end if;
end;
end return;
end Concat;
function Concat
(Left : Wide_Wide_String;
Right : Super_String) return Super_String
is
Result : Super_String (Right.Max_Length);
Llen : constant Natural := Left'Length;
Rlen : constant Natural := Right.Current_Length;
Nlen : constant Natural := Llen + Rlen;
begin
if Nlen > Right.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left;
Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
end if;
return Result : Super_String (Right.Max_Length) do
declare
Llen : constant Natural := Left'Length;
Rlen : constant Natural := Right.Current_Length;
Nlen : constant Natural := Llen + Rlen;
return Result;
begin
if Nlen > Right.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Nlen;
Result.Data (1 .. Llen) := Left;
Result.Data (Llen + 1 .. Nlen) := Right.Data (1 .. Rlen);
end if;
end;
end return;
end Concat;
function Concat
(Left : Super_String;
Right : Wide_Wide_Character) return Super_String
is
Result : Super_String (Left.Max_Length);
Llen : constant Natural := Left.Current_Length;
begin
if Llen = Left.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Llen + 1;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Result.Current_Length) := Right;
end if;
return Result : Super_String (Left.Max_Length) do
declare
Llen : constant Natural := Left.Current_Length;
return Result;
begin
if Llen = Left.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Llen + 1;
Result.Data (1 .. Llen) := Left.Data (1 .. Llen);
Result.Data (Result.Current_Length) := Right;
end if;
end;
end return;
end Concat;
function Concat
(Left : Wide_Wide_Character;
Right : Super_String) return Super_String
is
Result : Super_String (Right.Max_Length);
Rlen : constant Natural := Right.Current_Length;
begin
if Rlen = Right.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Rlen + 1;
Result.Data (1) := Left;
Result.Data (2 .. Result.Current_Length) := Right.Data (1 .. Rlen);
end if;
return Result : Super_String (Right.Max_Length) do
declare
Rlen : constant Natural := Right.Current_Length;
return Result;
begin
if Rlen = Right.Max_Length then
raise Ada.Strings.Length_Error;
else
Result.Current_Length := Rlen + 1;
Result.Data (1) := Left;
Result.Data (2 .. Result.Current_Length) :=
Right.Data (1 .. Rlen);
end if;
end;
end return;
end Concat;
-----------
......@@ -1469,13 +1480,15 @@ package body Ada.Strings.Wide_Wide_Superbounded is
begin
-- Note: test of High > Length is in accordance with AI95-00128
if Low > Source.Current_Length + 1
or else High > Source.Current_Length
then
raise Index_Error;
else
return Source.Data (Low .. High);
end if;
return R : Wide_Wide_String (Low .. High) do
if Low > Source.Current_Length + 1
or else High > Source.Current_Length
then
raise Index_Error;
end if;
R := Source.Data (Low .. High);
end return;
end Super_Slice;
function Super_Slice
......@@ -1483,19 +1496,18 @@ package body Ada.Strings.Wide_Wide_Superbounded is
Low : Positive;
High : Natural) return Super_String
is
Result : Super_String (Source.Max_Length);
begin
if Low > Source.Current_Length + 1
or else High > Source.Current_Length
then
raise Index_Error;
else
Result.Current_Length := High - Low + 1;
Result.Data (1 .. Result.Current_Length) := Source.Data (Low .. High);
end if;
return Result;
return Result : Super_String (Source.Max_Length) do
if Low > Source.Current_Length + 1
or else High > Source.Current_Length
then
raise Index_Error;
else
Result.Current_Length := High - Low + 1;
Result.Data (1 .. Result.Current_Length) :=
Source.Data (Low .. High);
end if;
end return;
end Super_Slice;
procedure Super_Slice
......@@ -1627,7 +1639,9 @@ package body Ada.Strings.Wide_Wide_Superbounded is
(Source : Super_String) return Wide_Wide_String
is
begin
return Source.Data (1 .. Source.Current_Length);
return R : Wide_Wide_String (1 .. Source.Current_Length) do
R := Source.Data (1 .. Source.Current_Length);
end return;
end Super_To_String;
---------------------
......
gcc/ada/exp_ch4.adb
......@@ -702,13 +702,16 @@ package body Exp_Ch4 is
(Is_Class_Wide_Type (Etype (Exp))
and then Scope (PtrT) /= Current_Scope))
then
-- If the allocator was built in place Ref is already a reference
-- If the allocator was built in place, Ref is already a reference
-- to the access object initialized to the result of the allocator
-- (see Exp_Ch6.Make_Build_In_Place_Call_In_Allocator). Otherwise
-- it is the entity associated with the object containing the
-- address of the allocated object.
-- (see Exp_Ch6.Make_Build_In_Place_Call_In_Allocator). We call
-- Remove_Side_Effects for cases where the build-in-place call may
-- still be the prefix of the reference (to avoid generating
-- duplicate calls). Otherwise, it is the entity associated with
-- the object containing the address of the allocated object.
if Built_In_Place then
Remove_Side_Effects (Ref);
New_Node := New_Copy (Ref);
else
New_Node := New_Reference_To (Ref, Loc);
......
gcc/ada/exp_ch6.adb
......@@ -4243,6 +4243,23 @@ package body Exp_Ch6 is
Error_Msg_N ("call to recursive subprogram cannot be inlined?", N);
Set_Is_Inlined (Subp, False);
return;
-- Skip inlining if this is not a true inlining since the attribute
-- Body_To_Inline is also set for renamings (see sinfo.ads)
elsif Nkind (Orig_Bod) in N_Entity then
return;
-- Skip inlining if the function returns an unconstrained type using
-- an extended return statement since this part of the new model of
-- inlining which is not yet supported by the current implementation.
elsif Is_Unc
and then
Nkind (First (Statements (Handled_Statement_Sequence (Orig_Bod))))
= N_Extended_Return_Statement
then
return;
end if;
if Nkind (Orig_Bod) = N_Defining_Identifier
......
gcc/ada/gcc-interface/Makefile.in
......@@ -1515,6 +1515,8 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ)))
s-memory.ads<s-memory-vms_64.ads \
s-osprim.adb<s-osprim-vms.adb \
s-osprim.ads<s-osprim-vms.ads \
s-osinte.adb<s-osinte-vms.adb \
s-osinte.ads<s-osinte-vms.ads \
s-taprop.adb<s-taprop-vms.adb \
s-tasdeb.adb<s-tasdeb-vms.adb \
s-taspri.ads<s-taspri-vms.ads \
......@@ -1528,8 +1530,6 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ)))
g-trasym.adb<g-trasym-vms-ia64.adb \
s-asthan.adb<s-asthan-vms-ia64.adb \
s-auxdec.adb<s-auxdec-vms-ia64.adb \
s-osinte.adb<s-osinte-vms-ia64.adb \
s-osinte.ads<s-osinte-vms-ia64.ads \
s-vaflop.adb<s-vaflop-vms-ia64.adb \
system.ads<system-vms-ia64.ads \
s-parame.ads<s-parame-vms-ia64.ads \
......@@ -1547,8 +1547,6 @@ ifeq ($(strip $(filter-out alpha64 ia64 dec hp vms% openvms% alphavms%,$(targ)))
g-trasym.adb<g-trasym-vms-alpha.adb \
s-asthan.adb<s-asthan-vms-alpha.adb \
s-auxdec.adb<s-auxdec-vms-alpha.adb \
s-osinte.adb<s-osinte-vms.adb \
s-osinte.ads<s-osinte-vms.ads \
s-traent.adb<s-traent-vms.adb \
s-traent.ads<s-traent-vms.ads \
s-vaflop.adb<s-vaflop-vms-alpha.adb \
......
gcc/ada/s-osinte-vms-ia64.adb deleted 100644 → 0
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . O S _ I N T E R F A C E --
-- --
-- B o d y --
-- --
-- Copyright (C) 2003-2010, 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/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
-- This is a OpenVMS/IA64 version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
pragma Polling (Off);
-- Turn off polling, we do not want ATC polling to take place during
-- tasking operations. It causes infinite loops and other problems.
with Interfaces.C; use Interfaces.C;
package body System.OS_Interface is
-----------------
-- sched_yield --
-----------------
function sched_yield return int is
procedure sched_yield_base;
pragma Import (C, sched_yield_base, "PTHREAD_YIELD_NP");
begin
sched_yield_base;
return 0;
end sched_yield;
end System.OS_Interface;
gcc/ada/s-osinte-vms.adb
......@@ -7,7 +7,7 @@
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2010, AdaCore --
-- Copyright (C) 1995-2012, AdaCore --
-- --
-- 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- --
......@@ -30,7 +30,7 @@
-- --
------------------------------------------------------------------------------
-- This is a OpenVMS/Alpha version of this package
-- This is the OpenVMS version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
......@@ -40,27 +40,9 @@ pragma Polling (Off);
-- tasking operations. It causes infinite loops and other problems.
with Interfaces.C; use Interfaces.C;
with System.Machine_Code; use System.Machine_Code;
package body System.OS_Interface is
------------------
-- pthread_self --
------------------
function pthread_self return pthread_t is
use ASCII;
Self : pthread_t;
begin
Asm ("call_pal 0x9e" & LF & HT &
"bis $31, $0, %0",
Outputs => pthread_t'Asm_Output ("=r", Self),
Clobber => "$0",
Volatile => True);
return Self;
end pthread_self;
-----------------
-- sched_yield --
-----------------
......
gcc/ada/s-osinte-vms.ads
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2012, 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- --
......@@ -30,7 +30,7 @@
-- --
------------------------------------------------------------------------------
-- This is a OpenVMS/Alpha version of this package
-- This is the OpenVMS version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by the tasking run-time (libgnarl).
......@@ -47,9 +47,6 @@ with System.Aux_DEC;
package System.OS_Interface is
pragma Preelaborate;
pragma Linker_Options ("--for-linker=sys$library:pthread$rtl.exe");
-- Link in the DEC threads library
-- pragma Linker_Options ("--for-linker=/threads_enable");
-- Enable upcalls and multiple kernel threads.
......@@ -558,6 +555,7 @@ package System.OS_Interface is
pragma Import (C, pthread_exit, "PTHREAD_EXIT");
function pthread_self return pthread_t;
pragma Import (C, pthread_self, "PTHREAD_SELF");
--------------------------
-- POSIX.1c Section 17 --
......
gcc/ada/s-vaflop-vms-alpha.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2011, Free Software Foundation, Inc. --
-- Copyright (C) 1997-2012, Free Software Foundation, Inc. --
-- (Version for Alpha OpenVMS) --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
......@@ -202,15 +202,6 @@ package body System.Vax_Float_Operations is
end S_To_F;
------------
-- T_To_D --
------------
function T_To_D (X : T) return D is
begin
return G_To_D (T_To_G (X));
end T_To_D;
------------
-- T_To_G --
------------
......@@ -223,6 +214,15 @@ package body System.Vax_Float_Operations is
return B;
end T_To_G;
------------
-- T_To_D --
------------
function T_To_D (X : T) return D is
begin
return G_To_D (T_To_G (X));
end T_To_D;
-----------
-- Abs_F --
-----------
......
gcc/ada/s-vaflop.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1997-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1997-2012, 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- --
......@@ -444,22 +444,22 @@ package body System.Vax_Float_Operations is
end Sub_G;
------------
-- T_To_D --
-- T_To_G --
------------
function T_To_D (X : T) return D is
function T_To_G (X : T) return G is
begin
return G_To_D (T_To_G (X));
end T_To_D;
return G (X);
end T_To_G;
------------
-- T_To_G --
-- T_To_D --
------------
function T_To_G (X : T) return G is
function T_To_D (X : T) return D is
begin
return G (X);
end T_To_G;
return G_To_D (T_To_G (X));
end T_To_D;
-------------
-- Valid_D --
......
gcc/ada/sem_ch5.adb
......@@ -1654,10 +1654,9 @@ package body Sem_Ch5 is
(Original_Bound : Node_Id;
Analyzed_Bound : Node_Id) return Node_Id
is
Assign : Node_Id;
Id : Entity_Id;
Decl : Node_Id;
Assign : Node_Id;
Decl : Node_Id;
Id : Entity_Id;
begin
-- If the bound is a constant or an object, no need for a separate
-- declaration. If the bound is the result of previous expansion
......@@ -1677,10 +1676,6 @@ package body Sem_Ch5 is
return Original_Bound;
end if;
-- Here we need to capture the value
Analyze_And_Resolve (Original_Bound, Typ);
-- Normally, the best approach is simply to generate a constant
-- declaration that captures the bound. However, there is a nasty
-- case where this is wrong. If the bound is complex, and has a
......@@ -1692,7 +1687,8 @@ package body Sem_Ch5 is
-- proper trace of the value, useful in optimizations that get rid
-- of junk range checks.
if not Has_Call_Using_Secondary_Stack (Original_Bound) then
if not Has_Call_Using_Secondary_Stack (Analyzed_Bound) then
Analyze_And_Resolve (Original_Bound, Typ);
Force_Evaluation (Original_Bound);
return Original_Bound;
end if;
......@@ -1712,14 +1708,6 @@ package body Sem_Ch5 is
Name => New_Occurrence_Of (Id, Loc),
Expression => Relocate_Node (Original_Bound));
-- We must recursively clean in the relocated expression the flag
-- analyzed to ensure that the expression is reanalyzed. Required
-- to ensure that the transient scope is established now (because
-- Establish_Transient_Scope discarded generating transient scopes
-- in the analysis of the iteration scheme).
Reset_Analyzed_Flags (Expression (Assign));
Insert_Actions (Parent (N), New_List (Decl, Assign));
-- Now that this temporary variable is initialized we decorate it
......
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