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