2004-04-19 Arnaud Charlet <charlet@act-europe.fr>

	* 5isystem.ads: Removed, unused.

	* gnat_rm.texi: Redo 1.13 change.

2004-04-19  Robert Dewar  <dewar@gnat.com>

	* s-stoele.ads: Clean up definition of Storage_Offset (the new
	definition is cleaner, avoids the kludge of explicit Standard operator
	references, and also is consistent with a visible System.Address with
	no visible operations.

	* s-geveop.adb: Add declarations to avoid assumption of visible
	operations on type System.Address (since these might not be available
	if Address is a non-private type for which the operations
	are made abstract).

	* sem_eval.adb: Minor reformatting

	* s-carsi8.ads, s-carun8.ads, s-casi16.ads, s-casi32.ads,
	s-casi64.ads, s-caun16.ads, s-caun32.ads, s-caun64.ads: Minor
	reformatting (new function spec format).

	* s-auxdec.adb, s-carsi8.adb, s-carun8.adb, s-casi16.adb,
	s-casi32.adb, s-casi64.adb, s-caun16.adb, s-caun32.adb,
	s-caun64.adb: Add declarations to avoid assumption of visible
	operations on type System.Address (since these might not be available
	if Address is a non-private type for which the operations are made
	abstract).

	* lib.ads, lib.adb (Synchronize_Serial_Number): New procedure.

	* exp_intr.adb: Minor comment update

	* exp_aggr.adb, exp_attr.adb, exp_ch13.adb: Minor reformatting.

	* 5omastop.adb: Add declarations to avoid assumption of visible
	operations on type System.Address (since these might not be available
	if Address is a non-private type for which the operations
	are made abstract).

2004-04-19  Vincent Celier  <celier@gnat.com>

	* switch-m.adb: (Scan_Make_Switches): Process new switch -eL

	* prj-pars.ads (Parse): New Boolean parameter Process_Languages,
	defaulted to Ada.

	* prj-proc.adb (Process): New Boolean parameter Process_Languages,
	defaulted to Ada.
	Call Check with Process_Languages.
	(Check): New Boolean parameter Process_Languages. Call Recursive_Check
	with Process_Languages.
	(Recursive_Check): New Boolean parameter Process_Languages. Call
	Nmsc.Ada_Check or Nmsc.Other_Languages_Check according to
	Process_Languages.

	* prj-proc.ads (Process): New Boolean parameter Process_Languages,

	* prj-util.ads, prj-util.adb (Executable_Of): New Boolean
	parameter Ada_Main, defaulted to True.
	Check for Ada specific characteristics only when Ada_Main is True.

	* opt.ads: (Follow_Links): New Boolean flag for gnatmake

	* prj.adb: (Project_Empty): Add new Project_Data components.

	* prj.ads: New types and tables for non Ada languages.
	(Project_Data): New components Languages, Impl_Suffixes,
	First_Other_Source, Last_Other_Source, Imported_Directories_Switches,
	Include_Path, Include_Data_Set.

	* prj-env.ads, prj-env.adb: Minor reformatting

	* prj-nmsc.ads, prj-nmsc.adb: (Other_Languages_Check): New procedure
	Put subprograms in alphabetical order

	* prj-pars.adb (Parse): New Boolean parameter Process_Languages,
	defaulted to Ada; Call Prj.Proc.Process with Process_Languages and
	Opt.Follow_Links.

	* mlib-prj.adb: Back out modification in last version, as they are
	incorrect.
	(Build_Library.Check_Libs): Remove useless pragma Warnings (Off)

	* make.adb: (Mains): Moved to package Makeutl
	(Linker_Opts): Moved to package Makeutl
	(Is_External_Assignment): Moved to package Makeutl
	(Test_If_Relative_Path): Moved to package Makeutl
	(Gnatmake): Move sorting of linker options to function
	Makeutl.Linker_Options_Switches.

	* Makefile.in: Add makeutl.o to the object files for gnatmake

	* makeusg.adb: Add line for new switch -eL.

	* gnatls.adb (Image): New function.
	(Output_Unit): If in verbose mode, output the list of restrictions
	specified by pragmas Restrictions.

	* 5bml-tgt.adb, 5vml-tgt.adb (Build_Dynamic_Library): Do not use
	Text_IO.

	* a-calend.adb (Split): Shift the date by multiple of 56 years, if
	needed, to put it in the range 1970 (included) - 2026 (excluded).
	(Time_Of): Do not shift Unix_Min_Year (1970).
	Shift the date by multiple of 56 years, if needed, to put it in the
	range 1970 (included) - 2026 (excluded).

	* adaint.h, adaint.c (__gnat_set_executable): New function.

2004-04-19  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	* trans.c (tree_transform, case N_Subprogram_Body): Temporarily push
	and pop GC context.
	(tree_transform, case N_Procedure_Call): Fix typo in setting TREE_TYPE.
	(tree_transform, case N_Label): Don't set LABEL_STMT_FIRST_IN_EH.
	(tree_transform, case N_Procedure_Call_Statement): Build a tree.
	(tree_transform, case N_Code_Statement): Likewise.
	(gnat_expand_stmt, case LABEL_STMT): Don't look at
	LABEL_STMT_FIRST_IN_EH.
	(gnat_expand_stmt, case ASM_STMT): New case.

	* utils2.c (build_unary_op): Properly set TREE_READONLY of
	UNCONSTRAINED_ARRAY_REF.

	* utils.c (poplevel): Temporarily push/pop GC context around inline
	function expansion.

	* decl.c (maybe_variable): Properly set TREE_READONLY of
	UNCONSTRAINED_ARRAY_REF.
	(make_packable_type): Only reference TYPE_IS_PADDING_P for RECORD_TYPE.

	* ada-tree.def: (ASM_STMT): New.

	* ada-tree.h: (LABEL_STMT_FIRST_IN_EH): Deleted.
	(ASM_STMT_TEMPLATE, ASM_STMT_OUTPUT, ASM_STMT_ORIG_OUT,
	ASM_STMT_INPUT): New.
	(ASM_STMT_CLOBBER): Likewise.

2004-04-19  Thomas Quinot  <quinot@act-europe.fr>

	* a-except.adb, s-parint.ads, s-parint.adb, types.ads, types.h: Use
	general rcheck mechanism to raise Program_Error for E.4(18), instead
	of a custom raiser in System.Partition_Interface.
	Part of general cleanup work before PolyORB integration.

	* snames.ads, snames.adb: Add new runtime library entities and names
	for PolyORB DSA.

	* sem_dist.ads, sem_dist.adb (Get_Subprogram_Id): Move from sem_dist to
	exp_dist.
	(Build_Subprogram_Id): New subprogram provided by exp_dist
	Code reorganisation in preparation for PolyORB integration.

	* exp_dist.ads, exp_dist.adb (Get_Subprogram_Id): Move from sem_dist to
	exp_dist.
	(Build_Subprogram_Id): New subprogram provided by exp_dist

	* sem_ch4.adb (Analyze_One_Call): Fix error message for mismatch in
	actual parameter types for call to dereference of an
	access-to-subprogram type.

	* rtsfind.ads: Add new runtime library entities and names for PolyORB
	DSA.

	* gnatlink.adb (Value): Remove. Use Interfaces.C.Strings.Value
	instead, which has the same behaviour here since we never pass it a
	NULL pointer.

	* link.c (run_path_option, Solaris case): Use -Wl, as for other
	platforms.

	* Makefile.in: adjust object file lists for gnatlink and gnatmake
	to account for new dependency upon Interfaces.C.Strings + link.o
	For x86 FreeBSD, use 86numaux.

	* make.adb, gnatcmd.adb: Linker_Library_Path_Option has been moved up
	from Mlib.Tgt to Mlib.

	* mlib.ads, mlib.adb (Linker_Library_Path_Option): New subprogram, now
	target-independent.

	* mlib-tgt.ads, mlib-tgt.adb (Linker_Library_Path_Option): Remove
	target-specific versions of this subprogram, now implemented as a
	target-independent function in Mlib.

	* 5aml-tgt.adb, 5bml-tgt.adb, 5gml-tgt.adb, 5hml-tgt.adb, 5lml-tgt.adb,
	5sml-tgt.adb, 5vml-tgt.adb, 5zml-tgt.adb, 5wml-tgt.adb
	(Linker_Library_Path_Option): Remove target-specific versions of this
	subprogram, now implemented as a target-independent function in Mlib.

	* atree.adb: (Allocate_Initialize_Node): New subprogram.
	Factors out node table slots allocation.
	(Fix_Parents): New subprogram.
	Encapsulate the pattern of fixing up parent pointers for syntactic
	children of a rewritten node.
	(New_Copy_Tree): Use New_Copy to copy non-entity nodes.
	(Rewrite): Use New_Copy when creating saved copy of original node.
	(Replace): Use Copy_Node to copy nodes.

2004-04-19  Javier Miranda  <miranda@gnat.com>

	* sprint.adb (Sprint_Node_Actual): Give support to the new
	Access_To_Subprogram node available in Access_Definition nodes. In
	addition, give support to the AI-231 node fields: null-exclusion,
	all-present, constant-present.

	* sem_util.ads, sem_util.adb: (Has_Declarations): New subprogram

	* sinfo.ads, sinfo.adb:
	New field Access_To_Subprogram_Definition in Access_Definition nodes

	* sem_ch6.adb (Process_Formals): Move here the code that creates and
	decorates internal subtype declaration corresponding to the
	null-excluding formal. This code was previously in Set_Actual_Subtypes.
	In addition, carry out some code cleanup on this code. In case of
	access to protected subprogram call
	Replace_Anonymous_Access_To_Protected_Subprogram.
	(Set_Actual_Subtypes): Code cleanup.

	* sem_ch8.adb (Analyze_Object_Renaming): Remove un-necessary call to
	Find_Type in case of anonymous access renamings. Add warning in case of
	null-excluding attribute used in anonymous access renaming.

	* sem_ch3.ads (Replace_Anonymous_Access_To_Protected_Subprogram): New
	subprogram

	* sem_ch3.adb (Replace_Anonymous_Access_To_Protected_Subprogram): New
	subprogram.
	(Access_Definition): In case of anonymous access to subprograms call
	the corresponding semantic routine to decorate the node.
	(Access_Subprogram_Declaration): Addition of some comments indicating
	some code that probably should be added here. Detected by comparison
	with the access_definition subprogram.
	(Analyze_Component_Declaration): In case of access to protected
	subprogram call Replace_Anonymous_Access_To_Protected.
	(Array_Type_Declaration): In case of access to protected subprogram call
	Replace_Anonymous_Access_To_Protected_Subprogram.
	(Process_Discriminants): In case of access to protected subprogram call
	Replace_Anonymous_Access_To_Protected_Subprogram.

	* par.adb (P_Access_Definition): New formal that indicates if the
	null-exclusion part was present.
	(P_Access_Type_Definition): New formal that indicates if the caller has
	already parsed the null-excluding part.

	* par-ch3.adb (P_Subtype_Declaration): Code cleanup.
	(P_Identifier_Declarations): Code cleanup and give support to renamings
	of anonymous access to subprogram types.
	(P_Derived_Type_Def_Or_Private_Ext_Decl): Code cleanup.
	(P_Array_Type_Definition): Give support to AI-254.
	(P_Component_Items): Give support to AI-254.
	(P_Access_Definition): New formal that indicates if the header was
	already parsed by the caller.
	(P_Access_Type_Definition): New formal that indicates if the caller has
	already parsed the null-excluding part.

	* par-ch6.adb (P_Formal_Part): Add the null-excluding parameter to the
	call to P_Access_Definition.

2004-04-19  Geert Bosch  <bosch@gnat.com>

	* checks.adb (Apply_Float_Conversion_Check): New procedure to implement
	the delicate semantics of floating-point to integer conversion.
	(Apply_Type_Conversion_Checks): Use Apply_Float_Conversion_Check.

	* eval_fat.adb (Machine_Mantissa): Moved to spec.
	(Machine_Radix): New function.

	* eval_fat.ads (Machine_Mantissa): Moved from body for use in
	conversion checks.
	(Machine_Radix): New function also for use in conversion checks.

2004-04-19  Ed Schonberg  <schonberg@gnat.com>

	* par-prag.adb (Source_File_Name_Project): Fix typo in error message.

	* exp_ch9.adb (Expand_Access_Protected_Subprogram_Type): Call analyze
	to decorate the access-to-protected subprogram and the equivalent type.

	* checks.adb (Null_Exclusion_Static_Checks): Code cleanup. Give support
	to anonymous access to subprogram types.

	* exp_ch4.adb (Expand_N_In): Preserve Static flag before
	constant-folding, for legality checks in contexts that require an RM
	static expression.

	* exp_ch6.adb (Expand_N_Function_Call): If call may generate large
	temporary but stack checking is not enabled, increment serial number
	to so that symbol generation is consistent with and without stack
	checking.

	* exp_util.ads, exp_util.adb (May_Generate_Large_Temp): Predicate is
	independent on whether stack checking is enabled, caller must check
	the corresponding flag.

	* sem_ch3.adb (Constrain_Index): Index bounds given by attributes need
	range checks.
	(Build_Derived_Concurrent_Type): Inherit Is_Constrained flag from
	parent if it has discriminants.
	(Build_Derived_Private_Type): Constructed full view does
	not come from source.
	(Process_Discriminants): Default discriminants on a tagged type are
	legal if this is the internal completion of a private untagged
	derivation.

	* sem_ch6.adb (Set_Actual_Subtypes): The generated declaration needs
	no constraint checks, because it corresponds to an existing object.

	* sem_prag.adb (Process_Convention): Pragma applies
	only to subprograms in the same declarative part, i.e. the same unit,
	not the same scope.

	* sem_res.adb (Valid_Conversion): In an instance or inlined body,
	ignore type mismatch on a numeric conversion if expression comes from
	expansion.

2004-04-19  Sergey Rybin  <rybin@act-europe.fr>

	* sem_elim.adb (Process_Eliminate_Pragma): Remove the processing for
	Homonym_Number parameter, add processing for Source_Location parameter
	corresponding.
	(Check_Eliminated): Remove the check for homonym numbers, add the check
	for source location traces.

	* sem_elim.ads (Process_Eliminate_Pragma): Replace Arg_Homonym_Number
	with Arg_Source_Location corresponding to the changes in the format of
	the pragma.

	* sem_prag.adb: (Analyze_Pragma): Changes in the processing of
	Eliminate pragma corresponding to the changes in the format of the
	pragma: Homonym_Number is replaced with Source_Location, two ways of
	distinguishing homonyms are mutially-exclusive.

2004-04-19  Joel Brobecker  <brobecker@gnat.com>

	* get_targ.ads (Get_No_Dollar_In_Label): Remove.

	* exp_dbug.adb (Output_Homonym_Numbers_Suffix): Remove use of
	No_Dollar_In_Label, no longer necessary, as it is always True.
	(Strip_Suffixes): Likewise.

2004-04-19  Gary Dismukes  <dismukes@gnat.com>

	* s-stalib.ads (type Exception_Code): Use Integer'Size for exponent of
	modulus for compatibility with size clause on targets with 16-bit
	Integer.

	* layout.adb (Discrimify): In the case of private types, set Vtyp to
	full type to fix type mismatches on calls to size functions for
	discriminant-dependent array components.

2004-04-19  Jerome Guitton  <guitton@act-europe.fr>

	* Makefile.in (gnatlib-zcx): New target, for building a ZCX run-time
	lib.

2004-04-19  Pascal Obry  <obry@gnat.com>

	* mdll-utl.adb (Locate): New version is idempotent.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@80856 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 364 insertions, 114 deletions

diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index ea73f2f8d4f..aaad1a488c3 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -31,6 +31,7 @@ with Errout;   use Errout;
 with Exp_Ch2;  use Exp_Ch2;
 with Exp_Util; use Exp_Util;
 with Elists;   use Elists;
+with Eval_Fat; use Eval_Fat;
 with Freeze;   use Freeze;
 with Lib;      use Lib;
 with Nlists;   use Nlists;
@@ -187,6 +188,14 @@ package body Checks is
    -- Local Subprograms --
    -----------------------
 
+   procedure Apply_Float_Conversion_Check
+     (Ck_Node    : Node_Id;
+      Target_Typ : Entity_Id);
+   --  The checks on a conversion from a floating-point type to an integer
+   --  type are delicate. They have to be performed before conversion, they
+   --  have to raise an exception when the operand is a NaN, and rounding must
+   --  be taken into account to determine the safe bounds of the operand.
+
    procedure Apply_Selected_Length_Checks
      (Ck_Node    : Node_Id;
       Target_Typ : Entity_Id;
@@ -1346,6 +1355,186 @@ package body Checks is
       end if;
    end Apply_Divide_Check;
 
+   ----------------------------------
+   -- Apply_Float_Conversion_Check --
+   ----------------------------------
+
+   --  Let F and I be the source and target types of the conversion.
+   --  The Ada standard specifies that a floating-point value X is rounded
+   --  to the nearest integer, with halfway cases being rounded away from
+   --  zero. The rounded value of X is checked against I'Range.
+
+   --  The catch in the above paragraph is that there is no good way
+   --  to know whether the round-to-integer operation resulted in
+   --  overflow. A remedy is to perform a range check in the floating-point
+   --  domain instead, however:
+   --      (1)  The bounds may not be known at compile time
+   --      (2)  The check must take into account possible rounding.
+   --      (3)  The range of type I may not be exactly representable in F.
+   --      (4)  The end-points I'First - 0.5 and I'Last + 0.5 may or may
+   --           not be in range, depending on the sign of  I'First and I'Last.
+   --      (5)  X may be a NaN, which will fail any comparison
+
+   --  The following steps take care of these issues converting X:
+   --      (1) If either I'First or I'Last is not known at compile time, use
+   --          I'Base instead of I in the next three steps and perform a
+   --          regular range check against I'Range after conversion.
+   --      (2) If I'First - 0.5 is representable in F then let Lo be that
+   --          value and define Lo_OK as (I'First > 0). Otherwise, let Lo be
+   --          F'Machine (T) and let Lo_OK be (Lo >= I'First). In other words,
+   --          take one of the closest floating-point numbers to T, and see if
+   --          it is in range or not.
+   --      (3) If I'Last + 0.5 is representable in F then let Hi be that value
+   --          and define Hi_OK as (I'Last < 0). Otherwise, let Hi be
+   --          F'Rounding (T) and let Hi_OK be (Hi <= I'Last).
+   --      (4) Raise CE when (Lo_OK and X < Lo) or (not Lo_OK and X <= Lo)
+   --                     or (Hi_OK and X > Hi) or (not Hi_OK and X >= Hi)
+
+   procedure Apply_Float_Conversion_Check
+     (Ck_Node    : Node_Id;
+      Target_Typ : Entity_Id)
+   is
+      LB          : constant Node_Id := Type_Low_Bound (Target_Typ);
+      HB          : constant Node_Id := Type_High_Bound (Target_Typ);
+      Loc         : constant Source_Ptr := Sloc (Ck_Node);
+      Expr_Type   : constant Entity_Id  := Base_Type (Etype (Ck_Node));
+      Target_Base : constant Entity_Id  := Implementation_Base_Type
+                                             (Target_Typ);
+      Max_Bound   : constant Uint := UI_Expon
+                                       (Machine_Radix (Expr_Type),
+                                        Machine_Mantissa (Expr_Type) - 1) - 1;
+      --  Largest bound, so bound plus or minus half is a machine number of F
+
+      Ifirst,
+      Ilast     : Uint;         --  Bounds of integer type
+      Lo, Hi    : Ureal;        --  Bounds to check in floating-point domain
+      Lo_OK,
+      Hi_OK     : Boolean;      --  True iff Lo resp. Hi belongs to I'Range
+
+      Lo_Chk,
+      Hi_Chk    : Node_Id;      --  Expressions that are False iff check fails
+
+      Reason    : RT_Exception_Code;
+
+   begin
+      if not Compile_Time_Known_Value (LB)
+          or not Compile_Time_Known_Value (HB)
+      then
+         declare
+            --  First check that the value falls in the range of the base
+            --  type, to prevent overflow during conversion and then
+            --  perform a regular range check against the (dynamic) bounds.
+
+            Par : constant Node_Id := Parent (Ck_Node);
+
+            pragma Assert (Target_Base /= Target_Typ);
+            pragma Assert (Nkind (Par) = N_Type_Conversion);
+
+            Temp : constant Entity_Id :=
+                    Make_Defining_Identifier (Loc,
+                      Chars => New_Internal_Name ('T'));
+
+         begin
+            Apply_Float_Conversion_Check (Ck_Node, Target_Base);
+            Set_Etype (Temp, Target_Base);
+
+            Insert_Action (Parent (Par),
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Temp,
+                Object_Definition => New_Occurrence_Of (Target_Typ, Loc),
+                Expression => New_Copy_Tree (Par)),
+                Suppress => All_Checks);
+
+            Insert_Action (Par,
+              Make_Raise_Constraint_Error (Loc,
+                Condition =>
+                  Make_Not_In (Loc,
+                    Left_Opnd  => New_Occurrence_Of (Temp, Loc),
+                    Right_Opnd => New_Occurrence_Of (Target_Typ, Loc)),
+                Reason => CE_Range_Check_Failed));
+            Rewrite (Par, New_Occurrence_Of (Temp, Loc));
+
+            return;
+         end;
+      end if;
+
+      --  Get the bounds of the target type
+
+      Ifirst := Expr_Value (LB);
+      Ilast  := Expr_Value (HB);
+
+      --  Check against lower bound
+
+      if abs (Ifirst) < Max_Bound then
+         Lo := UR_From_Uint (Ifirst) - Ureal_Half;
+         Lo_OK := (Ifirst > 0);
+      else
+         Lo := Machine (Expr_Type, UR_From_Uint (Ifirst), Round_Even, Ck_Node);
+         Lo_OK := (Lo >= UR_From_Uint (Ifirst));
+      end if;
+
+      if Lo_OK then
+
+         --  Lo_Chk := (X >= Lo)
+
+         Lo_Chk := Make_Op_Ge (Loc,
+                     Left_Opnd => Duplicate_Subexpr_No_Checks (Ck_Node),
+                     Right_Opnd => Make_Real_Literal (Loc, Lo));
+
+      else
+         --  Lo_Chk := (X > Lo)
+
+         Lo_Chk := Make_Op_Gt (Loc,
+                     Left_Opnd => Duplicate_Subexpr_No_Checks (Ck_Node),
+                     Right_Opnd => Make_Real_Literal (Loc, Lo));
+      end if;
+
+      --  Check against higher bound
+
+      if abs (Ilast) < Max_Bound then
+         Hi := UR_From_Uint (Ilast) + Ureal_Half;
+         Hi_OK := (Ilast < 0);
+      else
+         Hi := Machine (Expr_Type, UR_From_Uint (Ilast), Round_Even, Ck_Node);
+         Hi_OK := (Hi <= UR_From_Uint (Ilast));
+      end if;
+
+      if Hi_OK then
+
+         --  Hi_Chk := (X <= Hi)
+
+         Hi_Chk := Make_Op_Le (Loc,
+                     Left_Opnd => Duplicate_Subexpr_No_Checks (Ck_Node),
+                     Right_Opnd => Make_Real_Literal (Loc, Hi));
+
+      else
+         --  Hi_Chk := (X < Hi)
+
+         Hi_Chk := Make_Op_Lt (Loc,
+                     Left_Opnd => Duplicate_Subexpr_No_Checks (Ck_Node),
+                     Right_Opnd => Make_Real_Literal (Loc, Hi));
+      end if;
+
+      --  If the bounds of the target type are the same as those of the
+      --  base type, the check is an overflow check as a range check is
+      --  not performed in these cases.
+
+      if Expr_Value (Type_Low_Bound (Target_Base)) = Ifirst
+        and then Expr_Value (Type_High_Bound (Target_Base)) = Ilast
+      then
+         Reason := CE_Overflow_Check_Failed;
+      else
+         Reason := CE_Range_Check_Failed;
+      end if;
+
+      --  Raise CE if either conditions does not hold
+
+      Insert_Action (Ck_Node,
+        Make_Raise_Constraint_Error (Loc,
+          Condition => Make_Op_Not (Loc, Make_Op_And (Loc, Lo_Chk, Hi_Chk)),
+          Reason    => Reason));
+   end Apply_Float_Conversion_Check;
+
    ------------------------
    -- Apply_Length_Check --
    ------------------------
@@ -1918,9 +2107,14 @@ package body Checks is
             --  and no floating point type is involved in the type conversion
             --  then fixed point values must be read as integral values.
 
+            Float_To_Int : constant Boolean :=
+                             Is_Floating_Point_Type (Expr_Type)
+                               and then Is_Integer_Type (Target_Type);
+
          begin
             if not Overflow_Checks_Suppressed (Target_Base)
               and then not In_Subrange_Of (Expr_Type, Target_Base, Conv_OK)
+              and then not Float_To_Int
             then
                Set_Do_Overflow_Check (N);
             end if;
@@ -1928,8 +2122,12 @@ package body Checks is
             if not Range_Checks_Suppressed (Target_Type)
               and then not Range_Checks_Suppressed (Expr_Type)
             then
-               Apply_Scalar_Range_Check
-                 (Expr, Target_Type, Fixed_Int => Conv_OK);
+               if Float_To_Int then
+                  Apply_Float_Conversion_Check (Expr, Target_Type);
+               else
+                  Apply_Scalar_Range_Check
+                    (Expr, Target_Type, Fixed_Int => Conv_OK);
+               end if;
             end if;
          end;
 
@@ -2193,162 +2391,214 @@ package body Checks is
 
    procedure Null_Exclusion_Static_Checks (N : Node_Id) is
       K                  : constant Node_Kind := Nkind (N);
-      Expr               : Node_Id;
       Typ                : Entity_Id;
       Related_Nod        : Node_Id;
       Has_Null_Exclusion : Boolean := False;
 
-      --  Following declarations and subprograms are just used to qualify the
-      --  error messages
-
       type Msg_Kind is (Components, Formals, Objects);
       Msg_K : Msg_Kind := Objects;
+      --  Used by local subprograms to generate precise error messages
 
-      procedure Must_Be_Initialized;
-      procedure Null_Not_Allowed;
+      procedure Check_Must_Be_Access
+        (Typ                : Entity_Id;
+         Has_Null_Exclusion : Boolean);
+      --  ??? local subprograms must have comment on spec
 
-      -------------------------
-      -- Must_Be_Initialized --
-      -------------------------
+      procedure Check_Already_Null_Excluding_Type
+        (Typ                : Entity_Id;
+         Has_Null_Exclusion : Boolean;
+         Related_Nod        : Node_Id);
+      --  ??? local subprograms must have comment on spec
+
+      procedure Check_Must_Be_Initialized
+        (N           : Node_Id;
+         Related_Nod : Node_Id);
+      --  ??? local subprograms must have comment on spec
+
+      procedure Check_Null_Not_Allowed (N : Node_Id);
+      --  ??? local subprograms must have comment on spec
+
+      --  ??? following bodies lack comments
 
-      procedure Must_Be_Initialized is
+      --------------------------
+      -- Check_Must_Be_Access --
+      --------------------------
+
+      procedure Check_Must_Be_Access
+        (Typ                : Entity_Id;
+         Has_Null_Exclusion : Boolean)
+      is
       begin
-         case Msg_K is
-            when Components =>
-               Error_Msg_N
-                 ("(Ada 0Y) null-excluding components must be initialized",
-                  Related_Nod);
-
-            when Formals =>
-               Error_Msg_N
-                 ("(Ada 0Y) null-excluding formals must be initialized",
-                  Related_Nod);
-
-            when Objects =>
-               Error_Msg_N
-                 ("(Ada 0Y) null-excluding objects must be initialized",
-                  Related_Nod);
-         end case;
-      end Must_Be_Initialized;
+         if Has_Null_Exclusion
+           and then not Is_Access_Type (Typ)
+         then
+            Error_Msg_N ("(Ada 0Y) must be an access type", Related_Nod);
+         end if;
+      end Check_Must_Be_Access;
 
-      ----------------------
-      -- Null_Not_Allowed --
-      ----------------------
+      ---------------------------------------
+      -- Check_Already_Null_Excluding_Type --
+      ---------------------------------------
 
-      procedure Null_Not_Allowed is
+      procedure Check_Already_Null_Excluding_Type
+        (Typ                : Entity_Id;
+         Has_Null_Exclusion : Boolean;
+         Related_Nod        : Node_Id)
+      is
       begin
-         case Msg_K is
-            when Components =>
-               Error_Msg_N
-                 ("(Ada 0Y) NULL not allowed in null-excluding components",
-                  Expr);
-
-            when Formals =>
-               Error_Msg_N
-                 ("(Ada 0Y) NULL not allowed in null-excluding formals",
-                  Expr);
-
-            when Objects =>
-               Error_Msg_N
-                 ("(Ada 0Y) NULL not allowed in null-excluding objects",
-                  Expr);
-         end case;
-      end Null_Not_Allowed;
+         if Has_Null_Exclusion
+           and then Can_Never_Be_Null (Typ)
+         then
+            Error_Msg_N
+              ("(Ada 0Y) already a null-excluding type", Related_Nod);
+         end if;
+      end Check_Already_Null_Excluding_Type;
+
+      -------------------------------
+      -- Check_Must_Be_Initialized --
+      -------------------------------
+
+      procedure Check_Must_Be_Initialized
+        (N           : Node_Id;
+         Related_Nod : Node_Id)
+      is
+         Expr        : constant Node_Id := Expression (N);
+
+      begin
+         pragma Assert (Nkind (N) = N_Component_Declaration
+                          or else Nkind (N) = N_Object_Declaration);
+
+         if not Present (Expr) then
+            case Msg_K is
+               when Components =>
+                  Error_Msg_N
+                    ("(Ada 0Y) null-excluding components must be initialized",
+                     Related_Nod);
+
+               when Formals =>
+                  Error_Msg_N
+                    ("(Ada 0Y) null-excluding formals must be initialized",
+                     Related_Nod);
+
+               when Objects =>
+                  Error_Msg_N
+                    ("(Ada 0Y) null-excluding objects must be initialized",
+                     Related_Nod);
+            end case;
+         end if;
+      end Check_Must_Be_Initialized;
+
+      ----------------------------
+      -- Check_Null_Not_Allowed --
+      ----------------------------
+
+      procedure Check_Null_Not_Allowed (N : Node_Id) is
+         Expr : constant Node_Id := Expression (N);
+
+      begin
+         if Present (Expr)
+           and then Nkind (Expr) = N_Null
+         then
+            case Msg_K is
+               when Components =>
+                  Error_Msg_N
+                    ("(Ada 0Y) NULL not allowed in null-excluding components",
+                     Expr);
+
+               when Formals =>
+                  Error_Msg_N
+                    ("(Ada 0Y) NULL not allowed in null-excluding formals",
+                     Expr);
+
+               when Objects =>
+                  Error_Msg_N
+                    ("(Ada 0Y) NULL not allowed in null-excluding objects",
+                     Expr);
+            end case;
+         end if;
+      end Check_Null_Not_Allowed;
 
    --  Start of processing for Null_Exclusion_Static_Checks
 
    begin
       pragma Assert (K = N_Component_Declaration
-                     or else K = N_Parameter_Specification
-                     or else K = N_Object_Declaration
-                     or else K = N_Discriminant_Specification
-                     or else K = N_Allocator);
-
-      Expr := Expression (N);
+                       or else K = N_Parameter_Specification
+                       or else K = N_Object_Declaration
+                       or else K = N_Discriminant_Specification
+                       or else K = N_Allocator);
 
       case K is
          when N_Component_Declaration =>
