-- --
-- B o d y --
-- --
--- $Revision: 1.19 $
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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- --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- specialized appropriately, or better still, its generic instantiations
-- should be replaced by efficient machine-specific code.
-with Ada.Unchecked_Conversion; use Ada;
+with Ada.Unchecked_Conversion;
with System;
package body System.Fat_Gen is
Float_Radix : constant T := T (T'Machine_Radix);
- Float_Radix_Inv : constant T := 1.0 / Float_Radix;
Radix_To_M_Minus_1 : constant T := Float_Radix ** (T'Machine_Mantissa - 1);
pragma Assert (T'Machine_Radix = 2);
---------------
procedure Decompose (XX : T; Frac : out T; Expo : out UI) is
- X : T := T'Machine (XX);
+ X : constant T := T'Machine (XX);
begin
if X = 0.0 then
-- More useful would be defining Expo to be T'Machine_Emin - 1 or
-- T'Machine_Emin - T'Machine_Mantissa, which would preserve
- -- monotonicity of the exponent fuction ???
+ -- monotonicity of the exponent function ???
-- Check for infinities, transfinites, whatnot.
Ex : UI := Adjustment;
begin
- if Adjustment < T'Machine_Emin then
+ if Adjustment < T'Machine_Emin - 1 then
Y := 2.0 ** T'Machine_Emin;
Y1 := Y;
Ex := Ex - T'Machine_Emin;
- while Ex <= 0 loop
+ while Ex < 0 loop
Y := T'Machine (Y / 2.0);
if Y = 0.0 then
if Radix_Digits >= T'Machine_Mantissa then
return X;
+ elsif Radix_Digits <= 0 then
+ raise Constraint_Error;
+
else
L := Exponent (X) - Radix_Digits;
Y := Truncation (Scaling (X, -L));
P_Even : Boolean;
begin
+ if Y = 0.0 then
+ raise Constraint_Error;
+ end if;
+
if X > 0.0 then
Sign_X := 1.0;
Arg := X;
-- The Float_Rep type is an array of Float_Word elements. This
-- representation is chosen to make it possible to size the
- -- type based on a generic parameter.
+ -- type based on a generic parameter. Since the array size is
+ -- known at compile-time, efficient code can still be generated.
+ -- The size of Float_Word elements should be large enough to allow
+ -- accessing the exponent in one read, but small enough so that all
+ -- floating point object sizes are a multiple of the Float_Word'Size.
-- The following conditions must be met for all possible
-- instantiations of the attributes package:
-- and the exponent is in the following bits.
-- Unused bits (if any) are in the least significant part.
- type Float_Word is mod 2**32;
+ type Float_Word is mod 2**Positive'Min (System.Word_Size, 32);
type Rep_Index is range 0 .. 7;
Rep_Last : constant Rep_Index := (T'Size - 1) / Float_Word'Size;
type Float_Rep is array (Rep_Index range 0 .. Rep_Last) of Float_Word;
+ pragma Suppress_Initialization (Float_Rep);
+ -- This pragma supresses the generation of an initialization procedure
+ -- for type Float_Rep when operating in Initialize/Normalize_Scalars
+ -- mode. This is not just a matter of efficiency, but of functionality,
+ -- since Valid has a pragma Inline_Always, which is not permitted if
+ -- there are nested subprograms present.
+
Most_Significant_Word : constant Rep_Index :=
Rep_Last * Standard'Default_Bit_Order;
-- Finding the location of the Exponent_Word is a bit tricky.
-- This assumes that the range IEEE_Emin - 1 .. IEEE_Emax + 1
-- contains 2**N values, for some N in Natural.
- function To_Float is new Unchecked_Conversion (Float_Rep, T);
+ function To_Float is new Ada.Unchecked_Conversion (Float_Rep, T);
type Float_Access is access all T;
function To_Address is
- new Unchecked_Conversion (Float_Access, System.Address);
+ new Ada.Unchecked_Conversion (Float_Access, System.Address);
XA : constant System.Address := To_Address (Float_Access (X));
((E = IEEE_Emin - 1) and then abs To_Float (SR) = 1.0);
end Valid;
+ ---------------------
+ -- Unaligned_Valid --
+ ---------------------
+
+ function Unaligned_Valid (A : System.Address) return Boolean is
+ subtype FS is String (1 .. T'Size / Character'Size);
+ type FSP is access FS;
+
+ function To_FSP is new Ada.Unchecked_Conversion (Address, FSP);
+
+ Local_T : aliased T;
+
+ begin
+ To_FSP (Local_T'Address).all := To_FSP (A).all;
+ return Valid (Local_T'Access);
+ end Unaligned_Valid;
+
end System.Fat_Gen;
OSDN Git Service
