1 /* -*- mode: C; mode: fold; -*- */
2 /* slnspace.c --- Name Space implementation */
3 /*
4 Copyright (C) 2004-2017,2018 John E. Davis
5
6 This file is part of the S-Lang Library.
7
8 The S-Lang Library is free software; you can redistribute it and/or
9 modify it under the terms of the GNU General Public License as
10 published by the Free Software Foundation; either version 2 of the
11 License, or (at your option) any later version.
12
13 The S-Lang Library is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 General Public License for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with this library; if not, write to the Free Software
20 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
21 USA.
22 */
23
24 #include "slinclud.h"
25
26 #include "slang.h"
27 #include "_slang.h"
28
29 #define MAP_HASH_TO_NS_INDEX(hash,ns) (unsigned int) ((hash) % (ns->table_size))
30
31 static SLang_NameSpace_Type *Namespace_Tables;
32
_pSLns_find_namespace(SLCONST char * name)33 SLang_NameSpace_Type *_pSLns_find_namespace (SLCONST char *name)
34 {
35 SLang_NameSpace_Type *table_list;
36
37 table_list = Namespace_Tables;
38 while (table_list != NULL)
39 {
40 if ((table_list->namespace_name != NULL)
41 && (0 == strcmp (table_list->namespace_name, name)))
42 break;
43 table_list = table_list->next;
44 }
45 return table_list;
46 }
47
48 /* This function deletes the namespace. It is up to the caller to ensure that
49 * the table has already been removed from the list.
50 */
_pSLns_deallocate_namespace(SLang_NameSpace_Type * ns)51 void _pSLns_deallocate_namespace (SLang_NameSpace_Type *ns)
52 {
53 SLang_Name_Type **table;
54 unsigned int table_size;
55 unsigned int i;
56
57 if (ns == NULL)
58 return;
59
60 table = ns->table;
61 table_size = ns->table_size;
62
63 for (i = 0; i < table_size; i++)
64 {
65 SLang_Name_Type *t = table [i];
66 while (t != NULL)
67 {
68 SLang_Name_Type *t1 = t->next;
69 SLang_free_slstring ((char *) t->name);
70 SLfree ((char *) t);
71 t = t1;
72 }
73 }
74 SLang_free_slstring ((char *) ns->name);
75 SLang_free_slstring ((char *) ns->namespace_name);
76 SLang_free_slstring ((char *) ns->private_name);
77 SLfree ((char *)table);
78 SLfree ((char *) ns);
79 }
80
81 /* This function does not insert the namespace into the list */
_pSLns_allocate_namespace(SLFUTURE_CONST char * name,unsigned int size)82 SLang_NameSpace_Type *_pSLns_allocate_namespace (SLFUTURE_CONST char *name, unsigned int size)
83 {
84 SLang_Name_Type **nt;
85 SLang_NameSpace_Type *ns;
86
87 if (NULL == (name = SLang_create_slstring (name)))
88 return NULL;
89
90 if (NULL == (ns = (SLang_NameSpace_Type *)
91 SLcalloc (sizeof (SLang_NameSpace_Type), 1)))
92 {
93 SLang_free_slstring ((char *) name);
94 return NULL;
95 }
96
97 if (NULL == (nt = (SLang_Name_Type **) SLcalloc (sizeof (SLang_Name_Type *), size)))
98 {
99 SLang_free_slstring ((char *) name);
100 SLfree ((char *)ns);
101 return NULL;
102 }
103
104 ns->name = name;
105 ns->table = nt;
106 ns->table_size = size;
107
108 return ns;
109 }
110
111 /* allocate a namespace and add it to the internal list */
_pSLns_new_namespace(SLFUTURE_CONST char * name,unsigned int size)112 SLang_NameSpace_Type *_pSLns_new_namespace (SLFUTURE_CONST char *name, unsigned int size)
113 {
114 SLang_NameSpace_Type *table_list;
115 static int num;
116 char namebuf[64];
117
118 if (name == NULL)
119 {
120 sprintf (namebuf, " *** internal ns <%d> *** ", num);
121 name = namebuf;
122 num++;
123 }
124
125 if (NULL == (table_list = _pSLns_allocate_namespace (name, size)))
126 return NULL;
127
128 table_list->next = Namespace_Tables;
129 Namespace_Tables = table_list;
130
131 return table_list;
132 }
133
134 /* Find the private namespace associated with the object (file, etc) given by
135 * `name', and whose private namespace is given by `namespace_name'. If
136 * `namespace_name' is NULL, then it is anonymous.
137 */
_pSLns_get_private_namespace(SLFUTURE_CONST char * name,SLFUTURE_CONST char * namespace_name)138 SLang_NameSpace_Type *_pSLns_get_private_namespace (SLFUTURE_CONST char *name, SLFUTURE_CONST char *namespace_name)
139 {
140 SLang_NameSpace_Type *ns;
141
142 if ((namespace_name != NULL)
143 && (*namespace_name == 0))
144 namespace_name = NULL;
145
146 ns = Namespace_Tables;
147 while (ns != NULL)
148 {
149 if ((ns->namespace_name != NULL) /* a static namespace */
150 || (0 != strcmp (ns->name, name)))
151 {
152 ns = ns->next;
153 continue;
154 }
155
156 /* at this point, the namespace is anonymous and is associated with
157 * the correct file (given by name).
158 */
159 if (ns->private_name == NULL)
160 {
161 if (namespace_name == NULL)
162 return ns;
163
164 ns = ns->next;
165 continue;
166 }
167
168 if ((namespace_name != NULL)
169 && (0 == strcmp (ns->private_name, namespace_name)))
170 return ns;
171
172 ns = ns->next;
173 }
174
175 if (NULL == (ns = _pSLns_new_namespace (name, SLSTATIC_HASH_TABLE_SIZE)))
176 return ns;
177
178 if (namespace_name == NULL)
179 return ns;
180
181 if (NULL == (namespace_name = SLang_create_slstring (namespace_name)))
182 {
183 SLns_delete_namespace (ns);
184 return NULL;
185 }
186 ns->private_name = namespace_name;
187 return ns;
188 }
189
_pSLns_set_namespace_name(SLang_NameSpace_Type * t,SLFUTURE_CONST char * name)190 int _pSLns_set_namespace_name (SLang_NameSpace_Type *t, SLFUTURE_CONST char *name)
191 {
192 SLang_NameSpace_Type *t1;
193
194 t1 = _pSLns_find_namespace (name);
195 if (t == t1)
196 return 0; /* already has this name */
197
198 if (t1 == NULL)
199 t1 = t;
200
201 if ((t != t1) || (*name == 0))
202 {
203 _pSLang_verror (SL_Namespace_Error, "Namespace \"%s\" already exists",
204 name);
205 return -1;
206 }
207
208 if (t->namespace_name != NULL)
209 {
210 _pSLang_verror (SL_Namespace_Error, "An attempt was made to redefine namespace from \"%s\" to \"%s\"\n",
211 t->namespace_name, name);
212 return -1;
213 }
214
215 if (NULL == (name = SLang_create_slstring (name)))
216 return -1;
217
218 SLang_free_slstring ((char *) t->namespace_name); /* NULL ok */
219 t->namespace_name = name;
220
221 return 0;
222 }
223
_pSLnspace_apropos(SLang_NameSpace_Type * ns,SLFUTURE_CONST char * pat,unsigned int what)224 SLang_Array_Type *_pSLnspace_apropos (SLang_NameSpace_Type *ns, SLFUTURE_CONST char *pat, unsigned int what)
225 {
226 SLang_Array_Type *at;
227 unsigned int table_size;
228 SLang_Name_Type *t, **table;
229 SLindex_Type num_matches;
230 unsigned int i;
231 SLRegexp_Type *reg;
232 unsigned int two;
233
234 at = NULL;
235
236 if ((ns == NULL)
237 || ((table = ns->table) == NULL))
238 return NULL;
239
240 if (NULL == (reg = SLregexp_compile (pat, 0)))
241 {
242 _pSLang_verror (SL_Parse_Error, "Invalid regular expression: %s", pat);
243 return NULL;
244 }
245
246 table_size = ns->table_size;
247
248 two = 2;
249 while (two != 0)
250 {
251 two--;
252
253 num_matches = 0;
254 for (i = 0; i < table_size; i++)
255 {
256 t = table[i];
257 while (t != NULL)
258 {
259 unsigned int flags;
260 SLFUTURE_CONST char *name = t->name;
261
262 switch (t->name_type)
263 {
264 case SLANG_GVARIABLE:
265 flags = 8;
266 break;
267
268 case SLANG_ICONSTANT:
269 case SLANG_DCONSTANT:
270 case SLANG_FCONSTANT:
271 case SLANG_LLCONSTANT:
272 case SLANG_HCONSTANT:
273 case SLANG_LCONSTANT:
274 case SLANG_RVARIABLE:
275 case SLANG_IVARIABLE:
276 flags = 4;
277 break;
278
279 case SLANG_INTRINSIC:
280 case SLANG_MATH_UNARY:
281 case SLANG_APP_UNARY:
282 case SLANG_ARITH_UNARY:
283 case SLANG_ARITH_BINARY:
284 flags = 1;
285 break;
286
287 case SLANG_FUNCTION:
288 flags = 2;
289 break;
290
291 default:
292 flags = 0;
293 break;
294 }
295
296 if ((flags & what)
297 && (NULL != SLregexp_match (reg, name, strlen (name))))
298 {
299 if (at != NULL)
300 {
301 if (-1 == SLang_set_array_element (at, &num_matches, (VOID_STAR)&name))
302 goto return_error;
303 }
304 num_matches++;
305 }
306 t = t->next;
307 }
308 }
309
310 if (at == NULL)
311 {
312 at = SLang_create_array (SLANG_STRING_TYPE, 0, NULL, &num_matches, 1);
313 if (at == NULL)
314 goto return_error;
315 }
316 }
317
318 if (reg != NULL)
319 SLregexp_free (reg);
320 return at;
321
322 return_error:
323 SLregexp_free (reg);
324 SLang_free_array (at);
325 return NULL;
326 }
327
_pSLns_create_namespace2(SLFUTURE_CONST char * name,SLFUTURE_CONST char * namespace_name)328 SLang_NameSpace_Type *_pSLns_create_namespace2 (SLFUTURE_CONST char *name, SLFUTURE_CONST char *namespace_name)
329 {
330 SLang_NameSpace_Type *ns;
331
332 if (namespace_name == NULL)
333 namespace_name = "Global";
334
335 ns = _pSLns_find_namespace (namespace_name);
336 if (ns != NULL)
337 return ns;
338
339 if (NULL == (ns = _pSLns_new_namespace (name, SLSTATIC_HASH_TABLE_SIZE)))
340 return NULL;
341
342 if (-1 == _pSLns_set_namespace_name (ns, namespace_name))
343 {
344 SLns_delete_namespace (ns);
345 return NULL;
346 }
347
348 return ns;
349 }
350
_pSLns_check_name(SLFUTURE_CONST char * namespace_name)351 int _pSLns_check_name (SLFUTURE_CONST char *namespace_name)
352 {
353 if ((namespace_name == NULL) || (*namespace_name == 0))
354 return 0;
355
356 return _pSLcheck_identifier_syntax (namespace_name);
357 }
358
SLns_create_namespace(SLFUTURE_CONST char * namespace_name)359 SLang_NameSpace_Type *SLns_create_namespace (SLFUTURE_CONST char *namespace_name)
360 {
361 if (-1 == _pSLns_check_name (namespace_name))
362 return NULL;
363
364 return _pSLns_create_namespace2 (NULL, namespace_name);
365 }
366
SLns_delete_namespace(SLang_NameSpace_Type * ns)367 void SLns_delete_namespace (SLang_NameSpace_Type *ns)
368 {
369 if (ns == NULL)
370 return;
371
372 if (ns == Namespace_Tables)
373 Namespace_Tables = ns->next;
374 else
375 {
376 SLang_NameSpace_Type *prev = Namespace_Tables;
377 while (prev != NULL)
378 {
379 if (prev->next != ns)
380 {
381 prev = prev->next;
382 continue;
383 }
384 prev->next = ns->next;
385 break;
386 }
387 }
388 _pSLns_deallocate_namespace (ns);
389 }
390
_pSLns_list_namespaces(void)391 SLang_Array_Type *_pSLns_list_namespaces (void)
392 {
393 SLang_NameSpace_Type *table_list;
394 SLang_Array_Type *at;
395 SLindex_Type num, i;
396
397 num = 0;
398 table_list = Namespace_Tables;
399 while (table_list != NULL)
400 {
401 if (table_list->namespace_name != NULL)
402 num++;
403 table_list = table_list->next;
404 }
405 at = SLang_create_array (SLANG_STRING_TYPE, 0, NULL, &num, 1);
406 if (at == NULL)
407 return NULL;
408
409 table_list = Namespace_Tables;
410 i = 0;
411 while ((table_list != NULL)
412 && (i < num))
413 {
414 if (table_list->namespace_name != NULL)
415 {
416 SLCONST char *name = table_list->namespace_name;
417 if (-1 == SLang_set_array_element (at, &i, (VOID_STAR)&name))
418 {
419 SLang_free_array (at);
420 return NULL;
421 }
422 i++;
423 }
424 table_list = table_list->next;
425 }
426 return at;
427 }
428
429 SLang_Name_Type *
_pSLns_locate_hashed_name(SLang_NameSpace_Type * ns,SLCONST char * name,unsigned long hash)430 _pSLns_locate_hashed_name (SLang_NameSpace_Type *ns, SLCONST char *name, unsigned long hash)
431 {
432 SLang_Name_Type *t;
433 char ch;
434
435 t = ns->table [MAP_HASH_TO_NS_INDEX(hash,ns)];
436 ch = *name++;
437
438 while (t != NULL)
439 {
440 if ((ch == t->name[0])
441 && (0 == strcmp (t->name + 1, name)))
442 break;
443
444 t = t->next;
445 }
446
447 return t;
448 }
449
450 /* It is up to the caller to make sure that the name is not already in the table */
_pSLns_add_hashed_name(SLang_NameSpace_Type * ns,SLang_Name_Type * nt,unsigned long hash)451 int _pSLns_add_hashed_name (SLang_NameSpace_Type *ns, SLang_Name_Type *nt, unsigned long hash)
452 {
453 hash = MAP_HASH_TO_NS_INDEX(hash,ns);
454 nt->next = ns->table [(unsigned int)hash];
455 ns->table [(unsigned int) hash] = nt;
456
457 return 0;
458 }
459
_pSLns_find_object_namespace(SLang_Name_Type * nt)460 SLang_NameSpace_Type *_pSLns_find_object_namespace (SLang_Name_Type *nt)
461 {
462 SLang_NameSpace_Type *ns;
463 SLCONST char *name;
464 unsigned long hash;
465
466 if (nt == NULL)
467 return NULL;
468
469 name = nt->name;
470 hash = SLcompute_string_hash (name);
471
472 ns = Namespace_Tables;
473 while (ns != NULL)
474 {
475 SLang_Name_Type *t = ns->table [MAP_HASH_TO_NS_INDEX(hash,ns)];
476 while (t != NULL)
477 {
478 if (t == nt)
479 return ns;
480
481 t = t->next;
482 }
483 ns = ns->next;
484 }
485
486 return NULL;
487 }
488
_pSLns_locate_name(SLang_NameSpace_Type * ns,SLCONST char * name)489 SLang_Name_Type *_pSLns_locate_name (SLang_NameSpace_Type *ns, SLCONST char *name)
490 {
491 return _pSLns_locate_hashed_name (ns, name, SLcompute_string_hash (name));
492 }
493
delete_namespace_objects(SLang_NameSpace_Type * ns)494 static void delete_namespace_objects (SLang_NameSpace_Type *ns)
495 {
496 SLang_Name_Type **table = ns->table;
497 unsigned int i, table_size = ns->table_size;
498
499 for (i = 0; i < table_size; i++)
500 {
501 SLang_Name_Type *t = table[i];
502 while (t != NULL)
503 {
504 SLang_Name_Type *t1 = t->next;
505 switch (t->name_type)
506 {
507 case SLANG_PVARIABLE:
508 case SLANG_GVARIABLE:
509 SLang_free_object (&((SLang_Global_Var_Type *)t)->obj);
510 break;
511
512 case SLANG_PFUNCTION:
513 case SLANG_FUNCTION:
514 SLang_free_function (t);
515 break;
516
517 case SLANG_ICONSTANT:
518 case SLANG_DCONSTANT:
519 case SLANG_FCONSTANT:
520 case SLANG_LLCONSTANT:
521 case SLANG_HCONSTANT:
522 case SLANG_LCONSTANT:
523 case SLANG_RVARIABLE:
524 case SLANG_IVARIABLE:
525 case SLANG_INTRINSIC:
526 case SLANG_MATH_UNARY:
527 case SLANG_APP_UNARY:
528 case SLANG_ARITH_UNARY:
529 case SLANG_ARITH_BINARY:
530 default:
531 break;
532 }
533 SLang_free_slstring (t->name);
534 t = t1;
535 }
536 }
537 }
538
539 /* This is only called at exit. Until version 3, I cannot delete everything
540 * since the namespace contains a mixture of statically allocated table
541 * and dynamically allocated ones. The only way to tell the difference is
542 * to change the API by adding an additional field to SLang_Name_Type object.
543 * So, here I delete what I can safely do, but to avoid leak checkers complaining
544 * about false leaks, the Namespace_Tables pointer will be left as is.
545 */
_pSLns_delete_namespaces(void)546 void _pSLns_delete_namespaces (void)
547 {
548 SLang_NameSpace_Type *ns;
549
550 ns = Namespace_Tables;
551 while (ns != NULL)
552 {
553 SLang_NameSpace_Type *next = ns->next;
554 delete_namespace_objects (ns);
555 SLang_free_slstring ((char *) ns->name);
556 SLang_free_slstring ((char *) ns->namespace_name);
557 SLang_free_slstring ((char *) ns->private_name);
558 /* SLfree ((char *)ns->table); v3*/
559 /* SLfree ((char *) ns); v3 */
560 ns = next;
561 }
562 /* Namespace_Tables = NULL; v3 */
563 }
564
565