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    --  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_D --
 206    ------------
 207
 208    function T_To_D (X : T) return D is
 209    begin
 210       return G_To_D (T_To_G (X));
 211    end T_To_D;
 212
 213    ------------
 214    -- T_To_G --
 215    ------------
 216
 217    function T_To_G (X : T) return G is
 218       A : T;
 219       B : G;
 220    begin
 221       A := Cvt_T_G (X);
 222       Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
 223       return B;
 224    end T_To_G;
 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
 695 end System.Vax_Float_Operations;