Tcl_GetDoubleFromObj在列表的迭代中是一个缺点

xdnvmnnf  于 12个月前  发布在  其他
关注(0)|答案(1)|浏览(109)

我的目标是创建一个列表，找出我的值对应的类型，并将该类型添加到另一个列表中。为了做到这一点，我在Tcl中进行如下操作。

proc TCL_dataType {dataList} {
    set Tag {}
    foreach value $dataList {
        if {[string is double -strict $value]} {
            lappend Tag "N"
        } elseif {$value eq "null"} {
            lappend Tag "_"
        } else {
            lappend Tag "S"
        }
    }

    return $Tag
}

在C方面，我尝试做同样的事情：

int C_dataType (Tcl_Interp* interp Tcl_Obj* data) {

    Tcl_Obj **dataList;
    int count;
    double d;

    if (Tcl_ListObjGetElements(interp, data, &count, &dataList) != TCL_OK) {
        return TCL_ERROR;
    }

    Tcl_Obj *Tag  = Tcl_NewListObj (0,NULL);
    Tcl_Obj* s    = Tcl_NewStringObj("S", 1);
    Tcl_Obj* n    = Tcl_NewStringObj("N", 1);
    Tcl_Obj* null = Tcl_NewStringObj("_", 1);

    for (int i = 0; i < count; ++i) {

        if (Tcl_GetDoubleFromObj(interp, dataList[i], &d) == TCL_OK) {
            Tcl_ListObjAppendElement(interp, Tag, n);
        } else if (!strcmp(Tcl_GetString(dataList[i]), "null")) {
            Tcl_ListObjAppendElement(interp, Tag, null);
        } else {
            Tcl_ListObjAppendElement(interp, Tag, s);
        }
    }

    Tcl_SetObjResult(interp, Tag);

    return TCL_OK;
}

我的方法在C方面可能不正确，但如果我测量执行时间，我的C代码会慢5倍。

proc randomValues {len} {
    set l {10 null foo bar}
    set randomList {}

    for {set i 0} {$i < $len} {incr i} {
        set index [expr {int(rand() * 4)}]
        lappend randomList [lindex $l $index]
    }

    return $randomList
}

set myRandomList [randomValues 10000]
# time measure
puts [time {C_dataType $myRandomList} 10]   ; # 4921.3521 microseconds per iteration
puts [time {TCL_dataType $myRandomList} 10] ; # 986.0601 microseconds per iteration

'Tcl_GetDoubleFromObj'似乎花费了我的时间，所以我做了一个测试，从我的Tcl过程中删除了这个C函数和'string is double -strict xxx'，以比较相同的东西，这里是相反的。
也许在C方面，我应该知道我的变量的类型。但是我不知道如果不使用这个函数，我怎么能控制每个Tcl对象。

c

1条答案

按热度按时间
s4chpxco

s4chpxco1#

尝试将interp的NULL传递给Tcl_GetDoubleFromObj。我怀疑时间是用来设置一个永远不会使用的错误结果的。
另外，如果s、n和null中的Tcl_Objs没有添加到结果列表中，则存在泄漏的风险。Tcl_NewStringObj用零refCount创建它们，但如果它们从未进入Tag列表，则此后不会更改它们。我已经制定了一个规则，如果我有一个指向Tcl_Obj的指针，总是正确地引用，使用一个助手，比如：

static inline void replace_tclobj(Tcl_Obj** target, Tcl_Obj* replacement)
{
    Tcl_Obj*    old = *target;

    *target = replacement;
    if (*target) Tcl_IncrRefCount(*target);
    if (old) {
        Tcl_DecrRefCount(old);
        old = NULL;
    }
}

int C_dataType (Tcl_Interp* interp Tcl_Obj* data) {

    int code = TCL_OK;
    Tcl_Obj **dataList;
    int count;
    double d;
    Tcl_Obj *Tag  = NULL;
    Tcl_Obj* s    = NULL;
    Tcl_Obj* n    = NULL;
    Tcl_Obj* null = NULL;

    if ((code = Tcl_ListObjGetElements(interp, data, &count, &dataList)) != TCL_OK) {
        goto finally;
    }

    replace_tclobj(&Tag,  Tcl_NewListObj(count, NULL));
    replace_tclobj(&s,    Tcl_NewStringObj("S", 1));
    replace_tclobj(&n,    Tcl_NewStringObj("N", 1));
    replace_tclobj(&null, Tcl_NewStringObj("_", 1));

    for (int i = 0; i < count; ++i) {

        if (Tcl_GetDoubleFromObj(NULL, dataList[i], &d) == TCL_OK) {
            Tcl_ListObjAppendElement(interp, Tag, n);
        } else if (!strcmp(Tcl_GetString(dataList[i]), "null")) {
            Tcl_ListObjAppendElement(interp, Tag, null);
        } else {
            Tcl_ListObjAppendElement(interp, Tag, s);
        }
    }

    Tcl_SetObjResult(interp, Tag);

finally:
    replace_tclobj(&Tag,  NULL);
    replace_tclobj(&s,    NULL);
    replace_tclobj(&n,    NULL);
    replace_tclobj(&null, NULL);
    return code;
}

