' << big snip >>
' Complete code in the attached zip
Public Function InlineSimpleEval(sText As String) As Double
Const STR_SRC01 As String = _
"#define TOK_FINAL 0" & vbCrLf & _
"#define TOK_RPAREN 1" & vbCrLf & _
"#define TOK_ADD 2" & vbCrLf & _
"#define TOK_MOD 3" & vbCrLf & _
"#define TOK_IDIV 4" & vbCrLf & _
"#define TOK_MUL 5" & vbCrLf & _
"#define TOK_UNARY 6" & vbCrLf & _
"#define TOK_POWER 7" & vbCrLf & _
"#define TOK_LPAREN 8" & vbCrLf & _
"#define TOK_NUM 9" & vbCrLf & _
"#define TOK_WHITE 10" & vbCrLf & _
"" & vbCrLf & _
"int lookup[256];" & vbCrLf & _
"" & vbCrLf & _
"simple_eval(s, pdbl)" & vbCrLf & _
"{" & vbCrLf & _
" int i, p, l, ch, prec, prev_pr;" & vbCrLf & _
" int op_stack, op_idx;" & vbCrLf & _
" int val_stack, val_idx;" & vbCrLf & _
"" & vbCrLf & _
" op_idx = op_stack = alloca(4000);" & vbCrLf
Const STR_SRC02 As String = _
" val_idx = val_stack = alloca(8000);" & vbCrLf & _
" l = &lookup;" & vbCrLf & _
" if (*(char *)(l + 32) == 0) {" & vbCrLf & _
" p = l;" & vbCrLf & _
" i = 0;" & vbCrLf & _
" while (i < 256) {" & vbCrLf & _
" *(char *)p++ = TOK_WHITE;" & vbCrLf & _
" i++;" & vbCrLf & _
" }" & vbCrLf & _
" *(char *)(l + '(') = TOK_LPAREN;" & vbCrLf & _
" *(char *)(l + ')') = TOK_RPAREN;" & vbCrLf & _
" *(char *)(l + '+') = TOK_ADD;" & vbCrLf & _
" *(char *)(l + '-') = TOK_ADD;" & vbCrLf & _
" *(char *)(l + '*') = TOK_MUL;" & vbCrLf & _
" *(char *)(l + '/') = TOK_MUL;" & vbCrLf & _
" *(char *)(l + '^') = TOK_POWER;" & vbCrLf & _
" *(char *)(l + '\\') = TOK_IDIV;" & vbCrLf & _
" *(char *)(l + '%') = TOK_MOD;" & vbCrLf & _
" *(char *)(l + '.') = TOK_NUM;" & vbCrLf & _
" p = l + '0';" & vbCrLf & _
" i = '0';" & vbCrLf
Const STR_SRC03 As String = _
" while (i <= '9') {" & vbCrLf & _
" *(char *)p++ = TOK_NUM;" & vbCrLf & _
" i++;" & vbCrLf & _
" }" & vbCrLf & _
" }" & vbCrLf & _
" prev_pr = 0;" & vbCrLf & _
" p = s;" & vbCrLf & _
" while ((ch = *(short *)p)) {" & vbCrLf & _
" if (!(ch >> 8)) {" & vbCrLf & _
" prec = *(char *)(l + ch);" & vbCrLf & _
" if (prec != TOK_WHITE) {" & vbCrLf & _
" if (prec == TOK_NUM) {" & vbCrLf & _
" val_idx = val_idx + 8;" & vbCrLf & _
" p = fast_val(p, val_idx);" & vbCrLf & _
" } else if (prec == TOK_ADD) {" & vbCrLf & _
" if (prev_pr >= TOK_ADD && prev_pr < TOK_NUM)" & vbCrLf & _
" prec = TOK_UNARY;" & vbCrLf & _
" }" & vbCrLf & _
" if (prec >= TOK_ADD && prec < TOK_NUM) {" & vbCrLf & _
" if(prec != TOK_UNARY)" & vbCrLf & _
" eval_stack(prec, op_stack, &op_idx, val_stack, &val_idx);" & vbCrLf
Const STR_SRC04 As String = _
" op_idx = op_idx + 4;" & vbCrLf & _
" *(int *)op_idx = (prec << 16) + ch;" & vbCrLf & _
" }" & vbCrLf & _
" prev_pr = prec;" & vbCrLf & _
" }" & vbCrLf & _
" }" & vbCrLf & _
" p++; p++;" & vbCrLf & _
" }" & vbCrLf & _
" eval_stack(TOK_FINAL, op_stack, &op_idx, val_stack, &val_idx);" & vbCrLf & _
" *(int *)pdbl = *(int *)val_idx;" & vbCrLf & _
" *(int *)(pdbl + 4) = *(int *)(val_idx + 4);" & vbCrLf & _
"}" & vbCrLf & _
"" & vbCrLf & _
"#define ASM_MOV_EAX_ _asm mov eax," & vbCrLf & _
"#define ASM_ADD_EAX_ _asm _emit 0x83 _asm _emit 0xc0 _asm _emit" & vbCrLf & _
"#define ASM_SUB_EAX_ _asm _emit 0x83 _asm _emit 0xe8 _asm _emit" & vbCrLf & _
"#define ASM_FSTP_EAX _asm _emit 0xdd _asm _emit 0x18" & vbCrLf & _
"#define ASM_FLD_EAX _asm _emit 0xdd _asm _emit 0x00" & vbCrLf & _
"#define ASM_FLD_EAX_ _asm _emit 0xdd _asm _emit 0x40 _asm _emit" & vbCrLf & _
"#define ASM_FADD_EAX _asm _emit 0xdc _asm _emit 0x00" & vbCrLf & _
"#define ASM_FADD_EAX_ _asm _emit 0xdc _asm _emit 0x40 _asm _emit" & vbCrLf
Const STR_SRC05 As String = _
"#define ASM_FADDP_ST1 _asm _emit 0xde _asm _emit 0xc1" & vbCrLf & _
"#define ASM_FSUB_EAX_ _asm _emit 0xdc _asm _emit 0x60 _asm _emit" & vbCrLf & _
"#define ASM_FMUL_EAX _asm _emit 0xdc _asm _emit 0x08" & vbCrLf & _
"#define ASM_FMUL_EAX_ _asm _emit 0xdc _asm _emit 0x48 _asm _emit" & vbCrLf & _
"#define ASM_FMULP_ST1 _asm _emit 0xde _asm _emit 0xc9" & vbCrLf & _
"#define ASM_FDIV_EAX _asm _emit 0xdc _asm _emit 0x30" & vbCrLf & _
"#define ASM_FDIV_EAX_ _asm _emit 0xdc _asm _emit 0x70 _asm _emit" & vbCrLf & _
"#define ASM_FCHS _asm _emit 0xd9 _asm _emit 0xe0" & vbCrLf & _
"#define ASM_FILD_EAX _asm _emit 0xdb _asm _emit 0x00" & vbCrLf & _
"#define ASM_FISTP_EAX _asm _emit 0xdb _asm _emit 0x18" & vbCrLf & _
"#define ASM_FYL2X _asm _emit 0xd9 _asm _emit 0xf1" & vbCrLf & _
"#define ASM_FLD1 _asm _emit 0xd9 _asm _emit 0xe8" & vbCrLf & _
"#define ASM_FLD_ST1 _asm _emit 0xd9 _asm _emit 0xc1" & vbCrLf & _
"#define ASM_FPREM _asm _emit 0xd9 _asm _emit 0xf8" & vbCrLf & _
"#define ASM_F2XM1 _asm _emit 0xd9 _asm _emit 0xf0" & vbCrLf & _
"#define ASM_FSCALE _asm _emit 0xd9 _asm _emit 0xfd" & vbCrLf & _
"#define ASM_FLDZ _asm _emit 0xd9 _asm _emit 0xee" & vbCrLf & _
"" & vbCrLf & _
"eval_stack(prec, op_stack, pop_idx, val_stack, pval_idx)" & vbCrLf & _
"{" & vbCrLf & _
" int op_idx, val_idx, op, t1, pt1, t2, pt2;" & vbCrLf
Const STR_SRC06 As String = _
"" & vbCrLf & _
" op_idx = *(int *)pop_idx;" & vbCrLf & _
" val_idx = *(int *)pval_idx;" & vbCrLf & _
" while (op_idx > op_stack) {" & vbCrLf & _
" if (*(int *)(op_idx) < (prec << 16))" & vbCrLf & _
" break;" & vbCrLf & _
" val_idx = val_idx - 8;" & vbCrLf & _
" op = *(short *)op_idx;" & vbCrLf & _
" if (op == '+') {" & vbCrLf & _
" if (*(int *)(op_idx) > (TOK_UNARY << 16)) {" & vbCrLf & _
" val_idx = val_idx + 8;" & vbCrLf & _
" } else {" & vbCrLf & _
" /* *(double *)val_idx = *(double *)val_idx + *(double *)(val_idx + 8); */" & vbCrLf & _
" ASM_MOV_EAX_(val_idx);" & vbCrLf & _
" ASM_FLD_EAX;" & vbCrLf & _
" ASM_FADD_EAX_(8);" & vbCrLf & _
" ASM_FSTP_EAX;" & vbCrLf & _
" }" & vbCrLf & _
" } else if (op == '-') {" & vbCrLf & _
" if (*(int *)(op_idx) > (TOK_UNARY << 16)) {" & vbCrLf & _
" val_idx = val_idx + 8;" & vbCrLf
Const STR_SRC07 As String = _
" /* *(double *)val_idx = -*(double *)val_idx; */" & vbCrLf & _
" ASM_MOV_EAX_(val_idx);" & vbCrLf & _
" ASM_FLD_EAX;" & vbCrLf & _
" ASM_FCHS;" & vbCrLf & _
" ASM_FSTP_EAX;" & vbCrLf & _
" } else {" & vbCrLf & _
" /* *(double *)val_idx = *(double *)val_idx - *(double *)(val_idx + 8); */" & vbCrLf & _
" ASM_MOV_EAX_(val_idx);" & vbCrLf & _
" ASM_FLD_EAX;" & vbCrLf & _
" ASM_FSUB_EAX_(8);" & vbCrLf & _
" ASM_FSTP_EAX;" & vbCrLf & _
" }" & vbCrLf & _
" } else if (op == '*') {" & vbCrLf & _
" /* *(double *)val_idx = *(double *)val_idx * *(double *)(val_idx + 8); */" & vbCrLf & _
" ASM_MOV_EAX_(val_idx);" & vbCrLf & _
" ASM_FLD_EAX;" & vbCrLf & _
" ASM_FMUL_EAX_(8);" & vbCrLf & _
" ASM_FSTP_EAX;" & vbCrLf & _
" } else if (op == '/') {" & vbCrLf & _
" /* *(double *)val_idx = *(double *)val_idx / *(double *)(val_idx + 8); */" & vbCrLf & _
" ASM_MOV_EAX_(val_idx);" & vbCrLf
Const STR_SRC08 As String = _
" ASM_FLD_EAX;" & vbCrLf & _
" ASM_FDIV_EAX_(8);" & vbCrLf & _
" ASM_FSTP_EAX;" & vbCrLf & _
" } else if (op == '^') {" & vbCrLf & _
" /* *(double *)val_idx = pow(*(double *)val_idx, *(double *)(val_idx + 8)); */" & vbCrLf & _
" ASM_MOV_EAX_(val_idx);" & vbCrLf & _
" ASM_ADD_EAX_(8);" & vbCrLf & _
" ASM_FLD_EAX;" & vbCrLf & _
" ASM_SUB_EAX_(8);" & vbCrLf & _
" ASM_FLD_EAX;" & vbCrLf & _
" ASM_FYL2X;" & vbCrLf & _
" ASM_FLD1;" & vbCrLf & _
" ASM_FLD_ST1;" & vbCrLf & _
" ASM_FPREM;" & vbCrLf & _
" ASM_F2XM1;" & vbCrLf & _
" ASM_FADDP_ST1;" & vbCrLf & _
" ASM_FSCALE;" & vbCrLf & _
" ASM_FSTP_EAX;" & vbCrLf & _
" } else if (op == '\\') {" & vbCrLf & _
" pt1 = &t1;" & vbCrLf & _
" /* *(double *)val_idx = (int)(*(double *)val_idx / *(double *)(val_idx + 8)); */" & vbCrLf
Const STR_SRC09 As String = _
" ASM_MOV_EAX_(val_idx);" & vbCrLf & _
" ASM_FLD_EAX;" & vbCrLf & _
" ASM_FDIV_EAX_(8);" & vbCrLf & _
" ASM_MOV_EAX_(pt1);" & vbCrLf & _
" ASM_FISTP_EAX;" & vbCrLf & _
" ASM_FILD_EAX;" & vbCrLf & _
" ASM_MOV_EAX_(val_idx);" & vbCrLf & _
" ASM_FSTP_EAX;" & vbCrLf & _
" } else if (op == '%') {" & vbCrLf & _
" pt1 = &t1;" & vbCrLf & _
" pt2 = &t2;" & vbCrLf & _
" /* *(double *)val_idx = (int)*(double *)val_idx % (int)*(double *)(val_idx + 8); */" & vbCrLf & _
" ASM_MOV_EAX_(val_idx);" & vbCrLf & _
" ASM_FLD_EAX;" & vbCrLf & _
" ASM_MOV_EAX_(pt1);" & vbCrLf & _
" ASM_FISTP_EAX;" & vbCrLf & _
" ASM_MOV_EAX_(val_idx);" & vbCrLf & _
" ASM_ADD_EAX_(8);" & vbCrLf & _
" ASM_FLD_EAX;" & vbCrLf & _
" ASM_MOV_EAX_(pt2);" & vbCrLf & _
" ASM_FISTP_EAX;" & vbCrLf
Const STR_SRC10 As String = _
" t1 = t1 % t2;" & vbCrLf & _
" ASM_MOV_EAX_(pt1);" & vbCrLf & _
" ASM_FILD_EAX;" & vbCrLf & _
" ASM_MOV_EAX_(val_idx);" & vbCrLf & _
" ASM_FSTP_EAX;" & vbCrLf & _
" } else if (op == '(') {" & vbCrLf & _
" val_idx = val_idx + 8;" & vbCrLf & _
" if (prec == TOK_RPAREN) {" & vbCrLf & _
" op_idx = op_idx - 4;" & vbCrLf & _
" break;" & vbCrLf & _
" } else if (prec > TOK_RPAREN)" & vbCrLf & _
" break;" & vbCrLf & _
" }" & vbCrLf & _
" op_idx = op_idx - 4;" & vbCrLf & _
" }" & vbCrLf & _
" *(int *)pval_idx = val_idx;" & vbCrLf & _
" *(int *)pop_idx = op_idx;" & vbCrLf & _
"}" & vbCrLf & _
"" & vbCrLf & _
"fast_val(p, pdbl)" & vbCrLf & _
"{" & vbCrLf
Const STR_SRC11 As String = _
" int ch, addr;" & vbCrLf & _
" int newval, esgn, eint, hasfrac;" & vbCrLf & _
" int intpart, fracpart, fracdiv, dbl10; /* doubles */" & vbCrLf & _
"" & vbCrLf & _
" intpart = alloca(8);" & vbCrLf & _
" fracpart = alloca(8);" & vbCrLf & _
" fracdiv = alloca(8);" & vbCrLf & _
" dbl10 = alloca(8);" & vbCrLf & _
" newval = esgn = hasfrac = 0;" & vbCrLf & _
" /* *(double *)intpart = *(double *)fracpart = 0 */" & vbCrLf & _
" ASM_FLDZ;" & vbCrLf & _
" ASM_MOV_EAX_(intpart);" & vbCrLf & _
" ASM_FSTP_EAX;" & vbCrLf & _
" ASM_FLDZ;" & vbCrLf & _
" ASM_MOV_EAX_(fracpart);" & vbCrLf & _
" ASM_FSTP_EAX;" & vbCrLf & _
" /* *(double *)fracdiv = 1 */" & vbCrLf & _
" ASM_FLD1;" & vbCrLf & _
" ASM_MOV_EAX_(fracdiv);" & vbCrLf & _
" ASM_FSTP_EAX;" & vbCrLf & _
" /* *(double *)dbl10 = 10 */" & vbCrLf
Const STR_SRC12 As String = _
" ch = 10;" & vbCrLf & _
" addr = &ch;" & vbCrLf & _
" ASM_MOV_EAX_(addr);" & vbCrLf & _
" ASM_FILD_EAX;" & vbCrLf & _
" ASM_MOV_EAX_(dbl10);" & vbCrLf & _
" ASM_FSTP_EAX;" & vbCrLf & _
" while ((ch = *(short *)p)) {" & vbCrLf & _
" if (ch >= '0' && ch <= '9') {" & vbCrLf & _
" newval = 1;" & vbCrLf & _
" if (esgn) {" & vbCrLf & _
" eint = eint * 10 + ch - '0';" & vbCrLf & _
" } else {" & vbCrLf & _
" ch = ch - '0';" & vbCrLf & _
" if(!hasfrac) {" & vbCrLf & _
" /* *(double *)intpart = *(double *)intpart * *(double*)dbl10 + ch; */" & vbCrLf & _
" ASM_MOV_EAX_(intpart);" & vbCrLf & _
" ASM_FLD_EAX;" & vbCrLf & _
" ASM_MOV_EAX_(dbl10);" & vbCrLf & _
" ASM_FMUL_EAX;" & vbCrLf & _
" addr = &ch;" & vbCrLf & _
" ASM_MOV_EAX_(addr);" & vbCrLf
Const STR_SRC13 As String = _
" ASM_FILD_EAX;" & vbCrLf & _
" ASM_FADDP_ST1;" & vbCrLf & _
" ASM_MOV_EAX_(intpart);" & vbCrLf & _
" ASM_FSTP_EAX" & vbCrLf & _
" } else {" & vbCrLf & _
" /* *(double *)fracpart = *(double *)fracpart * *(double*)dbl10 + ch; */" & vbCrLf & _
" ASM_MOV_EAX_(fracpart);" & vbCrLf & _
" ASM_FLD_EAX;" & vbCrLf & _
" ASM_MOV_EAX_(dbl10);" & vbCrLf & _
" ASM_FMUL_EAX;" & vbCrLf & _
" addr = &ch;" & vbCrLf & _
" ASM_MOV_EAX_(addr);" & vbCrLf & _
" ASM_FILD_EAX;" & vbCrLf & _
" ASM_FADDP_ST1;" & vbCrLf & _
" ASM_MOV_EAX_(fracpart);" & vbCrLf & _
" ASM_FSTP_EAX" & vbCrLf & _
" /* *(double *)fracdiv = *(double *)fracdiv * *(double*)dbl10; */" & vbCrLf & _
" ASM_MOV_EAX_(fracdiv);" & vbCrLf & _
" ASM_FLD_EAX;" & vbCrLf & _
" ASM_MOV_EAX_(dbl10);" & vbCrLf & _
" ASM_FMUL_EAX;" & vbCrLf
Const STR_SRC14 As String = _
" ASM_MOV_EAX_(fracdiv);" & vbCrLf & _
" ASM_FSTP_EAX" & vbCrLf & _
" }" & vbCrLf & _
" }" & vbCrLf & _
" } else if (ch == '.') {" & vbCrLf & _
" if (hasfrac)" & vbCrLf & _
" break;" & vbCrLf & _
" newval = 1;" & vbCrLf & _
" hasfrac = 1;" & vbCrLf & _
" } else if (ch == 'e' || ch == 'E') {" & vbCrLf & _
" if (esgn)" & vbCrLf & _
" break;" & vbCrLf & _
" esgn = newval;" & vbCrLf & _
" eint = 0;" & vbCrLf & _
" } else if (ch == '-') {" & vbCrLf & _
" if (esgn > 0)" & vbCrLf & _
" esgn = -1;" & vbCrLf & _
" else" & vbCrLf & _
" break;" & vbCrLf & _
" } else" & vbCrLf & _
" break;" & vbCrLf
Const STR_SRC15 As String = _
" p++; p++;" & vbCrLf & _
" }" & vbCrLf & _
" /* *(double *)pdbl = newval * *(double *)intpart; */" & vbCrLf & _
" addr = &newval;" & vbCrLf & _
" ASM_MOV_EAX_(addr);" & vbCrLf & _
" ASM_FILD_EAX;" & vbCrLf & _
" ASM_MOV_EAX_(intpart);" & vbCrLf & _
" ASM_FMUL_EAX;" & vbCrLf & _
" ASM_MOV_EAX_(pdbl);" & vbCrLf & _
" ASM_FSTP_EAX" & vbCrLf & _
" if (hasfrac) {" & vbCrLf & _
" /* *(double *)pdbl = *(double *)pdbl + newval * *(double *)fracpart / *(double *)fracdiv; */" & vbCrLf & _
" addr = &newval;" & vbCrLf & _
" ASM_MOV_EAX_(addr);" & vbCrLf & _
" ASM_FILD_EAX;" & vbCrLf & _
" ASM_MOV_EAX_(fracpart);" & vbCrLf & _
" ASM_FMUL_EAX;" & vbCrLf & _
" ASM_MOV_EAX_(fracdiv);" & vbCrLf & _
" ASM_FDIV_EAX;" & vbCrLf & _
" ASM_MOV_EAX_(pdbl);" & vbCrLf & _
" ASM_FADD_EAX;" & vbCrLf
Const STR_SRC16 As String = _
" ASM_FSTP_EAX" & vbCrLf & _
" }" & vbCrLf & _
" if (esgn) {" & vbCrLf & _
" /* *(double *)pdbl = *(double *)pdbl * pow(dbl10, esgn * eint); */" & vbCrLf & _
" addr = &esgn;" & vbCrLf & _
" ASM_MOV_EAX_(addr);" & vbCrLf & _
" ASM_FILD_EAX;" & vbCrLf & _
" addr = &eint;" & vbCrLf & _
" ASM_MOV_EAX_(addr);" & vbCrLf & _
" ASM_FILD_EAX;" & vbCrLf & _
" ASM_FMULP_ST1;" & vbCrLf & _
" ASM_MOV_EAX_(dbl10);" & vbCrLf & _
" ASM_FLD_EAX;" & vbCrLf & _
" ASM_FYL2X;" & vbCrLf & _
" ASM_FLD1;" & vbCrLf & _
" ASM_FLD_ST1;" & vbCrLf & _
" ASM_FPREM;" & vbCrLf & _
" ASM_F2XM1;" & vbCrLf & _
" ASM_FADDP_ST1;" & vbCrLf & _
" ASM_FSCALE;" & vbCrLf & _
" ASM_MOV_EAX_(pdbl);" & vbCrLf
Const STR_SRC17 As String = _
" ASM_FMUL_EAX;" & vbCrLf & _
" ASM_FSTP_EAX;" & vbCrLf & _
" }" & vbCrLf & _
" return p;" & vbCrLf & _
"}"
Dim src As String
If m_ctx.m_state(31) = 0 Then
src = STR_SRC01 & STR_SRC02 & STR_SRC03 & STR_SRC04 & STR_SRC05 & STR_SRC06 & STR_SRC07 & STR_SRC08 & STR_SRC09 & _
STR_SRC10 & STR_SRC11 & STR_SRC12 & STR_SRC13 & STR_SRC14 & STR_SRC15 & STR_SRC16 & STR_SRC17
m_ctx.m_state(31) = RtccCompile(m_ctx, src)
PatchFunc AddressOf pvProtoSimpleEval
End If
pvProtoSimpleEval m_ctx.m_state(31), StrPtr(sText), VarPtr(InlineSimpleEval)
End Function