BigInt

[Arndt]

Anbei ein Modul für Berechnungen mit beliebig großen Zahlen (Einschränkungen siehe Header). Es ist mein Einstiegsprojekt in PureBasic. Entstanden ist aus einer Bibliothek für XProfanX4, die zum großen Teil in Assembler geschrieben war. Für PureBasic habe ich nur die Assemblerteile beibehalten, die direkten Zugriff auf Register bzw. das Carry-Flag benötigen.
Die Prozeduren arbeiten mit dynamischen Arrays. Deshalb muss man sich keine Gedanken über Konfigurationsparameter machen. Falls jemand Fehler findet oder Verbesserungsvorschläge hat, bitte melden.

Code: Alles auswählen

;/ ============================
;/ =    Big_Int_Module.pbi    =
;/ ============================
;/
;/ [ PB V6.1x / 64Bit / All OS / Strings Unicode]
;/
;/ Langzahlarithmetik (Stellenzahl nur begrenzt durch Leistungsfähikeit von CPU und Speicher, sowie
;/ durch die 2 GB Grenze für WriteData()/ReadData() )
;/ Die Langzahlen werden durch Arrays vom Typ long repräsentiert.
;/
;/ © 2025 Arndt Lindner (01/2025)
;/

; Last Update: 27.02.2025
;

;{ ===== MIT License =====
;
; Copyright (c) 2025 Arndt Lindner
;
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
;
; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software.
;
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
; SOFTWARE.
;}

DeclareModule big_int
  
  ; Alle Procedure, die Langzahlen berechnen, geben das Ergebnis im letzten Parameter zurück.
  ; Ausnahme Division: gibt Divisionsergebnis und Divisionsrest in den beiden letzten Parametern zurück.
  ;
  Declare.i sig(Array z.i(1)) 
  Declare.i test(Array z.i(1),m.i)                  
  Declare.i testgerade(Array z.i(1))   
  Declare.i testungerade(Array z.i(1))
  Declare compl2(Array z1.i(1), Array z2.i(1))
  Declare absBig(Array z1.i(1), Array z2.i(1))
  Declare add(Array z1.i(1), Array z2.i(1), Array z3.i(1)) 
  Declare sub(Array z1.i(1), Array z2.i(1), Array z3.i(1))
  Declare inc(Array z1.i(1), iz.i, Array z3.i(1))       
  Declare dec(Array z1.i(1), iz.i, Array z3.i(1))    
  Declare mul(Array z1.i(1), Array z2.i(1), Array z3.i(1))
  Declare div(Array n1.i(1),Array n2.i(1), Array rw.i(1), Array rest.i(1))
  Declare getbit(Array z.i(1), index.i)       
  Declare setbit(Array z.i(1), index.i, v.i,Array rw.i(1))
  Declare shiftleft(Array n.i(1),Array rw.i(1))
  Declare shiftright(Array n.i(1),Array rw.i(1))
  Declare pot(Array n.i(1),p.i,Array rw.i(1))
  Declare pot2(p.i,Array rw.i(1))                     
  Declare powermod(Array basis.i(1),Array expo.i(1), Array m.i(1), Array rw.i(1))
  Declare fak(n.i,Array rw.i(1))
  Declare equ(Array z1.i(1),Array z2.i(1))
  Declare notequ(Array z1.i(1),Array z2.i(1))
  Declare gt(Array z1.i(1),Array z2.i(1))
  Declare gte(Array z1.i(1),Array z2.i(1))
  Declare lt(Array z1.i(1),Array z2.i(1))
  Declare lte(Array z1.i(1),Array z2.i(1))
  Declare ggt(Array n1.i(1),Array n2.i(1),Array rw.i(1))
  Declare kgv(Array n1.i(1), Array n2.i(1), Array rw.i(1))
  Declare ValBig(z.s, Array rw.i(1))  
  Declare.s StrBig(Array z.i(1),tz.s="")
  Declare.s HexBig(Array n.i(1),tz.s=" ")                
  Declare.s BinBig(Array n.i(1),tz.s=" ") 
  Declare savebig(fn.s,Array z.i(1))        ;fn - Filename
  Declare loadbig(fn.s,Array z.i(1))  
  Declare.i anz_stellen(s.s)  
  
EndDeclareModule

