new header file GMP

General FreeBASIC programming questions.
frisian
Posts: 249
Joined: Oct 08, 2009 17:25

new header file GMP

Post by frisian »

I have made a new header file for GMP, version 6.0.0a, which has a few new functions, instead of adding to the old header file.
I used FBfrog 1.5 to convert the .h file to a .bi file, the .h file has some inline code that can't be translated so I removed that part.
The new header file that was produced is edited in some places to get it working, I also removed a bunch of empty lines to get a more cleaner look.
I also wrote a sort of program to check the working of the header file (also handy to see which keywords I need to add to my GMP keyword highlighting file).

I have also build a static GMP library file (i486/win32) with TDM32.

The download file (7z) contains the new header file "gmp.bi", "libgmp.a", "test_gmp.bas" (and some other files if your interested). download GMP.7z

First time that I made a header file so any comment, complains or suggestions are welcome.

Edit: TDM32 is gcc (tdm-1) 4.9.2
Last edited by frisian on Jan 17, 2015 13:45, edited 1 time in total.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: new header file GMP

Post by dodicat »

Hi frisian.
Did a quick test on Win XP, unfortunately I got a segment error on your test file :
'------------------------------------------------------------------------------------
size of int 4
size of clong 4
size of uint 4
size of culong 4
size of int ptr 4
size of clong ptr 4
size of uint ptr 4
size of culong ptr 4
size of zstr ptr 4


Gmp_printf does print directly uses C-style

1:Pi= 3.14159265358979311600 2:Pi= 3.14159265358979311600

Aborting due to runtime error 12 ("segmentation violation" signal) in C:\Documen
ts and Settings\USER\My Documents\Downloads\gmpheaders\FBIDETEMP.bas::()

Press any key to continue . . .

However, testing with my own stuff, which basically uses the gmp floats to get trig functions e.t.c. it tested OK.

Code: Select all

#Include once "gmp.bi"

'new libs
'sin,cos,tan,logtaylor,log,exp,power,atn,acos,asin,greater,equals,less
'absolute,Pi_ui
Dim Shared As Ulongint PRECISION 
'========= Just in case you forget to set_precision ==========
precision=60
mpf_set_default_prec( PRECISION*4 )
'========================================================

Sub set_precision(n As Uinteger)
    PRECISION=n
    mpf_set_default_prec( PRECISION*4 )
End Sub

Function equals overload(a As mpf_t,b As mpf_t) As Integer
    If Mpf_cmp(@a,@b) = 0 Then Return -1
End Function

Function greater overload(a As mpf_t,b As mpf_t) As Integer 'a>b
    If equals(a,b) Then Return 0
    Dim As mpf_t Ab,diff
    mpf_init(@Ab)
    mpf_init(@diff)
    mpf_sub(@diff,@b,@a)
    mpf_abs(@Ab,@diff)
    If mpf_cmp(@Ab,@diff)=0 Then Return 0
    Return -1
End Function
'(byval as mpz_ptr, byval as mpz_srcptr, byval as mpz_srcptr)
'function _mod_(n1 as mpz_ptr,n2 as mpz_ptr ) as mpz_srcptr
'mpz_mod
'end function
Function less overload(a As mpf_t,b As mpf_t) As Integer 'a>b
    If equals(a,b) Then Return 0
    if greater(a,b) then return 0
    return -1
End Function

function Absolute overload(a As mpf_t) as  mpf_t
    Dim As mpf_t Ab
    mpf_init(@Ab)
    mpf_abs(@Ab,@a)
    return Ab
    end function



Function Pi_ui Overload(places As Uinteger) As mpf_t
    Dim As __mpf_struct a,b,t,p,aa,bb,tt,pp,pi
    mpf_init2( @a, 4*places)
    mpf_init2( @b, 4*places)
    mpf_init2( @t, 4*places)
    mpf_init2( @p, 4*places)
    mpf_init2( @aa,4*places)
    mpf_init2( @bb,4*places)
    mpf_init2( @tt,4*places)
    mpf_init2( @pp,4*places)
    mpf_init2( @pi,4*places)
    mpf_set_str( @a,"1",10)
    mpf_set_str( @b,"2",10):mpf_sqrt( @b, @b )
    mpf_set_str( @t,".25",10)
    mpf_set_str( @p,"1",10)
    mpf_ui_div( @b,1,@b)
    Do 
        mpf_add( @aa,  @a,  @b )
        mpf_div_ui( @aa, @aa , 2 )
        mpf_mul( @bb, @a, @b )
        mpf_sqrt( @bb, @bb )
        mpf_sub( @tt, @a, @aa )
        mpf_mul(@tt,@tt,@tt)
        mpf_mul( @tt, @tt, @p )
        mpf_sub( @tt, @t, @tt )
        mpf_mul_ui( @pp, @p, 2 )
        mpf_swap( @a, @aa )
        mpf_swap( @b, @bb )
        mpf_swap( @t, @tt )
        mpf_swap( @p, @pp )
    Loop Until  Mpf_cmp(@a,@aa) = 0
    mpf_add( @pi, @a, @b )
    mpf_mul(@pi,@pi,@pi)
    mpf_div_ui( @pi, @pi, 4 )
    mpf_div( @pi, @pi, @t )
    Return pi
End Function

Function _sin Overload(x As mpf_t) As mpf_t
    Dim As mpf_t inv,XX,Term,Accum,_x,p,temp2,fac
    mpf_init(@_x)
    mpf_set(@_x,@x)
    Dim As mpf_t pi2,circ,Ab
    mpf_init(@circ)
    mpf_init(@Ab)
    pi2=Pi_ui(Cuint(20))
    mpf_mul_ui(@circ,@pi2,2)
    mpf_abs(@Ab,@x)
    If greater(Ab,circ) Then
        '======== CENTRALIZE ==============
        'floor/ceil to centralize
        Dim As mpf_t tmp,tmp2
        mpf_init(@tmp2)
        mpf_init(@tmp)
        If precision>20 Then
            pi2=pi_ui(precision)
        End If
        mpf_mul_ui(@pi2,@pi2,2) 'got 2*pi
        mpf_div(@tmp,@_x,@pi2)
        mpf_set(@tmp2,@tmp) 
        mpf_trunc(@tmp,@tmp)     'int part
        mpf_sub(@tmp,@tmp2,@tmp) 'frac part
        mpf_mul(@tmp,@tmp,@pi2)
        mpf_set(@_x,@tmp)
    End If
    '==================================
    Dim As Integer sign(3):sign(3)=1
    Dim As Integer c=1
    mpf_init(@XX)
    mpf_init(@Term)
    mpf_init(@Accum)
    mpf_init(@p)
    mpf_init(@fac)
    mpf_init(@temp2)
    mpf_init_set(@accum,@_x)
    mpf_init_set_str(@fac,"1",10)
    mpf_init_set(@p,@_x)
    mpf_mul(@XX,@_x,@_x)
    Do 
        c=c+2
        Mpf_set(@temp2,@accum)
        mpf_mul_ui(@fac,@fac,c*(c-1))
        mpf_mul(@p,@p,@XX)
        mpf_div(@term,@p,@fac)
        If sign(c And 3) Then
            mpf_sub(@Accum,@temp2,@Term)
        Else
            mpf_add(@Accum,@temp2,@Term)
        End If
    Loop Until  Mpf_cmp(@accum,@temp2) = 0  
    Return accum
End Function
Function _cos Overload(x As mpf_t) As mpf_t
    Dim As mpf_t inv,XX,Term,Accum,_x,p,temp2,fac
    mpf_init(@_x)
    mpf_set(@_x,@x)
    Dim As mpf_t pi2,circ,AB
    mpf_init(@circ)
    mpf_init(@Ab)
    pi2=Pi_ui(Cuint(20))
    mpf_mul_ui(@circ,@pi2,2)
    mpf_abs(@Ab,@x)
    If greater(Ab,circ) Then
        '======== CENTRALIZE ==============
        'floor/ceil to centralize
        Dim As mpf_t tmp,tmp2
        mpf_init(@tmp2)
        mpf_init(@tmp)
        If precision>20 Then
            pi2=pi_ui(precision)
        End If
        mpf_mul_ui(@pi2,@pi2,2) 'got 2*pi
        mpf_div(@tmp,@_x,@pi2)
        mpf_set(@tmp2,@tmp) 
        mpf_trunc(@tmp,@tmp)     'int part
        mpf_sub(@tmp,@tmp2,@tmp) 'frac part
        mpf_mul(@tmp,@tmp,@pi2)
        mpf_set(@_x,@tmp)
    End If
    '==================================
    Dim As Integer sign(3):sign(2)=1
    Dim As Integer c
    mpf_init(@XX)
    mpf_init(@Term)
    mpf_init(@Accum)
    mpf_init(@p)
    mpf_init(@fac)
    mpf_init(@temp2)
    mpf_init_set_str(@accum,"1",10)
    mpf_init_set_str(@fac,"1",10)
    mpf_init_set_str(@p,"1",10)
    mpf_mul(@XX,@_x,@_x)
    Do 
        c=c+2
        Mpf_set(@temp2,@accum)
        mpf_mul_ui(@fac,@fac,c*(c-1))
        mpf_mul(@p,@p,@XX)
        mpf_div(@term,@p,@fac)
        If sign(c And 3) Then
            mpf_sub(@Accum,@temp2,@Term)
        Else
            mpf_add(@Accum,@temp2,@Term)
        End If
    Loop Until  Mpf_cmp(@accum,@temp2) = 0  
    Return accum
End Function
Function _tan Overload(x As mpf_t) As mpf_t
    Dim As mpf_t s,c,_x,ans
    mpf_init(@ans)
    mpf_init(@_x)
    mpf_set(@_x,@x)
    s=_sin(_x)
    c=_cos(_x)
    mpf_div(@ans,@s,@c)
    Return ans