-            Msg_K               := Components;
-            Has_Null_Exclusion  := Null_Exclusion_Present
-                                     (Component_Definition (N));
-            Typ                 := Etype (Subtype_Indication
-                                           (Component_Definition (N)));
-            Related_Nod         := Subtype_Indication
-                                     (Component_Definition (N));
+            Msg_K := Components;
+
+            if not Present (Access_Definition (Component_Definition (N))) then
+               Has_Null_Exclusion  := Null_Exclusion_Present
+                                        (Component_Definition (N));
+               Typ := Etype (Subtype_Indication (Component_Definition (N)));
+               Related_Nod := Subtype_Indication (Component_Definition (N));
+               Check_Must_Be_Access (Typ, Has_Null_Exclusion);
+               Check_Already_Null_Excluding_Type
+                 (Typ, Has_Null_Exclusion, Related_Nod);
+               Check_Must_Be_Initialized (N, Related_Nod);
+            end if;
+
+            Check_Null_Not_Allowed (N);
 
          when N_Parameter_Specification =>
-            Msg_K              := Formals;
+            Msg_K := Formals;
             Has_Null_Exclusion := Null_Exclusion_Present (N);
-            Typ                := Entity (Parameter_Type (N));
-            Related_Nod        := Parameter_Type (N);
+            Typ := Entity (Parameter_Type (N));
+            Related_Nod := Parameter_Type (N);
+            Check_Must_Be_Access (Typ, Has_Null_Exclusion);
+            Check_Already_Null_Excluding_Type
+              (Typ, Has_Null_Exclusion, Related_Nod);
+            Check_Null_Not_Allowed (N);
 
          when N_Object_Declaration =>