我发现这种模式在避免内存泄漏（特别是在错误路径上）方面有很大帮助，并且通常减少了处理引用计数的认知负荷。
即使元素还不知道，也可以将结果列表的已知大小传递给Tcl_NewListObj，这将允许它在开始时分配正确的存储大小，而不是递增地增加（尽管我怀疑性能上的差异可能无法衡量）。
（稍后编辑）：好吧，所以我很好奇，在字符串代表上使用regexp是否会更快。这肯定是针对问题中的基准数据，但这有点不切实际：所有数字将指向一个共享的“10”Tcl_Obj，它将立即转换为双objtype（对C_dataType有利），并且也是一个短字符串（对re_dataType有利）。所以我调整了这个基准测试，为每个N元素生成一个不同的随机数，并覆盖了更多的数字文字（和长度）的语法空间。在这样做的时候，我注意到C_dataType和TCL_dataType实现在字符串“NaN”的分类上不一致-string is double -strict说是，C_dataType的Tcl_GetDoubleFromObj说不是。新的基于re 2c的实现与Tcl实现一致。

package require jitc

proc TCL_dataType {dataList} {
    set Tag {}
    foreach value $dataList {
        if {[string is double -strict $value]} {
            lappend Tag "N"
        } elseif {$value eq "null"} {
            lappend Tag "_"
        } else {
            lappend Tag "S"
        }
    }

    return $Tag
}

set cdef    {
    options {-Wall -Werror -g}
    filter  {jitc::re2c -W --case-ranges --no-debug-info}
    code {
        #include <string.h>

        enum {
            L_S,
            L_N,
            L__,
            L_size
        };
        static const char* static_strs[L_size] = {
            "S",
            "N",
            "_"
        };
        Tcl_Obj*    lit[L_size];

        const Tcl_ObjType* objtype_int    = NULL;
        const Tcl_ObjType* objtype_double = NULL;

        INIT {
            for (int i=0; i<L_size; i++) replace_tclobj(&lit[i], Tcl_NewStringObj(static_strs[i], -1));
            objtype_int    = Tcl_GetObjType("int");
            objtype_double = Tcl_GetObjType("double");
            return TCL_OK;
        }

        RELEASE {
            for (int i=0; i<L_size; i++) replace_tclobj(&lit[i], NULL);
        }

        OBJCMD(C_dataType)
        {
            int     code = TCL_OK;
            enum {A_cmd, A_DATA, A_objc};
            CHECK_ARGS_LABEL(finally, code, "data");

            Tcl_Obj **dataList;
            int count;
            double d;
            Tcl_Obj* Tag  = NULL;

            TEST_OK_LABEL(finally, code, Tcl_ListObjGetElements(interp, objv[A_DATA], &count, &dataList));

            replace_tclobj(&Tag, Tcl_NewListObj(count, NULL));

            for (int i = 0; i < count; ++i) {
                if (Tcl_GetDoubleFromObj(NULL, dataList[i], &d) == TCL_OK) {
                    Tcl_ListObjAppendElement(interp, Tag, lit[L_N]);
                } else if (!strcmp(Tcl_GetString(dataList[i]), "null")) {
                    Tcl_ListObjAppendElement(interp, Tag, lit[L__]);
                } else {
                    Tcl_ListObjAppendElement(interp, Tag, lit[L_S]);
                }
            }

            Tcl_SetObjResult(interp, Tag);

        finally:
            replace_tclobj(&Tag, NULL);
            return code;
        }

        OBJCMD(re_dataType) {
            int         code = TCL_OK;
            Tcl_Obj*    Tag = NULL;
            Tcl_Obj**   dataList;
            int         count;

            enum {A_cmd, A_DATA, A_objc};
            CHECK_ARGS_LABEL(finally, code, "data");

            TEST_OK_LABEL(finally, code, Tcl_ListObjGetElements(interp, objv[A_DATA], &count, &dataList));

            replace_tclobj(&Tag, Tcl_NewListObj(count, NULL));

            for (int i=0; i<count; i++) {
                /* Snoop on the objtype: if it's one of the number types we know about,
                 * then just add it directly */
                if (
                    Tcl_FetchInternalRep(dataList[i], objtype_int)    != NULL ||
                    Tcl_FetchInternalRep(dataList[i], objtype_double) != NULL
                ) {
                    Tcl_ListObjAppendElement(interp, Tag, lit[L_N]);
                    continue;
                }

                const char* YYCURSOR = Tcl_GetString(dataList[i]);
                const char* YYMARKER;

                /*!re2c
                re2c:define:YYCTYPE = char;
                re2c:yyfill:enable  = 0;

                end       = [\x00];
                null      = "null";
                digit     = [0-9];
                digit1    = [1-9];
                hexdigit  = [0-9A-Fa-f];
                octdigit  = [0-7];
                bindigit  = [01];
                sign      = [-+];
                inf       = 'Inf' 'inity'?;
                nan       = 'NaN';
                hexnum    = '0x' hexdigit+;
                octnum    = '0' 'o'? octdigit+;
                binnum    = '0b' bindigit+;
                decnum    = digit1 digit* | "0";
                realnum
                    = digit+ ("." digit*)? ('e' sign? digit+)?
                    | "." digit+ ('e' sign? digit+)?;
                number    = sign? (decnum | hexnum | octnum | binnum | realnum | inf | nan);

                number end  { Tcl_ListObjAppendElement(interp, Tag, lit[L_N]); continue; }
                null end    { Tcl_ListObjAppendElement(interp, Tag, lit[L__]); continue; }
                *           { Tcl_ListObjAppendElement(interp, Tag, lit[L_S]); continue; }

                */
            }

            Tcl_SetObjResult(interp, Tag);

        finally:
            replace_tclobj(&Tag, NULL);
            return code;
        }
    }
}

