Page 2 of 2 FirstFirst 12
Results 41 to 57 of 57

Thread: simple math string parser

  1. #41
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: simple math string parser

    You can do a search for it in the MSDN Library CHM Help and mark it as a "favorite" there as well. You'll probably get hits on two VBA entries and a VB6 entry along with a lot of red herrings if you search on "Operator Precedence"
    Last edited by dilettante; Mar 22nd, 2018 at 07:56 PM.

  2. #42
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,853

    Re: simple math string parser

    It's the following one that's the most confusing:

    Code:
    
    Debug.Print 2 ^ -3 ^ 2
    
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  3. #43
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: simple math string parser

    It took me a while to figure out why dilettante's VEval class was faster than my SimpleEval over 100k iterations. It turned out that having a local array like `Dim aValStack(0 To 1000) As Double` in a function induces a penalty for clearing it's members to zeroes, so just switching to `Static` arrays doubled my speed.

    Nevertheless I peeked at the assembly code VB6 was producing for the simple parser and got really frustrated with the inefficiencies produced by array indexing and what not. So came up with the idea to hoist a small C compiler (namely Obfuscated Tiny C Compiler), embed it as a machine code thunk and re-write my shunting yard implementation in the subset of C this compiler supports. I had to tweak OTCC to support inline assembly for the floating-point operations and other bits and pieces but the result is worth it.

    Currently the following inline C version of the parser is 3 times faster that VB6 impl SimpleEval from above (w/ `Static` optimizations).

    thinBasic Code:
    1. ' << big snip >>
    2. ' Complete code in the attached zip
    3.  
    4. Public Function InlineSimpleEval(sText As String) As Double
    5.     Const STR_SRC01 As String = _
    6.         "#define TOK_FINAL     0" & vbCrLf & _
    7.         "#define TOK_RPAREN    1" & vbCrLf & _
    8.         "#define TOK_ADD       2" & vbCrLf & _
    9.         "#define TOK_MOD       3" & vbCrLf & _
    10.         "#define TOK_IDIV      4" & vbCrLf & _
    11.         "#define TOK_MUL       5" & vbCrLf & _
    12.         "#define TOK_UNARY     6" & vbCrLf & _
    13.         "#define TOK_POWER     7" & vbCrLf & _
    14.         "#define TOK_LPAREN    8" & vbCrLf & _
    15.         "#define TOK_NUM       9" & vbCrLf & _
    16.         "#define TOK_WHITE     10" & vbCrLf & _
    17.         "" & vbCrLf & _
    18.         "int lookup[256];" & vbCrLf & _
    19.         "" & vbCrLf & _
    20.         "simple_eval(s, pdbl)" & vbCrLf & _
    21.         "{" & vbCrLf & _
    22.         "    int i, p, l, ch, prec, prev_pr;" & vbCrLf & _
    23.         "    int op_stack, op_idx;" & vbCrLf & _
    24.         "    int val_stack, val_idx;" & vbCrLf & _
    25.         "" & vbCrLf & _
    26.         "    op_idx = op_stack = alloca(4000);" & vbCrLf
    27.     Const STR_SRC02 As String = _
    28.         "    val_idx = val_stack = alloca(8000);" & vbCrLf & _
    29.         "    l = &lookup;" & vbCrLf & _
    30.         "    if (*(char *)(l + 32) == 0) {" & vbCrLf & _
    31.         "        p = l;" & vbCrLf & _
    32.         "        i = 0;" & vbCrLf & _
    33.         "        while (i < 256) {" & vbCrLf & _
    34.         "            *(char *)p++ = TOK_WHITE;" & vbCrLf & _
    35.         "            i++;" & vbCrLf & _
    36.         "        }" & vbCrLf & _
    37.         "        *(char *)(l + '(') = TOK_LPAREN;" & vbCrLf & _
    38.         "        *(char *)(l + ')') = TOK_RPAREN;" & vbCrLf & _
    39.         "        *(char *)(l + '+') = TOK_ADD;" & vbCrLf & _
    40.         "        *(char *)(l + '-') = TOK_ADD;" & vbCrLf & _
    41.         "        *(char *)(l + '*') = TOK_MUL;" & vbCrLf & _
    42.         "        *(char *)(l + '/') = TOK_MUL;" & vbCrLf & _
    43.         "        *(char *)(l + '^') = TOK_POWER;" & vbCrLf & _
    44.         "        *(char *)(l + '\\') = TOK_IDIV;" & vbCrLf & _
    45.         "        *(char *)(l + '%') = TOK_MOD;" & vbCrLf & _
    46.         "        *(char *)(l + '.') = TOK_NUM;" & vbCrLf & _
    47.         "        p = l + '0';" & vbCrLf & _
    48.         "        i = '0';" & vbCrLf
    49.     Const STR_SRC03 As String = _
    50.         "        while (i <= '9') {" & vbCrLf & _
    51.         "            *(char *)p++ = TOK_NUM;" & vbCrLf & _
    52.         "            i++;" & vbCrLf & _
    53.         "        }" & vbCrLf & _
    54.         "    }" & vbCrLf & _
    55.         "    prev_pr = 0;" & vbCrLf & _
    56.         "    p = s;" & vbCrLf & _
    57.         "    while ((ch = *(short *)p)) {" & vbCrLf & _
    58.         "        if (!(ch >> 8)) {" & vbCrLf & _
    59.         "            prec = *(char *)(l + ch);" & vbCrLf & _
    60.         "            if (prec != TOK_WHITE) {" & vbCrLf & _
    61.         "                if (prec == TOK_NUM) {" & vbCrLf & _
    62.         "                    val_idx = val_idx + 8;" & vbCrLf & _
    63.         "                    p = fast_val(p, val_idx);" & vbCrLf & _
    64.         "                } else if (prec == TOK_ADD) {" & vbCrLf & _
    65.         "                    if (prev_pr >= TOK_ADD && prev_pr < TOK_NUM)" & vbCrLf & _
    66.         "                        prec = TOK_UNARY;" & vbCrLf & _
    67.         "                }" & vbCrLf & _
    68.         "                if (prec >= TOK_ADD && prec < TOK_NUM) {" & vbCrLf & _
    69.         "                    if(prec != TOK_UNARY)" & vbCrLf & _
    70.         "                        eval_stack(prec, op_stack, &op_idx, val_stack, &val_idx);" & vbCrLf
    71.     Const STR_SRC04 As String = _
    72.         "                    op_idx = op_idx + 4;" & vbCrLf & _
    73.         "                    *(int *)op_idx = (prec << 16) + ch;" & vbCrLf & _
    74.         "                }" & vbCrLf & _
    75.         "                prev_pr = prec;" & vbCrLf & _
    76.         "            }" & vbCrLf & _
    77.         "        }" & vbCrLf & _
    78.         "        p++; p++;" & vbCrLf & _
    79.         "    }" & vbCrLf & _
    80.         "    eval_stack(TOK_FINAL, op_stack, &op_idx, val_stack, &val_idx);" & vbCrLf & _
    81.         "    *(int *)pdbl = *(int *)val_idx;" & vbCrLf & _
    82.         "    *(int *)(pdbl + 4) = *(int *)(val_idx + 4);" & vbCrLf & _
    83.         "}" & vbCrLf & _
    84.         "" & vbCrLf & _
    85.         "#define ASM_MOV_EAX_    _asm mov eax," & vbCrLf & _
    86.         "#define ASM_ADD_EAX_    _asm _emit 0x83 _asm _emit 0xc0 _asm _emit" & vbCrLf & _
    87.         "#define ASM_SUB_EAX_    _asm _emit 0x83 _asm _emit 0xe8 _asm _emit" & vbCrLf & _
    88.         "#define ASM_FSTP_EAX    _asm _emit 0xdd _asm _emit 0x18" & vbCrLf & _
    89.         "#define ASM_FLD_EAX     _asm _emit 0xdd _asm _emit 0x00" & vbCrLf & _
    90.         "#define ASM_FLD_EAX_    _asm _emit 0xdd _asm _emit 0x40 _asm _emit" & vbCrLf & _
    91.         "#define ASM_FADD_EAX    _asm _emit 0xdc _asm _emit 0x00" & vbCrLf & _
    92.         "#define ASM_FADD_EAX_   _asm _emit 0xdc _asm _emit 0x40 _asm _emit" & vbCrLf
    93.     Const STR_SRC05 As String = _
    94.         "#define ASM_FADDP_ST1   _asm _emit 0xde _asm _emit 0xc1" & vbCrLf & _
    95.         "#define ASM_FSUB_EAX_   _asm _emit 0xdc _asm _emit 0x60 _asm _emit" & vbCrLf & _
    96.         "#define ASM_FMUL_EAX    _asm _emit 0xdc _asm _emit 0x08" & vbCrLf & _
    97.         "#define ASM_FMUL_EAX_   _asm _emit 0xdc _asm _emit 0x48 _asm _emit" & vbCrLf & _
    98.         "#define ASM_FMULP_ST1   _asm _emit 0xde _asm _emit 0xc9" & vbCrLf & _
    99.         "#define ASM_FDIV_EAX    _asm _emit 0xdc _asm _emit 0x30" & vbCrLf & _
    100.         "#define ASM_FDIV_EAX_   _asm _emit 0xdc _asm _emit 0x70 _asm _emit" & vbCrLf & _
    101.         "#define ASM_FCHS        _asm _emit 0xd9 _asm _emit 0xe0" & vbCrLf & _
    102.         "#define ASM_FILD_EAX    _asm _emit 0xdb _asm _emit 0x00" & vbCrLf & _
    103.         "#define ASM_FISTP_EAX   _asm _emit 0xdb _asm _emit 0x18" & vbCrLf & _
    104.         "#define ASM_FYL2X       _asm _emit 0xd9 _asm _emit 0xf1" & vbCrLf & _
    105.         "#define ASM_FLD1        _asm _emit 0xd9 _asm _emit 0xe8" & vbCrLf & _
    106.         "#define ASM_FLD_ST1     _asm _emit 0xd9 _asm _emit 0xc1" & vbCrLf & _
    107.         "#define ASM_FPREM       _asm _emit 0xd9 _asm _emit 0xf8" & vbCrLf & _
    108.         "#define ASM_F2XM1       _asm _emit 0xd9 _asm _emit 0xf0" & vbCrLf & _
    109.         "#define ASM_FSCALE      _asm _emit 0xd9 _asm _emit 0xfd" & vbCrLf & _
    110.         "#define ASM_FLDZ        _asm _emit 0xd9 _asm _emit 0xee" & vbCrLf & _
    111.         "" & vbCrLf & _
    112.         "eval_stack(prec, op_stack, pop_idx, val_stack, pval_idx)" & vbCrLf & _
    113.         "{" & vbCrLf & _
    114.         "    int op_idx, val_idx, op, t1, pt1, t2, pt2;" & vbCrLf
    115.     Const STR_SRC06 As String = _
    116.         "" & vbCrLf & _
    117.         "    op_idx = *(int *)pop_idx;" & vbCrLf & _
    118.         "    val_idx = *(int *)pval_idx;" & vbCrLf & _
    119.         "    while (op_idx > op_stack) {" & vbCrLf & _
    120.         "        if (*(int *)(op_idx) < (prec << 16))" & vbCrLf & _
    121.         "            break;" & vbCrLf & _
    122.         "        val_idx = val_idx - 8;" & vbCrLf & _
    123.         "        op = *(short *)op_idx;" & vbCrLf & _
    124.         "        if (op == '+') {" & vbCrLf & _
    125.         "            if (*(int *)(op_idx) > (TOK_UNARY << 16)) {" & vbCrLf & _
    126.         "                val_idx = val_idx + 8;" & vbCrLf & _
    127.         "            } else {" & vbCrLf & _
    128.         "                /* *(double *)val_idx = *(double *)val_idx + *(double *)(val_idx + 8); */" & vbCrLf & _
    129.         "                ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    130.         "                ASM_FLD_EAX;" & vbCrLf & _
    131.         "                ASM_FADD_EAX_(8);" & vbCrLf & _
    132.         "                ASM_FSTP_EAX;" & vbCrLf & _
    133.         "            }" & vbCrLf & _
    134.         "        } else if (op == '-') {" & vbCrLf & _
    135.         "            if (*(int *)(op_idx) > (TOK_UNARY << 16)) {" & vbCrLf & _
    136.         "                val_idx = val_idx + 8;" & vbCrLf
    137.     Const STR_SRC07 As String = _
    138.         "                /* *(double *)val_idx = -*(double *)val_idx; */" & vbCrLf & _
    139.         "                ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    140.         "                ASM_FLD_EAX;" & vbCrLf & _
    141.         "                ASM_FCHS;" & vbCrLf & _
    142.         "                ASM_FSTP_EAX;" & vbCrLf & _
    143.         "            } else {" & vbCrLf & _
    144.         "                /* *(double *)val_idx = *(double *)val_idx - *(double *)(val_idx + 8); */" & vbCrLf & _
    145.         "                ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    146.         "                ASM_FLD_EAX;" & vbCrLf & _
    147.         "                ASM_FSUB_EAX_(8);" & vbCrLf & _
    148.         "                ASM_FSTP_EAX;" & vbCrLf & _
    149.         "            }" & vbCrLf & _
    150.         "        } else if (op == '*') {" & vbCrLf & _
    151.         "            /* *(double *)val_idx = *(double *)val_idx * *(double *)(val_idx + 8); */" & vbCrLf & _
    152.         "            ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    153.         "            ASM_FLD_EAX;" & vbCrLf & _
    154.         "            ASM_FMUL_EAX_(8);" & vbCrLf & _
    155.         "            ASM_FSTP_EAX;" & vbCrLf & _
    156.         "        } else if (op == '/') {" & vbCrLf & _
    157.         "            /* *(double *)val_idx = *(double *)val_idx / *(double *)(val_idx + 8); */" & vbCrLf & _
    158.         "            ASM_MOV_EAX_(val_idx);" & vbCrLf
    159.     Const STR_SRC08 As String = _
    160.         "            ASM_FLD_EAX;" & vbCrLf & _
    161.         "            ASM_FDIV_EAX_(8);" & vbCrLf & _
    162.         "            ASM_FSTP_EAX;" & vbCrLf & _
    163.         "        } else if (op == '^') {" & vbCrLf & _
    164.         "            /* *(double *)val_idx = pow(*(double *)val_idx, *(double *)(val_idx + 8)); */" & vbCrLf & _
    165.         "            ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    166.         "            ASM_ADD_EAX_(8);" & vbCrLf & _
    167.         "            ASM_FLD_EAX;" & vbCrLf & _
    168.         "            ASM_SUB_EAX_(8);" & vbCrLf & _
    169.         "            ASM_FLD_EAX;" & vbCrLf & _
    170.         "            ASM_FYL2X;" & vbCrLf & _
    171.         "            ASM_FLD1;" & vbCrLf & _
    172.         "            ASM_FLD_ST1;" & vbCrLf & _
    173.         "            ASM_FPREM;" & vbCrLf & _
    174.         "            ASM_F2XM1;" & vbCrLf & _
    175.         "            ASM_FADDP_ST1;" & vbCrLf & _
    176.         "            ASM_FSCALE;" & vbCrLf & _
    177.         "            ASM_FSTP_EAX;" & vbCrLf & _
    178.         "        } else if (op == '\\') {" & vbCrLf & _
    179.         "            pt1 = &t1;" & vbCrLf & _
    180.         "            /* *(double *)val_idx = (int)(*(double *)val_idx / *(double *)(val_idx + 8)); */" & vbCrLf
    181.     Const STR_SRC09 As String = _
    182.         "            ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    183.         "            ASM_FLD_EAX;" & vbCrLf & _
    184.         "            ASM_FDIV_EAX_(8);" & vbCrLf & _
    185.         "            ASM_MOV_EAX_(pt1);" & vbCrLf & _
    186.         "            ASM_FISTP_EAX;" & vbCrLf & _
    187.         "            ASM_FILD_EAX;" & vbCrLf & _
    188.         "            ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    189.         "            ASM_FSTP_EAX;" & vbCrLf & _
    190.         "        } else if (op == '%') {" & vbCrLf & _
    191.         "            pt1 = &t1;" & vbCrLf & _
    192.         "            pt2 = &t2;" & vbCrLf & _
    193.         "            /* *(double *)val_idx = (int)*(double *)val_idx % (int)*(double *)(val_idx + 8); */" & vbCrLf & _
    194.         "            ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    195.         "            ASM_FLD_EAX;" & vbCrLf & _
    196.         "            ASM_MOV_EAX_(pt1);" & vbCrLf & _
    197.         "            ASM_FISTP_EAX;" & vbCrLf & _
    198.         "            ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    199.         "            ASM_ADD_EAX_(8);" & vbCrLf & _
    200.         "            ASM_FLD_EAX;" & vbCrLf & _
    201.         "            ASM_MOV_EAX_(pt2);" & vbCrLf & _
    202.         "            ASM_FISTP_EAX;" & vbCrLf
    203.     Const STR_SRC10 As String = _
    204.         "            t1 = t1 % t2;" & vbCrLf & _
    205.         "            ASM_MOV_EAX_(pt1);" & vbCrLf & _
    206.         "            ASM_FILD_EAX;" & vbCrLf & _
    207.         "            ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    208.         "            ASM_FSTP_EAX;" & vbCrLf & _
    209.         "        } else if (op == '(') {" & vbCrLf & _
    210.         "            val_idx = val_idx + 8;" & vbCrLf & _
    211.         "            if (prec == TOK_RPAREN) {" & vbCrLf & _
    212.         "                op_idx = op_idx - 4;" & vbCrLf & _
    213.         "                break;" & vbCrLf & _
    214.         "            } else if (prec > TOK_RPAREN)" & vbCrLf & _
    215.         "                break;" & vbCrLf & _
    216.         "        }" & vbCrLf & _
    217.         "        op_idx = op_idx - 4;" & vbCrLf & _
    218.         "    }" & vbCrLf & _
    219.         "    *(int *)pval_idx = val_idx;" & vbCrLf & _
    220.         "    *(int *)pop_idx = op_idx;" & vbCrLf & _
    221.         "}" & vbCrLf & _
    222.         "" & vbCrLf & _
    223.         "fast_val(p, pdbl)" & vbCrLf & _
    224.         "{" & vbCrLf
    225.     Const STR_SRC11 As String = _
    226.         "    int ch, addr;" & vbCrLf & _
    227.         "    int newval, esgn, eint, hasfrac;" & vbCrLf & _
    228.         "    int intpart, fracpart, fracdiv, dbl10; /* doubles */" & vbCrLf & _
    229.         "" & vbCrLf & _
    230.         "    intpart = alloca(8);" & vbCrLf & _
    231.         "    fracpart = alloca(8);" & vbCrLf & _
    232.         "    fracdiv = alloca(8);" & vbCrLf & _
    233.         "    dbl10 = alloca(8);" & vbCrLf & _
    234.         "    newval = esgn = hasfrac = 0;" & vbCrLf & _
    235.         "    /* *(double *)intpart = *(double *)fracpart = 0 */" & vbCrLf & _
    236.         "    ASM_FLDZ;" & vbCrLf & _
    237.         "    ASM_MOV_EAX_(intpart);" & vbCrLf & _
    238.         "    ASM_FSTP_EAX;" & vbCrLf & _
    239.         "    ASM_FLDZ;" & vbCrLf & _
    240.         "    ASM_MOV_EAX_(fracpart);" & vbCrLf & _
    241.         "    ASM_FSTP_EAX;" & vbCrLf & _
    242.         "    /* *(double *)fracdiv = 1 */" & vbCrLf & _
    243.         "    ASM_FLD1;" & vbCrLf & _
    244.         "    ASM_MOV_EAX_(fracdiv);" & vbCrLf & _
    245.         "    ASM_FSTP_EAX;" & vbCrLf & _
    246.         "    /* *(double *)dbl10 = 10 */" & vbCrLf
    247.     Const STR_SRC12 As String = _
    248.         "    ch = 10;" & vbCrLf & _
    249.         "    addr = &ch;" & vbCrLf & _
    250.         "    ASM_MOV_EAX_(addr);" & vbCrLf & _
    251.         "    ASM_FILD_EAX;" & vbCrLf & _
    252.         "    ASM_MOV_EAX_(dbl10);" & vbCrLf & _
    253.         "    ASM_FSTP_EAX;" & vbCrLf & _
    254.         "    while ((ch = *(short *)p)) {" & vbCrLf & _
    255.         "        if (ch >= '0' && ch <= '9') {" & vbCrLf & _
    256.         "            newval = 1;" & vbCrLf & _
    257.         "            if (esgn) {" & vbCrLf & _
    258.         "                eint = eint * 10 + ch - '0';" & vbCrLf & _
    259.         "            } else {" & vbCrLf & _
    260.         "                ch = ch - '0';" & vbCrLf & _
    261.         "                if(!hasfrac) {" & vbCrLf & _
    262.         "                    /* *(double *)intpart = *(double *)intpart * *(double*)dbl10 + ch; */" & vbCrLf & _
    263.         "                    ASM_MOV_EAX_(intpart);" & vbCrLf & _
    264.         "                    ASM_FLD_EAX;" & vbCrLf & _
    265.         "                    ASM_MOV_EAX_(dbl10);" & vbCrLf & _
    266.         "                    ASM_FMUL_EAX;" & vbCrLf & _
    267.         "                    addr = &ch;" & vbCrLf & _
    268.         "                    ASM_MOV_EAX_(addr);" & vbCrLf
    269.     Const STR_SRC13 As String = _
    270.         "                    ASM_FILD_EAX;" & vbCrLf & _
    271.         "                    ASM_FADDP_ST1;" & vbCrLf & _
    272.         "                    ASM_MOV_EAX_(intpart);" & vbCrLf & _
    273.         "                    ASM_FSTP_EAX" & vbCrLf & _
    274.         "                } else {" & vbCrLf & _
    275.         "                    /* *(double *)fracpart = *(double *)fracpart * *(double*)dbl10 + ch; */" & vbCrLf & _
    276.         "                    ASM_MOV_EAX_(fracpart);" & vbCrLf & _
    277.         "                    ASM_FLD_EAX;" & vbCrLf & _
    278.         "                    ASM_MOV_EAX_(dbl10);" & vbCrLf & _
    279.         "                    ASM_FMUL_EAX;" & vbCrLf & _
    280.         "                    addr = &ch;" & vbCrLf & _
    281.         "                    ASM_MOV_EAX_(addr);" & vbCrLf & _
    282.         "                    ASM_FILD_EAX;" & vbCrLf & _
    283.         "                    ASM_FADDP_ST1;" & vbCrLf & _
    284.         "                    ASM_MOV_EAX_(fracpart);" & vbCrLf & _
    285.         "                    ASM_FSTP_EAX" & vbCrLf & _
    286.         "                    /* *(double *)fracdiv = *(double *)fracdiv * *(double*)dbl10; */" & vbCrLf & _
    287.         "                    ASM_MOV_EAX_(fracdiv);" & vbCrLf & _
    288.         "                    ASM_FLD_EAX;" & vbCrLf & _
    289.         "                    ASM_MOV_EAX_(dbl10);" & vbCrLf & _
    290.         "                    ASM_FMUL_EAX;" & vbCrLf
    291.     Const STR_SRC14 As String = _
    292.         "                    ASM_MOV_EAX_(fracdiv);" & vbCrLf & _
    293.         "                    ASM_FSTP_EAX" & vbCrLf & _
    294.         "                }" & vbCrLf & _
    295.         "            }" & vbCrLf & _
    296.         "        } else if (ch == '.') {" & vbCrLf & _
    297.         "            if (hasfrac)" & vbCrLf & _
    298.         "                break;" & vbCrLf & _
    299.         "            newval = 1;" & vbCrLf & _
    300.         "            hasfrac = 1;" & vbCrLf & _
    301.         "        } else if (ch == 'e' || ch == 'E') {" & vbCrLf & _
    302.         "            if (esgn)" & vbCrLf & _
    303.         "                break;" & vbCrLf & _
    304.         "            esgn = newval;" & vbCrLf & _
    305.         "            eint = 0;" & vbCrLf & _
    306.         "        } else if (ch == '-') {" & vbCrLf & _
    307.         "            if (esgn > 0)" & vbCrLf & _
    308.         "                esgn = -1;" & vbCrLf & _
    309.         "            else" & vbCrLf & _
    310.         "                break;" & vbCrLf & _
    311.         "        } else" & vbCrLf & _
    312.         "            break;" & vbCrLf
    313.     Const STR_SRC15 As String = _
    314.         "        p++; p++;" & vbCrLf & _
    315.         "    }" & vbCrLf & _
    316.         "    /* *(double *)pdbl = newval * *(double *)intpart; */" & vbCrLf & _
    317.         "    addr = &newval;" & vbCrLf & _
    318.         "    ASM_MOV_EAX_(addr);" & vbCrLf & _
    319.         "    ASM_FILD_EAX;" & vbCrLf & _
    320.         "    ASM_MOV_EAX_(intpart);" & vbCrLf & _
    321.         "    ASM_FMUL_EAX;" & vbCrLf & _
    322.         "    ASM_MOV_EAX_(pdbl);" & vbCrLf & _
    323.         "    ASM_FSTP_EAX" & vbCrLf & _
    324.         "    if (hasfrac) {" & vbCrLf & _
    325.         "        /* *(double *)pdbl = *(double *)pdbl + newval * *(double *)fracpart / *(double *)fracdiv; */" & vbCrLf & _
    326.         "        addr = &newval;" & vbCrLf & _
    327.         "        ASM_MOV_EAX_(addr);" & vbCrLf & _
    328.         "        ASM_FILD_EAX;" & vbCrLf & _
    329.         "        ASM_MOV_EAX_(fracpart);" & vbCrLf & _
    330.         "        ASM_FMUL_EAX;" & vbCrLf & _
    331.         "        ASM_MOV_EAX_(fracdiv);" & vbCrLf & _
    332.         "        ASM_FDIV_EAX;" & vbCrLf & _
    333.         "        ASM_MOV_EAX_(pdbl);" & vbCrLf & _
    334.         "        ASM_FADD_EAX;" & vbCrLf
    335.     Const STR_SRC16 As String = _
    336.         "        ASM_FSTP_EAX" & vbCrLf & _
    337.         "    }" & vbCrLf & _
    338.         "    if (esgn) {" & vbCrLf & _
    339.         "        /* *(double *)pdbl = *(double *)pdbl * pow(dbl10, esgn * eint); */" & vbCrLf & _
    340.         "        addr = &esgn;" & vbCrLf & _
    341.         "        ASM_MOV_EAX_(addr);" & vbCrLf & _
    342.         "        ASM_FILD_EAX;" & vbCrLf & _
    343.         "        addr = &eint;" & vbCrLf & _
    344.         "        ASM_MOV_EAX_(addr);" & vbCrLf & _
    345.         "        ASM_FILD_EAX;" & vbCrLf & _
    346.         "        ASM_FMULP_ST1;" & vbCrLf & _
    347.         "        ASM_MOV_EAX_(dbl10);" & vbCrLf & _
    348.         "        ASM_FLD_EAX;" & vbCrLf & _
    349.         "        ASM_FYL2X;" & vbCrLf & _
    350.         "        ASM_FLD1;" & vbCrLf & _
    351.         "        ASM_FLD_ST1;" & vbCrLf & _
    352.         "        ASM_FPREM;" & vbCrLf & _
    353.         "        ASM_F2XM1;" & vbCrLf & _
    354.         "        ASM_FADDP_ST1;" & vbCrLf & _
    355.         "        ASM_FSCALE;" & vbCrLf & _
    356.         "        ASM_MOV_EAX_(pdbl);" & vbCrLf
    357.     Const STR_SRC17 As String = _
    358.         "        ASM_FMUL_EAX;" & vbCrLf & _
    359.         "        ASM_FSTP_EAX;" & vbCrLf & _
    360.         "    }" & vbCrLf & _
    361.         "    return p;" & vbCrLf & _
    362.         "}"
    363.     Dim src         As String
    364.    
    365.     If m_ctx.m_state(31) = 0 Then
    366.         src = STR_SRC01 & STR_SRC02 & STR_SRC03 & STR_SRC04 & STR_SRC05 & STR_SRC06 & STR_SRC07 & STR_SRC08 & STR_SRC09 & _
    367.             STR_SRC10 & STR_SRC11 & STR_SRC12 & STR_SRC13 & STR_SRC14 & STR_SRC15 & STR_SRC16 & STR_SRC17
    368.         m_ctx.m_state(31) = RtccCompile(m_ctx, src)
    369.         PatchFunc AddressOf pvProtoSimpleEval
    370.     End If
    371.     pvProtoSimpleEval m_ctx.m_state(31), StrPtr(sText), VarPtr(InlineSimpleEval)
    372. End Function
    Considering how crippled the OTCC codegen is (it's using a single accumulator register eax and occasionally ecx for support on more complex constructs) I'm baffled how really bad VB6 "optimizing" performance is.

    Here is a link to the original C version that can be compiled both w/ VC++ and OTCC: test.c

    cheers,
    </wqw>
    Attached Files Attached Files
    Last edited by wqweto; Mar 29th, 2018 at 09:05 AM.

  4. #44
    PowerPoster ThEiMp's Avatar
    Join Date
    Dec 2007
    Location
    Take The PCI Bus Across To The CPU!!
    Posts
    3,899

    Re: simple math string parser

    OP: I have been looking at your Source Code you posted in the OP Post #1. You have specified you want to add and multiply sums together. How many do you want do work out, because you have an endless Do Loop, without any breaking limiting factors that I can see in your Code. You have to work out a break test, for the Code to end the program or then it will just perpetually work on the sums. is this what you want to do, because then it just looks like a virus to me, because of a perpetual loop without any escaping break test, for that matter of fact, even. So then you should be able to come up with the breaking event of the Do ... Loop Until a = 0, because how can you work over zero in a sums program, that has no end. do you wish to also then be able to as you have said before in this thread you want decimals of to what point of zero.
    I have a huge free products range, of computer software in which you can download using any kind of 64-Bit Web Browser. Also there is coming a Social Networking section that I am making on my Website...

    |Ambra Productions Inc. | The Black Sun Society | The Black Shield | Ambra College | Church of the Black Sun | Ambra Productions Inc's Homepage | Boomtick Event's Venues: Ambar Nightclub, Jack Rabbit Slim's, Villa Nightclub and Lucy's Bar | Pasta Ambra | Fish Feast Company | Wallet Wizard | Ambrose Liquor | Ambar Tavern | Ambra University |

    Do you wish to do unpaid work for me??? If so, the PM me on this Forum, and then we can get to work, programming for the future of computers go by the name of ThEiMp. This is my ghost writers name. Also my nickname, means that I am: The Imperial of the Technology Industry, so then to make it really short, I just then wrote: The Imp, which is where I get the nickname from...

  5. #45
    PowerPoster ThEiMp's Avatar
    Join Date
    Dec 2007
    Location
    Take The PCI Bus Across To The CPU!!
    Posts
    3,899

    Re: simple math string parser

    Quote Originally Posted by wqweto View Post
    It took me a while to figure out why dilettante's VEval class was faster than my SimpleEval over 100k iterations. It turned out that having a local array like `Dim aValStack(0 To 1000) As Double` in a function induces a penalty for clearing it's members to zeroes, so just switching to `Static` arrays doubled my speed.

    Nevertheless I peeked at the assembly code VB6 was producing for the simple parser and got really frustrated with the inefficiencies produced by array indexing and what not. So came up with the idea to hoist a small C compiler (namely Obfuscated Tiny C Compiler), embed it as a machine code thunk and re-write my shunting yard implementation in the subset of C this compiler supports. I had to tweak OTCC to support inline assembly for the floating-point operations and other bits and pieces but the result is worth it.

    Currently the following inline C version of the parser is 3 times faster that VB6 impl SimpleEval from above (w/ `Static` optimizations).

    thinBasic Code:
    1. ' << big snip >>
    2. ' Complete code in the attached zip
    3.  
    4. Public Function SimpleEval(sText As String) As Double
    5.     Dim src         As String
    6.    
    7.     If m_ctx.m_state(31) = 0 Then
    8.         src = src & _
    9.             "#define TOK_FINAL     0" & vbCrLf & _
    10.             "#define TOK_RPAREN    1" & vbCrLf & _
    11.             "#define TOK_ADD       2" & vbCrLf & _
    12.             "#define TOK_MOD       3" & vbCrLf & _
    13.             "#define TOK_IDIV      4" & vbCrLf & _
    14.             "#define TOK_MUL       5" & vbCrLf & _
    15.             "#define TOK_UNARY     6" & vbCrLf & _
    16.             "#define TOK_POWER     7" & vbCrLf & _
    17.             "#define TOK_LPAREN    8" & vbCrLf & _
    18.             "#define TOK_NUM       9" & vbCrLf & _
    19.             "#define TOK_WHITE     10" & vbCrLf & _
    20.             "" & vbCrLf & _
    21.             "int lookup[256];" & vbCrLf & _
    22.             "" & vbCrLf & _
    23.             "simple_eval(s, pdbl, wParam, lParam)" & vbCrLf & _
    24.             "{" & vbCrLf & _
    25.             "    int i, p, l, ch, prec, prev_pr;" & vbCrLf & _
    26.             "    int op_stack, op_idx;" & vbCrLf & _
    27.             "    int val_stack, val_idx;" & vbCrLf
    28.         src = src & _
    29.             "    int num_size;" & vbCrLf & _
    30.             "" & vbCrLf & _
    31.             "    op_idx = op_stack = alloca(4000);" & vbCrLf & _
    32.             "    val_idx = val_stack = alloca(8000);" & vbCrLf & _
    33.             "    l = &lookup;" & vbCrLf & _
    34.             "    if (*(char *)(l + 32) == 0) {" & vbCrLf & _
    35.             "        p = l;" & vbCrLf & _
    36.             "        i = 0;" & vbCrLf & _
    37.             "        while (i < 256) {" & vbCrLf & _
    38.             "            *(char *)p++ = TOK_WHITE;" & vbCrLf & _
    39.             "            i++;" & vbCrLf & _
    40.             "        }" & vbCrLf & _
    41.             "        *(char *)(l + '(') = TOK_LPAREN;" & vbCrLf & _
    42.             "        *(char *)(l + ')') = TOK_RPAREN;" & vbCrLf & _
    43.             "        *(char *)(l + '+') = TOK_ADD;" & vbCrLf & _
    44.             "        *(char *)(l + '-') = TOK_ADD;" & vbCrLf & _
    45.             "        *(char *)(l + '*') = TOK_MUL;" & vbCrLf & _
    46.             "        *(char *)(l + '/') = TOK_MUL;" & vbCrLf & _
    47.             "        *(char *)(l + '^') = TOK_POWER;" & vbCrLf & _
    48.             "        *(char *)(l + '\\') = TOK_IDIV;" & vbCrLf & _
    49.             "        *(char *)(l + '%') = TOK_MOD;" & vbCrLf & _
    50.             "        *(char *)(l + '.') = TOK_NUM;" & vbCrLf
    51.         src = src & _
    52.             "        p = l + '0';" & vbCrLf & _
    53.             "        i = '0';" & vbCrLf & _
    54.             "        while (i <= '9') {" & vbCrLf & _
    55.             "            *(char *)p++ = TOK_NUM;" & vbCrLf & _
    56.             "            i++;" & vbCrLf & _
    57.             "        }" & vbCrLf & _
    58.             "    }" & vbCrLf & _
    59.             "    prev_pr = 0;" & vbCrLf & _
    60.             "    p = s;" & vbCrLf & _
    61.             "    while ((ch = *(short *)p)) {" & vbCrLf & _
    62.             "        if (!(ch >> 8)) {" & vbCrLf & _
    63.             "            prec = *(char *)(l + ch);" & vbCrLf & _
    64.             "            if (prec != TOK_WHITE) {" & vbCrLf & _
    65.             "                if (prec == TOK_NUM) {" & vbCrLf & _
    66.             "                    val_idx = val_idx + 8;" & vbCrLf & _
    67.             "                    parse_num(p, val_idx, &num_size);" & vbCrLf & _
    68.             "                    p = p + ((num_size-1) << 1);" & vbCrLf & _
    69.             "                } else if (prec == TOK_ADD) {" & vbCrLf & _
    70.             "                    if (prev_pr >= TOK_ADD && prev_pr < TOK_NUM)" & vbCrLf & _
    71.             "                        prec = TOK_UNARY;" & vbCrLf
    72.         src = src & _
    73.             "                }" & vbCrLf & _
    74.             "                if (prec >= TOK_ADD && prec < TOK_NUM) {" & vbCrLf & _
    75.             "                    if(prec != TOK_UNARY)" & vbCrLf & _
    76.             "                        eval_stack(prec, op_stack, &op_idx, val_stack, &val_idx);" & vbCrLf & _
    77.             "                    op_idx = op_idx + 4;" & vbCrLf & _
    78.             "                    *(int *)op_idx = (prec << 16) + ch;" & vbCrLf & _
    79.             "                }" & vbCrLf & _
    80.             "                prev_pr = prec;" & vbCrLf & _
    81.             "            }" & vbCrLf & _
    82.             "        }" & vbCrLf & _
    83.             "        p++; p++;" & vbCrLf & _
    84.             "    }" & vbCrLf & _
    85.             "    eval_stack(TOK_FINAL, op_stack, &op_idx, val_stack, &val_idx);" & vbCrLf & _
    86.             "    *(int *)pdbl = *(int *)val_idx;" & vbCrLf & _
    87.             "    *(int *)(pdbl + 4) = *(int *)(val_idx + 4);" & vbCrLf & _
    88.             "}" & vbCrLf & _
    89.             "" & vbCrLf
    90.         src = src & _
    91.             "#define ASM_MOV_EAX_    _asm mov eax," & vbCrLf & _
    92.             "#define ASM_ADD_EAX_    _asm _emit 0x83 _asm _emit 0xc0 _asm _emit" & vbCrLf & _
    93.             "#define ASM_SUB_EAX_    _asm _emit 0x83 _asm _emit 0xe8 _asm _emit" & vbCrLf & _
    94.             "#define ASM_FSTP_EAX    _asm _emit 0xdd _asm _emit 0x18" & vbCrLf & _
    95.             "#define ASM_FLD_EAX     _asm _emit 0xdd _asm _emit 0x00" & vbCrLf & _
    96.             "#define ASM_FLD_EAX_    _asm _emit 0xdd _asm _emit 0x40 _asm _emit" & vbCrLf & _
    97.             "#define ASM_FADD_EAX_   _asm _emit 0xdc _asm _emit 0x40 _asm _emit" & vbCrLf & _
    98.             "#define ASM_FSUB_EAX_   _asm _emit 0xdc _asm _emit 0x60 _asm _emit" & vbCrLf & _
    99.             "#define ASM_FMUL_EAX_   _asm _emit 0xdc _asm _emit 0x48 _asm _emit" & vbCrLf & _
    100.             "#define ASM_FDIV_EAX_   _asm _emit 0xdc _asm _emit 0x70 _asm _emit" & vbCrLf & _
    101.             "#define ASM_FCHS        _asm _emit 0xd9 _asm _emit 0xe0" & vbCrLf & _
    102.             "#define ASM_FILD_EAX    _asm _emit 0xdb _asm _emit 0x00" & vbCrLf & _
    103.             "#define ASM_FISTP_EAX   _asm _emit 0xdb _asm _emit 0x18" & vbCrLf & _
    104.             "#define ASM_FYL2X       _asm _emit 0xd9 _asm _emit 0xf1" & vbCrLf & _
    105.             "#define ASM_FLD1        _asm _emit 0xd9 _asm _emit 0xe8" & vbCrLf & _
    106.             "#define ASM_FLD_ST1     _asm _emit 0xd9 _asm _emit 0xc1" & vbCrLf & _
    107.             "#define ASM_FPREM       _asm _emit 0xd9 _asm _emit 0xf8" & vbCrLf & _
    108.             "#define ASM_F2XM1       _asm _emit 0xd9 _asm _emit 0xf0" & vbCrLf & _
    109.             "#define ASM_FADDP_ST1   _asm _emit 0xde _asm _emit 0xc1" & vbCrLf & _
    110.             "#define ASM_FSCALE      _asm _emit 0xd9 _asm _emit 0xfd" & vbCrLf
    111.         src = src & _
    112.             "" & vbCrLf & _
    113.             "eval_stack(prec, op_stack, pop_idx, val_stack, pval_idx)" & vbCrLf & _
    114.             "{" & vbCrLf & _
    115.             "    int op_idx, val_idx, op, t1, pt1, t2, pt2;" & vbCrLf & _
    116.             "" & vbCrLf & _
    117.             "    op_idx = *(int *)pop_idx;" & vbCrLf & _
    118.             "    val_idx = *(int *)pval_idx;" & vbCrLf & _
    119.             "    while (op_idx > op_stack) {" & vbCrLf & _
    120.             "        if (*(int *)(op_idx) < (prec << 16))" & vbCrLf & _
    121.             "            break;" & vbCrLf & _
    122.             "        val_idx = val_idx - 8;" & vbCrLf & _
    123.             "        op = *(short *)op_idx;" & vbCrLf & _
    124.             "        if (op == '+') {" & vbCrLf & _
    125.             "            if (*(int *)(op_idx) > (TOK_UNARY << 16)) {" & vbCrLf & _
    126.             "                val_idx = val_idx + 8;" & vbCrLf & _
    127.             "            } else {" & vbCrLf & _
    128.             "                /* *(double *)val_idx = *(double *)val_idx + *(double *)(val_idx + 8); */" & vbCrLf & _
    129.             "                ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    130.             "                ASM_FLD_EAX;" & vbCrLf & _
    131.             "                ASM_FADD_EAX_(8);" & vbCrLf & _
    132.             "                ASM_FSTP_EAX;" & vbCrLf & _
    133.             "            }" & vbCrLf
    134.         src = src & _
    135.             "        } else if (op == '-') {" & vbCrLf & _
    136.             "            if (*(int *)(op_idx) > (TOK_UNARY << 16)) {" & vbCrLf & _
    137.             "                val_idx = val_idx + 8;" & vbCrLf & _
    138.             "                /* *(double *)val_idx = -*(double *)val_idx; */" & vbCrLf & _
    139.             "                ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    140.             "                ASM_FLD_EAX;" & vbCrLf & _
    141.             "                ASM_FCHS;" & vbCrLf & _
    142.             "                ASM_FSTP_EAX;" & vbCrLf & _
    143.             "            } else {" & vbCrLf & _
    144.             "                /* *(double *)val_idx = *(double *)val_idx - *(double *)(val_idx + 8); */" & vbCrLf & _
    145.             "                ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    146.             "                ASM_FLD_EAX;" & vbCrLf & _
    147.             "                ASM_FSUB_EAX_(8);" & vbCrLf & _
    148.             "                ASM_FSTP_EAX;" & vbCrLf & _
    149.             "            }" & vbCrLf & _
    150.             "        } else if (op == '*') {" & vbCrLf & _
    151.             "            /* *(double *)val_idx = *(double *)val_idx * *(double *)(val_idx + 8); */" & vbCrLf & _
    152.             "            ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    153.             "            ASM_FLD_EAX;" & vbCrLf
    154.         src = src & _
    155.             "            ASM_FMUL_EAX_(8);" & vbCrLf & _
    156.             "            ASM_FSTP_EAX;" & vbCrLf & _
    157.             "        } else if (op == '/') {" & vbCrLf & _
    158.             "            /* *(double *)val_idx = *(double *)val_idx / *(double *)(val_idx + 8); */" & vbCrLf & _
    159.             "            ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    160.             "            ASM_FLD_EAX;" & vbCrLf & _
    161.             "            ASM_FDIV_EAX_(8);" & vbCrLf & _
    162.             "            ASM_FSTP_EAX;" & vbCrLf & _
    163.             "        } else if (op == '^') {" & vbCrLf & _
    164.             "            /* *(double *)val_idx = pow(*(double *)val_idx, *(double *)(val_idx + 8)); */" & vbCrLf & _
    165.             "            ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    166.             "            ASM_ADD_EAX_(8);" & vbCrLf & _
    167.             "            ASM_FLD_EAX;" & vbCrLf & _
    168.             "            ASM_SUB_EAX_(8);" & vbCrLf & _
    169.             "            ASM_FLD_EAX;" & vbCrLf & _
    170.             "            ASM_FYL2X;" & vbCrLf & _
    171.             "            ASM_FLD1;" & vbCrLf & _
    172.             "            ASM_FLD_ST1;" & vbCrLf & _
    173.             "            ASM_FPREM;" & vbCrLf & _
    174.             "            ASM_F2XM1;" & vbCrLf & _
    175.             "            ASM_FADDP_ST1;" & vbCrLf & _
    176.             "            ASM_FSCALE;" & vbCrLf & _
    177.             "            ASM_FSTP_EAX;" & vbCrLf
    178.         src = src & _
    179.             "        } else if (op == '\\') {" & vbCrLf & _
    180.             "            pt1 = &t1;" & vbCrLf & _
    181.             "            /* *(double *)val_idx = (int)(*(double *)val_idx / *(double *)(val_idx + 8)); */" & vbCrLf & _
    182.             "            ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    183.             "            ASM_FLD_EAX;" & vbCrLf & _
    184.             "            ASM_FDIV_EAX_(8);" & vbCrLf & _
    185.             "            ASM_MOV_EAX_(pt1);" & vbCrLf & _
    186.             "            ASM_FISTP_EAX;" & vbCrLf & _
    187.             "            ASM_FILD_EAX;" & vbCrLf & _
    188.             "            ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    189.             "            ASM_FSTP_EAX;" & vbCrLf & _
    190.             "        } else if (op == '%') {" & vbCrLf & _
    191.             "            pt1 = &t1;" & vbCrLf & _
    192.             "            pt2 = &t2;" & vbCrLf & _
    193.             "            /* *(double *)val_idx = (int)*(double *)val_idx % (int)*(double *)(val_idx + 8); */" & vbCrLf & _
    194.             "            ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    195.             "            ASM_FLD_EAX;" & vbCrLf & _
    196.             "            ASM_MOV_EAX_(pt1);" & vbCrLf & _
    197.             "            ASM_FISTP_EAX;" & vbCrLf & _
    198.             "            ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    199.             "            ASM_ADD_EAX_(8);" & vbCrLf
    200.         src = src & _
    201.             "            ASM_FLD_EAX;" & vbCrLf & _
    202.             "            ASM_MOV_EAX_(pt2);" & vbCrLf & _
    203.             "            ASM_FISTP_EAX;" & vbCrLf & _
    204.             "            t1 = t1 % t2;" & vbCrLf & _
    205.             "            ASM_MOV_EAX_(pt1);" & vbCrLf & _
    206.             "            ASM_FILD_EAX;" & vbCrLf & _
    207.             "            ASM_MOV_EAX_(val_idx);" & vbCrLf & _
    208.             "            ASM_FSTP_EAX;" & vbCrLf & _
    209.             "        } else if (op == '(') {" & vbCrLf & _
    210.             "            val_idx = val_idx + 8;" & vbCrLf & _
    211.             "            if (prec == TOK_RPAREN) {" & vbCrLf & _
    212.             "                op_idx = op_idx - 4;" & vbCrLf & _
    213.             "                break;" & vbCrLf & _
    214.             "            } else if (prec > TOK_RPAREN)" & vbCrLf & _
    215.             "                break;" & vbCrLf & _
    216.             "        }" & vbCrLf & _
    217.             "        op_idx = op_idx - 4;" & vbCrLf & _
    218.             "    }" & vbCrLf & _
    219.             "    *(int *)pval_idx = val_idx;" & vbCrLf & _
    220.             "    *(int *)pop_idx = op_idx;" & vbCrLf & _
    221.             "}" & vbCrLf & _
    222.             "" & vbCrLf
    223.         src = src & _
    224.             "#define PARSE_FLAGS_DEFAULT 0xB14" & vbCrLf & _
    225.             "#define VTBIT_R8 0x20" & vbCrLf & _
    226.             "" & vbCrLf & _
    227.             "parse_num(s, pdbl, psize)" & vbCrLf & _
    228.             "{" & vbCrLf & _
    229.             "    int numparse, dig, variant_res;" & vbCrLf & _
    230.             "" & vbCrLf & _
    231.             "    numparse = alloca(24);" & vbCrLf & _
    232.             "    dig = alloca(30);" & vbCrLf & _
    233.             "    variant_res = alloca(16);" & vbCrLf & _
    234.             "    *(int *)numparse = 30;" & vbCrLf & _
    235.             "    *(int *)(numparse + 4) = PARSE_FLAGS_DEFAULT;" & vbCrLf & _
    236.             "    if (!VarParseNumFromStr(s, 0, 0, numparse, dig)) {" & vbCrLf & _
    237.             "        if (!VarNumFromParseNum(numparse, dig, VTBIT_R8, variant_res)) {" & vbCrLf & _
    238.             "            *(int *)pdbl = *(int *)(variant_res + 8);" & vbCrLf & _
    239.             "            *(int *)(pdbl + 4) = *(int *)(variant_res + 12);" & vbCrLf & _
    240.             "            *(int *)psize = *(int *)(numparse + 12); /* cchUsed */" & vbCrLf & _
    241.             "            return;" & vbCrLf & _
    242.             "        }" & vbCrLf & _
    243.             "    }" & vbCrLf & _
    244.             "    *(int *)pdbl = 0;" & vbCrLf & _
    245.             "    *(int *)(pdbl + 4) = 0;" & vbCrLf & _
    246.             "    *(int *)psize = 1;" & vbCrLf & _
    247.             "}"
    248.         m_ctx.m_state(31) = RtccCompile(m_ctx, src)
    249.     End If
    250.     CallWindowProc m_ctx.m_state(31), StrPtr(sText), VarPtr(SimpleEval)
    251. End Function
    Considering how crippled the OTCC codegen is (it's using a single accumulator register eax and occasionally ecx for support on more complex constructs) I'm baffled how really bad VB6 "optimizing" performance is.

    Here is a link to the original C version that can be compiled both w/ VC++ and OTCC: test.c

    cheers,
    </wqw>
    -- Just work on a Text Resource of the Data and then work using srKeyWord and loop through the keywords like int and #define
    I have a huge free products range, of computer software in which you can download using any kind of 64-Bit Web Browser. Also there is coming a Social Networking section that I am making on my Website...

    |Ambra Productions Inc. | The Black Sun Society | The Black Shield | Ambra College | Church of the Black Sun | Ambra Productions Inc's Homepage | Boomtick Event's Venues: Ambar Nightclub, Jack Rabbit Slim's, Villa Nightclub and Lucy's Bar | Pasta Ambra | Fish Feast Company | Wallet Wizard | Ambrose Liquor | Ambar Tavern | Ambra University |

    Do you wish to do unpaid work for me??? If so, the PM me on this Forum, and then we can get to work, programming for the future of computers go by the name of ThEiMp. This is my ghost writers name. Also my nickname, means that I am: The Imperial of the Technology Industry, so then to make it really short, I just then wrote: The Imp, which is where I get the nickname from...

  6. #46
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,872

    Re: simple math string parser

    @TheImp, do you even understand what the post is about??

  7. #47

    Thread Starter
    The Idiot
    Join Date
    Dec 2014
    Posts
    2,721

    Re: simple math string parser

    @TheImp, the OP code works fine with any amount of x and + and decimals in it. theres no error handling, meaning it can only deal with a proper string. but the thread is not about the OP code, instead is a question if theres better evaluators, and Olaf gave me a very nice code that works very fast. today Im still using his code with + x and - as I needed that in one formula. Since then we have other evaluators from different members, all quite nice and interesting, I learned a lot. The last one from wqweto is yet another way and again, impressed with the knowledge some of the members have.

  8. #48
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: simple math string parser

    Quote Originally Posted by wqweto View Post
    Currently the following inline C version of the parser is 3 times faster that VB6 impl SimpleEval from above (w/ `Static` optimizations).
    ...
    I'm baffled how really bad VB6 "optimizing" performance is.
    Your original VB6-implementation is slower for two reasons:
    - GoSub (instead of a function)
    - the VBA.Val() function-call (instead of direct parsing)

    Below I've changed your original slightly in this regard - and it is now (native compiled, with all extended options) -
    about 3 times as fast as the inline-C-version.

    I've put this into a *.bas
    Code:
    Option Explicit
    
    Private Enum eTokens
      TOK_FINAL = 0
      TOK_RPAREN = 1
      TOK_ADD = 2
      TOK_MOD = 3
      TOK_IDIV = 4
      TOK_MUL = 5
      TOK_UNARY = 6
      TOK_POWER = 7
      TOK_LPAREN = 8
      TOK_NUM = 9
      TOK_WHITE = 10
    End Enum
    
    Private aLookup(0 To 255) As eTokens, aValStack(0 To 1000) As Double, aOpStack(0 To 1000) As Long
    
    Public Function SimpleEval(sText As String) As Double
        Static WC() As Byte
        Dim i As Long, UB As Long
        Dim lValIdx As Long, lOpIdx As Long
        Dim Tok As Long, PrevTok As Long
     
        '--- one-time init of token type lookup
        If aLookup(32) = 0 Then
           For i = 0 To UBound(aLookup)
               Select Case i
                  Case 40:           aLookup(i) = TOK_LPAREN ' "("
                  Case 41:           aLookup(i) = TOK_RPAREN ' ")"
                  Case 43, 45:       aLookup(i) = TOK_ADD    ' "+", "-"
                  Case 42, 47:       aLookup(i) = TOK_MUL    ' "*", "/"
                  Case 94:           aLookup(i) = TOK_POWER  ' "^"
                  Case 92:           aLookup(i) = TOK_IDIV   ' "\"
                  Case 37:           aLookup(i) = TOK_MOD    ' "%"
                  Case 48 To 57, 46: aLookup(i) = TOK_NUM    ' "0" To "9", "."
                  Case Else:         aLookup(i) = TOK_WHITE
               End Select
           Next
        End If
        
        WC = sText 'assign the text to a WChar-Byte-Vector
        UB = UBound(WC) 'buffer the UBound (we pass this around into FastVal)
        
        For i = 0 To UB Step 2
            Tok = aLookup(WC(i))
            If Tok = TOK_NUM Then
               lValIdx = lValIdx + 1
               aValStack(lValIdx) = FastVal(WC, i, UB) 'FastVal will increment i correctly
            ElseIf Tok = TOK_ADD Then
                If PrevTok >= TOK_ADD And PrevTok < TOK_NUM Then
                   Tok = TOK_UNARY
                End If
            End If
            If Tok >= TOK_ADD And Tok < TOK_NUM Then
                If Tok <> TOK_UNARY Then '--- right assoc
                   EvalOpStack lOpIdx, Tok, lValIdx
                End If
                lOpIdx = lOpIdx + 1
                aOpStack(lOpIdx) = Tok * &H10000 + WC(i)
            End If
            If Tok <> TOK_WHITE Then PrevTok = Tok
        Next
     
        EvalOpStack lOpIdx, TOK_FINAL, lValIdx
        SimpleEval = aValStack(lValIdx)
        aValStack(lValIdx) = 0 'clear the bottom of the Value-Stack
    End Function
    
    Private Sub EvalOpStack(lOpIdx As Long, lTokPreced As Long, lValIdx As Long)
        For lOpIdx = lOpIdx To 1 Step -1
            If aOpStack(lOpIdx) < lTokPreced * &H10000 Then Exit For
    
            lValIdx = lValIdx - 1
            Select Case aOpStack(lOpIdx) And &HFFFF&
            Case 43         ' "+"
                If aOpStack(lOpIdx) > TOK_UNARY * &H10000 Then
                    lValIdx = lValIdx + 1
                Else
                    aValStack(lValIdx) = aValStack(lValIdx) + aValStack(lValIdx + 1)
                End If
            Case 45         ' "-"
                If aOpStack(lOpIdx) > TOK_UNARY * &H10000 Then
                    lValIdx = lValIdx + 1
                    aValStack(lValIdx) = -aValStack(lValIdx)
                Else
                    aValStack(lValIdx) = aValStack(lValIdx) - aValStack(lValIdx + 1)
                End If
            Case 42         ' "*"
                aValStack(lValIdx) = aValStack(lValIdx) * aValStack(lValIdx + 1)
            Case 47         ' "/"
                aValStack(lValIdx) = aValStack(lValIdx) / aValStack(lValIdx + 1)
            Case 94         ' "^"
                aValStack(lValIdx) = aValStack(lValIdx) ^ aValStack(lValIdx + 1)
            Case 92         ' "\"
                aValStack(lValIdx) = aValStack(lValIdx) \ aValStack(lValIdx + 1)
            Case 37         ' "%"
                aValStack(lValIdx) = aValStack(lValIdx) Mod aValStack(lValIdx + 1)
            Case 40         ' "("
                lValIdx = lValIdx + 1
                If lTokPreced > TOK_RPAREN Then Exit For
                If lTokPreced = TOK_RPAREN Then lOpIdx = lOpIdx - 1: Exit For
            End Select
        Next
    End Sub
    
    Private Function FastVal(WC() As Byte, i As Long, ByVal UB As Long) As Double
    Dim NewVal&, IntPart#, FracPart#, FracDivisor#, eSgn&, eInt&
     
        For i = i To UB Step 2
          Select Case WC(i)
            Case 48 To 57 'numeric
              If NewVal = 0 Then NewVal = 1
              If eSgn Then
                eInt = eInt * 10 + WC(i) - 48
              Else
                If FracDivisor = 0 Then
                  IntPart = IntPart * 10 + WC(i) - 48
                ElseIf FracDivisor < 10000000000000# Then
                  FracPart = FracPart * 10 + WC(i) - 48
                  FracDivisor = FracDivisor * 10
                End If
              End If
            Case 46 'decimal-point
              FracDivisor = 1: If NewVal = 0 Then NewVal = 1
            Case 69, 101 'e, E
              eInt = 0: If NewVal Then eSgn = 1
            Case 45 'a leading "-" (only possible after the eSign in this scenario)
              If eSgn > 0 Then eSgn = -1 Else Exit For
            Case Else: Exit For 'and everything else exits the loop
          End Select
        Next
        
        If NewVal Then
          If FracDivisor Then
            FastVal = NewVal * (IntPart + FracPart / FracDivisor)
          Else
            FastVal = NewVal * IntPart
          End If
          If eSgn Then FastVal = FastVal * (10 ^ (eSgn * eInt))
        End If
        i = i - 2
    End Function
    And that into a Test-Form (after renaming your inline-C-function to SimpleEval2):
    Code:
    Option Explicit
     
    Private Sub Form_Click()
        AutoRedraw = True: Cls
        Debug.Print SimpleEval("-.1*1e-1-.1^-3") = -0.1 * 0.1 - 0.1 ^ -3
        Debug.Print SimpleEval("(3.5) + 2.9 * (2 + -(1 + 2))") = (3.5) + 2.9 * (2 + -(1 + 2))
        Debug.Print SimpleEval("2 \ 3 / 3") = 2 \ 3 / 3
        Debug.Print SimpleEval("2 ^ -3 ^ 4") = 2 ^ -3 ^ 4
        Debug.Print SimpleEval("2 ^ 3 \ 5 ^ 2 / 5 / 3") = 2 ^ 3 \ 5 ^ 2 / 5 / 3
    
        Dim sExpr           As String
        Dim dblTimer        As Double
        Dim lIdx            As Long
        Dim dblResult       As Double
    
        sExpr = "(3.5) + 2.9 * (2 + -(1 + 2))"
        dblTimer = Timer
        For lIdx = 1 To 100000
            dblResult = SimpleEval(sExpr)
        Next
        Print "SimpleEval1: " & dblResult, Format$(Timer - dblTimer, "0.000")
    
    
        sExpr = "(3.5) + 2.9 * (2 + -(1 + 2))"
        dblTimer = Timer
        For lIdx = 1 To 100000
            dblResult = SimpleEval2(sExpr)
        Next
        Print "SimpleEval2: " & dblResult, Format$(Timer - dblTimer, "0.000")
    End Sub
    The results are (native compiled, 100,000 iterations) about:
    - 0.045sec for VB6-SimpleEval
    - 0.125sec for the Inline-C-SimpleEval2

    BTW, on my machine (not sure if that's a "locale-thingy") the Inline-C-function evaluates: "(3.5) + 2.9 * (2 + -(1 + 2))" to 6 instead of 0.6

    Edit: Fixed a bug in FastVal, for the case when no Space-Chars were given (enhanced the Form-TestCode about the test-string: "-.1*1e-1-.1^-3"

    Olaf
    Last edited by Schmidt; Mar 28th, 2018 at 06:13 PM. Reason: Fixed a bug in FastVal, when no spaces were given

  9. #49
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: simple math string parser

    Good effort, Olaf! FastVal makes the differences!

    Switched the inline C version to a translation of it (updated the .zip attachment above) and now your version and inline version are with very close performance when VB6 code is compiled w/ all optimizations on.

    This is the testing code (1 mil iters)
    thinBasic Code:
    1. Private Sub Form_Click()
    2.     Const ITER_MAX      As Long = 1000000
    3.     Dim lIdx            As Long
    4.     Dim dblTimer        As Double
    5.     Dim dblResult       As Double
    6.     Dim oEval           As VEval
    7.     Dim sExpr           As String
    8.    
    9.     sExpr = "(3.5) + 2.9 * (2 + -(1 + 2))"
    10.    
    11.     dblTimer = Timer
    12.     For lIdx = 1 To ITER_MAX
    13.         dblResult = CDbl("3.5") + CDbl("2.9") * (CDbl("2") + -(CDbl("1") + CDbl("2")))
    14.     Next
    15.     Print "CDbl:             " & dblResult, Format(Timer - dblTimer, "0.000")
    16.     Refresh
    17.    
    18.     dblTimer = Timer
    19.     For lIdx = 1 To ITER_MAX
    20.         dblResult = Val("3.5") + Val("2.9") * (Val("2") + -(Val("1") + Val("2")))
    21.     Next
    22.     Print "Val:              " & dblResult, Format(Timer - dblTimer, "0.000")
    23.     Refresh
    24.    
    25.     dblTimer = Timer
    26.     For lIdx = 1 To ITER_MAX
    27.         dblResult = InlineSimpleEval(sExpr)
    28.     Next
    29.     Print "InlineSimpleEval: " & dblResult, Format(Timer - dblTimer, "0.000")
    30.     Refresh
    31.    
    32.     dblTimer = Timer
    33.     For lIdx = 1 To ITER_MAX
    34.         dblResult = SimpleEval(sExpr)
    35.     Next
    36.     Print "SimpleEval:       " & dblResult, Format(Timer - dblTimer, "0.000")
    37.  
    38. '    dblTimer = Timer
    39. '    For lIdx = 1 To ITER_MAX
    40. '        dblResult = SimpleEval4(sExpr)
    41. '    Next
    42. '    Print "SimpleEval4:     " & dblResult, Format(Timer - dblTimer, "0.000")
    43. '    Refresh
    44.  
    45.     dblTimer = Timer
    46.     For lIdx = 1 To ITER_MAX
    47.         dblResult = OlafSimpleEval(sExpr)
    48.     Next
    49.     Print "OlafSimpleEval:   " & dblResult, Format(Timer - dblTimer, "0.000")
    50.     Refresh
    51.    
    52. '    dblTimer = Timer
    53. '    Set oEval = New VEval
    54. '    For lIdx = 1 To ITER_MAX
    55. '        dblResult = oEval.Eval(sExpr)
    56. '    Next
    57. '    Print "Dile VEval:       " & dblResult, Format(Timer - dblTimer, "0.000")
    58. '    Refresh
    59.  
    60. '    dblTimer = Timer
    61. '    For lIdx = 1 To ITER_MAX
    62. '        dblResult = OlafEval(sExpr)
    63. '    Next
    64. '    Print "OlafEval:         " & dblResult, Format(Timer - dblTimer, "0.000")
    65. '    Refresh
    66. End Sub

    Compiled w/ all advanced optimizations on (3 runs):



    Compiled w/ defaults (Optimize for Fast Code, no Advanced Optimizations):



    IDE performance (3 runs):


    It's quite impressive that both simple CDbl and Val calls are slower that OlafSimpleEval when compiled with optimizations.

    But then realisticly no one should disable arrays bounds checking in production code IMO.

    cheers,
    </wqw>

  10. #50
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: simple math string parser

    Quote Originally Posted by wqweto View Post
    It's quite impressive that both simple CDbl and Val calls are slower that OlafSimpleEval when compiled with optimizations.
    Yep, I've always found, that the VB6-native-compiler was quite on par with the VC-version-6 (tested that intensively years ago,
    where C2.exe was only about 10-15% slower at that time - when both versions had all possible optimizations checked in).

    More recently (though still about 3 years back), I've compared VB6-native-code versus TCC (0.9.26) -
    and found VB6-C2.exe to be about 10-20% faster than what the (not really optimizing) TCC was able to produce.

    So, with all options checked, there is no real reason why e.g. "fast Pixel-Loops" shouldn't be
    performed in normal VB6-code (since I saw you comment on that, in other threads)...
    And sure, one has to "work around" a few things to "get those inner loops fast" (e.g. the missing shift-operators
    come to mind) - but that can usually be solved (at little expense in more code) via LookupTable-techniques.

    Quote Originally Posted by wqweto View Post
    But then realisticly no one should disable arrays bounds checking in production code IMO.
    That's why such (usually welltested, manually making sure the Bounds are correct) code belongs into Dll-Projects
    (which then can have their own appropriate, optimized Compiler-Settings, independently from the Main-Project).

    And BTW, your Inline-C-Code will not perform any bounds-checks, if I'm not mistaken -
    (so to compare realistically, we should allow the VB6-native compiler the same thing).

    In the (bigger, "official") TCC, there's an Array-Bound-check available via Compiler-switch,
    but in older TCC-versions it was deactivated (had no effect) - do you know, whether the
    current version of the TCC (0.9.27) has this stuff activated again (behaving in a reliable way)?

    As for your results - there is one other thing that the C-Code does, which in my "tuned SimpleEval"
    was "thrown out" (because the main-boost came from replacing Val)...
    And that's the SafeArray-spanning over the Chars of the ExpressionString (to avoid the "full copy").

    If we re-introduce that, the tuned SimpleEval will gain another factor 2 over you (latest) C-Version.

    Here is the Code for a ClassEncapsulation which is using this SafeArr-Binding (I named the Class cMathExpr):
    Code:
    Option Explicit
    
    Private Enum eTokens
      TOK_FINAL = 0
      TOK_RPAREN = 1
      TOK_ADD = 2
      TOK_MOD = 3
      TOK_IDIV = 4
      TOK_MUL = 5
      TOK_UNARY = 6
      TOK_POWER = 7
      TOK_LPAREN = 8
      TOK_NUM = 9
      TOK_WHITE = 10
    End Enum
    
    Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (Ptr() As Any) As Long
    Private Declare Sub GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any)
    
    Private WC%(), saWC&(0 To 5), TokLUT(0 To 255) As eTokens, ValStack#(0 To 999), OpStack&(0 To 999)
    
    Private Sub Class_Initialize()
      saWC(0) = 1: saWC(1) = 2 'init the safearry-struct for cDims and cbElements
      GetMem4 VarPtr(saWC(0)), ByVal ArrPtr(WC) 'bind the struct to the 16Bit-Int-array WC
    
      Dim iC As Long
      For iC = 0 To UBound(TokLUT) 'init the Token-Lookup-Table
        Select Case iC
          Case 40:           TokLUT(iC) = TOK_LPAREN ' "("
          Case 41:           TokLUT(iC) = TOK_RPAREN ' ")"
          Case 43, 45:       TokLUT(iC) = TOK_ADD    ' "+", "-"
          Case 42, 47:       TokLUT(iC) = TOK_MUL    ' "*", "/"
          Case 94:           TokLUT(iC) = TOK_POWER  ' "^"
          Case 92:           TokLUT(iC) = TOK_IDIV   ' "\"
          Case 37:           TokLUT(iC) = TOK_MOD    ' "%"
          Case 48 To 57, 46: TokLUT(iC) = TOK_NUM    ' "0" To "9", "."
          Case Else:         TokLUT(iC) = TOK_WHITE
        End Select
      Next
    End Sub
    
    Private Sub Class_Terminate()
      GetMem4 0&, ByVal ArrPtr(WC) 'release the Binding of WC%()
    End Sub
    
    Public Function Evaluate(sText As String) As Double
        Dim Tok As eTokens, PrevTok As eTokens
        Dim iC As Long, iV As Long, iO As Long, UB As Long
     
        saWC(3) = StrPtr(sText) ' pvData
        saWC(4) = Len(sText)    ' cElements
        UB = saWC(4) - 1        ' buffer the UBound (we pass this around into FastVal)
     
        For iC = 0 To UB
            Tok = TokLUT(WC(iC))
            If Tok = TOK_NUM Then
               iV = iV + 1
               ValStack(iV) = FastVal(iC, UB) 'FastVal will increment iC correctly
            ElseIf Tok = TOK_ADD Then
                If PrevTok >= TOK_ADD And PrevTok < TOK_NUM Then
                   Tok = TOK_UNARY
                End If
            End If
            If Tok >= TOK_ADD And Tok < TOK_NUM Then
                If Tok <> TOK_UNARY Then '--- right assoc
                   EvalOpStack Tok, iO, iV
                End If
                iO = iO + 1
                OpStack(iO) = Tok * &H10000 + WC(iC)
            End If
            If Tok <> TOK_WHITE Then PrevTok = Tok
        Next
    
        EvalOpStack TOK_FINAL, iO, iV
        Evaluate = ValStack(iV)
        ValStack(iV) = 0 'clear the bottom of the Value-Stack
    End Function
    
    Private Sub EvalOpStack(ByVal Tok As eTokens, iO As Long, iV As Long)
        For iO = iO To 1 Step -1
          If OpStack(iO) < Tok * &H10000 Then Exit For
    
          iV = iV - 1
          Select Case OpStack(iO) And &HFFFF&
            Case 43         ' "+"
              If OpStack(iO) > TOK_UNARY * &H10000 Then
                 iV = iV + 1
              Else
                 ValStack(iV) = ValStack(iV) + ValStack(iV + 1)
              End If
            Case 45         ' "-"
              If OpStack(iO) > TOK_UNARY * &H10000 Then
                 iV = iV + 1
                 ValStack(iV) = -ValStack(iV)
              Else
                 ValStack(iV) = ValStack(iV) - ValStack(iV + 1)
              End If
            Case 42         ' "*"
              ValStack(iV) = ValStack(iV) * ValStack(iV + 1)
            Case 47         ' "/"
              ValStack(iV) = ValStack(iV) / ValStack(iV + 1)
            Case 94         ' "^"
              ValStack(iV) = ValStack(iV) ^ ValStack(iV + 1)
            Case 92         ' "\"
              ValStack(iV) = ValStack(iV) \ ValStack(iV + 1)
            Case 37         ' "%"
              ValStack(iV) = ValStack(iV) Mod ValStack(iV + 1)
            Case 40         ' "("
              iV = iV + 1
              If Tok > TOK_RPAREN Then Exit For
              If Tok = TOK_RPAREN Then iO = iO - 1: Exit For
          End Select
        Next
    End Sub
    
    Private Function FastVal(iC As Long, ByVal UB As Long) As Double
    Dim NewVal&, IntPart#, FracPart#, FracDivisor#, eSgn&, eInt&
     
        For iC = iC To UB
          Select Case WC(iC)
            Case 48 To 57 'numeric
              If NewVal = 0 Then NewVal = 1
              If eSgn Then
                eInt = eInt * 10 + WC(iC) - 48
              ElseIf FracDivisor = 0 Then
                IntPart = IntPart * 10 + WC(iC) - 48
              ElseIf FracDivisor < 10000000000000# Then
                FracPart = FracPart * 10 + WC(iC) - 48
                FracDivisor = FracDivisor * 10
              End If
            Case 46 'decimal-point
              FracDivisor = 1: If NewVal = 0 Then NewVal = 1
            Case 45 'a leading "-" (only possible after the eSign in this scenario)
              If eSgn > 0 Then eSgn = -1 Else Exit For
            Case 69, 101 'e, E
              eInt = 0: If NewVal Then eSgn = 1
            Case Else: Exit For 'everything else exits the loop
          End Select
        Next
        iC = iC - 1
        If NewVal Then
          If FracDivisor Then
            FastVal = NewVal * (IntPart + FracPart / FracDivisor)
          Else
            FastVal = NewVal * IntPart
          End If
          If eSgn Then FastVal = FastVal * (10 ^ (eSgn * eInt))
        End If
    End Function
    Here again my Form-TestCode:
    Code:
    Private Sub Form_Click()
        AutoRedraw = True: Cls
        
        Dim sExpr           As String
        Dim dblTimer        As Double
        Dim lIdx            As Long
        Dim dblResult       As Double
        Dim MathExpr As cMathExpr
        Set MathExpr = New cMathExpr
        
        Debug.Print MathExpr.Evaluate("-.1*1e-1-.1^-3") = -0.1 * 0.1 - 0.1 ^ -3
        Debug.Print MathExpr.Evaluate("(3.5) + 2.9 * (2 + -(1 + 2))") = (3.5) + 2.9 * (2 + -(1 + 2))
        Debug.Print MathExpr.Evaluate("2 \ 3 / 3") = 2 \ 3 / 3
        Debug.Print MathExpr.Evaluate("2 ^ -3 ^ 4") = 2 ^ -3 ^ 4
        Debug.Print MathExpr.Evaluate("2 ^ 3 \ 5 ^ 2 / 5 / 3") = 2 ^ 3 \ 5 ^ 2 / 5 / 3
     
        sExpr = "(3.5) + 2.9 * (2 + -(1 + 2))"
        dblTimer = Timer
        For lIdx = 1 To IIf(App.LogMode, 10 ^ 6, 10 ^ 5)
            dblResult = SimpleEval(sExpr)
        Next
        Print "SimpleEvalFastVal: " & dblResult, Format$(Timer - dblTimer, "0.000")
    
        sExpr = "(3.5) + 2.9 * (2 + -(1 + 2))"
        dblTimer = Timer
        For lIdx = 1 To IIf(App.LogMode, 10 ^ 6, 10 ^ 5)
            dblResult = MathExpr.Evaluate(sExpr)
        Next
        Print "MathExpr.Evaluate: " & dblResult, Format$(Timer - dblTimer, "0.000")
    End Sub
    Native compiled (all Options), MathExpr.Evaluate times out at about 0.25sec here on my machine (for 1Mio iterations).

    Olaf
    Last edited by Schmidt; Mar 29th, 2018 at 12:30 PM.

  11. #51
    PowerPoster ThEiMp's Avatar
    Join Date
    Dec 2007
    Location
    Take The PCI Bus Across To The CPU!!
    Posts
    3,899

    Re: simple math string parser

    We have to help the OP to learn by his/her experiences. so then OP please post your source code in this thread. then we will be able to check it for syntax errors, etc
    I have a huge free products range, of computer software in which you can download using any kind of 64-Bit Web Browser. Also there is coming a Social Networking section that I am making on my Website...

    |Ambra Productions Inc. | The Black Sun Society | The Black Shield | Ambra College | Church of the Black Sun | Ambra Productions Inc's Homepage | Boomtick Event's Venues: Ambar Nightclub, Jack Rabbit Slim's, Villa Nightclub and Lucy's Bar | Pasta Ambra | Fish Feast Company | Wallet Wizard | Ambrose Liquor | Ambar Tavern | Ambra University |

    Do you wish to do unpaid work for me??? If so, the PM me on this Forum, and then we can get to work, programming for the future of computers go by the name of ThEiMp. This is my ghost writers name. Also my nickname, means that I am: The Imperial of the Technology Industry, so then to make it really short, I just then wrote: The Imp, which is where I get the nickname from...

  12. #52
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,120

    Re: simple math string parser

    Just tested cMathExpr class agains VC++ optimized *Release* build of my InlineSimpleEval plain C version. Turns out Advanced Optimizations compiled cMathExpr has a small edge.



    This closes the case for me as obviously my optimization efforts snowballed out of control.

    At least the Runtime TCC spin-off project has some useful applications outside this particular parser problem.

    cheers,
    </wqw>

  13. #53

  14. #54
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: simple math string parser

    Quote Originally Posted by reexre View Post
    I'd like to have the possibility to add and set "Variables" in the expression.
    How to do it ? (using Post #50)
    Adding VarHandling to the Evaluator would probably slow down the Evaluation by factor 2
    (then operating in the range of 2 Mio Operations/sec from its former 4MegaOps/sec).

    And then you'd be in the performancerange of e.g. the MS-VBScripting.Engine.

    For example, if you'd want to use that in your ImageTools (to allow for some kind of "Userdefined Pixel-Processing-Functions"),
    you could make an attempt already with either the ScriptControl or the RC5-Scripting-support -
    as shown below (achieving about 1Mio calls per second into the Pixel-Processing-UDF, performing 3 simple evaluations there):
    Code:
    Option Explicit
    
    Private SC As cActiveScript
    
    Private Sub Form_Load()
      Set SC = New_c.ActiveScript("VBScript", False, False)
    End Sub
    
    Private Sub Form_Click()
      Dim SB As cStringBuilder, CO As Object, T!
      Set SB = New_c.StringBuilder 'let's build a Pixel-UDF for a simple "darkening"
          SB.AppendNL "Sub UDF(srcR, srcG, srcB, dstR, dstG, dstB)"
          SB.AppendNL "    dstR = srcR * 0.5"
          SB.AppendNL "    dstG = srcG * 0.5"
          SB.AppendNL "    dstB = srcB * 0.5"
          SB.AppendNL "End Sub"
      SC.AddCode SB.ToString 'compile the UDF
       
      Set CO = SC.CodeObject 'get the Code-Object (for faster calling from outside)
      T = Timer
        Dim i As Long, dstR, dstG, dstB
        For i = 1 To 10^6
          CO.UDF 2, 22, 222, dstR, dstG, dstB 'LateBound-call into the script (the 3 dstVariants are set ByRef)
        Next
        Debug.Print dstR, dstG, dstB
      Caption = Timer - T
    End Sub
    HTH

    Olaf
    Last edited by Schmidt; Apr 1st, 2018 at 04:53 PM.

  15. #55
    Fanatic Member
    Join Date
    Sep 2010
    Location
    Italy
    Posts
    678

    Re: simple math string parser

    Thank you Olaf!
    Very interesting and Fast. (Tons faster than cFormula...)
    The output variables seems that must be declared as Variant (This made me struggle a little bit)

    PS:
    How to check if the expression is a Valid one ? (maybe with error handling?)


    EDIT:
    Are there some other examples (Links) about ActiveScript?... 'cause I'm quite ignorant about this.. and it's a very powerfull tool.

  16. #56
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,219

    Re: simple math string parser

    Quote Originally Posted by reexre View Post
    How to check if the expression is a Valid one ? (maybe with error handling?)
    Just wrap the expression up in a small Script -Sub or -Function (using simple String-Concatenation) -
    and then Add this "dynamically constructed" routine via:
    SC.AddCode YourDynamicallyConstructedRoutine

    After making the above call, you can immediately ask the Scripting-Instance:
    If Len(SC.LastErrString) Then MsgBox SC.LastErrString
    to inform your user in case any error happened...

    The above SC-Variable can also be defined WithEvents (then you will get Error-Reports dynamically in an Event).

    Quote Originally Posted by reexre View Post
    Are there some other examples (Links) about ActiveScript?... 'cause I'm quite ignorant about this.. and it's a very powerfull tool.
    It supports quite a lot more than the "regular MS-ScriptControl" (especially with regards to dynamic Event-Support) -
    so you can even write "dynamic, userdefinable GUIs" with it - like the following example shows...

    Into a normal *.bas-Module (adjust the Project-Settings, to start from Sub Main)
    Code:
    Option Explicit
    
    Sub Main()
      Dim SC As cActiveScript, SB As cStringBuilder
      Set SC = New_c.ActiveScript
      Set SB = New_c.StringBuilder
      
      'first we add Code for a VBScript-Class (a simple Cairo-Widget)
        SB.AppendNL "Class cwMyWidget"
        SB.AppendNL "  Dim W"
      
        SB.AppendNL "  Sub Class_Initialize()"
        SB.AppendNL "     Set W = Cairo.WidgetBase"
        SB.AppendNL "         W.Moveable = True"
        SB.AppendNL "     AddEventSinkOn Me, 'W_Paint', 6"
        SB.AppendNL "  End Sub"
        
        SB.AppendNL "  Property Get Widget():  Set Widget = W:          End Property"
        SB.AppendNL "  Property Get Widgets(): Set Widgets = W.Widgets: End Property"
      
        SB.AppendNL "  Sub W_Paint(ByVal CC, ByVal x, ByVal y, ByVal dx, ByVal dy, ByVal UserObj)"
        SB.AppendNL "      CC.Paint 1, Cairo.CreateSolidPatternLng(vbMagenta, 0.3)"
        SB.AppendNL "      S = 'Hello World' & vbCrLf & 'from ' & W.Key & vbCrLf & '(move me around)'"
        SB.AppendNL "      CC.DrawText 0, 0, dx, dy, CStr(S), False, vbCenter, 4, True"
        SB.AppendNL "  End Sub"
        SB.AppendNL "End Class"
     
      'finally we add the Main-Code (using a Cairo-Form, two Widget-Class-Instances from the code above, and a RC5-cTimer)
        SB.AppendNL "Set Form = Cairo.WidgetForms.Create(vbSizable, 'Form-Caption', True, 480, 320)"
        SB.AppendNL "    Form.Widgets.Add New cwMyWidget, 'MyWidget1', 10, 10, 150, 150"
        SB.AppendNL "    Form.Widgets.Add New cwMyWidget, 'MyWidget2', 60, 60, 150, 150"
        SB.AppendNL "Set Timer1 = New_c.Timer(600, True): AddEventSupportFor 'Timer1'"
      
        SB.AppendNL "Sub Timer1_Timer()"
        SB.AppendNL "    Form.Caption= 'Form-Caption: ' & Now"
        SB.AppendNL "End Sub"
        
        SB.AppendNL "Form.Show vbModal"
          
      'the main-code (since it is not wrapped in a Routine) is now immediately executed "On Add"
      SC.AddCode Replace(SB.ToString, "'", """") '<- replace the single-quotes we've used in above code-defs with the needed double-quotes
    
      'we reach this point only, after the (modal) CairoForm we created in the Script above was closed...
      Set SB = Nothing
      Set SC = Nothing
      New_c.CleanupRichClientDll
    End Sub
    HTH

    Olaf

  17. #57
    Junior Member
    Join Date
    Oct 2013
    Posts
    30

    Re: simple math string parser

    Hello,

    My two penneth on this... it's 5 yrs old though.

    Access has the Eval function.

    Open an instance of access, pass it the math... get the answer.

    May be slower than other methods but will always work.

    HTH
    Lisa

Page 2 of 2 FirstFirst 12

Posting Permissions

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



Click Here to Expand Forum to Full Width