PureBasic Forums - English

Posted: **Tue Jul 17, 2007 4:09 pm**

Hey, I get a 15% speed increase for setting the structure to use longs, not bytes. more memory usage though.

still not as good as Demivec though

Posted: **Tue Jul 17, 2007 4:29 pm**

Hmm pdwyer,

seems that none of our routines is extremly fast, and I fear, there are still some issues (when testing your code, I didn't see the first cipher "3" in the result of Test 1, my "BCD" version seems to get crazy with very long numbers in Test 2 etc.)

Michael

PS
who ever "invented"

these funny numbers, I'll use them (1000 times) now for speed testing and call it Test 1:
result=43534253452345234532452352352357890808907890 * 89707890759830658903859036890436905489650

Test 2 starts with result=2 and multiply (15 times) result=result * result which should have a nice long number with 9865 ciphers at the end (my first string variante is ok, but the new BCD version fails)...

Posted: **Tue Jul 17, 2007 8:53 pm**

I have been working on this little bcd add trick found at http://www.azillionmonkeys.com/qed/asmexample.html
and in trying to extend it's precision I found a bug, it seems to work except when the values to be added are a string of 9's
maybe somebody will spot the bug.

Code: Select all

;from http://www.azillionmonkeys.com/qed/asmexample.html
Structure bcd64
    lo.l
    hi.l
EndStructure

Structure bcd128
    bcd.l[3]
EndStructure

Procedure add1(*z.bcd64, *x.bcd64, *y.bcd64)

   ; by Norbert Juffa
   ! mov   esi,[p.p_x]
   ! mov   edi,[p.p_y]
   ! mov   eax, [esi]   ; x (lo)
   ! mov   ebx, [edi]   ; y (lo)
   ! mov   edx, [esi+4] ; x (hi)
   ! mov   ecx, [edi+4] ; y (hi)

   ; here: EDX:EAX = augend, ECX:EBX = addend

   ! mov   esi, eax             ; x
   ! lea   edi, [eax+$66666666] ; x + 0x66666666
   ! xor   esi, ebx             ; x ^ y
   ! add   eax, ebx             ; x + y
   ! shr   esi, 1               ; t1 = (x ^ y) >> 1
   ! add   edi, ebx             ; x + y + 0x66666666
   ! sbb   ebx, ebx             ; capture carry
   ! rcr   edi, 1               ; t2 = (x + y + 0x66666666) >> 1
   ! xor   esi, edi             ; t1 ^ t2
   ! and   esi, $88888888       ; t3 = (t1 ^ t2) & 0x88888888
   ! add   eax, esi             ; x + y + t3
   ! shr   esi, 2               ; t3 >> 2
   ! sub   eax, esi             ; x + y + t3 - (t3 >> 2)

   ! sub   edx, ebx             ; propagate carry
   ! mov   esi, edx             ; x
   ! lea   edi, [edx+$66666666] ; x + 0x66666666
   ! xor   esi, ecx             ; x ^ y
   ! add   edx, ecx             ; x + y
   ! shr   esi, 1               ; t1 = (x ^ y) >> 1
   ! add   edi, ecx             ; x + y + 0x66666666
   ;;sbb   esi, esi             ; capture carry
   ! rcr   edi, 1               ; t2 = (x + y + 0x66666666) >> 1
   ! xor   esi, edi             ; t1 ^ t2
   ! and   esi, $88888888       ; t3 = (t1 ^ t2) & 0x88888888
   ! add   edx, esi             ; x + y + t3
   ! shr   esi, 2               ; t3 >> 2
   ! sub   edx, esi             ; x + y + t3 - (t3 >> 2)
        
   ; here EDX:EAX = sum

   ! mov   edi, [p.p_z]
   ! mov   [edi], eax
   ! mov   [edi+4], edx 
EndProcedure

Procedure add2(*z.bcd64, *x.bcd64, *y.bcd64)

   ; by Norbert Juffa
   ! mov   esi,[p.p_x]
   ! mov   edi,[p.p_y]
   ! mov   eax, [esi]   ; x (lo)
   ! mov   ebx, [edi]   ; y (lo)

   ! mov   esi, eax             ; x
   ! lea   edi, [eax+$66666666] ; x + 0x66666666
   ! xor   esi, ebx             ; x ^ y
   ! add   eax, ebx             ; x + y
   ! shr   esi, 1               ; t1 = (x ^ y) >> 1
   ! add   edi, ebx             ; x + y + 0x66666666
   ! sbb   ebx, ebx             ; capture carry
   ! rcr   edi, 1               ; t2 = (x + y + 0x66666666) >> 1
   ! xor   esi, edi             ; t1 ^ t2
   ! and   esi, $88888888       ; t3 = (t1 ^ t2) & 0x88888888
   ! add   eax, esi             ; x + y + t3
   ! shr   esi, 2               ; t3 >> 2
   ! sub   eax, esi             ; x + y + t3 - (t3 >> 2)

   ! mov   esi, [p.p_z]
   ! mov   [esi], eax
   ! mov   esi,[p.p_x]
   ! mov   edi,[p.p_y]
   ! mov   eax, [esi+4] ; x (hi)
   ! sub   eax, ebx             ; propagate carry
   ! mov   ebx, [edi+4] ; y (hi)
   ! mov   esi, eax             ; x
   ! lea   edi, [eax+$66666666] ; x + 0x66666666
   ! xor   esi, ebx             ; x ^ y
   ! add   eax, ebx             ; x + y
   ! shr   esi, 1               ; t1 = (x ^ y) >> 1
   ! add   edi, ebx             ; x + y + 0x66666666
   ! sbb   ebx, ebx             ; capture carry
   ! rcr   edi, 1               ; t2 = (x + y + 0x66666666) >> 1
   ! xor   esi, edi             ; t1 ^ t2
   ! and   esi, $88888888       ; t3 = (t1 ^ t2) & 0x88888888
   ! add   eax, esi             ; x + y + t3
   ! shr   esi, 2               ; t3 >> 2
   ! sub   eax, esi             ; x + y + t3 - (t3 >> 2)


   ! mov   edi, [p.p_z]
   ! mov   [edi+4], eax 
EndProcedure

Procedure add3(*z.bcd128, *x.bcd128, *y.bcd128)
   bug.l

   ; by Norbert Juffa
   ! mov   esi,[p.p_x]
   ! mov   edi,[p.p_y]
   ! mov   eax, [esi]   ; x (lo)
   ! mov   ebx, [edi]   ; y (lo)

   ! mov   esi, eax             ; x
   ! lea   edi, [eax+$66666666] ; x + 0x66666666
   ! xor   esi, ebx             ; x ^ y
   ! add   eax, ebx             ; x + y
   ! shr   esi, 1               ; t1 = (x ^ y) >> 1
   ! add   edi, ebx             ; x + y + 0x66666666
   ! sbb   ebx, ebx             ; capture carry
   ! rcr   edi, 1               ; t2 = (x + y + 0x66666666) >> 1
   ! xor   esi, edi             ; t1 ^ t2
   ! and   esi, $88888888       ; t3 = (t1 ^ t2) & 0x88888888
   ! add   eax, esi             ; x + y + t3
   ! shr   esi, 2               ; t3 >> 2
   ! sub   eax, esi             ; x + y + t3 - (t3 >> 2)

   ! mov   esi, [p.p_z]
   ! mov   [esi], eax
   ! mov   esi,[p.p_x]
   ! mov   edi,[p.p_y]
   ! mov   eax, [esi+4] ; x (hi)
   ! sub   eax, ebx             ; propagate carry
;! mov [p.v_bug],eax
   ! mov   ebx, [edi+4] ; y (hi)
   ! mov   esi, eax             ; x
   ! lea   edi, [eax+$66666666] ; x + 0x66666666
   ! xor   esi, ebx             ; x ^ y
   ! add   eax, ebx             ; x + y
   ! shr   esi, 1               ; t1 = (x ^ y) >> 1
   ! add   edi, ebx             ; x + y + 0x66666666
   ! sbb   ebx, ebx             ; capture carry
   ! rcr   edi, 1               ; t2 = (x + y + 0x66666666) >> 1
   ! xor   esi, edi             ; t1 ^ t2
   ! and   esi, $88888888       ; t3 = (t1 ^ t2) & 0x88888888
   ! add   eax, esi             ; x + y + t3
! mov [p.v_bug],eax
   ! shr   esi, 2               ; t3 >> 2
   ! sub   eax, esi             ; x + y + t3 - (t3 >> 2)


   ! mov   esi, [p.p_z]
   ! mov   [esi+4], eax
   ! mov   esi,[p.p_x]
   ! mov   edi,[p.p_y]
   ! mov   eax, [esi+8] ; x (hi)
   ! sub   eax, ebx             ; propagate carry
   ! mov   ebx, [edi+8] ; y (hi)
   ! mov   esi, eax             ; x
   ! lea   edi, [eax+$66666666] ; x + 0x66666666
   ! xor   esi, ebx             ; x ^ y
   ! add   eax, ebx             ; x + y
   ! shr   esi, 1               ; t1 = (x ^ y) >> 1
   ! add   edi, ebx             ; x + y + 0x66666666
   ! sbb   ebx, ebx             ; capture carry
   ! rcr   edi, 1               ; t2 = (x + y + 0x66666666) >> 1
   ! xor   esi, edi             ; t1 ^ t2
   ! and   esi, $88888888       ; t3 = (t1 ^ t2) & 0x88888888
   ! add   eax, esi             ; x + y + t3
   ! shr   esi, 2               ; t3 >> 2
   ! sub   eax, esi             ; x + y + t3 - (t3 >> 2)


   ! mov   edi, [p.p_z]
   ! mov   [edi+8], eax 
   ProcedureReturn bug
EndProcedure

Define.bcd64 x,y,z
Define.bcd128 a,b,c
bug.l

x\lo=$99999999
x\hi=$9999999

y\lo=$99999999
y\hi=$9999999

add1(z,x,y)

Debug("add1 = "+Hex(z\hi)+","+RSet(Hex(z\lo), 8, "0"))

add2(z,x,y)

Debug("add2 = "+Hex(z\hi)+","+RSet(Hex(z\lo), 8, "0"))

b\bcd[0]=$99999999
b\bcd[1]=$99999999
b\bcd[2]=$9999999

c\bcd[0]=$99999999
c\bcd[1]=$99999999
c\bcd[2]=$9999999

bug=add3(a,b,c)

Debug("bug = "+Hex(bug))

Debug("add3 = "+Hex(a\bcd[2])+","+RSet(Hex(a\bcd[1]), 8, "0")+","+RSet(Hex(a\bcd[0]), 8, "0"))

Posted: **Tue Jul 17, 2007 9:54 pm**

pdwyer wrote:Nice. Simple. Effective ( just needs to swap P and J with vars with more meaning)

Here's a slight speedup of 5%, and some added meaning

Code: Select all

Procedure.s MultiplyBig(factor_1$,factor_2$) ;returns Prod$ as factor_1$*factor_2$, factors can have leading zeroes and be negative
  
  Protected n.l,len_factor_1.l,len_factor_2.l
  
  len_factor_1=Len(factor_1$)
  len_factor_2=Len(factor_2$)
  If len_factor_2>len_factor_1 ;make it so larger# is always factor_1
    Swap factor_1$,factor_2$
    Swap len_factor_1,len_factor_2
  EndIf
  n=len_factor_1
  
  Protected n_2.l=n*2
  Protected Dim factor_1.l(n)
  Protected Dim factor_2.l(n)
  Protected Dim prod.l(n_2)
  Protected Prod$,I.l,J.l,s.l,temp.l
  
  For I = 1 To n ;convert #'s
    factor_1(I) = Val(Mid(factor_1$,I,1))
  Next I
  
  For I = n - len_factor_2 + 1 To n ;convert #'s
    factor_2(I) = Val(Mid(factor_2$,I + len_factor_2 - n,1))
  Next I 
  
  For I = n - len_factor_2 + 1 To n ;digit# for factor_1
    For J = n To 1 Step -1 ;digit# for factor_2
      prod(I + J) + factor_1(J) * factor_2(I)
    Next J
  Next I
  
  For I = n_2 To 1 Step -1 ;digits# of product
    temp=Int(prod(I) / 10) ;=carry
    prod(I - 1) + temp ;add to next place value
    prod(I) - 10 * temp  ;subtract from previous place value
  Next I
  
  For I = 1 To n_2 ;digits# of product
    If prod(I) >0 ;find first non-zero digit
      Break
    EndIf
  Next I
  
  If FindString(factor_1$,"-",1) ;get sign of factor_1
    s=1
  EndIf
  
  If FindString(factor_2$,"-",1) ;combine with sign of factor_2
    s ! 1
  EndIf
  
  If s=1  ;=sign will be negative
    Prod$="-"
  EndIf
  
  For J = I To n_2 ;digits# of product
    Prod$ + Str(prod(J))
  Next J
  
  ProcedureReturn Prod$
EndProcedure


F1$="-123456789098765432198765432123456789"
F2$="5555555556666666666777777777777777778765434567654" 
P$=MultiplyBig(F1$, F2$)

Debug P$

Posted: **Wed Jul 18, 2007 1:06 am**

Took a couple of loops out of Demivec's code:

Edit: Code removed. See next two messages I posted.

Posted: **Wed Jul 18, 2007 1:14 am**

I just realized that taking out the second loop that I did is likely to reduce performance -- it probably would have usually found the first non-zero number very quickly.

Posted: **Wed Jul 18, 2007 1:32 am**

Maybe this is better...

Code: Select all

Procedure.s MultiplyBig(factor_1$,factor_2$) ;returns Prod$ as factor_1$*factor_2$, factors can have leading zeroes and be negative
 
  Protected n.l,len_factor_1.l,len_factor_2.l
 
  len_factor_1=Len(factor_1$)
  len_factor_2=Len(factor_2$)
  If len_factor_2>len_factor_1 ;make it so larger# is always factor_1
    Swap factor_1$,factor_2$
    Swap len_factor_1,len_factor_2
  EndIf
  n=len_factor_1
 
  Protected n_2.l=n*2
  Protected Dim factor_1.l(n)
  Protected Dim factor_2.l(n)
  Protected Dim prod.l(n_2)
  Protected Prod$,I.l,J.l,s.l,temp.l
 
  For I = 1 To n ;convert #'s
    factor_1(I) = Val(Mid(factor_1$,I,1))
  Next I
 
  For I = n - len_factor_2 + 1 To n ;digit# for factor_1
    factor_2(I) = Val(Mid(factor_2$,I + len_factor_2 - n,1))
    For J = n To 1 Step -1 ;digit# for factor_2
      prod(I + J) + factor_1(J) * factor_2(I)
    Next J
  Next I
 
  For I = n_2 To (n - len_factor_2 + 2) Step -1 ;digits# of product
    temp=Int(prod(I) / 10) ;=carry
    prod(I - 1) + temp ;add to next place value
    prod(I) - 10 * temp  ;subtract from previous place value
  Next I
 
  For I = (n - len_factor_2 + 1) To n_2 ;digits# of product
    If prod(I) >0 ;find first non-zero digit
      Break
    EndIf
  Next I 
  
  If FindString(factor_1$,"-",1) ;get sign of factor_1
    s=1
  EndIf
 
  If FindString(factor_2$,"-",1) ;combine with sign of factor_2
    s ! 1
  EndIf
 
  If s=1  ;=sign will be negative
    Prod$="-"
  EndIf
 
  For J = I To n_2 ;digits# of product
    Prod$ + Str(prod(J))
  Next J
 
  ProcedureReturn Prod$
EndProcedure


F1$="-123456789098765432198765432123456789"
F2$="5555555556666666666777777777777777778765434567654"
P$=MultiplyBig(F1$, F2$)

Debug P$

Posted: **Wed Jul 18, 2007 1:59 am**

Michael Vogel wrote:Hmm pdwyer,

seems that none of our routines is extremly fast, and I fear, there are still some issues (when testing your code, I didn't see the first cipher "3" in the result of Test 1, my "BCD" version seems to get crazy with very long numbers in Test 2 etc.)

Michael

PS
who ever "invented" these funny numbers, I'll use them (1000 times) now for speed testing and call it Test 1:
result=43534253452345234532452352352357890808907890 * 89707890759830658903859036890436905489650

Test 2 starts with result=2 and multiply (15 times) result=result * result which should have a nice long number with 9865 ciphers at the end (my first string variante is ok, but the new BCD version fails)...

Actually, I thought these were okay. The strings are gone except in import and display.

I haven't worked at a bit level much in PB but perhaps getting rid of BCD for traditional bitwise arithmatic could be faster and look into making the calculations like a CPU does them but it would harder to code and support (let alone understand).

I thought we were doing pretty well

I have an idea to speed my original code up and get rid of the temp arrays but I'm still not sure I can touch Demivec.

How much faster does it need to be?

Posted: **Wed Jul 18, 2007 8:57 am**

pdwyer wrote:
I thought we were doing pretty well

I have an idea to speed my original code up and get rid of the temp arrays but I'm still not sure I can touch Demivec.

How much faster does it need to be?

Hi pdwyer,
you're right, we're coding not really bad

On the other hand, some simple math programs are able to multiply (at least) 20 times faster than our routines, so I think, there must be a totally different approach also... (which I have not found, of course

)

I thought, my code is so slow because of the usage of the funvtions mul, div and mod - so I made up a new version without any of these "complicate" things, it only contains add and sub inside

And it is slow as before

(or, lets say it more positive: it is not faster

)

Code: Select all

Procedure.s MulInt(a.s,b.s)

		If (a="0") Or (b="0")
			ProcedureReturn "0"
		EndIf
		
		Protected n
		Protected z
		Protected mul.s

		Protected la=Len(a)
		Protected lb=Len(b)
		Protected lc
		
		If la>lb
			Swap la,lb
			Swap a,b
		EndIf
		
		Protected Dim R(la+lb)
		Protected Dim N(lb,9)

		n=lb
		While n
			n-1
			N(n+1,1)=PeekB(@b+n)-'0'
		Wend
		
		For z=2 To 9
			n=lb
			While n
				N(n,z)+N(n,1)+N(n,z-1)
				If N(n,z)>9
					N(n,z)-10
					N(n-1,z)+1
				EndIf
				n-1
			Wend
			N(0,z)+N(0,z-1)
		Next z

		Repeat
			la-1
			z=(PeekB(@a+la)-'0')
			If z
				lb=Len(b)
				lc=la+lb		
				Repeat
					R(lc)+N(lb,z)
					If R(lc)>9
						R(lc)-10
						R(lc-1)+1
					EndIf
					lb-1
					lc-1
				Until lb=0
				R(la)+N(0,z)
			EndIf

		Until la=0

		If R(0)=0 : la=1 : EndIf
	
		lb=Len(a)+Len(b)
		While la<lb
			mul+Chr(R(la)+'0')
			la+1
		Wend

		ProcedureReturn mul
		
	EndProcedure

Posted: **Wed Jul 18, 2007 2:46 pm**

Ok, here's my last optimisation, more than this and I need a rewrite from scratch. It's still not the fastest but it's nearly as good (and quite a bit faster than my old one). The code is a lot cleaner and shorter than my last and the temp rubbish is gone.

From my last code, just replace this function

Code: Select all

Procedure BigMultiply(*Num1.Digits, *Num2.Digits, *Answer.Digits)

    carry.l = 0
    
    ;multiply
    For L1.l = 0 To *Num1\InUse -1
        For L2.l = 0 To *Num2\InUse
            *Answer\Digit[L2 + L1] + (*Num1\Digit[L1] * *Num2\Digit[L2]) + carry
            carry = Int(*Answer\Digit[L2 + L1] / 10)  ;int()
            *Answer\Digit[L2 + L1] = *Answer\Digit[L2 + L1] % 10  
        Next
        carry = 0
    Next
       
    ; set size
    If *Answer\Digit[*Num1\InUse + *Num2\InUse] = 0
        *Answer\InUse = *Num1\InUse + *Num2\InUse - 1
    Else
        *Answer\InUse = *Num1\InUse + *Num2\InUse
    EndIf

EndProcedure

Posted: **Wed Jul 18, 2007 4:00 pm**

For fun and test an assembler-example with BCD´s:

Code: Select all

Global ZF1.l 
Global ZF2.l 
Global ZP.l 
Global F1L.l 
Global F2L.l 
Global MEMP.l 
Global LP.l 
Global MZ.l 
Global ESICH.l 
Global BSICH.l 
Global LKLEIN.l 

Global X1.b 

F1$="5555555556666666666777777777777777778765434567654"  ;Not Unicode! Without signum for this test 
F2$="123456789098765432198765432123456789" 

;F1$="43534253452345234532452352352357890808907890" 
;F2$="89707890759830658903859036890436905489650" 

F1L=Len(F1$) 
F2L=Len(F2$) 

If F1L<F2L 
   LP=2*F2L 
   MZ=F2L 
   LKLEIN=F1L 
   ZF1=@F2$                  ;pointer 
   ZF2=@F1$ 
   Swap F1L,F2L 
 Else 
   LP=2*F1L 
   MZ=F1L 
   LKLEIN=F2L 
   ZF1=@F1$                  ;pointer 
   ZF2=@F2$ 
EndIf 

MEMP=AllocateMemory(LP)      ;for product 

!MOV esi,[v_ZF1]             ;string1 
!ADD esi,[v_F1L] 
!DEC esi 
!MOV [v_ESICH],esi 
!MOV edi,[v_ZF2]             ;string2 
!ADD edi,[v_F2L] 
!DEC edi 
!MOV ebx,[v_MEMP]            ;product 
!ADD ebx,[v_LP] 
!DEC ebx 
!MOV [v_BSICH],ebx 
                    
!XOR dh,dh 
!MOV ecx,[v_MZ]      

!MOV dl,[edi] 
!SUB dl,30h 

;------------------------------------------------ 
!@@: 
!MOV al,[esi] 
!SUB al,30h 
!MUL dl                      ;AH=0 
!AAM 
!ADD al,dh 
!AAA 
!MOV dh,[ebx] 
!ADD al,dh 
!AAA 
!MOV byte[ebx],al 
!MOV dh,ah 

!DEC esi 
!DEC ebx 
!DEC ecx 
!JNZ @b 
;-------- 

!ADD [ebx],ah                ;rest 

!DEC [v_LKLEIN]              ;test for end 
!JZ @f 

!XOR dh,dh 
!MOV ecx,[v_MZ]              
!DEC edi                     ;new 2.cipher 
!MOV dl,[edi] 
!SUB dl,30h 
!MOV esi,[v_ESICH] 
!MOV ebx,[v_BSICH]           ;product 
!DEC ebx 
!MOV [v_BSICH],ebx 
!JMP @b 
;------------------------------------------------ 
 
;-------- DISPLAY
!@@:
!MOV esi,[v_MEMP] 
!MOV ecx,[v_LP] 
!@@: 
!MOV al,[esi] 
!OR al,al 
!JNZ @f 
!INC esi 
!DEC ecx 
!JMP @b 

!@@: 
!MOV al,[esi]                ;evtl. doppelt, na ja... ;-) 
!MOV [v_X1],al 
!PUSH esi 
!PUSH ecx 
P$+Str(X1) 
!POP ecx 
!POP esi 
!INC esi 
!DEC ecx 
!JNZ @b 
;-------- 
  
MessageRequester("BCD-Multiply", P$)

Gruss
Helle

Posted: **Thu Jul 19, 2007 8:52 am**

As test-procedure:

Code: Select all

Procedure.s Mul_BCD(Fac1$, Fac2$)
Global ZF1.l
Global ZF2.l
Global F1L.l
Global F2L.l
Global MEMP.l
Global LP.l
Global ESICH.l
Global BSICH.l
Global LGROSS.l
Global LKLEIN.l
Global DIGIT.l

Global X1.b

F1L=Len(Fac1$)
F2L=Len(Fac2$)
Global Prod$=""

If F1L<F2L
   ZF1=@Fac2$                ;pointer
   ZF2=@Fac1$ 
   Swap F1L,F2L
 Else
   ZF1=@Fac1$                ;pointer
   ZF2=@Fac2$
EndIf

LP=2*F1L
LGROSS=F1L 
LKLEIN=F2L

MEMP=AllocateMemory(LP)      ;for product

!MOV esi,[v_ZF1]             ;string1
!MOV dl,43                   ;"+"
!MOV al,[esi]                ;test for signum
!CMP al,45                   ;"-"
!JA @f                       ;no signum
!DEC [v_LGROSS]
!MOV dl,al
!@@:
!ADD esi,[v_F1L]
!DEC esi
!MOV [v_ESICH],esi

!MOV edi,[v_ZF2]             ;string2
!MOV dh,43                   ;"+"
!MOV al,[edi]                ;test for signum
!CMP al,45                   ;"-"
!JA @f                       ;no signum
!DEC [v_LKLEIN]
!MOV dh,al
!@@:
!ADD dl,dh
!CMP dl,88                   ;43="+", 45="-"
!JNE @f
!PUSH edi
!PUSH esi
Prod$="-"
!POP esi
!POP edi
!@@:
!ADD edi,[v_F2L]
!DEC edi

!MOV ebx,[v_MEMP]            ;product
!ADD ebx,[v_LP]
!DEC ebx
!MOV [v_BSICH],ebx
                   
!XOR dh,dh
!MOV ecx,[v_LGROSS]     

!MOV dl,[edi]
!SUB dl,30h
;------------------------------------------------
 
!@@:
!MOV al,[esi]
!SUB al,30h
!MUL dl                      ;AH=0
!AAM 
!ADD al,dh
!AAA                         ;z.B. 199999*123459
!MOV dh,[ebx]
!ADD al,dh
!AAA
!MOV byte[ebx],al
!MOV dh,ah

!DEC esi
!DEC ebx
!DEC ecx
!JNZ @b
;--------

!ADD [ebx],ah                ;rest

!DEC [v_LKLEIN]              ;test for end
!JZ @f

!XOR dh,dh
!MOV ecx,[v_LGROSS]              
!DEC edi                     ;new 2.cipher
!MOV dl,[edi]
!SUB dl,30h
!MOV esi,[v_ESICH]
!MOV ebx,[v_BSICH]           ;product
!DEC ebx
!MOV [v_BSICH],ebx
!JMP @b
;------------------------------------------------

;-------- result in string
!@@:
!MOV [v_DIGIT],0
!MOV esi,[v_MEMP]
!MOV ecx,[v_LP]
!@@:
!MOV al,[esi]
!OR al,al
!JNZ @f
!INC esi
!DEC ecx
!JMP @b

!@@:
!MOV al,[esi]                ;evtl. doppelt, na ja... ;-)
!MOV [v_X1],al
!PUSH esi
!PUSH ecx
Prod$+Str(X1)
!POP ecx
!POP esi
!INC [v_DIGIT]
!INC esi
!DEC ecx
!JNZ @b
;--------

