' Fixed point integer calculation - J.L. Bezemer 2021, 2022

' SIN, COS, TAB, SQRT, LN, EXP and RND subroutines
' Numbers have to be scaled by 10K before conversion.

' ** NOTE: it requires a 64-bit uBasic; number ranges are limited. **

If Info("wordsize") < 64 Then Print "This program requires a 64-bit uBasic" : End

' Show SIN, COS and TAN values between 0 and PI

Print "Val";Tab(10);"Sin";Tab(20);"Cos";Tab(30);"Tan"

For x = 0 To 12
  z = FUNC(_Fdiv((31416 * x), 120000))
  Proc _Fprint(z)
  Print Tab(10); : Proc _Fprint(FUNC(_Fsin(z)))
  Print Tab(20); : Proc _Fprint(FUNC(_Fcos(z)))
  Print Tab(30); : Proc _Fprint(FUNC(_Ftan(z)))
  Print
Next

' Show SQRT values between 0 and 12

Print
Print "Val";Tab(15);"Sqrt"

For x = 0 To 12
  z = FUNC(_Itof(x*10000))
  Proc _Fprint(z)
  Print Tab(15); : Proc _Fprint(FUNC(_Fsqrt(z)))
  Print
Next

' Show LN values between 0.25 and 3.75, interval 0.25

Print
Print "Val";Tab(15);"Ln1"

For x = 1 To 15
  z = FUNC(_Itof(x*2500))
  Proc _Fprint(z)
  Print Tab(15); : Proc _Fprint(FUNC(_Fln(z)))
  Print
Next

' Show LN values between 2^1 and 2^15, powers of 2

Print : Push 2                         ' use the stack
Print "Val";Tab(15);"Ln2"

For x = 0 To 14
  z = FUNC(_Itof(Tos()*10000))
  Proc _Fprint(z)
  Print Tab(15); : Proc _Fprint(FUNC(_Fln(z)))
  Print : Push Pop()*2
Next : x = Pop()                       ' discard value on stack

' Show EXP values between -1.25 and 2.5, interval 0.25

Print
Print "Val";Tab(15);"Exp1"

For x = -6 To 10
  z = FUNC(_Itof(x*2500))
  Proc _Fprint(z)
  Print Tab(15); : Proc _Fprint(FUNC(_Fexp(z)))
  Print
Next

' Show EXP values between -6 and 10, interval 1

Print
Print "Val";Tab(15);"Exp2"

For x = -6 To 10
  z = FUNC(_Itof(x*10000))
  Proc _Fprint(z)
  Print Tab(15); : Proc _Fprint(FUNC(_Fexp(z)))
  Print
Next

' Show first 10 random numbers

Print
Print "Random" : Proc _Frand(1)        ' set random seed
For x = 1 To 10
  Proc _Fprint(FUNC(_Frnd)) : Print
Next

End

' ***********************
' Fixed point subroutines
' ***********************

' Fpi      - returns fixed point PI
' Frand    - sets random seed
' Frnd     - returns random fixed point number
' Fmul     - returns a*b
' Fdiv     - returns a/b (also: converts fraction to fixed point)
' Ftoi     - converts fixed point to integer
' Itof     - converts integer to fixed point
' Fprint   - print fixed point
' Fint     - returns integer part from fixed point
' Fsqrt    - returns square root
' Fsin     - returns sine
' Fcos     - returns cosine
' Ftan     - returns tangent
' Fln      - returns natural log
' Fexp     - returns natural exponent

_Fpi Return (51472)                    ' properly rounded
_Frand Param (1) : o = a@ : Return
_Frnd Return (FUNC(_Fdiv(Set(o, (((o+1)*75)-1)%65537), 65536)))
_Fmul Param (2) : Return ((a@*b@)/16384)
_Fdiv Param (2) : Return ((a@*16384)/b@)
_Ftoi Param (1) : Return ((10000*a@)/16384)
_Itof Param (1) : Return ((16384*a@)/10000)
_Fprint Param (1) : a@ = FUNC(_Ftoi(a@)) : Print Using "+?.####";a@; : Return
_Fint Param (1) : Return (FUNC(_Itof((FUNC(_Ftoi(a@))/10000)*10000)))
_Fsqrt Param (1) : Return (FUNC(_Itof(FUNC(_Sqrt(FUNC(_Ftoi(a@))*10000)))))
_Fln Param (1) : Return (FUNC(_Ln(a@*4))/4)
_Fsin Param (1) : Return (FUNC(_Itof(FUNC(_SIN(FUNC(_Ftoi(a@)))))))
_Fcos Param (1) : Return (FUNC(_Itof(FUNC(_COS(FUNC(_Ftoi(a@)))))))

_Ftan
  Param (1) : a@ = FUNC(_Ftoi(a@))
Return (FUNC(_Fdiv(FUNC(_SIN(a@)), FUNC(_COS(a@)))))

_Fexp
  Param (1)
  Local (1)

  b@ = FUNC(_Exp (abs(a@) * 4))
  If a@<0 Then Return (1073741824/b@)
Return (b@/4)