End Function
Function _logTaylor(x As mpf_t) As mpf_t
    'taylor series
    '====================Log Guard==================
    Dim As mpf_t g,zero
    mpf_init(@g)
    mpf_set(@g,@x)
    mpf_init(@zero)
    mpf_init_set_str(@zero,"0",10)
    mpf_abs(@g,@g)
    If  Mpf_cmp(@g,@x) <> 0 Then  Exit Function
    If Mpf_cmp(@x,@zero) = 0 Then  Exit Function
    '=============================================
    Dim As Integer invflag
    Dim As  mpf_t Inv,XX,Term,Accum,strC,_x,tmp,tmp2
    Dim As mpf_t T,B,one,Q,two
    mpf_init(@two)
    mpf_init(@XX)
    mpf_init(@Q)
    mpf_init(@inv)
    mpf_init(@tmp)
    mpf_init(@tmp2)
    mpf_init(@accum)
    mpf_init(@term)
    mpf_init(@T)
    mpf_init(@B)
    mpf_init(@one)
    mpf_init(@_x)
    mpf_init_set_str(@one,"1",10)
    mpf_init_set_str(@two,"2",10)
    mpf_set(@_x,@x)
    If less(x,one) Then
        invflag=1
        mpf_div(@_x,@one,@_x)
    End If
    mpf_sub(@T,@_x,@one)
    mpf_add(@B,@_x,@one)
    mpf_div(@accum,@T,@B)
    mpf_div(@Q,@T,@B)
    Mpf_set(@tmp,@Q)
    Mpf_mul(@XX,@Q,@Q)
    Dim As Integer c=1
    Do 
        c=c+2
        Mpf_set(@tmp2,@tmp)
        mpf_mul(@Q,@Q,@XX)
        mpf_div_ui(@term,@Q,c)
        mpf_add(@Accum,@tmp,@Term)
        Mpf_swap(@tmp,@Accum)
    Loop Until Mpf_cmp(@tmp,@tmp2) = 0
    mpf_mul(@accum,@accum,@two)
    If invflag Then
        Dim As mpf_t minus1
        mpf_init(@minus1)
        mpf_init_set_str(@minus1,"-1",10)
        mpf_mul(@accum,@minus1,@accum)
        Return accum
    End If
    Return accum
End Function
Function _log Overload(x As mpf_t) As mpf_t
    '====================Log Guard==================
    Dim As mpf_t g=x,zero
    mpf_init(@zero)
    mpf_init_set_str(@zero,"0",10)
    mpf_abs(@g,@g)
    If  Mpf_cmp(@g,@x) <> 0 Then  Exit Function
    If Mpf_cmp(@x,@zero) = 0 Then  Exit Function
    '=============================================
    Dim As mpf_t approx,ans,logx,factor
    mpf_init(@approx)
    Mpf_set(@approx,@x)
    mpf_init(@factor)
    mpf_init_set_str(@factor,"8",10)
    mpf_init(@ans)
    mpf_sqrt(@approx,@approx)
    mpf_sqrt(@approx,@approx)
    mpf_sqrt(@approx,@approx)
    logx=_logTaylor(approx)
    mpf_mul(@ans,@factor,@logx)
    Return ans
End Function
Function _exp Overload(x As mpf_t) As mpf_t
    'taylor series
    Dim As  mpf_t fac,inv,_x,temp1,temp2,accum,strc,one,p,term
    mpf_init(@Inv)
    mpf_init(@fac)
    mpf_init(@_x)
    mpf_init(@temp1)
    mpf_init(@temp2)
    mpf_init(@accum)
    mpf_init(@strc)
    mpf_init(@one)
    mpf_init(@p)
    mpf_init(@term)
    mpf_init_set_str(@one,"1",10)
    mpf_init_set_str(@fac,"1",10)
    mpf_set(@_x,@x)
    mpf_init_set_str(@temp1,"1",10)
    mpf_init_set_str(@p,"1",10)'_x
    mpf_init_set_str(@accum,"1",10)
    Dim As Integer c
    Do
        c=c+1
        Mpf_set(@temp2,@accum)
        mpf_init_set_str(@strC,Str(c),10)
        mpf_mul(@fac,@fac,@strc)
        mpf_mul(@p,@p,@_x)
        mpf_div(@term,@p,@fac)
        mpf_add(@Accum,@temp2,@Term)
    Loop Until Mpf_cmp(@accum,@temp2) = 0
    Return accum
End Function
Function power Overload(a As mpf_t,p As mpf_t) As mpf_t
    'a^p= exp(p*log(a))
    '====================Power Guard==================
    Dim As mpf_t g,zero
    mpf_init(@g)
    Mpf_set(@g,@a)
    mpf_init(@zero)
    mpf_init_set_str(@zero,"0",10)
    mpf_abs(@g,@g)
    If  Mpf_cmp(@g,@a) <> 0 Then  Exit Function
    If Mpf_cmp(@a,@zero) = 0 Then  Exit Function
    '=============================================
    Dim As mpf_t loga,product,ans
    mpf_init(@product)
    loga=_log(a)
    mpf_mul(@product,@p,@loga)
    ans=_exp(product)
    Return ans
End Function
Function _Atn Overload(x As mpf_t) As mpf_t
    #macro ArctanTaylor(decnum)
    mpf_init(@Inv)
    mpf_init(@XX)
    mpf_init(@Term)
    mpf_init(@Accum)
    mpf_init(@strC)
    mpf_init(@_x)
    mpf_init(@mt)
    mpf_init(@mt2)
    mpf_init(@p)
    Mpf_set(@mt,@decnum)
    Mpf_set(@_x,@decnum)
    Mpf_set(@p,@decnum)
    mpf_mul(@XX,@_x,@_x)
    Do
        c=c+2
        Mpf_set(@mt2,@mt)
        mpf_set_str(@strC,Str(c),10)
        mpf_mul(@p,@p,@XX)
        mpf_div(@Term,@p,@strc)
        If sign(c And 3) Then
            mpf_sub(@Accum,@mt,@Term)
        Else
            mpf_add(@Accum,@mt,@Term)
        End If
        Mpf_swap(@mt,@Accum)
    Loop Until  Mpf_cmp(@mt,@mt2) = 0
    #endmacro
    Dim As Integer sign(3):sign(3)=1
    Dim As Uinteger c=1
    Dim As mpf_t Inv,XX,Term,Accum,_one,strC,_x,mt,mt2,p
    Dim As mpf_t _temp,one,_temp2,factor
    
    mpf_init(@_temp)
    mpf_init(@one)
    mpf_init(@factor)
    mpf_init(@_temp2)
    mpf_set(@_temp2,@x)
    mpf_init_set_str(@one,"1",10)
    Dim As Integer limit=16
    Dim As String P2=Str(2^limit)
    mpf_init_set_str(@factor,p2,10)
    For z As Integer=1 To limit
        mpf_mul(@_temp,@_temp2,@_temp2)
        mpf_add(@_temp,@_temp,@one)
        mpf_sqrt(@_temp,@_temp)
        mpf_add(@_temp,@_temp,@one)
        mpf_div(@_temp,@_temp2,@_temp)
        Mpf_set(@_temp2,@_temp)
    Next z
    ArctanTaylor(_temp)
    mpf_mul(@mt,@factor,@mt)
    Return mt
End Function
Function _Acos Overload(x As mpf_t) As mpf_t
    Dim As mpf_t  one,minusone,two,atn1,tail,T,B,term1,atnterm1,ans',_x,temp
    'ARCCOS = ATN(-x / SQR(-x * x + 1)) + 2 * ATN(1)
    '============= ARCCOS GUARD =========
    Var num= mpf_get_d(@x)
    If num>1 Then Exit Function
    If num<-1 Then Exit Function
    '========================
    mpf_init(@one)
    mpf_init(@two)
    mpf_init(@minusone)
    mpf_init(@tail)
    mpf_init(@T)
    mpf_init(@B)
    mpf_init(@term1)
    mpf_init(@ans)
    mpf_init_set_str(@one,"1",10)
    mpf_init_set_str(@minusone,"-1",10)
    mpf_init_set_str(@two,"2",10)
    atn1=_ATN(one)
    mpf_mul(@tail,@two,@atn1)  '2*atn(1)
    mpf_mul(@T,@minusone,@x)   '-x
    mpf_mul(@B,@x,@x) 'x*x
    If Mpf_cmp(@B,@one) = 0 Then
        'for 1 and -1  
        If mpf_cmp(@x,@minusone)=0 Then
            Dim As mpf_t four
            mpf_init(@four)
            mpf_init_set_str(@four,"4",10)
            mpf_mul(@four,@four,@atn1)
            Return four
        Else
            Dim As mpf_t zero
            mpf_init(@zero)
            mpf_init_set_str(@zero,"0",10)
            Return zero
        End If
    End If
    mpf_sub(@B,@one,@B)        '1-x*x
    mpf_sqrt(@B,@B)            'sqr(1-x*x)
    mpf_div(@term1,@T,@B)
    atnterm1=_ATN(term1)
    mpf_add(@ans,@atnterm1,@tail)
    Return ans
End Function
Function _Asin Overload(x As mpf_t) As mpf_t
    ' ARCSIN = ATN(x / SQR(-x * x + 1))
    '============= ARCSIN GUARD =========
    Var num= mpf_get_d(@x)
    If num>1 Then Exit Function
    If num<-1 Then Exit Function
    '========================
    Dim As mpf_t  one,T,B,term1,atnterm1,minusone
    mpf_init(@minusone)
    mpf_init(@one)
    mpf_init(@T)
    mpf_init(@B)
    mpf_init(@term1)
    mpf_init_set_str(@one,"1",10)
    mpf_init_set_str(@minusone,"-1",10)
    mpf_set(@T,@x)
    'T=x
    mpf_mul(@B,@x,@x)          'x*x
    'for 1 and -1
    If Mpf_cmp(@B,@one) = 0 Then
        Dim As mpf_t two,atn1
        mpf_init(@two)
        mpf_init_set_str(@two,"2",10)
        atn1=_atn(one)
        If mpf_cmp(@x,@minusone)=0 Then
            mpf_mul(@two,@two,@atn1)
            mpf_mul(@two,@two,@minusone)
            Return two
        Else
            mpf_mul(@two,@two,@atn1)
            Return two
        End If
    End If
    mpf_sub(@B,@one,@B)        '1-x*x
    mpf_sqrt(@B,@B)            'sqr(1-x*x)
    mpf_div(@term1,@T,@B)
    atnterm1=_ATN(term1)
    Return atnterm1
End Function


'===========================================================================
'=======================   OVERLOADS  FOR STRINGS ===============================
Dim Shared As Zstring * 100000000 outtext

Function Pi_ui Overload(places As Integer) As String
    Dim As Mpf_t ans
    Var pl=Cuint(places)
    ans=pi_ui(pl)
    gmp_sprintf( @outtext,"%." & pl & "Ff",@ans )
    Var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt) 
End Function

Function _sin Overload(x As String) As String
    Dim As Mpf_t _x,ans
    mpf_init(@_x)
    mpf_init_set_str(@_x,x,10)
    ans=_sin(_x)
    gmp_sprintf( @outtext,"%." & precision & "Ff",@ans )
    Var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt) 
