1/* pt::rde::critcl - critcl - layer 1 definitions
2 * (c) PARAM functions
3 */
4
5#include <pInt.h> /* Our public and internal APIs */
6#include <util.h> /* Allocation macros */
7#include <string.h>
8
9/* .................................................. */
10
11static char*
12dup_string (const char* str);
13
14/* .................................................. */
15
16RDE_STATE
17param_new (void)
18{
19    RDE_STATE p;
20
21    ENTER ("param_new");
22
23    p = ALLOC (RDE_STATE_);
24#ifdef RDE_TRACE
25    p->icount = 0;
26#endif
27    p->c = NULL;
28
29    p->maxnum = 0;
30    p->numstr = 0;
31    p->string = NULL;
32    p->sfirst = NULL;
33    Tcl_InitHashTable (&p->str, TCL_STRING_KEYS);
34
35    p->p = rde_param_new (p->numstr, p->string);
36
37    /*
38     * Fixed elements of the string table, as needed by the lower level PARAM
39     * functions (class tests, see param.c, enum test_class).
40     *
41     * Maybe move the interning into the lower level, i.e. PARAM ?
42     */
43
44    param_intern (p, "alnum");
45    param_intern (p, "alpha");
46    param_intern (p, "ascii");
47    param_intern (p, "ddigit");
48    param_intern (p, "digit");
49    param_intern (p, "graph");
50    param_intern (p, "lower");
51    param_intern (p, "printable");
52    param_intern (p, "punct");
53    param_intern (p, "space");
54    param_intern (p, "upper");
55    param_intern (p, "wordchar");
56    param_intern (p, "xdigit");
57
58    RETURN ("%p",p);
59}
60
61void
62param_delete (RDE_STATE p)
63{
64    RDE_STRING* next;
65
66    ENTER ("param_delete");
67    TRACE (("RDE_STATE %p",p));
68
69    while (p->numstr) {
70	p->numstr --;
71	ASSERT_BOUNDS(p->numstr,p->maxnum);
72	ckfree (p->string [p->numstr]);
73    }
74
75    Tcl_DeleteHashTable (&p->str);
76
77    /* Process the list of Tcl_Obj* which have references to interned strings.
78     * We have to invalidate & release their intreps, and detach them from
79     * this state.
80     */
81    while (p->sfirst) {
82	next = p->sfirst->next;
83
84	TRACE (("del intern %p having %p '%s'", p, p->sfirst->self, Tcl_GetString(p->sfirst->self)));
85
86	p->sfirst->self->internalRep.twoPtrValue.ptr1 = NULL;
87	p->sfirst->self->internalRep.twoPtrValue.ptr2 = NULL;
88	p->sfirst->self->typePtr = NULL;
89
90	ckfree ((char*) p->sfirst);
91	p->sfirst = next;
92    }
93
94    rde_param_del (p->p);
95    ckfree ((char*) p);
96
97    RETURNVOID;
98}
99
100void
101param_setcmd (RDE_STATE p, Tcl_Command c)
102{
103    ENTER ("param_setcmd");
104    TRACE (("RDE_STATE   %p",p));
105    TRACE (("Tcl_Command %p",c));
106
107    p->c = c;
108
109    RETURNVOID;
110}
111
112int
113param_intern (RDE_STATE p, char* literal)
114{
115    int res, isnew;
116    Tcl_HashEntry* hPtr;
117
118    ENTER ("param_intern");
119    TRACE (("RDE_STATE   %p",p));
120    TRACE (("CHAR*      '%s'",literal));
121
122    hPtr = Tcl_FindHashEntry (&p->str, literal);
123    if (hPtr) {
124	res = (int) Tcl_GetHashValue (hPtr);
125	RETURN("%d",res);
126    }
127
128    hPtr = Tcl_CreateHashEntry(&p->str, literal, &isnew);
129    ASSERT (isnew, "Should have found entry");
130
131    Tcl_SetHashValue (hPtr, p->numstr);
132
133    if (p->numstr >= p->maxnum) {
134	int    new;
135	char** str;
136
137	new  = 2 * (p->maxnum ? p->maxnum : 8);
138	TRACE (("extend to %d strings",new));
139
140	str  = (char**) ckrealloc ((char*) p->string, new * sizeof(char*));
141	ASSERT (str,"Memory allocation failure for string table");
142	p->maxnum = new;
143	p->string = str;
144    }
145
146    res = p->numstr;
147
148    ASSERT_BOUNDS(res,p->maxnum);
149    p->string [res] = dup_string (literal);
150    p->numstr ++;
151
152    TRACE (("UPDATE ENGINE"));
153    rde_param_update_strings (p->p, p->numstr, p->string);
154
155    RETURN("%d",res);
156}
157/* .................................................. */
158
159static char*
160dup_string (const char* str)
161{
162    int   n = strlen(str);
163    char* s = NALLOC(n+1,char);
164
165    memcpy (s, str, n);
166    s[n] = '\0';
167
168    return s;
169}
170
171/* .................................................. */
172
173/*
174 * Local Variables:
175 * mode: c
176 * c-basic-offset: 4
177 * fill-column: 78
178 * End:
179 */
180