1/* 2 * = = == === ===== ======== ============= ===================== 3 * == pt::rde (critcl) - Data Structures - Tcl_ObjType for interned strings. 4 * 5 */ 6 7#include <ot.h> /* Our public API */ 8#include <util.h> /* Allocation macros */ 9#include <pInt.h> /* API to basic intern(ing) of strings */ 10#include <string.h> 11 12/* 13 * = = == === ===== ======== ============= ===================== 14 */ 15 16static void ot_free_rep (Tcl_Obj* obj); 17static void ot_dup_rep (Tcl_Obj* obj, Tcl_Obj* dup); 18static void ot_string_rep (Tcl_Obj* obj); 19static int ot_from_any (Tcl_Interp* ip, Tcl_Obj* obj); 20 21static Tcl_ObjType ot_type = { 22 "tcllib/pt::rde/critcl", 23 ot_free_rep, 24 ot_dup_rep, 25 ot_string_rep, 26 ot_from_any 27}; 28 29/* 30 * = = == === ===== ======== ============= ===================== 31 */ 32 33int 34rde_ot_intern (Tcl_Obj* obj, RDE_STATE p, char* pfx, char* sfx) 35{ 36 int id; 37 RDE_STRING* rs; 38 39 TRACE (("rde_ot_intern (%p, '%s','%s' of %p = '%s')", p, pfx, sfx, obj, Tcl_GetString(obj))); 40 41 /* 42 * Quick exit if we have a cached and valid value. 43 */ 44 45 if ((obj->typePtr == &ot_type) && 46 (obj->internalRep.twoPtrValue.ptr1 == p)) { 47 rs = (RDE_STRING*) obj->internalRep.twoPtrValue.ptr2; 48 TRACE (("CACHED %p = %d", rs, rs->id)); 49 return rs->id; 50 } 51 52 TRACE (("INTERNALIZE")); 53 54 /* 55 * Drop any previous internal rep. 56 */ 57 58 if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) { 59 obj->typePtr->freeIntRepProc(obj); 60 } 61 62 /* 63 * Compute the new int-rep, interning the prefix-modified string. 64 */ 65 66 if (!pfx && !sfx) { 67 id = param_intern (p, obj->bytes); 68 69 } else if (pfx && sfx) { 70 int plen = strlen(pfx); 71 int slen = strlen(sfx); 72 char* buf = NALLOC (plen + slen + obj->length + 3, char); 73 74 sprintf (buf, "%s %s %s", pfx, obj->bytes, sfx); 75 76 id = param_intern (p, buf); 77 ckfree(buf); 78 79 } else if (pfx) { 80 int plen = strlen(pfx); 81 char* buf = NALLOC (plen + obj->length + 2, char); 82 83 sprintf (buf, "%s %s", pfx, obj->bytes); 84 85 id = param_intern (p, buf); 86 ckfree(buf); 87 88 } else /* sfx */ { 89 int slen = strlen(sfx); 90 char* buf = NALLOC (slen + obj->length + 2, char); 91 92 sprintf (buf, "%s %s", obj->bytes, sfx); 93 94 id = param_intern (p, buf); 95 ckfree(buf); 96 } 97 98 rs = ALLOC (RDE_STRING); 99 rs->next = p->sfirst; 100 rs->self = obj; 101 rs->id = id; 102 p->sfirst = rs; 103 104 obj->internalRep.twoPtrValue.ptr1 = p; 105 obj->internalRep.twoPtrValue.ptr2 = rs; 106 obj->typePtr = &ot_type; 107 108 return id; 109} 110 111/* 112 * = = == === ===== ======== ============= ===================== 113 */ 114 115static void 116ot_free_rep(Tcl_Obj* obj) 117{ 118 RDE_STATE p = (RDE_STATE) obj->internalRep.twoPtrValue.ptr1; 119 RDE_STRING* rs = (RDE_STRING*) obj->internalRep.twoPtrValue.ptr2; 120 121 /* Take structure out of the tracking list. */ 122 if (p->sfirst == rs) { 123 p->sfirst = rs->next; 124 } else { 125 RDE_STRING* iter = p->sfirst; 126 while (iter->next != rs) { 127 iter = iter->next; 128 } 129 iter->next = rs->next; 130 } 131 132 /* Nothing to release. */ 133 ckfree ((char*) rs); 134 obj->internalRep.twoPtrValue.ptr1 = NULL; 135 obj->internalRep.twoPtrValue.ptr2 = NULL; 136} 137 138static void 139ot_dup_rep(Tcl_Obj* obj, Tcl_Obj* dup) 140{ 141 RDE_STRING* ors = (RDE_STRING*) obj->internalRep.twoPtrValue.ptr2; 142 RDE_STRING* drs; 143 RDE_STATE p = ((RDE_STATE) obj->internalRep.twoPtrValue.ptr1); 144 145 drs = ALLOC (RDE_STRING); 146 drs->next = p->sfirst; 147 drs->self = dup; 148 drs->id = ors->id; 149 p->sfirst = drs; 150 151 dup->internalRep.twoPtrValue.ptr1 = obj->internalRep.twoPtrValue.ptr1; 152 dup->internalRep.twoPtrValue.ptr2 = drs; 153 dup->typePtr = &ot_type; 154} 155 156static void 157ot_string_rep(Tcl_Obj* obj) 158{ 159 ASSERT (0, "Attempted reconversion of rde string to string rep"); 160} 161 162static int 163ot_from_any(Tcl_Interp* ip, Tcl_Obj* obj) 164{ 165 ASSERT (0, "Illegal conversion into rde string"); 166 return TCL_ERROR; 167} 168/* 169 * = = == === ===== ======== ============= ===================== 170 */ 171 172 173/* 174 * Local Variables: 175 * mode: c 176 * c-basic-offset: 4 177 * fill-column: 78 178 * End: 179 */ 180