1------------------------------------------------------------------------------ 2-- -- 3-- GNAT COMPILER 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-2012, Free Software Foundation, Inc. -- 10-- (Version for Alpha OpenVMS) -- 11-- -- 12-- GNAT is free software; you can redistribute it and/or modify it under -- 13-- terms of the GNU General Public License as published by the Free Soft- -- 14-- ware Foundation; either version 3, or (at your option) any later ver- -- 15-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 16-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- 17-- or FITNESS FOR A PARTICULAR PURPOSE. -- 18-- -- 19-- As a special exception under Section 7 of GPL version 3, you are granted -- 20-- additional permissions described in the GCC Runtime Library Exception, -- 21-- version 3.1, as published by the Free Software Foundation. -- 22-- -- 23-- You should have received a copy of the GNU General Public License and -- 24-- a copy of the GCC Runtime Library Exception along with this program; -- 25-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 26-- <http://www.gnu.org/licenses/>. -- 27-- -- 28-- GNAT was originally developed by the GNAT team at New York University. -- 29-- Extensive contributions were provided by Ada Core Technologies Inc. -- 30-- -- 31------------------------------------------------------------------------------ 32 33with System.IO; 34with System.Machine_Code; use System.Machine_Code; 35 36package body System.Vax_Float_Operations is 37 38 -- Declare the functions that do the conversions between floating-point 39 -- formats. Call the operands IEEE float so they get passed in 40 -- FP registers. 41 42 function Cvt_G_T (X : T) return T; 43 function Cvt_T_G (X : T) return T; 44 function Cvt_T_F (X : T) return S; 45 46 pragma Import (C, Cvt_G_T, "OTS$CVT_FLOAT_G_T"); 47 pragma Import (C, Cvt_T_G, "OTS$CVT_FLOAT_T_G"); 48 pragma Import (C, Cvt_T_F, "OTS$CVT_FLOAT_T_F"); 49 50 -- In each of the conversion routines that are done with OTS calls, 51 -- we define variables of the corresponding IEEE type so that they are 52 -- passed and kept in the proper register class. 53 54 Debug_String_Buffer : String (1 .. 32); 55 -- Buffer used by all Debug_String_x routines for returning result 56 57 ------------ 58 -- D_To_G -- 59 ------------ 60 61 function D_To_G (X : D) return G is 62 A, B : T; 63 C : G; 64 begin 65 Asm ("ldg %0,%1", T'Asm_Output ("=f", A), D'Asm_Input ("m", X)); 66 Asm ("cvtdg %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A)); 67 Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B)); 68 return C; 69 end D_To_G; 70 71 ------------ 72 -- F_To_G -- 73 ------------ 74 75 function F_To_G (X : F) return G is 76 A : T; 77 B : G; 78 begin 79 Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X)); 80 Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A)); 81 return B; 82 end F_To_G; 83 84 ------------ 85 -- F_To_S -- 86 ------------ 87 88 function F_To_S (X : F) return S is 89 A : T; 90 B : S; 91 92 begin 93 -- Because converting to a wider FP format is a no-op, we say 94 -- A is 64-bit even though we are loading 32 bits into it. 95 96 Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X)); 97 98 B := S (Cvt_G_T (A)); 99 return B; 100 end F_To_S; 101 102 ------------ 103 -- G_To_D -- 104 ------------ 105 106 function G_To_D (X : G) return D is 107 A, B : T; 108 C : D; 109 begin 110 Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X)); 111 Asm ("cvtgd %1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A)); 112 Asm ("stg %1,%0", D'Asm_Output ("=m", C), T'Asm_Input ("f", B)); 113 return C; 114 end G_To_D; 115 116 ------------ 117 -- G_To_F -- 118 ------------ 119 120 function G_To_F (X : G) return F is 121 A : T; 122 B : S; 123 C : F; 124 begin 125 Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X)); 126 Asm ("cvtgf %1,%0", S'Asm_Output ("=f", B), T'Asm_Input ("f", A)); 127 Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B)); 128 return C; 129 end G_To_F; 130 131 ------------ 132 -- G_To_Q -- 133 ------------ 134 135 function G_To_Q (X : G) return Q is 136 A : T; 137 B : Q; 138 begin 139 Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X)); 140 Asm ("cvtgq %1,%0", Q'Asm_Output ("=f", B), T'Asm_Input ("f", A)); 141 return B; 142 end G_To_Q; 143 144 ------------ 145 -- G_To_T -- 146 ------------ 147 148 function G_To_T (X : G) return T is 149 A, B : T; 150 begin 151 Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X)); 152 B := Cvt_G_T (A); 153 return B; 154 end G_To_T; 155 156 ------------ 157 -- F_To_Q -- 158 ------------ 159 160 function F_To_Q (X : F) return Q is 161 begin 162 return G_To_Q (F_To_G (X)); 163 end F_To_Q; 164 165 ------------ 166 -- Q_To_F -- 167 ------------ 168 169 function Q_To_F (X : Q) return F is 170 A : S; 171 B : F; 172 begin 173 Asm ("cvtqf %1,%0", S'Asm_Output ("=f", A), Q'Asm_Input ("f", X)); 174 Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A)); 175 return B; 176 end Q_To_F; 177 178 ------------ 179 -- Q_To_G -- 180 ------------ 181 182 function Q_To_G (X : Q) return G is 183 A : T; 184 B : G; 185 begin 186 Asm ("cvtqg %1,%0", T'Asm_Output ("=f", A), Q'Asm_Input ("f", X)); 187 Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A)); 188 return B; 189 end Q_To_G; 190 191 ------------ 192 -- S_To_F -- 193 ------------ 194 195 function S_To_F (X : S) return F is 196 A : S; 197 B : F; 198 begin 199 A := Cvt_T_F (T (X)); 200 Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A)); 201 return B; 202 end S_To_F; 203 204 ------------ 205 -- T_To_G -- 206 ------------ 207 208 function T_To_G (X : T) return G is 209 A : T; 210 B : G; 211 begin 212 A := Cvt_T_G (X); 213 Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A)); 214 return B; 215 end T_To_G; 216 217 ------------ 218 -- T_To_D -- 219 ------------ 220 221 function T_To_D (X : T) return D is 222 begin 223 return G_To_D (T_To_G (X)); 224 end T_To_D; 225 226 ----------- 227 -- Abs_F -- 228 ----------- 229 230 function Abs_F (X : F) return F is 231 A, B : S; 232 C : F; 233 begin 234 Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X)); 235 Asm ("cpys $f31,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A)); 236 Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B)); 237 return C; 238 end Abs_F; 239 240 ----------- 241 -- Abs_G -- 242 ----------- 243 244 function Abs_G (X : G) return G is 245 A, B : T; 246 C : G; 247 begin 248 Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X)); 249 Asm ("cpys $f31,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A)); 250 Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B)); 251 return C; 252 end Abs_G; 253 254 ----------- 255 -- Add_F -- 256 ----------- 257 258 function Add_F (X, Y : F) return F is 259 X1, Y1, R : S; 260 R1 : F; 261 begin 262 Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); 263 Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y)); 264 Asm ("addf %1,%2,%0", S'Asm_Output ("=f", R), 265 (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1))); 266 Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R)); 267 return R1; 268 end Add_F; 269 270 ----------- 271 -- Add_G -- 272 ----------- 273 274 function Add_G (X, Y : G) return G is 275 X1, Y1, R : T; 276 R1 : G; 277 begin 278 Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); 279 Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y)); 280 Asm ("addg %1,%2,%0", T'Asm_Output ("=f", R), 281 (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1))); 282 Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R)); 283 return R1; 284 end Add_G; 285 286 -------------------- 287 -- Debug_Output_D -- 288 -------------------- 289 290 procedure Debug_Output_D (Arg : D) is 291 begin 292 System.IO.Put (D'Image (Arg)); 293 end Debug_Output_D; 294 295 -------------------- 296 -- Debug_Output_F -- 297 -------------------- 298 299 procedure Debug_Output_F (Arg : F) is 300 begin 301 System.IO.Put (F'Image (Arg)); 302 end Debug_Output_F; 303 304 -------------------- 305 -- Debug_Output_G -- 306 -------------------- 307 308 procedure Debug_Output_G (Arg : G) is 309 begin 310 System.IO.Put (G'Image (Arg)); 311 end Debug_Output_G; 312 313 -------------------- 314 -- Debug_String_D -- 315 -------------------- 316 317 function Debug_String_D (Arg : D) return System.Address is 318 Image_String : constant String := D'Image (Arg) & ASCII.NUL; 319 Image_Size : constant Integer := Image_String'Length; 320 begin 321 Debug_String_Buffer (1 .. Image_Size) := Image_String; 322 return Debug_String_Buffer (1)'Address; 323 end Debug_String_D; 324 325 -------------------- 326 -- Debug_String_F -- 327 -------------------- 328 329 function Debug_String_F (Arg : F) return System.Address is 330 Image_String : constant String := F'Image (Arg) & ASCII.NUL; 331 Image_Size : constant Integer := Image_String'Length; 332 begin 333 Debug_String_Buffer (1 .. Image_Size) := Image_String; 334 return Debug_String_Buffer (1)'Address; 335 end Debug_String_F; 336 337 -------------------- 338 -- Debug_String_G -- 339 -------------------- 340 341 function Debug_String_G (Arg : G) return System.Address is 342 Image_String : constant String := G'Image (Arg) & ASCII.NUL; 343 Image_Size : constant Integer := Image_String'Length; 344 begin 345 Debug_String_Buffer (1 .. Image_Size) := Image_String; 346 return Debug_String_Buffer (1)'Address; 347 end Debug_String_G; 348 349 ----------- 350 -- Div_F -- 351 ----------- 352 353 function Div_F (X, Y : F) return F is 354 X1, Y1, R : S; 355 R1 : F; 356 begin 357 Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); 358 Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y)); 359 Asm ("divf %1,%2,%0", S'Asm_Output ("=f", R), 360 (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1))); 361 Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R)); 362 return R1; 363 end Div_F; 364 365 ----------- 366 -- Div_G -- 367 ----------- 368 369 function Div_G (X, Y : G) return G is 370 X1, Y1, R : T; 371 R1 : G; 372 begin 373 Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); 374 Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y)); 375 Asm ("divg %1,%2,%0", T'Asm_Output ("=f", R), 376 (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1))); 377 Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R)); 378 return R1; 379 end Div_G; 380 381 ---------- 382 -- Eq_F -- 383 ---------- 384 385 function Eq_F (X, Y : F) return Boolean is 386 X1, Y1, R : S; 387 begin 388 Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); 389 Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y)); 390 Asm ("cmpgeq %1,%2,%0", S'Asm_Output ("=f", R), 391 (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1))); 392 return R /= 0.0; 393 end Eq_F; 394 395 ---------- 396 -- Eq_G -- 397 ---------- 398 399 function Eq_G (X, Y : G) return Boolean is 400 X1, Y1, R : T; 401 begin 402 Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); 403 Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y)); 404 Asm ("cmpgeq %1,%2,%0", T'Asm_Output ("=f", R), 405 (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1))); 406 return R /= 0.0; 407 end Eq_G; 408 409 ---------- 410 -- Le_F -- 411 ---------- 412 413 function Le_F (X, Y : F) return Boolean is 414 X1, Y1, R : S; 415 begin 416 Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); 417 Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y)); 418 Asm ("cmpgle %1,%2,%0", S'Asm_Output ("=f", R), 419 (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1))); 420 return R /= 0.0; 421 end Le_F; 422 423 ---------- 424 -- Le_G -- 425 ---------- 426 427 function Le_G (X, Y : G) return Boolean is 428 X1, Y1, R : T; 429 begin 430 Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); 431 Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y)); 432 Asm ("cmpgle %1,%2,%0", T'Asm_Output ("=f", R), 433 (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1))); 434 return R /= 0.0; 435 end Le_G; 436 437 ---------- 438 -- Lt_F -- 439 ---------- 440 441 function Lt_F (X, Y : F) return Boolean is 442 X1, Y1, R : S; 443 begin 444 Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); 445 Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y)); 446 Asm ("cmpglt %1,%2,%0", S'Asm_Output ("=f", R), 447 (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1))); 448 return R /= 0.0; 449 end Lt_F; 450 451 ---------- 452 -- Lt_G -- 453 ---------- 454 455 function Lt_G (X, Y : G) return Boolean is 456 X1, Y1, R : T; 457 begin 458 Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); 459 Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y)); 460 Asm ("cmpglt %1,%2,%0", T'Asm_Output ("=f", R), 461 (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1))); 462 return R /= 0.0; 463 end Lt_G; 464 465 ----------- 466 -- Mul_F -- 467 ----------- 468 469 function Mul_F (X, Y : F) return F is 470 X1, Y1, R : S; 471 R1 : F; 472 begin 473 Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); 474 Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y)); 475 Asm ("mulf %1,%2,%0", S'Asm_Output ("=f", R), 476 (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1))); 477 Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R)); 478 return R1; 479 end Mul_F; 480 481 ----------- 482 -- Mul_G -- 483 ----------- 484 485 function Mul_G (X, Y : G) return G is 486 X1, Y1, R : T; 487 R1 : G; 488 begin 489 Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); 490 Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y)); 491 Asm ("mulg %1,%2,%0", T'Asm_Output ("=f", R), 492 (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1))); 493 Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R)); 494 return R1; 495 end Mul_G; 496 497 ---------- 498 -- Ne_F -- 499 ---------- 500 501 function Ne_F (X, Y : F) return Boolean is 502 X1, Y1, R : S; 503 begin 504 Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); 505 Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y)); 506 Asm ("cmpgeq %1,%2,%0", S'Asm_Output ("=f", R), 507 (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1))); 508 return R = 0.0; 509 end Ne_F; 510 511 ---------- 512 -- Ne_G -- 513 ---------- 514 515 function Ne_G (X, Y : G) return Boolean is 516 X1, Y1, R : T; 517 begin 518 Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); 519 Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y)); 520 Asm ("cmpgeq %1,%2,%0", T'Asm_Output ("=f", R), 521 (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1))); 522 return R = 0.0; 523 end Ne_G; 524 525 ----------- 526 -- Neg_F -- 527 ----------- 528 529 function Neg_F (X : F) return F is 530 A, B : S; 531 C : F; 532 begin 533 Asm ("ldf %0,%1", S'Asm_Output ("=f", A), F'Asm_Input ("m", X)); 534 Asm ("subf $f31,%1,%0", S'Asm_Output ("=f", B), S'Asm_Input ("f", A)); 535 Asm ("stf %1,%0", F'Asm_Output ("=m", C), S'Asm_Input ("f", B)); 536 return C; 537 end Neg_F; 538 539 ----------- 540 -- Neg_G -- 541 ----------- 542 543 function Neg_G (X : G) return G is 544 A, B : T; 545 C : G; 546 begin 547 Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X)); 548 Asm ("subg $f31,%1,%0", T'Asm_Output ("=f", B), T'Asm_Input ("f", A)); 549 Asm ("stg %1,%0", G'Asm_Output ("=m", C), T'Asm_Input ("f", B)); 550 return C; 551 end Neg_G; 552 553 -------- 554 -- pd -- 555 -------- 556 557 procedure pd (Arg : D) is 558 begin 559 System.IO.Put_Line (D'Image (Arg)); 560 end pd; 561 562 -------- 563 -- pf -- 564 -------- 565 566 procedure pf (Arg : F) is 567 begin 568 System.IO.Put_Line (F'Image (Arg)); 569 end pf; 570 571 -------- 572 -- pg -- 573 -------- 574 575 procedure pg (Arg : G) is 576 begin 577 System.IO.Put_Line (G'Image (Arg)); 578 end pg; 579 580 -------------- 581 -- Return_D -- 582 -------------- 583 584 function Return_D (X : D) return D is 585 R : D; 586 begin 587 -- The return value is already in $f0 so we need to trick the compiler 588 -- into thinking that we're moving X to $f0. 589 Asm ("cvtdg $f0,$f0", Inputs => D'Asm_Input ("g", X), Clobber => "$f0", 590 Volatile => True); 591 Asm ("stg $f0,%0", D'Asm_Output ("=m", R), Volatile => True); 592 return R; 593 end Return_D; 594 595 -------------- 596 -- Return_F -- 597 -------------- 598 599 function Return_F (X : F) return F is 600 R : F; 601 begin 602 -- The return value is already in $f0 so we need to trick the compiler 603 -- into thinking that we're moving X to $f0. 604 Asm ("stf $f0,%0", F'Asm_Output ("=m", R), F'Asm_Input ("g", X), 605 Clobber => "$f0", Volatile => True); 606 return R; 607 end Return_F; 608 609 -------------- 610 -- Return_G -- 611 -------------- 612 613 function Return_G (X : G) return G is 614 R : G; 615 begin 616 -- The return value is already in $f0 so we need to trick the compiler 617 -- into thinking that we're moving X to $f0. 618 Asm ("stg $f0,%0", G'Asm_Output ("=m", R), G'Asm_Input ("g", X), 619 Clobber => "$f0", Volatile => True); 620 return R; 621 end Return_G; 622 623 ----------- 624 -- Sub_F -- 625 ----------- 626 627 function Sub_F (X, Y : F) return F is 628 X1, Y1, R : S; 629 R1 : F; 630 631 begin 632 Asm ("ldf %0,%1", S'Asm_Output ("=f", X1), F'Asm_Input ("m", X)); 633 Asm ("ldf %0,%1", S'Asm_Output ("=f", Y1), F'Asm_Input ("m", Y)); 634 Asm ("subf %1,%2,%0", S'Asm_Output ("=f", R), 635 (S'Asm_Input ("f", X1), S'Asm_Input ("f", Y1))); 636 Asm ("stf %1,%0", F'Asm_Output ("=m", R1), S'Asm_Input ("f", R)); 637 return R1; 638 end Sub_F; 639 640 ----------- 641 -- Sub_G -- 642 ----------- 643 644 function Sub_G (X, Y : G) return G is 645 X1, Y1, R : T; 646 R1 : G; 647 begin 648 Asm ("ldg %0,%1", T'Asm_Output ("=f", X1), G'Asm_Input ("m", X)); 649 Asm ("ldg %0,%1", T'Asm_Output ("=f", Y1), G'Asm_Input ("m", Y)); 650 Asm ("subg %1,%2,%0", T'Asm_Output ("=f", R), 651 (T'Asm_Input ("f", X1), T'Asm_Input ("f", Y1))); 652 Asm ("stg %1,%0", G'Asm_Output ("=m", R1), T'Asm_Input ("f", R)); 653 return R1; 654 end Sub_G; 655 656 ------------- 657 -- Valid_D -- 658 ------------- 659 660 -- For now, convert to IEEE and do Valid test on result. This is not quite 661 -- accurate, but is good enough in practice. 662 663 function Valid_D (Arg : D) return Boolean is 664 Val : constant T := G_To_T (D_To_G (Arg)); 665 begin 666 return Val'Valid; 667 end Valid_D; 668 669 ------------- 670 -- Valid_F -- 671 ------------- 672 673 -- For now, convert to IEEE and do Valid test on result. This is not quite 674 -- accurate, but is good enough in practice. 675 676 function Valid_F (Arg : F) return Boolean is 677 Val : constant S := F_To_S (Arg); 678 begin 679 return Val'Valid; 680 end Valid_F; 681 682 ------------- 683 -- Valid_G -- 684 ------------- 685 686 -- For now, convert to IEEE and do Valid test on result. This is not quite 687 -- accurate, but is good enough in practice. 688 689 function Valid_G (Arg : G) return Boolean is 690 Val : constant T := G_To_T (Arg); 691 begin 692 return Val'Valid; 693 end Valid_G; 694 695end System.Vax_Float_Operations; 696