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