End Function

Function _cos Overload(x As String) As String
    Dim As Mpf_t _x,ans
    mpf_init(@_x)
    mpf_init_set_str(@_x,x,10)
    ans=_cos(_x)
    gmp_sprintf( @outtext,"%." & precision & "Ff",@ans )
    Var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt) 
End Function

Function _tan Overload(x As String) As String
    Dim As Mpf_t _x,ans
    mpf_init(@_x)
    mpf_init_set_str(@_x,x,10)
    ans=_tan(_x)
    gmp_sprintf( @outtext,"%." & precision & "Ff",@ans )
    Var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt) 
End Function

Function _log Overload(x As String) As String
    Dim As Mpf_t _x,ans
    mpf_init(@_x)
    mpf_init_set_str(@_x,x,10)
    ans=_log(_x)
    gmp_sprintf( @outtext,"%." & precision & "Ff",@ans )
    Var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt) 
End Function

Function _exp Overload(x As String) As String
    Dim As Mpf_t _x,ans
    mpf_init(@_x)
    mpf_init_set_str(@_x,x,10)
    ans=_exp(_x)
    gmp_sprintf( @outtext,"%." & precision & "Ff",@ans )
    Var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt) 
End Function

Function power Overload(a As String,p As String) As String
    Dim As Mpf_t _x,ans,pow
    mpf_init(@_x)
    mpf_init_set_str(@_x,a,10)
    mpf_init(@pow)
    mpf_init_set_str(@pow,p,10)
    ans=power(_x,pow)
    gmp_sprintf( @outtext,"%." & precision & "Ff",@ans )
    Var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt) 
End Function

Function _Atn Overload(x As String) As String
    Dim As Mpf_t _x,ans
    mpf_init(@_x)
    mpf_init_set_str(@_x,x,10)
    ans=_Atn(_x)
    gmp_sprintf( @outtext,"%." & precision & "Ff",@ans )
    Var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt) 
End Function

Function _Acos Overload(x As String) As String
    Dim As Mpf_t _x,ans
    mpf_init(@_x)
    mpf_init_set_str(@_x,x,10)
    ans=_Acos(_x)
    gmp_sprintf( @outtext,"%." & precision & "Ff",@ans )
    Var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt) 
End Function

Function _Asin Overload(x As String) As String
    Dim As Mpf_t _x,ans
    mpf_init(@_x)
    mpf_init_set_str(@_x,x,10)
    ans=_Asin(_x)
    gmp_sprintf( @outtext,"%." & precision & "Ff",@ans )
    Var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt) 
End Function


Function factorial(n As Uinteger) As String 'Automatic precision
    Dim As __mpz_struct Intanswer
    mpz_init2( @Intanswer,0)
    mpz_set_str( @Intanswer,"",10)
    mpz_fac_ui(@Intanswer,n)
    gmp_sprintf( @outtext,"%Zi", @Intanswer )
    Return Trim(outtext)
End Function

function _mod(n1 as string,n2 as string) as string
   dim as __mpz_struct answer,mn1,mn2
   mpz_init2( @answer,0)
    mpz_init2( @mn1,0)
     mpz_init2( @mn2,0)
   mpz_init_set_str( @answer,"",10)
   mpz_init_set_str( @mn1,n1,10)
   mpz_init_set_str( @mn2,n2,10)
   mpz_mod(@answer,@mn1,@mn2)
   gmp_sprintf( @outtext,"%Zi", @answer )
    Return Trim(outtext)
   
end function

Function Sqrroot(number As String,decimals As Uinteger=PRECISION) As String'precision parameter
    if instr(number,"-") then exit function
    Dim As __mpf_struct num,FloatAnswer
    Dim As Integer LN=Len(number)
    mpf_init2(@num,4*Ln):mpf_init2(@FloatAnswer,4*Ln)
    mpf_set_str(@num,number,10)
    mpf_sqrt( @FloatAnswer,@num)
    gmp_sprintf( @outtext,"%." & Str(decimals) & "Ff",@FloatAnswer )
    Return Trim(outtext)
End Function

Function mult(number1 As String,number2 As String) As String'Automatic precision
    Dim As Integer Ln1=Len(number1),Ln2=Len(number2)
    Dim As __mpf_struct num1,num2,FloatAnswer
    mpf_init2( @num1,4*(Ln1+Ln2+1) )
    mpf_init2( @num2,4*(Ln1+Ln2+1) )
    mpf_init2(@Floatanswer,4*(Ln1+Ln2+1))
    Ln1=Instr(1,number1,"."):Ln2=Instr(1,number2,".")
    var decimals=Len(Mid(number1,Ln1+1))+Len(Mid(number2,Ln2+1))+1
    mpf_set_str( @num1,number1,10)
    mpf_set_str( @num2,number2,10)
    mpf_mul(@Floatanswer,@num1,@num2)
    gmp_sprintf( @outtext,"%." & Str(decimals) & "Ff",@FloatAnswer )
    var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt)
End Function

'precision parameter
Function divide(number1 As String,number2 As String,decimals As Uinteger=PRECISION) As String
    Dim As Integer Ln1=Len(number1),Ln2=Len(number2),Ln
    If Ln1>=Ln2 Then  Ln=Ln1 Else Ln=Ln2
    Dim As __mpf_struct num1,num2,FloatAnswer
    mpf_init2( @num1,4*(Ln+1) )
    mpf_init2( @num2,4*(Ln+1) )
    mpf_init2(@Floatanswer,4*(Ln+1)+4*decimals)
    mpf_set_str( @num1,number1,10)
    mpf_set_str( @num2,number2,10)
    mpf_div(@Floatanswer,@num1,@num2)
    gmp_sprintf( @outtext,"%." & Str(decimals) & "Ff",@FloatAnswer)
    Return Trim(outtext)
End Function

Function  Power Overload(number As String,n As Uinteger) As String'automatic precision
    #define dp 3321921
    Dim As __mpf_struct _number,FloatAnswer
    Dim As Ulongint ln=Len(number)*(n)*4
    If ln>dp Then ln=dp
    mpf_init2(@FloatAnswer,ln)
    mpf_init2(@_number,ln) 'or 4*len(number)
    mpf_set_str(@_number,number,10)
    mpf_pow_ui(@Floatanswer,@_number,n)
    gmp_sprintf( @outtext,"%." & Str(n) & "Ff",@FloatAnswer )
    Var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt)
End Function

Function plus(number1 As String,number2 As String) As String'automatic precision
    Dim As Integer Ln1=Len(number1),Ln2=Len(number2),decimals,Ln
    If Ln1>=Ln2 Then Ln=Ln1 Else Ln=Ln2
    Ln=ln+1
    Dim As __mpf_struct num1,num2,FloatAnswer
    mpf_init2( @num1,4*(Ln1+1) )
    mpf_init2( @num2,4*(Ln2+1) )
    mpf_init2(@Floatanswer,4*(Ln))
    mpf_set_str( @num1,number1,10)
    mpf_set_str( @num2,number2,10)
    Ln1=Instr(1,number1,"."):Ln2=Instr(1,number2,".")
    If Ln1 Or Ln2 Then
        decimals=Len(Mid(number1,Ln1+1))+Len(Mid(number2,Ln2+1))+1
    End If
    mpf_add(@Floatanswer,@num1,@num2)
    gmp_sprintf( @outtext,"%." & Str(decimals) & "Ff",@FloatAnswer )
    var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt)
End Function

Function minus(number1 As String,number2 As String) As String'automatic precision
    Dim As Integer Ln1=Len(number1),Ln2=Len(number2),decimals,Ln
    If Ln1>=Ln2 Then  Ln=Ln1 Else Ln=Ln2
    Ln=ln+1
    Dim As __mpf_struct num1,num2,FloatAnswer
    mpf_init2( @num1,4*(Ln1+1) )
    mpf_init2( @num2,4*(Ln2+1) )
    mpf_init2(@Floatanswer,4*(Ln))
    mpf_set_str( @num1,number1,10)
    mpf_set_str( @num2,number2,10)
    Ln1=Instr(1,number1,"."):Ln2=Instr(1,number2,".")
    If Ln1 Or Ln2 Then
        decimals=Len(Mid(number1,Ln1+1))+Len(Mid(number2,Ln2+1))+1
    End If
    mpf_sub(@Floatanswer,@num1,@num2)
    gmp_sprintf( @outtext,"%." & Str(decimals) & "Ff",@FloatAnswer )
    var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt)
End Function
function Absolute overload(a As string) as  string
    Dim As __mpf_struct Ab,Floatanswer
     mpf_init2( @FloatAnswer,4*precision )
     mpf_init2( @Ab,4*precision )
     mpf_set_str( @Ab,a,10)
     mpf_abs(@FloatAnswer,@Ab)
     gmp_sprintf( @outtext,"%." & Str(precision) & "Ff",@FloatAnswer )
    var outtxt=Trim(outtext)
    If Instr(outtxt,".") Then outtxt= Rtrim(outtxt,"0"):outtxt=Rtrim(outtxt,".")
    Return Trim(outtxt)
end function

function greater overload(a as string,b as string) as integer
   dim as mpf_t ma,mb
   mpf_init2(@ma,4*precision)
   mpf_init2(@mb,4*precision)
    mpf_set_str( @ma,a,10)
    mpf_set_str( @mb,b,10)
    return greater(ma,mb)
end function
function equals overload(a as string,b as string) as integer
       dim as mpf_t ma,mb
   mpf_init2(@ma,4*precision)
   mpf_init2(@mb,4*precision)
    mpf_set_str( @ma,a,10)
    mpf_set_str( @mb,b,10)
    return equals(ma,mb)
end function

function less overload(a as string,b as string) as integer
   if equals(a,b) then return 0
   if greater(a,b) then return 0
   return -1
    end function

'======================== TESTS ===============================
''Extern gmp_version Alias "__gmp_version" As Zstring Ptr
Print "GMP version ";*gmp_version
set_precision(2000)

Print "256.00098 ^ -6.003"
Print "press a key"
Sleep
Dim As String num="256.00098",pow="-6.003"
Print "power ";num;" to ";pow
Print power(num,pow)
Print "Float check"
Print Val(num)^Val(pow)
Print "Now pi to 5000 places"
Print "Press a key"
Sleep
Print
Print
Print "pi from Pi_ui"
Print Pi_ui(5000)
Print "Press a key"
Sleep
Print

