added logical operators <, <=, ==, <>, >=, >
operator returns 0 for false and 1 for true.
Code:
Procedure.s eval(exprn$)
; placed in the public domain by tejon
;
;since you can't have procedures or subroutines inside a procedure
;(even tried CallFunctionFast(?GosubLabel) without success)
;we simulate Gosub and Return
;____________________________________________________________
;the following code simulates a Gosub
;1: it loads the effective address of the label right after the Gosub,
; the address is put into the gosub stack
;2: the stack pointer (eval_stk_index) is incremented
;3: jmp to sub-routine (you could use Goto here)
;Example:
;Gosub tokenize
;! MOV ebx,[eval_stk_index]
;! SAL ebx,2 ;multiply index by 4
;! MOV [ebx+gsubeval_stk],dword l_subeval2
;! inc dword [eval_stk_index]
;! JMP l_tokenize
;subeval2:
;____________________________________________________________
;this code simulates a return from gosub
;1: stack pointer (eval_stk_index) is decremented
;2: return address is put into ebx
;3: jmp to return address
;Example:
;! dec dword [eval_stk_index]
;! MOV eax,[eval_stk_index]
;! SAL eax,2
;! mov ebx,dword [eax+gsubeval_stk]
;! JMP ebx
;____________________________________________________________
;operators and functions supported:
;unary +,-
;+,-,*,/,^,! (! :factorial)
;____________________________________________________________
;operator precedence highest to lowest
;! (gamma(1+x) if fractional)
;^
;*,/
;unary +,-
;+,-
;logical: <, <=, ==, <>, >, >= returns 1 if comparison is true, 0 if false
;
;assignment: = ( as in a=2)
;and of course, parenthesis ().
;____________________________________________________________
;functions:
;sin,cos,tan,asin,acos,atan,sqrt,sqr,ln,exp,log,alog,sinh,cosh,tanh,asinh,acosh,atanh
;____________________________________________________________
;variables:
;A thru Z, (case insensitive)
;____________________________________________________________
;constants:
;#pi,#e
;____________________________________________________________
;@ holds the previous evaluation.
;for example: x$=eval("sin(1/2)"), x$="4.79425538604203000e-1"
; y$=eval("asin(@)"), y$="5.00000000000000000e-1"
Structure rx
StructureUnion
fword.w[5]
tbyte.b[10]
EndStructureUnion
EndStructure
g.rx ;-------------[esp+4]
gt.rx ;------------[esp+14]
g0.rx ;------------[esp+24]
g2.rx ;------------[esp+34]
tmp.rx ;-----------[esp+44]
tenx.rx ;----------[esp+54]
x.rx ;-------------[esp+64]
xtemp.rx ;---------[esp+74]
xtemp0.rx ;--------[esp+84]
xtemp1.rx ;--------[esp+94]
xtemp2.rx ;--------[esp+104]
y.rx ;-------------[esp+114]
CmpFlag.l ;--------[esp+124]
d.l ;--------------[esp+128]
e.l ;--------------[esp+132]
ep.l ;-------------[esp+136]
es.l ;-------------[esp+140]
f.l ;--------------[esp+144]
fln.l ;------------[esp+148]
fp.l ;-------------[esp+152]
i.l ;--------------[esp+156]
i1.l ;-------------[esp+160]
id.l ;-------------[esp+164]
j.l ;--------------[esp+168]
lenExpr.l ;--------[esp+172]
ln.l ;-------------[esp+176]
nm.l ;-------------[esp+180]
p.l ;--------------[esp+184]
tok.l ;------------[esp+188]
tokn.l ;-----------[esp+192]
token.l ;----------[esp+196]
token_Index.l = 1 ;[esp+200]
VarName.l=0 ;------[esp+204]
vi.l ;-------------[esp+208]
bc.w=0 ;-----------[esp+212]
bex.w ;------------[esp+214]
c.w ;--------------[esp+216]
ex.w=1 ;-----------[esp+218]
ex1.w ;------------[esp+220]
h.w ;--------------[esp+222]
l.w ;--------------[esp+224]
s.w ;--------------[esp+226]
z.w ;--------------[esp+228]
zz.w ;-------------[esp+230]
a$=""
ch$=""
ch1$=""
ch2$=""
expr$=exprn$
f1$=""
f2$=""
f3$=""
s$=""
Result$=""
#NF=19
#T_ADD=43 ;+
#T_SUB=45 ;-
#T_MUL=42 ;*
#T_DIV=47 ;/
#T_EXP=94 ;^
#T_SPC=32 ;space
#T_ERR=36 ;$
#T_CON=35 ;#
#T_LPR=40 ;(
#T_RPR=41 ;)
#T_FAC=33 ;!
#T_LST=64 ;@
#T_COM=44 ;,
#T_LT=60 ;less than
#T_EQ=61 ;equal
#T_GT=62 ;greater than
#T_LTE=188 ;less than or equal
#T_NEQ=189 ;not equal
#T_GTE=190 ;greater than or equal
! finit
! mov dword [OS_Index],0
! mov dword [VS_Index],0
! mov dword [eval_stk_index],0
;Gosub tokenize
! MOV ebx,[eval_stk_index]
! SAL ebx,2 ;multiply index by 4
! MOV [ebx+gsubeval_stk],dword l_subeval2
! inc dword [eval_stk_index]
! JMP l_tokenize
subeval2:
lenExpr.l = Len(expr$)
If lenExpr = 0
Goto EvalFNend
EndIf
ch1$=Mid(expr$,1,1)
i1=Asc(ch1$)
If (i1>64) And (i1<91)
If lenExpr>1
If (Mid(expr$,2,1)="=") And (Mid(expr$,3,1)<>"=")
expr$=Right(expr$,lenExpr-2)
lenExpr.l = Len(expr$)
VarName=i1
EndIf
EndIf
EndIf
;Gosub compare
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval4
! inc dword [eval_stk_index]
! JMP l_compare
subeval4:
If token <> #T_SPC
PrintN("")
PrintN("Syntax Error")
PrintN("")
;MessageRequester("","Syntax Error",0)
EndIf
If VarName>0
! fld tword [ValStack]
i1=(VarName-65)*10
! MOV eax,[esp+160];i1
! fstp tword [FnEvalVars+eax]
EndIf
! fld tword [ValStack]
! fld st0
! fstp tword [prev_eval]
! fstp tword [esp+64] ;x
;*****************************************************
;FtoA
z=x\fword[4]&$ffff
zz=x\fword[3]&$ffff
s=z>>15
If ((z=0) Or (z=-32768)) And (zz=0)
Result$=" 0.00000000000000000e+0000"
If s=-1
Result$="-0.00000000000000000e+0000" ;believe it or not, the FPU distinguishes between +0 and -0
EndIf
Goto FtoAend
EndIf
bex.w=(x\fword[4]&%111111111111111)-$3ffe
;ex.w=bex*146/485 ;ex.w=Int(0.30103*bex)>=====
! MOVSX eax,word [esp+214];bex ; |
! imul eax,eax,146 ;146/485 = 0.3010309 |
! mov ebx,485 ; |
! cdq ; |
! idiv ebx ; |
! MOV [esp+218],ax;ex ;.................... <=====
ex1.w=17-ex
;FINIT
;rxPower(@tenx,@rx_ten,ex1) ;raise tenx to ex power
! MOV ax,[esp+220];ex1
! cwde; eax
;***************************************
! mov [y_rxpower],eax
! fld tword [rx_ten]
! fstp tword [x_rxpower]
;Gosub rxpower
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_fneval12
! inc dword [eval_stk_index]
! JMP rxpower
FnEval12:
! fld tword [z_rxpower]
! fstp tword [esp+54] ;tenx; store z (st0)
! fld tword [esp+54] ;load tenx^ex into st0
! FST st1 ;store into st1
! fld tword [esp+64];x
! FMUL st0,st1 ;the number is multiplied by tenx^ex
! FST st1
! fbstp [esp+44] ;BCD pack float into tmp
eight.w=8
If (tmp\tbyte[eight]&$ff)<10
! FST st1
! fld tword [rx_ten] ;load 10 into st0
! FMUL st0,st1
ex=ex-1
EndIf
If s=-1 ;if our number sign was '-' then change the sign in float
! FCHS
EndIf
! fbstp tword [esp+44] ;BCD pack float into tmp
i=7
eight.w=8
c.w=tmp\tbyte[eight] & $ff
h.w=c>>4
l.w=c-h<<4
If h<10
hb$=Chr(h+48)
Else
hb$=Chr(h+55)
EndIf
If l<10
lb$=Chr(l+48)
Else
lb$=Chr(l+55)
EndIf
Result$=hb$+"."+lb$
While i>=0
c.w=tmp\tbyte[i] & $ff
h.w=c>>4
l.w=c-h<<4
If h<10
hb$=Chr(h+48)
Else
hb$=Chr(h+55)
EndIf
If l<10
lb$=Chr(l+48)
Else
lb$=Chr(l+55)
EndIf
Result$=Result$+hb$+lb$
i=i-1
Wend
If s=-1
Result$="-"+Result$
Else
Result$=" "+Result$
EndIf
ch$=Str(Abs(ex))
ch$=RSet(ch$, 4, "0")
If ex<0
ch$="-"+ch$
Else
ch$="+"+ch$
EndIf
Result$=Result$+"e"+ch$
! fstp st0
FtoAend:
;FtoA end
;*****************************************************
Goto EvalFNend
scan:
If token_Index > lenExpr
token = #T_SPC
Else
token = Asc(Mid(expr$, token_Index, 1))
token_Index = token_Index + 1
EndIf
;CompilerIf 0
If token_Index > lenExpr
ch$ = " "
Else
ch$ = Mid(expr$, token_Index, 1)
EndIf
If (token=#T_LT) ;if token="<"
If ch$="="
token=#T_LTE
token_Index = token_Index + 1
ElseIf ch$=">"
token=#T_NEQ
token_Index = token_Index + 1
ElseIf ch$=" "
token=#T_ERR
EndIf
ElseIf (token=#T_GT) ;if token=">"
If ch$="="
token=#T_GTE
token_Index = token_Index + 1
ElseIf ch$="<"
token=#T_NEQ
token_Index = token_Index + 1
ElseIf ch$=" "
token=#T_ERR
EndIf
ElseIf (token=#T_EQ) ;if token="="
If ch$="="
token_Index = token_Index + 1
ElseIf ch$="<"
token=#T_LTE
token_Index = token_Index + 1
ElseIf ch$=">"
token=#T_GTE
token_Index = token_Index + 1
ElseIf ch$=" "
token=#T_ERR
EndIf
EndIf
! dec dword [eval_stk_index]
! MOV eax,[eval_stk_index]
! SAL eax,2
! mov ebx,dword [eax+gsubeval_stk]
! JMP ebx
gamma:
;Gosub factor
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_gamma1
! inc dword [eval_stk_index]
! JMP l_factor
gamma1:
If token <> #T_FAC
Goto gamma2
EndIf
;Gosub scan
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval5
! inc dword [eval_stk_index]
! JMP l_scan
subeval5:
If token = #T_ERR
Goto gamma2
EndIf
;rxCopy(@x,@ValStack([VS_Index] - 1))
! MOV ebx,[VS_Index]
! DEC ebx
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! fld tword [ebx+ValStack]
! fstp tword [esp+64] ;x
If token <> #T_FAC
;Gosub factorial
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval6
! inc dword [eval_stk_index]
! JMP l_factorial
subeval6:
Else
;Gosub factorial2
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval7
! inc dword [eval_stk_index]
! JMP l_factorial2
subeval7:
EndIf
;rxCopy(@ValStack([VS_Index] - 1),@g)
! MOV ebx,[VS_Index]
! DEC ebx
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! fld tword [esp+4] ;g
! fstp tword [ebx+ValStack]
If token = #T_FAC
;Gosub scan
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval8
! inc dword [eval_stk_index]
! JMP l_scan
subeval8:
EndIf
Goto gamma1
gamma2:
! dec dword [eval_stk_index]
! MOV eax,[eval_stk_index]
! SAL eax,2
! mov ebx,dword [eax+gsubeval_stk]
! JMP ebx
expon:
;gosub gamma
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_expon1
! inc dword [eval_stk_index]
! JMP l_gamma
expon1:
If token <> #T_EXP
Goto expon2
EndIf
;gosub scan
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval9
! inc dword [eval_stk_index]
! JMP l_scan
subeval9:
;Gosub gamma
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval10
! inc dword [eval_stk_index]
! JMP l_gamma
subeval10:
If token = #T_ERR
Goto expon2
EndIf
If token = #T_EXP
;Gosub expon1
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval11
! inc dword [eval_stk_index]
! JMP l_expon1
subeval11:
EndIf
! DEC dword [VS_Index]
;rxFpow(@ValStack([VS_Index] - 1),@ValStack([VS_Index] - 1),@ValStack([VS_Index]))
! MOV ebx,[VS_Index]
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! fld tword [ebx+ValStack]
! fld tword [ebx+ValStack-10]
! FYL2X
! FLD st0
! FRNDINT
! FSUB st1, st0
! FLD1
! FSCALE
! FXCH
! FXCH st2
! F2XM1
! FLD1
! FADDP st1, st0
! FMULP st1, st0
! fstp st1
! fstp tword [ebx+ValStack-10]
Goto expon1
expon2:
! dec dword [eval_stk_index]
! MOV eax,[eval_stk_index]
! SAL eax,2
! mov ebx,dword [eax+gsubeval_stk]
! JMP ebx
term:
;Gosub expon
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_term1
! inc dword [eval_stk_index]
! JMP l_expon
term1:
If (token <> #T_MUL) And (token <> #T_DIV)
Goto term2
EndIf
;OpStack(OS_Index) = token:
! MOV ebx,[OS_Index]
! SAL ebx,2
! MOV eax,[esp+196];token
! MOV [ebx+OpStack],eax
! inc dword [OS_Index]
;Gosub scan
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval12
! inc dword [eval_stk_index]
! JMP l_scan
subeval12:
;Gosub expon
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval13
! inc dword [eval_stk_index]
! JMP l_expon
subeval13:
! dec dword [OS_Index]
! MOV ebx,[OS_Index]
! SAL ebx,2
! MOV eax,[ebx+OpStack]
! MOV [esp+192],eax;tokn
;tokn = OpStack(OS_Index)
If tokn = #T_MUL
If token = #T_ERR
Goto term2
EndIf
! DEC dword [VS_Index]
; rxMul(@ValStack([VS_Index] - 1),@ValStack([VS_Index] - 1),@ValStack([VS_Index]))
! MOV ebx,[VS_Index]
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! fld tword [ebx+ValStack-10]
! fld tword [ebx+ValStack]
! fmulp st1,st0
! fstp tword [ebx+ValStack-10]
Goto term1
EndIf
If tokn = #T_DIV
If token = #T_ERR
Goto term2
EndIf
! DEC dword [VS_Index]
; rxDiv(@ValStack([VS_Index] - 1),@ValStack([VS_Index] - 1),@ValStack([VS_Index]))
! MOV ebx,[VS_Index]
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! fld tword [ebx+ValStack-10]
! fld tword [ebx+ValStack]
! fdivp st1,st0
! fstp tword [ebx+ValStack-10]
Goto term1
EndIf
term2:
! dec dword [eval_stk_index]
! MOV eax,[eval_stk_index]
! SAL eax,2
! mov ebx,dword [eax+gsubeval_stk]
! JMP ebx
unary:
If (token = #T_SUB) Or (token = #T_ADD)
; OpStack(OS_Index) = token
! MOV ebx,[OS_Index]
! SAL ebx,2
! MOV eax,[esp+196];token
! MOV [ebx+OpStack],eax
! inc dword [OS_Index]
;Gosub scan
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval14
! inc dword [eval_stk_index]
! JMP l_scan
subeval14:
;Gosub term
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval15
! inc dword [eval_stk_index]
! JMP l_term
subeval15:
! dec dword [OS_Index]
! mov ebx,[OS_Index]
! SAL ebx,2
! MOV eax,[ebx+OpStack]
! MOV [esp+192],eax ;tokn
;tokn = OpStack(OS_Index)
If tokn <> #T_SUB
Goto unary1
EndIf
If token = #T_ERR
Goto unary1
EndIf
; rxChs(@ValStack([VS_Index] - 1),@ValStack([VS_Index] - 1))
! MOV ebx,[VS_Index]
! DEC ebx
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! fld tword [ebx+ValStack]
! FCHS
! fstp tword [ebx+ValStack]
Goto unary1
EndIf
;Gosub term
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_unary1
! inc dword [eval_stk_index]
! JMP l_term
unary1:
! dec dword [eval_stk_index]
! MOV eax,[eval_stk_index]
! SAL eax,2
! mov ebx,dword [eax+gsubeval_stk]
! JMP ebx
evaluate_expr:
;Gosub unary
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_expr1
! inc dword [eval_stk_index]
! JMP l_unary
expr1:
If (token <> #T_ADD) And (token <> #T_SUB)
Goto expr2
EndIf
;OpStack(OS_Index) = token:
! mov ebx,[OS_Index]
! SAL ebx,2
! MOV eax,[esp+196];token
! MOV [ebx+OpStack],eax
! inc dword [OS_Index]
;Gosub scan
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval16
! inc dword [eval_stk_index]
! JMP l_scan
subeval16:
;Gosub unary
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval17
! inc dword [eval_stk_index]
! JMP l_unary
subeval17:
! dec dword [OS_Index]
! mov ebx,[OS_Index]
! SAL ebx,2
! MOV eax,[ebx+OpStack]
! MOV [esp+192],eax ;tokn
;tokn = OpStack(OS_Index)
If tokn = #T_ADD
If token = #T_ERR
Goto expr2
EndIf
! DEC dword [VS_Index]
; rxAdd(@ValStack([VS_Index] - 1),@ValStack([VS_Index] - 1),@ValStack([VS_Index]))
! MOV ebx,[VS_Index]
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! fld tword [ebx+ValStack-10]
! fld tword [ebx+ValStack]
! faddp st1,st0
! fstp tword [ebx+ValStack-10]
Goto expr1
EndIf
If tokn = #T_SUB
If token = #T_ERR
Goto expr2
EndIf
! DEC dword [VS_Index]
; rxSub(@ValStack([VS_Index] - 1),@ValStack([VS_Index] - 1),@ValStack([VS_Index]))
! MOV ebx,[VS_Index]
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! fld tword [ebx+ValStack-10]
! fld tword [ebx+ValStack]
! fsubp st1,st0
! fstp tword [ebx+ValStack-10]
Goto expr1
EndIf
expr2:
! dec dword [eval_stk_index]
! MOV eax,[eval_stk_index]
! SAL eax,2
! mov ebx,dword [eax+gsubeval_stk]
! JMP ebx
compare:
;Gosub scan
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval3
! inc dword [eval_stk_index]
! JMP l_scan
subeval3:
;Gosub evaluate_expr
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_compare1
! inc dword [eval_stk_index]
! JMP l_evaluate_expr
compare1:
If ((token<>#T_LT) And (token<>#T_EQ) And (token<>#T_GT) And (token<>#T_LTE) And (token<>#T_GTE) And (token<>#T_NEQ))
Goto compare4
EndIf
;OpStack(OS_Index) = token:
! MOV ebx,[OS_Index]
! SAL ebx,2
! MOV eax,[esp+196];token
! MOV [ebx+OpStack],eax
! inc dword [OS_Index]
;Gosub scan
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_compare2
! inc dword [eval_stk_index]
! JMP l_scan
compare2:
;Gosub evaluate_expr
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_compare3
! inc dword [eval_stk_index]
! JMP l_evaluate_expr
compare3:
! dec dword [OS_Index]
! MOV ebx,[OS_Index]
! SAL ebx,2
! MOV eax,[ebx+OpStack]
! MOV [esp+192],eax ;tokn
If ((tokn=#T_LT) Or (tokn=#T_EQ) Or (tokn=#T_GT) Or (tokn=#T_LTE) Or (tokn=#T_GTE) Or (tokn=#T_NEQ))
If token=#T_ERR
Goto compare4
EndIf
! DEC dword [VS_Index]
! MOV edx,[VS_Index]
! SAL edx,1
! MOV eax,edx
! SAL edx,2
! ADD edx,eax
! fld tword [edx+ValStack]
! fld tword [edx+ValStack-10]
! fcompp
! fnstsw ax
! sahf
! JE l_cmp_equals
! JB l_cmp_x_less_y
! JA l_cmp_x_greater_y
cmp_equals:
! MOV dword [esp+124],0 ;CmpFlag
! JMP l_compare_end
cmp_x_less_y:
! MOV dword [esp+124],1 ;CmpFlag
! JMP l_compare_end
cmp_x_greater_y:
! MOV dword [esp+124],2 ;CmpFlag
compare_end:
If tokn=#T_LT
If (CmpFlag=1)
! fld1
Else
! fldz
EndIf
! fstp tword [edx+ValStack-10]
ElseIf tokn=#T_EQ
If (CmpFlag=0)
! fld1
Else
! fldz
EndIf
! fstp tword [edx+ValStack-10]
ElseIf tokn=#T_GT
If (CmpFlag=2)
! fld1
Else
! fldz
EndIf
! fstp tword [edx+ValStack-10]
ElseIf tokn=#T_LTE
If (CmpFlag=0) Or (CmpFlag=1)
! fld1
Else
! fldz
EndIf
! fstp tword [edx+ValStack-10]
ElseIf tokn=#T_GTE
If (CmpFlag=0) Or (CmpFlag=2)
! fld1
Else
! fldz
EndIf
! fstp tword [edx+ValStack-10]
ElseIf tokn=#T_NEQ
If (CmpFlag<>0)
! fld1
Else
! fldz
EndIf
! fstp tword [edx+ValStack-10]
EndIf
EndIf
compare4:
! dec dword [eval_stk_index]
! MOV eax,[eval_stk_index]
! SAL eax,2
! mov ebx,dword [eax+gsubeval_stk]
! JMP ebx
factor:
tok=tokn
tokn = token
If (token>64) And (token<91) ;A..Z
! MOV ebx,[VS_Index]
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! MOV eax,[esp+196];token
! sub eax,65
! sal eax,1
! mov edx,eax
! sal eax,2
! add eax,edx
! fld tword [eax+FnEvalVars]
! fstp tword [ebx+ValStack]
! INC dword [VS_Index]
;Gosub scan
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval18
! inc dword [eval_stk_index]
! JMP l_scan
subeval18:
ElseIf token = #T_LST
; rxCopy(@ValStack([VS_Index]),@prev_eval): [VS_Index] = [VS_Index] + 1
! MOV ebx,[VS_Index]
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! fld tword [prev_eval]
! fstp tword [ebx+ValStack]
! INC dword [VS_Index]
;Gosub scan
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval20
! inc dword [eval_stk_index]
! JMP l_scan
subeval20:
ElseIf token = #T_CON
; rxCopy(@ValStack([VS_Index]),@constant(Val(Mid(expr$, token_Index, 2)))): [VS_Index] = [VS_Index] + 1
i1=Val(Mid(expr$, token_Index, 2))
token_Index = token_Index + 2
! MOV ebx,[esp+160];i1
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! fld tword [ebx+constant]
! MOV ebx,[VS_Index]
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! fstp tword [ebx+ValStack]
! INC dword [VS_Index]
;Gosub scan
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval21
! inc dword [eval_stk_index]
! JMP l_scan
subeval21:
ElseIf (token = #T_SUB) Or (token = #T_ADD)
;Gosub unary
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval22
! inc dword [eval_stk_index]
! JMP l_unary
subeval22:
ElseIf token = #T_LPR
;Gosub compare
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval24
! inc dword [eval_stk_index]
! JMP l_compare
subeval24:
If token <> #T_RPR
PrintN("") : PrintN( "Missing ')'")
EndIf
;Gosub scan
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval25
! inc dword [eval_stk_index]
! JMP l_scan
subeval25:
Else
tokn = token
If (tokn = 0) Or (tokn > #NF)
token = #T_ERR
Else
;Gosub scan
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval26
! inc dword [eval_stk_index]
! JMP l_scan
subeval26:
; OpStack(OS_Index) = tokn:
! MOV ebx,[OS_Index]
! SAL ebx,2
! MOV eax,[esp+192];tokn
! MOV [ebx+OpStack],eax
! inc dword [OS_Index]
If token <> #T_LPR
PrintN( "'(' expected")
Else
;Gosub compare
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval28
! inc dword [eval_stk_index]
! JMP l_compare
subeval28:
If token <> #T_RPR
PrintN( "')' expected")
Else
;Gosub scan
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval29
! inc dword [eval_stk_index]
! JMP l_scan
subeval29:
! dec dword [OS_Index]
! mov ebx,[OS_Index]
! SAL ebx,2
! MOV eax,[ebx+OpStack]
! MOV [esp+192],eax ;tokn
! MOV ebx,[VS_Index]
! DEC ebx
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! fld tword [ebx+ValStack]
! MOV eax,[esp+192];tokn
! SAL eax,2 ;multiply by 4
! MOV eax,[eax+l_jmptable]
! JMP eax
asinh:! fldln2 ;load loge(2)
! FXCH
! FLD st0
! FMUL st0,st0
! FLD1
! faddp st1,st0
! FSQRT
! faddp st1,st0
! FYL2X ;st1*log2(x)
! JMP l_endfns
acosh:! fldln2 ;load loge(2)
! FXCH
! FLD st0
! FMUL st0,st0
! FLD1
! fsubp st1,st0
! FSQRT
! faddp st1,st0
! FYL2X ;st1*log2(x)
! JMP l_endfns
atanh:! fldln2 ;load loge(2)
! FXCH
! FLD1
! faddp st1,st0
! FLD st0
! fld tword [rx_two]
! fsubrp st1,st0
! fdivp st1,st0
! FYL2X ;st1*log2(x)
! fld tword [rx_half]
! fmulp st1,st0
! JMP l_endfns
sinh: ! fld tword [rx_e]
! FYL2X
! FLD st0
! FRNDINT
! FSUB st1, st0
! FLD1
! FSCALE
! FXCH
! FXCH st2
! F2XM1
! FLD1
! FADDP st1, st0
! FMULP st1, st0
! fstp st1
! FLD st0
! FLD1
! fdivrp st1,st0
! fsubp st1,st0
! fld tword [rx_half]
! fmulp st1,st0
! JMP l_endfns
cosh: ! fld tword [rx_e]
! FYL2X
! FLD st0
! FRNDINT
! FSUB st1, st0
! FLD1
! FSCALE
! FXCH
! FXCH st2
! F2XM1
! FLD1
! FADDP st1, st0
! FMULP st1, st0
! fstp st1
! FLD st0
! FLD1
! fdivrp st1,st0
! faddp st1,st0
! fld tword [rx_half]
! fmulp st1,st0
! JMP l_endfns
tanh: ! fld tword [rx_e]
! FYL2X
! FLD st0
! FRNDINT
! FSUB st1, st0
! FLD1
! FSCALE
! FXCH
! FXCH st2
! F2XM1
! FLD1
! FADDP st1, st0
! FMULP st1, st0
! fstp st1
! FMUL st0,st0
! FLD st0
! FLD1
! faddp st1,st0
! FXCH
! FLD1
! fsubp st1,st0
! fdivrp st1,st0
! JMP l_endfns
asin: ! FLD1
! FLD st1
! FMUL st0,st0
! FSUBP st1,st0
! FSQRT
! FPATAN
! fstp st1
! JMP l_endfns
acos: ! FLD1
! FLD st1
! FMUL st0,st0
! FSUBP st1,st0
! FSQRT
! FXCH
! FPATAN
! fstp st1
! JMP l_endfns
atan: ! FLD1
! FPATAN
! fstp st1
! JMP l_endfns
alog: ! fld tword [rx_ten]
! FYL2X
! FLD st0
! FRNDINT
! FSUB st1, st0
! FLD1
! FSCALE
! FXCH
! FXCH st2
! F2XM1
! FLD1
! FADDP st1, st0
! FMULP st1, st0
! fstp st1
! JMP l_endfns
sqrt: ! FSQRT
! JMP l_endfns
sin: ! FSIN
! JMP l_endfns
cos: ! fcos
! JMP l_endfns
tan: ! fptan
! fstp st0
! JMP l_endfns
log: ! fldlg2 ;load Log10(2)
! FXCH
! fyl2x ; st1*log2(x)
! JMP l_endfns
exp: ! fld tword [rx_e]
! FYL2X
! FLD st0
! FRNDINT
! FSUB st1, st0
! FLD1
! FSCALE
! FXCH
! FXCH st2
! F2XM1
! FLD1
! FADDP st1, st0
! FMULP st1, st0
! fstp st1
! JMP l_endfns
sqr: ! FMUL st0,st0
! JMP l_endfns
ln: ! fldln2 ;load loge(2)
! FXCH
! FYL2X ;st1*log2(x)
endfns:
! fstp tword [ebx+ValStack]
EndIf
endfactor:
EndIf
EndIf
EndIf
! dec dword [eval_stk_index]
! MOV eax,[eval_stk_index]
! SAL eax,2
! mov ebx,dword [eax+gsubeval_stk]
! JMP ebx
numstrip:
a$ = expr$ + " "
expr$ = ""
ln = Len(a$)
id = 1
value$ = ""
vi = 0
numstrip1:
ch1$=""
ch2$=""
If (id > ln) And (value$ = "")
Goto numstrip3
EndIf
If id > ln
;Gosub vl
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval30
! inc dword [eval_stk_index]
! JMP l_vl
subeval30:
Goto numstrip1
EndIf
ch$ = Mid(a$, id, 1)
id = id + 1
If id<ln
ch1$=Mid(a$, id, 1)
EndIf
If ch$="#"
If (id+1)<ln
ch2$=Mid(a$,id+1,1)
EndIf
If ch1$="E"
! MOV ebx,[esp+208];vi
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! fld tword [rx_e]
! fstp tword [ebx+constant]
s$ = Str(vi)
vi = vi + 1
If (Len(s$) < 2)
s$ = "0" + s$
EndIf
expr$ = expr$ + "#" + s$
value$ = ""
id=id+1
Goto numstrip1
ElseIf (ch1$="P") And (ch2$="I")
! MOV ebx,[esp+208];vi
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! fldpi
! fstp tword [ebx+constant]
s$ = Str(vi)
vi = vi + 1
If (Len(s$) < 2)
s$ = "0" + s$
EndIf
expr$ = expr$ + "#" + s$
value$ = ""
id=id+2
Goto numstrip1
EndIf
EndIf
nm = FindString(" .0123456789", ch$,1)
If nm = 1
Goto numstrip1
EndIf
If (nm = 0) And (value$ = "")
expr$ = expr$ + ch$
Goto numstrip1
EndIf
If nm = 0
If (value$ <> "") And (FindString("E", ch$,1) > 0)
;Gosub vl1
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval31
! inc dword [eval_stk_index]
! JMP l_vl1
subeval31:
Goto numstrip1
EndIf
If nm = 0
;Gosub vl
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval32
! inc dword [eval_stk_index]
! JMP l_vl
subeval32:
Goto numstrip1
EndIf
EndIf
value$ = value$ + ch$
If nm <> 2
Goto numstrip1
EndIf
numstrip2:
If id > ln
Goto numstrip1
EndIf
ch$ = Mid(a$, id, 1)
id = id + 1
nm = FindString(" .0123456789", ch$,1)
If (nm = 1) Or (nm = 2)
Goto numstrip2
EndIf
If nm = 0
If FindString("E", ch$,1) > 0
;Gosub vl1
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval33
! inc dword [eval_stk_index]
! JMP l_vl1
subeval33:
Goto numstrip1
EndIf
If nm = 0
;Gosub vl
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval34
! inc dword [eval_stk_index]
! JMP l_vl
subeval34:
Goto numstrip1
EndIf
EndIf
value$ = value$ + ch$
Goto numstrip2
Goto numstrip1
vl1:
value$ = value$ + "E"
vl0:
If id > ln
value$ = value$ + "0"
ch$ = ""
Goto vl
EndIf
ch$ = Mid(a$, id, 1)
id = id + 1
nm = FindString(" +-", ch$,1)
If nm = 1
Goto vl0
EndIf
If nm > 1
value$ = value$ + ch$
ch$ = Mid(a$, id, 1)
id = id + 1
nm = 0
EndIf
If nm = 0
nm = FindString("0123456789", ch$,1)
If nm = 0
value$ = value$ + "0"
Goto vl2
EndIf
value$ = value$ + ch$
Goto vl2
value$ = value$ + ch$ + "0"
EndIf
vl2:
If id > ln
ch$ = ""
Goto vl
EndIf
ch$ = Mid(a$, id, 1)
id = id + 1
nm = FindString(" 0123456789", ch$,1)
If nm = 1
Goto vl2
EndIf
If nm = 0
Goto vl
EndIf
value$ = value$ + ch$
Goto vl2
vl:
;rxAtoF(@constant(vi),value$ + "")
;rxAtoF(@x,value$)
;*******************************************************
;Procedure rxAtoF(*x.rx,float$)
s=1
d=0
e=0
ep=0
ex=0
es=1
i=0
f=0
fp=0
j=1
fln=Len(value$)
;f$=UCase(float$)
f1$=""
f2$=""
f3$=""
While j<=fln
c$=Mid(value$,j,1)
If ep=1
If c$=" "
Goto nxtch
EndIf
If c$="-"
es=-es
c$=""
EndIf
If c$="+"
Goto nxtch
EndIf
If (c$="0") And (f3$="")
Goto nxtch
EndIf
If (c$>"/") And (c$<":") ;c$ is digit between 0 and 9
f3$=f3$+c$
ex=10*ex+(Asc(c$)-48)
Goto nxtch
EndIf
EndIf
If c$=" "
Goto nxtch
EndIf
If c$="-"
s=-s
Goto nxtch
EndIf
If c$="+"
Goto nxtch
EndIf
If c$="."
If d=1
Goto nxtch
EndIf
d=1
EndIf
If (c$>"/") And (c$<":") ;c$ is digit between 0 and 9
If ((c$="0") And (i=0))
If d=0
Goto nxtch
EndIf
If (d=1) And (f=0)
e=e-1
Goto nxtch
EndIf
EndIf
If d=0
f1$=f1$+c$
i=i+1
Else
If (c$>"0")
fp=1
EndIf
f2$=f2$+c$
f=f+1
EndIf
EndIf
If c$="E"
ep=1
EndIf
nxtch:
j=j+1
Wend
If fp=0
f=0
f2$=""
EndIf
If i>18
f1$=Mid(f1$,1,18)
f2$=""
EndIf
ex=(es*ex)-(18-i)+e
f1$=f1$+f2$
fln=Len(f1$)
While Len(f1$)<18
f1$=f1$+"0"
Wend
x\tbyte[9]=0 ;alway zero for positive BCD number
i=1
j=8
c.w
While i<18
c=16*(Asc(Mid(f1$,i,1))-48)
i=i+1
c=c+(Asc(Mid(f1$,i,1))-48)
i=i+1
x\tbyte[j]=c
j=j-1
Wend
;rxPower(@tmp,@rx_ten,ex)
;now we raise 10 to power ex and multiply our number by it to get proper float
;*******************************************************
;! rxpower:
! MOV ax,[esp+218];ex
! cwde; eax
! mov [y_rxpower],eax
! fld tword [rx_ten]
! fstp tword [x_rxpower]
;Gosub rxpower
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_numstrip12
! inc dword [eval_stk_index]
! JMP rxpower
numstrip12:
! fld tword [z_rxpower]
;*******************************************************
! fbld tword [esp+64] ;x
! fmulp st1,st0
If s=-1 ;if our number sign was '-' then change the sign in float
! FCHS
EndIf
;end AtoF
;*******************************************************
! MOV ebx,[esp+208];vi
! SAL ebx,1
! MOV eax,ebx
! SAL ebx,2
! ADD ebx,eax
! fstp tword [ebx+constant]
s$ = Str(vi)
vi = vi + 1
If (Len(s$) < 2)
s$ = "0" + s$
EndIf
expr$ = expr$ + "#" + s$ + ch$
value$ = ""
numstrip3:
! dec dword [eval_stk_index]
! MOV eax,[eval_stk_index]
! SAL eax,2
! mov ebx,dword [eax+gsubeval_stk]
! JMP ebx
tokenize:
expr$ = UCase(RemoveString(expr$," "))
bc=1
p = FindString(expr$,"ASINH" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 5)+1)
p = FindString(expr$, "ASINH",1)
Wend
bc=bc+1
p = FindString(expr$,"ACOSH" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 5)+1)
p = FindString(expr$, "ACOSH",1)
Wend
bc=bc+1
p = FindString(expr$,"ATANH" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 5)+1)
p = FindString(expr$, "ATANH",1)
Wend
bc=bc+1
p = FindString(expr$,"SINH" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 4)+1)
p = FindString(expr$, "SINH",1)
Wend
bc=bc+1
p = FindString(expr$,"COSH" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 4)+1)
p = FindString(expr$, "COSH",1)
Wend
bc=bc+1
p = FindString(expr$,"TANH" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 4)+1)
p = FindString(expr$, "TANH",1)
Wend
bc=bc+1
p = FindString(expr$,"ASIN" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 4)+1)
p = FindString(expr$, "ASIN",1)
Wend
bc=bc+1
p = FindString(expr$,"ACOS" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 4)+1)
p = FindString(expr$, "ACOS",1)
Wend
bc=bc+1
p = FindString(expr$,"ATAN" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 4)+1)
p = FindString(expr$, "ATAN",1)
Wend
bc=bc+1
p = FindString(expr$,"ALOG" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 4)+1)
p = FindString(expr$, "ALOG",1)
Wend
bc=bc+1
p = FindString(expr$,"SQRT" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 4)+1)
p = FindString(expr$, "SQRT",1)
Wend
bc=bc+1
p = FindString(expr$,"SIN" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 3)+1)
p = FindString(expr$, "SIN",1)
Wend
bc=bc+1
p = FindString(expr$,"COS" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 3)+1)
p = FindString(expr$, "COS",1)
Wend
bc=bc+1
p = FindString(expr$,"TAN" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 3)+1)
p = FindString(expr$, "TAN",1)
Wend
bc=bc+1
p = FindString(expr$,"LOG" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 3)+1)
p = FindString(expr$, "LOG",1)
Wend
bc=bc+1
p = FindString(expr$,"EXP" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 3)+1)
p = FindString(expr$, "EXP",1)
Wend
bc=bc+1
p = FindString(expr$,"SQR" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 3)+1)
p = FindString(expr$, "SQR",1)
Wend
bc=bc+1
p = FindString(expr$,"LN" ,1)
While p <> 0
expr$ = Left(expr$, p - 1) + Chr(bc) + Right(expr$, Len(expr$)-(p + 2)+1)
p = FindString(expr$, "LN",1)
Wend
;Gosub numstrip
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_subeval35
! inc dword [eval_stk_index]
! JMP l_numstrip
subeval35:
! dec dword [eval_stk_index]
! MOV eax,[eval_stk_index]
! SAL eax,2
! mov ebx,dword [eax+gsubeval_stk]
! JMP ebx
;***************************************
factorial:
! fld tword [esp+64] ;x
! fldz
! FCOMPP
! FNSTSW ax
! SAHF
! JNE l_fac0
! fld1
! jmp l_fac
fac0:
! fld tword [esp+64]
! fld st0
! fld st0
! FRNDINT
! FCOMPP
! FNSTSW ax
! SAHF
! JE l_fac1
! jmp l_fac5
fac1:
! fldz
! FCOMPP
! FNSTSW ax
! SAHF
! JBE l_fac2
! fld tword [mbig]
! jmp l_fac
fac2:
! fld tword [esp+64]
! fild dword [OneHundred]
! FCOMPP
! FNSTSW ax
! SAHF
! JB l_fac5
! fld tword [esp+64]
! fist dword [IntX]
! mov ecx,[IntX]
! fld1
! fld1
! fld st2
! nop
! nop
! nop
fac3:
! fmul st2,st0
! fsub st0,st1
! sub ecx,1
;! jnle l_fac3
! jg l_fac3
fac4:
! fcompp
! fstp st1
! jmp l_fac
;***************************************
; gamma(x + 1) = (x + Y + 1/2)^(x + 1/2)*exp(-(x + Y + 1/2))
; *sqrt(2*Pi)*(C0 + C1/(x + 1) + C2/(x + 2) +...+ CN/(x + N))
;
; for more information visit http://home.att.net/~numericana/answer/info/godfrey.htm
fac5:
! fld tword [esp+64] ;load x
! fld tword [120+gamma] ; 9.5
! faddp st1,st0 ;x + 9.5
! fld st0 ;make copy
! fld tword [esp+64] ;load x again
! fld tword [rx_half] ;load .5
! faddp st1,st0 ;x + .5
! fxch ;exchange st0 and st1: st0 = x + 9.5, st1 = x + .5
! FYL2X ;st0 = st0 ^ st1
! FLD st0 ; "
! FRNDINT ; "
! FSUB st1, st0 ; "
! FLD1 ; "
! FSCALE ; "
! FXCH ; "
! FXCH st2 ; "
! F2XM1 ; "
! FLD1 ; "
! FADDP st1, st0 ; "
! FMULP st1, st0 ; "
! fstp st1 ; clean up fpu stack, result in st0
! fxch ;exchange st0 and st1: st0 = x + 9.5, st1 = (x + 9.5) ^ (x + .5)
! fchs ;st0 = - st0 = -(x + 9.5)
! fld tword [rx_e] ;st0 = exp(st0)
! FYL2X ; "
! FLD st0 ; "
! FRNDINT ; "
! FSUB st1, st0 ; "
! FLD1 ; "
! FSCALE ; "
! FXCH ; "
! FXCH st2 ; "
! F2XM1 ; "
! FLD1 ; "
! FADDP st1, st0 ; "
! FMULP st1, st0 ; "
! fstp st1 ; clean up fpu stack, result in st0
! fmulp st1,st0 ;st0 = (x + 9.5) ^ (x + .5) * exp(-(x + 9.5))
! fld tword [gamma] ; 2.50662827463100050 ; Sqrt(2*Pi)
! fmulp st1,st0 ;st0 = (x + 9.5) ^ (x + .5) * exp(-(x + 9.5)) * Sqrt(2*Pi)
! fld tword [gamma+10] ;1.00000000000000017
! fld tword [esp+64] ;load x again
! fiadd dword [ten] ;st0 = x + 10
! fld tword [110+gamma] ;-4.02353314126823637e-9
! fdiv st0,st1 ;st0 = -4.02353314126823637e-9 / (x + 10)
! faddp st2,st0
! fld1
! fsubp st1,st0 ;st0 = x + 9
! fld tword [100+gamma] ; 5.38413643250956406e-8
! fdiv st0,st1
! faddp st2,st0
! fld1
! fsubp st1,st0 ;st0 = x + 8
! fld tword [90+gamma] ;-7.42345251020141615e-3
! fdiv st0,st1
! faddp st2,st0
! fld1
! fsubp st1,st0 ;st0 = x + 7
! fld tword [80+gamma] ; 2.60569650561175583
! fdiv st0,st1
! faddp st2,st0
! fld1
! fsubp st1,st0 ;st0 = x + 6
! fld tword [70+gamma] ;-108.176705351436963
! fdiv st0,st1
! faddp st2,st0
! fld1
! fsubp st1,st0 ;st0 = x + 5
! fld tword [60+gamma] ; 1301.60828605832187
! fdiv st0,st1
! faddp st2,st0
! fld1
! fsubp st1,st0 ;st0 = x + 4
! fld tword [50+gamma] ;-6348.16021764145881
! fdiv st0,st1
! faddp st2,st0
! fld1
! fsubp st1,st0 ;st0 = x + 3
! fld tword [40+gamma] ; 14291.4927765747855
! fdiv st0,st1
! faddp st2,st0
! fld1
! fsubp st1,st0 ;st0 = x + 2
! fld tword [30+gamma] ;-14815.3042676841391
! fdiv st0,st1
! faddp st2,st0
! fld1
! fsubp st1,st0 ;st0 = x + 1
! fld tword [20+gamma] ; 5716.40018827434138
! fdivrp st1,st0
! faddp st1,st0
! fmulp st1,st0
! fstp st1
fac:
! fstp tword [esp+4] ;g
factorial1:
! dec dword [eval_stk_index]
! MOV eax,[eval_stk_index]
! SAL eax,2
! mov ebx,dword [eax+gsubeval_stk]
! JMP ebx
;***************************************
factorial2:;double factorial not implemented, goto factorial instead.
;Gosub factorial
! MOV ebx,[eval_stk_index]
! SAL ebx,2
! MOV [ebx+gsubeval_stk],dword l_factorial2a
! inc dword [eval_stk_index]
! JMP l_factorial
factorial2a:
! fld tword [esp+4] ;g
! fstp tword [esp+64] ;x
Goto factorial
;! dec dword [eval_stk_index]
;! MOV eax,[eval_stk_index]
;! SAL eax,2
;! mov ebx,dword [eax+gsubeval_stk]
;! JMP ebx
;***************************************
! rxInt:
! fstcw word [oldCW]
! mov ax,[oldCW]
! Or ax,110000000000b
! mov [newCW],ax
! fldcw word [newCW]
! fld tword [rx_X]
! frndint
! fstp tword [rx_Y]
! fldcw word [oldCW]
! dec dword [eval_stk_index]
! MOV eax,[eval_stk_index]
! SAL eax,2
! mov ebx,dword [eax+gsubeval_stk]
! JMP ebx
;***************************************
! rxpower:
! MOV eax,[y_rxpower]
! mov ebx,eax
! rxpower_abseax:
! neg eax
! js rxpower_abseax
! fld1 ; z:=1.0
! fld1
! fld tword [x_rxpower] ;load st0 with x
! cmp eax,0 ;while y>0
! rxpower_while1:
! jle rxpower_wend1
! rxpower_while2:
! bt eax,0 ;test for odd/even
! jc rxpower_wend2 ;jump if odd
; while y is even
! sar eax,1 ;eax=eax/2
! fmul st0,st0 ;x=x*x
! jmp rxpower_while2
! rxpower_wend2:
! sub eax,1
! fmul st1,st0 ;z=z*x ;st1=st1*st0
! jmp rxpower_while1
! rxpower_wend1:
! fstp st0 ;cleanup fpu stack
! fstp st1 ;" " "
! cmp ebx,0 ;test to see if y<0
! jge rxpower_noinv ;skip reciprocal if not less than 0
; If y<0 take reciprocal
! fld1
! fdivrp st1,st0
! rxpower_noinv:
! fstp tword [z_rxpower] ;store z (st0)
! dec dword [eval_stk_index]
! MOV eax,[eval_stk_index]
! SAL eax,2
! mov ebx,dword [eax+gsubeval_stk]
! JMP ebx
;***************************************
EvalFNend:
ProcedureReturn Result$
! section '.data' Data readable writeable
! gamma:
;N=10,Y=9
! dw $2CB2,$B138,$98FF,$A06C,$4000 ; 2.506628274631000502415; Sqrt(2*Pi); gamma
! dw $064A,$0000,$0000,$8000,$3FFF ; 1.000000000000000174663 __________ ; 10+gamma
! dw $4FAA,$E8F4,$3395,$B2A3,$400B ; 5716.400188274341379135 __________ ; 20+gamma
! dw $6D9E,$F2A2,$3791,$E77D,$C00C ; -14815.30426768413909044 __________ ; 30+gamma
! dw $C153,$6C23,$F89A,$DF4D,$400C ; 14291.49277657478554025 __________ ; 40+gamma
! dw $767D,$2FD2,$4820,$C661,$C00B ; -6348.160217641458813289 __________ ; 50+gamma
! dw $5DC8,$52E3,$7714,$A2B3,$4009 ; 1301.608286058321874104 __________ ; 60+gamma
! dw $5F26,$B2E6,$791F,$D85A,$C005 ; -108.1767053514369634679 __________ ; 70+gamma
! dw $AC57,$B9DA,$BB46,$A6C3,$4000 ; 2.605696505611755827728 __________ ; 80+gamma
! dw $5E13,$9ACD,$6EE0,$F340,$BFF7 ; -7.423452510201416151527e-3 _______ ; 90+gamma
! dw $16EB,$FC65,$34C4,$E73F,$3FE6 ; 5.384136432509564062960e-8 _______ ;100+gamma
! dw $B1AB,$8882,$5F2D,$8A3F,$BFE3 ; -4.023533141268236372067e-9 _______ ;110+gamma
! dw $0000,$0000,$0000,$9800,$4002 ; 9.5 ______________________________ ;120+gamma
! mbig: DW $7F1F,$D8A2,$8387,$9462,$FF95 ;-1.7e4900
! pbig: DW $7F1F,$D8A2,$8387,$9462,$7F95 ; 1.7e4900
! rx_two: DW $0000,$0000,$0000,$8000,$4000
! rx_four: DW $0000,$0000,$0000,$8000,$4001
! rx_ten: DW $0000,$0000,$0000,$A000,$4002
! rx_half: DW $0000,$0000,$0000,$8000,$3FFE
! rx_quarter: DW $0000,$0000,$0000,$8000,$3FFD
! rx_e: DW $4A9B,$A2BB,$5458,$ADF8,$4000
! OpStack:
! Repeat 100
! dd ?
! End Repeat
! gsubeval_stk:
! Repeat 512
! dd ?
! End Repeat
! ValStack:
! Repeat 100
! dt ?
! End Repeat
! constant:
! Repeat 100
! dt ?
! End Repeat
! prev_eval: dt ?
! FnEvalVars:
! Repeat 26
! dt ?
! End Repeat
! rx_X: dt ?
! rx_Y: dt ?
! x_rxpower: dt ?
! z_rxpower: dt ?
! x_factorial2: dt ?
! f1_factorial2: dt ?
! f2_factorial2: dt ?
! y_rxpower: DD ?
! OneHundred: DD 100
! IntX: DD ?
! oldCW: DD ?
! newCW: DD ?
! eval_stk_index: DD 0
! OS_Index: DD 0
! VS_Index: DD 0
! LST_Index: DD 0
jmptable:
! ten: ;not part of jumptable, but since table index starts at 1,
! dd 10 ;use location at index 0 for something else.
! dd l_asinh;ASINH
! dd l_acosh;ACOSH
! dd l_atanh;ATANH
! dd l_sinh ;SINH
! dd l_cosh ;COSH
! dd l_tanh ;TANH
! dd l_asin ;ASIN
! dd l_acos ;ACOS
! dd l_atan ;ATAN
! dd l_alog ;ALOG
! dd l_sqrt ;SQRT
! dd l_sin ;SIN
! dd l_cos ;COS
! dd l_tan ;TAN
! dd l_log ;LOG
! dd l_exp ;EXP
! dd l_sqr ;SQR
! dd l_ln ;LN
EndProcedure
FAQ
Search
Register
Login
.png){kind=avatar}