/usr/share/ada/adainclude/gmpada/gnu_multiple_precision.adb is in libgmpada3-dev 0.0.20110925-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 | -- GMPAda, binding to the Ada Language for the GNU MultiPrecision library.
-- Copyright (C) 2007-2011 Nicolas Boulenguez <nicolas.boulenguez@free.fr>
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
with Interfaces.C; use Interfaces.C;
with GMP.Binding; use GMP.Binding;
package body GNU_Multiple_Precision is
overriding procedure Initialize (Object : in out Big_Integer)
is
begin
Mpz_Init (Object.Value);
end Initialize;
overriding procedure Adjust (Object : in out Big_Integer)
is
Temp : constant Mpz_T := Object.Value;
begin
Mpz_Init_Set (Object.Value, Temp);
end Adjust;
overriding procedure Finalize (Object : in out Big_Integer)
is
begin
Mpz_Clear (Object.Value);
end Finalize;
overriding function "=" (Left, Right : Big_Integer) return Boolean
is
begin
return Mpz_Cmp (Left.Value, Right.Value) = 0;
end "=";
overriding procedure Initialize (Object : in out Big_Rational)
is
begin
Mpq_Init (Object.Value);
end Initialize;
overriding procedure Adjust (Object : in out Big_Rational)
is
Temp : constant Mpq_T := Object.Value;
begin
Mpq_Init (Object.Value);
Mpq_Set (Object.Value, Temp);
end Adjust;
overriding procedure Finalize (Object : in out Big_Rational)
is
begin
Mpq_Clear (Object.Value);
end Finalize;
overriding function "=" (Left, Right : in Big_Rational) return Boolean
is
begin
return Mpq_Equal (Left.Value, Right.Value) /= 0;
end "=";
procedure Read (Stream : access Ada.Streams.Root_Stream_Type'Class;
Item : out Big_Rational)
is
pragma Unmodified (Item);
-- Item *is* modified, please no warning.
-- Does anyone see how to do it in a cleaner way?
begin
Mpz_T'Read (Stream, Mpq_Numref (Item.Value).all);
Mpz_T'Read (Stream, Mpq_Denref (Item.Value).all);
end Read;
procedure Write (Stream : access Ada.Streams.Root_Stream_Type'Class;
Item : in Big_Rational)
is
begin
Mpz_T'Write (Stream, Mpq_Numref (Item.Value).all);
Mpz_T'Write (Stream, Mpq_Denref (Item.Value).all);
end Write;
overriding procedure Initialize (Object : in out Big_Float)
is
begin
Mpf_Init (Object.Value);
end Initialize;
overriding procedure Adjust (Object : in out Big_Float)
is
Temp : constant Mpf_T := Object.Value;
begin
Mpf_Init_Set (Object.Value, Temp);
end Adjust;
overriding procedure Finalize (Object : in out Big_Float)
is
begin
Mpf_Clear (Object.Value);
end Finalize;
overriding function "=" (Left, Right : Big_Float) return Boolean
is
begin
return Mpf_Cmp (Left.Value, Right.Value) = 0;
end "=";
procedure Read (Stream : access Ada.Streams.Root_Stream_Type'Class;
Item : out Big_Float)
is
Prec : constant unsigned_long := unsigned_long'Input (Stream);
Exp : constant long := long'Input (Stream);
Z : Mpz_T := Mpz_T'Input (Stream);
begin
Mpf_Init2 (Item.Value, Prec);
Mpf_Set_Z (Item.Value, Z);
Mpz_Clear (Z);
pragma Unreferenced (Z);
pragma Warnings (Off, "writable actual for ""Rop"" overlaps with actual for ""Op1""");
if Exp >= 0 then
Mpf_Mul_2exp (Item.Value, Item.Value, unsigned_long (Exp));
else
Mpf_Div_2exp (Item.Value, Item.Value, unsigned_long (-Exp));
end if;
pragma Warnings (On, "writable actual for ""Rop"" overlaps with actual for ""Op1""");
end Read;
procedure Write (Stream : access Ada.Streams.Root_Stream_Type'Class;
Item : in Big_Float)
is
Prec : constant unsigned_long := Mpf_Get_Prec (Item.Value);
D : double;
Exp : long;
F : Mpf_T;
Z : Mpz_T;
begin
Mpf_Init2 (F, Prec);
unsigned_long'Write (Stream, Prec);
Mpf_Get_D_2exp (D, Exp, Item.Value);
pragma Unreferenced (D);
Exp := Exp - long (Prec);
long'Write (Stream, Exp);
if Exp >= 0 then
Mpf_Div_2exp (F, Item.Value, unsigned_long (Exp));
else
Mpf_Mul_2exp (F, Item.Value, unsigned_long (-Exp));
end if;
Mpz_Init (Z);
Mpz_Set_F (Z, F);
Mpz_T'Write (Stream, Z);
Mpf_Clear (F);
pragma Unreferenced (F);
Mpz_Clear (Z);
pragma Unreferenced (Z);
end Write;
overriding procedure Initialize (Object : in out Big_Float_Rounded)
is
begin
Mpfr_Init (Object.Value);
end Initialize;
-- overriding procedure Adjust (Object : in out Big_Float_Rounded)
-- is
-- begin
-- null;
-- end Adjust;
overriding procedure Finalize (Object : in out Big_Float_Rounded)
is
begin
Mpfr_Clear (Object.Value);
end Finalize;
-- overriding function "=" (Left, Right : Big_Float_Rounded) return Boolean
-- is
-- begin
-- return True;
-- end "=";
-- procedure Read (Stream : access Ada.Streams.Root_Stream_Type'Class;
-- Item : out Big_Float_Rounded)
-- is
-- begin
-- null;
-- end Read;
-- procedure Write (Stream : access Ada.Streams.Root_Stream_Type'Class;
-- Item : in Big_Float_Rounded)
-- is
-- begin
-- null;
-- end Write;
function Identity (Item : in Character)
return Character
is
begin
return Item;
end Identity;
function Identity (Item : in Character;
Substitute : in Character := ' ')
return Character is
pragma Unreferenced (Substitute);
begin
return Item;
end Identity;
end GNU_Multiple_Precision;
|