Print
Print
Print "Log(50000.5)"
Print _log("50000.5")
Print
Print "Float check"
Print Str(Log(50000.5))
Print "Press a key"
Sleep
Print 


set_precision(60)
Print
Print "sin(.33)"
Print _sin(".33"),Sin(.33)
Print
Print "cos(-300.988)"
Print _cos("-300.988"),Cos(-300.988)
Print
Print "tan(1000000)"
Print _tan("1000000"),Tan(1000000)
Print
Print " Now -- 2 to power 1000000"
Print "press a key"
Sleep
Print
Print power("2",1000000)
Print
Print "now  1/5.870099330099900999 to 10000 places"
Print "press a key"
Sleep
var ans=divide("1","5.870099330099900999",10000)
Print ans
Print "Check length  ";Len(ans)
Print "e to 4000 places"
Print "press a key"
Sleep
set_precision(4000)
print _exp("1")

Print
Print "Last test, acos(-1), which is pi"
Print "press a key"
Sleep
Print _acos("-1")
Print "Done"
dim as string g="-56.99"
print absolute(g)

sleep
 
frisian
Posts: 249
Joined: Oct 08, 2009 17:25

Re: new header file GMP

Post by frisian »

dodicat

I was somewhat surprised by your error message, had I put the wrong program in the 7z file. I even downloaded my own file to check it, it had the correct bas file. I even downloaded FBide to see if I could get the same error message as you.I even put the gmp.bi and libgmp.a for the file into FBC 1.00.0 and FBC 1.00.1. I compiled the test_gmp file with FBide, FBedit, CSED_FB-1_0_6_7, but all cases it run correctly, even the produced .EXE files run correctly. I'm unable to recreate your error message.

I use FBedit myself (I started with FBide but switched to FBedit). When I wrote the test_gmp.bas file I noticed that the compiled EXE file runs without problems under FBedit but when starting the EXE file on it one (file manager/window explorer) it crashed. So before I included the bas file I tested that it would not crash when running EXE file.

The last error I had was the same as your error message, it's caused by ret_val = Gmp_sprintf(str_, "3:Pi= %.*Ff ", 20, f_op1 ) it seems that the problem is with str_. Under FBedit it would run correctly but on it one it would crash with the error message you had.

I tried a few things, inserting before the line deallocate(str_) : str_ = allocate(1000) also adding a new zstring would work like
dim as zstring Ptr qq
qq = allocate(1000)
ret_val = Gmp_sprintf(qq, "3:Pi= %.*Ff ", 20, f_op1 )
print *qq

Both solutions work but all this did not satisfy me so I looked for earlier occurrences of str_, about 20 lines above I had
str_ = Mpf_get_str(0, exp_, 10, 10, f_op1)
Mpf_urandomb(f_op1, @rs, b)
str_ = Mpf_get_str(0, exp_, 10, 10, f_op1)
Mpf_urandomb(f_op1, @rs, b)
str_ = Mpf_get_str(0, exp_, 10, 20, f_op1)

I changed the lines with str_ to
Mpf_get_str(str_, exp_, 10, 10, f_op1)
Mpf_urandomb(f_op1, @rs, b)
Mpf_get_str(str_, exp_, 10, 10, f_op1)
Mpf_urandomb(f_op1, @rs, b)
Mpf_get_str(str_, exp_, 10, 20, f_op1)

And I restored the rest to the state it was before.

The program ran without a crash under FBedit and on it one, and I added it to the 7z file.

So I the only thing at the moment I can do is to ask you to do a few thing.

1. Does the EXE file on it one also stops working.

2. Comment the line ret_val = Gmp_sprintf(str_, "3:Pi= %.*Ff ", 20, f_op1 ) out and recompile and run
does it still crashes in both cases (under FBide and on it one).

3. Insert before ret_val = Gmp_sprintf(str_, "3:Pi= %.*Ff ", 20, f_op1 ) a line with deallocate(str_) : str_ = allocate(1000)
does that work.

4. replace ret_val = Gmp_sprintf(str_, "3:Pi= %.*Ff ", 20, f_op1 ) with
dim as zstring Ptr qq
qq = allocate(1000)
ret_val = Gmp_sprintf(qq, "3:Pi= %.*Ff ", 20, f_op1 )
print *qq

does that work.

If none of these things works I out of options and the question would be if FreeBasic or GMP is cause off it and how to figure out what the cause of it is.

I would appreciate feedback on this from you and others who tried the program if it worked correctly or if it crashed and if one or more suggestions worked or not. (i know that only a few members use GMP so any feedback would help).


I did found one error in test_gmp.bas ret_val = Gmp_asprintf(@str_,"5:Pi= %.*Ff ", 20, f_op1 ) need to replaced with something like this
Dim As ZString Ptr Ptr d_ptr
d_ptr = Allocate(1000)
ret_val = Gmp_asprintf(d_ptr , "5:Pi= %.*Ff ", 20, f_op1 )
Print *(*d_ptr)


Gmp_asprintf needs a zstring ptr ptr not a zstring ptr

PS. I have seen your program before on the forum and noticed that can be in-proved / cleaned up, I will post a version with comments.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: new header file GMP

Post by dodicat »

For your test code to work here:
If you initialize str_ as a zstring * 1000 (say), then for the zstring ptr parameters use @str_.
The zstring ptr ptr needs a seperate variable derived from str_ via a cast.
Also, I've omitted the str_ in str_= ~~~

The crash was in the "3:Pi= and "4:Pi= values for ret_val, but if I commented out the "3:Pi= one it didn't crash.

I also tried your original test code in another IDE (wxFBE), no difference.

For my functions, mess about by all means, but they are only a FreeBASIC trial at some of mpfr from gmp.

I believe some mpfr functions becomes inaccurate at several thousand places (according to member srvaldez a while back), the power series shouldn't, albeit with a loss of some speed.
Here's your test adjusted to work here:

Code: Select all

 /'
Program to test/check gmp.bi file and to figure out wich functions are new (for my keyword highlighting) 
mpz_inits(), mpz_clears(), mpq_inits(), mpq_clears(), mpf_inits(), mpf_clears() will not work under FreeBasic 
Mpz_array_init does work but the array can't be cleared better do it the FreeBasic way
'/

#Include "gmp2.bi"

Print "       size of int "; SizeOf(Integer)
Print "     size of clong "; SizeOf(clong)
Print "      size of uint "; SizeOf(UInteger)
Print "    size of culong "; SizeOf(culong)
Print "   size of int ptr "; SizeOf(Integer Ptr)
Print " size of clong ptr "; SizeOf(clong Ptr)
Print "  size of uint ptr "; SizeOf(UInteger Ptr)
Print "size of culong ptr "; SizeOf(culong Ptr)
Print "  size of zstr ptr "; SizeOf(ZString ptr)
Print

Dim As Double d = 3.14
Dim As clong si = -10, ret_val, b, si1
Dim As cUlong ui = 10, ui1
Dim As clong Ptr exp_
exp_ = Allocate(SizeOf(clong ptr))
dim as zstring * 10000 Str_
'Dim As ZString Ptr  Str_
'Str_ = Allocate (1000)



'===== setup gmp variables =====
Dim As Mpz_ptr z_rop = Allocate (Len(__mpz_struct))
Mpz_init(z_rop)
Dim As Mpz_ptr z_op1 = Allocate (Len(__mpz_struct))
Dim As Mpz_ptr z_op2 = Allocate (Len(__mpz_struct))
Dim As Mpz_ptr z_op3 = Allocate (Len(__mpz_struct))

Mpz_init(z_op1)
Mpz_init(z_op2)
Mpz_init(z_op3)

Dim As Mpz_ptr z_r = Allocate (Len(__mpz_struct))
Dim As Mpz_ptr z_q = Allocate (Len(__mpz_struct))
Mpz_init2(z_r, 100)
Mpz_init2(z_q, 200)

Mpz_realloc2(z_q, 100)

'---------------------------------------------------
Dim As Mpq_ptr q_rop = Allocate (Len(__mpq_struct))
Mpq_init(q_rop)
Dim As Mpq_ptr q_op1 = Allocate (Len(__mpq_struct))
Dim As Mpq_ptr q_op2 = Allocate (Len(__mpq_struct))
Dim As Mpq_ptr q_op3 = Allocate (Len(__mpq_struct))

Mpq_init(q_op1)
Mpq_init(q_op1)
Mpq_init(q_op2)

Dim As Mpq_ptr q_r = Allocate (Len(__mpq_struct))
Dim As Mpq_ptr q_q = Allocate (Len(__mpq_struct))
Mpq_init(q_q)
Mpq_init(q_r)

'---------------------------------------------------
Dim As Mpf_ptr f_rop = Allocate (Len(__mpf_struct))
Mpf_init(f_rop)
Dim As Mpf_ptr f_op1 = Allocate (Len(__mpf_struct))
Dim As Mpf_ptr f_op2 = Allocate (Len(__mpf_struct))
Dim As Mpf_ptr f_op3 = Allocate (Len(__mpf_struct))

Mpf_init(f_op1)
Mpf_init(f_op2)
Mpf_init(f_op3)

Dim As Mpf_ptr f_r = Allocate (Len(__mpf_struct))
Dim As Mpf_ptr f_q = Allocate (Len(__mpf_struct))
Mpf_init2(f_q, 100)
Mpf_init2(f_r, 200)


'===== Integer Number Functions =====

Mpz_set(z_rop, z_op1)
Mpz_set_ui(z_op1, 10)  : Mpz_set_ui(z_rop, ui)
Mpz_set_si(z_op2, -10) : Mpz_set_si(z_op1, si)
Mpz_set_d(z_op3, 3.14) : Mpz_set_d(z_op2, d)

Mpz_set_q(z_rop, q_op1)
Mpz_set_f(z_rop, f_op1)

Mpz_set_str(z_rop, "10", 10)
ret_val = Mpz_set_str(z_rop, "1F", 16)

Mpz_swap(z_op1, z_op2)

Dim As Mpz_t z_a, z_b ,z_c ,z_d, z_e
Mpz_init_set(@z_a, z_op1)
Mpz_init_set_ui(@z_b, ui)
Mpz_init_set_si(@z_c, si)
Mpz_init_set_d(@z_d, d)
Mpz_init_set_str(@z_e, "10", 10)

Mpz_clear(@z_a)
Mpz_clear(@z_b)
Mpz_clear(@z_c)
Mpz_clear(@z_d)
Mpz_clear(@z_e)

Mpz_set_ui(z_op1,123)
ui = Mpz_get_ui(z_op1)
si = Mpz_get_si(z_op1)
d  = Mpz_get_d (z_op1)

