[multiple changes]
2005-12-05 Robert Dewar <dewar@adacore.com> * i-c.adb, i-cexten.ads, i-cobol.adb, i-cobol.ads, i-cpoint.ads, i-cpp.adb, i-cpp.ads, i-cstrea.ads, i-cstrin.adb, i-cstrin.ads, inline.adb, interfac.ads, i-os2err.ads, i-os2lib.ads, i-os2syn.ads, i-os2thr.ads, itypes.adb, itypes.adb, itypes.ads, krunch.ads, krunch.adb, lib.adb, lib.ads, lib-list.adb, lib-load.adb, lib-load.ads, lib-sort.adb, live.adb, make.ads, i-cstrea-vms.adb, interfac-vms.ads, makegpr.adb, indepsw-gnu.adb, indepsw.ads, s-wchcon.ads, sdefault.ads, sem_ch10.adb, sem_eval.ads: Minor reformatting. 2005-12-05 Robert Dewar <dewar@adacore.com> * s-vaflop-vms-alpha.adb: (Ne_F): New function (Ne_G): New function * exp_ch4.adb (Expand_Allocator_Expression): Factor duplicated code for tag assignment. (Rewrite_Comparison): Handle case where operation is not a comparison and ignore, and also handle type conversion case. 2005-12-05 Thomas Quinot <quinot@adacore.com> * exp_aggr.ads: Fix typo in comment. ???-mark Convert_Aggr_In_Assignment as needing documentation. 2005-12-05 Gary Dismukes <dismukes@adacore.com> * layout.adb: Replace various uses of byte by storage unit throughout. (Get_Max_SU_Size): Name changed from Get_Max_Size. In the case of a static size, convert to storage units before returning, to conform to spec. 2005-12-05 Matthew Gingell <gingell@adacore.com> * g-exctra.ads: Fix typo in comment. 2005-12-05 Richard Kenner <kenner@vlsi1.ultra.nyu.edu> * utils.c: Minor reformatting. 2005-12-05 Robert Dewar <dewar@adacore.com> * g-soccon.ads: Further comment fixes to make the status of the default file clear * s-bitops.adb: Clarify comment for Bits_Array From-SVN: r108308
This commit is contained in:
parent
9c8457a769
commit
d26dc4b5a1
45 changed files with 466 additions and 473 deletions
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
@ -43,12 +43,9 @@ package Exp_Aggr is
|
|||
-- Decl is an access N_Object_Declaration (produced during
|
||||
-- allocator expansion), Aggr is the initial expression aggregate
|
||||
-- of an allocator. This procedure perform in-place aggregate
|
||||
-- assignent in the newly allocated object.
|
||||
-- assignment in the newly allocated object.
|
||||
|
||||
procedure Convert_Aggr_In_Assignment (N : Node_Id);
|
||||
-- Decl is an access N_Object_Declaration (produced during
|
||||
-- allocator expansion), Aggr is the initial expression aggregate
|
||||
-- of an allocator. This procedure perform in-place aggregate
|
||||
-- assignent in the newly allocated object.
|
||||
-- ??? documentation needed
|
||||
|
||||
end Exp_Aggr;
|
||||
|
|
|
@ -192,10 +192,12 @@ package body Exp_Ch4 is
|
|||
-- this by using Convert_To_Actual_Subtype if necessary).
|
||||
|
||||
procedure Rewrite_Comparison (N : Node_Id);
|
||||
-- N is the node for a compile time comparison. If this outcome of this
|
||||
-- comparison can be determined at compile time, then the node N can be
|
||||
-- rewritten with True or False. If the outcome cannot be determined at
|
||||
-- compile time, the call has no effect.
|
||||
-- if N is the node for a comparison whose outcome can be determined at
|
||||
-- compile time, then the node N can be rewritten with True or False. If
|
||||
-- the outcome cannot be determined at compile time, the call has no
|
||||
-- effect. If N is a type conversion, then this processing is applied to
|
||||
-- its expression. If N is neither comparison nor a type conversion, the
|
||||
-- call has no effect.
|
||||
|
||||
function Tagged_Membership (N : Node_Id) return Node_Id;
|
||||
-- Construct the expression corresponding to the tagged membership test.
|
||||
|
@ -372,6 +374,12 @@ package body Exp_Ch4 is
|
|||
Node : Node_Id;
|
||||
Temp : Entity_Id;
|
||||
|
||||
TagT : Entity_Id := Empty;
|
||||
-- Type used as source for tag assignment
|
||||
|
||||
TagR : Node_Id := Empty;
|
||||
-- Target reference for tag assignment
|
||||
|
||||
Aggr_In_Place : constant Boolean := Is_Delayed_Aggregate (Exp);
|
||||
|
||||
Tag_Assign : Node_Id;
|
||||
|
@ -484,61 +492,46 @@ package body Exp_Ch4 is
|
|||
Reason => PE_Accessibility_Check_Failed));
|
||||
end if;
|
||||
|
||||
-- Suppress the tag assignment when Java_VM because JVM tags
|
||||
-- are represented implicitly in objects.
|
||||
if Java_VM then
|
||||
|
||||
if Is_Tagged_Type (T)
|
||||
and then not Is_Class_Wide_Type (T)
|
||||
and then not Java_VM
|
||||
-- Suppress the tag assignment when Java_VM because JVM tags
|
||||
-- are represented implicitly in objects.
|
||||
|
||||
null;
|
||||
|
||||
elsif Is_Tagged_Type (T) and then not Is_Class_Wide_Type (T) then
|
||||
TagT := T;
|
||||
TagR := New_Reference_To (Temp, Loc);
|
||||
|
||||
elsif Is_Private_Type (T)
|
||||
and then Is_Tagged_Type (Underlying_Type (T))
|
||||
then
|
||||
TagT := Underlying_Type (T);
|
||||
TagR := Unchecked_Convert_To (Underlying_Type (T),
|
||||
Make_Explicit_Dereference (Loc,
|
||||
New_Reference_To (Temp, Loc)));
|
||||
|
||||
end if;
|
||||
|
||||
if Present (TagT) then
|
||||
Tag_Assign :=
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name =>
|
||||
Make_Selected_Component (Loc,
|
||||
Prefix => New_Reference_To (Temp, Loc),
|
||||
Prefix => TagR,
|
||||
Selector_Name =>
|
||||
New_Reference_To (First_Tag_Component (T), Loc)),
|
||||
New_Reference_To (First_Tag_Component (TagT), Loc)),
|
||||
|
||||
Expression =>
|
||||
Unchecked_Convert_To (RTE (RE_Tag),
|
||||
New_Reference_To
|
||||
(Elists.Node (First_Elmt (Access_Disp_Table (T))),
|
||||
(Elists.Node (First_Elmt (Access_Disp_Table (TagT))),
|
||||
Loc)));
|
||||
|
||||
-- The previous assignment has to be done in any case
|
||||
|
||||
Set_Assignment_OK (Name (Tag_Assign));
|
||||
Insert_Action (N, Tag_Assign);
|
||||
|
||||
elsif Is_Private_Type (T)
|
||||
and then Is_Tagged_Type (Underlying_Type (T))
|
||||
and then not Java_VM
|
||||
then
|
||||
declare
|
||||
Utyp : constant Entity_Id := Underlying_Type (T);
|
||||
Ref : constant Node_Id :=
|
||||
Unchecked_Convert_To (Utyp,
|
||||
Make_Explicit_Dereference (Loc,
|
||||
New_Reference_To (Temp, Loc)));
|
||||
|
||||
begin
|
||||
Tag_Assign :=
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name =>
|
||||
Make_Selected_Component (Loc,
|
||||
Prefix => Ref,
|
||||
Selector_Name =>
|
||||
New_Reference_To (First_Tag_Component (Utyp), Loc)),
|
||||
|
||||
Expression =>
|
||||
Unchecked_Convert_To (RTE (RE_Tag),
|
||||
New_Reference_To (
|
||||
Elists.Node (First_Elmt (Access_Disp_Table (Utyp))),
|
||||
Loc)));
|
||||
|
||||
Set_Assignment_OK (Name (Tag_Assign));
|
||||
Insert_Action (N, Tag_Assign);
|
||||
end;
|
||||
end if;
|
||||
|
||||
if Controlled_Type (DesigT)
|
||||
|
@ -3530,7 +3523,6 @@ package body Exp_Ch4 is
|
|||
Parnt := Parent (Child);
|
||||
end loop;
|
||||
end;
|
||||
|
||||
end Expand_N_Indexed_Component;
|
||||
|
||||
---------------------
|
||||
|
@ -4570,12 +4562,9 @@ package body Exp_Ch4 is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
-- If we still have an equality comparison (i.e. it was not rewritten
|
||||
-- in some way), then we can test if result is known at compile time).
|
||||
-- Test if result is known at compile time
|
||||
|
||||
if Nkind (N) = N_Op_Eq then
|
||||
Rewrite_Comparison (N);
|
||||
end if;
|
||||
Rewrite_Comparison (N);
|
||||
|
||||
-- If we still have comparison for Vax_Float, process it
|
||||
|
||||
|
@ -8010,78 +7999,91 @@ package body Exp_Ch4 is
|
|||
------------------------
|
||||
|
||||
procedure Rewrite_Comparison (N : Node_Id) is
|
||||
Typ : constant Entity_Id := Etype (N);
|
||||
Op1 : constant Node_Id := Left_Opnd (N);
|
||||
Op2 : constant Node_Id := Right_Opnd (N);
|
||||
|
||||
Res : constant Compare_Result := Compile_Time_Compare (Op1, Op2);
|
||||
-- Res indicates if compare outcome can be determined at compile time
|
||||
|
||||
True_Result : Boolean;
|
||||
False_Result : Boolean;
|
||||
|
||||
begin
|
||||
case N_Op_Compare (Nkind (N)) is
|
||||
when N_Op_Eq =>
|
||||
True_Result := Res = EQ;
|
||||
False_Result := Res = LT or else Res = GT or else Res = NE;
|
||||
if Nkind (N) = N_Type_Conversion then
|
||||
Rewrite_Comparison (Expression (N));
|
||||
|
||||
when N_Op_Ge =>
|
||||
True_Result := Res in Compare_GE;
|
||||
False_Result := Res = LT;
|
||||
elsif Nkind (N) not in N_Op_Compare then
|
||||
null;
|
||||
|
||||
if Res = LE
|
||||
and then Constant_Condition_Warnings
|
||||
and then Comes_From_Source (Original_Node (N))
|
||||
and then Nkind (Original_Node (N)) = N_Op_Ge
|
||||
and then not In_Instance
|
||||
and then not Warnings_Off (Etype (Left_Opnd (N)))
|
||||
and then Is_Integer_Type (Etype (Left_Opnd (N)))
|
||||
then
|
||||
Error_Msg_N
|
||||
("can never be greater than, could replace by ""'=""?", N);
|
||||
else
|
||||
declare
|
||||
Typ : constant Entity_Id := Etype (N);
|
||||
Op1 : constant Node_Id := Left_Opnd (N);
|
||||
Op2 : constant Node_Id := Right_Opnd (N);
|
||||
|
||||
Res : constant Compare_Result := Compile_Time_Compare (Op1, Op2);
|
||||
-- Res indicates if compare outcome can be compile time determined
|
||||
|
||||
True_Result : Boolean;
|
||||
False_Result : Boolean;
|
||||
|
||||
begin
|
||||
case N_Op_Compare (Nkind (N)) is
|
||||
when N_Op_Eq =>
|
||||
True_Result := Res = EQ;
|
||||
False_Result := Res = LT or else Res = GT or else Res = NE;
|
||||
|
||||
when N_Op_Ge =>
|
||||
True_Result := Res in Compare_GE;
|
||||
False_Result := Res = LT;
|
||||
|
||||
if Res = LE
|
||||
and then Constant_Condition_Warnings
|
||||
and then Comes_From_Source (Original_Node (N))
|
||||
and then Nkind (Original_Node (N)) = N_Op_Ge
|
||||
and then not In_Instance
|
||||
and then not Warnings_Off (Etype (Left_Opnd (N)))
|
||||
and then Is_Integer_Type (Etype (Left_Opnd (N)))
|
||||
then
|
||||
Error_Msg_N
|
||||
("can never be greater than, could replace by ""'=""?", N);
|
||||
end if;
|
||||
|
||||
when N_Op_Gt =>
|
||||
True_Result := Res = GT;
|
||||
False_Result := Res in Compare_LE;
|
||||
|
||||
when N_Op_Lt =>
|
||||
True_Result := Res = LT;
|
||||
False_Result := Res in Compare_GE;
|
||||
|
||||
when N_Op_Le =>
|
||||
True_Result := Res in Compare_LE;
|
||||
False_Result := Res = GT;
|
||||
|
||||
if Res = GE
|
||||
and then Constant_Condition_Warnings
|
||||
and then Comes_From_Source (Original_Node (N))
|
||||
and then Nkind (Original_Node (N)) = N_Op_Le
|
||||
and then not In_Instance
|
||||
and then not Warnings_Off (Etype (Left_Opnd (N)))
|
||||
and then Is_Integer_Type (Etype (Left_Opnd (N)))
|
||||
then
|
||||
Error_Msg_N
|
||||
("can never be less than, could replace by ""'=""?", N);
|
||||
end if;
|
||||
|
||||
when N_Op_Ne =>
|
||||
True_Result := Res = NE or else Res = GT or else Res = LT;
|
||||
False_Result := Res = EQ;
|
||||
end case;
|
||||
|
||||
if True_Result then
|
||||
Rewrite (N,
|
||||
Convert_To (Typ,
|
||||
New_Occurrence_Of (Standard_True, Sloc (N))));
|
||||
Analyze_And_Resolve (N, Typ);
|
||||
Warn_On_Known_Condition (N);
|
||||
|
||||
elsif False_Result then
|
||||
Rewrite (N,
|
||||
Convert_To (Typ,
|
||||
New_Occurrence_Of (Standard_False, Sloc (N))));
|
||||
Analyze_And_Resolve (N, Typ);
|
||||
Warn_On_Known_Condition (N);
|
||||
end if;
|
||||
|
||||
when N_Op_Gt =>
|
||||
True_Result := Res = GT;
|
||||
False_Result := Res in Compare_LE;
|
||||
|
||||
when N_Op_Lt =>
|
||||
True_Result := Res = LT;
|
||||
False_Result := Res in Compare_GE;
|
||||
|
||||
when N_Op_Le =>
|
||||
True_Result := Res in Compare_LE;
|
||||
False_Result := Res = GT;
|
||||
|
||||
if Res = GE
|
||||
and then Constant_Condition_Warnings
|
||||
and then Comes_From_Source (Original_Node (N))
|
||||
and then Nkind (Original_Node (N)) = N_Op_Le
|
||||
and then not In_Instance
|
||||
and then not Warnings_Off (Etype (Left_Opnd (N)))
|
||||
and then Is_Integer_Type (Etype (Left_Opnd (N)))
|
||||
then
|
||||
Error_Msg_N
|
||||
("can never be less than, could replace by ""'=""?", N);
|
||||
end if;
|
||||
|
||||
when N_Op_Ne =>
|
||||
True_Result := Res = NE or else Res = GT or else Res = LT;
|
||||
False_Result := Res = EQ;
|
||||
end case;
|
||||
|
||||
if True_Result then
|
||||
Rewrite (N,
|
||||
Convert_To (Typ, New_Occurrence_Of (Standard_True, Sloc (N))));
|
||||
Analyze_And_Resolve (N, Typ);
|
||||
Warn_On_Known_Condition (N);
|
||||
|
||||
elsif False_Result then
|
||||
Rewrite (N,
|
||||
Convert_To (Typ, New_Occurrence_Of (Standard_False, Sloc (N))));
|
||||
Analyze_And_Resolve (N, Typ);
|
||||
Warn_On_Known_Condition (N);
|
||||
end;
|
||||
end if;
|
||||
end Rewrite_Comparison;
|
||||
|
||||
|
|
|
@ -44,7 +44,7 @@
|
|||
-- The default backtrace is in the form of absolute code locations which may
|
||||
-- be converted to corresponding source locations using the addr2line utility
|
||||
-- or from within GDB. Please refer to GNAT.Traceback for information about
|
||||
-- what is necessary to be able to exploit thisg possibility.
|
||||
-- what is necessary to be able to exploit this possibility.
|
||||
|
||||
-- The backtrace output can also be customized by way of a "decorator" which
|
||||
-- may return any string output in association with a provided call chain.
|
||||
|
|
|
@ -36,11 +36,12 @@
|
|||
-- directly with'ed by an applications program.
|
||||
|
||||
-- WARNING! This file is a default version that must be replaced for
|
||||
-- each platform.
|
||||
-- The values below were computed from a i686-pc-linux-gnu environment.
|
||||
-- each platform by running gen-soccon.c which automatically generates
|
||||
-- the appropriate target specific values.
|
||||
|
||||
-- This file is generated automatically, do not modify it by hand! Instead,
|
||||
-- make changes to gen-soccon.c and re-run it on each target.
|
||||
-- The values below were computed from a i686-pc-linux-gnu environment,
|
||||
-- but are for illustration purposes only. As noted above, part of a port
|
||||
-- to a new target is to replace this file appropriately.
|
||||
|
||||
package GNAT.Sockets.Constants is
|
||||
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
-- S p e c --
|
||||
-- (ASCII Version) --
|
||||
-- --
|
||||
-- Copyright (C) 1993-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1993-2005, 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 --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1993-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1993-2005, 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 --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1996-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1996-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1995-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1995-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1993-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1993-2005, 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 --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1993-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1993-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1993-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1993-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1993-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1993-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1993-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1993-2005, 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- --
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
-- B o d y --
|
||||
-- (GNU version) --
|
||||
-- --
|
||||
-- Copyright (C) 2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2002-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2002-2005, 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 --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 2002-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2002-2005, 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 --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
@ -24,11 +24,11 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Atree; use Atree;
|
||||
with Opt; use Opt;
|
||||
with Sem; use Sem;
|
||||
with Sinfo; use Sinfo;
|
||||
with Stand; use Stand;
|
||||
with Atree; use Atree;
|
||||
with Opt; use Opt;
|
||||
with Sem; use Sem;
|
||||
with Sinfo; use Sinfo;
|
||||
with Stand; use Stand;
|
||||
|
||||
package body Itypes is
|
||||
|
||||
|
@ -42,8 +42,7 @@ package body Itypes is
|
|||
Related_Id : Entity_Id := Empty;
|
||||
Suffix : Character := ' ';
|
||||
Suffix_Index : Nat := 0;
|
||||
Scope_Id : Entity_Id := Current_Scope)
|
||||
return Entity_Id
|
||||
Scope_Id : Entity_Id := Current_Scope) return Entity_Id
|
||||
is
|
||||
Typ : Entity_Id;
|
||||
|
||||
|
@ -90,20 +89,19 @@ package body Itypes is
|
|||
Related_Nod => Related_Nod,
|
||||
Scope_Id => Scope_Id);
|
||||
|
||||
Set_Directly_Designated_Type (I_Typ,
|
||||
Directly_Designated_Type (T));
|
||||
Set_Etype (I_Typ, T);
|
||||
Init_Size_Align (I_Typ);
|
||||
Set_Depends_On_Private (I_Typ, Depends_On_Private (T));
|
||||
Set_Is_Public (I_Typ, Is_Public (T));
|
||||
Set_From_With_Type (I_Typ, From_With_Type (T));
|
||||
Set_Is_Access_Constant (I_Typ, Is_Access_Constant (T));
|
||||
Set_Is_Generic_Type (I_Typ, Is_Generic_Type (T));
|
||||
Set_Is_Volatile (I_Typ, Is_Volatile (T));
|
||||
Set_Treat_As_Volatile (I_Typ, Treat_As_Volatile (T));
|
||||
Set_Is_Atomic (I_Typ, Is_Atomic (T));
|
||||
Set_Is_Ada_2005 (I_Typ, Is_Ada_2005 (T));
|
||||
Set_Can_Never_Be_Null (I_Typ);
|
||||
Set_Directly_Designated_Type (I_Typ, Directly_Designated_Type (T));
|
||||
Set_Etype (I_Typ, T);
|
||||
Init_Size_Align (I_Typ);
|
||||
Set_Depends_On_Private (I_Typ, Depends_On_Private (T));
|
||||
Set_Is_Public (I_Typ, Is_Public (T));
|
||||
Set_From_With_Type (I_Typ, From_With_Type (T));
|
||||
Set_Is_Access_Constant (I_Typ, Is_Access_Constant (T));
|
||||
Set_Is_Generic_Type (I_Typ, Is_Generic_Type (T));
|
||||
Set_Is_Volatile (I_Typ, Is_Volatile (T));
|
||||
Set_Treat_As_Volatile (I_Typ, Treat_As_Volatile (T));
|
||||
Set_Is_Atomic (I_Typ, Is_Atomic (T));
|
||||
Set_Is_Ada_2005 (I_Typ, Is_Ada_2005 (T));
|
||||
Set_Can_Never_Be_Null (I_Typ);
|
||||
|
||||
return I_Typ;
|
||||
end Create_Null_Excluding_Itype;
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
@ -85,8 +85,7 @@ package Itypes is
|
|||
Related_Id : Entity_Id := Empty;
|
||||
Suffix : Character := ' ';
|
||||
Suffix_Index : Nat := 0;
|
||||
Scope_Id : Entity_Id := Current_Scope)
|
||||
return Entity_Id;
|
||||
Scope_Id : Entity_Id := Current_Scope) return Entity_Id;
|
||||
-- Used to create a new Itype.
|
||||
--
|
||||
-- Related_Nod is the node for which this Itype was created. It is
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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 Hostparm;
|
||||
|
||||
procedure Krunch
|
||||
(Buffer : in out String;
|
||||
Len : in out Natural;
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2001-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2001-2005, 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- --
|
||||
|
@ -107,7 +107,7 @@ package body Layout is
|
|||
-- dynamic sizes in storage units. If the argument N is anything other
|
||||
-- than an integer literal, it is returned unchanged, but if it is an
|
||||
-- integer literal, then it is taken as a size in bits, and is replaced
|
||||
-- by the corresponding size in bytes.
|
||||
-- by the corresponding size in storage units.
|
||||
|
||||
function Compute_Length (Lo : Node_Id; Hi : Node_Id) return Node_Id;
|
||||
-- Given expressions for the low bound (Lo) and the high bound (Hi),
|
||||
|
@ -154,7 +154,7 @@ package body Layout is
|
|||
-- resolved (which may not be the case yet if we build the expression
|
||||
-- in this unit).
|
||||
|
||||
function Get_Max_Size (E : Entity_Id) return Node_Id;
|
||||
function Get_Max_SU_Size (E : Entity_Id) return Node_Id;
|
||||
-- E is an array type or subtype that has at least one index bound that
|
||||
-- is the value of a record discriminant. For such an array, the function
|
||||
-- computes an expression that yields the maximum possible size of the
|
||||
|
@ -222,7 +222,7 @@ package body Layout is
|
|||
Esize_Set := Has_Size_Clause (E);
|
||||
end if;
|
||||
|
||||
-- If size is known it must be a multiple of the byte size
|
||||
-- If size is known it must be a multiple of the storage unit size
|
||||
|
||||
if Esize (E) mod SSU /= 0 then
|
||||
|
||||
|
@ -230,10 +230,11 @@ package body Layout is
|
|||
|
||||
if Esize_Set then
|
||||
Error_Msg_NE
|
||||
("size for& not a multiple of byte size", Size_Clause (E), E);
|
||||
("size for& not a multiple of storage unit size",
|
||||
Size_Clause (E), E);
|
||||
return;
|
||||
|
||||
-- Otherwise bump up size to a byte boundary
|
||||
-- Otherwise bump up size to a storage unit boundary
|
||||
|
||||
else
|
||||
Set_Esize (E, (Esize (E) + SSU - 1) / SSU * SSU);
|
||||
|
@ -270,7 +271,7 @@ package body Layout is
|
|||
|
||||
-- In this situation, the initial alignment of t is 4, copied from
|
||||
-- the Integer base type, but it is safe to reduce it to 1 at this
|
||||
-- stage, since we will only be loading a single byte.
|
||||
-- stage, since we will only be loading a single storage unit.
|
||||
|
||||
if Is_Discrete_Type (Etype (E))
|
||||
and then not Has_Alignment_Clause (E)
|
||||
|
@ -652,11 +653,11 @@ package body Layout is
|
|||
end if;
|
||||
end Expr_From_SO_Ref;
|
||||
|
||||
------------------
|
||||
-- Get_Max_Size --
|
||||
------------------
|
||||
---------------------
|
||||
-- Get_Max_SU_Size --
|
||||
---------------------
|
||||
|
||||
function Get_Max_Size (E : Entity_Id) return Node_Id is
|
||||
function Get_Max_SU_Size (E : Entity_Id) return Node_Id is
|
||||
Loc : constant Source_Ptr := Sloc (E);
|
||||
Indx : Node_Id;
|
||||
Ityp : Entity_Id;
|
||||
|
@ -725,7 +726,7 @@ package body Layout is
|
|||
end if;
|
||||
end Min_Discrim;
|
||||
|
||||
-- Start of processing for Get_Max_Size
|
||||
-- Start of processing for Get_Max_SU_Size
|
||||
|
||||
begin
|
||||
pragma Assert (Size_Depends_On_Discriminant (E));
|
||||
|
@ -859,10 +860,10 @@ package body Layout is
|
|||
end loop;
|
||||
|
||||
-- Here after processing all bounds to set sizes. If the value is
|
||||
-- a constant, then it is bits, and we just return the value.
|
||||
-- a constant, then it is bits, so we convert to storage units.
|
||||
|
||||
if Size.Status = Const then
|
||||
return Make_Integer_Literal (Loc, Size.Val);
|
||||
return Bits_To_SU (Make_Integer_Literal (Loc, Size.Val));
|
||||
|
||||
-- Case where the value is dynamic
|
||||
|
||||
|
@ -884,7 +885,7 @@ package body Layout is
|
|||
|
||||
return Size.Nod;
|
||||
end if;
|
||||
end Get_Max_Size;
|
||||
end Get_Max_SU_Size;
|
||||
|
||||
-----------------------
|
||||
-- Layout_Array_Type --
|
||||
|
@ -1480,7 +1481,7 @@ package body Layout is
|
|||
-- Get maximum size of previous component
|
||||
|
||||
if Size_Depends_On_Discriminant (Etype (Prev_Comp)) then
|
||||
Old_Maxsz := Get_Max_Size (Etype (Prev_Comp));
|
||||
Old_Maxsz := Get_Max_SU_Size (Etype (Prev_Comp));
|
||||
else
|
||||
Old_Maxsz := Expr_From_SO_Ref (Loc, Old_Esiz, Prev_Comp);
|
||||
end if;
|
||||
|
@ -2556,7 +2557,7 @@ package body Layout is
|
|||
|
||||
-- For scalar types, increase Object_Size to power of 2,
|
||||
-- but not less than a storage unit in any case (i.e.,
|
||||
-- normally this means it will be byte addressable).
|
||||
-- normally this means it will be storage-unit addressable).
|
||||
|
||||
if Is_Scalar_Type (E) then
|
||||
if Size <= System_Storage_Unit then
|
||||
|
@ -2717,7 +2718,8 @@ package body Layout is
|
|||
|
||||
-- Size is known, alignment is not set
|
||||
|
||||
-- Reset alignment to match size if size is exactly 2, 4, or 8 bytes
|
||||
-- Reset alignment to match size if size is exactly 2, 4, or 8
|
||||
-- storage units.
|
||||
|
||||
if Siz = 2 * System_Storage_Unit then
|
||||
Align := 2;
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2000-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2000-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2004-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 2004-2005, 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- --
|
||||
|
|
|
@ -40,12 +40,13 @@ with Unchecked_Conversion;
|
|||
package body System.Bit_Ops is
|
||||
|
||||
subtype Bits_Array is System.Unsigned_Types.Packed_Bytes1 (Positive);
|
||||
-- Constrained array used to interpret the address values. We use the
|
||||
-- Dummy array type used to interpret the address values. We use the
|
||||
-- unaligned version always, since this will handle both the aligned and
|
||||
-- unaligned cases, and we always do these operations by bytes anyway.
|
||||
-- Note: we use a ones origin array here so that the computations of the
|
||||
-- length in bytes work correctly (give a non-negative value) for the
|
||||
-- case of zero length bit strings).
|
||||
-- case of zero length bit strings). Note that we never allocate any
|
||||
-- objects of this type (we can't because they would be absurdly big).
|
||||
|
||||
type Bits is access Bits_Array;
|
||||
-- This is the actual type into which address values are converted
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1997-2005 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1997-2005, Free Software Foundation, Inc. --
|
||||
-- (Version for Alpha OpenVMS) --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
|
@ -58,14 +58,16 @@ package body System.Vax_Float_Operations is
|
|||
-- we define variables of the corresponding IEEE type so that they are
|
||||
-- passed and kept in the proper register class.
|
||||
|
||||
Debug_String_Buffer : String (1 .. 32);
|
||||
-- Buffer used by all Debug_String_x routines for returning result
|
||||
|
||||
------------
|
||||
-- D_To_G --
|
||||
------------
|
||||
|
||||
function D_To_G (X : D) return G is
|
||||
A, B : T;
|
||||
C : G;
|
||||
|
||||
C : G;
|
||||
begin
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), D'Asm_Input ("m", X));
|
||||
Asm ("cvtdg %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
|
||||
|
@ -80,7 +82,6 @@ package body System.Vax_Float_Operations is
|
|||
function F_To_G (X : F) return G is
|
||||
A : T;
|
||||
B : G;
|
||||
|
||||
begin
|
||||
Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X));
|
||||
Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
|
||||
|
@ -98,6 +99,7 @@ package body System.Vax_Float_Operations is
|
|||
begin
|
||||
-- Because converting to a wider FP format is a no-op, we say
|
||||
-- A is 64-bit even though we are loading 32 bits into it.
|
||||
|
||||
Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X));
|
||||
|
||||
B := S (Cvt_G_T (A));
|
||||
|
@ -110,8 +112,7 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function G_To_D (X : G) return D is
|
||||
A, B : T;
|
||||
C : D;
|
||||
|
||||
C : D;
|
||||
begin
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
|
||||
Asm ("cvtgd %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
|
||||
|
@ -127,7 +128,6 @@ package body System.Vax_Float_Operations is
|
|||
A : T;
|
||||
B : S;
|
||||
C : F;
|
||||
|
||||
begin
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
|
||||
Asm ("cvtgf %1,%0", S'Asm_Output ("=f", B), T'Asm_Input ("f", A));
|
||||
|
@ -142,7 +142,6 @@ package body System.Vax_Float_Operations is
|
|||
function G_To_Q (X : G) return Q is
|
||||
A : T;
|
||||
B : Q;
|
||||
|
||||
begin
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
|
||||
Asm ("cvtgq %1,%0", Q'Asm_Output ("=f", B), T'Asm_Input ("f", A));
|
||||
|
@ -155,7 +154,6 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function G_To_T (X : G) return T is
|
||||
A, B : T;
|
||||
|
||||
begin
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
|
||||
B := Cvt_G_T (A);
|
||||
|
@ -178,7 +176,6 @@ package body System.Vax_Float_Operations is
|
|||
function Q_To_F (X : Q) return F is
|
||||
A : S;
|
||||
B : F;
|
||||
|
||||
begin
|
||||
Asm ("cvtqf %1,%0", S'Asm_Output ("=f", A), Q'Asm_Input ("f", X));
|
||||
Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A));
|
||||
|
@ -192,7 +189,6 @@ package body System.Vax_Float_Operations is
|
|||
function Q_To_G (X : Q) return G is
|
||||
A : T;
|
||||
B : G;
|
||||
|
||||
begin
|
||||
Asm ("cvtqg %1,%0", T'Asm_Output ("=f", A), Q'Asm_Input ("f", X));
|
||||
Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
|
||||
|
@ -206,7 +202,6 @@ package body System.Vax_Float_Operations is
|
|||
function S_To_F (X : S) return F is
|
||||
A : S;
|
||||
B : F;
|
||||
|
||||
begin
|
||||
A := Cvt_T_F (T (X));
|
||||
Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A));
|
||||
|
@ -229,7 +224,6 @@ package body System.Vax_Float_Operations is
|
|||
function T_To_G (X : T) return G is
|
||||
A : T;
|
||||
B : G;
|
||||
|
||||
begin
|
||||
A := Cvt_T_G (X);
|
||||
Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
|
||||
|
@ -242,8 +236,7 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Abs_F (X : F) return F is
|
||||
A, B : S;
|
||||
C : F;
|
||||
|
||||
C : F;
|
||||
begin
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X));
|
||||
Asm ("cpys $f31,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A));
|
||||
|
@ -257,8 +250,7 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Abs_G (X : G) return G is
|
||||
A, B : T;
|
||||
C : G;
|
||||
|
||||
C : G;
|
||||
begin
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
|
||||
Asm ("cpys $f31,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
|
||||
|
@ -272,8 +264,7 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Add_F (X, Y : F) return F is
|
||||
X1, Y1, R : S;
|
||||
R1 : F;
|
||||
|
||||
R1 : F;
|
||||
begin
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
|
||||
|
@ -289,8 +280,7 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Add_G (X, Y : G) return G is
|
||||
X1, Y1, R : T;
|
||||
R1 : G;
|
||||
|
||||
R1 : G;
|
||||
begin
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
|
||||
|
@ -331,13 +321,9 @@ package body System.Vax_Float_Operations is
|
|||
-- Debug_String_D --
|
||||
--------------------
|
||||
|
||||
Debug_String_Buffer : String (1 .. 32);
|
||||
-- Buffer used by all Debug_String_x routines for returning result
|
||||
|
||||
function Debug_String_D (Arg : D) return System.Address is
|
||||
Image_String : constant String := D'Image (Arg) & ASCII.NUL;
|
||||
Image_String : constant String := D'Image (Arg) & ASCII.NUL;
|
||||
Image_Size : constant Integer := Image_String'Length;
|
||||
|
||||
begin
|
||||
Debug_String_Buffer (1 .. Image_Size) := Image_String;
|
||||
return Debug_String_Buffer (1)'Address;
|
||||
|
@ -348,9 +334,8 @@ package body System.Vax_Float_Operations is
|
|||
--------------------
|
||||
|
||||
function Debug_String_F (Arg : F) return System.Address is
|
||||
Image_String : constant String := F'Image (Arg) & ASCII.NUL;
|
||||
Image_String : constant String := F'Image (Arg) & ASCII.NUL;
|
||||
Image_Size : constant Integer := Image_String'Length;
|
||||
|
||||
begin
|
||||
Debug_String_Buffer (1 .. Image_Size) := Image_String;
|
||||
return Debug_String_Buffer (1)'Address;
|
||||
|
@ -361,9 +346,8 @@ package body System.Vax_Float_Operations is
|
|||
--------------------
|
||||
|
||||
function Debug_String_G (Arg : G) return System.Address is
|
||||
Image_String : constant String := G'Image (Arg) & ASCII.NUL;
|
||||
Image_String : constant String := G'Image (Arg) & ASCII.NUL;
|
||||
Image_Size : constant Integer := Image_String'Length;
|
||||
|
||||
begin
|
||||
Debug_String_Buffer (1 .. Image_Size) := Image_String;
|
||||
return Debug_String_Buffer (1)'Address;
|
||||
|
@ -375,8 +359,7 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Div_F (X, Y : F) return F is
|
||||
X1, Y1, R : S;
|
||||
|
||||
R1 : F;
|
||||
R1 : F;
|
||||
begin
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
|
||||
|
@ -392,8 +375,7 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Div_G (X, Y : G) return G is
|
||||
X1, Y1, R : T;
|
||||
R1 : G;
|
||||
|
||||
R1 : G;
|
||||
begin
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
|
||||
|
@ -409,7 +391,6 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Eq_F (X, Y : F) return Boolean is
|
||||
X1, Y1, R : S;
|
||||
|
||||
begin
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
|
||||
|
@ -424,7 +405,6 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Eq_G (X, Y : G) return Boolean is
|
||||
X1, Y1, R : T;
|
||||
|
||||
begin
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
|
||||
|
@ -439,7 +419,6 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Le_F (X, Y : F) return Boolean is
|
||||
X1, Y1, R : S;
|
||||
|
||||
begin
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
|
||||
|
@ -454,7 +433,6 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Le_G (X, Y : G) return Boolean is
|
||||
X1, Y1, R : T;
|
||||
|
||||
begin
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
|
||||
|
@ -469,7 +447,6 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Lt_F (X, Y : F) return Boolean is
|
||||
X1, Y1, R : S;
|
||||
|
||||
begin
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
|
||||
|
@ -484,7 +461,6 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Lt_G (X, Y : G) return Boolean is
|
||||
X1, Y1, R : T;
|
||||
|
||||
begin
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
|
||||
|
@ -499,8 +475,7 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Mul_F (X, Y : F) return F is
|
||||
X1, Y1, R : S;
|
||||
R1 : F;
|
||||
|
||||
R1 : F;
|
||||
begin
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
|
||||
|
@ -516,8 +491,7 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Mul_G (X, Y : G) return G is
|
||||
X1, Y1, R : T;
|
||||
R1 : G;
|
||||
|
||||
R1 : G;
|
||||
begin
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
|
||||
|
@ -527,14 +501,41 @@ package body System.Vax_Float_Operations is
|
|||
return R1;
|
||||
end Mul_G;
|
||||
|
||||
----------
|
||||
-- Ne_F --
|
||||
----------
|
||||
|
||||
function Ne_F (X, Y : F) return Boolean is
|
||||
X1, Y1, R : S;
|
||||
begin
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y));
|
||||
Asm ("cmpgeq %1,%2,%0", S'Asm_Output ("=f", R),
|
||||
(S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1)));
|
||||
return R = 0.0;
|
||||
end Ne_F;
|
||||
|
||||
----------
|
||||
-- Ne_G --
|
||||
----------
|
||||
|
||||
function Ne_G (X, Y : G) return Boolean is
|
||||
X1, Y1, R : T;
|
||||
begin
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
|
||||
Asm ("cmpgeq %1,%2,%0", T'Asm_Output ("=f", R),
|
||||
(T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1)));
|
||||
return R = 0.0;
|
||||
end Ne_G;
|
||||
|
||||
-----------
|
||||
-- Neg_F --
|
||||
-----------
|
||||
|
||||
function Neg_F (X : F) return F is
|
||||
A, B : S;
|
||||
C : F;
|
||||
|
||||
C : F;
|
||||
begin
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X));
|
||||
Asm ("cpysn %1,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A));
|
||||
|
@ -548,8 +549,7 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Neg_G (X : G) return G is
|
||||
A, B : T;
|
||||
C : G;
|
||||
|
||||
C : G;
|
||||
begin
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
|
||||
Asm ("cpysn %1,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A));
|
||||
|
@ -590,7 +590,7 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Sub_F (X, Y : F) return F is
|
||||
X1, Y1, R : S;
|
||||
R1 : F;
|
||||
R1 : F;
|
||||
|
||||
begin
|
||||
Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X));
|
||||
|
@ -607,8 +607,7 @@ package body System.Vax_Float_Operations is
|
|||
|
||||
function Sub_G (X, Y : G) return G is
|
||||
X1, Y1, R : T;
|
||||
R1 : G;
|
||||
|
||||
R1 : G;
|
||||
begin
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X));
|
||||
Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y));
|
||||
|
|
|
@ -171,7 +171,7 @@ package System.WCh_Con is
|
|||
|
||||
subtype WC_ESC_Encoding_Method is
|
||||
WC_Encoding_Method range WCEM_Hex .. WCEM_Hex;
|
||||
-- Encoding methods using an ESC character at the start of the sequence.
|
||||
-- Encoding methods using an ESC character at the start of the sequence
|
||||
|
||||
subtype WC_Upper_Half_Encoding_Method is
|
||||
WC_Encoding_Method range WCEM_Upper .. WCEM_UTF8;
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1992-1999 Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2005, 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- --
|
||||
|
@ -24,15 +24,15 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
-- This package contains functions that return the default values for the
|
||||
-- include and object file directories, target name, default library
|
||||
-- subdirectory (libsubdir) prefix, and the target OS.
|
||||
|
||||
with Types; use Types;
|
||||
|
||||
package Sdefault is
|
||||
|
||||
-- This package contains functions that return the default values for
|
||||
-- the include and object file directories, target name, and the default
|
||||
-- library subdirectory (libsubdir) prefix.
|
||||
|
||||
function Include_Dir_Default_Name return String_Ptr;
|
||||
function Object_Dir_Default_Name return String_Ptr;
|
||||
function Target_Name return String_Ptr;
|
||||
function Search_Dir_Prefix return String_Ptr;
|
||||
function Object_Dir_Default_Name return String_Ptr;
|
||||
function Target_Name return String_Ptr;
|
||||
function Search_Dir_Prefix return String_Ptr;
|
||||
end Sdefault;
|
||||
|
|
|
@ -777,7 +777,7 @@ package body Sem_Ch10 is
|
|||
declare
|
||||
Save_Style_Check : constant Boolean := Style_Check;
|
||||
Save_Warning : constant Warning_Mode_Type := Warning_Mode;
|
||||
Options : Style_Check_Options;
|
||||
Options : Style_Check_Options;
|
||||
|
||||
begin
|
||||
Save_Style_Check_Options (Options);
|
||||
|
|
|
@ -25,14 +25,14 @@
|
|||
------------------------------------------------------------------------------
|
||||
|
||||
-- This package contains various subprograms involved in compile time
|
||||
-- evaluation of expressions and checks for staticness of expressions
|
||||
-- and types. It also contains the circuitry for checking for violations
|
||||
-- of pure and preelaborated conditions (this naturally goes here, since
|
||||
-- these rules involve consideration of staticness).
|
||||
-- evaluation of expressions and checks for staticness of expressions and
|
||||
-- types. It also contains the circuitry for checking for violations of pure
|
||||
-- and preelaborated conditions (this naturally goes here, since these rules
|
||||
-- involve consideration of staticness).
|
||||
|
||||
-- Note: the static evaluation for attributes is found in Sem_Attr even
|
||||
-- though logically it belongs here. We have done this so that it is easier
|
||||
-- to add new attributes to GNAT.
|
||||
-- Note: the static evaluation for attributes is found in Sem_Attr even though
|
||||
-- logically it belongs here. We have done this so that it is easier to add
|
||||
-- new attributes to GNAT.
|
||||
|
||||
with Types; use Types;
|
||||
with Uintp; use Uintp;
|
||||
|
@ -45,66 +45,64 @@ package Sem_Eval is
|
|||
------------------------------------
|
||||
|
||||
-- This package contains a set of routine that process individual
|
||||
-- subexpression nodes with the objective of folding (precomputing)
|
||||
-- the value of static expressions that are known at compile time and
|
||||
-- properly computing the setting of two flags that appear in every
|
||||
-- subexpression node:
|
||||
-- subexpression nodes with the objective of folding (precomputing) the
|
||||
-- value of static expressions that are known at compile time and properly
|
||||
-- computing the setting of two flags that appear in every subexpression
|
||||
-- node:
|
||||
|
||||
-- Is_Static_Expression
|
||||
|
||||
-- This flag is set on any expression that is static according
|
||||
-- to the rules in (RM 4.9(3-32)).
|
||||
-- This flag is set on any expression that is static according to the
|
||||
-- rules in (RM 4.9(3-32)).
|
||||
|
||||
-- Raises_Constraint_Error
|
||||
|
||||
-- This flag indicatest that it is known at compile time that the
|
||||
-- evaluation of an expression raises constraint error. If the
|
||||
-- expression is static, and this flag is off, then it is also known
|
||||
-- at compile time that the expression does not raise constraint error
|
||||
-- expression is static, and this flag is off, then it is also known at
|
||||
-- compile time that the expression does not raise constraint error
|
||||
-- (i.e. the flag is accurate for static expressions, and conservative
|
||||
-- for non-static expressions.
|
||||
|
||||
-- If a static expression does not raise constraint error, then the
|
||||
-- Raises_Constraint_Error flag is off, and the expression must be
|
||||
-- computed at compile time, which means that it has the form of either
|
||||
-- a literal, or a constant that is itself (recursively) either a literal
|
||||
-- or a constant.
|
||||
-- Raises_Constraint_Error flag is off, and the expression must be computed
|
||||
-- at compile time, which means that it has the form of either a literal,
|
||||
-- or a constant that is itself (recursively) either a literal or a
|
||||
-- constant.
|
||||
|
||||
-- The above rules must be followed exactly in order for legality
|
||||
-- checks to be accurate. For subexpressions that are not static
|
||||
-- according to the RM definition, they are sometimes folded anyway,
|
||||
-- but of course in this case Is_Static_Expression is not set.
|
||||
-- The above rules must be followed exactly in order for legality checks to
|
||||
-- be accurate. For subexpressions that are not static according to the RM
|
||||
-- definition, they are sometimes folded anyway, but of course in this case
|
||||
-- Is_Static_Expression is not set.
|
||||
|
||||
-------------------------------
|
||||
-- Compile-Time Known Values --
|
||||
-------------------------------
|
||||
|
||||
-- For most legality checking purposes the flag Is_Static_Expression
|
||||
-- defined in Sinfo should be used. This package also provides
|
||||
-- a routine called Is_OK_Static_Expression which in addition of
|
||||
-- checking that an expression is static in the RM 4.9 sense, it
|
||||
-- checks that the expression does not raise constraint error. In
|
||||
-- fact for certain legality checks not only do we need to ascertain
|
||||
-- that the expression is static, but we must also ensure that it
|
||||
-- does not raise constraint error.
|
||||
-- defined in Sinfo should be used. This package also provides a routine
|
||||
-- called Is_OK_Static_Expression which in addition of checking that an
|
||||
-- expression is static in the RM 4.9 sense, it checks that the expression
|
||||
-- does not raise constraint error. In fact for certain legality checks not
|
||||
-- only do we need to ascertain that the expression is static, but we must
|
||||
-- also ensure that it does not raise constraint error.
|
||||
--
|
||||
-- Neither of Is_Static_Expression and Is_OK_Static_Expression should
|
||||
-- be used for compile time evaluation purposes. In fact certain
|
||||
-- expression whose value is known at compile time are not static
|
||||
-- in the RM 4.9 sense. A typical example is:
|
||||
-- Neither of Is_Static_Expression and Is_OK_Static_Expression should be
|
||||
-- used for compile time evaluation purposes. In fact certain expression
|
||||
-- whose value is known at compile time are not static in the RM 4.9 sense.
|
||||
-- A typical example is:
|
||||
--
|
||||
-- C : constant Integer := Record_Type'Size;
|
||||
--
|
||||
-- The expression 'C' is not static in the technical RM sense, but for
|
||||
-- many simple record types, the size is in fact known at compile time.
|
||||
-- When we are trying to perform compile time constant folding (for
|
||||
-- instance for expressions such as 'C + 1', Is_Static_Expression or
|
||||
-- Is_OK_Static_Expression are not the right functions to test to see
|
||||
-- if folding is possible. Instead, we use Compile_Time_Known_Value.
|
||||
-- All static expressions that do not raise constraint error (i.e.
|
||||
-- those for which Is_OK_Static_Expression is true) are known at
|
||||
-- compile time, but as shown by the above example, there are cases
|
||||
-- of non-static expressions which are known at compile time.
|
||||
-- The expression 'C' is not static in the technical RM sense, but for many
|
||||
-- simple record types, the size is in fact known at compile time. When we
|
||||
-- are trying to perform compile time constant folding (for instance for
|
||||
-- expressions like C + 1, Is_Static_Expression or Is_OK_Static_Expression
|
||||
-- are not the right functions to test if folding is possible. Instead, we
|
||||
-- use Compile_Time_Known_Value. All static expressions that do not raise
|
||||
-- constraint error (i.e. those for which Is_OK_Static_Expression is true)
|
||||
-- are known at compile time, but as shown by the above example, there are
|
||||
-- cases of non-static expressions which are known at compile time.
|
||||
|
||||
-----------------
|
||||
-- Subprograms --
|
||||
|
@ -114,17 +112,17 @@ package Sem_Eval is
|
|||
-- Deals with the special check required for a static expression that
|
||||
-- appears in a non-static context, i.e. is not part of a larger static
|
||||
-- expression (see RM 4.9(35)), i.e. the value of the expression must be
|
||||
-- within the base range of the base type of its expected type. A check
|
||||
-- is also made for expressions that are inside the base range, but
|
||||
-- outside the range of the expected subtype (this is a warning message
|
||||
-- rather than an illegality).
|
||||
-- within the base range of the base type of its expected type. A check is
|
||||
-- also made for expressions that are inside the base range, but outside
|
||||
-- the range of the expected subtype (this is a warning message rather than
|
||||
-- an illegality).
|
||||
--
|
||||
-- Note: most cases of non-static context checks are handled within
|
||||
-- Sem_Eval itself, including all cases of expressions at the outer
|
||||
-- level (i.e. those that are not a subexpression). Currently the only
|
||||
-- outside customer for this procedure is Sem_Attr (because Eval_Attribute
|
||||
-- is there). There is also one special case arising from ranges (see body
|
||||
-- of Resolve_Range).
|
||||
-- Sem_Eval itself, including all cases of expressions at the outer level
|
||||
-- (i.e. those that are not a subexpression). Currently the only outside
|
||||
-- customer for this procedure is Sem_Attr (because Eval_Attribute is
|
||||
-- there). There is also one special case arising from ranges (see body of
|
||||
-- Resolve_Range).
|
||||
|
||||
procedure Check_String_Literal_Length (N : Node_Id; Ttype : Entity_Id);
|
||||
-- N is either a string literal, or a constraint error node. In the latter
|
||||
|
@ -138,48 +136,47 @@ package Sem_Eval is
|
|||
function Compile_Time_Compare
|
||||
(L, R : Node_Id;
|
||||
Rec : Boolean := False) return Compare_Result;
|
||||
-- Given two expression nodes, finds out whether it can be determined
|
||||
-- at compile time how the runtime values will compare. An Unknown
|
||||
-- result means that the result of a comparison cannot be determined at
|
||||
-- compile time, otherwise the returned result indicates the known result
|
||||
-- of the comparison, given as tightly as possible (i.e. EQ or LT is a
|
||||
-- preferred returned value to LE). Rec is a parameter that is set True
|
||||
-- for a recursive call from within Compile_Time_Compare to avoid some
|
||||
-- infinite recursion cases. It should never be set by a client.
|
||||
-- Given two expression nodes, finds out whether it can be determined at
|
||||
-- compile time how the runtime values will compare. An Unknown result
|
||||
-- means that the result of a comparison cannot be determined at compile
|
||||
-- time, otherwise the returned result indicates the known result of the
|
||||
-- comparison, given as tightly as possible (i.e. EQ or LT is preferred
|
||||
-- returned value to LE). Rec is a parameter that is set True for a
|
||||
-- recursive call from within Compile_Time_Compare to avoid some infinite
|
||||
-- recursion cases. It should never be set by a client.
|
||||
|
||||
procedure Flag_Non_Static_Expr (Msg : String; Expr : Node_Id);
|
||||
-- This procedure is called after it has been determined that Expr is
|
||||
-- not static when it is required to be. Msg is the text of a message
|
||||
-- that explains the error. This procedure checks if an error is already
|
||||
-- posted on Expr, if so, it does nothing unless All_Errors_Mode is set
|
||||
-- in which case this flag is ignored. Otherwise the given message is
|
||||
-- posted using Error_Msg_F, and then Why_Not_Static is called on
|
||||
-- Expr to generate additional messages. The string given as Msg
|
||||
-- should end with ! to make it an unconditional message, to ensure
|
||||
-- that if it is posted, the entire set of messages is all posted.
|
||||
-- This procedure is called after it has been determined that Expr is not
|
||||
-- static when it is required to be. Msg is the text of a message that
|
||||
-- explains the error. This procedure checks if an error is already posted
|
||||
-- on Expr, if so, it does nothing unless All_Errors_Mode is set in which
|
||||
-- case this flag is ignored. Otherwise the given message is posted using
|
||||
-- Error_Msg_F, and then Why_Not_Static is called on Expr to generate
|
||||
-- additional messages. The string given as Msg should end with ! to make
|
||||
-- it an unconditional message, to ensure that if it is posted, the entire
|
||||
-- set of messages is all posted.
|
||||
|
||||
function Is_OK_Static_Expression (N : Node_Id) return Boolean;
|
||||
-- An OK static expression is one that is static in the RM definition
|
||||
-- sense and which does not raise constraint error. For most legality
|
||||
-- checking purposes you should use Is_Static_Expression. For those
|
||||
-- legality checks where the expression N should not raise constaint
|
||||
-- error use this routine. This routine is *not* to be used in contexts
|
||||
-- where the test is for compile time evaluation purposes. Use routine
|
||||
-- Compile_Time_Known_Value instead (see section on "Compile-Time Known
|
||||
-- Values" above).
|
||||
-- An OK static expression is one that is static in the RM definition sense
|
||||
-- and which does not raise constraint error. For most legality checking
|
||||
-- purposes you should use Is_Static_Expression. For those legality checks
|
||||
-- where the expression N should not raise constaint error use this
|
||||
-- routine. This routine is *not* to be used in contexts where the test is
|
||||
-- for compile time evaluation purposes. Use Compile_Time_Known_Value
|
||||
-- instead (see section on "Compile-Time Known Values" above).
|
||||
|
||||
function Is_Static_Range (N : Node_Id) return Boolean;
|
||||
-- Determine if range is static, as defined in RM 4.9(26). The only
|
||||
-- allowed argument is an N_Range node (but note that the semantic
|
||||
-- analysis of equivalent range attribute references already turned
|
||||
-- them into the equivalent range).
|
||||
-- Determine if range is static, as defined in RM 4.9(26). The only allowed
|
||||
-- argument is an N_Range node (but note that the semantic analysis of
|
||||
-- equivalent range attribute references already turned them into the
|
||||
-- equivalent range).
|
||||
|
||||
function Is_OK_Static_Range (N : Node_Id) return Boolean;
|
||||
-- Like Is_Static_Range, but also makes sure that the bounds of the
|
||||
-- range are compile-time evaluable (i.e. do not raise constraint error).
|
||||
-- A result of true means that the bounds are compile time evaluable.
|
||||
-- A result of false means they are not (either because the range is
|
||||
-- not static, or because one or the other bound raises CE).
|
||||
-- Like Is_Static_Range, but also makes sure that the bounds of the range
|
||||
-- are compile-time evaluable (i.e. do not raise constraint error). A
|
||||
-- result of true means that the bounds are compile time evaluable. A
|
||||
-- result of false means they are not (either because the range is not
|
||||
-- static, or because one or the other bound raises CE).
|
||||
|
||||
function Is_Static_Subtype (Typ : Entity_Id) return Boolean;
|
||||
-- Determines whether a subtype fits the definition of an Ada static
|
||||
|
@ -187,10 +184,10 @@ package Sem_Eval is
|
|||
|
||||
function Is_OK_Static_Subtype (Typ : Entity_Id) return Boolean;
|
||||
-- Like Is_Static_Subtype but also makes sure that the bounds of the
|
||||
-- subtype are compile-time evaluable (i.e. do not raise constraint
|
||||
-- error). A result of true means that the bounds are compile time
|
||||
-- evaluable. A result of false means they are not (either because the
|
||||
-- range is not static, or because one or the other bound raises CE).
|
||||
-- subtype are compile-time evaluable (i.e. do not raise constraint error).
|
||||
-- A result of true means that the bounds are compile time evaluable. A
|
||||
-- result of false means they are not (either because the range is not
|
||||
-- static, or because one or the other bound raises CE).
|
||||
|
||||
function Subtypes_Statically_Compatible
|
||||
(T1 : Entity_Id;
|
||||
|
@ -204,52 +201,49 @@ package Sem_Eval is
|
|||
-- are statically matching subtypes (RM 4.9.1(1-2)).
|
||||
|
||||
function Compile_Time_Known_Value (Op : Node_Id) return Boolean;
|
||||
-- Returns true if Op is an expression not raising constraint error
|
||||
-- whose value is known at compile time. This is true if Op is a static
|
||||
-- expression, but can also be true for expressions which are
|
||||
-- technically non-static but which are in fact known at compile time,
|
||||
-- such as the static lower bound of a non-static range or the value
|
||||
-- of a constant object whose initial value is static. Note that this
|
||||
-- routine is defended against unanalyzed expressions. Such expressions
|
||||
-- will not cause a blowup, they may cause pessimistic (i.e. False)
|
||||
-- results to be returned.
|
||||
-- Returns true if Op is an expression not raising constraint error whose
|
||||
-- value is known at compile time. This is true if Op is a static
|
||||
-- expression, but can also be true for expressions which are technically
|
||||
-- non-static but which are in fact known at compile time, such as the
|
||||
-- static lower bound of a non-static range or the value of a constant
|
||||
-- object whose initial value is static. Note that this routine is defended
|
||||
-- against unanalyzed expressions. Such expressions will not cause a
|
||||
-- blowup, they may cause pessimistic (i.e. False) results to be returned.
|
||||
|
||||
function Compile_Time_Known_Value_Or_Aggr (Op : Node_Id) return Boolean;
|
||||
-- Similar to Compile_Time_Known_Value, but also returns True if the
|
||||
-- value is a compile time known aggregate, i.e. an aggregate all of
|
||||
-- whose constituent expressions are either compile time known values
|
||||
-- or compile time known aggregates.
|
||||
-- Similar to Compile_Time_Known_Value, but also returns True if the value
|
||||
-- is a compile time known aggregate, i.e. an aggregate all of whose
|
||||
-- constituent expressions are either compile time known values or compile
|
||||
-- time known aggregates.
|
||||
|
||||
function Compile_Time_Known_Bounds (T : Entity_Id) return Boolean;
|
||||
-- If T is an array whose index bounds are all known at compile time,
|
||||
-- then True is returned, if T is not an array, or one or more of its
|
||||
-- index bounds is not known at compile time, then False is returned.
|
||||
-- If T is an array whose index bounds are all known at compile time, then
|
||||
-- True is returned, if T is not an array, or one or more of its index
|
||||
-- bounds is not known at compile time, then False is returned.
|
||||
|
||||
function Expr_Value (N : Node_Id) return Uint;
|
||||
-- Returns the folded value of the expression N. This function is called
|
||||
-- in instances where it has already been determined that the expression
|
||||
-- is static or its value is known at compile time (ie the call to
|
||||
-- Compile_Time_Known_Value (N) returns True). This version is used for
|
||||
-- integer values, and enumeration or character literals. In the latter
|
||||
-- two cases, the value returned is the Pos value in the relevant
|
||||
-- enumeration type. It can also be used for fixed-point values, in
|
||||
-- which case it returns the corresponding integer value. It cannot be
|
||||
-- used for floating-point values.
|
||||
-- Returns the folded value of the expression N. This function is called in
|
||||
-- instances where it has already been determined that the expression is
|
||||
-- static or its value is compile time known (Compile_Time_Known_Value (N)
|
||||
-- returns True). This version is used for integer values, and enumeration
|
||||
-- or character literals. In the latter two cases, the value returned is
|
||||
-- the Pos value in the relevant enumeration type. It can also be used for
|
||||
-- fixed-point values, in which case it returns the corresponding integer
|
||||
-- value. It cannot be used for floating-point values.
|
||||
|
||||
function Expr_Value_E (N : Node_Id) return Entity_Id;
|
||||
-- Returns the folded value of the expression. This function is called
|
||||
-- in instances where it has already been determined that the expression
|
||||
-- is static or its value known at compile time. This version is used
|
||||
-- for enumeration types and returns the corresponding enumeration
|
||||
-- literal.
|
||||
-- Returns the folded value of the expression. This function is called in
|
||||
-- instances where it has already been determined that the expression is
|
||||
-- static or its value known at compile time. This version is used for
|
||||
-- enumeration types and returns the corresponding enumeration literal.
|
||||
|
||||
function Expr_Value_R (N : Node_Id) return Ureal;
|
||||
-- Returns the folded value of the expression. This function is called
|
||||
-- in instances where it has already been determined that the expression
|
||||
-- is static or its value known at compile time. This version is used
|
||||
-- for real values (including both the floating-point and fixed-point
|
||||
-- cases). In the case of a fixed-point type, the real value is returned
|
||||
-- (cf above version returning Uint).
|
||||
-- Returns the folded value of the expression. This function is called in
|
||||
-- instances where it has already been determined that the expression is
|
||||
-- static or its value known at compile time. This version is used for real
|
||||
-- values (including both the floating-point and fixed-point cases). In the
|
||||
-- case of a fixed-point type, the real value is returned (cf above version
|
||||
-- returning Uint).
|
||||
|
||||
function Expr_Value_S (N : Node_Id) return Node_Id;
|
||||
-- Returns the folded value of the expression. This function is called
|
||||
|
@ -261,12 +255,12 @@ package Sem_Eval is
|
|||
-- This is identical to Expr_Value, except in the case of enumeration
|
||||
-- literals of types for which an enumeration representation clause has
|
||||
-- been given, in which case it returns the representation value rather
|
||||
-- than the pos value. This is the value that is needed for generating
|
||||
-- code sequences, while the Expr_Value value is appropriate for compile
|
||||
-- time constraint errors or getting the logical value. Note that this
|
||||
-- function does NOT concern itself with biased values, if the caller
|
||||
-- needs a properly biased value, the subtraction of the bias must be
|
||||
-- handled explicitly.
|
||||
-- than the pos value. This is the value that is needed for generating code
|
||||
-- sequences, while the Expr_Value value is appropriate for compile time
|
||||
-- constraint errors or getting the logical value. Note that this function
|
||||
-- does NOT concern itself with biased values, if the caller needs a
|
||||
-- properly biased value, the subtraction of the bias must be handled
|
||||
-- explicitly.
|
||||
|
||||
procedure Eval_Actual (N : Node_Id);
|
||||
procedure Eval_Allocator (N : Node_Id);
|
||||
|
@ -296,58 +290,56 @@ package Sem_Eval is
|
|||
procedure Eval_Unchecked_Conversion (N : Node_Id);
|
||||
|
||||
procedure Fold_Str (N : Node_Id; Val : String_Id; Static : Boolean);
|
||||
-- Rewrite N with a new N_String_Literal node as the result of the
|
||||
-- compile time evaluation of the node N. Val is the resulting string
|
||||
-- value from the folding operation. The Is_Static_Expression flag is
|
||||
-- set in the result node. The result is fully analyzed and resolved.
|
||||
-- Static indicates whether the result should be considered static or
|
||||
-- not (True = consider static). The point here is that normally all
|
||||
-- string literals are static, but if this was the result of some
|
||||
-- sequence of evaluation where values were known at compile time
|
||||
-- but not static, then the result is not static.
|
||||
-- Rewrite N with a new N_String_Literal node as the result of the compile
|
||||
-- time evaluation of the node N. Val is the resulting string value from
|
||||
-- the folding operation. The Is_Static_Expression flag is set in the
|
||||
-- result node. The result is fully analyzed and resolved. Static indicates
|
||||
-- whether the result should be considered static or not (True = consider
|
||||
-- static). The point here is that normally all string literals are static,
|
||||
-- but if this was the result of some sequence of evaluation where values
|
||||
-- were known at compile time but not static, then the result is not
|
||||
-- static.
|
||||
|
||||
procedure Fold_Uint (N : Node_Id; Val : Uint; Static : Boolean);
|
||||
-- Rewrite N with a (N_Integer_Literal, N_Identifier, N_Character_Literal)
|
||||
-- node as the result of the compile time evaluation of the node N. Val
|
||||
-- is the result in the integer case and is the position of the literal
|
||||
-- in the literals list for the enumeration case. Is_Static_Expression
|
||||
-- is set True in the result node. The result is fully analyzed/resolved.
|
||||
-- Static indicates whether the result should be considered static or
|
||||
-- not (True = consider static). The point here is that normally all
|
||||
-- string literals are static, but if this was the result of some
|
||||
-- sequence of evaluation where values were known at compile time
|
||||
-- but not static, then the result is not static.
|
||||
-- node as the result of the compile time evaluation of the node N. Val is
|
||||
-- the result in the integer case and is the position of the literal in the
|
||||
-- literals list for the enumeration case. Is_Static_Expression is set True
|
||||
-- in the result node. The result is fully analyzed/resolved. Static
|
||||
-- indicates whether the result should be considered static or not (True =
|
||||
-- consider static). The point here is that normally all string literals
|
||||
-- are static, but if this was the result of some sequence of evaluation
|
||||
-- where values were known at compile time but not static, then the result
|
||||
-- is not static.
|
||||
|
||||
procedure Fold_Ureal (N : Node_Id; Val : Ureal; Static : Boolean);
|
||||
-- Rewrite N with a new N_Real_Literal node as the result of the compile
|
||||
-- time evaluation of the node N. Val is the resulting real value from
|
||||
-- the folding operation. The Is_Static_Expression flag is set in the
|
||||
-- result node. The result is fully analyzed and result. Static
|
||||
-- indicates whether the result should be considered static or not
|
||||
-- (True = consider static). The point here is that normally all
|
||||
-- string literals are static, but if this was the result of some
|
||||
-- sequence of evaluation where values were known at compile time
|
||||
-- but not static, then the result is not static.
|
||||
-- time evaluation of the node N. Val is the resulting real value from the
|
||||
-- folding operation. The Is_Static_Expression flag is set in the result
|
||||
-- node. The result is fully analyzed and result. Static indicates whether
|
||||
-- the result should be considered static or not (True = consider static).
|
||||
-- The point here is that normally all string literals are static, but if
|
||||
-- this was the result of some sequence of evaluation where values were
|
||||
-- known at compile time but not static, then the result is not static.
|
||||
|
||||
function Is_In_Range
|
||||
(N : Node_Id;
|
||||
Typ : Entity_Id;
|
||||
Fixed_Int : Boolean := False;
|
||||
Int_Real : Boolean := False) return Boolean;
|
||||
-- Returns True if it can be guaranteed at compile time that expression
|
||||
-- N is known to be in range of the subtype Typ. If the values of N or
|
||||
-- of either bouds of Type are unknown at compile time, False will
|
||||
-- always be returned. A result of False does not mean that the
|
||||
-- expression is out of range, merely that it cannot be determined at
|
||||
-- compile time that it is in range. If Typ is a floating point type or
|
||||
-- Int_Real is set, any integer value is treated as though it was a real
|
||||
-- value (i.e. the underlying real value is used). In this case we use
|
||||
-- the corresponding real value, both for the bounds of Typ, and for the
|
||||
-- value of the expression N. If Typ is a fixed type or a discrete type
|
||||
-- and Int_Real is False but flag Fixed_Int is True then any fixed-point
|
||||
-- value is treated as though it was a discrete value (i.e. the
|
||||
-- underlying integer value is used). In this case we use the
|
||||
-- corresponding integer value, both for the bounds of Typ, and for the
|
||||
-- Returns True if it can be guaranteed at compile time that expression is
|
||||
-- known to be in range of the subtype Typ. If the values of N or of either
|
||||
-- bouds of Type are unknown at compile time, False will always be
|
||||
-- returned. A result of False does not mean that the expression is out of
|
||||
-- range, merely that it cannot be determined at compile time that it is in
|
||||
-- range. If Typ is a floating point type or Int_Real is set, any integer
|
||||
-- value is treated as though it was a real value (i.e. the underlying real
|
||||
-- value is used). In this case we use the corresponding real value, both
|
||||
-- for the bounds of Typ, and for the value of the expression N. If Typ is
|
||||
-- a fixed type or a discrete type and Int_Real is False but flag Fixed_Int
|
||||
-- is True then any fixed-point value is treated as though it was discrete
|
||||
-- value (i.e. the underlying integer value is used). In this case we use
|
||||
-- the corresponding integer value, both for the bounds of Typ, and for the
|
||||
-- value of the expression N. If Typ is a discret type and Fixed_Int as
|
||||
-- well as Int_Real are false, intere values are used throughout.
|
||||
|
||||
|
@ -356,52 +348,52 @@ package Sem_Eval is
|
|||
Typ : Entity_Id;
|
||||
Fixed_Int : Boolean := False;
|
||||
Int_Real : Boolean := False) return Boolean;
|
||||
-- Returns True if it can be guaranteed at compile time that expression
|
||||
-- N is known to be out of range of the subtype Typ. True is returned
|
||||
-- if Typ is a scalar type, at least one of whose bounds is known at
|
||||
-- compile time, and N is a compile time known expression which can be
|
||||
-- determined to be outside a compile_time known bound of Typ. A result
|
||||
-- of False does not mean that the expression is in range, merely that
|
||||
-- it cannot be determined at compile time that it is out of range. Flags
|
||||
-- Int_Real and Fixed_Int are used as in routine Is_In_Range above.
|
||||
-- Returns True if it can be guaranteed at compile time that expression is
|
||||
-- known to be out of range of the subtype Typ. True is returned if Typ is
|
||||
-- a scalar type, at least one of whose bounds is known at compile time,
|
||||
-- and N is a compile time known expression which can be determined to be
|
||||
-- outside a compile_time known bound of Typ. A result of False does not
|
||||
-- mean that the expression is in range, but rather merely that it cannot
|
||||
-- be determined at compile time that it is out of range. Flags Int_Real
|
||||
-- and Fixed_Int are used as in routine Is_In_Range above.
|
||||
|
||||
function In_Subrange_Of
|
||||
(T1 : Entity_Id;
|
||||
T2 : Entity_Id;
|
||||
Fixed_Int : Boolean := False) return Boolean;
|
||||
-- Returns True if it can be guaranteed at compile time that the range
|
||||
-- of values for scalar type T1 are always in the range of scalar type
|
||||
-- T2. A result of False does not mean that T1 is not in T2's subrange,
|
||||
-- only that it cannot be determined at compile time. Flag Fixed_Int is
|
||||
-- used as in routine Is_In_Range above.
|
||||
-- Returns True if it can be guaranteed at compile time that the range of
|
||||
-- values for scalar type T1 are always in the range of scalar type T2. A
|
||||
-- result of False does not mean that T1 is not in T2's subrange, only that
|
||||
-- it cannot be determined at compile time. Flag Fixed_Int is used as in
|
||||
-- routine Is_In_Range above.
|
||||
|
||||
function Is_Null_Range (Lo : Node_Id; Hi : Node_Id) return Boolean;
|
||||
-- Returns True if it can guarantee that Lo .. Hi is a null range.
|
||||
-- If it cannot (because the value of Lo or Hi is not known at compile
|
||||
-- time) then it returns False.
|
||||
-- Returns True if it can guarantee that Lo .. Hi is a null range. If it
|
||||
-- cannot (because the value of Lo or Hi is not known at compile time) then
|
||||
-- it returns False.
|
||||
|
||||
function Not_Null_Range (Lo : Node_Id; Hi : Node_Id) return Boolean;
|
||||
-- Returns True if it can guarantee that Lo .. Hi is not a null range.
|
||||
-- If it cannot (because the value of Lo or Hi is not known at compile
|
||||
-- time) then it returns False.
|
||||
-- Returns True if it can guarantee that Lo .. Hi is not a null range. If
|
||||
-- it cannot (because the value of Lo or Hi is not known at compile time)
|
||||
-- then it returns False.
|
||||
|
||||
procedure Why_Not_Static (Expr : Node_Id);
|
||||
-- This procedure may be called after generating an error message that
|
||||
-- complains that something is non-static. If it finds good reasons,
|
||||
-- it generates one or more error messages pointing the appropriate
|
||||
-- offending component of the expression. If no good reasons can be
|
||||
-- figured out, then no messages are generated. The expectation here
|
||||
-- is that the caller has already issued a message complaining that
|
||||
-- the expression is non-static. Note that this message should be
|
||||
-- placed using Error_Msg_F or Error_Msg_FE, so that it will sort
|
||||
-- before any messages placed by this call. Note that it is fine to
|
||||
-- call Why_Not_Static with something that is not an expression, and
|
||||
-- usually this has no effect, but in some cases (N_Parameter_Association
|
||||
-- or N_Range), it makes sense for the internal recursive calls.
|
||||
-- complains that something is non-static. If it finds good reasons, it
|
||||
-- generates one or more error messages pointing the appropriate offending
|
||||
-- component of the expression. If no good reasons can be figured out, then
|
||||
-- no messages are generated. The expectation here is that the caller has
|
||||
-- already issued a message complaining that the expression is non-static.
|
||||
-- Note that this message should be placed using Error_Msg_F or
|
||||
-- Error_Msg_FE, so that it will sort before any messages placed by this
|
||||
-- call. Note that it is fine to call Why_Not_Static with something that is
|
||||
-- not an expression, and usually this has no effect, but in some cases
|
||||
-- (N_Parameter_Association or N_Range), it makes sense for the internal
|
||||
-- recursive calls.
|
||||
|
||||
procedure Initialize;
|
||||
-- Initializes the internal data structures. Must be called before
|
||||
-- each separate main program unit (e.g. in a GNSA/ASIS context).
|
||||
-- Initializes the internal data structures. Must be called before each
|
||||
-- separate main program unit (e.g. in a GNSA/ASIS context).
|
||||
|
||||
private
|
||||
-- The Eval routines are all marked inline, since they are called once
|
||||
|
|
|
@ -3094,9 +3094,10 @@ remove_conversions (tree exp, bool true_address)
|
|||
if (true_address
|
||||
&& TREE_CODE (TREE_TYPE (exp)) == RECORD_TYPE
|
||||
&& TYPE_JUSTIFIED_MODULAR_P (TREE_TYPE (exp)))
|
||||
return remove_conversions (VEC_index (constructor_elt,
|
||||
CONSTRUCTOR_ELTS (exp), 0)->value,
|
||||
true);
|
||||
return
|
||||
remove_conversions (VEC_index (constructor_elt,
|
||||
CONSTRUCTOR_ELTS (exp), 0)->value,
|
||||
true);
|
||||
break;
|
||||
|
||||
case COMPONENT_REF:
|
||||
|
|
Loading…
Add table
Reference in a new issue