1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER COMPONENTS -- 4-- -- 5-- S E M _ V F P T -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1997-2010, Free Software Foundation, Inc. -- 10-- -- 11-- GNAT is free software; you can redistribute it and/or modify it under -- 12-- terms of the GNU General Public License as published by the Free Soft- -- 13-- ware Foundation; either version 3, or (at your option) any later ver- -- 14-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 15-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 16-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- 17-- for more details. You should have received a copy of the GNU General -- 18-- Public License distributed with GNAT; see file COPYING3. If not, go to -- 19-- http://www.gnu.org/licenses for a complete copy of the license. -- 20-- -- 21-- GNAT was originally developed by the GNAT team at New York University. -- 22-- Extensive contributions were provided by Ada Core Technologies Inc. -- 23-- -- 24------------------------------------------------------------------------------ 25 26with CStand; use CStand; 27with Einfo; use Einfo; 28with Opt; use Opt; 29with Stand; use Stand; 30with Targparm; use Targparm; 31 32package body Sem_VFpt is 33 34 ----------------- 35 -- Set_D_Float -- 36 ----------------- 37 38 procedure Set_D_Float (E : Entity_Id) is 39 VAXDF_Digits : constant := 9; 40 41 begin 42 Init_Size (Base_Type (E), 64); 43 Init_Alignment (Base_Type (E)); 44 Init_Digits_Value (Base_Type (E), VAXDF_Digits); 45 Set_Float_Rep (Base_Type (E), VAX_Native); 46 Set_Float_Bounds (Base_Type (E)); 47 48 Init_Size (E, 64); 49 Init_Alignment (E); 50 Init_Digits_Value (E, VAXDF_Digits); 51 Set_Scalar_Range (E, Scalar_Range (Base_Type (E))); 52 end Set_D_Float; 53 54 ----------------- 55 -- Set_F_Float -- 56 ----------------- 57 58 procedure Set_F_Float (E : Entity_Id) is 59 VAXFF_Digits : constant := 6; 60 61 begin 62 Init_Size (Base_Type (E), 32); 63 Init_Alignment (Base_Type (E)); 64 Init_Digits_Value (Base_Type (E), VAXFF_Digits); 65 Set_Float_Rep (Base_Type (E), VAX_Native); 66 Set_Float_Bounds (Base_Type (E)); 67 68 Init_Size (E, 32); 69 Init_Alignment (E); 70 Init_Digits_Value (E, VAXFF_Digits); 71 Set_Scalar_Range (E, Scalar_Range (Base_Type (E))); 72 end Set_F_Float; 73 74 ----------------- 75 -- Set_G_Float -- 76 ----------------- 77 78 procedure Set_G_Float (E : Entity_Id) is 79 VAXGF_Digits : constant := 15; 80 81 begin 82 Init_Size (Base_Type (E), 64); 83 Init_Alignment (Base_Type (E)); 84 Init_Digits_Value (Base_Type (E), VAXGF_Digits); 85 Set_Float_Rep (Base_Type (E), VAX_Native); 86 Set_Float_Bounds (Base_Type (E)); 87 88 Init_Size (E, 64); 89 Init_Alignment (E); 90 Init_Digits_Value (E, VAXGF_Digits); 91 Set_Scalar_Range (E, Scalar_Range (Base_Type (E))); 92 end Set_G_Float; 93 94 ------------------- 95 -- Set_IEEE_Long -- 96 ------------------- 97 98 procedure Set_IEEE_Long (E : Entity_Id) is 99 IEEEL_Digits : constant := 15; 100 101 begin 102 Init_Size (Base_Type (E), 64); 103 Init_Alignment (Base_Type (E)); 104 Init_Digits_Value (Base_Type (E), IEEEL_Digits); 105 Set_Float_Rep (Base_Type (E), IEEE_Binary); 106 Set_Float_Bounds (Base_Type (E)); 107 108 Init_Size (E, 64); 109 Init_Alignment (E); 110 Init_Digits_Value (E, IEEEL_Digits); 111 Set_Scalar_Range (E, Scalar_Range (Base_Type (E))); 112 end Set_IEEE_Long; 113 114 -------------------- 115 -- Set_IEEE_Short -- 116 -------------------- 117 118 procedure Set_IEEE_Short (E : Entity_Id) is 119 IEEES_Digits : constant := 6; 120 121 begin 122 Init_Size (Base_Type (E), 32); 123 Init_Alignment (Base_Type (E)); 124 Init_Digits_Value (Base_Type (E), IEEES_Digits); 125 Set_Float_Rep (Base_Type (E), IEEE_Binary); 126 Set_Float_Bounds (Base_Type (E)); 127 128 Init_Size (E, 32); 129 Init_Alignment (E); 130 Init_Digits_Value (E, IEEES_Digits); 131 Set_Scalar_Range (E, Scalar_Range (Base_Type (E))); 132 end Set_IEEE_Short; 133 134 ------------------------------ 135 -- Set_Standard_Fpt_Formats -- 136 ------------------------------ 137 138 procedure Set_Standard_Fpt_Formats is 139 begin 140 -- IEEE case 141 142 if Opt.Float_Format = 'I' then 143 Set_IEEE_Short (Standard_Float); 144 Set_IEEE_Long (Standard_Long_Float); 145 Set_IEEE_Long (Standard_Long_Long_Float); 146 147 -- Vax float case 148 149 else 150 Set_F_Float (Standard_Float); 151 152 if Opt.Float_Format_Long = 'D' then 153 Set_D_Float (Standard_Long_Float); 154 else 155 Set_G_Float (Standard_Long_Float); 156 end if; 157 158 -- Note: Long_Long_Float gets set only in the real VMS case, 159 -- because this gives better results for testing out the use 160 -- of VAX float on non-VMS environments with the -gnatdm switch. 161 162 if OpenVMS_On_Target then 163 Set_G_Float (Standard_Long_Long_Float); 164 end if; 165 end if; 166 end Set_Standard_Fpt_Formats; 167 168end Sem_VFpt; 169