Dim As culong q
d  = Mpz_get_d_2exp(@q, z_op1) ' z_op1 = d*2^uint_ptr

Mpz_get_str(str_, 10, z_op1)

 Mpz_get_str(0, 10, z_op1)
'#print typeof (Mpz_get_str(0, 10, z_op1))

Mpz_add(z_rop, z_op1, z_op2)
Mpz_add_ui(z_rop, z_op1, ui)

Mpz_sub(z_rop, z_op1, z_op2)
Mpz_sub_ui(z_rop, z_op1, ui)
Mpz_ui_sub(z_rop, ui, z_op2)

Mpz_mul(z_rop, z_op1, z_op2)
Mpz_mul_si(z_rop, z_op1, si)
Mpz_mul_ui(z_rop, z_op1, ui)

Mpz_addmul(z_rop, z_op1, z_op2)
Mpz_addmul_ui(z_rop, z_op1, ui)

Mpz_submul(z_rop, z_op1, z_op2)
Mpz_submul_ui(z_rop, z_op1, ui)

Mpz_mul_2exp(z_rop, z_op1, b) ' lsh, ui > 0  : rsh ui < 0

Mpz_neg(z_rop, z_op1)

Mpz_abs(z_rop, z_op1)

Mpz_cdiv_q(z_q, z_op1, z_op2)
Mpz_cdiv_r(z_r, z_op1, z_op2)
Mpz_cdiv_qr(z_q, z_r, z_op1, z_op2)
ret_val = Mpz_cdiv_q_ui(z_q, z_op1, ui)        ' returns the remainder in ret_val
ret_val = Mpz_cdiv_r_ui(z_r, z_op1, ui)        ' returns the remainder in ret_val
ret_val = Mpz_cdiv_qr_ui(z_q, z_r, z_op1 ,ui)  ' returns the remainder in ret_val
ret_val = Mpz_cdiv_ui(z_op1, ui)               ' returns the remainder in ret_val
Mpz_cdiv_q_2exp(z_q, z_op1, b)                 ' z_op1 rhs b
Mpz_cdiv_r_2exp(z_r, z_op1, b)                 ' z_op1 and (2^b-1)

Mpz_fdiv_q(z_q, z_op1, z_op2)
Mpz_fdiv_r(z_r, z_op1, z_op2)
Mpz_fdiv_qr(z_q, z_r, z_op1, z_op2)
ret_val = Mpz_fdiv_q_ui(z_q, z_op1, ui)        ' returns the remainder in ret_val
ret_val = Mpz_fdiv_r_ui(z_r, z_op1, ui)        ' returns the remainder in ret_val
ret_val = Mpz_fdiv_qr_ui(z_q, z_r, z_op1 ,ui)  ' returns the remainder in ret_val
ret_val = Mpz_fdiv_ui(z_op1, ui)               ' returns the remainder in ret_val
Mpz_fdiv_q_2exp(z_q, z_op1, b)                 ' z_op1 rhs b
Mpz_fdiv_r_2exp(z_r, z_op1, b)                 ' z_op1 and (2^b-1)

Mpz_tdiv_q(z_q, z_op1, z_op2)
Mpz_tdiv_r(z_r, z_op1, z_op2)
Mpz_tdiv_qr(z_q, z_r, z_op1, z_op2)
ret_val = Mpz_tdiv_q_ui(z_q, z_op1, ui)        ' returns the remainder in ret_val
ret_val = Mpz_tdiv_r_ui(z_r, z_op1, ui)        ' returns the remainder in ret_val
ret_val = Mpz_tdiv_qr_ui(z_q, z_r, z_op1 ,ui)  ' returns the remainder in ret_val
ret_val = Mpz_tdiv_ui(z_op1, ui)               ' returns the remainder in ret_val
Mpz_tdiv_q_2exp(z_q, z_op1, b)                 ' z_op1 rhs b
Mpz_tdiv_r_2exp(z_r, z_op1, b)                 ' z_op1 and (2^b-1)

Mpz_mod(z_r, z_op1, z_op2)
ret_val = mpz_mod_ui(z_r, z_op1, ui)           ' = mpz_fdiv_r_ui

Mpz_divexact(z_q, z_op1, z_op2)
Mpz_divexact_ui(z_q, z_op1, ui)

ret_val = Mpz_divisible_p(z_op1, z_op2)
ret_val = Mpz_divisible_ui_p(z_op1, ui)
ret_val = Mpz_divisible_2exp_p(z_op1, b)

ret_val = Mpz_congruent_p(z_rop, z_op1, z_op2)
ret_val = Mpz_congruent_ui_p(z_op1, ui, ui)
ret_val = Mpz_congruent_2exp_p(z_op1, z_op2, b)

Swap z_op1, z_op2                        '  if z_op2 is negative gives crash, so swap with z_op1
Mpz_powm(z_rop, z_op1, z_op2, z_op3)
Mpz_powm_ui(z_rop, z_op1, ui, z_op2)
mpz_powm_sec(z_rop, z_op1, z_op2, z_op3) ' exp > 0 and mod (z_op3) must be odd
Mpz_pow_ui(z_rop, z_op1, ui)
Mpz_ui_pow_ui(z_rop, ui, ui)

Mpz_set_si(z_op1, 100)                   ' set z_op1 to avoid crash
ret_val = Mpz_root(z_rop, z_op1, ui)     ' return value is non zero if computation was exact
mpz_rootrem(z_rop, z_r, z_op1, ui)
Mpz_sqrt(z_rop, z_op1)
Mpz_sqrtrem(z_rop, z_r, z_op1)           ' z_rop = abs(sqr(z_op1)), z_r = z_op1 - z_rop^2

ret_val = Mpz_perfect_power_p(z_op1)
ret_val = Mpz_perfect_square_p(z_op1)

ret_val = Mpz_probab_prime_p(z_op1, si)
Mpz_nextprime(z_rop, z_op1)
Mpz_gcd(z_rop, z_op1, z_op2)
ret_val = Mpz_gcd_ui(z_rop, z_op1, ui)
Mpz_gcdext(z_rop, z_op1, z_op2, z_op3, z_r)  ' consider z_r to be z_op4
Mpz_lcm(z_rop, z_op1, z_op2)
Mpz_lcm_ui(z_rop, z_op1, ui)

ret_val = Mpz_invert(z_rop, z_op1, z_op2)
ret_val = Mpz_jacobi(z_op1, z_op2)
ret_val = mpz_legendre(z_op1, z_op2)
ret_val = mpz_kronecker(z_op1, z_op2)
ret_val = Mpz_kronecker_si(z_op1, si)
ret_val = Mpz_kronecker_ui(z_op1, ui)
ret_val = Mpz_si_kronecker(si, z_op1)
ret_val = Mpz_ui_kronecker(ui, z_op1)
Mpz_set_si(z_op2, 7)                         'avoid crash in mpz_remove, z_op2 needs to be absolute
ret_val = Mpz_remove(z_rop, z_op1, z_op2)
Mpz_fac_ui(z_rop, ui)
mpz_2fac_ui(z_rop, ui)
mpz_mfac_uiui(z_rop, ui, ui)
mpz_primorial_ui(z_rop, ui)
Mpz_bin_ui(z_rop, z_op1, ui)
Mpz_bin_uiui(z_rop, ui, ui)
Mpz_fib_ui(z_rop, ui)
Mpz_fib2_ui(z_rop, z_op1, ui)
Mpz_lucnum_ui(z_rop, ui)
Mpz_lucnum2_ui(z_rop, z_op1, ui)

ret_val = Mpz_cmp(z_op1, z_op2)
ret_val = Mpz_cmp_d(z_op1, d)
ret_val = Mpz_cmp_si(z_op1, si)
ret_val = Mpz_cmp_ui(z_op1, ui)

ret_val = Mpz_cmpabs(z_op1, z_op2)
ret_val = Mpz_cmpabs_d(z_op1, d)
ret_val = Mpz_cmpabs_ui(z_op1, ui)

ret_val = mpz_sgn(z_op1)

Mpz_and(z_rop, z_op1, z_op2)
Mpz_ior(z_rop, z_op1, z_op2)
Mpz_xor(z_rop, z_op1, z_op2)
Mpz_com(z_rop, z_op1)
ret_val = Mpz_popcount(z_op1)
ret_val = Mpz_hamdist(z_op1, z_op2)
ret_val = Mpz_scan0(z_op1, b)
ret_val = Mpz_scan1(z_op1, b)
Mpz_setbit(z_rop, b)
Mpz_clrbit(z_rop, b)
mpz_combit(z_rop, b)
Mpz_tstbit(z_rop, b)

''ret_val = mpz_out_str( )          ' no sub or function in gmp.bi
''ret_val = mpz_inp_str( )          ' no sub or function in gmp.bi
''ret_val = mpz_out_raw( )          ' no sub or function in gmp.bi
''ret_val = mpz_inp_raw( )          ' no sub or function in gmp.bi

Dim As Gmp_randstate_t rs, rs1
b = 10

Gmp_randinit_default(@rs)
gmp_randinit_mt(@rs) : gmp_randinit_mt(@rs1)
Gmp_randinit_lc_2exp(@rs, z_op1, ui, b)
Gmp_randinit_lc_2exp_size(@rs, b)
'gmp_randinit_set(@rs, @rs1) ' obsolete, crashes the program ???
Gmp_randseed(@rs, z_op1)
Gmp_randseed_ui(@rs, ui)
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Dim As String t = Str(Timer), seed = Left(t,InStr(t,".")-1) + Right(t,Len(t)-InStr(t,"."))
Mpz_set_str(z_r, seed, 10)
Gmp_randseed(@rs, z_r)
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Mpz_urandomb(z_rop, @rs, b)
Mpz_urandomm(z_rop, @rs, Z_op1)
Mpz_rrandomb(z_rop, @rs, b)
Mpz_random(z_rop, ui)    ' obsolete
Mpz_random2(z_rop, ui)   ' obsolete

Gmp_randclear(@rs1)

'Mpz_import(z_rop, size_t, order, size, endian, nails, *op)
'Mpz_export(*rop, countp, order, size, endian, nails, z_op1)

ret_val = Mpz_fits_ulong_p(z_op1)
ret_val = Mpz_fits_slong_p(z_op1)
ret_val = Mpz_fits_uint_p(z_op1)
ret_val = Mpz_fits_sint_p(z_op1)
ret_val = Mpz_fits_ushort_p(z_op1)
ret_val = Mpz_fits_sshort_p(z_op1)

