Results 1 to 4 of 4

Thread: something wrong

  1. #1
    thinBasic MVPs danbaron's Avatar
    Join Date
    Jan 2010
    Location
    California
    Posts
    1,378
    Rep Power
    152

    something wrong

    '
    '====================
    '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()
    
    "You can't cheat an honest man. Never give a sucker an even break, or smarten up a chump." - W.C.Fields

  2. #2
    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

  3. #3
    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

  4. #4
    thinBasic MVPs danbaron's Avatar
    Join Date
    Jan 2010
    Location
    California
    Posts
    1,378
    Rep Power
    152
    Thanks Charles.

    I have to wait.

    It's late here.

    But, I'm on the trail.

    Dan

    "You can't cheat an honest man. Never give a sucker an even break, or smarten up a chump." - W.C.Fields

Members who have read this thread: 0

There are no members to list at the moment.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •