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