-            Msg_K              := Objects;
+            Msg_K := Objects;
             Has_Null_Exclusion := Null_Exclusion_Present (N);
-            Typ                := Entity (Object_Definition (N));
-            Related_Nod        := Object_Definition (N);
+            Typ := Entity (Object_Definition (N));
+            Related_Nod := Object_Definition (N);
+            Check_Must_Be_Access (Typ, Has_Null_Exclusion);
+            Check_Already_Null_Excluding_Type
+              (Typ, Has_Null_Exclusion, Related_Nod);
+            Check_Must_Be_Initialized (N, Related_Nod);
+            Check_Null_Not_Allowed (N);
 
          when N_Discriminant_Specification =>
-            Msg_K              := Components;
-
-            if Nkind (Discriminant_Type (N)) = N_Access_Definition then
+            Msg_K := Components;
 
-               --  This case is special. We do not want to carry out some of
-               --  the null-excluding checks. Reason: the analysis of the
-               --  access_definition propagates the null-excluding attribute
-               --  to the can_never_be_null entity attribute (and thus it is
-               --  wrong to check it now)
-
-               Has_Null_Exclusion := False;
-            else
+            if Nkind (Discriminant_Type (N)) /= N_Access_Definition then
                Has_Null_Exclusion := Null_Exclusion_Present (N);
