+2012-03-07 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch5.adb, s-vaflop.adb, s-taprop-vms.adb, exp_ch6.adb,
+ s-gearop.adb, sem_ch6.adb, g-trasym.adb: Minor reformatting.
+
+2012-03-07 Javier Miranda <miranda@adacore.com>
+
+ * a-ngrear.ads: Add documentation.
+
2012-03-07 Tristan Gingold <gingold@adacore.com>
* s-taprop-vms.adb (Create_Task): set thread name.
-- The following operations are either relatively simple compared to the
-- expense of returning unconstrained arrays, or are just function wrappers
-- calling procedures implementing the actual operation. By having the
- -- front end always inline these, the expense of the unconstrained returns
+ -- front end inline these, the expense of the unconstrained returns
-- can be avoided.
- -- Confusing comment above, why does the front end always inline
- -- these functions ???
+ -- Note: We use an extended return statement in their implementation to
+ -- allow the frontend to inline these functions.
pragma Inline ("+");
pragma Inline ("-");
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.
+ -- an extended return statement since this part of the new inlining
+ -- model which is not yet supported by the current implementation. ???
elsif Is_Unc
and then
begin
if Traceback'Length = 0 then
return "";
+
else
declare
Img : String := System.Address_Image (Traceback (Traceback'First));
package body System.Generic_Array_Operations is
- -- The local function Check_Unit_Last computes the index of the last
- -- element returned by Unit_Vector or Unit_Matrix. A separate function is
- -- needed to allow raising Constraint_Error before declaring the function
- -- result variable. The result variable needs to be declared first, to
- -- allow front-end inlining.
-
function Check_Unit_Last
(Index : Integer;
Order : Positive;
First : Integer) return Integer;
pragma Inline_Always (Check_Unit_Last);
+ -- Compute index of last element returned by Unit_Vector or Unit_Matrix.
+ -- A separate function is needed to allow raising Constraint_Error before
+ -- declaring the function result variable. The result variable needs to be
+ -- declared first, to allow front-end inlining.
--------------
-- Diagonal --
begin
if A'Length (1) /= A'Length (2) then
raise Constraint_Error with "matrix is not square";
+ else
+ return A'Length (1);
end if;
-
- return A'Length (1);
end Square_Matrix_Length;
---------------------
-- Elementary row operation that subtracts Factor * M (Source, <>) from
-- M (Target, <>)
+ -------------
+ -- Sub_Row --
+ -------------
+
procedure Sub_Row
(M : in out Matrix;
Target : Integer;
procedure Swap (X, Y : in out Scalar);
-- Exchange the values of X and Y
+ ----------
+ -- Swap --
+ ----------
+
procedure Swap (X, Y : in out Scalar) is
T : constant Scalar := X;
begin
begin
return R : Result_Matrix (Left'Range (1), Left'Range (2)) do
if Left'Length (1) /= Right'Length (1)
- or else
- Left'Length (2) /= Right'Length (2)
+ or else
+ Left'Length (2) /= Right'Length (2)
then
raise Constraint_Error with
"matrices are of different dimension in elementwise operation";
------------------------------------------------
function Matrix_Matrix_Scalar_Elementwise_Operation
- (X : X_Matrix;
- Y : Y_Matrix;
- Z : Z_Scalar) return Result_Matrix is
+ (X : X_Matrix;
+ Y : Y_Matrix;
+ Z : Z_Scalar) return Result_Matrix
+ is
begin
return R : Result_Matrix (X'Range (1), X'Range (2)) do
if X'Length (1) /= Y'Length (1)
- or else
- X'Length (2) /= Y'Length (2)
+ or else
+ X'Length (2) /= Y'Length (2)
then
raise Constraint_Error with
"matrices are of different dimension in elementwise operation";
procedure Update_Matrix_With_Matrix (X : in out X_Matrix; Y : Y_Matrix) is
begin
if X'Length (1) /= Y'Length (1)
- or else X'Length (2) /= Y'Length (2)
+ or else
+ X'Length (2) /= Y'Length (2)
then
raise Constraint_Error with
"matrices are of different dimension in update operation";
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
Ada.Unchecked_Conversion (System.Aux_DEC.Short_Address, Thread_Body);
Task_Name : String (1 .. System.Parameters.Max_Task_Image_Length + 1);
+
begin
-- Since the initial signal mask of a thread is inherited from the
-- creator, we need to set our local signal mask to mask all signals
pragma Assert (Result = 0);
if T.Common.Task_Image_Len > 0 then
+
-- Set thread name to ease debugging
Task_Name (1 .. T.Common.Task_Image_Len) :=
end Sub_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;
------------
- -- 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;
-------------
-- Valid_D --
(Original_Bound : Node_Id;
Analyzed_Bound : Node_Id) return Node_Id
is
- Assign : Node_Id;
- Decl : Node_Id;
- Id : Entity_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
end if;
-- Internally generated subprograms, such as type-specific functions,
- -- don't get assertions checks.
+ -- don't get assertion checks.
if Get_TSS_Name (Designator) /= TSS_Null then
return;
projects / platform / upstream / gcc.git / commitdiff