Updated 2011-02-01 05:10:29 by RLE

Here's my code which shows how to (in short) do a deep copy of a Tcl_Obj structure from C.

It stores any unknown type as string and the following in internal represenatation:

  • list (including sublists)
  • int
  • long
  • double
  • strings (this is the default handler)

Here's the main code:

[deepcopy.h]
    #ifndef DEEPCOPY_H
    #define DEEPCOPY_H 1

    #include <tcl.h>

    void *Dc_GetTclObj(Tcl_Obj *obj);
    Tcl_Obj *Dc_NewTclObj(void *ptr);
    void Dc_FreeDcObj(void *ptr);
    unsigned long Dc_ObjSize(void *ptr);

    #endif

[deepcopyInt.h]
    #ifndef DEEPCOPYINT_H
    #define DEEPCOPYINT_H 1

    #define DCO_STRING      1
    #define DCO_INTEGER     2
    #define DCO_LONG        3
    #define DCO_DOUBLE      4
    #define DCO_LIST        5

    #ifdef  AOLSERVER
    #define dc_Malloc       Ns_Alloc
    #define dc_Free         Ns_Free
    #else
    #define dc_Malloc       Tcl_Alloc
    #define dc_Free         Tcl_Free
    #endif

    /* objhead */
    struct dcObjHead {
        short type;
        unsigned long size;         // including dcObjHead
    };

    /* int object */
    struct dcIntObj {
        struct dcObjHead head;
        int value;
    };

    static struct dcObjHead *int_GetTclObj(Tcl_Obj *to);
    Tcl_Obj *int_NewTclObj(struct dcObjHead *o);
    static void int_Free(struct dcObjHead *o);

    /* long object */
    struct dcLongObj {
        struct dcObjHead head;
        long value;
    };

    static struct dcObjHead *long_GetTclObj(Tcl_Obj *to);
    Tcl_Obj *long_NewTclObj(struct dcObjHead *o);
    static void long_Free(struct dcObjHead *o);

    /* double object */
    struct dcDoubleObj {
        struct dcObjHead head;
        double value;
    };

    static struct dcObjHead *double_GetTclObj(Tcl_Obj *to);
    Tcl_Obj *double_NewTclObj(struct dcObjHead *o);
    static void double_Free(struct dcObjHead *o);

    /* string object */
    struct dcStrObj {
        struct dcObjHead head;
        char string[1];
    };

    static struct dcObjHead *str_GetTclObj(Tcl_Obj *to);
    Tcl_Obj *str_NewTclObj(struct dcObjHead *o);
    static void str_Free(struct dcObjHead *o);

    /* list object */
    struct dcListObj {
        struct dcObjHead head;
        int nelem;
        struct dcObjHead *list[1];
    };

    static struct dcObjHead *list_GetTclObj(Tcl_Obj *to);
    Tcl_Obj *list_NewTclObj(struct dcObjHead *o);
    static void list_Free(struct dcObjHead *o);

    #endif

