1------------------------------------------------------------------------------ 2-- -- 3-- GNAT RUN-TIME COMPONENTS -- 4-- -- 5-- S Y S T E M . V A X _ F L O A T _ O P E R A T I O N S -- 6-- -- 7-- B o d y -- 8-- -- 9-- Copyright (C) 1997-2001 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 2, 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 COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- As a special exception, if other files instantiate generics from this -- 23-- unit, or you link this unit with other files to produce an executable, -- 24-- this unit does not by itself cause the resulting executable to be -- 25-- covered by the GNU General Public License. This exception does not -- 26-- however invalidate any other reasons why the executable file might be -- 27-- covered by the GNU Public License. -- 28-- -- 29-- GNAT was originally developed by the GNAT team at New York University. -- 30-- Extensive contributions were provided by Ada Core Technologies Inc. -- 31-- -- 32------------------------------------------------------------------------------ 33 34-- This is a dummy body for use on non-Alpha systems so that the library 35-- can compile. This dummy version uses ordinary conversions and other 36-- arithmetic operations. it is used only for testing purposes in the 37-- case where the -gnatdm switch is used to force testing of VMS features 38-- on non-VMS systems. 39 40with System.IO; use System.IO; 41 42package body System.Vax_Float_Operations is 43 44 ----------- 45 -- Abs_F -- 46 ----------- 47 48 function Abs_F (X : F) return F is 49 begin 50 return abs X; 51 end Abs_F; 52 53 ----------- 54 -- Abs_G -- 55 ----------- 56 57 function Abs_G (X : G) return G is 58 begin 59 return abs X; 60 end Abs_G; 61 62 ----------- 63 -- Add_F -- 64 ----------- 65 66 function Add_F (X, Y : F) return F is 67 begin 68 return X + Y; 69 end Add_F; 70 71 ----------- 72 -- Add_G -- 73 ----------- 74 75 function Add_G (X, Y : G) return G is 76 begin 77 return X + Y; 78 end Add_G; 79 80 ------------ 81 -- D_To_G -- 82 ------------ 83 84 function D_To_G (X : D) return G is 85 begin 86 return G (X); 87 end D_To_G; 88 89 -------------------- 90 -- Debug_Output_D -- 91 -------------------- 92 93 procedure Debug_Output_D (Arg : D) is 94 begin 95 Put (D'Image (Arg)); 96 end Debug_Output_D; 97 98 -------------------- 99 -- Debug_Output_F -- 100 -------------------- 101 102 procedure Debug_Output_F (Arg : F) is 103 begin 104 Put (F'Image (Arg)); 105 end Debug_Output_F; 106 107 -------------------- 108 -- Debug_Output_G -- 109 -------------------- 110 111 procedure Debug_Output_G (Arg : G) is 112 begin 113 Put (G'Image (Arg)); 114 end Debug_Output_G; 115 116 -------------------- 117 -- Debug_String_D -- 118 -------------------- 119 120 Debug_String_Buffer : String (1 .. 32); 121 -- Buffer used by all Debug_String_x routines for returning result 122 123 function Debug_String_D (Arg : D) return System.Address is 124 Image_String : constant String := D'Image (Arg) & ASCII.NUL; 125 Image_Size : constant Integer := Image_String'Length; 126 127 begin 128 Debug_String_Buffer (1 .. Image_Size) := Image_String; 129 return Debug_String_Buffer (1)'Address; 130 end Debug_String_D; 131 132 -------------------- 133 -- Debug_String_F -- 134 -------------------- 135 136 function Debug_String_F (Arg : F) return System.Address is 137 Image_String : constant String := F'Image (Arg) & ASCII.NUL; 138 Image_Size : constant Integer := Image_String'Length; 139 140 begin 141 Debug_String_Buffer (1 .. Image_Size) := Image_String; 142 return Debug_String_Buffer (1)'Address; 143 end Debug_String_F; 144 145 -------------------- 146 -- Debug_String_G -- 147 -------------------- 148 149 function Debug_String_G (Arg : G) return System.Address is 150 Image_String : constant String := G'Image (Arg) & ASCII.NUL; 151 Image_Size : constant Integer := Image_String'Length; 152 153 begin 154 Debug_String_Buffer (1 .. Image_Size) := Image_String; 155 return Debug_String_Buffer (1)'Address; 156 end Debug_String_G; 157 158 ----------- 159 -- Div_F -- 160 ----------- 161 162 function Div_F (X, Y : F) return F is 163 begin 164 return X / Y; 165 end Div_F; 166 167 ----------- 168 -- Div_G -- 169 ----------- 170 171 function Div_G (X, Y : G) return G is 172 begin 173 return X / Y; 174 end Div_G; 175 176 ---------- 177 -- Eq_F -- 178 ---------- 179 180 function Eq_F (X, Y : F) return Boolean is 181 begin 182 return X = Y; 183 end Eq_F; 184 185 ---------- 186 -- Eq_G -- 187 ---------- 188 189 function Eq_G (X, Y : G) return Boolean is 190 begin 191 return X = Y; 192 end Eq_G; 193 194 ------------ 195 -- F_To_G -- 196 ------------ 197 198 function F_To_G (X : F) return G is 199 begin 200 return G (X); 201 end F_To_G; 202 203 ------------ 204 -- F_To_Q -- 205 ------------ 206 207 function F_To_Q (X : F) return Q is 208 begin 209 return Q (X); 210 end F_To_Q; 211 212 ------------ 213 -- F_To_S -- 214 ------------ 215 216 function F_To_S (X : F) return S is 217 begin 218 return S (X); 219 end F_To_S; 220 221 ------------ 222 -- G_To_D -- 223 ------------ 224 225 function G_To_D (X : G) return D is 226 begin 227 return D (X); 228 end G_To_D; 229 230 ------------ 231 -- G_To_F -- 232 ------------ 233 234 function G_To_F (X : G) return F is 235 begin 236 return F (X); 237 end G_To_F; 238 239 ------------ 240 -- G_To_Q -- 241 ------------ 242 243 function G_To_Q (X : G) return Q is 244 begin 245 return Q (X); 246 end G_To_Q; 247 248 ------------ 249 -- G_To_T -- 250 ------------ 251 252 function G_To_T (X : G) return T is 253 begin 254 return T (X); 255 end G_To_T; 256 257 ---------- 258 -- Le_F -- 259 ---------- 260 261 function Le_F (X, Y : F) return Boolean is 262 begin 263 return X <= Y; 264 end Le_F; 265 266 ---------- 267 -- Le_G -- 268 ---------- 269 270 function Le_G (X, Y : G) return Boolean is 271 begin 272 return X <= Y; 273 end Le_G; 274 275 ---------- 276 -- Lt_F -- 277 ---------- 278 279 function Lt_F (X, Y : F) return Boolean is 280 begin 281 return X < Y; 282 end Lt_F; 283 284 ---------- 285 -- Lt_G -- 286 ---------- 287 288 function Lt_G (X, Y : G) return Boolean is 289 begin 290 return X < Y; 291 end Lt_G; 292 293 ----------- 294 -- Mul_F -- 295 ----------- 296 297 function Mul_F (X, Y : F) return F is 298 begin 299 return X * Y; 300 end Mul_F; 301 302 ----------- 303 -- Mul_G -- 304 ----------- 305 306 function Mul_G (X, Y : G) return G is 307 begin 308 return X * Y; 309 end Mul_G; 310 311 ----------- 312 -- Neg_F -- 313 ----------- 314 315 function Neg_F (X : F) return F is 316 begin 317 return -X; 318 end Neg_F; 319 320 ----------- 321 -- Neg_G -- 322 ----------- 323 324 function Neg_G (X : G) return G is 325 begin 326 return -X; 327 end Neg_G; 328 329 -------- 330 -- pd -- 331 -------- 332 333 procedure pd (Arg : D) is 334 begin 335 Put_Line (D'Image (Arg)); 336 end pd; 337 338 -------- 339 -- pf -- 340 -------- 341 342 procedure pf (Arg : F) is 343 begin 344 Put_Line (F'Image (Arg)); 345 end pf; 346 347 -------- 348 -- pg -- 349 -------- 350 351 procedure pg (Arg : G) is 352 begin 353 Put_Line (G'Image (Arg)); 354 end pg; 355 356 ------------ 357 -- Q_To_F -- 358 ------------ 359 360 function Q_To_F (X : Q) return F is 361 begin 362 return F (X); 363 end Q_To_F; 364 365 ------------ 366 -- Q_To_G -- 367 ------------ 368 369 function Q_To_G (X : Q) return G is 370 begin 371 return G (X); 372 end Q_To_G; 373 374 ------------ 375 -- S_To_F -- 376 ------------ 377 378 function S_To_F (X : S) return F is 379 begin 380 return F (X); 381 end S_To_F; 382 383 ----------- 384 -- Sub_F -- 385 ----------- 386 387 function Sub_F (X, Y : F) return F is 388 begin 389 return X - Y; 390 end Sub_F; 391 392 ----------- 393 -- Sub_G -- 394 ----------- 395 396 function Sub_G (X, Y : G) return G is 397 begin 398 return X - Y; 399 end Sub_G; 400 401 ------------ 402 -- T_To_D -- 403 ------------ 404 405 function T_To_D (X : T) return D is 406 begin 407 return G_To_D (T_To_G (X)); 408 end T_To_D; 409 410 ------------ 411 -- T_To_G -- 412 ------------ 413 414 function T_To_G (X : T) return G is 415 begin 416 return G (X); 417 end T_To_G; 418 419end System.Vax_Float_Operations; 420