1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
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 --
9 -- Copyright (C) 1997-2011, Free Software Foundation, Inc. --
10 -- (Version for Alpha OpenVMS) --
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. --
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. --
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/>. --
28 -- GNAT was originally developed by the GNAT team at New York University. --
29 -- Extensive contributions were provided by Ada Core Technologies Inc. --
31 ------------------------------------------------------------------------------
34 with System.Machine_Code; use System.Machine_Code;
36 package body System.Vax_Float_Operations is
38 -- Declare the functions that do the conversions between floating-point
39 -- formats. Call the operands IEEE float so they get passed in
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;
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");
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.
54 Debug_String_Buffer : String (1 .. 32);
55 -- Buffer used by all Debug_String_x routines for returning result
61 function D_To_G (X : D) return G is
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));
75 function F_To_G (X : F) return G is
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));
88 function F_To_S (X : F) return S is
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.
96 Asm ("ldf %0,%1", T'Asm_Output ("=f", A), F'Asm_Input ("m", X));
106 function G_To_D (X : G) return D is
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));
120 function G_To_F (X : G) return F is
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));
135 function G_To_Q (X : G) return Q is
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));
148 function G_To_T (X : G) return T is
151 Asm ("ldg %0,%1", T'Asm_Output ("=f", A), G'Asm_Input ("m", X));
160 function F_To_Q (X : F) return Q is
162 return G_To_Q (F_To_G (X));
169 function Q_To_F (X : Q) return F is
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));
182 function Q_To_G (X : Q) return G is
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));
195 function S_To_F (X : S) return F is
199 A := Cvt_T_F (T (X));
200 Asm ("stf %1,%0", F'Asm_Output ("=m", B), S'Asm_Input ("f", A));
208 function T_To_D (X : T) return D is
210 return G_To_D (T_To_G (X));
217 function T_To_G (X : T) return G is
222 Asm ("stg %1,%0", G'Asm_Output ("=m", B), T'Asm_Input ("f", A));
230 function Abs_F (X : F) return F is
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));
244 function Abs_G (X : G) return G is
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));
258 function Add_F (X, Y : F) return F is
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));
274 function Add_G (X, Y : G) return G is
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));
290 procedure Debug_Output_D (Arg : D) is
292 System.IO.Put (D'Image (Arg));
299 procedure Debug_Output_F (Arg : F) is
301 System.IO.Put (F'Image (Arg));
308 procedure Debug_Output_G (Arg : G) is
310 System.IO.Put (G'Image (Arg));
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;
321 Debug_String_Buffer (1 .. Image_Size) := Image_String;
322 return Debug_String_Buffer (1)'Address;
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;
333 Debug_String_Buffer (1 .. Image_Size) := Image_String;
334 return Debug_String_Buffer (1)'Address;
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;
345 Debug_String_Buffer (1 .. Image_Size) := Image_String;
346 return Debug_String_Buffer (1)'Address;
353 function Div_F (X, Y : F) return F is
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));
369 function Div_G (X, Y : G) return G is
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));
385 function Eq_F (X, Y : F) return Boolean is
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)));
399 function Eq_G (X, Y : G) return Boolean is
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)));
413 function Le_F (X, Y : F) return Boolean is
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)));
427 function Le_G (X, Y : G) return Boolean is
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)));
441 function Lt_F (X, Y : F) return Boolean is
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)));
455 function Lt_G (X, Y : G) return Boolean is
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)));
469 function Mul_F (X, Y : F) return F is
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));
485 function Mul_G (X, Y : G) return G is
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));
501 function Ne_F (X, Y : F) return Boolean is
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)));
515 function Ne_G (X, Y : G) return Boolean is
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)));
529 function Neg_F (X : F) return F is
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));
543 function Neg_G (X : G) return G is
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));
557 procedure pd (Arg : D) is
559 System.IO.Put_Line (D'Image (Arg));
566 procedure pf (Arg : F) is
568 System.IO.Put_Line (F'Image (Arg));
575 procedure pg (Arg : G) is
577 System.IO.Put_Line (G'Image (Arg));
584 function Return_D (X : D) return D is
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",
591 Asm ("stg $f0,%0", D'Asm_Output ("=m", R), Volatile => True);
599 function Return_F (X : F) return F is
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);
613 function Return_G (X : G) return G is
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);
627 function Sub_F (X, Y : F) return F is
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));
644 function Sub_G (X, Y : G) return G is
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));
660 -- For now, convert to IEEE and do Valid test on result. This is not quite
661 -- accurate, but is good enough in practice.
663 function Valid_D (Arg : D) return Boolean is
664 Val : constant T := G_To_T (D_To_G (Arg));
673 -- For now, convert to IEEE and do Valid test on result. This is not quite
674 -- accurate, but is good enough in practice.
676 function Valid_F (Arg : F) return Boolean is
677 Val : constant S := F_To_S (Arg);
686 -- For now, convert to IEEE and do Valid test on result. This is not quite
687 -- accurate, but is good enough in practice.
689 function Valid_G (Arg : G) return Boolean is
690 Val : constant T := G_To_T (Arg);
695 end System.Vax_Float_Operations;