1with Interfaces; use Interfaces;
2with Ada.Text_IO; use Ada.Text_IO;
3with Ada.Command_Line; use Ada.Command_Line;
4
5procedure Pattr is
6   Xdigit : constant array (0 .. 15) of Character := "0123456789abcdef";
7
8   procedure Disp_Lit (Z : Natural; Known : Boolean; S : String) is
9   begin
10      Put_Line (S);
11   end Disp_Lit;
12
13   procedure Disp_Float_Lit
14     (Lit_Type : Natural; Known : Boolean; Val : IEEE_Float_64)
15   is
16      pragma Assert (IEEE_Float_64'Machine_Radix = 2);
17      pragma Assert (IEEE_Float_64'Machine_Mantissa = 53);
18      Exp : Integer;
19      Man : Unsigned_64;
20      --  Res: sign(1) + 0x(2) + Man(53 / 3 ~= 18) + p(1) + sing(1) + exp(4)
21      Str : String (1 .. 1 + 2 + 18 + 1 + 1 + 4);
22      P : Natural;
23      Neg : Boolean;
24   begin
25      Exp := IEEE_Float_64'Exponent (Val) - 1;
26      Man := Unsigned_64 (abs (IEEE_Float_64'Fraction (Val)) * 2.0 ** 53);
27
28      --  Use decimal representation if there is no digit after the dot.
29      if Man = 0 then
30         Disp_Lit (Lit_Type, Known, "0.0");
31      else
32         pragma Assert (Shift_Right (Man, 52) = 1);
33
34         --  Remove hidden 1.
35         Man := Man and (2**52 - 1);
36
37         --  Remove trailing hex 0.
38         while Man /= 0 and (Man rem 16) = 0 loop
39            Man := Man / 16;
40         end loop;
41
42         --  Exponent.
43         P := Str'Last;
44         if Exp < 0 then
45            Neg := True;
46            Exp := -Exp;
47         else
48            Neg := False;
49         end if;
50         loop
51            Str (P) := Xdigit (Exp rem 10);
52            P := P - 1;
53            Exp := Exp / 10;
54            exit when Exp = 0;
55         end loop;
56         if Neg then
57            Str (P) := '-';
58            P := P - 1;
59         end if;
60         Str (P) := 'p';
61         P := P - 1;
62
63         --  Mantissa.
64         loop
65            Str (P) := Xdigit (Natural (Man and 15));
66            P := P - 1;
67            Man := Man / 16;
68            exit when Man = 0;
69         end loop;
70
71         P := P - 4;
72         Str (P + 1) := '0';
73         Str (P + 2) := 'x';
74         Str (P + 3) := '1';
75         Str (P + 4) := '.';
76
77         if Val < 0.0 then
78            Str (P) := '-';
79            P := P - 1;
80         end if;
81
82         Disp_Lit (Lit_Type, Known, Str (P + 1 .. Str'Last));
83      end if;
84   end Disp_Float_Lit;
85
86  subtype T is IEEE_Float_64;
87  V : T;
88begin
89  if Argument_Count /= 1 then
90    Put_Line ("usage : pattr FNUM");
91    return;
92  end if;
93
94  V := T'Value (Argument (1));
95
96  Put_Line ("Machine Radix:" & Natural'Image (T'Machine_Radix));
97  Put_Line ("Machine Mantissa:" & Natural'Image (T'Machine_Mantissa));
98  Put_Line ("Machine Emin: " & Natural'Image (T'Machine_Emin));
99  Put_Line ("Machine Emax: " & Natural'Image (T'Machine_Emax));
100  Put_Line ("Exponent: " & Integer'Image (T'Exponent (V)));
101  Put_Line ("Fraction: " & T'Image (T'Fraction (V)));
102  Disp_Float_Lit (1, False, V);
103end pattr;
104