+               Typ := Etype (Defining_Identifier (N));
+               Related_Nod := Discriminant_Type (N);
+               Check_Must_Be_Access (Typ, Has_Null_Exclusion);
+               Check_Already_Null_Excluding_Type
+                 (Typ, Has_Null_Exclusion, Related_Nod);
             end if;
 
-            Typ                := Etype (Defining_Identifier (N));
-            Related_Nod        := Discriminant_Type (N);
+            Check_Null_Not_Allowed (N);
 
          when N_Allocator =>
-            Msg_K              := Objects;
+            Msg_K := Objects;
             Has_Null_Exclusion := Null_Exclusion_Present (N);
-            Typ                := Etype (Expr);
+            Typ := Etype (Expression (N));
 
-            if Nkind (Expr) = N_Qualified_Expression then
-               Related_Nod     := Subtype_Mark (Expr);
+            if Nkind (Expression (N)) = N_Qualified_Expression then
+               Related_Nod := Subtype_Mark (Expression (N));
             else
-               Related_Nod     := Expr;
+               Related_Nod := Expression (N);
             end if;
 
+            Check_Must_Be_Access (Typ, Has_Null_Exclusion);
+            Check_Already_Null_Excluding_Type
+              (Typ, Has_Null_Exclusion, Related_Nod);
+            Check_Null_Not_Allowed (N);
+
          when others =>
             pragma Assert (False);
             null;
       end case;
-
-      --  Check that the entity was already decorated
-
-      pragma Assert (Typ /= Empty);
-
-      if Has_Null_Exclusion
-        and then not Is_Access_Type (Typ)
-      then
-         Error_Msg_N ("(Ada 0Y) must be an access type", Related_Nod);
-
-      elsif Has_Null_Exclusion
-        and then Can_Never_Be_Null (Typ)
-      then
-         Error_Msg_N
-           ("(Ada 0Y) already a null-excluding type", Related_Nod);
-
-      elsif (Nkind (N) = N_Component_Declaration
-             or else Nkind (N) = N_Object_Declaration)
-        and not Present (Expr)
-      then
-         Must_Be_Initialized;
-
-      elsif Present (Expr)
-        and then Nkind (Expr) = N_Null
-      then
-         Null_Not_Allowed;
-      end if;
    end Null_Exclusion_Static_Checks;
 
    ----------------------------------