OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sem_attr.adb: Implement Machine_Rounding attribute 

2005-11-14  Robert Dewar  <dewar@adacore.com>
	    Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_attr.adb: Implement Machine_Rounding attribute
	(Analyze_Access_Attribute): The access attribute may appear within an
	aggregate that has been expanded into a loop.
	(Check_Task_Prefix): Add semantic check for attribute 'Callable and
	'Terminated whenever the prefix is of a task interface class-wide type.
	(Analyze_Attribute): Add semantic check for attribute 'Identity whenever
	the prefix is of a task interface class-wide type.

	* s-vaflop-vms-alpha.adb: Valid_D, Valid_F, Valid_G: Make Val constant
	to avoid warnings.

	* s-fatgen.ads, s-fatgen.adb (Machine_Rounding): New function
	Remove pragma Inline for [Unaligned_]Valid.
	Add comments that Valid routines do not work for Vax_Float

	* exp_attr.adb: Implement Machine_Rounding attribute

	* snames.h: Add entry for Machine_Rounding attribute

From-SVN: r106970
This commit is contained in:
Robert Dewar 2005-11-15 14:56:51 +01:00 committed by Arnaud Charlet
parent 7b9d0d6990
commit 65f01153ab
6 changed files with 514 additions and 230 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

340
gcc/ada/exp_attr.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -85,16 +85,17 @@ package body Exp_Attr is
procedure Expand_Fpt_Attribute procedure Expand_Fpt_Attribute
(N : Node_Id; (N : Node_Id;
Rtp : Entity_Id; Pkg : RE_Id;
Nam : Name_Id; Nam : Name_Id;
Args : List_Id); Args : List_Id);
-- This procedure expands a call to a floating-point attribute function. -- This procedure expands a call to a floating-point attribute function.
-- N is the attribute reference node, and Args is a list of arguments to -- N is the attribute reference node, and Args is a list of arguments to
-- be passed to the function call. Rtp is the root type of the floating -- be passed to the function call. Pkg identifies the package containing
-- point type involved (used to select the proper generic instantiation -- the appropriate instantiation of System.Fat_Gen. Float arguments in Args
-- of the package containing the attribute routines). The Nam argument -- have already been converted to the floating-point type for which Pkg was
-- is the attribute processing routine to be called. This is normally -- instantiated. The Nam argument is the relevant attribute processing
-- the same as the attribute name, except in the Unaligned_Valid case. -- routine to be called. This is the same as the attribute name, except in
-- the Unaligned_Valid case.
procedure Expand_Fpt_Attribute_R (N : Node_Id); procedure Expand_Fpt_Attribute_R (N : Node_Id);
-- This procedure expands a call to a floating-point attribute function -- This procedure expands a call to a floating-point attribute function
@ -123,6 +124,15 @@ package body Exp_Attr is
-- A reference to a type within its own scope is resolved to a reference -- A reference to a type within its own scope is resolved to a reference
-- to the current instance of the type in its initialization procedure. -- to the current instance of the type in its initialization procedure.
procedure Find_Fat_Info
(T : Entity_Id;
Fat_Type : out Entity_Id;
Fat_Pkg : out RE_Id);
-- Given a floating-point type T, identifies the package containing the
-- attributes for this type (returned in Fat_Pkg), and the corresponding
-- type for which this package was instantiated from Fat_Gen. Error if T
-- is not a floating-point type.
function Find_Stream_Subprogram function Find_Stream_Subprogram
(Typ : Entity_Id; (Typ : Entity_Id;
Nam : TSS_Name_Type) return Entity_Id; Nam : TSS_Name_Type) return Entity_Id;
@ -176,7 +186,7 @@ package body Exp_Attr is
if Check then if Check then
Insert_Action (N, Decl); Insert_Action (N, Decl);
else else
Insert_Action (N, Decl, All_Checks); Insert_Action (N, Decl, Suppress => All_Checks);
end if; end if;
if Installed then if Installed then
@ -260,18 +270,17 @@ package body Exp_Attr is
procedure Expand_Fpt_Attribute procedure Expand_Fpt_Attribute
(N : Node_Id; (N : Node_Id;
Rtp : Entity_Id; Pkg : RE_Id;
Nam : Name_Id; Nam : Name_Id;
Args : List_Id) Args : List_Id)
is is
Loc : constant Source_Ptr := Sloc (N); Loc : constant Source_Ptr := Sloc (N);
Typ : constant Entity_Id := Etype (N); Typ : constant Entity_Id := Etype (N);
Pkg : RE_Id;
Fnm : Node_Id; Fnm : Node_Id;
begin begin
-- The function name is the selected component Fat_xxx.yyy where xxx -- The function name is the selected component Attr_xxx.yyy where
-- is the floating-point root type, and yyy is the argument Nam. -- Attr_xxx is the package name, and yyy is the argument Nam.
-- Note: it would be more usual to have separate RE entries for each -- Note: it would be more usual to have separate RE entries for each
-- of the entities in the Fat packages, but first they have identical -- of the entities in the Fat packages, but first they have identical
@ -279,16 +288,6 @@ package body Exp_Attr is
-- meet the normal RE rule of separate names for all runtime entities), -- meet the normal RE rule of separate names for all runtime entities),
-- and second there would be an awful lot of them! -- and second there would be an awful lot of them!
if Rtp = Standard_Short_Float then
Pkg := RE_Fat_Short_Float;
elsif Rtp = Standard_Float then
Pkg := RE_Fat_Float;
elsif Rtp = Standard_Long_Float then
Pkg := RE_Fat_Long_Float;
else
Pkg := RE_Fat_Long_Long_Float;
end if;
Fnm := Fnm :=
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
Prefix => New_Reference_To (RTE (Pkg), Loc), Prefix => New_Reference_To (RTE (Pkg), Loc),
@ -302,7 +301,7 @@ package body Exp_Attr is
Rewrite (N, Rewrite (N,
Unchecked_Convert_To (Base_Type (Etype (N)), Unchecked_Convert_To (Base_Type (Etype (N)),
Make_Function_Call (Loc, Make_Function_Call (Loc,
Name => Fnm, Name => Fnm,
Parameter_Associations => Args))); Parameter_Associations => Args)));
Analyze_And_Resolve (N, Typ); Analyze_And_Resolve (N, Typ);
@ -318,12 +317,13 @@ package body Exp_Attr is
procedure Expand_Fpt_Attribute_R (N : Node_Id) is procedure Expand_Fpt_Attribute_R (N : Node_Id) is
E1 : constant Node_Id := First (Expressions (N)); E1 : constant Node_Id := First (Expressions (N));
Rtp : constant Entity_Id := Root_Type (Etype (E1)); Ftp : Entity_Id;
Pkg : RE_Id;
begin begin
Find_Fat_Info (Etype (E1), Ftp, Pkg);
Expand_Fpt_Attribute Expand_Fpt_Attribute
(N, Rtp, Attribute_Name (N), (N, Pkg, Attribute_Name (N),
New_List (Unchecked_Convert_To (Rtp, Relocate_Node (E1)))); New_List (Unchecked_Convert_To (Ftp, Relocate_Node (E1))));
end Expand_Fpt_Attribute_R; end Expand_Fpt_Attribute_R;
----------------------------- -----------------------------
@ -337,14 +337,15 @@ package body Exp_Attr is
procedure Expand_Fpt_Attribute_RI (N : Node_Id) is procedure Expand_Fpt_Attribute_RI (N : Node_Id) is
E1 : constant Node_Id := First (Expressions (N)); E1 : constant Node_Id := First (Expressions (N));
Rtp : constant Entity_Id := Root_Type (Etype (E1)); Ftp : Entity_Id;
Pkg : RE_Id;
E2 : constant Node_Id := Next (E1); E2 : constant Node_Id := Next (E1);
begin begin
Find_Fat_Info (Etype (E1), Ftp, Pkg);
Expand_Fpt_Attribute Expand_Fpt_Attribute
(N, Rtp, Attribute_Name (N), (N, Pkg, Attribute_Name (N),
New_List ( New_List (
Unchecked_Convert_To (Rtp, Relocate_Node (E1)), Unchecked_Convert_To (Ftp, Relocate_Node (E1)),
Unchecked_Convert_To (Standard_Integer, Relocate_Node (E2)))); Unchecked_Convert_To (Standard_Integer, Relocate_Node (E2))));
end Expand_Fpt_Attribute_RI; end Expand_Fpt_Attribute_RI;
@ -358,15 +359,16 @@ package body Exp_Attr is
procedure Expand_Fpt_Attribute_RR (N : Node_Id) is procedure Expand_Fpt_Attribute_RR (N : Node_Id) is
E1 : constant Node_Id := First (Expressions (N)); E1 : constant Node_Id := First (Expressions (N));
Rtp : constant Entity_Id := Root_Type (Etype (E1)); Ftp : Entity_Id;
Pkg : RE_Id;
E2 : constant Node_Id := Next (E1); E2 : constant Node_Id := Next (E1);
begin begin
Find_Fat_Info (Etype (E1), Ftp, Pkg);
Expand_Fpt_Attribute Expand_Fpt_Attribute
(N, Rtp, Attribute_Name (N), (N, Pkg, Attribute_Name (N),
New_List ( New_List (
Unchecked_Convert_To (Rtp, Relocate_Node (E1)), Unchecked_Convert_To (Ftp, Relocate_Node (E1)),
Unchecked_Convert_To (Rtp, Relocate_Node (E2)))); Unchecked_Convert_To (Ftp, Relocate_Node (E2))));
end Expand_Fpt_Attribute_RR; end Expand_Fpt_Attribute_RR;
---------------------------------- ----------------------------------
@ -1011,8 +1013,31 @@ package body Exp_Attr is
when Attribute_Callable => Callable : when Attribute_Callable => Callable :
begin begin
Rewrite (N, -- We have an object of a task interface class-wide type as a prefix
Build_Call_With_Task (Pref, RTE (RE_Callable))); -- to Callable. Generate:
-- callable (Pref._disp_get_task_id);
if Ada_Version >= Ada_05
and then Ekind (Etype (Pref)) = E_Class_Wide_Type
and then Is_Interface (Etype (Pref))
and then Is_Task_Interface (Etype (Pref))
then
Rewrite (N,
Make_Function_Call (Loc,
Name =>
New_Reference_To (RTE (RE_Callable), Loc),
Parameter_Associations => New_List (
Make_Selected_Component (Loc,
Prefix =>
New_Copy_Tree (Pref),
Selector_Name =>
Make_Identifier (Loc, Name_uDisp_Get_Task_Id)))));
else
Rewrite (N,
Build_Call_With_Task (Pref, RTE (RE_Callable)));
end if;
Analyze_And_Resolve (N, Standard_Boolean); Analyze_And_Resolve (N, Standard_Boolean);
end Callable; end Callable;
@ -1630,8 +1655,8 @@ package body Exp_Attr is
-- expands into -- expands into
-- Result_Type (System.Fore (Long_Long_Float (Type'First)), -- Result_Type (System.Fore (Universal_Real (Type'First)),
-- Long_Long_Float (Type'Last)) -- Universal_Real (Type'Last))
-- Note that we know that the type is a non-static subtype, or Fore -- Note that we know that the type is a non-static subtype, or Fore
-- would have itself been computed dynamically in Eval_Attribute. -- would have itself been computed dynamically in Eval_Attribute.
@ -1647,12 +1672,12 @@ package body Exp_Attr is
Name => New_Reference_To (RTE (RE_Fore), Loc), Name => New_Reference_To (RTE (RE_Fore), Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
Convert_To (Standard_Long_Long_Float, Convert_To (Universal_Real,
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (Ptyp, Loc), Prefix => New_Reference_To (Ptyp, Loc),
Attribute_Name => Name_First)), Attribute_Name => Name_First)),
Convert_To (Standard_Long_Long_Float, Convert_To (Universal_Real,
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => New_Reference_To (Ptyp, Loc), Prefix => New_Reference_To (Ptyp, Loc),
Attribute_Name => Name_Last)))))); Attribute_Name => Name_Last))))));
@ -2283,6 +2308,17 @@ package body Exp_Attr is
when Attribute_Machine => when Attribute_Machine =>
Expand_Fpt_Attribute_R (N); Expand_Fpt_Attribute_R (N);
----------------------
-- Machine_Rounding --
----------------------
-- Transforms 'Machine_Rounding into a call to the floating-point
-- attribute function Machine_Rounding in Fat_xxx (where xxx is the root
-- type).
when Attribute_Machine_Rounding =>
Expand_Fpt_Attribute_R (N);
------------------ ------------------
-- Machine_Size -- -- Machine_Size --
------------------ ------------------
@ -2425,7 +2461,7 @@ package body Exp_Attr is
end if; end if;
Analyze_And_Resolve (N, Btyp, All_Checks); Analyze_And_Resolve (N, Btyp, Suppress => All_Checks);
end Mod_Case; end Mod_Case;
----------- -----------
@ -3211,7 +3247,7 @@ package body Exp_Attr is
Rewrite (Prefix (N), New_Occurrence_Of (Entity (Pref), Loc)); Rewrite (Prefix (N), New_Occurrence_Of (Entity (Pref), Loc));
return; return;
-- For x'Size applied to an object of a class-wide type, transform -- For X'Size applied to an object of a class-wide type, transform
-- X'Size into a call to the primitive operation _Size applied to X. -- X'Size into a call to the primitive operation _Size applied to X.
elsif Is_Class_Wide_Type (Ptyp) then elsif Is_Class_Wide_Type (Ptyp) then
@ -3268,8 +3304,8 @@ package body Exp_Attr is
else else
Apply_Universal_Integer_Attribute_Checks (N); Apply_Universal_Integer_Attribute_Checks (N);
-- If we have Size applied to a formal parameter, that is a -- If Size is applied to a formal parameter that is of a packed
-- packed array subtype, then apply size to the actual subtype. -- array subtype, then apply Size to the actual subtype.
if Is_Entity_Name (Pref) if Is_Entity_Name (Pref)
and then Is_Formal (Entity (Pref)) and then Is_Formal (Entity (Pref))
@ -3284,6 +3320,20 @@ package body Exp_Attr is
Analyze_And_Resolve (N, Typ); Analyze_And_Resolve (N, Typ);
end if; end if;
-- If Size is applied to a dereference of an access to
-- unconstrained packed array, GIGI needs to see its
-- unconstrained nominal type, but also a hint to the actual
-- constrained type.
if Nkind (Pref) = N_Explicit_Dereference
and then Is_Array_Type (Etype (Pref))
and then not Is_Constrained (Etype (Pref))
and then Is_Packed (Etype (Pref))
then
Set_Actual_Designated_Subtype (Pref,
Get_Actual_Subtype (Pref));
end if;
return; return;
end if; end if;
@ -3590,7 +3640,28 @@ package body Exp_Attr is
when Attribute_Terminated => Terminated : when Attribute_Terminated => Terminated :
begin begin
if Restricted_Profile then -- The prefix of Terminated is of a task interface class-wide type.
-- Generate:
-- terminated (Pref._disp_get_task_id);
if Ada_Version >= Ada_05
and then Ekind (Etype (Pref)) = E_Class_Wide_Type
and then Is_Interface (Etype (Pref))
and then Is_Task_Interface (Etype (Pref))
then
Rewrite (N,
Make_Function_Call (Loc,
Name =>
New_Reference_To (RTE (RE_Terminated), Loc),
Parameter_Associations => New_List (
Make_Selected_Component (Loc,
Prefix =>
New_Copy_Tree (Pref),
Selector_Name =>
Make_Identifier (Loc, Name_uDisp_Get_Task_Id)))));
elsif Restricted_Profile then
Rewrite (N, Rewrite (N,
Build_Call_With_Task (Pref, RTE (RE_Restricted_Terminated))); Build_Call_With_Task (Pref, RTE (RE_Restricted_Terminated)));
@ -3641,7 +3712,26 @@ package body Exp_Attr is
---------------------- ----------------------
when Attribute_Unchecked_Access => when Attribute_Unchecked_Access =>
Expand_Access_To_Type (N);
-- Ada 2005 (AI-251): If the designated type is an interface, then
-- rewrite the referenced object as a conversion to force the
-- displacement of the pointer to the secondary dispatch table.
if Is_Interface (Directly_Designated_Type (Btyp)) then
declare
Ref_Object : constant Node_Id := Get_Referenced_Object (Pref);
Conversion : Node_Id;
begin
Conversion := Convert_To (Typ, New_Copy_Tree (Ref_Object));
Rewrite (N, Conversion);
Analyze_And_Resolve (N, Typ);
end;
-- Otherwise this is like normal Access without a check
else
Expand_Access_To_Type (N);
end if;
----------------- -----------------
-- UET_Address -- -- UET_Address --
@ -3687,7 +3777,26 @@ package body Exp_Attr is
------------------------- -------------------------
when Attribute_Unrestricted_Access => when Attribute_Unrestricted_Access =>
Expand_Access_To_Type (N);
-- Ada 2005 (AI-251): If the designated type is an interface, then
-- rewrite the referenced object as a conversion to force the
-- displacement of the pointer to the secondary dispatch table.
if Is_Interface (Directly_Designated_Type (Btyp)) then
declare
Ref_Object : constant Node_Id := Get_Referenced_Object (Pref);
Conversion : Node_Id;
begin
Conversion := Convert_To (Typ, New_Copy_Tree (Ref_Object));
Rewrite (N, Conversion);
Analyze_And_Resolve (N, Typ);
end;
-- Otherwise this is like Access without a check
else
Expand_Access_To_Type (N);
end if;
--------------- ---------------
-- VADS_Size -- -- VADS_Size --
@ -3824,43 +3933,50 @@ package body Exp_Attr is
if Is_Floating_Point_Type (Ptyp) then if Is_Floating_Point_Type (Ptyp) then
declare declare
Rtp : constant Entity_Id := Root_Type (Etype (Pref)); Pkg : RE_Id;
Ftp : Entity_Id;
begin begin
-- For vax fpt types, call appropriate routine in special vax -- For vax fpt types, call appropriate routine in special vax
-- floating point unit. We do not have to worry about loads in -- floating point unit. We do not have to worry about loads in
-- this case, since these types have no signalling NaN's. -- this case, since these types have no signalling NaN's.
if Vax_Float (Rtp) then if Vax_Float (Btyp) then
Expand_Vax_Valid (N); Expand_Vax_Valid (N);
-- If the floating-point object might be unaligned, we need -- Non VAX float case
-- to call the special routine Unaligned_Valid, which makes
-- the needed copy, being careful not to load the value into
-- any floating-point register. The argument in this case is
-- obj'Address (see Unchecked_Valid routine in s-fatgen.ads).
elsif Is_Possibly_Unaligned_Object (Pref) then
Set_Attribute_Name (N, Name_Unaligned_Valid);
Expand_Fpt_Attribute
(N, Rtp, Name_Unaligned_Valid,
New_List (
Make_Attribute_Reference (Loc,
Prefix => Relocate_Node (Pref),
Attribute_Name => Name_Address)));
-- In the normal case where we are sure the object is aligned,
-- we generate a call to Valid, and the argument in this case
-- is obj'Unrestricted_Access (after converting obj to the
-- right floating-point type).
else else
Expand_Fpt_Attribute Find_Fat_Info (Etype (Pref), Ftp, Pkg);
(N, Rtp, Name_Valid,
New_List ( -- If the floating-point object might be unaligned, we need
Make_Attribute_Reference (Loc, -- to call the special routine Unaligned_Valid, which makes
Prefix => Unchecked_Convert_To (Rtp, Pref), -- the needed copy, being careful not to load the value into
Attribute_Name => Name_Unrestricted_Access))); -- any floating-point register. The argument in this case is
-- obj'Address (see Unchecked_Valid routine in Fat_Gen).
if Is_Possibly_Unaligned_Object (Pref) then
Set_Attribute_Name (N, Name_Unaligned_Valid);
Expand_Fpt_Attribute
(N, Pkg, Name_Unaligned_Valid,
New_List (
Make_Attribute_Reference (Loc,
Prefix => Relocate_Node (Pref),
Attribute_Name => Name_Address)));
-- In the normal case where we are sure the object is
-- aligned, we generate a call to Valid, and the argument in
-- this case is obj'Unrestricted_Access (after converting
-- obj to the right floating-point type).
else
Expand_Fpt_Attribute
(N, Pkg, Name_Valid,
New_List (
Make_Attribute_Reference (Loc,
Prefix => Unchecked_Convert_To (Ftp, Pref),
Attribute_Name => Name_Unrestricted_Access)));
end if;
end if; end if;
-- One more task, we still need a range check. Required -- One more task, we still need a range check. Required
@ -4488,6 +4604,78 @@ package body Exp_Attr is
Reason => CE_Overflow_Check_Failed)); Reason => CE_Overflow_Check_Failed));
end Expand_Pred_Succ; end Expand_Pred_Succ;
-------------------
-- Find_Fat_Info --
-------------------
procedure Find_Fat_Info
(T : Entity_Id;
Fat_Type : out Entity_Id;
Fat_Pkg : out RE_Id)
is
Btyp : constant Entity_Id := Base_Type (T);
Rtyp : constant Entity_Id := Root_Type (T);
Digs : constant Nat := UI_To_Int (Digits_Value (Btyp));
begin
-- If the base type is VAX float, then get appropriate VAX float type
if Vax_Float (Btyp) then
case Digs is
when 6 =>
Fat_Type := RTE (RE_Fat_VAX_F);
Fat_Pkg := RE_Attr_VAX_F_Float;
when 9 =>
Fat_Type := RTE (RE_Fat_VAX_D);
Fat_Pkg := RE_Attr_VAX_D_Float;
when 15 =>
Fat_Type := RTE (RE_Fat_VAX_G);
Fat_Pkg := RE_Attr_VAX_G_Float;
when others =>
raise Program_Error;
end case;
-- If root type is VAX float, this is the case where the library has
-- been recompiled in VAX float mode, and we have an IEEE float type.
-- This is when we use the special IEEE Fat packages.
elsif Vax_Float (Rtyp) then
case Digs is
when 6 =>
Fat_Type := RTE (RE_Fat_IEEE_Short);
Fat_Pkg := RE_Attr_IEEE_Short;
when 15 =>
Fat_Type := RTE (RE_Fat_IEEE_Long);
Fat_Pkg := RE_Attr_IEEE_Long;
when others =>
raise Program_Error;
end case;
-- If neither the base type nor the root type is VAX_Float then VAX
-- float is out of the picture, and we can just use the root type.
else
Fat_Type := Rtyp;
if Fat_Type = Standard_Short_Float then
Fat_Pkg := RE_Attr_Short_Float;
elsif Fat_Type = Standard_Float then
Fat_Pkg := RE_Attr_Float;
elsif Fat_Type = Standard_Long_Float then
Fat_Pkg := RE_Attr_Long_Float;
elsif Fat_Type = Standard_Long_Long_Float then
Fat_Pkg := RE_Attr_Long_Long_Float;
else
raise Program_Error;
end if;
end if;
end Find_Fat_Info;
---------------------------- ----------------------------
-- Find_Stream_Subprogram -- -- Find_Stream_Subprogram --
---------------------------- ----------------------------