Module big_int
  
  ;- ============================================================================
  ;-   Module - Internal Constants
  ;- ============================================================================ 
  
  ;#maske  = $FFFFFFFF
  #qmaske = $FFFFFFFFFFFFFFFF
  #ZiffZahl = 1000000000000000000   ; = 10^ZiffLength
  #ZiffLength = 18
  #binbits = "00000000000000000000000000000000000000000000000000000000000000000"
  #hexhex = "00000000000000000"
  #bfn = "~~big_int_"
  #konmask = $3FFFFF
  #konleng = 22
  
  ;- ============================================================================
  ;-   Module - Macros
  ;- ============================================================================ 
  
  Macro getbiti(v,bitnr)
    Bool(v & (1 << bitnr))
  EndMacro
  
  Macro vzkorr(vz,ze,za)
    If vz
      compl2(ze,za)
    Else  
      compress(ze,za)
    EndIf  
  EndMacro
  
  Macro lkorr(s,konvanz)
    If Len(s) < konvanz
      s = RSet(s,konvanz,"0")
    ElseIf Len(s) > konvanz
      s = Right(s,konvanz)
    EndIf  
  EndMacro
  
  ;- ============================================================================
  ;-   Module - Internal Functions
  ;- ============================================================================ 
  
  Procedure.i setbiti(v.i,bitnr.i,bitv.i)
    Define rw.q = v
    Select bitv
      Case 0
        rw & ((1 << bitnr) ! #qmaske) 
      Case 1
        rw | ~((1 << bitnr) ! #qmaske) 
    EndSelect
    ProcedureReturn rw
  EndProcedure
  
  Procedure maxi(a.i,b.i)
    Define rw.i = a
    If a < b : rw = b : EndIf
    ProcedureReturn rw
  EndProcedure
  
  Procedure mini(a.i,b.i)
    Define rw.i = b
    If a < b : rw = a : EndIf
    ProcedureReturn rw
  EndProcedure
  
  ; al sollte >= ArraySize(z1()) sein
  Procedure normalize(Array z1.i(1),al.i,Array z2.i(1))
    Define rlz.i = ArraySize(z1())
    Dim zi.i(1)
    CopyArray(z1(),zi())
    ReDim zi.i(al+1)
    If Getbiti(z1(rlz),63) = 1
      Define i.i 
      For i = rlz+1 To al+1
        zi(i) = -1
      Next  
    EndIf
    CopyArray(zi(),z2())
  EndProcedure
  
  Procedure compress(Array z1.i(1),Array z2.i(1))
    Define asz.i = ArraySize(z1())
    Dim zi.i(asz)
    CopyArray(z1(),zi())
    If asz > 0    ;1
      While (zi(asz) = -Getbiti(zi(asz-1),63)) And (asz > 1)
        asz -1
      Wend  
      If (zi(1) = -Getbiti(zi(0),63)) And (asz = 1) : asz = 0 : EndIf
      ReDim zi.i(asz)
    EndIf  
    CopyArray(zi(),z2())
  EndProcedure
  
  Procedure.s asm_incz(si.s)
    Define i.i, shb.b
    i = Len(si)
    Repeat
      shb = PeekB(@si+2*(i-1)) + 1 
      If shb > 57
        shb - 10
        PokeB(@si+2*(i-1),shb)
        i - 1
      Else
        PokeB(@si+2*(i-1),shb)
        i = 0
      EndIf  
    Until i <= 0
    ProcedureReturn si
  EndProcedure
  
  Procedure.s asm_mul2(si.s)
    Define i.i, u.b, shb.b
    i = Len(si)
    u = 0
    Repeat
      shb = PeekB(@si+2*(i-1))
      shb = ((shb - 48) << 1) + u
      If shb > 9
        shb + 38
        u = 1
      Else
        shb + 48
        u = 0
      EndIf 
      PokeB(@si+2*(i-1),shb)
      i - 1
    Until i = 0
    ProcedureReturn si
  EndProcedure
  
  Procedure.s horner(Array a.i(1),msb.i)
    Define rw.s
    If ArraySize(a()) = 0
      rw = Str(a(0))
    Else
      Define i.i
      rw = "00"
      For i = msb To 1 Step -1
        If getbit(a(),i) 
          If Left(rw,1) <> "0" : rw = "0"+rw : EndIf
          rw = asm_incz(rw)
        EndIf
        If Left(rw,1) <> "0" : rw = "0"+rw : EndIf
        rw = asm_mul2(rw)
      Next
      If getbiti(a(0),0)
        If Left(rw,1) <> "0" : rw = "0"+rw : EndIf
        rw = asm_incz(rw)
        rw = LTrim(rw,"0")
      EndIf
    EndIf
    ProcedureReturn rw
  EndProcedure
  
  Procedure.i msb(Array n.i(1))
    Dim ni.i(1)
    Define rw.i, i.i, ba.i, nt.i
    CopyArray(n(),ni())
    ba = ArraySize(ni())
    nt = ni(ba)
    While (nt = 0) And (ba > 0)
      ba-1
      nt = ni(ba)
    Wend
    rw = 64*(ba+1)-1
    i = 63
    While (i >= 0) And Not(getbiti(nt,i))
      i-1
      rw-1
    Wend
    ProcedureReturn rw
  EndProcedure
  
  Procedure strbighelp(nr.i)
    Dim z.i(1)
    Define inr.i = nr, j.i
    Define konvanz.i = inr & #konmask
    inr >> #konleng
    Define rw.s
    Define fneg.s = GetTemporaryDirectory()+#bfn+Str(inr)+".Data"
    loadbig(fneg,z.i())    
    DeleteFile(fneg)
    Define rueckname.s = GetTemporaryDirectory()+#bfn+Str(inr)+".text"  
    Dim faktor.i(1)
    faktor(0) = 10
    pot(faktor(),konvanz,faktor())
    If gte(z(),faktor())
      Dim intz1.i(1)
      Dim intz2.i(1)
      div(z(),faktor(),intz1(),intz2())
      inr + 1
      savebig(GetTemporaryDirectory()+#bfn+Str(inr)+".Data",intz1())
      tid = CreateThread(@strbighelp(),(inr << #konleng)+konvanz)
      Define fnee.s = GetTemporaryDirectory()+#bfn+Str(inr)+".text"
      rw = horner(Intz2(),msb(Intz2()))
      lkorr(rw,konvanz)
      WaitThread(tid)  
      ReadFile(0,fnee)
      rw = ReadString(0) + rw
      CloseFile(0)
      DeleteFile(fnee)
    Else
      rw = horner(z(),msb(z()))
      lkorr(rw,konvanz)
    EndIf    
    CreateFile(0,rueckname) 
    WriteString(0,rw)
    CloseFile(0)
  EndProcedure
  
  ;- ============================================================================
  ;-   Module - Functions
  ;- ============================================================================ 
  
  Procedure.i sig(Array z.i(1))
    ProcedureReturn getbiti(z(ArraySize(z())),63)
  EndProcedure
  
  Procedure.i test(Array z.i(1),m.i)
    Dim zi.i(0)
    CopyArray(z(),zi())
    compress(zi(),zi())
    ProcedureReturn Bool((ArraySize(zi()) = 0) And (zi(0) = m))
  EndProcedure  
  
  Procedure.i testgerade(Array z.i(1))
    ProcedureReturn Bool(getbiti(z(0),0) = 0)
  EndProcedure  
  
  Procedure.i testungerade(Array z.i(1))
    ProcedureReturn Bool(getbiti(z(0),0) = 1)
  EndProcedure  
  
  Procedure compl2(Array z1.i(1), Array z2.i(1))
    Dim zn.i(1)
    arz = ArraySize(z1()) + 1
    CopyArray(z1(),zn())
    ReDim zn.i(arz)
    zn(arz) = -getbiti(zn(arz-1),63)
    For i = 0 To arz
      zn(i) = ~zn(i)
    Next
    inc(zn(),1,z2())
  EndProcedure
  
  Procedure absBig(Array z1.i(1), Array z2.i(1))
    If getbiti(z1(ArraySize(z1())),63) = 1
      compl2(z1(),z2())
    Else
      compress(z1(),z2())
    EndIf
  EndProcedure
  
  Procedure add(Array z1.i(1), Array z2.i(1), Array z3.i(1))
    numlength1 = ArraySize(z1())
    numlength2 = ArraySize(z2())
    Dim zi1.i(numlength1)
    Dim zi2.i(numlength2)
    Define numlength = maxi(numlength1,numlength2)
    normalize(z1(),numlength,zi1())
    normalize(z2(),numlength,zi2())
    numlength + 1
    Dim zi3.i(numlength)
    Define az1 = @zi1(0)
    Define az2 = @zi2(0)
    Define az3 = @zi3(0)
    EnableASM
      mov   r8,az1
      mov   r9,az2
      mov   rax,az3
      mov   rcx,numlength
      inc   rcx
      push  rsi
      push  rdi
      mov   rsi,r8
      mov   rdi,rax
      clc
      cld
! big_int_add_sch:
!    lodsq
      mov   rdx,rax  
      xchg  rsi,r9
!     lodsq
      xchg  rsi,r9 
      adc   rax,rdx
!     stosq  
!     loop  big_int_add_sch     
      pop   rdi
      pop   rsi
    DisableASM
    compress(zi3(),z3())
  EndProcedure
  
  Procedure sub(Array z1.i(1), Array z2.i(1), Array z3.i(1))
    Dim zh.i(1)
    compl2(z2(),zh())
    add(z1(),zh(),z3())
  EndProcedure  
  
  Procedure inc(Array z1.i(1), iz.i, Array z3.i(1))
    If iz >= 0
      Dim z2.i(1)
      CopyArray(z1(),z2())
      Define arz.i = ArraySize(z2())+1
      ReDim z2.i(arz)
      z2(arz) = -getbiti(z2(arz-1),63)
      Define a2 = @z2(0)
      EnableASM
        mov   r8,a2
        mov   r9,iz
        mov   rcx,arz
;       inc   rcx
        push  rsi
        push  rdi
        mov   rsi,r8
        mov   rdi,r8
        xor   r8,r8
        clc
        cld
!       lodsq
        adc   rax,r9
!       stosq
!big_int_inc_sch:
!       lodsq
        adc   rax,r8
!       stosq  
!       jnc   big_int_inc_ende
!       loop  big_int_inc_sch     
!big_int_inc_ende:
        pop   rdi
        pop   rsi
      DisableASM
      compress(z2(),z3())
    Else
      MessageRequester("big_int::inc-Error","Second parameter less than zero.",#PB_MessageRequester_Error)
      CopyArray(z1(),z3())
    EndIf
  EndProcedure  
  
  Procedure dec(Array z1.i(1), iz.i, Array z3.i(1))
    If iz >= 0
      Dim z2.i(1)
      CopyArray(z1(),z2())
      Define arz.i = ArraySize(z2())+1
      ReDim z2.i(arz)
      z2(arz) = -getbiti(z2(arz-1),63)
      Define a2 = @z2(0)
      EnableASM
        mov   r8,a2
        mov   r9,iz
        mov   rcx,arz
        inc   rcx
        push  rsi
        push  rdi
        mov   rsi,r8
        mov   rdi,r8
        xor   r8,r8
        clc
        cld
!       lodsq
        sbb   rax,r9
!       stosq
!big_int_dec_sch:
!       lodsq
        sbb   rax,r8
!       stosq  
!       jnc   big_int_dec_ende
!       loop  big_int_dec_sch     
!big_int_dec_ende:
        pop   rdi
        pop   rsi
      DisableASM
      compress(z2(),z3())
    Else
      MessageRequester("big_int::dec-Error","Second parameter less than zero.",#PB_MessageRequester_Error)
      CopyArray(z1(),z3())
    EndIf
  EndProcedure  
  
  Procedure mul(Array z1.i(1), Array z2.i(1), Array z3.i(1))
    vz.i = getbiti(z1(ArraySize(z1())),63) ! getbiti(z2(ArraySize(z2())),63)
    Dim zi1.i(1)
    Dim zi2.i(1)
    AbsBig(z1(),zi1())
    AbsBig(z2(),zi2())
    numlength1.i = ArraySize(zi1())
    numlength2.i = ArraySize(zi2())
    Dim zh.i(0)
    Dim rw.i(0)
    rw(0) = 0
    If numlength2 > numlength1
      CopyArray(zi1(),zh())
      CopyArray(zi2(),zi1())
      CopyArray(zh(),zi2())
    EndIf  
    so2.i = ArraySize(zi2())
    so1.i = ArraySize(zi1())
    ReDim zi1(so1+1)
    Dim zh.i(0)
    For i.i = 0 To so2
      zz.i = zi2(i)
      If zz <> 0
        Dim zh.i(so1+i+1) 
        Define az1 = @zi1(0)
        Define az3 = @zh(i)
        EnableASM
          mov   r8,az1
          mov   r9,zz
          mov   rax,az3
          mov   rcx,so1
          inc   rcx
          inc   rcx
          push  rsi
          push  rdi
          mov   rsi,r8
          mov   rdi,rax
          clc
          cld
          xor   r8,r8
!big_int_mul_sch:
!         lodsq
          mul   r9
          add   rax,r8
          mov   r8,rdx
          adc   r8,0
!         stosq  
!         loop  big_int_mul_sch     
          pop   rdi
          pop   rsi
        DisableASM
        add(rw(),zh(),rw())
      EndIf
    Next i
    vzkorr(vz,rw(),z3())
  EndProcedure
  
  Procedure div(Array n1.i(1),Array n2.i(1), Array rw.i(1), Array rest.i(1))
    Dim hf1.i(1)
    Dim hf2.i(1)
    Dim hf3.i(1)
    Dim hfrw.i(1)
    Define.i i, vz, msb1, msb2, offset, k
    If test(n2(),0)
      MessageRequester("Error", "Division by 0", #PB_MessageRequester_Error)
    ElseIf Not(test(n1(),0))
      vz = sig(n1()) ! sig(n2())
      AbsBig(n1(),hf1())
      AbsBig(n2(),hf2())
      While (getbiti(hf1(0),0) = 0) And (getbiti(hf2(0),0) = 0)
        shiftright(hf1(),hf1())                              ; Kürzen mit 2    
        shiftright(hf2(),hf2())
        k + 1
      Wend
      msb1 = msb(hf1())
      msb2 = msb(hf2())
      offset = msb1 - msb2
      If offset < 0
        hfrw(0) = 0
      ElseIf offset = 0
        If Not(gt(hf2(),hf1()))
          hfrw(0) = 1
          sub(hf1(),hf2(),hf1())
        Else
          hfrw(0) = 0
        EndIf
      Else
        For i = 1 To offset
          shiftleft(hf2(),hf2())
        Next
        Dim hfrw.i(offset/64 + 1)
        compl2(hf2(),hf2())                 ; um in der Schleife zu addieren
        For i = offset To 0 Step -1
          If (getbit(hf1(),msb2+i) = 1) Or (getbit(hf1(),msb2+i+1) = 1)
            CopyArray(hf1(),hf3())
            add(hf1(),hf2(),hf1())          ; statt sub(...), s.o.
            If Not(sig(hf1()))
              setbit(hfrw(),i,1,hfrw())
            Else
              CopyArray(hf3(),hf1())
            EndIf
          EndIf
          shiftright(hf2(),hf2())
        Next
      EndIf
      If Not(test(hf1(),0))
        While k > 0                        ; Korrektur Rest wegen Kürzen!
          shiftleft(hf1(),hf1())
          k - 1
        Wend  
      EndIf
      vzkorr(vz,hfrw(),rw())
      vzkorr(sig(n1()),hf1(),rest())
    Else
      Dim rw.i(0)
      Dim rest.i(0)
    EndIf
  EndProcedure
  
  Procedure.i getbit(Array z.i(1), index.i)
    Define fe.i, iie.i
    fe = index >> 6     ;index / 64
    iie = index % 64
    If fe > ArraySize(z())
      fe = ArraySize(z())
      iie = 63
    EndIf
    ProcedureReturn getbiti(z(fe),iie) 
  EndProcedure
  
  Procedure setbit(Array z.i(1), index.i, v.i,Array rw.i(1))
    Define fe.i, iie.i, fl.i
    Dim irw.i(1)
    CopyArray(z(),irw())
    fe = index >> 6     ;index / 64
    iie = index % 64
    If fe > ArraySize(irw()) : ReDim irw.i(fe+1) : EndIf
    irw(fe) = setbiti(irw(fe),iie,v)
    CopyArray(irw(),rw())
  EndProcedure
  
  Procedure shiftleft(Array n.i(1),Array rw.i(1))
    Define numlength.i = ArraySize(n())
    Dim rwi.i(numlength)
    CopyArray(n(),rwi())
    ReDim rwi.i(numlength+1)
    rwi(numlength+1) = -getbiti(rwi(numlength),63)
    Define arw.i = @rwi(0)
    EnableASM
      mov   rax,arw
      mov   rcx,numlength
      inc   rcx
      push  rsi
      push  rdi
      mov   rdi,rax
      mov   rsi,rax
      clc
      cld
!big_int_shiftleft_sch:
!     lodsq
!     rcl   rax,1 
!     stosq
!     loop  big_int_shiftleft_sch
      pop   rdi
      pop   rsi
    DisableASM
    compress(rwi(),rw())
  EndProcedure
  
  Procedure shiftright(Array n.i(1),Array rw.i(1))
    Define numlength.i = ArraySize(n())
    Dim rwi.i(numlength)
    CopyArray(n(),rwi())
    For i.i = 0 To numlength-1
      ld.i = getbiti(rwi(i+1),0)
      rwi(i) >> 1
      rwi(i) = rwi(i) & $7fffffffffffffff 
      If ld = 1 : rwi(i) = rwi(i) | $8000000000000000 : EndIf
    Next
    ld = getbiti(rwi(numlength),63)
    rwi(numlength) >> 1
    rwi(numlength) = rwi(numlength) & $7fffffffffffffff
    If ld = 1 : rwi(numlength) = rwi(numlength) | $8000000000000000 : EndIf
    compress(rwi(),rw())
  EndProcedure
  
  Procedure pot(Array n.i(1),p.i,Array rw.i(1))
    Dim hf.i(1)
    If p < 0
      MessageRequester("Fehler", "negativer Exponent", #PB_MessageRequester_Error)
      Dim rw.i(1)
    Else  
      Select p
        Case 0
          Dim rw.i(1)
          rw(0) = 1
        Case 1
          CopyArray(n(),rw())
        Case 2
          mul(n(),n(),rw())
        Default
          If getbiti(p,0)              ;(p mod 2) != 0
            pot(n(),p-1,hf())
            mul(n(),hf(),rw())
          Else
            pot(n(),p >> 1,hf())
            mul(hf(),hf(),rw())
          EndIf
      EndSelect
    EndIf
  EndProcedure
  
  ; berechnet 2^p
  ;
  Procedure pot2(p.i,Array rw.i(1))
    Dim rw.i(1)
    setbit(rw(),p,1,rw())
    If (p % 64) = 63 : ReDim rw(ArraySize(rw())+1) : EndIf
  EndProcedure
  
  ; powermod(basis[],expo[],m[],rw[])
  ; Berechnet basis[]^expo[] mod m[]
  ; Ergebnis in rw[]
  ;
  Procedure PowerMod(Array basis.i(1), Array expo.i(1), Array m.i(1), Array rw.i(1))
    Dim kk.i(1)
    CopyArray(expo(),kk())
    Dim pot1.i(1)
    CopyArray(basis(),pot1())
    Dim x.i(1)
    x(0) = 1
    Define fertig.i = #False
    Dim d.i(1)
    Repeat
      If getbiti(kk(0),0)  
        mul(x(),pot1(),x())
        div(x(),m(),d(),x())
        If test(kk(),1)
          fertig = #True
        Else
          dec(kk(),1,kk())
        EndIf
      EndIf  
      shiftright(kk(),kk())
      mul(pot1(),pot1(),pot1())
      div(pot1(),m(),d(),pot1())
    Until fertig
    CopyArray(x(),rw())
  EndProcedure  
  
  Procedure fak(n.i,Array rw.i(1))
    Dim rw.i(1)
    rw(0) = 1
    If n > 1
      Dim zh.i(1)
      zh(0) = 1
      For i.i = 1 To n-1
        inc(zh(),1,zh())
        mul(rw(),zh(),rw())
      Next  
    ElseIf Not((n = 0) Or (n = 1))
      MessageRequester("Fehler", "negativer Eingangswert bei Fakultät", #PB_MessageRequester_Error)
      Dim rw.i(1)
    EndIf
  EndProcedure
  
  Procedure.i equ(Array z1.i(1),Array z2.i(1))
    compress(z1(),z1())
    compress(z2(),z2())
    ProcedureReturn CompareArray(z1(),z2())
  EndProcedure
  
  Procedure.i notequ(Array z1.i(1),Array z2.i(1))
    ProcedureReturn Bool(Not(equ(z1(),z2())))
  EndProcedure
  
  Procedure.i gte(Array z1.i(1),Array z2.i(1))
    Define rw.i = #False
    Dim zi.i(1)
    sub(z1(),z2(),zi())
    If (test(zi(),0) = 1) Or (sig(zi()) = 0)
      rw = #True
    EndIf
    ProcedureReturn rw
  EndProcedure
  
  Procedure.i gt(Array z1.i(1),Array z2.i(1))
    ProcedureReturn Bool(gte(z1(),z2()) And Not(equ(z1(),z2())))
  EndProcedure
  
  Procedure.i lt(Array z1.i(1),Array z2.i(1))
    ProcedureReturn Bool(Not(gte(z1(),z2())))
  EndProcedure
  
  Procedure.i lte(Array z1.i(1),Array z2.i(1))
    ProcedureReturn Bool(Not(gt(z1(),z2())))
  EndProcedure
  
  ;   ggt(n1(),n2(),rw())
  ;   Größter gemeinsamer Teiler von n1() und n2()
  ;   Steinscherscher Algorithmus implementiert nach Donald E. Knuth, The Art of Computer Programming
  ;   n1(), n2() - positive Langzahlen (Typ Long-Array)
  ;   Ergebnis: rw() - Langzahlen (Typ Long-Array)
  ; 
  Procedure ggt(Array n1.i(1),Array n2.i(1),Array rw.i(1))
    Dim a.i(1)
    Dim b.i(1)
    Dim t.i(1)
    Dim rwi.i(1)
    Define k.i, i.i
    compress(n1(),a())
    compress(n2(),b())
    If (sig(a()) = 0) And (sig(b()) = 0)
      If test(b(),0)
        CopyArray(a(),rwi())
      ElseIf test(a(),0)
        CopyArray(b(),rwi())
      Else
        k = 0
        While testgerade(a()) And testgerade(b())
          shiftright(a(),a())
          shiftright(b(),b())
          k + 1
        Wend
        If testungerade(a())
          compl2(b(),t())
        Else
          CopyArray(a(),t())
        EndIf
        While Not(test(t(),0))
          While testgerade(t()) And Not(test(t(),0))
            shiftright(t(),t())
          Wend
          If Not(sig(t())) And Not(test(t(),0))
            CopyArray(t(),a())
          Else
            compl2(t(),b())
          EndIf
          sub(a(),b(),t())
        Wend
        CopyArray(a(),rwi())
        For i = 1 To k
          shiftleft(rwi(),rwi())
        Next
      EndIf
      CopyArray(rwi(),rw())
    Else
      MessageRequester("Fehler", "negative(r) Eingangswert(e) bei ggt()", #PB_MessageRequester_Error)
    EndIf
  EndProcedure
  
  ;   kgv(n1(),n2(),rw())
  ;   Kleistes gemeinsames Vielfaches von n1() und n2()
  ;   n1(), n2() - positive Langzahlen (Typ Long-Array)
  ;   Ergebnis: rw() - Langzahlen (Typ Long-Array)
  ; 
  Procedure kgv(Array n1.i(1), Array n2.i(1), Array rw.i(1))
    Dim c.i(1)
    Dim d.i(1)
    Dim h.i(1)
    Dim rw.i(1)
    If (sig(n1()) Or sig(n2())) = 0
      mul(n1(),n2(),c())
      ggt(n1(),n2(),d())
      div(c(),d(),rw(),h())
    Else
      MessageRequester("Fehler", "negative(r) Eingangswert(e) bei kgv()", #PB_MessageRequester_Error)
    EndIf
  EndProcedure
  
  Procedure valBig(z.s, Array rw.i(1))
    Define ezl.i, vorzeichen.i, i.i, lz.i, iz.s, ihz.s,ch.s
    Dim hf1.i(1)
    Dim hf2.i(1)
    iz = Trim(z)
    lz = Len(iz)
    Dim rw.i(0)
    Select Left(iz,1)
      Case "$"
        iz = LTrim(iz,"$")
        If Len(iz) > 0
          i = 0
          While Len(iz) >= 16
            rw(i) = Val("$"+Right(iz,16))
            iz = Left(iz,Len(iz)-16)
            i+1
            ReDim rw.i(i)
          Wend
          If Len(iz) > 0
            rw(i) = Val("$"+iz)
          Else
            ReDim rw.i(i-1)
          EndIf
        EndIf
      Case "%"
        iz = LTrim(iz,"%")
        If Len(iz) > 0
          i = 0
          While Len(iz) >= 64
            rw(i) = Val("%"+Right(iz,64))
            iz = Left(iz,Len(iz)-64)
            i+1
            ReDim rw(i)
          Wend
          If Len(iz) > 0
            rw(i) = Val("%"+iz)
          Else
            ReDim rw(i-1)
          EndIf  
        EndIf
      Default
        If Left(iz,1) = "-"
          vorzeichen = 1
          iz = Right(iz,Len(iz)-1)
        ElseIf Left(iz,1) = "+"
          iz = Right(iz,Len(iz)-1)
        EndIf
        ezl = Len(iz) % #Zifflength
        rw(0) = Val(Left(iz,ezl))
        iz = Right(iz,Len(iz)-ezl)
        hf1(0) = #ZiffZahl
        While Len(iz) > 0                      ; Hornerschema
          mul(rw(),hf1(),rw())
          hf2(0) = Val(Left(iz,#ZiffLength))
          If hf2(0) > 0 : add(rw(),hf2(),rw()) : EndIf
          iz = Right(iz,Len(iz)-#ZiffLength)
        Wend
        vzkorr(vorzeichen,rw(),rw())
    EndSelect
  EndProcedure
  
  Procedure.s strBig(Array z.i(1), tz.s="")
    Define rw.s
    Define vorzeichen.s
    Define i.i, j.i
    Dim intz.i(1)
    Dim faktor.i(1)
    If getbiti(z(ArraySize(z())),63) = 1 : vorzeichen = "-" :EndIf
    absBig(z(),intz())
    faktor(0) = 10
    Define konvanz.i = maxi((msb(intz()) + 1) * Log10(2)/4,1000)
    pot(faktor(),konvanz,faktor())
    If gte(intz(),faktor())
      Dim intz1.i(1)
      Dim intz2.i(1)
      div(intz(),faktor(),intz1(),intz2())
      savebig(GetTemporaryDirectory()+#bfn+"1.data",intz1())
      Define tid = CreateThread(@strbighelp(),setbiti(konvanz,#konleng,1))
      rw = horner(Intz2(),msb(Intz2()))
      lkorr(rw,konvanz)
      Define fnee.s = GetTemporaryDirectory()+#bfn+"1.text"
      WaitThread(tid)  
      ReadFile(0,fnee)
      rw = ReadString(0)+rw
      CloseFile(0)
      DeleteFile(fnee)
    Else
      rw = horner(Intz(),msb(Intz()))
    EndIf    
    rw = LTrim(rw,"0")
    If rw = "" : rw = "0" : EndIf
    If tz <> ""
      j = Len(rw) / 3
      For i = 1 To j
        rw = InsertString(rw,tz,Len(rw) - i*4 + 2)
      Next
      rw = LTrim(rw,tz)
    EndIf
    ProcedureReturn vorzeichen + rw
  EndProcedure
  
  Procedure.s hexBig(Array na.i(1),tz.s=" ")
    Define rw.s, j.i
    Dim n.i(0)
    CopyArray(na(),n())
    For i = 0 To ArraySize(n())
      rw = RSet(Hex(n(i),#PB_Quad),16,"0")+rw
    Next
    If Left(rw,16) = #hexhex : rw = Right(rw,Len(rw)-16) :EndIf
    If tz <> ""
      j = Len(rw) / 16
      For i = 1 To j
        rw = InsertString(rw,tz,Len(rw) - i*17 + 2)
      Next
      rw = LTrim(rw,tz)
    EndIf
    ProcedureReturn rw
  EndProcedure
  
  Procedure.s binBig(Array n.i(1),tz.s=" ")
    Define rw.s
    For i = 0 To ArraySize(n())
      rw = RSet(Bin(n(i),#PB_Quad),64,"0")+rw
    Next
    If Left(rw,64) = #binbits : rw = Right(rw,Len(rw)-64) : EndIf
    If tz <> ""
      j = Len(rw) / 8
      For i = 1 To j
        rw = InsertString(rw,tz,Len(rw) - i*9 + 2)   
      Next
      rw = LTrim(rw,tz)
    EndIf
    ProcedureReturn rw
  EndProcedure
  
  Procedure savebig(fn.s,Array z.i(1))            ; Speichert eine Langzahl in die Datei fn
    CreateFile(0,fn)
    WriteData(0,@z(0),(ArraySize(z())+1)*8)
    CloseFile(0)
  EndProcedure
  
  Procedure loadbig(fn.s,Array z.i(1))            ; Läd eine Langzahl aus der Datei fn
    If ReadFile(0, fn) 
      Define length = Lof(0)                      ; Länge der geöffneten Datei ermitteln
      Dim z.i(length/8-1)
      Define bytes = ReadData(0, @z(0), length)   ; Einlesen aller Daten in das Array
      CloseFile(0)
    Else
      Dim z.i(0)
    EndIf
  EndProcedure
  
  Procedure.i anz_stellen(s.s)
    Define hs.s = LTrim(s)
    Define rw = Len(hs)
    If Left(hs,1) = "-" Or Left(hs,1) = "+" : rw - 1 : EndIf
    ProcedureReturn rw
  EndProcedure
  
EndModule

Gruß
Arndt

[STARGÅTE]

Hallo Arndt, willkommen im Forum.

Ein Big-Int-Modul als Einstiegsprojekt, nicht schlecht.
Ich habe es mal ein bisschen getestet und hier ein paar Hinweise:

• Ein paar Kontrollberechnungen zeigen zunächst keine Fehler. Code funktioniert also.
• Es wäre gut, wenn du noch ein oder zwei Beispiele am Ende des Code packst, damit die Leute sehen, wie man es verwendet.
• Im Kopfkommentar schreibst du "Arrays vom Typ long", allerdings sind deine Arrays nicht long (.l, 4 Byte) sondern integer (.i, 8 Byte).
• Du solltest darauf hinweisen, dass dein Code Threads benutzt (in strBig), denn man muss ThreadSafe aktivieren, wenn man den Code nutzen möchte, sonst gibt es abstürze.
• Außerdem wundert es mich, warum du in strBig auch noch eine temporäre Datei schreibst? Ist das nur weil du die Daten an den Thread übergeben willst? Die Vorgehensweise ist mir hier nicht klar.
• Generell solltest du auch keine konstanten Datei-Nummern verwenden, wie bei CreateFile(0,fn).
  Diese PureBasic File-Nummer ist nämlich nicht im Modul gekapselt.
• Du initialisierst sehr häufig Arrays mit Dim name.i(1), schreibst dann aber nur in Index 0. Ich weiß nicht ob es dir bewusst ist, aber in Pure Basic erzeugt ein Dim name.i(1) ein Array mit zwei Feldern (Index 0 und 1).

[Arndt]

Vielen Dank für die Hinweise. Ich werde den Code und die Kommentare entsprechend überarbeiten. Eine Reihe von Unstimmigkeiten resultieren aus der Urscprünglichen XProfanX4-Implementierung (z.B. der Verweis auf long und die Dimensionierung der Arrays mit 1). Das sind genau die Hinweise, die ich brauche um vernünftigen PureBasic-Code zu schreiben.
Die temporären Dateien benutze ich tatsächlich nur zur Übergabe von Daten an die Threads und zur Rückübergabe der Ergebnisse. Gibt es eine bessere Möglichkeit ein Array an einen Thread zu übergeben und eine String zurückzuliefern? Mit einer SSD im Rechner ist das Vorgehen mit temporären Dateien brauchbar, ohne diesen Umweg könnte es aber eventuell schneller gehen.
Gruß
Arndt

[Macros]

Hallo Arndt,
auch von mir: Willkommen im Forum, und danke, dass du gleich einen großen Code teilst!

Um Strings oder andere Daten aus einem Thread zu übergeben hast du viele Möglichkeiten.
Ich habe gerade (noch) nicht die Zeit mir dein Modul genau anzusehen, aber empfehlenswert währen vermutlich globale Variablen und Mutexes.

Die Globalen Variablen kannst du im "Module" teil definieren, dann sieht man sie außerhalb nicht und hat nur über loadBig() Zugriff.
Da Strings grundsätzlich nicht Threadsicher sind musst du den Zugriff darauf in einem Mutex kapseln, der lässt nur exklusiven Zugriff zu. Die Hilfe erklärt die Verwendung gut.

Falls du mehrere Strings übergeben musst, kannst du auch eine globale Linked List verwenden (oder eine Map).

Beispiel:

Code: Alles auswählen

Global NewList Stringliste.s()
Global Listmutex = CreateMutex()
Global quit

Procedure ThreadFunc(Dummy)
  Repeat
    Delay(100)
    LockMutex(Listmutex)
    If FirstElement(Stringliste())    
      Debug "Thread empfing: " + Stringliste()
      DeleteElement(Stringliste())
    EndIf
    UnlockMutex(Listmutex)
  Until quit=1
EndProcedure

CreateThread(@ThreadFunc(), 0)

LockMutex(Listmutex)
AddElement(Stringliste())
Stringliste() = "Übergebener String"
AddElement(Stringliste())
Stringliste() = "Übergebener String2"
UnlockMutex(Listmutex)

Delay(1000)
quit=1

[NicTheQuick]

Daten übergibt man mittels einer Struktur an einen Thread. Auf die selbe Weise kann man die Daten auch wieder zurückholen.
Beispiel:

Code: Alles auswählen

CompilerIf Not #PB_Compiler_Thread
	CompilerWarning "Please enable Threadsafe mode."
CompilerEndIf

Structure Daten
	hThread.i
	zahl.i
	text.s
	ergebnis.s
EndStructure

Procedure Thread(*daten.Daten)
	; Simuliere etwas zu tun
	Delay(100)
	With *daten
		\ergebnis = \text + Str(\zahl)
	EndWith
EndProcedure

Define thread1.Daten
With thread1
	\zahl = 123
	\text = "Die Zahl ist "
	\hThread = CreateThread(@Thread(), thread1)
EndWith

WaitThread(thread1\hThread)
Debug thread1\ergebnis

Und natürlich kann statt eines Strings auch ein ganzes Array in die Struktur gepackt werden.

[Arndt]

Vielen Dank nocheimal an alle Hinweisgeber. Ich habe den Code überarbeitet und das Resultat sieht so aus:

Code: Alles auswählen

;/ ============================
;/ =    Big_Int_Module.pbi    =
;/ ============================
;/
;/ [ PB V6.1x / 64Bit / All OS / Strings Unicode]
;/
;/ Langzahlarithmetik (Stellenzahl nur begrenzt durch Leistungsfähikeit von CPU und Speicher, sowie
;/ durch die 2 GB Grenze für WriteData()/ReadData() in loadbig()/savebi())
;/ Die Langzahlen werden durch Arrays vom Typ integer repräsentiert.
;/ Die Procedure StrBig verwendet Threads (Compileroption ThreadSafe aktivieren!).
;/
;/ © 2025 Arndt Lindner (01/2025)
;/

; Version 1.0
; Last Update: 07.03.2025
;

;{ ===== MIT License =====
;
; Copyright (c) 2025 Arndt Lindner
;
; Permission is hereby granted, free of charge, to any person obtaining a copy
; of this software and associated documentation files (the "Software"), to deal
; in the Software without restriction, including without limitation the rights
; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
; copies of the Software, and to permit persons to whom the Software is
; furnished to do so, subject to the following conditions:
;
; The above copyright notice and this permission notice shall be included in all
; copies or substantial portions of the Software.
;
; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
; SOFTWARE.
;}

DeclareModule big_int
  
  ; Alle Procedure, die Langzahlen berechnen, geben das Ergebnis im letzten Parameter zurück.
  ; Ausnahme Division: gibt Divisionsergebnis und Divisionsrest in den beiden letzten Parametern zurück.
  ;
  Declare.i sig(Array z.i(1)) 
  Declare.i test(Array z.i(1),m.i)                  
  Declare.i testgerade(Array z.i(1))   
  Declare.i testungerade(Array z.i(1))
  Declare compl2(Array z1.i(1), Array z2.i(1))
  Declare absBig(Array z1.i(1), Array z2.i(1))
  Declare add(Array z1.i(1), Array z2.i(1), Array z3.i(1)) 
  Declare sub(Array z1.i(1), Array z2.i(1), Array z3.i(1))
  Declare inc(Array z1.i(1), iz.i, Array z3.i(1))       
  Declare dec(Array z1.i(1), iz.i, Array z3.i(1))    
  Declare mul(Array z1.i(1), Array z2.i(1), Array z3.i(1))
  Declare div(Array n1.i(1),Array n2.i(1), Array rw.i(1), Array rest.i(1))
  Declare getbit(Array z.i(1), index.i)       
  Declare setbit(Array z.i(1), index.i, v.i,Array rw.i(1))
  Declare shiftleft(Array n.i(1),Array rw.i(1))
  Declare shiftright(Array n.i(1),Array rw.i(1))
  Declare pot(Array n.i(1),p.i,Array rw.i(1))
  Declare pot2(p.i,Array rw.i(1))                     
  Declare powermod(Array basis.i(1),Array expo.i(1), Array m.i(1), Array rw.i(1))
  Declare fak(n.i,Array rw.i(1))
  Declare equ(Array z1.i(1),Array z2.i(1))
  Declare notequ(Array z1.i(1),Array z2.i(1))
  Declare gt(Array z1.i(1),Array z2.i(1))
  Declare gte(Array z1.i(1),Array z2.i(1))
  Declare lt(Array z1.i(1),Array z2.i(1))
  Declare lte(Array z1.i(1),Array z2.i(1))
  Declare ggt(Array n1.i(1),Array n2.i(1),Array rw.i(1))
  Declare kgv(Array n1.i(1), Array n2.i(1), Array rw.i(1))
  Declare ValBig(z.s, Array rw.i(1))  
  Declare.s StrBig(Array z.i(1),tz.s="")
  Declare.s HexBig(Array n.i(1),tz.s=" ")                
  Declare.s BinBig(Array n.i(1),tz.s=" ") 
  Declare savebig(fn.s,Array z.i(1))        ;fn - Filename
  Declare loadbig(fn.s,Array z.i(1))  
  Declare.i anz_stellen(s.s)  
  
EndDeclareModule

Module big_int
  
  EnableExplicit
  
  ;- ============================================================================
  ;-   Module - Internal constants and structures
  ;- ============================================================================ 
  
  #qmaske = $FFFFFFFFFFFFFFFF
  #ZiffZahl = 1000000000000000000   ; = 10^ZiffLength
  #ZiffLength = 18
  #binbits = "00000000000000000000000000000000000000000000000000000000000000000"
  #hexhex = "00000000000000000"
  #k1 = 0.0753                      ; ca. log10(2)/4,  begrenzt die Anzahl der erzeugten Threads in StrBig()
  #k2 = 400                         ; Stellenzahl, die im SingleTread-Modus schnell konvertiert wird
  
  Structure daten
    hthread.i
    konvanz.i
    Array zd.i(0)
    Array zfaktor.i(0)
    ergebnis.s
  EndStructure

  ;- ============================================================================
  ;-   Module - Macros
  ;- ============================================================================ 
  
  Macro getbiti(v,bitnr)
    Bool(v & (1 << bitnr))
  EndMacro
  
  Macro vzkorr(vz,ze,za)
    If vz
      compl2(ze,za)
    Else  
      compress(ze,za)
    EndIf  
  EndMacro
  
  Macro lkorr(s,konvanz)
    If Len(s) < konvanz
      s = RSet(s,konvanz,"0")
    ElseIf Len(s) > konvanz
      s = Right(s,konvanz)
    EndIf  
  EndMacro
  
  ;- ============================================================================
  ;-   Module - Internal Functions
  ;- ============================================================================ 
  
  Procedure.i setbiti(v.i,bitnr.i,bitv.i)
    Define rw.q = v
    Select bitv
      Case 0
        rw & ((1 << bitnr) ! #qmaske) 
      Case 1
        rw | ~((1 << bitnr) ! #qmaske) 
    EndSelect
    ProcedureReturn rw
  EndProcedure
  
  Procedure maxi(a.i,b.i)
    Define rw.i = a
    If a < b : rw = b : EndIf
    ProcedureReturn rw
  EndProcedure
  
  Procedure mini(a.i,b.i)
    Define rw.i = b
    If a < b : rw = a : EndIf
    ProcedureReturn rw
  EndProcedure
  
  ; al sollte >= ArraySize(z1()) sein
  ;
  Procedure normalize(Array z1.i(1),al.i,Array z2.i(1))
    Define rlz.i = ArraySize(z1())
    Dim zi.i(0)
    CopyArray(z1(),zi())
    ReDim zi.i(al+1)
    If Getbiti(z1(rlz),63) = 1
      Define i.i 
      For i = rlz+1 To al+1
        zi(i) = -1
      Next  
    EndIf
    CopyArray(zi(),z2())
  EndProcedure
  
  Procedure compress(Array z1.i(1),Array z2.i(1))
    Define asz.i = ArraySize(z1())
    Dim zi.i(asz)
    CopyArray(z1(),zi())
    If asz > 0    ;1
      While (zi(asz) = -Getbiti(zi(asz-1),63)) And (asz > 1)
        asz -1
      Wend  
      If (zi(1) = -Getbiti(zi(0),63)) And (asz = 1) : asz = 0 : EndIf
      ReDim zi.i(asz)
    EndIf  
    CopyArray(zi(),z2())
  EndProcedure
  
  Procedure.s incz(si.s)
    Define i.i, shb.b
    i = Len(si)
    Repeat
      shb = PeekB(@si+2*(i-1)) + 1 
      If shb > 57
        shb - 10
        PokeB(@si+2*(i-1),shb)
        i - 1
      Else
        PokeB(@si+2*(i-1),shb)
        i = 0
      EndIf  
    Until i <= 0
    ProcedureReturn si
  EndProcedure
  
  Procedure.s mul2(si.s)
    Define i.i, u.b, shb.b
    i = Len(si)
    u = 0
    Repeat
      shb = PeekB(@si+2*(i-1))
      shb = ((shb - 48) << 1) + u
      If shb > 9
        shb + 38
        u = 1
      Else
        shb + 48
        u = 0
      EndIf 
      PokeB(@si+2*(i-1),shb)
      i - 1
    Until i = 0
    ProcedureReturn si
  EndProcedure
  
  Procedure.s horner(Array a.i(1),msb.i)
    Define rw.s
    If ArraySize(a()) = 0
      rw = Str(a(0))
    Else
      Define i.i
      rw = "00"
      For i = msb To 1 Step -1
        If getbit(a(),i) 
          If Left(rw,1) <> "0" : rw = "0"+rw : EndIf
          rw = incz(rw)
        EndIf
        If Left(rw,1) <> "0" : rw = "0"+rw : EndIf
        rw = mul2(rw)
      Next
      If getbiti(a(0),0)
        If Left(rw,1) <> "0" : rw = "0"+rw : EndIf
        rw = incz(rw)
        rw = LTrim(rw,"0")
      EndIf
    EndIf
    ProcedureReturn rw
  EndProcedure
  
  Procedure.i msb(Array n.i(1))
    Dim ni.i(0)
    Define rw.i, i.i, ba.i, nt.i
    CopyArray(n(),ni())
    ba = ArraySize(ni())
    nt = ni(ba)
    While (nt = 0) And (ba > 0)
      ba-1
      nt = ni(ba)
    Wend
    rw = 64*(ba+1)-1
    i = 63
    While (i >= 0) And Not(getbiti(nt,i))
      i-1
      rw-1
    Wend
    ProcedureReturn rw
  EndProcedure
  
  Procedure strbighelp(*daten.daten)
    Dim z.i(1)
    CopyArray(*daten\zd(),z())
    Define rw.s
    If gte(z(),*daten\zfaktor())
      Dim intz1.i(1)
      Dim intz2.i(1)
      div(z(),*daten\zfaktor(),intz1(),intz2())
      Define threaddaten.daten
      With threaddaten
        CopyArray(intz1(),\zd())
        CopyArray(*daten\zfaktor(),\zfaktor())
        \konvanz = *daten\konvanz
        \hthread = CreateThread(@strbighelp(),threaddaten)
      EndWith
      rw = horner(Intz2(),msb(Intz2()))
      lkorr(rw,*daten\konvanz)
      WaitThread(threaddaten\hthread)  
      rw = threaddaten\ergebnis + rw
    Else
      rw = horner(z(),msb(z()))
      lkorr(rw,*daten\konvanz)
    EndIf  
    *daten\ergebnis = rw
  EndProcedure
  
  ;- ============================================================================
  ;-   Module - Functions
  ;- ============================================================================ 
  
  Procedure.i sig(Array z.i(1))
    ProcedureReturn getbiti(z(ArraySize(z())),63)
  EndProcedure
  
  Procedure.i test(Array z.i(1),m.i)
    Dim zi.i(0)
    CopyArray(z(),zi())
    compress(zi(),zi())
    ProcedureReturn Bool((ArraySize(zi()) = 0) And (zi(0) = m))
  EndProcedure  
  
  Procedure.i testgerade(Array z.i(1))
    ProcedureReturn Bool(getbiti(z(0),0) = 0)
  EndProcedure  
  
  Procedure.i testungerade(Array z.i(1))
    ProcedureReturn Bool(getbiti(z(0),0) = 1)
  EndProcedure  
  
  Procedure compl2(Array z1.i(1), Array z2.i(1))
    Dim zn.i(0)
    Define arz.i = ArraySize(z1()) + 1
    Define i.i
    CopyArray(z1(),zn())
    ReDim zn.i(arz)
    zn(arz) = -getbiti(zn(arz-1),63)
    For i = 0 To arz
      zn(i) = ~zn(i)
    Next
    inc(zn(),1,z2())
  EndProcedure
  
  Procedure absBig(Array z1.i(1), Array z2.i(1))
    If getbiti(z1(ArraySize(z1())),63) = 1
      compl2(z1(),z2())
    Else
      compress(z1(),z2())
    EndIf
  EndProcedure
  
  Procedure add(Array z1.i(1), Array z2.i(1), Array z3.i(1))
    Define numlength1.i = ArraySize(z1())
    Define numlength2.i = ArraySize(z2())
    Dim zi1.i(numlength1)
    Dim zi2.i(numlength2)
    Define numlength = maxi(numlength1,numlength2)
    normalize(z1(),numlength,zi1())
    normalize(z2(),numlength,zi2())
    numlength + 1
    Dim zi3.i(numlength)
    Define az1 = @zi1()
    Define az2 = @zi2()
    Define az3 = @zi3()
    EnableASM
      mov   r8,az1
      mov   r9,az2
      mov   rax,az3
      mov   rcx,numlength
      inc   rcx
      push  rsi
      push  rdi
      mov   rsi,r8
      mov   rdi,rax
      clc
      cld
! big_int_add_sch:
!    lodsq
      mov   rdx,rax  
      xchg  rsi,r9
!     lodsq
      xchg  rsi,r9 
      adc   rax,rdx
!     stosq  
!     loop  big_int_add_sch     
      pop   rdi
      pop   rsi
    DisableASM
    compress(zi3(),z3())
  EndProcedure
  
  Procedure sub(Array z1.i(1), Array z2.i(1), Array z3.i(1))
    Dim zh.i(0)
    compl2(z2(),zh())
    add(z1(),zh(),z3())
  EndProcedure  
  
  Procedure inc(Array z1.i(1), iz.i, Array z3.i(1))
    If iz >= 0
      Dim z2.i(1)
      CopyArray(z1(),z2())
      Define arz.i = ArraySize(z2())+1
      ReDim z2.i(arz)
      z2(arz) = -getbiti(z2(arz-1),63)
      Define a2 = @z2()
      EnableASM
        mov   r8,a2
        mov   r9,iz
        mov   rcx,arz
;       inc   rcx
        push  rsi
        push  rdi
        mov   rsi,r8
        mov   rdi,r8
        xor   r8,r8
        clc
        cld
!       lodsq
        adc   rax,r9
!       stosq
!big_int_inc_sch:
!       lodsq
        adc   rax,r8
!       stosq  
!       jnc   big_int_inc_ende
!       loop  big_int_inc_sch     
!big_int_inc_ende:
        pop   rdi
        pop   rsi
      DisableASM
      compress(z2(),z3())
    Else
      MessageRequester("Error (inc())","Second parameter less than 0.",#PB_MessageRequester_Error)
      CopyArray(z1(),z3())
    EndIf
  EndProcedure  
  
  Procedure dec(Array z1.i(1), iz.i, Array z3.i(1))
    If iz >= 0
      Dim z2.i(0)
      CopyArray(z1(),z2())
      Define arz.i = ArraySize(z2())+1
      ReDim z2.i(arz)
      z2(arz) = -getbiti(z2(arz-1),63)
      Define a2 = @z2()
      EnableASM
        mov   r8,a2
        mov   r9,iz
        mov   rcx,arz
        inc   rcx
        push  rsi
        push  rdi
        mov   rsi,r8
        mov   rdi,r8
        xor   r8,r8
        clc
        cld
!       lodsq
        sbb   rax,r9
!       stosq
!big_int_dec_sch:
!       lodsq
        sbb   rax,r8
!       stosq  
!       jnc   big_int_dec_ende
!       loop  big_int_dec_sch     
!big_int_dec_ende:
        pop   rdi
        pop   rsi
      DisableASM
      compress(z2(),z3())
    Else
      MessageRequester("Error (dec())","Second parameter less than 0.",#PB_MessageRequester_Error)
      CopyArray(z1(),z3())
    EndIf
  EndProcedure  
  
  Procedure mul(Array z1.i(1), Array z2.i(1), Array z3.i(1))
    Define vz.i = getbiti(z1(ArraySize(z1())),63) ! getbiti(z2(ArraySize(z2())),63)
    Define i.i
    Dim zi1.i(0)
    Dim zi2.i(0)
    AbsBig(z1(),zi1())
    AbsBig(z2(),zi2())
    Define numlength1.i = ArraySize(zi1())
    Define numlength2.i = ArraySize(zi2())
    Dim zh.i(0)
    Dim rw.i(0)
    rw(0) = 0
    If numlength2 > numlength1
      CopyArray(zi1(),zh())
      CopyArray(zi2(),zi1())
      CopyArray(zh(),zi2())
    EndIf  
    Define so2.i = ArraySize(zi2())
    Define so1.i = ArraySize(zi1())
    ReDim zi1(so1+1)
    Dim zh.i(0)
    For i.i = 0 To so2
      Define zz.i = zi2(i)
      If zz <> 0
        Dim zh.i(so1+i+1) 
        Define az1 = @zi1()
        Define az3 = @zh(i)
        EnableASM
          mov   r8,az1
          mov   r9,zz
          mov   rax,az3
          mov   rcx,so1
          inc   rcx
          inc   rcx
          push  rsi
          push  rdi
          mov   rsi,r8
          mov   rdi,rax
          clc
          cld
          xor   r8,r8
!big_int_mul_sch:
!         lodsq
          mul   r9
          add   rax,r8
          mov   r8,rdx
          adc   r8,0
!         stosq  
!         loop  big_int_mul_sch     
          pop   rdi
          pop   rsi
        DisableASM
        add(rw(),zh(),rw())
      EndIf
    Next i
    vzkorr(vz,rw(),z3())
  EndProcedure
  
  Procedure div(Array n1.i(1),Array n2.i(1), Array rw.i(1), Array rest.i(1))
    Dim hf1.i(0)
    Dim hf2.i(0)
    Dim hf3.i(0)
    Dim hfrw.i(0)
    Define.i i, vz, msb1, msb2, offset, k
    If test(n2(),0)
      MessageRequester("Error (div())", "Division by 0", #PB_MessageRequester_Error)
    ElseIf Not(test(n1(),0))
      vz = sig(n1()) ! sig(n2())
      AbsBig(n1(),hf1())
      AbsBig(n2(),hf2())
      While (getbiti(hf1(0),0) = 0) And (getbiti(hf2(0),0) = 0)
        shiftright(hf1(),hf1())                              ; Kürzen mit 2    
        shiftright(hf2(),hf2())
        k + 1
      Wend
      msb1 = msb(hf1())
      msb2 = msb(hf2())
      offset = msb1 - msb2
      If offset < 0
        hfrw(0) = 0
      ElseIf offset = 0
        If Not(gt(hf2(),hf1()))
          hfrw(0) = 1
          sub(hf1(),hf2(),hf1())
        Else
          hfrw(0) = 0
        EndIf
      Else
        For i = 1 To offset
          shiftleft(hf2(),hf2())
        Next
        Dim hfrw.i(offset/64 + 1)
        compl2(hf2(),hf2())                 ; um in der Schleife zu addieren
        For i = offset To 0 Step -1
          If (getbit(hf1(),msb2+i) = 1) Or (getbit(hf1(),msb2+i+1) = 1)
            CopyArray(hf1(),hf3())
            add(hf1(),hf2(),hf1())          ; statt sub(...), s.o.
            If Not(sig(hf1()))
              setbit(hfrw(),i,1,hfrw())
            Else
              CopyArray(hf3(),hf1())
            EndIf
          EndIf
          shiftright(hf2(),hf2())
        Next
      EndIf
      If Not(test(hf1(),0))
        While k > 0                        ; Korrektur Rest wegen Kürzen!
          shiftleft(hf1(),hf1())
          k - 1
        Wend  
      EndIf
      vzkorr(vz,hfrw(),rw())
      vzkorr(sig(n1()),hf1(),rest())
    Else
      Dim rw.i(0)
      Dim rest.i(0)
    EndIf
  EndProcedure
  
  Procedure.i getbit(Array z.i(1), index.i)
    Define fe.i, iie.i
    fe = index >> 6     ;index / 64
    iie = index % 64
    If fe > ArraySize(z())
      fe = ArraySize(z())
      iie = 63
    EndIf
    ProcedureReturn getbiti(z(fe),iie) 
  EndProcedure
  
  Procedure setbit(Array z.i(1), index.i, v.i,Array rw.i(1))
    Define fe.i, iie.i, fl.i
    Dim irw.i(0)
    CopyArray(z(),irw())
    fe = index >> 6     ;index / 64
    iie = index % 64
    If fe > ArraySize(irw()) : ReDim irw.i(fe+1) : EndIf
    irw(fe) = setbiti(irw(fe),iie,v)
    CopyArray(irw(),rw())
  EndProcedure
  
  Procedure shiftleft(Array n.i(1),Array rw.i(1))
    Define numlength.i = ArraySize(n())
    Dim rwi.i(numlength)
    CopyArray(n(),rwi())
    ReDim rwi.i(numlength+1)
    rwi(numlength+1) = -getbiti(rwi(numlength),63)
    Define arw.i = @rwi()
    EnableASM
      mov   rax,arw
      mov   rcx,numlength
      inc   rcx
      push  rsi
      push  rdi
      mov   rdi,rax
      mov   rsi,rax
      clc
      cld
!big_int_shiftleft_sch:
!     lodsq
!     rcl   rax,1 
!     stosq
!     loop  big_int_shiftleft_sch
      pop   rdi
      pop   rsi
    DisableASM
    compress(rwi(),rw())
  EndProcedure
  
  Procedure shiftright(Array n.i(1),Array rw.i(1))
    Define numlength.i = ArraySize(n())
    Dim rwi.i(numlength)
    Define i.i
    CopyArray(n(),rwi())
    For i.i = 0 To numlength-1
      Define ld.i = getbiti(rwi(i+1),0)
      rwi(i) >> 1
      rwi(i) = rwi(i) & $7fffffffffffffff 
      If ld = 1 : rwi(i) = rwi(i) | $8000000000000000 : EndIf
    Next
    ld = getbiti(rwi(numlength),63)
    rwi(numlength) >> 1
    rwi(numlength) = rwi(numlength) & $7fffffffffffffff
    If ld = 1 : rwi(numlength) = rwi(numlength) | $8000000000000000 : EndIf
    compress(rwi(),rw())
  EndProcedure
  
  Procedure pot(Array n.i(1),p.i,Array rw.i(1))
    Dim hf.i(0)
    If p < 0
      MessageRequester("Error (pot())", "Exponent less than 0", #PB_MessageRequester_Error)
      Dim rw.i(0)
    Else  
      Select p
        Case 0
          Dim rw.i(0)
          rw(0) = 1
        Case 1
          CopyArray(n(),rw())
        Case 2
          mul(n(),n(),rw())
        Default
          If getbiti(p,0)              ;(p mod 2) != 0
            pot(n(),p-1,hf())
            mul(n(),hf(),rw())
          Else
            pot(n(),p >> 1,hf())
            mul(hf(),hf(),rw())
          EndIf
      EndSelect
    EndIf
  EndProcedure
  
  ; berechnet 2^p
  ;
  Procedure pot2(p.i,Array rw.i(1))
    Dim rw.i(0)
    setbit(rw(),p,1,rw())
    If (p % 64) = 63 : ReDim rw(ArraySize(rw())+1) : EndIf
  EndProcedure
  
  ; powermod(basis[],expo[],m[],rw[])
  ; Berechnet basis[]^expo[] mod m[]
  ; Ergebnis in rw[]
  ;
  Procedure PowerMod(Array basis.i(1), Array expo.i(1), Array m.i(1), Array rw.i(1))
    Dim kk.i(0)
    CopyArray(expo(),kk())
    Dim pot1.i(0)
    CopyArray(basis(),pot1())
    Dim x.i(0)
    x(0) = 1
    Define fertig.i = #False
    Dim d.i(0)
    Repeat
      If getbiti(kk(0),0)  
        mul(x(),pot1(),x())
        div(x(),m(),d(),x())
        If test(kk(),1)
          fertig = #True
        Else
          dec(kk(),1,kk())
        EndIf
      EndIf  
      shiftright(kk(),kk())
      mul(pot1(),pot1(),pot1())
      div(pot1(),m(),d(),pot1())
    Until fertig
    CopyArray(x(),rw())
  EndProcedure  
  
  Procedure fak(n.i,Array rw.i(1))
    Define i.i
    Dim rw.i(0)
    rw(0) = 1
    If n > 1
      Dim zh.i(0)
      zh(0) = 1
      For i.i = 1 To n-1
        inc(zh(),1,zh())
        mul(rw(),zh(),rw())
      Next  
    ElseIf Not((n = 0) Or (n = 1))
      MessageRequester("Error (fak())", "Inputvalue less than 0", #PB_MessageRequester_Error)
      Dim rw.i(0)
    EndIf
  EndProcedure
  
  Procedure.i equ(Array z1.i(1),Array z2.i(1))
    compress(z1(),z1())
    compress(z2(),z2())
    ProcedureReturn CompareArray(z1(),z2())
  EndProcedure
  
  Procedure.i notequ(Array z1.i(1),Array z2.i(1))
    ProcedureReturn Bool(Not(equ(z1(),z2())))
  EndProcedure
  
  Procedure.i gte(Array z1.i(1),Array z2.i(1))
    Define rw.i = #False
    Dim zi.i(0)
    sub(z1(),z2(),zi())
    If (test(zi(),0) = 1) Or (sig(zi()) = 0)
      rw = #True
    EndIf
    ProcedureReturn rw
  EndProcedure
  
  Procedure.i gt(Array z1.i(1),Array z2.i(1))
    ProcedureReturn Bool(gte(z1(),z2()) And Not(equ(z1(),z2())))
  EndProcedure
  
  Procedure.i lt(Array z1.i(1),Array z2.i(1))
    ProcedureReturn Bool(Not(gte(z1(),z2())))
  EndProcedure
  
  Procedure.i lte(Array z1.i(1),Array z2.i(1))
    ProcedureReturn Bool(Not(gt(z1(),z2())))
  EndProcedure
  
  ;   ggt(n1(),n2(),rw())
  ;   Größter gemeinsamer Teiler von n1() und n2()
  ;   Steinscherscher Algorithmus implementiert nach Donald E. Knuth, The Art of Computer Programming
  ;   n1(), n2() - positive Langzahlen (Typ Integer-Array)
  ;   Ergebnis: rw() - Langzahlen (Typ Integer-Array)
  ; 
  Procedure ggt(Array n1.i(1),Array n2.i(1),Array rw.i(1))
    Dim a.i(0)
    Dim b.i(0)
    Dim t.i(0)
    Dim rwi.i(0)
    Define k.i, i.i
    compress(n1(),a())
    compress(n2(),b())
    If (sig(a()) = 0) And (sig(b()) = 0)
      If test(b(),0)
        CopyArray(a(),rwi())
      ElseIf test(a(),0)
        CopyArray(b(),rwi())
      Else
        k = 0
        While testgerade(a()) And testgerade(b())
          shiftright(a(),a())
          shiftright(b(),b())
          k + 1
        Wend
        If testungerade(a())
          compl2(b(),t())
        Else
          CopyArray(a(),t())
        EndIf
        While Not(test(t(),0))
          While testgerade(t()) And Not(test(t(),0))
            shiftright(t(),t())
          Wend
          If Not(sig(t())) And Not(test(t(),0))
            CopyArray(t(),a())
          Else
            compl2(t(),b())
          EndIf
          sub(a(),b(),t())
        Wend
        CopyArray(a(),rwi())
        For i = 1 To k
          shiftleft(rwi(),rwi())
        Next
      EndIf
      CopyArray(rwi(),rw())
    Else
      MessageRequester("Error (ggt())", "negative input values", #PB_MessageRequester_Error)
    EndIf
  EndProcedure
  
  ;   kgv(n1(),n2(),rw())
  ;   Kleistes gemeinsames Vielfaches von n1() und n2()
  ;   n1(), n2() - positive Langzahlen (Typ Integer-Array)
  ;   Ergebnis: rw() - Langzahlen (Typ Integer-Array)
  ; 
  Procedure kgv(Array n1.i(1), Array n2.i(1), Array rw.i(1))
    Dim c.i(0)
    Dim d.i(0)
    Dim h.i(0)
    Dim rw.i(0)
    If (sig(n1()) Or sig(n2())) = 0
      mul(n1(),n2(),c())
      ggt(n1(),n2(),d())
      div(c(),d(),rw(),h())
    Else
      MessageRequester("Error (kgv())", "negative input vlue(s)", #PB_MessageRequester_Error)
    EndIf
  EndProcedure
  
  Procedure valBig(z.s, Array rw.i(1))
    Define ezl.i, vorzeichen.i, i.i, lz.i, iz.s, ihz.s,ch.s
    Dim hf1.i(0)
    Dim hf2.i(0)
    iz = Trim(z)
    lz = Len(iz)
    Dim rw.i(0)
    Select Left(iz,1)
      Case "$"
        iz = LTrim(iz,"$")
        If Len(iz) > 0
          i = 0
          While Len(iz) >= 16
            rw(i) = Val("$"+Right(iz,16))
            iz = Left(iz,Len(iz)-16)
            i+1
            ReDim rw.i(i)
          Wend
          If Len(iz) > 0
            rw(i) = Val("$"+iz)
          Else
            ReDim rw.i(i-1)
          EndIf
        EndIf
      Case "%"
        iz = LTrim(iz,"%")
        If Len(iz) > 0
          i = 0
          While Len(iz) >= 64
            rw(i) = Val("%"+Right(iz,64))
            iz = Left(iz,Len(iz)-64)
            i+1
            ReDim rw(i)
          Wend
          If Len(iz) > 0
            rw(i) = Val("%"+iz)
          Else
            ReDim rw(i-1)
          EndIf  
        EndIf
      Default
        If Left(iz,1) = "-"
          vorzeichen = 1
          iz = Right(iz,Len(iz)-1)
        ElseIf Left(iz,1) = "+"
          iz = Right(iz,Len(iz)-1)
        EndIf
        ezl = Len(iz) % #Zifflength
        rw(0) = Val(Left(iz,ezl))
        iz = Right(iz,Len(iz)-ezl)
        hf1(0) = #ZiffZahl
        While Len(iz) > 0                      ; Hornerschema
          mul(rw(),hf1(),rw())
          hf2(0) = Val(Left(iz,#ZiffLength))
          If hf2(0) > 0 : add(rw(),hf2(),rw()) : EndIf
          iz = Right(iz,Len(iz)-#ZiffLength)
        Wend
        vzkorr(vorzeichen,rw(),rw())
    EndSelect
  EndProcedure
  
    Procedure.s strBig(Array z.i(1), tz.s="")
    Define rw.s
    Define vorzeichen.s
    Define i.i, j.i
    Dim intz.i(0)
    Dim faktor.i(0)
    If getbiti(z(ArraySize(z())),63) = 1 : vorzeichen = "-" :EndIf
    absBig(z(),intz())
    faktor(0) = 10
    Define konvanz.i = maxi((msb(z()) + 1) * #k1,#k2)
    pot(faktor(),konvanz,faktor())
    If gte(intz(),faktor())
      Define threaddaten.daten
      Dim intz1.i(1)
      Dim intz2.i(1)
      div(intz(),faktor(),intz1(),intz2())
      With threaddaten
        CopyArray(intz1(),\zd())
        CopyArray(faktor(),\zfaktor())
        \konvanz = konvanz
        \hthread = CreateThread(@strbighelp(),threaddaten)
        EndWith
      rw = horner(Intz2(),msb(Intz2()))
      lkorr(rw,konvanz)
      WaitThread(threaddaten\hthread)  
      rw = threaddaten\ergebnis + rw
     Else
      rw = horner(Intz(),msb(Intz()))
    EndIf    
    rw = LTrim(rw,"0")
    If rw = "" : rw = "0" : EndIf
    If tz <> ""
      j = Len(rw) / 3
      For i = 1 To j
        rw = InsertString(rw,tz,Len(rw) - i*4 + 2)
      Next
      rw = LTrim(rw,tz)
    EndIf
    ProcedureReturn vorzeichen + rw
  EndProcedure
   
  Procedure.s hexBig(Array na.i(1),tz.s=" ")
    Define rw.s, i.i, j.i
    Dim n.i(0)
    CopyArray(na(),n())
    For i = 0 To ArraySize(n())
      rw = RSet(Hex(n(i),#PB_Quad),16,"0")+rw
    Next
    If Left(rw,16) = #hexhex : rw = Right(rw,Len(rw)-16) :EndIf
    If tz <> ""
      j = Len(rw) / 16
      For i = 1 To j
        rw = InsertString(rw,tz,Len(rw) - i*17 + 2)
      Next
      rw = LTrim(rw,tz)
    EndIf
    ProcedureReturn rw
  EndProcedure
  
  Procedure.s binBig(Array n.i(1),tz.s=" ")
    Define rw.s, i.i, j.i
    For i = 0 To ArraySize(n())
      rw = RSet(Bin(n(i),#PB_Quad),64,"0")+rw
    Next
    If Left(rw,64) = #binbits : rw = Right(rw,Len(rw)-64) : EndIf
    If tz <> ""
      j = Len(rw) / 8
      For i = 1 To j
        rw = InsertString(rw,tz,Len(rw) - i*9 + 2)   
      Next
      rw = LTrim(rw,tz)
    EndIf
    ProcedureReturn rw
  EndProcedure
  
  Procedure savebig(fn.s,Array z.i(1))             ; Speichert eine Langzahl in die Datei fn
    Define fnr.i = CreateFile(#PB_Any,fn)
    WriteData(fnr,@z(),(ArraySize(z())+1)*8)
    CloseFile(fnr)
  EndProcedure
  
  Procedure loadbig(fn.s,Array z.i(1))              ; Läd eine Langzahl aus der Datei fn
    Define fnr.i = ReadFile(#PB_Any, fn) 
    If fnr
      Define length = Lof(fnr)                      ; Länge der geöffneten Datei ermitteln
      Dim z.i(length/8-1)
      Define bytes = ReadData(fnr, @z(), length)    ; Einlesen aller Daten in das Array
      CloseFile(fnr)
    Else
      Dim z.i(0)
    EndIf
  EndProcedure
  
  Procedure.i anz_stellen(s.s)
    Define hs.s = LTrim(s)
    Define rw = Len(hs)
    If Left(hs,1) = "-" Or Left(hs,1) = "+" : rw - 1 : EndIf
    ProcedureReturn rw
  EndProcedure
  
EndModule

Zur Anwendung des Codes steht alles in der nachfolgenden Demo.

Code: Alles auswählen

IncludeFile  "big_int_module.pbi" 

#winb = 1000   ; an eigenen Bildschirm anpassen
#winh = 800

Procedure.s zufallszahl(n.i)
  Define z.s,i.i
  z = Chr(Random(57,49))
  For i = 2 To n
    z = z + Chr(Random(57,48))
  Next
  If Random(100,1) > 50 : z = "-" + z : EndIf
  ProcedureReturn z
EndProcedure

UseModule big_int

Define.s s1, s2, s3, s11, s21
Dim n1.i(0)
Dim n2.i(0)
Dim n3.i(0)
Dim n4.i(0)

Define win.i = OpenWindow(#PB_Any, 10, 10, #winb, #winh, "big_int-Test",#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget)  
If win
  Define ausgabegadget = EditorGadget(#PB_Any,10,10,#winb-20,#winh-40,#PB_Editor_ReadOnly | #PB_Editor_WordWrap)
  Repeat
    ClearGadgetItems(ausgabegadget) 
    s1 = zufallszahl(1050)       ; mit Stellenzahlen experimentieren
    s2 = zufallszahl(800)        ; mit Stellenzahlen experimentieren
    big_int::valbig(s1,n1())
    big_int::valbig(s2,n2())
    s11 = big_int::strbig(n1(),"")
    s21 = big_int::strbig(n2(),"")
    If (s1 = s11) And (s2 = s21)
      AddGadgetItem(ausgabegadget,-1,~"Konvertierung korrekt\n1. Zahl\n"+s11+~"\n\n2. Zahl\n"+s21+~"\n") 
    Else
      AddGadgetItem(ausgabegadget,-1,~"Konvertierung fehlerhaft\n") 
    EndIf
    big_int::mul(n1(),n2(),n3())
    s3 = big_int::strbig(n3())
    AddGadgetItem(ausgabegadget,-1,~"Multiplikation:\n"+s3+~"\n") 
    big_int::div(n1(),n2(),n3(),n4())
    AddGadgetItem(ausgabegadget,-1,~"Division:\n"+big_int::strbig(n3())+~"\nDivisionsrest:\n"+big_int::strbig(n4())+~"\n") 
    big_int::absbig(n1(),n1())
    big_int::absbig(n2(),n2())
    big_int::ggt(n1(),n2(),n3())
    AddGadgetItem(ausgabegadget,-1,~"Größter gemeinsamer Teiler der beiden Zahlen:\n"+big_int::strbig(n3())+~"\n") 
    big_int::fak(150,n1())
    big_int::fak(50,n2())
    big_int::ggt(n1(),n2(),n3())
    AddGadgetItem(ausgabegadget,-1,~"Größter gemeinsamer Teiler von 150! und 50!:\n"+big_int::strbig(n3(),".")+~"\n") 
    AddGadgetItem(ausgabegadget,-1,~"50!:\n"+big_int::strbig(n2(),".")+~"\n") 
    
  Until MessageRequester("","Erneut abarbeiten?",#PB_MessageRequester_Info|#PB_MessageRequester_YesNo) = #PB_MessageRequester_No
  
EndIf

End 

Gruß
Arndt