------------------------------------------------------------------------------ -- -- -- G N U _ M U L T I P L E _ P R E C I S I O N . C O N T R O L L E D _ Z -- -- -- -- B o d y -- -- -- -- $Revision: 1.1 $ -- -- -- -- Copyright (C) 1999 Michael Roe -- -- -- -- This is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- -- ware Foundation; either version 2, or (at your option) any later ver- -- -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- -- OUT 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 distributed with GNAT; see file COPYING. If not, write -- -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- -- MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ with GNU_Multiple_Precision.Z; use GNU_Multiple_Precision.Z; package body GNU_Multiple_Precision.Controlled_Z is procedure Initialize(Object : in out Big_Integer) is begin GNU_Multiple_Precision.Z.Init (Object.Value); end Initialize; procedure Finalize (Object : in out Big_Integer) is begin GNU_Multiple_Precision.Z.Clear (Object.Value); end Finalize; ------------------------------------------------------------------------------ -- Assignment -- ------------------------------------------------------------------------------ --------- -- Set -- --------- procedure Set (Rop : in out Big_Integer; Op : in Big_Integer) is begin Set (Rop.Value, Op.Value); end Set; procedure Set_Integer (Rop : in out Big_Integer; Op : in Interfaces.C.int) is begin Set_Integer (Rop.Value, Op); end Set_Integer; procedure Set_Unsigned (Rop : in out Big_Integer; Op : in Interfaces.C.unsigned) is begin Set_Unsigned (Rop.Value, Op); end Set_Unsigned; procedure Set_Double (Rop : in out Big_Integer; Op : in Interfaces.C.double) is begin Set_Double (Rop.Value, Op); end Set_Double; procedure Set_C_String (Rop : in out Big_Integer; Str : in Interfaces.C.char_array; Base : in Interfaces.C.int) is begin Set_C_String (Rop.Value, Str, Base); end Set_C_String; ------------------------------------------------------------------------------ -- Type Conversion -- ------------------------------------------------------------------------------ --------- -- Get -- --------- function Get_Unsigned (Op : Big_Integer) return Interfaces.C.unsigned is begin return Get_Unsigned (Op.Value); end Get_Unsigned; function Get_Integer (Op : Big_Integer) return Interfaces.C.int is begin return Get_Integer (Op.Value); end Get_Integer; function Get_String (Buffer : System.Address; Base : Integer; Op : Big_Integer) return System.Address is begin return Get_String (Buffer, Base, Op.Value); end Get_String; ------------------------------------------------------------------------------ -- Arithmetic -- ------------------------------------------------------------------------------ -------------- -- Absolute -- -------------- -- NB: Abs is a reserved word in Ada, so cannot be a procedure name procedure Absolute (Rop : in out Big_Integer; Op : in Big_Integer) is begin Absolute (Rop.Value, Op.Value); end Absolute; --------- -- Add -- --------- procedure Add (Rop : in out Big_Integer; Op1, Op2 : in Big_Integer) is begin Add (Rop.Value, Op1.Value, Op2.Value); end Add; procedure Add_Unsigned (Rop : in out Big_Integer; Op1 : in Big_Integer; Op2 : in Interfaces.C.unsigned_long) is begin Add_Unsigned (Rop.Value, Op1.Value, Op2); end Add_Unsigned; --------- -- Div -- --------- procedure Cdiv_Q (Rop : in out Big_Integer; Op1, Op2 : in Big_Integer) is begin Cdiv_Q (Rop.Value, Op1.Value, Op2.Value); end Cdiv_Q; procedure Cdiv_Q_Unsigned (Rop : in out Big_Integer; Op1 : in Big_Integer; Op2 : in Interfaces.C.unsigned) is begin Cdiv_Q_Unsigned (Rop.Value, Op1.Value, Op2); end Cdiv_Q_Unsigned; procedure Cdiv_QR (Quotient, Remainder : out Big_Integer; Op1, Op2 : in Big_Integer) is begin Cdiv_QR (Quotient.Value, Remainder.Value, Op1.Value, Op2.Value); end Cdiv_QR; procedure Cdiv_QR_Unsigned (Quotient, Remainder : out Big_Integer; Op1 : in Big_Integer; Op2 : in Interfaces.C.unsigned) is begin Cdiv_QR_Unsigned (Quotient.Value, Remainder.Value, Op1.Value, Op2); end Cdiv_QR_Unsigned; procedure Cdiv_R (Rop : in out Big_Integer; Op1, Op2 : in Big_Integer) is begin Cdiv_R (Rop.Value, Op1.Value, Op2.Value); end Cdiv_R; procedure Cdiv_R_Unsigned (Remainder : out Interfaces.C.unsigned; Quotient : out Big_Integer; Op1 : in Big_Integer; Op2 : in Interfaces.C.unsigned) is begin Cdiv_R_Unsigned (Remainder, Quotient.Value, Op1.Value, Op2); end Cdiv_R_Unsigned; function Cdiv_Unsigned (Op1 : in Big_Integer; Op2 : in Interfaces.C.unsigned) return Interfaces.C.unsigned is begin return Cdiv_Unsigned (Op1.Value, Op2); end Cdiv_Unsigned; --------------- -- Div_Exact -- --------------- procedure Div_Exact (Rop : in out Big_Integer; Op1, Op2 : in Big_Integer) is begin Div_Exact (Rop.Value, Op1.Value, Op2.Value); end Div_Exact; --------------- -- Factorial -- --------------- procedure Factorial (Rop : in out Big_Integer; Op : Interfaces.C.unsigned) is begin Factorial (Rop.Value, Op); end Factorial; --------- -- GCD -- --------- procedure GCD (Rop : in out Big_Integer; Op1, Op2 : in Big_Integer) is begin GCD (Rop.Value, Op1.Value, Op2.Value); end GCD; procedure GCD_Unsigned (Rop : in out Big_Integer; Op1 : in Big_Integer; Op2 : in Interfaces.C.unsigned) is begin GCD_Unsigned (Rop.Value, Op1.Value, Op2); end GCD_Unsigned; procedure GCD_Extended (G, S, T : in out Big_Integer; A, B : in Big_Integer) is begin GCD_Extended (G.Value, S.Value, T.Value, A.Value, B.Value); end GCD_Extended; -- In Ada, we can't pass a NULL pointer so have to resort to this trick: procedure GCD_Extended_No_T (G, S : in out Big_Integer; Dummy : System.Address; A, B : in Big_Integer) is begin GCD_Extended_No_T (G.Value, S.Value, Dummy, A.Value, B.Value); end GCD_Extended_No_T; ------------ -- Invert -- ------------ procedure Invert (Return_Code : out Interfaces.C.int; Rop : in out Big_Integer; Op1, Op2 : in Big_Integer) is begin Invert (Return_Code, Rop.Value, Op1.Value, Op2.Value); end Invert; --------- -- Neg -- --------- procedure Negate (Rop : in out Big_Integer; Op : in Big_Integer) is begin Negate (Rop.Value, Op.Value); end Negate; --------- -- Mod -- --------- -- Mod is a reserved word in Ada procedure Remainder (Rop : in out Big_Integer; Op1, Op2 : in Big_Integer) is begin Remainder (Rop.Value, Op1.Value, Op2.Value); end Remainder; -- function Mod_Unsigned (Rop : in out Big_Integer; -- Op1, Op2 : in Big_Integer) -- return Interfaces.C.unsigned; -- pragma Import (C, Mod_Unsigned, "mpz_mod_ui"); -------------- -- Multiply -- -------------- procedure Multiply (Rop : in out Big_Integer; Op1, Op2 : in Big_Integer) is begin Multiply (Rop.Value, Op1.Value, Op2.Value); end Multiply; procedure Multiply_2_Exponent (Rop : in out Big_Integer; X : in Big_Integer; Exponent : in Interfaces.C.unsigned) is begin Multiply_2_Exponent (Rop.Value, X.Value, Exponent); end Multiply_2_Exponent; procedure Multiply_Unsigned (Rop : in out Big_Integer; Op1 : in Big_Integer; Op2 : in Interfaces.C.unsigned) is begin Multiply_Unsigned (Rop.Value, Op1.Value, Op2); end Multiply_Unsigned; ---------------------- -- Perfect_Square_P -- ---------------------- function Perfect_Square_P (Op : Big_Integer) return Interfaces.C.int is begin return Perfect_Square_P (Op.Value); end Perfect_Square_P; ----------- -- Power -- ----------- procedure Power (Rop : in out Big_Integer; Base : in Big_Integer; Exponent : in Interfaces.C.unsigned) is begin Power (Rop.Value, Base.Value, Exponent); end Power; procedure Power_Unsigned (Rop : in out Big_Integer; Base, Exponent : Interfaces.C.unsigned) is begin Power_Unsigned (Rop.Value, Base, Exponent); end Power_Unsigned; procedure Power_Modulus (Rop : in out Big_Integer; Base, Exponent, Modulus : in Big_Integer) is begin Power_Modulus (Rop.Value, Base.Value, Exponent.Value, Modulus.Value); end Power_Modulus; procedure Power_Modulus_Unsigned (Rop : in out Big_Integer; Base : in Big_Integer; Exponent : in Interfaces.C.unsigned; Modulus : in Big_Integer) is begin Power_Modulus_Unsigned (Rop.Value, Base.Value, Exponent, Modulus.Value); end Power_Modulus_Unsigned; ---------------------- -- Probable_Prime_P -- ---------------------- function Probable_Prime_P (Op : Big_Integer; Reps : Interfaces.C.int) return Interfaces.C.int is begin return Probable_Prime_P (Op.Value, Reps); end Probable_Prime_P; ---------- -- Sqrt -- ---------- procedure Sqrt (Rop : in out Big_Integer; Op : in Big_Integer) is begin Sqrt (Rop.Value, Op.Value); end Sqrt; procedure Sqrt_Remainder (Rop1, Rop2 : in out Big_Integer; Op : in Big_Integer) is begin Sqrt_Remainder (Rop1.Value, Rop2.Value, Op.Value); end Sqrt_Remainder; --------- -- Sub -- --------- procedure Sub (Rop : in out Big_Integer; Op1, Op2 : in Big_Integer) is begin Sub (Rop.Value, Op1.Value, Op2.Value); end Sub; procedure Sub_Unsigned (Rop : in out Big_Integer; Op1 : in Big_Integer; Op2 : in Interfaces.C.unsigned) is begin Sub_Unsigned (Rop.Value, Op1.Value, Op2); end Sub_Unsigned; ------------------------------------------------------------------------------ -- Comparison -- ------------------------------------------------------------------------------ ------------- -- Compare -- ------------- function Compare (Op1, Op2 : Big_Integer) return Integer is begin return Compare (Op1.Value, Op2.Value); end Compare; function Compare_Integer (X : Big_Integer; Y : Integer) return Integer is begin return Compare_Integer (X.Value, Y); end Compare_Integer; function Compare_Unsigned (X : Big_Integer; Y : Interfaces.C.unsigned) return Integer is begin return Compare_Unsigned (X.Value, Y); end Compare_Unsigned; -- Don't overload both the signed and unsigned versions as 'compare', -- as this will lead to ambiguity in resolving the name ------------------------------------------------------------------------------ -- Bit Manipulation -- ------------------------------------------------------------------------------ ----------------- -- Bitwise_And -- ----------------- -- and is a reserved word in Ada, so cannot be a procedure name procedure Bitwise_And (Rop : in out Big_Integer; X, Y : in Big_Integer) is begin Bitwise_And (Rop.Value, X.Value, Y.Value); end Bitwise_And; ---------------- -- Bitwise_Or -- ---------------- -- or is a reserved word in Ada, so cannot be a procedure name procedure Bitwise_Or (Rop : in out Big_Integer; Op1, Op2 : in Big_Integer) is begin Bitwise_Or (Rop.Value, Op1.Value, Op2.Value); end Bitwise_Or; ---------------- -- Complement -- ---------------- procedure Complement (Rop : in out Big_Integer; Op : in Big_Integer) is begin Complement (Rop.Value, Op.Value); end Complement; ---------------------- -- Population_Count -- ---------------------- function Population_Count (Op : Big_Integer) return Interfaces.C.unsigned is begin return Population_Count (Op.Value); end Population_Count; -- For non-negative numbers, return the numbers of 1's bits in the twos -- complement representation of Op. For negative numbers, return MAX_ULONG ---------------------- -- Hamming_Distance -- ---------------------- function Hamming_Distance (Op1, Op2 : Big_Integer) return Interfaces.C.unsigned is begin return Hamming_Distance (Op1.Value, Op2.Value); end Hamming_Distance; -- If Op1 and Op2 are both non-negative, return the hamming distance -- between them. The behaviour in other cases depends on the version of -- the GMP library; MAX_ULONG may be returned. ----------- -- Scan0 -- ----------- function Scan0 (Op1 : Big_Integer; Starting_Bit : Interfaces.C.unsigned) return Interfaces.C.unsigned is begin return Scan0 (Op1.Value, Starting_Bit); end Scan0; ----------- -- Scan1 -- ----------- function Scan1 (Op1 : Big_Integer; Starting_Bit : Interfaces.C.unsigned) return Interfaces.C.unsigned is begin return Scan1 (Op1.Value, Starting_Bit); end Scan1; ------------- -- Set_Bit -- ------------- procedure Set_Bit (Rop : in out Big_Integer; Bit_Index : in Interfaces.C.unsigned) is begin Set_Bit (Rop.Value, Bit_Index); end Set_Bit; --------------- -- Clear_Bit -- --------------- procedure Clear_Bit (Rop : in out Big_Integer; Bit : Interfaces.C.unsigned) is begin Clear_Bit (Rop.Value, Bit); end Clear_Bit; ------------------------------------------------------------------------------ -- Miscellaneous -- ------------------------------------------------------------------------------ ------------------ -- Size_In_Base -- ------------------- function Size_In_Base (Op : Big_Integer; Base : Interfaces.C.int) return Interfaces.C.size_t is begin return Size_In_Base (Op.Value, Base); end Size_In_Base; ------------ -- Random -- ------------ procedure Random (Rop : Big_Integer; Max_Size : Interfaces.C.size_t) is begin Random (Rop.Value, Max_Size); end Random; procedure Random2 (Rop : Big_Integer; Max_Size : Interfaces.C.size_t) is begin Random2 (Rop.Value, Max_Size); end Random2; end GNU_Multiple_Precision.Controlled_Z;