_Sqrt
  Param (1)
  Local (3)

  Let b@ = 1
  Let c@ = 0

  Do Until b@ > a@
    Let b@ = b@ * 4
  Loop

  Do While b@ > 1
    Let b@ = b@ / 4
    Let d@ = a@ - c@ - b@
    Let c@ = c@ / 2
    If d@ > -1 Then
      Let a@ = d@
      Let c@ = c@ + b@
    Endif
  Loop

Return (c@)

_SIN PARAM(1) : PUSH A@ : LET A@=TOS()<0 : PUSH ABS(POP()%62832)
     IF TOS()>31416 THEN A@=A@=0 : PUSH POP()-31416
     IF TOS()>15708 THEN PUSH 31416-POP()
     PUSH (TOS()*TOS())/10000 : PUSH 10000+((10000*-(TOS()/72))/10000)
     PUSH 10000+((POP()*-(TOS()/42))/10000)
     PUSH 10000+((POP()*-(TOS()/20))/10000)
     PUSH 10000+((POP()*-(POP()/6))/10000)  : PUSH (POP()*POP())/10000
     IF A@ THEN PUSH -POP()
     RETURN

_COS PARAM(1) : PUSH ABS(A@%62832) : IF TOS()>31416 THEN PUSH 62832-POP()
     LET A@=TOS()>15708 : IF A@ THEN PUSH 31416-POP()
     PUSH TOS() : PUSH (POP()*POP())/10000
     PUSH 10000+((10000*-(TOS()/56))/10000)
     PUSH 10000+((POP()*-(TOS()/30))/10000)
     PUSH 10000+((POP()*-(TOS()/12))/10000)
     PUSH 10000+((POP()*-(POP()/2))/10000) : IF A@ THEN PUSH -POP()
     RETURN

_Exp
  Param (1)
  Local (2)

  c@=65536
  b@=a@-363409 : If b@>-1 Then a@=b@ : c@=SHL(c@, 8)
  b@=a@-181704 : If b@>-1 Then a@=b@ : c@=SHL(c@, 4)
  b@=a@-90852  : If b@>-1 Then a@=b@ : c@=SHL(c@, 2)
  b@=a@-45426  : If b@>-1 Then a@=b@ : c@=SHL(c@, 1)
  b@=a@-26573  : If b@>-1 Then a@=b@ : c@=c@+SHL(c@, -1)
  b@=a@-14624  : If b@>-1 Then a@=b@ : c@=c@+SHL(c@, -2)
  b@=a@-7719   : If b@>-1 Then a@=b@ : c@=c@+SHL(c@, -3)
  b@=a@-3973   : If b@>-1 Then a@=b@ : c@=c@+SHL(c@, -4)
  b@=a@-2017   : If b@>-1 Then a@=b@ : c@=c@+SHL(c@, -5)
  b@=a@-1016   : If b@>-1 Then a@=b@ : c@=c@+SHL(c@, -6)
  b@=a@-510    : If b@>-1 Then a@=b@ : c@=c@+SHL(c@, -7)
  If (AND(a@, 256)) Then c@=c@+SHL(c@, -8)
  If (AND(a@, 128)) Then c@=c@+SHL(c@, -9)
  If (AND(a@, 64))  Then c@=c@+SHL(c@, -10)
  If (AND(a@, 32))  Then c@=c@+SHL(c@, -11)
  If (AND(a@, 16))  Then c@=c@+SHL(c@, -12)
  If (AND(a@, 8))   Then c@=c@+SHL(c@, -13)
  If (AND(a@, 4))   Then c@=c@+SHL(c@, -14)
  If (AND(a@, 2))   Then c@=c@+SHL(c@, -15)
  If (AND(a@, 1))   Then c@=c@+SHL(c@, -16)
Return (c@)

_Ln
  Param (1)
  Local (2)

  c@=681391
  If (a@<32768)      Then a@=SHL(a@, 16) : c@=c@-726817
  If (a@<8388608)    Then a@=SHL(a@, 8)  : c@=c@-363409
  If (a@<134217728)  Then a@=SHL(a@, 4)  : c@=c@-181704
  If (a@<536870912)  Then a@=SHL(a@, 2)  : c@=c@-90852
  If (a@<1073741824) Then a@=SHL(a@, 1)  : c@=c@-45426
  b@=a@+SHL(a@, -1) : If (AND(b@, 2147483648)) = 0 Then a@=b@ : c@=c@-26573
  b@=a@+SHL(a@, -2) : If (AND(b@, 2147483648)) = 0 Then a@=b@ : c@=c@-14624
  b@=a@+SHL(a@, -3) : If (AND(b@, 2147483648)) = 0 Then a@=b@ : c@=c@-7719
  b@=a@+SHL(a@, -4) : If (AND(b@, 2147483648)) = 0 Then a@=b@ : c@=c@-3973
  b@=a@+SHL(a@, -5) : If (AND(b@, 2147483648)) = 0 Then a@=b@ : c@=c@-2017
  b@=a@+SHL(a@, -6) : If (AND(b@, 2147483648)) = 0 Then a@=b@ : c@=c@-1016
  b@=a@+SHL(a@, -7) : If (AND(b@, 2147483648)) = 0 Then a@=b@ : c@=c@-510
  a@=2147483648-a@;
  c@=c@-SHL(a@, -15)
Return (c@)