FreeMemory(MEMP)
  ProcedureReturn Prod$
EndProcedure 

;Numbers (strings) and test from Micheal Vogel (1000 --> 10000)
Global F1$="43534253452345234532452352352357890808907890"  ;Not Unicode!
Global F2$="89707890759830658903859036890436905489650"

TA = ElapsedMilliseconds()
For i = 1 To 10000             ;1000 is too little! 
  P$ = Mul_BCD(F1$, F2$)
Next
TE = ElapsedMilliseconds() - TA

MessageRequester("BCD-Multiply, Test1", P$ + #LFCR$ + "Time : " + Str(TE) + " ms" + #LFCR$ + "Digits : " + Str(DIGIT)) 

Global F3$ = "2"

TA = ElapsedMilliseconds()
  P$ = Mul_BCD(F3$, F3$)
For i = 1 To 14
  P$ = Mul_BCD(P$, P$)
Next
TE = ElapsedMilliseconds() - TA

MessageRequester("BCD-Multiply, Test2", Mid(P$, 2500, DIGIT-2499) + #LFCR$ + "Time : " + Str(TE) + " ms" + #LFCR$ + "Digits : " + Str(DIGIT)) 
;MID because of (my) screen ;-)!  

If OpenWindow(0, 0, 0, 960, 700, "BCD-Multiply, Test2", #PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
    EditorGadget(0, 8, 10, 940, 680)
      q=1
      For z = 1 To (DIGIT / 150) + 1
        AddGadgetItem(0, z, Mid(P$, q, 150))
      q+150
      Next 
     
      z+1
      AddGadgetItem(0, z, "Time : " + Str(TE) + " ms")
      z+1
      AddGadgetItem(0, z, "Digits : " + Str(DIGIT))    
    Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

End

Gruss
Helle

Edit: MID-parameter; 19.07.2007
Edit2: Add EditorGadget; 19.07.2007

Posted: **Thu Jul 19, 2007 1:54 pm**

Instead of thinking 'bout puzzles from Project Euler I tried oncemore to write a fast multiplier - the last idea (see posts before) was eleminating all higher order functions (mul, div and mod) from my multiply-procedure, but the result was really bad.

Now I have now a totally different approach - and its quite fast (50.000 multiplications in a second

- even faster than the BCD assembler approach)

So I would be satisfied, but of course it's not perfect:
- it has no possibility for changing the number length dynamically
- I've a bug in the GetNumber procedure which does not put the string to the pointer (still have not understood the pointer games

)

Michael

Code: Select all

; Define VNF - Vogels Number Format

	#VNFDim=55; ~500 Ziffern

	#VNFLen=9
	#VNFMod=1000000000

	Structure VNF
		len.w
		sign.w
		num.l[#VNFDim]
	EndStructure

; EndDefine

Procedure PutNumber(*s.s,*num.VNF)

	Protected n,p
	Protected t.s

	*num\sign=0

	t=PeekS(@*s)
	n=Len(t)-#VNFLen

	While n>0
		*num\num[p]=Val(PeekS(@t+n,#VNFLen))
		p+1
		n-#VNFLen
	Wend

	n=Val(PeekS(@t,9+n))
	If n<0
		*num\sign=-1
		n=-n
	EndIf

	*num\num[p]=n

	*num\len=p

EndProcedure
Procedure GetNumber(*s.s,*num.VNF)
	Protected n
	Protected t.s

	If *num\sign
		t="-"
	EndIf

	n=*num\len
	t+Str(*num\num[n])

	While n>0
		n-1
		t+RSet(Str(*num\num[n]),#VNFLen,"0")
	Wend

	*s=t;	Does not work!!!!

EndProcedure
Procedure.s Number(*num.VNF)

	Protected n
	Protected t.s

	If *num\sign
		t="-"
	EndIf

	n=*num\len
	t+Str(*num\num[n])

	While n>0
		n-1
		t+RSet(Str(*num\num[n]),#VNFLen,"0")
	Wend

	ProcedureReturn t

EndProcedure

Procedure VNFMul(*a.VNF,*b.VNF,*c.VNF)

	Protected la
	Protected lb
	Protected n

	Protected s.q
	Protected z.q

	*c\sign=-(*a\sign * *b\sign)
	*c\len=*a\len+*b\len+1
	For n=0 To *c\len
		*c\num[n]=0
	Next n

	la=0
	Repeat
		lb=0
		z=*b\num[lb]
		Repeat
			s=*a\num[la] * *b\num[lb] + *c\num[la+lb]
			;Debug Str(*a\num[la])+" * "+Str(*b\num[lb])+" + "+Str(*c\num[la+lb+1])
			;Debug " = "+StrQ(s)+"  -> "+Str(s/#VNFMod)+" | "+Str(s%#VNFMod)
			*c\num[la+lb]=s%#VNFMod
			*c\num[la+lb+1]+s/#VNFMod
			lb+1
		Until lb>*b\len
		la+1
	Until la>*a\len
	
	If *c\num[*c\len]=0
		*c\len-1
	EndIf

EndProcedure


zahl1.s="123456789098765432198765432123456789"
zahl2.s="5555555556666666666777777777777777778765434567654"

num1.VNF
num2.VNF
num3.VNF

PutNumber(@zahl1,@num1)
PutNumber(@zahl2,@num2)

n=10000
t1=-GetTickCount_()
For i=1 To n
	VNFMul(@num1,@num2,@num3)
Next i
t1+GetTickCount_()

MessageRequester("Not so bad - "+Str(t1)+" ms for "+Str(n)+" multiplications",Number(@num1)+" x "+Number(@num2)+" = "+#LF$+Number(@num3))

; But here's something wrong, I can't get the Number back to a string...

zahl3.s
GetNumber(@zahl3,@num1)
Debug zahl3

Posted: **Thu Jul 19, 2007 2:32 pm**

The original string is empty. if you set it to:

Code: Select all

zahl3.s = "                                              "

it should work (or the length of the string to fill it with)

does seem a little odd, perhaps I'm missing something too, PB is still new to me

Posted: **Thu Jul 19, 2007 2:42 pm**

If you put a "Debug *s" in the procedure you get the right string. I don't why its address isn't the same as the address of zahl3.

PureBasic Forums - English

Huge #'s