[deepcopy.c]
    #include <tcl.h>
    #include <deepcopy.h>
    #include <deepcopyInt.h>

    /* external API */

    void *Dc_GetTclObj(Tcl_Obj *obj) {
        void *rc;
        char *otype = "";

        if (obj->typePtr!=NULL) {
            otype = obj->typePtr->name;
        }
        if (!strcmp(otype,"int")) {
            rc = int_GetTclObj(obj);
        } else if (!strcmp(otype,"long")) {
            rc = long_GetTclObj(obj);
        } else if (!strcmp(otype,"double")) {
            rc = double_GetTclObj(obj);
        } else if (!strcmp(otype,"list")) {
            rc = list_GetTclObj(obj);
        } else {
            rc = str_GetTclObj(obj);
        }
        return rc;
    }

    Tcl_Obj *Dc_NewTclObj(void *ptr) {
        struct dcObjHead *oh = ptr;
        Tcl_Obj *rc = NULL;
        switch (oh->type) {
            case DCO_STRING:
                rc = str_NewTclObj(ptr);
                break;
            case DCO_LIST:
                rc = list_NewTclObj(ptr);
                break;
            case DCO_INTEGER:
                rc = int_NewTclObj(ptr);
                break;
            case DCO_DOUBLE:
                rc = double_NewTclObj(ptr);
                break;
            case DCO_LONG:
                rc = long_NewTclObj(ptr);
                break;
        }
        return rc;
    }

    void Dc_FreeDcObj(void *ptr) {
        struct dcObjHead *oh = ptr;
        switch (oh->type) {
            case DCO_STRING:
                str_Free(ptr);
                break;
            case DCO_LIST:
                list_Free(ptr);
                break;
            case DCO_INTEGER:
                int_Free(ptr);
                break;
            case DCO_LONG:
                long_Free(ptr);
                break;
            case DCO_DOUBLE:
                double_Free(ptr);
                break;
        }
    }

    unsigned long Dc_ObjSize(void *ptr) {
        struct dcObjHead *oh = ptr;
        return oh->size;
    }

    /* internal type representations */

    static struct dcObjHead *str_GetTclObj(Tcl_Obj *to) {
        struct dcStrObj *rc;
        int strlen;
        char *str = Tcl_GetStringFromObj(to, &strlen);
        unsigned long size = strlen+1+sizeof(struct dcObjHead);

        if (rc=(struct dcStrObj *) dc_Malloc(size)) {
            memcpy(rc->string, str, strlen);
            rc->string[strlen] = '\0';
            rc->head.type = DCO_STRING;
            rc->head.size = size;
        }
        return ((struct dcObjHead *) rc);
    }

    Tcl_Obj *str_NewTclObj(struct dcObjHead *o) {
        struct dcStrObj *so = (struct dcStrObj *) o;
        Tcl_Obj *rc = NULL;
        if (o->type==DCO_STRING) {
            rc = Tcl_NewStringObj(so->string,
                    o->size-sizeof(struct dcObjHead)-1);
        }
        return rc;
    }

    static void str_Free(struct dcObjHead *o) {
        if (o->type==DCO_STRING) {
            dc_Free(o);
        }
    }

    static struct dcObjHead *int_GetTclObj(Tcl_Obj *to) {
        struct dcIntObj *rc = (struct dcIntObj *)
                dc_Malloc(sizeof(struct dcIntObj));
        if (rc != NULL) {
            Tcl_GetIntFromObj(NULL, to, &rc->value);
            rc->head.type = DCO_INTEGER;
            rc->head.size = sizeof(struct dcIntObj);
        }
        return ((struct dcObjHead *) rc);
    }

    Tcl_Obj *int_NewTclObj(struct dcObjHead *o) {
        struct dcIntObj *so = (struct dcIntObj *) o;
        Tcl_Obj *rc = NULL;
        if (o->type==DCO_INTEGER) {
            rc = Tcl_NewIntObj(so->value);
        }
        return rc;
    }

    static void int_Free(struct dcObjHead *o) {
        if (o->type==DCO_INTEGER) {
            dc_Free((void *) o);
        }
    }

    static struct dcObjHead *long_GetTclObj(Tcl_Obj *to) {
        struct dcLongObj *rc = (struct dcLongObj *)
                dc_Malloc(sizeof(struct dcLongObj));
        if (rc != NULL) {
            Tcl_GetLongFromObj(NULL, to, &rc->value);
            rc->head.type = DCO_LONG;
            rc->head.size = sizeof(struct dcLongObj);
        }
        return ((struct dcObjHead *) rc);
    }

    Tcl_Obj *long_NewTclObj(struct dcObjHead *o) {
        struct dcLongObj *so = (struct dcLongObj *) o;
        Tcl_Obj *rc = NULL;
        if (o->type==DCO_LONG) {
            rc = Tcl_NewLongObj(so->value);
        }
        return rc;
    }

    static void long_Free(struct dcObjHead *o) {
        if (o->type==DCO_LONG) {
            dc_Free((void *) o);
        }
    }

    static struct dcObjHead *double_GetTclObj(Tcl_Obj *to) {
        struct dcDoubleObj *rc = (struct dcDoubleObj *)
                dc_Malloc(sizeof(struct dcDoubleObj));
        if (rc != NULL) {
            Tcl_GetDoubleFromObj(NULL, to, &rc->value);
            rc->head.type = DCO_DOUBLE;
            rc->head.size = sizeof(struct dcDoubleObj);
        }
        return ((struct dcObjHead *) rc);
    }

    Tcl_Obj *double_NewTclObj(struct dcObjHead *o) {
        struct dcDoubleObj *so = (struct dcDoubleObj *) o;
        Tcl_Obj *rc = NULL;
        if (o->type==DCO_DOUBLE) {
            rc = Tcl_NewDoubleObj(so->value);
        }
        return rc;
    }

    static void double_Free(struct dcObjHead *o) {
        if (o->type==DCO_DOUBLE) {
            dc_Free((void *) o);
        }
    }

    static struct dcObjHead *list_GetTclObj(Tcl_Obj *to) {
        Tcl_Obj *elem;
        struct dcListObj *rc;
        int size, llen, i;

        if (Tcl_ListObjLength(NULL,to,&llen) != TCL_OK)
            return NULL;

        size = sizeof(struct dcListObj)+(llen-1)*sizeof(struct dcListObj *);
        rc = (struct dcListObj *) dc_Malloc(size);
        if (rc != NULL) {
            rc->head.type = DCO_LIST;
            rc->nelem = llen;
            for (i=0 ; i<llen ; i++) {
                if (Tcl_ListObjIndex(NULL,to,i,&elem)!=TCL_OK) {
                    rc->list[i] = NULL;
                } else {
                    rc->list[i] = Dc_GetTclObj(elem);
                    size += rc->list[i]->size;
                }
            }
            rc->head.size = size;
        }
        return ((struct dcObjHead *) rc);
    }

    Tcl_Obj *list_NewTclObj(struct dcObjHead *o) {
        struct dcListObj *so = (struct dcListObj *) o;
        Tcl_Obj *rc = NULL, **tbl;
        int llen,i;

        if (o->type==DCO_LIST) {
            llen = so->nelem;
            tbl = dc_Malloc(llen*sizeof(Tcl_Obj *));
            if (tbl!=NULL) {
                for (i=0 ; i<llen ; i++) {
                    tbl[i] = Dc_NewTclObj(so->list[i]);
                }
                rc = Tcl_NewListObj(llen,tbl);
                dc_Free(tbl);
            }
        }
        return rc;
    }

    static void list_Free(struct dcObjHead *o) {
        struct dcListObj *so = o;
        int i;
        if (o->type==DCO_LIST) {
            for (i=0 ; i<so->nelem ; i++) {
                Dc_FreeDcObj(so->list[i]);
            }
            dc_Free((void *) o);
        }
    }