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