/* Shared Memory extensions for Tcl.

   Copyright (C) 2003 David N. Welton <davidw@dedasys.com>

   To compile, do something along these lines:

   gcc -O -shared -o libtclshmem.so tclshmem.c

   This code may be distributed under the same license as Tcl.
*/

#include <tcl.h>
#include <sys/shm.h>
#include <sys/types.h>
#include <string.h>


int ShmAt(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    int shmid = 0;
    void *mem = NULL;
    int shmflag = 0;

    if (objc != 3)
    {
	Tcl_WrongNumArgs(interp, 1, objv, "shmid flags");
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[1], &shmid) == TCL_ERROR)
    {
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[2], &shmflag) == TCL_ERROR)
    {
	return TCL_ERROR;
    }

    mem = shmat (shmid, 0, shmflag);
    if ((int)mem == -1)
    {
	Tcl_SetObjResult(interp, Tcl_NewStringObj((char *)strerror(Tcl_GetErrno()), -1));
	return TCL_ERROR;
    } else {
	struct shmid_ds shmiddy;
    	Tcl_Obj *rslt;

	shmctl(shmid, IPC_STAT, &shmiddy);
	Tcl_SetByteArrayObj(rslt, mem, shmiddy.shm_segsz);
	Tcl_SetObjResult(interp, rslt);
	return TCL_OK;
    }
}

int ShmPut(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    key_t key;
    int shmid;
    int mode;
    int length;
    int memlength;
    unsigned char *bytes;
    void *mem;
    struct shmid_ds shmiddy;


    if (objc != 5)
    {
	Tcl_WrongNumArgs(interp, 1, objv, "shmid key mode object");
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[1], (int *)&shmid) == TCL_ERROR)
    {
	return TCL_ERROR;
    }
    if (Tcl_GetLongFromObj(interp, objv[2], (long *)&key) == TCL_ERROR)
    {
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[3], &mode) == TCL_ERROR)
    {
	return TCL_ERROR;
    }
    bytes = Tcl_GetByteArrayFromObj(objv[4], &length);

    if (shmid == 0)
    {
	shmid = shmget(key, length, IPC_CREAT|mode);
    }
    if (shmctl(shmid, IPC_STAT, &shmiddy) == -1)
    {
	Tcl_SetObjResult(interp, Tcl_NewStringObj((char *)strerror(Tcl_GetErrno()), -1));
	return TCL_ERROR;
    }

    memlength = shmiddy.shm_segsz;
    if (length > memlength)
    {
	Tcl_AddErrorInfo(interp, "Object is larger than available shared memory");
	return TCL_ERROR;
    }

    mem = shmat (shmid, 0, 0);
    if ((int)mem == -1)
    {
	Tcl_SetObjResult(interp, Tcl_NewStringObj((char *)strerror(Tcl_GetErrno()), -1));
	return TCL_ERROR;
    }

    memset(mem, 0, memlength);
    memcpy(mem, bytes, length);

    shmdt(mem);
    return TCL_OK;
}

int ShmGet(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    key_t key;
    int shmid;
    int mode;
    int length = 0;
    unsigned char *bytes;
    void *mem;
    struct shmid_ds shmiddy;
    Tcl_Obj *rslt;

    if (objc != 3)
    {
	Tcl_WrongNumArgs(interp, 1, objv, "shmget shmid key");
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[1], (int *)&shmid) == TCL_ERROR)
    {
	return TCL_ERROR;
    }
    if (Tcl_GetLongFromObj(interp, objv[2], (long *)&key) == TCL_ERROR)
    {
	return TCL_ERROR;
    }
    if (shmid == 0)
    {
	shmid = shmget(key, length, 0);
	if (shmid < 0)
	{
	    Tcl_SetObjResult(interp, Tcl_NewStringObj((char *)strerror(Tcl_GetErrno()), -1));
	    return TCL_ERROR;
	}
    }
    if (shmctl(shmid, IPC_STAT, &shmiddy) == -1)
    {
	Tcl_SetObjResult(interp, Tcl_NewStringObj((char *)strerror(Tcl_GetErrno()), -1));
	return TCL_ERROR;
    }

    length = shmiddy.shm_segsz;
    mem = shmat(shmid, 0, 0);
    if ((int)mem == -1)
    {
	Tcl_SetObjResult(interp, Tcl_NewStringObj((char *)strerror(Tcl_GetErrno()), -1));
	return TCL_ERROR;
    }

    bytes = (char *)malloc(length);
    memcpy(bytes, mem, length);
    rslt = Tcl_NewObj();
    Tcl_SetByteArrayObj(rslt, bytes, length);
    Tcl_SetObjResult(interp, rslt);
    shmdt(mem);
    return TCL_OK;
}


int ShmDel(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    key_t key;
    int shmid;
    struct shmid_ds shmiddy;

    if (objc != 3)
    {
	Tcl_WrongNumArgs(interp, 1, objv, "shmdel shmid key");
	return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[1], (int *)&shmid) == TCL_ERROR)
    {
	return TCL_ERROR;
    }
    if (Tcl_GetLongFromObj(interp, objv[2], (long *)&key) == TCL_ERROR)
    {
	return TCL_ERROR;
    }
    if (shmid == 0)
    {
	shmid = shmget(key, 0, 0);
	if (shmid < 0)
	{
	    Tcl_SetObjResult(interp, Tcl_NewStringObj((char *)strerror(Tcl_GetErrno()), -1));
	    return TCL_ERROR;
	}
    }
    if (shmctl(shmid, IPC_RMID, &shmiddy) == -1)
    {
	Tcl_SetObjResult(interp, Tcl_NewStringObj((char *)strerror(Tcl_GetErrno()), -1));
	return TCL_ERROR;
    }
    return TCL_OK;
}

int Tclshmem_Init(Tcl_Interp *interp)
{
    Tcl_CreateObjCommand(interp, "shmget", ShmGet, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "shmput", ShmPut, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateObjCommand(interp, "shmdel", ShmDel, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_PkgProvide(interp, "tclshmem", "1.0");
    return TCL_OK;
}