Updated 2017-05-24 05:50:49 by dbohdan

dbohdan 2017-05-24: The following example shows a simple Tcl extension implemented in the programming language D (D2). It has been tested with the DMD64 D Compiler v2.074.0 and Tcl 8.6.6 on x86_64 Linux. Use the Makefile below (you'll have to fix the leading tabs first, since the wiki replaces them with spaces) or compile and test it with the POSIX shell command

dmd -shared tcldexample.d -L-ltclstub8.6 && echo 'load tcldexample.so; puts [hello]; puts [square 5]' | tclsh

tcldexample.d  edit

enum TCL_OK = 0;
enum TCL_ERROR = 1;

alias ClientData = void*;
alias Tcl_Interp = void;
alias Tcl_Obj = void;
alias Tcl_Command = void*;
alias Tcl_CmdDeleteProc = void*;
alias Tcl_ObjCmdProc = extern (C) int function(ClientData clientData,
                                               Tcl_Interp* interp,
                                               int objc,
                                               Tcl_Obj** Tcl_Obj);

extern (C) {
    char* Tcl_InitStubs(Tcl_Interp* interp,
                        const char* ver,
                        int exact);
    Tcl_Command Tcl_CreateObjCommand(Tcl_Interp* interp,
                                     const char* cmdName,
                                     Tcl_ObjCmdProc proc,
                                     ClientData clientData,
                                     Tcl_CmdDeleteProc deleteProc);
    int Tcl_GetIntFromObj(Tcl_Interp* interp,
                          Tcl_Obj* objPtr,
                          int* intPtr);
    Tcl_Obj* Tcl_NewIntObj(int intValue);
    Tcl_Obj* Tcl_NewStringObj(const char* bytes, int length);
    void Tcl_SetObjResult(Tcl_Interp* interp,
                          Tcl_Obj* resultObjPtr);
    void Tcl_WrongNumArgs(Tcl_Interp* interp,
                          int objc,
                          Tcl_Obj** objv,
                          const char* message);
}

extern (C) int Hello_Cmd(ClientData clientData,
                         Tcl_Interp* interp,
                         int objc,
                         Tcl_Obj** objv) {
    if (objc != 1) {
        Tcl_WrongNumArgs(interp, 1, objv, null);
        return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewStringObj("Hello, World!", -1));
    return TCL_OK;
}

extern (C) int Square_Cmd(ClientData clientData,
                          Tcl_Interp* interp,
                          int objc,
                          Tcl_Obj** objv) {
    int i;
    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "value");
        return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &i) != TCL_OK) {
        return TCL_ERROR;
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(i * i));
    return TCL_OK;
}

extern(C) int Tcldexample_Init(Tcl_Interp* interp) {
    if (Tcl_InitStubs(interp, "8.6", 0) == null) {
        return TCL_ERROR;
    }
    Tcl_CreateObjCommand(interp, "hello", &Hello_Cmd, null, null);
    Tcl_CreateObjCommand(interp, "square", &Square_Cmd, null, null);
    return TCL_OK;
}

Makefile  edit

test: tcldexample.so
        echo 'load tcldexample.so; puts [hello]; puts [square 5]' | tclsh
tcldexample.so: tcldexample.d
        dmd -shared $< -of=$@ -L-ltclstub8.6
clean:
        -rm tcldexample.o tcldexample.so
.PHONY: clean test

Discussion  edit