1 /*---------------------------------------------------------------------------
2 * Mapping handling functions.
3 *
4 *---------------------------------------------------------------------------
5 * TODO: Rewrite the low-level functions (like allocate_mapping()) to return
6 * TODO:: failure codes (errno like) instead of throwing errors. In addition,
7 * TODO:: provide wrapper functions which do throw errorf()s, so that every
8 * TODO:: caller can handle the errors himself (like the swapper).
9 *
10 * TODO: A better mapping implementation would utilise the to-be-written
11 * TODO:: small block pools. The mapping entries would be unified to
12 * TODO:: (hash header:key:values) tuples and stored in a pool.
13 * TODO:: The 'compacted' part of the mapping would obviously go away,
14 * TODO:: and all indexing would be done through hash table.
15 * TODO:: The pool is not absolutely required, but would reduce overhead if
16 * TODO:: MALLOC_TRACE is in effect.
17 *
18 * TODO: Check if the use of mp_int is reasonable for values for num_values
19 * TODO::and num_entries (which are in the struct p_int). And check as
20 * TODO::the wild mixture of mp_int, p_int, size_t (and maybe still int?)
21 * TODO::used for iterating over mapping structures.
22 *
23 * Mappings, or 'associative arrays', are similar to normal arrays, with
24 * the principal difference that they can use every value to index their
25 * stored data, whereas arrays only index with integer values. On the
26 * other hand this means that in mappings the data is not stored in any
27 * particular order, whereas arrays imply an order through their indexing.
28 *
29 * LPMud mappings in extension allow to store several values for each
30 * index value. This behaviour is functionally equivalent to a 'normal'
31 * mapping holding arrays as data, but its direct implementation allows
32 * certain optimisations.
33 *
34 * NB: Where strings are used as index value, they are made shared strings.
35 *
36 *
37 * A mapping consists of several structures (defined in mapping.h):
38 *
39 * - the mapping_t is the base of all mappings.
40 * - mapping_cond_t holds the condensed entries
41 * - mapping_hash_t holds the hashed entries added since the
42 * creation of the mapping_cond_t block.
43 *
44 * Using this approach, mappings manage to combine a low memory overhead
45 * with fast operation. Both the hashed and the condensed part may
46 * be absent.
47 *
48 * The key values are sorted according to svalue_cmp(), that is in principle
49 * by (.type, .u.number >> 1, .x.generic), with the exception of closures and
50 * strings which have their own sorting order within their .type.
51 *
52 * Since the x.generic information is also used to generate the hash value for
53 * hashing, for values which don't have a secondary information, x.generic is
54 * set to .u.number << 1.
55 *
56 * The mapping_cond_t block holds mapping entries in sorted order.
57 * Deleted entries are signified by a T_INVALID key value and can appear
58 * out of order. The data values for a deleted entry are set to svalue-0.
59 *
60 * The mapping_hash_t block is used to record all the new additions to
61 * the mapping since the last compaction. The new entries' data is kept
62 * directly in the hash entries. The hash table grows with the
63 * number of hashed entries, so that the average chain length is
64 * no more than 2. For easier computations,the number of buckets
65 * is always a power of 2.
66 *
67 * All mappings with a mapping_hash_t structure are considered 'dirty'
68 * (and vice versa, only 'dirty' mappings have a mapping_hash_t).
69 * During the regular object cleanup, the backend will find and 'clean'
70 * the dirty mappings by sorting the hashed entries into the condensed part,
71 * removing the hashed part by this.
72 *
73 * To be compacted, a mapping has to conform to a number of conditions:
74 * - it has been at least TIME_TO_COMPACT seconds (typical 10 minutes)
75 * since the last addition or deletion of an entry
76 * and
77 * - it was to be at least 2*TIME_TO_COMPACT seconds (typical 20 minutes)
78 * since the last addition or deletion of an entry
79 * or - the number of condensed-deleted entries is at least half the capacity
80 * of the condensed part
81 * or - the number of hashed entries exceeds the number non-deleted condensed
82 * entries.
83 *
84 * The idea is to minimize reallocations of the (potentially large) condensed
85 * block, as it easily runs into fragmentation of the large block heap.
86 *
87 * A garbage collection however compacts all mappings unconditionally.
88 *
89 *
90 * Mappings maintain two refcounts: the main refcount for all references,
91 * and in the hash structure a protector refcount for references as
92 * PROTECTED_MAPPING. The latter references are used for 'dirty' mappings
93 * (ie. mappings with a hash part) which are passed fully or in part as a
94 * reference to a function. As long as the protector refcount is not 0, all
95 * entry deletions are not executed immediately. Instead, the 'deleted'
96 * entries are kept in a separate list until all protective references
97 * are removed. PROTECTED_MAPPINGs don't need to protect the condensed
98 * part of a mapping as that changes only during compact_mapping()s
99 * in the backend.
100 *
101 *
102 * -- mapping_t --
103 *
104 * mapping_t {
105 * p_int ref;
106 * wiz_list_t * user;
107 * int num_values;
108 * p_int num_entries;
109 *
110 * mapping_cond_t * cond;
111 * mapping_hash_t * hash;
112 *
113 * mapping_t * next;
114 * }
115 *
116 * .ref is the number of references, as usual.
117 *
118 * .user is, as usual, the wizlist entry of the owner object.
119 *
120 * .num_values and .num_entries give the width (excluding the key!)
121 * and number of valid entries in the mapping.
122 *
123 * .cond and .hash are the condensed resp. hashed data blocks.
124 * .hash also serves as indicator if the mapping is 'dirty',
125 * and therefore contains all the information about the dirtyness.
126 *
127 * The .next pointer is not used by the mapping module itself,
128 * but is provided as courtesy for the cleanup code and the GC, to
129 * avoid additional memory allocations during a low memory situation.
130 * The cleanup code uses it to keep its list of dirty mappings; the
131 * GC uses it to keep its list of stale mappings (ie. mappings with
132 * keys referencing destructed objects).
133 *
134 * -- mapping_cond_t --
135 *
136 * mapping_cond_t {
137 * size_t size;
138 * svalue_t *data[(mapping->num_values+1) * .size];
139 * }
140 *
141 * This structure holds the .size compacted entries for a mapping (.size
142 * includes the deleted entries as well, if any).
143 *
144 * The first .size svalues in .data[] are the keys. Follwing are the
145 * actual data values, the values for one entry each in one row.
146 *
147 * If a key is .data[ix], its data values are in
148 * .data[.size + ix * mapping->num_values] through
149 * .data[.size + (ix+1) * mapping->num_values - 1].
150 *
151 * If an entry is deleted, the key's .type is set to T_INVALID and
152 * the data values are zeroed out (and mapping->hash->cond_deleted is
153 * incremented), but the entry is otherwise left in place.
154 *
155 * -- mapping_hash_t --
156 *
157 * hash_mapping_t {
158 * p_int mask;
159 * p_int used;
160 * p_int cond_deleted;
161 * p_int ref;
162 * mp_int last_used;
163 * map_chain_t *deleted;
164 * map_chain_t *chains[ 1 +.mask ];
165 * }
166 *
167 * This structure keeps track of the changes to a mapping. Every mapping
168 * with a hash part is considered 'dirty'.
169 *
170 * New entries to the mapping are kept in the hashtable made up by
171 * .chains[]. There are .mask+1 different chains, with .mask+1 always
172 * being a power of two. This way, .mask can be used in a binary-&
173 * operation to convert a hash value into a chain index. The number
174 * of entries in the hashtable is listed in .used.
175 *
176 * The driver imposes an upper limit onto the average length of the
177 * chains: if the average length exceeds two elements, the size of
178 * the hashtable is doubled (by reallocating the hash_mapping structure).
179 * This is the reason why you can allocate a mapping with a given 'size':
180 * it reduces the number of reallocations in the long run.
181 *
182 * .condensed_deleted gives the number of deleted entries in
183 * the mappings condensed_part.
184 *
185 * .ref and .deleted come into use when the mapping is used as
186 * protector mapping. Protector mappings are necessary whenever
187 * single values of the mapping are used as lvalues, in order to
188 * protect them against premature deletion ( map[0] = ({ map=0 })
189 * being the classic case). .ref counts the number of such
190 * protective references, and is always <= mapping.ref. .deleted
191 * is the list of entries deleted from the mapping while the
192 * protection is in effect. If the .ref falls back to 0, all
193 * the pending deletions of the .deleted entries are performed.
194 *
195 * .last_used holds the time (seconds since the epoch) of the last addition
196 * or removal of an entry. It is used by the compaction algorithm to
197 * determine whether the mapping should be compacted or not.
198 *
199 * -- map_chain_t --
200 *
201 * This structure is used to keep single entries in the hash chains
202 * of hash_mapping, and occasionally, in the .deleted list of
203 * protector mappings.
204 *
205 * map_chain_t {
206 * map_chain_t *next;
207 * svalue_t data[ mapping->num_values+1 ];
208 * }
209 *
210 * .next is the next struct map_chain in the hash chain (or .deleted list).
211 * .data holds the key and it's data values.
212 *
213 *---------------------------------------------------------------------------
214 */
215
216 #include "driver.h"
217 #include "typedefs.h"
218
219 #include "my-alloca.h"
220 #include <stdio.h>
221
222 #include "mapping.h"
223
224 #include "array.h"
225 #include "backend.h"
226 #include "closure.h"
227 #include "gcollect.h"
228 #include "interpret.h"
229 #include "main.h"
230 #include "mstrings.h"
231 #include "object.h"
232 #include "simulate.h"
233 #ifdef USE_STRUCTS
234 #include "structs.h"
235 #endif /* USE_STRUCTS */
236 #include "svalue.h"
237 #include "wiz_list.h"
238 #include "xalloc.h"
239
240 #include "i-svalue_cmp.h"
241
242 #define TIME_TO_COMPACT (600) /* 10 Minutes */
243 /* TODO: Make this configurable.
244 * TODO:: When doing so, also implement the shrinking of the hashtable
245 */
246
247 /*-------------------------------------------------------------------------*/
248 /* Types */
249
250 /* The local typedefs */
251 typedef struct map_chain_s map_chain_t;
252
253
254 /* --- struct map_chain_s: one entry in a hash chain ---
255 *
256 * The hashed mapping entries.
257 */
258
259 struct map_chain_s {
260 map_chain_t * next; /* next entry */
261 svalue_t data[1 /* +mapping->num_values */];
262 /* [0]: the key, [1..]: the data */
263 };
264
265 #define SIZEOF_MCH(mch, nv) ( \
266 sizeof(*mch) + (nv) * sizeof(svalue_t) \
267 )
268 /* Allocation size of a map_chain_t for <nv> values per key.
269 */
270
271
272 /*-------------------------------------------------------------------------*/
273
274 mp_int num_mappings = 0;
275 /* Number of allocated mappings.
276 */
277
278 mp_int num_hash_mappings = 0;
279 /* Number of allocated mappings with only a hash part.
280 */
281
282 mp_int num_dirty_mappings = 0;
283 /* Number of allocated mappings with a hash and a condensed part.
284 */
285
286 mapping_t *stale_mappings;
287 /* During a garbage collection, this is a list of mappings with
288 * keys referencing destructed objects/lambdas, linked through
289 * the .next pointers. Since th GC performs a global cleanup first,
290 * this list is normally empty, but having it increases the robustness
291 * of the GC.
292 */
293
294 /*-------------------------------------------------------------------------*/
295 /* Forward declarations */
296
297 #if 0
298
299 /* TODO: Remove these defines when the statistics prove to be correct */
300
301 #define LOG_ALLOC(where,add,alloc) \
302 printf("DEBUG: %s: m %p user %p total %ld + %ld (alloc %ld) = %ld\n", where, m, m->user, m->user->mapping_total, add, alloc, m->user->mapping_total + (add))
303
304 #define LOG_ADD(where,add) \
305 printf("DEBUG: %s: m %p user %p total %ld + %ld = %ld\n", where, m, m->user, m->user->mapping_total, add, m->user->mapping_total + (add))
306
307 #define LOG_SUB(where,sub) \
308 printf("DEBUG: %s: m %p user %p total %ld - %ld = %ld\n", where, m, m->user, m->user->mapping_total, sub, m->user->mapping_total - (sub))
309
310 #define LOG_SUB_M(where,m,sub) \
311 printf("DEBUG: %s: m %p user %p total %ld - %ld = %ld\n", where, (m), (m)->user, (m)->user->mapping_total, sub, (m)->user->mapping_total - (sub))
312
313 #else
314
315 #define LOG_ALLOC(where,add,alloc)
316 #define LOG_ADD(where,add)
317 #define LOG_SUB(where,add)
318 #define LOG_SUB_M(where,m,add)
319
320 #endif
321
322 /*-------------------------------------------------------------------------*/
323 static INLINE map_chain_t *
new_map_chain(mapping_t * m)324 new_map_chain (mapping_t * m)
325
326 /* Return a fresh map_chain_t for mapping <m>.
327 * The .data[] values are not initialised.
328 *
329 * Return NULL if out of memory.
330 */
331
332 {
333 map_chain_t *rc;
334
335 rc = xalloc(SIZEOF_MCH(rc, m->num_values));
336 if (rc)
337 {
338 LOG_ALLOC("new_map_chain", SIZEOF_MCH(rc, m->num_values), SIZEOF_MCH(rc, m->num_values));
339 m->user->mapping_total += SIZEOF_MCH(rc, m->num_values);
340 }
341
342 return rc;
343 } /* new_map_chain() */
344
345 /*-------------------------------------------------------------------------*/
346 static INLINE void
free_map_chain(mapping_t * m,map_chain_t * mch,Bool no_data)347 free_map_chain (mapping_t * m, map_chain_t *mch, Bool no_data)
348
349 /* Free the map_chain <mch> of mapping <m>.
350 * If <no_data> is TRUE, the svalues themselves are supposed to be empty.
351 */
352
353 {
354 p_int ix;
355
356 if (!no_data)
357 {
358 for (ix = m->num_values; ix >= 0; ix--)
359 {
360 free_svalue(mch->data+ix);
361 }
362 }
363
364 LOG_SUB("free_map_chain", SIZEOF_MCH(mch, m->num_values));
365 m->user->mapping_total -= SIZEOF_MCH(mch, m->num_values);
366 xfree(mch);
367 } /* free_map_chain() */
368
369 /*-------------------------------------------------------------------------*/
370 static INLINE mapping_hash_t *
get_new_hash(mapping_t * m,mp_int hash_size)371 get_new_hash ( mapping_t *m, mp_int hash_size)
372
373 /* Allocate a new hash structure for mapping <m>, prepared to take
374 * <hash_size> entries. The hash structure is NOT linked into <m>.
375 *
376 * Return the new structure, or NULL when out of memory.
377 */
378 /* TODO: hash_size of mp_int seems unnecessarily large to me, because
379 * TODO::mappings can only have p_int values? */
380 {
381 mapping_hash_t *hm;
382 map_chain_t **mcp;
383
384 /* Compute the number of hash buckets to 2**k, where
385 * k is such that 2**(k+1) > size >= 2**k.
386 *
387 * To do this, compute 'size' to (2**k)-1 by first setting
388 * all bits after the leading '1' and then shifting the
389 * number right once. The result is then also the mask
390 * required for indexing.
391 */
392 hash_size |= hash_size >> 1;
393 hash_size |= hash_size >> 2;
394 hash_size |= hash_size >> 4;
395 if (hash_size & ~0xff)
396 {
397 hash_size |= hash_size >> 8;
398 hash_size |= hash_size >> 16;
399 }
400 hash_size >>= 1;
401
402 /* Allocate the hash_mapping big enough to hold (size+1) hash
403 * buckets.
404 * size must not exceed the accessible indexing range. This is
405 * a possibility because size as a mp_int may have a different
406 * range than array indices which are size_t.
407 * TODO: The 0x100000 seems to be a safety offset, but is it?
408 */
409 if (hash_size > (mp_int)((MAXINT - sizeof *hm - 0x100000) / sizeof *mcp)
410 || !(hm = xalloc(sizeof *hm + sizeof *mcp * hash_size) ) )
411 {
412 return NULL;
413 }
414
415 hm->mask = hash_size;
416 hm->used = hm->cond_deleted = hm->ref = 0;
417 hm->last_used = current_time;
418
419 /* These members don't really need a default initialisation
420 * but it's here to catch bogies.
421 */
422 hm->deleted = NULL;
423
424 /* Initialise the hashbuckets (there is at least one) */
425 mcp = hm->chains;
426 do *mcp++ = NULL; while (--hash_size >= 0);
427
428 LOG_ALLOC("get_new_hash", SIZEOF_MH(hm), sizeof *hm + sizeof *mcp * hm->mask);
429 m->user->mapping_total += SIZEOF_MH(hm);
430
431 return hm;
432 } /* get_new_hash() */
433
434 /*-------------------------------------------------------------------------*/
435 static mapping_t *
get_new_mapping(wiz_list_t * user,mp_int num_values,mp_int hash_size,mp_int cond_size)436 get_new_mapping ( wiz_list_t * user, mp_int num_values
437 , mp_int hash_size, mp_int cond_size)
438
439 /* Allocate a basic mapping with <num_values> values per key, and set it
440 * up to have an initial datablock of <data_size> entries, a hash
441 * suitable for <hash_size> entries, and a condensed block for <cond_size>
442 * entries.
443 *
444 * The .user is of the mapping is set to <user>.
445 *
446 * Return the new mapping, or NULL when out of memory.
447 */
448 /* TODO: hash_size of mp_int seems unnecessarily large to me, because
449 * TODO::mappings can only have p_int values? */
450 {
451 mapping_cond_t *cm;
452 mapping_hash_t *hm;
453 mapping_t *m;
454 /* DEBUG: */ size_t cm_size;
455
456 /* Check if the new size is too big */
457 if (num_values > 0)
458 {
459 if (num_values > SSIZE_MAX /* TODO: SIZET_MAX, see port.h */
460 || ( num_values != 0
461 && (SSIZE_MAX - sizeof(map_chain_t)) / num_values < sizeof(svalue_t))
462 )
463 return NULL;
464 }
465
466 /* Allocate the structures */
467 m = xalloc(sizeof *m);
468 if (!m)
469 return NULL;
470
471 m->user = user; /* Already needed for statistics */
472
473 /* Set up the key block for <cond_size> entries */
474
475 cm = NULL;
476 if (cond_size > 0)
477 {
478
479 /* !DEBUG: size_t */ cm_size = (size_t)cond_size;
480 cm = xalloc(sizeof(*cm) + sizeof(svalue_t) * cm_size * (num_values+1) - 1);
481 if (!cm)
482 {
483 xfree(m);
484 return NULL;
485 }
486
487 cm->size = cm_size;
488 }
489
490 /* Set up the hash block for <hash_size> entries.
491 * Do this last because get_new_hash() modifies the statistics.
492 */
493
494 hm = NULL;
495 if (hash_size > 0)
496 {
497 hm = get_new_hash(m, hash_size);
498 if (!hm)
499 {
500 if (cm) xfree(cm);
501 xfree(m);
502 return NULL;
503 }
504 }
505
506 /* Initialise the mapping */
507
508 m->cond = cm;
509 m->hash = hm;
510 m->next = NULL;
511 m->num_values = num_values;
512 m->num_entries = 0;
513 m->ref = 1;
514
515 /* Statistics */
516 LOG_ADD("get_new_mapping - base", sizeof *m);
517 m->user->mapping_total += sizeof *m;
518 if (cm)
519 {
520 LOG_ALLOC("get_new_mapping - cond", SIZEOF_MC(cm, num_values), sizeof(*cm) + sizeof(svalue_t) * cm_size * (num_values+1) - 1);
521 m->user->mapping_total += SIZEOF_MC(cm, num_values);
522 }
523 /* hm has already been counted */
524
525 num_mappings++;
526 if (m->cond && m->hash)
527 num_dirty_mappings++;
528 else if (m->hash)
529 num_hash_mappings++;
530 check_total_mapping_size();
531
532 return m;
533
534 } /* get_new_mapping() */
535
536 /*-------------------------------------------------------------------------*/
537 mapping_t *
allocate_mapping(mp_int size,mp_int num_values)538 allocate_mapping (mp_int size, mp_int num_values)
539
540 /* Allocate a mapping with <num_values> values per key, and setup the
541 * hash part for (initially) <size> entries. The condensed part will
542 * not be allocated.
543 *
544 * Return the new mapping, or NULL when out of memory.
545 */
546
547 {
548 return get_new_mapping(current_object->user, num_values, size, 0);
549 } /* allocate_mapping() */
550
551 /*-------------------------------------------------------------------------*/
552 mapping_t *
allocate_cond_mapping(wiz_list_t * user,mp_int size,mp_int num_values)553 allocate_cond_mapping (wiz_list_t * user, mp_int size, mp_int num_values)
554
555 /* Allocate for <user> a mapping with <num_values> values per key, and
556 * setup the condensed part for <size> entries. The hash part will not be
557 * allocated.
558 *
559 * The swapper uses this function.
560 *
561 * Return the new mapping, or NULL when out of memory.
562 */
563
564 {
565 return get_new_mapping(user, num_values, 0, size);
566 } /* allocate_cond_mapping() */
567
568 /*-------------------------------------------------------------------------*/
569 Bool
_free_mapping(mapping_t * m,Bool no_data)570 _free_mapping (mapping_t *m, Bool no_data)
571
572 /* Aliases: free_mapping(m) -> _free_mapping(m, FALSE)
573 * free_empty_mapping(m) -> _free_mapping(m, TRUE)
574 *
575 * The mapping and all associated memory is deallocated resp. dereferenced.
576 * Always return TRUE (for use within the free_mapping() macro).
577 *
578 * If <no_data> is TRUE, all the svalues are assumed to be freed already
579 * (the swapper uses this after swapping out a mapping). The function still
580 * will deallocate any map_chain entries, if existing.
581 *
582 * If the mapping is 'dirty' (ie. contains a hash_mapping part), it
583 * is not deallocated immediately, but instead counts 1 to the empty_mapping-
584 * _load (with regard to the threshold).
585 */
586
587 {
588 mapping_hash_t *hm; /* Hashed part of <m> */
589
590 #ifdef DEBUG
591 if (!m)
592 fatal("NULL pointer passed to free_mapping().\n");
593
594 if (!m->user)
595 fatal("No wizlist pointer for mapping");
596
597 if (!no_data && m->ref > 0)
598 fatal("Mapping with %"PRIdPINT" refs passed to _free_mapping().\n",
599 m->ref);
600 #endif
601
602 num_mappings--;
603 if (m->cond && m->hash)
604 num_dirty_mappings--;
605 else if (m->hash)
606 num_hash_mappings--;
607
608 m->ref = 0;
609 /* In case of free_empty_mapping(), this is neither guaranteed nor a
610 * precondition, but in case this mapping needs to be entered into the
611 * dirty list the refcount needs to be correct.
612 */
613
614 /* Free the condensed data */
615 if (m->cond != NULL)
616 {
617 p_int left = m->cond->size * (m->num_values + 1);
618 svalue_t *data = &(m->cond->data[0]);
619
620 for (; !no_data && left > 0; left--, data++)
621 free_svalue(data);
622
623 LOG_SUB("free_mapping cond", SIZEOF_MC(m->cond, m->num_values));
624 m->user->mapping_total -= SIZEOF_MC(m->cond, m->num_values);
625 check_total_mapping_size();
626 xfree(m->cond);
627 m->cond = NULL;
628
629 }
630
631 /* Free the hashed data */
632 if ( NULL != (hm = m->hash) )
633 {
634 map_chain_t **mcp, *mc, *next;
635 p_int i;
636
637 #ifdef DEBUG
638 if (hm->ref)
639 fatal("Ref count in freed hash mapping: %"PRIdPINT"\n", hm->ref);
640 #endif
641 LOG_SUB("free_mapping hash", SIZEOF_MH(hm));
642 m->user->mapping_total -= SIZEOF_MH(hm);
643 check_total_mapping_size();
644
645 mcp = hm->chains;
646
647 /* Loop through all chains */
648
649 i = hm->mask + 1;
650 do {
651
652 /* Free this chain */
653
654 for (next = *mcp++; NULL != (mc = next); )
655 {
656 next = mc->next;
657 free_map_chain(m, mc, no_data);
658 }
659 } while (--i);
660
661 xfree(hm);
662 }
663
664 /* Free the base structure.
665 */
666
667 LOG_SUB("free_mapping base", sizeof(*m));
668 m->user->mapping_total -= sizeof(*m);
669 check_total_mapping_size();
670 xfree(m);
671
672 return MY_TRUE;
673 } /* _free_mapping() */
674
675 /*-------------------------------------------------------------------------*/
676 void
free_protector_mapping(mapping_t * m)677 free_protector_mapping (mapping_t *m)
678
679 /* Free the mapping <m> which is part of a T_PROTECTOR_MAPPING svalue.
680 * Such svalues are created only for mappings with a hashed part, and
681 * have the ref of the hashed part incremented at creation.
682 *
683 * This function is a wrapper around free_mapping() and takes care
684 * to free m->hash->deleted if m->hash->ref reaches zero due to this
685 * call.
686 */
687
688 {
689 mapping_hash_t *hm;
690
691 #ifdef DEBUG
692 /* This type of mapping must have a hash part */
693
694 if (!m->hash || m->hash->ref <= 0)
695 {
696 /* This shouldn't happen */
697 printf("%s free_protector_mapping() : no hash %s\n"
698 , time_stamp(), m->hash ? "reference" : "part");
699 #ifdef TRACE_CODE
700 {
701 last_instructions(TOTAL_TRACE_LENGTH, MY_TRUE, NULL);
702 }
703 #endif
704 dump_trace(MY_FALSE, NULL);
705 /* printf("%s free_protector_mapping() : no hash %s\n"
706 , time_stamp(), m->hash ? "reference" : "part");
707 */
708 free_mapping(m);
709 }
710 #endif /* DEBUG */
711
712
713 /* If this was the last protective reference, execute
714 * the pending deletions.
715 */
716
717 if (!--(hm = m->hash)->ref)
718 {
719 map_chain_t *mc, *next;
720
721 for (mc = hm->deleted; mc; mc = next)
722 {
723 next = mc->next;
724 free_map_chain(m, mc, MY_FALSE);
725 }
726
727 hm->deleted = NULL;
728 }
729
730 /* Call free_mapping() if appropriate */
731
732 free_mapping(m);
733
734 } /* free_protector_mapping() */
735
736 /*-------------------------------------------------------------------------*/
737 static INLINE mp_int
mhash(svalue_t * svp)738 mhash (svalue_t * svp)
739
740 /* Compute and return the hash value for svalue *<svp>.
741 * The function requires that x.generic is valid even for types without
742 * a secondary type information.
743 */
744
745 {
746 mp_int i;
747
748 switch (svp->type)
749 {
750 case T_STRING:
751 i = mstr_get_hash(svp->u.str);
752 break;
753
754 case T_CLOSURE:
755 if (CLOSURE_REFERENCES_CODE(svp->x.closure_type))
756 {
757 i = (p_int)(svp->u.lambda) ^ *SVALUE_FULLTYPE(svp);
758 }
759 else if (CLOSURE_MALLOCED(svp->x.closure_type))
760 {
761 i = (p_int)(svp->u.lambda->ob) ^ *SVALUE_FULLTYPE(svp);
762 }
763 else /* Efun, Simul-Efun, Operator closure */
764 {
765 i = *SVALUE_FULLTYPE(svp);
766 }
767 break;
768
769 default:
770 i = svp->u.number ^ *SVALUE_FULLTYPE(svp);
771 break;
772 }
773
774 i = i ^ i >> 16;
775 i = i ^ i >> 8;
776
777 return i;
778 } /* mhash() */
779
780 /*-------------------------------------------------------------------------*/
781 static svalue_t *
find_map_entry(mapping_t * m,svalue_t * map_index,p_int * pKeys,map_chain_t ** ppChain,Bool bMakeTabled)782 find_map_entry ( mapping_t *m, svalue_t *map_index
783 , p_int * pKeys, map_chain_t ** ppChain
784 , Bool bMakeTabled
785 )
786
787 /* Index mapping <m> with key value <map_index> and if found, return a pointer
788 * to the entry block for this key (ie. the result pointer will point to
789 * the stored key value).
790 * If the key was found in the condensed data, *<pKeys> will be set
791 * to key index; otherwise *<ppChain> will point to the hash map chain entry.
792 * The 'not found' values for the two variables are -1 and NULL resp.
793 *
794 * If <bMakeTabled> is TRUE and <map_index> is a string, it is made tabled.
795 *
796 * If the key is not found, NULL is returned.
797 *
798 * Sideeffect: <map_index>.x.generic information is generated for types
799 * which usually have none (required for hashing).
800 */
801
802 {
803 *pKeys = -1;
804 *ppChain = NULL;
805
806 /* If the key is a string, make it tabled */
807 if (map_index->type == T_STRING && !mstr_tabled(map_index->u.str)
808 && bMakeTabled)
809 {
810 map_index->u.str = make_tabled(map_index->u.str);
811 }
812
813 /* Check if it's a destructed object.
814 */
815 if (destructed_object_ref(map_index))
816 assign_svalue(map_index, &const0);
817
818 /* Generate secondary information for types which usually
819 * have none (required for hashing).
820 */
821 if (map_index->type != T_CLOSURE
822 && map_index->type != T_FLOAT
823 && map_index->type != T_SYMBOL
824 && map_index->type != T_QUOTED_ARRAY
825 )
826 map_index->x.generic = (short)(map_index->u.number << 1);
827
828 /* Search in the condensed part first.
829 */
830
831 if (m->cond && m->cond->size != 0)
832 {
833 mapping_cond_t *cm = m->cond;
834 mp_int size = cm->size;
835 svalue_t *key, * keystart, * keyend;
836
837 keystart = &cm->data[0];
838 keyend = keystart + size;
839
840 /* Skip eventual deleted entries at start or end */
841 while (size > 0 && keystart->type == T_INVALID)
842 {
843 keystart++;
844 size--;
845 }
846
847 while (size > 0 && keyend[-1].type == T_INVALID)
848 {
849 keyend--;
850 size--;
851 }
852
853 while (keyend > keystart)
854 {
855 int cmp;
856
857 key = (keyend - keystart) / 2 + keystart;
858
859 while (key > keystart && key->type == T_INVALID)
860 key--;
861
862 cmp = svalue_cmp(map_index, key);
863
864 if (cmp == 0)
865 {
866 /* Found it */
867 *pKeys = (p_int)(key - &(cm->data[0]));
868 return key;
869 }
870
871 if (cmp > 0)
872 {
873 /* The map_index value is after key */
874 for ( keystart = key+1
875 ; keystart < keyend && keystart->type == T_INVALID
876 ; keystart++)
877 NOOP;
878 }
879 else
880 {
881 /* The map_index value is before key */
882 for ( keyend = key
883 ; keystart < keyend && keyend[-1].type == T_INVALID
884 ; keyend--)
885 NOOP;
886 }
887 }
888 }
889
890 /* At this point, the key was not found in the condensed index
891 * of the mapping. Try the hashed index next.
892 */
893
894 if (m->hash && m->hash->used)
895 {
896 mapping_hash_t *hm = m->hash;
897 map_chain_t *mc;
898
899 mp_int idx = mhash(map_index) & hm->mask;
900
901 /* Look for the value in the chain determined by index */
902
903 for (mc = hm->chains[idx]; mc != NULL; mc = mc->next)
904 {
905 if (!svalue_eq(&(mc->data[0]), map_index))
906 {
907 /* Found it */
908 *ppChain = mc;
909 return &(mc->data[0]);
910 }
911 }
912 }
913
914 /* Not found at all */
915
916 return NULL;
917 } /* find_map_entry() */
918
919 /*-------------------------------------------------------------------------*/
920 svalue_t *
_get_map_lvalue(mapping_t * m,svalue_t * map_index,Bool need_lvalue,Bool check_size)921 _get_map_lvalue (mapping_t *m, svalue_t *map_index
922 , Bool need_lvalue, Bool check_size)
923
924 /* Index mapping <m> with key value <map_index> and return a pointer to the
925 * array of values stored for this key. If the mapping has no values for a
926 * key, a pointer to const1 is returned.
927 *
928 * If the mapping does not contains the given index, and <need_lvalue> is
929 * false, &const0 is returned. If <need_lvalue> is true, a new key/value
930 * entry is created and returned (map_index is assigned for this). If the
931 * mapping doesn't have values for a key, a pointer to a local static
932 * instance of svalue-0 is returned.
933 *
934 * If check_size is true and the extension of the mapping would increase
935 * its size over max_mapping_size, a runtime error is raised.
936 *
937 * Return NULL when out of memory.
938 *
939 * Sideeffect: if <map_index> is an unshared string, it is made shared.
940 * Also, <map_index>.x.generic information is generated for types
941 * which usually have none (required for hashing).
942 *
943 * For easier use, mapping.h defines the following macros:
944 * get_map_value(m,x) -> _get_map_lvalue(m,x,false,true)
945 * get_map_lvalue(m,x) -> _get_map_lvalue(m,x,true,true)
946 * get_map_lvalue_unchecked(m,x) -> _get_map_lvalue(m,x,true,false)
947 */
948
949 {
950 map_chain_t * mc;
951 mapping_hash_t * hm;
952 svalue_t * entry;
953 mp_int idx;
954
955 static svalue_t local_const0;
956 /* Local svalue-0 instance to be returned if a lvalue
957 * for a 0-width was requested.
958 */
959
960 entry = find_map_entry(m, map_index, (p_int *)&idx, &mc, need_lvalue);
961
962 /* If we found the entry, return the values */
963 if (entry != NULL)
964 {
965 if (!m->num_values)
966 return &const1;
967
968 if (mc != NULL)
969 return entry+1;
970
971 return COND_DATA(m->cond, idx, m->num_values);
972 }
973
974 if (!need_lvalue)
975 return &const0;
976
977 /* We didn't find key and the caller wants the data.
978 * So create a new entry and enter it into the hash index (also
979 * created if necessary).
980 */
981
982 /* Size limit exceeded? */
983 if (check_size && (max_mapping_size || max_mapping_keys))
984 {
985 mp_int msize;
986
987 msize = (mp_int)MAP_TOTAL_SIZE(m) + m->num_values + 1;
988 if ( (max_mapping_size && msize > (mp_int)max_mapping_size)
989 || (max_mapping_keys && MAP_SIZE(m)+1 > max_mapping_keys)
990 )
991 {
992 check_map_for_destr(m);
993 msize = (mp_int)MAP_TOTAL_SIZE(m) + m->num_values + 1;
994 }
995 if (max_mapping_size && msize > (mp_int)max_mapping_size)
996 {
997 errorf("Illegal mapping size: %"PRIdMPINT" elements (%"
998 PRIdPINT" x %"PRIdPINT")\n"
999 , msize, MAP_SIZE(m)+1, m->num_values);
1000 return NULL;
1001 }
1002 if (max_mapping_keys && MAP_SIZE(m) > (mp_int)max_mapping_keys)
1003 {
1004 errorf("Illegal mapping size: %"PRIdMPINT" entries\n", msize+1);
1005 return NULL;
1006 }
1007 }
1008
1009 /* Get the new entry svalues, but don't assign the key value
1010 * yet - further steps might still fail.
1011 */
1012 mc = new_map_chain(m);
1013 if (NULL == mc)
1014 return NULL;
1015
1016 /* If the mapping has no hashed index, create one with just one
1017 * chain and put the new entry in there.
1018 */
1019
1020 if ( !(hm = m->hash) )
1021 {
1022 /* Create the hash part of the mapping and put
1023 * it into the dirty list.
1024 */
1025
1026 hm = get_new_hash(m, 1);
1027 if (!hm)
1028 {
1029 free_map_chain(m, mc, MY_TRUE);
1030 return NULL; /* Oops */
1031 }
1032 m->hash = hm;
1033
1034 /* Now insert the map_chain structure into its chain */
1035 hm->chains[0] = mc;
1036 mc->next = NULL;
1037
1038 if (m->cond)
1039 num_dirty_mappings++;
1040 else
1041 num_hash_mappings++;
1042 }
1043 else
1044 {
1045
1046 /* The hashed index exists, so we can insert the new entry there.
1047 *
1048 * However, if the average number of map_chains per chain exceeds 2,
1049 * double the size of the bucket array first.
1050 */
1051 if (hm->used & ~hm->mask<<1)
1052 {
1053 mapping_hash_t *hm2;
1054 mp_int size, mask, j;
1055 map_chain_t **mcp, **mcp2, *next;
1056
1057 hm2 = hm;
1058
1059 /* Compute new size and mask, and allocate the structure */
1060
1061 size = (hm->mask << 1) + 2;
1062 mask = size - 1;
1063
1064 hm = xalloc(sizeof *hm - sizeof *mcp + sizeof *mcp * size);
1065 if (!hm)
1066 {
1067 free_map_chain(m, mc, MY_TRUE);
1068 return NULL;
1069 }
1070
1071 /* Initialise the new structure except for the chains */
1072
1073 *hm = *hm2;
1074 hm->mask = mask;
1075 mcp = hm->chains;
1076 do *mcp++ = NULL; while (--size);
1077
1078 /* Copy the old chains into the new buckets by rehashing
1079 * them.
1080 */
1081 mcp = hm->chains;
1082 mcp2 = hm2->chains;
1083 for (j = hm2->mask + 1; --j >= 0; )
1084 {
1085 map_chain_t *mc2;
1086
1087 for (mc2 = *mcp2++; mc2; mc2 = next)
1088 {
1089 next = mc2->next;
1090 idx = mhash(&(mc2->data[0])) & mask;
1091 mc2->next = mcp[idx];
1092 mcp[idx] = mc2;
1093 }
1094 }
1095 m->hash = hm;
1096
1097 LOG_ALLOC("get_map_lvalue - existing hash", SIZEOF_MH(hm) - SIZEOF_MH(hm2), sizeof *hm - sizeof *mcp + sizeof *mcp * size);
1098 m->user->mapping_total += SIZEOF_MH(hm) - SIZEOF_MH(hm2);
1099 check_total_mapping_size();
1100
1101 /* Away, old data! */
1102
1103 xfree(hm2);
1104 }
1105
1106 /* Finally, insert the new entry into its chain */
1107
1108 idx = mhash(map_index) & hm->mask;
1109 mc->next = hm->chains[idx];
1110 hm->chains[idx] = mc;
1111 }
1112
1113 /* With the new map_chain structure inserted, we can adjust
1114 * the statistics and copy the key value into the structure.
1115 */
1116
1117 assign_svalue_no_free(&(mc->data[0]), map_index);
1118 for (idx = m->num_values, entry = &(mc->data[1]); idx > 0
1119 ; idx--, entry++)
1120 put_number(entry, 0);
1121
1122 hm->last_used = current_time;
1123 hm->used++;
1124 m->num_entries++;
1125
1126 if (m->num_values)
1127 return &(mc->data[1]);
1128
1129 /* Return a reference to the local static svalue-0 instance, so that
1130 * buggy code doesn't accidentally changes the global const0.
1131 */
1132 put_number(&local_const0, 0);
1133 return &local_const0;
1134 } /* _get_map_lvalue() */
1135
1136 /*-------------------------------------------------------------------------*/
1137 Bool
mapping_references_objects(mapping_t * m)1138 mapping_references_objects (mapping_t *m)
1139
1140 /* Check if the mapping <m> references objects (directly or through
1141 * closures) as keys.
1142 * Return TRUE if it does, FALSE if it doesn't.
1143 *
1144 * The swapper uses this function to determine whether or not to
1145 * swap a mapping.
1146 */
1147
1148 {
1149 mapping_cond_t *cm;
1150 mapping_hash_t *hm;
1151
1152 /* Scan the condensed part for object references used as keys.
1153 */
1154
1155 if (NULL != (cm = m->cond))
1156 {
1157 size_t ix;
1158 svalue_t * entry;
1159
1160 for (ix = 0, entry = &(cm->data[0]); ix < cm->size; ++ix, ++entry)
1161 {
1162 if (T_OBJECT == entry->type || T_CLOSURE == entry->type)
1163 return MY_TRUE;
1164 } /* for (all keys) */
1165
1166 } /* if (m->cond) */
1167
1168 /* If it exists, scan the hash part for object references.
1169 */
1170
1171 if ( NULL != (hm = m->hash) )
1172 {
1173 map_chain_t **mcp, *mc;
1174 p_int i;
1175
1176 /* Walk all chains */
1177
1178 for (mcp = hm->chains, i = hm->mask + 1; --i >= 0;)
1179 {
1180 /* Walk this chain */
1181
1182 for (mc = *mcp++; NULL != mc; mc = mc->next)
1183 {
1184 svalue_t * entry = &(mc->data[0]);
1185
1186 if (T_OBJECT == entry->type || T_CLOSURE == entry->type)
1187 return MY_TRUE;
1188 } /* walk this chain */
1189 } /* walk all chains */
1190 } /* if (hash part exists) */
1191
1192 return MY_FALSE;
1193 } /* mapping_references_objects() */
1194
1195 /*-------------------------------------------------------------------------*/
1196 void
check_map_for_destr(mapping_t * m)1197 check_map_for_destr (mapping_t *m)
1198
1199 /* Check the mapping <m> for references to destructed objects.
1200 * Where they appear as keys, both key and associated values are
1201 * deleted from the mapping. Where they appear as values, they are
1202 * replaced by svalue-0.
1203 */
1204
1205 {
1206 p_int num_values;
1207 mapping_cond_t *cm;
1208 mapping_hash_t *hm;
1209
1210 num_values = m->num_values;
1211
1212 /* Scan the condensed part for destructed object references used as keys.
1213 */
1214
1215 if (NULL != (cm = m->cond))
1216 {
1217 size_t ix;
1218 svalue_t * entry;
1219
1220 /* First, scan the keys */
1221 for (ix = 0, entry = &(cm->data[0]); ix < cm->size; ++ix, ++entry)
1222 {
1223 if (T_INVALID == entry->type)
1224 continue;
1225
1226 if (destructed_object_ref(entry))
1227 {
1228 p_int i;
1229 svalue_t * data = COND_DATA(cm, ix, num_values);
1230
1231 /* Destructed key: remove the whole entry */
1232 m->num_entries--;
1233
1234 free_svalue(entry);
1235 entry->type = T_INVALID;
1236
1237 for (i = num_values; i > 0; --i, data++)
1238 {
1239 free_svalue(data);
1240 put_number(data, 0);
1241 }
1242
1243 /* Count the deleted entry in the hash part.
1244 * Create it if necessary.
1245 */
1246 if ( !(hm = m->hash) )
1247 {
1248 hm = get_new_hash(m, 0);
1249 if (!hm)
1250 {
1251 outofmem(sizeof *hm, "hash mapping");
1252 /* NOTREACHED */
1253 return;
1254 }
1255 m->hash = hm;
1256 num_dirty_mappings++;
1257 }
1258
1259 hm->cond_deleted++;
1260
1261 continue;
1262 }
1263 } /* for (all keys) */
1264
1265 /* Second, scan the values */
1266 for ( ix = 0, entry = &(cm->data[cm->size])
1267 ; ix < num_values * cm->size; ++ix, ++entry)
1268 {
1269 if (destructed_object_ref(entry))
1270 {
1271 assign_svalue(entry, &const0);
1272 }
1273 } /* for (all values) */
1274 } /* if (m->cond) */
1275
1276 /* If it exists, scan the hash part for destructed objects.
1277 */
1278
1279 if ( NULL != (hm = m->hash) )
1280 {
1281 map_chain_t **mcp, **mcp2, *mc;
1282 p_int i, j;
1283
1284 /* Walk all chains */
1285
1286 for (mcp = hm->chains, i = hm->mask + 1; --i >= 0;)
1287 {
1288 /* Walk this chain */
1289
1290 for (mcp2 = mcp++; NULL != (mc = *mcp2); )
1291 {
1292 /* Destructed object as key: remove entry */
1293
1294 svalue_t * entry = &(mc->data[0]);
1295
1296 if (destructed_object_ref(entry))
1297 {
1298 m->num_entries--;
1299
1300 *mcp2 = mc->next;
1301
1302 /* If the mapping is a protector mapping, move
1303 * the entry into the 'deleted' list, else
1304 * just deallocate it.
1305 */
1306 if (hm->ref)
1307 {
1308 mc->next = hm->deleted;
1309 hm->deleted = mc;
1310 }
1311 else
1312 {
1313 free_map_chain(m, mc, MY_FALSE);
1314 }
1315 hm->used--;
1316 continue;
1317 }
1318
1319 /* Scan the values of this entry (not reached
1320 * if the entry was removed above
1321 */
1322 for (entry++, j = num_values; j > 0; --j, ++entry)
1323 {
1324 if (destructed_object_ref(entry))
1325 {
1326 assign_svalue(entry, &const0);
1327 }
1328 }
1329
1330 mcp2 = &mc->next;
1331
1332 } /* walk this chain */
1333 } /* walk all chains */
1334 } /* if (hash part exists) */
1335
1336 } /* check_map_for_destr() */
1337
1338 /*-------------------------------------------------------------------------*/
1339 static void
remove_mapping(mapping_t * m,svalue_t * map_index)1340 remove_mapping (mapping_t *m, svalue_t *map_index)
1341
1342 /* Remove from mapping <m> that entry which is index by key value
1343 * <map_index>. Nothing happens if it doesn't exist.
1344 *
1345 * Sideeffect: if <map_index> is an unshared string, it is made shared.
1346 * Also, <map_index>.x.generic information is generated for types
1347 * which usually have none (required for hashing).
1348 */
1349
1350 {
1351 p_int key_ix;
1352 svalue_t * entry;
1353 map_chain_t * mc;
1354 mapping_hash_t * hm;
1355 p_int num_values;
1356
1357 num_values = m->num_values;
1358
1359 entry = find_map_entry(m, map_index, &key_ix, &mc, MY_FALSE);
1360
1361 if (NULL != entry)
1362 {
1363 /* The entry exists - now remove it */
1364
1365 m->num_entries--;
1366
1367 if (key_ix >= 0)
1368 {
1369 /* The entry is in the condensed part */
1370 p_int i;
1371
1372 free_svalue(entry); entry->type = T_INVALID;
1373 entry = COND_DATA(m->cond, key_ix, num_values);
1374 for (i = num_values; i > 0; i--, entry++)
1375 {
1376 free_svalue(entry);
1377 put_number(entry, 0);
1378 }
1379
1380 /* Count the deleted entry in the hash part.
1381 * Create it if necessary.
1382 */
1383 if ( !(hm = m->hash) )
1384 {
1385 hm = get_new_hash(m, 0);
1386 if (!hm)
1387 {
1388 outofmem(sizeof *hm, "hash mapping");
1389 /* NOTREACHED */
1390 return;
1391 }
1392 m->hash = hm;
1393
1394 if (m->cond)
1395 num_dirty_mappings++;
1396 else
1397 num_hash_mappings++;
1398 }
1399
1400 hm->last_used = current_time;
1401 hm->cond_deleted++;
1402 }
1403 else if (mc != NULL && NULL != (hm = m->hash))
1404 {
1405 /* The key is in the hash mapping */
1406
1407 map_chain_t *prev, *mc2;
1408 mp_int idx = mhash(entry) & hm->mask;
1409
1410 for ( prev = 0, mc2 = hm->chains[idx]
1411 ; mc2 != NULL && mc2 != mc
1412 ; prev = mc2, mc2 = mc2->next)
1413 NOOP;
1414
1415 if (mc2 == NULL)
1416 fatal("Mapping entry didn't hash to the same spot.\n");
1417
1418 /* Unlink the found entry */
1419 if (prev)
1420 prev->next = mc->next;
1421 else
1422 hm->chains[idx] = mc->next;
1423
1424 /* If the mapping is a protector mapping, move
1425 * the entry into the 'deleted' list, else
1426 * just deallocate it.
1427 */
1428 if (hm->ref)
1429 {
1430 mc->next = hm->deleted;
1431 hm->deleted = mc;
1432 }
1433 else
1434 {
1435 free_map_chain(m, mc, MY_FALSE);
1436 }
1437
1438 hm->last_used = current_time;
1439 hm->used--;
1440 /* TODO: Reduce the size of the hashtable if the average
1441 * TODO:: number of entries per chain is <= 1 (or better <= 0.5
1442 * TODO:: to provide some breathing space for new entries).
1443 */
1444 }
1445 else
1446 fatal("Mapping entry found in neither condensed nor hash index.\n");
1447 }
1448 /* else the entry wasn't found */
1449
1450 } /* remove_mapping() */
1451
1452 /*-------------------------------------------------------------------------*/
1453 mapping_t *
resize_mapping(mapping_t * m,mp_int new_width)1454 resize_mapping (mapping_t *m, mp_int new_width)
1455
1456 /* Produce a shallow copy of mapping <m>, adjusted to have
1457 * <new_width> values per key, and return it.
1458 * The copy of a protector mapping is a normal mapping.
1459 *
1460 * check_map_for_destr(m) should be called before.
1461 */
1462
1463 {
1464 mapping_t * m2;
1465 mapping_hash_t * hm, *hm2 = NULL;
1466 mapping_cond_t * cm, *cm2 = NULL;
1467 mp_int common_width; /* == min(num_values, new_width) */
1468 p_int num_entries;
1469
1470 /* Set the width variables */
1471 if (m->num_values >= new_width)
1472 {
1473 common_width = new_width;
1474 }
1475 else
1476 {
1477 common_width = m->num_values;
1478 }
1479
1480 /* Check if the new size is too big */
1481 if (new_width > 0)
1482 {
1483 if (new_width > SSIZE_MAX /* TODO: SIZET_MAX, see port.h */
1484 || ( new_width != 0
1485 && (SSIZE_MAX - sizeof(map_chain_t)) / new_width < sizeof(svalue_t))
1486 )
1487 {
1488 errorf("Mapping width too big (%"PRIdMPINT")\n", new_width);
1489 /* NOTREACHED */
1490 return NULL;
1491 }
1492
1493 }
1494
1495 num_entries = m->num_entries;
1496
1497 /* Get the target mapping without a hash, but with a condensed block
1498 * big enough to hold all entries.
1499 */
1500 {
1501 p_int cm_size = 0;
1502 if (m->cond)
1503 {
1504 cm_size = m->cond->size;
1505 if (m->hash)
1506 cm_size -= m->hash->cond_deleted;
1507 }
1508 m2 = get_new_mapping(current_object->user, new_width, 0, cm_size);
1509 if (!m2)
1510 {
1511 outofmem(sizeof *m2 + (mp_int)sizeof(svalue_t) * m->num_entries * new_width
1512 , "result mapping base structure");
1513 /* NOTREACHED */
1514 return NULL;
1515 }
1516 }
1517
1518 /* --- Copy the hash part, if existent ---
1519 */
1520
1521 if ( NULL != (hm = m->hash) )
1522 {
1523 map_chain_t **mcp, **mcp2;
1524 mp_int size;
1525
1526 /* Allocate and initialize the hash structure */
1527
1528 size = hm->mask + 1;
1529 hm2 = xalloc(sizeof *hm - sizeof *mcp + sizeof *mcp * size);
1530 if (!hm2)
1531 {
1532 outofmem(sizeof *hm - sizeof *mcp + sizeof *mcp * size, "hash structure");
1533 /* NOTREACHED */
1534 return NULL;
1535 }
1536
1537 hm2->mask = hm->mask;
1538 hm2->used = hm->used;
1539 hm2->last_used = current_time;
1540 hm2->cond_deleted = 0;
1541 hm2->deleted = NULL;
1542 hm2->ref = 0;
1543
1544 /* Now copy the hash chains */
1545
1546 mcp = hm->chains;
1547 mcp2 = hm2->chains;
1548 do {
1549 map_chain_t *last = NULL, *mc, *mc2;
1550
1551 for (mc = *mcp++; mc; mc = mc->next)
1552 if(destructed_object_ref(&(mc->data[0])))
1553 num_entries--;
1554 else
1555 {
1556 svalue_t *src, *dest;
1557 p_int i;
1558
1559 mc2 = new_map_chain(m2);
1560 if (!mc2)
1561 {
1562 xfree(hm2);
1563 outofmem(SIZEOF_MCH(mc, new_width), "hash link");
1564 /* NOTREACHED */
1565 return NULL;
1566 }
1567
1568 /* Copy the key and the common values */
1569 for (src = &(mc->data[0]), dest = &(mc2->data[0]), i = common_width
1570 ; i >= 0
1571 ; --i, src++, dest++)
1572 {
1573 assign_svalue_no_free(dest, src);
1574 }
1575
1576 /* Zero out any extraneous values */
1577 for (dest = &(mc2->data[common_width+1]), i = new_width - common_width
1578 ; i > 0
1579 ; --i, dest++)
1580 {
1581 put_number(dest, 0);
1582 }
1583
1584
1585 mc2->next = last;
1586 last = mc2;
1587 }
1588 *mcp2++ = last;
1589 } while (--size);
1590
1591 /* Plug the new hash into the new mapping */
1592 m2->hash = hm2;
1593 LOG_ALLOC("copy_mapping - hash", SIZEOF_MH(hm2), sizeof *hm - sizeof *mcp + sizeof *mcp * size);
1594 m->user->mapping_total += SIZEOF_MH(hm2);
1595 check_total_mapping_size();
1596 if (m->cond)
1597 num_dirty_mappings++;
1598 else
1599 num_hash_mappings++;
1600 }
1601
1602
1603 /* --- Copy the condensed part ---
1604 */
1605
1606 if (NULL != (cm = m->cond) && NULL != (cm2 = m2->cond))
1607 {
1608 size_t src_ix;
1609 svalue_t * src_key, * src_data;
1610 svalue_t * dest_key, * dest_data;
1611
1612 for ( src_ix = 0
1613 , src_key = &(cm->data[0])
1614 , dest_key = &(cm2->data[0])
1615 , dest_data = COND_DATA(cm2, 0, new_width)
1616 ; src_ix < cm->size
1617 ; src_ix++, src_key++)
1618 {
1619 if (src_key->type == T_INVALID)
1620 ; /* Do nothing */
1621 else if (destructed_object_ref(src_key))
1622 {
1623 /* We have to fill the space.
1624 * (Alternatively we could decrease m->cond->size.)
1625 */
1626 p_int i;
1627
1628 num_entries--;
1629
1630 dest_key->type = T_INVALID;
1631 dest_key++;
1632
1633 for (i = new_width; i > 0; i--, dest_data++)
1634 put_number(dest_data, 0);
1635 }
1636 else
1637 {
1638 p_int i;
1639
1640 src_data = COND_DATA(cm, src_ix, m->num_values);
1641
1642 /* Copy the key and the common data */
1643 assign_svalue_no_free(dest_key++, src_key);
1644 for (i = common_width; i > 0; i--)
1645 assign_svalue_no_free(dest_data++, src_data++);
1646
1647 /* Zero out any extraneous values */
1648 for (i = new_width - common_width; i > 0; i--, dest_data++)
1649 put_number(dest_data, 0);
1650 }
1651 } /* for (all keys) */
1652 }
1653
1654 /* --- Finalize the basis structure ---
1655 */
1656
1657 m2->num_entries = num_entries;
1658
1659 /* That's it. */
1660 return m2;
1661 } /* resize_mapping() */
1662
1663 /*-------------------------------------------------------------------------*/
1664 mapping_t *
add_mapping(mapping_t * m1,mapping_t * m2)1665 add_mapping (mapping_t *m1, mapping_t *m2)
1666
1667 /* Merge mappings <m1> and <m2> into a new mapping and return it.
1668 * Entries from <m2> effectively overwrite entries <m1> if their key
1669 * matches.
1670 *
1671 * If <m1> and <m2> differ in the number of values per entry, return
1672 * a copy of <m1> if non-empty, else return a copy of <m2>.
1673 *
1674 * Return NULL if out of memory.
1675 *
1676 * To keep the function fast, the condensed part of m3 is always
1677 * the sum of the condensed parts of m1 and m2: this allows to operate
1678 * with static limits. To achieve this, entries from m1
1679 * overwritten by m2 are counted as cond_deleted entries in m3.
1680 * We leave it to the later compaction phase to get rid of all these
1681 * entries - if the mapping is still alive then.
1682 *
1683 * Note: The mappings (or at least mapping m2) should not contain destructed
1684 * objects, ie. check_map_for_destr() should be called on both mappings
1685 * before the addition. If this is not done, strange things may happen to your
1686 * mappings, though the exact reasons are unclear (b-001204).
1687 */
1688
1689 {
1690 mp_int num_values = m1->num_values;
1691 mapping_t * m3; /* The result mapping */
1692 mapping_hash_t * hm;
1693 p_int cm3size;
1694
1695 /* Special case: number of values per entry differs.
1696 * If one of the mappings is empty, the other one is returned.
1697 * If both mappings contain data, an error is thrown.
1698 */
1699
1700 if (m2->num_values != num_values)
1701 {
1702 if (!m1->num_entries)
1703 {
1704 return copy_mapping(m2);
1705 }
1706
1707 if (!m2->num_entries)
1708 {
1709 return copy_mapping(m1);
1710 }
1711
1712 errorf("Mappings to be added are of different width: %"PRIdMPINT
1713 " vs. %"PRIdPINT"\n",
1714 num_values, m2->num_values);
1715 }
1716
1717
1718 /* Allocate the result mapping *m3 and initialise it.
1719 */
1720
1721 {
1722 p_int hsize = 1; /* Force the creation of the hash */
1723
1724 if (m1->hash) hsize += m1->hash->used;
1725 if (m2->hash) hsize += m2->hash->used;
1726
1727 cm3size = 0;
1728 if (m1->cond) cm3size += m1->cond->size;
1729 if (m2->cond) cm3size += m2->cond->size;
1730
1731 m3 = get_new_mapping(current_object->user, num_values, hsize, cm3size);
1732
1733 if (!m3)
1734 {
1735 outofmem(sizeof *m3 + sizeof(svalue_t) * hsize * cm3size * num_values
1736 , "result mapping base structure");
1737 /* NOTREACHED */
1738 return NULL;
1739 }
1740 }
1741
1742 /* Merge the condensed entries.
1743 * Since the keys are sorted, a simple walk through both mappings
1744 * in parallel with proper selection does the trick.
1745 */
1746
1747 if (NULL != m3->cond)
1748 {
1749 mapping_cond_t *cm1, *cm2, *cm3;
1750 svalue_t *src1_key, *src2_key, *dest_key, *dest_data;
1751 size_t cm1size, cm2size;
1752 size_t cm1_ix, cm2_ix, num_entries;
1753
1754 cm1 = m1->cond;
1755 cm1size = cm1 ? cm1->size : 0;
1756
1757 cm2 = m2->cond;
1758 cm2size = cm2 ? cm2->size : 0;
1759
1760 cm3 = m3->cond;
1761
1762 /* Loop over the mappings in parallel */
1763 for ( cm1_ix = cm2_ix = 0
1764 , src1_key = cm1 ? &(cm1->data[0]) : NULL
1765 , src2_key = cm2 ? &(cm2->data[0]) : NULL
1766 , dest_key = &(cm3->data[0])
1767 , dest_data = COND_DATA(cm3, 0, num_values)
1768 , num_entries = 0
1769 ; cm1_ix < cm1size && cm2_ix < cm2size
1770 ; NOOP )
1771 {
1772 int cmp;
1773 p_int i;
1774
1775 if (src1_key->type == T_INVALID
1776 || destructed_object_ref(src1_key)
1777 )
1778 {
1779 cm1_ix++;
1780 src1_key++;
1781 continue;
1782 }
1783
1784 if (src2_key->type == T_INVALID
1785 || destructed_object_ref(src2_key)
1786 )
1787 {
1788 cm2_ix++;
1789 src2_key++;
1790 continue;
1791 }
1792
1793 /* Ok, it's a new entry */
1794 m3->num_entries++;
1795
1796 cmp = svalue_cmp(src1_key, src2_key);
1797
1798 if (cmp < 0)
1799 {
1800 svalue_t *src_data = COND_DATA(cm1, cm1_ix, num_values);
1801
1802 /* Copy the key and the values */
1803 assign_svalue_no_free(dest_key++, src1_key);
1804 for (i = num_values; i > 0; i--)
1805 assign_svalue_no_free(dest_data++, src_data++);
1806
1807 num_entries++;
1808 cm1_ix++;
1809 src1_key++;
1810 }
1811 else if (cmp >= 0)
1812 {
1813 svalue_t *src_data = COND_DATA(cm2, cm2_ix, num_values);
1814
1815 /* Copy the key and the values */
1816 assign_svalue_no_free(dest_key++, src2_key);
1817 for (i = num_values; i > 0; i--)
1818 assign_svalue_no_free(dest_data++, src_data++);
1819
1820 num_entries++;
1821 cm2_ix++;
1822 src2_key++;
1823
1824 if (cmp == 0)
1825 {
1826 cm1_ix++;
1827 src1_key++;
1828 }
1829 }
1830 } /* for(mappings in parallel) */
1831
1832 /* Copy remaining values from m1 */
1833 for ( ; cm1_ix < cm1size; cm1_ix++, src1_key++)
1834 {
1835 svalue_t *data = COND_DATA(cm1, cm1_ix, num_values);
1836 p_int i;
1837
1838 if (src1_key->type != T_INVALID
1839 && !destructed_object_ref(src1_key))
1840 {
1841 /* Copy the key and the values */
1842 assign_svalue_no_free(dest_key++, src1_key);
1843 for (i = num_values; i > 0; i--)
1844 assign_svalue_no_free(dest_data++, data++);
1845
1846 num_entries++;
1847 }
1848 } /* for (remaining values in m1) */
1849
1850 /* Copy remaining values from m2 */
1851 for ( ; cm2_ix < cm2size; cm2_ix++, src2_key++)
1852 {
1853 svalue_t *data = COND_DATA(cm2, cm2_ix, num_values);
1854 p_int i;
1855
1856 if (src2_key->type != T_INVALID
1857 && !destructed_object_ref(src2_key))
1858 {
1859 /* Copy the key and the values */
1860 assign_svalue_no_free(dest_key++, src2_key);
1861 for (i = num_values; i > 0; i--)
1862 assign_svalue_no_free(dest_data++, data++);
1863
1864 num_entries++;
1865 }
1866 } /* for (remaining values in m2) */
1867
1868 /* We have now num_entries entries in m3.
1869 * Any remaining space in cm3 counts as 'deleted', so
1870 * initialise it accordingly.
1871 */
1872 m3->num_entries = num_entries;
1873 m3->hash->cond_deleted = cm3size - num_entries;
1874
1875 for ( ; (p_int)num_entries < cm3size; num_entries++)
1876 {
1877 p_int i;
1878
1879 dest_key->type = T_INVALID; dest_key++;
1880
1881 for (i = num_values; i > 0; i--, dest_data++)
1882 {
1883 put_number(dest_data, 0);
1884 }
1885
1886 }
1887 } /* Merge condensed entries */
1888
1889 /* Now copy the two hash parts, using get_map_lvalue() to create
1890 * the new hashed entries
1891 *
1892 * First m1...
1893 */
1894 if ( NULL != (hm = m1->hash) )
1895 {
1896 map_chain_t **mcp;
1897 p_int size;
1898
1899 size = hm->mask + 1;
1900 mcp = hm->chains;
1901 do {
1902 map_chain_t *mc;
1903
1904 for (mc = *mcp++; mc; mc = mc->next)
1905 {
1906 svalue_t * src, * dest;
1907 p_int i;
1908
1909 src = &(mc->data[0]);
1910 dest = get_map_lvalue_unchecked(m3, src);
1911 if (!dest)
1912 {
1913 free_mapping(m3);
1914 return NULL;
1915 }
1916 for (src++, i = num_values; --i >= 0; )
1917 assign_svalue(dest++, src++);
1918 }
1919 } while (--size);
1920 }
1921
1922 /* ...now m2, potentially overwriting the entries from m1.
1923 */
1924 if ( NULL != (hm = m2->hash) )
1925 {
1926 map_chain_t **mcp;
1927 p_int size;
1928
1929 size = hm->mask + 1;
1930 mcp = hm->chains;
1931 do {
1932 map_chain_t *mc;
1933
1934 for (mc = *mcp++; mc; mc = mc->next)
1935 {
1936 svalue_t * src, * dest;
1937 p_int i;
1938
1939 src = &(mc->data[0]);
1940 dest = get_map_lvalue_unchecked(m3, src);
1941 if (!dest)
1942 {
1943 free_mapping(m3);
1944 return NULL;
1945 }
1946 for (src++, i = num_values; --i >= 0; )
1947 assign_svalue(dest++, src++);
1948 }
1949 } while (--size);
1950 }
1951
1952 /* And that's it :-) */
1953 return m3;
1954
1955 } /* add_mapping() */
1956
1957 /*-------------------------------------------------------------------------*/
1958 void
walk_mapping(mapping_t * m,void (* func)(svalue_t * key,svalue_t * val,void * extra),void * extra)1959 walk_mapping ( mapping_t *m
1960 , void (*func) (svalue_t *key, svalue_t *val, void *extra)
1961 , void *extra)
1962
1963 /* Generic function to perform a mapping walk. The function visits every
1964 * valid entry of <m> and for each entry calls <func>, passing the
1965 * current key, the current value(s) and the parameter <extra> to the
1966 * function.
1967 *
1968 * <func> may modify the value(s), but not the key.
1969 */
1970
1971 {
1972 mapping_cond_t *cm;
1973 mapping_hash_t *hm;
1974 svalue_t *key, *data;
1975 mp_int num_values;
1976
1977 num_values = m->num_values;
1978
1979 /* Walk through the condensed data */
1980
1981 if (NULL != (cm = m->cond))
1982 {
1983 size_t ix;
1984
1985 for ( ix = 0, key = &(cm->data[0]), data = COND_DATA(cm, 0, num_values)
1986 ; ix < cm->size
1987 ; ix++, key++, data += num_values
1988 )
1989 {
1990 if (key->type != T_INVALID
1991 && !destructed_object_ref(key)
1992 )
1993 (*func)(key, data, extra);
1994 }
1995 }
1996
1997 /* Walk through the hashed data */
1998
1999 if (NULL != (hm = m->hash))
2000 {
2001 mp_int size;
2002
2003 for (size = hm->mask; size >= 0; size--)
2004 {
2005 map_chain_t *mc;
2006
2007 for (mc = hm->chains[size]; mc != NULL; )
2008 {
2009 map_chain_t *next = mc->next;
2010 if (!destructed_object_ref(&(mc->data[0])))
2011 (*func)(&(mc->data[0]), &(mc->data[1]), extra);
2012 mc = next;
2013 }
2014 }
2015 }
2016
2017 } /* walk_mapping() */
2018
2019 /*-------------------------------------------------------------------------*/
2020 Bool
compact_mapping(mapping_t * m,Bool force)2021 compact_mapping (mapping_t *m, Bool force)
2022
2023 /* Compact the mapping <m>.
2024 *
2025 * If <force> is TRUE, always compact the mapping.
2026 * If <force> is FALSE, the mappings is compacted if
2027 * - have a .last_used time of 2*TIME_TO_COMPACT or more seconds earlier,
2028 * - or have to have at least half of their condensed entries deleted
2029 * and have a .last_used time of TIME_TO_COMPACT or more seconds earlier.
2030 *
2031 * Return TRUE if the mapping has been freed altogether in the function
2032 * (ie. <m> is now invalid), or FALSE if it still exists.
2033 *
2034 * The merger is a two step process: first, all hashed entries are
2035 * sorted, then the sorted entries are merged with the condensed part.
2036 * The sort itself is done using Mergesort, with special treatment for those
2037 * portions that don't make up the current power of 2.
2038 *
2039 * The function is big, but functionally simple: there is only so
2040 * much complexity in a Mergesort.
2041 */
2042
2043 {
2044 int old_malloc_privilege = malloc_privilege;
2045 /* Since it will be set temporarily to MALLOC_SYSTEM */
2046
2047 Bool checked_map_for_destr = MY_FALSE;
2048 /* Flag if check_map_for_destr() has been called. */
2049
2050 mapping_hash_t *hm;
2051 /* The hash part of m (guaranteed to exist!) */
2052 mapping_cond_t *cm;
2053 /* The condensed part of m */
2054 int num_values;
2055 /* Number of values per entry */
2056
2057 mapping_t *m2;
2058 /* Temporary holder for the compacted result mapping */
2059 mapping_cond_t *cm2;
2060 /* The new condensed part of the mapping */
2061
2062 map_chain_t *hook1, *hook2;
2063 /* All hashed entries in two long chains.
2064 */
2065
2066 mp_int count1, count2;
2067 map_chain_t **mcpp, *mcp, *next;
2068 map_chain_t *last_hash;
2069 /* Auxiliaries */
2070
2071 mp_int runlength;
2072 /* Current Mergesort partition length */
2073
2074 malloc_privilege = MALLOC_SYSTEM;
2075 /* compact_mappings() may be called in very low memory situations,
2076 * so it has to be allowed to use the system reserve.
2077 * Neat sideeffect: all allocations are guaranteed to work (or
2078 * the driver terminates).
2079 */
2080
2081 if (last_indexing_protector.type == T_PROTECTOR_MAPPING)
2082 {
2083 /* There is a slight chance that free_protector_mapping causes
2084 * remove_empty_mappings().
2085 */
2086 free_protector_mapping(last_indexing_protector.u.map);
2087 last_indexing_protector.type = T_NUMBER;
2088 }
2089
2090 #ifdef DEBUG
2091 if (!m->user)
2092 fatal("No wizlist pointer for mapping\n");
2093 #endif
2094
2095 m->ref++; /* prevent freeing while using in case of recursive
2096 * mappings referenced by a deleted value
2097 */
2098
2099 hm = m->hash;
2100 cm = m->cond;
2101
2102 if (hm && hm->ref) {
2103 fatal("compact_mapping(): remaining protector ref count %"
2104 PRIdPINT"!\n", hm->ref);
2105 }
2106
2107 /* Test if the mapping is dirty at all.
2108 */
2109 if (!hm)
2110 {
2111 check_map_for_destr(m); /* may create a hash part */
2112 checked_map_for_destr = MY_TRUE;
2113 hm = m->hash;
2114 cm = m->cond;
2115 }
2116
2117 if (!hm)
2118 {
2119 LOG_SUB("compact_mapping(): no hash part", 0);
2120 malloc_privilege = old_malloc_privilege;
2121 check_total_mapping_size();
2122
2123 return free_mapping(m);
2124 }
2125
2126 /* Test the compaction criterium.
2127 * By testing it before check_map_for_destr(), the size related
2128 * criterias might trigger later than desired, but the time criterium
2129 * makes sure that we won't miss one.
2130 */
2131 if (!force
2132 && !( current_time - hm->last_used >= TIME_TO_COMPACT
2133 && ( hm->cond_deleted * 2 >= m->num_entries - hm->used
2134 || hm->used >= m->num_entries - hm->used - hm->cond_deleted
2135 || current_time - hm->last_used >= 2*TIME_TO_COMPACT
2136 )
2137 )
2138 )
2139 {
2140 /* This mapping doesn't qualify for compaction.
2141 */
2142 m->ref--; /* undo the ref increment from above */
2143 malloc_privilege = old_malloc_privilege;
2144 return MY_FALSE;
2145 }
2146
2147 /* Detect all destructed entries - the compaction algorithm
2148 * relies on it.
2149 */
2150 if (!checked_map_for_destr)
2151 {
2152 check_map_for_destr(m);
2153 checked_map_for_destr = MY_TRUE;
2154 hm = m->hash;
2155 cm = m->cond;
2156 }
2157
2158 /* Test if the mapping needs compaction at all.
2159 * If not, just delete the hash part (if any).
2160 */
2161 if (!hm->used && !hm->cond_deleted)
2162 {
2163 LOG_SUB("compact_mapping(): no need to", SIZEOF_MH(hm));
2164 malloc_privilege = old_malloc_privilege;
2165 m->user->mapping_total -= SIZEOF_MH(hm);
2166 m->hash = NULL;
2167
2168 if (m->cond)
2169 num_dirty_mappings--;
2170 else
2171 num_hash_mappings--;
2172 check_total_mapping_size();
2173
2174 xfree(hm);
2175
2176 /* the ref count has been incremented above; on the other
2177 * hand, the last real reference might have gone with the
2178 * deleted keys. If that is the case, free_mapping() will
2179 * deallocate it (since we NULLed out the .hash).
2180 */
2181 return free_mapping(m);
2182 }
2183
2184 /* This mapping can be compacted, and there is something to compact. */
2185
2186 /* Get the temporary result mapping (we need the condensed block
2187 * anyway, and this way it's simple to keep the statistics
2188 * straight).
2189 */
2190
2191 if (m->cond && m->hash)
2192 num_dirty_mappings--;
2193 else if (m->hash)
2194 num_hash_mappings--;
2195
2196 num_values = m->num_values;
2197
2198 m2 = get_new_mapping(m->user, num_values, 0, m->num_entries);
2199 cm2 = m2->cond;
2200
2201 if (cm2 != NULL)
2202 {
2203 /* --- Setup Mergesort ---
2204 *
2205 * Unravel all hash chains into two chains, dangling from hook1
2206 * and hook2.
2207 *
2208 * The chains differ in length by at most 1 element. Within
2209 * the chains, the elements are pairwise sorted.
2210 *
2211 * In this loop, hook1 is always the next chain to add to,
2212 * and last_hash is the first element of the next pair to add.
2213 */
2214 mcpp = hm->chains;
2215 count1 = hm->mask;
2216 hook1 = hook2 = NULL;
2217 last_hash = NULL;
2218
2219 do {
2220 mcp = *mcpp;
2221 *mcpp++ = NULL; /* m no longer owns this chain */
2222 while (mcp)
2223 {
2224 next = mcp->next;
2225
2226 if (last_hash)
2227 {
2228 int d = svalue_cmp(&(mcp->data[0]), &(last_hash->data[0]));
2229
2230 if (d < 0) {
2231 last_hash->next = hook1;
2232 mcp->next = last_hash;
2233 hook1 = hook2;
2234 hook2 = mcp;
2235 } else {
2236 mcp->next = hook1;
2237 last_hash->next = mcp;
2238 hook1 = hook2;
2239 hook2 = last_hash;
2240 }
2241 last_hash = NULL;
2242 }
2243 else
2244 {
2245 last_hash = mcp;
2246 }
2247 mcp = next;
2248 }
2249 } while (--count1 >= 0);
2250
2251 /* Add the remaining odd element */
2252 if (last_hash)
2253 {
2254 last_hash->next = hook1;
2255 hook1 = last_hash;
2256 }
2257
2258
2259 /* --- Mergesort the hashed entries ---
2260 *
2261 * Sort hook1 and hook2 into hook1.
2262 */
2263 for (runlength = 2; runlength < hm->used; runlength <<= 1)
2264 {
2265 map_chain_t *out_hook1, *out_hook2, **out1, **out2;
2266 /* The output chains, which serve as input chains in
2267 * the next pass
2268 */
2269
2270 count1 = hm->used & (runlength-1);
2271 count2 = hm->used & runlength;
2272 if (!count1)
2273 {
2274 out2 = &out_hook1;
2275 *out2 = hook2;
2276 while (--count2 >= 0) {
2277 out2 = &(*out2)->next;
2278 }
2279 hook2 = *out2;
2280 count1 = count2 = runlength;
2281 out1 = &out_hook2;
2282 }
2283 else if (!count2)
2284 {
2285 out2 = &out_hook1;
2286 *out2 = hook1;
2287 do {
2288 out2 = &(*out2)->next;
2289 } while (--count1);
2290 hook1 = *out2;
2291 count1 = count2 = runlength;
2292 out1 = &out_hook2;
2293 }
2294 else
2295 {
2296 out1 = &out_hook1;
2297 out2 = &out_hook2;
2298 }
2299
2300 while (hook1)
2301 {
2302 /* Sort the next runlength elements onto out1 */
2303 while (1) {
2304 int d = svalue_cmp(&(hook1->data[0]), &(hook2->data[0]));
2305
2306 if (d > 0)
2307 {
2308 *out1 = hook2;
2309 out1 = &hook2->next;
2310 hook2 = *out1;
2311 if (!--count2)
2312 {
2313 *out1 = hook1;
2314 do {
2315 out1 = &(*out1)->next;
2316 } while (--count1);
2317 hook1 = *out1;
2318 break;
2319 }
2320 }
2321 else
2322 {
2323 *out1 = hook1;
2324 out1 = &hook1->next;
2325 hook1 = *out1;
2326 if (!--count1)
2327 {
2328 *out1 = hook2;
2329 do {
2330 out1 = &(*out1)->next;
2331 } while (--count2);
2332 hook2 = *out1;
2333 break;
2334 }
2335 }
2336 }
2337
2338 /* Now switch the chains */
2339 {
2340 map_chain_t **temp;
2341
2342 temp = out1;
2343 out1 = out2;
2344 out2 = temp;
2345 }
2346 count1 = count2 = runlength;
2347 }
2348
2349 /* Terminate the out-chains and set them up
2350 * as next input chains.
2351 */
2352 *out1 = NULL;
2353 *out2 = NULL;
2354 hook1 = out_hook1;
2355 hook2 = out_hook2;
2356 }
2357 if (!hook1)
2358 hook1 = hook2;
2359
2360
2361 /* --- Merge the old condensed part with the sorted lists ---
2362 */
2363 {
2364 size_t src_ix; /* Index into the old keys */
2365 svalue_t *src_key, *src_data;
2366 svalue_t *dest_key, *dest_data;
2367
2368 src_ix = 0;
2369 src_key = cm ? &(cm->data[0]) : NULL;
2370 src_data = cm ? COND_DATA(cm, 0, num_values) : NULL;
2371 dest_key = &(cm2->data[0]);
2372 dest_data = COND_DATA(cm2, 0, num_values);
2373
2374 /* Do the actual merge.
2375 */
2376 while (hook1 && cm != NULL && src_ix < cm->size)
2377 {
2378 int d;
2379
2380 if (src_key->type == T_INVALID)
2381 {
2382 src_ix++;
2383 src_key++;
2384 src_data += num_values;
2385 continue;
2386 }
2387
2388 d = svalue_cmp(src_key, &(hook1->data[0]));
2389
2390 if (d > 0)
2391 {
2392 /* Take entry from hook1 */
2393
2394 map_chain_t *temp;
2395 svalue_t *src;
2396 p_int i;
2397
2398 *dest_key++ = hook1->data[0];
2399
2400 for (src = &(hook1->data[1]), i = num_values; i > 0; --i)
2401 *dest_data++ = *src++;
2402
2403 temp = hook1;
2404 hook1 = temp->next;
2405 free_map_chain(m, temp, MY_TRUE);
2406 }
2407 else
2408 {
2409 /* Take entry from the old condensed part */
2410
2411 p_int i;
2412
2413 *dest_key++ = *src_key++;
2414
2415 for (i = num_values; i > 0; --i)
2416 *dest_data++ = *src_data++;
2417
2418 src_ix++;
2419 }
2420 } /* if (hook1 && src_ix < cm->size) */
2421
2422 /* Copy any remaining entries from the old condensed part
2423 * or the misc_hook1
2424 */
2425 if (cm != NULL && src_ix < cm->size)
2426 {
2427 /* Copy from the old condensed part */
2428
2429 while (src_ix < cm->size)
2430 {
2431 if (src_key->type != T_INVALID)
2432 {
2433 p_int i;
2434
2435 *dest_key++ = *src_key++;
2436
2437 for (i = num_values; i > 0; --i)
2438 *dest_data++ = *src_data++;
2439 }
2440 else
2441 {
2442 src_key++;
2443 src_data += num_values;
2444 }
2445 src_ix++;
2446 }
2447 }
2448 else
2449 {
2450 /* Copy from hook1 */
2451
2452 while (hook1)
2453 {
2454 map_chain_t *temp;
2455 svalue_t *src;
2456 p_int i;
2457
2458 *dest_key++ = hook1->data[0];
2459
2460 for (src = &(hook1->data[1]), i = num_values; i > 0; --i)
2461 *dest_data++ = *src++;
2462
2463 temp = hook1;
2464 hook1 = temp->next;
2465 free_map_chain(m, temp, MY_TRUE);
2466 }
2467 }
2468 } /* --- End of Merge --- */
2469 } /* --- if (cm2 != NULL) --- */
2470
2471 /* Switch the new key and data blocks from m2 to m, and
2472 * vice versa for the old ones. We don't assign the hash block
2473 * as we already deleted all the map_chain structures.
2474 */
2475 m->cond = cm2;
2476 m2->cond = cm;
2477
2478 m->hash = NULL; /* Since we compacted it away */
2479
2480 LOG_SUB("compact_mapping() - remove old hash", SIZEOF_MH(hm));
2481 malloc_privilege = old_malloc_privilege;
2482 m->user->mapping_total -= SIZEOF_MH(hm);
2483 check_total_mapping_size();
2484 /* The memorysize for the map_chain_t structure has already been
2485 * subtracted.
2486 */
2487
2488 xfree(hm);
2489
2490 free_empty_mapping(m2);
2491 /* Get rid of the temporary mapping and the old cond block.
2492 */
2493
2494 return free_mapping(m);
2495 /* Undo the initial m->ref++; if there was a recursive
2496 * reference which is now gone, the mapping will be deallocated
2497 * now.
2498 */
2499
2500 } /* compact_mapping() */
2501
2502 /*-------------------------------------------------------------------------*/
2503 #ifdef CHECK_MAPPING_TOTAL
2504 void
m_check_total_mapping_size(const char * file,int line)2505 m_check_total_mapping_size (const char * file, int line)
2506
2507 /* Check the sanity of the total amount of memory recorded for all
2508 * mappings in the system. If the value becomes bogus, log a message.
2509 */
2510
2511 {
2512 static mp_int last_size = 0;
2513 static Bool last_size_ok = MY_TRUE;
2514 wiz_list_t *wl;
2515 mp_int total;
2516 #ifdef MALLOC_smalloc
2517 mp_int available;
2518 #endif
2519 Bool this_size_ok = MY_TRUE;
2520
2521 #ifdef MALLOC_smalloc
2522 available = available_memory();
2523 #endif
2524 total = default_wizlist_entry.mapping_total;
2525 for (wl = all_wiz; wl; wl = wl->next)
2526 {
2527 total += wl->mapping_total;
2528 }
2529
2530 if (total < 0
2531 #ifdef MALLOC_smalloc
2532 || total > available
2533 #endif
2534 )
2535 this_size_ok = MY_FALSE;
2536
2537 if (last_size_ok && !this_size_ok)
2538 {
2539 dprintf3(gcollect_outfd, "DEBUG: (%s : %d) Invalid total mapping size %d"
2540 , (p_int)file, (p_int)line, (p_int)total);
2541 #ifdef MALLOC_smalloc
2542 dprintf1(gcollect_outfd, " (avail %d)", (p_int)available);
2543 #endif
2544 dprintf1(gcollect_outfd, ", was %d\n", (p_int)last_size);
2545 }
2546
2547 last_size_ok = this_size_ok;
2548 last_size = total;
2549 }
2550 #endif /* CHECK_MAPPING_TOTAL */
2551
2552 /*-------------------------------------------------------------------------*/
2553 mp_int
total_mapping_size(void)2554 total_mapping_size (void)
2555
2556 /* Return the amount of memory used by all mappings in the system
2557 */
2558
2559 {
2560 wiz_list_t *wl;
2561 mp_int total;
2562
2563 total = default_wizlist_entry.mapping_total;
2564 for (wl = all_wiz; wl; wl = wl->next) {
2565 total += wl->mapping_total;
2566 }
2567 return total;
2568 } /* total_mapping_size() */
2569
2570 /*-------------------------------------------------------------------------*/
2571 size_t
mapping_overhead(mapping_t * m)2572 mapping_overhead (mapping_t *m)
2573
2574 /* Return the memory overhead size of the given mapping <m>.
2575 */
2576
2577 {
2578 size_t rc = 0;
2579
2580 rc = sizeof(*m);
2581 if (m->cond)
2582 rc += sizeof(m->cond) - sizeof(svalue_t);
2583 if (m->hash)
2584 rc += SIZEOF_MH(m->hash)
2585 + m->hash->used * (sizeof(map_chain_t) - sizeof(svalue_t))
2586 ;
2587
2588 return rc;
2589 } /* mapping_overhead() */
2590
2591 /*-------------------------------------------------------------------------*/
2592
2593 /* Structure used by set_mapping_user() to communicate with ..._filter()
2594 */
2595 struct set_mapping_user_locals
2596 {
2597 p_int num_values; /* Number of values per key */
2598 object_t *owner; /* Owner to set */
2599 svalue_t **hairy;
2600 /* Next free entry in the array of keys which need manual tweaking */
2601 };
2602
2603
2604 static void
set_mapping_user_filter(svalue_t * key,svalue_t * data,void * extra)2605 set_mapping_user_filter (svalue_t *key, svalue_t *data, void *extra)
2606
2607 /* walk_mapping-callback function used by set_mapping_user().
2608 * <extra> points in fact to a struct set_mapping_user_locals.
2609 *
2610 * Set the owner of <key> and all <data> to extra.owner (this might call
2611 * set_mapping_user() recursively).
2612 *
2613 * If the key needs special treatment (ie. changing the owner would change
2614 * its sort index), it is left unchanged and a memory copy of it is stored in
2615 * extra.hairy++.
2616 */
2617
2618 {
2619 p_int i;
2620 struct set_mapping_user_locals *locals;
2621 object_t *owner;
2622
2623 locals = (struct set_mapping_user_locals *)extra;
2624 owner = locals->owner;
2625
2626 if (key->type == T_CLOSURE)
2627 {
2628 *(locals->hairy++) = key;
2629 }
2630 else
2631 {
2632 set_svalue_user(key, owner);
2633 }
2634 for (i = locals->num_values; --i > 0;)
2635 {
2636 set_svalue_user(data++, owner);
2637 }
2638 }
2639
2640 void
set_mapping_user(mapping_t * m,object_t * owner)2641 set_mapping_user (mapping_t *m, object_t *owner)
2642
2643 /* Set the <owner> as the user of mapping <m> and all its contained
2644 * keys and values, and update the wizlist entry for <owner>.
2645 *
2646 * As this function is called only for variables in newly compiled
2647 * objects, there is no need to guard against recursive
2648 * calls for this particular mapping.
2649 */
2650
2651 {
2652 p_int num_values;
2653 mp_int total;
2654 wiz_list_t *user;
2655 struct set_mapping_user_locals locals;
2656 svalue_t **first_hairy;
2657 mp_int i;
2658
2659 num_values = m->num_values;
2660
2661 /* Move the total size in the wizlist from the old owner
2662 * to the new one
2663 */
2664 total = (mp_int)( sizeof(*m)
2665 + ((m->cond) ? SIZEOF_MC(m->cond, m->num_values) : 0)
2666 );
2667 LOG_SUB("set_mapping_user", total);
2668 m->user->mapping_total -= total;
2669 check_total_mapping_size();
2670 user = owner->user;
2671 m->user = user;
2672 LOG_ADD("set_mapping_user", total);
2673 m->user->mapping_total += total;
2674 check_total_mapping_size();
2675
2676
2677 /* Walk the mapping to set all owners */
2678
2679 locals.owner = owner;
2680 locals.num_values = num_values;
2681 first_hairy = alloca(((m->cond) ? m->cond->size : 1) * sizeof(svalue_t *));
2682 if (!first_hairy)
2683 {
2684 errorf("Stack overflow.\n");
2685 /* NOTREACHED */
2686 return;
2687 }
2688 locals.hairy = first_hairy;
2689 walk_mapping(m, set_mapping_user_filter, &locals);
2690
2691 /* All 'hairy' keys are changed by reassignment to the mapping.
2692 * Be aware that changing the user might not change the search order.
2693 */
2694 for (i = locals.hairy - first_hairy; --i >= 0; first_hairy++)
2695 {
2696 svalue_t new_key, *dest, *source;
2697 mp_int j;
2698
2699 /* Create the new key by changing its owner */
2700 assign_svalue_no_free(&new_key, *first_hairy);
2701 set_svalue_user(&new_key, owner);
2702
2703 /* Create a new entry in the mapping for the new key */
2704 dest = get_map_lvalue_unchecked(m, &new_key);
2705 if (!dest)
2706 {
2707 outofmemory("key with new owner");
2708 /* NOTREACHED */
2709 return;
2710 }
2711 free_svalue(&new_key);
2712
2713 /* Move the values from the old entry to the new one, invalidating
2714 * the old ones by this.
2715 */
2716 source = get_map_value(m, *first_hairy);
2717 if (source != dest)
2718 {
2719 if (num_values)
2720 memcpy((char *)dest, (char *)source, num_values * sizeof *dest);
2721 for (j = num_values; --j > 0; source++)
2722 source->type = T_INVALID;
2723
2724 /* Remove the old entry */
2725 remove_mapping(m, *first_hairy);
2726 }
2727 }
2728 } /* set_mapping_user() */
2729
2730
2731 #ifdef GC_SUPPORT
2732
2733 /*-------------------------------------------------------------------------*/
2734 void
clear_mapping_size(void)2735 clear_mapping_size (void)
2736
2737 /* Clear the statistics about the number and memory usage of all mappings
2738 * in the game.
2739 */
2740
2741 {
2742 wiz_list_t *wl;
2743
2744 num_mappings = 0;
2745 default_wizlist_entry.mapping_total = 0;
2746 for (wl = all_wiz; wl; wl = wl->next)
2747 wl->mapping_total = 0;
2748 check_total_mapping_size();
2749 } /* clear_mapping_size(void) */
2750
2751 /*-------------------------------------------------------------------------*/
2752 void
count_mapping_size(mapping_t * m)2753 count_mapping_size (mapping_t *m)
2754
2755 /* Add the mapping <m> to the statistics.
2756 * This method is called from the garbage collector only, at which point
2757 * the .hash member is either NULL or used as link pointer for a list
2758 * of stale mappings.
2759 */
2760
2761 {
2762 mp_int total;
2763
2764 num_mappings++;
2765
2766 total = sizeof(*m);
2767 #if 0 && defined(CHECK_MAPPING_TOTAL)
2768 dprintf3(gcollect_outfd, "DEBUG: map '%s' %d (num values %d)"
2769 , (p_int)(m->user->name ? get_txt(m->user->name) : "<0>")
2770 , (p_int)total, (p_int)m->num_values);
2771 #endif
2772
2773 if (m->cond != NULL)
2774 {
2775 mp_int subtotal;
2776
2777 subtotal = SIZEOF_MC(m->cond, m->num_values);
2778 total += subtotal;
2779 #if 0 && defined(CHECK_MAPPING_TOTAL)
2780 dprintf2(gcollect_outfd, " + %d (size %d)"
2781 , (p_int)subtotal
2782 , (p_int)m->cond->size
2783 );
2784 #endif
2785 }
2786
2787 /* m->hash does not point to a hash structure at this time */
2788
2789 #if 0 && defined(CHECK_MAPPING_TOTAL)
2790 dprintf1(gcollect_outfd, " = %d\n", (p_int)total);
2791 #endif
2792
2793 m->user->mapping_total += total;
2794 check_total_mapping_size();
2795 } /* count_mapping_size(void) */
2796
2797 /*-------------------------------------------------------------------------*/
2798 static void
handle_destructed_key(svalue_t * key)2799 handle_destructed_key (svalue_t *key)
2800
2801 /* GC support: <key> has been found to be a key referencing a destructed
2802 * object. This function modifies it so that the GC wont choke.
2803 */
2804
2805 {
2806 if (key->type == T_CLOSURE &&
2807 key->x.closure_type == CLOSURE_BOUND_LAMBDA)
2808 {
2809 /* Avoid changing keys: collapse the bound/unbound combination
2810 * into a single lambda closure bound to the destructed
2811 * object. This way the GC will treat it correctly.
2812 */
2813 lambda_t *l = key->u.lambda;
2814
2815 key->x.closure_type = CLOSURE_LAMBDA;
2816 key->u.lambda = l->function.lambda;
2817 if (!l->ref)
2818 {
2819 /* This would have been the first reference to the
2820 * lambda closure: add it to the stale list and mark
2821 * it as 'stale'.
2822 */
2823 l->function.lambda->ob = l->ob;
2824 l->ref = -1;
2825 l->ob = (object_t *)stale_misc_closures;
2826 stale_misc_closures = l;
2827 }
2828 else
2829 {
2830 /* Closure is already been marked as 'stale': no need
2831 * to do anything about it, but but since l->ob is no
2832 * longer a valid object, we need to use a known
2833 * destructed object as stand-in for remaining lambda.
2834 * TODO: Having a type CLOSURE_DESTRUCTED_LAMBDA
2835 * TODO:: might be safer? After all,
2836 * TODO:: gc_obj_list_destructed might be NULL.
2837 */
2838 #ifdef DEBUG
2839 if (gc_obj_list_destructed)
2840 fatal("gc_obj_list_destructed is NULL\n");
2841 #endif
2842 l->function.lambda->ob = gc_obj_list_destructed;
2843 }
2844 }
2845 count_ref_in_vector(key, 1);
2846 if (key->type == T_CLOSURE)
2847 {
2848 /* *key has been transformed by count_ref_in_vector()
2849 * into an efun closure bound to the master.
2850 */
2851 key->u.ob->ref--;
2852 }
2853
2854 /* Don't bother freeing the svalues - this is the GC after all,
2855 * and freeing them might even confuse the memory allocator.
2856 */
2857 key->type = T_INVALID;
2858 } /* handle_destructed_key() */
2859
2860 /*-------------------------------------------------------------------------*/
2861 void
count_ref_in_mapping(mapping_t * m)2862 count_ref_in_mapping (mapping_t *m)
2863
2864 /* GC support: Count all references by the mapping <m>.
2865 *
2866 * If the mapping contains keys referencing destructed objects/lambdas,
2867 * it is added to the list of stale mappings.
2868 */
2869
2870 {
2871 mp_int size;
2872 mp_int num_values;
2873 Bool any_destructed = MY_FALSE;
2874
2875 num_values = m->num_values;
2876
2877 /* Mark the blocks as referenced */
2878 if (m->cond)
2879 note_malloced_block_ref(m->cond);
2880 if (m->hash)
2881 note_malloced_block_ref(m->hash);
2882
2883 /* Count references by condensed keys and their data.
2884 * Take special care of keys referencing destructed objects/lambdas.
2885 */
2886
2887 size = m->cond ? m->cond->size : 0;
2888 while ( --size >= 0)
2889 {
2890 svalue_t * key = &(m->cond->data[size]);
2891 svalue_t * data = COND_DATA(m->cond, size, num_values);
2892
2893 if (destructed_object_ref(key))
2894 {
2895 /* This key is a destructed object, resp. is bound to a destructed
2896 * object. The entry has to be deleted.
2897 */
2898 handle_destructed_key(key);
2899 m->num_entries--;
2900
2901 any_destructed = MY_TRUE;
2902 }
2903 else
2904 {
2905 count_ref_in_vector(key, 1);
2906 count_ref_in_vector(data, num_values);
2907 }
2908 }
2909
2910 /* Count references by hashed keys and their data.
2911 * Take special care of keys referencing destructed objects/lambdas.
2912 */
2913 size = m->hash ? m->hash->mask+1 : 0;
2914 while ( --size >= 0)
2915 {
2916 map_chain_t * mc = m->hash->chains[size];
2917
2918 for ( ; mc != NULL; mc = mc->next)
2919 {
2920 note_malloced_block_ref(mc);
2921 if (destructed_object_ref(mc->data))
2922 {
2923 /* This key is a destructed object, resp. is bound to a
2924 * destructed object. The entry has to be deleted.
2925 */
2926 handle_destructed_key(mc->data);
2927
2928 any_destructed = MY_TRUE;
2929 }
2930 else
2931 {
2932 count_ref_in_vector(mc->data, 1);
2933 count_ref_in_vector(mc->data+1, num_values);
2934 }
2935 }
2936 }
2937
2938 /* If any stale key was found, link the mapping into the
2939 * stale mapping list.
2940 */
2941 if (any_destructed)
2942 {
2943 m->next = stale_mappings;
2944 stale_mappings = m;
2945 /* We are going to use free_svalue() later to get rid of the
2946 * data asscoiated with the keys. This data might reference
2947 * mappings with destructed keys... Thus, we must prevent
2948 * free_mapping() to look at the hash field.
2949 */
2950 m->ref++;
2951 /* Ref for the stale-mapping link. */
2952 }
2953 } /* count_ref_in_mapping() */
2954
2955 /*-------------------------------------------------------------------------*/
2956 void
clean_stale_mappings(void)2957 clean_stale_mappings (void)
2958
2959 /* GC support: After count_ref_in_mapping(), the gc will free all
2960 * unreferenced destructed objects and lambdas. This may have removed
2961 * several keys in the stale_mappings. Since the objective
2962 * is to recover memory, we try to compact these mappings now.
2963 * Be aware that the mappings might be empty now.
2964 */
2965
2966 {
2967 mapping_t *m, *next;
2968
2969 for (m = stale_mappings; m; m = next)
2970 {
2971 mapping_cond_t *cm;
2972 mapping_hash_t *hm;
2973 size_t size;
2974 mp_int num_cond_entries;
2975 mp_int num_values;
2976 mp_int i;
2977
2978 /* Unlink from the stale_mapping list */
2979 next = m->next;
2980 m->next = NULL;
2981
2982 num_values = m->num_values;
2983 cm = m->cond;
2984 hm = m->hash;
2985
2986 /* Try to reallocate a new condensed block */
2987
2988 num_cond_entries = m->num_entries - (hm ? hm->used : 0);
2989 if (num_cond_entries)
2990 {
2991 mapping_cond_t *cm2;
2992 size_t ix;
2993 svalue_t *src_key, *src_data;
2994 svalue_t *dest_key, *dest_data;
2995
2996 size = sizeof(*cm2) + sizeof(svalue_t) * (num_cond_entries * (num_values+1) - 1);
2997 cm2 = xalloc(size);
2998 if (!cm2)
2999 {
3000 fprintf(stderr, "%s Unable to compact stale mapping: Out of memory "
3001 "for new condensed block (%zu bytes).\n"
3002 , time_stamp(), size);
3003 debug_message("%s Unable to compact stale mapping: Out of memory "
3004 "for new condensed block (%zu bytes).\n"
3005 , time_stamp(), size);
3006
3007 /* No use in even trying to compact the much bigger data
3008 * block either.
3009 */
3010 continue;
3011 }
3012
3013 cm2->size = num_cond_entries;
3014
3015 /* Copy the data */
3016 for ( ix = 0
3017 , src_key = &(cm->data[0])
3018 , src_data = COND_DATA(cm, 0, num_values)
3019 , dest_key = &(cm2->data[0])
3020 , dest_data = COND_DATA(cm2, 0, num_values)
3021 ; ix < cm->size
3022 ; ix++, src_key++)
3023 {
3024 if (src_key->type != T_INVALID)
3025 {
3026 *dest_key++ = *src_key;
3027 for (i = num_values; i > 0; i--)
3028 *dest_data++ = *src_data++;
3029 }
3030 else
3031 src_data += num_values;
3032 }
3033
3034 /* Replace the old keyblock by the new one. */
3035 LOG_ALLOC("clean_stale - new keyblock", SIZEOF_MC(cm2, num_values), size);
3036 m->user->mapping_total += SIZEOF_MC(cm2, num_values);
3037 m->cond = cm2;
3038 }
3039 else
3040 {
3041 /* No condensed block needed. */
3042 m->cond = NULL;
3043 }
3044
3045 /* Delete the old condensed block, if any */
3046 if (cm)
3047 {
3048 LOG_SUB("clean_state - old keyblock", SIZEOF_MC(cm, num_values));
3049 m->user->mapping_total -= SIZEOF_MC(cm, num_values);
3050 xfree(cm);
3051 }
3052
3053 /* Removed all invalid keys from the hash part, if any */
3054 if (hm && hm->used)
3055 {
3056 size_t ix;
3057
3058 for (ix = 0; ix <= (size_t)hm->mask; ix++)
3059 {
3060 map_chain_t * mc, * mcp;
3061
3062 for (mcp = NULL, mc = hm->chains[ix]; mc != NULL ; )
3063 {
3064 if (mc->data[0].type == T_INVALID)
3065 {
3066 /* This key has been marked for deletion,
3067 * now remove it altogether.
3068 */
3069 map_chain_t * this = mc;
3070
3071 if (mcp == NULL)
3072 {
3073 hm->chains[ix] = this->next;
3074 }
3075 else
3076 {
3077 mcp->next = this->next;
3078 }
3079 mc = this->next;
3080
3081 m->num_entries--;
3082 hm->used--;
3083 m->user->mapping_total -= SIZEOF_MCH(this, num_values);
3084 xfree(this);
3085 }
3086 else
3087 {
3088 /* Valid key - just step forward */
3089 mcp = mc;
3090 mc = mc->next;
3091 }
3092 } /* for(mc) */
3093 } /* for(ix) */
3094 } /* hash part */
3095
3096 check_total_mapping_size();
3097 free_mapping(m); /* Undo the ref held by the stale-mapping list */
3098 }
3099 } /* clean_stale_mappings() */
3100
3101 #endif /* GC_SUPPORT */
3102
3103 /*=========================================================================*/
3104
3105 /* EFUNS */
3106
3107 /*-------------------------------------------------------------------------*/
3108 svalue_t *
f_m_allocate(svalue_t * sp)3109 f_m_allocate (svalue_t *sp)
3110
3111 /* EFUN m_allocate()
3112 *
3113 * mapping m_allocate(int size, int width)
3114 *
3115 * Reserve memory for a mapping.
3116 *
3117 * size is the number of entries (i.e. keys) to reserve, width is
3118 * the number of data items per entry. If the optional width is
3119 * omitted, 1 is used as default.
3120 */
3121
3122 {
3123 p_int size = sp[-1].u.number;
3124 p_int width = sp[0].u.number;
3125
3126 if (size < 0)
3127 errorf("Illegal mapping size: %"PRIdPINT"\n", size);
3128 if (width < 0)
3129 errorf("Illegal mapping width: %"PRIdPINT"\n", width);
3130
3131 if (max_mapping_size
3132 && size * (1 + width) > (p_int)max_mapping_size)
3133 errorf("Illegal mapping size: %"PRIdMPINT
3134 " elements (%"PRIdPINT" x %"PRIdPINT").\n",
3135 (mp_int)size * (1+width),
3136 size, width);
3137
3138 if (max_mapping_keys
3139 && size > (p_int)max_mapping_keys)
3140 errorf("Illegal mapping size: %"PRIdPINT" entries.\n", size);
3141
3142 sp--;
3143
3144 if (!(sp->u.map = allocate_mapping(size, width)))
3145 {
3146 sp++;
3147 /* sp points to a number-typed svalue, so freeing won't
3148 * be a problem.
3149 */
3150 errorf("Out of memory for mapping[%"PRIdPINT",%"PRIdPINT"].\n",
3151 size, width);
3152 /* NOTREACHED */
3153 }
3154 sp->type = T_MAPPING;
3155
3156 return sp;
3157 } /* f_m_allocate() */
3158
3159 /*-------------------------------------------------------------------------*/
3160 svalue_t *
v_m_add(svalue_t * sp,int num_arg)3161 v_m_add (svalue_t *sp, int num_arg)
3162
3163 /* EFUN m_allocate()
3164 *
3165 * mapping m_add(mapping map, mixed key, [mixed data...])
3166 *
3167 * Add (or replace) an entry with index <key> in mapping <map>.
3168 * The modified mapping is also returned as result.
3169 *
3170 * The values for the entry are taken from the <data> arguments.
3171 * Unassigned entry values default to 0, extraneous <data> arguments
3172 * are ignore.
3173 */
3174
3175 {
3176 mapping_t *m;
3177 svalue_t *argp;
3178 svalue_t *entry;
3179 p_int num_values;
3180
3181 argp = sp - num_arg + 1;
3182 m = argp->u.map;
3183
3184 /* Get (or create) the mapping entry */
3185 entry = get_map_lvalue(m, argp+1);
3186
3187 /* Transfer the given values from the stack into the mapping
3188 * entry.
3189 */
3190 num_values = m->num_values;
3191 if (num_values > num_arg - 2)
3192 num_values = num_arg - 2;
3193 for ( argp += 2
3194 ; num_values > 0 && argp <= sp
3195 ; num_values--, argp++, entry++
3196 )
3197 {
3198 transfer_svalue(entry, argp);
3199 /* And since we take out values from under sp, play it
3200 * safe:
3201 */
3202 put_number(argp, 0);
3203 }
3204
3205 /* We leave the reference to the mapping on the stack as result,
3206 * but pop everything else.
3207 */
3208 sp = pop_n_elems(num_arg-1, sp);
3209
3210 return sp;
3211 } /* v_m_add() */
3212
3213 /*-------------------------------------------------------------------------*/
3214 svalue_t *
f_m_delete(svalue_t * sp)3215 f_m_delete (svalue_t *sp)
3216
3217 /* EFUN m_delete()
3218 *
3219 * mapping m_delete(mapping map, mixed key)
3220 *
3221 * Remove the entry with index 'key' from mapping 'map'. The
3222 * changed mapping 'map' is also returned as result.
3223 * If the mapping does not have an entry with index 'key',
3224 * nothing is changed.
3225 */
3226
3227 {
3228 mapping_t *m;
3229
3230 m = (sp-1)->u.map;
3231 remove_mapping(m, sp);
3232 free_svalue(sp--);
3233 /* leave the modified mapping on the stack */
3234 return sp;
3235 } /* f_m_delete() */
3236
3237 /*-------------------------------------------------------------------------*/
3238 vector_t *
m_indices(mapping_t * m)3239 m_indices (mapping_t *m)
3240
3241 /* Create a vector with all keys from mapping <m> and return it.
3242 * If the mapping contains destructed objects, m_indices() will remove
3243 * them.
3244 *
3245 * The helper function m_indices_filter() is located in interpret.c
3246 * to take advantage of inlined assign_svalue_no_free().
3247 *
3248 * The function is used for efuns m_indices(), map_mapping(), and for
3249 * the loop construct foreach().
3250 */
3251
3252 {
3253 vector_t *v;
3254 svalue_t *svp;
3255 mp_int size;
3256
3257 check_map_for_destr(m);
3258 size = MAP_SIZE(m);
3259 v = allocate_array(size); /* might cause error */
3260 svp = v->item;
3261 walk_mapping(m, m_indices_filter, &svp);
3262 return v;
3263 } /* m_indices() */
3264
3265 /*-------------------------------------------------------------------------*/
3266 svalue_t *
f_m_indices(svalue_t * sp)3267 f_m_indices (svalue_t *sp)
3268
3269 /* EFUN m_indices()
3270 *
3271 * mixed *m_indices(mapping map)
3272 *
3273 * Returns an array containing the indices of mapping 'map'.
3274 */
3275
3276 {
3277 mapping_t *m;
3278 vector_t *v;
3279
3280 m = sp->u.map;
3281 v = m_indices(m);
3282
3283 free_mapping(m);
3284 put_array(sp,v);
3285
3286 return sp;
3287 } /* f_m_indices() */
3288
3289 /*-------------------------------------------------------------------------*/
3290 svalue_t *
f_m_values(svalue_t * sp)3291 f_m_values (svalue_t *sp)
3292
3293 /* EFUN m_values()
3294 *
3295 * mixed *m_values(mapping map)
3296 * mixed *m_values(mapping map, int index)
3297 *
3298 * Returns an array with the values of mapping 'map'.
3299 * If <index> is given as a number between 0 and the width of
3300 * the mapping, the values from the given column are returned,
3301 * else the values of the first column.
3302 *
3303 * The called filter function m_values_filter() is in interpret.c
3304 * to take advantage of inline expansion.
3305 */
3306
3307 {
3308 mapping_t *m;
3309 vector_t *v;
3310 struct mvf_info vip;
3311 p_int size;
3312 p_int num;
3313
3314 /* Get and check the arguments */
3315 num = sp->u.number;
3316 sp--;
3317 inter_sp = sp;
3318
3319 m = sp->u.map;
3320 if (num < 0 || num >= m->num_values)
3321 errorf("Illegal index %"PRIdPINT" to m_values(): should be in 0..%"
3322 PRIdPINT".\n", num, m->num_values-1);
3323
3324 /* Get the size of the mapping */
3325 check_map_for_destr(m);
3326 size = MAP_SIZE(m);
3327
3328 if (size > 0 && m->num_values < 1)
3329 errorf("m_values() applied on mapping with no values.\n");
3330
3331 v = allocate_array(size);
3332
3333 /* Extract the desired column from the mapping */
3334 vip.svp = v->item;
3335 vip.num = num;
3336 walk_mapping(m, m_values_filter, &vip);
3337 free_mapping(m);
3338
3339 /* Push the result */
3340 put_array(sp,v);
3341
3342 return sp;
3343 } /* f_m_values() */
3344
3345 /*-------------------------------------------------------------------------*/
3346 static void
add_to_mapping_filter(svalue_t * key,svalue_t * data,void * extra)3347 add_to_mapping_filter (svalue_t *key, svalue_t *data, void *extra)
3348
3349 /* Auxiliary function to add_to_mapping():
3350 * Add/overwrite (key:data) to mapping <extra>.
3351 */
3352
3353 {
3354 svalue_t *data2;
3355 p_int i;
3356
3357 data2 = get_map_lvalue_unchecked((mapping_t *)extra, key);
3358 if (!data2)
3359 {
3360 outofmemory("entry added to mapping");
3361 /* NOTREACHED */
3362 return;
3363 }
3364 if (data2 != data) /* this should always be true */
3365 {
3366 for (i = ((mapping_t *)extra)->num_values; --i >= 0;)
3367 {
3368 assign_svalue(data2++, data++);
3369 }
3370 }
3371 } /* add_to_mapping_filter() */
3372
3373 /*-------------------------------------------------------------------------*/
3374 void
add_to_mapping(mapping_t * m1,mapping_t * m2)3375 add_to_mapping (mapping_t *m1, mapping_t *m2)
3376
3377 /* Add the data from mapping <m2> to mapping <m1>, overwriting existing
3378 * entries.
3379 *
3380 * If the values per entry differ, and one of the mappings is empty,
3381 * the empty mapping's width is set to that of the non-empy one.
3382 * Otherwise (different width, no mapping empty) the function returns
3383 * immediately.
3384 *
3385 * Called by interpret.c as part of F_ADD_EQ and F_VOID_ADD_EQ.
3386 */
3387
3388 {
3389 /* Adding a mapping to itself doesn't change its content. */
3390 if (m1 == m2)
3391 return;
3392
3393 if (m2->num_values != m1->num_values)
3394 {
3395 /* If one of the two mappings is empty, we can adjust its width
3396 * after getting rid of all pending data blocks.
3397 */
3398 if (0 == m2->num_entries && NULL == m2->hash)
3399 {
3400 if (m2->cond != NULL)
3401 {
3402 LOG_SUB_M("add_to_mapping - m2 no cond", m2, SIZEOF_MC(m2->cond, m2->num_values));
3403 m2->user->mapping_total -= SIZEOF_MC(m2->cond, m2->num_values);
3404 xfree(m2->cond);
3405 m2->cond = NULL;
3406 }
3407 m2->num_values = m1->num_values;
3408 }
3409 else if (0 == m1->num_entries && NULL == m1->hash)
3410 {
3411 if (m1->cond != NULL)
3412 {
3413 LOG_SUB_M("add_to_mapping - m1 no cond", m1, SIZEOF_MC(m2->cond, m2->num_values));
3414 m1->user->mapping_total -= SIZEOF_MC(m1->cond, m1->num_values);
3415 xfree(m1->cond);
3416 m1->cond = NULL;
3417 }
3418 m1->num_values = m2->num_values;
3419 }
3420 else
3421 {
3422 errorf("Mappings to be added are of different width: %"PRIdPINT
3423 " vs. %"PRIdPINT"\n",
3424 m1->num_values, m2->num_values);
3425 return;
3426 }
3427 }
3428 walk_mapping(m2, add_to_mapping_filter, m1);
3429 } /* add_to_mapping() */
3430
3431 /*-------------------------------------------------------------------------*/
3432 void
sub_from_mapping_filter(svalue_t * key,svalue_t * data UNUSED,void * extra)3433 sub_from_mapping_filter ( svalue_t *key, svalue_t *data UNUSED
3434 , void *extra)
3435
3436 /* Auxiliary to subtract_mapping(): Delete <key> from mapping <extra>.
3437 * Also called by interpret.c as part of F_SUB_EQ (which then makes sure
3438 * that subtrahend and minuend are not identical).
3439 */
3440
3441 {
3442 #ifdef __MWERKS__
3443 # pragma unused(data)
3444 #endif
3445 remove_mapping((mapping_t *)extra, key);
3446 } /* sub_from_mapping_filter() */
3447
3448 /*-------------------------------------------------------------------------*/
3449 mapping_t *
subtract_mapping(mapping_t * minuend,mapping_t * subtrahend)3450 subtract_mapping (mapping_t *minuend, mapping_t *subtrahend)
3451
3452 /* Create a copy of <minuend> minus all entries which are also in
3453 * <subtrahend>.
3454 *
3455 * Called by interpret.c as part of F_SUBTRACT.
3456 */
3457
3458 {
3459 /* TODO: This could be done faster, especially if there the mappings are
3460 * mainly condensed. On the other hand, the priority of fast mapping
3461 * subtraction is unknown.
3462 * Also, by providing a copy of the minuend it is safe to subtract
3463 * a mapping from itself.
3464 */
3465 minuend = copy_mapping(minuend);
3466 walk_mapping(subtrahend, sub_from_mapping_filter, minuend);
3467 return minuend;
3468 } /* subtract_mapping() */
3469
3470 /*-------------------------------------------------------------------------*/
3471 struct map_intersect_s
3472 {
3473 mapping_t * m; /* Mapping to be intersected */
3474 mapping_t * rc; /* Result mapping */
3475 };
3476
3477
3478 static void
map_intersect_filter(svalue_t * key,svalue_t * data UNUSED,void * extra)3479 map_intersect_filter (svalue_t *key, svalue_t *data UNUSED, void *extra)
3480
3481 /* Auxiliary function to map_intersect():
3482 * If <key> is in <extra>->m, add the data to <extra>->rc.
3483 */
3484
3485 {
3486 #ifdef __MWERKS__
3487 # pragma unused(data)
3488 #endif
3489 mapping_t * m = ((struct map_intersect_s *)extra)->m;
3490 mapping_t * rc = ((struct map_intersect_s *)extra)->rc;
3491
3492 svalue_t * src;
3493
3494 src = get_map_value(m, key);
3495 if (src != &const0)
3496 {
3497 p_int num_values = m->num_values;
3498 svalue_t * dest;
3499 p_int j;
3500
3501 dest = get_map_lvalue(rc, key);
3502 if (!dest)
3503 {
3504 outofmemory("result mapping entry");
3505 /* NOTREACHED */
3506 }
3507 for (j = 0; j < num_values; j++)
3508 {
3509 assign_svalue(dest+j, src+j);
3510 }
3511 } /* if found element */
3512 } /* map_intersect_filter() */
3513
3514
3515 mapping_t *
map_intersect(mapping_t * m,svalue_t * val)3516 map_intersect (mapping_t *m, svalue_t * val)
3517
3518 /* Intersect mapping <m> with vector/mapping <val>.
3519 *
3520 * The result is a new mapping with all those elements of <m> which index
3521 * can be found in vector <val>->u.vector resp. as index in mapping
3522 * <val>->u.map. Both <m> and <val> are freed on return.
3523 *
3524 * Called by interpret to implement F_AND.
3525 */
3526
3527 {
3528 mapping_t *rc = NULL;
3529
3530 if (val->type == T_POINTER)
3531 {
3532 vector_t * vec = val->u.vec;
3533 p_int vecsize = VEC_SIZE(vec);
3534 p_int num_values = m->num_values;
3535 p_int i;
3536
3537 rc = allocate_mapping(vecsize, num_values);
3538 if (!rc)
3539 {
3540 outofmemory("result mapping");
3541 /* NOTREACHED */
3542 }
3543
3544 for (i = 0; i < vecsize; i++)
3545 {
3546 svalue_t * src;
3547
3548 src = get_map_value(m, &vec->item[i]);
3549 if (src != &const0)
3550 {
3551 svalue_t * dest;
3552 p_int j;
3553
3554 dest = get_map_lvalue(rc, &vec->item[i]);
3555 if (!dest)
3556 {
3557 outofmemory("result mapping entry");
3558 /* NOTREACHED */
3559 }
3560 for (j = 0; j < num_values; j++)
3561 {
3562 assign_svalue(dest+j, src+j);
3563 }
3564 } /* if found element */
3565 } /* for (i) */
3566 }
3567 else if (val->type == T_MAPPING)
3568 {
3569 mapping_t * map = val->u.map;
3570 p_int num_values = m->num_values;
3571 struct map_intersect_s data;
3572
3573 rc = allocate_mapping(MAP_SIZE(map), num_values);
3574 if (!rc)
3575 {
3576 outofmemory("result mapping");
3577 /* NOTREACHED */
3578 }
3579
3580 data.m = m;
3581 data.rc = rc;
3582 walk_mapping(map, map_intersect_filter, &data);
3583 }
3584 else
3585 fatal("(map_intersect) Illegal type to arg2: %d, "
3586 "expected array/mapping."
3587 , val->type);
3588
3589 free_mapping(m);
3590 free_svalue(val);
3591 return rc;
3592 } /* map_intersect() */
3593
3594 /*-------------------------------------------------------------------------*/
3595 vector_t *
map_intersect_array(vector_t * vec,mapping_t * map)3596 map_intersect_array (vector_t *vec, mapping_t *map)
3597
3598 /* OPERATOR & (array/map intersection)
3599 *
3600 * Perform an intersection of the vectors <vec> with the indices of
3601 * mapping <map>.
3602 *
3603 * The result is a new vector with all elements which are present in both
3604 * input vectors.
3605 *
3606 * Both <vec> and <map> are freed.
3607 */
3608
3609 {
3610 Bool *flags; /* The result from match_arrays() */
3611 p_int result_size; /* Size of the result array */
3612 vector_t *result; /* Result array */
3613 svalue_t *dest; /* Pointer for storing the result elements */
3614 p_int i;
3615
3616 p_int vec_size = VEC_SIZE(vec);
3617
3618 /* Handle empty arrays */
3619
3620 if (vec_size == 0)
3621 {
3622 free_mapping(map);
3623 free_array(vec);
3624 return ref_array(&null_vector);
3625 }
3626
3627 /* Non-trivial arrays: match them up */
3628
3629 xallocate(flags, vec_size * sizeof(Bool), "flag vector");
3630 memset(flags, 0, vec_size * sizeof(Bool));
3631
3632 /* Walk through the vector and check for each element
3633 * if it exists in the mapping.
3634 * If it does, set the corresponding flag and count the
3635 * result size.
3636 */
3637 result_size = 0;
3638 for (i = 0; i < vec_size; ++i)
3639 {
3640 if (get_map_value(map, vec->item+i) != &const0)
3641 {
3642 flags[i] = MY_TRUE;
3643 result_size++;
3644 }
3645 }
3646
3647 if (result_size == vec_size)
3648 {
3649 /* No elements to remove */
3650 xfree(flags);
3651 free_mapping(map);
3652 return vec;
3653 }
3654
3655 if (max_array_size && result_size > max_array_size)
3656 {
3657 xfree(flags);
3658 free_mapping(map);
3659 free_array(vec);
3660 errorf("Illegal array size: %"PRIdPINT".\n", result_size);
3661 }
3662
3663 result = allocate_array(result_size);
3664
3665 /* Copy the elements to keep from vec into result.
3666 * We count down result_size to be able to stop as early
3667 * as possible.
3668 */
3669 for ( dest = result->item, i = 0
3670 ; i < vec_size && result_size != 0
3671 ; i++
3672 )
3673 {
3674 if (flags[i])
3675 {
3676 assign_svalue_no_free(dest, vec->item+i);
3677 dest++;
3678 result_size--;
3679 }
3680 }
3681
3682 /* Cleanup and return */
3683 xfree(flags);
3684 free_array(vec);
3685 free_mapping(map);
3686
3687 return result;
3688 } /* map_intersect_array() */
3689
3690 /*-------------------------------------------------------------------------*/
3691 static void
f_walk_mapping_filter(svalue_t * key,svalue_t * data,void * extra)3692 f_walk_mapping_filter (svalue_t *key, svalue_t *data, void *extra)
3693
3694 /* Auxiliary to efuns {walk,filter}_mapping(): callback for walk_mapping().
3695 *
3696 * <extra> is a pointer to a (svalue_t *) to an array of 2 svalues.
3697 * The first of these gets to hold the <key>, the second is an lvalue
3698 * pointing to <data>.
3699 */
3700
3701 {
3702 svalue_t *svp;
3703
3704 svp = *(svalue_t **)extra;
3705 assign_svalue_no_free(svp, key);
3706 (++svp)->u.lvalue = data;
3707 *(svalue_t **)extra = ++svp;
3708 } /* f_walk_mapping_filter() */
3709
3710 /*-------------------------------------------------------------------------*/
3711 static void
f_walk_mapping_cleanup(svalue_t * arg)3712 f_walk_mapping_cleanup (svalue_t *arg)
3713
3714 /* Auxiliary to efuns {walk,filter}_walk_mapping(): Cleanup.
3715 *
3716 * This function is called during the stackcleanup after a mapping walk.
3717 * <arg> is the array of svalue allocated by walk_mapping_prologue().
3718 * See walk_mapping_prologue() for details.
3719 */
3720
3721 {
3722 svalue_t *svp;
3723 mapping_t *m;
3724 mp_int i;
3725
3726 svp = arg + 1;
3727
3728 if (svp->u.cb)
3729 free_callback(svp->u.cb);
3730 svp++;
3731
3732 m = svp[1].u.map;
3733
3734 /* If the mapping had a hash part prior to the f_walk_mapping(),
3735 * it was protected by the prologue and we have to lift that
3736 * protection.
3737 */
3738 if (svp[1].x.generic)
3739 {
3740 mapping_hash_t *hm;
3741
3742 hm = m->hash;
3743
3744 if (!--hm->ref)
3745 {
3746 /* Last ref gone: deallocated the pending deleted entries */
3747
3748 map_chain_t *mc, *next;
3749
3750 for (mc = hm->deleted; mc; mc = next)
3751 {
3752 next = mc->next;
3753 free_map_chain(m, mc, MY_FALSE);
3754 }
3755
3756 hm->deleted = NULL;
3757 }
3758 }
3759
3760 /* Free the key svalues in the block */
3761 i = svp->u.number;
3762 if (i) do
3763 {
3764 svp += 2;
3765 free_svalue(svp);
3766 } while (--i > 0);
3767
3768 /* Deallocate the block */
3769 xfree(arg);
3770
3771 } /* f_walk_mapping_cleanup() */
3772
3773 /*-------------------------------------------------------------------------*/
3774 static svalue_t *
walk_mapping_prologue(mapping_t * m,svalue_t * sp,callback_t * cb)3775 walk_mapping_prologue (mapping_t *m, svalue_t *sp, callback_t *cb)
3776
3777 /* Auxiliary to efuns {walk,filter}_walk_mapping(): Setup.
3778 *
3779 * The function creates an svalue array of the keys and (as lvalues) the
3780 * data values of mapping <m>. The head of the array holds organisational
3781 * information; the array as a whole is put as lvalue onto the stack
3782 * at <sp>+1.
3783 *
3784 * The result configuration of the array is:
3785 *
3786 * sp+1 -> [0] { lvalue } -> { T_ERROR_HANDLER: f_walk_mapping_cleanup }
3787 * [1] { u.cb: callback structure }
3788 * [2] { u.number: number of mapping entries }
3789 * [3] { u.map: <m>, x.generic: <m> has hash part }
3790 * result -> [4] { key1 }
3791 * [5] { lvalue } -> values of key1
3792 * [6] { key2 }
3793 * [7] { lvalue } -> values of key2
3794 * etc
3795 *
3796 * Storing the array as error handler allows a simple cleanup in course
3797 * of the free_svalue()s done by f_walk_mapping().
3798 *
3799 * If <m> at call time has a hash part, it is protected by incrementing
3800 * hash->ref.
3801 */
3802
3803 {
3804 mapping_hash_t *hm;
3805 svalue_t *pointers;
3806 svalue_t *write_pointer, *read_pointer;
3807
3808 if ( NULL != (hm = m->hash) ) {
3809 if (m->num_values == 0)
3810 {
3811 hm = NULL; /* Flag: no values per key */
3812 }
3813 else if (!hm->ref++)
3814 {
3815 hm->deleted = NULL;
3816 }
3817 }
3818 xallocate(pointers, (m->num_entries * 2 + 4) * sizeof(svalue_t)
3819 , "walk_mapping prologue" );
3820 pointers[1].type = T_CALLBACK;
3821 pointers[1].u.cb = cb;
3822 pointers[2].u.number = m->num_entries;
3823 pointers[3].u.map = m;
3824 pointers[3].x.generic = hm != NULL;
3825 inter_sp = sp;
3826 push_error_handler(f_walk_mapping_cleanup, pointers);
3827 read_pointer = write_pointer = pointers + 4;
3828 walk_mapping(m, f_walk_mapping_filter, &write_pointer);
3829 return read_pointer;
3830 } /* walk_mapping_prologue() */
3831
3832 /*-------------------------------------------------------------------------*/
3833 svalue_t *
v_walk_mapping(svalue_t * sp,int num_arg)3834 v_walk_mapping (svalue_t *sp, int num_arg)
3835
3836 /* EFUN walk_mapping()
3837 *
3838 * void walk_mapping(mapping m, string func, string|object ob, mixed extra,...)
3839 * void walk_mapping(mapping m, closure cl, mixed extra,...)
3840 *
3841 * Calls ob->func(key, value1, ..., valueN, extra,...) resp. applies
3842 * the closure to every entry in the mapping. The keys are passed
3843 * by value, the values are passed by reference and can be
3844 * changed in the function.
3845 * Any number of extra arguments is accepted and passed.
3846 * If <ob> is omitted, or neither an object nor a string, then
3847 * this_object() is used.
3848 */
3849
3850 {
3851 svalue_t *arg; /* Begin of the args on the stack */
3852 callback_t cb;
3853 int error_index;
3854 mapping_t *m; /* Mapping to walk */
3855 p_int num_values; /* Number of values per entry */
3856 svalue_t *read_pointer; /* Prepared mapping values */
3857 mp_int i;
3858
3859 /* Locate the arguments on the stack and extract them */
3860 arg = sp - num_arg + 1;
3861 inter_sp = sp;
3862
3863 error_index = setup_efun_callback(&cb, arg+1, num_arg-1);
3864 inter_sp = sp = arg;
3865 num_arg = 1;
3866
3867 if (error_index >= 0)
3868 {
3869 vefun_bad_arg(error_index+2, sp);
3870 /* NOTREACHED */
3871 return sp;
3872 }
3873
3874 m = arg[0].u.map;
3875
3876
3877 /* Preparations */
3878
3879 check_map_for_destr(m);
3880 assign_eval_cost();
3881
3882 read_pointer = walk_mapping_prologue(m, sp, &cb);
3883 i = read_pointer[-2].u.number;
3884 inter_sp = ++sp; /* walk_mapping_prologue() pushed one value */
3885
3886 num_values = m->num_values;
3887
3888 /* For every key:values pair in read_pointer[], set up
3889 * the stack for a call to the walk function.
3890 */
3891 while (--i >= 0)
3892 {
3893 p_int j;
3894 svalue_t *sp2, *data;
3895
3896 if (!callback_object(&cb))
3897 errorf("Object used by walk_mapping destructed\n");
3898
3899 /* Push the key */
3900 assign_svalue_no_free( (sp2 = sp+1), read_pointer++ );
3901
3902 /* Push the values as lvalues */
3903 for (j = num_values, data = (read_pointer++)->u.lvalue; --j >= 0; )
3904 {
3905 (++sp2)->type = T_LVALUE;
3906 sp2->u.lvalue = data++;
3907 }
3908
3909 /* Call the function */
3910 inter_sp = sp2;
3911 (void)apply_callback(&cb, 1 + num_values);
3912 }
3913
3914 /* This frees the whole array allocated by the prologue,
3915 * including the data held by the callback.
3916 */
3917 free_svalue(sp);
3918
3919 /* Free the arguments */
3920 i = num_arg;
3921 do
3922 free_svalue(--sp);
3923 while (--i > 0);
3924
3925 return sp-1;
3926 } /* v_walk_mapping() */
3927
3928 /*-------------------------------------------------------------------------*/
3929 svalue_t *
x_filter_mapping(svalue_t * sp,int num_arg,Bool bFull)3930 x_filter_mapping (svalue_t *sp, int num_arg, Bool bFull)
3931
3932 /* EFUN filter() on mappings, filter_mapping() == filter_indices()
3933 *
3934 * mapping filter_mapping(mapping, string func, string|object ob, ...)
3935 * mapping filter_mapping(mapping, closure cl, ...)
3936 *
3937 * mapping filter(mapping, string func, string|object ob, ...)
3938 * mapping filter(mapping, closure cl, ...)
3939 *
3940 * ob->func() is called resp. cl applied to every element in the
3941 * mapping, with the key of the element as first argument, optionally
3942 * the data for the key as second argument (if bFull is TRUE), and
3943 * then the extra args that were given to the efun. If the function
3944 * returns true, the element is added to the result mapping.
3945 *
3946 * If <ob> is omitted, or neither an object nor a string, then
3947 * this_object() is used.
3948 *
3949 * If the data for the key is passed, it can take one of the following
3950 * forms:
3951 * widthof(m) == 0: nothing is passed
3952 * widthof(m) == 1: m[key] is passed
3953 * widthof(m) > 1: ({ m[key,0] .. m[key,width-1] }) is passed
3954 */
3955
3956 {
3957 svalue_t *arg; /* Start of arguments on the stack */
3958 mapping_t *m; /* Mapping to filter */
3959 int error_index;
3960 callback_t cb;
3961 p_int num_values; /* Width of the mapping */
3962 vector_t *dvec; /* Values of one key */
3963 svalue_t *dvec_sp; /* Stackentry of dvec */
3964 svalue_t *read_pointer; /* Prepared mapping values */
3965 svalue_t *v;
3966 p_int i, j;
3967
3968 /* Locate the arguments on the stack and extract them */
3969 arg = sp - num_arg + 1;
3970
3971 error_index = setup_efun_callback(&cb, arg+1, num_arg-1);
3972 inter_sp = sp = arg;
3973 num_arg = 1;
3974
3975 if (error_index >= 0)
3976 {
3977 vefun_bad_arg(error_index+2, sp);
3978 /* NOTREACHED */
3979 return sp;
3980 }
3981
3982 m = arg[0].u.map;
3983
3984 /* Preparations */
3985
3986 check_map_for_destr(m);
3987 assign_eval_cost();
3988
3989 num_values = m->num_values;
3990
3991 /* Prepare the vector for the values of each element */
3992 dvec = NULL;
3993 dvec_sp = NULL;
3994 bFull = bFull ? 1 : 0;
3995 /* So we can use it as the number of extra arguments */
3996
3997 if (bFull && num_values > 1)
3998 {
3999 dvec = allocate_array(num_values);
4000 if (!dvec)
4001 {
4002 inter_sp = sp;
4003 free_callback(&cb);
4004 errorf("Out of memory\n");
4005 }
4006 ++sp;
4007 put_array(sp, dvec);
4008 dvec_sp = sp;
4009 }
4010
4011 read_pointer = walk_mapping_prologue(m, sp, &cb);
4012
4013 m = allocate_mapping(read_pointer[-2].u.number, num_values);
4014 if (!m)
4015 {
4016 inter_sp = sp + 1;
4017 errorf("Out of memory\n");
4018 }
4019 sp += 2;
4020 put_mapping(sp, m);
4021
4022 /* m and dvec are kept referenced on the stack so that
4023 * in case of an error it is properly dereferenced.
4024 * At a normal termination however, m will not be dereferenced.
4025 */
4026
4027 /* For every (key:values) in read_pointer[], set up the stack for
4028 * a call to the filter function. If it returns true, assign the
4029 * pair to the new mapping.
4030 */
4031 for (i = read_pointer[-2].u.number; --i >= 0; read_pointer += 2)
4032 {
4033 svalue_t *data;
4034
4035 /* Check if somebody took a reference to the old dvec.
4036 * If yes, we need to create a new one.
4037 */
4038 if (dvec != NULL && dvec->ref > 1)
4039 {
4040 free_array(dvec);
4041 dvec = allocate_array(num_values);
4042 if (!dvec)
4043 {
4044 put_number(dvec_sp, 0);
4045 inter_sp = sp;
4046 free_callback(&cb);
4047 errorf("Out of memory\n");
4048 }
4049 else
4050 put_array(dvec_sp, dvec);
4051 }
4052
4053 /* Push the key */
4054 assign_svalue_no_free((inter_sp = sp + 1), read_pointer);
4055
4056 if (bFull) /* Push the data */
4057 {
4058 if (num_values == 0)
4059 {
4060 push_number(inter_sp, 0);
4061 }
4062 else if (1 == num_values)
4063 {
4064 push_svalue(read_pointer[1].u.lvalue);
4065 }
4066 else
4067 {
4068 svalue_t *svp;
4069
4070 v = read_pointer[1].u.lvalue;
4071 for (j = 0, svp = dvec->item
4072 ; j < num_values
4073 ; j++, svp++, v++)
4074 assign_svalue(svp, v);
4075 push_svalue(dvec_sp);
4076 }
4077 }
4078
4079 if (!callback_object(&cb))
4080 errorf("Object used by %s destructed"
4081 , bFull ? "filter" : "filter_mapping");
4082
4083
4084 v = apply_callback(&cb, 1 + bFull);
4085
4086 /* Did the filter return TRUE? */
4087 if (!v || (v->type == T_NUMBER && !v->u.number) )
4088 continue;
4089
4090 /* If we come here, the filter function returned 'true'.
4091 * Therefore assign the pair to the new mapping.
4092 */
4093 v = get_map_lvalue_unchecked(m, read_pointer);
4094 if (!v)
4095 {
4096 outofmemory("filtered entry");
4097 /* NOTREACHED */
4098 return NULL;
4099 }
4100 for (j = num_values, data = read_pointer[1].u.lvalue; --j >= 0; )
4101 {
4102 assign_svalue_no_free(v++, data++);
4103 }
4104 }
4105
4106 /* Cleanup the temporary data except for the reference to m.
4107 * The arguments have been removed before already.
4108 */
4109 free_callback(&cb);
4110 i = num_arg + (dvec != NULL ? 1 : 0);
4111 do
4112 {
4113 free_svalue(--sp);
4114 }
4115 while (--i >= 0);
4116
4117 /* Return the result mapping in place of the argument mapping.
4118 */
4119 put_mapping(sp, m);
4120
4121 return sp;
4122 } /* x_filter_mapping() */
4123
4124 /*-------------------------------------------------------------------------*/
4125 svalue_t *
v_filter_indices(svalue_t * sp,int num_arg)4126 v_filter_indices (svalue_t *sp, int num_arg)
4127
4128 /* EFUN filter_indices()
4129 *
4130 * mapping filter_indices(mapping, string func, string|object ob, ...)
4131 * mapping filter_indices(mapping, closure cl, ...)
4132 *
4133 * ob->func() is called resp. cl applied to every element in the
4134 * mapping, with first argument being the key of the
4135 * element, and then the extra args that were given to
4136 * filter_mapping. If the function returns true, the element is
4137 * added to the result mapping. ob can also be a file_name of an
4138 * object.
4139 * If <ob> is omitted, or neither an object nor a string, then
4140 * this_object() is used.
4141 */
4142
4143 {
4144 return x_filter_mapping(sp, num_arg, MY_FALSE);
4145 } /* v_filter_indices() */
4146
4147 /*-------------------------------------------------------------------------*/
4148 svalue_t *
x_map_mapping(svalue_t * sp,int num_arg,Bool bFull)4149 x_map_mapping (svalue_t *sp, int num_arg, Bool bFull)
4150
4151 /* EFUN map() on mappings, map_indices()
4152 *
4153 * mapping map(mapping m, string func, string|object ob, ...)
4154 * mapping map(mapping m, closure cl, ...)
4155 *
4156 * ob->func() is called resp. cl applied to every element in the
4157 * mapping, with the key of the element as first argument, optionally
4158 * the data for the key as second argument (if bFull is TRUE), and
4159 * then the extra args that were given to the efun.
4160 *
4161 * If <ob> is omitted, or neither an object nor a string, then
4162 * this_object() is used.
4163 *
4164 * If the data for the key is passed, it can take one of the following
4165 * forms:
4166 * widthof(m) == 0: nothing is passed
4167 * widthof(m) == 1: m[key] is passed
4168 * widthof(m) > 1: ({ m[key,0] .. m[key,width-1] }) is passed
4169 *
4170 * The data item in the result mapping is set to the return value
4171 * of the function. ob can also be a file_name of an object.
4172 * If the second arg is a string and the third is not an
4173 * object, this_object() will be used as default.
4174 *
4175 * Note that if mapping m has more than one value per key, these
4176 * are ignored: the resulting mapping always has one value per key.
4177 *
4178 * Also note that the behaviour of this function is different from
4179 * map_array().
4180 */
4181
4182 {
4183 svalue_t *arg; /* Begin of arguments on the stack */
4184 mapping_t *arg_m; /* Mapping to map */
4185 mapping_t *m; /* Result mapping */
4186 p_int num_values; /* Width of the mapping */
4187 vector_t *vec; /* Indices of m */
4188 svalue_t *dvec_sp; /* Stackentry of dvec */
4189 vector_t *dvec; /* Values of one key */
4190 p_int i;
4191 svalue_t *key;
4192 callback_t cb;
4193 int error_index;
4194
4195 /* Locate and extract arguments */
4196 arg = sp - num_arg + 1;
4197 inter_sp = sp;
4198
4199 error_index = setup_efun_callback(&cb, arg+1, num_arg-1);
4200 inter_sp = sp = arg;
4201 num_arg = 2;
4202
4203 if (error_index >= 0)
4204 {
4205 vefun_bad_arg(error_index+2, sp);
4206 /* NOTREACHED */
4207 return sp;
4208 }
4209
4210 sp++;
4211 inter_sp = sp;
4212 put_callback(sp, &cb);
4213
4214 /* Preparations */
4215
4216 arg_m = arg[0].u.map;
4217
4218 assign_eval_cost();
4219
4220 num_values = arg_m->num_values;
4221
4222 /* Get the indices of arg_m */
4223 vec = m_indices(arg_m); /* might cause error */
4224 ++sp;
4225 put_array(sp, vec);
4226
4227 /* Prepare the vector for the values of each element */
4228 dvec = NULL;
4229 dvec_sp = NULL;
4230 bFull = bFull ? 1 : 0;
4231 /* So we can use it as the number of extra arguments */
4232
4233 if (bFull && num_values > 1)
4234 {
4235 dvec = allocate_array(num_values);
4236 if (!dvec)
4237 {
4238 inter_sp = sp;
4239 errorf("Out of memory\n");
4240 }
4241 ++sp;
4242 put_array(sp, dvec);
4243 dvec_sp = sp;
4244 }
4245
4246 m = allocate_mapping((i = VEC_SIZE(vec)), 1);
4247 if (!m)
4248 {
4249 inter_sp = sp;
4250 errorf("Out of memory\n");
4251 }
4252 ++sp;
4253 put_mapping(sp, m);
4254
4255 /* Both cb, vec, dvec and m are kept referenced on the stack so that
4256 * in case of an error they are properly dereferenced.
4257 * At a normal termination however, m will not be dereferenced
4258 * but cb, vec and dvec will.
4259 */
4260
4261 key = vec->item;
4262 for (; --i >= 0; key++) {
4263 svalue_t *v;
4264 svalue_t *data;
4265
4266 /* Check if somebody took a reference to the old dvec.
4267 * If yes, we need to create a new one.
4268 */
4269 if (dvec != NULL && dvec->ref > 1)
4270 {
4271 free_array(dvec);
4272 dvec = allocate_array(num_values);
4273 if (!dvec)
4274 {
4275 put_number(dvec_sp, 0);
4276 inter_sp = sp;
4277 errorf("Out of memory\n");
4278 }
4279 else
4280 put_array(dvec_sp, dvec);
4281 }
4282
4283 /* Push the key */
4284 assign_svalue_no_free((inter_sp = sp + 1), key);
4285
4286 if (bFull) /* Push the data */
4287 {
4288 if (0 == num_values)
4289 push_number(inter_sp, 0);
4290 else if (1 == num_values)
4291 {
4292 v = get_map_value(arg_m, key);
4293 push_svalue(v);
4294 }
4295 else
4296 {
4297 p_int j;
4298 svalue_t *svp;
4299
4300 v = get_map_value(arg_m, key);
4301 for (j = 0, svp = dvec->item; j < num_values; j++, svp++, v++)
4302 assign_svalue(svp, v);
4303 push_svalue(dvec_sp);
4304 }
4305 }
4306
4307 /* Call the filter function */
4308 v = get_map_lvalue_unchecked(m, key);
4309 if (!v)
4310 {
4311 outofmemory("mapped entry");
4312 /* NOTREACHED */
4313 return NULL;
4314 }
4315
4316 if (!callback_object(&cb))
4317 errorf("Object used by %s destructed"
4318 , bFull ? "map" : "map_mapping");
4319
4320 data = apply_callback(&cb, 1 + bFull);
4321 if (data)
4322 {
4323 transfer_svalue_no_free(v, data);
4324 data->type = T_INVALID;
4325 }
4326 }
4327
4328 /* Cleanup the temporary data except for the reference to m.
4329 * The arguments have been removed before already.
4330 */
4331 i = num_arg + (dvec != NULL ? 1 : 0);
4332 do
4333 {
4334 free_svalue(--sp);
4335 }
4336 while (--i >= 0);
4337
4338 /* Return the result mapping in place of the argument mapping.
4339 */
4340 put_mapping(sp, m);
4341 return sp;
4342 } /* x_map_mapping() */
4343
4344 /*-------------------------------------------------------------------------*/
4345 svalue_t *
v_map_indices(svalue_t * sp,int num_arg)4346 v_map_indices (svalue_t *sp, int num_arg)
4347
4348 /* VEFUN map_indices()
4349 *
4350 * mapping map_indices(mapping m, string func, object ob, ...)
4351 * mapping map_indices(mapping m, closure cl, ...)
4352 *
4353 * ob->func() is called resp. cl applied to every element in the
4354 * mapping, with the key of the element as first argument, and
4355 * then the extra args that were given to map_mapping.
4356 * The data item in the mapping is replaced by the return value
4357 * of the function. ob can also be a file_name of an object.
4358 *
4359 * If <ob> is omitted, or neither an object nor a string, then
4360 * this_object() is used.
4361 */
4362
4363 {
4364 return x_map_mapping(sp, num_arg, MY_FALSE);
4365 } /* v_map_indices() */
4366
4367 /*-------------------------------------------------------------------------*/
4368 svalue_t *
v_m_contains(svalue_t * sp,int num_arg)4369 v_m_contains (svalue_t *sp, int num_arg)
4370
4371 /* EFUN m_contains()
4372 *
4373 * int m_contains(mixed &data1, ..., &dataN, map, key)
4374 *
4375 * If the mapping contains the key map, the corresponding values
4376 * are assigned to the data arguments, which must be passed by
4377 * reference, and 1 is returned. If key is not in map, 0 is
4378 * returned and the data args are left unchanged.
4379 * It is possible to use this function for a 0-value mapping, in
4380 * which case it has the same effect as member(E).
4381 */
4382
4383 {
4384 svalue_t *item;
4385 int i;
4386
4387 /* Test the arguments */
4388 for (i = -num_arg; ++i < -1; )
4389 if (sp[i].type != T_LVALUE)
4390 vefun_arg_error(num_arg + i, T_LVALUE, sp[i].type, sp);
4391 if (sp[-1].type != T_MAPPING)
4392 vefun_arg_error(num_arg-1, T_MAPPING, sp[-1].type, sp);
4393 if (sp[-1].u.map->num_values != num_arg - 2)
4394 errorf("Not enough lvalues: given %d, required %"PRIdPINT".\n",
4395 num_arg-2, sp[-1].u.map->num_values);
4396
4397 item = get_map_value(sp[-1].u.map, sp);
4398 if (item == &const0)
4399 {
4400 /* Not found */
4401 sp = pop_n_elems(num_arg-1, sp);
4402 free_svalue(sp);
4403 put_number(sp, 0);
4404 return sp;
4405 }
4406
4407 free_svalue(sp--); /* free key */
4408
4409 /* Copy the elements */
4410 for (i = -num_arg + 1; ++i < 0; )
4411 {
4412 /* get_map_lvalue() may return destructed objects. */
4413 /* TODO: May this cause problems elsewhere, too? */
4414 if (destructed_object_ref(item))
4415 {
4416 assign_svalue(sp[i].u.lvalue, &const0);
4417 item++;
4418 }
4419 else
4420 /* mapping must not have been freed yet */
4421 assign_svalue(sp[i].u.lvalue, item++);
4422 free_svalue(&sp[i]);
4423 }
4424
4425 free_svalue(sp--); /* free mapping */
4426 sp += 3 - num_arg;
4427 put_number(sp, 1);
4428
4429 return sp;
4430 } /* v_m_contains() */
4431
4432 /*-------------------------------------------------------------------------*/
4433 svalue_t *
f_m_entry(svalue_t * sp)4434 f_m_entry (svalue_t *sp)
4435
4436 /* TEFUN m_entry()
4437 *
4438 * mixed * m_entry (mapping m, mixed key)
4439 *
4440 * Query the mapping <m> for key <key> and return all values for this
4441 * key as array.
4442 * If the mapping does not contain an entry for <key>, svalue-0 is
4443 * returned.
4444 */
4445
4446 {
4447 svalue_t * data;
4448 vector_t * rc;
4449
4450 data = get_map_value(sp[-1].u.map, sp);
4451 if (&const0 != data)
4452 {
4453 p_int num_values = sp[-1].u.map->num_values;
4454 p_int i;
4455
4456 rc = allocate_array(num_values);
4457
4458 for (i = 0; i < num_values; i++)
4459 {
4460 assign_svalue(rc->item+i, data+i);
4461 }
4462 }
4463 else
4464 rc = NULL;
4465
4466 free_svalue(sp); sp--;
4467 free_svalue(sp);
4468
4469 if (rc)
4470 put_array(sp, rc);
4471 else
4472 put_number(sp, 0);
4473
4474 return sp;
4475 } /* f_m_entry() */
4476
4477 /*-------------------------------------------------------------------------*/
4478 svalue_t *
f_m_reallocate(svalue_t * sp)4479 f_m_reallocate (svalue_t *sp)
4480
4481 /* EFUN m_reallocate()
4482 *
4483 * mapping m_reallocate(mapping m, int width)
4484 *
4485 * Create a new mapping of width <width> and fill it with the values
4486 * of mapping <m>. If <m> is narrower than <width>, the extra values
4487 * in the result will be 0; if <m> is wider, the extra values of <m>
4488 * will be omitted.
4489 */
4490
4491 {
4492 p_int new_width; /* Requested width of the target mapping */
4493 mapping_t *m; /* Argument mapping */
4494 mapping_t *new_m; /* New mapping */
4495
4496 /* Test and get arguments */
4497 new_width = sp->u.number;
4498 if (new_width < 0)
4499 {
4500 errorf("Illegal width to m_reallocate(): %"PRIdPINT"\n", new_width);
4501 /* NOTREACHED */
4502 return sp;
4503 }
4504
4505 inter_sp = --sp;
4506
4507 m = sp->u.map;
4508
4509 /* Resize the mapping */
4510 check_map_for_destr(m);
4511 new_m = resize_mapping(m, new_width);
4512 if (!new_m)
4513 {
4514 errorf("Out of memory.\n");
4515 /* NOTREACHED */
4516 return sp;
4517 }
4518
4519 /* Assign and return the result */
4520 free_svalue(sp);
4521 put_mapping(sp, new_m);
4522
4523 return sp;
4524 } /* f_m_reallocate() */
4525
4526 /*-------------------------------------------------------------------------*/
4527 svalue_t *
v_mkmapping(svalue_t * sp,int num_arg)4528 v_mkmapping (svalue_t *sp, int num_arg)
4529
4530 /* EFUN mkmapping()
4531 *
4532 * mapping mkmapping(mixed *arr1, mixed *arr2,...)
4533 *
4534 * Returns a mapping with indices from 'arr1' and values from
4535 * 'arr2'... . arr1[0] will index arr2...[0], arr1[1] will index
4536 * arr2...[1], etc. If the arrays are of unequal size, the mapping
4537 * will only contain as much elements as are in the smallest
4538 * array.
4539 *
4540 #ifdef USE_STRUCTS
4541 * mapping mkmapping(struct st)
4542 *
4543 * Return a mapping with all values from struct <st>, indexed by
4544 * the struct's member names.
4545 #endif
4546 */
4547
4548 {
4549 mapping_t *m;
4550
4551 m = NULL;
4552
4553 #ifdef USE_STRUCTS
4554 if (sp[-num_arg+1].type == T_STRUCT)
4555 {
4556 struct_t * st;
4557 long i, length;
4558
4559 /* Check the arguments and determine the mapping length.
4560 */
4561 if (num_arg > 1)
4562 errorf("Too many arguments to mkmapping(): expected struct\n");
4563
4564 st = sp->u.strct;
4565 length = struct_size(st);
4566
4567 if (max_mapping_size && length > (p_int)max_mapping_size)
4568 errorf("Illegal mapping size: %ld elements\n", length);
4569 if (max_mapping_keys && length > (p_int)max_mapping_keys)
4570 errorf("Illegal mapping size: %ld entries\n", length);
4571
4572 /* Allocate the mapping and assign the values */
4573 m = allocate_mapping(length, 1);
4574 if (!m)
4575 errorf("Out of memory\n");
4576
4577 for (i = 0; i < length; i++)
4578 {
4579 svalue_t key;
4580 svalue_t * data;
4581
4582 put_string(&key, st->type->member[i].name);
4583 data = get_map_lvalue_unchecked(m, &key);
4584 assign_svalue(data, &st->member[i]);
4585 }
4586 }
4587 #endif
4588
4589 if (sp[-num_arg+1].type == T_POINTER)
4590 {
4591 int i, num_values; /* contains num_arg, which is int */
4592 p_int length; /* VEC_SIZE, array sizes */
4593 svalue_t *key;
4594
4595 /* Check the arguments and set length to the size of
4596 * the shortest array.
4597 */
4598 length = PINT_MAX;
4599 for (i = -num_arg; ++i <= 0; )
4600 {
4601 if ( sp[i].type != T_POINTER )
4602 vefun_arg_error(i+num_arg, T_POINTER, sp[i].type, sp);
4603 if (length > VEC_SIZE(sp[i].u.vec))
4604 length = VEC_SIZE(sp[i].u.vec);
4605 }
4606
4607 if (max_mapping_size && (mp_int)length * num_arg > (mp_int)max_mapping_size)
4608 errorf("Illegal mapping size: %"PRIdMPINT
4609 " elements (%"PRIdPINT" x %d)\n"
4610 , (mp_int)length * num_arg, length, num_arg);
4611 if (max_mapping_keys && length > (p_int)max_mapping_keys)
4612 errorf("Illegal mapping size: %"PRIdPINT" entries\n", length);
4613
4614 /* Allocate the mapping */
4615 num_values = num_arg - 1;
4616 m = allocate_mapping(length, num_values);
4617 if (!m)
4618 errorf("Out of memory\n");
4619
4620 /* Shift key through the first array and assign the values
4621 * from the others.
4622 */
4623 key = &(sp-num_values)->u.vec->item[length];
4624 while (--length >= 0)
4625 {
4626 svalue_t *dest;
4627
4628 dest = get_map_lvalue_unchecked(m, --key);
4629 if (!dest)
4630 {
4631 outofmemory("new mapping entry");
4632 /* NOTREACHED */
4633 return NULL;
4634 }
4635 for (i = -num_values; ++i <= 0; )
4636 {
4637 /* If a key value appears multiple times, we have to free
4638 * a previous assigned value to avoid a memory leak
4639 */
4640 assign_svalue(dest++, &sp[i].u.vec->item[length]);
4641 }
4642 }
4643 }
4644
4645 /* If m is NULL at this point, we got an illegal argument */
4646 if (m == NULL)
4647 {
4648 fatal("Illegal argument to mkmapping(): %s, expected array/struct.\n"
4649 , typename(sp[-num_arg+1].type));
4650 }
4651
4652 /* Clean up the stack and push the result */
4653 sp = pop_n_elems(num_arg, sp);
4654 push_mapping(sp, m);
4655
4656 return sp;
4657 } /* v_mkmapping() */
4658
4659 /*-------------------------------------------------------------------------*/
4660 svalue_t *
f_unmkmapping(svalue_t * sp)4661 f_unmkmapping (svalue_t *sp)
4662
4663 /* EFUN unmkmapping()
4664 *
4665 * mixed* unmkmapping(mapping map)
4666 *
4667 * Take mapping <map> and return an array of arrays with the keys
4668 * and values from the mapping.
4669 *
4670 * The return array has the form ({ keys[], data0[], data1[], ... }).
4671 */
4672
4673 {
4674 svalue_t *svp;
4675 mapping_t *m;
4676 vector_t *v;
4677 struct mvf_info vip;
4678 mp_int size;
4679 p_int i;
4680
4681 /* Get the arguments */
4682 m = sp->u.map;
4683
4684 /* Determine the size of the mapping and allocate the result vector */
4685 check_map_for_destr(m);
4686 size = MAP_SIZE(m);
4687 v = allocate_array(m->num_values+1);
4688
4689 /* Allocate the sub vectors */
4690 for (i = 0, svp = v->item; i <= m->num_values; i++, svp++)
4691 {
4692 vector_t *v2;
4693
4694 v2 = allocate_array(size);
4695 put_array(svp, v2);
4696 }
4697
4698 /* Copy the elements from the mapping into the vector brush */
4699 vip.svp = v->item;
4700 vip.num = 0;
4701 vip.width = m->num_values;
4702 walk_mapping(m, m_unmake_filter, &vip);
4703
4704 /* Clean up the stack and push the result */
4705 free_mapping(m);
4706 put_array(sp,v);
4707
4708 return sp;
4709 } /* f_unmkmapping() */
4710
4711 /*-------------------------------------------------------------------------*/
4712 svalue_t *
f_widthof(svalue_t * sp)4713 f_widthof (svalue_t *sp)
4714
4715 /* EFUN widthof()
4716 *
4717 * int widthof (mapping map)
4718 *
4719 * Returns the number of values per key of mapping <map>.
4720 * If <map> is 0, the result is 0.
4721 */
4722
4723 {
4724 p_int width;
4725
4726 if (sp->type == T_NUMBER && sp->u.number == 0)
4727 return sp;
4728
4729 if (sp->type != T_MAPPING)
4730 efun_arg_error(1, T_MAPPING, sp->type, sp);
4731
4732 width = sp->u.map->num_values;
4733 free_mapping(sp->u.map);
4734 put_number(sp, width);
4735
4736 return sp;
4737 } /* f_widthof() */
4738
4739 /***************************************************************************/
4740