ret_val = mpz_odd_p(z_op1)
ret_val = mpz_even_p(z_op1)
ret_val = Mpz_sizeinbase(z_op1, 10)

Dim As Mpz_t z_array(10)
Mpz_array_init (@z_array(1), 10, b)    ' obsolete no rational or float, no mpz_clear for array

Mpz_realloc(z_op1, 10)

ret_val = mpz_getlimbn(z_op1, ui)
ret_val = Mpz_size(z_op1)

'===== Rational Number Functions =====
Mpq_canonicalize(q_op1)

Mpq_set(q_rop, q_op1)
Mpq_set_z(q_rop, z_op1)
Mpq_set_ui(q_rop, ui, ui)
Mpq_set_si(q_rop, si, si)
ret_val = Mpq_set_str(q_rop, "10/11", 10)

Mpq_swap(q_op1, q_op2)

d = Mpq_get_d(q_op1)
Mpq_set_d(q_rop, d)
Mpq_set_f(q_rop, f_op1)
Mpq_get_str(0, 10, q_op1)
Mpq_get_str(str_, 10, q_op1)

Mpq_set_str(q_op1, "123/45", 10)
Mpq_set_str(q_op2, "100/11", 10)

Mpq_add(q_rop, q_op1, q_op2)
Mpq_sub(q_rop, q_op1, q_op2)
Mpq_mul(q_rop, q_op1, q_op2)
Mpq_mul_2exp(q_rop, q_op1, b)
Mpq_div(q_rop, q_op1, q_op2)
Mpq_div_2exp(q_rop, q_op1, b)
Mpq_neg(q_rop, q_op1)
Mpq_abs(q_rop, q_op1)
Mpq_inv(q_rop, q_op1)

ui = 10 : ui1 = 11 : si = -10 : si1 = -11
ret_val = Mpq_cmp(q_op1, q_op2)
ret_val = Mpq_cmp_ui(q_op1, ui, ui1)
ret_val = Mpq_cmp_si(q_op1, si, si1)
ret_val = mpq_sgn(q_op1)
ret_val = Mpq_equal(q_op1, q_op2)

z_op1 = mpq_numref(q_op1)
z_op2 = mpq_denref(q_op1)

Mpq_get_num(z_rop, q_op1)
Mpq_get_den(z_rop, q_op1)
Mpq_set_num(q_rop, z_op1)
Mpq_set_num(q_rop, z_op1)

''ret_val = mpq_out_str( )         ' no sub or function in gmp.bi
''ret_val = mpq_inp_str( )         ' no sub or function in gmp.bi

'===== Floating Point Functions =====

b = 120
Mpf_set_default_prec(b)
ret_val = Mpf_get_default_prec
ret_val = Mpf_get_prec(f_op1)
Mpf_set_prec(f_rop, b)
Mpf_set_prec_raw(f_rop, b)

Mpf_set(f_rop, f_op1)
Mpf_set_ui(f_rop, ui)
Mpf_set_si(f_rop, si)
Mpf_set_d(f_rop, d)
Mpf_set_z(f_rop, z_op1)
Mpf_set_q(f_rop, q_op1)
ret_val = Mpf_set_str(f_rop, "3.14", 10)

Mpf_swap(f_op1, f_op2)

Dim As Mpf_t f_a, f_b ,f_c , f_d, f_e
Mpf_init_set(@f_a, f_op1)
Mpf_init_set_ui(@f_b, ui)
Mpf_init_set_si(@f_c, si)
Mpf_init_set_d(@f_d, d)
Mpf_init_set_str(@f_e, "10", 10)

Mpf_clear(@f_a)
Mpf_clear(@f_b)
Mpf_clear(@f_c)
Mpf_clear(@f_d)
Mpf_clear(@f_e)

d = Mpf_get_d(f_op1)
d = Mpf_get_d_2exp(@ui1, f_op1)
si = Mpf_get_si(f_op1)
ui = Mpf_get_ui(f_op1)

ui = 1 : exp_ = @ui
Mpf_set_d(f_op1, 3.1415)
Mpf_get_str(str_, exp_, 10, 10, f_op1)
Mpf_get_str(0, exp_, 10, 10, f_op1)

Mpf_add(f_rop, f_op1, f_op2)
Mpf_add_ui(f_rop, f_op1, ui)
Mpf_sub(f_rop, f_op1, f_op2)
Mpf_ui_sub(f_rop, ui, f_op1)
Mpf_sub_ui(f_rop, f_op1, ui)
Mpf_mul(f_rop, f_op1, f_op1)
Mpf_mul_ui(f_rop, f_op1, ui)
Mpf_div(f_rop, f_op1, f_op1)
Mpf_ui_div(f_rop, ui, f_op1)
Mpf_div_ui(f_rop, f_op1, ui)
Mpf_sqrt(f_rop, f_op1)
Mpf_sqrt_ui(f_rop, ui)
Mpf_pow_ui(f_rop, f_op1, ui)
Mpf_neg(f_rop, f_op1)
Mpf_abs(f_rop, f_op1)
Mpf_mul_2exp(f_rop, f_op1, b)
Mpf_div_2exp(f_rop, f_op1, b)

ret_val = Mpf_cmp(f_op1, f_op2)
ret_val = Mpf_cmp_d(f_op1, d)
ret_val = Mpf_cmp_ui(f_op1, ui)
ret_val = Mpf_cmp_si(f_op1, si)

ret_val = Mpf_eq(f_op1, f_op2, b)
Mpf_reldiff(f_rop, f_op1, f_op2)
ret_val = mpf_sgn(f_op1)

''ret_val = mpf_out_str( )         ' no sub or function in gmp.bi
''ret_val = mpf_inp_str( )         ' no sub or function in gmp.bi

Mpf_ceil(f_rop, f_op1)
Mpf_floor(f_rop, f_op1)
Mpf_trunc(f_rop, f_op1)
ret_val = Mpf_integer_p(f_op1)
ret_val = Mpf_fits_ulong_p(f_op1)
ret_val = Mpf_fits_slong_p(f_op1)
ret_val = Mpf_fits_uint_p(f_op1)
ret_val = Mpf_fits_sint_p(f_op1)
ret_val = Mpf_fits_ushort_p(f_op1)
ret_val = Mpf_fits_sshort_p(f_op1)

Mpf_get_str(str_, exp_, 10, 10, f_op1)
Mpf_urandomb(f_op1, @rs, b)
Mpf_get_str(str_, exp_, 10, 10, f_op1)
Mpf_urandomb(f_op1, @rs, b)
Mpf_get_str(str_, exp_, 10, 20, f_op1)

Dim As clong max_size = 1  ' max_size limbs
Dim As mp_exp_t exp1
Mpf_random2(f_rop, max_size, exp1)

'===== Low Level Functions =====
' Never work with low level functions
' Need to figure out how the work

'===== Formatted Output =====
Print 
Print "Gmp_printf does print directly uses C-style "
Print
Mpf_set_d(f_op1,4*Atn(1))
ret_val = Gmp_printf("1:Pi= %.*Ff  ", 20, f_op1) ' does not add a lf\cr
ret_val = Gmp_printf(!"2:Pi= %.*Ff  \n", 20, f_op1) ' add a lf\cr
'ret_val = gmp_vprintf( )           ' no sub or function in gmp.bi
'ret_val = gmp_fprintf( )           ' no sub or function in gmp.bi
'ret_val = gmp_vfprint( )

ret_val = Gmp_sprintf(@str_, "3:Pi= %.*Ff  ", 20, f_op1 )
print str_
'ret_val = gmp_vsprintf( )          ' no sub or function in gmp.bi
ret_val = Gmp_snprintf(@str_, 11, "4:Pi= %.*Ff  ", 20, f_op1 ) ' limits size of output string to 11 chars. (/0 included)
print str_
'ret_val = gmp_vsnprint( )          ' no sub or function in gmp.bi

var _str_=cast(zstring ptr ptr,@str_)
ret_val = Gmp_asprintf(_str_,"5:Pi= %.*Ff  ", 20, f_op1 )
print **_str_
'ret_val = gmp_vasprintf( )         ' no sub or function in gmp.bi
'ret_val = gmp_obstack_printf( )    ' no sub or function in gmp.bi
'ret_val = gmp_obstack_vprintf( )   ' no sub or function in gmp.bi

'===== Formatted Input =====

'ret_val = Gmp_scanf()              ' have no idea how that should work
'ret_val = gmp_vscanf()             ' no sub or function in gmp.bi
'ret_val = gmp_fscanf()             ' no sub or function in gmp.bi
'ret_val = gmp_vfscanf()            ' no sub or function in gmp.bi
'ret_val = Gmp_sscanf()             ' have no idea how that should work
'ret_val = gmp_vsscanf()            ' no sub or function in gmp.bi


Print
Print "Predefined GMP symbols"
Print
Print "  __GMP_HAVE_HOST_CPU_FAMILY_power ";  __GMP_HAVE_HOST_CPU_FAMILY_power
Print "__GMP_HAVE_HOST_CPU_FAMILY_powerpc ";  __GMP_HAVE_HOST_CPU_FAMILY_powerpc
Print "                     GMP_LIMB_BITS ";  GMP_LIMB_BITS
Print "                     GMP_NAIL_BITS ";  GMP_NAIL_BITS
Print "                     GMP_NUMB_BITS ";  GMP_NUMB_BITS
Print "                     GMP_NUMB_MASK  ";  GMP_NUMB_MASK
Print "                      GMP_NUMB_MAX  ";  GMP_NUMB_MAX
Print "                         __GNU_MP__";  __GNU_MP__
Print "                   __GMP_LIBGMP_DLL";  __GMP_LIBGMP_DLL
'Print __GMP_DECLSPEC_EXPORT  '' not set in lib
'Print __GMP_DECLSPEC_IMPORT  '' not set in lib
Print "                   __GNU_MP_VERSION"; __GNU_MP_VERSION
Print "             __GNU_MP_VERSION_MINOR"; __GNU_MP_VERSION_MINOR
Print "        __GNU_MP_VERSION_PATCHLEVEL"; __GNU_MP_VERSION_PATCHLEVEL
Print "                   __GNU_MP_RELEASE"; __GNU_MP_RELEASE
'Print "                          __GMP_H__"; __GMP_H__   '' replace by __GMP_BI__ ???
Print "            __GMP_INLINE_PROTOTYPES"; __GMP_INLINE_PROTOTYPES
Print " x = -1                __GMP_ABS(x)"; __GMP_ABS(-1)   '' equal to FreeBasic ABS()
Print " h = 11, i = 3      __GMP_MAX(h, i)"; __GMP_MAX(3, 11)
Print "                     __GMP_UINT_MAX "; __GMP_UINT_MAX
Print "                    __GMP_ULONG_MAX "; __GMP_ULONG_MAX
Print "                    __GMP_USHRT_MAX"; __GMP_USHRT_MAX
'Print __GMP_LIKELY(cond)     '' not set in lib
'Print __GMP_UNLIKELY(cond)   '' not set in lib
'Print "             __GMP_CRAY_Pragma(Str)"; __GMP_CRAY_Pragma(Str) '' ???
Print
'Print "__GMP_DECLSPEC "; __GMP_DECLSPEC   '' ???
Print "__GMP_CC     "; __GMP_CC
Print "__GMP_CFLAGS "; __GMP_CFLAGS
Print

