1 /*
2 Copyright (C) 2004-2017,2018 John E. Davis
3
4 This file is part of the S-Lang Library.
5
6 The S-Lang Library is free software; you can redistribute it and/or
7 modify it under the terms of the GNU General Public License as
8 published by the Free Software Foundation; either version 2 of the
9 License, or (at your option) any later version.
10
11 The S-Lang Library is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this library; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
19 USA.
20 */
21
22 #include "slinclud.h"
23
24 /* #define SL_APP_WANTS_FOREACH */
25 #include "slang.h"
26 #include "_slang.h"
27
28 #define USE_NEW_ANYTYPE_CODE 1
29
30 #define MAP_HASH_TO_INDEX(hash, table_len) \
31 (unsigned int)((hash)&(table_len-1))
32
33 /* Must be a power of 2 */
34 #define MIN_TABLE_SIZE 512
35
36 static SLFUTURE_CONST char *Deleted_Key = "*deleted*";
37
38 typedef struct _pSLAssoc_Array_Element_Type
39 {
40 SLFUTURE_CONST char *key; /* slstring */
41 SLstr_Hash_Type hash;
42 SLang_Object_Type value;
43 }
44 _pSLAssoc_Array_Element_Type;
45
46 typedef struct _pSLang_Assoc_Array_Type
47 {
48 _pSLAssoc_Array_Element_Type *elements;
49 unsigned int table_len;
50 unsigned int num_occupied; /* includes deletions */
51 unsigned int num_deleted;
52 unsigned int resize_num; /* resize when num_occupied hits this number */
53 SLang_Object_Type default_value;
54 #define HAS_DEFAULT_VALUE 1
55 unsigned int flags;
56 SLtype type;
57 #if SLANG_OPTIMIZE_FOR_SPEED
58 int is_scalar_type;
59 #endif
60 int ref_count;
61 }
62 _pSLang_Assoc_Array_Type;
63
HASH_AGAIN(SLCONST char * str,SLstr_Hash_Type hash,unsigned int table_len)64 static int HASH_AGAIN (SLCONST char *str, SLstr_Hash_Type hash, unsigned int table_len)
65 {
66 int h;
67 (void) table_len; (void) str;
68 h = (int)(hash % 311); /* 311 should be smaller than MIN_TABLE_SIZE */
69 if (0 == (h & 1))
70 h++;
71 return h;
72 }
73
74 static _pSLAssoc_Array_Element_Type *
find_element(SLang_Assoc_Array_Type * a,char * str,SLstr_Hash_Type hash)75 find_element (SLang_Assoc_Array_Type *a, char *str, SLstr_Hash_Type hash)
76 {
77 int i, c;
78 _pSLAssoc_Array_Element_Type *e, *elements;
79 int table_len;
80
81 table_len = a->table_len;
82 i = MAP_HASH_TO_INDEX(hash, table_len);
83 e = a->elements + i;
84 if (e->key == str)
85 return e;
86
87 if (e->key == NULL)
88 return NULL;
89
90 c = HASH_AGAIN(str, hash, table_len);
91 elements = a->elements;
92
93 while (1)
94 {
95 i -= c;
96 if (i < 0)
97 i += table_len;
98
99 e = elements + i;
100 if (e->key == str)
101 return e;
102 if (e->key == NULL)
103 return NULL;
104 }
105 }
106
107 static _pSLAssoc_Array_Element_Type *
find_empty_element(_pSLAssoc_Array_Element_Type * elements,unsigned int table_len,SLCONST char * str,SLstr_Hash_Type hash)108 find_empty_element (_pSLAssoc_Array_Element_Type *elements, unsigned int table_len,
109 SLCONST char *str, SLstr_Hash_Type hash)
110 {
111 int i, c;
112 _pSLAssoc_Array_Element_Type *e;
113
114 i = MAP_HASH_TO_INDEX(hash, table_len);
115 e = elements + i;
116 if ((e->key == NULL) || (e->key == Deleted_Key))
117 return e;
118
119 c = HASH_AGAIN(str, hash, table_len);
120 while (1)
121 {
122 i -= c;
123 if (i < 0)
124 i += table_len;
125
126 e = elements + i;
127 if ((e->key == NULL) || (e->key == Deleted_Key))
128 return e;
129 }
130 }
131
resize_table(SLang_Assoc_Array_Type * a)132 static int resize_table (SLang_Assoc_Array_Type *a)
133 {
134 int num_occupied, new_table_len;
135 _pSLAssoc_Array_Element_Type *old_es;
136 _pSLAssoc_Array_Element_Type *new_es;
137
138 num_occupied = a->num_occupied - a->num_deleted;
139
140 if (num_occupied == 0)
141 num_occupied = (MIN_TABLE_SIZE >> 1);
142
143 new_table_len = a->table_len;
144 if (new_table_len < MIN_TABLE_SIZE)
145 new_table_len = MIN_TABLE_SIZE;
146
147 /* In practice, num_occupied*2 will not overflow because we would be
148 * out of memory if would be num_occupied objects stored.
149 */
150 num_occupied *= 2;
151 while (num_occupied > new_table_len)
152 {
153 new_table_len *= 2;
154 if (new_table_len < 0)
155 {
156 SLang_set_error (SL_Malloc_Error);
157 return -1;
158 }
159 }
160
161 new_es = (_pSLAssoc_Array_Element_Type *)SLcalloc (new_table_len, sizeof (_pSLAssoc_Array_Element_Type));
162 if (new_es == NULL)
163 return -1;
164 if (NULL != (old_es = a->elements))
165 {
166 _pSLAssoc_Array_Element_Type *old_e, *old_emax;
167
168 old_e = old_es;
169 old_emax = old_e + a->table_len;
170 while (old_e < old_emax)
171 {
172 _pSLAssoc_Array_Element_Type *new_e;
173 SLCONST char *key = old_e->key;
174
175 if ((key == NULL) || (key == Deleted_Key))
176 {
177 old_e++;
178 continue;
179 }
180
181 /* Cannot fail */
182 new_e = find_empty_element (new_es, new_table_len, key, old_e->hash);
183 *new_e = *old_e;
184 old_e++;
185 }
186 SLfree ((char *)old_es);
187 }
188 a->elements = new_es;
189 a->table_len = new_table_len;
190 a->num_occupied -= a->num_deleted;
191 a->num_deleted = 0;
192 a->resize_num = 13*(new_table_len>>4);
193
194 return 0;
195 }
196
delete_assoc_array(SLang_Assoc_Array_Type * a)197 static void delete_assoc_array (SLang_Assoc_Array_Type *a)
198 {
199 _pSLAssoc_Array_Element_Type *e;
200 #if SLANG_OPTIMIZE_FOR_SPEED
201 int is_scalar_type;
202 #endif
203
204 if (a == NULL) return;
205
206 #if SLANG_OPTIMIZE_FOR_SPEED
207 is_scalar_type = a->is_scalar_type;
208 #endif
209
210 e = a->elements;
211 if (e != NULL)
212 {
213 _pSLAssoc_Array_Element_Type *emax = e + a->table_len;
214 while (e < emax)
215 {
216 if ((e->key != NULL) && (e->key != Deleted_Key))
217 {
218 _pSLfree_hashed_string ((char *)e->key, strlen (e->key), e->hash);
219 #if SLANG_OPTIMIZE_FOR_SPEED
220 if ((is_scalar_type == 0) && (e->value.o_data_type != SLANG_INT_TYPE))
221 #endif
222 SLang_free_object (&e->value);
223 }
224 e++;
225 }
226 SLfree ((char *) a->elements);
227 }
228 if (a->flags & HAS_DEFAULT_VALUE)
229 SLang_free_object (&a->default_value);
230
231 SLfree ((char *) a);
232 }
233
free_assoc(SLang_Assoc_Array_Type * assoc)234 static void free_assoc (SLang_Assoc_Array_Type *assoc)
235 {
236 if (assoc == NULL)
237 return;
238
239 if (assoc->ref_count > 1)
240 {
241 assoc->ref_count--;
242 return;
243 }
244 delete_assoc_array (assoc);
245 }
246
alloc_assoc_array(SLtype type,int has_default_value)247 static SLang_Assoc_Array_Type *alloc_assoc_array (SLtype type, int has_default_value)
248 {
249 SLang_Assoc_Array_Type *a;
250
251 a = (SLang_Assoc_Array_Type *)SLmalloc (sizeof (SLang_Assoc_Array_Type));
252 if (a == NULL)
253 {
254 if (has_default_value)
255 SLdo_pop_n (1);
256 return NULL;
257 }
258
259 memset ((char *) a, 0, sizeof (SLang_Assoc_Array_Type));
260 a->type = type;
261 #if SLANG_OPTIMIZE_FOR_SPEED
262 a->is_scalar_type = (SLANG_CLASS_TYPE_SCALAR == _pSLang_get_class_type (type));
263 #endif
264
265 if (has_default_value)
266 {
267 if (
268 #if USE_NEW_ANYTYPE_CODE
269 ((type != SLANG_ANY_TYPE) && (-1 == SLclass_typecast (type, 1, 0)))
270 #else
271 (-1 == SLclass_typecast (type, 1, 0))
272 #endif
273 || (-1 == SLang_pop (&a->default_value)))
274 {
275 SLfree ((char *) a);
276 return NULL;
277 }
278
279 a->flags |= HAS_DEFAULT_VALUE;
280 }
281 if (-1 == resize_table (a))
282 {
283 delete_assoc_array (a);
284 return NULL;
285 }
286
287 a->ref_count = 1;
288 return a;
289 }
290
store_object(SLang_Assoc_Array_Type * a,_pSLAssoc_Array_Element_Type * e,SLstr_Type * s,SLstr_Hash_Type hash,SLang_Object_Type * obj)291 static _pSLAssoc_Array_Element_Type *store_object (SLang_Assoc_Array_Type *a, _pSLAssoc_Array_Element_Type *e, SLstr_Type *s, SLstr_Hash_Type hash, SLang_Object_Type *obj)
292 {
293 if ((e != NULL)
294 || (NULL != (e = find_element (a, s, hash))))
295 {
296 #if SLANG_OPTIMIZE_FOR_SPEED
297 if ((a->is_scalar_type == 0) && (e->value.o_data_type != SLANG_INT_TYPE))
298 #endif
299 SLang_free_object (&e->value);
300 }
301 else
302 {
303 if ((a->num_occupied == a->resize_num)
304 && (-1 == resize_table (a)))
305 return NULL;
306
307 if (NULL == (e = find_empty_element (a->elements, a->table_len, s, hash)))
308 return NULL;
309 if (e->key == Deleted_Key)
310 a->num_deleted--;
311 else
312 a->num_occupied++;
313
314 if (NULL == (e->key = _pSLstring_dup_hashed_string (s, hash)))
315 return NULL;
316
317 e->hash = hash;
318 }
319 e->value = *obj;
320 return e;
321 }
322
pop_assoc(SLang_Assoc_Array_Type ** assoc)323 static int pop_assoc (SLang_Assoc_Array_Type **assoc)
324 {
325 if (-1 == SLclass_pop_ptr_obj (SLANG_ASSOC_TYPE, (VOID_STAR *) assoc))
326 {
327 *assoc = NULL;
328 return -1;
329 }
330 return 0;
331 }
332
pop_index(unsigned int num_indices,SLang_Assoc_Array_Type ** ap,SLstr_Type ** strp,SLstr_Hash_Type * hashp)333 static int pop_index (unsigned int num_indices,
334 SLang_Assoc_Array_Type **ap,
335 SLstr_Type **strp, SLstr_Hash_Type *hashp)
336 {
337
338 if (-1 == pop_assoc (ap))
339 {
340 *strp = NULL;
341 return -1;
342 }
343
344 if ((num_indices != 1)
345 || (-1 == SLang_pop_slstring (strp)))
346 {
347 _pSLang_verror (SL_NOT_IMPLEMENTED,
348 "Assoc_Type arrays require a single string index");
349 free_assoc (*ap);
350 *ap = NULL;
351 *strp = NULL;
352 return -1;
353 }
354
355 *hashp = _pSLstring_get_hash (*strp);
356
357 return 0;
358 }
359
push_assoc_element(SLang_Assoc_Array_Type * a,SLstr_Type * str,SLstr_Hash_Type hash)360 static int push_assoc_element (SLang_Assoc_Array_Type *a, SLstr_Type *str, SLstr_Hash_Type hash)
361 {
362 _pSLAssoc_Array_Element_Type *e = find_element (a, str, hash);
363 SLang_Object_Type *obj;
364
365 if (e == NULL)
366 {
367 if (a->flags & HAS_DEFAULT_VALUE)
368 obj = &a->default_value;
369 else
370 {
371 _pSLang_verror (SL_INTRINSIC_ERROR,
372 "No such element in Assoc Array: %s", str);
373 return -1;
374 }
375 }
376 else
377 obj = &e->value;
378
379 #if SLANG_OPTIMIZE_FOR_SPEED
380 if (a->is_scalar_type)
381 return SLang_push (obj);
382 else
383 #endif
384 return _pSLpush_slang_obj (obj);
385 }
386
_pSLassoc_aget(SLtype type,unsigned int num_indices)387 int _pSLassoc_aget (SLtype type, unsigned int num_indices)
388 {
389 SLstr_Hash_Type hash;
390 SLstr_Type *str;
391 SLang_Assoc_Array_Type *a;
392 int ret;
393
394 (void) type;
395
396 if (-1 == pop_index (num_indices, &a, &str, &hash))
397 return -1;
398
399 ret = push_assoc_element (a, str, hash);
400
401 _pSLang_free_slstring (str);
402 free_assoc (a);
403 return ret;
404 }
405
406 _INLINE_
407 static _pSLAssoc_Array_Element_Type *
assoc_aput(SLang_Assoc_Array_Type * a,_pSLAssoc_Array_Element_Type * e,SLstr_Type * str,SLstr_Hash_Type hash)408 assoc_aput (SLang_Assoc_Array_Type *a, _pSLAssoc_Array_Element_Type *e,
409 SLstr_Type *str, SLstr_Hash_Type hash)
410 {
411 SLang_Object_Type obj;
412
413 if (-1 == SLang_pop (&obj))
414 return NULL;
415
416 if ((obj.o_data_type != a->type)
417 #if USE_NEW_ANYTYPE_CODE
418 && (a->type != SLANG_ANY_TYPE)
419 #endif
420 )
421 {
422 (void) SLang_push (&obj);
423 if ((-1 == SLclass_typecast (a->type, 1, 0))
424 || (-1 == SLang_pop (&obj)))
425 return NULL;
426 }
427
428 if (NULL == (e = store_object (a, e, str, hash, &obj)))
429 SLang_free_object (&obj);
430
431 return e;
432 }
433
_pSLassoc_aput(SLtype type,unsigned int num_indices)434 int _pSLassoc_aput (SLtype type, unsigned int num_indices)
435 {
436 SLstr_Type *str;
437 SLang_Assoc_Array_Type *a;
438 int ret;
439 SLstr_Hash_Type hash;
440
441 (void) type;
442
443 if (-1 == pop_index (num_indices, &a, &str, &hash))
444 return -1;
445
446 if (NULL == assoc_aput (a, NULL, str, hash))
447 ret = -1;
448 else
449 ret = 0;
450
451 _pSLang_free_slstring (str);
452 free_assoc (a);
453
454 return ret;
455 }
456
_pSLassoc_inc_value(unsigned int num_indices,int inc)457 int _pSLassoc_inc_value (unsigned int num_indices, int inc)
458 {
459 SLstr_Hash_Type hash;
460 SLstr_Type *str;
461 _pSLAssoc_Array_Element_Type *e;
462 SLang_Assoc_Array_Type *a;
463 SLang_Object_Type *objp;
464 SLang_Object_Type inc_obj;
465 int ret;
466
467 if (-1 == pop_index (num_indices, &a, &str, &hash))
468 return -1;
469
470 e = find_element (a, str, hash);
471
472 ret = -1;
473
474 if (e == NULL)
475 {
476 if (a->flags & HAS_DEFAULT_VALUE)
477 {
478 if (-1 == _pSLpush_slang_obj (&a->default_value))
479 goto free_and_return;
480 }
481 else
482 {
483 _pSLang_verror (SL_INTRINSIC_ERROR,
484 "No such element in Assoc Array: %s", str);
485 goto free_and_return;
486 }
487
488 if (NULL == (e = assoc_aput (a, e, str, hash)))
489 goto free_and_return;
490 }
491
492 objp = &e->value;
493
494 if (objp->o_data_type == SLANG_INT_TYPE)
495 {
496 ret = 0;
497 objp->v.int_val += inc;
498 goto free_and_return;
499 }
500
501 inc_obj.o_data_type = SLANG_INT_TYPE;
502 inc_obj.v.int_val = inc;
503
504 if ((-1 == _pSLang_do_binary_ab (SLANG_PLUS, objp, &inc_obj))
505 || (NULL == assoc_aput (a, e, str, hash)))
506 goto free_and_return;
507
508 ret = 0;
509 /* drop */
510
511 free_and_return:
512
513 _pSLang_free_slstring (str);
514 free_assoc (a);
515 return ret;
516 }
517
assoc_anew(SLtype type,unsigned int num_dims)518 static int assoc_anew (SLtype type, unsigned int num_dims)
519 {
520 SLang_Assoc_Array_Type *a;
521 int has_default_value;
522
523 has_default_value = 0;
524 switch (num_dims)
525 {
526 case 0:
527 type = SLANG_ANY_TYPE;
528 break;
529 case 2:
530 if (-1 == SLreverse_stack (2))
531 return -1;
532 has_default_value = 1;
533 /* drop */
534 case 1:
535 if (0 == SLang_pop_datatype (&type))
536 break;
537 num_dims--;
538 /* drop */
539 default:
540 SLdo_pop_n (num_dims);
541 _pSLang_verror (SL_SYNTAX_ERROR, "Usage: Assoc_Type [DataType_Type]");
542 return -1;
543 }
544
545 a = alloc_assoc_array (type, has_default_value);
546 if (a == NULL)
547 return -1;
548
549 return SLang_push_assoc (a, 1);
550 }
551
assoc_get_keys(SLang_Assoc_Array_Type * a)552 static void assoc_get_keys (SLang_Assoc_Array_Type *a)
553 {
554 SLang_Array_Type *at;
555 SLindex_Type i, num;
556 char **data;
557 _pSLAssoc_Array_Element_Type *e, *emax;
558
559 /* Note: If support for threads is added, then we need to modify this
560 * algorithm to prevent another thread from modifying the array.
561 * However, that should be handled in inner_interp.
562 */
563 num = a->num_occupied - a->num_deleted;
564
565 if (NULL == (at = SLang_create_array (SLANG_STRING_TYPE, 0, NULL, &num, 1)))
566 return;
567
568 data = (char **)at->data;
569
570 e = a->elements;
571 emax = e + a->table_len;
572
573 i = 0;
574 while (e < emax)
575 {
576 if ((e->key != NULL) && (e->key != Deleted_Key))
577 {
578 /* Next cannot fail because it is an slstring */
579 data [i] = _pSLstring_dup_hashed_string (e->key, e->hash);
580 i++;
581 }
582 e++;
583 }
584 (void) SLang_push_array (at, 1);
585 }
586
587 static int
transfer_element(SLang_Class_Type * cl,VOID_STAR dest_data,SLang_Object_Type * obj)588 transfer_element (SLang_Class_Type *cl, VOID_STAR dest_data,
589 SLang_Object_Type *obj)
590 {
591 VOID_STAR src_data;
592
593 #if USE_NEW_ANYTYPE_CODE
594 if (cl->cl_data_type == SLANG_ANY_TYPE)
595 {
596 SLang_Any_Type *any;
597
598 if ((-1 == _pSLpush_slang_obj (obj))
599 || (-1 == SLang_pop_anytype (&any)))
600 return -1;
601
602 *(SLang_Any_Type **)dest_data = any;
603 return 0;
604 }
605 #endif
606 /* Optimize for scalar */
607 if (cl->cl_class_type == SLANG_CLASS_TYPE_SCALAR)
608 {
609 memcpy ((char *) dest_data, (char *)&obj->v, cl->cl_sizeof_type);
610 return 0;
611 }
612
613 src_data = _pSLclass_get_ptr_to_value (cl, obj);
614
615 if (-1 == (*cl->cl_acopy) (cl->cl_data_type, src_data, dest_data))
616 return -1;
617
618 return 0;
619 }
620
assoc_get_values(SLang_Assoc_Array_Type * a)621 static void assoc_get_values (SLang_Assoc_Array_Type *a)
622 {
623 SLang_Array_Type *at;
624 SLindex_Type num;
625 char *dest_data;
626 SLtype type;
627 SLang_Class_Type *cl;
628 unsigned int sizeof_type;
629 _pSLAssoc_Array_Element_Type *e, *emax;
630
631 /* Note: If support for threads is added, then we need to modify this
632 * algorithm to prevent another thread from modifying the array.
633 * However, that should be handled in inner_interp.
634 */
635 num = a->num_occupied - a->num_deleted;
636 type = a->type;
637
638 cl = _pSLclass_get_class (type);
639 sizeof_type = cl->cl_sizeof_type;
640
641 if (NULL == (at = SLang_create_array (type, 0, NULL, &num, 1)))
642 return;
643
644 dest_data = (char *)at->data;
645
646 e = a->elements;
647 emax = e + a->table_len;
648
649 while (e < emax)
650 {
651 if ((e->key != NULL) && (e->key != Deleted_Key))
652 {
653 if (-1 == transfer_element (cl, (VOID_STAR) dest_data, &e->value))
654 {
655 SLang_free_array (at);
656 return;
657 }
658 dest_data += sizeof_type;
659 }
660 e++;
661 }
662 (void) SLang_push_array (at, 1);
663 }
664
assoc_key_exists(SLang_Assoc_Array_Type * a,char * key)665 static int assoc_key_exists (SLang_Assoc_Array_Type *a, char *key)
666 {
667 return (NULL != find_element (a, key, SLcompute_string_hash (key)));
668 }
669
assoc_delete_key(SLang_Assoc_Array_Type * a,char * key)670 static void assoc_delete_key (SLang_Assoc_Array_Type *a, char *key)
671 {
672 _pSLAssoc_Array_Element_Type *e;
673
674 e = find_element (a, key, _pSLstring_get_hash (key));
675 if (e == NULL)
676 return;
677
678 _pSLang_free_slstring ((char *) e->key);
679 SLang_free_object (&e->value);
680 e->key = Deleted_Key;
681 a->num_deleted++;
682 }
683
684 #define A SLANG_ASSOC_TYPE
685 #define S SLANG_STRING_TYPE
686 static SLang_Intrin_Fun_Type Assoc_Table [] =
687 {
688 MAKE_INTRINSIC_1("assoc_get_keys", assoc_get_keys, SLANG_VOID_TYPE, A),
689 MAKE_INTRINSIC_1("assoc_get_values", assoc_get_values, SLANG_VOID_TYPE, A),
690 MAKE_INTRINSIC_2("assoc_key_exists", assoc_key_exists, SLANG_INT_TYPE, A, S),
691 MAKE_INTRINSIC_2("assoc_delete_key", assoc_delete_key, SLANG_VOID_TYPE, A, S),
692
693 SLANG_END_INTRIN_FUN_TABLE
694 };
695 #undef A
696 #undef S
697
assoc_length(SLtype type,VOID_STAR v,SLuindex_Type * len)698 static int assoc_length (SLtype type, VOID_STAR v, SLuindex_Type *len)
699 {
700 SLang_Assoc_Array_Type *a;
701
702 (void) type;
703 a = *(SLang_Assoc_Array_Type **) v;
704 *len = a->num_occupied - a->num_deleted;
705 return 0;
706 }
707
708 struct _pSLang_Foreach_Context_Type
709 {
710 SLang_Assoc_Array_Type *a;
711 unsigned int next_hash_index;
712 #define CTX_WRITE_KEYS 1
713 #define CTX_WRITE_VALUES 2
714 unsigned char flags;
715 #if SLANG_OPTIMIZE_FOR_SPEED
716 int is_scalar;
717 #endif
718 };
719
720 static SLang_Foreach_Context_Type *
cl_foreach_open(SLtype type,unsigned int num)721 cl_foreach_open (SLtype type, unsigned int num)
722 {
723 SLang_Foreach_Context_Type *c;
724 SLang_Assoc_Array_Type *assoc;
725 unsigned char flags;
726
727 (void) type;
728
729 if (-1 == pop_assoc (&assoc))
730 return NULL;
731
732 flags = 0;
733
734 while (num--)
735 {
736 char *s;
737
738 if (-1 == SLang_pop_slstring (&s))
739 {
740 free_assoc (assoc);
741 return NULL;
742 }
743
744 if (0 == strcmp (s, "keys"))
745 flags |= CTX_WRITE_KEYS;
746 else if (0 == strcmp (s, "values"))
747 flags |= CTX_WRITE_VALUES;
748 else
749 {
750 _pSLang_verror (SL_NOT_IMPLEMENTED,
751 "using '%s' not supported by SLassoc_Type",
752 s);
753 _pSLang_free_slstring (s);
754 free_assoc (assoc);
755 return NULL;
756 }
757
758 _pSLang_free_slstring (s);
759 }
760
761 if (NULL == (c = (SLang_Foreach_Context_Type *) SLmalloc (sizeof (SLang_Foreach_Context_Type))))
762 {
763 free_assoc (assoc);
764 return NULL;
765 }
766
767 memset ((char *) c, 0, sizeof (SLang_Foreach_Context_Type));
768
769 c->a = assoc;
770
771 if (flags == 0) flags = CTX_WRITE_VALUES|CTX_WRITE_KEYS;
772
773 c->flags = flags;
774 #if SLANG_OPTIMIZE_FOR_SPEED
775 c->is_scalar = (SLANG_CLASS_TYPE_SCALAR == _pSLang_get_class_type (c->a->type));
776 #endif
777 return c;
778 }
779
cl_foreach_close(SLtype type,SLang_Foreach_Context_Type * c)780 static void cl_foreach_close (SLtype type, SLang_Foreach_Context_Type *c)
781 {
782 (void) type;
783 if (c == NULL) return;
784 free_assoc (c->a);
785 SLfree ((char *) c);
786 }
787
cl_foreach(SLtype type,SLang_Foreach_Context_Type * c)788 static int cl_foreach (SLtype type, SLang_Foreach_Context_Type *c)
789 {
790 SLang_Assoc_Array_Type *a;
791 _pSLAssoc_Array_Element_Type *e, *emax;
792
793 (void) type;
794
795 if (c == NULL)
796 return -1;
797
798 a = c->a;
799
800 e = a->elements + c->next_hash_index;
801 emax = a->elements + a->table_len;
802 while (1)
803 {
804 if (e == emax)
805 return 0;
806
807 if ((e->key != NULL) && (e->key != Deleted_Key))
808 break;
809
810 e++;
811 }
812
813 c->next_hash_index = (e - a->elements) + 1;
814
815 if ((c->flags & CTX_WRITE_KEYS)
816 && (-1 == SLang_push_string (e->key)))
817 return -1;
818
819 if (c->flags & CTX_WRITE_VALUES)
820 {
821 #if SLANG_OPTIMIZE_FOR_SPEED
822 if (c->is_scalar)
823 {
824 if (-1 == SLang_push (&e->value))
825 return -1;
826 }
827 else
828 #endif
829 if (-1 == _pSLpush_slang_obj (&e->value))
830 return -1;
831 }
832
833 /* keep going */
834 return 1;
835 }
836
assoc_destroy(SLtype type,VOID_STAR ptr)837 static void assoc_destroy (SLtype type, VOID_STAR ptr)
838 {
839 (void) type;
840 free_assoc (*(SLang_Assoc_Array_Type **) ptr);
841 }
842
assoc_push(SLtype type,VOID_STAR ptr)843 static int assoc_push (SLtype type, VOID_STAR ptr)
844 {
845 (void) type;
846 return SLang_push_assoc (*(SLang_Assoc_Array_Type **) ptr, 0);
847 }
848
849
SLang_init_slassoc(void)850 int SLang_init_slassoc (void)
851 {
852 SLang_Class_Type *cl;
853
854 if (SLclass_is_class_defined (SLANG_ASSOC_TYPE))
855 return 0;
856
857 if (NULL == (cl = SLclass_allocate_class ("Assoc_Type")))
858 return -1;
859
860 (void) SLclass_set_destroy_function (cl, assoc_destroy);
861 (void) SLclass_set_push_function (cl, assoc_push);
862
863 (void) SLclass_set_aput_function (cl, _pSLassoc_aput);
864 (void) SLclass_set_aget_function (cl, _pSLassoc_aget);
865 (void) SLclass_set_anew_function (cl, assoc_anew);
866 cl->cl_length = assoc_length;
867 cl->cl_foreach_open = cl_foreach_open;
868 cl->cl_foreach_close = cl_foreach_close;
869 cl->cl_foreach = cl_foreach;
870
871 cl->is_container = 1;
872 if (-1 == SLclass_register_class (cl, SLANG_ASSOC_TYPE, sizeof (SLang_Assoc_Array_Type), SLANG_CLASS_TYPE_PTR))
873 return -1;
874
875 if (-1 == SLadd_intrin_fun_table (Assoc_Table, "__SLASSOC__"))
876 return -1;
877
878 return 0;
879 }
880
SLang_create_assoc(SLtype type,int has_default_value)881 SLang_Assoc_Array_Type *SLang_create_assoc (SLtype type, int has_default_value)
882 {
883 if (type == SLANG_VOID_TYPE) type = SLANG_ANY_TYPE;
884 return alloc_assoc_array (type, has_default_value);
885 }
886
SLang_assoc_put(SLang_Assoc_Array_Type * assoc,SLstr_Type * key)887 int SLang_assoc_put (SLang_Assoc_Array_Type *assoc, SLstr_Type *key)
888 {
889 SLstr_Hash_Type hash = _pSLstring_get_hash (key);
890
891 if (NULL == assoc_aput (assoc, NULL, key, hash))
892 return -1;
893
894 return 0;
895 }
896
SLang_assoc_get(SLang_Assoc_Array_Type * assoc,SLstr_Type * key,SLtype * typep)897 int SLang_assoc_get (SLang_Assoc_Array_Type *assoc, SLstr_Type *key, SLtype *typep)
898 {
899 int type;
900 SLstr_Hash_Type hash = _pSLstring_get_hash (key);
901
902 if ((-1 == push_assoc_element (assoc, key, hash))
903 || (-1 == (type = SLang_peek_at_stack ())))
904 return -1;
905
906 if (typep != NULL)
907 *typep = (SLtype) type;
908
909 return 0;
910 }
911
SLang_push_assoc(SLang_Assoc_Array_Type * assoc,int free_flag)912 int SLang_push_assoc (SLang_Assoc_Array_Type *assoc, int free_flag)
913 {
914 if (assoc == NULL)
915 return SLang_push_null ();
916
917 /* SLclass_push_ptr_obj does not do memory management */
918 if (-1 == SLclass_push_ptr_obj (SLANG_ASSOC_TYPE, (VOID_STAR)assoc))
919 {
920 if (free_flag) free_assoc (assoc);
921 return -1;
922 }
923
924 if (free_flag == 0)
925 assoc->ref_count++;
926
927 return 0;
928 }
929
SLang_pop_assoc(SLang_Assoc_Array_Type ** assoc)930 int SLang_pop_assoc (SLang_Assoc_Array_Type **assoc)
931 {
932 return SLclass_pop_ptr_obj (SLANG_ASSOC_TYPE, (VOID_STAR *) assoc);
933 }
934
SLang_free_assoc(SLang_Assoc_Array_Type * assoc)935 void SLang_free_assoc (SLang_Assoc_Array_Type *assoc)
936 {
937 free_assoc (assoc);
938 }
939
SLang_assoc_key_exists(SLang_Assoc_Array_Type * a,SLstr_Type * key)940 int SLang_assoc_key_exists (SLang_Assoc_Array_Type *a, SLstr_Type *key)
941 {
942 return assoc_key_exists(a, key);
943 }
944
945