something wrong

**danbaron** · 30-08-2011, 06:33

'
'====================
'MONSTROUS ARITHMETIC
'====================

'THIS WORKS WITH THINBASIC V1.8.8.0
Uses "console" 
Uses "oxygen"        'compiler module
Dim src As String    'source code
Dim p0,p1,p2,p3 As Long 'function pointers

src="


'---------------------------------------------------------
function multiply(string ia, string ib) as string external
'=========================================================
dim as string a,b,c,d
dim as long pa,pb,pc,pd,la,lb,lc,ld
dim as long nd,sh,qa

a=ia
b=ib
la=len a
lb=len b
lc=la+lb'+10
ld=lc'+20
c=nuls lc 'LINE ACCUMULATOR
d=nuls ld 'BLOCK ACCUMULATOR
pa=*a
pb=*b
pc=*c
pd=*d


pushad



'SETUP POINTERS
'==============

mov esi,pa : add esi,la
mov edi,pb : add edi,lb
mov edx,pc : add edx,lc
mov ebx,pa


mov qa,esi 'RIGHT START POSITION FOR NUMBER A
mov nd,edi 'SETUP NEXT DIGIT POINTER (B NUMBER)
mov sh,edx 'SETUP POSITION SHIFT POINTER



'CONVERT FROM ASCII TO BINARY CODED DECIMAL
'==========================================


mov edi,pa
mov ecx,la
(
 dec ecx 
 jl exit
 sub byte [edi],48
 inc edi
 repeat
)
mov edi,pb
mov ecx,lb
(
 dec ecx : jl exit
 sub byte [edi],48
 inc edi
 repeat
)



nextline:
'========

'MULTIPLY BY ONE DIGIT
'WORKING FROM RIGHT TO LEFT

dec edi
mov cl,[edi]
mov ch,0
(
  dec esi
  cmp esi,ebx : jl exit
  mov al,[esi]
  mov ah,0
  mul cl
  add al,ch 'ADD CARRY VALUE
  mov ch,0  'CLEAR CARRY VALUE
  (
    cmp al,10
    jl exit   'NO CARRY
    mov ch,10 'DIVISOR
    div ch    '
    mov ch,al 'CARRY VAL IN CH
    mov al,ah 'REMAINDER NOW IN AL
  )
  dec edx
  mov [edx],al
  repeat
)
'FINAL CARRY
(
  cmp ch,0
  jz exit
  dec edx
  mov [edx],ch
)

'ADD TO BLOCK ACCUMULATOR
'========================

mov esi,pc : add esi,lc
mov edi,pd : add edi,ld
mov ah,0
mov ebx,pc


'BCD ADDITION
'
'WORKING FROM RIGHT TO LEFT

(
  dec esi
  cmp esi,ebx : jl exit
  dec edi
  mov al,0
  xchg al,[esi] 'LOAD AND THEN CLEAR LINE DIGIT
  mov cl,[edi]
  add al,ah 'PREVIOUS CARRY
  add al,cl 'OPERAND
  (
   mov ah,0
   cmp al,10 : jl exit
   sub al,10
   inc ah
  )
  mov [edi],al
  repeat
)


mov ebx,pa

mov esi,qa  'START POSITION FOR NUMBER A

mov edi,nd 'NEXT DIGIT IN NUMBER B
dec edi
mov nd,edi

cmp edi,pb : jle fwd done

'SHIFT OUTPUT TO LINE ACCUM

mov edx,sh
dec edx
mov sh,edx


jmp long nextline



done:



'CONVERT FROM BCD TO ASCII
'=========================


mov edi,pd
mov ecx,ld
add ecx,edi
(
 cmp edi,ecx : jge exit
 add byte [edi],48 : inc edi
 repeat
)



'TRIM LEADING ZEROS
'==================


mov edi,pd
mov ecx,ld
add ecx,edi
(
 cmp edi,ecx : jge exit
 mov al,[edi]
 inc edi
 cmp al,48 : jg exit
 repeat
)
sub edi,pd
mov nd,edi


popad

function=mid(d,nd,ld)

end function

'----------------------------------------------
function factorial(string a) as string external
'==============================================
sys factorial=val a
string b="1"
for i=1 to factorial
b=multiply(b,str(i))
next
function=b
end function

'----------------------------------------------------
function power(string x, string p) as string external
'----------------------------------------------------
string product = "1"
for i = 1 to val p
product = multiply(product,x)
next
function = product
end function

'--------------------
sub finish() external
'====================
  terminate
end sub



'map functions INTO thinBasic pointers
'=====================================

sys p0 at #p0=@finish 
sys p1 at #p1=@multiply
sys p2 at #p2=@factorial
sys p2 at #p3=@power


"

'compile the program
'===================

'MsgBox 0,O2_PREP src ': Stop
O2_ASMO src
If Len(O2_ERROR) Then
  MsgBox 0, O2_ERROR
  stop
Else
  O2_EXEC
End If


'setup header for thinBasic
'==========================

declare sub finish() at p0
declare function multiply(byval a as string, b as string) as string at p1
declare function factorial(byval a as string) as string at p2
Declare Function power(ByVal x As String, p As String) As String At p3


'test
'====

Dim As String n="1000"
Dim As String f
Dim T1, T2 As Quad
Dim As String x = "2"
Dim As String p = "3"
Dim As String v

'HiResTimer_Init
'T1 = HiResTimer_Get
'f = Factorial(n)
v = power(x,p)
'T2 = HiResTimer_Get
'MsgBox 0, Len(f) & $CRLF & $CRLF & Format$(T2-T1, "#0")& $CRLF & $CRLF & "Factorial: " & n & $CRLF & $CRLF & f 
PrintL v
v = multiply(x,p)
PrintL v
WaitKey
'release the compiled program
'============================

finish()

**Charles Pegge** · 30-08-2011, 07:04

There was a missing 'byval' on the second parameter for 'multiply'
and 'power'

Lines 269 ..

declare sub finish() at p0
declare function multiply(byval a as string, byval b as string) as string at p1
declare function factorial(byval a as string) as string at p2
Declare Function power(ByVal x As String, byval p As String) As String At p3

I should have checked it. Sorry.

Charles

**Charles Pegge** · 30-08-2011, 07:22

For slightly better performance, I would convert string p into an integer first, otherwise an expensive val(p) is executed on each iteration.

'----------------------------------------------------
function power(string x, string p) as string external
'====================================================
string product = "1"
sys power=val(p)
for i = 1 to power
product = multiply(product,x)
next
function = product
end function

Charles