print
Print "Hit any key"
print curdir
Sleep
End
integer
Posts: 408
Joined: Feb 01, 2007 16:54
Location: usa

Re: new header file GMP

Post by integer »

Obviously, some of the paths are not complete.
Where should this files be placed (after I find them)?
In what Subdirectory does FB expect to find them?
I move frisian's gmp.bi and libgmp.a to the appropriate subdir


Command executed:
"C:\FreeBasic\fbc.exe" "C:\fb_GMP\test_gmp.bas"

Compiler output:
C:\fb_GMP\test_gmp.o:fake:(.text+0x9da): undefined reference to `__gmpz_powm_sec'
C:\fb_GMP\test_gmp.o:fake:(.text+0xa31): undefined reference to `__gmpz_rootrem'
C:\fb_GMP\test_gmp.o:fake:(.text+0xbb1): undefined reference to `__gmpz_2fac_ui'
C:\fb_GMP\test_gmp.o:fake:(.text+0xbc2): undefined reference to `__gmpz_mfac_uiui'
C:\fb_GMP\test_gmp.o:fake:(.text+0xbd0): undefined reference to `__gmpz_primorial_ui'
C:\fb_GMP\test_gmp.o:fake:(.text+0xd8e): undefined reference to `__gmpz_combit'
C:\fb_GMP\test_gmp.o:fake:(.text+0xdeb): undefined reference to `__gmp_randinit_mt'
C:\fb_GMP\test_gmp.o:fake:(.text+0xdfa): undefined reference to `__gmp_randinit_mt'

Results:
Compilation failed

System:
FBIde: 0.4.6
fbc: FreeBASIC Compiler - Version 1.02.0 (01-09-2015), built for win32 (32bit)
OS: Windows XP (build 2600, Service Pack 3)
frisian
Posts: 249
Joined: Oct 08, 2009 17:25

Re: new header file GMP

Post by frisian »

