Body_Stmts : List_Id;
Init_Tags_List : List_Id;
+ Covers_Default_Constructor : Entity_Id := Empty;
+
+ -- Start of processing for Set_CPP_Constructor
+
begin
pragma Assert (Is_CPP_Class (Typ));
Defining_Identifier =>
Make_Defining_Identifier (Loc,
Chars (Defining_Identifier (P))),
- Parameter_Type => New_Copy_Tree (Parameter_Type (P))));
+ Parameter_Type =>
+ New_Copy_Tree (Parameter_Type (P)),
+ Expression => New_Copy_Tree (Expression (P))));
Next (P);
end loop;
end if;
Discard_Node (Wrapper_Body_Node);
Set_Init_Proc (Typ, Wrapper_Id);
+
+ -- If this constructor has parameters and all its parameters
+ -- have defaults then it covers the default constructor. The
+ -- semantic analyzer ensures that only one constructor with
+ -- defaults covers the default constructor.
+
+ if Present (Parameter_Specifications (Parent (E)))
+ and then Needs_No_Actuals (E)
+ then
+ Covers_Default_Constructor := Wrapper_Id;
+ end if;
end if;
Next_Entity (E);
Set_Is_Abstract_Type (Typ);
end if;
+ -- Handle constructor that has all its parameters with defaults and
+ -- hence it covers the default constructor. We generate a wrapper IP
+ -- which calls the covering constructor.
+
+ if Present (Covers_Default_Constructor) then
+ Loc := Sloc (Covers_Default_Constructor);
+
+ Body_Stmts := New_List (
+ Make_Procedure_Call_Statement (Loc,
+ Name =>
+ New_Reference_To (Covers_Default_Constructor, Loc),
+ Parameter_Associations => New_List (
+ Make_Identifier (Loc, Name_uInit))));
+
+ Wrapper_Id :=
+ Make_Defining_Identifier (Loc, Make_Init_Proc_Name (Typ));
+
+ Wrapper_Body_Node :=
+ Make_Subprogram_Body (Loc,
+ Specification =>
+ Make_Procedure_Specification (Loc,
+ Defining_Unit_Name => Wrapper_Id,
+ Parameter_Specifications => New_List (
+ Make_Parameter_Specification (Loc,
+ Defining_Identifier =>
+ Make_Defining_Identifier (Loc, Name_uInit),
+ Parameter_Type =>
+ New_Reference_To (Typ, Loc)))),
+
+ Declarations => No_List,
+
+ Handled_Statement_Sequence =>
+ Make_Handled_Sequence_Of_Statements (Loc,
+ Statements => Body_Stmts,
+ Exception_Handlers => No_List));
+
+ Discard_Node (Wrapper_Body_Node);
+ Set_Init_Proc (Typ, Wrapper_Id);
+ end if;
+
-- If the CPP type has constructors then it must import also the default
-- C++ constructor. It is required for default initialization of objects
-- of the type. It is also required to elaborate objects of Ada types
procedure Free_Bignum (X : Bignum) is null;
-- Called to free a Bignum value used in intermediate computations. In
- -- this implementation using the secondary stack, does nothing at all,
+ -- this implementation using the secondary stack, it does nothing at all,
-- because we rely on Mark/Release, but it may be of use for some
-- alternative implementation.
function Add (X, Y : Digit_Vector; X_Neg, Y_Neg : Boolean) return Bignum is
begin
- -- If signs are the same we are doing an addition, it is convenient to
- -- ensure that the first operand is the longer of the two,
+ -- If signs are the same, we are doing an addition, it is convenient to
+ -- ensure that the first operand is the longer of the two.
if X_Neg = Y_Neg then
if X'Last < Y'Last then
- return Add (Y => X, X => Y, X_Neg => Y_Neg, Y_Neg => X_Neg);
+ return Add (X => Y, Y => X, X_Neg => Y_Neg, Y_Neg => X_Neg);
-- Here signs are the same, and the first operand is the longer
end;
end if;
- -- Signs are different so really this is an subtraction, we want to
- -- make sure that the largest magnitude operand is the first one, and
- -- then the result will have the sign of the first operand.
+ -- Signs are different so really this is a subtraction, we want to make
+ -- sure that the largest magnitude operand is the first one, and then
+ -- the result will have the sign of the first operand.
else
declare
return Normalize (Zero_Data);
elsif CR = LT then
- return Add (Y => X, X => Y, X_Neg => Y_Neg, Y_Neg => X_Neg);
+ return Add (X => Y, Y => X, X_Neg => Y_Neg, Y_Neg => X_Neg);
else
pragma Assert (X_Neg /= Y_Neg and then CR = GT);
declare
Diff : Digit_Vector (1 .. X'Length);
- RD : DD;
+ RD : DD;
begin
RD := 0;
-- Big_EQ --
------------
- function Big_EQ (X, Y : Bignum) return Boolean is
+ function Big_EQ (X, Y : Bignum) return Boolean is
begin
return Compare (X.D, Y.D, X.Neg, Y.Neg) = EQ;
end Big_EQ;
-- Big_GE --
------------
- function Big_GE (X, Y : Bignum) return Boolean is
+ function Big_GE (X, Y : Bignum) return Boolean is
begin
return Compare (X.D, Y.D, X.Neg, Y.Neg) /= LT;
end Big_GE;
-- Big_GT --
------------
- function Big_GT (X, Y : Bignum) return Boolean is
+ function Big_GT (X, Y : Bignum) return Boolean is
begin
return Compare (X.D, Y.D, X.Neg, Y.Neg) = GT;
end Big_GT;
-- Big_LE --
------------
- function Big_LE (X, Y : Bignum) return Boolean is
+ function Big_LE (X, Y : Bignum) return Boolean is
begin
return Compare (X.D, Y.D, X.Neg, Y.Neg) /= GT;
end Big_LE;
-- Big_LT --
------------
- function Big_LT (X, Y : Bignum) return Boolean is
+ function Big_LT (X, Y : Bignum) return Boolean is
begin
return Compare (X.D, Y.D, X.Neg, Y.Neg) = LT;
end Big_LT;
-- 13 -5 -2 3 -13 -5 -3 -3
-- 14 -5 -1 4 -14 -5 -4 -4
- function Big_Mod (X, Y : Bignum) return Bignum is
+ function Big_Mod (X, Y : Bignum) return Bignum is
Q, R : Bignum;
begin
if X.Neg = Y.Neg then
return Big_Rem (X, Y);
- -- Case where mod is different
+ -- Case where Mod is different
else
-- Do division
-- Big_NE --
------------
- function Big_NE (X, Y : Bignum) return Boolean is
+ function Big_NE (X, Y : Bignum) return Boolean is
begin
return Compare (X.D, Y.D, X.Neg, Y.Neg) /= EQ;
end Big_NE;
-- 13 -5 3 -13 -5 -3
-- 14 -5 4 -14 -5 -4
- function Big_Rem (X, Y : Bignum) return Bignum is
+ function Big_Rem (X, Y : Bignum) return Bignum is
Q, R : Bignum;
begin
Div_Rem (X, Y, Q, R, Discard_Quotient => True);
- R.Neg := R.Len > 0 and then X.Neg;
+ R.Neg := R.Len > 0 and then X.Neg;
return R;
end Big_Rem;
if Compare (X.D, Y.D, False, False) = LT then
Remainder := Normalize (X.D);
- Quotient := Normalize (Zero_Data);
+ Quotient := Normalize (Zero_Data);
return;
- -- If both X and Y are comfortably less than 2**63-1 we can just use
+ -- If both X and Y are comfortably less than 2**63-1, we can just use
-- Long_Long_Integer arithmetic. Note it is good not to do an accurate
-- range check here since -2**63 / -1 overflows!
ND := ND rem Div;
end loop;
- Quotient := Normalize (Result);
+ Quotient := Normalize (Result);
Remdr (1) := SD (ND);
Remainder := Normalize (Remdr);
return;
end loop;
B := Allocate_Bignum (X'Last - J + 1);
- B.Neg := B.Len > 0 and then Neg;
+ B.Neg := B.Len > 0 and then Neg;
B.D := X (J .. X'Last);
return B;
end Normalize;
projects / thirdparty / gcc.git / commitdiff
