gcc/ada/s-vaflop-vms-alpha.adb

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