Example of a Tcl extension in D

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

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

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

MHo 2020-10-29: Win10, dmd 2.094.1, Tcl 8.6, 64bit:

OPTLINK : Warning 9: Unknown Option : LTCLSTUB8.6

The linker is different. Couldn't figure out the right config yet....


bll - 2020-10-29 19:13:11

I would try the gdc compiler.


MHo 2020-10-30: I'm confused. I think there is no GDC for Windows. At least I did not find one yet...