121
gcc/ada/s-fatgen.adb
View File

@ -99,10 +99,8 @@ package body System.Fat_Gen is
begin begin
if Towards = X then if Towards = X then
return X; return X;
elsif Towards > X then elsif Towards > X then
return Succ (X); return Succ (X);
else else
return Pred (X); return Pred (X);
end if; end if;
@ -114,14 +112,11 @@ package body System.Fat_Gen is
function Ceiling (X : T) return T is function Ceiling (X : T) return T is
XT : constant T := Truncation (X); XT : constant T := Truncation (X);
begin begin
if X <= 0.0 then if X <= 0.0 then
return XT; return XT;
elsif X = XT then elsif X = XT then
return X; return X;
else else
return XT + 1.0; return XT + 1.0;
end if; end if;
@ -175,7 +170,7 @@ package body System.Fat_Gen is
-- T'Machine_Emin - T'Machine_Mantissa, which would preserve -- T'Machine_Emin - T'Machine_Mantissa, which would preserve
-- monotonicity of the exponent function ??? -- monotonicity of the exponent function ???
-- Check for infinities, transfinites, whatnot. -- Check for infinities, transfinites, whatnot
elsif X > T'Safe_Last then elsif X > T'Safe_Last then
Frac := Invrad; Frac := Invrad;
@ -193,7 +188,7 @@ package body System.Fat_Gen is
Ax : T := abs X; Ax : T := abs X;
Ex : UI := 0; Ex : UI := 0;
-- Ax * Rad ** Ex is invariant. -- Ax * Rad ** Ex is invariant
begin begin
if Ax >= 1.0 then if Ax >= 1.0 then
@ -256,7 +251,6 @@ package body System.Fat_Gen is
function Exponent (X : T) return UI is function Exponent (X : T) return UI is
X_Frac : T; X_Frac : T;
X_Exp : UI; X_Exp : UI;
begin begin
Decompose (X, X_Frac, X_Exp); Decompose (X, X_Frac, X_Exp);
return X_Exp; return X_Exp;
@ -268,14 +262,11 @@ package body System.Fat_Gen is
function Floor (X : T) return T is function Floor (X : T) return T is
XT : constant T := Truncation (X); XT : constant T := Truncation (X);
begin begin
if X >= 0.0 then if X >= 0.0 then
return XT; return XT;
elsif XT = X then elsif XT = X then
return X; return X;
else else
return XT - 1.0; return XT - 1.0;
end if; end if;
@ -288,7 +279,6 @@ package body System.Fat_Gen is
function Fraction (X : T) return T is function Fraction (X : T) return T is
X_Frac : T; X_Frac : T;
X_Exp : UI; X_Exp : UI;
begin begin
Decompose (X, X_Frac, X_Exp); Decompose (X, X_Frac, X_Exp);
return X_Frac; return X_Frac;
@ -366,6 +356,38 @@ package body System.Fat_Gen is
return Temp; return Temp;
end Machine; end Machine;
----------------------
-- Machine_Rounding --
----------------------
-- For now, the implementation is identical to that of Rounding, which is
-- a permissible behavior, but is not the most efficient possible approach.
function Machine_Rounding (X : T) return T is
Result : T;
Tail : T;
begin
Result := Truncation (abs X);
Tail := abs X - Result;
if Tail >= 0.5 then
Result := Result + 1.0;
end if;
if X > 0.0 then
return Result;
elsif X < 0.0 then
return -Result;
-- For zero case, make sure sign of zero is preserved
else
return X;
end if;
end Machine_Rounding;
----------- -----------
-- Model -- -- Model --
----------- -----------
@ -542,7 +564,7 @@ package body System.Fat_Gen is
return X; return X;
end if; end if;
-- Nonzero x. essentially, just multiply repeatedly by Rad ** (+-2**n). -- Nonzero x. essentially, just multiply repeatedly by Rad ** (+-2**n)
declare declare
Y : T := X; Y : T := X;
@ -587,6 +609,7 @@ package body System.Fat_Gen is
end if; end if;
-- 0 <= Ex < Log_Power (N) -- 0 <= Ex < Log_Power (N)
end loop; end loop;
-- Ex = 0 -- Ex = 0
@ -652,7 +675,7 @@ package body System.Fat_Gen is
-- The basic approach is to compute -- The basic approach is to compute
-- T'Machine (RM1 + N) - RM1. -- T'Machine (RM1 + N) - RM1
-- where N >= 0.0 and RM1 = radix ** (mantissa - 1) -- where N >= 0.0 and RM1 = radix ** (mantissa - 1)
@ -693,7 +716,6 @@ package body System.Fat_Gen is
return X; return X;
end if; end if;
end if; end if;
end Truncation; end Truncation;
----------------------- -----------------------
@ -727,13 +749,16 @@ package body System.Fat_Gen is
else else
return X; return X;
end if; end if;
end Unbiased_Rounding; end Unbiased_Rounding;
----------- -----------
-- Valid -- -- Valid --
----------- -----------
-- Note: this routine does not work for VAX float. We compensate for this
-- in Exp_Attr by using the Valid functions in Vax_Float_Operations rather
-- than the corresponding instantiation of this function.
function Valid (X : access T) return Boolean is function Valid (X : access T) return Boolean is
IEEE_Emin : constant Integer := T'Machine_Emin - 1; IEEE_Emin : constant Integer := T'Machine_Emin - 1;
@ -744,17 +769,17 @@ package body System.Fat_Gen is
subtype IEEE_Exponent_Range is subtype IEEE_Exponent_Range is
Integer range IEEE_Emin - 1 .. IEEE_Emax + 1; Integer range IEEE_Emin - 1 .. IEEE_Emax + 1;
-- The implementation of this floating point attribute uses -- The implementation of this floating point attribute uses a
-- a representation type Float_Rep that allows direct access to -- representation type Float_Rep that allows direct access to the
-- the exponent and mantissa parts of a floating point number. -- exponent and mantissa parts of a floating point number.
-- The Float_Rep type is an array of Float_Word elements. This -- The Float_Rep type is an array of Float_Word elements. This
-- representation is chosen to make it possible to size the -- representation is chosen to make it possible to size the type based
-- type based on a generic parameter. Since the array size is -- on a generic parameter. Since the array size is known at compile
-- known at compile-time, efficient code can still be generated. -- time, efficient code can still be generated. The size of Float_Word
-- The size of Float_Word elements should be large enough to allow -- elements should be large enough to allow accessing the exponent in
-- accessing the exponent in one read, but small enough so that all -- one read, but small enough so that all floating point object sizes
-- floating point object sizes are a multiple of the Float_Word'Size. -- are a multiple of the Float_Word'Size.
-- The following conditions must be met for all possible -- The following conditions must be met for all possible
-- instantiations of the attributes package: -- instantiations of the attributes package:
@ -764,9 +789,9 @@ package body System.Fat_Gen is
-- - The exponent and sign are completely contained in a single -- - The exponent and sign are completely contained in a single
-- component of Float_Rep, named Most_Significant_Word (MSW). -- component of Float_Rep, named Most_Significant_Word (MSW).
-- - The sign occupies the most significant bit of the MSW -- - The sign occupies the most significant bit of the MSW and the
-- and the exponent is in the following bits. -- exponent is in the following bits. Unused bits (if any) are in
-- Unused bits (if any) are in the least significant part. -- the least significant part.
type Float_Word is mod 2**Positive'Min (System.Word_Size, 32); type Float_Word is mod 2**Positive'Min (System.Word_Size, 32);
type Rep_Index is range 0 .. 7; type Rep_Index is range 0 .. 7;
@ -775,12 +800,12 @@ package body System.Fat_Gen is
(T'Size + Float_Word'Size - 1) / Float_Word'Size; (T'Size + Float_Word'Size - 1) / Float_Word'Size;
Rep_Last : constant Rep_Index := Rep_Index'Min Rep_Last : constant Rep_Index := Rep_Index'Min
(Rep_Index (Rep_Words - 1), (T'Mantissa + 16) / Float_Word'Size); (Rep_Index (Rep_Words - 1), (T'Mantissa + 16) / Float_Word'Size);
-- Determine the number of Float_Words needed for representing -- Determine the number of Float_Words needed for representing the
-- the entire floating-poinit value. Do not take into account -- entire floating-point value. Do not take into account excessive
-- excessive padding, as occurs on IA-64 where 80 bits floats get -- padding, as occurs on IA-64 where 80 bits floats get padded to 128
-- padded to 128 bits. In general, the exponent field cannot -- bits. In general, the exponent field cannot be larger than 15 bits,
-- be larger than 15 bits, even for 128-bit floating-poin t types, -- even for 128-bit floating-poin t types, so the final format size
-- so the final format size won't be larger than T'Mantissa + 16. -- won't be larger than T'Mantissa + 16.
type Float_Rep is type Float_Rep is
array (Rep_Index range 0 .. Rep_Index (Rep_Words - 1)) of Float_Word; array (Rep_Index range 0 .. Rep_Index (Rep_Words - 1)) of Float_Word;
@ -794,26 +819,26 @@ package body System.Fat_Gen is
Most_Significant_Word : constant Rep_Index := Most_Significant_Word : constant Rep_Index :=
Rep_Last * Standard'Default_Bit_Order; Rep_Last * Standard'Default_Bit_Order;
-- Finding the location of the Exponent_Word is a bit tricky. -- Finding the location of the Exponent_Word is a bit tricky. In general
-- In general we assume Word_Order = Bit_Order. -- we assume Word_Order = Bit_Order. This expression needs to be refined
-- This expression needs to be refined for VMS. -- for VMS.
Exponent_Factor : constant Float_Word := Exponent_Factor : constant Float_Word :=
2**(Float_Word'Size - 1) / 2**(Float_Word'Size - 1) /
Float_Word (IEEE_Emax - IEEE_Emin + 3) * Float_Word (IEEE_Emax - IEEE_Emin + 3) *
Boolean'Pos (Most_Significant_Word /= 2) + Boolean'Pos (Most_Significant_Word /= 2) +
Boolean'Pos (Most_Significant_Word = 2); Boolean'Pos (Most_Significant_Word = 2);
-- Factor that the extracted exponent needs to be divided by -- Factor that the extracted exponent needs to be divided by to be in
-- to be in range 0 .. IEEE_Emax - IEEE_Emin + 2. -- range 0 .. IEEE_Emax - IEEE_Emin + 2. Special kludge: Exponent_Factor
-- Special kludge: Exponent_Factor is 1 for x86/IA64 double extended -- is 1 for x86/IA64 double extended as GCC adds unused bits to the
-- as GCC adds unused bits to the type. -- type.
Exponent_Mask : constant Float_Word := Exponent_Mask : constant Float_Word :=
Float_Word (IEEE_Emax - IEEE_Emin + 2) * Float_Word (IEEE_Emax - IEEE_Emin + 2) *
Exponent_Factor; Exponent_Factor;
-- Value needed to mask out the exponent field. -- Value needed to mask out the exponent field. This assumes that the
-- This assumes that the range IEEE_Emin - 1 .. IEEE_Emax + 1 -- range IEEE_Emin - 1 .. IEEE_Emax + contains 2**N values, for some N
-- contains 2**N values, for some N in Natural. -- in Natural.
function To_Float is new Ada.Unchecked_Conversion (Float_Rep, T); function To_Float is new Ada.Unchecked_Conversion (Float_Rep, T);
@ -834,8 +859,8 @@ package body System.Fat_Gen is
Integer ((R (Most_Significant_Word) and Exponent_Mask) / Integer ((R (Most_Significant_Word) and Exponent_Mask) /
Exponent_Factor) Exponent_Factor)
- IEEE_Bias; - IEEE_Bias;
-- Mask/Shift T to only get bits from the exponent -- Mask/Shift T to only get bits from the exponent. Then convert biased
-- Then convert biased value to integer value. -- value to integer value.
SR : Float_Rep; SR : Float_Rep;
-- Float_Rep representation of significant of X.all -- Float_Rep representation of significant of X.all
@ -843,8 +868,8 @@ package body System.Fat_Gen is
begin begin
if T'Denorm then if T'Denorm then
-- All denormalized numbers are valid, so only invalid numbers -- All denormalized numbers are valid, so only invalid numbers are
-- are overflows and NaN's, both with exponent = Emax + 1. -- overflows and NaN's, both with exponent = Emax + 1.
return E /= IEEE_Emax + 1; return E /= IEEE_Emax + 1;

13
gcc/ada/s-fatgen.ads
View File

@ -71,6 +71,8 @@ package System.Fat_Gen is
function Machine (X : T) return T; function Machine (X : T) return T;
function Machine_Rounding (X : T) return T;
function Model (X : T) return T; function Model (X : T) return T;
function Pred (X : T) return T; function Pred (X : T) return T;
@ -95,6 +97,8 @@ package System.Fat_Gen is
-- register, and the whole point of 'Valid is to prevent exceptions. -- register, and the whole point of 'Valid is to prevent exceptions.
-- Note that the object of type T must have the natural alignment -- Note that the object of type T must have the natural alignment
-- for type T. See Unaligned_Valid for further discussion. -- for type T. See Unaligned_Valid for further discussion.
--
-- Note: this routine does not work for Vax_Float ???
function Unaligned_Valid (A : System.Address) return Boolean; function Unaligned_Valid (A : System.Address) return Boolean;
-- This version of Valid is used if the floating-point value to -- This version of Valid is used if the floating-point value to
@ -112,11 +116,16 @@ package System.Fat_Gen is
-- not require strict alignment (e.g. the ia32/x86), since on a -- not require strict alignment (e.g. the ia32/x86), since on a
-- target not requiring strict alignment, it is fine to pass a -- target not requiring strict alignment, it is fine to pass a
-- non-aligned value to the standard Valid routine. -- non-aligned value to the standard Valid routine.
--
-- Note: this routine does not work for Vax_Float ???
private private
pragma Inline (Machine); pragma Inline (Machine);
pragma Inline (Model); pragma Inline (Model);
pragma Inline_Always (Valid);
pragma Inline_Always (Unaligned_Valid); -- Note: previously the validity checking subprograms (Unaligned_Valid and
-- Valid) were also inlined, but this was changed since there were some
-- problems with this inlining in optimized mode, and in any case it seems
-- better to avoid this inlining (space and robustness considerations).
end System.Fat_Gen; end System.Fat_Gen;

6
gcc/ada/s-vaflop-vms-alpha.adb
View File

@ -626,7 +626,7 @@ package body System.Vax_Float_Operations is
-- accurate, but is good enough in practice. -- accurate, but is good enough in practice.
function Valid_D (Arg : D) return Boolean is function Valid_D (Arg : D) return Boolean is
Val : T := G_To_T (D_To_G (Arg)); Val : constant T := G_To_T (D_To_G (Arg));
begin begin
return Val'Valid; return Val'Valid;
end Valid_D; end Valid_D;
@ -639,7 +639,7 @@ package body System.Vax_Float_Operations is
-- accurate, but is good enough in practice. -- accurate, but is good enough in practice.
function Valid_F (Arg : F) return Boolean is function Valid_F (Arg : F) return Boolean is
Val : S := F_To_S (Arg); Val : constant S := F_To_S (Arg);
begin begin
return Val'Valid; return Val'Valid;
end Valid_F; end Valid_F;
@ -652,7 +652,7 @@ package body System.Vax_Float_Operations is
-- accurate, but is good enough in practice. -- accurate, but is good enough in practice.
function Valid_G (Arg : G) return Boolean is function Valid_G (Arg : G) return Boolean is
Val : T := G_To_T (Arg); Val : constant T := G_To_T (Arg);
begin begin
return Val'Valid; return Val'Valid;
end Valid_G; end Valid_G;

93
gcc/ada/sem_attr.adb
View File

@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- 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 -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
@ -492,9 +492,16 @@ package body Sem_Attr is
-- accesses are allowed (references to the current type instance). -- accesses are allowed (references to the current type instance).
if Is_Entity_Name (P) then if Is_Entity_Name (P) then
Scop := Current_Scope;
Typ := Entity (P); Typ := Entity (P);
-- The reference may appear in an aggregate that has been expanded
-- into a loop. Locate scope of type definition, if any.
Scop := Current_Scope;
while Ekind (Scop) = E_Loop loop
Scop := Scope (Scop);
end loop;
if Is_Type (Typ) then if Is_Type (Typ) then
-- OK if we are within the scope of a limited type -- OK if we are within the scope of a limited type
@ -516,6 +523,7 @@ package body Sem_Attr is
loop loop
Q := Parent (Q); Q := Parent (Q);
end loop; end loop;
if Present (Q) then if Present (Q) then
Set_Has_Per_Object_Constraint ( Set_Has_Per_Object_Constraint (
Defining_Identifier (Q), True); Defining_Identifier (Q), True);
@ -585,11 +593,9 @@ package body Sem_Attr is
declare declare
Index : Interp_Index; Index : Interp_Index;
It : Interp; It : Interp;
begin begin
Set_Etype (N, Any_Type); Set_Etype (N, Any_Type);
Get_First_Interp (P, Index, It); Get_First_Interp (P, Index, It);
while Present (It.Typ) loop while Present (It.Typ) loop
Acc_Type := Build_Access_Object_Type (It.Typ); Acc_Type := Build_Access_Object_Type (It.Typ);
Add_One_Interp (N, Acc_Type, Acc_Type); Add_One_Interp (N, Acc_Type, Acc_Type);
@ -1373,13 +1379,27 @@ package body Sem_Attr is
begin begin
Analyze (P); Analyze (P);
-- Ada 2005 (AI-345): Attribute 'Terminated can be applied to
-- task interface class-wide types.
if Is_Task_Type (Etype (P)) if Is_Task_Type (Etype (P))
or else (Is_Access_Type (Etype (P)) or else (Is_Access_Type (Etype (P))
and then Is_Task_Type (Designated_Type (Etype (P)))) and then Is_Task_Type (Designated_Type (Etype (P))))
or else (Ada_Version >= Ada_05
and then Ekind (Etype (P)) = E_Class_Wide_Type
and then Is_Interface (Etype (P))
and then Is_Task_Interface (Etype (P)))
then then
Resolve (P); Resolve (P);
else else
Error_Attr ("prefix of % attribute must be a task", P); if Ada_Version >= Ada_05 then
Error_Attr ("prefix of % attribute must be a task or a task "
& "interface class-wide object", P);
else
Error_Attr ("prefix of % attribute must be a task", P);
end if;
end if; end if;
end Check_Task_Prefix; end Check_Task_Prefix;
@ -2793,16 +2813,28 @@ package body Sem_Attr is
if Etype (P) = Standard_Exception_Type then if Etype (P) = Standard_Exception_Type then
Set_Etype (N, RTE (RE_Exception_Id)); Set_Etype (N, RTE (RE_Exception_Id));
-- Ada 2005 (AI-345): Attribute 'Identity may be applied to
-- task interface class-wide types.
elsif Is_Task_Type (Etype (P)) elsif Is_Task_Type (Etype (P))
or else (Is_Access_Type (Etype (P)) or else (Is_Access_Type (Etype (P))
and then Is_Task_Type (Designated_Type (Etype (P)))) and then Is_Task_Type (Designated_Type (Etype (P))))
or else (Ada_Version >= Ada_05
and then Ekind (Etype (P)) = E_Class_Wide_Type
and then Is_Interface (Etype (P))
and then Is_Task_Interface (Etype (P)))
then then
Resolve (P); Resolve (P);
Set_Etype (N, RTE (RO_AT_Task_Id)); Set_Etype (N, RTE (RO_AT_Task_Id));
else else
Error_Attr ("prefix of % attribute must be a task or an " if Ada_Version >= Ada_05 then
& "exception", P); Error_Attr ("prefix of % attribute must be an exception, a "
& "task or a task interface class-wide object", P);
else
Error_Attr ("prefix of % attribute must be a task or an "
& "exception", P);
end if;
end if; end if;
----------- -----------
@ -2962,6 +2994,15 @@ package body Sem_Attr is
Check_E0; Check_E0;
Set_Etype (N, Universal_Integer); Set_Etype (N, Universal_Integer);
----------------------
-- Machine_Rounding --
----------------------
when Attribute_Machine_Rounding =>
Check_Floating_Point_Type_1;
Set_Etype (N, P_Base_Type);
Resolve (E1, P_Base_Type);
-------------------- --------------------
-- Machine_Rounds -- -- Machine_Rounds --
-------------------- --------------------
@ -5481,6 +5522,20 @@ package body Sem_Attr is
Fold_Uint (N, Uint_2, True); Fold_Uint (N, Uint_2, True);
end if; end if;
----------------------
-- Machine_Rounding --
----------------------
-- Note: for the folding case, it is fine to treat Machine_Rounding
-- exactly the same way as Rounding, since this is one of the allowed
-- behaviors, and performance is not an issue here. It might be a bit
-- better to give the same result as it would give at run-time, even
-- though the non-determinism is certainly permitted.
when Attribute_Machine_Rounding =>
Fold_Ureal (N,
Eval_Fat.Rounding (P_Root_Type, Expr_Value_R (E1)), Static);
-------------------- --------------------
-- Machine_Rounds -- -- Machine_Rounds --
-------------------- --------------------
@ -6243,7 +6298,6 @@ package body Sem_Attr is
end if; end if;
Rewrite (N, New_Occurrence_Of (RTE (Id), Loc)); Rewrite (N, New_Occurrence_Of (RTE (Id), Loc));
end Type_Class; end Type_Class;
----------------------- -----------------------
@ -7685,12 +7739,19 @@ package body Sem_Attr is
return True; return True;
end if; end if;
if Nam = TSS_Stream_Input then -- In Ada 2005, Input can invoke Read, and Output can invoke Write
return Ada_Version >= Ada_05
and then Stream_Attribute_Available (Etyp, TSS_Stream_Read); if Nam = TSS_Stream_Input
elsif Nam = TSS_Stream_Output then and then Ada_Version >= Ada_05
return Ada_Version >= Ada_05 and then Stream_Attribute_Available (Etyp, TSS_Stream_Read)
and then Stream_Attribute_Available (Etyp, TSS_Stream_Write); then
return True;
elsif Nam = TSS_Stream_Output
and then Ada_Version >= Ada_05
and then Stream_Attribute_Available (Etyp, TSS_Stream_Write)
then
return True;
end if; end if;
-- Case of Read and Write: check for attribute definition clause that -- Case of Read and Write: check for attribute definition clause that

171
gcc/ada/snames.h
View File

@ -95,91 +95,92 @@ extern unsigned char Get_Attribute_Id (int);
#define Attr_Machine_Mantissa 47 #define Attr_Machine_Mantissa 47
#define Attr_Machine_Overflows 48 #define Attr_Machine_Overflows 48
#define Attr_Machine_Radix 49 #define Attr_Machine_Radix 49
#define Attr_Machine_Rounds 50 #define Attr_Machine_Rounding 50
#define Attr_Machine_Size 51 #define Attr_Machine_Rounds 51
#define Attr_Mantissa 52 #define Attr_Machine_Size 52
#define Attr_Max_Size_In_Storage_Elements 53 #define Attr_Mantissa 53
#define Attr_Maximum_Alignment 54 #define Attr_Max_Size_In_Storage_Elements 54
#define Attr_Mechanism_Code 55 #define Attr_Maximum_Alignment 55
#define Attr_Mod 56 #define Attr_Mechanism_Code 56
#define Attr_Model_Emin 57 #define Attr_Mod 57
#define Attr_Model_Epsilon 58 #define Attr_Model_Emin 58
#define Attr_Model_Mantissa 59 #define Attr_Model_Epsilon 59
#define Attr_Model_Small 60 #define Attr_Model_Mantissa 60
#define Attr_Modulus 61 #define Attr_Model_Small 61
#define Attr_Null_Parameter 62 #define Attr_Modulus 62
#define Attr_Object_Size 63 #define Attr_Null_Parameter 63
#define Attr_Partition_ID 64 #define Attr_Object_Size 64
#define Attr_Passed_By_Reference 65 #define Attr_Partition_ID 65
#define Attr_Pool_Address 66 #define Attr_Passed_By_Reference 66
#define Attr_Pos 67 #define Attr_Pool_Address 67
#define Attr_Position 68 #define Attr_Pos 68
#define Attr_Range 69 #define Attr_Position 69
#define Attr_Range_Length 70 #define Attr_Range 70
#define Attr_Round 71 #define Attr_Range_Length 71
#define Attr_Safe_Emax 72 #define Attr_Round 72
#define Attr_Safe_First 73 #define Attr_Safe_Emax 73
#define Attr_Safe_Large 74 #define Attr_Safe_First 74
#define Attr_Safe_Last 75 #define Attr_Safe_Large 75
#define Attr_Safe_Small 76 #define Attr_Safe_Last 76
#define Attr_Scale 77 #define Attr_Safe_Small 77
#define Attr_Scaling 78 #define Attr_Scale 78
#define Attr_Signed_Zeros 79 #define Attr_Scaling 79
#define Attr_Size 80 #define Attr_Signed_Zeros 80
#define Attr_Small 81 #define Attr_Size 81
#define Attr_Storage_Size 82 #define Attr_Small 82
#define Attr_Storage_Unit 83 #define Attr_Storage_Size 83
#define Attr_Stream_Size 84 #define Attr_Storage_Unit 84
#define Attr_Tag 85 #define Attr_Stream_Size 85
#define Attr_Target_Name 86 #define Attr_Tag 86
#define Attr_Terminated 87 #define Attr_Target_Name 87
#define Attr_To_Address 88 #define Attr_Terminated 88
#define Attr_Type_Class 89 #define Attr_To_Address 89
#define Attr_UET_Address 90 #define Attr_Type_Class 90
#define Attr_Unbiased_Rounding 91 #define Attr_UET_Address 91
#define Attr_Unchecked_Access 92 #define Attr_Unbiased_Rounding 92
#define Attr_Unconstrained_Array 93 #define Attr_Unchecked_Access 93
#define Attr_Universal_Literal_String 94 #define Attr_Unconstrained_Array 94
#define Attr_Unrestricted_Access 95 #define Attr_Universal_Literal_String 95
#define Attr_VADS_Size 96 #define Attr_Unrestricted_Access 96
#define Attr_Val 97 #define Attr_VADS_Size 97
#define Attr_Valid 98 #define Attr_Val 98
#define Attr_Value_Size 99 #define Attr_Valid 99
#define Attr_Version 100 #define Attr_Value_Size 100
#define Attr_Wchar_T_Size 101 #define Attr_Version 101
#define Attr_Wide_Wide_Width 102 #define Attr_Wchar_T_Size 102
#define Attr_Wide_Width 103 #define Attr_Wide_Wide_Width 103
#define Attr_Width 104 #define Attr_Wide_Width 104
#define Attr_Word_Size 105 #define Attr_Width 105
#define Attr_Adjacent 106 #define Attr_Word_Size 106
#define Attr_Ceiling 107 #define Attr_Adjacent 107
#define Attr_Copy_Sign 108 #define Attr_Ceiling 108
#define Attr_Floor 109 #define Attr_Copy_Sign 109
#define Attr_Fraction 110 #define Attr_Floor 110
#define Attr_Image 111 #define Attr_Fraction 111
#define Attr_Input 112 #define Attr_Image 112
#define Attr_Machine 113 #define Attr_Input 113
#define Attr_Max 114 #define Attr_Machine 114
#define Attr_Min 115 #define Attr_Max 115
#define Attr_Model 116 #define Attr_Min 116
#define Attr_Pred 117 #define Attr_Model 117
#define Attr_Remainder 118 #define Attr_Pred 118
#define Attr_Rounding 119 #define Attr_Remainder 119
#define Attr_Succ 120 #define Attr_Rounding 120
#define Attr_Truncation 121 #define Attr_Succ 121
#define Attr_Value 122 #define Attr_Truncation 122
#define Attr_Wide_Image 123 #define Attr_Value 123
#define Attr_Wide_Wide_Image 124 #define Attr_Wide_Image 124
#define Attr_Wide_Value 125 #define Attr_Wide_Wide_Image 125
#define Attr_Wide_Wide_Value 126 #define Attr_Wide_Value 126
#define Attr_Output 127 #define Attr_Wide_Wide_Value 127
#define Attr_Read 128 #define Attr_Output 128
#define Attr_Write 129 #define Attr_Read 129
#define Attr_Elab_Body 130 #define Attr_Write 130
#define Attr_Elab_Spec 131 #define Attr_Elab_Body 131
#define Attr_Storage_Pool 132 #define Attr_Elab_Spec 132
#define Attr_Base 133 #define Attr_Storage_Pool 133
#define Attr_Class 134 #define Attr_Base 134
#define Attr_Class 135
/* Define the numeric values for the conventions. */ /* Define the numeric values for the conventions. */