integer wrote:Compiler output:
C:\fb_GMP\test_gmp.o:fake:(.text+0x9da): undefined reference to `__gmpz_powm_sec'
C:\fb_GMP\test_gmp.o:fake:(.text+0xa31): undefined reference to `__gmpz_rootrem'
C:\fb_GMP\test_gmp.o:fake:(.text+0xbb1): undefined reference to `__gmpz_2fac_ui'
C:\fb_GMP\test_gmp.o:fake:(.text+0xbc2): undefined reference to `__gmpz_mfac_uiui'
The undefined reference to `__gmpz_powm_sec' means it can't find __gmpz_powm_sec wich is a new function so it looks likes FB uses a older libgmp.
Test_gmp.bas only works with the new header file and the static library in the 7z file.
The new header and static library can be used with older programs that use GMP.

Your problem made me think about the instructions I wrote done they could be use some clarification.
So for you and others that have problems I hope that gives a better idea what needs to be done.

First, when installing a new/other version of FreeBasic the hole process needs to be repeated.

Noticed that you use St_W build so I downloaded the latest build and unpacked in the root of the D drive, they look somewhat different from the official versions but in principal they are the same.
The directory tree look like this (in ASCII graphic).

D:\fbc_win32_mingw_0220_2015-01-17
\--fbc_win32_mingw
+--bin
| \--win32
+--inc
\--lib
\--win32

The gmp.bi file needs to go in the the "INC" directory (D:\fbc_win32_mingw_0220_2015-01-17\fbc_win32_mingw\inc) the contents off that directory look like this.

datetime.bi
dir.bi
fbgfx.bi
fbio.bi
fbthread.bi
file.bi
string.bi
utf_conv.bi
vbcompat.bi

Also you need to include a directory named "CRT" that contains two files that are needed for gmp.bi to work properly. Integer You have this part right otherwise you had a different error message.

The file named libgmp.a needs to placed in the directory "LIB/WIN32" (D:\fbc_win32_mingw_0220_2015-01-17\fbc_win32_mingw\lib\win32) the contents should like this.

Code: Select all

crt2.o
crtbegin.o
crtend.o
dllcrt2.o
fbextra.x
fbrt0.o
gcrt2.o
libadvapi32.dll.a
libfb.a
libfbgfx.a
libfbgfxmt.a
libfbmt.a
libffi.a
libgcc.a
libgcc_eh.a
libgdi32.dll.a
libgmon.a
libkernel32.dll.a
libmingw32.a
libmingwex.a
libmoldname.a
libmsvcrt.dll.a
libsupc++.a
libuser32.dll.a
libwinmm.dll.a
libwinspool.dll.a
You should check if there's a file with start with "libgmp.*", if it's ends with ".a" it should be rename/moved or simply overwritten, all other files beginning with "libgmp.*" should be renamed or moved to prevent FreeBasic from using them. (FB looks for the first file that begins with libgmp, some info in that file tells it if is a static library or data for use with a .DDL. Therefore it important to that files like libgmp.la are renamed to something like libgmp.la.old)

I hope this helps, if not let me know.

Some general remarks
The file libgmp.a is a WIN32 build static so it does not work in the DOS/WIN64 version of FreeBasic.
If you have a St_W build version of FreeBasic you need the contains of the directory "CRT" you can find it in a official version of FreeBasic.
The St_W builds only contains the files that the FreeBasic compiler needs to work, so some extra works needs to be done to get libgmp.a to work.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: new header file GMP

Post by dodicat »

Put frisians gmp.7z into a folder, call the folder what you like.
Extract the gmp.7z into that folder.
Using fbide, I can just click frisian's test directly and the whole thing runs in the folder.

Then, if you are happy, put the .bi into the inc folder.
You could rename it to gmp6.bi if you already have a gmp.bi.

Then pop the libgmp.a into the lib folder.
Then it is available generally with your FREE Basic.

Nice that it is a static lib, no dll's to be bothered about.
frisian
Posts: 249
Joined: Oct 08, 2009 17:25

Re: new header file GMP

Post by frisian »

dodicat wrote: You could rename it to gmp6.bi if you already have a gmp.bi.
If you rename it to gmp6.bi make sure that you change #include "gmp" into #include "gmp6" or FreeBasic will use the old header file.
integer
Posts: 408
Joined: Feb 01, 2007 16:54
Location: usa

Re: new header file GMP

Post by integer »

@frisian
@dodicat
Your explanations cleared the fog.
Thanks.


From the test file:
In the output section
gmp_sprintf(...) failed

Code: Select all

ret_val = Gmp_sprintf(str_, "3:Pi= %.*Ff  ", 20, f_op1 )
That caused a crash. I commented it out as dodicat stated, and the program continued

Both

Code: Select all

ret_val = Gmp_snprintf(str_, 11, "4:Pi= %.*Ff \n ", 20, f_op1 ) 
and

Code: Select all

ret_val = Gmp_asprintf(@str_,"5:Pi= %.*Ff  ", 20, f_op1 )
printed nothing.

It appears that the GMP test file works (except for minor output routines)

However, and most important:
I now have a "workable" GMP.

Thank you.
frisian
Posts: 249
Joined: Oct 08, 2009 17:25

Re: new header file GMP

Post by frisian »

integer wrote:@frisian
@dodicat
Your explanations cleared the fog.
Thanks.
Glad to hear that you got it working.
Both

Code: Select all

ret_val = Gmp_snprintf(str_, 11, "4:Pi= %.*Ff \n ", 20, f_op1 ) 
and

Code: Select all

ret_val = Gmp_asprintf(@str_,"5:Pi= %.*Ff  ", 20, f_op1 )
printed nothing.
That's because they have no print *str_ statement.
The file was created to see if the header file worked and that the compiler would compile without error message's. Therefore it does not print much.

Gmp_printf print directy to the console, Gmp_sprintf, Gmp_snprintf and Gmp_asprintf make a formatted text that is send to a Zstring using a pointer. There are also some other statements that convert a GMP variable to text. I suggest you read the GMP manual (specially when your new to GMP), somethings like formatted output is a little hard to understand because GMP is written in C.

You could try dodicat's altered version in his post directly above your first posting.
Makoto WATANABE
Posts: 231
Joined: Apr 10, 2010 11:41
Location: Japan
Contact:

Re: new header file GMP

Post by Makoto WATANABE »

Dear frisian
Dear dodicat

I think that your programs (test_gmp.bas and dodicat's own stuff) show how to use GMP in FreeBasic plainly.
I would like to translate your programs into Japanese and introduce them to Japanese people on my website.
Please consent to this.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: new header file GMP

Post by dodicat »

Hi Makoto WATANABE

I have:
GMP version 6.1.0

For this version or

GMP version 6.0.0

you may have to add one line to my functions code:


#Include once "gmp.bi"
type mpf_t as __mpf_struct ' <--- add this line
Makoto WATANABE
Posts: 231
Joined: Apr 10, 2010 11:41
Location: Japan
Contact:

Re: new header file GMP

Post by Makoto WATANABE »

Dear dodicat

Thanks for your quick reply.

>I have:
I think that you consent.
I upped it on my website.
http://makoto-watanabe.main.jp/freebasi ... tions.html
If you have inconvenient points etc., I will correct / delete them.

P.S.
I think that it is useful if you add Operator (Integer divide) to your functions.

Also, if you add your own stuff to the FreeBASIC document (e.g. following page) ,
I think that not only Japanese people but also the people of the world will become happy.
Http://www.freebasic.net/wiki/wikka.php?wakka=ExtLibgmp

Anyway, I am deeply moved by your program.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: new header file GMP

Post by dodicat »

Here is div (lines 23 to 34) using strings.
The other code is my own mod/div -- NOT GMP.
I have tested random strings against each method.

Code: Select all


#Include once "gmp.bi"
type mpf_t as __mpf_struct 'not needed here

'string overloads section
Dim Shared As Zstring * 100000000 outtext

function _mod(n1 as string,n2 as string) as string
   dim as __mpz_struct answer,mn1,mn2
   mpz_init2( @answer,0)
    mpz_init2( @mn1,0)
     mpz_init2( @mn2,0)
   mpz_init_set_str( @answer,"",10)
   mpz_init_set_str( @mn1,n1,10)
   mpz_init_set_str( @mn2,n2,10)
   mpz_mod(@answer,@mn1,@mn2)
   gmp_sprintf( @outtext,"%Zi", @answer )
    Return Trim(outtext)
   
end function

function _div(n1 as string,n2 as string) as string
   dim as __mpz_struct answer,mn1,mn2
   mpz_init2( @answer,0)
    mpz_init2( @mn1,0)
     mpz_init2( @mn2,0)
   mpz_init_set_str( @answer,"",10)
   mpz_init_set_str( @mn1,n1,10)
   mpz_init_set_str( @mn2,n2,10)
   mpz_div(@answer,@mn1,@mn2)
   gmp_sprintf( @outtext,"%Zi", @answer )
    Return Trim(outtext)
end function
'============================ END GMP BIT ======================== 

'================  ANOTHER METHOD =================================
Function _divide(n1 As String,n2 As String,decimal_places As integer=10,dpflag As String="s") As String
          Dim As String number=n1,divisor=n2
          dpflag=lcase(dpflag)
          'For MOD
          dim as integer modstop
          if dpflag="mod" then 
              if len(n1)<len(n2) then return n1
              if len(n1)=len(n2) then
                  if n1<n2 then return n1
                  end if
              modstop=len(n1)-len(n2)+1
              end if
          if dpflag<>"mod" then
     If dpflag<>"s"  Then dpflag="raw" 
     end if
        Dim runcount As integer
        '_______  LOOK UP TABLES ______________
        Dim Qmod(0 To 19) As Ubyte
        Dim bool(0 To 19) As Ubyte
        For z As Integer=0 To 19
    Qmod(z)=(z Mod 10+48)
    bool(z)=(-(10>z))
Next z
Dim answer As String   'THE ANSWER STRING  

'_______ SET THE DECIMAL WHERE IT SHOULD BE AT _______
Dim As String part1,part2
#macro set(decimal)
#macro insert(s,char,position)
If position > 0 And position <=Len(s) Then
part1=Mid$(s,1,position-1)
part2=Mid$(s,position)
s=part1+char+part2
End if
#endmacro
insert(answer,".",decpos)
  answer=thepoint+zeros+answer
If dpflag="raw" Then
    answer=Mid(answer,1,decimal_places)
    End if
#endmacro
'______________________________________________
'__________ SPLIT A STRING ABOUT A CHARACTRR __________
Dim As String var1,var2
    Dim pst As integer
      #macro split(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
    var1=Rtrim(Mid(stri,1,pst),".")
    var2=Ltrim(Mid(stri,pst),".")
Else
    var1=stri
    End if
    #endmacro
    
       #macro Removepoint(s)
       split(s,".",var1,var2)
#endmacro
'__________ GET THE SIGN AND CLEAR THE -ve __________________
Dim sign As String
          If Left(number,1)="-" Xor Left (divisor,1)="-" Then sign="-"
            If Left(number,1)="-" Then  number=Ltrim(number,"-")
            If Left (divisor,1)="-" Then divisor=Ltrim(divisor,"-")
              
'DETERMINE THE DECIMAL POSITION BEFORE THE DIVISION
Dim As integer lennint,lenddec,lend,lenn,difflen
split(number,".",var1,var2)
lennint=Len(var1)
split(divisor,".",var1,var2)
lenddec=Len(var2)

If Instr(number,".") Then 
    Removepoint(number)
    number=var1+var2
    End if
If Instr(divisor,".") Then 
    Removepoint(divisor)
    divisor=var1+var2
    End if
Dim As integer numzeros
numzeros=Len(number)
number=Ltrim(number,"0"):divisor=Ltrim (divisor,"0")
numzeros=numzeros-Len(number)
lend=Len(divisor):lenn=Len(number)
If lend>lenn Then difflen=lend-lenn
Dim decpos As integer=lenddec+lennint-lend+2-numzeros 'THE POSITION INDICATOR
Dim _sgn As Byte=-Sgn(decpos)
If _sgn=0 Then _sgn=1
Dim As String thepoint=String(_sgn,".") 'DECIMAL AT START (IF)
Dim As String zeros=String(-decpos+1,"0")'ZEROS AT START (IF) e.g. .0009
if dpflag<>"mod" then
If Len(zeros) =0 Then dpflag="s"
end if
Dim As integer runlength
If Len(zeros) Then 
     runlength=decimal_places
     answer=String(Len(zeros)+runlength+10,"0")
    If dpflag="raw" Then 
        runlength=1
        answer=String(Len(zeros)+runlength+10,"0")
        If decimal_places>Len(zeros) Then
            runlength=runlength+(decimal_places-Len(zeros))
            answer=String(Len(zeros)+runlength+10,"0")
            End If
            End If

Else
decimal_places=decimal_places+decpos
runlength=decimal_places
answer=String(Len(zeros)+runlength+10,"0")
End if
'___________DECIMAL POSITION DETERMINED  _____________

'SET UP THE VARIABLES AND START UP CONDITIONS
number=number+String(difflen+decimal_places,"0")
        Dim count As integer
        Dim temp As String
        Dim copytemp As String
        Dim topstring As String
        Dim copytopstring As String
        Dim As integer lenf,lens
        Dim As Ubyte takeaway,subtractcarry
        Dim As integer n3,diff
       If Ltrim(divisor,"0")="" Then Return "Error :division by zero"   
        lens=Len(divisor)
         topstring=Left(number,lend)
         copytopstring=topstring
        Do
            count=0
        Do
            count=count+1
            copytemp=temp
    
            Do
'___________________ QUICK SUBTRACTION loop _________________              
            
lenf=Len(topstring)
If  lens<lenf=0 Then 'not
If Lens>lenf Then
temp= "done"
Exit Do
End if
If divisor>topstring Then 
temp= "done"
Exit Do
End if
End if

  diff=lenf-lens
        temp=topstring
        subtractcarry=0
        
        For n3=lenf-1 To diff Step -1
            takeaway= topstring[n3]-divisor[n3-diff]+10-subtractcarry
            temp[n3]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
        Next n3 
        If subtractcarry=0 Then Exit Do
         If n3=-1 Then Exit Do
        For n3=n3 To 0 Step -1 
            takeaway= topstring[n3]-38-subtractcarry
             temp[n3]=Qmod(takeaway)
            subtractcarry=bool(takeaway)
            if subtractcarry=0 then exit do
            Next n3
        Exit Do
        
        Loop 'single run
        temp=Ltrim(temp,"0")
        If temp="" Then temp= "0"
            topstring=temp
        Loop Until temp="done"
     ' INDIVIDUAL CHARACTERS CARVED OFF ________________       
        runcount=runcount+1
       If count=1 Then
           topstring=copytopstring+Mid(number,lend+runcount,1)
           Else
       topstring=copytemp+Mid(number,lend+runcount,1)
   End If
       copytopstring=topstring
       topstring=Ltrim(topstring,"0")
       if dpflag="mod" then
       if runcount=modstop then 
           if topstring="" then return "0"
           return mid(topstring,1,len(topstring)-1)
           end if
       end if
       answer[runcount-1]=count+47
       If topstring="" And runcount>Len(n1)+1 Then
           Exit Do
           End if
   Loop Until runcount=runlength+1
   
   ' END OF RUN TO REQUIRED DECIMAL PLACES
   set(decimal) 'PUT IN THE DECIMAL POINT
  'THERE IS ALWAYS A DECIMAL POINT SOMEWHERE IN THE ANSWER
  'NOW GET RID OF IT IF IT IS REDUNDANT
       answer=Rtrim(answer,"0")
       answer=Rtrim(answer,".")
       answer=Ltrim(answer,"0")
       If answer="" Then Return "0"
   Return sign+answer
End Function
'=======================================================================


#define mod_(a,b) _divide((a),(b),,"mod")
#define div_(a,b) iif(len((a))<len((b)),"0",_divide((a),(b),-2))

#define range(f,l) int(Rnd*(((l)+1)-(f))+(f))
#macro create(L)
i=string(L," ")
j=string(L-20," ")
do
    for n as long =0 to L-1
        i[n]=range(48,57)
    next
loop until i[0]<>48
do
    for n as long =0 to L-20-1
        j[n]=range(48,57)
    next
loop until j[0]<>48
#endmacro

dim as string i,j
do
   create(60)
    print "    GMP"       ;tab(50); "OTHER"
    print "MOD ";_mod(i,j);tab(50);mod_(i,j),iif(_mod(i,j)=mod_(i,j)," OK","Error")
    print "DIV ";_div(i,j);tab(50);div_(i,j),iif(_div(i,j)=div_(i,j)," OK","Error")
    print
sleep
loop until inkey=chr(27)
sleep 
Makoto WATANABE
Posts: 231
Joined: Apr 10, 2010 11:41
Location: Japan
Contact:

Re: new header file GMP

Post by Makoto WATANABE »

Dear dodicat

Thank you for providing "Integer divide function".

When compiling in my environment, the following error occurred.
error 41: Variable not declared, mpz_div in 'mpz_div(@answer,@mn1,@mn2)'
Therefore, I tried to change "mpz_div" to "mpz_cdiv_q".

When I tested to divide 10000 by 1 to 20, the results differ slightly.
I think that div_ is correct and _ div is "1" many (moving up).

I would appreciate it if you could tell me how to fix it.

Code: Select all

#Include "divFunction.bas"

Dim As String i,j
Dim As Integer counter
Dim As ULongInt dividend

i="10000"
dividend=Val(i)

    Print "    GMP"       ;Tab(20); "OTHER";Tab(30); " \ "
For counter =1 To 20
   j=Str(counter)
    Print "MOD ";_mod(i,j);Tab(20);mod_(i,j);Tab(30);Space(20);IIf(_mod(i,j)=mod_(i,j)," OK","Error");counter
    Print "DIV ";_div(i,j);Tab(20);div_(i,j);Tab(30);dividend\counter,IIf(_div(i,j)=div_(i,j)," OK","Error")
    Print
Next counter

Sleep 
Image
Post Reply