jitc::bind C_dataType  $cdef C_dataType
jitc::bind re_dataType $cdef re_dataType

proc randomValues {len} {
    set l {N null foo bar}
    #set l {10 null foo bar}
    set randomList {}

    for {set i 0} {$i < $len} {incr i} {
        set index   [expr {int(rand() * 4)}]
        set v       [lindex $l $index]
        if {$v eq "N"} {
            # Contrive to have the value be a pure number objtype some of the time
            set v   [switch [expr {int(rand() * 9)}] {
                0 {expr {int(rand() * 1000)}}
                1 {expr {rand() * 1000.0}}
                2 {format %se%s [expr {rand() * 10.0}] [expr {int(rand() * 10)}]}
                3 {return -level 0 NaN}
                4 {return -level 0 Inf}
                5 {return -level 0 Infinity}
                6 {format 0x%x [expr {int(rand() * 0x100000000)}]}
                7 {format 0b%b [expr {int(rand() * 0x10000)}]}
                8 {format 0%o [expr {int(rand() * 0x10000)}]}
            }]
        }
        lappend randomList $v
    }

    return $randomList
}

set myRandomList [randomValues 10000]

puts "TCL_dataType: [timerate {TCL_dataType $myRandomList} 1 1]" ; # 787 µs/#
puts "re_dataType:  [timerate {re_dataType $myRandomList} 1 1]"  ; # 142 µs/#
puts "C_dataType:   [timerate {C_dataType $myRandomList} 1 1]"   ; # 186 µs/#

re_dataType实现在C_dataType实现之前进行基准测试，以避免所有N种类型都被转换为本地数字对象类型，这将无法执行re_dataType的数字解析路径。
基准测试的迭代次数上限为1，以防止后续迭代不公平地受益于所有已转换为双对象类型的数字。
由于这表明使用正则表达式对列表中的元素进行分类可能比参考C实现更快，因此可以使用Tcl实现来接近它，如：lmap e $dataList {switch -regex $e {...}}但是把regex从re 2c语法转换成可以被switch -regex处理的情况，这对我来说听起来不再有趣了。

赞(0）分享  回复(0）举报  12个月前
我来回答

相关问题

    查看更多

    热门标签

    更多
    JavaquerypythonNode开发语言requestUtil数据库Table后端算法LoggerMessageElementParser

    最新问答

    更多
    • 蜀ICP备13028337号-1 大数据知识库 https://www.saoniuhuo.com © All rights reserved
    • 本站内容来源互联网,如果侵犯您的权益请联系我们删除, 联系方式：448109455@qq.com