0

我想在 Tcl 和 C 线程之间有一个动态共享内存空间。

该线程共享内存空间的大小是在运行xxx_Init (Tcl_Interp *interp) {...}过程时分配的，但我想根据 Tcl 变量分配一个空间，以优化内存使用。

可能吗？如果是，该怎么做？

编辑：提供的详细代码显示了我想要做什么和我的问题。

指向包含共享数据的结构的指针将作为客户端数据与调用的过程共享，该过程testCmd在两个 Tcl 变量之后分配内存空间大小。它还作为客户端数据与新创建的线程共享。C 扩展在下文中有详细说明，但由于内存空间不在线程之间共享，应在xxx_Init (Tcl_Interp *interp) {...}过程中定义，因此不起作用。但如果我这样做，我就无法获得指定要分配的内存空间大小的 Tcl 变量。

    #include <tcl.h>

typedef struct dataHandle_ {
    char *data ;
    long p1 ;
    long p2 ;
} dataHandle_T ;

// Thread function
// Test if we can write memory space allocated by 'testCmd0' function
static void startRoutine (ClientData clientData) {
    dataHandle_T *dH = (dataHandle_T *) clientData;
    //test
    FILE *file;
    file=fopen("testFile.txt", "w");
    while (1) { 
        int mul=dH->p1*dH->p2;
        if (mul<10) {
            dH->data="A";
        } else {
            dH->data="Large str";
        }
        fprintf(file, "Memory size is %d, word is %s ", mul, dH->data);
    }
    fclose(file);
}


// Test command
// Allocating a new memory space for thread shared memory, depending on 2 Tcl variables values
int testCmd(
    ClientData data,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *CONST objv[])
{
    dataHandle_T *dH = (dataHandle_T *)data ;

    // Check the number of arguments
    if (objc != 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "arg arg");
        return TCL_ERROR;
    }

    long p1, p2, result ;

    if ( Tcl_GetLongFromObj(interp, objv[1], &p1) != TCL_OK)
        return TCL_ERROR ;

    if ( Tcl_GetLongFromObj(interp, objv[2], &p2)  != TCL_OK)
        return TCL_ERROR ;

    // Is a re-allocation needed?
    if (dH->p1 != p1 || dH->p2 != p2) {
        if (dH->data != NULL)
            Tcl_Free(dH->data) ;
        dH->data = Tcl_Alloc(p1 * p2 * sizeof(char)) ;// Or whatever allocation you need
    }

    return TCL_OK ;

}

// Create thread launching startRoutine procedure with a dataHandle_T as argument
createThread_Cmd(
    ClientData cdata,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{

    // Contain the ID of the newly created thread
    Tcl_ThreadId id;    
    // Thread argument
    ClientData limitData;

    // Transfering global var argument to the created thread
    limitData=cdata;

    // Thread creation
    id=0;
    Tcl_CreateThread(&id, startRoutine, limitData, TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS);

    // Return thread ID to tcl prog to allow thread management
    Tcl_SetObjResult(interp, Tcl_NewIntObj((int) id));
    return TCL_OK;  
}


// Note the casing on the _Init function name
int DLLEXPORT

Test_Init(Tcl_Interp *interp)
{
    // Link with the stubs library to make the extension as portable as possible
    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
        return TCL_ERROR;
    }

    // Declare which package and version is provided by this C code
    if ( Tcl_PkgProvide(interp, "BasicTclExtn", "1.0") != TCL_OK ) {
        return TCL_ERROR ;
    }

    // Allocate the storage for the ClientData
    dataHandle_T *hD = (dataHandle_T *)Tcl_Alloc(sizeof(dataHandle_T));

    // Initialise the new structure
    hD->data = NULL ;
    hD->p1 = -1 ;
    hD->p2 = -1 ;

    // Create a command
    Tcl_CreateObjCommand(interp, "test", testCmd, (ClientData)hD, (Tcl_CmdDeleteProc *)NULL);
    Tcl_CreateObjCommand(interp, "createThread", createThread_Cmd, (ClientData)hD, NULL);
    return TCL_OK ;
}

执行以下 Tcl 的代码时：

load [file join [pwd] libtest[info sharedlibextension]]
test 1 2

set threadId [createThread]
puts "Created thread $threadId"
after 500
# ==Produce an error==
test 4 3
after 500
test 10 20
# =====
exit 1

代码的输出给出（如果产生错误的部分被注释或没有）：

$ tclsh test.tcl
Created thread -1227109568
$ tclsh test.tcl
Created thread -1227019456
alloc: invalid block: 0x431abb: 69 2e
Aborted (core dumped)
4

1 回答 1

2

_Init 函数中的一个参数是 Tcl_Interp*。因此，您应该能够使用 Tcl_Eval 或其变体之一在该解释器中执行一些 Tcl 代码。然后你应该能够运行一个 Tcl proc 说它返回你想要的值，然后使用 Tcl_GetObjResult() 从 Interp 中检索值。

以下代码适用于我的 _Init 函数：

int res ;
if ( Tcl_Eval(interp, "set myVal") != TCL_OK)
    return TCL_ERROR ;

if (Tcl_GetIntFromObj(interp,Tcl_GetObjResult(interp), &res) != TCL_OK)
    return TCL_ERROR ;

使用以下 Tcl 脚本：

set myVal 102
load basicTclExtn.dll

值 102 最终出现在 C++ res 变量中。

根据编辑和评论，我最终得到了以下代码，希望能解决您的问题：

首先是 Tcl C 扩展

typedef struct dataHandle_ {
    char *data ;
    long p1 ;
    long p2 ;
} dataHandle_T ;

// Test command
int testCmd(
    ClientData data,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *CONST objv[])
{
    dataHandle_T *dH = (dataHandle_T *)data ;

    // Check the number of arguments
    if (objc != 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "arg arg");
        return TCL_ERROR;
    }

    long p1, p2, result ;

    if ( Tcl_GetLongFromObj(interp, objv[1], &p1) != TCL_OK)
        return TCL_ERROR ;

    if ( Tcl_GetLongFromObj(interp, objv[2], &p2)  != TCL_OK)
        return TCL_ERROR ;

    // Is a re-allocation needed?
    if (dH->p1 != p1 || dH->p2 != p2) {
        if (dH->data != NULL)
            Tcl_Free(dH->data) ;
        dH->data = Tcl_Alloc(p1 * p2 * sizeof(char)) ;// Or whatever allocation you need
    }

    return TCL_OK ;

}

// Note the casing on the _Init function name
BASICTCLEXTN_API int Basictclextn_Init(Tcl_Interp *interp)
{
    // Link with the stubs library to make the extension as portable as possible
    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
        return TCL_ERROR;
    }

    // Declare which package and version is provided by this C code
    if ( Tcl_PkgProvide(interp, "BasicTclExtn", "1.0") != TCL_OK ) {
        return TCL_ERROR ;
    }

    // Allocate the storage for the ClientData
    dataHandle_T *hD = (dataHandle_T *)Tcl_Alloc(sizeof(dataHandle_T));

    // Initialise the new structure
    hD->data = NULL ;
    hD->p1 = -1 ;
    hD->p2 = -1 ;

    // Create a command
    Tcl_CreateObjCommand(interp, "test", testCmd, (ClientData)hD, (Tcl_CmdDeleteProc *)NULL);

    return TCL_OK ;
}

然后是 Tcl 脚本

load basicTclExtn.dll
puts [BasicExtnCmd 10 12]
test 1 2
test 3 4

因此，每次根据要测试的前 2 个参数的值调用 test 时，都会重新分配内存。

于 2012-09-20T13:57:40.100 回答