There have been several shared-memory extensions written for Tcl, including
[Explain what shared memory is.]
See Inventory of IPC methods for other ways to let tcl processes communicate.
"Shared memory" and "memory mapping" are roughly synonymous. [Explain distinction, usage.]
I've been using these two little packages "shm" and "bob" (binary object) for several years and its very simple. This only works on systems where sizeof int == sizeof pointer.
package require critcl
package provide shm 1.0
namespace eval shm {
critcl::ccode {
#include <sys/ipc.h>
#include <sys/shm.h>
}
critcl::cproc get { int key } int {
return shmget(key, 0, 0);
}
critcl::cproc new { int key int size int perm } int {
return shmget(key, size, perm | IPC_CREAT);
}
critcl::cproc siz { int id } int {
struct shmid_ds shm;
if ( shmctl(id, IPC_STAT, &shm) != -1 ) {
return shm.shm_segsz;
}
return -1;
}
critcl::cproc att { int id } int {
return (int) shmat(id, 0, 0);
}
}
package require critcl
package provide bob 1.0
namespace eval bob {
namespace export {[a-z]*}
critcl::cproc get { Tcl_Interp* interp int att int off int len } ok {
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj((char *) att + off, len));
return TCL_OK;
}
critcl::cproc set { Tcl_Interp* interp int att int off int len Tcl_Obj* data } void {
memcpy((char *) att + off, Tcl_GetByteArrayFromObj(data, NULL), len);
}
critcl::ccommand write { data interp objc objv } {
char *att;
int off;
int len;
Tcl_Channel ofp;
int mode;
if ( objc != 5 ) {
Tcl_SetResult(interp, "bob::write pointer offset length file", TCL_STATIC);
return TCL_ERROR;
}
Tcl_GetIntFromObj(interp, objv[1], &att);
Tcl_GetIntFromObj(interp, objv[2], &off);
Tcl_GetIntFromObj(interp, objv[3], &len);
if ( (ofp = Tcl_GetChannel(interp, Tcl_GetString(objv[4]), &mode)) == NULL ) {
Tcl_SetResult(interp, "bob::read cannot get channel", TCL_STATIC);
return TCL_ERROR;
}
Tcl_Write(ofp, att + off, len);
return TCL_OK;
}
critcl::ccommand read { data interp objc objv } {
char *att;
int off;
int len;
Tcl_Channel ifp;
int mode;
if ( objc != 5 ) {
Tcl_SetResult(interp, "bob::read data offset length file", TCL_STATIC);
return TCL_ERROR;
}
Tcl_GetIntFromObj(interp, objv[1], &att);
Tcl_GetIntFromObj(interp, objv[2], &off);
Tcl_GetIntFromObj(interp, objv[3], &len);
if ( (ifp = Tcl_GetChannel(interp, Tcl_GetString(objv[4]), &mode)) == NULL ) {
Tcl_SetResult(interp, "bob::read cannot get channel", TCL_STATIC);
return TCL_ERROR;
}
Tcl_Read(ifp, att + off, len);
return TCL_OK;
}
}